ADDED CONTRIBUTORS
Index: CONTRIBUTORS
==================================================================
--- /dev/null
+++ CONTRIBUTORS
@@ -0,0 +1,52 @@
+The historical files here represents copies of earlier versions of
+Reduce and PSL with (at present) the oldes ones being from the early 1980s.
+They are in general unaltered from the original archives that they were
+recovered from, and a consequence of that is that some have restrictive
+rights messages embedded which represented their status at that time.
+Tony Hearn and Martin Griss as lead copyright holders were senty an enquiry:
+> Would you grant permission for me to make these public as part of the
+> above-mentioned web site (which Im expecting will eventually be
+> formally accessioned into the Computer History Museum digital
+> repository? Thanks very much.
+
+Tony Hearn replied:
+> Fine with me.
+
+Martin Griss replied:
+> I have no objections to their release with an appropriate note, but its
+> important to know that several files were written or updated by
+> multiple students at Utah and by several staff at HP Laboratories; many
+> of these folks have most likely retired.
+>
+> So, I am not sure if we need to contact them for permission. Perhaps
+> they at least need to be listed as contributors. As far as I can
+> tell/recall, only some of the files have copyright notices that request
+> my permission for release - I assume (or intended -:) these notice on
+> the "main" files apply to all subsidiary files, both hand written and
+> generated.
+>
+> We will need certainly to add some sort of caveat/disclosure that says
+> these files are provided for historical interest only, and there is no
+> implied warrantee of fitness or correctness for use, nor may they be
+> used for any commercial pupose..
+
+Please note that last paragraph that these files are made availanle to
+record the historical trail of the Reduce project and the contributors -
+both those named within the filea and others deserve thanks and credit.
+
+For later copies of Reduce Tony Hearn arranged that contributors completed
+paperwork to confirm that they were willing to have their code distributed
+as part of Reduce. For PSL at some stage control and support was organised
+through HP Labs, and a modest while after Reduce became an open source
+project they confirmed that they were happy for their code to be included
+as part of the open source version. It is probable that the rights that they
+acquired in order to be able to develop and exploit PSL means that their
+release of the code covers almost all of the versions here. See the HP
+disclaimer in the PSL section of the main current version of the code.
+
+The bibliography in the file doc/manual/bibl.bib lists many of those who
+contributed to Reduce.
+
+ ACN April 2020
+
+
ADDED perq-pascal-lisp-project/CONTRIBUTORS
Index: perq-pascal-lisp-project/CONTRIBUTORS
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/CONTRIBUTORS
@@ -0,0 +1,52 @@
+The historical files here represents copies of earlier versions of
+Reduce and PSL with (at present) the oldes ones being from the early 1980s.
+They are in general unaltered from the original archives that they were
+recovered from, and a consequence of that is that some have restrictive
+rights messages embedded which represented their status at that time.
+Tony Hearn and Martin Griss as lead copyright holders were senty an enquiry:
+> Would you grant permission for me to make these public as part of the
+> above-mentioned web site (which Im expecting will eventually be
+> formally accessioned into the Computer History Museum digital
+> repository? Thanks very much.
+
+Tony Hearn replied:
+> Fine with me.
+
+Martin Griss replied:
+> I have no objections to their release with an appropriate note, but its
+> important to know that several files were written or updated by
+> multiple students at Utah and by several staff at HP Laboratories; many
+> of these folks have most likely retired.
+>
+> So, I am not sure if we need to contact them for permission. Perhaps
+> they at least need to be listed as contributors. As far as I can
+> tell/recall, only some of the files have copyright notices that request
+> my permission for release - I assume (or intended -:) these notice on
+> the "main" files apply to all subsidiary files, both hand written and
+> generated.
+>
+> We will need certainly to add some sort of caveat/disclosure that says
+> these files are provided for historical interest only, and there is no
+> implied warrantee of fitness or correctness for use, nor may they be
+> used for any commercial pupose..
+
+Please note that last paragraph that these files are made availanle to
+record the historical trail of the Reduce project and the contributors -
+both those named within the filea and others deserve thanks and credit.
+
+For later copies of Reduce Tony Hearn arranged that contributors completed
+paperwork to confirm that they were willing to have their code distributed
+as part of Reduce. For PSL at some stage control and support was organised
+through HP Labs, and a modest while after Reduce became an open source
+project they confirmed that they were happy for their code to be included
+as part of the open source version. It is probable that the rights that they
+acquired in order to be able to develop and exploit PSL means that their
+release of the code covers almost all of the versions here. See the HP
+disclaimer in the PSL section of the main current version of the code.
+
+The bibliography in the file doc/manual/bibl.bib lists many of those who
+contributed to Reduce.
+
+ ACN April 2020
+
+
ADDED perq-pascal-lisp-project/[teco].output
Index: perq-pascal-lisp-project/[teco].output
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/[teco].output
@@ -0,0 +1,366 @@
+@Device(lpt)
+@style(justification yes)
+@style(spacing 1)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@make(article)
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(appendix,numbered=<APPENDIX @A: >)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+@define(up,use text,capitalized on, break off)
+@define(mac,use text, underline off, break off)
+@define(LISPmac,use text, underline alphanumerics, break off)
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "December 1981",
+ Line "Operating Note 60"
+ )
+@set(page=1)
+@newpage()
+@begin(titlepage)
+@begin(titlebox)
+@b(A PASCAL Based Standard LISP for the Apollo Domain)
+@center[
+by
+
+M. L. Griss and R. Ottenheimer
+
+Department of Computer Science
+University of Utah
+Salt Lake City, Utah 84112
+
+@b(Preliminary Version)
+
+Last Revision: @value(date)]
+
+@end(titlebox)
+@begin(abstract)
+This report describes an interim implementation of Standard LISP for the
+Apollo DOMAIN. This LISP is based upon the Standard LISP report, and a newly
+developing Portable Standard LISP. This interim implementation is designed
+to explore LISP implementations in PASCAL on the Apollo DOMAIN and similar
+machines.
+The system consists of a kernel, handcoded in PASCAL, with the rest of the
+system written in LISP and compiled to PASCAL.
+@End(abstract)
+@begin(Researchcredit)
+Work supported in part by the National Science Foundation
+under Grant No. MCS80-07034.
+@end(Researchcredit)
+@end(titlepage)
+@pageheading(Left "Apollo Pascal LISP",Center "@value(date)",
+ Right "@value(Page)"
+ )
+@set(page=1)
+@newpage
+@section(Introduction)
+In this preliminary report, we describe an implementation of Standard LISP
+in PASCAL, PASLSP. Versions of PASLSP have been run on a number of
+machines, ranging from an LSI-11 based TERAK to Apollo and PERQ. This report
+concentrates on the Apollo DOMAIN implementation. This report is to be read in
+conjunction with the Standard LISP report@cite(Marti79); we will
+highlight the differences from the functions documented in the Standard
+LISP, describe the implementation strategy, and discuss future work.
+
+PASLSP is based on a series of small and medium sized LISP interpreters
+that have been developed at the University of Utah to explore LISP
+implementations in higher level languages. Each of these LISP systems
+consists of a small kernel handcoded in some language, with the rest of the
+system written in LISP and compiled to the target language. We have used
+FORTRAN, PASCAL and assembly language as targets. The PASLSP series use
+PASCAL for the kernel, and have a LISP to PASCAL compiler for the rest of
+the system.
+
+Recent work has concentrated on reducing the size of the hand-coded kernel,
+and extending the compiler to handle systems level constructs. This has
+resulted in a new Portable Standard LISP, PSL, running on the DEC-20 and
+VAX-11/750@cite(Benson81,Griss81). An implementation of PSL for MC68000 is
+underway. The PSL system is a modern, efficient LISP, written entirely in
+itself; it uses an efficient LISP to machine code compiler to produce the
+kernel, and then the rest of LISP is loaded. In the future we hope to
+produce a complete PSL targeted at a higher level languages, such as
+PASCAL, C or ADA, and this will replace the current PASLSP.
+
+@subsection(History of PASLSP)
+The system now called PASLSP was originally developed (by M. Griss and W.
+Galway), as a small LISP like kernel to support a small computer algebra
+system on an LSI-11 TERAK; this was to be used as an answer analysis module
+within a CAI system@cite(Brandt81), written entirely in PASCAL. It was
+decided to hand-code a very small kernel, and compile additional functions
+written in LISP (LISP support functions, parser and
+simplifier) to PASCAL,
+using a modified Portable LISP compiler@cite(griss79). This version (call
+it V0) did not even have user defined functions, since space on the TERAK
+was at a premium.
+
+About June 1981, PASLSP came to the attention of a number people evaluating
+Apollo's and PERQ's, and it was suggested that we enhance V0 PASLSP for
+this purpose. During the space of a few days, features taken
+from the Standard LISP Report and newly developing
+PSL files were added to
+produce PASLSP-V1, running on a DEC-20 and Terak. This
+was a fairly complete LISP (including Catch and Throw), but lacked a few
+features (OPEN, CLOSE, RDS, WRS, PROG, GO, RETURN, COMPRESS, EXPLODE,
+Vectors and Strings, etc.). V1 PASLSP was adapted to a PERQ, VAX and
+Apollo by Paul Milazo of Schlumberge in the space of a few weeks (we did
+not have a PERQ or Apollo at that time).
+
+We subsequently obtained a PERQ and an Apollo, and recent work has been
+aimed at producing an enhanced PASLSP for these machines, maintaining all
+versions in one set of source files. The current system, PASLSP-V2, is
+produced from a single PASCAL kernel and set of LISP support files; the
+machine specific features are handled by a simple Source Code
+Conditionalizer, changing the definition of certain constants and data
+types. Only a few features of the Standard LISP report are missing,
+and there are a number of additions.
+
+@subsection(Acknowledgement)
+
+We would like to acknowledge the contributions and support of
+Eric Benson, Dick Brandt, Will Galway, and Paul Milazo.
+
+@section(Features of PASLSP and relation to Standard LISP)
+PASLSP as far as possible provides all the functions mentioned
+in the attached Standard LISP Report (note the hand-written
+comments added to this appendix); some of the functions are simply
+stubs, so that a Standard LISP Test-file can be run without major
+modification.
+
+PASLSP-V2 does not implement the following features of Standard LISP:
+@begin(enumeration,spread 0)
+VECTORS (only a simple garbage collector is used).
+
+String space is not garbage collected.
+
+Integers are limited in size (INTs and FIXNUMs, no BIGNUMs).
+
+FLOATING Point is not implemented.
+
+IDs can not be REMOB'ed or INTERN'd.
+
+Only 3 Input Channels and 2 Output Channels are available to OPEN,
+RDS, WRS, and CLOSE. Thus file input statements can not be nested
+very deeply in files.
+
+Line, Page and Character counting (POSN, LPOSN, etc) are not implemented.
+@end(enumeration)
+
+PASLSP-V2 provides some extensions over Standard LISP:
+@begin(enumerate,spread 0)
+(CATCH form) and (THROW form) and the tagged versions: (TCATCH tag form)
+and (TTHROW tag form) are used to implement error and errorset,
+and higher level control functions.
+
+Implicit PROGN in COND, and LAMBDA expressions.
+
+(WHILE pred action-1 action-2 ... action-n).
+
+(DSKIN 'filename)
+@end(enumerate)
+
+PASLSP-V2 has not been extensively tested, and there may still be a number
+of bugs. While some effort has been spent in adjusting PASLSP to the Apollo
+DOMAIN, it is clear that the various heap sizes are not yet optimal.
+See appendix A for current list of functions, and appendix B for a copy
+of the Standard LISP Report annotated to reflect the current status of
+PASLSP.
+
+@section(Using PASLSP on the Apollo DOMAIN)
+ Initializing the system from the floppy looks like this:
+@begin(verbatim)
+Create a directory (call it pl):
+ crd /pl
+Mount the floppy:
+ mtvol f 1 /f
+Copy the files of interest:
+ cpt /f/pascallisp /pl
+
+ The files copied will be: paslsp (executable file)
+ paslsp.ini (initialization file)
+ paslsp.tst (a test file)
+@end(verbatim)
+
+Run paslsp as you would any other file. If you
+get an error it is most likely because the paslsp.ini file couldn't be found.
+If this happens, locate paslsp.ini and try again. If it still hangs,
+try calling Ralph Ottenheimer at (801) 355-0226 or M. Griss at (801) 581-6542.
+
+
+Previously prepared files of LISP (e.g., library procedures)
+can be input by
+using the function "DSKIN". For Example,
+@begin(verbatim)
+(DSKIN 'Paslsptst)
+(DSKIN '!/p!/foo!.sl)
+@end
+would load the paslsp test file. Paslsp test is adapted from an extensive
+test of Standard LISP (avoiding features not yet implemented). This is a
+good excercise, try it. [Note that the filename must be given as an ID,
+and that special characters should be prefaced by an "escape character",
+! . This is also the case for filenames in OPEN.]
+
+
+ Paslsp is "case-sensitive" with regard to identifiers. All of the
+kernel procedures have upper-case identifiers associated with them. This
+means that ordinarily the expression (dskin 'paslsptst) would not be
+recognized since "dskin" is in lowercase. However, there is a global flag
+!*RAISE which if true will convert all lower-case typin to upper-case.
+This Apollo DOMAIN paslsp implementation sets !*RAISE to T as a default by
+having (SETQ !*RAISE T) in the paslsp.ini file. You may put any special
+initialization code you like at the end of paslsp.ini as indicated by the
+comments in the file.
+Toggling would be accomplished by typing the following lisp-expressions:
+@begin(verbatim)
+ (SETQ !*RAISE T)
+ (SETQ !*RAISE NIL)
+@end(verbatim)
+
+ Any Apollo DOMAIN filename (25 characters maximum)is allowable
+ as a paslsp filename.
+Remember to prefix all special characters with an exclamation-mark: "!".
+Special characters include all non-alphanumerics. For example: fof!.ksjd
+!*RAISE goforit!! paslsp!.test .
+@section(Implementation of PASLSP)
+@subsection(Building PASLSP)
+PASLSP is built in the following steps:
+
+@u(Kernel files), PAS0.PRE, and trailer file (main program) PASN.PRE
+are run through a filter program to produce PAS0.PAS and PASN.PAS,
+tailored to the Apollo DOMAIN (appropriate Include files, Consts, etc).
+This kernel provides the Basic I/O (Token reading and printing),
+handcoded storage allocator and garbage collector, lowlevel arithmetic
+primitives, lowlevel calls (via Case statement) from LISP to kernel, etc.
+
+@u(Rest of LISP), currently files PAS1.RED, PAS2.RED and PAS3.RED are
+compiled to PASCAL using a version of the Portable LISP Compiler
+(PLC)@cite(griss79). During compilation, a Symbol Table file, PASn.SYM is
+read in and written out. These files record (for "incremental" compilation)
+the names and ID table locations of each ID encountered, so that the compiler
+can refer to an ID by its offset in the ID table. LISP constants are also
+recorded in the PASn.SYM files. PAS0.SYM is modified by hand as the kernel
+is changed.
+
+The compilation model used is that of a Register Machine: Arguments to LISP
+functions are passed in registers (a PASCAL array), and the result returned
+in Register 1. Space is allocated on a software stack (not the PASCAL
+recursion stack), for any temporaries or save arguments required. Short
+functions usually do not require any stack. The reason for this choice was
+the existence of the PLC (targeted at comventional machines), and the fact
+that inline access to the register array compiles quite well, while a
+"PUSH/POP" stack would be much less efficient.
+
+@u(Initialization).
+After the PAS0.PAS,..PASN.PAS are produced,
+the symbol table file (pas3.sym) is converted into a file
+PASLSP.INI, which contains the names of all ID's, the LISP constants
+used, and also ID's for all kernel functions that should be known to the
+user LISP level. Also produced is a file, EXEC.PAS, that contains a case
+statement associating each user callable kernel function with an integer.
+The PAS0.PAS ... PASN.PAS and EXEC.PAS are compiled and linked into an
+executable .RUN file. When this file is executed, PASLSP.INI is read in:
+each id is read and stored in the appropriate location in the symbol-table,
+the kernal function names have the associated Case index put into
+a function cell, and the LISP s-expressions are READ in. Finally,
+some s-expressions will be executed (with care, the user can add his own
+expressions, including requests to (DSKIN 'library), etc.
+@subsection(Internal data structures)
+[To be written, see the PAS0.PRE files regarding data-types,
+function calling conventions, etc]
+ itemref = RECORD
+ tag: integer; (* Small integer denoting the type. *)
+ info: integer; (* Either the item or a pointer to it *)
+ (* depending upon the type. *)
+ END;
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ END;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+
+@subsection(Adding user functions to the kernel)
+[To be written, describe format of EXEC.PAS, PASLSP.INI and major functions
+that are needed to add new Arithmetic extensions,
+or more complex operations].
+
+@Section(Future work on PASLSP)
+PASLSP V2 is based on a fairly old model of a portable LISP, and
+has been used mainly to explore the capbilities of PASCAL as a
+target language. In particular, V2 PASCAL is not yet powerful enough to
+run the PLC compiler itself;
+instead, the PLC is run on our PSL system on the DEC-20. In order for the
+full benefits of PASLSP (or PSL) to be realized, the user should be able to
+compile his own LISP modules into PASCAL and link them with the kernel.
+In order to make the system even more adapatable, we would like to write
+even less of the kernel in PASCAL by hand. This goal has lead us to the
+development of PSL.
+
+@subsection(Goals of the Utah PSL Project)
+
+The goal of the PSL project is to produce an efficient and transportable
+Standard LISP system that may be used to:
+@begin(enumeration)
+Experimentally explore
+a variety of LISP implementation issues (storage management, binding,
+environments, etc.).
+
+Effectively support the REDUCE computer algebra system@cite(hearn73)
+on a number of machines.
+
+Provide the same, uniform, modern LISP programming environment on all of
+the machines that we use (DEC-20, VAX/750, PDP-11/45, PERQ, and Apollo), of
+the power and complexity of UCI-LISP, FranzLISP or MACLISP, with some
+extensions and enhancements derived from LISP Machine LISP or CommonLISP.
+@end(enumeration)
+
+The approach we have been using is to write the @b(entire) LISP system in
+Standard LISP (with extensions for dealing with
+machine words and operations), and to bootstrap it to the desired target
+machine
+in two steps:
+@begin(enumeration)
+Cross compile an appropriate kernel to the assembly language of the
+target machine;
+
+Once the kernel is running, use a resident compiler and loader, or
+fast-loader, to build the rest of the system.
+@end(enumeration)
+
+ The PASLSP system, and other early implementations, have the problem that
+the implementation language (PASCAL) is a distinct language from LISP, so
+that communication between "system" code and "LISP" code was difficult. We
+have incorporated all of the good features of the earlier work into a new
+efficient LISP-like systems language, SYSLISP, recoded all useful modules
+into SYSLISP, and proceeded from there. SYSLISP currently produces
+targeted assembly code; earlier verisions were targeted at high-level
+languages such as FORTRAN, PASCAL, C or ADA. The goal is a portability
+strategy that leads to an efficient enough system for a production quality,
+yet portable system. We currently think of the extensions to Standard LISP
+as having two levels: the SYSLISP level, dealing with words and bytes and
+machine operations, enabling us to write essentially all of the kernel in
+Standard LISP; and, the STDLISP level, incorporating all of the features
+that make Standard LISP into a modern LISP, PSL. SYSLISP and LISP are both
+compiled by an improved version of the Portable Standard LISP Compiler. The
+SYSLISP mode of the PSL compiler does compile-time folding of constants,
+and more comprehensive register allocation than the previous LISP-only
+version of the compiler.
+
+The current state of PSL is fully described in an "overview" document
+obtainable from the authors @cite(griss81e). Currently PSL runs on the
+DEC-20 under TOPS-20, and on the DEC VAX-11/750 under Unix. We are now
+concentrating on the MC68000 PSL for the Apollo. All of the code-generators
+and assembler support is complete, and a number of large files have been
+compiled from LISP to assembly code, and correctly assembled and executed
+on the Apollo, testing basic I/O and arithmetic. We are now in the process
+of writing the PSL support code (small functions in LAP), and testing that
+various decisions about register and memory usage are correct. Based on the
+development history on the VAX, we are about 1-2 months away from a
+preliminary PSL on the Apollo.
+@section(References)
+@Bibliography
ADDED perq-pascal-lisp-project/apollo-paslsp.aux
Index: perq-pascal-lisp-project/apollo-paslsp.aux
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/apollo-paslsp.aux
@@ -0,0 +1,8 @@
+@Comment{AUXFILE of APOLLO-PASLSP.MSS.35 by Scribe 3C(1250) on 26 February 1982 at 14:47}
+@AuxCitation{BENSON81$=(1;;)}
+@AuxCitation{BRANDT81$=(2;;)}
+@AuxCitation{GRISS79$=(3;;)}
+@AuxCitation{GRISS81$=(4;;)}
+@AuxCitation{GRISS81E$=(5;;)}
+@AuxCitation{HEARN73$=(6;;)}
+@AuxCitation{MARTI79$=(7;;)}
ADDED perq-pascal-lisp-project/apollo-paslsp.err
Index: perq-pascal-lisp-project/apollo-paslsp.err
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/apollo-paslsp.err
@@ -0,0 +1,5 @@
+@Comment{ErrLog of APOLLO-PASLSP.MSS.35 by Scribe 3C(1250) on 26 February 1982 at 14:47}
+
+Error in text found while processing the manuscript.
+APOLLO-PASLSP.MSS.35 line 239: notpair = 2; (* a pair operation attempted on a non-pair.*)
+Line too wide; lost ")".
ADDED perq-pascal-lisp-project/apollo-paslsp.lpt
Index: perq-pascal-lisp-project/apollo-paslsp.lpt
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/apollo-paslsp.lpt
@@ -0,0 +1,808 @@
+Utah Symbolic Computation Group December 1981
+Operating Note 60
+
+
+
+
+
+
+
+
+
+ A PASCAL Based Standard LISP for the Apollo Domain
A PASCAL Based Standard LISP for the Apollo Domain
A PASCAL Based Standard LISP for the Apollo Domain
+
+
+ by
+
+ M. L. Griss and R. Ottenheimer
+
+ Department of Computer Science
+ University of Utah
+ Salt Lake City, Utah 84112
+
+ Preliminary Version
Preliminary Version
Preliminary Version
+
+ Last Revision: 26 February 1982
+
+
+
+
+
+
+
+
+
+
+ ABSTRACT
ABSTRACT
ABSTRACT
+
+
+This report describes an interim implementation of Standard LISP
+for the Apollo DOMAIN. This LISP is based upon the Standard LISP
+report, and a newly developing Portable Standard LISP. This
+interim implementation is designed to explore LISP
+implementations in PASCAL on the Apollo DOMAIN and similar
+machines. The system consists of a kernel, handcoded in PASCAL,
+with the rest of the system written in LISP and compiled to
+PASCAL.
+
+
+
+
+
+Work supported in part by the National Science Foundation under
+Grant No. MCS80-07034.
Apollo Pascal LISP 26 February 1982 1
+
+
+1. Introduction
1. Introduction
1. Introduction
+
+ In this preliminary report, we describe an implementation of
+Standard LISP in PASCAL, PASLSP. Versions of PASLSP have been run
+on a number of machines, ranging from an LSI-11 based TERAK to
+Apollo and PERQ. This report concentrates on the Apollo DOMAIN
+implementation. This report is to be read in conjunction with the
+Standard LISP report [7]; we will highlight the differences from
+the functions documented in the Standard LISP, describe the
+implementation strategy, and discuss future work.
+
+
+ PASLSP is based on a series of small and medium sized LISP
+interpreters that have been developed at the University of Utah
+to explore LISP implementations in higher level languages. Each
+of these LISP systems consists of a small kernel handcoded in
+some language, with the rest of the system written in LISP and
+compiled to the target language. We have used FORTRAN, PASCAL
+and assembly language as targets. The PASLSP series use PASCAL
+for the kernel, and have a LISP to PASCAL compiler for the rest
+of the system.
+
+
+ Recent work has concentrated on reducing the size of the
+hand-coded kernel, and extending the compiler to handle systems
+level constructs. This has resulted in a new Portable Standard
+LISP, PSL, running on the DEC-20 and VAX-11/750 [1, 4]. An
+implementation of PSL for MC68000 is underway. The PSL system is
+a modern, efficient LISP, written entirely in itself; it uses an
+efficient LISP to machine code compiler to produce the kernel,
+and then the rest of LISP is loaded. In the future we hope to
+produce a complete PSL targeted at a higher level languages, such
+as PASCAL, C or ADA, and this will replace the current PASLSP.
+
+
+1.1. History of PASLSP
1.1. History of PASLSP
1.1. History of PASLSP
+
+ The system now called PASLSP was originally developed (by
+M. Griss and W. Galway), as a small LISP like kernel to support a
+small computer algebra system on an LSI-11 TERAK; this was to be
+used as an answer analysis module within a CAI system [2],
+written entirely in PASCAL. It was decided to hand-code a very
+small kernel, and compile additional functions written in LISP
+(LISP support functions, parser and simplifier) to PASCAL, using
+a modified Portable LISP compiler [3]. This version (call it V0)
+did not even have user defined functions, since space on the
+TERAK was at a premium.
+
+
+ About June 1981, PASLSP came to the attention of a number
+people evaluating Apollo's and PERQ's, and it was suggested that
+we enhance V0 PASLSP for this purpose. During the space of a few
Apollo Pascal LISP 26 February 1982 2
+
+
+days, features taken from the Standard LISP Report and newly
+developing PSL files were added to produce PASLSP-V1, running on
+a DEC-20 and Terak. This was a fairly complete LISP (including
+Catch and Throw), but lacked a few features (OPEN, CLOSE, RDS,
+WRS, PROG, GO, RETURN, COMPRESS, EXPLODE, Vectors and Strings,
+etc.). V1 PASLSP was adapted to a PERQ, VAX and Apollo by Paul
+Milazo of Schlumberge in the space of a few weeks (we did not
+have a PERQ or Apollo at that time).
+
+
+ We subsequently obtained a PERQ and an Apollo, and recent work
+has been aimed at producing an enhanced PASLSP for these
+machines, maintaining all versions in one set of source files.
+The current system, PASLSP-V2, is produced from a single PASCAL
+kernel and set of LISP support files; the machine specific
+features are handled by a simple Source Code Conditionalizer,
+changing the definition of certain constants and data types. Only
+a few features of the Standard LISP report are missing, and there
+are a number of additions.
+
+
+1.2. Acknowledgement
1.2. Acknowledgement
1.2. Acknowledgement
+
+ We would like to acknowledge the contributions and support of
+Eric Benson, Dick Brandt, Will Galway, and Paul Milazo.
+
+
+
+2. Features of PASLSP and relation to Standard LISP
2. Features of PASLSP and relation to Standard LISP
2. Features of PASLSP and relation to Standard LISP
+
+ PASLSP as far as possible provides all the functions mentioned
+in the attached Standard LISP Report (note the hand-written
+comments added to this appendix); some of the functions are
+simply stubs, so that a Standard LISP Test-file can be run
+without major modification.
+
+
+ PASLSP-V2 does not implement the following features of Standard
+LISP:
+
+
+ a. VECTORS (only a simple garbage collector is used).
+ b. Strings are implemented as identifiers (not garbage
+ collected).
+ c. Integers are limited in size (INTs and FIXNUMs, no
+ BIGNUMs).
+ d. FLOATING Point is not implemented.
+ e. IDs can not be REMOB'ed or INTERN'd.
+ f. Only 3 Input Channels and 2 Output Channels are
+ available to OPEN, RDS, WRS, and CLOSE. Thus file
+ input statements can not be nested very deeply in
+ files.
Apollo Pascal LISP 26 February 1982 3
+
+
+ g. Line, Page and Character counting (POSN, LPOSN, etc)
+ are not implemented.
+
+
+ PASLSP-V2 provides some extensions over Standard LISP:
+
+
+ a. (CATCH form) and (THROW form) and the tagged versions:
+ (TCATCH tag form) and (TTHROW tag form) are used to
+ implement error and errorset, and higher level control
+ functions.
+ b. Implicit PROGN in COND, and LAMBDA expressions.
+ c. (WHILE pred action-1 action-2 ... action-n).
+ d. (DSKIN 'filename) or (DSKIN "filename")
+
+
+ PASLSP-V2 has not been extensively tested, and there may still
+be a number of bugs. While some effort has been spent in
+adjusting PASLSP to the Apollo DOMAIN, it is clear that the
+various heap sizes are not yet optimal. See appendix A for
+current list of functions, and appendix B for a copy of the
+Standard LISP Report annotated to reflect the current status of
+PASLSP.
+
+
+
+3. Using PASLSP on the Apollo DOMAIN
3. Using PASLSP on the Apollo DOMAIN
3. Using PASLSP on the Apollo DOMAIN
+
+ Initializing the system from the floppy looks like this:
+
+
+Create a directory (call it pl):
+ crd /pl
+Mount the floppy:
+ mtvol f 1 /f
+Copy the files of interest:
+ cpt /f/pascallisp /pl
+
+ The files copied will be: paslsp (executable file)
+ paslsp.ini (initialization file)
+ paslsp.tst (a test file)
+
+
+ Run paslsp as you would any other file. If you get an error it
+is most likely because the paslsp.ini file couldn't be found. If
+this happens, locate paslsp.ini and try again. If it still
+hangs, try calling Ralph Ottenheimer at (801) 355-0226 or
+M. Griss at (801) 581-6542.
+
+
+ Previously prepared files of LISP (e.g., library procedures)
+can be input by using the function "DSKIN". For Example,
Apollo Pascal LISP 26 February 1982 4
+
+
+(DSKIN 'Paslsp!.tst) or (DSKIN "Paslsp.tst")
+
+
+would load the paslsp test file. The PASLSP test is adapted from
+an extensive test of Standard LISP (avoiding features not yet
+implemented). This is a good excercise, try it. [Note that if
+the filename is given as an ID, that special characters should be
+prefaced by an "escape character", ! . This is also the case for
+filenames in OPEN. Alternately the string form may be used, in
+that case special characters need not be escaped.]
+
+
+ Paslsp is "case-sensitive" with regard to identifiers. All of
+the kernel procedures have upper-case identifiers associated with
+them. This means that ordinarily the expression (dskin
+'paslsp!.tst) would not be recognized since "dskin" is in
+lowercase. However, there is a global flag !*RAISE which if true
+will convert all lower-case typin to upper-case. This Apollo
+DOMAIN paslsp implementation sets !*RAISE to T as a default by
+having (SETQ !*RAISE T) in the paslsp.ini file. You may put any
+special initialization code you like at the end of paslsp.ini as
+indicated by the comments in the file. Toggling would be
+accomplished by typing the following lisp-expressions:
+
+
+ (ON !*RAISE) equivalent to (SETQ !*RAISE T)
+ (OFF !*RAISE) equivalent to (SETQ !*RAISE NIL)
+
+
+ Any Apollo DOMAIN filename (60 characters maximum)is allowable
+as a paslsp filename. Remember to prefix all special characters
+with an exclamation-mark: "!". Special characters include all
+non-alphanumerics. For example: !*RAISE goforit!! paslsp!.test
+!/login!/smith!/foo!.sl .
+
+
+ If the global !*ECHO is not NIL (default is NIL), input will be
+echoed to the selected output channel. It is sometimes
+convienient to put:
+
+
+ (SETQ !*ECHO T)
+
+
+at the beginning of a file to be read by DSKIN, and:
+
+
+ (SETQ !*ECHO NIL)
+
+
+at the end. This will echo the file to the screen (or to a file)
+as it is read.
Apollo Pascal LISP 26 February 1982 5
+
+
+ Certain low level errors do not display any explanatory message
+but instead display a numeric code (such as *** # 2), below is a
+summary of these codes and their meanings:
+
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on a non-pair.*
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells *)
+ noint = 5; (* no free integer space after gc. *)
+ notid = 6; (* id was expected *)
+
+
+
+4. Implementation of PASLSP
4. Implementation of PASLSP
4. Implementation of PASLSP
+
+
+4.1. Building PASLSP
4.1. Building PASLSP
4.1. Building PASLSP
+
+ PASLSP is built in the following steps:
+
+
+ ______ _____
Kernel files, PAS0.PRE, and trailer file (main program)
+PASN.PRE are run through a filter program to produce PAS0.PAS and
+PASN.PAS, tailored to the Apollo DOMAIN (appropriate Include
+files, Consts, etc). This kernel provides the Basic I/O (Token
+reading and printing), handcoded storage allocator and garbage
+collector, lowlevel arithmetic primitives, lowlevel calls (via
+Case statement) from LISP to kernel, etc.
+
+
+ ____ __ ____
Rest of LISP, currently files PAS1.RED, PAS2.RED and PAS3.RED
+are compiled to PASCAL using a version of the Portable LISP
+Compiler (PLC) [3]. During compilation, a Symbol Table file,
+PASn.SYM is read in and written out. These files record (for
+"incremental" compilation) the names and ID table locations of
+each ID encountered, so that the compiler can refer to an ID by
+its offset in the ID table. LISP constants are also recorded in
+the PASn.SYM files. PAS0.SYM is modified by hand as the kernel is
+changed.
+
+
+ The compilation model used is that of a Register Machine:
+Arguments to LISP functions are passed in registers (a PASCAL
+array), and the result returned in Register 1. Space is allocated
+on a software stack (not the PASCAL recursion stack), for any
+temporaries or save arguments required. Short functions usually
+do not require any stack. The reason for this choice was the
+existence of the PLC (targeted at comventional machines), and the
+fact that inline access to the register array compiles quite
+well, while a "PUSH/POP" stack would be much less efficient.
Apollo Pascal LISP 26 February 1982 6
+
+
+ ______________
Initialization. After the PAS0.PAS,..PASN.PAS are produced,
+the symbol table file (pas3.sym) is converted into a file
+PASLSP.INI, which contains the names of all ID's, the LISP
+constants used, and also ID's for all kernel functions that
+should be known to the user LISP level. Also produced is a file,
+EXEC.PAS, that contains a case statement associating each user
+callable kernel function with an integer. The PAS0.PAS ...
+PASN.PAS and EXEC.PAS are compiled and linked into an executable
+file. When this file is executed, PASLSP.INI is read in: each id
+is read and stored in the appropriate location in the
+symbol-table, the kernel function names have the associated Case
+index put into a function cell, and the LISP s-expressions are
+READ in. Finally, some s-expressions will be executed (with care,
+the user can add his own expressions, including requests to
+(DSKIN 'library), etc.
+
+
+4.2. Internal data structures
4.2. Internal data structures
4.2. Internal data structures
+
+ The data spaces (or heaps) in PASLSP are divided into 4
+sections: the pair space, id space (the oblist), string space and
+large integer (fixnum) space. These are all arrays of objects of
+the appropriate type (see declarations below). The system is
+fully tagged, that is, every LISP item has associated with it a
+tag field which denotes the type of the item and an 'info' field
+which either points to the item in an array (in the case of
+pairs, identifiers and fixnums), or contains the information
+itself (in the case of inums, character codes and error
+conditions). The info field of a code pointer contains the index
+into a case staement (see procedure 'execute') by means of which
+any LISP callable function may be invoked.
+
+
+itemref = RECORD
+ tag: integer; (* Small integer denoting type. *)
+ info: integer; (* Item or a pointer to it *)
+ (* depending upon the type. *)
+ END;
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ END;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
Apollo Pascal LISP 26 February 1982 7
+
+
+4.3. Adding user functions to the kernel
4.3. Adding user functions to the kernel
4.3. Adding user functions to the kernel
+
+ It is fairly easy to add handcoded Pascal functions to the
+kernel so that they can be called from LISP. For example,
+consider adding the function SQR(x), that squares its integer
+argument. Since SQR is already the name of an existing PASCAL
+function, we will call it "Xsqr" in PASCAL, and SQR in LISP.
+
+
+ The function Xsqr has to take its argument from R[1], check
+that it is an intege, square the information part, and retag as
+integer:
+
+
+PROCEDURE Xsqr;
+ VAR i1 : longint;
+
+ BEGIN
+ int_val(r[1], i1); (* Test type and extract Info *)
+ mkint(i1 * i1, 1) (* Square, retag, and put in R[1] *)
+ END;
+
+
+ Now procedure Xsqr needs be to be installed into the EXECUTE
+table, so that it can be found as the N'th code item. The number
+of defined procedures will have to be increased by 1 in the 3'rd
+line of procedure EXECUTE, (currently 201 defined), and an
+additional case added:
+
+
+202: Xsqr;
+
+
+ Note also that this table gives the Internal names of each
+available procedure, should one of these be required in your
+handcoded procedure. Finally, the Identifier SQR needs to be
+associated with case 202 in PASLSP.INI. Note that PASLAP.INI has
+3 tables of objects, each prefixed by a count and terminated by a
+0. The first is the Random ID table, consisting of special ID's
+used for messages etc. The second block is for S-expression
+constants, which get loaded into the base of the stack as
+Globals. The next batch are the names of LISP callable functions
+in the order corresponding to the EXECUTE procedure. Simply
+modify the count form 201 to 202 (or whatever), and add SQR at
+the end, just before the 0.
+
+
+ In general, look for a sample procedure in the kernel if
+possible, or in the compiled part (although these are hard to
+follow), and adapt to the specific needs. Note the use of the
+ALLOC(n) and DEALLOC(n) procedures to allocate a block of
+temporaries on the stack. These should be used, rather than
Apollo Pascal LISP 26 February 1982 8
+
+
+PASCAL VAR's, since the garbage collector may need to trace from
+one of the saved objects.
+
+
+
+5. Future work on PASLSP
5. Future work on PASLSP
5. Future work on PASLSP
+
+ PASLSP V2 is based on a fairly old model of a portable LISP,
+and has been used mainly to explore the capbilities of PASCAL as
+a target language. In particular, V2 PASCAL is not yet powerful
+enough to run the PLC compiler itself; instead, the PLC is run on
+our PSL system on the DEC-20. In order for the full benefits of
+PASLSP (or PSL) to be realized, the user should be able to
+compile his own LISP modules into PASCAL and link them with the
+kernel. In order to make the system even more adapatable, we
+would like to write even less of the kernel in PASCAL by hand.
+This goal has lead us to the development of PSL.
+
+
+5.1. Goals of the Utah PSL Project
5.1. Goals of the Utah PSL Project
5.1. Goals of the Utah PSL Project
+
+ The goal of the PSL project is to produce an efficient and
+transportable Standard LISP system that may be used to:
+
+
+ a. Experimentally explore a variety of LISP
+ implementation issues (storage management, binding,
+ environments, etc.).
+
+ b. Effectively support the REDUCE computer algebra
+ system [6] on a number of machines.
+
+ c. Provide the same, uniform, modern LISP programming
+ environment on all of the machines that we use
+ (DEC-20, VAX/750, PDP-11/45, PERQ, and Apollo), of the
+ power and complexity of UCI-LISP, FranzLISP or
+ MACLISP, with some extensions and enhancements derived
+ from LISP Machine LISP or CommonLISP.
+
+
+ entire
entire
The approach we have been using is to write the entire LISP
+system in PSL (using LISP extensions for dealing with machine
+words and operations), and to bootstrap it to the desired target
+machine in two steps:
+
+
+ a. Cross compile an appropriate kernel to the assembly
+ language of the target machine;
+
+ b. Once the kernel is running, use a resident compiler
+ and loader, or fast-loader, to build the rest of the
+ system.
Apollo Pascal LISP 26 February 1982 9
+
+
+ The PASLSP system, and other early implementations, have the
+problem that the implementation language (PASCAL) is a distinct
+language from LISP, so that communication between "system" code
+and "LISP" code was difficult. We have incorporated all of the
+good features of the earlier work into a new efficient LISP-like
+systems language, SYSLISP, recoded all useful modules into
+SYSLISP, and proceeded from there. SYSLISP currently produces
+targeted assembly code; earlier verisions were targeted at
+high-level languages such as FORTRAN, PASCAL, C or ADA. The goal
+is a portability strategy that leads to an efficient enough
+system for a production quality, yet portable system. We
+currently think of the extensions to Standard LISP as having two
+levels: the SYSLISP level, dealing with words and bytes and
+machine operations, enabling us to write essentially all of the
+kernel in Standard LISP; and, the LISP level, incorporating all
+of the features that make PSL into a modern LISP. Both modes of
+PSL are compiled by an improved version of the Portable Standard
+LISP Compiler. The SYSLISP mode of the PSL compiler does
+compile-time folding of constants, and more comprehensive
+register allocation than the previous LISP-only version of the
+compiler.
+
+
+ The current state of PSL is fully described in an "overview"
+document obtainable from the authors [5]. Currently PSL runs on
+the DEC-20 under TOPS-20, and on the DEC VAX-11/750 under Unix.
+We are now concentrating on the MC68000 PSL for the Apollo. All
+of the code-generators and assembler support is complete, and a
+number of large files have been compiled from LISP to assembly
+code, and correctly assembled and executed on the Apollo, testing
+basic I/O and arithmetic. We are now in the process of writing
+the PSL support code (small functions in LAP), and testing that
+various decisions about register and memory usage are correct.
+Based on the development history on the VAX, we are about 1-2
+months away from a preliminary PSL on the Apollo.
+
+
+
+6. References
6. References
6. References
+
+[1] Benson, E. and Griss, M. L.
+ _______ _ ________ ____ _____ _______ ______________
SYSLISP: A portable LISP based systems implementation
+ ________
language.
+ Utah Symbolic Computation Group, Report UCP-81, University
+ of Utah, February, 1981.
+
+[2] Brandt, R. C. and Knapp, B. H.
+ The University of Utah Video Computer Authoring System.
+ ___________ __ ___ _________ __ ________ __________
In Proceedings of the Symposium on Learning Technology,
+ pages 18-23. Orlando, Florida, Feb, 1981.
Apollo Pascal LISP 26 February 1982 10
+
+
+[3] Griss, M. L.; Kessler, R. R.; and Maguire, G. Q. Jr.
+ TLISP - A Portable LISP Implemented in P-code.
+ ___________ __ _______ __
In Proceedings of EUROSAM 79, pages 490-502. ACM, June,
+ 1979.
+
+[4] Griss, M. L. and Morrison, B.
+ ___ ________ ________ ____ _____ ______
The Portable Standard LISP Users Manual.
+ Utah Symbolic Computation Group, TR-10, University of
+ Utah, March, 1981.
+
+[5] Griss, M. L.
+ ________ ________ ____ _ _____ ________
Portable Standard LISP: A Brief Overview.
+ Utah Symbolic Computation Group, Operating Note 58,
+ University of Utah, October, 1981.
+
+[6] Hearn, A. C.
+ ______ _ _____ ______
REDUCE 2 Users Manual.
+ Utah Symbolic Computation Group UCP-19, University of Utah,
+ 1973.
+
+[7] Marti, J. B., et al.
+ Standard LISP Report.
+ _______ _______
SIGPLAN Notices 14(10):48-68, October, 1979.
+
+
+
+APPENDIX A: A List of Current PASLSP Functions and Globals
APPENDIX A: A List of Current PASLSP Functions and Globals
APPENDIX A: A List of Current PASLSP Functions and Globals
+
+
+____ ________ __________ ___ ________ ____ ______
Lisp Callable Functions, see Standard LISP Report
+!*FIRST!-PROCEDURE The top loop LISP reader
+ABS
+ADD1
+AND
+APPEND
+APPLY
+APPLY1 (APPLY f (LIST u))
+ASSOC
+ATOM
+ATSOC
+CAAAAR
+CAAADR
+CAAAR
+CAADAR
+CAADDR
+CAADR
+CAAR
+CADAAR
+CADADR
+CADAR
+CADDAR
+CADDDR
Apollo Pascal LISP 26 February 1982 11
+
+
+CADDR
+CADR
+CAR
+CATCH
+CDAAAR
+CDAADR
+CDAAR
+CDADAR
+CDADDR
+CDADR
+CDAR
+CDDAAR
+CDDADR
+CDDAR
+CDDDAR
+CDDDDR
+CDDDR
+CDDR
+CDR
+CLOSE
+CODEP
+COMPRESS
+COND
+CONS
+CONSTANTP
+DE
+DEFLIST
+DELATQ (DELATQ 'X alist) deletes (X . any) from alist
+DELETE
+DELQ Efficient DELETE (using EQ)
+DF
+DIFFERENCE
+DIGIT
+DIVIDE
+DM
+DN
+DSKIN (DSKIN file-id)
+EOFP (EOFP channel)
+EQ
+EQCAR
+EQN
+EQUAL
+ERROR
+ERRORSET
+ERRPRT Prints message with *'s
+EVAL
+EVLAM Evaluates a LAMBDA expression
+EVLIS
+EXPAND
+EXPLODE
+EXPT
+FASTSTAT Prints RECLAIM message
Apollo Pascal LISP 26 February 1982 12
+
+
+FIX
+FIXP
+FLAG
+FLAG1 (FLAG (LIST x) y)
+FLAGP
+FLOAT
+FLOATP
+FLUID
+FLUIDP
+FUNCELL Accesses function cell
+FUNCTION
+GENSYM
+GET
+GETD
+GETV
+GLOBAL
+GLOBALP
+GO
+GREATERP
+IDP
+INTERN
+LBIND1 Binds a single ID in LAMBDA
+LBINDN
+LENGTH
+LESSP
+LIST2 For efficent LIST compilation
+LIST3
+LIST4
+LIST5
+LITER
+MAP
+MAPC
+MAPCAN
+MAPCAR
+MAPCON
+MAPLIST
+MAX
+MAX2
+MEMBER
+MEMQ
+MIN
+MIN2
+MINUS
+MINUSP
+MKVECT
+MSGPRT
+NCONC
+NCONS
+NOT
+NULL
+NUMBERP
+ONEP
Apollo Pascal LISP 26 February 1982 13
+
+
+OPEN
+OR
+ORDERP
+P!.N Evaluates Implicit PROGNs
+PAIR
+PAIRP
+PBIND1 PROG binding
+PBINDN
+PLIST Access full property list
+PLUS
+PLUS2
+PRIN1
+PRIN2
+PRIN2T
+PRIN2TL
+PRINC
+PRINT
+PROG
+PROG2
+PROGG0131
+PROGN
+PUT
+PUTC
+PUTD
+PUTL
+PUTV
+QUOTIENT
+RDEVPR A read-eval-print loop
+RDS
+RDTOK
+READ
+READCH
+RECLAIM
+REMAINDER
+REMD
+REMFLAG
+REMFLAG1
+REMOB
+REMPROP
+RETURN
+REV
+REVERSE
+REVX
+RLIST
+RPLACA
+RPLACD
+SASSOC
+SET
+SETFUNCELL
+SETPLIST
+SETVALUE
+STRINGP Equivalent to IDP
Apollo Pascal LISP 26 February 1982 14
+
+
+SUB1
+SUBLIS
+SUBST
+TCATCH
+TERPRI
+THROW
+TIMES
+TIMES2
+TOKEN
+TTHROW
+UNBIND1
+UNBINDN
+UNBINDTO
+UNFLUID
+UPBV
+VALUE
+VECTORP
+WHILE
+WRS
+WRTOK
+XAPPLY
+XCONS
+ZEROP
+___________ _______
Interesting Globals
+!*RAISE Raise lower case typing to upper case if not NIL
+!*ECHO Selected input to selected output if not NIL.
+BSTK!* Holds old values of rebound IDS
+EMSG!* Error message in most recent call on ERROR
+ENUM!* Error number in most recent call on ERROR.
+INITFORM!* First Expression EVAL'ed
+THROWING!* Indicates if throwing
+THROWTAG!* Indicates TAG in TTHROW
+TOK!* Holds last token scanned
+TOKTYPE Indicates type of token scanned:
+ 1: integer
+ 2: id
+ 3: character
Apollo Pascal LISP 26 February 1982 i
+
+
+ Table of Contents
Table of Contents
Table of Contents
+
+1. Introduction 1
+ 1.1. History of PASLSP 1
+ 1.2. Acknowledgement 2
+2. Features of PASLSP and relation to Standard LISP 2
+3. Using PASLSP on the Apollo DOMAIN 3
+4. Implementation of PASLSP 5
+ 4.1. Building PASLSP 5
+ 4.2. Internal data structures 6
+ 4.3. Adding user functions to the kernel 7
+5. Future work on PASLSP 8
+ 5.1. Goals of the Utah PSL Project 8
+6. References 9
+APPENDIX A: A List of Current PASLSP Functions and Globals 10
ADDED perq-pascal-lisp-project/apollo-paslsp.mss
Index: perq-pascal-lisp-project/apollo-paslsp.mss
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/apollo-paslsp.mss
@@ -0,0 +1,443 @@
+@Device(lpt)
+@style(justification yes)
+@style(spacing 1)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@make(article)
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(appendix,numbered=<APPENDIX @A: >)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+@define(up,use text,capitalized on, break off)
+@define(mac,use text, underline off, break off)
+@define(LISPmac,use text, underline alphanumerics, break off)
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "December 1981",
+ Line "Operating Note 60"
+ )
+@set(page=1)
+@newpage()
+@begin(titlepage)
+@begin(titlebox)
+@b(A PASCAL Based Standard LISP for the Apollo Domain)
+@center[
+by
+
+M. L. Griss and R. Ottenheimer
+
+Department of Computer Science
+University of Utah
+Salt Lake City, Utah 84112
+
+@b(Preliminary Version)
+
+Last Revision: @value(date)]
+
+@end(titlebox)
+@begin(abstract)
+This report describes an interim implementation of Standard LISP for the
+Apollo DOMAIN. This LISP is based upon the Standard LISP report, and a
+newly developing Portable Standard LISP. This interim implementation is
+designed to explore LISP implementations in PASCAL on the Apollo DOMAIN and
+similar machines. The system consists of a kernel, handcoded in PASCAL,
+with the rest of the system written in LISP and compiled to PASCAL.
+@End(abstract)
+@begin(Researchcredit)
+Work supported in part by the National Science Foundation
+under Grant No. MCS80-07034.
+@end(Researchcredit)
+@end(titlepage)
+@pageheading(Left "Apollo Pascal LISP",Center "@value(date)",
+ Right "@value(Page)"
+ )
+@set(page=1)
+@newpage
+@section(Introduction)
+In this preliminary report, we describe an implementation of Standard LISP
+in PASCAL, PASLSP. Versions of PASLSP have been run on a number of
+machines, ranging from an LSI-11 based TERAK to Apollo and PERQ. This report
+concentrates on the Apollo DOMAIN implementation. This report is to be read in
+conjunction with the Standard LISP report@cite(Marti79); we will
+highlight the differences from the functions documented in the Standard
+LISP, describe the implementation strategy, and discuss future work.
+
+PASLSP is based on a series of small and medium sized LISP interpreters
+that have been developed at the University of Utah to explore LISP
+implementations in higher level languages. Each of these LISP systems
+consists of a small kernel handcoded in some language, with the rest of the
+system written in LISP and compiled to the target language. We have used
+FORTRAN, PASCAL and assembly language as targets. The PASLSP series use
+PASCAL for the kernel, and have a LISP to PASCAL compiler for the rest of
+the system.
+
+Recent work has concentrated on reducing the size of the hand-coded kernel,
+and extending the compiler to handle systems level constructs. This has
+resulted in a new Portable Standard LISP, PSL, running on the DEC-20 and
+VAX-11/750@cite(Benson81,Griss81). An implementation of PSL for MC68000 is
+underway. The PSL system is a modern, efficient LISP, written entirely in
+itself; it uses an efficient LISP to machine code compiler to produce the
+kernel, and then the rest of LISP is loaded. In the future we hope to
+produce a complete PSL targeted at a higher level languages, such as
+PASCAL, C or ADA, and this will replace the current PASLSP.
+
+@subsection(History of PASLSP)
+The system now called PASLSP was originally developed (by M. Griss and W.
+Galway), as a small LISP like kernel to support a small computer algebra
+system on an LSI-11 TERAK; this was to be used as an answer analysis module
+within a CAI system@cite(Brandt81), written entirely in PASCAL. It was
+decided to hand-code a very small kernel, and compile additional functions
+written in LISP (LISP support functions, parser and
+simplifier) to PASCAL,
+using a modified Portable LISP compiler@cite(griss79). This version (call
+it V0) did not even have user defined functions, since space on the TERAK
+was at a premium.
+
+About June 1981, PASLSP came to the attention of a number people evaluating
+Apollo's and PERQ's, and it was suggested that we enhance V0 PASLSP for
+this purpose. During the space of a few days, features taken from the
+Standard LISP Report and newly developing PSL files were added to produce
+PASLSP-V1, running on a DEC-20 and Terak. This was a fairly complete LISP
+(including Catch and Throw), but lacked a few features (OPEN, CLOSE, RDS,
+WRS, PROG, GO, RETURN, COMPRESS, EXPLODE, Vectors and Strings, etc.). V1
+PASLSP was adapted to a PERQ, VAX and Apollo by Paul Milazo of Schlumberge
+in the space of a few weeks (we did not have a PERQ or Apollo at that
+time).
+
+We subsequently obtained a PERQ and an Apollo, and recent work has been
+aimed at producing an enhanced PASLSP for these machines, maintaining all
+versions in one set of source files. The current system, PASLSP-V2, is
+produced from a single PASCAL kernel and set of LISP support files; the
+machine specific features are handled by a simple Source Code
+Conditionalizer, changing the definition of certain constants and data
+types. Only a few features of the Standard LISP report are missing,
+and there are a number of additions.
+
+@subsection(Acknowledgement)
+
+We would like to acknowledge the contributions and support of
+Eric Benson, Dick Brandt, Will Galway, and Paul Milazo.
+
+@section(Features of PASLSP and relation to Standard LISP)
+PASLSP as far as possible provides all the functions mentioned
+in the attached Standard LISP Report (note the hand-written
+comments added to this appendix); some of the functions are simply
+stubs, so that a Standard LISP Test-file can be run without major
+modification.
+
+PASLSP-V2 does not implement the following features of Standard LISP:
+@begin(enumeration,spread 0)
+VECTORS (only a simple garbage collector is used).
+
+Strings are implemented as identifiers (not garbage collected).
+
+Integers are limited in size (INTs and FIXNUMs, no BIGNUMs).
+
+FLOATING Point is not implemented.
+
+IDs can not be REMOB'ed or INTERN'd.
+
+Only 3 Input Channels and 2 Output Channels are available to OPEN,
+RDS, WRS, and CLOSE. Thus file input statements can not be nested
+very deeply in files.
+
+Line, Page and Character counting (POSN, LPOSN, etc) are not implemented.
+@end(enumeration)
+
+PASLSP-V2 provides some extensions over Standard LISP:
+@begin(enumerate,spread 0)
+(CATCH form) and (THROW form) and the tagged versions: (TCATCH tag form)
+and (TTHROW tag form) are used to implement error and errorset,
+and higher level control functions.
+
+Implicit PROGN in COND, and LAMBDA expressions.
+
+(WHILE pred action-1 action-2 ... action-n).
+
+(DSKIN 'filename) or (DSKIN "filename")
+@end(enumerate)
+
+PASLSP-V2 has not been extensively tested, and there may still be a number
+of bugs. While some effort has been spent in adjusting PASLSP to the Apollo
+DOMAIN, it is clear that the various heap sizes are not yet optimal.
+See appendix A for current list of functions, and appendix B for a copy
+of the Standard LISP Report annotated to reflect the current status of
+PASLSP.
+
+@section(Using PASLSP on the Apollo DOMAIN)
+ Initializing the system from the floppy looks like this:
+@begin(verbatim)
+Create a directory (call it pl):
+ crd /pl
+Mount the floppy:
+ mtvol f 1 /f
+Copy the files of interest:
+ cpt /f/pascallisp /pl
+
+ The files copied will be: paslsp (executable file)
+ paslsp.ini (initialization file)
+ paslsp.tst (a test file)
+@end(verbatim)
+
+Run paslsp as you would any other file. If you
+get an error it is most likely because the paslsp.ini file couldn't be found.
+If this happens, locate paslsp.ini and try again. If it still hangs,
+try calling Ralph Ottenheimer at (801) 355-0226 or M. Griss at (801) 581-6542.
+
+
+Previously prepared files of LISP (e.g., library procedures)
+can be input by
+using the function "DSKIN". For Example,
+@begin(verbatim)
+(DSKIN 'Paslsp!.tst) or (DSKIN "Paslsp.tst")
+@end
+would load the paslsp test file. The PASLSP test is adapted from an extensive
+test of Standard LISP (avoiding features not yet implemented). This is a
+good excercise, try it. [Note that if the filename is given as an ID,
+that special characters should be prefaced by an "escape character",
+! . This is also the case for filenames in OPEN. Alternately the string
+form may be used, in that case special characters need not be escaped.]
+
+ Paslsp is "case-sensitive" with regard to identifiers. All of the
+kernel procedures have upper-case identifiers associated with them. This
+means that ordinarily the expression (dskin 'paslsp!.tst) would not be
+recognized since "dskin" is in lowercase. However, there is a global flag
+!*RAISE which if true will convert all lower-case typin to upper-case.
+This Apollo DOMAIN paslsp implementation sets !*RAISE to T as a default by
+having (SETQ !*RAISE T) in the paslsp.ini file. You may put any special
+initialization code you like at the end of paslsp.ini as indicated by the
+comments in the file.
+Toggling would be accomplished by typing the following lisp-expressions:
+@begin(verbatim)
+ (ON !*RAISE) equivalent to (SETQ !*RAISE T)
+ (OFF !*RAISE) equivalent to (SETQ !*RAISE NIL)
+@end(verbatim)
+
+ Any Apollo DOMAIN filename (60 characters maximum)is allowable
+ as a paslsp filename.
+Remember to prefix all special characters with an exclamation-mark: "!".
+Special characters include all non-alphanumerics. For example: !*RAISE
+ goforit!! paslsp!.test !/login!/smith!/foo!.sl .
+
+If the global !*ECHO is not NIL (default is NIL), input will be echoed to
+the selected output channel. It is sometimes convienient to put:
+@begin(verbatim)
+ (SETQ !*ECHO T)
+@end(verbatim)
+at the beginning of a file to be read by DSKIN, and:
+@begin(verbatim)
+ (SETQ !*ECHO NIL)
+@end(verbatim)
+at the end. This will echo the file to the screen (or to a file) as it is
+read.
+
+Certain low level errors do not display any explanatory message but
+instead display a numeric code (such as *** # 2), below is a summary of these
+codes and their meanings:
+
+@begin(verbatim)
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on non-pair.*)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells *)
+ noint = 5; (* no free integer space after gc. *)
+ notid = 6; (* id was expected *)
+@end(verbatim)
+
+
+@section(Implementation of PASLSP)
+@subsection(Building PASLSP)
+PASLSP is built in the following steps:
+
+@u(Kernel files), PAS0.PRE, and trailer file (main program) PASN.PRE
+are run through a filter program to produce PAS0.PAS and PASN.PAS,
+tailored to the Apollo DOMAIN (appropriate Include files, Consts, etc).
+This kernel provides the Basic I/O (Token reading and printing),
+handcoded storage allocator and garbage collector, lowlevel arithmetic
+primitives, lowlevel calls (via Case statement) from LISP to kernel, etc.
+
+@u(Rest of LISP), currently files PAS1.RED, PAS2.RED and PAS3.RED are
+compiled to PASCAL using a version of the Portable LISP Compiler
+(PLC)@cite(griss79). During compilation, a Symbol Table file, PASn.SYM is
+read in and written out. These files record (for "incremental" compilation)
+the names and ID table locations of each ID encountered, so that the compiler
+can refer to an ID by its offset in the ID table. LISP constants are also
+recorded in the PASn.SYM files. PAS0.SYM is modified by hand as the kernel
+is changed.
+
+The compilation model used is that of a Register Machine: Arguments to LISP
+functions are passed in registers (a PASCAL array), and the result returned
+in Register 1. Space is allocated on a software stack (not the PASCAL
+recursion stack), for any temporaries or save arguments required. Short
+functions usually do not require any stack. The reason for this choice was
+the existence of the PLC (targeted at comventional machines), and the fact
+that inline access to the register array compiles quite well, while a
+"PUSH/POP" stack would be much less efficient.
+
+@u(Initialization).
+After the PAS0.PAS,..PASN.PAS are produced,
+the symbol table file (pas3.sym) is converted into a file
+PASLSP.INI, which contains the names of all ID's, the LISP constants
+used, and also ID's for all kernel functions that should be known to the
+user LISP level. Also produced is a file, EXEC.PAS, that contains a case
+statement associating each user callable kernel function with an integer.
+The PAS0.PAS ... PASN.PAS and EXEC.PAS are compiled and linked into an
+executable file. When this file is executed, PASLSP.INI is read in:
+each id is read and stored in the appropriate location in the symbol-table,
+the kernel function names have the associated Case index put into
+a function cell, and the LISP s-expressions are READ in. Finally,
+some s-expressions will be executed (with care, the user can add his own
+expressions, including requests to (DSKIN 'library), etc.
+@subsection(Internal data structures)
+The data spaces (or heaps) in PASLSP are divided into 4 sections: the
+pair space, id space (the oblist), string space and large integer
+(fixnum) space. These are all arrays of objects of the appropriate type
+(see declarations below). The system is fully tagged, that is, every LISP
+item has associated with it a tag field which denotes the type of the item
+and an 'info' field which either points to the item in an array (in the
+case of pairs, identifiers and fixnums), or contains the information
+itself (in the case of inums, character codes and error conditions). The
+info field of a code pointer contains the index into a case staement (see
+procedure 'execute') by means of which any LISP callable function may be
+invoked.
+
+@begin(verbatim,leftmargin 0)
+itemref = RECORD
+ tag: integer; (* Small integer denoting type. *)
+ info: integer; (* Item or a pointer to it *)
+ (* depending upon the type. *)
+ END;
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ END;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+@end(verbatim)
+@subsection(Adding user functions to the kernel)
+It is fairly easy to add handcoded Pascal functions to
+the kernel so that they can be called from LISP. For example,
+consider adding the function SQR(x), that squares its integer argument.
+Since SQR is already the name of an existing PASCAL function, we will
+call it "Xsqr" in PASCAL, and SQR in LISP.
+
+The function Xsqr has to take its argument from R[1], check that it is an intege, square the information part, and retag as integer:
+@begin(verbatim)
+PROCEDURE Xsqr;
+ VAR i1 : longint;
+
+ BEGIN
+ int_val(r[1], i1); (* Test type and extract Info *)
+ mkint(i1 * i1, 1) (* Square, retag, and put in R[1] *)
+ END;
+@end(verbatim)
+
+Now procedure Xsqr needs be to be installed into the EXECUTE table, so that
+it can be found as the N'th code item. The number of defined procedures
+will have to be increased by 1 in the 3'rd line of procedure EXECUTE,
+(currently 201 defined), and an additional case added:
+@begin(verbatim)
+202: Xsqr;
+@end(verbatim)
+
+Note also that this table gives the Internal names of each available
+procedure, should one of these be required in your handcoded procedure.
+Finally, the Identifier SQR needs to be associated with case 202 in
+PASLSP.INI. Note that PASLAP.INI has 3 tables of objects, each prefixed by
+a count and terminated by a 0. The first is the Random ID table, consisting
+of special ID's used for messages etc. The second block is for S-expression
+constants, which get loaded into the base of the stack as Globals. The
+next batch are the names of LISP callable functions in the order
+corresponding to the EXECUTE procedure. Simply modify the count form
+201 to 202 (or whatever), and add SQR at the end, just before the 0.
+
+In general, look for a sample procedure in the kernel if possible,
+or in the compiled part (although these are hard to follow), and adapt
+to the specific needs. Note the use of the ALLOC(n) and DEALLOC(n)
+procedures to allocate a block of temporaries on the stack.
+These should be used, rather than PASCAL VAR's, since the garbage collector
+may need to trace from one of the saved objects.
+@Section(Future work on PASLSP)
+PASLSP V2 is based on a fairly old model of a portable LISP, and
+has been used mainly to explore the capbilities of PASCAL as a
+target language. In particular, V2 PASCAL is not yet powerful enough to
+run the PLC compiler itself;
+instead, the PLC is run on our PSL system on the DEC-20. In order for the
+full benefits of PASLSP (or PSL) to be realized, the user should be able to
+compile his own LISP modules into PASCAL and link them with the kernel.
+In order to make the system even more adapatable, we would like to write
+even less of the kernel in PASCAL by hand. This goal has lead us to the
+development of PSL.
+
+@subsection(Goals of the Utah PSL Project)
+
+The goal of the PSL project is to produce an efficient and transportable
+Standard LISP system that may be used to:
+@begin(enumeration)
+Experimentally explore
+a variety of LISP implementation issues (storage management, binding,
+environments, etc.).
+
+Effectively support the REDUCE computer algebra system@cite(hearn73)
+on a number of machines.
+
+Provide the same, uniform, modern LISP programming environment on all of
+the machines that we use (DEC-20, VAX/750, PDP-11/45, PERQ, and Apollo), of
+the power and complexity of UCI-LISP, FranzLISP or MACLISP, with some
+extensions and enhancements derived from LISP Machine LISP or CommonLISP.
+@end(enumeration)
+
+The approach we have been using is to write the @b(entire) LISP system in
+PSL (using LISP extensions for dealing with
+machine words and operations), and to bootstrap it to the desired target
+machine
+in two steps:
+@begin(enumeration)
+Cross compile an appropriate kernel to the assembly language of the
+target machine;
+
+Once the kernel is running, use a resident compiler and loader, or
+fast-loader, to build the rest of the system.
+@end(enumeration)
+
+ The PASLSP system, and other early implementations, have the problem that
+the implementation language (PASCAL) is a distinct language from LISP, so
+that communication between "system" code and "LISP" code was difficult. We
+have incorporated all of the good features of the earlier work into a new
+efficient LISP-like systems language, SYSLISP, recoded all useful modules
+into SYSLISP, and proceeded from there. SYSLISP currently produces
+targeted assembly code; earlier verisions were targeted at high-level
+languages such as FORTRAN, PASCAL, C or ADA. The goal is a portability
+strategy that leads to an efficient enough system for a production quality,
+yet portable system. We currently think of the extensions to Standard LISP
+as having two levels: the SYSLISP level, dealing with words and bytes and
+machine operations, enabling us to write essentially all of the kernel in
+Standard LISP; and, the LISP level, incorporating all of the features that
+make PSL into a modern LISP. Both modes of PSL are compiled by an improved
+version of the Portable Standard LISP Compiler. The SYSLISP mode of the PSL
+compiler does compile-time folding of constants, and more comprehensive
+register allocation than the previous LISP-only version of the compiler.
+
+The current state of PSL is fully described in an "overview" document
+obtainable from the authors @cite(griss81e). Currently PSL runs on the
+DEC-20 under TOPS-20, and on the DEC VAX-11/750 under Unix. We are now
+concentrating on the MC68000 PSL for the Apollo. All of the code-generators
+and assembler support is complete, and a number of large files have been
+compiled from LISP to assembly code, and correctly assembled and executed
+on the Apollo, testing basic I/O and arithmetic. We are now in the process
+of writing the PSL support code (small functions in LAP), and testing that
+various decisions about register and memory usage are correct. Based on the
+development history on the VAX, we are about 1-2 months away from a
+preliminary PSL on the Apollo.
+@section(References)
+@Bibliography
+@appendix(A List of Current PASLSP Functions and Globals)
+@begin(verbatim,leftmargin 0)
+@include(Appendix-A.table)
+@end(verbatim)
ADDED perq-pascal-lisp-project/apollo-paslsp.otl
Index: perq-pascal-lisp-project/apollo-paslsp.otl
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/apollo-paslsp.otl
@@ -0,0 +1,19 @@
+@Comment{OUTLINE of APOLLO-PASLSP.MSS.35 by Scribe 3C(1250) on 26 February 1982 at 14:47}
+1. Introduction 1 APOLLO-PASLSP.MSS.35 line 54
+ 1.1. History of PASLSP 1 APOLLO-PASLSP.MSS.35 line 82
+ 1.2. Acknowledgement 2 APOLLO-PASLSP.MSS.35 line 114
+2. Features of PASLSP and relation to Standard LISP 2 APOLLO-PASLSP.MSS.35 line 119
+3. Using PASLSP on the Apollo DOMAIN 3 APOLLO-PASLSP.MSS.35 line 165
+4. Implementation of PASLSP 5 APOLLO-PASLSP.MSS.35 line 248
+ 4.1. Building PASLSP 5 APOLLO-PASLSP.MSS.35 line 249
+ 4.2. Internal data structures 6 APOLLO-PASLSP.MSS.35 line 291
+ 4.3. Adding user functions to the kernel 7 APOLLO-PASLSP.MSS.35 line 324
+5. Future work on PASLSP 8 APOLLO-PASLSP.MSS.35 line 367
+ 5.1. Goals of the Utah PSL Project 8 APOLLO-PASLSP.MSS.35 line 379
+6. References 9 APOLLO-PASLSP.MSS.35 line 439
+APPENDIX A: A List of Current PASLSP Functions and Glo 10 APOLLO-PASLSP.MSS.35 line 441
+ Table of Contents 1 -SCRIBE-SCRATCH-.25-4-1.100025 line 3
+ Alphabetic Listing of Cross-Reference Tags and Labels
+
+Tag or Label Name Page Label Value Source file Location
+-----------------------------------------------------------------------------
ADDED perq-pascal-lisp-project/appendix-a.table
Index: perq-pascal-lisp-project/appendix-a.table
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/appendix-a.table
@@ -0,0 +1,216 @@
+@u[Lisp Callable Functions, see Standard LISP Report]
+!*FIRST!-PROCEDURE The top loop LISP reader
+ABS
+ADD1
+AND
+APPEND
+APPLY
+APPLY1 (APPLY f (LIST u))
+ASSOC
+ATOM
+ATSOC
+CAAAAR
+CAAADR
+CAAAR
+CAADAR
+CAADDR
+CAADR
+CAAR
+CADAAR
+CADADR
+CADAR
+CADDAR
+CADDDR
+CADDR
+CADR
+CAR
+CATCH
+CDAAAR
+CDAADR
+CDAAR
+CDADAR
+CDADDR
+CDADR
+CDAR
+CDDAAR
+CDDADR
+CDDAR
+CDDDAR
+CDDDDR
+CDDDR
+CDDR
+CDR
+CLOSE
+CODEP
+COMPRESS
+COND
+CONS
+CONSTANTP
+DE
+DEFLIST
+DELATQ (DELATQ 'X alist) deletes (X . any) from alist
+DELETE
+DELQ Efficient DELETE (using EQ)
+DF
+DIFFERENCE
+DIGIT
+DIVIDE
+DM
+DN
+DSKIN (DSKIN file-id)
+EOFP (EOFP channel)
+EQ
+EQCAR
+EQN
+EQUAL
+ERROR
+ERRORSET
+ERRPRT Prints message with *'s
+EVAL
+EVLAM Evaluates a LAMBDA expression
+EVLIS
+EXPAND
+EXPLODE
+EXPT
+FASTSTAT Prints RECLAIM message
+FIX
+FIXP
+FLAG
+FLAG1 (FLAG (LIST x) y)
+FLAGP
+FLOAT
+FLOATP
+FLUID
+FLUIDP
+FUNCELL Accesses function cell
+FUNCTION
+GENSYM
+GET
+GETD
+GETV
+GLOBAL
+GLOBALP
+GO
+GREATERP
+IDP
+INTERN
+LBIND1 Binds a single ID in LAMBDA
+LBINDN
+LENGTH
+LESSP
+LIST2 For efficent LIST compilation
+LIST3
+LIST4
+LIST5
+LITER
+MAP
+MAPC
+MAPCAN
+MAPCAR
+MAPCON
+MAPLIST
+MAX
+MAX2
+MEMBER
+MEMQ
+MIN
+MIN2
+MINUS
+MINUSP
+MKVECT
+MSGPRT
+NCONC
+NCONS
+NOT
+NULL
+NUMBERP
+ONEP
+OPEN
+OR
+ORDERP
+P!.N Evaluates Implicit PROGNs
+PAIR
+PAIRP
+PBIND1 PROG binding
+PBINDN
+PLIST Access full property list
+PLUS
+PLUS2
+PRIN1
+PRIN2
+PRIN2T
+PRIN2TL
+PRINC
+PRINT
+PROG
+PROG2
+PROGG0131
+PROGN
+PUT
+PUTC
+PUTD
+PUTL
+PUTV
+QUOTIENT
+RDEVPR A read-eval-print loop
+RDS
+RDTOK
+READ
+READCH
+RECLAIM
+REMAINDER
+REMD
+REMFLAG
+REMFLAG1
+REMOB
+REMPROP
+RETURN
+REV
+REVERSE
+REVX
+RLIST
+RPLACA
+RPLACD
+SASSOC
+SET
+SETFUNCELL
+SETPLIST
+SETVALUE
+STRINGP Equivalent to IDP
+SUB1
+SUBLIS
+SUBST
+TCATCH
+TERPRI
+THROW
+TIMES
+TIMES2
+TOKEN
+TTHROW
+UNBIND1
+UNBINDN
+UNBINDTO
+UNFLUID
+UPBV
+VALUE
+VECTORP
+WHILE
+WRS
+WRTOK
+XAPPLY
+XCONS
+ZEROP
+@u[Interesting Globals]
+!*RAISE Raise lower case typing to upper case if not NIL
+!*ECHO Selected input to selected output if not NIL.
+BSTK!* Holds old values of rebound IDS
+EMSG!* Error message in most recent call on ERROR
+ENUM!* Error number in most recent call on ERROR.
+INITFORM!* First Expression EVAL'ed
+THROWING!* Indicates if throwing
+THROWTAG!* Indicates TAG in TTHROW
+TOK!* Holds last token scanned
+TOKTYPE Indicates type of token scanned:
+ 1: integer
+ 2: id
+ 3: character
ADDED perq-pascal-lisp-project/componly.bld
Index: perq-pascal-lisp-project/componly.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/componly.bld
@@ -0,0 +1,6 @@
+pascal
+s:PL20.rel
+S:PL20.lst
+S:PL20.PAS/debug
+load S:PL20.REL
+save S:PL20.EXE
ADDED perq-pascal-lisp-project/delete.pas
Index: perq-pascal-lisp-project/delete.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/delete.pas
@@ -0,0 +1,96 @@
+forward;
+(* !(!*ENTRY DELETE EXPR !2!) *)
+(* EXPR DELETE *)
+procedure PAS227;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!0!9!9 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!1!0!1!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!9!9!) *)
+100:
+(* !(!*LOAD !2 !(CAR !2!)!) *)
+ ANYcar(R[2],R[2]);
+(* !(!*LINK EQUAL EXPR !2!) *)
+ PAS226;
+(* !(!*JUMPNIL G!0!1!0!0!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !1 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[1]);
+(* !(!*JUMP G!0!1!0!1!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!0!0!) *)
+101:
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK DELETE EXPR !2!) *)
+ PAS227;
+(* !(!*LOAD !2 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[2]);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!1!0!1!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS228;
+forward;
+(* !(!*ENTRY DELQ EXPR !2!) *)
+(* EXPR DELQ *)
+procedure PAS228;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !2 !0!) *)
+ store(2,0);
+(* !(!*JUMPC G!0!1!0!5 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!1!0!7!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!0!5!) *)
+100:
+(* !(!*JUMPN G!0!1!0!6 !(CAR !2!)!) *)
+ ANYcar(R[2],RXX);
+ IF R[1] <> RXX THEN GOTO 101;
+(* !(!*LOAD !1 !(CDR !2!)!) *)
+ ANYcdr(R[2],R[1]);
+(* !(!*JUMP G!0!1!0!7!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!0!6!) *)
+101:
+(* !(!*LOAD !2 !(CDR !2!)!) *)
+ ANYcdr(R[2],R[2]);
+(* !(!*LINK DELQ EXPR !2!) *)
+ PAS228;
+(* !(!*LOAD !2 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[2]);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!1!0!7!) *)
+102:
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
ADDED perq-pascal-lisp-project/draft
Index: perq-pascal-lisp-project/draft
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/draft
@@ -0,0 +1,6 @@
+Subject: PASLSP TEST
+To: GRISS
+cc: CAI.OTTENHEIMER
+
+(DSKIN "PASLSP.TST") croaks on the 20 also, ends up with inf. recursion.
+
ADDED perq-pascal-lisp-project/exec.pas
Index: perq-pascal-lisp-project/exec.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/exec.pas
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/lspfns.pas
Index: perq-pascal-lisp-project/lspfns.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/lspfns.pas
@@ -0,0 +1,171 @@
+function caar(x: any): any;
+ begin
+ caar := car(car(x))
+ end;
+
+function cadr(x: any): any;
+ begin
+ cadr := car(cdr(x))
+ end;
+
+function cdar(x: any): any;
+ begin
+ cdar := car(cdr(x))
+ end;
+
+function cddr(x: any): any;
+ begin
+ cddr := cdr(cdr(x))
+ end;
+
+function prin2(x: any): any;
+ begin
+ end;
+
+function rev(l1: any): any;
+ begin
+ end;
+
+function notnull(x: any): any;
+ begin
+ notnull := x
+ end;
+
+function list2(r1, r2: any): any;
+ begin
+ list2 := cons(r1, ncons(r2))
+ end;
+
+function list3(r1, r2, r3: any): any;
+ begin
+ list3 := cons(r1, list2(r2, r3))
+ end;
+
+function list4(r1, r2, r3, r4: any): any;
+ begin
+ list4 := cons(r1, list3(r2, r3, r4))
+ end;
+
+function list5(r1, r2, r3, r4, r5: any): any;
+ begin
+ list5 := cons(r1, list4(r2, r3, r4, r5))
+ end;
+
+function reverse(u: any): any;
+ begin
+ reverse := rev(u)
+ end;
+
+function append(u, v: any): any;
+ function append1: any;
+ begin
+ junk := setq(u, reverse(u));
+ while truep(pairp(u)) do
+ begin
+ junk := setq(v, cons(car(u), v));
+ junk := setq(u, cdr(u)) (* a hard case *)
+ end;
+ append := v (* goto also needed? *)
+ end;
+
+ begin
+ append := append1;
+ end;
+
+ (* procedures to support get & put. *)
+function memq(u, v: any): any;
+ begin
+ if truep(xnot(pairp(v))) then memq := v
+ else if truep(eq(u, car(v))) then memq := v
+ else memq := memq(u, cdr(v))
+ end;
+
+function atsoc(u, v: any): any;
+ begin
+ if truep(xnot(pairp(v))) then atsoc := v
+ else if truep(xnot(pairp(v))) or truep(xnot(eq(u, caar(v)))) then
+ atsoc := atsoc(u, cdr(v))
+ else atsoc := car(v)
+ end;
+
+function delq(u, v: any): any;
+ begin
+ if truep(xnot(pairp(v))) then delq := v
+ else if truep(eq(u, car(v))) then delq := cdr(v)
+ else delq := cons(car(v), delq(u, cdr(v)))
+ end;
+
+function delatq(u, v: any): any;
+ begin
+ if truep(xnot(pairp(v))) then delatq := v
+ else if truep(xnot(pairp(car(v)))) or truep(xnot(eq(u, caar(v)))) then
+ delatq := cons(car(v), delatq(u, cdr(v)))
+ else delatq := cdr(v)
+ end;
+
+function get(u, v:any): any;
+ begin
+ if truep(xnot(idp(u))) then get := xnil
+ else if truep(pairp(setq(u, atsoc(v, plist(u))))) then get := cdr(u)
+ else get := xnil
+ end;
+
+function put(u, v, ww: any): any;
+ function put1: any;
+ label 1;
+ var l: any;
+ begin
+ if truep(xnot(idp(u))) then
+ begin
+ put1 := ww;
+ goto 1
+ end;
+ junk := setq(l, plist(u));
+ if truep(atsoc(v, l)) then junk := delatq(v, l);
+ if truep(notnull(ww)) then junk := setq(l, cons(cons(v, ww), l));
+ junk := setplist(u, l);
+ begin
+ put1 := ww;
+ goto 1
+ end;
+ 1:
+ end;
+
+ begin
+ put := put1
+ end;
+
+function remprop(u, v: any): any;
+ begin
+ remprop := put(u, v, xnil)
+ end;
+
+function eqcar(u, v: any): any;
+ begin
+ if truep(pairp(u)) then
+ if truep(eq(car(u), v)) then eqcar := t
+ else eqcar := xnil
+ end;
+
+function null(u: any): any;
+ begin
+ null := eq(u, xnil)
+ end;
+
+function equal(x, y: any): any;
+ begin
+ if truep(atom(x)) then
+ if truep(atom(y)) then
+ equal := eq(x, y)
+ else equal := xnil
+ else if truep(atom(y)) then equal := xnil
+ else if truep(equal(car(x), car(y))) then
+ if truep(equal(cdr(x), cdr(y))) then equal := t
+ else equal := xnil
+ else equal := xnil
+ end;
+
+function read;
+ begin
+ end;
+
ADDED perq-pascal-lisp-project/lspker.pas
Index: perq-pascal-lisp-project/lspker.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/lspker.pas
@@ -0,0 +1,1269 @@
+(* include following two lines for terak *)
+(* [$s+] *) (* swapping mode to manage this large file *)
+(* [$g+] *) (* goto is legal *)
+
+PROGRAM Paslsp(symin, input, output);
+
+ (************************************************************)
+ (* this file contains global data declarations and *)
+ (* function definitions to support a sub-standard lisp *)
+ (* system. it is used with a compiler which compiles lisp *)
+ (* to pascal source code. this file is divided into the *)
+ (* following sections: *)
+ (* 1. constant, type & global variable declarations. *)
+ (* 2. lisp item selectors & constructors - these are *)
+ (* the functions which know about the internal *)
+ (* (pascal) representation of lisp data primitives. *)
+ (* currently these are: integers (-4096..4095), *)
+ (* characters, dotted pairs, identifiers, *)
+ (* code pointers, error conditions, large integers & *)
+ (* floating point numbers (most hooks exist). *)
+ (* 3. stack allocation - variables local to a function *)
+ (* are kept on a stack. *)
+ (* 4. the garbage collector. *)
+ (* 5. identifier lookup & entry - symbol table *)
+ (* management. *)
+ (* 6. standard lisp functions - pascal implementations *)
+ (* taking lisp items as arguments and returning a *)
+ (* lisp item. more standard lisp functions are found *)
+ (* in lspfns.red. *)
+ (* 7. i/o primitives (not callable from lisp functions).*)
+ (* 8. a lisp callable token scanner. *)
+ (* 9. initialization. *)
+ (* 10. apply *)
+ (************************************************************)
+ (* symin is input channel one--used to initialize "symbol *)
+ (* table". input is input channel two--standard input. *)
+ (* output is output channel one--the standard output. *)
+ (************************************************************)
+ (* written by martin l. griss, william f. galway and *)
+ (* ralph ottenheimer. *)
+ (* last changed 16 june 1981 *)
+ (************************************************************)
+
+CONST
+
+ (* constants relating to input / output *)
+ sp = ' ';
+ nul = 0; (* ascii codes *)
+ ht = 9;
+ lf = 10;
+ cr = 13;
+
+ inchns = 2; (* number of input channels. *)
+ outchns = 1; (* number of output channels. *)
+ eofcode = 26; (* magic character code for eof, ascii for *)
+ (* cntrl-z. kludge, see note in rdtok. *)
+ choffset = 1; (* add choffset to ascii code to get address *)
+ (* in id space for corresponding identifier. *)
+ eos = nul; (* terminator character for strings. *)
+
+ (* constants relating to the token scanner *)
+ toktype = 129; (* slot in idspace for toktype. *)
+ chartype = 3; (* various token types *)
+ inttype = 1;
+ idtype = 2;
+
+ (* constants relating to lisp data types and their representations. *)
+ shift_const = 8192; (* tags and info are packed into an integer *)
+ (* assumed to be at least 16 bits long. low order 13 bits *)
+ (* are the info, top 3 are the tag. *)
+ int_offset = 4096; (* small integers are stored 0..8191 *)
+ (* instead of -4096..4095 because it will pack smaller *)
+ (* under ucsd pascal. *)
+ end_flag = -1; (* marks end of fixnum free list. *)
+
+ (* the various tags - can't use a defined scalar type *)
+ (* because of the lack of convertion functions. *)
+ inttag = 0; (* info is an integer *)
+ chartag = 1; (* info is a character code *)
+ pairtag = 2; (* info points to pair *)
+ idtag = 3; (* info points to identifier *)
+ codetag = 4; (* info is index into a case statement *)
+ (* that calls appropriate function. *)
+ errtag = 5; (* info is an error code - see below. *)
+ fixtag = 6; (* info points to a full word (or *)
+ (* longer) integer. *)
+ flotag = 7; (* info points to a float number. *)
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on a non-pair. *)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells (etc?) *)
+
+ (* constants relating to data space *)
+ maxpair = 2500; (* max number of pairs allowed. *)
+ maxident = 400; (* max number of identifiers *)
+ maxstrsp = 2000; (* size of string (literal) storage space. *)
+ maxintsp = 50; (* max number of long integers allowed *)
+ maxflosp = 2; (* max number of floating numbers allowed *)
+ maxgcstk = 100; (* size of garbage collection stack. *)
+ stksize = 500; (* stack size *)
+
+ (* constants relating to the symbol table. *)
+ hidmax = 50; (* number of hash values for identifiers *)
+ nillnk = 0; (* when integers are used as pointers. *)
+
+
+TYPE
+ onechar = char;
+
+ (* note we allow zero for id_ptr, allowing a "nil" link. *)
+ stringp = 1..maxstrsp; (* pointer into string space. *)
+ id_ptr = 0..maxident; (* pointer into id space. *)
+
+ any = integer; (* your basic lisp item *)
+ itemtype = 0..7; (* the tags *)
+
+
+ pair = PACKED RECORD
+ prcar: any;
+ prcdr: any;
+ markflg: boolean; (* for garbage collection *)
+ END;
+
+
+ ascfile = PACKED FILE OF onechar;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: any; (* value *)
+ plist: any; (* property list *)
+ funcell: any; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+ longint = integer; (* use integer[n] on terak *)
+
+VAR
+ (* global information *)
+ xnil, t: any; (* refers to identifiers "nil", and "t". *)
+ junk: any; (* global to hold uneeded function results *)
+ old_binds: any; (* saved fluid bindings *)
+
+ (* "st" is the stack pointer into "stk". it counts the number of *)
+ (* items on the stack, so it runs from zero while the stack starts *)
+ (* at one. *)
+ st: 0..stksize;
+ stk: ARRAY[1..stksize] OF any;
+
+ (* pair space *)
+ prspace: PACKED ARRAY[1..maxpair] OF pair; (* all pairs stored here. *)
+ freepair: integer; (* pointer to next free pair in prspace. *)
+
+ (* identifier space *)
+ idhead: ARRAY[0..hidmax] OF id_ptr;
+ idspace: PACKED ARRAY[1..maxident] OF ident;
+ freeident: integer;
+
+ (* string space *)
+ strspace: PACKED ARRAY[1..maxstrsp] OF onechar;
+ freestr: stringp;
+
+ (* large integer space *)
+ intspace: ARRAY[1..maxintsp] OF longint;
+ freeint: 1..maxintsp;
+
+ (* floating point number space *)
+ flospace: ARRAY[1..maxflosp] OF real;
+ freefloat: 1..maxflosp;
+
+ (* i/o channels *)
+ symin: ascfile;
+ input: ascfile; (* comment out for terak. *)
+
+ inchnl: 1..inchns; (* current input channel number *)
+ outchnl: 1..outchns; (* current output channel number *)
+
+ (* "current character" for each input channel. *)
+ (* may want to include more than one character at some later date *)
+ (* (for more lookahead). *)
+ ichrbuf: ARRAY[1..inchns] OF onechar;
+
+ (* for collecting statistics. *)
+ gccount: integer; (* counts garbage collections *)
+ (* counts from last garbage collection. *)
+ consknt: integer; (* number of times "cons" called *)
+ pairknt: integer; (* number of pairs created *)
+
+
+ (********************************************************)
+ (* *)
+ (* item selectors & constructors *)
+ (* *)
+ (********************************************************)
+
+FUNCTION Truep(predicate: any): boolean;
+ BEGIN (* truep *)
+ Truep := predicate <> xnil
+ END (* truep *);
+
+FUNCTION Falsep(predicate: any): boolean;
+ BEGIN (* Falsep *)
+ Falsep := predicate = xnil
+ END (* Falsep *);
+
+FUNCTION Tag_of(item: any): itemtype;
+ BEGIN (* tag_of *)
+ Tag_of := item DIV shift_const;
+ END;
+ (* tag_of *)
+
+FUNCTION Info_of(item: any): integer;
+ BEGIN (* info_of *)
+ IF item DIV shift_const = inttag THEN
+ Info_of := item MOD shift_const - int_offset
+ ELSE
+ Info_of := item MOD shift_const
+ END;
+ (* info_of *)
+
+FUNCTION Mkitem(tag: itemtype; info: longint): any;
+ (* do range checking on info. ints run from -4096 to +4095 *)
+ (* everything else runs from 0 to 8191. ints & chars *)
+ (* contain their info, all others points into an *)
+ (* appropriate space. *)
+
+ BEGIN (* mkitem *)
+ IF info < 0 THEN (* this check probably not necessary *)
+ Writeln('*****MKITEM: BAD NEG');
+
+ (* pack tag and info into 16-bit item. *)
+ Mkitem := tag * shift_const + info
+ END (* mkitem *);
+
+
+PROCEDURE Set_info(VAR item: any; newinfo: longint);
+ BEGIN (* set_info *)
+ item := Mkitem(Tag_of(item), newinfo)
+ END;
+ (* set_info *)
+
+PROCEDURE Set_tag(VAR item: any; newtag: itemtype);
+ BEGIN (* set_tag *)
+ item := Mkitem(newtag, Info_of(item))
+ END;
+ (* set_tag *)
+
+FUNCTION Mkident(id: integer): any;
+ BEGIN (* mkident *)
+ Mkident := Mkitem(idtag, id);
+ END;
+ (* mkident *)
+
+FUNCTION Car(u: any): any; FORWARD;
+FUNCTION Cdr(u: any): any; FORWARD;
+FUNCTION Pairp(item: any): any; FORWARD;
+
+FUNCTION Mkfixint(fixint: longint): any;
+ VAR p: integer;
+
+ PROCEDURE Gc_int; (* Garbage collect large integer space. *)
+ VAR i: integer;
+ mark_flag: PACKED ARRAY[1..maxintsp] OF boolean;
+
+ PROCEDURE Mark(u: any);
+ BEGIN (* mark *)
+ IF Truep(Pairp(u)) THEN
+ BEGIN
+ Mark(Car(u));
+ Mark(Cdr(u))
+ END
+ ELSE IF Tag_of(u) = fixtag THEN
+ mark_flag[Info_of(u)] := true
+ END; (* mark *)
+
+ BEGIN (* gc_int *)
+ FOR i := 1 TO maxintsp DO (* clear mark flags *)
+ mark_flag[i] := false;
+
+ FOR i := 1 TO st DO (* mark from the stack *)
+ Mark(stk[i]);
+
+ FOR i := 1 TO maxident DO (* mark from the symbol table *)
+ BEGIN
+ Mark(idspace[i].val);
+ Mark(idspace[i].plist);
+ Mark(idspace[i].funcell)
+ END;
+
+ (* reconstruct free list *)
+ FOR i := 1 TO maxintsp - 1 DO
+ IF NOT mark_flag[i] THEN
+ BEGIN
+ intspace[i] := freeint;
+ freeint := i
+ END
+ END; (* gc_int *)
+
+
+ BEGIN (* mkfixint *)
+ IF intspace[freeint] = end_flag THEN Gc_int;
+ IF intspace[freeint] <> end_flag THEN (* convert to fixnum *)
+ BEGIN
+ p := freeint;
+ freeint := intspace[freeint];
+ Mkfixint := Mkitem(fixtag, p);
+ intspace[p] := fixint
+ END
+ ELSE Writeln('*****FIXNUM SPACE EXHAUSTED')
+ END (* mkfixint *);
+
+FUNCTION Mkint(int: longint): any;
+ BEGIN (* mkint *)
+ IF (int < -int_offset) OR (int > int_offset - 1) THEN
+ Mkint := Mkfixint(int)
+ ELSE
+ Mkint := Mkitem(inttag, int + int_offset)
+ (* int was in range so add offset *)
+ END (* mkint *);
+
+FUNCTION Mkpair(pr: integer): any;
+ BEGIN (* mkpair *)
+ Mkpair := Mkitem(pairtag, pr)
+ END;
+ (* mkpair *)
+
+PROCEDURE Int_val(item: any; VAR number: longint);
+ (* returns integer value of item (int or fixnum). *)
+ (* must return 'number' in var parameter instead *)
+ (* of function value since long integers are not *)
+ (* a legal function type in ucsd pascal. *)
+ BEGIN (* int_val *)
+ IF Tag_of(item) = inttag THEN
+ number := Info_of(item)
+ ELSE IF Tag_of(item) = fixtag THEN
+ number := intspace[Info_of(item)]
+ ELSE Writeln('***** ILLEGAL DATA TYPE FOR NUMERIC OPERATION')
+ END (* int_val *);
+
+
+ (********************************************************)
+ (* *)
+ (* stack allocation *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE Alloc(n: integer);
+ BEGIN
+ IF n + st <= stksize THEN
+ st := n+st
+ ELSE
+ BEGIN
+ Writeln('*****LISP STACK OVERFLOW');
+ Writeln(' TRIED TO ALLOCATE ',n);
+ Writeln(' CURRENT STACK TOP IS ',st);
+ END;
+ END;
+
+PROCEDURE Dealloc(n: integer);
+ BEGIN
+ IF st - n >= 0 THEN
+ st := st - n
+ ELSE
+ Writeln('*****LISP STACK UNDERFLOW');
+ END;
+
+ (* optimized allocs *)
+
+PROCEDURE Alloc1;
+ BEGIN Alloc(1) END;
+
+PROCEDURE Dealloc1;
+ BEGIN Dealloc(1) END;
+
+PROCEDURE Alloc2;
+ BEGIN Alloc(2) END;
+
+PROCEDURE Dealloc2;
+ BEGIN Dealloc(2) END;
+
+PROCEDURE Alloc3;
+ BEGIN Alloc(3) END;
+
+PROCEDURE Dealloc3;
+ BEGIN Dealloc(3) END;
+
+
+ (********************************************************)
+ (* *)
+ (* the garbage collector *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE Faststat;
+ (* give quick summary of statistics gathered *)
+ BEGIN
+ Writeln('CONSES:',consknt);
+ Writeln('PAIRS :',pairknt);
+ Writeln('CONSES/PAIRS: ',consknt/pairknt);
+ Writeln('ST :',st);
+ END;
+
+
+PROCEDURE Gcollect;
+ VAR
+ i: integer;
+ markedk: integer; (* counts the number of pairs marked *)
+ freedk: integer; (* counts the number of pairs freed. *)
+ gcstkp: 0..maxgcstk; (* note the garbage collection stack *)
+ mxgcstk: 0..maxgcstk; (* is local to this procedure. *)
+ gcstk: ARRAY[1..maxgcstk] OF integer;
+
+ PROCEDURE Pushref(pr: any);
+ (* push the address of an unmarked pair, if that's what it is. *)
+ BEGIN
+ IF Tag_of(pr) = pairtag THEN
+ IF NOT prspace[Info_of(pr)].markflg THEN
+ BEGIN
+ IF gcstkp < maxgcstk THEN
+ BEGIN
+ gcstkp := gcstkp + 1;
+ gcstk[gcstkp] := Info_of(pr);
+ IF gcstkp > mxgcstk THEN
+ mxgcstk := gcstkp;
+ END
+ ELSE
+ Writeln('*****GARBAGE STACK OVERFLOW');
+ (* fatal error *)
+ END;
+ END;
+
+ PROCEDURE Mark;
+ (* "recursively" mark pairs referred to from gcstk. gcstk is used to *)
+ (* simulate recursion. *)
+ VAR
+ prloc: integer;
+ BEGIN
+ WHILE gcstkp > 0 DO
+ BEGIN
+ prloc := gcstk[gcstkp];
+ gcstkp := gcstkp - 1;
+ prspace[prloc].markflg := true;
+ Pushref(prspace[prloc].prcdr);
+ Pushref(prspace[prloc].prcar); (* trace the car first. *)
+ END;
+ END;
+
+ BEGIN (* gcollect *)
+ Writeln('***GARBAGE COLLECTOR CALLED');
+ gccount := gccount + 1; (* count garbage collections. *)
+ Faststat; (* give summary of statistics collected *)
+ consknt := 0; (* clear out the cons/pair counters *)
+ pairknt := 0;
+ gcstkp := 0; (* initialize the garbage stack pointer. *)
+ mxgcstk := 0; (* keeps track of max stack depth. *)
+
+ (* mark things from the "computation" stack. *)
+ FOR i := 1 TO st DO
+ BEGIN
+ Pushref(stk[i]);
+ Mark;
+ END;
+ (* mark things from identifier space. *)
+ FOR i := 1 TO maxident DO
+ BEGIN
+ Pushref(idspace[i].val);
+ Mark;
+ Pushref(idspace[i].plist);
+ Mark;
+ Pushref(idspace[i].funcell);
+ Mark;
+ END;
+
+ (* reconstruct free list by adding things to the head. *)
+ freedk := 0;
+ markedk := 0;
+ FOR i:= 1 TO maxpair - 1 DO
+ BEGIN
+ IF prspace[i].markflg THEN
+ BEGIN
+ markedk := markedk + 1;
+ prspace[i].markflg := false
+ END
+ ELSE
+ BEGIN
+ prspace[i].prcar := xnil;
+ prspace[i].prcdr := Mkitem(pairtag, freepair);
+ freepair := i;
+ freedk := freedk + 1
+ END
+ END (* for *);
+ Writeln(freedk,' PAIRS FREED.');
+ Writeln(markedk,' PAIRS IN USE.');
+ Writeln('MAX GC STACK WAS ',mxgcstk);
+ END (* gcollect *);
+
+
+ (********************************************************)
+ (* *)
+ (* identifier lookup & entry *)
+ (* *)
+ (********************************************************)
+
+FUNCTION Nmhash(nm: stringp): integer;
+ CONST
+ hashc = 256;
+ VAR
+ i,tmp: integer;
+ BEGIN
+ tmp := 0;
+ i := 1; (* get hash code from first three chars of string. *)
+ WHILE (i <= 3) AND (strspace[nm+i] <> Chr(eos)) DO
+ BEGIN
+ tmp := Ord(strspace[nm+i]) + hashc*tmp;
+ i := i + 1;
+ END;
+ Nmhash := Abs(tmp) MOD hidmax; (* abs because mod is screwy. *)
+ END;
+
+FUNCTION Eqstr(s1,s2: stringp): boolean;
+ BEGIN
+ WHILE (strspace[s1] = strspace[s2]) AND (strspace[s1] <> Chr(eos)) DO
+ BEGIN
+ s1 := s1 + 1;
+ s2 := s2 + 1;
+ END;
+ Eqstr := (strspace[s1] = strspace[s2]);
+ END;
+
+PROCEDURE Nmlookup(nm: stringp; VAR found: boolean; VAR hash: integer;
+ VAR loc: any);
+ (* lookup a name in "identifier space". *)
+ (* "hash" returns the hash value for the name. *)
+ (* "loc" returns the location in the space for the (possibly new) *)
+ (* identifier. *)
+ BEGIN
+ hash := Nmhash(nm);
+ loc := Mkitem(idtag, idhead[hash]);
+ (* default is identifier, but may be "error". *)
+ (* start at appropriate hash chain. *)
+
+ found := false;
+ WHILE (Info_of(loc) <> nillnk) AND (NOT found) DO
+ BEGIN
+ found := Eqstr(nm, idspace[Info_of(loc)].idname);
+ IF NOT found THEN
+ Set_info(loc, idspace[Info_of(loc)].idhlink);
+ (* next id in chain *)
+ END;
+ IF NOT found THEN (* find spot for new identifier *)
+ BEGIN
+ IF freeident=nillnk THEN (* no more free identifiers. *)
+ loc := Mkitem(errtag, noidspace)
+ ELSE
+ BEGIN
+ Set_info(loc, freeident);
+ freeident := idspace[freeident].idhlink;
+ END;
+ END;
+ END;
+
+PROCEDURE Putnm(nm: stringp; VAR z: any; VAR found: boolean);
+ (* put a new name into identifier space, or return old location *)
+ (* if it's already there. *)
+ VAR
+ tmp: ident;
+ hash: integer;
+ BEGIN
+ Nmlookup(nm, found, hash, z);
+ IF (NOT found) AND (Tag_of(z) = idtag) THEN
+ BEGIN
+ tmp.idname := nm;
+ tmp.idhlink := idhead[hash]; (* put new ident at head of chain *)
+ tmp.val := xnil; (* initialize value and property list *)
+ tmp.plist := xnil;
+ tmp.funcell := xnil; (* also, the function cell *)
+ idhead[hash] := Info_of(z);
+ idspace[Info_of(z)] := tmp;
+ END;
+ END;
+
+ (********************************************************)
+ (* *)
+ (* standard lisp functions *)
+ (* *)
+ (********************************************************)
+
+ (* the following standard lisp functions appear in *)
+ (* lspfns.red: reverse, append, memq, atsoc, get, *)
+ (* put, remprop, eq, null, equal, error, errorset, *)
+ (* abs, idp, numberp, atom, minusp, eval, apply, *)
+ (* evlis, prin1, print, prin2t, list2 ... list5. *)
+
+FUNCTION Setq(VAR u: any; v: any): any;
+ BEGIN (* setq *)
+ (* should check to make sure u not t or nil. *)
+ u := v;
+ Setq := v
+ END (* setq *);
+
+FUNCTION Atom(item : any): any;
+ BEGIN (* atom *)
+ IF Tag_of(item) <> pairtag THEN Atom := t
+ ELSE Atom := xnil
+ END (* atom *);
+
+FUNCTION Codep(item: any): any;
+ BEGIN (* codep *)
+ IF Tag_of(item) = codetag THEN Codep := t
+ ELSE Codep := xnil
+ END (* codep *);
+
+FUNCTION Idp(item: any): any;
+ BEGIN (* idp *)
+ IF Tag_of(item) = idtag THEN Idp := t
+ ELSE Idp := xnil
+ END (* idp *);
+
+FUNCTION Pairp(*item: any): any*);
+ BEGIN (* pairp *)
+ IF Tag_of(item) = pairtag THEN Pairp := t
+ ELSE Pairp := xnil
+ END (* pairp *);
+
+FUNCTION Constantp(item: any): any;
+ BEGIN (* constantp *)
+ IF NOT((Pairp(item) = t) OR (Idp(item) = t)) THEN
+ Constantp := t
+ ELSE Constantp := xnil
+ END (* constantp *);
+
+FUNCTION Eq(u, v: any): any;
+ BEGIN (* eq *)
+ IF u = v THEN Eq := t
+ ELSE Eq := xnil
+ END (* eq *);
+
+FUNCTION Eqn(u, v: any): any;
+ VAR i, j: longint;
+
+ BEGIN (* eqn *)
+ Int_val(u, i);
+ Int_val(v, j);
+ IF i = j THEN Eqn := t
+ ELSE Eqn := xnil
+ END (* eqn *);
+
+FUNCTION Fixp(item: any): any;
+ BEGIN (* fixp *)
+ IF (Tag_of(item) = inttag) OR (Tag_of(item) = fixtag) THEN
+ Fixp := t
+ ELSE Fixp := xnil
+ END (* fixp *);
+
+FUNCTION Floatp(item: any): any;
+ BEGIN (* floatp *)
+ IF Tag_of(item) = flotag THEN Floatp := t
+ ELSE Floatp := xnil
+ END (* floatp *);
+
+FUNCTION Numberp(item: any): any;
+ BEGIN (* numberp *)
+ Numberp := Fixp(item) (* will have to fix for floats *)
+ END (* numberp *);
+
+FUNCTION Cons(u, v: any): any;
+ VAR p: integer;
+
+ BEGIN (* cons *)
+ (* push args onto stack, in case we need to garbage collect the *)
+ (* references will be detected. *)
+ Alloc(2);
+ stk[st] := u;
+ stk[st-1] := v;
+
+ IF prspace[freepair].prcdr = xnil THEN Gcollect;
+
+ p := freepair;
+ freepair := Info_of(prspace[p].prcdr);
+ prspace[p].prcar := u;
+ prspace[p].prcdr := v;
+ Cons := Mkpair(p); (* return new pair. *)
+
+ consknt := consknt + 1;
+ Dealloc(2);
+ END (* cons *);
+
+FUNCTION Ncons(u: any): any;
+ BEGIN
+ Ncons := Cons(u, xnil)
+ END;
+
+FUNCTION Xcons(u, v: any): any;
+ BEGIN
+ Xcons := Cons(v, u)
+ END;
+
+FUNCTION Car(*u: any): any*);
+ BEGIN
+ IF Tag_of(u) = pairtag THEN
+ Car := prspace[Info_of(u)].prcar
+ ELSE
+ Car := Mkitem(errtag, notpair);
+ END;
+
+FUNCTION Cdr(*u: any): any*);
+ BEGIN
+ IF Tag_of(u) = pairtag THEN
+ Cdr := prspace[Info_of(u)].prcdr
+ ELSE
+ Cdr := Mkitem(errtag, notpair);
+ END;
+
+
+ (* fluid binding *)
+FUNCTION Push_bind(bind: any): any;
+ BEGIN (* push_bind *)
+ old_binds := cons(bind, old_binds);
+ push_bind := xnil
+ END (* push_bind *);
+
+FUNCTION Lam_bind(alist: any): any;
+ VAR bind: any;
+
+ BEGIN (* lam_bind *)
+ WHILE Truep(Pairp(alist)) DO
+ BEGIN
+ bind := Car(alist);
+ alist := Cdr(alist);
+ push_bind(bind);
+ setvalue(Car(bind), Cdr(bind))
+ END;
+ Lam_bind := xnil
+ END (* lam_bind *);
+
+FUNCTION Prog_bind(id: any): any;
+ BEGIN (* prog_bind *)
+ Prog_bind := Lam_bind(cons(id, xnil))
+ END (* prog_bind *);
+
+FUNCTION Unbind(id: any): any;
+ BEGIN (* unbind *)
+ setvalue(id, cdr(atsoc(id, old_binds)))
+ Unbind := xnil
+ END (* unbind *);
+
+ (* arithmetic functions *)
+FUNCTION Add1(i: any): any;
+ VAR j: longint;
+
+ BEGIN
+ Int_val(i, j);
+ Add1 := Mkint(j + 1)
+ END;
+
+FUNCTION Difference(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+ Difference := Mkint(i1 - i2)
+ END;
+
+FUNCTION Divide(i, j: any): any;
+ (* returns dotted pair (quotient . remainder). *)
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+ IF i2 = 0 THEN Writeln('***** ATTEMPT TO DIVIDE BY 0 IN DIVIDE');
+ Divide := Cons(Mkint(i1 DIV i2), Mkint(i1 MOD i2))
+ END;
+
+FUNCTION Greaterp(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+
+ IF i1 > i2 THEN
+ Greaterp := t
+ ELSE
+ Greaterp := xnil;
+ END;
+
+FUNCTION Lessp(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+
+ IF i1 < i2 THEN
+ Lessp := t
+ ELSE
+ Lessp := xnil;
+ END;
+
+FUNCTION Minus(i: any): any;
+ VAR j: longint;
+
+ BEGIN
+ Int_val(i, j);
+ Minus := Mkint(-j)
+ END;
+
+FUNCTION Plus2(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+ Plus2 := Mkint(i1 + i2)
+ END;
+
+FUNCTION Quotient(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+ IF i2 = 0 THEN Writeln('***** ATTEMPT TO DIVIDE BY 0 IN QUOTIENT');
+ Quotient := Mkint(i1 DIV i2)
+ END;
+
+FUNCTION Remainder(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+ IF i2 = 0 THEN Writeln('***** ATTEMPT TO DIVIDE BY 0 IN REMAINDER');
+ Remainder := Mkint(i1 MOD i2)
+ END;
+
+FUNCTION Times2(i, j: any): any;
+ VAR i1, i2: longint;
+
+ BEGIN
+ Int_val(i, i1);
+ Int_val(j, i2);
+ Times2 := Mkint(i1 * i2)
+ END;
+ (* times2 *)
+
+ (* symbol table support *)
+FUNCTION Value(u: any): any;
+ BEGIN (* value *)
+ Value := idspace[Info_of(u)].val
+ END (* value *);
+
+FUNCTION Plist(u: any): any;
+ BEGIN (* plist *)
+ Plist := idspace[Info_of(u)].plist
+ END (* plist *);
+
+FUNCTION Funcell(u: any): any;
+ BEGIN (* funcell *)
+ Funcell := idspace[Info_of(u)].funcell
+ END (* funcell *);
+
+FUNCTION Setplist(u, v: any): any;
+ BEGIN (* setplist *)
+ END (* setplist *);
+
+ (* also need setvalue, setfuncell, setplist. *)
+
+FUNCTION Xnot(u: any): any;
+ BEGIN (* xnot *)
+ Xnot := Eq(u, xnil)
+ END (* xnot *);
+
+
+ (********************************************************)
+ (* *)
+ (* i/o primitives *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE Terpri;
+ (* need to change for multiple output channels. *)
+ BEGIN
+ Writeln(output);
+ END;
+
+
+PROCEDURE Wrtok(u: any);
+ (* doesn't expand escaped characters in identifier names *)
+ VAR i: integer;
+ BEGIN
+ IF Tag_of(u) = inttag THEN
+ IF Info_of(u) = 0 THEN
+ Write('0')
+ ELSE
+ Write(Info_of(u): 2+Trunc(Log(Abs(Info_of(u)))))
+
+ ELSE IF Tag_of(u) = fixtag THEN
+ Write(intspace[Info_of(u)])
+
+ ELSE IF Tag_of(u) = flotag THEN
+ Write(flospace[Info_of(u)])
+
+ ELSE IF Tag_of(u) = idtag THEN
+ BEGIN
+ i := idspace[Info_of(u)].idname;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> Chr(eos)) DO
+ BEGIN
+ Write(strspace[i]);
+ i:= i + 1;
+ END;
+ END
+
+ ELSE IF Tag_of(u) = chartag THEN
+ Write(Chr(Info_of(u) - choffset))
+
+ ELSE
+ Writeln('WRTOK GIVEN ',Tag_of(u), Info_of(u));
+ END;
+
+
+PROCEDURE Rdchnl(chnlnum: integer; VAR ch: onechar);
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ Writeln('*****BAD INPUT CHANNEL FOR RDCHNL')
+ ELSE
+ CASE chnlnum OF
+ 1: BEGIN
+ ch := symin^; (* a little strange, but avoids *)
+ Get(symin); (* initialization problems *)
+ ichrbuf[inchnl] := symin^;
+ END;
+
+ 2: BEGIN
+ ch := input^;
+ Get(input);
+ ichrbuf[inchnl] := input^;
+ END;
+ END;
+ (* case *)
+ END;
+ (* rdchnl *)
+
+FUNCTION Eofchnl(chnlnum: integer): boolean;
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ Writeln('*****BAD INPUT CHANNEL FOR EOFCHNL')
+ ELSE
+ CASE chnlnum OF
+ 1: Eofchnl := Eof(symin);
+ 2: Eofchnl := Eof(input);
+ END;
+ END;
+
+ (********************************************************)
+ (* *)
+ (* token scanner *)
+ (* *)
+ (********************************************************)
+
+FUNCTION Rdtok: any;
+ VAR
+ ch: onechar;
+ i: integer;
+ anint: longint;
+ moreid: boolean;
+ found: boolean;
+ token: any; (* the token read *)
+
+ FUNCTION Digit(ch: onechar): boolean;
+ BEGIN
+ Digit := ( '0' <= ch ) AND ( ch <= '9')
+ END;
+
+ FUNCTION Escalpha(VAR ch: onechar): boolean;
+ (* test for alphabetic or escaped character. *)
+ (* note possible side effect. *)
+ BEGIN (* escalpha *)
+ IF ( 'A' <= ch ) AND ( ch <= 'Z') THEN
+ Escalpha := true
+ ELSE IF ( Ord('A')+32 <= Ord(ch)) AND ( Ord(ch) <= Ord('Z')+32) THEN
+ Escalpha := true (* lower case alphabetics *)
+ ELSE IF ch='!' THEN
+ BEGIN
+ Rdchnl(inchnl,ch);
+ Escalpha := true;
+ END
+ ELSE
+ Escalpha := false;
+ END (* escalpha *);
+
+ FUNCTION Alphanum(VAR ch: onechar): boolean;
+ (* test if escalfa or digit *)
+ VAR b: boolean;
+ BEGIN
+ b := Digit(ch);
+ IF NOT b THEN b := Escalpha(ch);
+ Alphanum := b;
+ END;
+
+ FUNCTION Whitesp(ch: onechar): boolean;
+ BEGIN
+ (* may want a faster test *)
+ Whitesp := (ch = sp) OR (Ord(ch) = cr) OR (Ord(ch) = lf)
+ OR (Ord(ch) = ht) OR (Ord(ch) = nul)
+ END;
+
+
+ (* reads fixnums...need to read flonums too *)
+ BEGIN (* rdtok *)
+ IF NOT Eofchnl(inchnl) THEN
+ REPEAT (* skip leading white space. *)
+ Rdchnl(inchnl,ch)
+ UNTIL (NOT Whitesp(ch)) OR Eofchnl(inchnl);
+ IF Eofchnl(inchnl) THEN
+ token := Mkitem(chartag, eofcode + choffset)
+ (* should really return !$eof!$ *)
+
+ ELSE
+ BEGIN
+ token := xnil; (* init to something *)
+
+ IF Digit(ch) THEN
+ Set_tag(token, inttag)
+ ELSE IF Escalpha(ch) THEN
+ Set_tag(token, idtag)
+ ELSE
+ Set_tag(token, chartag);
+
+ CASE Tag_of(token) OF
+ chartag: BEGIN
+ Set_tag(token, idtag);
+ idspace[toktype].val := Mkitem(inttag, chartype);
+ Set_info(token, Ord(ch) + choffset);
+ END;
+ inttag: BEGIN
+ idspace[toktype].val := Mkitem(inttag, inttype);
+ anint := Ord(ch) - Ord('0');
+ WHILE Digit(ichrbuf[inchnl]) DO
+ BEGIN
+ Rdchnl(inchnl,ch);
+ anint := 10 * anint + (Ord(ch) - Ord('0'))
+ END;
+ Set_info(token, anint)
+ END;
+
+ idtag: BEGIN
+ idspace[toktype].val := Mkitem(inttag, idtype);
+ i := freestr; (* point to possible new string *)
+ moreid := true;
+ WHILE (i < maxstrsp) AND moreid DO
+ BEGIN
+ strspace[i] := ch;
+ i := i + 1;
+ moreid := Alphanum(ichrbuf[inchnl]);
+ IF moreid THEN
+ Rdchnl(inchnl,ch);
+ END;
+ strspace[i] := Chr(eos); (* terminate string *)
+ IF (i >= maxstrsp) THEN
+ Writeln('*****STRING SPACE EXHAUSTED')
+ ELSE (* look the name up, return item for it *)
+ BEGIN
+ Putnm(freestr, token, found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END;
+ END;
+ (* of case idtag *)
+ END;
+ (* of case *)
+ END;
+ Rdtok := token
+ END;
+ (* rdtok *)
+
+ (********************************************************)
+ (* *)
+ (* initialization *)
+ (* *)
+ (********************************************************)
+
+FUNCTION Read: any; FORWARD;
+
+PROCEDURE Init;
+ (* initialization procedure depends on *)
+ (* ability to load stack with constants *)
+ (* from a file. *)
+ VAR
+ strptr: stringp;
+ nam: PACKED ARRAY[1..3] OF onechar;
+ (* holds 'nil', other strings? *)
+ i, n: integer;
+ idref: any;
+ found: boolean;
+
+ (* init is divided into two parts so it can compile on terak *)
+ PROCEDURE Init1;
+ BEGIN
+ (* initialize top of stack *)
+ st := 0;
+
+ freefloat := 1;
+
+ (* define nil - the id, nil, is defined a little later. *)
+ freeident := 1;
+ xnil := Mkitem(idtag, freeident);
+
+ (* initialize pair space. *)
+ FOR i := 1 TO maxpair - 1 DO (* initialize free list. *)
+ BEGIN
+ prspace[i].markflg := false; (* redundant? *)
+ prspace[i].prcar := xnil; (* just for fun *)
+ prspace[i].prcdr := Mkitem(pairtag, i + 1)
+ END;
+ prspace[maxpair].prcar := xnil;
+ prspace[maxpair].prcdr := xnil; (* end flag *)
+ freepair := 1; (* point to first free pair *)
+
+
+ (* initialize identifier space and string space. *)
+ freestr := 1;
+ FOR i := 0 TO hidmax - 1 DO
+ idhead[i] := nillnk;
+ FOR i := 1 TO maxident DO
+ BEGIN
+ IF i < maxident THEN
+ idspace[i].idhlink := i + 1
+ ELSE (* nil to mark the final identifier in the table. *)
+ idspace[i].idhlink := nillnk;
+ (* set function cells to undefined *)
+ idspace[i].funcell := Mkitem(errtag, undefined)
+ END;
+
+ (* nil must be the first identifier in the table--id #1 *)
+ (* must fill in fields by hand for nil.*)
+ (* putnm can handle any later additions. *)
+ nam := 'NIL';
+ strptr := freestr;
+ FOR i := 1 TO 3 DO
+ BEGIN
+ strspace[strptr] := nam[i];
+ strptr:= strptr + 1;
+ END;
+ strspace[strptr] := Chr(eos);
+ Putnm(freestr, xnil, found);
+ IF NOT found THEN
+ freestr := strptr + 1;
+
+ (* make the single character ascii identifiers, except nul(=eos). *)
+ FOR i := 1 TO 127 DO
+ BEGIN
+ strspace[freestr] := Chr(i);
+ strspace[freestr + 1] := Chr(eos);
+ Putnm(freestr, idref, found);
+ IF NOT found THEN
+ freestr := freestr + 2;
+ IF i = Ord('T') THEN
+ t := idref;
+ (* returns location for 't. *)
+ END;
+
+ (* init fixnum free list. *)
+ FOR i := 1 TO maxintsp - 1 DO
+ intspace[i] := i + 1;
+ intspace[maxintsp] := end_flag;
+ freeint := 1;
+
+
+ (* clear the counters *)
+ gccount := 0;
+ consknt := 0;
+ pairknt := 0;
+ END (* init1 *);
+
+
+ PROCEDURE Init2;
+ VAR token: any;
+
+ BEGIN
+ (* load "symbol table" with identifiers, constants, and functions. *)
+ inchnl := 1; (* select symbol input file. *)
+ (* reset(symin,'#5:poly.data'); *) (* for terak *)
+
+
+ token := Rdtok; (* get count of identifiers. *)
+ IF Tag_of(token) <> inttag THEN
+ Writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED AT START');
+ n := Info_of(token);
+ FOR i := 1 TO n DO
+ token := Rdtok;
+ (* reading token magically loads it into id space. *)
+ token := Rdtok; (* look for zero terminator. *)
+ IF (Tag_of(token) <> inttag) OR (Info_of(token) <> 0) THEN
+ Writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER IDENTIFIERS');
+
+ token := Rdtok; (* count of constants *)
+ IF Tag_of(token) <> inttag THEN
+ Writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE CONSTANTS');
+ n := Info_of(token);
+ Alloc(n); (* space for constants on the stack *)
+ FOR i := 1 TO n DO
+ stk[i] := Read;
+ token := Rdtok;
+ IF (Tag_of(token) <> inttag) OR (Info_of(token) <> 0) THEN
+ Writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER CONSTANTS');
+
+
+ token := Rdtok; (* count of functions. *)
+ IF Tag_of(token) <> inttag THEN
+ Writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE FUNCTIONS');
+ n := Info_of(token);
+ FOR i := 1 TO n DO
+ (* for each function *)
+ (* store associated code *)
+ idspace[Rdtok].funcell := Mkitem(codetag, i);
+ token := Rdtok;
+ IF (Tag_of(token) <> inttag) OR (Info_of(token) <> 0) THEN
+ Writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER FUNCTIONS');
+
+ inchnl := 2; (* select standard input. *)
+ END (* init2 *);
+
+ BEGIN (* init *)
+ Init1;
+ Init2;
+ END (* init *);
+
+
+ (********************************************************)
+ (* *)
+ (* apply *)
+ (* *)
+ (********************************************************)
+
+FUNCTION Apply(fn, arglist: any): any;
+ VAR arg1, arg2, arg3, arg4, arg5: any;
+ numargs: integer;
+
+ BEGIN (* apply *)
+ IF Tag_of(fn) <> codetag THEN
+ Writeln('*****APPLY: UNDEFINED FUNCTION.')
+ ELSE
+ BEGIN (* spread the arguments *)
+ numargs := 0;
+ WHILE Truep(Pairp(arglist)) DO
+ BEGIN
+ numargs := numargs + 1;
+ CASE numargs OF
+ 1: arg1 := Car(arglist);
+ 2: arg2 := Car(arglist);
+ 3: arg3 := Car(arglist);
+ 4: arg4 := Car(arglist);
+ 5: arg5 := Car(arglist);
+ 6: Writeln('APPLY: TOO MANY ARGS SUPPLIED.')
+ END (* case *);
+ arglist := Cdr(arglist)
+ END (* while *)
+ END (* if *);
+
+ CASE Info_of(fn) OF
+ 1: Apply := Atom(arg1);
+ END (* case *)
+ END (* apply *);
+ (*??* Missing closing point at end of program. *??*)
+(*??* Missing closing point at end of program. *??*)
ADDED perq-pascal-lisp-project/pas0.perq
Index: perq-pascal-lisp-project/pas0.perq
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas0.perq
@@ -0,0 +1,1505 @@
+
+ (* PreProcessor Version - Run through Filter *)
+ (* PERQ version *)
+(*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PASCAL BASED MINI-LISP
+%
+% File: PAS0.PAS - PASCAL/LISP KERNEL
+% ChangeDate: 11:00pm Monday, 28 September 1981
+% By: Ralph Ottenheimer big -> fix, END comment FOR #pta
+% COMPRESS & EXPLODE
+%
+% All RIGHTS RESERVED
+% COPYRIGHT (C) - 1981 - M. L. GRISS
+% Computer Science Department
+% University of Utah
+%
+% Do Not distribute with out written consent of M. L. Griss
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)
+
+
+ PROGRAM pas0 (input,output, symin,finput,foutput);
+ (************************************************************)
+ (* support routines for a "lisp" machine. uses a register *)
+ (* model with a stack for holding frames. stack also used *)
+ (* to hold compiler generated constants. *)
+ (* written by william f. galway and martin l. griss *)
+ (* modified by ralph ottenheimer may 81 *)
+ (* append pas1...pasn at end *)
+ (* -------------------------------------------------------- *)
+ (* symin is input channel one--used to initialize "symbol *)
+ (* table". input is input channel two--standard input. *)
+ (* output is output channel one--the standard output. *)
+ (* finput is file input channel three. *)
+ (* foutput is file output channel four. *)
+ (************************************************************)
+
+
+imports Stream from Stream;
+imports system from system;
+imports io_others from io_others;
+imports io_unit from io_unit;
+
+
+CONST
+ (* for terak, perq, Apollo, vax *)
+ sp = ' ';
+ ht = 9; (* ascii codes *)
+ lf = 10;
+ cr = 13;
+ nul = 0;
+
+ eos = chr(0); (* KLUDGE: null string *)
+ inchns = 3; (* number of input channels. *)
+ outchns = 4; (* number of output channels. *)
+ begin_comment = '%';
+
+(* Initial symbols, needed in Kernel *)
+ xtoktype = 129; (* slot in idspace for toktype. *)
+ xbstack = 130; (* Bstack Pointer *)
+ xthrowing = 131; (* If throw mode *)
+ xinitform = 132; (* for restart *)
+ xraise = 133; (* for RAISE of lc in ids *)
+
+ chartype = 3; (* various token types *)
+ inttype = 1;
+ idtype = 2;
+
+ (* no shift const *)
+ (* assumed to be at least 16 bits long. low order 13 bits *)
+ (* are the info, top 3 are the tag. *)
+ int_offset = 32767; (* PERQ item is record * )
+
+ (* the various tags - can't use a defined scalar type *)
+ (* because of the lack of convertion functions. *)
+ inttag = 0; (* info is an integer *)
+ chartag = 1; (* info is a character code *)
+ pairtag = 2; (* info points to pair *)
+ idtag = 3; (* info points to identifier *)
+ codetag = 4; (* info is index into a case statement *)
+ (* that calls appropriate function. *)
+ errtag = 5; (* info is an error code - see below. *)
+ fixtag = 6; (* info points to a full word (or *)
+ (* longer) integer. *)
+ flotag = 7; (* info points to a float number. *)
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on a non-pair. *)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells (etc?) *)
+
+ maxpair = 3700; (* max number of pairs allowed. *)
+ maxident = 800; (* max number of identifiers *)
+ maxstrsp = 4500; (* size of string (literal) storage space. *)
+ maxintsp = 200; (* max number of long integers allowed *)
+ maxflosp = 50; (* max number of floating numbers allowed *)
+
+ hidmax = 50; (* number of hash values for identifiers *)
+ maxgcstk = 100; (* size of garbage collection stack. *)
+ stksize = 500; (* stack size *)
+ maxreg = 15; (* number of registers in lisp machine. *)
+
+ eofcode = 26; (* magic character code for eof, ascii for *)
+ (* cntrl-z. kludge, see note in xrdtok. *)
+ choffset = 1; (* add choffset to ascii code to get address *)
+ (* in id space for corresponding identifier. *)
+ nillnk = 0; (* when integers are used as pointers. *)
+
+
+TYPE
+ onechar = char; (* for terak,perq,Apollo*)
+
+ (* note we allow zero for id_ptr, allowing a "nil" link. *)
+
+ stringp = 1..maxstrsp; (* pointer into string space. *)
+ id_ptr = 0..maxident; (* pointer into id space. *)
+
+ itemref = RECORD
+ tag:integer;
+ info:integer;
+ END;
+ itemtype = 0..7; (* the tags *)
+
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ (* OLD markflag:boolean , but wastes space *)
+ END;
+
+
+ ascfile = PACKED FILE OF onechar;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+ longint = integer;
+VAR
+ (* global information *)
+ nilref,trueref: itemref; (* refers to identifiers "nil", and "t". *)
+ initphase: integer; (* Start up *)
+ r: ARRAY[1..maxreg] OF itemref;
+ rxx,ryy: itemref;
+
+
+
+ (* "st" is the stack pointer into "stk". it counts the number of *)
+ (* items on the stack, so it runs from zero while the stack starts *)
+ (* at one. *)
+ st: 0..stksize;
+ stk: ARRAY[1..stksize] OF itemref;
+
+ (* pair space *)
+ prspace: PACKED ARRAY[1..maxpair] OF pair; (* all pairs stored here. *)
+ freepair: integer; (* pointer to next free pair in prspace. *)
+
+ (* identifier space *)
+ idhead: ARRAY[0..hidmax] OF id_ptr;
+ idspace: PACKED ARRAY[1..maxident] OF ident;
+ freeident: integer;
+
+ (* string space *)
+ strspace: PACKED ARRAY[1..maxstrsp] OF onechar;
+ freestr: stringp;
+
+ (* large integer space *)
+ intspace: ARRAY[1..maxintsp] OF longint; (* use long int on terak *)
+ freeint: 1..maxintsp;
+
+ (* floating point number space *)
+ flospace: ARRAY[1..maxflosp] OF real;
+ freefloat: 1..maxflosp;
+
+ (* i/o channels *)
+ (* files declared on header *)
+ symin : ascfile;
+ finput : ascfile;
+ foutput : ascfile;
+ inchnl: 1..inchns; (* current input channel number *)
+ outchnl: 1..outchns; (* current output channel number *)
+
+ (* "current character" for each input channel. *)
+ (* may want to include more than one character at some later date *)
+ (* (for more lookahead). *)
+ ichrbuf: ARRAY[1..inchns] OF onechar;
+
+ (* for collecting statistics. *)
+ gccount: integer; (* counts garbage collections *)
+ (* counts from last garbage collection. *)
+ consknt: integer; (* number of times "cons" called *)
+
+
+
+(* ........ Everything nested inside CATCH *)
+
+Procedure Xcatch; (* ----------- Outermost Procedure ----------- *)
+ var catch_stk:0..stksize;
+ catch_Bstk:itemref;
+
+PROCEDURE xread;
+ FORWARD;
+
+PROCEDURE xprint;
+ FORWARD;
+
+PROCEDURE xunbindto;
+ FORWARD;
+
+PROCEDURE xeval;
+ FORWARD;
+
+ Procedure Xthrow;
+ begin (* throw value *)
+ idspace[Xthrowing].val := trueref;
+ exit(xeval)
+ end (* throw *);
+
+ Handler CtlC; (* ------- handle runaway aborts ------- *)
+
+ begin
+ write('^C');
+ IOKeyClear;
+ IObeep;
+ if initphase > 1 then Xthrow;
+ end;
+
+ (********************************************************)
+ (* *)
+ (* item selectors & constructors *)
+ (* *)
+ (********************************************************)
+
+
+FUNCTION tag_of(item: itemref): itemtype;
+
+ BEGIN (* tag_of *)
+ tag_of := item.tag;
+ END;
+ (* tag_of *)
+
+FUNCTION info_of(item: itemref): integer;
+
+ BEGIN (* info_of *)
+ info_of := item.info
+ END;
+ (* info_of *)
+
+PROCEDURE mkitem(tag: itemtype; info: longint; VAR item: itemref);
+ (* do range checking on info. ints run from -4096 to +4095 *)
+ (* everything else runs from 0 to 8191. ints & chars *)
+ (* contain their info, all others points into an *)
+ (* appropriate space. *)
+
+ PROCEDURE mkfixint;
+ BEGIN (* mkfixint *)
+ IF freeint < maxintsp THEN (* convert to fixnum *)
+ BEGIN
+ tag := fixtag;
+ intspace[freeint] := info;
+ info := freeint; (* since we want the pointer *)
+ freeint := freeint + 1;
+ END
+ ELSE BEGIN
+ writeln('*****FIXNUM SPACE EXHAUSTED');
+ (* should do gc *)
+ exit(pas0);
+ END;
+ END;
+ (* mkfixint *)
+
+
+ BEGIN (* mkitem *)
+ IF tag = inttag THEN
+ BEGIN
+ IF (info < -int_offset) OR (info > int_offset - 1) THEN mkfixint
+ END
+ ELSE IF tag = fixtag THEN mkfixint
+
+ ELSE IF info < 0 THEN
+ BEGIN
+ writeln('*****MKITEM: BAD NEG');
+ exit(pas0);
+ END;
+ (* nothing special to do for other types *)
+
+ (* pack tag and info into 16-bit item. *)
+ item.tag := tag;
+ item.info := info
+ END;
+ (* mkitem *)
+
+PROCEDURE set_info(VAR item: itemref; newinfo: longint);
+ BEGIN (* set_info *)
+ mkitem(tag_of(item), newinfo, item)
+ END;
+ (* set_info *)
+
+PROCEDURE set_tag(VAR item: itemref; newtag: itemtype);
+ BEGIN (* set_tag *)
+ mkitem(newtag, info_of(item), item)
+ END;
+ (* set_tag *)
+
+PROCEDURE mkident(id: integer; reg: integer);
+ (* make identifier "id" in register "reg" *)
+ BEGIN (* mkident *)
+ mkitem(idtag, id, r[reg]);
+ END;
+ (* mkident *)
+
+PROCEDURE mkint(int: longint; reg: integer);
+ BEGIN (* mkint *)
+ mkitem(inttag, int, r[reg]);
+ END;
+ (* mkint *)
+
+PROCEDURE mkpair(pr: integer; reg: integer);
+ BEGIN (* mkpair *)
+ mkitem(pairtag, pr, r[reg])
+ END;
+ (* mkpair *)
+
+PROCEDURE int_val(item: itemref; VAR number: longint);
+ (* returns integer value of item (int or fixnum). *)
+ (* must return 'number' in var parameter instead *)
+ (* of function value since long integers are not *)
+ (* a legal function type in ucsd pascal. *)
+ BEGIN (* int_val *)
+ IF tag_of(item) = inttag THEN
+ number := info_of(item)
+ ELSE IF tag_of(item) = fixtag THEN
+ number := intspace[info_of(item)]
+ ELSE writeln('***** ILLEGAL DATA TYPE FOR NUMERIC OPERATION')
+ (* halt or fatal error *)
+ END;
+ (* int_val *)
+
+
+ (********************************************************)
+ (* *)
+ (* stack allocation *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE alloc(n: integer);
+ BEGIN
+ IF n + st <= stksize THEN
+ st := n+st
+ ELSE
+ BEGIN
+ writeln('*****LISP STACK OVERFLOW');
+ writeln(' TRIED TO ALLOCATE ',n);
+ writeln(' CURRENT STACK TOP IS ',st);
+ END;
+ END;
+
+PROCEDURE dealloc(n: integer);
+ BEGIN
+ IF st - n >= 0 THEN
+ st := st - n
+ ELSE
+ writeln('*****LISP STACK UNDERFLOW');
+ END;
+
+ (* optimized allocs *)
+
+PROCEDURE alloc1;
+ BEGIN alloc(1) END;
+
+PROCEDURE dealloc1;
+ BEGIN dealloc(1) END;
+
+PROCEDURE alloc2;
+ BEGIN alloc(2) END;
+
+PROCEDURE dealloc2;
+ BEGIN dealloc(2) END;
+
+PROCEDURE alloc3;
+ BEGIN alloc(3) END;
+
+PROCEDURE dealloc3;
+ BEGIN dealloc(3) END;
+
+
+ (********************************************************)
+ (* *)
+ (* support for register model *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE load(reg: integer; sloc: integer);
+ BEGIN
+ IF sloc < 0 THEN r[reg] := r[-sloc]
+ ELSE r[reg] := stk[st-sloc];
+ (* will, fix for load (pos,pos) *)
+ END;
+
+PROCEDURE store(reg: integer; sloc: integer);
+ BEGIN
+ stk[st-sloc] := r[reg];
+ END;
+
+ (* optimized load/store. *)
+PROCEDURE load10;
+ BEGIN
+ load(1,0);
+ END;
+
+PROCEDURE store10;
+ BEGIN
+ store(1,0);
+ END;
+
+PROCEDURE storenil(sloc: integer);
+ BEGIN
+ stk[st-sloc] := nilref;
+ END;
+
+(* Other primitives ?? *)
+
+ (********************************************************)
+ (* *)
+ (* identifier lookup & entry *)
+ (* *)
+ (********************************************************)
+
+function nmhash(nm: stringp): integer;
+ CONST
+ hashc = 256;
+ VAR
+ i,tmp: integer;
+ BEGIN
+ tmp := 0;
+ i := 1; (* get hash code from first three chars of string. *)
+ WHILE (i <= 3) AND (strspace[nm+i] <> eos) DO
+ BEGIN
+ tmp := ord(strspace[nm+i]) + hashc*tmp;
+ i := i + 1;
+ END;
+ nmhash := abs(tmp) MOD hidmax; (* abs because mod is screwy. *)
+ END;
+
+FUNCTION eqstr(s1,s2: stringp): boolean;
+ BEGIN
+ WHILE (strspace[s1] = strspace[s2]) AND (strspace[s1] <> eos) DO
+ BEGIN
+ s1 := s1 + 1;
+ s2 := s2 + 1;
+ END;
+ eqstr := (strspace[s1] = strspace[s2]);
+ END;
+
+PROCEDURE nmlookup(nm: stringp; VAR found: boolean; VAR hash: integer;
+ VAR loc: itemref);
+ (* lookup a name in "identifier space". *)
+ (* "hash" returns the hash value for the name. *)
+ (* "loc" returns the location in the space for the (possibly new) *)
+ (* identifier. *)
+ BEGIN
+ hash := nmhash(nm);
+ mkitem(idtag, idhead[hash], loc);
+ (* default is identifier, but may be "error". *)
+ (* start at appropriate hash chain. *)
+
+ found := false;
+ WHILE (info_of(loc) <> nillnk) AND (NOT found) DO
+ BEGIN
+ found := eqstr(nm, idspace[info_of(loc)].idname);
+ IF NOT found THEN
+ set_info(loc, idspace[info_of(loc)].idhlink);
+ (* next id in chain *)
+ END;
+ IF NOT found THEN (* find spot for new identifier *)
+ BEGIN
+ IF freeident=nillnk THEN (* no more free identifiers. *)
+ mkitem(errtag, noidspace, loc)
+ ELSE
+ BEGIN
+ set_info(loc, freeident);
+ freeident := idspace[freeident].idhlink;
+ END;
+ END;
+ END;
+
+PROCEDURE putnm(nm: stringp; VAR z: itemref; VAR found: boolean);
+ (* put a new name into identifier space, or return old location *)
+ (* if it's already there. *)
+ VAR
+ tmp: ident;
+ hash: integer;
+ BEGIN
+ nmlookup(nm, found, hash, z);
+ IF (NOT found) AND (tag_of(z) = idtag) THEN
+ BEGIN
+ tmp.idname := nm;
+ tmp.idhlink := idhead[hash]; (* put new ident at head of chain *)
+ tmp.val := nilref; (* initialize value and property list *)
+ tmp.plist := nilref;
+ tmp.funcell := nilref; (* also, the function cell *)
+ idhead[hash] := info_of(z);
+ idspace[info_of(z)] := tmp;
+ END;
+ END;
+
+PROCEDURE xfaststat;
+ (* give quick summary of statistics gathered *)
+ BEGIN
+ writeln('CONSES:',consknt);
+ writeln('ST :',st);
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* the garbage collector *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xgcollect;
+ VAR
+ i: integer;
+ markedk: integer; (* counts the number of pairs marked *)
+ freedk: integer; (* counts the number of pairs freed. *)
+ gcstkp: 0..maxgcstk; (* note the garbage collection stack *)
+ mxgcstk: 0..maxgcstk; (* is local to this procedure. *)
+ gcstk: ARRAY[1..maxgcstk] OF integer;
+ markflag: PACKED ARRAY[1..maxpair] OF boolean;
+(* used not to have array here *)
+
+ PROCEDURE pushref(pr: itemref);
+ (* push the address of an unmarked pair, if that's what it is. *)
+ BEGIN
+ IF tag_of(pr) = pairtag THEN
+ IF NOT markflag[info_of(pr)] THEN (* was .markflag *)
+ BEGIN
+ IF gcstkp < maxgcstk THEN
+ BEGIN
+ gcstkp := gcstkp + 1;
+ gcstk[gcstkp] := info_of(pr);
+ IF gcstkp > mxgcstk THEN
+ mxgcstk := gcstkp;
+ END
+ ELSE
+ BEGIN
+ writeln('*****GARBAGE STACK OVERFLOW');
+ exit(pas0);
+ END;
+ END;
+ END;
+
+ PROCEDURE mark;
+ (* "recursively" mark pairs referred to from gcstk. gcstk is used to *)
+ (* simulate recursion. *)
+ VAR
+ prloc: integer;
+ BEGIN
+ WHILE gcstkp > 0 DO
+ BEGIN
+ prloc := gcstk[gcstkp];
+ gcstkp := gcstkp - 1;
+ markflag[prloc] := true;
+(* OLD prspace[prloc].markflag := true; *)
+ pushref(prspace[prloc].prcdr);
+ pushref(prspace[prloc].prcar); (* trace the car first. *)
+ END;
+ END;
+
+ BEGIN (* xgcollect *)
+ writeln('***GARBAGE COLLECTOR CALLED');
+ gccount := gccount + 1; (* count garbage collections. *)
+ xfaststat; (* give summary of statistics collected *)
+ consknt := 0; (* clear out the cons counter *)
+ gcstkp := 0; (* initialize the garbage stack pointer. *)
+ mxgcstk := 0; (* keeps track of max stack depth. *)
+
+ (* clear markflags *)
+ FOR i := 1 TO maxpair DO markflag[i] := false;
+ (* OLD: wasnt needed *)
+ (* mark things from the "computation" stack. *)
+ FOR i := 1 TO st DO
+ BEGIN
+ pushref(stk[i]);
+ mark;
+ END;
+ (* mark things from identifier space. *)
+ FOR i := 1 TO maxident DO
+ BEGIN
+ pushref(idspace[i].val);
+ mark;
+ pushref(idspace[i].plist);
+ mark;
+ pushref(idspace[i].funcell);
+ mark;
+ END;
+
+ (* reconstruct free list by adding things to the head. *)
+ freedk := 0;
+ markedk := 0;
+ FOR i:= 1 TO maxpair - 1 DO
+ BEGIN
+ IF markflag[i] THEN
+ (* OLD: IF prspace[i].markflag THEN *)
+ BEGIN
+ markedk := markedk + 1;
+ markflag[i] := false
+ (* OLD: prspace[i].markflag := false *)
+ END
+ ELSE
+ BEGIN
+ prspace[i].prcar := nilref;
+ mkitem(pairtag, freepair, prspace[i].prcdr);
+ freepair := i;
+ freedk := freedk + 1
+ END
+ END;
+ writeln(freedk,' PAIRS FREED.');
+ writeln(markedk,' PAIRS IN USE.');
+ writeln('MAX GC STACK WAS ',mxgcstk);
+ END;
+ (* xgcollect *)
+
+ (********************************************************)
+ (* *)
+ (* lisp primitives *)
+ (* *)
+ (********************************************************)
+
+ (* return r[1].r[2] in r[1] *)
+PROCEDURE xcons;
+ VAR p: integer;
+
+ BEGIN
+ (* push args onto stack, in case we need to garbage collect the *)
+ (* references will be detected. *)
+ alloc(2);
+ stk[st] := r[1];
+ stk[st-1] := r[2];
+
+ IF prspace[freepair].prcdr = nilref THEN xgcollect;
+
+ p := freepair;
+ freepair := info_of(prspace[p].prcdr);
+ prspace[p].prcar := stk[st];
+ prspace[p].prcdr := stk[st - 1];
+ mkpair(p, 1); (* leave r[1] pointing at new pair. *)
+
+ consknt := consknt + 1;
+ dealloc(2);
+ END;
+
+PROCEDURE xncons;
+ BEGIN r[2] := nilref;
+ xcons;
+ END;
+
+PROCEDURE xxcons;
+ BEGIN rxx := r[1];
+ r[1] := r[2];
+ r[2] := rxx;
+ xcons;
+ END;
+
+ (* return car of r[1] in r[1] *)
+PROCEDURE xcar;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcar
+ ELSE
+ mkitem(errtag, notpair, r[1]);
+ END;
+
+PROCEDURE xcdr;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcdr
+ ELSE
+ mkitem(errtag, notpair, r[1]);
+ END;
+
+PROCEDURE xrplaca;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ prspace[info_of(r[1])].prcar:=r[2]
+ ELSE
+ mkitem(errtag, notpair, r[1]);
+ END;
+
+PROCEDURE xrplacd;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ prspace[info_of(r[1])].prcdr :=r[2]
+ ELSE
+ mkitem(errtag, notpair, r[1]);
+ END;
+
+ (* anyreg car and cdr *)
+PROCEDURE anycar(VAR a, b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcar
+ ELSE
+ mkitem(errtag, notpair, b);
+ END;
+
+PROCEDURE anycdr(VAR a, b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcdr
+ ELSE
+ mkitem(errtag, notpair, b);
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* compress & explode *)
+ (* *)
+ (********************************************************)
+PROCEDURE compress; (* returns new id from list of chars *)
+ VAR i: stringp;
+ clist, c: itemref;
+ found: boolean;
+ int: integer;
+
+ FUNCTION is_int(i: stringp; VAR int: longint): boolean;
+ VAR negative, could_be: boolean;
+
+ BEGIN (* is_int *)
+ int := 0;
+ could_be := true;
+ negative := strspace[i] = '-';
+ IF negative OR (strspace[i] = '+') THEN i := i + 1;
+
+ WHILE could_be AND (strspace[i] <> eos) DO
+ BEGIN
+ IF (strspace[i] >= '0') AND (strspace[i] <= '9') THEN
+ int := int * 10 + (ord(strspace[i]) - ord('0'))
+ ELSE could_be := false;
+ i := i + 1
+ END;
+
+ IF negative THEN int := -int;
+ is_int := could_be
+ END (* is_int *);
+
+ BEGIN (* compress *)
+ clist := r[1]; (* list of chars *)
+ i := freestr; (* point to possible new string *)
+
+ WHILE (i < maxstrsp) AND (clist <> nilref) DO
+ BEGIN
+ IF tag_of(clist) = PAIRTAG THEN
+ BEGIN
+ c := prspace[info_of(clist)].prcar;
+ clist := prspace[info_of(clist)].prcdr;
+ IF tag_of(c) = IDTAG THEN
+ IF (info_of(c) > choffset) AND
+ (info_of(c) < choffset + 128) THEN
+ BEGIN
+ strspace[i] := chr(info_of(c) - choffset);
+ i := i + 1
+ END
+ ELSE
+ writeln('*****COMPRESS: LIST ID NOT SINGLE CHAR')
+ ELSE
+ writeln('*****COMPRESS: LIST ITEM NOT ID');
+ END
+ ELSE
+ writeln('*****COMPRESS: ITEM NOT LIST')
+ END (* WHILE *);
+
+ strspace[i] := eos; (* terminate string *)
+
+ IF (i >= maxstrsp) THEN
+ writeln('*****STRING SPACE EXHAUSTED')
+ ELSE IF is_int(freestr, int) THEN
+ mkint(int, 1)
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END
+ END (* compress *);
+
+PROCEDURE explode; (* returns list of chars from id or int *)
+
+ FUNCTION id_explode(i: stringp): itemref;
+ BEGIN (* id_explode *)
+ IF strspace[i] = eos THEN id_explode := nilref
+ ELSE
+ BEGIN
+ r[2] := id_explode(i + 1);
+ mkident(ord(strspace[i]) + choffset, 1);
+ xcons;
+ id_explode := r[1]
+ END
+ END (* id_explode *);
+
+ FUNCTION int_explode(i: integer): itemref;
+ VAR negative: boolean;
+
+ BEGIN (* int_explode *)
+ r[1] := nilref;
+ IF i < 0 THEN
+ BEGIN negative := true;
+ i := -i
+ END
+ ELSE negative := false;
+
+ WHILE i > 0 DO
+ BEGIN
+ r[2] := r[1];
+ mkident(i MOD 10 + ord('0') + choffset, 1);
+ xcons;
+ i := i DIV 10
+ END;
+
+ IF negative THEN
+ BEGIN
+ r[2] := r[1];
+ mkident(ord('-') + choffset, 1);
+ xcons
+ END;
+ int_explode := r[1]
+ END (* int_explode *);
+
+ BEGIN (* explode *)
+ IF tag_of(r[1]) = IDTAG THEN
+ r[1] := id_explode(idspace[info_of(r[1])].idname)
+ ELSE IF tag_of(r[1]) = INTTAG THEN
+ r[1] := int_explode(info_of(r[1]))
+ ELSE IF tag_of(r[1]) = FIXTAG THEN
+ r[1] := int_explode(intspace[info_of(r[1])])
+ ELSE
+ writeln('***** EXPLODE: ARG BAD TYPE')
+ END (* explode *);
+
+
+ (********************************************************)
+ (* *)
+ (* i/o primitives *)
+ (* *)
+ (********************************************************)
+
+procedure xopen;
+
+var s1: string; i,j : integer;
+
+ handler ResetError(name: PathName);
+ begin
+ writeln('**** Could not open file - ',name,' for read');
+ exit(xopen);
+ end;
+
+ handler RewriteError(name: PathName);
+ begin
+ writeln('**** Could not open file - ',name,' for write');
+ exit(xopen);
+ end;
+
+begin
+ IF tag_of(r[1]) = IDTAG THEN
+ begin
+ i := idspace[info_of(r[1])].idname;
+ s1[0] := chr(255);
+ j:= 0;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos) do
+ begin
+ j:= j + 1;
+ s1[j] := strspace[i];
+ i:= i + 1;
+ end;
+ s1[0]:= chr(j);
+
+ IF tag_of(r[2]) = IDTAG THEN
+ case strspace[idspace[info_of(r[2])].idname] of
+ 'i', 'I': begin reset(finput,s1); mkint(3,1) end;
+ 'o', 'O': begin rewrite(foutput,s1); mkint(4,1) end;
+ otherwise: writeln('**** OPEN: ARG2 NOT INPUT/OUTPUT');
+ end else writeln('**** OPEN: ARG2 BAD TYPE')
+ end else writeln('**** OPEN: ARG1 BAD TYPE');
+end;
+
+procedure xclose;
+
+begin
+ case info_of(r[1]) of
+ 1,2: ;
+ 3: close(finput);
+ 4: close(foutput);
+ end;
+end;
+
+PROCEDURE xrds;
+ (* Select channel for input *)
+ VAR tmp:longint;
+ BEGIN
+ tmp:=inchnl;
+ inchnl := info_of(r[1]);
+ mkint(tmp,1)
+ END;
+
+PROCEDURE xwrs;
+ (* Select channel for output *)
+ VAR tmp:longint;
+ BEGIN
+ tmp:=outchnl;
+ outchnl := info_of(r[1]);
+ mkint(tmp,1)
+ END;
+
+PROCEDURE xterpri;
+(* need to change for multiple output channels. *)
+ BEGIN
+ case outchnl of
+ 1: writeln(' ');
+
+ 2: writeln(foutput,' ')
+ end;
+ END;
+
+
+PROCEDURE xwrtok;
+ (* doesn't expand escaped characters in identifier names *)
+ VAR
+ temp_real: real; (* KLUDGE: for bug *)
+ i: integer;
+ BEGIN
+ case outchnl of
+ 1: BEGIN
+ IF tag_of(r[1]) = inttag THEN
+ BEGIN
+ IF info_of(r[1]) = 0 THEN
+ write('0')
+ ELSE
+ write(' ', info_of(r[1]):0);
+ END
+
+ ELSE IF tag_of(r[1]) = fixtag THEN
+ write(intspace[info_of(r[1])])
+
+ ELSE IF tag_of(r[1]) = flotag THEN
+ BEGIN temp_real:= flospace[info_of(r[1])];
+ write( '* Real number bug *', trunc (temp_real))
+ END
+ ELSE IF tag_of(r[1]) = idtag THEN
+ BEGIN
+ i := idspace[info_of(r[1])].idname;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos) DO
+ BEGIN
+ write(strspace[i]);
+ i:= i + 1;
+ END;
+ END
+
+ ELSE IF tag_of(r[1]) = chartag THEN
+ write(chr(info_of(r[1]) - choffset))
+
+ ELSE IF tag_of(r[1]) = errtag THEN
+ writeln(' *** Error # ', ' ',info_of(r[1]):0)
+ ELSE IF tag_of(r[1]) = codetag THEN
+ write(' ## ',' ', info_of(r[1]):0)
+
+ ELSE write(' ? ',' ' ,tag_of(r[1]):0,' / ' ,info_of(r[1]):0,' ? ');
+ END;
+
+ 4: BEGIN
+ IF tag_of(r[1]) = inttag THEN
+ BEGIN
+ IF info_of(r[1]) = 0 THEN
+ write(foutput,'0')
+ ELSE
+ write(foutput,' ', info_of(r[1]):0);
+ END
+
+ ELSE IF tag_of(r[1]) = fixtag THEN
+ write(foutput,intspace[info_of(r[1])])
+
+ ELSE IF tag_of(r[1]) = flotag THEN
+ BEGIN temp_real:= flospace[info_of(r[1])];
+ write(foutput, '* Real number bug *', trunc (temp_real))
+ END
+ ELSE IF tag_of(r[1]) = idtag THEN
+ BEGIN
+ i := idspace[info_of(r[1])].idname;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos) DO
+ BEGIN
+ write(foutput,strspace[i]);
+ i:= i + 1;
+ END;
+ END
+
+ ELSE IF tag_of(r[1]) = chartag THEN
+ write(foutput,chr(info_of(r[1]) - choffset))
+
+ ELSE IF tag_of(r[1]) = errtag THEN
+ writeln(foutput,' *** Error # ', ' ',info_of(r[1]):0)
+ ELSE IF tag_of(r[1]) = codetag THEN
+ write(foutput,' ## ',' ', info_of(r[1]):0)
+
+ ELSE write(foutput,' ? ',' ' ,tag_of(r[1]):0,' / ' ,info_of(r[1]):0,' ? ');
+ END;
+ END; (*case*)
+ end; (*wrtoken*)
+
+
+PROCEDURE rdchnl(chnlnum: integer; VAR ch: onechar);
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ writeln('*****BAD INPUT CHANNEL FOR RDCHNL',chnlnum)
+ ELSE
+ CASE chnlnum OF
+ 1: BEGIN
+ ch := symin^; (* a little strange, but avoids *)
+ get(symin); (* initialization problems *)
+ ichrbuf[inchnl] := symin^; (* Peek ahead *)
+ END;
+
+ 2: BEGIN
+ ch := input^;
+ get(input);
+ ichrbuf[inchnl] := input^;
+ END;
+
+ 3: BEGIN
+ ch := finput^;
+ get(finput);
+ ichrbuf[inchnl] := finput^;
+ END;
+
+ END;
+ (* case *)
+ END;
+ (* rdchnl *)
+
+FUNCTION eofchnl: boolean;
+ BEGIN
+ CASE inchnl OF
+ 1: eofchnl := eof(symin);
+ 2: eofchnl := eof(input);
+ 3: eofchnl := eof(finput);
+ END;
+ END;
+
+
+ FUNCTION eol: boolean;
+ BEGIN
+ CASE inchnl OF
+ 1: eol := eoln(symin);
+ 2: eol := eoln(input);
+ 3: eol := eoln(finput);
+ END;
+ END;
+
+ (********************************************************)
+ (* *)
+ (* token scanner *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xrdtok;
+LABEL 1;
+
+ VAR
+ ch,ch1,ChangedCh: onechar;
+ i: integer;
+ anint: longint;
+ moreid: boolean;
+ found: boolean;
+
+ FUNCTION digit(ch: onechar): boolean;
+ BEGIN
+ digit := ( '0' <= ch ) AND ( ch <= '9');
+ END;
+
+
+ FUNCTION escalpha(VAR ch: onechar): boolean;
+ (* test for alphabetic or escaped character. *)
+ (* note side effect in ChangedCh. *)
+ BEGIN
+ ChangedCh := Ch;
+ IF ( 'A' <= ch ) AND ( ch <= 'Z') THEN
+ escalpha := true
+ ELSE IF ( ord('A')+32 <= ord(ch)) AND ( ord(ch) <= ord('Z')+32) THEN
+ BEGIN
+ IF idspace[xraise].val=trueref
+ THEN Changedch := chr(ord(ch)-32);
+ escalpha := true; (* lower case alphabetics *)
+ END
+ ELSE IF ch='!' THEN
+ BEGIN
+ rdchnl(inchnl,ch);
+ ChangedCh:=Ch;
+ escalpha := true;
+ END
+ ELSE
+ escalpha := false;
+ END;
+
+ FUNCTION alphanum(VAR ch: onechar): boolean;
+ (* test if escalfa or digit *)
+ VAR b: boolean;
+ BEGIN
+ ChangedCh:=Ch;
+ b := digit(ch);
+ IF NOT b THEN b := escalpha(ch);
+ alphanum := b;
+ END;
+
+ FUNCTION whitesp(ch: onechar): boolean;
+ VAR ascode:integer
+ BEGIN
+ ascode:=ord(ch);
+ WHITESP := (CH = SP) OR (ascode = CR) OR (ascode = LF)
+ OR (ascode = ht) or (ascode = nul); (* null?? *)
+ END;
+
+ (* reads fixnums...need to read flonums too *)
+
+ var negflag : integer;
+ BEGIN (* xrdtok *)
+1:
+ IF NOT eofchnl THEN
+ REPEAT (* skip leading white space. *)
+ rdchnl(inchnl,ch)
+ UNTIL (NOT whitesp(ch)) OR eofchnl;
+ IF eofchnl THEN
+ mkitem(chartag, eofcode + choffset, r[1])
+ (* should really return !$eof!$ *)
+ ELSE
+ BEGIN
+ IF digit(ch) or (ch = '-') THEN
+ set_tag(r[1], inttag)
+ ELSE IF escalpha(ch) THEN
+ set_tag(r[1], idtag)
+ ELSE
+ set_tag(r[1], chartag);
+
+ CASE tag_of(r[1]) OF
+ chartag: BEGIN
+ if ch = begin_comment then
+ BEGIN
+ while not eol do rdchnl(inchnl, ch);
+ (*REPEAT rdchnl(inchnl, ch)*)
+ (*UNTIL eol; (of selected input *)
+ rdchnl(inchnl, ch);
+ GOTO 1
+ END;
+ set_tag(r[1], idtag);
+ mkitem(inttag, chartype, idspace[xtoktype].val);
+ set_info(r[1], ord(ch) + choffset);
+ END;
+ inttag: BEGIN
+ mkitem(inttag, inttype, idspace[xtoktype].val);
+ negflag := 1;
+ if ch = '-' then
+ begin
+ anint := 0;
+ negflag := -1
+ end else
+ anint := ord(ch) - ord('0');
+ WHILE digit(ichrbuf[inchnl]) DO
+ BEGIN
+ rdchnl(inchnl,ch);
+ anint := 10 * anint + (ord(ch) - ord('0'))
+ END;
+ anint := anint * negflag;
+ set_info(r[1], anint)
+ END;
+ idtag: BEGIN
+ mkitem(inttag, idtype, idspace[xtoktype].val);
+ i := freestr; (* point to possible new string *)
+ moreid := true;
+ WHILE (i < maxstrsp) AND moreid DO
+ BEGIN
+ strspace[i] := ChangedCh; (* May have Case Change, etc *)
+ i:= i + 1;
+ moreid :=alphanum(ichrbuf[inchnl]); (* PEEK ahead char *)
+ IF moreid THEN rdchnl(inchnl,ch) (* Advance readch *)
+ END;
+ strspace[i] := eos; (* terminate string *)
+ IF (i >= maxstrsp) THEN
+ writeln('*****STRING SPACE EXHAUSTED')
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END;
+ END;
+ (* of case idtag *)
+ END;
+ (* of case *)
+ END;
+ END;
+ (* xrdtok *)
+ (* for DEBUG *)
+ (********************************************************)
+ (* *)
+ (* initialization *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE init;
+ (* initialization procedure depends on *)
+ (* ability to load stack with constants *)
+ (* from a file. *)
+ VAR
+ strptr: stringp;
+ nam: PACKED ARRAY[1..3] OF onechar;
+ (* holds 'nil', other strings? *)
+ i, n: integer;
+ idref: itemref;
+ found: boolean;
+
+ (* init is divided into two parts so it can compile on terak *)
+ PROCEDURE init1;
+ BEGIN
+
+ (* initialize top of stack *)
+ st := 0;
+
+ freefloat := 1;
+ freeint := 1;
+
+ (* define nilref - the id, nil, is defined a little later. *)
+ freeident := 1;
+ mkitem(idtag, freeident, nilref);
+
+ (* initialize pair space. *)
+ FOR i := 1 TO maxpair - 1 DO (* initialize free list. *)
+ BEGIN
+ (* OLD: prspace[i].MarkFlag := false; *)
+ prspace[i].prcar := nilref; (* just for fun *)
+ mkitem(pairtag, i + 1, prspace[i].prcdr);
+ END;
+ prspace[maxpair].prcar := nilref;
+ prspace[maxpair].prcdr := nilref; (* end flag *)
+ freepair := 1; (* point to first free pair *)
+
+
+ (* initialize identifier space and string space. *)
+ freestr := 1;
+ FOR i := 0 TO hidmax - 1 DO
+ idhead[i] := nillnk;
+ FOR i := 1 TO maxident DO
+ BEGIN
+ IF i < maxident THEN
+ idspace[i].idhlink := i + 1
+ ELSE (* nil to mark the final identifier in the table. *)
+ idspace[i].idhlink := nillnk;
+ (* set function cells to undefined *)
+ mkitem(errtag, undefined, idspace[i].funcell);
+ mkitem(errtag, undefined, idspace[i].val);
+ mkitem(errtag, undefined, idspace[i].plist);
+
+ END;
+
+ (* nil must be the first identifier in the table--id #1 *)
+ (* must fill in fields by hand for nilref.*)
+ (* putnm can handle any later additions. *)
+ nam := 'NIL';
+ strptr := freestr;
+ FOR i := 1 TO 3 DO
+ BEGIN
+ strspace[strptr] := nam[i];
+ strptr:= strptr + 1;
+ END;
+ strspace[strptr] := eos;
+ putnm(freestr, nilref, found);
+ IF NOT found THEN
+ freestr := strptr + 1;
+
+ (* make the single character ascii identifiers, except nul(=eos). *)
+ FOR i := 1 TO 127 DO
+ BEGIN
+ strspace[freestr] := chr(i);
+ strspace[freestr + 1] := eos;
+ putnm(freestr, idref, found);
+ IF NOT found THEN
+ freestr := freestr + 2;
+ IF i = ord('T') THEN
+ trueref := idref;
+ (* returns location for 't. *)
+ END;
+
+ (* clear the counters *)
+ idspace[xraise].val := trueref;
+ gccount := 0;
+ consknt := 0;
+ END;
+ (* init1 *)
+
+ PROCEDURE init2;
+ BEGIN
+ (* load "symbol table" with identifiers, constants, and functions. *)
+ inchnl := 1; (* select symbol input file. *)
+ outchnl := 1; (* select standard output file. *)
+ reset(symin,'paslsp.ini');
+ reset(input);
+ rewrite(output);
+ xrdtok; (* get count of identifiers. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED AT START');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ xrdtok;
+ (* reading token magically loads it into id space. *)
+ xrdtok; (* look for zero terminator. *)
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER IDENTIFIERS');
+
+ xrdtok; (* count of constants *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE CONSTANTS');
+ n := info_of(r[1]);
+ alloc(n); (* space for constants on the stack *)
+ FOR i := 1 TO n DO
+ BEGIN
+ xread;
+ stk[i] := r[1];
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER CONSTANTS');
+
+ xrdtok; (* count of functions. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE FUNCTIONS');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ (* for each function *)
+ (* store associated code *)
+ BEGIN
+ xrdtok;
+ mkitem(codetag, i, idspace[info_of(r[1])].funcell);
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER FUNCTIONS');
+
+ END;
+ (* init2 *)
+ BEGIN (* init *)
+ init1;
+ init2;
+ END;
+ (* init *)
+
+ (********************************************************)
+ (* *)
+ (* arithmetic functions *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xadd1;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(i + 1, 1)
+ END;
+
+PROCEDURE xdifference;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 - i2, 1)
+ END;
+
+PROCEDURE xdivide; (* returns dotted pair (quotient . remainder). *)
+ VAR quot, rem: integer;
+ i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ mkint(i1 DIV i2, 1);
+ mkint(i1 MOD i2, 2);
+ xcons
+ END;
+
+PROCEDURE xgreaterp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 > i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xlessp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 < i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xminus;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(-i, 1)
+ END;
+
+PROCEDURE xplus2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 + i2, 1)
+ END;
+
+PROCEDURE xquotient;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 DIV i2, 1)
+ END;
+
+PROCEDURE xremainder;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 MOD i2, 1)
+ END;
+
+PROCEDURE xtimes2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 * i2, 1)
+ END;
+ (* xtimes2 *)
+
+
+ (********************************************************)
+ (* *)
+ (* support for eval *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE execute(code: integer);
+ FORWARD;
+
+ (* Xapply(fn,arglist)-- "fn" is an operation code. *)
+PROCEDURE xxapply;
+ VAR
+ i: integer;
+ code: integer;
+ tmp: itemref;
+ tmpreg: ARRAY[1..maxreg] OF itemref;
+ BEGIN
+ code := info_of(r[1]);
+ r[1] := r[2];
+ i := 1;
+ (* spread the arguments *)
+ WHILE (r[1] <> nilref) AND (i <= maxreg) DO
+ BEGIN
+ tmp := r[1];
+ xcar;
+ tmpreg[i] := r[1];
+ i := i + 1;
+ r[1] := tmp;
+ xcdr;
+ END;
+ WHILE i > 1 DO
+ BEGIN
+ i := i - 1;
+ r[i] := tmpreg[i];
+ END;
+ execute(code);
+ END;
+
ADDED perq-pascal-lisp-project/pas0.pre
Index: perq-pascal-lisp-project/pas0.pre
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas0.pre
@@ -0,0 +1,1867 @@
+#padtwv (* PreProcessor Version - Run through Filter *)
+#p (* PERQ version *)
+#a (* Apollo Version *)
+#d (* DEC-20 Version *)
+#t (* Terak Version *)
+#w (* Wicat Version *)
+#v (* VAX version *)
+(*********************************************************************
+
+ PASCAL BASED MINI-LISP
+
+ File: PAS0.PAS - PASCAL/LISP KERNEL
+ ChangeHistory:
+ 3 Mar 82 RO: Apollo version finished, some changes for WICAT
+ 16 Feb 82 RO: Implement !*ECHO
+ 11 Feb 82 RO: Allow string as alias for identifier
+ 8 Feb 82 RO: Fix GC bug & clean up for apollo
+ 19 Jan 82 RO: Change I/O channel assginments
+ 29 Dec 81 RO: File I/O for apollo & wicat
+ 23 Dec 81 RO: More changes for Apollo & Wicat
+ 9 Dec 81, RO: Remove apollo specific I/O.
+ 1 Dec 81 RO: I/O fixes for wicat & fixnum bug
+ 14 Nov 81, MLG:add some PERQ updates from Voelker
+ 28 Oct 81, RO: GENSYM & fixnum gc
+
+ All RIGHTS RESERVED
+ COPYRIGHT (C) - 1981 - M. L. Griss and R. Ottenheimer
+ Computer Science Department
+ University of Utah
+
+ Do Not distribute with out written consent of M. L. Griss
+
+********************************************************************)
+
+#t (*$S+*) (* swapping mode *)
+#t (*$G+*) (* goto is legal *)
+
+#adtvw PROGRAM pas0 ; (* (input*,output) *)
+#p PROGRAM pas0 (input,output, symin, finput,foutput);
+ (************************************************************)
+ (* support routines for a "lisp" machine. uses a register *)
+ (* model with a stack for holding frames. stack also used *)
+ (* to hold compiler generated constants. *)
+ (* written by: *)
+ (* william f. galway, martin l. griss *)
+ (* ralph ottenheimer *)
+ (* append pas1...pasn at end *)
+ (* -------------------------------------------------------- *)
+
+ (* I/O channel assignments:
+ 1: symin, used to init symbol table
+ 2: stdin,
+ 3: stdout,
+ 4: finput,
+ 5: foutput.
+ *)
+
+ (************************************************************)
+#a (* Apollo System include files *)
+#a %include '/sys/ins/base.ins.pas';
+#a %include '/sys/ins/pgm.ins.pas';
+
+
+#p imports Stream from Stream;
+#p imports system from system;
+#p imports io_others from io_others;
+#p imports io_unit from io_unit;
+
+ (************************************************************)
+
+CONST
+#aptv (* for terak, perq, Apollo, vax *)
+#aptvw sp = ' ';
+#aptvw ht = 9; (* ascii codes *)
+#aptvw lf = 10;
+#aptvw cr = 13;
+#aptvw nul = 0;
+
+#d eos = nul; (* terminator character for strings. *)
+#t (* use eos=chr(nul) *)
+#av eos=chr(nul) ;
+#pw eos = chr(0); (* KLUDGE: null string *)
+#adtwpv inchns = 5; (* number of input channels. *)
+#adtwpv outchns = 5; (* number of output channels. *)
+ begin_comment = '%';
+
+(* Initial symbols, needed in Kernel *)
+ xtoktype = 129; (* slot in idspace for toktype. *)
+ xbstack = 130; (* Bstack Pointer *)
+ xthrowing = 131; (* If throw mode *)
+ xinitform = 132; (* for restart *)
+ xraise = 133; (* for RAISE of lc in ids *)
+ Xinput = 134; (* For Open *)
+ Xoutput = 135; (* For Open *)
+ xQuote = 138; (* For quoting ids in pascal code. *)
+ xEcho = 136; (* raw input is echoed if not NIL. *)
+ chartype = 3; (* various token types *)
+ inttype = 1;
+ idtype = 2;
+
+ max_gsym = 4; (* number of digits in gen'd id. *)
+
+#dt shift_const = 8192; (* tags and info are packed into an integer *)
+#a (* no shift const *)
+#p (* no shift const *)
+#w (* no shift const *)
+#dt (* assumed to be at least 16 bits long. low order 13 bits *)
+#dt (* are the info, top 3 are the tag. *)
+#dt int_offset = 4096; (* small integers are stored 0..8191 *)
+#dt (* instead of -4096..4095 because it will pack smaller *)
+#dt (* under ucsd pascal. *)
+#apw int_offset = 32767; (* Apollo, PERQ and WICAT items are records *)
+
+ (* the various tags - can't use a defined scalar type *)
+ (* because of the lack of convertion functions. *)
+ inttag = 0; (* info is an integer *)
+ chartag = 1; (* info is a character code *)
+ pairtag = 2; (* info points to pair *)
+ idtag = 3; (* info points to identifier *)
+ codetag = 4; (* info is index into a case statement *)
+ (* that calls appropriate function. *)
+ errtag = 5; (* info is an error code - see below. *)
+ fixtag = 6; (* info points to a full word (or *)
+ (* longer) integer. *)
+ strtag = 7; (* info points to a string. *)
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on a non-pair. *)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells (etc?) *)
+ noint = 5; (* no free integer space after garbage collection *)
+ notid = 6;
+
+ (* data space sizes *)
+(* remember pointers to these things are inums, sometimes quite small *)
+#av maxpair = 10000; (* max number of pairs allowed. *)
+#dpw maxpair = 3700; (* max number of pairs allowed. *)
+#t maxpair = 1000; (* max number of pairs allowed *)
+#tw maxident = 400; (* max number of identifiers *)
+#adpv maxident = 800; (* max number of identifiers *)
+#adpv maxstrsp = 4000; (* size of string (literal) storage space. *)
+ (* beware - string pointers are inums. *)
+#tw maxstrsp = 2000; (* size of string (literal) storage space. *)
+#adpv maxintsp = 200; (* max number of long integers allowed *)
+#tw maxintsp = 2; (* max number of long integers allowed *)
+
+ hidmax = 50; (* number of hash values for identifiers *)
+ maxgcstk = 100; (* size of garbage collection stack. *)
+ stksize = 500; (* stack size *)
+ maxreg = 15; (* number of registers in lisp machine. *)
+
+ eofcode = 26; (* magic character code for eof, ascii for *)
+ (* cntrl-z. kludge, see note in xrdtok. *)
+ choffset = 1; (* add choffset to ascii code to get address *)
+ (* in id space for corresponding identifier. *)
+ nillnk = 0; (* when integers are used as pointers. *)
+#dptw end_flag = maxint; (* marks end of fixnum space *)
+#a end_flag = -2147483648; (* marks end of fixnum space *)
+
+ (************************************************************)
+
+TYPE
+#w regblk_type = array[0..16] of longint;
+#d onechar = ascii; (* for DEC *)
+#aptvw onechar = char; (* for terak,perq,Apollo,Wicat*)
+#awv FileName=Packed ARRAY[0..59] of onechar;
+#p FileName: string;
+#t FileName: string[60];
+#d FileName=Packed ARRAY[1..9] of onechar;
+
+ (* note we allow zero for id_ptr, allowing a "nil" link. *)
+ stringp = 1..maxstrsp; (* pointer into string space. *)
+ id_ptr = 0..maxident; (* pointer into id space. *)
+
+#dtv itemref = integer;
+#apw itemref = RECORD
+#apw tag:integer;
+#apw info:integer;
+#apw END;
+ itemtype = 0..7; (* the tags *)
+
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ END;
+
+
+#aw ascfile = text;
+#dptv ascfile = PACKED FILE OF onechar;
+#d textfile =PACKED FILE of char;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+#dptvw longint = integer;
+#a longint = integer32;
+
+ (************************************************************)
+
+VAR
+ (* global information *)
+ nilref, trueref, tmpref: itemref;
+ (* refers to identifiers "nil", "t", and a temp to get around bug in. *)
+ (* apollo & wicat pascal *)
+ initphase: integer; (* Start up *)
+#adpvw r: ARRAY[1..maxreg] OF itemref;
+#t r: ARRAY[0..maxreg] OF itemref; (* cuts code size down *)
+ rxx,ryy: itemref;
+
+#t CHARCNT: INTEGER; (* input buffer & pointer *)
+#t LINE: STRING;
+
+ (* "st" is the stack pointer into "stk". it counts the number of *)
+ (* items on the stack, so it runs from zero while the stack starts *)
+ (* at one. *)
+ st: 0..stksize;
+ stk: ARRAY[1..stksize] OF itemref;
+
+ (* pair space *)
+ prspace: PACKED ARRAY[1..maxpair] OF pair; (* all pairs stored here. *)
+ freepair: integer; (* pointer to next free pair in prspace. *)
+
+ (* identifier space *)
+ idhead: ARRAY[0..hidmax] OF id_ptr;
+ idspace: PACKED ARRAY[1..maxident] OF ident;
+ freeident: integer;
+ g_sym: ARRAY[1..max_gsym] OF onechar;
+
+ (* string space *)
+ strspace: PACKED ARRAY[1..maxstrsp] OF onechar;
+ freestr: stringp;
+
+ (* large integer space *)
+ intspace: ARRAY[1..maxintsp] OF longint;
+ freeint: 1..maxintsp;
+
+
+ (* i/o channels *)
+#p (* files declared on header *)
+#adptvw symin: ascfile;
+#adptvw finput : ascfile;
+#aptvw foutput: ascfile;
+#d foutput: textfile;
+#d input: ascfile;
+#a IoStatus:Integer32;
+ inchnl: 1..inchns; (* current input channel number *)
+ outchnl: 1..outchns; (* current output channel number *)
+
+ (* "current character" for each input channel. *)
+ (* may want to include more than one character at some later date *)
+ (* (for more lookahead). *)
+ ichrbuf: ARRAY[1..inchns] OF onechar;
+
+ (* for collecting statistics. *)
+ gccount: integer; (* counts garbage collections *)
+ (* counts from last garbage collection. *)
+ consknt: integer; (* number of times "cons" called *)
+
+
+
+(* ........ Everything nested inside CATCH *)
+
+#w procedure _setjmp(var regblk:regblk_type);external;
+#w procedure _long_jump(var regblk:regblk_type);external;
+
+Procedure Xcatch; (* ----------- Outermost Procedure ----------- *)
+#adv LABEL 9999;
+#w (* need to use special ASM68 procedures for Wicat *)
+ var catch_stk:0..stksize;
+ catch_Bstk:itemref;
+#w Catch_regs:regblk_type;
+
+PROCEDURE xread;
+ FORWARD;
+
+PROCEDURE xprint;
+ FORWARD;
+
+PROCEDURE xunbindto;
+ FORWARD;
+
+PROCEDURE xeval;
+ FORWARD;
+
+ Procedure Xthrow;
+ begin (* throw value *)
+ idspace[Xthrowing].val := trueref;
+#dav goto 9999
+#w _long_jump(Catch_regs);
+#tp exit(xeval)
+ end (* throw *);
+#p (* Special handlers *)
+#p Handler CtlC; (* ------- handle runaway aborts ------- *)
+
+#p begin
+#p write('^C');
+#p IOKeyClear;
+#p IObeep;
+#p if initphase > 1 then Xthrow;
+#p end;
+
+ (********************************************************)
+ (* *)
+ (* item selectors & constructors *)
+ (* *)
+ (********************************************************)
+
+#a (* use some SHIFTS ? *)
+
+FUNCTION tag_of(item: itemref): itemtype;
+#t VAR gettag: PACKED RECORD
+#t CASE boolean OF
+#t TRUE: (i: itemref);
+#t FALSE: (info: 0..8191;
+#t tag: 0..7)
+#t END;
+
+ BEGIN (* tag_of *)
+#t gettag.i := item;
+#t tag_of := gettag.tag
+#dv tag_of := item DIV shift_const;
+#apw tag_of := item.tag;
+ END;
+ (* tag_of *)
+
+FUNCTION info_of(item: itemref): integer;
+#t VAR getinfo: PACKED RECORD
+#t CASE boolean OF
+#t TRUE: (i: itemref);
+#t FALSE: (info: 0..8191;
+#t tag: 0..7)
+#t END;
+
+ BEGIN (* info_of *)
+#t getinfo.i := item;
+#t if getinfo.tag = inttag then
+#t info_of := getinfo.info - int_offset
+#t else info_of := getinfo.info
+#dv IF item DIV shift_const = inttag THEN
+#dv info_of := item MOD shift_const - int_offset
+#dv ELSE
+#dv info_of := item MOD shift_const
+#apw info_of := item.info
+ END;
+ (* info_of *)
+
+FUNCTION xnull(item: itemref): boolean;
+ BEGIN
+ xnull := (tag_of(item) = tag_of(nilref)) AND
+ (info_of(item) = info_of(nilref))
+ END;
+
+
+PROCEDURE mkitem(tag: itemtype; info: longint; VAR item: itemref);
+ (* do range checking on info. ints run from -4096 to +4095 *)
+ (* everything else runs from 0 to 8191. ints & chars *)
+ (* contain their info, all others points into an *)
+ (* appropriate space. *)
+
+ PROCEDURE mkfixint;
+ VAR nextfree: integer;
+
+ PROCEDURE gc_int;
+ VAR i: integer;
+ mark_flag: PACKED ARRAY[1..maxintsp] OF boolean;
+
+
+ PROCEDURE mark(u: itemref);
+ BEGIN (* Mark *)
+ IF tag_of(u) = pairtag THEN
+ BEGIN
+ mark(prspace[info_of(u)].prcar);
+ mark(prspace[info_of(u)].prcdr)
+ END
+ ELSE IF tag_of(u) = fixtag THEN
+ mark_flag[info_of(u)] := true
+ END (* Mark *);
+
+ BEGIN (* Gc_int *)
+ writeln('*** Gc int');
+ FOR i := 1 TO maxintsp do (* clear mark flags *)
+ mark_flag[i] := false;
+
+ FOR i := 1 TO st DO (* mark from the stack *)
+ Mark(stk[i]);
+
+ FOR i := 1 TO maxident DO (* mark from the symbol table *)
+ BEGIN
+ Mark(idspace[i].val);
+ Mark(idspace[i].plist);
+ Mark(idspace[i].funcell) (* probably NOT necessary *)
+ END;
+
+ (* reconstruct free list *)
+ FOR i := 1 TO maxintsp - 1 DO
+ IF NOT mark_flag[i] THEN
+ BEGIN
+ intspace[i] := freeint;
+ freeint := i
+ END
+ END (* Gc_int *);
+
+ BEGIN (* mkfixint *)
+ IF info = end_flag THEN (* user can't use magic number *)
+ BEGIN info := 0;
+ writeln('*****Mkfixint: Info too large')
+ END;
+ IF intspace[freeint] = end_flag THEN
+ gc_int; (* garbage collect intspace *)
+
+ IF intspace[freeint] <> end_flag THEN
+ BEGIN (* convert to fixnum *)
+ tag := fixtag;
+ nextfree := intspace[freeint];
+ intspace[freeint] := info;
+ info := freeint; (* since we want the pointer *)
+ freeint := nextfree
+ END
+ ELSE
+ BEGIN mkitem(errtag, noint, r[1]);
+ writeln('***** Integer space exhausted')
+ END
+ END;
+ (* mkfixint *)
+
+
+ BEGIN (* mkitem *)
+ IF tag = inttag THEN
+#apw BEGIN
+ IF (info < -int_offset) OR (info > int_offset - 1) THEN mkfixint
+#dtv ELSE info := info + int_offset (* info was in range so add offset *)
+#apw END
+ ELSE IF tag = fixtag THEN mkfixint
+
+ ELSE IF info < 0 THEN
+ BEGIN
+ writeln('*****Mkitem: bad neg');
+#d break(output);
+#dtv halt;
+#p exit(pas0);
+#a pgm_$exit;
+ END;
+ (* nothing special to do for other types *)
+
+#dtv (* pack tag and info into 16-bit item. *)
+#dtv item := tag * shift_const + info
+#apw item.tag := tag;
+#apw item.info := info
+ END;
+ (* mkitem *)
+
+PROCEDURE mkerr(info: longint; VAR item: itemref);
+ Begin
+ mkitem(errtag,info,item);
+ End;
+
+
+PROCEDURE set_info(VAR item: itemref; newinfo: longint);
+ BEGIN (* set_info *)
+ mkitem(tag_of(item), newinfo, item)
+ END;
+ (* set_info *)
+
+PROCEDURE set_tag(VAR item: itemref; newtag: itemtype);
+ BEGIN (* set_tag *)
+ mkitem(newtag, info_of(item), item)
+ END;
+ (* set_tag *)
+
+PROCEDURE mkident(id: integer; reg: integer);
+ (* make identifier "id" in register "reg" *)
+ BEGIN (* mkident *)
+ mkitem(idtag, id, r[reg]);
+ END;
+ (* mkident *)
+
+PROCEDURE mkint(int: longint; reg: integer);
+ BEGIN (* mkint *)
+ mkitem(inttag, int, r[reg]);
+ END;
+ (* mkint *)
+
+PROCEDURE mkpair(pr: integer; reg: integer);
+ BEGIN (* mkpair *)
+ mkitem(pairtag, pr, r[reg])
+ END;
+ (* mkpair *)
+
+PROCEDURE int_val(item: itemref; VAR number: longint);
+ (* returns integer value of item (int or fixnum). *)
+ (* must return 'number' in var parameter instead *)
+ (* of function value since long integers are not *)
+ (* a legal function type in ucsd pascal. *)
+ BEGIN (* int_val *)
+ IF tag_of(item) = inttag THEN
+ number := info_of(item)
+ ELSE IF tag_of(item) = fixtag THEN
+ number := intspace[info_of(item)]
+ ELSE writeln(tag_of(item), ' *****Illegal data type for numeric operation')
+ (* halt or fatal error *)
+ END;
+ (* int_val *)
+
+
+ (********************************************************)
+ (* *)
+ (* stack allocation *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE alloc(n: integer);
+ BEGIN
+ IF n + st <= stksize THEN
+ st := n+st
+ ELSE
+ BEGIN
+ writeln('*****LISP stack overflow');
+ writeln(' tried to allocate ',n);
+ writeln(' current stack top is ',st);
+#d break(output);
+ END;
+ END;
+
+PROCEDURE dealloc(n: integer);
+ BEGIN
+ IF st - n >= 0 THEN
+ st := st - n
+ ELSE
+ writeln('*****Lisp stack underflow');
+ END;
+
+ (* optimized allocs *)
+
+PROCEDURE alloc1;
+ BEGIN alloc(1) END;
+
+PROCEDURE dealloc1;
+ BEGIN dealloc(1) END;
+
+PROCEDURE alloc2;
+ BEGIN alloc(2) END;
+
+PROCEDURE dealloc2;
+ BEGIN dealloc(2) END;
+
+PROCEDURE alloc3;
+ BEGIN alloc(3) END;
+
+PROCEDURE dealloc3;
+ BEGIN dealloc(3) END;
+
+
+ (********************************************************)
+ (* *)
+ (* support for register model *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE load(reg: integer; sloc: integer);
+ BEGIN
+ IF sloc < 0 THEN r[reg] := r[-sloc]
+ ELSE r[reg] := stk[st-sloc];
+ (* will, fix for load (pos,pos) *)
+ END;
+
+PROCEDURE store(reg: integer; sloc: integer);
+ BEGIN
+ stk[st-sloc] := r[reg];
+ END;
+
+ (* optimized load/store. *)
+PROCEDURE load10;
+ BEGIN
+ load(1,0);
+ END;
+
+PROCEDURE store10;
+ BEGIN
+ store(1,0);
+ END;
+
+PROCEDURE storenil(sloc: integer);
+ BEGIN
+ stk[st-sloc] := nilref;
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* identifier lookup & entry *)
+ (* *)
+ (********************************************************)
+
+function nmhash(nm: stringp): integer;
+ CONST
+ hashc = 256;
+ VAR
+ i,tmp: integer;
+ BEGIN
+ tmp := 0;
+ i := 1; (* get hash code from first three chars of string. *)
+ WHILE (i <= 3) AND (strspace[nm+i] <> eos) DO
+ BEGIN
+ tmp := ord(strspace[nm+i]) + hashc*tmp;
+ i := i + 1;
+ END;
+ nmhash := abs(tmp) MOD hidmax; (* abs because mod is screwy. *)
+ END;
+
+FUNCTION eqstr(s1,s2: stringp): boolean;
+ BEGIN
+ WHILE (strspace[s1] = strspace[s2]) AND (strspace[s1] <> eos) DO
+ BEGIN
+ s1 := s1 + 1;
+ s2 := s2 + 1;
+ END;
+ eqstr := (strspace[s1] = strspace[s2]);
+ END;
+
+PROCEDURE nmlookup(nm: stringp; VAR found: boolean; VAR hash: integer;
+ VAR loc: itemref);
+ (* lookup a name in "identifier space". *)
+ (* "hash" returns the hash value for the name. *)
+ (* "loc" returns the location in the space for the (possibly new) *)
+ (* identifier. *)
+ BEGIN
+ hash := nmhash(nm);
+ mkitem(idtag, idhead[hash], loc);
+ (* default is identifier, but may be "error". *)
+ (* start at appropriate hash chain. *)
+
+ found := false;
+ WHILE (info_of(loc) <> nillnk) AND (NOT found) DO
+ BEGIN
+ found := eqstr(nm, idspace[info_of(loc)].idname);
+ IF NOT found THEN
+ set_info(loc, idspace[info_of(loc)].idhlink);
+ (* next id in chain *)
+ END;
+ IF NOT found THEN (* find spot for new identifier *)
+ BEGIN
+ IF freeident=nillnk THEN (* no more free identifiers. *)
+ BEGIN
+ mkerr(noidspace, loc);
+ writeln('*****Identifer space exhausted')
+ END
+ ELSE
+ BEGIN
+ set_info(loc, freeident);
+ freeident := idspace[freeident].idhlink;
+ END;
+ END;
+ END;
+
+PROCEDURE putnm(nm: stringp; VAR z: itemref; VAR found: boolean);
+ (* put a new name into identifier space, or return old location *)
+ (* if it's already there. *)
+ VAR
+ tmp: ident;
+ hash: integer;
+ BEGIN
+ nmlookup(nm, found, hash, z);
+ IF (NOT found) AND (tag_of(z) = idtag) THEN
+ BEGIN
+ tmp.idname := nm;
+ tmp.idhlink := idhead[hash]; (* put new ident at head of chain *)
+ tmp.val := nilref; (* initialize value and property list *)
+ tmp.plist := nilref;
+ tmp.funcell := nilref; (* also, the function cell *)
+ idhead[hash] := info_of(z);
+ idspace[info_of(z)] := tmp;
+ END;
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* the garbage collector *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xfaststat;
+ (* give quick summary of statistics gathered *)
+ BEGIN
+#dw writeln('Next free pair: ', freepair, ' out of ', maxpair);
+#dw writeln('Next free fixnum: ', freeint, ' out of ', maxintsp);
+#dw writeln('Next free string: ', freestr, ' out of ', maxstrsp);
+ writeln('Next free id loc: ', freeident, ' out of ', maxident);
+ writeln('Pair space reclaimed ', gccount, ' times');
+ writeln('Conses since last reclaim:',consknt);
+ writeln('Stack top is:',st);
+#d break(output)
+ END;
+
+
+PROCEDURE xgcollect;
+ VAR
+ i: integer;
+ markedk: integer; (* counts the number of pairs marked *)
+ freedk: integer; (* counts the number of pairs freed. *)
+ gcstkp: 0..maxgcstk; (* note the garbage collection stack *)
+ mxgcstk: 0..maxgcstk; (* is local to this procedure. *)
+ gcstk: ARRAY[1..maxgcstk] OF integer;
+ markflag: PACKED ARRAY[1..maxpair] OF boolean;
+
+ PROCEDURE pushref(pr: itemref);
+ (* push the address of an unmarked pair, if that's what it is. *)
+ BEGIN
+ IF tag_of(pr) = pairtag THEN
+ IF NOT markflag[info_of(pr)] THEN (* was .markflag *)
+ BEGIN
+ IF gcstkp < maxgcstk THEN
+ BEGIN
+ gcstkp := gcstkp + 1;
+ gcstk[gcstkp] := info_of(pr);
+ IF gcstkp > mxgcstk THEN
+ mxgcstk := gcstkp;
+ END
+ ELSE
+ BEGIN
+ writeln('*****Garbage stack overflow');
+#dtv halt;
+#p exit(pas0);
+#a pgm_$exit;
+ END;
+ END;
+ END;
+
+ PROCEDURE mark;
+ (* "recursively" mark pairs referred to from gcstk. gcstk is used to *)
+ (* simulate recursion. *)
+ VAR
+ prloc: integer;
+ BEGIN
+ WHILE gcstkp > 0 DO
+ BEGIN
+ prloc := gcstk[gcstkp];
+ gcstkp := gcstkp - 1;
+ markflag[prloc] := true;
+ pushref(prspace[prloc].prcdr);
+ pushref(prspace[prloc].prcar); (* trace the car first. *)
+ END;
+ END;
+
+ BEGIN (* xgcollect *)
+ writeln;
+ writeln('***Garbage collector called');
+#d break(output);
+ gccount := gccount + 1; (* count garbage collections. *)
+ xfaststat; (* give summary of statistics collected *)
+ consknt := 0; (* clear out the cons counter *)
+ gcstkp := 0; (* initialize the garbage stack pointer. *)
+ mxgcstk := 0; (* keeps track of max stack depth. *)
+
+ (* clear markflags *)
+ FOR i := 1 TO maxpair DO markflag[i] := false;
+ (* mark things from the "computation" stack. *)
+ FOR i := 1 TO st DO
+ BEGIN
+ pushref(stk[i]);
+ mark;
+ END;
+ (* mark things from identifier space. *)
+ FOR i := 1 TO maxident DO
+ BEGIN
+ pushref(idspace[i].val);
+ mark;
+ pushref(idspace[i].plist);
+ mark;
+ pushref(idspace[i].funcell);
+ mark;
+ END;
+
+ (* reconstruct free list by adding things to the head. *)
+ freedk := 0;
+ markedk := 0;
+ FOR i:= 1 TO maxpair - 1 DO
+ BEGIN
+ IF markflag[i] THEN
+ BEGIN
+ markedk := markedk + 1;
+ markflag[i] := false
+ END
+ ELSE
+ BEGIN
+ prspace[i].prcar := nilref;
+ mkitem(pairtag, freepair, prspace[i].prcdr);
+ freepair := i;
+ freedk := freedk + 1
+ END
+ END;
+ writeln(freedk,' pairs freed.');
+ writeln(markedk,' pairs in use.');
+ writeln('Max gc stack was ',mxgcstk);
+#d break(output);
+ mkint(gccount, 1) (* return number of garbage collections *)
+ END;
+ (* xgcollect *)
+
+ (********************************************************)
+ (* *)
+ (* lisp primitives *)
+ (* *)
+ (********************************************************)
+
+ (* return r[1].r[2] in r[1] *)
+PROCEDURE xcons;
+ VAR p: integer;
+
+ BEGIN
+ (* push args onto stack, in case we need to garbage collect the *)
+ (* references will be detected. *)
+ alloc(2);
+ stk[st] := r[1];
+ stk[st-1] := r[2];
+
+ IF xNull(prspace[freepair].prcdr) THEN xgcollect;
+
+ p := freepair;
+ freepair := info_of(prspace[p].prcdr);
+ prspace[p].prcar := stk[st];
+ prspace[p].prcdr := stk[st - 1];
+ mkpair(p, 1); (* leave r[1] pointing at new pair. *)
+
+ consknt := consknt + 1;
+ dealloc(2);
+ END;
+
+PROCEDURE xncons;
+ BEGIN r[2] := nilref;
+ xcons;
+ END;
+
+PROCEDURE xxcons;
+ BEGIN rxx := r[1];
+ r[1] := r[2];
+ r[2] := rxx;
+ xcons;
+ END;
+(* Makes things too big for Apollo ...
+PROCEDURE xWrtok; FORWARD;
+
+PROCEDURE err_not_pair(VAR u: itemref);
+ BEGIN
+ write('*****Pair operation attempted on '); xwrtok; writeln;
+ mkerr(notpair, u);
+ END;
+*)
+
+ (* return car of r[1] in r[1] *)
+PROCEDURE xcar;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcar
+ ELSE
+ mkerr(notpair, r[1]);
+ END;
+
+PROCEDURE xcdr;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcdr
+ ELSE
+ mkerr(notpair, r[1]);
+ END;
+
+PROCEDURE xrplaca;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ prspace[info_of(r[1])].prcar:=r[2]
+ ELSE
+ mkerr(notpair, r[1]);
+ END;
+
+PROCEDURE xrplacd;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ prspace[info_of(r[1])].prcdr :=r[2]
+ ELSE
+ mkerr(notpair, r[1]);
+ END;
+
+ (* anyreg car and cdr *)
+PROCEDURE anycar(a: itemref; VAR b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcar
+ ELSE
+ mkerr(notpair, b);
+ END;
+
+PROCEDURE anycdr(a: itemref; VAR b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcdr
+ ELSE
+ mkerr(notpair, b);
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* compress & explode *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE compress; (* returns new id from list of chars *)
+ VAR i: stringp;
+ clist, c: itemref;
+ found: boolean;
+ int: longint;
+
+ FUNCTION is_int(i: stringp; VAR int: longint): boolean;
+ VAR negative, could_be: boolean;
+
+ BEGIN (* is_int *)
+ int := 0;
+ could_be := true;
+ negative := strspace[i] = '-';
+ IF negative OR (strspace[i] = '+') THEN i := i + 1;
+
+ WHILE could_be AND (strspace[i] <> eos) DO
+ BEGIN
+ IF (strspace[i] >= '0') AND (strspace[i] <= '9') THEN
+ int := int * 10 + (ord(strspace[i]) - ord('0'))
+ ELSE could_be := false;
+ i := i + 1
+ END;
+
+ IF negative THEN int := -int;
+ is_int := could_be
+ END (* is_int *);
+
+ BEGIN (* compress *)
+ clist := r[1]; (* list of chars *)
+ i := freestr; (* point to possible new string *)
+
+ WHILE (i < maxstrsp) AND NOT xNull(clist) DO
+ BEGIN
+ IF tag_of(clist) = PAIRTAG THEN
+ BEGIN
+ c := prspace[info_of(clist)].prcar;
+ clist := prspace[info_of(clist)].prcdr;
+ IF tag_of(c) = IDTAG THEN
+ IF (info_of(c) > choffset) AND
+ (info_of(c) < choffset + 128) THEN
+ BEGIN
+ strspace[i] := chr(info_of(c) - choffset);
+ i := i + 1
+ END
+ ELSE
+ writeln('*****Compress: list item not single char')
+ ELSE
+ writeln('*****Compress: list item not ID');
+ END
+ ELSE
+ writeln('*****Compress: item not list')
+ END (* WHILE *);
+
+ strspace[i] := eos; (* terminate string *)
+
+ IF (i >= maxstrsp) THEN
+ writeln('*****String space exhausted')
+ ELSE IF is_int(freestr, int) THEN
+ mkint(int, 1)
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END
+ END (* compress *);
+
+PROCEDURE explode; (* returns list of chars from id or int *)
+
+ FUNCTION id_explode(i: stringp): itemref;
+ BEGIN (* id_explode *)
+ IF strspace[i] = eos THEN id_explode := nilref
+ ELSE
+ BEGIN
+ r[2] := id_explode(i + 1);
+ mkident(ord(strspace[i]) + choffset, 1);
+ xcons;
+ id_explode := r[1]
+ END
+ END (* id_explode *);
+
+ FUNCTION int_explode(i: longint): itemref;
+ VAR negative: boolean;
+
+ BEGIN (* int_explode *)
+ r[1] := nilref;
+ IF i < 0 THEN
+ BEGIN negative := true;
+ i := -i
+ END
+ ELSE negative := false;
+
+ WHILE i > 0 DO
+ BEGIN
+ r[2] := r[1];
+ mkident(i MOD 10 + ord('0') + choffset, 1);
+ xcons;
+ i := i DIV 10
+ END;
+
+ IF negative THEN
+ BEGIN
+ r[2] := r[1];
+ mkident(ord('-') + choffset, 1);
+ xcons
+ END;
+ int_explode := r[1]
+ END (* int_explode *);
+
+ BEGIN (* explode *)
+ IF tag_of(r[1]) = IDTAG THEN
+ r[1] := id_explode(idspace[info_of(r[1])].idname)
+ ELSE IF tag_of(r[1]) = INTTAG THEN
+ r[1] := int_explode(info_of(r[1]))
+ ELSE IF tag_of(r[1]) = FIXTAG THEN
+ r[1] := int_explode(intspace[info_of(r[1])])
+ ELSE IF tag_of(r[1]) = CODETAG THEN
+ r[1] := int_explode(info_of(r[1]))
+ ELSE
+ writeln('***** EXPLODE: Arg bad type')
+ END (* explode *);
+
+PROCEDURE gensym;
+ VAR i: integer;
+
+ PROCEDURE kick(i: integer); (* increments gsym digit *)
+ BEGIN (* Kick *)
+ IF (g_sym[i] = '9') THEN
+ BEGIN
+ g_sym[i] := '0';
+ IF (i < max_gsym) THEN kick(i + 1) (* otherwise wrap around *)
+ END
+ ELSE g_sym[i] := succ(g_sym[i])
+
+ END (* Kick *);
+
+ BEGIN (* gensym *)
+ r[1] := nilref;
+
+ FOR i := 1 TO max_gsym DO
+ BEGIN
+ r[2] := r[1];
+ mkident(ord(g_sym[i]) + choffset, 1);
+ xcons
+ END;
+ r[2] := r[1];
+ mkident(ord('G') + choffset, 1);
+ xcons;
+ compress;
+
+ Kick(1);
+ END; (* gensym *)
+
+
+ (********************************************************)
+ (* *)
+ (* i/o primitives *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xopen; (* Simple OPEN, but see NPAS0 *)
+
+var s1: FileName;
+ i,j : integer;
+#a io_status: integer32;
+#p (* catch some I/O errors *)
+#p handler ResetError(name: PathName);
+#p begin
+#p writeln('**** Could not open file - ',name,' for read');
+#p exit(xopen);
+#p end;
+
+#p handler RewriteError(name: PathName);
+#p begin
+#p writeln('**** Could not open file - ',name,' for write');
+#p exit(xopen);
+#p end;
+
+begin
+ IF tag_of(r[1]) = IDTAG THEN
+ begin
+ i := idspace[info_of(r[1])].idname;
+#p s1[0] := chr(255); (* set length *)
+#d s1:=' ';
+#w s1:=" ";
+#aptv s1:=' ';
+#adpvw j:= 0;
+#t j := 1;
+
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos)
+#d AND (j <9 )
+ do
+ begin
+#d IF strspace[i] <> '.' THEN (* ignore dots in 20 file names. *)
+#d BEGIN
+#d j:= j + 1;
+ s1[j] := strspace[i];
+#d END;
+#aptvw j:= j + 1;
+ i:= i + 1;
+ end;
+#p s1[0]:= chr(j); (* set Actual Length *)
+
+ IF tag_of(r[2]) = IDTAG THEN
+ BEGIN
+ If info_of(r[2])= Xinput then
+ begin
+#t close(finput);
+#twp reset(finput, s1);
+#d reset(finput,s1,0,0,'DSK ');
+#a close(finput);
+#a open(finput, s1, 'old', io_status);
+#a IF io_status = 0 THEN
+#a BEGIN
+#a reset(finput);
+ mkint(4,1)
+#a END
+#a ELSE BEGIN writeln('***** OPEN: Could not open ', s1);
+#a r[1] := nilref END
+ end
+
+ else if info_of(r[2])= Xoutput then
+ begin
+#t close(foutput);
+#twp rewrite(foutput, s1);
+#d rewrite(foutput,s1,0,0,'DSK ');
+#a close(foutput);
+#a open(foutput, s1, 'new', io_status);
+#a IF io_status = 0 THEN
+#a BEGIN
+#a rewrite(foutput);
+ mkint(5,1)
+#a END
+#a ELSE BEGIN writeln('***** OPEN: Could not open ', s1);
+#a r[1] := nilref
+#a END
+ END
+ ELSE
+ BEGIN writeln('***** Open: arg2 not INPUT/OUTPUT');
+ mkerr(notid,r[1])
+ END
+ END ELSE writeln('***** Open: arg2 bad type')
+ END ELSE writeln('***** Open: arg1 bad type');
+END;
+
+PROCEDURE xclose;
+begin
+ case info_of(r[1]) of
+ 1: ;
+ 2: ;
+ 3: ;
+#w 4: ;
+#w 5: ;
+#apt 4: close(finput);
+#apt 5: close(foutput);
+#d 4: break(finput);
+#d 5: break(foutput);
+ end;
+end;
+
+PROCEDURE xrds;
+ (* Select channel for input *)
+ VAR tmp: longint;
+ BEGIN
+ tmp:=inchnl;
+ inchnl := info_of(r[1]);
+ mkint(tmp,1)
+ END;
+
+PROCEDURE Xwrs;
+ (* Select channel for output *)
+ VAR tmp:longint;
+ BEGIN
+ tmp:=outchnl;
+ outchnl := info_of(r[1]);
+ mkint(tmp,1)
+ END;
+
+PROCEDURE xterpri;
+ BEGIN
+ CASE outchnl OF
+#p 3: writeln(' ');
+#d 3: begin writeln(output); break(output); end;
+#dp 5: begin writeln(foutput,' '); break(foutput); end;
+#atw 3: writeln(output);
+#atw 5: writeln(foutput);
+ END (* CASE *)
+ END;
+
+ FUNCTION Int_field(I: longint): Integer;
+ VAR width: integer;
+ n: longint;
+ BEGIN
+ width := 1;
+ n := 10;
+ IF i < 0 THEN width := width + 1; (* For minus sign *)
+ i := abs(i);
+ WHILE (i >= n) AND (width < 10) DO
+ BEGIN width := width + 1;
+ n := n * 10
+ END;
+ int_field := width
+ END;
+
+PROCEDURE XwriteInt(I:integer);
+ BEGIN
+ CASE outchnl OF
+ 3: write(i: int_field(i));
+ 5: write(foutput, i: int_field(i));
+ END (* CASE *)
+ END (* XwriteInt *);
+
+PROCEDURE XwriteChar(C:onechar);
+ BEGIN
+#adptw CASE outchnl OF
+#p 3: write(' ', C);
+#adtvw 3: write(C);
+#p 5: write(foutput,' ', C);
+#adtvw 5: write(foutput,C);
+#adptw END (* CASE *)
+ END;
+
+PROCEDURE xwrtok;
+ (* doesn't expand escaped characters in identifier names *)
+ VAR i: integer;
+ BEGIN
+ IF tag_of(r[1]) = inttag THEN XwriteInt(info_of(R[1]))
+ ELSE IF tag_of(r[1]) = fixtag THEN XwriteInt(intspace[info_of(R[1])])
+ ELSE IF tag_of(r[1]) = idtag THEN
+ BEGIN
+ i := idspace[info_of(r[1])].idname;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos) DO
+ BEGIN
+ XwriteChar(strspace[i]);
+ i:= i + 1;
+ END;
+ END
+(*
+ ELSE IF tag_of(r[1]) = strtag THEN
+ BEGIN xWriteChar('"');
+ i := info_of(r[1]);
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos) DO
+ BEGIN
+ XwriteChar(strspace[i]);
+ i := i + 1;
+ END;
+ xWriteChar('"')
+ END
+*)
+
+ ELSE IF tag_of(r[1]) = chartag THEN
+ XwriteChar(chr(info_of(r[1]) - choffset))
+ ELSE IF tag_of(r[1]) = errtag THEN
+ Begin XwriteChar(' ');
+ XwriteChar('*'); XwriteChar('*'); XwriteChar('*');
+ XwriteChar(' '); XwriteChar('#'); XwriteChar(' ');
+ XwriteInt(info_of(r[1])); Xterpri;
+ End
+ ELSE IF tag_of(r[1]) = codetag THEN
+ Begin XwriteChar(' '); XwriteChar('#'); XwriteChar('#');
+ XwriteInt(info_of(r[1]));
+ End
+ ELSE
+ Begin
+ XwriteChar(' '); XwriteChar('?'); XwriteChar(' ');
+ XwriteInt(tag_of(r[1]));
+ XwriteChar(' '); XwriteChar('/'); XwriteChar(' ');
+ XwriteInt(info_of(r[1]));
+ XwriteChar(' '); XwriteChar('?'); XwriteChar(' ');
+ End;
+#d break(output);
+ END;
+
+#aptvw FUNCTION eol: boolean;
+#aptvw BEGIN
+#aptvw CASE inchnl OF
+#aptvw 1: eol := eoln(symin);
+#aptvw 2: eol := eoln(input);
+#aptvw 4: eol := eoln(finput);
+#aptvw END;
+#aptvw END;
+
+PROCEDURE rdchnl(chnlnum: integer; VAR ch: onechar);
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ writeln('*****Bad input channel for RDCHNL', chnlnum)
+ ELSE
+ CASE chnlnum OF
+ 1: BEGIN
+ ch := symin^; (* a little strange, but avoids *)
+ get(symin); (* initialization problems *)
+ ichrbuf[inchnl] := symin^; (* Peek ahead *)
+ END;
+
+ 2: BEGIN
+#t IF charcnt > Length(line) THEN
+#t BEGIN
+#t charcnt := 1;
+#t Readln(line)
+#t END;
+#t ch := line[charcnt];
+#t IF Length(line) > charcnt THEN
+#t ichrbuf[inchnl] := line[charcnt + 1]
+#t ELSE ichrbuf[inchnl] := sp;
+#t charcnt := charcnt + 1
+#adpvw ch := input^;
+#adpvw get(input);
+#adpvw ichrbuf[inchnl] := input^;
+ END;
+ 4: begin
+ ch := finput^;
+ get(finput);
+ ichrbuf[inchnl] := finput^;
+ END;
+ END;
+ (* case *)
+ IF idspace[xEcho].val <> nilref THEN
+#aptvw IF eol THEN BEGIN xWriteChar(ch); xTerpri END ELSE xWriteChar(ch);
+#d xWriteChar(ch);
+ END;
+ (* rdchnl *)
+
+FUNCTION eofchnl: boolean;
+ BEGIN
+#adptvw CASE inchnl OF
+#adptvw 1: eofchnl := eof(symin);
+#adptvw 2: eofchnl := eof(input);
+#adptvw 4: eofchnl := eof(finput);
+#adptvw END;
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* token scanner *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xrdtok;
+LABEL 1;
+
+ VAR
+ ch,ch1,ChangedCh: onechar;
+ i: integer;
+ anint: longint;
+ moreid: boolean;
+ found: boolean;
+ negflag: integer;
+
+ FUNCTION digit(ch: onechar): boolean;
+ BEGIN
+ digit := ( '0' <= ch ) AND ( ch <= '9');
+ END;
+
+
+ FUNCTION escalpha(VAR ch: onechar): boolean;
+ (* test for alphabetic or escaped character. *)
+ (* note side effect in ChangedCh. *)
+ BEGIN
+ ChangedCh := Ch;
+ IF ( 'A' <= ch ) AND ( ch <= 'Z') THEN
+ escalpha := true
+ ELSE IF ( ord('A')+32 <= ord(ch)) AND ( ord(ch) <= ord('Z')+32) THEN
+ BEGIN
+ IF NOT xNull(idspace[xraise].val) THEN
+ Changedch := chr(ord(ch)-32);
+ escalpha := true; (* lower case alphabetics *)
+ END
+ ELSE IF ch='!' THEN
+ BEGIN
+ rdchnl(inchnl,ch);
+ ChangedCh:=Ch;
+ escalpha := true;
+ END
+ ELSE
+ escalpha := false;
+ END;
+
+ FUNCTION alphanum(VAR ch: onechar): boolean;
+ (* test if escalfa or digit *)
+ VAR b: boolean;
+ BEGIN
+ ChangedCh:=Ch;
+ b := digit(ch);
+ IF NOT b THEN b := escalpha(ch);
+ alphanum := b;
+ END;
+
+ FUNCTION whitesp(ch: onechar): boolean;
+#d BEGIN
+#d (* may want a faster test *)
+#d whitesp := (ch = sp) OR (ch = cr) OR (ch = lf) OR (ch = ht)
+#d OR (ch = nul); (* null?? *)
+#aptvw VAR ascode:integer;
+#aptvw BEGIN
+#aptvw ascode:=ord(ch);
+#aptvw WHITESP := (CH = SP) OR (ascode = CR) OR (ascode = LF)
+#aptvw OR (ascode = ht) or (ascode = nul); (* null?? *)
+ END;
+
+ BEGIN (* xrdtok *)
+1:
+ IF NOT eofchnl THEN
+ REPEAT (* skip leading white space. *)
+ rdchnl(inchnl,ch)
+ UNTIL (NOT whitesp(ch)) OR eofchnl;
+ IF eofchnl THEN
+ mkitem(chartag, eofcode + choffset, r[1])
+ (* should really return !$eof!$ *)
+ ELSE
+ BEGIN
+ IF digit(ch) or (ch = '-') THEN
+ set_tag(r[1], inttag)
+ ELSE IF ch = '"' THEN set_tag(r[1], strtag)
+ ELSE IF escalpha(ch) THEN
+ set_tag(r[1], idtag)
+ ELSE
+ set_tag(r[1], chartag);
+
+ CASE tag_of(r[1]) OF
+ chartag: BEGIN
+ if ch = begin_comment then
+ BEGIN
+#d While (ch <> cr) do rdchnl(inchnl,ch);
+#aptvw While not eol do rdchnl(inchnl,ch);
+ rdchnl(inchnl, ch);
+ GOTO 1
+ END;
+ set_tag(r[1], idtag);
+ mkitem(inttag, chartype, tmpref);
+ idspace[xtoktype].val := tmpref;
+ set_info(r[1], ord(ch) + choffset);
+ END;
+ inttag: BEGIN
+ mkitem(inttag, inttype, tmpref);
+ idspace[xtoktype].val :=tmpref;
+ negflag := 1;
+ if ch = '-' then
+ begin anint := 0; negflag :=-1 end
+ else anint := ord(ch) - ord('0');
+ WHILE digit(ichrbuf[inchnl]) DO
+ BEGIN
+ rdchnl(inchnl,ch);
+ anint := 10 * anint + (ord(ch) - ord('0'))
+ END;
+ anint := negflag * anint;
+ set_info(r[1], anint)
+ END;
+ idtag: BEGIN
+ mkitem(inttag, idtype, tmpref);
+ idspace[xtoktype].val:=tmpref;
+ i := freestr; (* point to possible new string *)
+ moreid := true;
+ WHILE (i < maxstrsp) AND moreid DO
+ BEGIN
+ strspace[i] := ChangedCh;
+ (* May have Case Change, etc *)
+ i:= i + 1;
+ moreid :=alphanum(ichrbuf[inchnl]); (* PEEK ahead char *)
+ IF moreid THEN rdchnl(inchnl,ch) (* Advance readch *)
+ END;
+ strspace[i] := eos; (* terminate string *)
+ IF (i >= maxstrsp) THEN
+ writeln('*****String space exhausted')
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END;
+ END (* of case idtag *);
+ strtag: BEGIN
+ (* an alias for quoted identifier - special *)
+ (* characters need not be escaped. *)
+ mkitem(inttag, idtype, tmpref);
+ idspace[xtoktype].val:=tmpref;
+ i := freestr;
+ rdchnl(inchnl, ch); (* scan past " *)
+ WHILE (ch <> '"') AND (i < maxstrsp) DO
+ BEGIN
+ strspace[i] := ch;
+ i := i + 1;
+ rdchnl(inchnl, ch);
+ END;
+#adw strspace[i] := eos;
+#ptv strspace[i] := chr(eos);
+ i := i + 1;
+ IF ch <> '"' THEN
+ writeln('***** String space exhausted')
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ set_tag(r[1], idtag);
+ (* must have the form ('QUOTE . id . NIL) *)
+ (* to give the effect of a quoted id. *)
+ r[2] := nilref;
+ xcons;
+ r[2] := r[1];
+ mkident(xQuote, 1);
+ xcons;
+ IF NOT found THEN
+ freestr := i;
+ END;
+ END (* OF CASE strtag *);
+ END (* of case *);
+ END;
+ END (* xrdtok *);
+
+ (********************************************************)
+ (* *)
+ (* initialization *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE init;
+ (* initialization procedure depends on *)
+ (* ability to load stack with constants *)
+ (* from a file. *)
+ VAR
+ strptr: stringp;
+#dptvw nam: PACKED ARRAY[1..3] OF onechar;
+#a nam: PACKED ARRAY[1..4] OF onechar; (* SPL bug for Apollo *)
+ (* holds 'nil', other strings? *)
+ i, n: integer;
+ idref: itemref;
+ found: boolean;
+
+#aptv (* init is divided into two parts so it can compile on terak *)
+ PROCEDURE init1;
+ BEGIN
+#t CHARCNT := 1;
+#t LINE := '';
+#t eos := chr(nul);
+
+ (* initialize top of stack *)
+ st := 0;
+
+ (* initialize fixnum free list *)
+ FOR freeint := 1 TO maxintsp - 1 DO
+ intspace[freeint] := freeint + 1;
+ intspace[maxintsp] := end_flag;
+ freeint := 1;
+
+ (* define nilref - the id, nil, is defined a little later. *)
+ freeident := 1;
+ mkitem(idtag, freeident, nilref);
+
+ (* initialize pair space. *)
+ FOR i := 1 TO maxpair - 1 DO (* initialize free list. *)
+ BEGIN
+ prspace[i].prcar := nilref; (* just for fun *)
+ mkitem(pairtag, i + 1, prspace[i].prcdr);
+ END;
+ prspace[maxpair].prcar := nilref;
+ prspace[maxpair].prcdr := nilref; (* end flag *)
+ freepair := 1; (* point to first free pair *)
+
+
+ (* initialize identifier space and string space. *)
+ freestr := 1;
+ FOR i := 0 TO hidmax - 1 DO
+ idhead[i] := nillnk;
+ FOR i := 1 TO maxident DO
+ BEGIN
+ IF i < maxident THEN
+ idspace[i].idhlink := i + 1
+ ELSE (* nil to mark the final identifier in the table. *)
+ idspace[i].idhlink := nillnk;
+ (* set function cells to undefined *)
+ mkerr(undefined, tmpref);
+ idspace[i].funcell :=tmpref;
+ idspace[i].val :=tmpref;
+ idspace[i].plist :=tmpref;
+ END;
+
+ (* nil must be the first identifier in the table--id #1 *)
+ (* must fill in fields by hand for nilref.*)
+ (* putnm can handle any later additions. *)
+ nam := 'NIL';
+ strptr := freestr;
+ FOR i := 1 TO 3 DO
+ BEGIN
+ strspace[strptr] := nam[i];
+ strptr:= strptr + 1;
+ END;
+ strspace[strptr] := eos;
+ putnm(freestr, nilref, found);
+ IF NOT found THEN
+ freestr := strptr + 1;
+
+ (* make the single character ascii identifiers, except nul(=eos). *)
+ FOR i := 1 TO 127 DO
+ BEGIN
+ strspace[freestr] := chr(i);
+ strspace[freestr + 1] := eos;
+ putnm(freestr, idref, found);
+ IF NOT found THEN
+ freestr := freestr + 2;
+ IF i = ord('T') THEN
+ BEGIN
+ trueref := idref; (* returns location for 't. *)
+ idspace[info_of(idref)].val := trueref (* Set T to T *)
+ END
+ END;
+
+
+ (* init gensym id list *)
+ FOR i := 1 TO max_gsym DO g_sym[i] := '0';
+
+ (* clear the counters *)
+ idspace[xraise].val := trueref; (* gets undone when !*RAISE is read *)
+ idspace[xEcho].val := nilref; (* prevent echo until !*ECHO is read *)
+ gccount := 0;
+ consknt := 0;
+ END;
+ (* init1 *)
+
+ PROCEDURE init2;
+ BEGIN
+ (* load "symbol table" with identifiers, constants, and functions. *)
+ inchnl := 1; (* select symbol input file. *)
+ outchnl := 3; (* select output file. *)
+#p reset(symin,'paslsp.ini');
+#p reset(input);
+#p rewrite(output);
+#w reset(symin, "paslsp.ini");
+#t reset(symin,'#5:lspini.text');
+#d reset(symin,'paslspini',0,0,'DSK ');
+#d reset(input,'tty ',0,0,'TTY ');
+#d rewrite(output,'tty ',0,0,'TTY ');
+#a open(symin,'paslsp.ini','old',iostatus);
+#a reset(symin);
+#a for i:=1 to inchns do
+#a ichrbuf[i]:=' ';
+ xrdtok; (* get count of identifiers. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****Bad symbol table, integer expected at start');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ xrdtok;
+ (* reading token magically loads it into id space. *)
+ xrdtok; (* look for zero terminator. *)
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****Bad symbol table, zero expected after identifiers');
+
+ xrdtok; (* count of constants *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****Bad symbol table, integer expected before constants');
+ n := info_of(r[1]);
+ alloc(n); (* space for constants on the stack *)
+ FOR i := 1 TO n DO
+ BEGIN
+ xread;
+ stk[i] := r[1];
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****Bad symbol table, zero expected after constants');
+ xrdtok; (* count of functions. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****Bad symbol table, integer expected before functions');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ (* for each function *)
+ (* store associated code *)
+ BEGIN
+ xrdtok;
+ mkitem(codetag, i, tmpref);
+ idspace[info_of(r[1])].funcell :=tmpref;
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****Bad symbol table, zero expected after functions');
+ END;
+ (* init2 *)
+
+(*
+PROCEDURE dumpids;
+ VAR i, p: integer;
+
+ BEGIN
+ FOR i := 1 TO freeident - 1 DO
+ BEGIN
+ p := idspace[i].idname;
+ write('id #', i:5, ' at', p:5, ': ');
+ WHILE strspace[p] <> eos DO
+ BEGIN
+ write(strspace[p]);
+ p := p + 1
+ END;
+ write('. Function code: ');
+ writeln(INFO_OF(idspace[i].funcell));
+ END
+ END;
+*)
+
+ BEGIN (* init *)
+ init1;
+ init2;
+ END;
+ (* init *)
+
+ (********************************************************)
+ (* *)
+ (* arithmetic functions *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xadd1;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(i + 1, 1)
+ END;
+
+PROCEDURE xdifference;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 - i2, 1)
+ END;
+
+PROCEDURE xdivide; (* returns dotted pair (quotient . remainder). *)
+ VAR quot, rem: integer;
+ i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ IF i2 = 0 THEN writeln('*****Attempt to divide by 0 in DIVIDE')
+ ELSE BEGIN mkint(i1 DIV i2, 1);
+ mkint(i1 MOD i2, 2);
+ END;
+ xcons
+ END;
+
+PROCEDURE xgreaterp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 > i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xlessp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 < i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xminus;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(-i, 1)
+ END;
+
+PROCEDURE xplus2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 + i2, 1)
+ END;
+
+PROCEDURE xquotient;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ IF i2 = 0 THEN writeln('*****Attempt to divide by 0 in QUOTIENT')
+ ELSE mkint(i1 DIV i2, 1)
+ END;
+
+PROCEDURE xremainder;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ IF i2 = 0 THEN writeln('*****Attempt to divide by 0 in REMAINDER')
+ ELSE mkint(i1 MOD i2, 1)
+ END;
+
+PROCEDURE xtimes2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 * i2, 1)
+ END;
+ (* xtimes2 *)
+
+
+ (********************************************************)
+ (* *)
+ (* support for eval *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE execute(code: integer);
+ FORWARD;
+
+ (* Xapply(fn,arglist)-- "fn" is an operation code. *)
+PROCEDURE xxapply;
+ VAR
+ i: integer;
+ code: integer;
+ tmp: itemref;
+ tmpreg: ARRAY[1..maxreg] OF itemref;
+ BEGIN
+ code := info_of(r[1]);
+ r[1] := r[2];
+ i := 1;
+ (* spread the arguments *)
+ WHILE NOT xNull(r[1]) AND (i <= maxreg) DO
+ BEGIN
+ tmp := r[1];
+ xcar;
+ tmpreg[i] := r[1];
+ i := i + 1;
+ r[1] := tmp;
+ xcdr;
+ END;
+ WHILE i > 1 DO
+ BEGIN
+ i := i - 1;
+ r[i] := tmpreg[i];
+ END;
+ execute(code);
+ END;
+
+ (* rest of pas1...pasn follow , pasn Closes definition of Catch *)
+
ADDED perq-pascal-lisp-project/pas0.save
Index: perq-pascal-lisp-project/pas0.save
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas0.save
@@ -0,0 +1,1760 @@
+#padtwv (* PreProcessor Version - Run through Filter *)
+#p (* PERQ version *)
+#a (* Apollo Version *)
+#d (* DEC-20 Version *)
+#t (* Terak Version *)
+#w (* Wicat Version *)
+#v (* VAX version *)
+(*********************************************************************
+
+ PASCAL BASED MINI-LISP
+
+ File: PAS0.PAS - PASCAL/LISP KERNEL
+ ChangeHistory:
+ 9 Dec 81, RO: Remove apollo specific I/O.
+ 1 Dec 81 RO: I/O fixes for wicat & fixnum bug
+ 14 Nov 81, MLG:add some PERQ updates from Voelker
+ 28 Oct 81, RO: GENSYM & fixnum gc
+
+ All RIGHTS RESERVED
+ COPYRIGHT (C) - 1981 - M. L. Griss and R. Ottenheimer
+ Computer Science Department
+ University of Utah
+
+ Do Not distribute with out written consent of M. L. Griss
+
+********************************************************************)
+
+#t (*$S+*) (* swapping mode *)
+#t (*$G+*) (* goto is legal *)
+
+#adtvw PROGRAM pas0 ; (* (input*,output) *)
+#p PROGRAM pas0 (input,output, symin, finput,foutput);
+ (************************************************************)
+ (* support routines for a "lisp" machine. uses a register *)
+ (* model with a stack for holding frames. stack also used *)
+ (* to hold compiler generated constants. *)
+ (* written by: *)
+ (* william f. galway, martin l. griss *)
+ (* ralph ottenheimer *)
+ (* append pas1...pasn at end *)
+ (* -------------------------------------------------------- *)
+ (* symin is input channel one--used to initialize "symbol *)
+ (* table". input is input channel two--standard input. *)
+ (* output is output channel one--the standard output. *)
+ (* finput is file input channel three. *)
+ (* foutput is file output channel four. *)
+ (************************************************************)
+#a (* Apollo System include files *)
+#a %include '/sys/ins/base.ins.pas';
+#a %include '/sys/ins/base_transition.ins.pas';
+#a %include '/sys/ins/streams.ins.pas';
+#a %include '/sys/ins/pgm.ins.pas';
+
+
+#p imports Stream from Stream;
+#p imports system from system;
+#p imports io_others from io_others;
+#p imports io_unit from io_unit;
+
+ (************************************************************)
+
+CONST
+#aptv (* for terak, perq, Apollo, vax *)
+#aptvw sp = ' ';
+#aptvw ht = 9; (* ascii codes *)
+#aptvw lf = 10;
+#aptvw cr = 13;
+#aptvw nul = 0;
+
+#d eos = nul; (* terminator character for strings. *)
+#t (* use eos=chr(nul) *)
+#av eos=chr(nul) ;
+#pw eos = chr(0); (* KLUDGE: null string *)
+#adtwpv inchns = 3; (* number of input channels. *)
+#adtwpv outchns = 2; (* number of output channels. *)
+ begin_comment = '%';
+
+(* Initial symbols, needed in Kernel *)
+ xtoktype = 129; (* slot in idspace for toktype. *)
+ xbstack = 130; (* Bstack Pointer *)
+ xthrowing = 131; (* If throw mode *)
+ xinitform = 132; (* for restart *)
+ xraise = 133; (* for RAISE of lc in ids *)
+ Xinput = 134; (* For Open *)
+ Xoutput = 135; (* For Open *)
+ chartype = 3; (* various token types *)
+ inttype = 1;
+ idtype = 2;
+
+ max_gsym = 4; (* number of digits in gen'd id. *)
+
+#dt shift_const = 8192; (* tags and info are packed into an integer *)
+#av shift_const = 4096;
+#p (* no shift const *)
+#w (* no shift const *)
+ (* assumed to be at least 16 bits long. low order 13 bits *)
+ (* are the info, top 3 are the tag. *)
+#dt int_offset = 4096; (* small integers are stored 0..8191 *)
+#av int_offset = 2048; (* small integers are stored -2048..2047 *)
+#pw int_offset = 32767; (* PERQ and WICAT items are records *)
+#dt (* instead of -4096..4095 because it will pack smaller *)
+#dt (* under ucsd pascal. *)
+
+ (* the various tags - can't use a defined scalar type *)
+ (* because of the lack of convertion functions. *)
+ inttag = 0; (* info is an integer *)
+ chartag = 1; (* info is a character code *)
+ pairtag = 2; (* info points to pair *)
+ idtag = 3; (* info points to identifier *)
+ codetag = 4; (* info is index into a case statement *)
+ (* that calls appropriate function. *)
+ errtag = 5; (* info is an error code - see below. *)
+ fixtag = 6; (* info points to a full word (or *)
+ (* longer) integer. *)
+ flotag = 7; (* info points to a float number. *)
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on a non-pair. *)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells (etc?) *)
+ noint = 5; (* no free integer space after garbage collection *)
+ notid = 6;
+
+ (* data space sizes *)
+#adwv maxpair = 10000; (* max number of pairs allowed. *)
+#p maxpair = 3700; (* max number of pairs allowed. *)
+#t maxpair = 1000; (* max number of pairs allowed *)
+#t maxident = 400; (* max number of identifiers *)
+#adpwv maxident = 800; (* max number of identifiers *)
+#adpwv maxstrsp = 4500; (* size of string (literal) storage space. *)
+#t maxstrsp = 2000; (* size of string (literal) storage space. *)
+ maxintsp = 200; (* max number of long integers allowed *)
+#t maxflosp = 2; (* max number of floating numbers allowed *)
+#adpwv maxflosp = 50; (* max number of floating numbers allowed *)
+
+ hidmax = 50; (* number of hash values for identifiers *)
+ maxgcstk = 100; (* size of garbage collection stack. *)
+ stksize = 500; (* stack size *)
+ maxreg = 15; (* number of registers in lisp machine. *)
+
+ eofcode = 26; (* magic character code for eof, ascii for *)
+ (* cntrl-z. kludge, see note in xrdtok. *)
+ choffset = 1; (* add choffset to ascii code to get address *)
+ (* in id space for corresponding identifier. *)
+ nillnk = 0; (* when integers are used as pointers. *)
+ end_flag = maxint; (* marks end of fixnum space *)
+
+ (************************************************************)
+
+TYPE
+#w regblk_type:array[0..16] of longint;
+#d onechar = ascii; (* for DEC *)
+#aptvw onechar = char; (* for terak,perq,Apollo,Wicat*)
+#a real= integer32; (* Kludge, no reals yet *)
+#p FileName= String; (* For PERQ FileName *)
+#atwv FileName=Packed ARRAY[0..8] of onechar;
+#d FileName=Packed ARRAY[1..9] of onechar;
+ (* note we allow zero for id_ptr, allowing a "nil" link. *)
+
+ stringp = 1..maxstrsp; (* pointer into string space. *)
+ id_ptr = 0..maxident; (* pointer into id space. *)
+
+#adtv itemref = integer;
+#pw itemref = RECORD
+#pw tag:integer;
+#pw info:integer;
+#pw END;
+ itemtype = 0..7; (* the tags *)
+
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ (* OLD markflag:boolean , but wastes space *)
+ END;
+
+
+#aw ascfile = text;
+#dptv ascfile = PACKED FILE OF onechar;
+#d textfile =PACKED FILE of char;
+#a (* No PASCAL file I/O yet *)
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+#dptvw longint = integer;
+#a longint = integer; (* Should be integer32 ? *)
+
+ (************************************************************)
+
+VAR
+ (* global information *)
+ nilref, trueref, tmpref: itemref;
+ (* refers to identifiers "nil", "t", and a temp to get around bug in. *)
+ (* apollo & wicat pascal *)
+ initphase: integer; (* Start up *)
+#adpvw r: ARRAY[1..maxreg] OF itemref;
+#t r: ARRAY[0..maxreg] OF itemref; (* cuts code size down *)
+ rxx,ryy: itemref;
+
+#tw CHARCNT: INTEGER; (* input buffer & pointer *)
+#tw LINE: STRING;
+
+ (* "st" is the stack pointer into "stk". it counts the number of *)
+ (* items on the stack, so it runs from zero while the stack starts *)
+ (* at one. *)
+ st: 0..stksize;
+ stk: ARRAY[1..stksize] OF itemref;
+
+ (* pair space *)
+ prspace: PACKED ARRAY[1..maxpair] OF pair; (* all pairs stored here. *)
+ freepair: integer; (* pointer to next free pair in prspace. *)
+
+ (* identifier space *)
+ idhead: ARRAY[0..hidmax] OF id_ptr;
+ idspace: PACKED ARRAY[1..maxident] OF ident;
+ freeident: integer;
+ g_sym: ARRAY[1..max_gsym] OF onechar;
+
+ (* string space *)
+ strspace: PACKED ARRAY[1..maxstrsp] OF onechar;
+ freestr: stringp;
+
+ (* large integer space *)
+ intspace: ARRAY[1..maxintsp] OF longint; (* use long int on terak *)
+ freeint: 1..maxintsp;
+
+ (* floating point number space *)
+ flospace: ARRAY[1..maxflosp] OF real;
+ freefloat: 1..maxflosp;
+
+ (* i/o channels *)
+#p (* files declared on header *)
+#adptvw symin: ascfile;
+#adptvw finput : ascfile;
+#aptvw foutput: ascfile;
+#d foutput: textfile;
+#d input: ascfile;
+#a IoStatus:Integer32;
+ inchnl: 1..inchns; (* current input channel number *)
+ outchnl: 1..outchns; (* current output channel number *)
+
+ (* "current character" for each input channel. *)
+ (* may want to include more than one character at some later date *)
+ (* (for more lookahead). *)
+ ichrbuf: ARRAY[1..inchns] OF onechar;
+
+ (* for collecting statistics. *)
+ gccount: integer; (* counts garbage collections *)
+ (* counts from last garbage collection. *)
+ consknt: integer; (* number of times "cons" called *)
+
+
+
+(* ........ Everything nested inside CATCH *)
+
+#w procedure _setjmp(var regblk:regblk_type);external;
+#w procedure _long_jump(var regblk:regblk_type);external;
+
+Procedure Xcatch; (* ----------- Outermost Procedure ----------- *)
+#adv LABEL 9999;
+#w (* need to use special ASM68 procedures for Wicat *)
+ var catch_stk:0..stksize;
+ catch_Bstk:itemref;
+#w Catch_regs:regblk_type;
+
+#t Procedure xeval;
+#t Forward;
+PROCEDURE xread;
+ FORWARD;
+
+PROCEDURE xprint;
+ FORWARD;
+
+PROCEDURE xunbindto;
+ FORWARD;
+
+PROCEDURE xeval;
+ FORWARD;
+
+ Procedure Xthrow;
+ begin (* throw value *)
+ idspace[Xthrowing].val := trueref;
+#dav goto 9999
+#w _long_jump(Catch_regs);
+#tp exit(xeval)
+ end (* throw *);
+#p (* Special handlers *)
+#p Handler CtlC; (* ------- handle runaway aborts ------- *)
+
+#p begin
+#p write('^C');
+#p IOKeyClear;
+#p IObeep;
+#p if initphase > 1 then Xthrow;
+#p end;
+
+ (********************************************************)
+ (* *)
+ (* item selectors & constructors *)
+ (* *)
+ (********************************************************)
+
+#a (* use some SHIFTS ? *)
+
+FUNCTION tag_of(item: itemref): itemtype;
+#t VAR gettag: PACKED RECORD
+#t CASE boolean OF
+#t TRUE: (i: itemref);
+#t FALSE: (info: 0..8191;
+#t tag: 0..7)
+#t END;
+
+ BEGIN (* tag_of *)
+#t gettag.i := item;
+#t tag_of := gettag.tag
+#adv tag_of := item DIV shift_const;
+#pw tag_of := item.tag;
+ END;
+ (* tag_of *)
+
+FUNCTION info_of(item: itemref): integer;
+#t VAR getinfo: PACKED RECORD
+#t CASE boolean OF
+#t TRUE: (i: itemref);
+#t FALSE: (info: 0..8191;
+#t tag: 0..7)
+#t END;
+
+ BEGIN (* info_of *)
+#t getinfo.i := item;
+#t if getinfo.tag = inttag then
+#t info_of := getinfo.info - int_offset
+#t else info_of := getinfo.info
+#adv IF item DIV shift_const = inttag THEN
+#adv info_of := item MOD shift_const - int_offset
+#adv ELSE
+#adv info_of := item MOD shift_const
+#pw info_of := item.info
+ END;
+ (* info_of *)
+
+FUNCTION xnull(item: itemref): boolean;
+ BEGIN
+ xnull := (tag_of(item) = tag_of(nilref)) AND
+ (info_of(item) = info_of(nilref))
+ END;
+
+
+PROCEDURE mkitem(tag: itemtype; info: longint; VAR item: itemref);
+ (* do range checking on info. ints run from -4096 to +4095 *)
+ (* everything else runs from 0 to 8191. ints & chars *)
+ (* contain their info, all others points into an *)
+ (* appropriate space. *)
+
+ PROCEDURE mkfixint;
+ VAR nextfree: integer;
+
+ PROCEDURE gc_int;
+ VAR i: integer;
+ mark_flag: PACKED ARRAY[1..maxintsp] OF boolean;
+
+
+ PROCEDURE mark(u: itemref);
+ BEGIN (* Mark *)
+ IF tag_of(u) = pairtag THEN
+ BEGIN
+ mark(prspace[info_of(u)].prcar);
+ mark(prspace[info_of(u)].prcdr)
+ END
+ ELSE IF tag_of(u) = fixtag THEN
+ mark_flag[info_of(u)] := true
+ END (* Mark *);
+
+ BEGIN (* Gc_int *)
+ writeln('*** Gc int');
+ FOR i := 1 TO maxintsp do (* clear mark flags *)
+ mark_flag[i] := false;
+
+ FOR i := 1 TO st DO (* mark from the stack *)
+ Mark(stk[i]);
+
+ FOR i := 1 TO maxident DO (* mark from the symbol table *)
+ BEGIN
+ Mark(idspace[i].val);
+ Mark(idspace[i].plist);
+ Mark(idspace[i].funcell) (* probably NOT necessary *)
+ END;
+
+ (* reconstruct free list *)
+ FOR i := 1 TO maxintsp - 1 DO
+ IF NOT mark_flag[i] THEN
+ BEGIN
+ intspace[i] := freeint;
+ freeint := i
+ END
+ END (* Gc_int *);
+
+ BEGIN (* mkfixint *)
+ IF intspace[freeint] = end_flag THEN
+ gc_int; (* garbage collect intspace *)
+
+ IF intspace[freeint] <> end_flag THEN
+ BEGIN (* convert to fixnum *)
+ tag := fixtag;
+ nextfree := intspace[freeint];
+ intspace[freeint] := info;
+ info := freeint; (* since we want the pointer *)
+ freeint := nextfree
+ END
+ ELSE
+ BEGIN mkitem(errtag,noint, r[1]);
+ writeln('***** Integer space exhausted')
+ END
+ END;
+ (* mkfixint *)
+
+
+ BEGIN (* mkitem *)
+ IF tag = inttag THEN
+#pw BEGIN
+ IF (info < -int_offset) OR (info > int_offset - 1) THEN mkfixint
+#adtv ELSE info := info + int_offset (* info was in range so add offset *)
+#pw END
+ ELSE IF tag = fixtag THEN mkfixint
+
+ ELSE IF info < 0 THEN
+ BEGIN
+ writeln('*****MKITEM: BAD NEG');
+#d break(output);
+#dtv halt;
+#p exit(pas0);
+#a pgm_$exit;
+ END;
+ (* nothing special to do for other types *)
+
+ (* pack tag and info into 16-bit item. *)
+#adtv item := tag * shift_const + info
+#pw item.tag := tag;
+#pw item.info := info
+ END;
+ (* mkitem *)
+
+PROCEDURE mkerr(info: longint; VAR item: itemref);
+ Begin
+ mkitem(errtag,info,item);
+ End;
+
+
+PROCEDURE set_info(VAR item: itemref; newinfo: longint);
+ BEGIN (* set_info *)
+ mkitem(tag_of(item), newinfo, item)
+ END;
+ (* set_info *)
+
+PROCEDURE set_tag(VAR item: itemref; newtag: itemtype);
+ BEGIN (* set_tag *)
+ mkitem(newtag, info_of(item), item)
+ END;
+ (* set_tag *)
+
+PROCEDURE mkident(id: integer; reg: integer);
+ (* make identifier "id" in register "reg" *)
+ BEGIN (* mkident *)
+ mkitem(idtag, id, r[reg]);
+ END;
+ (* mkident *)
+
+PROCEDURE mkint(int: longint; reg: integer);
+ BEGIN (* mkint *)
+ mkitem(inttag, int, r[reg]);
+ END;
+ (* mkint *)
+
+PROCEDURE mkpair(pr: integer; reg: integer);
+ BEGIN (* mkpair *)
+ mkitem(pairtag, pr, r[reg])
+ END;
+ (* mkpair *)
+
+PROCEDURE int_val(item: itemref; VAR number: longint);
+ (* returns integer value of item (int or fixnum). *)
+ (* must return 'number' in var parameter instead *)
+ (* of function value since long integers are not *)
+ (* a legal function type in ucsd pascal. *)
+ BEGIN (* int_val *)
+ IF tag_of(item) = inttag THEN
+ number := info_of(item)
+ ELSE IF tag_of(item) = fixtag THEN
+ number := intspace[info_of(item)]
+ ELSE writeln('***** ILLEGAL DATA TYPE FOR NUMERIC OPERATION')
+ (* halt or fatal error *)
+ END;
+ (* int_val *)
+
+
+ (********************************************************)
+ (* *)
+ (* stack allocation *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE alloc(n: integer);
+ BEGIN
+ IF n + st <= stksize THEN
+ st := n+st
+ ELSE
+ BEGIN
+ writeln('*****LISP STACK OVERFLOW');
+ writeln(' TRIED TO ALLOCATE ',n);
+ writeln(' CURRENT STACK TOP IS ',st);
+#d break(output);
+ END;
+ END;
+
+PROCEDURE dealloc(n: integer);
+ BEGIN
+ IF st - n >= 0 THEN
+ st := st - n
+ ELSE
+ writeln('*****LISP STACK UNDERFLOW');
+ END;
+
+ (* optimized allocs *)
+
+PROCEDURE alloc1;
+ BEGIN alloc(1) END;
+
+PROCEDURE dealloc1;
+ BEGIN dealloc(1) END;
+
+PROCEDURE alloc2;
+ BEGIN alloc(2) END;
+
+PROCEDURE dealloc2;
+ BEGIN dealloc(2) END;
+
+PROCEDURE alloc3;
+ BEGIN alloc(3) END;
+
+PROCEDURE dealloc3;
+ BEGIN dealloc(3) END;
+
+
+ (********************************************************)
+ (* *)
+ (* support for register model *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE load(reg: integer; sloc: integer);
+ BEGIN
+ IF sloc < 0 THEN r[reg] := r[-sloc]
+ ELSE r[reg] := stk[st-sloc];
+ (* will, fix for load (pos,pos) *)
+ END;
+
+PROCEDURE store(reg: integer; sloc: integer);
+ BEGIN
+ stk[st-sloc] := r[reg];
+ END;
+
+ (* optimized load/store. *)
+PROCEDURE load10;
+ BEGIN
+ load(1,0);
+ END;
+
+PROCEDURE store10;
+ BEGIN
+ store(1,0);
+ END;
+
+PROCEDURE storenil(sloc: integer);
+ BEGIN
+ stk[st-sloc] := nilref;
+ END;
+
+(* Other primitives ?? *)
+
+ (********************************************************)
+ (* *)
+ (* identifier lookup & entry *)
+ (* *)
+ (********************************************************)
+
+function nmhash(nm: stringp): integer;
+ CONST
+ hashc = 256;
+ VAR
+ i,tmp: integer;
+ BEGIN
+ tmp := 0;
+ i := 1; (* get hash code from first three chars of string. *)
+ WHILE (i <= 3) AND (strspace[nm+i] <> eos) DO
+ BEGIN
+ tmp := ord(strspace[nm+i]) + hashc*tmp;
+ i := i + 1;
+ END;
+ nmhash := abs(tmp) MOD hidmax; (* abs because mod is screwy. *)
+ END;
+
+FUNCTION eqstr(s1,s2: stringp): boolean;
+ BEGIN
+ WHILE (strspace[s1] = strspace[s2]) AND (strspace[s1] <> eos) DO
+ BEGIN
+ s1 := s1 + 1;
+ s2 := s2 + 1;
+ END;
+ eqstr := (strspace[s1] = strspace[s2]);
+ END;
+
+PROCEDURE nmlookup(nm: stringp; VAR found: boolean; VAR hash: integer;
+ VAR loc: itemref);
+ (* lookup a name in "identifier space". *)
+ (* "hash" returns the hash value for the name. *)
+ (* "loc" returns the location in the space for the (possibly new) *)
+ (* identifier. *)
+ BEGIN
+ hash := nmhash(nm);
+ mkitem(idtag, idhead[hash], loc);
+ (* default is identifier, but may be "error". *)
+ (* start at appropriate hash chain. *)
+
+ found := false;
+ WHILE (info_of(loc) <> nillnk) AND (NOT found) DO
+ BEGIN
+ found := eqstr(nm, idspace[info_of(loc)].idname);
+ IF NOT found THEN
+ set_info(loc, idspace[info_of(loc)].idhlink);
+ (* next id in chain *)
+ END;
+ IF NOT found THEN (* find spot for new identifier *)
+ BEGIN
+ IF freeident=nillnk THEN (* no more free identifiers. *)
+ mkerr( noidspace, loc)
+ ELSE
+ BEGIN
+ set_info(loc, freeident);
+ freeident := idspace[freeident].idhlink;
+ END;
+ END;
+ END;
+
+PROCEDURE putnm(nm: stringp; VAR z: itemref; VAR found: boolean);
+ (* put a new name into identifier space, or return old location *)
+ (* if it's already there. *)
+ VAR
+ tmp: ident;
+ hash: integer;
+ BEGIN
+ nmlookup(nm, found, hash, z);
+ IF (NOT found) AND (tag_of(z) = idtag) THEN
+ BEGIN
+ tmp.idname := nm;
+ tmp.idhlink := idhead[hash]; (* put new ident at head of chain *)
+ tmp.val := nilref; (* initialize value and property list *)
+ tmp.plist := nilref;
+ tmp.funcell := nilref; (* also, the function cell *)
+ idhead[hash] := info_of(z);
+ idspace[info_of(z)] := tmp;
+ END;
+ END;
+
+PROCEDURE xfaststat;
+ (* give quick summary of statistics gathered *)
+ BEGIN
+ writeln('CONSES:',consknt);
+ writeln('ST :',st);
+#d break(output)
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* the garbage collector *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xgcollect;
+ VAR
+ i: integer;
+ markedk: integer; (* counts the number of pairs marked *)
+ freedk: integer; (* counts the number of pairs freed. *)
+ gcstkp: 0..maxgcstk; (* note the garbage collection stack *)
+ mxgcstk: 0..maxgcstk; (* is local to this procedure. *)
+ gcstk: ARRAY[1..maxgcstk] OF integer;
+ markflag: PACKED ARRAY[1..maxpair] OF boolean;
+(* used not to have array here *)
+
+ PROCEDURE pushref(pr: itemref);
+ (* push the address of an unmarked pair, if that's what it is. *)
+ BEGIN
+ IF tag_of(pr) = pairtag THEN
+ IF NOT markflag[info_of(pr)] THEN (* was .markflag *)
+ BEGIN
+ IF gcstkp < maxgcstk THEN
+ BEGIN
+ gcstkp := gcstkp + 1;
+ gcstk[gcstkp] := info_of(pr);
+ IF gcstkp > mxgcstk THEN
+ mxgcstk := gcstkp;
+ END
+ ELSE
+ BEGIN
+ writeln('*****GARBAGE STACK OVERFLOW');
+#dtv halt;
+#p exit(pas0);
+#a pgm_$exit;
+ END;
+ END;
+ END;
+
+ PROCEDURE mark;
+ (* "recursively" mark pairs referred to from gcstk. gcstk is used to *)
+ (* simulate recursion. *)
+ VAR
+ prloc: integer;
+ BEGIN
+ WHILE gcstkp > 0 DO
+ BEGIN
+ prloc := gcstk[gcstkp];
+ gcstkp := gcstkp - 1;
+ markflag[prloc] := true;
+(* OLD prspace[prloc].markflag := true; *)
+ pushref(prspace[prloc].prcdr);
+ pushref(prspace[prloc].prcar); (* trace the car first. *)
+ END;
+ END;
+
+ BEGIN (* xgcollect *)
+ writeln('***GARBAGE COLLECTOR CALLED');
+#d break(output);
+ gccount := gccount + 1; (* count garbage collections. *)
+ xfaststat; (* give summary of statistics collected *)
+ consknt := 0; (* clear out the cons counter *)
+ gcstkp := 0; (* initialize the garbage stack pointer. *)
+ mxgcstk := 0; (* keeps track of max stack depth. *)
+
+ (* clear markflags *)
+ FOR i := 1 TO maxpair DO markflag[i] := false;
+ (* OLD: wasnt needed *)
+ (* mark things from the "computation" stack. *)
+ FOR i := 1 TO st DO
+ BEGIN
+ pushref(stk[i]);
+ mark;
+ END;
+ (* mark things from identifier space. *)
+ FOR i := 1 TO maxident DO
+ BEGIN
+ pushref(idspace[i].val);
+ mark;
+ pushref(idspace[i].plist);
+ mark;
+ pushref(idspace[i].funcell);
+ mark;
+ END;
+
+ (* reconstruct free list by adding things to the head. *)
+ freedk := 0;
+ markedk := 0;
+ FOR i:= 1 TO maxpair - 1 DO
+ BEGIN
+ IF markflag[i] THEN
+ (* OLD: IF prspace[i].markflag THEN *)
+ BEGIN
+ markedk := markedk + 1;
+ markflag[i] := false
+ (* OLD: prspace[i].markflag := false *)
+ END
+ ELSE
+ BEGIN
+ prspace[i].prcar := nilref;
+ mkitem(pairtag, freepair, prspace[i].prcdr);
+ freepair := i;
+ freedk := freedk + 1
+ END
+ END;
+ writeln(freedk,' PAIRS FREED.');
+ writeln(markedk,' PAIRS IN USE.');
+ writeln('MAX GC STACK WAS ',mxgcstk);
+#d break(output);
+ END;
+ (* xgcollect *)
+
+ (********************************************************)
+ (* *)
+ (* lisp primitives *)
+ (* *)
+ (********************************************************)
+
+ (* return r[1].r[2] in r[1] *)
+PROCEDURE xcons;
+ VAR p: integer;
+
+ BEGIN
+ (* push args onto stack, in case we need to garbage collect the *)
+ (* references will be detected. *)
+ alloc(2);
+ stk[st] := r[1];
+ stk[st-1] := r[2];
+
+ IF xNull(prspace[freepair].prcdr) THEN xgcollect;
+
+ p := freepair;
+ freepair := info_of(prspace[p].prcdr);
+ prspace[p].prcar := stk[st];
+ prspace[p].prcdr := stk[st - 1];
+ mkpair(p, 1); (* leave r[1] pointing at new pair. *)
+
+ consknt := consknt + 1;
+ dealloc(2);
+ END;
+
+PROCEDURE xncons;
+ BEGIN r[2] := nilref;
+ xcons;
+ END;
+
+PROCEDURE xxcons;
+ BEGIN rxx := r[1];
+ r[1] := r[2];
+ r[2] := rxx;
+ xcons;
+ END;
+
+ (* return car of r[1] in r[1] *)
+PROCEDURE xcar;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcar
+ ELSE
+ mkerr( notpair, r[1]);
+ END;
+
+PROCEDURE xcdr;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcdr
+ ELSE
+ mkerr( notpair, r[1]);
+ END;
+
+PROCEDURE xrplaca;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ prspace[info_of(r[1])].prcar:=r[2]
+ ELSE
+ mkerr( notpair, r[1]);
+ END;
+
+PROCEDURE xrplacd;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ prspace[info_of(r[1])].prcdr :=r[2]
+ ELSE
+ mkerr( notpair, r[1]);
+ END;
+
+ (* anyreg car and cdr *)
+PROCEDURE anycar(a: itemref; VAR b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcar
+ ELSE
+ mkerr( notpair, b);
+ END;
+
+PROCEDURE anycdr(a: itemref; VAR b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcdr
+ ELSE
+ mkerr( notpair, b);
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* compress & explode *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE compress; (* returns new id from list of chars *)
+ VAR i: stringp;
+ clist, c: itemref;
+ found: boolean;
+ int: integer;
+
+ FUNCTION is_int(i: stringp; VAR int: longint): boolean;
+ VAR negative, could_be: boolean;
+
+ BEGIN (* is_int *)
+ int := 0;
+ could_be := true;
+ negative := strspace[i] = '-';
+ IF negative OR (strspace[i] = '+') THEN i := i + 1;
+
+ WHILE could_be AND (strspace[i] <> eos) DO
+ BEGIN
+ IF (strspace[i] >= '0') AND (strspace[i] <= '9') THEN
+ int := int * 10 + (ord(strspace[i]) - ord('0'))
+ ELSE could_be := false;
+ i := i + 1
+ END;
+
+ IF negative THEN int := -int;
+ is_int := could_be
+ END (* is_int *);
+
+ BEGIN (* compress *)
+ clist := r[1]; (* list of chars *)
+ i := freestr; (* point to possible new string *)
+
+ WHILE (i < maxstrsp) AND NOT xNull(clist) DO
+ BEGIN
+ IF tag_of(clist) = PAIRTAG THEN
+ BEGIN
+ c := prspace[info_of(clist)].prcar;
+ clist := prspace[info_of(clist)].prcdr;
+ IF tag_of(c) = IDTAG THEN
+ IF (info_of(c) > choffset) AND
+ (info_of(c) < choffset + 128) THEN
+ BEGIN
+ strspace[i] := chr(info_of(c) - choffset);
+ i := i + 1
+ END
+ ELSE
+ writeln('*****COMPRESS: LIST ID NOT SINGLE CHAR')
+ ELSE
+ writeln('*****COMPRESS: LIST ITEM NOT ID');
+ END
+ ELSE
+ writeln('*****COMPRESS: ITEM NOT LIST')
+ END (* WHILE *);
+
+ strspace[i] := eos; (* terminate string *)
+
+ IF (i >= maxstrsp) THEN
+ writeln('*****STRING SPACE EXHAUSTED')
+ ELSE IF is_int(freestr, int) THEN
+ mkint(int, 1)
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END
+ END (* compress *);
+
+PROCEDURE explode; (* returns list of chars from id or int *)
+
+ FUNCTION id_explode(i: stringp): itemref;
+ BEGIN (* id_explode *)
+ IF strspace[i] = eos THEN id_explode := nilref
+ ELSE
+ BEGIN
+ r[2] := id_explode(i + 1);
+ mkident(ord(strspace[i]) + choffset, 1);
+ xcons;
+ id_explode := r[1]
+ END
+ END (* id_explode *);
+
+ FUNCTION int_explode(i: integer): itemref;
+ VAR negative: boolean;
+
+ BEGIN (* int_explode *)
+ r[1] := nilref;
+ IF i < 0 THEN
+ BEGIN negative := true;
+ i := -i
+ END
+ ELSE negative := false;
+
+ WHILE i > 0 DO
+ BEGIN
+ r[2] := r[1];
+ mkident(i MOD 10 + ord('0') + choffset, 1);
+ xcons;
+ i := i DIV 10
+ END;
+
+ IF negative THEN
+ BEGIN
+ r[2] := r[1];
+ mkident(ord('-') + choffset, 1);
+ xcons
+ END;
+ int_explode := r[1]
+ END (* int_explode *);
+
+ BEGIN (* explode *)
+ IF tag_of(r[1]) = IDTAG THEN
+ r[1] := id_explode(idspace[info_of(r[1])].idname)
+ ELSE IF tag_of(r[1]) = INTTAG THEN
+ r[1] := int_explode(info_of(r[1]))
+ ELSE IF tag_of(r[1]) = FIXTAG THEN
+ r[1] := int_explode(intspace[info_of(r[1])])
+ ELSE
+ writeln('***** EXPLODE: ARG BAD TYPE')
+ END (* explode *);
+
+PROCEDURE gensym;
+ VAR i: integer;
+
+ PROCEDURE kick(i: integer); (* increments gsym digit *)
+ BEGIN (* Kick *)
+ IF (g_sym[i] = '9') THEN
+ BEGIN
+ g_sym[i] := '0';
+ IF (i < max_gsym) THEN kick(i + 1) (* otherwise wrap around *)
+ END
+ ELSE g_sym[i] := succ(g_sym[i])
+
+ END (* Kick *);
+
+ BEGIN (* gensym *)
+ r[1] := nilref;
+
+ FOR i := 1 TO max_gsym DO
+ BEGIN
+ r[2] := r[1];
+ mkident(ord(g_sym[i]) + choffset, 1);
+ xcons
+ END;
+ r[2] := r[1];
+ mkident(ord('G') + choffset, 1);
+ xcons;
+ compress;
+
+ Kick(1);
+ END; (* gensym *)
+
+
+ (********************************************************)
+ (* *)
+ (* i/o primitives *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xopen; (* Simple OPEN, but see NPAS0 *)
+
+var s1: FileName;
+ i,j : integer;
+#p (* catch some I/O errors *)
+#p handler ResetError(name: PathName);
+#p begin
+#p writeln('**** Could not open file - ',name,' for read');
+#p exit(xopen);
+#p end;
+
+#p handler RewriteError(name: PathName);
+#p begin
+#p writeln('**** Could not open file - ',name,' for write');
+#p exit(xopen);
+#p end;
+
+begin
+ IF tag_of(r[1]) = IDTAG THEN
+ begin
+ i := idspace[info_of(r[1])].idname;
+#p s1[0] := chr(255); (* set length *)
+#d s1:=' ';
+ j:= 0;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos)
+#d AND (j <9 )
+ do
+ begin
+ j:= j + 1;
+ s1[j] := strspace[i];
+ i:= i + 1;
+ end;
+#p s1[0]:= chr(j); (* set Actual Length *)
+
+ IF tag_of(r[2]) = IDTAG THEN
+ BEGIN
+ If info_of(r[2])= Xinput then
+ begin
+#p reset(finput,s1);
+#d reset(finput,s1,0,0,'DSK ');
+ mkint(3,1) end
+ else if info_of(r[2])= Xoutput then
+ begin
+#p rewrite(foutput,s1);
+#d rewrite(foutput,s1,0,0,'DSK ');
+ mkint(2,1) end
+ else
+ begin writeln('**** OPEN: ARG2 NOT INPUT/OUTPUT');
+ mkerr(notid,r[1])
+ end
+ end else writeln('**** OPEN: ARG2 BAD TYPE')
+ end else writeln('**** OPEN: ARG1 BAD TYPE');
+end;
+
+procedure xclose;
+
+begin
+ case info_of(r[1]) of
+ 1: ;
+#d 2: break(output);
+#a 3: close(finput);
+#d 3: ;
+#ap 4: close(foutput);
+#d 4: break(foutput);
+ end;
+end;
+
+PROCEDURE xrds;
+ (* Select channel for input *)
+ VAR tmp: longint;
+ BEGIN
+ tmp:=inchnl;
+ inchnl := info_of(r[1]);
+ mkint(tmp,1)
+ END;
+
+PROCEDURE Xwrs;
+ (* Select channel for output *)
+ VAR tmp:longint;
+ BEGIN
+ tmp:=outchnl;
+ outchnl := info_of(r[1]);
+ mkint(tmp,1)
+ END;
+
+PROCEDURE xterpri;
+(* need to change for multiple output channels. *)
+ BEGIN
+ CASE outchnl OF
+#p 1: writeln(' ');
+#d 1: begin writeln(output); break(output); end;
+#dp 2: begin writeln(foutput,' '); break(foutput); end;
+#awtv 1: writeln(output);
+#wtv 2: writeln(foutput);
+ END (* CASE *)
+ END;
+
+#adv FUNCTION Int_field(I:integer):Integer;
+#adv Begin
+#adv Int_field:=2+trunc(log(abs(I)));
+#adv END;
+
+PROCEDURE XwriteInt(I:integer);
+ BEGIN
+#adptw CASE outchnl OF
+#p 1: write(' ', I:0);
+#dv 1: If I=0 then Write('0') else write(I:Int_field(I) );
+#atw 1: write(i);
+#p 2: write(foutput,' ', I:0);
+#dv 2: If I=0 then Write(foutput,'0') else write(foutput,I:Int_field(I) );
+#atw 2: write(foutput, i);
+#adptw END (* CASE *)
+ END (* XwriteInt *);
+
+PROCEDURE Xwritereal(R:real);
+ BEGIN
+#adtpw CASE outchnl OF
+#p 1: write(' real Bug ', trunc(R));
+#adtvw 1: write(output,R);
+#p 2: write(foutput,' real Bug ', trunc(R));
+#dtvw 2: write(foutput,R);
+#adtpw END (* CASE *)
+ END;
+
+PROCEDURE XwriteChar(C:onechar);
+ BEGIN
+#adptw CASE outchnl OF
+#p 1: write(' ', C);
+#adtvw 1: write(C);
+#p 2: write(foutput,' ', C);
+#adtvw 2: write(foutput,C);
+#adptw END (* CASE *)
+ END;
+
+PROCEDURE xwrtok;
+ (* doesn't expand escaped characters in identifier names *)
+ VAR i: integer;
+ BEGIN
+ IF tag_of(r[1]) = inttag THEN XwriteInt(info_of(R[1]))
+ ELSE IF tag_of(r[1]) = fixtag THEN XwriteInt(intspace[info_of(R[1])])
+ ELSE IF tag_of(r[1]) = flotag THEN XwriteReal(flospace[info_of(r[1])])
+ ELSE IF tag_of(r[1]) = idtag THEN
+ BEGIN
+ i := idspace[info_of(r[1])].idname;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> eos) DO
+ BEGIN
+ XwriteChar(strspace[i]);
+ i:= i + 1;
+ END;
+ END
+ ELSE IF tag_of(r[1]) = chartag THEN
+ XwriteChar(chr(info_of(r[1]) - choffset))
+ ELSE IF tag_of(r[1]) = errtag THEN
+ Begin XwriteChar(' ');
+ XwriteChar('*'); XwriteChar('*'); XwriteChar('*');
+ XwriteChar(' '); XwriteChar('#'); XwriteChar(' ');
+ XwriteInt(info_of(r[1])); Xterpri;
+ End
+ ELSE IF tag_of(r[1]) = codetag THEN
+ Begin XwriteChar(' '); XwriteChar('#'); XwriteChar('#');
+ XwriteInt(info_of(r[1]));
+ End
+ ELSE
+ Begin
+ XwriteChar(' '); XwriteChar('?'); XwriteChar(' ');
+ XwriteInt(tag_of(r[1]));
+ XwriteChar(' '); XwriteChar('/'); XwriteChar(' ');
+ XwriteInt(info_of(r[1]));
+ XwriteChar(' '); XwriteChar('?'); XwriteChar(' ');
+ End;
+#d break(output);
+ END;
+
+PROCEDURE rdchnl(chnlnum: integer; VAR ch: onechar);
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ writeln('*****BAD INPUT CHANNEL FOR RDCHNL',chnlnum)
+ ELSE
+ CASE chnlnum OF
+ 1: BEGIN
+#adptvw ch := symin^; (* a little strange, but avoids *)
+#adptvw get(symin); (* initialization problems *)
+#adptvw ichrbuf[inchnl] := symin^; (* Peek ahead *)
+ END;
+
+ 2: BEGIN
+#tw IF charcnt > Length(line) THEN
+#tw BEGIN
+#tw charcnt := 1;
+#tw Readln(line)
+#tw END;
+#tw ch := line[charcnt];
+#tw IF Length(line) > charcnt THEN
+#tw ichrbuf[inchnl] := line[charcnt + 1]
+#tw ELSE ichrbuf[inchnl] := sp;
+#tw charcnt := charcnt + 1
+#adpv ch := input^;
+#adpv get(input);
+#adpv ichrbuf[inchnl] := input^;
+ END;
+#dp 3: begin
+#dp ch := finput^;
+#dp get(finput);
+#dp ichrbuf[inchnl] := finput^;
+#dp END;
+ END;
+ (* case *)
+ END;
+ (* rdchnl *)
+
+FUNCTION eofchnl: boolean;
+ BEGIN
+#adptvw CASE inchnl OF
+#adptvw 1: eofchnl := eof(symin);
+#adptvw 2: eofchnl := eof(input);
+#adptvw 3: eofchnl := eof(finput);
+#adptvw END;
+ END;
+
+ FUNCTION eol: boolean;
+ BEGIN
+ CASE inchnl OF
+ 1: eol := eoln(symin);
+ 2: eol := eoln(input);
+ 3: eol := eoln(finput);
+ END;
+ END;
+
+ (********************************************************)
+ (* *)
+ (* token scanner *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xrdtok;
+LABEL 1;
+
+ VAR
+ ch,ch1,ChangedCh: onechar;
+ i: integer;
+ anint: longint;
+ moreid: boolean;
+ found: boolean;
+ negflag: integer;
+
+ FUNCTION digit(ch: onechar): boolean;
+ BEGIN
+ digit := ( '0' <= ch ) AND ( ch <= '9');
+ END;
+
+
+ FUNCTION escalpha(VAR ch: onechar): boolean;
+ (* test for alphabetic or escaped character. *)
+ (* note side effect in ChangedCh. *)
+ BEGIN
+ ChangedCh := Ch;
+ IF ( 'A' <= ch ) AND ( ch <= 'Z') THEN
+ escalpha := true
+ ELSE IF ( ord('A')+32 <= ord(ch)) AND ( ord(ch) <= ord('Z')+32) THEN
+ BEGIN
+ IF NOT xNull(idspace[xraise].val) THEN
+ Changedch := chr(ord(ch)-32);
+ escalpha := true; (* lower case alphabetics *)
+ END
+ ELSE IF ch='!' THEN
+ BEGIN
+ rdchnl(inchnl,ch);
+ ChangedCh:=Ch;
+ escalpha := true;
+ END
+ ELSE
+ escalpha := false;
+ END;
+
+ FUNCTION alphanum(VAR ch: onechar): boolean;
+ (* test if escalfa or digit *)
+ VAR b: boolean;
+ BEGIN
+ ChangedCh:=Ch;
+ b := digit(ch);
+ IF NOT b THEN b := escalpha(ch);
+ alphanum := b;
+ END;
+
+ FUNCTION whitesp(ch: onechar): boolean;
+#d BEGIN
+#d (* may want a faster test *)
+#d whitesp := (ch = sp) OR (ch = cr) OR (ch = lf) OR (ch = ht)
+#d OR (ch = nul); (* null?? *)
+#aptvw VAR ascode:integer;
+#aptvw BEGIN
+#aptvw ascode:=ord(ch);
+#aptvw WHITESP := (CH = SP) OR (ascode = CR) OR (ascode = LF)
+#aptvw OR (ascode = ht) or (ascode = nul); (* null?? *)
+ END;
+
+ (* reads fixnums...need to read flonums too *)
+ BEGIN (* xrdtok *)
+1:
+ IF NOT eofchnl THEN
+ REPEAT (* skip leading white space. *)
+ rdchnl(inchnl,ch)
+ UNTIL (NOT whitesp(ch)) OR eofchnl;
+ IF eofchnl THEN
+ mkitem(chartag, eofcode + choffset, r[1])
+ (* should really return !$eof!$ *)
+ ELSE
+ BEGIN
+ IF digit(ch) or (ch = '-') THEN
+ set_tag(r[1], inttag)
+ ELSE IF escalpha(ch) THEN
+ set_tag(r[1], idtag)
+ ELSE
+ set_tag(r[1], chartag);
+
+ CASE tag_of(r[1]) OF
+ chartag: BEGIN
+ if ch = begin_comment then
+ BEGIN
+ While not eol do rdchnl(inchnl,ch);
+ rdchnl(inchnl, ch);
+ GOTO 1
+ END;
+ set_tag(r[1], idtag);
+ mkitem(inttag, chartype, tmpref);
+ idspace[xtoktype].val := tmpref;
+ set_info(r[1], ord(ch) + choffset);
+ END;
+ inttag: BEGIN
+ mkitem(inttag, inttype, tmpref;
+ idspace[xtoktype].val :=tmpref;
+ negflag := 1;
+ if ch = '-' then
+ begin anint := 0; negflag :=-1 end
+ else anint := ord(ch) - ord('0');
+ WHILE digit(ichrbuf[inchnl]) DO
+ BEGIN
+ rdchnl(inchnl,ch);
+ anint := 10 * anint + (ord(ch) - ord('0'))
+ END;
+ anint := negflag * anint;
+ set_info(r[1], anint)
+ END;
+ idtag: BEGIN
+ mkitem(inttag, idtype, tmpref);
+ idspace[xtoktype].val:=tmpref;
+ i := freestr; (* point to possible new string *)
+ moreid := true;
+ WHILE (i < maxstrsp) AND moreid DO
+ BEGIN
+ strspace[i] := ChangedCh; (* May have Case Change, etc *)
+ i:= i + 1;
+ moreid :=alphanum(ichrbuf[inchnl]); (* PEEK ahead char *)
+ IF moreid THEN rdchnl(inchnl,ch) (* Advance readch *)
+ END;
+ strspace[i] := eos; (* terminate string *)
+ IF (i >= maxstrsp) THEN
+ writeln('*****STRING SPACE EXHAUSTED')
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END;
+ END;
+ (* of case idtag *)
+ END;
+ (* of case *)
+ END;
+ END;
+ (* xrdtok *)
+ (* for DEBUG *)
+ (********************************************************)
+ (* *)
+ (* initialization *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE init;
+ (* initialization procedure depends on *)
+ (* ability to load stack with constants *)
+ (* from a file. *)
+ VAR
+ strptr: stringp;
+#dptvw nam: PACKED ARRAY[1..3] OF onechar;
+#a nam: PACKED ARRAY[1..4] OF onechar; (* SPL bug for Apollo *)
+ (* holds 'nil', other strings? *)
+ i, n: integer;
+ idref: itemref;
+ found: boolean;
+
+#aptv (* init is divided into two parts so it can compile on terak *)
+ PROCEDURE init1;
+ BEGIN
+#tw CHARCNT := 1;
+#tw LINE := '';
+
+ (* initialize top of stack *)
+ st := 0;
+
+ freefloat := 1;
+ (* initialize fixnum free list *)
+ FOR freeint := 1 TO maxintsp - 1 DO
+ intspace[freeint] := freeint + 1;
+ intspace[maxintsp] := end_flag;
+ freeint := 1;
+
+ (* define nilref - the id, nil, is defined a little later. *)
+ freeident := 1;
+ mkitem(idtag, freeident, nilref);
+
+ (* initialize pair space. *)
+ FOR i := 1 TO maxpair - 1 DO (* initialize free list. *)
+ BEGIN
+ (* OLD: prspace[i].MarkFlag := false; *)
+ prspace[i].prcar := nilref; (* just for fun *)
+ mkitem(pairtag, i + 1, prspace[i].prcdr);
+ END;
+ prspace[maxpair].prcar := nilref;
+ prspace[maxpair].prcdr := nilref; (* end flag *)
+ freepair := 1; (* point to first free pair *)
+
+
+ (* initialize identifier space and string space. *)
+ freestr := 1;
+ FOR i := 0 TO hidmax - 1 DO
+ idhead[i] := nillnk;
+ FOR i := 1 TO maxident DO
+ BEGIN
+ IF i < maxident THEN
+ idspace[i].idhlink := i + 1
+ ELSE (* nil to mark the final identifier in the table. *)
+ idspace[i].idhlink := nillnk;
+ (* set function cells to undefined *)
+ mkerr( undefined, tmpref);
+ idspace[i].funcell :=tmpref;
+ idspace[i].val :=tmpref;
+ idspace[i].plist :=tmpref;
+ END;
+
+ (* nil must be the first identifier in the table--id #1 *)
+ (* must fill in fields by hand for nilref.*)
+ (* putnm can handle any later additions. *)
+ nam := 'NIL';
+ strptr := freestr;
+ FOR i := 1 TO 3 DO
+ BEGIN
+ strspace[strptr] := nam[i];
+ strptr:= strptr + 1;
+ END;
+ strspace[strptr] := eos;
+ putnm(freestr, nilref, found);
+ IF NOT found THEN
+ freestr := strptr + 1;
+
+ (* make the single character ascii identifiers, except nul(=eos). *)
+ FOR i := 1 TO 127 DO
+ BEGIN
+ strspace[freestr] := chr(i);
+ strspace[freestr + 1] := eos;
+ putnm(freestr, idref, found);
+ IF NOT found THEN
+ freestr := freestr + 2;
+ IF i = ord('T') THEN
+ trueref := idref;
+ (* returns location for 't. *)
+ END;
+
+ (* init gensym id list *)
+ FOR i := 1 TO max_gsym DO g_sym[i] := '0';
+
+ (* clear the counters *)
+ idspace[xraise].val := trueref;
+ gccount := 0;
+ consknt := 0;
+ END;
+ (* init1 *)
+
+ PROCEDURE init2;
+ BEGIN
+ (* load "symbol table" with identifiers, constants, and functions. *)
+ inchnl := 1; (* select symbol input file. *)
+ outchnl := 1; (* select symbol OUTPUT file. *)
+#p reset(symin,'paslsp.ini');
+#p reset(input);
+#p rewrite(output);
+#w reset(symin, "paslsp.ini");
+#t reset(symin,'#5:poly.data');
+#d reset(symin,'paslspini',0,0,'DSK ');
+#d reset(input,'tty ',0,0,'TTY ');
+#d rewrite(output,'tty ',0,0,'TTY ');
+#a open(symin,'paslsp.ini','old',iostatus);
+#a reset(symin);
+#a for i:=1 to inchns do
+#a BEGIN;
+#a ichrbuf[i]:=' ';
+#a END;
+ xrdtok; (* get count of identifiers. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED AT START');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ xrdtok;
+ (* reading token magically loads it into id space. *)
+ xrdtok; (* look for zero terminator. *)
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER IDENTIFIERS');
+
+ xrdtok; (* count of constants *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE CONSTANTS');
+ n := info_of(r[1]);
+ alloc(n); (* space for constants on the stack *)
+ FOR i := 1 TO n DO
+ BEGIN
+ xread;
+ stk[i] := r[1];
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER CONSTANTS');
+ xrdtok; (* count of functions. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE FUNCTIONS');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ (* for each function *)
+ (* store associated code *)
+ BEGIN
+ xrdtok;
+ mkitem(codetag, i, tmpref);
+ idspace[info_of(r[1])].funcell :=tmpref;
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER FUNCTIONS');
+ END;
+ (* init2 *)
+
+PROCEDURE dumpids;
+ VAR i, p: integer;
+
+ BEGIN
+ FOR i := 1 TO freeident - 1 DO
+ BEGIN
+ p := idspace[i].idname;
+ write('id #', i:5, ' at', p:5, ': ');
+ WHILE strspace[p] <> eos DO
+ BEGIN
+ write(strspace[p]);
+ p := p + 1
+ END;
+ write('. Function code: ');
+ writeln(INFO_OF(idspace[i].funcell));
+ END
+ END;
+
+ BEGIN (* init *)
+ init1;
+ init2;
+ END;
+ (* init *)
+
+ (********************************************************)
+ (* *)
+ (* arithmetic functions *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xadd1;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(i + 1, 1)
+ END;
+
+PROCEDURE xdifference;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 - i2, 1)
+ END;
+
+PROCEDURE xdivide; (* returns dotted pair (quotient . remainder). *)
+ VAR quot, rem: integer;
+ i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ mkint(i1 DIV i2, 1);
+ mkint(i1 MOD i2, 2);
+ xcons
+ END;
+
+PROCEDURE xgreaterp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 > i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xlessp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 < i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xminus;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(-i, 1)
+ END;
+
+PROCEDURE xplus2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 + i2, 1)
+ END;
+
+PROCEDURE xquotient;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 DIV i2, 1)
+ END;
+
+PROCEDURE xremainder;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 MOD i2, 1)
+ END;
+
+PROCEDURE xtimes2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 * i2, 1)
+ END;
+ (* xtimes2 *)
+
+
+ (********************************************************)
+ (* *)
+ (* support for eval *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE execute(code: integer);
+ FORWARD;
+
+ (* Xapply(fn,arglist)-- "fn" is an operation code. *)
+PROCEDURE xxapply;
+ VAR
+ i: integer;
+ code: integer;
+ tmp: itemref;
+ tmpreg: ARRAY[1..maxreg] OF itemref;
+ BEGIN
+ code := info_of(r[1]);
+ r[1] := r[2];
+ i := 1;
+ (* spread the arguments *)
+ WHILE NOT xNull(r[1]) AND (i <= maxreg) DO
+ BEGIN
+ tmp := r[1];
+ xcar;
+ tmpreg[i] := r[1];
+ i := i + 1;
+ r[1] := tmp;
+ xcdr;
+ END;
+ WHILE i > 1 DO
+ BEGIN
+ i := i - 1;
+ r[i] := tmpreg[i];
+ END;
+ execute(code);
+ END;
+
+ (* rest of pas1...pasn follow , pasn Closes definition of Catch *)
+
ADDED perq-pascal-lisp-project/pas0.sym
Index: perq-pascal-lisp-project/pas0.sym
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas0.sym
@@ -0,0 +1,55 @@
+PAS0IDS := '((TOKTYPE . 129)
+ (BSTK!* . 130)
+ (THROWING!* . 131)
+ (INITFORM!* . 132)
+ (!*RAISE . 133)
+ (INPUT . 134)
+ (OUTPUT . 135)
+ (!*ECHO . 137)
+ )$
+PAS0CSTS := '()$
+PAS0LITS := '()$
+
+% Functions that initial system is expected to know about.
+% (Arranged in alphabetical order.)
+PAS0FNS:='(
+(!*FIRST!-PROCEDURE . FIRSTP)
+ (ADD1 . XADD1)
+ (XAPPLY . XXAPPLY)
+ (CAR . XCAR)
+ (CATCH . XCATCH)
+ (CDR . XCDR)
+ (CODEP . XCODEP)
+ (COMPRESS . COMPRESS)
+ (CONS . XCONS)
+ (CLOSE . XCLOSE)
+ (DIFFERENCE . XDIFFERENCE)
+ (DIVIDE . XDIVIDE)
+ (EVAL . XEVAL)
+ (EXPLODE . EXPLODE)
+ (FASTSTAT . XFASTSTAT)
+ (GENSYM . GENSYM)
+ (GREATERP . XGREATERP)
+ (LESSP . XLESSP)
+ (MINUS . XMINUS)
+ (NCONS . XNCONS)
+ (OPEN . XOPEN)
+ (PLUS2 . XPLUS2)
+ (PRINT . XPRINT)
+ (QUOTIENT . XQUOTIENT)
+ (RDTOK . XRDTOK)
+ (RDS . XRDS)
+ (READ . XREAD)
+ (RECLAIM . XGCOLLECT)
+ (REMAINDER . XREMAINDER)
+ (RPLACA . XRPLACA)
+ (RPLACD . XRPLACD)
+ (TERPRI . XTERPRI)
+ (TIMES2 . XTIMES2)
+ (THROW . XTHROW)
+ (UNBINDTO . XUNBINDTO)
+ (WRTOK . XWRTOK)
+ (WRS . XWRS)
+ (XCONS . XXCONS)
+ )
+$
ADDED perq-pascal-lisp-project/pas1.bld
Index: perq-pascal-lisp-project/pas1.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas1.bld
@@ -0,0 +1,29 @@
+DEF s: <SCRATCH>
+DEF DSK: DSK:,SYS:
+DEF SYS: DSK:,SYS:
+pas:PASCMP
+OFF SYSLISP$
+OFF MSG$
+OFF NOUUO$
+ON DOMOVE$
+ON NOFIXFRM;
+ON MACECHO$ %OFF cuts down size of output file.
+PUT('CAR,'ANYREG,'T)$
+PUT('CDR,'ANYREG,'T)$
+
+IN PAS0.SYM$ % Pre Symbol Table
+OUT PAS1.PAS$
+DRT1('PAS1,PAS0IDS,PAS0CSTS,PAS0LITS,PAS0FNS)$
+IN PAS1.RED$
+DRT2()$
+SHUT PAS1.PAS$
+
+OUT PAS1.SYM$ % Post SYMBOL Table
+DUMPSYMS('PAS1)$
+SHUT PAS1.SYM$
+
+OUT PAS1.SLI$ % Sexpressions and declarations
+DRT3()$
+SHUT PAS1.SLI$
+QUIT$
+
ADDED perq-pascal-lisp-project/pas1.pas
Index: perq-pascal-lisp-project/pas1.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas1.pas
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas1.red
Index: perq-pascal-lisp-project/pas1.red
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas1.red
@@ -0,0 +1,151 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PASCAL BASED MINI-LISP
+%
+% File: PAS1.RED - Basic I/O Functions
+% ChangeDate: 10:48pm Wednesday, 15 July 1981
+% By: M. L. Griss
+% Change to add Features for Schlumberger Demo
+%
+% All RIGHTS RESERVED
+% COPYRIGHT (C) - 1981 - M. L. GRISS
+% Computer Science Department
+% University of Utah
+%
+% Do Not distribute with out written consent of M. L. Griss
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Additional Support procedures for optimized code;
+
+SYMBOLIC PROCEDURE CAAR(X);
+ CAR CAR X;
+
+SYMBOLIC PROCEDURE CADR X;
+ CAR CDR X;
+
+SYMBOLIC PROCEDURE CDAR X;
+ CDR CAR X;
+
+SYMBOLIC PROCEDURE CDDR X;
+ CDR CDR X;
+
+% All Friendly CxxxR's
+
+SYMBOLIC PROCEDURE CAAAAR X; CAR CAR CAR CAR X;
+
+SYMBOLIC PROCEDURE CAAADR X; CAR CAR CAR CDR X;
+
+SYMBOLIC PROCEDURE CAADAR X; CAR CAR CDR CAR X;
+
+SYMBOLIC PROCEDURE CAADDR X; CAR CAR CDR CDR X;
+
+SYMBOLIC PROCEDURE CADAAR X; CAR CDR CAR CAR X;
+
+SYMBOLIC PROCEDURE CADADR X; CAR CDR CAR CDR X;
+
+SYMBOLIC PROCEDURE CADDAR X; CAR CDR CDR CAR X;
+
+SYMBOLIC PROCEDURE CADDDR X; CAR CDR CDR CDR X;
+
+SYMBOLIC PROCEDURE CDAAAR X; CDR CAR CAR CAR X;
+
+SYMBOLIC PROCEDURE CDAADR X; CDR CAR CAR CDR X;
+
+SYMBOLIC PROCEDURE CDADAR X; CDR CAR CDR CAR X;
+
+SYMBOLIC PROCEDURE CDADDR X; CDR CAR CDR CDR X;
+
+SYMBOLIC PROCEDURE CDDAAR X; CDR CDR CAR CAR X;
+
+SYMBOLIC PROCEDURE CDDADR X; CDR CDR CAR CDR X;
+
+SYMBOLIC PROCEDURE CDDDAR X; CDR CDR CDR CAR X;
+
+SYMBOLIC PROCEDURE CDDDDR X; CDR CDR CDR CDR X;
+
+SYMBOLIC PROCEDURE CAAAR X; CAR CAR CAR X;
+
+SYMBOLIC PROCEDURE CAADR X; CAR CAR CDR X;
+
+SYMBOLIC PROCEDURE CADAR X; CAR CDR CAR X;
+
+SYMBOLIC PROCEDURE CADDR X; CAR CDR CDR X;
+
+SYMBOLIC PROCEDURE CDAAR X; CDR CAR CAR X;
+
+SYMBOLIC PROCEDURE CDADR X; CDR CAR CDR X;
+
+SYMBOLIC PROCEDURE CDDAR X; CDR CDR CAR X;
+
+SYMBOLIC PROCEDURE CDDDR X; CDR CDR CDR X;
+
+symbolic procedure prin2(x);
+ begin
+ if pairp(x) then
+ << wrtok( '!( );
+ while pairp(x) do
+ << prin2 car(x);
+ x := cdr x;
+ if not eq(x,NIL) then wrtok('! ); % A space.
+ >>;
+ if not eq(x,NIL) then
+ << wrtok( '!.! ); %Period followed by space.
+ prin2(x);
+ >>;
+ wrtok( '!) );
+ >>
+ else
+ wrtok(x);
+ end;
+
+symbolic procedure revx(l1,l2);
+ % Non-destructive reverser, adds reverse of l1 to front of l2.
+ begin
+ while pairp(l1) do
+ << l2 := (car l1).l2;
+ l1 := cdr l1;
+ >>;
+ if not null (l1) then l2 := l1 . l2;
+ return l2;
+ end;
+
+symbolic procedure rev(l1);
+ revx(l1,NIL);
+
+% EOF code is Ascii Z plus an offset of 1, much too obscure!.
+symbolic procedure eofp(x);
+ if atom(x) and (!*inf(x) eq 27) then 'T else 'NIL;
+
+symbolic procedure read();
+ begin scalar itm,ii;
+ itm := rdtok();
+ if not(toktype eq 3) or eofp(itm) then return(itm); % Over cautious;
+ if (itm eq '!( )
+ then return rlist()
+ else if (itm eq '!' ) % Treat quote mark as QUOTE.
+ then return <<ii := read();
+ if eofp(ii) then ii
+ else ('QUOTE . ii . NIL)>>
+ else return itm;
+ end;
+
+symbolic procedure rlist();
+% Non destructive READ of S-expr, including ".".
+ begin scalar itm,lst,done,last;
+ itm := read();
+ if eofp(itm) then return itm;
+ done := NIL;
+ while not done do
+ if itm eq '!) and toktype eq 3
+ then done :='T
+ else if itm = '!. and toktype eq 3
+ then <<done:='T; last:= car rlist()>> %CAR cures bug? WFG
+ else
+ <<lst := itm.lst; itm := read()>>;
+% ??? if pairp last then last:=car last>>;
+ if eofp(itm) then return itm;
+ return revx(lst,last);
+ end;
+
+END$
ADDED perq-pascal-lisp-project/pas1.sli
Index: perq-pascal-lisp-project/pas1.sli
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas1.sli
@@ -0,0 +1,1 @@
+% Initialization LISP for module: PAS1
ADDED perq-pascal-lisp-project/pas1.sym
Index: perq-pascal-lisp-project/pas1.sym
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas1.sym
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas2.bld
Index: perq-pascal-lisp-project/pas2.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas2.bld
@@ -0,0 +1,43 @@
+DEF s: <SCRATCH>
+DEF DSK: DSK:,SYS:
+DEF SYS: DSK:,SYS:
+pas:PASCMP
+OFF SYSLISP$
+OFF MSG$
+OFF NOUUO$
+OFF DOMOVE$ % Can't have BOTH DOMOVE and FXFRM
+OFF NOFIXFRM; % Reduce ALLOCS
+ON MACECHO$ %OFF Cuts down size of output file.
+REMPROP('W,'STAT);
+REMPROP('PLIST,'STAT);
+
+IN PAS1.SYM$
+% Perhaps the following lines should really be in POLY.RED, but they
+% don't work correctly inside body of text being compiled.
+PUT('CAR,'ANYREG,'T)$
+PUT('CDR,'ANYREG,'T)$
+PUT('VALUE,'OPENCOD,'(" R[1] := idspace[info_of(R[1])].val;"));
+PUT('PLIST,'OPENCOD,'(" R[1] := idspace[Info_of(r[1])].plist;"));
+PUT('FUNCELL,'OPENCOD,'(" R[1] := idspace[Info_of(r[1])].funcell;"));
+PUT('SETVALUE,'OPENCOD,'(" idspace[Info_of(r[1])].val := R[2];"));
+PUT('SETPLIST,'OPENCOD,'(" idspace[Info_of(r[1])].plist := R[2];"));
+PUT('SETFUNCELL,'OPENCOD,'(" idspace[Info_of(r[1])].funcell := R[2];"));
+PUT('CHAR2ID,'OPENCOD,'(" set_tag(R[1], idtag);"));
+PUT('CODEP, 'OPENCOD, '(" tag_of(r[1]) = codetag;"));
+
+OUT PAS2.PAS$
+DRT1('PAS2,PAS1IDS,PAS1CSTS,PAS1LITS,PAS1FNS)$
+IN PAS2.RED$
+
+DRT2()$
+SHUT PAS2.PAS$
+
+OUT PAS2.SYM$
+DUMPSYMS('PAS2)$
+SHUT PAS2.SYM$
+
+OUT PAS2.SLI$
+DRT3()$ % S-expressions and Declarations
+SHUT PAS2.SLI$
+
+QUIT$
ADDED perq-pascal-lisp-project/pas2.pas
Index: perq-pascal-lisp-project/pas2.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas2.pas
@@ -0,0 +1,2516 @@
+(* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ PASCAL Based MINI-LISP/ compilation: V1
+ Special Schlumberger Demo
+ All RIGHTS RESERVED
+ COPYRIGHT (C) - 1981 - M. L. GRISS
+ Computer Science Department
+ University of Utah
+
+ Do Not distribute with out written consent of M. L. Griss
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% *)
+(* !(!*ENTRY PAIRP EXPR !1!) *)
+(* EXPR PAIRP *)
+procedure PAS21;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!0!0!5 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!0!0!6!) *)
+ GOTO 101;
+(* !(!*LBL G!0!0!0!5!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!0!0!6!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS22;
+forward;
+(* !(!*ENTRY NOT EXPR !1!) *)
+(* EXPR NOT *)
+procedure PAS23;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE NIL!)!) *)
+ R[2] := nilref;
+(* !(!*LINK EQ EXPR !2!) *)
+ PAS22;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY CODEP EXPR !1!) *)
+(* EXPR CODEP *)
+procedure XCODEP;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!0!1!0 !1 CODETAG!) *)
+ IF tag_of(R[1]) <> CODETAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!0!1!1!) *)
+ GOTO 101;
+(* !(!*LBL G!0!0!1!0!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!0!1!1!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS24;
+forward;
+procedure PAS25;
+forward;
+(* !(!*ENTRY CONSTANTP EXPR !1!) *)
+(* EXPR CONSTANTP *)
+procedure PAS26;
+label
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LINK PAIRP EXPR !1!) *)
+ PAS21;
+(* !(!*JUMPT G!0!0!1!3!) *)
+ IF R[1] <> nilref THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK IDP EXPR !1!) *)
+ PAS24;
+(* !(!*LBL G!0!0!1!3!) *)
+100:
+(* !(!*LINK NULL EXPR !1!) *)
+ PAS25;
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY EQN EXPR !2!) *)
+(* EXPR EQN *)
+procedure PAS27;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK EQ EXPR !2!) *)
+ PAS22;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY LIST!2 EXPR !2!) *)
+(* EXPR LIST2 *)
+procedure PAS28;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*LINK NCONS EXPR !1!) *)
+ XNCONS;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY LIST!3 EXPR !3!) *)
+(* EXPR LIST3 *)
+procedure PAS29;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LOAD !2 !3!) *)
+ R[2] := R[3];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK LIST!2 EXPR !2!) *)
+ PAS28;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY LIST!4 EXPR !4!) *)
+(* EXPR LIST4 *)
+procedure PAS210;
+begin
+(* !(!*ALLOC !3!) *)
+ alloc3;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*STORE !3 !-!2!) *)
+ store(3,2);
+(* !(!*LOAD !3 !4!) *)
+ R[3] := R[4];
+(* !(!*LOAD !2 !-!2!) *)
+ load(2,2);
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK LIST!3 EXPR !3!) *)
+ PAS29;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*DEALLOC !3!) *)
+ dealloc3;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY LIST!5 EXPR !5!) *)
+(* EXPR LIST5 *)
+procedure PAS211;
+begin
+(* !(!*ALLOC !4!) *)
+ alloc(4);
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*STORE !3 !-!2!) *)
+ store(3,2);
+(* !(!*STORE !4 !-!3!) *)
+ store(4,3);
+(* !(!*LOAD !4 !5!) *)
+ R[4] := R[5];
+(* !(!*LOAD !3 !-!3!) *)
+ load(3,3);
+(* !(!*LOAD !2 !-!2!) *)
+ load(2,2);
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK LIST!4 EXPR !4!) *)
+ PAS210;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*DEALLOC !4!) *)
+ dealloc(4);
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY REVERSE EXPR !1!) *)
+(* EXPR REVERSE *)
+procedure PAS212;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK REV EXPR !1!) *)
+ PAS131;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY APPEND EXPR !2!) *)
+(* EXPR APPEND *)
+procedure PAS213;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK REVERSE EXPR !1!) *)
+ PAS212;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LBL G!0!0!2!9!) *)
+100:
+(* !(!*JUMPNC G!0!0!2!8 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 101;
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*LINK CONS EXPR !2!) *)
+ XCONS;
+(* !(!*STORE !1 !-!1!) *)
+ store(1,1);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*JUMP G!0!0!2!9!) *)
+ GOTO 100;
+(* !(!*LBL G!0!0!2!8!) *)
+101:
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS214;
+forward;
+(* !(!*ENTRY MEMBER EXPR !2!) *)
+(* EXPR MEMBER *)
+procedure PAS214;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !3 !1!) *)
+ R[3] := R[1];
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMPT G!0!0!3!4!) *)
+ IF R[1] <> nilref THEN GOTO 100;
+(* !(!*LOAD !1 !3!) *)
+ R[1] := R[3];
+(* !(!*JUMP G!0!0!3!6!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!3!4!) *)
+100:
+(* !(!*LOAD !1 !3!) *)
+ R[1] := R[3];
+(* !(!*JUMPN G!0!0!3!5 !(CAR !2!)!) *)
+ ANYcar(R[2],RXX);
+ IF R[1] <> RXX THEN GOTO 101;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!0!3!6!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!3!5!) *)
+101:
+(* !(!*LOAD !2 !(CDR !2!)!) *)
+ ANYcdr(R[2],R[2]);
+(* !(!*LINK MEMBER EXPR !2!) *)
+ PAS214;
+(* !(!*LBL G!0!0!3!6!) *)
+102:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS215;
+forward;
+procedure PAS216;
+forward;
+(* !(!*ENTRY PAIR EXPR !2!) *)
+(* EXPR PAIR *)
+procedure PAS216;
+label
+ 103,
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !3!) *)
+ alloc3;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPNIL G!0!0!3!9!) *)
+ IF R[1] = nilref THEN GOTO 100;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMPT G!0!0!4!0!) *)
+ IF R[1] <> nilref THEN GOTO 102;
+(* !(!*LBL G!0!0!3!9!) *)
+100:
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*JUMPT G!0!0!4!4!) *)
+ IF R[1] <> nilref THEN GOTO 101;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMPNIL G!0!0!4!5!) *)
+ IF R[1] = nilref THEN GOTO 103;
+(* !(!*LBL G!0!0!4!4!) *)
+101:
+(* !(!*LOAD !2 !(QUOTE PAIR!)!) *)
+ mkident(139,2);
+(* !(!*LOAD !1 !(QUOTE !0!)!) *)
+ mkint(0,1);
+(* !(!*LINK ERROR EXPR !2!) *)
+ PAS215;
+(* !(!*LBL G!0!0!4!0!) *)
+102:
+(* !(!*LOAD !2 !(CAR !1!)!) *)
+ ANYcar(R[1],R[2]);
+(* !(!*LOAD !1 !(CAR !0!)!) *)
+ ANYcar(stk[st],R[1]);
+(* !(!*LINK CONS EXPR !2!) *)
+ XCONS;
+(* !(!*STORE !1 !-!2!) *)
+ store(1,2);
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK PAIR EXPR !2!) *)
+ PAS216;
+(* !(!*LOAD !2 !-!2!) *)
+ load(2,2);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!0!4!5!) *)
+103:
+(* !(!*DEALLOC !3!) *)
+ dealloc3;
+(* !(!*EXIT!) *)
+end;
+procedure PAS217;
+forward;
+procedure PAS218;
+forward;
+(* !(!*ENTRY SASSOC EXPR !3!) *)
+(* EXPR SASSOC *)
+procedure PAS218;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !3!) *)
+ alloc3;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*STORE !3 !-!2!) *)
+ store(3,2);
+(* !(!*JUMPC G!0!0!4!8 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !2 !(QUOTE !(NIL!)!)!) *)
+ R[2] := stk[1];
+(* !(!*LOAD !1 !3!) *)
+ R[1] := R[3];
+(* !(!*LINK APPLY EXPR !2!) *)
+ PAS217;
+(* !(!*JUMP G!0!0!5!0!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!4!8!) *)
+100:
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*JUMPN G!0!0!4!9 !0!) *)
+ IF R[1] <> stk[st] THEN GOTO 101;
+(* !(!*LOAD !1 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[1]);
+(* !(!*JUMP G!0!0!5!0!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!4!9!) *)
+101:
+(* !(!*LOAD !3 !-!2!) *)
+ load(3,2);
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SASSOC EXPR !3!) *)
+ PAS218;
+(* !(!*LBL G!0!0!5!0!) *)
+102:
+(* !(!*DEALLOC !3!) *)
+ dealloc3;
+(* !(!*EXIT!) *)
+end;
+procedure PAS219;
+forward;
+procedure PAS220;
+forward;
+(* !(!*ENTRY SUBLIS EXPR !2!) *)
+(* EXPR SUBLIS *)
+procedure PAS220;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !3!) *)
+ alloc3;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!0!5!3 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!0!5!4!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!5!3!) *)
+100:
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK ASSOC EXPR !2!) *)
+ PAS219;
+(* !(!*JUMPNIL G!0!0!5!7!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*JUMP G!0!0!5!4!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!5!7!) *)
+101:
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*JUMPC G!0!0!5!4 !1 ATOM!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 102;
+(* !(!*LOAD !2 !(CAR !1!)!) *)
+ ANYcar(R[1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SUBLIS EXPR !2!) *)
+ PAS220;
+(* !(!*STORE !1 !-!2!) *)
+ store(1,2);
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SUBLIS EXPR !2!) *)
+ PAS220;
+(* !(!*LOAD !2 !-!2!) *)
+ load(2,2);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!0!5!4!) *)
+102:
+(* !(!*DEALLOC !3!) *)
+ dealloc3;
+(* !(!*EXIT!) *)
+end;
+procedure PAS221;
+forward;
+(* !(!*ENTRY SUBST EXPR !3!) *)
+(* EXPR SUBST *)
+procedure PAS221;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !4!) *)
+ alloc(4);
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMPNIL G!0!0!6!8!) *)
+ IF R[1] = nilref THEN GOTO 102;
+(* !(!*JUMPN G!0!0!6!6 !3!) *)
+ IF R[1] <> R[3] THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*JUMP G!0!0!6!8!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!6!6!) *)
+100:
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*STORE !3 !-!2!) *)
+ store(3,2);
+(* !(!*JUMPNC G!0!0!6!7 !3 ATOM!) *)
+ IF tag_of(R[3]) = PAIRTAG THEN GOTO 101;
+(* !(!*LOAD !1 !3!) *)
+ R[1] := R[3];
+(* !(!*JUMP G!0!0!6!8!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!6!7!) *)
+101:
+(* !(!*LOAD !3 !(CAR !3!)!) *)
+ ANYcar(R[3],R[3]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SUBST EXPR !3!) *)
+ PAS221;
+(* !(!*STORE !1 !-!3!) *)
+ store(1,3);
+(* !(!*LOAD !3 !(CDR !-!2!)!) *)
+ ANYcdr(stk[st-2],R[3]);
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SUBST EXPR !3!) *)
+ PAS221;
+(* !(!*LOAD !2 !-!3!) *)
+ load(2,3);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!0!6!8!) *)
+102:
+(* !(!*DEALLOC !4!) *)
+ dealloc(4);
+(* !(!*EXIT!) *)
+end;
+procedure PAS222;
+forward;
+(* !(!*ENTRY MEMQ EXPR !2!) *)
+(* EXPR MEMQ *)
+procedure PAS222;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!0!7!6 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) <> PAIRTAG THEN GOTO 100;
+(* !(!*JUMPN G!0!0!7!4 !(CAR !2!)!) *)
+ ANYcar(R[2],RXX);
+ IF R[1] <> RXX THEN GOTO 101;
+(* !(!*LBL G!0!0!7!6!) *)
+100:
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!0!7!5!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!7!4!) *)
+101:
+(* !(!*LOAD !2 !(CDR !2!)!) *)
+ ANYcdr(R[2],R[2]);
+(* !(!*LINK MEMQ EXPR !2!) *)
+ PAS222;
+(* !(!*LBL G!0!0!7!5!) *)
+102:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS223;
+forward;
+(* !(!*ENTRY ATSOC EXPR !2!) *)
+(* EXPR ATSOC *)
+procedure PAS223;
+label
+ 103,
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!0!7!9 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!0!8!2!) *)
+ GOTO 103;
+(* !(!*LBL G!0!0!7!9!) *)
+100:
+(* !(!*LOAD !1 !(CAR !2!)!) *)
+ ANYcar(R[2],R[1]);
+(* !(!*JUMPNC G!0!0!8!1 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 101;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*JUMPE G!0!0!8!0 !0!) *)
+ IF R[1]=stk[st] THEN GOTO 102;
+(* !(!*LBL G!0!0!8!1!) *)
+101:
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK ATSOC EXPR !2!) *)
+ PAS223;
+(* !(!*JUMP G!0!0!8!2!) *)
+ GOTO 103;
+(* !(!*LBL G!0!0!8!0!) *)
+102:
+(* !(!*LOAD !1 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[1]);
+(* !(!*LBL G!0!0!8!2!) *)
+103:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ASSOC EXPR !2!) *)
+(* EXPR ASSOC *)
+procedure PAS219;
+label
+ 103,
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!0!8!5 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!0!8!9!) *)
+ GOTO 103;
+(* !(!*LBL G!0!0!8!5!) *)
+100:
+(* !(!*LOAD !1 !(CAR !2!)!) *)
+ ANYcar(R[2],R[1]);
+(* !(!*JUMPNC G!0!0!8!6 !1 ATOM!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 101;
+(* !(!*LOAD !2 !(QUOTE ASSOC!)!) *)
+ mkident(140,2);
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK LIST!2 EXPR !2!) *)
+ PAS28;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !(QUOTE !1!0!0!)!) *)
+ mkint(100,1);
+(* !(!*LINK ERROR EXPR !2!) *)
+ PAS215;
+(* !(!*LBL G!0!0!8!6!) *)
+101:
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*JUMPN G!0!0!8!8 !0!) *)
+ IF R[1] <> stk[st] THEN GOTO 102;
+(* !(!*LOAD !1 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[1]);
+(* !(!*JUMP G!0!0!8!9!) *)
+ GOTO 103;
+(* !(!*LBL G!0!0!8!8!) *)
+102:
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK ASSOC EXPR !2!) *)
+ PAS219;
+(* !(!*LBL G!0!0!8!9!) *)
+103:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS224;
+forward;
+procedure PAS225;
+forward;
+(* !(!*ENTRY DEFLIST EXPR !2!) *)
+(* EXPR DEFLIST *)
+procedure PAS225;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !3!) *)
+ alloc3;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!0!9!2 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!0!9!3!) *)
+ GOTO 101;
+(* !(!*LBL G!0!0!9!2!) *)
+100:
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*LOAD !3 !(CAR !(CDR !(CAR !0!)!)!)!) *)
+ ANYcar(stk[st],R[3]);
+ ANYcdr(R[3],R[3]);
+ ANYcar(R[3],R[3]);
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LINK PUT EXPR !3!) *)
+ PAS224;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*STORE !1 !-!2!) *)
+ store(1,2);
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK DEFLIST EXPR !2!) *)
+ PAS225;
+(* !(!*LOAD !2 !-!2!) *)
+ load(2,2);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!0!9!3!) *)
+101:
+(* !(!*DEALLOC !3!) *)
+ dealloc3;
+(* !(!*EXIT!) *)
+end;
+procedure PAS226;
+forward;
+procedure PAS227;
+forward;
+(* !(!*ENTRY DELETE EXPR !2!) *)
+(* EXPR DELETE *)
+procedure PAS227;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!0!9!9 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!1!0!1!) *)
+ GOTO 102;
+(* !(!*LBL G!0!0!9!9!) *)
+100:
+(* !(!*LOAD !2 !(CAR !2!)!) *)
+ ANYcar(R[2],R[2]);
+(* !(!*LINK EQUAL EXPR !2!) *)
+ PAS226;
+(* !(!*JUMPNIL G!0!1!0!0!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !1 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[1]);
+(* !(!*JUMP G!0!1!0!1!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!0!0!) *)
+101:
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK DELETE EXPR !2!) *)
+ PAS227;
+(* !(!*LOAD !2 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[2]);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!1!0!1!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS228;
+forward;
+(* !(!*ENTRY DELQ EXPR !2!) *)
+(* EXPR DELQ *)
+procedure PAS228;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !2 !0!) *)
+ store(2,0);
+(* !(!*JUMPC G!0!1!0!5 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!1!0!7!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!0!5!) *)
+100:
+(* !(!*JUMPN G!0!1!0!6 !(CAR !2!)!) *)
+ ANYcar(R[2],RXX);
+ IF R[1] <> RXX THEN GOTO 101;
+(* !(!*LOAD !1 !(CDR !2!)!) *)
+ ANYcdr(R[2],R[1]);
+(* !(!*JUMP G!0!1!0!7!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!0!6!) *)
+101:
+(* !(!*LOAD !2 !(CDR !2!)!) *)
+ ANYcdr(R[2],R[2]);
+(* !(!*LINK DELQ EXPR !2!) *)
+ PAS228;
+(* !(!*LOAD !2 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[2]);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LBL G!0!1!0!7!) *)
+102:
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+procedure PAS229;
+forward;
+(* !(!*ENTRY DELATQ EXPR !2!) *)
+(* EXPR DELATQ *)
+procedure PAS229;
+label
+ 103,
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!1!1!1 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMP G!0!1!1!5!) *)
+ GOTO 103;
+(* !(!*LBL G!0!1!1!1!) *)
+100:
+(* !(!*LOAD !1 !(CAR !2!)!) *)
+ ANYcar(R[2],R[1]);
+(* !(!*JUMPNC G!0!1!1!3 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 101;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*JUMPE G!0!1!1!2 !0!) *)
+ IF R[1]=stk[st] THEN GOTO 102;
+(* !(!*LBL G!0!1!1!3!) *)
+101:
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK DELATQ EXPR !2!) *)
+ PAS229;
+(* !(!*LOAD !2 !(CAR !-!1!)!) *)
+ ANYcar(stk[st-1],R[2]);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*JUMP G!0!1!1!5!) *)
+ GOTO 103;
+(* !(!*LBL G!0!1!1!2!) *)
+102:
+(* !(!*LOAD !1 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[1]);
+(* !(!*LBL G!0!1!1!5!) *)
+103:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY GET EXPR !2!) *)
+(* EXPR GET *)
+procedure PAS230;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !2 !0!) *)
+ store(2,0);
+(* !(!*JUMPNC G!0!1!1!9 !1 IDTAG!) *)
+ IF tag_of(R[1]) <> IDTAG THEN GOTO 100;
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK ATSOC EXPR !2!) *)
+ PAS223;
+(* !(!*JUMPNC G!0!1!1!9 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*JUMP G!0!1!2!1!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!1!9!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!1!2!1!) *)
+101:
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PUT EXPR !3!) *)
+(* EXPR PUT *)
+procedure PAS224;
+label
+ 103,
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !4!) *)
+ alloc(4);
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*STORE !3 !-!2!) *)
+ store(3,2);
+(* !(!*JUMPC G!0!1!2!6 !1 IDTAG!) *)
+ IF tag_of(R[1]) = IDTAG THEN GOTO 100;
+(* !(!*LOAD !1 !3!) *)
+ R[1] := R[3];
+(* !(!*JUMP G!0!1!2!4!) *)
+ GOTO 103;
+(* !(!*LBL G!0!1!2!6!) *)
+100:
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*STORE !1 !-!3!) *)
+ store(1,3);
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK ATSOC EXPR !2!) *)
+ PAS223;
+(* !(!*JUMPNIL G!0!1!2!8!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !2 !-!3!) *)
+ load(2,3);
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK DELATQ EXPR !2!) *)
+ PAS229;
+(* !(!*STORE !1 !-!3!) *)
+ store(1,3);
+(* !(!*LBL G!0!1!2!8!) *)
+101:
+(* !(!*LOAD !1 !-!2!) *)
+ load(1,2);
+(* !(!*JUMPNIL G!0!1!3!0!) *)
+ IF R[1] = nilref THEN GOTO 102;
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LOAD !2 !-!3!) *)
+ load(2,3);
+(* !(!*LINK CONS EXPR !2!) *)
+ XCONS;
+(* !(!*STORE !1 !-!3!) *)
+ store(1,3);
+(* !(!*LBL G!0!1!3!0!) *)
+102:
+(* !(!*LOAD !2 !-!3!) *)
+ load(2,3);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SETPLIST EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].PLIST := R[2];
+(* !(!*LOAD !1 !-!2!) *)
+ load(1,2);
+(* !(!*LBL G!0!1!2!4!) *)
+103:
+(* !(!*DEALLOC !4!) *)
+ dealloc(4);
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY REMPROP EXPR !2!) *)
+(* EXPR REMPROP *)
+procedure PAS231;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !3 !(QUOTE NIL!)!) *)
+ R[3] := nilref;
+(* !(!*LINK PUT EXPR !3!) *)
+ PAS224;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS232;
+forward;
+(* !(!*ENTRY LENGTH EXPR !1!) *)
+(* EXPR LENGTH *)
+procedure PAS232;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPC G!0!1!3!5 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE !0!)!) *)
+ mkint(0,1);
+(* !(!*JUMP G!0!1!3!6!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!3!5!) *)
+100:
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*LINK LENGTH EXPR !1!) *)
+ PAS232;
+(* !(!*LINK ADD!1 EXPR !1!) *)
+ XADD1;
+(* !(!*LBL G!0!1!3!6!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ERRPRT EXPR !1!) *)
+(* EXPR ERRPRT *)
+procedure PAS233;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !(QUOTE !*!*!*!*! !)!) *)
+ mkident(141,1);
+(* !(!*LINK PRIN!2 EXPR !1!) *)
+ PAS129;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK PRINT EXPR !1!) *)
+ XPRINT;
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY MSGPRT EXPR !1!) *)
+(* EXPR MSGPRT *)
+procedure PAS234;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !(QUOTE !*!*!*! !)!) *)
+ mkident(142,1);
+(* !(!*LINK PRIN!2 EXPR !1!) *)
+ PAS129;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK PRINT EXPR !1!) *)
+ XPRINT;
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY FLAGP EXPR !2!) *)
+(* EXPR FLAGP *)
+procedure PAS235;
+label
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK IDP EXPR !1!) *)
+ PAS24;
+(* !(!*JUMPNIL G!0!1!4!1!) *)
+ IF R[1] = nilref THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK MEMQ EXPR !2!) *)
+ PAS222;
+(* !(!*LBL G!0!1!4!1!) *)
+100:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS236;
+forward;
+procedure PAS237;
+forward;
+(* !(!*ENTRY FLAG EXPR !2!) *)
+(* EXPR FLAG *)
+procedure PAS237;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!1!4!5 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!1!4!6!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!4!5!) *)
+100:
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*LINK FLAG!1 EXPR !2!) *)
+ PAS236;
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK FLAG EXPR !2!) *)
+ PAS237;
+(* !(!*LBL G!0!1!4!6!) *)
+101:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY FLAG!1 EXPR !2!) *)
+(* EXPR FLAG1 *)
+procedure PAS236;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPNC G!0!1!5!5 !1 IDTAG!) *)
+ IF tag_of(R[1]) <> IDTAG THEN GOTO 100;
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK MEMQ EXPR !2!) *)
+ PAS222;
+(* !(!*JUMPNIL G!0!1!5!0!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LBL G!0!1!5!5!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!1!5!2!) *)
+ GOTO 102;
+(* !(!*LBL G!0!1!5!0!) *)
+101:
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SETPLIST EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].PLIST := R[2];
+(* !(!*LBL G!0!1!5!2!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS238;
+forward;
+procedure PAS239;
+forward;
+(* !(!*ENTRY REMFLAG EXPR !2!) *)
+(* EXPR REMFLAG *)
+procedure PAS239;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!1!5!8 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!1!5!9!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!5!8!) *)
+100:
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*LINK REMFLAG!1 EXPR !2!) *)
+ PAS238;
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK REMFLAG EXPR !2!) *)
+ PAS239;
+(* !(!*LBL G!0!1!5!9!) *)
+101:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY REMFLAG!1 EXPR !2!) *)
+(* EXPR REMFLAG1 *)
+procedure PAS238;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!1!6!2 !1 IDTAG!) *)
+ IF tag_of(R[1]) = IDTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!1!6!5!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!6!2!) *)
+100:
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK MEMQ EXPR !2!) *)
+ PAS222;
+(* !(!*JUMPNIL G!0!1!6!5!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK DELQ EXPR !2!) *)
+ PAS228;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SETPLIST EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].PLIST := R[2];
+(* !(!*LBL G!0!1!6!5!) *)
+101:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY EQ EXPR !2!) *)
+(* EXPR EQ *)
+procedure PAS22;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPN G!0!1!7!0 !2!) *)
+ IF R[1] <> R[2] THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!1!7!1!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!7!0!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!1!7!1!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY EQCAR EXPR !2!) *)
+(* EXPR EQCAR *)
+procedure PAS240;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!1!7!4 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*JUMPN G!0!1!7!4 !2!) *)
+ IF R[1] <> R[2] THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!1!7!3!) *)
+ GOTO 101;
+(* !(!*LBL G!0!1!7!4!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!1!7!3!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY NULL EXPR !1!) *)
+(* EXPR NULL *)
+procedure PAS25;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE NIL!)!) *)
+ R[2] := nilref;
+(* !(!*LINK EQ EXPR !2!) *)
+ PAS22;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PLIST EXPR !1!) *)
+(* EXPR PLIST *)
+procedure PAS241;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK PLIST EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].PLIST;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY VALUE EXPR !1!) *)
+(* EXPR VALUE *)
+procedure PAS242;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK VALUE EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].VAL;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY FUNCELL EXPR !1!) *)
+(* EXPR FUNCELL *)
+procedure PAS243;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK FUNCELL EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].FUNCELL;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY SETPLIST EXPR !2!) *)
+(* EXPR SETPLIST *)
+procedure PAS244;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK SETPLIST EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].PLIST := R[2];
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY SETVALUE EXPR !2!) *)
+(* EXPR SETVALUE *)
+procedure PAS245;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK SETVALUE EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].VAL := R[2];
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY SETFUNCELL EXPR !2!) *)
+(* EXPR SETFUNCELL *)
+procedure PAS246;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK SETFUNCELL EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].FUNCELL := R[2];
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ORDERP EXPR !2!) *)
+(* EXPR ORDERP *)
+procedure PAS247;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK !*INF EXPR !1!) *)
+ mkitem(INTTAG,info_of(R[1]),R[1]);
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK !*INF EXPR !1!) *)
+ mkitem(INTTAG,info_of(R[1]),R[1]);
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK GREATERP EXPR !2!) *)
+ XGREATERP;
+(* !(!*LINK NULL EXPR !1!) *)
+ PAS25;
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY TOKEN EXPR !0!) *)
+(* EXPR TOKEN *)
+procedure PAS248;
+label
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK RDTOK EXPR !0!) *)
+ XRDTOK;
+(* !(!*STORE !1 !(FLUID TOK!*!)!) *)
+ idspace[143].val := R[1];
+(* !(!*JUMPNC G!0!1!9!1 !1 CHARTAG!) *)
+ IF tag_of(R[1]) <> CHARTAG THEN GOTO 100;
+(* !(!*LINK CHAR!2ID EXPR !1!) *)
+ SET_TAG(R[1], IDTAG);
+(* !(!*STORE !1 !(FLUID TOK!*!)!) *)
+ idspace[143].val := R[1];
+(* !(!*LBL G!0!1!9!1!) *)
+100:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY EQUAL EXPR !2!) *)
+(* EXPR EQUAL *)
+procedure PAS226;
+label
+ 103,
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPNC G!0!1!9!6 !1 ATOM!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*JUMPNC G!0!2!0!3 !2 ATOM!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 101;
+(* !(!*LINK EQ EXPR !2!) *)
+ PAS22;
+(* !(!*JUMP G!0!2!0!1!) *)
+ GOTO 103;
+(* !(!*LBL G!0!1!9!6!) *)
+100:
+(* !(!*JUMPNC G!0!2!0!0 !2 ATOM!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 102;
+(* !(!*LBL G!0!2!0!3!) *)
+101:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!2!0!1!) *)
+ GOTO 103;
+(* !(!*LBL G!0!2!0!0!) *)
+102:
+(* !(!*LOAD !2 !(CAR !2!)!) *)
+ ANYcar(R[2],R[2]);
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*LINK EQUAL EXPR !2!) *)
+ PAS226;
+(* !(!*JUMPNIL G!0!2!0!1!) *)
+ IF R[1] = nilref THEN GOTO 103;
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK EQUAL EXPR !2!) *)
+ PAS226;
+(* !(!*LBL G!0!2!0!1!) *)
+103:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ERROR EXPR !2!) *)
+(* EXPR ERROR *)
+procedure PAS215;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LOAD !3 !2!) *)
+ R[3] := R[2];
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !(QUOTE !*!*!*!*! ERROR! !)!) *)
+ mkident(144,1);
+(* !(!*LINK LIST!3 EXPR !3!) *)
+ PAS29;
+(* !(!*LINK PRINT EXPR !1!) *)
+ XPRINT;
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*STORE !1 !(FLUID EMSG!*!)!) *)
+ idspace[145].val := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*STORE !1 !(FLUID ENUM!*!)!) *)
+ idspace[146].val := R[1];
+(* !(!*LINK THROW EXPR !1!) *)
+ XTHROW;
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ERRORSET EXPR !3!) *)
+(* EXPR ERRORSET *)
+procedure PAS249;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE NIL !(FLUID THROWING!*!)!) *)
+ idspace[131].val := nilref;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK CATCH EXPR !1!) *)
+ XCATCH;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !(FLUID THROWING!*!)!) *)
+ R[1] := idspace[131].val;
+(* !(!*JUMPT G!0!2!0!9!) *)
+ IF R[1] <> nilref THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK NCONS EXPR !1!) *)
+ XNCONS;
+(* !(!*JUMP G!0!2!0!7!) *)
+ GOTO 102;
+(* !(!*LBL G!0!2!0!9!) *)
+100:
+(* !(!*STORE NIL !(FLUID THROWING!*!)!) *)
+ idspace[131].val := nilref;
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*JUMPNIL G!0!2!1!2!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !3 !(FLUID EMSG!*!)!) *)
+ R[3] := idspace[145].val;
+(* !(!*LOAD !2 !(FLUID ENUM!*!)!) *)
+ R[2] := idspace[146].val;
+(* !(!*LOAD !1 !(QUOTE !*!*!*!*!)!) *)
+ mkident(147,1);
+(* !(!*LINK LIST!3 EXPR !3!) *)
+ PAS29;
+(* !(!*LINK PRINT EXPR !1!) *)
+ XPRINT;
+(* !(!*LBL G!0!2!1!2!) *)
+101:
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LBL G!0!2!0!7!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS250;
+forward;
+(* !(!*ENTRY FIXP EXPR !1!) *)
+(* EXPR FIXP *)
+procedure PAS251;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK NUMBERP EXPR !1!) *)
+ PAS250;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS252;
+forward;
+(* !(!*ENTRY ABS EXPR !1!) *)
+(* EXPR ABS *)
+procedure PAS253;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LINK MINUSP EXPR !1!) *)
+ PAS252;
+(* !(!*JUMPNIL G!0!2!1!7!) *)
+ IF R[1] = nilref THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK MINUS EXPR !1!) *)
+ XMINUS;
+(* !(!*JUMP G!0!2!1!8!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!1!7!) *)
+100:
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LBL G!0!2!1!8!) *)
+101:
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY SUB!1 EXPR !1!) *)
+(* EXPR SUB1 *)
+procedure PAS254;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE !-!1!)!) *)
+ mkint(-1,2);
+(* !(!*LINK PLUS!2 EXPR !2!) *)
+ XPLUS2;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ZEROP EXPR !1!) *)
+(* EXPR ZEROP *)
+procedure PAS255;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE !0!)!) *)
+ mkint(0,2);
+(* !(!*LINK EQ EXPR !2!) *)
+ PAS22;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ONEP EXPR !1!) *)
+(* EXPR ONEP *)
+procedure PAS256;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE !1!)!) *)
+ mkint(1,2);
+(* !(!*LINK EQ EXPR !2!) *)
+ PAS22;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY IDP EXPR !1!) *)
+(* EXPR IDP *)
+procedure PAS24;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!2!2!4 !1 IDTAG!) *)
+ IF tag_of(R[1]) <> IDTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!2!2!5!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!2!4!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!2!2!5!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS257;
+forward;
+(* !(!*ENTRY EXPT EXPR !2!) *)
+(* EXPR EXPT *)
+procedure PAS257;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*JUMPN G!0!2!2!8 !(QUOTE !0!)!) *)
+ mkitem(INTTAG,0,RXX);
+ IF R[1] <> RXX THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE !1!)!) *)
+ mkint(1,1);
+(* !(!*JUMP G!0!2!3!0!) *)
+ GOTO 102;
+(* !(!*LBL G!0!2!2!8!) *)
+100:
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK MINUSP EXPR !1!) *)
+ PAS252;
+(* !(!*JUMPNIL G!0!2!2!9!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LOAD !1 !(QUOTE !0!)!) *)
+ mkint(0,1);
+(* !(!*JUMP G!0!2!3!0!) *)
+ GOTO 102;
+(* !(!*LBL G!0!2!2!9!) *)
+101:
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK SUB!1 EXPR !1!) *)
+ PAS254;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK EXPT EXPR !2!) *)
+ PAS257;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK TIMES!2 EXPR !2!) *)
+ XTIMES2;
+(* !(!*LBL G!0!2!3!0!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY FIX EXPR !1!) *)
+(* EXPR FIX *)
+procedure PAS258;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY FLOAT EXPR !1!) *)
+(* EXPR FLOAT *)
+procedure PAS259;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+procedure PAS260;
+forward;
+(* !(!*ENTRY MAX MACRO !1!) *)
+(* MACRO MAX *)
+procedure PAS261;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE MAX!2!)!) *)
+ mkident(148,2);
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*LINK EXPAND EXPR !2!) *)
+ PAS260;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY MIN MACRO !1!) *)
+(* MACRO MIN *)
+procedure PAS262;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE MIN!2!)!) *)
+ mkident(149,2);
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*LINK EXPAND EXPR !2!) *)
+ PAS260;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PLUS MACRO !1!) *)
+(* MACRO PLUS *)
+procedure PAS263;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE PLUS!2!)!) *)
+ mkident(150,2);
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*LINK EXPAND EXPR !2!) *)
+ PAS260;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY TIMES MACRO !1!) *)
+(* MACRO TIMES *)
+procedure PAS264;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !2 !(QUOTE TIMES!2!)!) *)
+ mkident(151,2);
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*LINK EXPAND EXPR !2!) *)
+ PAS260;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY MAX!2 EXPR !2!) *)
+(* EXPR MAX2 *)
+procedure PAS265;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK GREATERP EXPR !2!) *)
+ XGREATERP;
+(* !(!*JUMPNIL G!0!2!4!1!) *)
+ IF R[1] = nilref THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*JUMP G!0!2!4!2!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!4!1!) *)
+100:
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LBL G!0!2!4!2!) *)
+101:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY MIN!2 EXPR !2!) *)
+(* EXPR MIN2 *)
+procedure PAS266;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK LESSP EXPR !2!) *)
+ XLESSP;
+(* !(!*JUMPNIL G!0!2!4!5!) *)
+ IF R[1] = nilref THEN GOTO 100;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*JUMP G!0!2!4!6!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!4!5!) *)
+100:
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LBL G!0!2!4!6!) *)
+101:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY FUNCTION FEXPR !1!) *)
+(* FEXPR FUNCTION *)
+procedure PAS267;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY EXPAND EXPR !2!) *)
+(* EXPR EXPAND *)
+procedure PAS260;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !(CDR !1!)!) *)
+ XCDR;
+(* !(!*JUMPT G!0!2!5!0!) *)
+ IF R[1] <> nilref THEN GOTO 100;
+(* !(!*LOAD !1 !(CAR !0!)!) *)
+ ANYcar(stk[st],R[1]);
+(* !(!*JUMP G!0!2!5!1!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!5!0!) *)
+100:
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK EXPAND EXPR !2!) *)
+ PAS260;
+(* !(!*LOAD !3 !1!) *)
+ R[3] := R[1];
+(* !(!*LOAD !2 !(CAR !0!)!) *)
+ ANYcar(stk[st],R[2]);
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LINK LIST!3 EXPR !3!) *)
+ PAS29;
+(* !(!*LBL G!0!2!5!1!) *)
+101:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY NUMBERP EXPR !1!) *)
+(* EXPR NUMBERP *)
+procedure PAS250;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!2!5!5 !1 NUMTAG!) *)
+ IF not((tag_of(R[1]) = INTTAG)
+ or (tag_of(R[1]) = FIXTAG)) THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!2!5!6!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!5!5!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!2!5!6!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY ATOM EXPR !1!) *)
+(* EXPR ATOM *)
+procedure PAS268;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!2!5!9 !1 ATOM!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!2!6!0!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!5!9!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!2!6!0!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY MINUSP EXPR !1!) *)
+(* EXPR MINUSP *)
+procedure PAS252;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*JUMPNC G!0!2!6!3 !1 NUMTAG!) *)
+ IF not((tag_of(R[1]) = INTTAG)
+ or (tag_of(R[1]) = FIXTAG)) THEN GOTO 100;
+(* !(!*LOAD !2 !(QUOTE !-!1!)!) *)
+ mkint(-1,2);
+(* !(!*LINK GREATERP EXPR !2!) *)
+ XGREATERP;
+(* !(!*JUMPT G!0!2!6!3!) *)
+ IF R[1] <> nilref THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE T!)!) *)
+ R[1] := trueref;
+(* !(!*JUMP G!0!2!6!5!) *)
+ GOTO 101;
+(* !(!*LBL G!0!2!6!3!) *)
+100:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LBL G!0!2!6!5!) *)
+101:
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY SET EXPR !2!) *)
+(* EXPR SET *)
+procedure PAS269;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPNC G!0!2!6!9 !1 IDTAG!) *)
+ IF tag_of(R[1]) <> IDTAG THEN GOTO 100;
+(* !(!*JUMPE G!0!2!6!9 !(QUOTE T!)!) *)
+ IF R[1]=trueref THEN GOTO 100;
+(* !(!*JUMPN G!0!2!6!8 !(QUOTE NIL!)!) *)
+ IF R[1] <> nilref THEN GOTO 101;
+(* !(!*LBL G!0!2!6!9!) *)
+100:
+(* !(!*LOAD !1 !2!) *)
+ R[1] := R[2];
+(* !(!*LINK NCONS EXPR !1!) *)
+ XNCONS;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LOAD !2 !(QUOTE SET!)!) *)
+ mkident(152,2);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*JUMP G!0!2!7!2!) *)
+ GOTO 102;
+(* !(!*LBL G!0!2!6!8!) *)
+101:
+(* !(!*LINK SETVALUE EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].VAL := R[2];
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*LBL G!0!2!7!2!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PRINC EXPR !1!) *)
+(* EXPR PRINC *)
+procedure PAS270;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK PRIN!2 EXPR !1!) *)
+ PAS129;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PRIN!1 EXPR !1!) *)
+(* EXPR PRIN1 *)
+procedure PAS271;
+begin
+(* !(!*ALLOC !0!) *)
+(* !(!*LINK PRIN!2 EXPR !1!) *)
+ PAS129;
+(* !(!*DEALLOC !0!) *)
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PRINT EXPR !1!) *)
+(* EXPR PRINT *)
+procedure XPRINT;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LINK PRIN!1 EXPR !1!) *)
+ PAS271;
+(* !(!*LINK TERPRI EXPR !0!) *)
+ XTERPRI;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PRIN!2T EXPR !1!) *)
+(* EXPR PRIN2T *)
+procedure PAS272;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LINK PRIN!2 EXPR !1!) *)
+ PAS129;
+(* !(!*LINK TERPRI EXPR !0!) *)
+ XTERPRI;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY LBIND!1 EXPR !2!) *)
+(* EXPR LBIND1 *)
+procedure PAS273;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LINK VALUE EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].VAL;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LOAD !2 !(FLUID BSTK!*!)!) *)
+ R[2] := idspace[130].val;
+(* !(!*LINK CONS EXPR !2!) *)
+ XCONS;
+(* !(!*STORE !1 !(FLUID BSTK!*!)!) *)
+ idspace[130].val := R[1];
+(* !(!*LOAD !2 !-!1!) *)
+ load(2,1);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SETVALUE EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].VAL := R[2];
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PBIND!1 EXPR !1!) *)
+(* EXPR PBIND1 *)
+procedure PAS274;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LINK VALUE EXPR !1!) *)
+ R[1] := IDSPACE[INFO_OF(R[1])].VAL;
+(* !(!*LOAD !2 !0!) *)
+ load(2,0);
+(* !(!*LINK XCONS EXPR !2!) *)
+ XXCONS;
+(* !(!*LOAD !2 !(FLUID BSTK!*!)!) *)
+ R[2] := idspace[130].val;
+(* !(!*LINK CONS EXPR !2!) *)
+ XCONS;
+(* !(!*STORE !1 !(FLUID BSTK!*!)!) *)
+ idspace[130].val := R[1];
+(* !(!*LOAD !2 !(QUOTE NIL!)!) *)
+ R[2] := nilref;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SETVALUE EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].VAL := R[2];
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY UNBIND!1 EXPR !0!) *)
+(* EXPR UNBIND1 *)
+procedure PAS275;
+label
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*LOAD !1 !(FLUID BSTK!*!)!) *)
+ R[1] := idspace[130].val;
+(* !(!*JUMPC G!0!2!8!9 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !2 !(QUOTE BNDUNDERFLOW!)!) *)
+ mkident(153,2);
+(* !(!*LOAD !1 !(QUOTE !9!9!)!) *)
+ mkint(99,1);
+(* !(!*LINK ERROR EXPR !2!) *)
+ PAS215;
+(* !(!*LBL G!0!2!8!9!) *)
+100:
+(* !(!*LINK CAAR EXPR !1!) *)
+ PAS11;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !(FLUID BSTK!*!)!) *)
+ R[1] := idspace[130].val;
+(* !(!*LINK CDAR EXPR !1!) *)
+ PAS13;
+(* !(!*LOAD !2 !1!) *)
+ R[2] := R[1];
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SETVALUE EXPR !2!) *)
+ IDSPACE[INFO_OF(R[1])].VAL := R[2];
+(* !(!*LOAD !1 !(CDR !(FLUID BSTK!*!)!)!) *)
+ ANYcdr(idspace[130].val,R[1]);
+(* !(!*STORE !1 !(FLUID BSTK!*!)!) *)
+ idspace[130].val := R[1];
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY UNBINDN EXPR !1!) *)
+(* EXPR UNBINDN *)
+procedure PAS276;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LBL G!0!2!9!3!) *)
+100:
+(* !(!*LOAD !2 !(QUOTE !0!)!) *)
+ mkint(0,2);
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK GREATERP EXPR !2!) *)
+ XGREATERP;
+(* !(!*JUMPNIL G!0!2!9!2!) *)
+ IF R[1] = nilref THEN GOTO 101;
+(* !(!*LINK UNBIND!1 EXPR !0!) *)
+ PAS275;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*LINK SUB!1 EXPR !1!) *)
+ PAS254;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*JUMP G!0!2!9!3!) *)
+ GOTO 100;
+(* !(!*LBL G!0!2!9!2!) *)
+101:
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY UNBINDTO EXPR !2!) *)
+(* EXPR UNBINDTO *)
+procedure XUNBINDTO;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*LBL G!0!2!9!9!) *)
+100:
+(* !(!*LOAD !1 !(FLUID BSTK!*!)!) *)
+ R[1] := idspace[130].val;
+(* !(!*JUMPNC G!0!3!0!2 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 101;
+(* !(!*JUMPE G!0!3!0!2 !-!1!) *)
+ IF R[1]=stk[st-1] THEN GOTO 101;
+(* !(!*LINK UNBIND!1 EXPR !0!) *)
+ PAS275;
+(* !(!*JUMP G!0!2!9!9!) *)
+ GOTO 100;
+(* !(!*LBL G!0!3!0!2!) *)
+101:
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*LOAD !1 !0!) *)
+ load10;
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+procedure PAS277;
+forward;
+procedure PAS278;
+forward;
+(* !(!*ENTRY EVLAM EXPR !2!) *)
+(* EXPR EVLAM *)
+procedure PAS279;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !3!) *)
+ alloc3;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*JUMPNC G!0!3!0!7 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) <> PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*JUMPE G!0!3!0!6 !(QUOTE LAMBDA!)!) *)
+ mkitem(IDTAG,154,RXX);
+ IF R[1]=RXX THEN GOTO 101;
+(* !(!*LBL G!0!3!0!7!) *)
+100:
+(* !(!*LOAD !2 !(QUOTE NOT! DEFINED!)!) *)
+ mkident(155,2);
+(* !(!*LOAD !1 !(QUOTE !9!9!)!) *)
+ mkint(99,1);
+(* !(!*LINK ERROR EXPR !2!) *)
+ PAS215;
+(* !(!*LBL G!0!3!0!6!) *)
+101:
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*STORE !1 !-!2!) *)
+ store(1,2);
+(* !(!*LINK LBINDN EXPR !2!) *)
+ PAS277;
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK P!.N EXPR !1!) *)
+ PAS278;
+(* !(!*STORE !1 !-!1!) *)
+ store(1,1);
+(* !(!*LOAD !1 !-!2!) *)
+ load(1,2);
+(* !(!*LINK LENGTH EXPR !1!) *)
+ PAS232;
+(* !(!*LINK UNBINDN EXPR !1!) *)
+ PAS276;
+(* !(!*LOAD !1 !-!1!) *)
+ load(1,1);
+(* !(!*DEALLOC !3!) *)
+ dealloc3;
+(* !(!*EXIT!) *)
+end;
+procedure PAS280;
+forward;
+(* !(!*ENTRY LBINDN EXPR !2!) *)
+(* EXPR LBINDN *)
+procedure PAS277;
+label
+ 102,
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !2!) *)
+ alloc2;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*STORE !2 !-!1!) *)
+ store(2,1);
+(* !(!*JUMPC G!0!3!1!2 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!3!1!4!) *)
+ GOTO 102;
+(* !(!*LBL G!0!3!1!2!) *)
+100:
+(* !(!*JUMPC G!0!3!1!3 !2 PAIRTAG!) *)
+ IF tag_of(R[2]) = PAIRTAG THEN GOTO 101;
+(* !(!*LINK PBINDN EXPR !1!) *)
+ PAS280;
+(* !(!*JUMP G!0!3!1!4!) *)
+ GOTO 102;
+(* !(!*LBL G!0!3!1!3!) *)
+101:
+(* !(!*LOAD !2 !(CAR !2!)!) *)
+ ANYcar(R[2],R[2]);
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*LINK LBIND!1 EXPR !2!) *)
+ PAS273;
+(* !(!*LOAD !2 !(CDR !-!1!)!) *)
+ ANYcdr(stk[st-1],R[2]);
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK LBINDN EXPR !2!) *)
+ PAS277;
+(* !(!*LBL G!0!3!1!4!) *)
+102:
+(* !(!*DEALLOC !2!) *)
+ dealloc2;
+(* !(!*EXIT!) *)
+end;
+(* !(!*ENTRY PBINDN EXPR !1!) *)
+(* EXPR PBINDN *)
+procedure PAS280;
+label
+ 101,
+ 100;
+begin
+(* !(!*ALLOC !1!) *)
+ alloc1;
+(* !(!*STORE !1 !0!) *)
+ store10;
+(* !(!*JUMPC G!0!3!1!7 !1 PAIRTAG!) *)
+ IF tag_of(R[1]) = PAIRTAG THEN GOTO 100;
+(* !(!*LOAD !1 !(QUOTE NIL!)!) *)
+ R[1] := nilref;
+(* !(!*JUMP G!0!3!1!8!) *)
+ GOTO 101;
+(* !(!*LBL G!0!3!1!7!) *)
+100:
+(* !(!*LOAD !1 !(CAR !1!)!) *)
+ XCAR;
+(* !(!*LINK PBIND!1 EXPR !1!) *)
+ PAS274;
+(* !(!*LOAD !1 !(CDR !0!)!) *)
+ ANYcdr(stk[st],R[1]);
+(* !(!*LINK PBINDN EXPR !1!) *)
+ PAS280;
+(* !(!*LBL G!0!3!1!8!) *)
+101:
+(* !(!*DEALLOC !1!) *)
+ dealloc1;
+(* !(!*EXIT!) *)
+end;
ADDED perq-pascal-lisp-project/pas2.red
Index: perq-pascal-lisp-project/pas2.red
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas2.red
@@ -0,0 +1,363 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PASCAL BASED MINI-LISP
+%
+% File: PAS2.RED - Basic LISP Functions
+% ChangeDate: 10:42pm Wednesday, 15 July 1981
+% By: M. L. Griss
+% Change to add Features for Schlumberger Demo
+%
+% All RIGHTS RESERVED
+% COPYRIGHT (C) - 1981 - M. L. GRISS
+% Computer Science Department
+% University of Utah
+%
+% Do Not distribute with out written consent of M. L. Griss
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+SYMBOLIC PROCEDURE PAIRP X;
+ IF PAIRP X THEN T ELSE NIL;
+
+SMACRO PROCEDURE NOTNULL(X); %For readability.
+ X;
+
+SYMBOLIC PROCEDURE NOT X;
+ X EQ NIL;
+
+SYMBOLIC PROCEDURE CODEP X;
+ IF CODEP X THEN T ELSE NIL;
+
+SYMBOLIC PROCEDURE CONSTANTP X;
+ NULL (PAIRP X OR IDP X);
+
+SYMBOLIC PROCEDURE EQN(A,B);
+ A EQ B;
+
+%. List entries (+ CONS, NCONS, XCONS)
+
+SYMBOLIC PROCEDURE LIST2(R1,R2);
+ R1 . NCONS R2;
+
+SYMBOLIC PROCEDURE LIST3(R1,R2,R3);
+ R1 . LIST2(R2,R3);
+
+SYMBOLIC PROCEDURE LIST4(R1,R2,R3,R4);
+ R1 . LIST3(R2,R3,R4);
+
+SYMBOLIC PROCEDURE LIST5(R1,R2,R3,R4,R5);
+ R1 . LIST4(R2,R3,R4,R5);
+
+SYMBOLIC PROCEDURE REVERSE U;
+ REV U;
+
+SYMBOLIC PROCEDURE APPEND(U,V);
+ BEGIN U:=REVERSE U;
+ WHILE PAIRP U DO <<V :=CAR U . V; U:=CDR U>>;
+ RETURN V
+ END;
+
+%. procedures to support GET and PUT, FLAG, etc.
+
+
+SYMBOLIC PROCEDURE MEMBER(A,B);
+ IF NULL B THEN A ELSE IF A EQ CAR B THEN B ELSE A MEMBER CDR B;
+
+SYMBOLIC PROCEDURE PAIR(U,V);
+ IF U AND V THEN (CAR U . CAR V) . PAIR(CDR U,CDR V)
+ ELSE IF U OR V THEN ERROR(0,'PAIR)
+ ELSE NIL;
+
+SYMBOLIC PROCEDURE SASSOC(U,V,FN);
+ IF NOT PAIRP V THEN APPLY(FN,'(NIL))
+ ELSE IF U EQ CAAR V THEN CAR V
+ ELSE SASSOC(U,CDR V,FN);
+
+SYMBOLIC PROCEDURE SUBLIS(X,Y);
+ IF NOT PAIRP X THEN Y
+ ELSE BEGIN SCALAR U;
+ U := ASSOC(Y,X);
+ RETURN IF U THEN CDR U
+ ELSE IF ATOM Y THEN Y
+ ELSE SUBLIS(X,CAR Y) . SUBLIS(X,CDR Y)
+ END;
+
+SYMBOLIC PROCEDURE SUBST(U,V,W);
+ IF NULL V THEN NIL
+ ELSE IF V EQ W THEN U
+ ELSE IF ATOM W THEN W
+ ELSE SUBST(U,V,CAR W) . SUBST(U,V,CDR W);
+
+SYMBOLIC PROCEDURE MEMQ(U,V);
+ IF NOT PAIRP V THEN V
+ ELSE IF U EQ CAR V THEN V ELSE MEMQ(U,CDR V);
+
+SYMBOLIC PROCEDURE ATSOC(U,V);
+ IF NOT PAIRP V THEN V
+ ELSE IF (NOT PAIRP CAR V)
+ OR NOT(U EQ CAAR V) THEN ATSOC(U,CDR V)
+ ELSE CAR V;
+
+SYMBOLIC PROCEDURE ASSOC(U,V);
+ IF NOT PAIRP V THEN NIL
+ ELSE IF ATOM CAR V THEN ERROR(100,LIST(V,'ASSOC))
+ ELSE IF U EQ CAAR V THEN CAR V
+ ELSE ASSOC(U,CDR V);
+
+SYMBOLIC PROCEDURE DEFLIST(U,IND);
+ IF NOT PAIRP U THEN NIL
+ ELSE (<<PUT(CAAR U,IND,CADAR U); CAAR U>>) . DEFLIST(CDR U,IND);
+
+SYMBOLIC PROCEDURE DELETE(U,V);
+ IF NOT PAIRP V THEN NIL
+ ELSE IF U=CAR V THEN CDR V
+ ELSE CAR V . DELETE(U,CDR V);
+
+SYMBOLIC PROCEDURE DELQ(U,V);
+ IF NOT PAIRP V THEN V
+ ELSE IF U EQ CAR V THEN CDR V
+ ELSE CAR V . DELQ(U,CDR V); % Recopy
+
+SYMBOLIC PROCEDURE DELATQ(U,V);
+ IF NOT PAIRP V THEN V
+ ELSE IF (NOT PAIRP CAR V)
+ OR NOT(U EQ CAAR V) THEN (CAR V . DELATQ(U,CDR V))
+ ELSE CDR V;
+
+SYMBOLIC PROCEDURE GET(U,V);
+ IF NOT IDP U THEN NIL
+ ELSE IF PAIRP (U:=ATSOC(V,PLIST U)) THEN CDR U ELSE NIL;
+
+SYMBOLIC PROCEDURE PUT(U,V,WW);
+ BEGIN SCALAR L;
+ IF NOT IDP U THEN RETURN WW;
+ L:=PLIST U;
+ IF ATSOC(V,L) THEN L:=DELATQ(V,L);
+ IF NOTNULL WW THEN L:=(V . WW) . L;
+ SETPLIST(U,L);
+ RETURN WW;
+ END;
+
+SYMBOLIC PROCEDURE REMPROP(U,V);
+ PUT(U,V,NIL);
+
+
+SYMBOLIC PROCEDURE LENGTH L;
+ IF NOT PAIRP L THEN 0
+ ELSE 1+LENGTH CDR L;
+
+SYMBOLIC PROCEDURE ERRPRT L;
+ <<PRIN2 '!*!*!*!*! ; PRINT L>>;
+
+SYMBOLIC PROCEDURE MSGPRT L;
+ <<PRIN2 '!*!*!*! ; PRINT L>>;
+
+SYMBOLIC PROCEDURE FLAGP(NAM,FLG);
+ IDP NAM AND FLG MEMQ PLIST NAM;
+
+SYMBOLIC PROCEDURE FLAG(NAML,FLG);
+ IF NOT PAIRP NAML THEN NIL
+ ELSE <<FLAG1(CAR NAML,FLG); FLAG(CDR NAML,FLG)>>;
+
+SYMBOLIC PROCEDURE FLAG1(NAM,FLG);
+ IF NOT IDP NAM THEN NIL
+ ELSE IF FLG MEMQ PLIST NAM THEN NIL
+ ELSE SETPLIST(NAM, FLG . PLIST(NAM));
+
+SYMBOLIC PROCEDURE REMFLAG(NAML,FLG);
+ IF NOT PAIRP NAML THEN NIL
+ ELSE <<REMFLAG1(CAR NAMl,FLG); REMFLAG(CDR NAML,FLG)>>;
+
+SYMBOLIC PROCEDURE REMFLAG1(NAM,FLG);
+ IF NOT IDP NAM THEN NIL
+ ELSE IF NOT(FLG MEMQ PLIST NAM)THEN NIL
+ ELSE SETPLIST(NAM,DELQ(FLG, PLIST(NAM)));
+
+% Interpreter entries for some important OPEN-coded functions;
+
+SYMBOLIC PROCEDURE EQ(U,V);
+ IF U EQ V THEN T ELSE NIL; % Careful, only bool-test opencoded
+
+SYMBOLIC PROCEDURE EQCAR(U,V);
+ IF PAIRP U THEN IF(CAR U EQ V) THEN T ELSE NIL;
+
+SYMBOLIC PROCEDURE NULL U;
+ U EQ NIL;
+
+SYMBOLIC PROCEDURE PLIST U;
+ PLIST U;
+
+SYMBOLIC PROCEDURE VALUE U;
+ VALUE U;
+
+SYMBOLIC PROCEDURE FUNCELL U;
+ FUNCELL U;
+
+SYMBOLIC PROCEDURE SETPLIST(U,V);
+ SETPLIST(U,V);
+
+SYMBOLIC PROCEDURE SETVALUE(U,V);
+ SETVALUE(U,V);
+
+SYMBOLIC PROCEDURE SETFUNCELL(U,V);
+ SETFUNCELL(U,V);
+
+%. Support for ALGebra
+
+SYMBOLIC PROCEDURE ORDERP(X,Y); %. Compare ID orders
+ !*INF(X) <= !*INF(Y);
+
+SYMBOLIC PROCEDURE TOKEN; %. Renaming
+ BEGIN TOK!*:=RDTOK();
+ IF CHARP TOK!* THEN TOK!*:=CHAR2ID TOK!*;
+ RETURN TOK!*;
+ END;
+
+% Can get confused if user changes from non-hashed to hashed cons.
+
+SYMBOLIC PROCEDURE EQUAL(X,Y);
+ IF ATOM(X) THEN IF ATOM(Y) THEN X EQ Y ELSE NIL
+ ELSE IF ATOM(Y) THEN NIL ELSE EQUAL(CAR X, CAR Y) AND EQUAL(CDR X, CDR Y);
+
+%--------- CATCH/THROW and ERROR handler ---------------
+
+SYMBOLIC PROCEDURE ERROR(X,Y);
+ <<PRINT LIST('!*!*!*!*! ERROR! ,X,Y);
+ EMSG!* := Y; ENUM!* := X;
+ THROW X>>;
+
+SYMBOLIC PROCEDURE ERRORSET(FORM,MSGP,TRACEP);
+ BEGIN SCALAR VAL;
+ THROWING!* :=NIL;
+ VAL:=CATCH FORM;
+ IF NOT THROWING!* THEN RETURN LIST VAL;
+ THROWING!*:=NIL;
+ IF MSGP THEN PRINT LIST('!*!*!*!*,ENUM!*,EMSG!*);
+ RETURN VAL
+ END;
+
+% More ARITHMETIC
+SYMBOLIC PROCEDURE FIXP X; NUMBERP X;
+
+SYMBOLIC PROCEDURE ABS X;
+ IF X < 0 THEN (-X) ELSE X;
+
+SYMBOLIC PROCEDURE SUB1 X;
+ PLUS2(X,MINUS 1);
+
+SYMBOLIC PROCEDURE ZEROP X;
+ X=0;
+
+SYMBOLIC PROCEDURE ONEP X;
+ X=1;
+
+SYMBOLIC PROCEDURE IDP X;
+ IF IDP X THEN T ELSE NIL;
+SYMBOLIC PROCEDURE EXPT(A,B);
+ IF B EQ 0 THEN 1
+ ELSE IF B <0 THEN 0 % Error ?
+ ELSE TIMES2(A,A**SUB1 B);
+
+SYMBOLIC PROCEDURE FIX X; X;
+
+SYMBOLIC PROCEDURE FLOAT X; X;
+% Should BE MACROS, check problem?
+
+SYMBOLIC MACRO PROCEDURE MAX X; EXPAND(CDR X,'MAX2);
+
+SYMBOLIC MACRO PROCEDURE MIN X; EXPAND(CDR X,'MIN2);
+
+SYMBOLIC MACRO PROCEDURE PLUS X; EXPAND(CDR X,'PLUS2);
+
+SYMBOLIC MACRO PROCEDURE TIMES X; EXPAND(CDR X,'TIMES2);
+
+SYMBOLIC PROCEDURE MAX2(A,B); IF A>B THEN A ELSE B;
+
+SYMBOLIC PROCEDURE MIN2(A,B); IF A<B THEN A ELSE B;
+
+SYMBOLIC FEXPR PROCEDURE FUNCTION X; CAR X;
+
+SYMBOLIC PROCEDURE EXPAND(L,FN);
+ IF NULL CDR L THEN CAR L ELSE LIST(FN,CAR L,EXPAND(CDR L,FN));
+
+SYMBOLIC PROCEDURE NUMBERP X;
+ IF NUMBERP X THEN T ELSE NIL;
+
+SYMBOLIC PROCEDURE ATOM X;
+ IF ATOM X THEN T ELSE NIL;
+
+SYMBOLIC PROCEDURE MINUSP X;
+ IF NUMBERP X AND X <=(-1) THEN T ELSE NIL;
+
+SYMBOLIC PROCEDURE SET(A,B);
+ IF (NOT IDP(A)) OR (A EQ 'T) OR (A EQ 'NIL) THEN
+ ('SET . A . B . NIL) % Error value
+ ELSE <<SETVALUE(A,B); B>>;
+
+SYMBOLIC PROCEDURE PRINC X;
+ PRIN2 X;
+
+SYMBOLIC PROCEDURE PRIN1 X;
+ PRIN2 X;
+
+SYMBOLIC PROCEDURE PRINT X;
+ <<PRIN1 X; TERPRI(); X>>;
+
+SYMBOLIC PROCEDURE PRIN2T X;
+ <<PRIN2 X; TERPRI(); X>>;
+
+%. a) Simple Binding for LAMBDA eval
+% Later convert to bstack in PAS0, will need GC hooks
+
+FLUID '(BSTK!*); % The Binding stack, list of (id . oval)
+ % For Special cell model
+SYMBOLIC PROCEDURE LBIND1(IDNAME,NVAL); %. For LAMBDA
+ <<BSTK!*:=(IDNAME . VALUE(IDNAME)) . BSTK!*;
+ SETVALUE(IDNAME,NVAL)>>;
+
+SYMBOLIC PROCEDURE PBIND1(IDNAME); %. Prog Bind 1 id
+ <<BSTK!*:=(IDNAME . VALUE(IDNAME)) . BSTK!*;
+ SETVALUE(IDNAME,'NIL)>>;
+
+SYMBOLIC PROCEDURE UNBIND1; %. Unbind 1 item
+ IF PAIRP BSTK!* THEN <<SETVALUE(CAAR BSTK!*,CDAR BSTK!*);
+ BSTK!*:=CDR BSTK!*>>
+ ELSE ERROR(99,'BNDUNDERFLOW);
+
+SYMBOLIC PROCEDURE UNBINDN N; %. Unbind N items
+ WHILE N>0 DO <<UNBIND1(); N:=N-1>>;
+
+SYMBOLIC PROCEDURE UNBINDTO(RETVAL,OLDSTK); %. Unbind to CATCH-mark
+ <<WHILE PAIRP BSTK!* AND NOT(BSTK!* EQ OLDSTK)
+ DO UNBIND1();
+ RETVAL>>;
+
+% b) Simple LAMBDA evaluator
+
+SYMBOLIC PROCEDURE EVLAM(LAM,ARGS); %. Will PAD args NILs
+ BEGIN SCALAR VARS,BOD;
+ IF NOT (PAIRP LAM AND CAR LAM EQ 'LAMBDA)
+ THEN RETURN ERROR(99,'Not! defined);
+ LAM:=CDR LAM;
+ VARS:=CAR LAM;
+ LBINDN(VARS,ARGS); % Set up BSTK!*
+ BOD:=P!.N CDR LAM; % and do PROGN eval
+ UNBINDN LENGTH VARS; % restore BSTK!*
+ RETURN BOD
+ END;
+
+SYMBOLIC PROCEDURE LBINDN(VARS,ARGS); %. Bind each element of VARS to ARGS
+ IF NOT PAIRP VARS THEN NIL
+ ELSE IF NOT PAIRP ARGS THEN PBINDN VARS % rest to NIL
+ ELSE <<LBIND1(CAR VARS,CAR ARGS);
+ LBINDN(CDR VARS,CDR ARGS)>>;
+
+
+SYMBOLIC PROCEDURE PBINDN VARS; %. Bind each element of VARS to NIL
+ IF NOT PAIRP VARS THEN NIL
+ ELSE <<PBIND1 CAR VARS;
+ PBINDN CDR VARS>>;
+
+
+END$
+
ADDED perq-pascal-lisp-project/pas2.sli
Index: perq-pascal-lisp-project/pas2.sli
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas2.sli
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas2.sym
Index: perq-pascal-lisp-project/pas2.sym
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas2.sym
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas3.bld
Index: perq-pascal-lisp-project/pas3.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas3.bld
@@ -0,0 +1,56 @@
+DEF s: <SCRATCH>
+DEF DSK: DSK:,SYS:
+DEF SYS: DSK:,SYS:
+pas:PASCMP
+OFF SYSLISP$
+OFF MSG$
+OFF NOUUO$
+OFF DOMOVE$ % Can't have BOTH DOMOVE and FXFRM
+OFF NOFIXFRM; % Reduce ALLOCS
+ON MACECHO$ %OFF Cuts down size of output file.
+
+% passer fixups
+
+REMPROP('W,'STAT);
+REMPROP('PLIST,'STAT);
+PUT(QUOTE SETQ,QUOTE UNARY,QUOTE SETQ)$ % Permit FEXPR definitions
+PUT(QUOTE AND,QUOTE UNARY,QUOTE AND)$
+PUT(QUOTE OR,QUOTE UNARY,QUOTE OR)$
+
+IN PAS2.SYM$
+% Perhaps the following lines should really be in POLY.RED, but they
+% don't work correctly inside body of text being compiled.
+PUT('CAR,'ANYREG,'T)$
+PUT('CDR,'ANYREG,'T)$
+PUT('VALUE,'OPENCOD,'(" R[1] := idspace[info_of(R[1])].val;"));
+PUT('PLIST,'OPENCOD,'(" R[1] := idspace[Info_of(r[1])].plist;"));
+PUT('FUNCELL,'OPENCOD,'(" R[1] := idspace[Info_of(r[1])].funcell;"));
+PUT('SETVALUE,'OPENCOD,'(" idspace[Info_of(r[1])].val := R[2];"));
+PUT('SETPLIST,'OPENCOD,'(" idspace[Info_of(r[1])].plist := R[2];"));
+PUT('SETFUNCELL,'OPENCOD,'(" idspace[Info_of(r[1])].funcell := R[2];"));
+PUT('CHAR2ID,'OPENCOD,'(" set_tag(R[1], idtag);"));
+PUT('CODEP, 'OPENCOD, '(" tag_of(r[1]) = codetag;"));
+
+OUT PAS3.PAS$
+DRT1('PAS3,PAS2IDS,PAS2CSTS,PAS2LITS,PAS2FNS)$
+IN PAS3.RED$
+DRT2()$
+SHUT PAS3.PAS$
+
+OUT PAS3.SYM$
+DUMPSYMS('PAS3)$
+SHUT PAS3.SYM$
+
+OUT PAS3.SLI$
+DRT3()$
+SHUT PAS3.SLI$
+
+OUT EXEC.PAS$
+DMPFLST()$ % Construct EXECUTE table
+SHUT EXEC.PAS$
+
+OUT PAS3.INI$
+DUMPINI()$
+SHUT PAS3.INI$
+QUIT$
+
ADDED perq-pascal-lisp-project/pas3.ini
Index: perq-pascal-lisp-project/pas3.ini
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas3.ini
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas3.pas
Index: perq-pascal-lisp-project/pas3.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas3.pas
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas3.red
Index: perq-pascal-lisp-project/pas3.red
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas3.red
@@ -0,0 +1,351 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PASCAL BASED MINI-LISP
+%
+% File: PAS3.RED - Basic LISP Functions
+% ChangeDate: 10:48pm Wednesday, 15 July 1981
+% By: M. L. Griss
+% Change to add Features for Schlumberger Demo
+%
+% All RIGHTS RESERVED
+% COPYRIGHT (C) - 1981 - M. L. GRISS
+% Computer Science Department
+% University of Utah
+%
+% Do Not distribute with out written consent of M. L. Griss
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%. Tagged TCATCH and TTHROW In terms of CATCH and THROW
+
+SYMBOLIC PROCEDURE TCATCH(TG,FORM);
+ BEGIN SCALAR VAL;
+ THROWING!* := NIL;
+ VAL:=CATCH(FORM);
+ IF NULL TG OR NULL THROWING!* THEN RETURN VAL; % CatchALL
+ IF THROWTAG!* EQ TG THEN RETURN VAL;
+ THROW VAL;
+ END;
+
+SYMBOLIC PROCEDURE TTHROW(TG,VAL);
+ <<THROWING!* := 'T;
+ THROWTAG!* := TG;
+ THROW VAL>>;
+
+SYMBOLIC PROCEDURE GETD NAM; %. Return (type.code) if func
+ BEGIN SCALAR TY,V;
+ IF NOT IDP NAM THEN RETURN NIL;
+ TY:=GET(NAM,'TYPE);
+ V:=FUNCELL NAM;
+ IF NULL TY AND V THEN TY:='EXPR;
+ IF V THEN RETURN (TY . V) ELSE RETURN NIL;
+ END;
+
+SYMBOLIC PROCEDURE PUTD(NAM,TY,BOD); %. Make function entry
+ IF FLAGP(NAM, 'LOSE) THEN
+ << ERRPRT LIST(NAM,'not,'flagged,'LOSE); NAM >>
+ ELSE BEGIN
+ IF GETD(NAM) THEN MSGPRT LIST('Function,NAM,'redefined);
+ IF (CODEP BOD OR EQCAR(BOD,'LAMBDA)
+ AND TY MEMQ '(EXPR FEXPR NEXPR MACRO) )
+ THEN <<IF TY EQ 'EXPR THEN TY:=NIL;
+ PUT(NAM,'TYPE,TY);
+ SETFUNCELL(NAM,BOD)>>
+ ELSE RETURN ERROR(99,LIST(NAM,'Cant,'be,'defined));
+ RETURN NAM;
+ END;
+
+SYMBOLIC PROCEDURE REMD NAM; %. Remove function defn
+ BEGIN SCALAR PR;
+ IF (PR:=GETD NAM) THEN <<SETFUNCELL(NAM,NIL);
+ REMPROP(NAM,'TYPE)>>;
+ RETURN PR;
+ END;
+
+
+%. Convenient definitions
+
+SYMBOLIC PROCEDURE PUTL(L,IND,VAL);
+ IF NOT PAIRP L THEN NIL
+ ELSE <<PUT(CAR L,IND,VAL);
+ PUTL(CDR L,IND,VAL)>>;
+
+SYMBOLIC FEXPR PROCEDURE DE L;
+ PUTD(CAR L,'EXPR,'LAMBDA . CDR L);
+
+SYMBOLIC FEXPR PROCEDURE DF L;
+ PUTD(CAR L,'FEXPR,'LAMBDA . CDR L);
+
+SYMBOLIC FEXPR PROCEDURE DN L;
+ PUTD(CAR L,'NEXPR,'LAMBDA . CDR L);
+
+SYMBOLIC FEXPR PROCEDURE DM L;
+ PUTD(CAR L,'MACRO,'LAMBDA . CDR L);
+
+%. d) Improved EVAL, with LAMBDA, FEXPR, etc
+
+SYMBOLIC PROCEDURE EVAL(X);
+ BEGIN SCALAR FN,A,TY;
+ L:IF IDP(X) THEN RETURN VALUE(X)
+ ELSE IF NOT PAIRP(X) OR (FN := CAR X) EQ 'LAMBDA THEN
+ RETURN X;
+ A := CDR X; % Arguments
+ IF FN EQ 'QUOTE THEN %Important special Fexprs
+ RETURN CAR(A);
+ IF FN EQ 'SETQ THEN RETURN SET(CAR A,EVAL CADR A);
+ IF IDP FN AND (TY := GET(FN, 'TYPE)) THEN
+ <<IF TY EQ 'FEXPR THEN
+ RETURN APPLY1(FN,A); % No Spread, No EVAL
+ IF TY EQ 'NEXPR THEN
+ RETURN APPLY1(FN,EVLIS A); % No Spread, EVAL
+ IF TY EQ 'MACRO % Reval full form
+ THEN <<X := APPLY1(FN,X); GOTO L >> >>;
+ A := EVLIS A;
+ IF FN EQ 'LIST THEN RETURN A;
+ RETURN APPLY(FN,A);
+END;
+
+SYMBOLIC PROCEDURE APPLY1(FN,A);
+ APPLY(FN, A . NIL);
+
+SYMBOLIC PROCEDURE APPLY(FN,A);
+ BEGIN SCALAR EFN;
+ EFN := FUNCELL FN;
+ IF CODEP EFN THEN RETURN XAPPLY(EFN,A); % Spread args and EXECUTE
+ RETURN EVLAM(EFN,A);
+END;
+
+SYMBOLIC PROCEDURE EVLIS(L);
+IF NOT PAIRP L THEN EVAL L
+ ELSE EVAL(CAR L) . EVLIS(CDR L);
+
+%. Some standard FEXPRS and MACROS
+
+SYMBOLIC FEXPR PROCEDURE PROGN ARGS; %. Evaluate a LIST
+ P!.N ARGS;
+
+SYMBOLIC PROCEDURE PROG2(A,B); B;
+
+SYMBOLIC PROCEDURE P!.N ARGS; %. EVALS elems of list and returns last
+BEGIN SCALAR ANS;
+ WHILE PAIRP ARGS DO <<ANS := EVAL CAR ARGS; ARGS:=CDR ARGS>>;
+ RETURN ANS
+END;
+
+%.===== Section 3.7 ===== Program Feature functions
+
+% All this stuff should be rewritten to use the same binding mechanism as
+% compiled code, and obey the same constraints on placement of GO/RETURN
+% as compiled code.
+
+SYMBOLIC FEXPR PROCEDURE RETURN E; %. Return From Current PROG
+<< P!.P := NIL;
+ TTHROW('!$PROG!$,P!.N E) >>;
+
+SYMBOLIC FEXPR PROCEDURE GO E; %. Go to label in Current PROG
+BEGIN SCALAR L;
+ E := CAR E;
+ REPEAT <<
+ WHILE NOT IDP E DO
+ ERROR(1100,LIST(E,'Not,'Label));
+ L := ATSOC(E,P!.G);
+ IF ATOM L THEN
+ ERROR(1101,LIST(E,'Not,'a,'label))>>
+ UNTIL PAIRP L;
+ P!.P := CDR L;
+ TTHROW('!$PROG!$,NIL)
+END;
+
+SYMBOLIC FEXPR PROCEDURE PROG E; %. Program feature interpreter
+% P!.P is Next SEXPR to EVAL
+BEGIN SCALAR TG,X,V,NVALS,SAVEP,SAVEG;
+ SAVEP:=P!.P;
+ SAVEG:=P!.G; % Note FLUIDS not yet working compiled
+ NVALS :=LENGTH CAR E;
+ PBINDN CAR E; % Bind each to NIL, putting old value on BSTACK
+ P!.P := CDR E;
+% The code body
+ X := P!.P;
+ P!.G := NIL;
+ FOR EACH U ON P!.P DO
+ IF IDP CAR U THEN
+ P!.G := U . P!.G;
+ THROWING!* := NIL;
+ TG := '!$PROG!$;
+ WHILE P!.P AND TG EQ '!$PROG!$ DO <<
+ X := CAR P!.P;
+ P!.P := CDR P!.P;
+ IF NOT IDP X THEN <<
+ X := TCATCH(NIL,X);
+ IF THROWING!* THEN
+ <<TG := THROWTAG!*; V:=X>> >> >>;
+% UNBIND Even if thrown through
+ UNBINDN NVALS;
+ P!.P := SAVEP;
+ P!.G := SAVEG;
+ IF NOT(TG EQ '!$PROG!$) THEN
+ TTHROW(TG,V)
+ ELSE
+ RETURN V
+END;
+
+
+SYMBOLIC FEXPR PROCEDURE WHILE ARGS; %. Simple WHILE LOOP
+% Will do (WHILE bool s1 .. sn)
+ BEGIN SCALAR BOOL;
+ IF NOT PAIRP ARGS THEN RETURN NIL;
+ BOOL:=CAR ARGS;
+ L1: IF NULL EVAL BOOL THEN RETURN NIL;
+ P!.N CDR ARGS;
+ GOTO L1
+ END;
+
+
+SYMBOLIC FEXPR PROCEDURE AND(X); %. Xis list of actions
+ BEGIN
+ IF NOT PAIRP X THEN RETURN(T);
+ L: IF NULL CDR(X) THEN RETURN(EVAL(CAR X))
+ ELSE IF NULL EVAL(CAR X) THEN RETURN(NIL)
+ ELSE << X:=CDR X; GOTO L >>
+ END;
+
+%/// Add also IF ?
+
+SYMBOLIC FEXPR PROCEDURE COND(E); %. Conditional eval
+ BEGIN SCALAR PR,Y;
+ L: IF NOT PAIRP E THEN RETURN NIL;
+ PR:=CAR E; E:=CDR E;
+ IF PAIRP PR THEN Y:=CAR PR ELSE Y:=PR;
+ IF NULL (Y:=EVAL(Y)) THEN GOTO L;
+ IF NULL PAIRP PR OR NULL CDR PR THEN RETURN(Y);
+ RETURN P!.N(CDR PR)
+ END;
+
+SYMBOLIC FEXPR PROCEDURE OR(X); %. Or of action list
+ BEGIN SCALAR Y;
+ L: IF NOT PAIRP X THEN RETURN(NIL)
+ ELSE IF(Y:=EVAL(CAR X)) THEN RETURN(Y)
+ ELSE << X:=CDR X;GOTO L >>
+ END;
+
+%.===== Section 3.12 ===== MAP composite functions
+
+SYMBOLIC PROCEDURE MAP(X,FN); %. Apply FN to each cdr x
+ WHILE X DO <<APPLY1(FN,X); X := CDR X>>;
+
+SYMBOLIC PROCEDURE MAPC(X,FN); %. Apply FN to each car x
+ WHILE X DO <<APPLY1(FN,CAR X); X := CDR X>>;
+
+SYMBOLIC PROCEDURE MAPCAN(X,FN); %. Append FN car x
+ IF ATOM X THEN NIL ELSE NCONC(APPLY1(FN,CAR X),MAPCAN(CDR X,FN));
+
+SYMBOLIC PROCEDURE MAPCAR(X,FN); %. Collect FN car x
+ IF ATOM X THEN NIL ELSE APPLY1(FN,CAR X) . MAPCAR(CDR X,FN);
+
+SYMBOLIC PROCEDURE MAPCON(X,FN); %. Append FN cdr x
+ IF ATOM X THEN NIL ELSE NCONC(APPLY1(FN,X),MAPCON(CDR X,FN));
+
+SYMBOLIC PROCEDURE MAPLIST(X,FN); %. Collect FN cdr x
+ IF ATOM X THEN NIL ELSE APPLY1(FN,X) . MAPLIST(CDR X,FN);
+
+SYMBOLIC PROCEDURE NCONC(U,V); %. Tack V onto end U
+ BEGIN SCALAR W;
+ IF ATOM U THEN RETURN V;
+ W := U;
+ WHILE PAIRP CDR W DO W := CDR W;
+ RPLACD(W,V);
+ RETURN U
+ END;
+
+%... This procedure drives a simple read/eval/print top loop.
+
+SYMBOLIC PROCEDURE PUTC(X,Y,Z);
+ PUT(X,Y,Z);
+
+SYMBOLIC PROCEDURE FLUID L;
+ L;
+
+SYMBOLIC PROCEDURE PRIN2TL L;
+ IF NOT PAIRP L THEN TERPRI()
+ ELSE <<PRIN2 CAR L; PRIN2 '! ; PRIN2TL CDR L>>;
+% ... Missing functions to complete Standard LISP set
+% ... some dummies developed for PERQ, modified to better use PASLSP
+
+
+SYMBOLIC PROCEDURE FLOATP X; NIL;
+
+SYMBOLIC PROCEDURE STRINGP X; IDP X;
+
+SYMBOLIC PROCEDURE VECTORP X; NIL;
+
+SYMBOLIC PROCEDURE FLUIDP X; NIL;
+
+SYMBOLIC PROCEDURE INTERN X; X;
+
+SYMBOLIC PROCEDURE REMOB X; NIL;
+
+SYMBOLIC PROCEDURE GLOBAL X;
+ WHILE X DO <<FLAG(X,'GLOBAL); X := CDR X>>;
+
+SYMBOLIC PROCEDURE GLOBALP X;
+ FLAGP(X,'GLOBAL);
+
+SYMBOLIC PROCEDURE UNFLUID X;
+ NIL;
+
+
+% No vectors yet
+
+SYMBOLIC PROCEDURE GETV(A,B); NIL;
+
+SYMBOLIC PROCEDURE MKVECT X; NIL;
+
+SYMBOLIC PROCEDURE PUTV(A,B,C); NIL;
+
+SYMBOLIC PROCEDURE UPBV X; NIL;
+
+SYMBOLIC PROCEDURE DIGIT X; NIL;
+
+SYMBOLIC PROCEDURE LITER X; NIL;
+
+SYMBOLIC PROCEDURE READCH X; NIL; %/ Needs Interp Mod
+
+SYMBOLIC PROCEDURE RDEVPR;
+ WHILE T DO PRINT EVAL READ();
+
+SYMBOLIC PROCEDURE DSKIN(FILE);
+ BEGIN SCALAR TMP;
+ TMP := RDS OPEN(FILE, 'INPUT);
+ WHILE NULL EOFP PRINT EVAL READ() DO NIL; %Use RDEVPR ?
+ CLOSE RDS TMP;
+ END;
+
+SYMBOLIC PROCEDURE !*FIRST!-PROCEDURE;
+BEGIN SCALAR X, EOFFLG, OUT;
+ PRIN2TL '(Pascal LISP V2 !- 15 Feb 1982);
+ PRIN2TL '(Copyright (c) 1981 U UTAH);
+ PRIN2TL '(All Rights Reserved);
+ NEXPRS:='(LIST);
+ PUTL(NEXPRS,'TYPE,'NEXPR);
+ PROCS:='(EXPR FEXPR NEXPR MACRO);
+ EOFFLG := NIL;
+ % Continue reading Init-File on channel 1;
+ WHILE NOT EOFFLG DO
+ << X := READ();
+ EOFFLG := EOFP(X);
+ IF NOT EOFFLG THEN
+ EVAL X
+ >>;
+ RDS(2); % Switch to USER input, THE TTY
+ EOFFLG := NIL;
+ WHILE NOT EOFFLG DO
+ <<OUT := WRS 3; PRIN2 '!>; WRS OUT; % Prompt, OUT holds channel #
+ X := READ();
+ IF EQCAR(X,'QUIT) THEN EOFFLG := 'T ELSE EOFFLG := EOFP(X);
+ IF NOT EOFFLG THEN
+ PRIN2T(CATCH X)
+ >>;
+ PRIN2T LIST('EXITING,'Top,'Loop);
+END;
+
+END;
ADDED perq-pascal-lisp-project/pas3.sli
Index: perq-pascal-lisp-project/pas3.sli
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas3.sli
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pas3.sym
Index: perq-pascal-lisp-project/pas3.sym
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pas3.sym
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/pasasm.pat
Index: perq-pascal-lisp-project/pasasm.pat
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pasasm.pat
@@ -0,0 +1,330 @@
+%Patterns for Lisp to Pascal compilation.
+% Taken from FORTRAN version
+%"system" lisp to Fortran work: "SYSASM.PAT".
+%
+%Version of 4:23pm Monday, 13 October 1980.
+
+LISP$ OFF ECHO$ OFF RAISE$
+
+OFF COMP;
+ON SYSLISP;
+
+% Very optimized with inline consts, etc.
+
+RULEBLOCK (PAS2,
+
+'(!*ENTRY &1 &2 &3)->
+ (BEGIN
+ NALLOC:=0;
+ W "(* ",&2," ",&1," *)"$
+ W "procedure ",MAPFUN &1,";"$
+ DCLRLABELS(); %Declare the labels generated for this routine.
+ W "begin";
+ RETURN T END),
+
+% Exit VS end of procedure? Works now since we suppress !*LINKE.
+'(!*EXIT)->
+ (BEGIN
+ W "end;";
+ RETURN T END),
+
+'(!*ALLOC 0)-> T,
+
+'(!*ALLOC 1)->
+ (BEGIN
+ W " alloc1;" $
+ NALLOC:=1;
+ RETURN T END),
+
+'(!*ALLOC 2)->
+ (BEGIN
+ W " alloc2;" $
+ NALLOC:=2;
+ RETURN T END),
+
+'(!*ALLOC 3)->
+ (BEGIN
+ W " alloc3;" $
+ NALLOC:=3;
+ RETURN T END),
+
+'(!*ALLOC &1)->
+ (BEGIN
+ W " alloc(",&1,");" $
+ NALLOC:=&1;
+ RETURN T END),
+
+'(!*DEALLOC 0)->
+ <<NALLOC:=0;T>>,
+
+'(!*DEALLOC 1)->
+ <<NALLOC:=0;
+ W " dealloc1;" $
+ T>>,
+
+'(!*DEALLOC 2)->
+ <<NALLOC:=0;
+ W " dealloc2;" $
+ T>>,
+
+'(!*DEALLOC 3)->
+ <<NALLOC:=0;
+ W " dealloc3;" $
+ T>>,
+
+'(!*DEALLOC &1)->
+ <<NALLOC:=0;
+ IF &1 NEQ 0 THEN W " dealloc(",&1,");" $
+ T>>,
+
+'(!*LINK &1 &2 &3)->
+ (BEGIN SCALAR X$
+ IF X:=GET(&1,'OPENCOD) THEN
+ <<% Has OPENCOD form, no retadr needed
+ WLST X$
+ RETURN T$
+ >>
+ ELSE
+ <<
+ W " ",MAPFUN &1,";"; % simply invoke as proc;
+ RETURN T$
+ >>$
+ END),
+
+% Suppress LINKE by using ON NOLINKE;
+%'(!*LINKE &1 &2 &3 &4)-> NOTHING!
+
+'(!*LOAD 1 0)->
+ <<W " load10;";
+ T>>,
+
+'(!*LOAD &1 &2)->
+ (BEGIN SCALAR Y;
+ IF &1 NEQ &2 THEN Y:=LOADIT(&1,&2)$ %LOADIT may emit some code.
+ IF (REGNAM &1) NEQ Y THEN
+ IF NUMBERP(&1) AND NUMBERP(&2) AND (&2 <= 0) THEN
+ W " load(", &1 , "," , -&2 , ");"
+ ELSE
+ W " ",REGNAM &1," := ",Y,";" $
+ RETURN T END),
+
+'(!*MOVE &1 &2) -> % Need to FIX so RXX not used as much. If no YY then
+ (BEGIN SCALAR V1,V2;
+ IF &1 EQ &2 THEN RETURN T$
+ IF(V1:=EASYSTORE(&1)) THEN
+ RETURN <<STOREIT('XX,&2,V1);T>>$
+ V2:=LOADIT('XX,&2);
+ V1:=LOADIT('YY,&1);
+ W " ",V1," := ",V2,";"$
+ RETURN T END),
+
+%********** Delete--not needed?
+%'(!*PUTARR &1 &2 &3) ->
+% (BEGIN SCALAR V1,V2;
+% V1:=LOADIT('XX,&2);
+% V2:=LOADIT('YY,&3);
+% W " ",&1,"(",V1,")=",V2$
+% RETURN T END),
+%**********
+
+'(!*STORE 1 0)->
+ <<W " store10;";
+ T>>,
+
+'(!*STORE &1 (FLUID &2))-> PAS2 LIST('!*STORE,&1,LIST('GLOBAL,&2)),
+
+'(!*STORE &1 (GLOBAL &2))->
+ (BEGIN SCALAR V;
+ IF !*SYSLISP THEN
+ W " ",WSYSEVAL &2,":=",REGNAM &1,";"
+ ELSE
+ << V :=FNDID &2;
+ W " idspace[",V,"].val := ",REGNAM &1,";">>$
+ RETURN T END),
+
+'(!*STORE NIL &1)->
+ << W " storenil(", -&1 , ");" ;
+ T>>,
+
+'(!*STORE &1 &2)->
+ <<IF NUMBERP(&1) AND NUMBERP(&2) AND (&2 <=0 ) THEN
+ W " store(", &1 , "," , -&2 , ");"
+ ELSE
+ W " stk[st",&2,"] := ",REGNAM &1,";"$
+ T>>,
+
+'(!*LBL &1)-> <<W MAPLBL &1,": "$ T>>,
+
+'(!*JUMP &1)-> <<W " GOTO ",MAPLBL &1,";"$ T>>,
+
+%Delete? --> MAP to CASE?/MLG
+'(!*JUMPTABLE &1)->
+ << W " JMPIT=R[1]+1"$
+ W " IF((JMPIT.LE.0).OR.(R[1].GE.",LENGTH &1,"))GOTO ",MAPLBL CAR &1;
+ WX " GOTO(",LBLLST CDR &1,")JMPIT"$ T>>,
+
+'(!*JUMPE &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF R[1]=",V," THEN GOTO ",MAPLBL &1,";"$
+ RETURN T END),
+
+'(!*JUMPN &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF R[1] <> ",V," THEN GOTO ",MAPLBL &1,";"$
+ RETURN T END),
+
+'(!*JUMPWEQ &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF R[1]=",V," THEN GOTO ",MAPLBL &1,";"$
+ RETURN T END),
+
+'(!*JUMPWNE &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF info_of(R[1]) <> info_of(",V,") THEN GOTO ",MAPLBL &1,";"$
+ RETURN T END),
+
+'(!*JUMPWG &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF info_of(R[1]) > info_of(",V,") THEN GOTO ",MAPLBL &1,";"
+ RETURN T END),
+
+'(!*JUMPWGE &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF info_of(R[1]) >= info_of(",V,") THEN GOTO ",MAPLBL &1,";"
+ RETURN T END),
+
+'(!*JUMPWL &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF info_of(R[1]) < info_of(",V,") THEN GOTO ",MAPLBL &1,";"
+ RETURN T END),
+
+'(!*JUMPWLE &1 &2)->
+ (BEGIN SCALAR V;
+ V:=LOADIT('XX,&2)$
+ W " IF info_of(R[1]) <= info_of(",V,") THEN GOTO ",MAPLBL &1,";" $
+ RETURN T END),
+
+'(!*JUMPT &1)->
+ <<W " IF R[1] <> nilref THEN GOTO ",MAPLBL &1,";"; T>>,
+
+'(!*JUMPNIL &1)->
+ <<W " IF R[1] = nilref THEN GOTO ",MAPLBL &1,";"; T>>,
+
+% !*TEST stuff has been replaced by !*JUMPC and !*JUMPNC stuff.
+% Form is (!*JUMPC LABL REG TYPE)
+'(!*JUMPNC &1 &2 ATOM)->PAS2 LIST('!*JUMPC,&1,&2,'PAIRTAG),
+
+'(!*JUMPC &1 &2 ATOM)-> PAS2 LIST('!*JUMPNC,&1,&2,'PAIRTAG),
+
+'(!*JUMPC &1 &2 NUMTAG)->
+ <<W " IF (tag_of(",REGNAM &2,") = INTTAG)"$
+ W " or (tag_of(",REGNAM &2,") = FIXTAG) THEN GOTO ",MAPLBL &1,";" $
+ T>>,
+
+'(!*JUMPNC &1 &2 NUMTAG)->
+ <<W " IF not((tag_of(",REGNAM &2,") = INTTAG)"$
+ W " or (tag_of(",REGNAM &2,") = FIXTAG)) THEN GOTO ",MAPLBL &1,";" $
+ T>>,
+
+'(!*JUMPC &1 &2 &3)->
+ <<W " IF tag_of(",REGNAM &2,") = ",&3," THEN GOTO ",MAPLBL &1,";" $
+ T>>,
+
+'(!*JUMPNC &1 &2 &3)->
+ <<W " IF tag_of(",REGNAM &2,") <> ",&3," THEN GOTO ",MAPLBL &1,";" $
+ T>>,
+
+'(!*FREERSTR &1)-> <<W " UNBIND(",LENGTH &1,");"$T>>,
+
+'(!*PROGBIND &1)->
+ (BEGIN SCALAR Y$
+ FOR EACH X IN &1 DO
+ <<FNDID CAR X$
+ W " PBIND(",-CADR X,!, ,V,");" $T>>$
+ RETURN T END),
+
+'(!*LAMBIND &1 &2)->
+ (BEGIN SCALAR X,Y$
+ X:=&1$ Y:=&2$
+ WHILE X DO
+ <<FNDID CAAR Y$
+ W " LBIND(",REGNAM CAR X,!,,-CADAR Y,!,,V,");"$
+ X:=CDR X$ Y:=CDR Y>>$
+ RETURN T END),
+
+'( &1 &2 BASE &3 WORDS &4 LEFT )-> T,
+
+'(!*CHECK &1 &2 &3) ->
+ <<W " IF tag_of(",REGNAM &1,") <> ",&2,"THEN GOTO ",MAPLBL &3,";"$ T>>,
+
+'(!*CODE &1) -> <<W &1; T>>,
+
+'(!*EVAL &1) -> <<EVAL &1; T>>,
+
+&1-> <<WX "1*** Unknown ",&1," ***** "$T>> )$
+
+
+PUT('CAAR,'CARCDRFN,'(CAR . CAR))$
+PUT('CDAR,'CARCDRFN,'(CDR . CAR))$
+PUT('CADR,'CARCDRFN,'(CAR . CDR))$
+PUT('CDDR,'CARCDRFN,'(CDR . CDR))$
+PUT('CAAAR,'CARCDRFN,'(CAAR . CAR))$
+PUT('CADAR,'CARCDRFN,'(CADR . CAR))$
+PUT('CAADR,'CARCDRFN,'(CAAR . CDR))$
+PUT('CADDR,'CARCDRFN,'(CADR . CDR))$
+PUT('CDAAR,'CARCDRFN,'(CDAR . CAR))$
+PUT('CDDAR,'CARCDRFN,'(CDDR . CAR))$
+PUT('CDADR,'CARCDRFN,'(CDAR . CDR))$
+PUT('CDDDR,'CARCDRFN,'(CDDR . CDR))$
+PUT('CAAAAR,'CARCDRFN,'(CAAAR . CAR))$
+PUT('CAADAR,'CARCDRFN,'(CAADR . CAR))$
+PUT('CAAADR,'CARCDRFN,'(CAAAR . CDR))$
+PUT('CAADDR,'CARCDRFN,'(CAADR . CDR))$
+PUT('CADAAR,'CARCDRFN,'(CADAR . CAR))$
+PUT('CADDAR,'CARCDRFN,'(CADDR . CAR))$
+PUT('CADADR,'CARCDRFN,'(CADAR . CDR))$
+PUT('CADDDR,'CARCDRFN,'(CADDR . CDR))$
+PUT('CDAAAR,'CARCDRFN,'(CDAAR . CAR))$
+PUT('CDADAR,'CARCDRFN,'(CDADR . CAR))$
+PUT('CDAADR,'CARCDRFN,'(CDAAR . CDR))$
+PUT('CDADDR,'CARCDRFN,'(CDADR . CDR))$
+PUT('CDDAAR,'CARCDRFN,'(CDDAR . CAR))$
+PUT('CDDDAR,'CARCDRFN,'(CDDDR . CAR))$
+PUT('CDDADR,'CARCDRFN,'(CDDAR . CDR))$
+PUT('CDDDDR,'CARCDRFN,'(CDDDR . CDR))$
+
+
+% Some of the OPEN coded functions;
+% Take a LIST of strings, operating on R[1],R[2],...;
+
+
+PUT('!*INF,'OPENCOD,'(" mkitem(INTTAG,info_of(R[1]),R[1]);"));
+PUT('!*TAG,'OPENCOD,'(" mkitem(INTTAG,tag_of(R[1]),R[1]);"));
+
+PUT('!*MKITEM,'OPENCOD,'(" mkitem(tag_of(R[1]),info_of(R[2]),R[1]);"));
+PUT('!*INTINF,'OPENCOD,'(" mkitem(INTTAG,info_of(R[1]),R[1]);"));
+
+%Only appropriate for systems lisp. Solution used here is questionable.
+PUT('!*WPLUS2,'OPENCOD,'(" R[1].info:=R[1].info+R[2].info;"));
+PUT('!*WDIFFERENCE,'OPENCOD,'(" R[1].info:=R[1].info-R[2].info;"));
+PUT('!*WADD1,'OPENCOD,'(" R[1].info:=R[1].info+1;"));
+PUT('!*WSUB1,'OPENCOD,'(" R[1].info:=R[1].info-1;"));
+PUT('!*WMINUS,'OPENCOD,'(" R[1].info:=-R[1].info;"));
+PUT('!*WTIMES2,'OPENCOD,'(" R[1].info:=R[1].info*R[2].info;"));
+PUT('!*WQUOTIENT,'OPENCOD,'(" R[1].info:=R[1].info div R[2].info;"));
+PUT('!*WREMAINDER,'OPENCOD,'(" R[1].info:=R[1].info mod R[2].info;"));
+
+%NEED support functions for these!
+PUT('!*WAND,'OPENCOD,'(" R[1].info:=land(R[1].info, R[2].info);"));
+PUT('!*WOR,'OPENCOD, '(" R[1].info:=lor(R[1].info, R[2].info);"));
+PUT('!*WXOR,'OPENCOD,'(" R[1].info:=lxor(R[1].info, R[2].info);"));
+PUT('!*WNOT,'OPENCOD,'(" R[1].info:=not R[1].info;"));
+
+END$
ADDED perq-pascal-lisp-project/paslsp-20.bld
Index: perq-pascal-lisp-project/paslsp-20.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-20.bld
@@ -0,0 +1,21 @@
+; Command file to assemble PASn pieces together and then compile them.
+; for Dec-20 version
+;
+COP PAS3.INI PASLSP.INI
+APP PAS1.SLI PASLSP.INI
+APP PAS2.SLI PASLSP.INI
+APP PAS3.SLI PASLSP.INI
+APP USER.SLI PASLSP.INI
+filter d <pas0.pre >s:pl20.pas
+append pas1.pas S:PL20.PAS
+append pas2.pas S:PL20.PAS
+append pas3.pas S:PL20.PAS
+append exec.pas S:PL20.PAS
+filter d <pasn.pre >s:pl20n.pas
+append s:pl20n.pas S:PL20.PAS
+pascal
+S:PL20.rel
+S:PL20.lst
+S:PL20.PAS
+load S:PL20.REL
+save S:PL20.EXE
ADDED perq-pascal-lisp-project/paslsp-apollo.bld
Index: perq-pascal-lisp-project/paslsp-apollo.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-apollo.bld
@@ -0,0 +1,15 @@
+; Command file to assemble PASn pieces together
+; Apollo version
+;
+COP PAS3.INI PASLSP.INI
+APP PAS1.SLI PASLSP.INI
+APP PAS2.SLI PASLSP.INI
+APP PAS3.SLI PASLSP.INI
+APP USER.SLI PASLSP.INI
+filter a <pas0.pre >s:plA.pas
+append pas1.pas S:PLA.PAS
+append pas2.pas S:PLA.PAS
+append pas3.pas S:PLA.PAS
+append exec.pas S:PLA.PAS
+filter a <pasn.pre >s:plAn.pas
+append S:plAn.pas S:PLA.PAS
ADDED perq-pascal-lisp-project/paslsp-ini-read.red
Index: perq-pascal-lisp-project/paslsp-ini-read.red
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-ini-read.red
@@ -0,0 +1,60 @@
+% File to read PASLSP.INI to produce sorted tables
+
+FLUID '(NID!* IDLIST!* NCONST!* CONSTLIST!* NFN!* FNLIST!*);
+
+lisp procedure IniErr x;
+ Error LIST("Bad Ini File ",x);
+
+load gsort;
+
+lisp procedure prinl l;
+ for each x in l do print x;
+
+lisp procedure Sorts;
+ Begin
+ ReadPaslspInit();
+ Prin2t "--------------- Functions ----------------";
+ prinl idsort FNLIST!*;
+ Prin2t "--------------- Other IDS ----------------";
+ prinl idsort IDLIST!*;
+ Prin2t "--------------- CONST ----------------";
+ prinl CONSTLIST!*;
+ End;
+
+lisp procedure ReadPaslspInit;
+ BEGIN scalar infil,oldfil;
+ % load "symbol table" with identifiers, constants, and functions.
+ infil:=open("paslsp.ini",'input);
+ oldfil:=rds(infil);
+ NID!*:=RATOM(); % get count of identifiers.
+ IF not fixp NID!* THEN
+ IniErr("*****BAD SYMBOL TABLE, INTEGER EXPECTED AT START");
+ IDLIST!*:=NIL;
+ FOR i := 1:NID!* DO
+ IDLIST!* := RATOM() . IDLIST!*;
+ % reading token magically loads it into id space.
+ IF not ZeroP RATOM() % look for zero terminator.
+ then
+ IniErr("*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER IDENTIFIERS");
+ NCONST!*:=RATOM(); % count of constants
+ IF not FIXP NCONST!* THEN
+ IniErr("*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE CONSTANTS");
+ CONSTLIST!*:=NIL;
+ FOR i := 1:NCONST!* DO
+ CONSTLIST!*:=READ() . CONSTLIST!*;
+ IF not ZeroP RATOM() then
+ IniErr("*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER CONSTANTS");
+
+ NFN!*:=RATOM(); % count of functions.
+ IF not FIXP NFN!* then
+ IniErr("*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE FUNCTIONS");
+ FNLIST!*:=NIL;
+ FOR i := 1:NFN!* DO
+ % for each function
+ % store associated code
+ FNLIST!*:=RATOM(). FNLIST!*;
+ If not Zerop RATOM() then
+ IniErr("*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER FUNCTIONS");
+ RDS(oldfil);
+ CLOSE infil;
+ END;
ADDED perq-pascal-lisp-project/paslsp-perq.bld
Index: perq-pascal-lisp-project/paslsp-perq.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-perq.bld
@@ -0,0 +1,17 @@
+; Command file to assemble PASn pieces together and then compile them.
+def s: <scratch>
+def pl: <griss.PASLSP>
+; produces PERQ version.
+COP pl:PAS3.INI s:PLPERQ.INI
+APP pl:PAS1.SLI s:PLPERQ.INI
+APP pl:PAS2.SLI s:PLPERQ.INI
+APP pl:PAS3.SLI s:PLPERQ.INI
+APP pl:USER.SLI s:PLPERQ.INI
+pl:filter p <pl:pas0.pre >s:PlPerq.pas
+pl:filter p <pl:pasn.pre >s:PlPerqn.pas
+append pl:pas1.pas S:PLPERQ.pas
+append pl:pas2.pas S:PLPERQ.pas
+append pl:pas3.pas S:PLPERQ.pas
+append pl:exec.pas S:PLPERQ.pas
+append s:PlPerqN.pas S:PLPERQ.pas
+; Send S:PlPerq.ini S:PlPerq.pas
ADDED perq-pascal-lisp-project/paslsp-terak.bld
Index: perq-pascal-lisp-project/paslsp-terak.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-terak.bld
@@ -0,0 +1,15 @@
+; Command file to assemble PASn pieces together and then compile them.
+; for Terak-20 version
+;
+COP PAS3.INI PASLSP.INI
+APP PAS1.SLI PASLSP.INI
+APP PAS2.SLI PASLSP.INI
+APP PAS3.SLI PASLSP.INI
+APP USER.SLI PASLSP.INI
+filter t <pas0.pre >s:plt.pas
+append pas1.pas S:PLT.PAS
+append pas2.pas S:PLT.PAS
+append pas3.pas S:PLT.PAS
+append exec.pas S:PLT.PAS
+filter t <pasn.pre >s:pltn.pas
+append s:pltn.pas S:PLT.PAS
ADDED perq-pascal-lisp-project/paslsp-test.photo
Index: perq-pascal-lisp-project/paslsp-test.photo
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-test.photo
@@ -0,0 +1,890 @@
+
+[PHOTO: Recording initiated Mon 15-Feb-82 5:11PM]
+
+LINK FROM CAI.OTTENHEIMER, TTY 102
+
+ TOPS-20 Command processor 4(714)-2
+@PLJJS:PL20
+
+PASCAL LISP V2 - 15 NOV 1981
+COPYRIGHT (C) 1981 U UTAH
+ALL RIGHTS RESERVED
+UserInitStart
+UserInitEnd
+>(*JSETQ *!RAISE T)
+NIL
+>(SETQ !*RAISE T)
+T
+>(SETQ !*ECHO T)
+T
+>(DSKIN "PASLSP>TSTJJJJ.TST")
+%%%%%%%%%%%% Standard - LISP Verification file. %%%%%%%%%%%%%%%%%%%%%%%
+%
+% Copyright (C) M. Griss and J. Marti, February 1981
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+% Flags for SYSLISP based PSL
+
+
+(SETQ !*ECHO T)T
+
+(SETQ FZERO (FLOAT 0))0
+
+(SETQ FONE (FLOAT 1))1
+
+
+% The following should return T:
+TT
+
+(NULL NIL)T
+
+(COND (T T))T
+
+(COND (NIL NIL) (T T))T
+
+% The following should return NIL:
+NILNIL
+
+(NULL T)NIL
+
+(COND (T NIL))NIL
+
+(COND (NIL T)
+ (T NIL))NIL
+
+% The following should be 0
+00
+ (QUOTE 0)0
+
+% The following minimum set of functions must work:
+% PUTD, PROG, SET, QUOTE, COND, NULL, RETURN, LIST, CAR, CDR,
+% EVAL, PRINT, PRIN1, TERPRI, PROGN, GO.
+% Check PUTD, GETD, LAMBDA
+(PUTD (QUOTE FOO) (QUOTE EXPR) (QUOTE (LAMBDA (X) 3)))FOO
+
+% Expect (EXPR LAMBDA (X) 3)
+(GETD (QUOTE FOO))(EXPR LAMBDA (X) 3)
+
+% Should return 3
+(FOO 1)3
+
+(FOO 2)3
+
+% Test SET :
+(SET (QUOTE A) 1)1
+
+A1
+
+(SET (QUOTE B) 2)2
+
+B2
+
+% Test LIST, CAR, CDR
+% Expect (1 2 3 4) 1 and (2 3 4)
+(SET (QUOTE A) (LIST 1 2 3 4))(1 2 3 4)
+
+(CAR A)1
+
+(CDR A)(2 3 4)
+
+% Test REDEFINITION in PUTD, PROGN, PRIN1, TERPRI
+(PUTD (QUOTE FOO) (QUOTE EXPR)
+ (QUOTE (LAMBDA (X) (PROGN (PRIN1 X) (TERPRI)))))*** (FUNCTION FOO REDEFINE
+D)
+FOO
+
+% expect 1 and 2 printed , value NIL
+(FOO 1)1
+NIL
+
+(FOO 2)2
+NIL
+
+% Test simple PROG, GO, RETURN
+(PROG NIL (PRINT 1) (PRINT 2))1
+2
+NIL
+
+(PROG (A) (PRINT A) (PRINT 1))NIL
+1
+NIL
+
+% Now test GO, RETURN, PROG binding
+(SET 'A 'AA)AA
+ (SET 'B 'BB)BB
+
+(PROG (A B) (PRINT 'test! binding! of! A!,! B! expect! NIL)
+ (PRIN1 A) (PRINT B)
+ (PRINT 'Reset! to! 1!,2)
+ (SET 'A 1) (SET 'B 2)
+ (PRIN1 A) (PRINT B)
+ (PRINT 'test! forward! GO)
+ (GO LL)
+ (PRINT 'forward! GO! failed)
+LL (PRINT 'Forward! GO! ok)
+ (GO L2)
+L1 (PRINT '! Should! be! after! BACKWARD! go )
+ (PRINT '! now! return! 3)
+ (RETURN 3)
+L2 (PRINT 'Test! backward! GO)
+ (GO L1) )TEST BINDING OF A, B EXPECT NIL
+NILNIL
+RESET TO 1,2
+12
+TEST FORWARD GO
+FORWARD GO OK
+TEST BACKWARD GO
+ SHOULD BE AFTER BACKWARD GO
+ NOW RETURN 3
+3
+
+% Test that A,B correctly rebound, expect AA and BB%
+AAA
+ BBB
+
+% Test simple FEXPR%
+(PUTD (QUOTE FOO) (QUOTE FEXPR) (QUOTE (LAMBDA (X) (PRINT X))))*** (FUNCTION FOO
+ REDEFINED)
+FOO
+
+% Expect (FEXPR LAMBDA (X) (PRINT X))%
+(GETD (QUOTE FOO))(FEXPR LAMBDA (X) (PRINT X))
+
+% Expect (1) (1 2) and (1 2 3)%
+(FOO 1)(1)
+(1)
+
+(FOO 1 2)(1 2)
+(1 2)
+
+(FOO 1 2 3)(1 2 3)
+(1 2 3)
+
+% Finally, TEST EVAL inside an FEXPR %
+(PUTD (QUOTE FOO) (QUOTE FEXPR)
+ (QUOTE (LAMBDA (XX) (PRINT (EVAL (CAR XX))))))*** (FUNCTION FOO REDEFINED)
+FOO
+
+(FOO 1)1
+1
+
+(FOO (NULL NIL))T
+T
+
+% PUTD is being used here to define a function !$TEST.%
+(PUTD (QUOTE !$TEST) (QUOTE FEXPR) (QUOTE
+ (LAMBDA (!$X)
+ (PROG (A B)
+ (SET (QUOTE A) (CDR !$X))
+LOOP (while A (progn
+ % (print (list 'trying (car a)))
+ (SET (QUOTE B) (EVAL (CAR A)))
+ (COND ( (null (eq b T))
+ (PROGN (PRIN1 (LIST '!*!*!*!*!* (CAR A) '! returned B))
+ (TERPRI))))
+ (SET (QUOTE A) (CDR A))
+ (GO LOOP)))
+ (return (LIST (CAR !$X) '! test! complete))
+ ))))$TEST
+
+% $TEST should be defined.
+(GETD (QUOTE !$TEST))(FEXPR LAMBDA ($X) (PROG (A B) (SET (QUOTE A) (CDR $X)) LOO
+P (WHILE A (PROGN (SET (QUOTE B) (EVAL (CAR A))) (COND ((NULL (EQ B T)) (PROGN (
+PRIN1 (LIST (QUOTE *****) (CAR A) (QUOTE RETURNED) B)) (TERPRI)))) (SET (QUOTE
+A) (CDR A)) (GO LOOP))) (RETURN (LIST (CAR $X) (QUOTE TEST COMPLETE)))))
+
+% Global, vector, function-pointer partial test.
+(!$TEST 'GLOBAL!,VECTOR (NULL (GLOBAL (QUOTE (!$VECTOR !$CODE TEMP))))
+ (GLOBALP (QUOTE !$VECTOR))
+ (GLOBALP (QUOTE !$CODE))
+ (SET (QUOTE !$VECTOR) (MKVECT 4))
+ (SET (QUOTE !$CODE) (CDR (GETD (QUOTE CDR)))) )(***** (GLOBALP (QUOTE $VECT
+OR)) RETURNED (GLOBAL))
+(***** (GLOBALP (QUOTE $CODE)) RETURNED (GLOBAL))
+(***** (SET (QUOTE $VECTOR) (MKVECT 4)) RETURNED NIL)
+(***** (SET (QUOTE $CODE) (CDR (GETD (QUOTE CDR)))) RETURNED ##89)
+((QUOTE GLOBAL,VECTOR) TEST COMPLETE)
+
+
+
+(!$TEST LIST (EQUAL (LIST 1 (QUOTE A) 'STRING )
+ (QUOTE (1 A STRING))))(LIST TEST COMPLETE)
+
+
+% -----3.1 Elementary Predicates-----%
+% This section tests the elementary predicates of section 3.1 of
+% the Standard LISP Report. In general they will test that the
+% predicate returns non-NIL for the correct case, and NIL for all
+% others.
+
+% CODEP should not return T for numbers as function
+% pointers must not be implemented in this way.
+(!$TEST CODEP (CODEP !$CODE) (NULL (CODEP 1))
+ (NULL (CODEP T)) (NULL (CODEP NIL))
+ (NULL (CODEP (QUOTE IDENTIFIER)))
+ (NULL (CODEP 'STRING)) (NULL (CODEP (QUOTE (A . B))))
+ (NULL (CODEP (QUOTE (A B C))))
+ (NULL (CODEP !$VECTOR)) )(CODEP TEST COMPLETE)
+
+
+% PAIRP must not return T for vectors even if vectors are
+% implemented as lists.
+(!$TEST PAIRP
+ (PAIRP (QUOTE (A . B))) (PAIRP (QUOTE (NIL)))
+ (PAIRP (QUOTE (A B C))) (NULL (PAIRP 0))
+ (NULL (PAIRP (QUOTE IDENTIFIER)))
+ (NULL (PAIRP 'STRING))
+ (NULL (PAIRP !$VECTOR)) )(PAIRP TEST COMPLETE)
+
+
+(!$TEST FIXP (FIXP 1)
+ (NULL (FIXP (QUOTE IDENTIFIER)))
+ (NULL (FIXP (QUOTE 'STRING)))
+ (NULL (FIXP (QUOTE (A . B))))
+ (NULL (FIXP (QUOTE (A B C))))
+ (NULL (FIXP !$VECTOR))
+ (NULL (FIXP !$CODE)) )(FIXP TEST COMPLETE)
+
+
+% T and NIL must test as identifiers as must specially
+% escaped character identifiers.
+(!$TEST IDP (IDP (QUOTE IDENTIFIER))
+ (IDP NIL) (IDP T)
+ (IDP (QUOTE !1)) (IDP (QUOTE !A)) (IDP (QUOTE !!))
+ (IDP (QUOTE !()) (IDP (QUOTE !))) (IDP (QUOTE !.))
+ (IDP (QUOTE !')) (IDP (QUOTE !*)) (IDP (QUOTE !/))
+ (IDP (QUOTE !+)) (IDP (QUOTE !-)) (IDP (QUOTE !#))
+ (IDP (QUOTE ! )) (IDP (QUOTE !1!2!3)) (IDP (QUOTE !*!*!*))
+ (IDP (QUOTE !'ID))
+ (NULL (IDP 1))
+ (NULL (IDP 'STRING))
+ (NULL (IDP (QUOTE (A . B))))
+ (NULL (IDP (QUOTE (A B C))))
+ (NULL (IDP !$VECTOR))
+ (NULL (IDP !$CODE)) )(***** (NULL (IDP (QUOTE STRING))) RETURNED NIL)
+(***** (NULL (IDP $VECTOR)) RETURNED NIL)
+(IDP TEST COMPLETE)
+
+
+% STRINGP should answer T to strings only and not things
+% that might look like strings if the system implements them as
+% identifiers.
+(!$TEST STRINGP (STRINGP 'STRING)
+ (NULL (STRINGP (QUOTE (STRING NOTASTRING))))
+ (NULL (STRINGP 1))
+ (NULL (STRINGP (QUOTE A)))
+ (NULL (STRINGP (QUOTE (A . B))))
+ (NULL (STRINGP (QUOTE (A B C))))
+ (NULL (STRINGP !$VECTOR))
+ (NULL (STRINGP !$CODE)) )(***** (NULL (STRINGP (QUOTE A))) RETURNED NIL)
+(***** (NULL (STRINGP $VECTOR)) RETURNED NIL)
+(STRINGP TEST COMPLETE)
+
+
+% VECTORP should not answer T to pairs if vectors are
+% implemented as pairs.
+(!$TEST VECTORP (VECTORP !$VECTOR)
+ (NULL (VECTORP 1))
+ (NULL (VECTORP (QUOTE A)))
+ (NULL (VECTORP 'STRING))
+ (NULL (VECTORP (QUOTE (A . B))))
+ (NULL (VECTORP (QUOTE (A B C))))
+ (NULL (VECTORP !$CODE)) )(***** (VECTORP $VECTOR) RETURNED NIL)
+(VECTORP TEST COMPLETE)
+
+
+% Vectors are constants in Standard LISP. However T and NIL
+% are special global variables with the values T and NIL.
+(!$TEST CONSTANTP (CONSTANTP 1)
+ (CONSTANTP 'STRING)
+ (CONSTANTP !$VECTOR)
+ (CONSTANTP !$CODE)
+ (NULL (CONSTANTP NIL))
+ (NULL (CONSTANTP T))
+ (NULL (CONSTANTP (QUOTE A)))
+ (NULL (CONSTANTP (QUOTE (A . B))))
+ (NULL (CONSTANTP (QUOTE (A B C)))) )(***** (CONSTANTP (QUOTE STRING)) RETU
+RNED NIL)
+(***** (CONSTANTP $VECTOR) RETURNED NIL)
+
+***GARBAGE COLLECTOR CALLED
+CONSES: 3699
+ST : 58
+ 3465 PAIRS FREED.
+ 234 PAIRS IN USE.
+MAX GC STACK WAS 5
+(CONSTANTP TEST COMPLETE)
+
+
+% An ATOM is anything that is not a pair, thus vectors are
+% atoms.
+(!$TEST ATOM (ATOM T) (ATOM NIL) (ATOM 1) (ATOM 0)
+ (ATOM 'STRING) (ATOM (QUOTE IDENTIFIER))
+ (ATOM !$VECTOR)
+ (NULL (ATOM (QUOTE (A . B))))
+ (NULL (ATOM (QUOTE (A B C)))) )(ATOM TEST COMPLETE)
+
+
+
+(!$TEST EQ (EQ NIL NIL) (EQ T T)
+ (EQ !$VECTOR !$VECTOR)
+ (EQ !$CODE !$CODE)
+ (EQ (QUOTE A) (QUOTE A))
+ (NULL (EQ NIL T))
+ (NULL (EQ NIL !$VECTOR))
+ (NULL (EQ (QUOTE (A . B)) (QUOTE (A . B)))) )(***** (NULL (EQ NIL $VECTOR))
+ RETURNED NIL)
+(EQ TEST COMPLETE)
+
+
+% Function pointers are not numbers, therefore the function
+% pointer $CODE is not EQN to the fixed number 0. Numbers must have
+% the same type to be EQN.
+(!$TEST EQN (EQN 1 1) (EQN 0 0)
+ (EQN FONE FONE) (EQN FZERO FZERO)
+ (NULL (EQN FONE FZERO)) (NULL (EQN FZERO FONE))
+ (NULL (EQN 1 FONE)) (NULL (EQN 0 FZERO))
+ (NULL (EQN 1 0)) (NULL (EQN 0 1))
+ (NULL (EQN 0 !$CODE))
+ (NULL (EQN NIL 0))
+ (EQN NIL NIL) (EQN T T) (EQN !$VECTOR !$VECTOR)
+ (EQN !$CODE !$CODE) (EQN (QUOTE A) (QUOTE A))
+ (NULL (EQN (QUOTE (A . B)) (QUOTE (A . B))))
+ (NULL (EQN (QUOTE (A B C)) (QUOTE (A B C)))) )(***** (NULL (EQN 1 FONE))
+RETURNED NIL)
+(***** (NULL (EQN 0 FZERO)) RETURNED NIL)
+(EQN TEST COMPLETE)
+
+
+% EQUAL checks for general equality rather than specific, so
+% it must check all elements of general expressions and all elements
+% of vectors for equality. This test assumes that CAR does not have
+% the function pointer value EQUAL to 0. Further tests of EQUAL
+% are in the vector section 3.9.
+(!$TEST EQUAL (EQUAL NIL NIL)
+ (EQUAL T T)
+ (NULL (EQUAL NIL T))
+ (EQUAL !$CODE !$CODE)
+ (NULL (EQUAL !$CODE (CDR (GETD (QUOTE CAR)))))
+ (EQUAL (QUOTE IDENTIFIER) (QUOTE IDENTIFIER))
+ (NULL (EQUAL (QUOTE IDENTIFIER1) (QUOTE IDENTIFIER2)))
+ (EQUAL 'STRING 'STRING)
+ (NULL (EQUAL 'STRING1 'STRING2))
+ (EQUAL 0 0)
+ (NULL (EQUAL 0 1))
+ (EQUAL (QUOTE (A . B)) (QUOTE (A . B)))
+ (NULL (EQUAL (QUOTE (A . B)) (QUOTE (A . C))))
+ (NULL (EQUAL (QUOTE (A . B)) (QUOTE (C . B))))
+ (EQUAL (QUOTE (A B)) (QUOTE (A B)))
+ (NULL (EQUAL (QUOTE (A B)) (QUOTE (A C))))
+ (NULL (EQUAL (QUOTE (A B)) (QUOTE (C B))))
+ (EQUAL !$VECTOR !$VECTOR)
+ (NULL (EQUAL 0 NIL))
+ (NULL (EQUAL 'T T))
+ (NULL (EQUAL 'NIL NIL)) )(***** (NULL (EQUAL (QUOTE T) T)) RETURNED NIL)
+(***** (NULL (EQUAL (QUOTE NIL) NIL)) RETURNED NIL)
+(EQUAL TEST COMPLETE)
+
+
+% -----3.2 Functions on Dotted-Pairs-----%
+% Test the C....R functions by simply verifying that they select
+% correct part of a structure.
+(!$TEST CAR (EQ (CAR (QUOTE (A . B))) (QUOTE A))
+ (EQUAL (CAR (QUOTE ((A) . B))) (QUOTE (A))) )(CAR TEST COMPLETE)
+
+
+(!$TEST CDR (EQ (CDR (QUOTE (A . B))) (QUOTE B))
+ (EQUAL (CDR (QUOTE (A B))) (QUOTE (B))) )(CDR TEST COMPLETE)
+
+
+(!$TEST CAAR (EQ (CAAR (QUOTE ((A)))) (QUOTE A)))(CAAR TEST COMPLETE)
+
+(!$TEST CADR (EQ (CADR (QUOTE (A B))) (QUOTE B)))(CADR TEST COMPLETE)
+
+(!$TEST CDAR (EQ (CDAR (QUOTE ((A . B)))) (QUOTE B)))(CDAR TEST COMPLETE)
+
+(!$TEST CDDR (EQ (CDDR (QUOTE (A . (B . C)))) (QUOTE C)))(CDDR TEST COMPLETE)
+
+
+(!$TEST CAAAR (EQ (CAAAR (QUOTE (((A))))) (QUOTE A)))(CAAAR TEST COMPLETE)
+
+(!$TEST CAADR (EQ (CAADR (QUOTE (A (B)))) (QUOTE B)))(CAADR TEST COMPLETE)
+
+(!$TEST CADAR (EQ (CADAR (QUOTE ((A B)))) (QUOTE B)))(CADAR TEST COMPLETE)
+
+(!$TEST CADDR (EQ (CADDR (QUOTE (A B C))) (QUOTE C)))(CADDR TEST COMPLETE)
+
+(!$TEST CDAAR (EQ (CDAAR (QUOTE (((A . B)) C))) (QUOTE B)))(CDAAR TEST COMPLETE
+)
+
+(!$TEST CDADR (EQ (CDADR (QUOTE (A (B . C)))) (QUOTE C)))(CDADR TEST COMPLETE)
+
+(!$TEST CDDAR (EQ (CDDAR (QUOTE ((A . (B . C))))) (QUOTE C)))(CDDAR TEST COMPLE
+TE)
+
+(!$TEST CDDDR (EQ (CDDDR (QUOTE (A . (B . (C . D))))) (QUOTE D)))(CDDDR TEST CO
+MPLETE)
+
+
+(!$TEST CAAAAR (EQ (CAAAAR (QUOTE ((((A)))))) (QUOTE A)))(CAAAAR TEST COMPLETE)
+
+(!$TEST CAAADR (EQ (CAAADR (QUOTE (A ((B))))) (QUOTE B)))(CAAADR TEST COMPLETE)
+
+(!$TEST CAADAR (EQ (CAADAR (QUOTE ((A (B))))) (QUOTE B)))(CAADAR TEST COMPLETE)
+
+(!$TEST CAADDR (EQ (CAADDR (QUOTE (A . (B (C))))) (QUOTE C)))(CAADDR TEST COMPL
+ETE)
+
+(!$TEST CADAAR (EQ (CADAAR (QUOTE (((A . (B)))))) (QUOTE B)))(CADAAR TEST COMPL
+ETE)
+
+(!$TEST CADADR (EQ (CADADR (QUOTE (A (B . (C))))) (QUOTE C)))(CADADR TEST COMPL
+ETE)
+
+(!$TEST CADDAR (EQ (CADDAR (QUOTE ((A . (B . (C)))))) (QUOTE C)))
+***GARBAGE COLLECTOR CALLED
+CONSES: 3465
+ST : 84
+ 3500 PAIRS FREED.
+ 199 PAIRS IN USE.
+MAX GC STACK WAS 5
+(CADDAR TEST COMPLETE)
+
+(!$TEST CADDDR (EQ (CADDDR (QUOTE (A . (B . (C . (D)))))) (QUOTE D)))(CADDDR TE
+ST COMPLETE)
+
+(!$TEST CDAAAR (EQ (CDAAAR (QUOTE ((((A . B)))))) (QUOTE B)))(CDAAAR TEST COMPL
+ETE)
+
+(!$TEST CDAADR (EQ (CDAADR (QUOTE (A ((B . C))))) (QUOTE C)))(CDAADR TEST COMPL
+ETE)
+
+(!$TEST CDADAR (EQ (CDADAR (QUOTE ((A (B . C))))) (QUOTE C)))(CDADAR TEST COMPL
+ETE)
+
+(!$TEST CDADDR (EQ (CDADDR (QUOTE (A . (B . ((C . D)))))) (QUOTE D)))(CDADDR TE
+ST COMPLETE)
+
+(!$TEST CDDAAR (EQ (CDDAAR (QUOTE (((A . (B . C)))))) (QUOTE C)))(CDDAAR TEST C
+OMPLETE)
+
+(!$TEST CDDADR (EQ (CDDADR (QUOTE (A . ((B . (C . D)))))) (QUOTE D)))(CDDADR TE
+ST COMPLETE)
+
+(!$TEST CDDDAR (EQ (CDDDAR (QUOTE ((A . (B . (C . D)))))) (QUOTE D)))(CDDDAR T
+EST COMPLETE)
+
+(!$TEST CDDDDR (EQ (CDDDDR (QUOTE (A . (B . (C . (D . E)))))) (QUOTE E)))(CDDDDR
+ TEST COMPLETE)
+
+
+% CONS should return a unique cell when invoked. Also test that
+% the left and right parts are set correctly.
+(!$TEST CONS (NULL (EQ (CONS (QUOTE A) (QUOTE B)) (QUOTE (A . B))))
+ (EQ (CAR (CONS (QUOTE A) (QUOTE B))) (QUOTE A))
+ (EQ (CDR (CONS (QUOTE A) (QUOTE B))) (QUOTE B)) )(CONS TEST COMPLETE)
+
+
+% Veryify that RPLACA doesn't modify the binding of a list, and
+% that only the CAR part of the cell is affected.
+(!$TEST RPLACA
+ (SET (QUOTE TEMP) (QUOTE (A)))
+ (EQ (RPLACA TEMP 1) TEMP)
+ (EQ (CAR (RPLACA TEMP (QUOTE B))) (QUOTE B))
+ (EQ (CDR TEMP) NIL) )(***** (SET (QUOTE TEMP) (QUOTE (A))) RETURNED (A))
+(RPLACA TEST COMPLETE)
+
+
+(!$TEST RPLACD
+ (SET (QUOTE TEMP) (QUOTE (A . B)))
+ (EQ (RPLACD TEMP (QUOTE A)) TEMP)
+ (EQ (CDR (RPLACD TEMP (QUOTE C))) (QUOTE C))
+ (EQ (CAR TEMP) (QUOTE A)) )(***** (SET (QUOTE TEMP) (QUOTE (A . B))) RETURNED
+ (A . B))
+(RPLACD TEST COMPLETE)
+
+
+% -----3.3 Identifiers-----%
+% Verify that COMPRESS handles the various types of lexemes
+% correctly.
+(!$TEST COMPRESS
+ (NULL (EQ (COMPRESS (QUOTE (A B))) (COMPRESS (QUOTE (A B)))))
+ (EQN (COMPRESS (QUOTE (!1 !2))) 12)
+ (EQN (COMPRESS (QUOTE (!+ !1 !2))) 12)
+ (EQN (COMPRESS (QUOTE (!- !1 !2))) -12)
+ (EQUAL (COMPRESS (QUOTE ( S T R I N G ))) 'STRING)
+ (EQ (INTERN (COMPRESS (QUOTE (A B)))) (QUOTE AB))
+ (EQ (INTERN (COMPRESS (QUOTE (!! !$ A)))) (QUOTE !$A)) )(***** (NULL (EQ (COMP
+RESS (QUOTE (A B))) (COMPRESS (QUOTE (A B))))) RETURNED NIL)
+(***** (EQ (INTERN (COMPRESS (QUOTE (! $ A)))) (QUOTE $A)) RETURNED NIL)
+(COMPRESS TEST COMPLETE)
+
+
+% Verify that EXPLODE returns the expected lists and that COMPRESS
+% and explode are inverses of each other.
+(!$TEST EXPLODE
+ (EQUAL (EXPLODE 12) (QUOTE (!1 !2)))
+ (EQUAL (EXPLODE -12) (QUOTE (!- !1 !2)))
+ (EQUAL (EXPLODE 'STRING) (QUOTE ( S T R I N G )))
+ (EQUAL (EXPLODE (QUOTE AB)) (QUOTE (A B)) )
+ (EQUAL (EXPLODE (QUOTE !$AB)) (QUOTE (!! !$ A B)))
+ (EQUAL (COMPRESS (EXPLODE 12)) 12)
+ (EQUAL (COMPRESS (EXPLODE -12)) -12)
+ (EQUAL (COMPRESS (EXPLODE 'STRING)) 'STRING)
+ (EQ (INTERN (COMPRESS (EXPLODE (QUOTE AB)))) (QUOTE AB))
+ (EQ (INTERN (COMPRESS (EXPLODE (QUOTE !$AB)))) (QUOTE !$AB)) )(***** (EQUAL (E
+XPLODE (QUOTE $AB)) (QUOTE (! $ A B))) RETURNED NIL)
+(EXPLODE TEST COMPLETE)
+
+
+% Test that GENSYM returns identifiers and that they are different.
+(!$TEST GENSYM
+ (IDP (GENSYM))
+ (NULL (EQ (GENSYM) (GENSYM))) )(GENSYM TEST COMPLETE)
+
+
+% Test that INTERN works on strings to produce identifiers the same
+% as those read in. Try ID's with special characters in them (more
+% will be tested with READ).
+(!$TEST INTERN
+ (EQ (INTERN 'A) (QUOTE A))
+ (EQ (INTERN 'A12) (QUOTE A12))
+ (EQ (INTERN 'A!*) (QUOTE A!*))
+ (NULL (EQ (INTERN 'A) (INTERN 'B))) )(INTERN TEST COMPLETE)
+
+
+% Just test that REMOB returns the ID removed.
+(!$TEST REMOB
+ (EQ (REMOB (QUOTE AAAA)) (QUOTE AAAA)) )(***** (EQ (REMOB (QUOTE AAAA)) (QUOTE
+ AAAA)) RETURNED NIL)
+(REMOB TEST COMPLETE)
+
+
+% ----- 3.4 Property List Functions-----%
+% Test that FLAG always returns NIL. More testing is done in FLAGP.
+(!$TEST FLAG
+ (NULL (FLAG NIL (QUOTE W)))
+ (NULL (FLAG (QUOTE (U V T NIL)) (QUOTE X)))
+ (NULL (FLAG (QUOTE (U)) NIL)) )(FLAG TEST COMPLETE)
+
+
+% Test that FLAG worked only on a list. Test all items in a flagged
+% list were flagged and that those that weren't aren't.
+(!$TEST FLAGP
+ (NULL (FLAGP NIL (QUOTE W)))
+ (FLAGP (QUOTE U) (QUOTE X))
+ (FLAGP (QUOTE V) (QUOTE X))
+ (FLAGP T (QUOTE X))
+ (FLAGP NIL (QUOTE X))
+ (FLAGP (QUOTE U) NIL) )(***** (FLAGP (QUOTE U) (QUOTE X)) RETURNED (X))
+(***** (FLAGP (QUOTE V) (QUOTE X)) RETURNED (X))
+(***** (FLAGP T (QUOTE X)) RETURNED (X))
+(***** (FLAGP NIL (QUOTE X)) RETURNED (X))
+(***** (FLAGP (QUOTE U) NIL) RETURNED (NIL X))
+(FLAGP TEST COMPLETE)
+
+
+% Test that REMFLAG always returns NIL and that flags removed are
+% gone. Test that unremoved flags are still present.
+(!$TEST REMFLAG
+ (NULL (REMFLAG NIL (QUOTE X)))
+ (NULL (REMFLAG (QUOTE (U T NIL)) (QUOTE X)))
+ (NULL (FLAGP (QUOTE U) (QUOTE X)))
+ (FLAGP (QUOTE V) (QUOTE X))
+ (NULL (FLAGP T (QUOTE X)))
+ (NULL (FLAGP NIL (QUOTE X))) )(***** (FLAGP (QUOTE V) (QUOTE X)) RETURNED (X)
+)
+(REMFLAG TEST COMPLETE)
+
+
+(!$TEST PUT
+ (EQ (PUT (QUOTE U) (QUOTE IND1) (QUOTE PROP)) (QUOTE PROP))
+ (EQN (PUT (QUOTE U) (QUOTE IND2) 0) 0)
+ (EQ (PUT (QUOTE U) (QUOTE IND3) !$VECTOR) !$VECTOR)
+ (EQ (PUT (QUOTE U) (QUOTE IND4) !$CODE) !$CODE) )(PUT TEST COMPLETE)
+
+
+(!$TEST GET
+ (EQ (GET (QUOTE U) (QUOTE IND1)) (QUOTE PROP))
+ (EQN (GET (QUOTE U) (QUOTE IND2)) 0)
+ (EQ (GET (QUOTE U) (QUOTE IND3)) !$VECTOR)
+ (EQ (GET (QUOTE U) (QUOTE IND4)) !$CODE) )
+***GARBAGE COLLECTOR CALLED
+CONSES: 3500
+ST : 68
+ 3460 PAIRS FREED.
+ 239 PAIRS IN USE.
+MAX GC STACK WAS 5
+(GET TEST COMPLETE)
+
+
+(!$TEST REMPROP
+ (NULL (REMPROP !$CODE !$CODE))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND1)) (QUOTE PROP))
+ (NULL (GET (QUOTE U) (QUOTE IND1)))
+ (EQN (REMPROP (QUOTE U) (QUOTE IND2)) (QUOTE 0))
+ (NULL (GET (QUOTE U) (QUOTE IND2)))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND3)) !$VECTOR)
+ (NULL (GET (QUOTE U) (QUOTE IND3)))
+ (GET (QUOTE U) (QUOTE IND4))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND4)) !$CODE)
+ (NULL (GET (QUOTE U) (QUOTE IND4))) )(***** (EQ (REMPROP (QUOTE U) (QUOTE IND
+1)) (QUOTE PROP)) RETURNED NIL)
+(***** (EQN (REMPROP (QUOTE U) (QUOTE IND2)) (QUOTE 0)) RETURNED NIL)
+(***** (GET (QUOTE U) (QUOTE IND4)) RETURNED ##89)
+(***** (EQ (REMPROP (QUOTE U) (QUOTE IND4)) $CODE) RETURNED NIL)
+(REMPROP TEST COMPLETE)
+
+
+
+% -----3.5 Function Definition-----%
+(!$TEST DE
+ (EQ (DE FIE (X) (PLUS2 X 1)) (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQN (FIE 1) 2)
+)(***** (GETD (QUOTE FIE)) RETURNED (EXPR LAMBDA (X) (PLUS2 X 1)))
+(DE TEST COMPLETE)
+
+% Expect (FIE 1) to return 2%
+(FIE 1)2
+
+% Expect FIE redefined in DF test%
+(!$TEST DF
+ (EQ (DF FIE (X) (PROGN (PRINT X) (CAR X))) (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQN (FIE 1) 1)
+ (EQN (FIE 2 3) 2)
+)*** (FUNCTION FIE REDEFINED)
+(***** (GETD (QUOTE FIE)) RETURNED (FEXPR LAMBDA (X) (PROGN (PRINT X) (CAR X)))
+)
+(1)
+(2 3)
+(DF TEST COMPLETE)
+
+% Expect (FIE 1) to return 1, and print (1)%
+(FIE 1)(1)
+1
+
+% Expect (FIE 1 2) to return 1, and print (1 2)%
+(FIE 1 2)(1 2)
+1
+
+% Expect FIE redefined in DM%
+(!$TEST DM
+ (EQ (DM FIE (X)
+ (LIST (QUOTE LIST)
+ (LIST (QUOTE QUOTE) X)
+ (LIST (QUOTE QUOTE) X) ))
+ (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQUAL (FIE 1) (QUOTE ((FIE 1) (FIE 1))))
+)*** (FUNCTION FIE REDEFINED)
+(***** (GETD (QUOTE FIE)) RETURNED (MACRO LAMBDA (X) (LIST (QUOTE LIST) (LIST (
+QUOTE QUOTE) X) (LIST (QUOTE QUOTE) X))))
+(DM TEST COMPLETE)
+
+% Expect (FIE 1) to return ((FIE 1) (FIE 1))%
+(FIE 1)((FIE 1) (FIE 1))
+
+(!$TEST GETD
+ (PAIRP (GETD (QUOTE FIE)))
+ (NULL (PAIRP (GETD (QUOTE FIEFIEFIE))))
+ (EQ (CAR (GETD (QUOTE FIE))) (QUOTE MACRO))
+)(GETD TEST COMPLETE)
+
+
+(!$TEST PUTD
+ (GLOBALP (QUOTE FIE))
+ )(***** (GLOBALP (QUOTE FIE)) RETURNED NIL)
+(PUTD TEST COMPLETE)
+
+% Should check that a FLUID variable not PUTDable;
+(!$TEST REMD
+ (PAIRP (REMD (QUOTE FIE)))
+ (NULL (GETD (QUOTE FIE)))
+ (NULL (REMD (QUOTE FIE)))
+ (NULL (REMD (QUOTE FIEFIEFIE)))
+)(REMD TEST COMPLETE)
+
+% -----3.6 Variables and Bindings------%
+% Make FLUIDVAR1 and FLUIDVAR2 fluids%
+(FLUID (QUOTE (FLUIDVAR1 FLUIDVAR2)))(FLUIDVAR1 FLUIDVAR2)
+
+% Check that FLUIDVAR1 and FLUIDVAR2 are fluid,expect T, T%
+(FLUIDP (QUOTE FLUIDVAR1))NIL
+
+(FLUIDP (QUOTE FLUIDVAR2))NIL
+
+% Give FLUIDVAR1 and FLUIDVAR2 initial values%
+(SETQ FLUIDVAR1 1)1
+
+(SETQ FLUIDVAR2 2)2
+
+
+(!$TEST 'FLUID! and! FLUIDP
+ (NULL (FLUID (QUOTE (FLUIDVAR3 FLUIDVAR1 FLUIDVAR2 FLUIDVAR4))))
+ (FLUIDP (QUOTE FLUIDVAR3))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (FLUIDP (QUOTE FLUIDVAR2))
+ (FLUIDP (QUOTE FLUIDVAR4))
+ (NULL (GLOBALP (QUOTE FLUIDVAR3)))
+ (NULL (GLOBALP (QUOTE FLUIDVAR1)))
+ (NULL FLUIDVAR3)
+ (EQN FLUIDVAR1 1)
+ (NULL (FLUIDP (QUOTE CAR)))
+)(***** (NULL (FLUID (QUOTE (FLUIDVAR3 FLUIDVAR1 FLUIDVAR2 FLUIDVAR4)))) RETURN
+ED NIL)
+(***** (FLUIDP (QUOTE FLUIDVAR3)) RETURNED NIL)
+(***** (FLUIDP (QUOTE FLUIDVAR1)) RETURNED NIL)
+(***** (FLUIDP (QUOTE FLUIDVAR2)) RETURNED NIL)
+(***** (FLUIDP (QUOTE FLUIDVAR4)) RETURNED NIL)
+((QUOTE FLUID AND FLUIDP) TEST COMPLETE)
+
+(GLOBAL (QUOTE (FLUIDGLOBAL1)))NIL
+
+% Expect ERROR that FLUIDGLOBAL1 already FLUID%
+(FLUID (QUOTE (FLUIDGLOBAL2)))(FLUIDGLOBAL2)
+
+
+% Expect ERROR that cant change FLUID%
+(GLOBAL (QUOTE (FLUIDVAR1 FLUIDVAR2 GLOBALVAR1 GLOBALVAR2)))NIL
+
+% Does error cause GLOBALVAR1, GLOBALVAR2 to be declared ;
+
+(!$TEST 'GLOBAL! and! GLOBALP
+ (NULL (GLOBAL (QUOTE (GLOBALVAR1 GLOBALVAR2))))
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (GLOBALP (QUOTE GLOBALVAR2))
+ (NULL (GLOBALP (QUOTE FLUIDVAR1)))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (NULL (FLUIDP (QUOTE GLOBALVAR1)))
+ (NULL (FLUIDP (QUOTE GLOBALVAR2)))
+ (GLOBALP (QUOTE CAR))
+)(***** (GLOBALP (QUOTE GLOBALVAR1)) RETURNED (GLOBAL))
+(***** (GLOBALP (QUOTE GLOBALVAR2)) RETURNED (GLOBAL))
+(***** (NULL (GLOBALP (QUOTE FLUIDVAR1))) RETURNED NIL)
+(***** (FLUIDP (QUOTE FLUIDVAR1)) RETURNED NIL)
+(***** (GLOBALP (QUOTE CAR)) RETURNED NIL)
+((QUOTE GLOBAL AND GLOBALP) TEST COMPLETE)
+
+
+% Set SETVAR1 to have an ID value%
+(SET (QUOTE SETVAR1) (QUOTE SETVAR2))SETVAR2
+
+
+% Expect SETVAR3 to be declared FLUID%
+(!$TEST SET
+ (NULL (FLUIDP (QUOTE SETVAR3)))
+ (EQN 3 (SET (QUOTE SETVAR3) 3))
+ (EQN 3 SETVAR3)
+ (FLUIDP (QUOTE SETVAR3))
+ (EQN (SET SETVAR1 4) 4)
+ (NULL (EQN SETVAR1 4))
+ (EQ SETVAR1 (QUOTE SETVAR2))
+ (EQN SETVAR2 4)
+)(***** (FLUIDP (QUOTE SETVAR3)) RETURNED NIL)
+(SET TEST COMPLETE)
+
+% Expect ERROR if try to set non ID%
+(SET 1 2)(SET 1 2)
+
+(SET (QUOTE SETVAR1) 1)1
+
+(SET SETVAR1 2)(SET 1 2)
+
+
+% Expect ERROR if try to SET T or NIL%
+(SET (QUOTE SAVENIL) NIL)NIL
+
+(SET (QUOTE SAVET) T)T
+
+(!$TEST 'Special! SET! value
+ (SET (QUOTE NIL) 1)
+ (NULL (EQN NIL 1))
+ (SET (QUOTE NIL) SAVENIL)
+ (SET (QUOTE T) 2)
+ (NULL (EQN T 2))
+ (SET (QUOTE T) SAVET)
+)(***** (SET (QUOTE NIL) 1) RETURNED 1 . 1)
+(***** (NULL (EQN NIL 1)) RETURNED NIL . 1)
+(***** (SET (QUOTE NIL) SAVENIL) RETURNED NIL)
+(***** (NULL (EQN T 2)) RETURNED NIL)
+((QUOTE SPECIAL SET VALUE) TEST COMPLETE)
+
+
+
+% Expect SETVAR3 to be declared FLUID%
+(!$TEST SETQ
+ (NULL (FLUIDP (QUOTE SETVAR3)))
+ (EQN 3 (SETQ SETVAR3 3))
+ (EQN 3 SETVAR3)
+ (FLUIDP (QUOTE SETVAR3))
+)(***** (FLUIDP (QUOTE SETVAR3)) RETURNED NIL)
+(SETQ TEST COMPLETE)
+
+
+% Expect ERROR if try to SETQ T or NIL%
+(SET (QUOTE SAVENIL) NIL)NIL
+
+(SET (QUOTE SAVET) T)T
+
+(!$TEST 'Special! SETQ! value
+ (SETQ NIL 1)
+ (NULL (EQN NIL 1))
+ (SETQ NIL SAVENIL)
+ (SETQ T 2)
+ (NULL (EQN T 2))
+ (SETQ T SAVET)
+)(***** (SETQ NIL 1) RETURNED 1 . 1)
+(***** (NULL (EQN NIL 1)) RETURNED NIL . 1)
+(***** (SETQ NIL SAVENIL) RETURNED NIL)
+(***** (NULL (EQN T 2)) RETURNED NIL)
+((QUOTE SPECIAL SETQ VALUE) TEST COMPLETE)
+
+
+(!$TEST UNFLUID
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (NULL (UNFLUID (QUOTE (GLOBALVAR1 FLUIDVAR1))))
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (NULL (FLUIDP (QUOTE FLUIDVAR1)))
+)(***** (GLOBALP (QUOTE GLOBALVAR1)) RETURNED (GLOBAL))
+(***** (FLUIDP (QUOTE FLUIDVAR1)) RETURNED NIL)
+(***** (GLOBALP (QUOTE GLOBALVAR1)) RETURNED (GLOBAL))
+(UNFLUID TEST COMPLETE)
+
+
+
+% ----- 3.7 Program Feature Functions -----%
+
+% These have been tested as part of BASIC tests;
+
+% Check exact GO and RETURN scoping rules ;
+
+% ----- 3.8 Error Handling -----%
+
+(!$TEST EMSG!* (GLOBALP (QUOTE EMSG!*)))(***** (GLOBALP (QUOTE EMSG*)) RETURNED
+ NIL)
+(EMSG* TEST COMPLETE)
+
+
+(!$TEST ERRORSET
+ (EQUAL (ERRORSET 1 T T) (QUOTE (1)))
+ (NULL (PAIRP (ERRORSET (QUOTE (CAR 1)) T T)))
+)
+***GARBAGE COLLECTOR CALLED
+CONSES: 3460
+ST : 83
+ 3483 PAIRS FREED.
+ 216 PAIRS IN USE.
+MAX GC STACK WAS 5
+
+%? SCALAR OUT OF RANGE AT USER PC 000000
+
+EXIT
+@POP
+
+[PHOTO: Recording terminated Mon 15-Feb-82 5:16PM]
ADDED perq-pascal-lisp-project/paslsp-wicat.bld
Index: perq-pascal-lisp-project/paslsp-wicat.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp-wicat.bld
@@ -0,0 +1,15 @@
+; Command file to assemble PASn pieces together
+; Wicat version
+;
+COP PAS3.INI PASLSP.INI
+APP PAS1.SLI PASLSP.INI
+APP PAS2.SLI PASLSP.INI
+APP PAS3.SLI PASLSP.INI
+APP USER.SLI PASLSP.INI
+filter w <pas0.pre >s:plw.pas
+append pas1.pas S:PLW.PAS
+append pas2.pas S:PLW.PAS
+append pas3.pas S:PLW.PAS
+append exec.pas S:PLW.PAS
+filter w <pasn.pre >s:plwn.pas
+append S:plwn.pas S:PLW.PAS
ADDED perq-pascal-lisp-project/paslsp.bld
Index: perq-pascal-lisp-project/paslsp.bld
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.bld
@@ -0,0 +1,19 @@
+; Command file to assemble PASn pieces together and then compile them.
+;
+COP PAS3.INI PASLSP.INI
+APP PAS1.SLI PASLSP.INI
+APP PAS2.SLI PASLSP.INI
+APP PAS3.SLI PASLSP.INI
+APP USER.SLI PASLSP.INI
+copy pas0.pas S:PASLSP.pas
+append pas1.pas S:PASLSP.pas
+append pas2.pas S:PASLSP.pas
+append pas3.pas S:PASLSP.pas
+append exec.pas S:PASLSP.pas
+append pasN.pas S:PASLSP.pas
+pascal
+S:PASLSP.rel
+S:PASLSP.lst
+S:PASLSP.pas
+load S:PASLSP.REL
+save S:PASLSP.EXE
ADDED perq-pascal-lisp-project/paslsp.ini
Index: perq-pascal-lisp-project/paslsp.ini
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.ini
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/paslsp.mail
Index: perq-pascal-lisp-project/paslsp.mail
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.mail
@@ -0,0 +1,3 @@
+PASLSPers: GRISS, CAI.OTTENHEIMER,JW-PETERSON,
+ PENDLETON, BENSON, GALWAY, VOELKER
+; Working on PASCAL-LISP project
ADDED perq-pascal-lisp-project/paslsp.mic
Index: perq-pascal-lisp-project/paslsp.mic
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.mic
@@ -0,0 +1,8 @@
+@pascal
+s:paslsp.rel
+
+s:paslsp.pas
+@load s:paslsp.rel
+@save s:paslsp.exe
+@st
+
ADDED perq-pascal-lisp-project/paslsp.mss
Index: perq-pascal-lisp-project/paslsp.mss
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.mss
@@ -0,0 +1,193 @@
+@Device(lpt)
+@style(justification yes)
+@style(spacing 1)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@make(article)
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(appendix,numbered=<APPENDIX @A: >)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+@define(up,use text,capitalized on, break off)
+@define(mac,use text, underline off, break off)
+@define(LISPmac,use text, underline alphanumerics, break off)
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "November 1981",
+ Line "Operating Note xx"
+ )
+@set(page=1)
+@newpage()
+@begin(titlepage)
+@begin(titlebox)
+@b(A PASCAL Based Standard LISP for the PERQ)
+@center[
+by
+
+M. L. Griss, R. Ottenheimer, S. Voelker, K. Boekleheide
+
+Department of Computer Science
+University of Utah
+Salt Lake City, Utah 84112
+
+@b(Preliminary Version)
+
+Last Revision: @value(date)]
+
+@end(titlebox)
+@begin(abstract)
+This report describes an interim implementation
+of Standard LISP for the PERQ. This LISP is based upon the
+Standard LISP report, and a newly developing Portable Standard LISP.
+This interim implementation is designed to explore LISP implementations
+in PASCAL on the PERQ and similar machines. The system consists of
+a kernel, handcoded in PASCAL, with the rest of the system written in
+LISP and compiled to PASCAL.
+@End(abstract)
+@begin(Researchcredit)
+Work supported in part by the National Science Foundation
+under Grant No. MCS80-07034, and by xxxx.
+@end(Researchcredit)
+@end(titlepage)
+@pageheading(Left "PERQ Standard LISP",Center "@value(date)",
+ Right "@value(Page)"
+ )
+@set(page=1)
+@newpage
+@section(Introduction)
+In this preliminary report, we describe an implementation of Standard LISP
+in PASCAL, PASLSP. Versions of PASLSP have been run on a number of
+machines, ranging from LSI-11 based TERAK to APOLLO and PERQ. This report
+concentrates on the PERQ implementation. This report is to be read in
+conjunction with the Standard LISP report@cite(Marti79); we will
+highlight the differences from the functions documented in the Standard
+LISP, describe the implementation strategy, and discuss future work.
+
+PASLSP is based on a series of small and medium sized LISP interpreters
+that have been developed at the University of Utah; each of these LISP
+systems consists of a small kernel handcoded in some language, with the
+rest of the system written in LISP and compiled to the target language.
+We have used FORTRAN, PASCAL and assembly language as targets. The PASLSP
+series use PASCAL for the kernel, and have a LISP to PASCAL for the rest of the
+system. Recent work has concentrated on reducing the hand-coded kernel,
+and has extended the compiler to compile more systems level constructs
+(SYSLISP level), resulting in a new Portable Standard LISP running
+on the DEC-20@cite(xxx). The PSL system is a modern, efficient system,
+and it is hoped to replace PASLSP with a PSL implemented in PASCAL.
+
+@subsection(History of PASLSP)
+The system now called PASLSP was originally developed (by M. Griss and W.
+Galway), as a small LISP like kernel to support a small algebra system on
+an LSI-11 TERAK; this was to be used as an answer analysis module within a
+CAI system@cite(Brandtxx), written entirely in PASCAL. It was decided to
+hand-code a very small kernel, and compile additional functions written in
+LISP (LISP support functions and algebra package) to PASCAL, using a
+modified Portable LISP compiler@cite(griss79). This version (call it V0)
+did not even have user defined functions, since space on the TERAK was
+at a premium.
+
+About June 1981, PASLSP came to the attention of a number people evaluating
+Apollo's and PERQ's, and it was suggested that we enhance V0 PASLSP for
+this purpose. During the space of a few days, sufficient features taken
+from the Standard LISP Report were added to the kernel and support files
+to produce V1 of PASLSP, running on a DEC-20 and Terak. This was
+a fairly complete LISP (including Catch and Throw), but lacked a few
+features (OPEN, CLOSE, RSD, WRS, PROG, GO, RETURN, Vectors and Strings).
+V1 PASLSP was adapted to a PERQ, VAX and Apollo by Paul Milazo of Schlumberge
+in the space of a few weeks (we did not have a PERQ or Apollo at that time).
+
+We subsequently obtained a PERQ and an Apollo, and recent work has been
+aimed at producing an enhanced PASLSP for these machines, as well as
+the TERAK, and other personal machines. The current system, V2 PASLSP,
+is produced from a single PASCAL kernel and set of LISP support files;
+the machine specific features are handled by a simple Source Code
+conditionalizer, changing the definition of certain constants and data
+types.
+
+We are releasing a copy of V2 PASLSP as an small, interim LISP, until
+a better LISP based on a more modern Portable Standard LISP can
+be completed.
+@subsection(Acknowledgement)
+
+I would like to acknowledge the advice, and software contributions of
+Will Galway, Eric Benson and Paul Milazo.
+
+@section(Implementation of PASLSP)
+
+@section(Features of PASLSP and relation to Standard LISP)
+PASLSP as far as possible provides all the functions mentioned
+in the attached Standard LISP Report (note the hand-written
+comments added to this appendix); some of the functions are simply
+stubs, so that a Standard LISP Test-file can be run with out major
+modification.
+
+PASLSP-V2 does not implement the following features of Standard LISP:
+@begin(enumeration,spread 0)
+STRINGS or VECTORS (only a simple garbage collector is used).
+
+Integers are limited in size (INTs and FIXNUMs,no BIGNUMs).
+
+FLOATING Point.
+
+IDs can not be REMOB'ed or INTERN'd.
+
+Only 3 Input Channels and 2 Output Channels are available to OPEN,
+RDS, WRS, and CLOSE. Thus file input statements can not be nested
+very deeply in files.
+
+Line, Page and Character counting (POSN, LPOSN, etc).
+@end(enumeration)
+
+PASLSP-V2 provides some extensions over Standard LISP:
+@begin(enumerate,spread 0)
+CATCH and THROW (both tagged and Untagged).
+
+Implicit PROGN in COND, and LAMBDA expressions.
+
+WHILE loop.
+
+CntrlC handlers.
+@end(enumerate)
+@Section(Features of PSL that will be incorporated in next PASLSP)
+
+@subsection(Goals of the Utah PSL Project)
+
+The goal of the PSL project is to produce an efficient and transportable
+Standard LISP system that may be used to:
+@begin(enumeration)
+Experimentally explore
+a variety of LISP implementation issues (storage management, binding,
+environments, etc.);
+
+Effectively support the REDUCE algebra system on a number of machines;
+
+Provide the same, uniform, modern LISP programming environment on all of
+the
+machines that we use (DEC-20, VAX/750, PDP-11/45 and some personal machine, perhaps 68000
+based), of the power and complexity of UCI-LISP or MACLISP, with some
+extensions and enhancements.
+@end(enumeration)
+
+The approach we have been using is to write the @b(entire) LISP system in
+Standard LISP (with extensions for dealing with
+machine words and operations), and to bootstrap it to the desired target
+machine
+in two steps:
+@begin(enumeration)
+Cross compile an appropriate kernel to the assembly language of the
+target machine;
+
+Once the kernel is running, use a resident compiler and loader, or
+fast-loader, to build the rest of the system.
+@end(enumeration)
+
+We currently think of the extensions to Standard LISP as having two levels:
+the SYSLISP level, dealing with words and bytes and machine operations,
+enabling us to write essentially all of the kernel in Standard LISP; and,
+the STDLISP level, incorporating all of the features that make Standard
+LISP into a modern LISP.
+
+In our environment, we write LISP code using an ALGOL-like preprocessor
+language, RLISP, that provides a number of syntactic niceties that
+we find convenient; we do not distinguish LISP from RLISP, and can
+mechanically translate from one to the other in either direction.
+@section(References)
+@Bibliography
ADDED perq-pascal-lisp-project/paslsp.table
Index: perq-pascal-lisp-project/paslsp.table
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.table
@@ -0,0 +1,266 @@
+NIL
+--------------- Functions ----------------
+!*FIRST!-PROCEDURE
+ABS
+ADD1
+AND
+APPEND
+APPLY
+APPLY1
+ASSOC
+ATOM
+ATSOC
+CAAAAR
+CAAADR
+CAAAR
+CAADAR
+CAADDR
+CAADR
+CAAR
+CADAAR
+CADADR
+CADAR
+CADDAR
+CADDDR
+CADDR
+CADR
+CAR
+CATCH
+CDAAAR
+CDAADR
+CDAAR
+CDADAR
+CDADDR
+CDADR
+CDAR
+CDDAAR
+CDDADR
+CDDAR
+CDDDAR
+CDDDDR
+CDDDR
+CDDR
+CDR
+CLOSE
+CODEP
+COMPRESS
+COND
+CONS
+CONSTANTP
+DE
+DEFLIST
+DELATQ
+DELETE
+DELQ
+DF
+DIFFERENCE
+DIGIT
+DIVIDE
+DM
+DN
+DSKIN
+EOFP
+EQ
+EQCAR
+EQN
+EQUAL
+ERROR
+ERRORSET
+ERRPRT
+EVAL
+EVLAM
+EVLIS
+EXPAND
+EXPLODE
+EXPT
+FASTSTAT
+FIX
+FIXP
+FLAG
+FLAG1
+FLAGP
+FLOAT
+FLOATP
+FLUID
+FLUIDP
+FUNCELL
+FUNCTION
+GENSYM
+GET
+GETD
+GETV
+GLOBAL
+GLOBALP
+GO
+GREATERP
+IDP
+INTERN
+LBIND1
+LBINDN
+LENGTH
+LESSP
+LIST2
+LIST3
+LIST4
+LIST5
+LITER
+MAP
+MAPC
+MAPCAN
+MAPCAR
+MAPCON
+MAPLIST
+MAX
+MAX2
+MEMBER
+MEMQ
+MIN
+MIN2
+MINUS
+MINUSP
+MKVECT
+MSGPRT
+NCONC
+NCONS
+NOT
+NULL
+NUMBERP
+ONEP
+OPEN
+OR
+ORDERP
+P!.N
+PAIR
+PAIRP
+PBIND1
+PBINDN
+PLIST
+PLUS
+PLUS2
+PRIN1
+PRIN2
+PRIN2T
+PRIN2TL
+PRINC
+PRINT
+PROG
+PROG2
+PROGG0131
+PROGN
+PUT
+PUTC
+PUTD
+PUTL
+PUTV
+QUOTIENT
+RDEVPR
+RDS
+RDTOK
+READ
+READCH
+RECLAIM
+REMAINDER
+REMD
+REMFLAG
+REMFLAG1
+REMOB
+REMPROP
+RETURN
+REV
+REVERSE
+REVX
+RLIST
+RPLACA
+RPLACD
+SASSOC
+SET
+SETFUNCELL
+SETPLIST
+SETVALUE
+STRINGP
+SUB1
+SUBLIS
+SUBST
+TCATCH
+TERPRI
+THROW
+TIMES
+TIMES2
+TOKEN
+TTHROW
+UNBIND1
+UNBINDN
+UNBINDTO
+UNFLUID
+UPBV
+VALUE
+VECTORP
+WHILE
+WRS
+WRTOK
+XAPPLY
+XCONS
+ZEROP
+--------------- Other IDS ----------------
+!$PROG!$
+!*!*!*!
+!*!*!*!*
+!*!*!*!*!
+!*!*!*!*! ERROR!
+!*RAISE
+!.!
+ASSOC
+BADLAMBDA
+BE
+BNDUNDERFLOW
+BSTK!*
+CANT
+DEFINED
+EMSG!*
+ENUM!*
+EXITING
+EXPR
+FEXPR
+FLAGGED
+FUNCTION
+GLOBAL
+INITFORM!*
+INPUT
+LABEL
+LAMBDA
+LIST
+LOOP
+LOSE
+MACRO
+MAX2
+MIN2
+NEXPR
+NEXPRS
+NOT
+OUTPUT
+P!.G
+P!.P
+PAIR
+PLUS2
+PROCS
+PROGG0131
+QUIT
+QUOTE
+REDEFINED
+SET
+SETQ
+THROWING!*
+THROWTAG!*
+TIMES2
+TOK!*
+TOKTYPE
+TOP
+TYPE
+--------------- CONST ----------------
+(LIST)
+(ALL RIGHTS RESERVED)
+(COPYRIGHT (C) 1981 U UTAH)
+(PASCAL LISP V2 !- 15 NOV 1981)
+(EXPR FEXPR NEXPR MACRO)
+(NIL)
+NIL
ADDED perq-pascal-lisp-project/paslsp.tst
Index: perq-pascal-lisp-project/paslsp.tst
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/paslsp.tst
@@ -0,0 +1,1171 @@
+%%%%%%%%%%%% Standard - LISP Verification file. %%%%%%%%%%%%%%%%%%%%%%%
+%
+% Copyright (C) M. Griss and J. Marti, February 1981
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+% Flags for SYSLISP based PSL
+
+
+(SETQ !*ECHO T)
+(SETQ FZERO (FLOAT 0))
+(SETQ FONE (FLOAT 1))
+(SETQ !*RAISE 'T)
+
+% The following should return T:
+T
+(NULL NIL)
+(COND (T T))
+(COND (NIL NIL) (T T))
+% The following should return NIL:
+NIL
+(NULL T)
+(COND (T NIL))
+(COND (NIL T)
+ (T NIL))
+% The following should be 0
+0 (QUOTE 0)
+% The following minimum set of functions must work:
+% PUTD, PROG, SET, QUOTE, COND, NULL, RETURN, LIST, CAR, CDR,
+% EVAL, PRINT, PRIN1, TERPRI, PROGN, GO.
+% Check PUTD, GETD, LAMBDA
+(PUTD (QUOTE FOO) (QUOTE EXPR) (QUOTE (LAMBDA (X) 3)))
+% Expect (EXPR LAMBDA (X) 3)
+(GETD (QUOTE FOO))
+% Should return 3
+(FOO 1)
+(FOO 2)
+% Test SET :
+(SET (QUOTE A) 1)
+A
+(SET (QUOTE B) 2)
+B
+% Test LIST, CAR, CDR
+% Expect (1 2 3 4) 1 and (2 3 4)
+(SET (QUOTE A) (LIST 1 2 3 4))
+(CAR A)
+(CDR A)
+% Test REDEFINITION in PUTD, PROGN, PRIN1, TERPRI
+(PUTD (QUOTE FOO) (QUOTE EXPR)
+ (QUOTE (LAMBDA (X) (PROGN (PRIN1 X) (TERPRI)))))
+% expect 1 and 2 printed , value NIL
+(FOO 1)
+(FOO 2)
+% Test simple PROG, GO, RETURN
+(PROG NIL (PRINT 1) (PRINT 2))
+(PROG (A) (PRINT A) (PRINT 1))
+% Now test GO, RETURN, PROG binding
+(SET 'A 'AA) (SET 'B 'BB)
+(PROG (A B) (PRINT 'test! binding! of! A!,! B! expect! NIL)
+ (PRIN1 A) (PRINT B)
+ (PRINT 'Reset! to! 1!,2)
+ (SET 'A 1) (SET 'B 2)
+ (PRIN1 A) (PRINT B)
+ (PRINT 'test! forward! GO)
+ (GO LL)
+ (PRINT 'forward! GO! failed)
+LL (PRINT 'Forward! GO! ok)
+ (GO L2)
+L1 (PRINT '! Should! be! after! BACKWARD! go )
+ (PRINT '! now! return! 3)
+ (RETURN 3)
+L2 (PRINT 'Test! backward! GO)
+ (GO L1) )
+% Test that A,B correctly rebound, expect AA and BB%
+A B
+% Test simple FEXPR%
+(PUTD (QUOTE FOO) (QUOTE FEXPR) (QUOTE (LAMBDA (X) (PRINT X))))
+% Expect (FEXPR LAMBDA (X) (PRINT X))%
+(GETD (QUOTE FOO))
+% Expect (1) (1 2) and (1 2 3)%
+(FOO 1)
+(FOO 1 2)
+(FOO 1 2 3)
+% Finally, TEST EVAL inside an FEXPR %
+(PUTD (QUOTE FOO) (QUOTE FEXPR)
+ (QUOTE (LAMBDA (XX) (PRINT (EVAL (CAR XX))))))
+(FOO 1)
+(FOO (NULL NIL))
+% PUTD is being used here to define a function !$TEST.%
+(PUTD (QUOTE !$TEST) (QUOTE FEXPR) (QUOTE
+ (LAMBDA (!$X)
+ (PROG (A B)
+ (SET (QUOTE A) (CDR !$X))
+LOOP (while A (progn
+ % (print (list 'trying (car a)))
+ (SET (QUOTE B) (EVAL (CAR A)))
+ (COND ( (null (eq b T))
+ (PROGN (PRIN1 (LIST '!*!*!*!*!* (CAR A) '! returned B))
+ (TERPRI))))
+ (SET (QUOTE A) (CDR A))
+ (GO LOOP)))
+ (return (LIST (CAR !$X) '! test! complete))
+ ))))
+% $TEST should be defined.
+(GETD (QUOTE !$TEST))
+% Global, vector, function-pointer partial test.
+(!$TEST 'GLOBAL!,VECTOR (NULL (GLOBAL (QUOTE (!$VECTOR !$CODE TEMP))))
+ (GLOBALP (QUOTE !$VECTOR))
+ (GLOBALP (QUOTE !$CODE))
+ (SET (QUOTE !$VECTOR) (MKVECT 4))
+ (SET (QUOTE !$CODE) (CDR (GETD (QUOTE CDR)))) )
+
+
+(!$TEST LIST (EQUAL (LIST 1 (QUOTE A) 'STRING )
+ (QUOTE (1 A STRING))))
+
+% -----3.1 Elementary Predicates-----%
+% This section tests the elementary predicates of section 3.1 of
+% the Standard LISP Report. In general they will test that the
+% predicate returns non-NIL for the correct case, and NIL for all
+% others.
+
+% CODEP should not return T for numbers as function
+% pointers must not be implemented in this way.
+(!$TEST CODEP (CODEP !$CODE) (NULL (CODEP 1))
+ (NULL (CODEP T)) (NULL (CODEP NIL))
+ (NULL (CODEP (QUOTE IDENTIFIER)))
+ (NULL (CODEP 'STRING)) (NULL (CODEP (QUOTE (A . B))))
+ (NULL (CODEP (QUOTE (A B C))))
+ (NULL (CODEP !$VECTOR)) )
+
+% PAIRP must not return T for vectors even if vectors are
+% implemented as lists.
+(!$TEST PAIRP
+ (PAIRP (QUOTE (A . B))) (PAIRP (QUOTE (NIL)))
+ (PAIRP (QUOTE (A B C))) (NULL (PAIRP 0))
+ (NULL (PAIRP (QUOTE IDENTIFIER)))
+ (NULL (PAIRP 'STRING))
+ (NULL (PAIRP !$VECTOR)) )
+
+(!$TEST FIXP (FIXP 1)
+ (NULL (FIXP (QUOTE IDENTIFIER)))
+ (NULL (FIXP (QUOTE 'STRING)))
+ (NULL (FIXP (QUOTE (A . B))))
+ (NULL (FIXP (QUOTE (A B C))))
+ (NULL (FIXP !$VECTOR))
+ (NULL (FIXP !$CODE)) )
+
+% T and NIL must test as identifiers as must specially
+% escaped character identifiers.
+(!$TEST IDP (IDP (QUOTE IDENTIFIER))
+ (IDP NIL) (IDP T)
+ (IDP (QUOTE !1)) (IDP (QUOTE !A)) (IDP (QUOTE !!))
+ (IDP (QUOTE !()) (IDP (QUOTE !))) (IDP (QUOTE !.))
+ (IDP (QUOTE !')) (IDP (QUOTE !*)) (IDP (QUOTE !/))
+ (IDP (QUOTE !+)) (IDP (QUOTE !-)) (IDP (QUOTE !#))
+ (IDP (QUOTE ! )) (IDP (QUOTE !1!2!3)) (IDP (QUOTE !*!*!*))
+ (IDP (QUOTE !'ID))
+ (NULL (IDP 1))
+ (NULL (IDP 'STRING))
+ (NULL (IDP (QUOTE (A . B))))
+ (NULL (IDP (QUOTE (A B C))))
+ (NULL (IDP !$VECTOR))
+ (NULL (IDP !$CODE)) )
+
+% STRINGP should answer T to strings only and not things
+% that might look like strings if the system implements them as
+% identifiers.
+(!$TEST STRINGP (STRINGP 'STRING)
+ (NULL (STRINGP (QUOTE (STRING NOTASTRING))))
+ (NULL (STRINGP 1))
+ (NULL (STRINGP (QUOTE A)))
+ (NULL (STRINGP (QUOTE (A . B))))
+ (NULL (STRINGP (QUOTE (A B C))))
+ (NULL (STRINGP !$VECTOR))
+ (NULL (STRINGP !$CODE)) )
+
+% VECTORP should not answer T to pairs if vectors are
+% implemented as pairs.
+(!$TEST VECTORP (VECTORP !$VECTOR)
+ (NULL (VECTORP 1))
+ (NULL (VECTORP (QUOTE A)))
+ (NULL (VECTORP 'STRING))
+ (NULL (VECTORP (QUOTE (A . B))))
+ (NULL (VECTORP (QUOTE (A B C))))
+ (NULL (VECTORP !$CODE)) )
+
+% Vectors are constants in Standard LISP. However T and NIL
+% are special global variables with the values T and NIL.
+(!$TEST CONSTANTP (CONSTANTP 1)
+ (CONSTANTP 'STRING)
+ (CONSTANTP !$VECTOR)
+ (CONSTANTP !$CODE)
+ (NULL (CONSTANTP NIL))
+ (NULL (CONSTANTP T))
+ (NULL (CONSTANTP (QUOTE A)))
+ (NULL (CONSTANTP (QUOTE (A . B))))
+ (NULL (CONSTANTP (QUOTE (A B C)))) )
+
+% An ATOM is anything that is not a pair, thus vectors are
+% atoms.
+(!$TEST ATOM (ATOM T) (ATOM NIL) (ATOM 1) (ATOM 0)
+ (ATOM 'STRING) (ATOM (QUOTE IDENTIFIER))
+ (ATOM !$VECTOR)
+ (NULL (ATOM (QUOTE (A . B))))
+ (NULL (ATOM (QUOTE (A B C)))) )
+
+
+(!$TEST EQ (EQ NIL NIL) (EQ T T)
+ (EQ !$VECTOR !$VECTOR)
+ (EQ !$CODE !$CODE)
+ (EQ (QUOTE A) (QUOTE A))
+ (NULL (EQ NIL T))
+ (NULL (EQ NIL !$VECTOR))
+ (NULL (EQ (QUOTE (A . B)) (QUOTE (A . B)))) )
+
+% Function pointers are not numbers, therefore the function
+% pointer $CODE is not EQN to the fixed number 0. Numbers must have
+% the same type to be EQN.
+(!$TEST EQN (EQN 1 1) (EQN 0 0)
+ (EQN FONE FONE) (EQN FZERO FZERO)
+ (NULL (EQN FONE FZERO)) (NULL (EQN FZERO FONE))
+ (NULL (EQN 1 FONE)) (NULL (EQN 0 FZERO))
+ (NULL (EQN 1 0)) (NULL (EQN 0 1))
+ (NULL (EQN 0 !$CODE))
+ (NULL (EQN NIL 0))
+ (EQN NIL NIL) (EQN T T) (EQN !$VECTOR !$VECTOR)
+ (EQN !$CODE !$CODE) (EQN (QUOTE A) (QUOTE A))
+ (NULL (EQN (QUOTE (A . B)) (QUOTE (A . B))))
+ (NULL (EQN (QUOTE (A B C)) (QUOTE (A B C)))) )
+
+% EQUAL checks for general equality rather than specific, so
+% it must check all elements of general expressions and all elements
+% of vectors for equality. This test assumes that CAR does not have
+% the function pointer value EQUAL to 0. Further tests of EQUAL
+% are in the vector section 3.9.
+(!$TEST EQUAL (EQUAL NIL NIL)
+ (EQUAL T T)
+ (NULL (EQUAL NIL T))
+ (EQUAL !$CODE !$CODE)
+ (NULL (EQUAL !$CODE (CDR (GETD (QUOTE CAR)))))
+ (EQUAL (QUOTE IDENTIFIER) (QUOTE IDENTIFIER))
+ (NULL (EQUAL (QUOTE IDENTIFIER1) (QUOTE IDENTIFIER2)))
+ (EQUAL 'STRING 'STRING)
+ (NULL (EQUAL 'STRING1 'STRING2))
+ (EQUAL 0 0)
+ (NULL (EQUAL 0 1))
+ (EQUAL (QUOTE (A . B)) (QUOTE (A . B)))
+ (NULL (EQUAL (QUOTE (A . B)) (QUOTE (A . C))))
+ (NULL (EQUAL (QUOTE (A . B)) (QUOTE (C . B))))
+ (EQUAL (QUOTE (A B)) (QUOTE (A B)))
+ (NULL (EQUAL (QUOTE (A B)) (QUOTE (A C))))
+ (NULL (EQUAL (QUOTE (A B)) (QUOTE (C B))))
+ (EQUAL !$VECTOR !$VECTOR)
+ (NULL (EQUAL 0 NIL))
+ (NULL (EQUAL 'T T))
+ (NULL (EQUAL 'NIL NIL)) )
+
+% -----3.2 Functions on Dotted-Pairs-----%
+% Test the C....R functions by simply verifying that they select
+% correct part of a structure.
+(!$TEST CAR (EQ (CAR (QUOTE (A . B))) (QUOTE A))
+ (EQUAL (CAR (QUOTE ((A) . B))) (QUOTE (A))) )
+
+(!$TEST CDR (EQ (CDR (QUOTE (A . B))) (QUOTE B))
+ (EQUAL (CDR (QUOTE (A B))) (QUOTE (B))) )
+
+(!$TEST CAAR (EQ (CAAR (QUOTE ((A)))) (QUOTE A)))
+(!$TEST CADR (EQ (CADR (QUOTE (A B))) (QUOTE B)))
+(!$TEST CDAR (EQ (CDAR (QUOTE ((A . B)))) (QUOTE B)))
+(!$TEST CDDR (EQ (CDDR (QUOTE (A . (B . C)))) (QUOTE C)))
+
+(!$TEST CAAAR (EQ (CAAAR (QUOTE (((A))))) (QUOTE A)))
+(!$TEST CAADR (EQ (CAADR (QUOTE (A (B)))) (QUOTE B)))
+(!$TEST CADAR (EQ (CADAR (QUOTE ((A B)))) (QUOTE B)))
+(!$TEST CADDR (EQ (CADDR (QUOTE (A B C))) (QUOTE C)))
+(!$TEST CDAAR (EQ (CDAAR (QUOTE (((A . B)) C))) (QUOTE B)))
+(!$TEST CDADR (EQ (CDADR (QUOTE (A (B . C)))) (QUOTE C)))
+(!$TEST CDDAR (EQ (CDDAR (QUOTE ((A . (B . C))))) (QUOTE C)))
+(!$TEST CDDDR (EQ (CDDDR (QUOTE (A . (B . (C . D))))) (QUOTE D)))
+
+(!$TEST CAAAAR (EQ (CAAAAR (QUOTE ((((A)))))) (QUOTE A)))
+(!$TEST CAAADR (EQ (CAAADR (QUOTE (A ((B))))) (QUOTE B)))
+(!$TEST CAADAR (EQ (CAADAR (QUOTE ((A (B))))) (QUOTE B)))
+(!$TEST CAADDR (EQ (CAADDR (QUOTE (A . (B (C))))) (QUOTE C)))
+(!$TEST CADAAR (EQ (CADAAR (QUOTE (((A . (B)))))) (QUOTE B)))
+(!$TEST CADADR (EQ (CADADR (QUOTE (A (B . (C))))) (QUOTE C)))
+(!$TEST CADDAR (EQ (CADDAR (QUOTE ((A . (B . (C)))))) (QUOTE C)))
+(!$TEST CADDDR (EQ (CADDDR (QUOTE (A . (B . (C . (D)))))) (QUOTE D)))
+(!$TEST CDAAAR (EQ (CDAAAR (QUOTE ((((A . B)))))) (QUOTE B)))
+(!$TEST CDAADR (EQ (CDAADR (QUOTE (A ((B . C))))) (QUOTE C)))
+(!$TEST CDADAR (EQ (CDADAR (QUOTE ((A (B . C))))) (QUOTE C)))
+(!$TEST CDADDR (EQ (CDADDR (QUOTE (A . (B . ((C . D)))))) (QUOTE D)))
+(!$TEST CDDAAR (EQ (CDDAAR (QUOTE (((A . (B . C)))))) (QUOTE C)))
+(!$TEST CDDADR (EQ (CDDADR (QUOTE (A . ((B . (C . D)))))) (QUOTE D)))
+(!$TEST CDDDAR (EQ (CDDDAR (QUOTE ((A . (B . (C . D)))))) (QUOTE D)))
+(!$TEST CDDDDR (EQ (CDDDDR (QUOTE (A . (B . (C . (D . E)))))) (QUOTE E)))
+
+% CONS should return a unique cell when invoked. Also test that
+% the left and right parts are set correctly.
+(!$TEST CONS (NULL (EQ (CONS (QUOTE A) (QUOTE B)) (QUOTE (A . B))))
+ (EQ (CAR (CONS (QUOTE A) (QUOTE B))) (QUOTE A))
+ (EQ (CDR (CONS (QUOTE A) (QUOTE B))) (QUOTE B)) )
+
+% Veryify that RPLACA doesn't modify the binding of a list, and
+% that only the CAR part of the cell is affected.
+(!$TEST RPLACA
+ (SET (QUOTE TEMP) (QUOTE (A)))
+ (EQ (RPLACA TEMP 1) TEMP)
+ (EQ (CAR (RPLACA TEMP (QUOTE B))) (QUOTE B))
+ (EQ (CDR TEMP) NIL) )
+
+(!$TEST RPLACD
+ (SET (QUOTE TEMP) (QUOTE (A . B)))
+ (EQ (RPLACD TEMP (QUOTE A)) TEMP)
+ (EQ (CDR (RPLACD TEMP (QUOTE C))) (QUOTE C))
+ (EQ (CAR TEMP) (QUOTE A)) )
+
+% -----3.3 Identifiers-----%
+% Verify that COMPRESS handles the various types of lexemes
+% correctly.
+(!$TEST COMPRESS
+ (NULL (EQ (COMPRESS (QUOTE (A B))) (COMPRESS (QUOTE (A B)))))
+ (EQN (COMPRESS (QUOTE (!1 !2))) 12)
+ (EQN (COMPRESS (QUOTE (!+ !1 !2))) 12)
+ (EQN (COMPRESS (QUOTE (!- !1 !2))) -12)
+ (EQUAL (COMPRESS (QUOTE ( S T R I N G ))) 'STRING)
+ (EQ (INTERN (COMPRESS (QUOTE (A B)))) (QUOTE AB))
+ (EQ (INTERN (COMPRESS (QUOTE (!! !$ A)))) (QUOTE !$A)) )
+
+% Verify that EXPLODE returns the expected lists and that COMPRESS
+% and explode are inverses of each other.
+(!$TEST EXPLODE
+ (EQUAL (EXPLODE 12) (QUOTE (!1 !2)))
+ (EQUAL (EXPLODE -12) (QUOTE (!- !1 !2)))
+ (EQUAL (EXPLODE 'STRING) (QUOTE ( S T R I N G )))
+ (EQUAL (EXPLODE (QUOTE AB)) (QUOTE (A B)) )
+ (EQUAL (EXPLODE (QUOTE !$AB)) (QUOTE (!! !$ A B)))
+ (EQUAL (COMPRESS (EXPLODE 12)) 12)
+ (EQUAL (COMPRESS (EXPLODE -12)) -12)
+ (EQUAL (COMPRESS (EXPLODE 'STRING)) 'STRING)
+ (EQ (INTERN (COMPRESS (EXPLODE (QUOTE AB)))) (QUOTE AB))
+ (EQ (INTERN (COMPRESS (EXPLODE (QUOTE !$AB)))) (QUOTE !$AB)) )
+
+% Test that GENSYM returns identifiers and that they are different.
+(!$TEST GENSYM
+ (IDP (GENSYM))
+ (NULL (EQ (GENSYM) (GENSYM))) )
+
+% Test that INTERN works on strings to produce identifiers the same
+% as those read in. Try ID's with special characters in them (more
+% will be tested with READ).
+(!$TEST INTERN
+ (EQ (INTERN 'A) (QUOTE A))
+ (EQ (INTERN 'A12) (QUOTE A12))
+ (EQ (INTERN 'A!*) (QUOTE A!*))
+ (NULL (EQ (INTERN 'A) (INTERN 'B))) )
+
+% Just test that REMOB returns the ID removed.
+(!$TEST REMOB
+ (EQ (REMOB (QUOTE AAAA)) (QUOTE AAAA)) )
+
+% ----- 3.4 Property List Functions-----%
+% Test that FLAG always returns NIL. More testing is done in FLAGP.
+(!$TEST FLAG
+ (NULL (FLAG NIL (QUOTE W)))
+ (NULL (FLAG (QUOTE (U V T NIL)) (QUOTE X)))
+ (NULL (FLAG (QUOTE (U)) NIL)) )
+
+% Test that FLAG worked only on a list. Test all items in a flagged
+% list were flagged and that those that weren't aren't.
+(!$TEST FLAGP
+ (NULL (FLAGP NIL (QUOTE W)))
+ (FLAGP (QUOTE U) (QUOTE X))
+ (FLAGP (QUOTE V) (QUOTE X))
+ (FLAGP T (QUOTE X))
+ (FLAGP NIL (QUOTE X))
+ (FLAGP (QUOTE U) NIL) )
+
+% Test that REMFLAG always returns NIL and that flags removed are
+% gone. Test that unremoved flags are still present.
+(!$TEST REMFLAG
+ (NULL (REMFLAG NIL (QUOTE X)))
+ (NULL (REMFLAG (QUOTE (U T NIL)) (QUOTE X)))
+ (NULL (FLAGP (QUOTE U) (QUOTE X)))
+ (FLAGP (QUOTE V) (QUOTE X))
+ (NULL (FLAGP T (QUOTE X)))
+ (NULL (FLAGP NIL (QUOTE X))) )
+
+(!$TEST PUT
+ (EQ (PUT (QUOTE U) (QUOTE IND1) (QUOTE PROP)) (QUOTE PROP))
+ (EQN (PUT (QUOTE U) (QUOTE IND2) 0) 0)
+ (EQ (PUT (QUOTE U) (QUOTE IND3) !$VECTOR) !$VECTOR)
+ (EQ (PUT (QUOTE U) (QUOTE IND4) !$CODE) !$CODE) )
+
+(!$TEST GET
+ (EQ (GET (QUOTE U) (QUOTE IND1)) (QUOTE PROP))
+ (EQN (GET (QUOTE U) (QUOTE IND2)) 0)
+ (EQ (GET (QUOTE U) (QUOTE IND3)) !$VECTOR)
+ (EQ (GET (QUOTE U) (QUOTE IND4)) !$CODE) )
+
+(!$TEST REMPROP
+ (NULL (REMPROP !$CODE !$CODE))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND1)) (QUOTE PROP))
+ (NULL (GET (QUOTE U) (QUOTE IND1)))
+ (EQN (REMPROP (QUOTE U) (QUOTE IND2)) (QUOTE 0))
+ (NULL (GET (QUOTE U) (QUOTE IND2)))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND3)) !$VECTOR)
+ (NULL (GET (QUOTE U) (QUOTE IND3)))
+ (GET (QUOTE U) (QUOTE IND4))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND4)) !$CODE)
+ (NULL (GET (QUOTE U) (QUOTE IND4))) )
+
+
+% -----3.5 Function Definition-----%
+(!$TEST DE
+ (EQ (DE FIE (X) (PLUS2 X 1)) (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQN (FIE 1) 2)
+)
+% Expect (FIE 1) to return 2%
+(FIE 1)
+% Expect FIE redefined in DF test%
+(!$TEST DF
+ (EQ (DF FIE (X) (PROGN (PRINT X) (CAR X))) (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQN (FIE 1) 1)
+ (EQN (FIE 2 3) 2)
+)
+% Expect (FIE 1) to return 1, and print (1)%
+(FIE 1)
+% Expect (FIE 1 2) to return 1, and print (1 2)%
+(FIE 1 2)
+% Expect FIE redefined in DM%
+(!$TEST DM
+ (EQ (DM FIE (X)
+ (LIST (QUOTE LIST)
+ (LIST (QUOTE QUOTE) X)
+ (LIST (QUOTE QUOTE) X) ))
+ (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQUAL (FIE 1) (QUOTE ((FIE 1) (FIE 1))))
+)
+% Expect (FIE 1) to return ((FIE 1) (FIE 1))%
+(FIE 1)
+(!$TEST GETD
+ (PAIRP (GETD (QUOTE FIE)))
+ (NULL (PAIRP (GETD (QUOTE FIEFIEFIE))))
+ (EQ (CAR (GETD (QUOTE FIE))) (QUOTE MACRO))
+)
+
+(!$TEST PUTD
+ (GLOBALP (QUOTE FIE))
+ )
+% Should check that a FLUID variable not PUTDable;
+(!$TEST REMD
+ (PAIRP (REMD (QUOTE FIE)))
+ (NULL (GETD (QUOTE FIE)))
+ (NULL (REMD (QUOTE FIE)))
+ (NULL (REMD (QUOTE FIEFIEFIE)))
+)
+% -----3.6 Variables and Bindings------%
+% Make FLUIDVAR1 and FLUIDVAR2 fluids%
+(FLUID (QUOTE (FLUIDVAR1 FLUIDVAR2)))
+% Check that FLUIDVAR1 and FLUIDVAR2 are fluid,expect T, T%
+(FLUIDP (QUOTE FLUIDVAR1))
+(FLUIDP (QUOTE FLUIDVAR2))
+% Give FLUIDVAR1 and FLUIDVAR2 initial values%
+(SETQ FLUIDVAR1 1)
+(SETQ FLUIDVAR2 2)
+
+(!$TEST 'FLUID! and! FLUIDP
+ (NULL (FLUID (QUOTE (FLUIDVAR3 FLUIDVAR1 FLUIDVAR2 FLUIDVAR4))))
+ (FLUIDP (QUOTE FLUIDVAR3))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (FLUIDP (QUOTE FLUIDVAR2))
+ (FLUIDP (QUOTE FLUIDVAR4))
+ (NULL (GLOBALP (QUOTE FLUIDVAR3)))
+ (NULL (GLOBALP (QUOTE FLUIDVAR1)))
+ (NULL FLUIDVAR3)
+ (EQN FLUIDVAR1 1)
+ (NULL (FLUIDP (QUOTE CAR)))
+)
+(GLOBAL (QUOTE (FLUIDGLOBAL1)))
+% Expect ERROR that FLUIDGLOBAL1 already FLUID%
+(FLUID (QUOTE (FLUIDGLOBAL2)))
+
+% Expect ERROR that cant change FLUID%
+(GLOBAL (QUOTE (FLUIDVAR1 FLUIDVAR2 GLOBALVAR1 GLOBALVAR2)))
+% Does error cause GLOBALVAR1, GLOBALVAR2 to be declared ;
+
+(!$TEST 'GLOBAL! and! GLOBALP
+ (NULL (GLOBAL (QUOTE (GLOBALVAR1 GLOBALVAR2))))
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (GLOBALP (QUOTE GLOBALVAR2))
+ (NULL (GLOBALP (QUOTE FLUIDVAR1)))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (NULL (FLUIDP (QUOTE GLOBALVAR1)))
+ (NULL (FLUIDP (QUOTE GLOBALVAR2)))
+ (GLOBALP (QUOTE CAR))
+)
+
+% Set SETVAR1 to have an ID value%
+(SET (QUOTE SETVAR1) (QUOTE SETVAR2))
+
+% Expect SETVAR3 to be declared FLUID%
+(!$TEST SET
+ (NULL (FLUIDP (QUOTE SETVAR3)))
+ (EQN 3 (SET (QUOTE SETVAR3) 3))
+ (EQN 3 SETVAR3)
+ (FLUIDP (QUOTE SETVAR3))
+ (EQN (SET SETVAR1 4) 4)
+ (NULL (EQN SETVAR1 4))
+ (EQ SETVAR1 (QUOTE SETVAR2))
+ (EQN SETVAR2 4)
+)
+% Expect ERROR if try to set non ID%
+(SET 1 2)
+(SET (QUOTE SETVAR1) 1)
+(SET SETVAR1 2)
+
+% Expect ERROR if try to SET T or NIL%
+(SET (QUOTE SAVENIL) NIL)
+(SET (QUOTE SAVET) T)
+(!$TEST 'Special! SET! value
+ (SET (QUOTE NIL) 1)
+ (NULL (EQN NIL 1))
+ (SET (QUOTE NIL) SAVENIL)
+ (SET (QUOTE T) 2)
+ (NULL (EQN T 2))
+ (SET (QUOTE T) SAVET)
+)
+
+
+% Expect SETVAR3 to be declared FLUID%
+(!$TEST SETQ
+ (NULL (FLUIDP (QUOTE SETVAR3)))
+ (EQN 3 (SETQ SETVAR3 3))
+ (EQN 3 SETVAR3)
+ (FLUIDP (QUOTE SETVAR3))
+)
+
+% Expect ERROR if try to SETQ T or NIL%
+(SET (QUOTE SAVENIL) NIL)
+(SET (QUOTE SAVET) T)
+(!$TEST 'Special! SETQ! value
+ (SETQ NIL 1)
+ (NULL (EQN NIL 1))
+ (SETQ NIL SAVENIL)
+ (SETQ T 2)
+ (NULL (EQN T 2))
+ (SETQ T SAVET)
+)
+
+(!$TEST UNFLUID
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (NULL (UNFLUID (QUOTE (GLOBALVAR1 FLUIDVAR1))))
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (NULL (FLUIDP (QUOTE FLUIDVAR1)))
+)
+
+
+% ----- 3.7 Program Feature Functions -----%
+
+% These have been tested as part of BASIC tests;
+
+% Check exact GO and RETURN scoping rules ;
+
+% ----- 3.8 Error Handling -----%
+
+(!$TEST EMSG!* (GLOBALP (QUOTE EMSG!*)))
+
+(!$TEST ERRORSET
+ (EQUAL (ERRORSET 1 T T) (QUOTE (1)))
+ (NULL (PAIRP (ERRORSET (QUOTE (CAR 1)) T T)))
+)
+
+% Display ERRORSET range of messages and features%
+
+% First with primitive (CAR 1) error%
+
+(SETQ ERRORVAR1 (QUOTE (CAR 1)))
+
+% Expect MSG and BACKTRACE %
+(ERRORSET ERRORVAR1 T T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect MSG, no backtrace %
+(ERRORSET ERRORVAR1 T NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect no MSG, but BACKTRACE %
+(ERRORSET ERRORVAR1 NIL T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect neither MSG nor Backtrace%
+(ERRORSET ERRORVAR1 NIL NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+
+% Test with CALL on ERROR, with num=789, (A MESSAGE)%
+
+(SETQ ERRORVAR2 (QUOTE (ERROR 789 (LIST (QUOTE A) (QUOTE MESSAGE)))))
+% Expect MSG and BACKTRACE %
+(ERRORSET ERRORVAR2 T T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect MSG, no backtrace %
+(ERRORSET ERRORVAR2 T NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect no MSG, but BACKTRACE %
+(ERRORSET ERRORVAR2 NIL T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect neither MSG nor Backtrace%
+(ERRORSET ERRORVAR2 NIL NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+
+% Test of Rebinding/Unbinding%
+
+(FLUID (QUOTE (ERRORVAR3 ERRORVAR4)))
+(SETQ ERRORVAR3 3)
+(SETQ ERRORVAR4 4)
+
+(DE ERRORFN1 (X ERRORVAR3)
+ (PROGN (PRINT (LIST (QUOTE ERRORVAR3) ERRORVAR3))
+ (SETQ ERRORVAR3 33)
+ (PROG (Y ERRORVAR4)
+ (PRINT (LIST (QUOTE ERRORVAR3) ERRORVAR3))
+ (PRINT (LIST (QUOTE ERRORVAR4) ERRORVAR4))
+ (SETQ ERRORVAR3 333)
+ (SETQ ERRORVAR4 444)
+ (ERROR 555 'Error! Inside! ERRORFN1)
+ (RETURN 'Error! Failed))))
+
+% Expect to see 3333 33 44 printed%
+% Followed by ERROR 555 messgae%
+(ERRORSET (QUOTE (ERRORFN1 3333 4444)) T T)
+% Expect 3 and 4 as Final values of ERRORVAR3 and ERRORVAR4%
+ERRORVAR3
+ERRORVAR4
+(!$TEST ERRORVARS
+ (EQN ERRORVAR3 3)
+ (EQN ERRORVAR4 4)
+)
+% ----- 3.9 Vectors -----%
+% Create a few variables that may be vectors %
+(SETQ VECTVAR1 NIL)
+(SETQ VECTVAR2 (QUOTE (VECTOR 1 2 3)))
+(SETQ VECTVAR3 (QUOTE [1 2 3 4]))
+
+% Expect Type mismatch Error for next 2%
+(GETV VECTVAR1 1)
+(GETV VECTVAR2 1)
+% Expect 1 2 for next 2%
+(GETV VECTVAR3 0)
+(GETV VECTVAR3 1)
+% Expect Index error for next 2%
+(GETV VECVAR3 -1)
+(GETV VECTVAR3 4)
+
+
+(!$TEST MKVECT
+ (VECTORP (SETQ VECTVAR3 (MKVECT 5)))
+ (EQN 5 (UPBV VECTVAR3))
+ (NULL (GETV VECTVAR3 0))
+ (NULL (GETV VECTVAR3 5))
+ (EQN 10 (PUTV VECTVAR3 0 10))
+ (EQN 10 (GETV VECTVAR3 0))
+ (EQN 20 (PUTV VECTVAR3 5 20))
+ (EQN 20 (GETV VECTVAR3 5))
+)
+% Expect VECTVAR3 to be [ 10 nil nil nil nil 20 ]%
+(PRINT VECTVAR3)
+
+% Expect MKVECT error for index less than 0%
+(MKVECT -1)
+% Expect length 1 vector%
+(MKVECT 0)
+% Expect type error%
+(MKVECT NIL)
+% Expect 2 TYPE errors%
+(PUTV VECTVAR1 0 1)
+(PUTV VECTVAR1 -1 1)
+
+(!$TEST UPBV
+ (NULL (UPBV VECTVAR1))
+ (EQN (UPBV VECTVAR3 5) 5 )
+)
+% ----- 3.10 Booleans and Conditionals -----%
+(!$TEST AND
+ (EQ T (AND))
+ (EQ T (AND T))
+ (EQ T (AND T T))
+ (EQN 1 (AND T 1))
+ (EQ T (AND 1 T))
+ (EQ T (AND T T 1 1 T T))
+ (NULL (AND NIL))
+ (NULL (AND T NIL))
+ (NULL (AND NIL T))
+ (NULL (AND T T T T NIL T T))
+)
+% The next should not ERROR, else AND is evaluating all args%
+(AND T T NIL (ERROR 310 'AND! Failed) T)
+
+(!$TEST COND
+ (EQN 1 (COND (T 1)))
+ (NULL (COND))
+ (NULL (COND (NIL 1)))
+ (EQN 1 (COND (T 1) (T 2)))
+ (EQN 2 (COND (NIL 1) (T 2)))
+ (NULL (COND (NIL 1) (NIL 2)))
+)
+% Test COND with GO and RETURN%
+(PROG NIL
+ (COND (T (GO L1)))
+ (ERROR 310 'COND! fell! through)
+ L1 (PRINT 'GO! in! cond! worked)
+ (COND (T (RETURN (PRINT 'Return! 2))))
+ (ERROR 310 'COND! did! not! RETURN)
+)
+% Certain Extensions to COND might fail%
+%/(COND 1 2)
+%/(COND (T))
+%/(COND (T 1 2 3))
+
+(!$TEST NOT
+ (NULL (NOT T))
+ (EQ T (NOT NIL))
+)
+
+(!$TEST OR
+ (NULL (OR))
+ (EQ T (OR T))
+ (EQ T (OR T T))
+ (EQN T (OR T 1))
+ (EQ 1 (OR 1 T))
+ (EQ T (OR T T 1 1 T T))
+ (NULL (OR NIL))
+ (EQ T (OR T NIL))
+ (EQ T (OR NIL T))
+ (EQ T (OR T T T T NIL T T))
+)
+% The next should not ERROR, else OR is evaluating all args%
+(OR T NIL NIL (ERROR 310 'OR! Failed) T)
+
+% -----3.11 Arithmetic Functions-----%
+% Setup some ints%
+% Setup some floats%
+(SETQ FZERO (FLOAT 0))
+(SETQ FONE (FLOAT 1))
+(SETQ FTWO (FLOAT 2))
+(SETQ FTHREE (FLOAT 3))
+(!$TEST ABS
+ (EQN 0 (ABS 0))
+ (EQN 1 (ABS 1))
+ (EQN 1 (ABS -1))
+ (EQN FZERO (ABS FZERO))
+ (EQN FONE (ABS FONE))
+ (EQN FONE (ABS (MINUS FONE)))
+)
+
+(!$TEST ADD1
+ (EQN 1 (ADD1 0))
+ (EQN 0 (ADD1 -1))
+ (EQN 2 (ADD1 1))
+ (EQN FONE (ADD1 FZERO))
+ (EQN FTWO (ADD1 FONE))
+)
+
+(!$TEST DIFFERENCE
+ (EQN 0 (DIFFERENCE 1 1))
+ (EQN FZERO (DIFFERENCE FONE FONE))
+ (EQN FZERO (DIFFERENCE 1 FONE))
+ (EQN FZERO (DIFFERENCE FONE 1))
+ (EQN 1 (DIFFERENCE 2 1))
+ (EQN -1 (DIFFERENCE 1 2))
+)
+
+(!$TEST DIVIDE
+ (EQUAL (CONS 1 2) (DIVIDE 7 5))
+ (EQUAL (CONS -1 -2) (DIVIDE -7 5))
+ (EQUAL (CONS -1 2) (DIVIDE 7 -5))
+ (EQUAL (CONS 1 -2) (DIVIDE -7 -5))
+)
+(!$TEST EXPT
+ (EQN (EXPT 2 0) 1)
+ (EQN (EXPT 2 1) 2)
+ (EQN (EXPT 2 2) 4)
+ (EQN (EXPT 2 3) 8)
+ (EQN (EXPT -2 2) 4)
+ (EQN (EXPT -2 3) -8)
+)
+
+(!$TEST FIX
+ (NUMBERP (FIX FONE))
+ (FIXP (FIX FONE))
+ (NULL (FLOATP (FIX FONE)))
+ (EQN (FIX FONE ) 1)
+ (NUMBERP (FIX 1))
+ (FIXP (FIX 1))
+)
+
+(!$TEST FLOAT
+ (NUMBERP (FLOAT 1))
+ (FLOATP (FLOAT 1))
+ (NULL (FIXP (FLOAT 1)))
+ (EQN FONE (FLOAT 1))
+)
+
+(!$TEST GREATERP
+ (GREATERP 2 1)
+ (GREATERP 1 0)
+ (GREATERP 0 -1)
+ (NULL (GREATERP 2 2))
+ (NULL (GREATERP 1 1))
+ (NULL (GREATERP 0 0))
+ (NULL (GREATERP 0 1))
+ (NULL (GREATERP -1 0))
+)
+(!$TEST LESSP
+ (NULL (LESSP 2 1))
+ (NULL (LESSP 1 0))
+ (NULL (LESSP 0 -1))
+ (NULL (LESSP 2 2))
+ (NULL (LESSP 1 1))
+ (NULL (LESSP 0 0))
+ (LESSP 0 1)
+ (LESSP -1 0)
+)
+(!$TEST MAX
+ (EQN (MAX 1 2 3) 3)
+ (EQN (MAX 3 2 1) 3)
+ (EQN 1 (MAX 1 0))
+ (EQN 1 (MAX 1))
+)
+% What is (MAX) ;
+
+(!$TEST MAX2
+ (EQN (MAX2 1 2) 2)
+ (EQN (MAX2 2 1) 2)
+ (EQN 1 (MAX2 1 0))
+ (EQN -1 (MAX2 -1 -2))
+)
+(!$TEST MIN
+ (EQN (MIN 1 2 3) 1)
+ (EQN (MIN 3 2 1) 1)
+ (EQN 0 (MIN 1 0))
+ (EQN 1 (MIN 1))
+)
+% What is (MIN) ;
+
+(!$TEST MIN2
+ (EQN (MIN2 1 2) 1)
+ (EQN (MIN2 2 1) 1)
+ (EQN 0 (MIN2 1 0))
+ (EQN 0 (MIN2 0 1))
+ (EQN -2 (MIN2 -1 -2))
+)
+(!$TEST MINUS
+ (EQN 0 (MINUS 0))
+ (EQN -1 (MINUS 1))
+ (MINUSP (MINUS 1))
+ (MINUSP -1)
+ (LESSP -1 0)
+ (EQN 1 (MINUS -1))
+)
+
+(!$TEST PLUS
+ (EQN 6 (PLUS 1 2 3))
+ (EQN 10 (PLUS 1 2 3 4))
+ (EQN 0 (PLUS 1 2 3 -6))
+ (EQN 3 (PLUS 1 2))
+ (EQN 1 (PLUS 1))
+)
+% What is (PLUS) ;
+
+(!$TEST PLUS2
+ (EQN 3 (PLUS2 1 2))
+ (EQN 0 (PLUS2 1 -1))
+ (EQN 1 (PLUS2 -2 3))
+)
+
+(!$TEST QUOTIENT
+ (EQN 1 (QUOTIENT 3 3))
+ (EQN 1 (QUOTIENT 4 3))
+ (EQN 1 (QUOTIENT 5 3))
+ (EQN 2 (QUOTIENT 6 3))
+ (EQN -1 (QUOTIENT -3 3))
+ (EQN -1 (QUOTIENT 3 -3))
+ (EQN -1 (QUOTIENT 4 -3))
+ (EQN -1 (QUOTIENT -4 3))
+)
+
+% Expect 2 ZERO DIVISOR error messages%
+(QUOTIENT 1 0)
+(QUOTIENT 0 0)
+
+(!$TEST REMAINDER
+ (EQN 0 (REMAINDER 3 3))
+ (EQN 1 (REMAINDER 4 3))
+ (EQN 2 (REMAINDER 5 3))
+ (EQN 0 (REMAINDER 6 3))
+ (EQN 0 (REMAINDER -3 3))
+ (EQN 0 (REMAINDER 3 -3))
+ (EQN -1 (REMAINDER 4 -3))
+ (EQN -1 (REMAINDER -4 3))
+)
+
+% Expect 2 ZERO DIVISOR error messages%
+%(REMAINDER 1 0)
+%(REMAINDER 0 0)
+
+(!$TEST SUB1
+ (EQN 1 (SUB1 2))
+ (EQN 0 (SUB1 1))
+ (EQN -1 (SUB1 0))
+)
+
+(!$TEST TIMES
+ (EQN 6 (TIMES 1 2 3))
+ (EQN 1 (TIMES 1))
+ (EQN 2 (TIMES 1 2))
+)
+% What is (TIMES) ;
+
+(!$TEST TIMES2
+ (EQN 0 (TIMES2 1 0))
+ (EQN 0 (TIMES2 0 1))
+ (EQN 10 (TIMES2 5 2))
+ (EQN -10 (TIMES2 5 -2))
+)
+
+% -----3.12 MAP composite functions ------%
+
+(SETQ LST (QUOTE (1 2 3)))
+(DE LISTX (X) (LIST X (QUOTE X)))
+(DE PRNTX (X) (PRINT (LISTX X)))
+
+% MAP: Expect 3 lines of output, equivalent to:%
+% ((1 2 3) X)%
+% ((2 3) X)%
+% ((3) X)%
+(!$TEST MAP (NULL (MAP LST (FUNCTION PRNTX))))
+
+% MAPC: Expect 3 lines of output, equivalent to:%
+% (1 X)%
+% (2 X)%
+% (3 X)%
+(!$TEST MAPC (NULL (MAPC LST (FUNCTION PRNTX))))
+
+% MAPCAN: Expect 3 lines of output, equivalent to:%
+% (1 X)%
+% (2 X)%
+% (3 X)%
+(!$TEST MAPCAN
+ (EQUAL (MAPCAN LST (FUNCTION PRNTX))
+ (QUOTE (1 X 2 X 3 X)))
+)
+
+% MAPCAR: Expect 3 Lines of output, equivalent to:%
+% (1 X)%
+% (2 X)%
+% (3 X)%
+(!$TEST MAPCAR
+ (EQUAL (MAPCAR LST (FUNCTION PRNTX))
+ (QUOTE ((1 X) (2 X) (3 X))))
+)
+
+% MAPCON: Expect 3 lines of output, equivalent to:%
+% ((1 2 3) X)%
+% ((2 3) X)%
+% ((3) X)%
+(!$TEST MAPCON
+ (EQUAL (MAPCON LST (FUNCTION PRNTX))
+ (QUOTE ((1 2 3) X (2 3) X (3) X)))
+)
+
+% MAPLIST: Expect 3 lines of output, equivalent to:%
+% ((1 2 3) X)%
+% ((2 3) X)%
+% ((3) X)%
+
+(!$TEST MAPLIST
+ (EQUAL (MAPLIST LST (FUNCTION PRNTX))
+ (QUOTE (((1 2 3) X) ((2 3) X) ((3) X))))
+)
+
+% ----- 3 . 13 Composite Functions -----%
+(SETQ APPVAR1 (QUOTE (1 2 3)))
+
+(!$TEST APPEND
+ (NULL (APPEND NIL NIL))
+ (EQUAL APPVAR1 (SETQ APPVAR2 (APPEND APPVAR1 NIL)))
+ (NULL (EQ APPVAR1 APPVAR2))
+ (EQUAL APPVAR1 (SETQ APPVAR2 (APPEND NIL APPVAR1)))
+ (EQ APPVAR1 APPVAR2)
+ (EQUAL APPVAR1 (APPEND (QUOTE (1)) (QUOTE (2 3))))
+ (EQUAL APPVAR1 (APPEND (QUOTE (1 2)) (QUOTE (3))))
+)
+
+(SETQ ASSVAR
+ (QUOTE ( ((1 . 1) . ONE) ((2 . 2) . TWO) ((3 . 3) . THREE) ) ) )
+(!$TEST ASSOC
+ (NULL (ASSOC NIL NIL))
+ (NULL (ASSOC 1 NIL))
+ (NULL (ASSOC 1 ASSVAR))
+ (EQUAL (QUOTE ((1 . 1) . ONE)) (ASSOC (QUOTE (1 . 1)) ASSVAR))
+ (EQUAL (QUOTE ((2 . 2) . TWO)) (ASSOC (QUOTE (2 . 2)) ASSVAR))
+)
+% Expect Error MSG on poor ALIST%
+%(ASSOC (QUOTE (1)) (QUOTE (1 2 3)))
+
+(SETQ DLIST (QUOTE ((AA BB) (EE FF))))
+
+(!$TEST DEFLIST
+ (EQUAL (QUOTE (AA EE)) (DEFLIST DLIST (QUOTE DEFLIST)))
+ (EQ (QUOTE BB) (GET (QUOTE AA) (QUOTE DEFLIST)))
+ (EQ (QUOTE FF) (GET (QUOTE EE) (QUOTE DEFLIST)))
+)
+
+(!$TEST DELETE
+ (EQUAL (QUOTE ((1 . 1) (2 . 2)))
+ (DELETE (QUOTE (0 . 0)) (QUOTE ((0 . 0) (1 . 1) (2 . 2)))))
+ (EQUAL (QUOTE ((0 . 0) (2 . 2)))
+ (DELETE (QUOTE (1 . 1)) (QUOTE ((0 . 0) (1 . 1) (2 . 2)))))
+ (EQUAL (QUOTE ((0 . 0) (2 . 2) (1 . 1)))
+ (DELETE (QUOTE (1 . 1))
+ (QUOTE ((0 . 0) (1 . 1) (2 . 2) (1 . 1)))))
+)
+
+% remove the comments when digit and liter are added.
+
+%(SETQ DIGITLST (QUOTE (!0 !1 !2 !3 !4 !5 !6 !7 !8 !9)))
+
+%(DE TESTEACH (LST FN)
+% (PROG (X)
+% L1 (while t (progn
+% (COND ((NULL (PAIRP LST)) (RETURN T)))
+% (SETQ X (APPLY FN (LIST (CAR LST)))) % Not (FN (CAR LST)) ?
+% (COND ((NULL X)
+% (PRINT (LIST '!*!*!*! TESTEACH (CAR LST) 'failed))))
+% (SETQ LST (CDR LST))
+% (GO L1)))))
+%
+%(!$TEST DIGIT
+% (TESTEACH DIGITLST (FUNCTION DIGIT))
+% (NULL (DIGIT 1))
+% (NULL (DIGIT (QUOTE A)))
+% (NULL (DIGIT '1))
+%)
+
+(!$TEST LENGTH
+ (EQN 0 (LENGTH (QUOTE A)))
+ (EQN 0 (LENGTH 1))
+ (EQN 1 (LENGTH (QUOTE (A))))
+ (EQN 1 (LENGTH (QUOTE (A . B))))
+ (EQN 2 (LENGTH (QUOTE (A B))))
+)
+
+%(SETQ UPVAR
+% (QUOTE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z)))
+%(SETQ DNVAR
+% (QUOTE (a b c d e f g h i j k l m n o p q r s t u v w x y z)))
+%
+%(!$TEST LITER
+% (TESTEACH UPVAR (FUNCTION LITER))
+% (TESTEACH DNVAR (FUNCTION LITER))
+% (NULL (LITER 'A))
+% (NULL (LITER 1))
+% (NULL (LITER (QUOTE AA)))
+%)
+
+(SETQ MEMBVAR (QUOTE ((1 . 1) ( 2 . 2) (3 . 3))))
+
+(!$TEST MEMBER
+ (NULL (MEMBER NIL NIL))
+ (NULL (MEMBER NIL MEMBVAR))
+ (NULL (MEMBER (QUOTE (4 . 4)) MEMBVAR))
+ (EQ (CDR MEMBVAR) (MEMBER (QUOTE (2 . 2)) MEMBVAR))
+)
+
+(!$TEST MEMQ
+ (NULL (MEMQ NIL NIL))
+ (EQ MEMBVAR (MEMQ (CAR MEMBVAR) MEMBVAR))
+ (NULL (MEMQ (QUOTE (1 . 1)) MEMBVAR))
+ (EQ (CDR MEMBVAR) (MEMQ (CADR MEMBVAR) MEMBVAR))
+)
+
+
+(SETQ NCONCVAR1 (LIST 1 2 3))
+
+(!$TEST NCONC
+ (EQUAL (QUOTE ( 1 2 3 4 5))
+ (SETQ NCONCVAR2 (NCONC NCONCVAR1 (QUOTE ( 4 5)))))
+ (EQ NCONCVAR1 NCONCVAR2)
+ (EQUAL NCONCVAR1 (QUOTE (1 2 3 4 5)))
+)
+
+(!$TEST PAIR
+ (EQUAL NIL (PAIR NIL NIL))
+ (EQUAL (QUOTE ((1 . ONE) (2 . TWO)))
+ (PAIR (QUOTE (1 2)) (QUOTE (ONE TWO))))
+)
+
+% expect 2 PAIR mismatch errors%
+
+%(PAIR (QUOTE (1)) (QUOTE ( ONE TWO)))
+%(PAIR (QUOTE (1)) NIL)
+
+(!$TEST REVERSE
+ (NULL (REVERSE NIL))
+ (EQUAL (QUOTE (1)) (REVERSE (QUOTE (1))))
+ (EQUAL (QUOTE (1 2 3)) (REVERSE (QUOTE (3 2 1))))
+ (EQUAL (QUOTE ((1 . 2) (2 . 3) (3 4 5)))
+ (REVERSE (QUOTE ((3 4 5) (2 . 3) (1 . 2)))))
+)
+
+(DE SASSFN NIL
+ (PROG2 (PRINT 'Sassfn! Called) 99))
+
+(SETQ SASSVAR (QUOTE ((1 . ONE) (2 . TWO))))
+
+(!$TEST SASSOC
+ (EQN 99 (SASSOC NIL NIL (FUNCTION SASSFN)))
+ (EQN 99 (SASSOC NIL SASSVAR (FUNCTION SASSFN)))
+ (EQUAL (QUOTE (2 . TWO))
+ (SASSOC 2 SASSVAR (FUNCTION SASSFN)))
+)
+
+% Expect ERROR for poor alist:
+%(SASSOC (QUOTE A) (QUOTE (B (A . 1))) (FUNCTION SASSFN))
+
+% Set up SUBLIS values
+(SETQ SUBLVAR1 (QUOTE ((X . 1) ((X . X) . 2))))
+(SETQ SUBLVAR2 (QUOTE (X X (X . 1) (X . X) ((X . X)))))
+(SETQ SUBLVAR3 (QUOTE (1 1 (1 . 1) 2 (2))))
+
+%(!$TEST SUBLIS
+% (NULL (SUBLIS NIL NIL))
+% (EQN 1 (SUBLIS NIL 1))
+% (EQ SUBLVAR2 (SUBLIS NIL SUBLVAR2))
+% (EQUAL SUBLVAR2 (SUBLIS NIL SUBLVAR2))
+% (EQ SUBLVAR2 (SUBLIS (QUOTE ((Y . 3))) SUBLVAR2))
+%% Will fail, but nice opt if no action;
+% (EQUAL SUBLVAR2 (SUBLIS (QUOTE ((Y . 3))) SUBLVAR2))
+% (EQUAL SUBLVAR3 (SUBLIS SUBLVAR1 SUBLVAR2))
+%)
+%
+(!$TEST SUBST
+ (NULL (SUBST NIL 1 NIL))
+ (EQ (QUOTE A) (SUBST NIL 1 (QUOTE A)))
+ (EQN 1 (SUBST 1 2 2))
+ (EQUAL (CONS 2 2) (SUBST 2 1 (CONS 1 1)))
+ (EQUAL (QUOTE (1 1 (1 . 1) (1 . 1) ((1 . 1))))
+ (SUBST 1 (QUOTE X) SUBLVAR2))
+)
+% ----- 3.14 The Interpreter ----%
+
+% To be done ;
+
+% ----- 3.15 IO -----%
+% ----- 3.16 The Standard LISP Reader ----%
+% To be done ;
+
+% ----- 4.0 Globals ----%
+
+% To be done ;
+
+% ----- 5.0 Miscellaneous functions -----%
+
+% to be done ;
+
+(RDS NIL)
ADDED perq-pascal-lisp-project/pasn.pas
Index: perq-pascal-lisp-project/pasn.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pasn.pas
@@ -0,0 +1,45 @@
+(*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ %
+ % PASCAL BASED MINI-LISP
+ %
+ % File: PASN.RED - Trailer File
+ % ChangeDate: 12:26pm Saturday, 18 July 1981
+ % By: M. L. Griss
+ % Change to add Features for Schlumberger Demo
+ % Add Hooks for CATCH/THROW
+ %
+ % All RIGHTS RESERVED
+ % COPYRIGHT (C) - 1981 - M. L. GRISS
+ % Computer Science Department
+ % University of Utah
+ %
+ % Do Not distribute with out written consent of M. L. Griss
+ %
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)
+
+
+(* pasN.PAS ---- the last file to be appended, close CATCH, do init *)
+BEGIN (* Body of Catch *)
+IF initphase=0 THEN (* Kludge to get into scope of CATCH *)
+ BEGIN init; initphase := 1; firstp; END
+ELSE BEGIN
+ idspace[xthrowing].val := nilref;
+ catch_stk:=st; (* Capture Stack *)
+ catch_bstk:=idspace[xbstack].val; (* Capture Bstack *)
+ xeval;
+9999: (* Return Point *)
+ IF idspace[xthrowing].val <> nilref
+ THEN BEGIN
+ st:=catch_stk;
+ r[2]:=catch_bstk;
+ xunbindto; (* return value, old stack *)
+ END;
+ END
+END (* catch *);
+
+BEGIN (* Top Level *)
+ initphase := 0;
+ r[1] := 0;
+ Xcatch;
+ writeln(tty,'halt');break(tty);
+end.
ADDED perq-pascal-lisp-project/pasn.perq
Index: perq-pascal-lisp-project/pasn.perq
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pasn.perq
@@ -0,0 +1,47 @@
+(*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ %
+ % PASCAL BASED MINI-LISP
+ %
+ % File: PASN.RED - Trailer File
+ % ChangeDate: 5:39am Saturday, 26 September 1981
+ % By: M. L. Griss
+ % Add Hooks for CATCH/THROW
+ %
+ % All RIGHTS RESERVED
+ % COPYRIGHT (C) - 1981 - M. L. GRISS
+ % Computer Science Department
+ % University of Utah
+ %
+ % Do Not distribute with out written consent of M. L. Griss
+ %
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)
+
+
+(* pasN.PAS ---- the last file to be appended, close CATCH, do init *)
+BEGIN (* Body of Catch *)
+IF initphase=0 THEN (* Kludge to get into scope of CATCH *)
+ BEGIN init; initphase := 1; firstp; END
+ELSE BEGIN
+ initphase := initphase + 1;
+ idspace[xthrowing].val := nilref;
+ catch_stk:=st; (* Capture Stack *)
+ catch_bstk:=idspace[xbstack].val; (* Capture Bstack *)
+ xeval;
+ initphase := initphase - 1;
+ (* Return Point *)
+ IF idspace[xthrowing].val <> nilref
+ THEN BEGIN
+ st:=catch_stk;
+ r[2]:=catch_bstk;
+ xunbindto; (* return value, old stack *)
+ END;
+ END
+END (* catch *);
+
+BEGIN (* Top Level *)
+ initphase := 0;
+ r[1] := nilref;
+ Xcatch;
+ writeln('halt after top catch');
+ exit(pas0);
+end.
ADDED perq-pascal-lisp-project/pasn.pre
Index: perq-pascal-lisp-project/pasn.pre
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pasn.pre
@@ -0,0 +1,48 @@
+#adptwv (* Pre-process with filter *)
+(*
+
+ PASCAL BASED MINI-LISP
+
+ File: PASN.RED - Trailer File
+ ChangeDate: 5:39am Saturday, 26 September 1981
+ By: M. L. Griss
+ Add Hooks for CATCH/THROW
+
+ All RIGHTS RESERVED
+ COPYRIGHT (C) - 1981 - M. L. GRISS
+ Computer Science Department
+ University of Utah
+
+ Do Not distribute with out written consent of M. L. Griss
+
+*)
+
+
+(* pasN.PAS ---- the last file to be appended, close CATCH, do init *)
+BEGIN (* Body of Catch *)
+IF initphase=0 THEN (* Kludge to get into scope of CATCH *)
+ BEGIN init; initphase := 1; firstp; END
+ELSE BEGIN
+#p initphase:=initphase+1; (* ??? *)
+ idspace[xthrowing].val := nilref;
+ catch_stk:=st; (* Capture Stack *)
+ catch_bstk:=idspace[xbstack].val; (* Capture Bstack *)
+ xeval;
+#p initphase:=initphase-1; (* ??? *)
+ (* Return Point *)
+#adv 9999:
+ IF idspace[xthrowing].val <> nilref
+ THEN BEGIN
+ st:=catch_stk;
+ r[2]:=catch_bstk;
+ xunbindto; (* return value, old stack *)
+ END;
+ END
+END (* catch *);
+
+BEGIN (* Top Level *)
+ initphase := 0;
+ r[1] := nilref;
+ Xcatch;
+#d break(tty);
+end.
ADDED perq-pascal-lisp-project/pl20.prc
Index: perq-pascal-lisp-project/pl20.prc
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/pl20.prc
@@ -0,0 +1,258 @@
+PASCAL/UTAH FROM 31-MAR-79 PROC/FUNC LINE NUMBER REPORT OF PL20 .PAS ON 14-MAR-82 AT 16:45:36
+
+PROC/FUNC HEAD BEGIN END
+
+ XTHROW 236 237 240
+ TAG_OF 250 252 254
+ INFO_OF 257 259 264
+ XNULL 267 268 271
+ MARK 288 289 297
+ GC_INT 283 299 321
+ MKFIXINT 280 323 343
+ MKITEM 274 347 363
+ MKERR 366 367 369
+ SET_INFO 372 373 375
+ SET_TAG 378 379 381
+ MKIDENT 384 386 388
+ MKINT 391 392 394
+ MKPAIR 397 398 400
+ INT_VAL 403 408 415
+ ALLOC 425 426 436
+ DEALLOC 438 439 444
+ ALLOC1 448 449 449
+ DEALLOC1 451 452 452
+ ALLOC2 454 455 455
+ DEALLOC2 457 458 458
+ ALLOC3 460 461 461
+ DEALLOC3 463 464 464
+ LOAD 473 474 478
+ STORE 480 481 483
+ LOAD10 486 487 489
+ STORE10 491 492 494
+ STORENIL 496 497 499
+ NMHASH 508 513 522
+ EQSTR 524 525 532
+ NMLOOKUP 534 540 567
+ PUTNM 569 575 587
+ XFASTSTAT 596 598 607
+ PUSHREF 620 622 639
+ MARK 641 646 655
+ XGCOLLECT 610 657 709
+ XCONS 719 722 739
+ XNCONS 741 742 744
+ XXCONS 746 747 751
+ XCAR 763 764 769
+ XCDR 771 772 777
+ XRPLACA 779 780 785
+ XRPLACD 787 788 793
+ ANYCAR 796 797 802
+ ANYCDR 804 805 810
+ IS_INT 825 828 844
+ COMPRESS 819 846 884
+ ID_EXPLODE 888 889 898
+ INT_EXPLOD 900 903 926
+ EXPLODE 886 928 939
+ KICK 944 945 953
+ GENSYM 941 955 970
+ XOPEN 979 985 1023
+ XCLOSE 1025 1026 1034
+ XRDS 1036 1039 1043
+ XWRS 1045 1048 1052
+ XTERPRI 1054 1055 1060
+ INT_FIELD 1062 1065 1075
+ XWRITEINT 1077 1078 1083
+ XWRITECHAR 1085 1086 1091
+ XWRTOK 1093 1096 1142
+ RDCHNL 1145 1146 1171
+ EOFCHNL 1174 1175 1181
+ DIGIT 1201 1202 1204
+ ESCALPHA 1207 1210 1228
+ ALPHANUM 1230 1233 1238
+ WHITESP 1240 1241 1245
+ XRDTOK 1190 1247 1351
+ INIT1 1372 1373 1455
+ INIT2 1458 1459 1505
+ INIT 1360 1528 1531
+ XADD1 1540 1543 1546
+ XDIFFERENC 1548 1551 1555
+ XDIVIDE 1557 1561 1569
+ XGREATERP 1571 1574 1582
+ XLESSP 1584 1587 1595
+ XMINUS 1597 1600 1603
+ XPLUS2 1605 1608 1612
+ XQUOTIENT 1614 1617 1622
+ XREMAINDER 1624 1627 1632
+ XTIMES2 1634 1637 1641
+ XXAPPLY 1656 1662 1682
+ PAS11 1698 1699 1708
+ PAS12 1711 1712 1721
+ PAS13 1724 1725 1734
+ PAS14 1737 1738 1747
+ PAS15 1750 1751 1762
+ PAS16 1765 1766 1777
+ PAS17 1780 1781 1792
+ PAS18 1795 1796 1807
+ PAS19 1810 1811 1822
+ PAS110 1825 1826 1837
+ PAS111 1840 1841 1852
+ PAS112 1855 1856 1867
+ PAS113 1870 1871 1882
+ PAS114 1885 1886 1897
+ PAS115 1900 1901 1912
+ PAS116 1915 1916 1927
+ PAS117 1930 1931 1942
+ PAS118 1945 1946 1957
+ PAS119 1960 1961 1972
+ PAS120 1975 1976 1987
+ PAS121 1990 1991 2001
+ PAS122 2004 2005 2015
+ PAS123 2018 2019 2029
+ PAS124 2032 2033 2043
+ PAS125 2046 2047 2057
+ PAS126 2060 2061 2071
+ PAS127 2074 2075 2085
+ PAS128 2088 2089 2099
+ PAS129 2104 2110 2170
+ PAS130 2173 2178 2222
+ PAS131 2225 2226 2236
+ PAS132 2239 2243 2266
+ XREAD 2271 2278 2351
+ PAS133 2354 2363 2465
+ PAS21 2478 2482 2498
+ PAS23 2503 2504 2512
+ XCODEP 2515 2519 2535
+ PAS26 2542 2545 2565
+ PAS27 2568 2569 2575
+ PAS28 2578 2579 2595
+ PAS29 2598 2599 2619
+ PAS210 2622 2623 2647
+ PAS211 2650 2651 2679
+ PAS212 2682 2683 2689
+ PAS213 2692 2696 2730
+ PAS214 2735 2740 2773
+ PAS216 2780 2786 2842
+ PAS218 2849 2854 2900
+ PAS220 2907 2912 2968
+ PAS221 2973 2978 3032
+ PAS222 3037 3042 3065
+ PAS223 3070 3076 3120
+ PAS219 3123 3129 3185
+ PAS225 3192 3196 3242
+ PAS227 3249 3254 3296
+ PAS228 3301 3306 3341
+ PAS229 3346 3352 3400
+ PAS230 3403 3407 3437
+ PAS224 3440 3446 3514
+ PAS231 3517 3518 3526
+ PAS232 3531 3535 3555
+ PAS233 3558 3559 3575
+ PAS234 3578 3579 3595
+ PAS235 3598 3601 3627
+ PAS237 3634 3638 3668
+ PAS236 3671 3676 3722
+ PAS239 3729 3733 3763
+ PAS238 3766 3770 3816
+ PAS22 3819 3823 3839
+ PAS240 3842 3846 3866
+ PAS25 3869 3870 3878
+ PAS241 3881 3882 3888
+ PAS242 3891 3892 3898
+ PAS243 3901 3902 3908
+ PAS244 3911 3912 3918
+ PAS245 3921 3922 3928
+ PAS246 3931 3932 3938
+ PAS247 3941 3942 3966
+ PAS248 3969 3972 3988
+ PAS226 3991 3997 4043
+ PAS215 4046 4047 4077
+ PAS249 4080 4085 4133
+ PAS251 4138 4139 4145
+ PAS253 4150 4154 4178
+ PAS254 4181 4182 4190
+ PAS255 4193 4194 4202
+ PAS256 4205 4206 4214
+ PAS24 4217 4221 4237
+ PAS257 4242 4247 4296
+ PAS258 4299 4300 4304
+ PAS259 4307 4308 4312
+ PAS261 4317 4318 4328
+ PAS262 4331 4332 4342
+ PAS263 4345 4346 4356
+ PAS264 4359 4360 4370
+ PAS265 4373 4377 4401
+ PAS266 4404 4408 4432
+ PAS267 4435 4436 4442
+ PAS260 4445 4449 4481
+ PAS250 4484 4488 4505
+ PAS268 4508 4512 4528
+ PAS252 4531 4535 4558
+ PAS269 4561 4566 4606
+ PAS270 4609 4610 4616
+ PAS271 4619 4620 4626
+ XPRINT 4629 4630 4644
+ PAS272 4647 4648 4662
+ PAS273 4665 4666 4694
+ PAS274 4697 4698 4724
+ PAS275 4727 4730 4766
+ PAS276 4769 4773 4803
+ XUNBINDTO 4806 4810 4838
+ PAS279 4845 4849 4898
+ PAS277 4903 4908 4948
+ PAS280 4951 4955 4981
+ PAS31 4994 4999 5043
+ PAS32 5046 5047 5065
+ PAS33 5068 5073 5125
+ PAS34 5128 5136 5253
+ PAS35 5256 5259 5289
+ PAS36 5294 5298 5332
+ PAS37 5335 5336 5358
+ PAS38 5361 5362 5384
+ PAS39 5387 5388 5410
+ PAS310 5413 5414 5436
+ XEVAL 5443 5457 5606
+ PAS312 5609 5610 5628
+ PAS217 5631 5635 5659
+ PAS311 5662 5666 5698
+ PAS313 5701 5702 5708
+ PAS314 5711 5712 5718
+ PAS278 5721 5725 5753
+ PAS315 5756 5757 5771
+ PAS316 5774 5779 5853
+ PAS317 5856 5860 5888
+ PAS319 5893 5899 6021
+ PAS320 6024 6029 6063
+ PAS321 6066 6071 6115
+ PAS322 6118 6126 6194
+ PAS323 6197 6202 6236
+ PAS318 6239 6243 6271
+ PAS324 6274 6278 6306
+ PAS325 6313 6317 6357
+ PAS327 6362 6366 6404
+ PAS328 6409 6413 6453
+ PAS329 6458 6462 6500
+ PAS326 6503 6509 6551
+ PAS330 6554 6555 6561
+ PAS331 6564 6565 6569
+ PAS332 6574 6578 6608
+ PAS333 6611 6612 6618
+ PAS334 6621 6622 6628
+ PAS335 6631 6632 6638
+ PAS336 6641 6642 6648
+ PAS337 6651 6652 6656
+ PAS338 6659 6660 6666
+ PAS339 6669 6673 6697
+ PAS340 6700 6701 6709
+ PAS341 6712 6713 6719
+ PAS342 6722 6723 6729
+ PAS343 6732 6733 6739
+ PAS344 6742 6743 6749
+ PAS345 6752 6753 6759
+ PAS346 6762 6763 6769
+ PAS347 6772 6773 6779
+ PAS348 6782 6783 6789
+ PAS349 6792 6796 6818
+ PAS350 6821 6824 6860
+ FIRSTP 6863 6871 7007
+ EXECUTE 7008 7009 7417
+ XCATCH 219 7439 7456
+PAS0 31 7458 7463
ADDED perq-pascal-lisp-project/poltok.red
Index: perq-pascal-lisp-project/poltok.red
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/poltok.red
@@ -0,0 +1,144 @@
+LISP$
+% Simple TOKEN scanner to Debug POLY. RED;
+% Griss and Morrison
+
+GLOBAL '(CURCHARTYPE!* CURCHAR!* TOK!*);
+
+SYMBOLIC PROCEDURE CLEARTOKEN; %. Clear token scanner
+ <<CURCHARTYPE!* := 'WHITE; CURCHAR!* := '! >>;
+
+SYMBOLIC PROCEDURE NTOKEN; %. get next token
+BEGIN SCALAR TOK;
+ WHILE CURCHARTYPE!* MEMQ '(WHITE COMMENT) DO
+ IF CURCHARTYPE!* EQ 'WHITE THEN
+ READCHAR()
+ ELSE << % Skip the comment
+ REPEAT
+ READCHAR()
+ UNTIL CURCHAR!* MEMQ COMMENTEND!*;
+ READCHAR() >>;
+ IF CURCHARTYPE!* EQ 'DIGIT THEN <<
+ WHILE CURCHARTYPE!* EQ 'DIGIT DO <<
+ TOK := CURCHAR!* . TOK;
+ READCHAR() >>;
+ TOK!* := COMPRESS REVERSIP TOK >>
+ ELSE IF CURCHARTYPE!* MEMQ '(LETTER ESCAPE) THEN <<
+ WHILE CURCHARTYPE!* MEMQ '(LETTER ESCAPE) DO <<
+ IF CURCHARTYPE!* EQ 'ESCAPE THEN <<
+ TOK := '!! . TOK;
+ READCHAR() >>;
+ TOK := CURCHAR!* . TOK;
+ READCHAR() >>;
+ TOK!* := INTERN COMPRESS REVERSIP TOK >>
+ ELSE IF CURCHARTYPE!* EQ 'DELIMITER THEN <<
+ TOK!* := CURCHAR!*;
+ READCHAR();TOK!* >>
+ ELSE IF CURCHARTYPE!* EQ 'TERMINATOR THEN <<
+ TOK!* := CURCHAR!*; CLEARTOKEN(); TOK!*>>
+ ELSE
+ ERROR(1010,
+ LIST( "Illegal character `",COMPRESS LIST('!!,CURCHAR!*),
+ "' in input stream -- NTOKEN") );
+END NTOKEN;
+
+SYMBOLIC PROCEDURE READCHAR; %. Get next char and classify
+<< CURCHAR!* := READCH();
+ CURCHARTYPE!* := GET(CURCHAR!*,'CHARACTERTYPE) >>;
+
+SYMBOLIC PROCEDURE INITTOKEN; %. Initialise TOKEN scan
+ BEGIN
+DEFLIST('(
+ (A LETTER)
+ (B LETTER)
+ (C LETTER)
+ (D LETTER)
+ (E LETTER)
+ (F LETTER)
+ (G LETTER)
+ (H LETTER)
+ (I LETTER)
+ (J LETTER)
+ (K LETTER)
+ (L LETTER)
+ (M LETTER)
+ (N LETTER)
+ (O LETTER)
+ (P LETTER)
+ (Q LETTER)
+ (R LETTER)
+ (S LETTER)
+ (T LETTER)
+ (U LETTER)
+ (V LETTER)
+ (W LETTER)
+ (X LETTER)
+ (Y LETTER)
+ (Z LETTER)
+ (a LETTER)
+ (b LETTER)
+ (c LETTER)
+ (d LETTER)
+ (e LETTER)
+ (f LETTER)
+ (g LETTER)
+ (h LETTER)
+ (i LETTER)
+ (j LETTER)
+ (k LETTER)
+ (l LETTER)
+ (m LETTER)
+ (n LETTER)
+ (o LETTER)
+ (p LETTER)
+ (q LETTER)
+ (r LETTER)
+ (s LETTER)
+ (t LETTER)
+ (u LETTER)
+ (v LETTER)
+ (w LETTER)
+ (x LETTER)
+ (y LETTER)
+ (z LETTER)
+ (!_ LETTER)
+ (!. LETTER)
+ (!0 DIGIT)
+ (!1 DIGIT)
+ (!2 DIGIT)
+ (!3 DIGIT)
+ (!4 DIGIT)
+ (!5 DIGIT)
+ (!6 DIGIT)
+ (!7 DIGIT)
+ (!8 DIGIT)
+ (!9 DIGIT)
+ (!+ DELIMITER)
+ (!- DELIMITER)
+ (!* DELIMITER)
+ (!/ DELIMITER)
+ (!^ DELIMITER)
+ (!' DELIMITER)
+ (!( DELIMITER)
+ (!) DELIMITER)
+ (!, DELIMITER)
+ (!; TERMINATOR)
+ (!! ESCAPE)
+ (! WHITE) % Blank
+ (! WHITE) % Tab
+ (!
WHITE) % Carriage Return
+ (!
+ WHITE) % Line Feed
+ (! WHITE) % Form Feed
+ (!% COMMENT)
+ ), 'CHARACTERTYPE);
+ PUT(!$EOL!$,'CHARACTERTYPE,'WHITE);
+ COMMENTEND!* := LIST !$EOL!$;
+ CLEARTOKEN();
+END;
+
+INITTOKEN();
+
+SYMBOLIC PROCEDURE XAPPLY(FN,ARGS); %. Interface for PLISP
+ APPLY(FN,ARGS)$
+
+END$
ADDED perq-pascal-lisp-project/poly.ini
Index: perq-pascal-lisp-project/poly.ini
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/poly.ini
cannot compute difference between binary files
ADDED perq-pascal-lisp-project/poly.red
Index: perq-pascal-lisp-project/poly.red
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/poly.red
@@ -0,0 +1,664 @@
+OFF ECHO,RAISE$
+LISP;
+
+% Simple POLY, RAT AND ALG system, based on POLY by Fitch and Marti.
+% Modifed by GRISS and GALWAY
+% September 1980.
+% Further modified by MORRISON
+% October 1980.
+% Parser modified by OTTENHEIMER
+% February 1981, to be left associative March 1981.
+% Current bug: print routines print as if right associative.
+% MORRISON again, March 1981.
+% Parses INFIX expressions to PREFIX, then SIMPlifies and PRINTs
+% Handles also PREFIX expressions
+
+% RUNNING: After loading POLY.RED, run function ALGG();
+% This accepts a sequence of expressions:
+% <exp> ; (Semicolon terminator)
+% <exp> ::= <term> [+ <exp> | - <exp>]
+% <term> ::= <primary> [* <term> | / <term>]
+% <primary> ::= <primary0> [^ <primary0> | ' <primary0> ]
+% ^ is exponentiation, ' is derivative
+% <primary0> ::= <number> | <variable> | ( <exp> )
+
+% PREFIX Format: <number> | <id> | (op arg1 arg2)
+% + -> PLUS2
+% - -> DIFFERENCE (or MINUS)
+% * -> TIMES2
+% / -> QUOTIENT
+% ^ -> EXPT
+% ' -> DIFF
+
+% Canonical Formats: Polynomial: integer | (term . polynomial)
+% term : (power . polynomial)
+% power : (variable . integer)
+% Rational : (polynomial . polynomial)
+
+ %******************** Selectors and Constructors **********************
+
+SYMBOLIC SMACRO PROCEDURE RATNUM X; % parts of Rational
+ CAR X;
+
+SYMBOLIC SMACRO PROCEDURE RATDEN X;
+ CDR X;
+
+SYMBOLIC SMACRO PROCEDURE MKRAT(X,Y);
+ CONS(X,Y);
+
+SYMBOLIC SMACRO PROCEDURE POLTRM X; % parts of Poly
+ CAR X;
+
+SYMBOLIC SMACRO PROCEDURE POLRED X;
+ CDR X;
+
+SYMBOLIC SMACRO PROCEDURE MKPOLY(X,Y);
+ CONS(X,Y);
+
+SYMBOLIC SMACRO PROCEDURE TRMPWR X; % parts of TERM
+ CAR X;
+
+SYMBOLIC SMACRO PROCEDURE TRMCOEF X;
+ CDR X;
+
+SYMBOLIC SMACRO PROCEDURE MKTERM(X,Y);
+ CONS(X,Y);
+
+SYMBOLIC SMACRO PROCEDURE PWRVAR X; % parts of Poly
+ CAR X;
+
+SYMBOLIC SMACRO PROCEDURE PWREXPT X;
+ CDR X;
+
+SYMBOLIC SMACRO PROCEDURE MKPWR(X,Y);
+ CONS(X,Y);
+
+SYMBOLIC SMACRO PROCEDURE POLVAR X;
+ PWRVAR TRMPWR POLTRM X;
+
+SYMBOLIC SMACRO PROCEDURE POLEXPT X;
+ PWREXPT TRMPWR POLTRM X;
+
+SYMBOLIC SMACRO PROCEDURE POLCOEF X;
+ TRMCOEF POLTRM X;
+
+ %*********************** Utility Routines *****************************
+
+SYMBOLIC PROCEDURE VARP X;
+ IDP X OR (PAIRP X AND IDP CAR X);
+
+
+ %*********************** Entry Point **********************************
+
+GLOBAL '(!*RBACKTRACE !*RECHO REXPRESSION!* !*RMESSAGE);
+
+!*RECHO := !*RMESSAGE := T;
+
+SYMBOLIC PROCEDURE ALGG(); %. Main LOOP, end with QUIT OR Q
+BEGIN SCALAR VVV;
+ ALGINIT();
+ CLEARTOKEN(); % Initialize scanner
+LOOP: VVV := ERRORSET('(RPARSE),T,!*RBACKTRACE);
+ IF ATOM VVV THEN % What about resetting the Scanner?
+ <<PRINT LIST('ALGG, 'error, VVV); CLEARTOKEN();GO TO LOOP>>;
+ REXPRESSION!* := CAR VVV;
+ IF !*RECHO THEN PRINT REXPRESSION!*;
+ IF REXPRESSION!* EQ 'QUIT THEN <<
+ PRINT 'QUITTING;
+ RETURN >>;
+ ERRORSET('(PREPRINT (PRESIMP REXPRESSION!*)),T,!*RBACKTRACE);
+ GO TO LOOP
+END ALGG;
+
+SYMBOLIC PROCEDURE ALGINIT(); %. Called to INIT tables
+ BEGIN
+ INITTOKEN();
+ PUT('TIMES2,'RSIMP,'R!*); %. Simplifier Tables
+ PUT('PLUS2,'RSIMP,'R!+);
+ PUT('DIFFERENCE,'RSIMP,'R!-);
+ PUT('QUOTIENT,'RSIMP,'R!/);
+ PUT('EXPT,'RSIMP,'R!^);
+ PUT('DIFF,'RSIMP,'R!');
+ PUT('MINUS,'RSIMP,'R!.NEG);
+ PUT('!+,'REXP,'PLUS2); % Use corresponding 'R!xx in EVAL mode
+ PUT('!-,'REXP,'DIFFERENCE);
+ PUT('!*,'RTERM,'TIMES2);;
+ PUT('!/,'RTERM,'QUOTIENT);
+ PUT('!^,'RPRIMARY,'EXPT);
+ PUT('!','RPRIMARY,'DIFF);
+ PUT('PLUS2,'PRINOP,'PLUSPRIN); %. Output funs
+ PUT('DIFFERENCE,'PRINOP,'DIFFERENCEPRIN);
+ PUT('TIMES2,'PRINOP,'TIMESPRIN);
+ PUT('QUOTIENT,'PRINOP,'QUOTPRIN);
+ PUT('EXPT,'PRINOP,'EXPPRIN);
+ END;
+
+SYMBOLIC PROCEDURE RSIMP X; %. Simplify Prefix Form to Canonical
+ IF ATOM X THEN RCREATE X
+ ELSE BEGIN SCALAR Y,OP;
+ OP:=CAR X;
+ IF (Y:=GET(OP,'RSIMP)) THEN RETURN XAPPLY(Y,RSIMPL CDR X);
+ Y:=PRESIMP X; % As "variable" ?
+ IF ATOM Y OR NOT(X=Y) THEN RETURN RSIMP Y;
+ RETURN RCREATE Y;
+ END;
+
+SYMBOLIC PROCEDURE RSIMPL X; %. Simplify argument list
+ IF NULL X THEN NIL ELSE RSIMP(CAR X) . RSIMPL CDR X;
+
+SYMBOLIC PROCEDURE PRESIMP X; %. Simplify Prefix Form to PREFIX
+ IF ATOM X THEN X
+ ELSE BEGIN SCALAR Y,OP;
+ OP:=CAR X;
+ IF (Y:=GET(OP,'RSIMP)) THEN RETURN RAT2PRE XAPPLY(Y,RSIMPL CDR X);
+ X:=PRESIMPL CDR X;
+ IF (Y:=GET(OP,'PRESIMP)) THEN RETURN XAPPLY(Y,X);
+ RETURN (OP . X);
+ END;
+
+SYMBOLIC PROCEDURE PRESIMPL X; %. Simplify argument list
+ IF NULL X THEN NIL ELSE PRESIMP(CAR X) . PRESIMPL CDR X;
+
+ %**************** Simplification Routines for Rationals ***************
+
+SYMBOLIC PROCEDURE R!+(A,B); %. RAT addition
+ IF RATDEN A = RATNUM B THEN
+ MAKERAT(P!+(RATNUM A,RATNUM B),CDR A)
+ ELSE
+ MAKERAT(P!+(P!*(RATNUM A,RATDEN B),
+ P!*(RATDEN A,RATNUM B)),
+ P!*(RATDEN A,RATDEN B));
+
+SYMBOLIC PROCEDURE R!-(A,B); %. RAT subtraction
+ R!+(A,R!.NEG B);
+
+SYMBOLIC PROCEDURE R!.NEG A; %. RAT negation
+ MKRAT(P!.NEG RATNUM A,RATDEN A);
+
+SYMBOLIC PROCEDURE R!*(A,B); %. RAT multiplication
+ BEGIN SCALAR X,Y;
+ X:=MAKERAT(RATNUM A,RATDEN B);
+ Y:=MAKERAT(RATNUM B,RATDEN A);
+ IF RATNUM X=0 OR RATNUM Y=0 THEN RETURN 0 . 1;
+ RETURN MKRAT(P!*(RATNUM X,RATNUM Y),
+ P!*(RATDEN X,RATDEN Y))
+END;
+
+SYMBOLIC PROCEDURE R!.RECIP A; %. RAT inverse
+ IF RATNUM A=0 THEN ERROR(777,'(ZERO DIVISOR))
+ ELSE MKRAT(RATDEN A,RATNUM A);
+
+SYMBOLIC PROCEDURE R!/(A,B); %. RAT division
+ R!*(A,R!.RECIP B);
+
+SYMBOLIC PROCEDURE R!.LVAR A; %. Leading VARIABLE of RATIONAL
+ BEGIN SCALAR P;
+ P:=RATNUM A;
+ IF NUMBERP P THEN RETURN ERROR(99,'(non structured polynomial));
+ P:=POLVAR P;
+ RETURN P;
+ END;
+
+SYMBOLIC PROCEDURE R!'(A,X); %. RAT derivative
+ <<X:=R!.LVAR X;
+ IF RATDEN A=1 THEN MKRAT(PDIFF(RATNUM A,X),1)
+ ELSE R!-(MAKERAT(PDIFF(RATNUM A,X),RATDEN A),
+ MAKERAT(P!*(RATNUM A,PDIFF(RATDEN A,X)),
+ P!*(RATDEN A,RATDEN A) ) ) >>;
+
+SYMBOLIC PROCEDURE RCREATE X; %. RAT create
+ IF NUMBERP X THEN X . 1
+ ELSE IF VARP X THEN (PCREATE X) . 1
+ ELSE ERROR(100,LIST(X, '(non kernel)));
+
+SYMBOLIC PROCEDURE MAKERAT(A,B);
+IF A=B THEN MKRAT(1,1)
+ ELSE IF A=0 THEN 0 . 1
+ ELSE IF B=0 THEN ERROR(777,'(ZERO DIVISOR))
+ ELSE IF NUMBERP A AND NUMBERP B THEN
+ BEGIN SCALAR GG;
+ GG:=NUMGCD(A,B);
+ IF B<0 THEN <<B:=-B; A := -A>>;
+ RETURN MKRAT(A/GG,B/GG)
+ END
+ ELSE BEGIN SCALAR GG,NN;
+ GG:=PGCD(A,B);
+ IF GG=1 THEN RETURN MKRAT(A,B);
+ NN:=GG;
+LL: IF NUMBERP NN THEN NN:=GCDPT(GG,NN)
+ ELSE << NN:=POLCOEF GG; GOTO LL >>;
+ GG:=CAR PDIVIDE(GG,NN);
+ RETURN MKRAT(DIVIDEOUT(A,GG),DIVIDEOUT(B,GG))
+END;
+
+SYMBOLIC PROCEDURE R!^(A,N); %. RAT Expt
+ BEGIN SCALAR AA;
+ N:=RATNUM N;
+ IF NOT NUMBERP N THEN RETURN ERROR(777,'(Non numeric exponent))
+ ELSE IF N=0 THEN RETURN RCREATE 1;
+ IF N<0 THEN <<A:=R!.RECIP A; N:=-N>>;
+ AA:=1 . 1;
+ FOR I:=1:N DO AA:=R!*(AA,A);
+ RETURN AA
+ END;
+
+ %**************** Simplification Routines for Polynomials *************
+
+SYMBOLIC PROCEDURE P1!+(A, B); % Fix for UCSD pascal to cut down proc size
+ BEGIN SCALAR AA,BB;
+ AA:=P!+(POLCOEF A,POLCOEF B);
+ IF AA=0 THEN RETURN P!+(POLRED A,POLRED B);
+ AA:=MKPOLY(TRMPWR POLTRM A,AA);
+ AA:=ZCONS AA; BB:=P!+(POLRED A,POLRED B);
+ RETURN P!+(AA,BB)
+ END P1!+;
+
+SYMBOLIC PROCEDURE P!+(A,B); %. POL addition
+ IF A=0 THEN B ELSE IF B=0 THEN A ELSE
+ IF NUMBERP A AND NUMBERP B THEN PLUS2(A,B)
+ ELSE IF NUMBERP A THEN MKPOLY(POLTRM B,P!+(A,POLRED B))
+ ELSE IF NUMBERP B THEN MKPOLY(POLTRM A,P!+(B,POLRED A))
+ ELSE BEGIN SCALAR ORD;
+ ORD:=PORDERP(POLVAR A,POLVAR B);
+ IF ORD=1 THEN RETURN MKPOLY(POLTRM A,P!+(POLRED A,B));
+ IF ORD=-1 THEN RETURN MKPOLY(POLTRM B,P!+(POLRED B,A));
+ IF POLEXPT A=POLEXPT B THEN RETURN P1!+(A, B);
+ IF POLEXPT A>POLEXPT B THEN RETURN
+ MKPOLY(POLTRM A,P!+(POLRED A,B));
+ RETURN MKPOLY(POLTRM B,P!+(POLRED B,A))
+ END;
+
+SYMBOLIC PROCEDURE PORDERP(A,B); %. POL variable ordering
+ IF A EQ B THEN 0
+ ELSE IF ORDERP(A,B) THEN 1 ELSE -1;
+
+SYMBOLIC PROCEDURE P!*(A,B); %. POL multiply
+ IF NUMBERP A THEN
+ IF A=0 THEN 0
+ ELSE IF NUMBERP B THEN TIMES2(A,B)
+ ELSE CONS(CONS(CAAR B,PNTIMES(CDAR B,A)),
+ PNTIMES(CDR B,A))
+ ELSE IF NUMBERP B THEN PNTIMES(A,B)
+ ELSE P!+(PTTIMES(CAR A,B),P!*(CDR A,B));
+
+SYMBOLIC PROCEDURE PTTIMES(TT,A); %. POL term mult
+ IF NUMBERP A THEN
+ IF A=0 THEN 0 ELSE
+ ZCONS CONS(CAR TT,PNTIMES(CDR TT,A))
+ ELSE P!+(TTTIMES(TT,CAR A),PTTIMES(TT,CDR A));
+
+SYMBOLIC PROCEDURE PNTIMES(A,N); %. POL numeric coef mult
+ IF N=0 THEN 0
+ ELSE IF NUMBERP A THEN TIMES2(A,N)
+ ELSE CONS(CONS(CAAR A,PNTIMES(CDAR A,N)),PNTIMES(CDR A,N));
+
+SYMBOLIC PROCEDURE TTTIMES(TA,TB); %. TERM Mult
+ BEGIN SCALAR ORD;
+ ORD:=PORDERP(CAAR TA,CAAR TB);
+ RETURN IF ORD=0 THEN
+ ZCONS(CONS(CONS(CAAR TA,PLUS2(CDAR TA,CDAR TB)),
+ P!*(CDR TA,CDR TB)))
+ ELSE IF ORD=1 THEN
+ ZCONS(CONS(CAR TA,P!*(ZCONS TB,CDR TA)))
+ ELSE ZCONS(CONS(CAR TB,P!*(ZCONS TA,CDR TB)))
+END;
+
+SYMBOLIC PROCEDURE ZCONS A; %. Make single term POL
+ CONS(A,0);
+
+SYMBOLIC PROCEDURE PCREATE1(X); %. Create POLY from Variable/KERNEL
+ ZCONS(CONS(CONS(X,1),1));
+
+SYMBOLIC PROCEDURE PCREATE X;
+ IF IDP X THEN PCREATE1 X
+ ELSE IF PAIRP X AND IDP CAR X THEN PCREATE1 MKKERNEL X
+ ELSE ERROR(1000,LIST(X, '(bad kernel)));
+
+SYMBOLIC PROCEDURE PGCD(A,B); %. POL Gcd
+% A and B must be primitive.
+IF A=1 OR B=1 THEN 1 ELSE
+IF NUMBERP A AND NUMBERP B THEN NUMGCD(A,B)
+ ELSE IF NUMBERP A THEN GCDPT(B,A)
+ ELSE IF NUMBERP B THEN GCDPT(A,B)
+ ELSE BEGIN SCALAR ORD;
+ ORD:=PORDERP(CAAAR A,CAAAR B);
+ IF ORD=0 THEN RETURN GCDPP(A,B);
+ IF ORD>0 THEN RETURN GCDPT(A,B);
+ RETURN GCDPT(B,A)
+END;
+
+SYMBOLIC PROCEDURE NUMGCD(A,B); %. Numeric GCD
+ IF A=0 THEN ABS B
+ ELSE NUMGCD(REMAINDER(B,A),A);
+
+SYMBOLIC PROCEDURE GCDPT(A,B); %. POL GCD, non-equal vars
+IF NUMBERP A THEN IF NUMBERP B THEN NUMGCD(A,B) ELSE
+ GCDPT(B,A) ELSE
+BEGIN SCALAR ANS,ANS1;
+ ANS:=PGCD(CDAR A,B);
+ A:=CDR A;
+ WHILE NOT NUMBERP A DO <<
+ ANS1:=PGCD(CDAR A,B);
+ ANS:=PGCD(ANS,ANS1);
+ A:=CDR A;
+ IF ANS=1 THEN RETURN ANS >>;
+ RETURN IF A=0 THEN ANS ELSE GCDPT(ANS,A)
+END;
+
+SYMBOLIC PROCEDURE GCDPP(A,B); %. POL GCD, equal vars
+BEGIN SCALAR TT,PA,ALPHA,PREVALPHA;
+ IF POLEXPT B>POLEXPT A THEN <<
+ TT := A;
+ A := B;
+ B := TT >>;
+ ALPHA := 1;
+LOOP: PREVALPHA := ALPHA;
+ ALPHA := POLCOEF B;
+ PA := POLEXPT A - POLEXPT B;
+ IF PA<0 THEN <<
+ PRINT A;
+ PRINT B;
+ PRINT PA;
+ ERROR(999,'(WRONG)) >>;
+ WHILE NOT (PA=0) DO <<
+ PA := PA-1;
+ ALPHA := P!*(POLCOEF B,ALPHA) >>;
+ A := P!*(A,ALPHA); % to ensure no fractions;
+ TT := CDR PDIVIDE(A,B); % quotient and remainder of polynomials;
+ IF TT=0 THEN
+ RETURN B; % which is the GCD;
+ A := B;
+ B := PDIVIDE(TT,PREVALPHA);
+ IF NOT(CDR B=0) THEN
+ ERROR(12,'(REDUCED PRS FAILS));
+ B := CAR B;
+ IF NUMBERP B OR NOT (POLVAR A EQ POLVAR B) THEN RETURN 1;
+ % Lost leading VAR we started with. /MLG
+ GO TO LOOP
+END;
+
+SYMBOLIC PROCEDURE DIVIDEOUT(A,B); %. POL exact division
+ CAR PDIVIDE(A,B);
+
+SYMBOLIC PROCEDURE PDIVIDE(A,B); %. POL (quotient.remainder)
+ IF NUMBERP A THEN
+ IF NUMBERP B THEN DIVIDE(A,B)
+ ELSE CONS(0,A)
+ ELSE IF NUMBERP B THEN
+ BEGIN SCALAR SS,TT;
+ SS:=PDIVIDE(CDR A,B);
+ TT:=PDIVIDE(CDAR A,B);
+ RETURN CONS(
+ P!+(P!*(ZCONS CONS(CAAR A,1),CAR TT),CAR SS),
+ P!+(P!*(ZCONS CONS(CAAR A,1),CDR TT),CDR SS))
+ END
+ ELSE
+ BEGIN SCALAR QQ,BB,CC,TT;
+ IF NOT(POLVAR A EQ POLVAR B) OR POLEXPT A < POLEXPT B THEN
+ RETURN CONS(0,A); % Not same var/MLG, degree check/DFM
+
+ QQ:=PDIVIDE(POLCOEF A,POLCOEF B); % Look for leading term;
+ IF NOT(CDR QQ=0) THEN RETURN CONS(0,A);
+ QQ:=CAR QQ; %Get the quotient;
+ BB:=P!*(B,QQ);
+ IF CDAAR A > CDAAR B THEN
+ << TT:=ZCONS CONS(CONS(CAAAR A,CDAAR A-CDAAR B),1);
+ BB:=P!*(BB,TT);
+ QQ:=P!*(QQ,TT)
+ >>;
+ CC:=P!-(A,BB); %Take it off;
+ BB:=PDIVIDE(CC,B);
+ RETURN CONS(P!+(QQ,CAR BB),CDR BB)
+ END;
+
+SYMBOLIC PROCEDURE P!-(A,B); %. POL subtract
+ P!+(A,P!.NEG B);
+
+SYMBOLIC PROCEDURE P!.NEG(A); %. POL Negate
+ IF NUMBERP A THEN -A
+ ELSE CONS(CONS(CAAR A,P!.NEG CDAR A),P!.NEG CDR A);
+
+SYMBOLIC PROCEDURE PDIFF(A,X); %. POL derivative (to variable)
+ IF NUMBERP A THEN 0
+ ELSE BEGIN SCALAR ORD;
+ ORD:=PORDERP(POLVAR A,X);
+ RETURN
+ IF ORD=-1 THEN 0
+ ELSE IF ORD=0 THEN
+ IF CDAAR A=1 THEN
+ CDAR A
+ ELSE P!+(ZCONS CONS(CONS(X,CDAAR A-1),P!*(CDAAR A,CDAR A)),
+ PDIFF(CDR A,X))
+ ELSE P!+(P!*(ZCONS CONS(CAAR A,1),PDIFF(CDAR A,X)),PDIFF(CDR A,X))
+END;
+
+SYMBOLIC PROCEDURE MKKERNEL X;
+ BEGIN SCALAR KERNELS,K,OP;
+ K:=KERNELS:=GET(OP:=CAR X,'KERNELS);
+ L: IF NULL K THEN RETURN<<PUT(OP,'KERNELS,X.KERNELS);X>>;
+ IF X=CAR K THEN RETURN CAR K;
+ K:=CDR K;
+ GOTO L
+ END;
+
+ %***************************** Parser *********************************
+
+% Simple parser creates expressions to be evaluated by the
+% rational polynomial routines.
+% J. Marti, August 1980.
+% Modified and Extended by GRISS and GALWAY
+% Rewritten to be left associative by OTTENHEIMER, March 1981
+
+
+GLOBAL '(TOK!*);
+
+SYMBOLIC PROCEDURE RPARSE(); %. PARSE Infix to Prefix
+BEGIN SCALAR X;
+ NTOKEN();
+ IF TOK!* EQ '!; THEN RETURN NIL; % Fix for null exp RBO 9 Feb 81
+ IF NULL(X := REXP()) THEN RETURN ERROR(105, '(Unparsable Expression));
+ IF TOK!* NEQ '!; THEN RETURN ERROR(106, '(Missing !; at end of expression));
+ RETURN X
+END RPARSE;
+
+SYMBOLIC PROCEDURE REXP(); %. Parse an EXP and rename OP
+BEGIN SCALAR LEFT, RIGHT,OP;
+ IF NOT (LEFT := RTERM()) THEN RETURN NIL;
+ WHILE (OP := GET(TOK!*,'REXP)) DO
+ << NTOKEN();
+ IF NOT(RIGHT := RTERM()) THEN RETURN ERROR(100, '(Missing Term in Exp));
+ LEFT := LIST(OP, LEFT, RIGHT)
+ >>;
+ RETURN LEFT
+END REXP;
+
+SYMBOLIC PROCEDURE RTERM(); %. PARSE a TERM
+BEGIN SCALAR LEFT, RIGHT, OP;
+ IF NOT (LEFT := RPRIMARY()) THEN RETURN NIL;
+ WHILE (OP := GET(TOK!*,'RTERM)) DO
+ << NTOKEN();
+ IF NOT (RIGHT := RPRIMARY()) THEN
+ RETURN ERROR (101, '(Missing Primary in Term));
+ LEFT := LIST(OP, LEFT, RIGHT)
+ >>;
+ RETURN LEFT
+END RTERM;
+
+SYMBOLIC PROCEDURE RPRIMARY(); %. RPRIMARY, allows "^" and "'"
+BEGIN SCALAR LEFT, RIGHT, OP;
+ IF TOK!* EQ '!+ THEN RETURN <<NTOKEN(); RPRIMARY0()>>;
+ IF TOK!* EQ '!-
+ THEN RETURN << NTOKEN();
+ IF (LEFT := RPRIMARY0()) THEN LIST('MINUS, LEFT)
+ ELSE RETURN ERROR(200,'(Missing Primary0 after MINUS))
+ >>;
+
+ IF NOT (LEFT := RPRIMARY0()) THEN RETURN NIL;
+ WHILE (OP := GET(TOK!*,'RPRIMARY)) DO
+ << NTOKEN();
+ IF NOT (RIGHT := RPRIMARY0()) THEN
+ RETURN ERROR(200, '(Missing Primary0 in Primary));
+ LEFT := LIST(OP, LEFT, RIGHT)
+ >>;
+ RETURN LEFT;
+END RPRIMARY;
+
+SYMBOLIC PROCEDURE RPRIMARY0(); %. Variables, etc
+BEGIN SCALAR EXP, ARGS;
+ IF TOK!* EQ '!( THEN
+ << NTOKEN();
+ IF NOT (EXP := REXP()) THEN RETURN ERROR(102, '(Missing Expression));
+ IF TOK!* NEQ '!) THEN RETURN ERROR(103, '(Missing Right Parenthesis));
+ NTOKEN();
+ RETURN EXP
+ >>;
+
+ IF NUMBERP(EXP := TOK!*)
+ THEN RETURN <<NTOKEN(); EXP>>;
+
+ IF NOT IDP EXP THEN RETURN NIL;
+ NTOKEN();
+ IF ARGS := RARGS(EXP) THEN RETURN ARGS;
+ RETURN EXP;
+END RPRIMARY0;
+
+SYMBOLIC PROCEDURE RARGS(X);
+ BEGIN SCALAR ARGS,ARG;
+ IF TOK!* NEQ '!( THEN RETURN NIL;
+ NTOKEN();
+ IF TOK!* EQ '!) THEN RETURN <<NTOKEN();X . NIL>>;
+ L: IF NOT (ARG :=REXP()) THEN ERROR(104,'(Not expression in ARGLST));
+ ARGS := ARG . ARGS;
+ IF TOK!* EQ '!, THEN <<NTOKEN(); GOTO L>>;
+ IF TOK!* EQ '!) THEN RETURN <<NTOKEN();X . REVERSE ARGS>>;
+ ERROR(105,'(Missing !) or !, in ARGLST));
+ END;
+
+SYMBOLIC PROCEDURE MKATOM X;
+% Use LIST('RCREATE, LIST('QUOTE,x)); if doing EVAL mode
+ X;
+
+ %******************* Printing Routines ********************************
+
+SYMBOLIC PROCEDURE PPRINT A;
+% Print internal canonical form in Infix notation.
+ IF NUMBERP A THEN PRIN2 A ELSE
+BEGIN
+ IF NUMBERP CDAR A THEN
+ IF CDAR A = 0 THEN
+ << PRIN2 '0; RETURN NIL >>
+ ELSE IF CDAR A NEQ 1 THEN
+ << PRIN2 CDAR A; PRIN2 '!* >>
+ ELSE
+ ELSE IF RPREC!* CDAR A THEN << PPRINT CDAR A; PRIN2 '!* >>
+ ELSE <<PRIN2 '!(; PPRINT CDAR A; PRIN2 '!)!* >>;
+ IF CDAAR A = 0 THEN PRIN2 1
+ ELSE IF CDAAR A = 1 THEN PRIN2 CAAAR A
+ ELSE << PRIN2 CAAAR A; PRIN2 '!^;
+ IF RPREC!^ CDAAR A THEN PPRINT CDAAR A
+ ELSE <<PRIN2 '!(; PPRINT CAAAR A; PRIN2 '!) >> >>;
+ IF NUMBERP CDR A THEN
+ IF CDR A> 0 THEN <<PRIN2 '!+ ; PRIN2 CDR A; RETURN NIL>>
+ ELSE IF CDR A < 0 THEN <<PRIN2 '!-! ; PRIN2 (-CDR A);
+ RETURN NIL>>
+ ELSE RETURN NIL;
+ IF ATOM CDR A THEN <<PRIN2 '!+ ; PRIN2 CDR A; RETURN NIL>>;
+ PRIN2 '!+ ; PPRINT CDR A;
+END;
+
+SYMBOLIC PROCEDURE RPREC!* X; %. T if there is no significant addition in X.
+ ATOM X OR (NUMBERP POLRED X AND POLRED X = 0);
+
+SYMBOLIC PROCEDURE RPREC!^ X; %. T if there is not significant addition or multiplication in X.
+RPREC!* X AND (ATOM X OR
+ (ATOM CDAR X AND NUMBERP CDAR X));
+
+SYMBOLIC PROCEDURE SIMPLE X; %. POL that doest need ()
+ ATOM X OR ((POLRED X=0) AND (POLEXPT X=1) AND (POLCOEF X =1));
+
+SYMBOLIC PROCEDURE RATPRINT A; %. Print a RAT
+BEGIN
+ IF CDR A = 1 THEN PPRINT CAR A
+ ELSE <<NPRINT CAR A;
+ PRIN2 '!/;
+ NPRINT CDR A>>;
+ TERPRI()
+END;
+
+SYMBOLIC PROCEDURE NPRINT A; %. Add parens, if needed
+ IF NOT SIMPLE A THEN <<PRIN2 '!( ; PPRINT A; PRIN2 '!) >>
+ ELSE PPRINT A;
+
+%. Convert RCAN back to PREFIX form
+
+SYMBOLIC PROCEDURE RAT2PRE X; %. RATIONAL to Prefix
+ IF RATDEN X = 1 THEN POL2PRE RATNUM X
+ ELSE LIST('QUOTIENT,POL2PRE RATNUM X, POL2PRE RATDEN X);
+
+SYMBOLIC PROCEDURE POL2PRE X; %. Polynomial to Prefix
+BEGIN SCALAR TT,RR;
+ IF NOT PAIRP X THEN RETURN X;
+ TT:=TRM2PRE POLTRM X;
+ RR:=POL2PRE POLRED X;
+ IF RR = 0 THEN RETURN TT;
+ IF NUMBERP RR AND RR <0 THEN RETURN LIST('DIFFERENCE,TT,-RR);
+ RETURN LIST('PLUS2,TT,RR);
+END;
+
+SYMBOLIC PROCEDURE TRM2PRE X; %. Term to Prefix
+ IF TRMCOEF X = 1 THEN PWR2PRE TRMPWR X
+ ELSE IF TRMCOEF X = (-1) THEN LIST('MINUS,PWR2PRE TRMPWR X)
+ ELSE LIST('TIMES2,POL2PRE TRMCOEF X,PWR2PRE TRMPWR X);
+
+SYMBOLIC PROCEDURE PWR2PRE X; %. Power to Prefix
+ IF PWREXPT X = 1 THEN PWRVAR X
+ ELSE LIST('EXPT,PWRVAR X,PWREXPT X);
+
+%. prefix Pretty print
+
+SYMBOLIC PROCEDURE PREPRIN(A,PARENS); %. Print PREFIX form in Infix notation.
+ BEGIN SCALAR PRINOP;
+ IF ATOM A THEN RETURN PRIN2 A;
+ IF (PRINOP:=GET(CAR A,'PRINOP))
+ THEN RETURN XAPPLY(PRINOP,LIST(A,PARENS));
+ PRIN2(CAR A); PRINARGS CDR A;
+ RETURN A;
+ END;
+
+SYMBOLIC PROCEDURE PRINARGS A; %. Print ArgLIST
+ IF NOT PAIRP A THEN PRIN2 '!(!)
+ ELSE <<PRIN2 '!(; WHILE PAIRP A DO
+ <<PREPRIN(CAR A,NIL);
+ IF PAIRP (A:=CDR A) THEN PRIN2 '!,>>;
+ PRIN2 '!)>>;
+
+SYMBOLIC PROCEDURE PREPRINT A;
+ <<PREPRIN(A,NIL); TERPRI(); A>>;
+
+SYMBOLIC PROCEDURE NARYPRIN(OP,ARGS,PARENS);
+ IF NOT PAIRP ARGS THEN NIL
+ ELSE IF NOT PAIRP CDR ARGS THEN PREPRIN(CAR ARGS,PARENS)
+ ELSE <<IF PARENS THEN PRIN2 '!(;
+ WHILE PAIRP ARGS DO
+ <<PREPRIN(CAR ARGS,T); % Need precedence here
+ IF PAIRP(ARGS:=CDR ARGS) THEN PRIN2 OP>>;
+ IF PARENS THEN PRIN2 '!)>>;
+
+
+SYMBOLIC PROCEDURE PLUSPRIN(A,PARENS);
+ NARYPRIN('! !+! ,CDR A,PARENS);
+
+SYMBOLIC PROCEDURE DIFFERENCEPRIN(A,PARENS);
+ NARYPRIN('! !-! ,CDR A,PARENS);
+
+SYMBOLIC PROCEDURE TIMESPRIN(A,PARENS);
+ NARYPRIN('!*,CDR A,PARENS);
+
+SYMBOLIC PROCEDURE QUOTPRIN(A,PARENS);
+ NARYPRIN('!/,CDR A,PARENS);
+
+SYMBOLIC PROCEDURE EXPPRIN(A,PARENS);
+ NARYPRIN('!^,CDR A,PARENS);
+
+ON RAISE;
+END;
ADDED perq-pascal-lisp-project/test.sl
Index: perq-pascal-lisp-project/test.sl
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/test.sl
@@ -0,0 +1,4 @@
+1
+2
+(PRINT '(AHA OHO))
+(RDS NIL)
ADDED perq-pascal-lisp-project/tpas0.pas
Index: perq-pascal-lisp-project/tpas0.pas
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/tpas0.pas
@@ -0,0 +1,1212 @@
+(* include following two lines for terak *)
+(* [$s+] *) (* swapping mode to manage this large file *)
+(* [$g+] *) (* goto is legal *)
+
+PROGRAM pas0(symin*,input*,output);
+
+ (************************************************************)
+ (* support routines for a "lisp" machine. uses a register *)
+ (* model with a stack for holding frames. stack also used *)
+ (* to hold compiler generated constants. *)
+ (* written by william f. galway and martin l. griss *)
+ (* modified by ralph ottenheimer may 81 *)
+ (* append pas1...pasn at end *)
+ (* -------------------------------------------------------- *)
+ (* symin is input channel one--used to initialize "symbol *)
+ (* table". input is input channel two--standard input. *)
+ (* output is output channel one--the standard output. *)
+ (************************************************************)
+
+CONST
+ (* for terak *)
+ sp = ' ';
+ ht = 9; (* ascii codes *)
+ lf = 10;
+ cr = 13;
+ nul = 0;
+
+ eos = nul; (* terminator character for strings. *)
+ (* note: use chr(eos) on terak *)
+ inchns = 2; (* number of input channels. *)
+ outchns = 1; (* number of output channels. *)
+
+ xtoktype = 129; (* slot in idspace for toktype. *)
+ chartype = 3; (* various token types *)
+ inttype = 1;
+ idtype = 2;
+
+ shift_const = 8192; (* tags and info are packed into an integer *)
+ (* assumed to be at least 16 bits long. low order 13 bits *)
+ (* are the info, top 3 are the tag. *)
+ int_offset = 4096; (* small integers are stored 0..8191 *)
+ (* instead of -4096..4095 because it will pack smaller *)
+ (* under ucsd pascal. *)
+
+ (* the various tags - can't use a defined scalar type *)
+ (* because of the lack of convertion functions. *)
+ inttag = 0; (* info is an integer *)
+ chartag = 1; (* info is a character code *)
+ pairtag = 2; (* info points to pair *)
+ idtag = 3; (* info points to identifier *)
+ codetag = 4; (* info is index into a case statement *)
+ (* that calls appropriate function. *)
+ errtag = 5; (* info is an error code - see below. *)
+ bigtag = 6; (* info points to a full word (or *)
+ (* longer) integer. *)
+ flotag = 7; (* info points to a float number. *)
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on a non-pair. *)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells (etc?) *)
+
+ maxpair = 2500; (* max number of pairs allowed. *)
+ maxident = 400; (* max number of identifiers *)
+ maxstrsp = 2000; (* size of string (literal) storage space. *)
+ maxintsp = 50; (* max number of long integers allowed *)
+ maxflosp = 50; (* max number of floating numbers allowed *)
+
+ hidmax = 50; (* number of hash values for identifiers *)
+ maxgcstk = 100; (* size of garbage collection stack. *)
+ stksize = 500; (* stack size *)
+ maxreg = 15; (* number of registers in lisp machine. *)
+
+ eofcode = 26; (* magic character code for eof, ascii for *)
+ (* cntrl-z. kludge, see note in xrdtok. *)
+ choffset = 1; (* add choffset to ascii code to get address *)
+ (* in id space for corresponding identifier. *)
+ nillnk = 0; (* when integers are used as pointers. *)
+
+
+TYPE
+ (* onechar = ascii; *)
+ onechar = char; (* for terak *)
+
+ (* note we allow zero for id_ptr, allowing a "nil" link. *)
+ stringp = 1..maxstrsp; (* pointer into string space. *)
+ id_ptr = 0..maxident; (* pointer into id space. *)
+
+ itemref = integer;
+ itemtype = 0..7; (* the tags *)
+
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ markflg: boolean; (* for garbage collection *)
+ END;
+
+
+ ascfile = PACKED FILE OF onechar;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+ longint = integer; (* use long int on terak *)
+
+VAR
+ (* global information *)
+ nilref,trueref: itemref; (* refers to identifiers "nil", and "t". *)
+
+ r: ARRAY[1..maxreg] OF itemref;
+ rxx,ryy: itemref;
+
+ (* "st" is the stack pointer into "stk". it counts the number of *)
+ (* items on the stack, so it runs from zero while the stack starts *)
+ (* at one. *)
+ st: 0..stksize;
+ stk: ARRAY[1..stksize] OF itemref;
+
+ (* pair space *)
+ prspace: PACKED ARRAY[1..maxpair] OF pair; (* all pairs stored here. *)
+ freepair: integer; (* pointer to next free pair in prspace. *)
+
+ (* identifier space *)
+ idhead: ARRAY[0..hidmax] OF id_ptr;
+ idspace: PACKED ARRAY[1..maxident] OF ident;
+ freeident: integer;
+
+ (* string space *)
+ strspace: PACKED ARRAY[1..maxstrsp] OF onechar;
+ freestr: stringp;
+
+ (* large integer space *)
+ intspace: ARRAY[1..maxintsp] OF longint;
+ freeint: 1..maxintsp;
+
+ (* i/o channels *)
+ symin: ascfile;
+(* input: ascfile; (* comment out for terak. *)
+
+ inchnl: 1..inchns; (* current input channel number *)
+ outchnl: 1..outchns; (* current output channel number *)
+
+ (* "current character" for each input channel. *)
+ (* may want to include more than one character at some later date *)
+ (* (for more lookahead). *)
+ ichrbuf: ARRAY[1..inchns] OF onechar;
+
+ (* for collecting statistics. *)
+ gccount: integer; (* counts garbage collections *)
+ (* counts from last garbage collection. *)
+ consknt: integer; (* number of times "cons" called *)
+ pairknt: integer; (* number of pairs created *)
+
+
+ (********************************************************)
+ (* *)
+ (* item selectors & constructors *)
+ (* *)
+ (********************************************************)
+
+
+FUNCTION tag_of(item: itemref): itemtype;
+ BEGIN (* tag_of *)
+ tag_of := item DIV shift_const;
+ END;
+ (* tag_of *)
+
+FUNCTION info_of(item: itemref): integer;
+ BEGIN (* info_of *)
+ IF item DIV shift_const = inttag THEN
+ info_of := item MOD shift_const - int_offset
+ ELSE
+ info_of := item MOD shift_const
+ END;
+ (* info_of *)
+
+PROCEDURE mkitem(tag: itemtype; info: longint; VAR item: itemref);
+ (* do range checking on info. ints run from -4096 to +4095 *)
+ (* everything else runs from 0 to 8191. ints & chars *)
+ (* contain their info, all others points into an *)
+ (* appropriate space. *)
+
+ PROCEDURE mkbigint;
+ BEGIN (* mkbigint *)
+ IF freeint <= maxintsp THEN (* convert to bignum *)
+ BEGIN
+ tag := bigtag;
+ intspace[freeint] := info;
+ info := freeint; (* since we want the pointer *)
+ freeint := freeint + 1;
+ END
+ ELSE writeln('*****BIGNUM SPACE EXHAUSTED') (* should do gc *)
+ END;
+ (* mkbigint *)
+
+
+ BEGIN (* mkitem *)
+ IF tag = inttag THEN
+ IF (info < -int_offset) OR (info > int_offset - 1) THEN mkbigint
+ ELSE info := info + int_offset (* info was in range so add offset *)
+
+ ELSE IF tag = bigtag THEN mkbigint
+
+ ELSE IF info < 0 THEN
+ BEGIN
+ writeln('*****MKITEM: BAD NEG');
+ break(output); halt
+ END;
+ (* nothing special to do for other types *)
+
+ (* pack tag and info into 16-bit item. *)
+ item := tag * shift_const + info
+ END;
+ (* mkitem *)
+
+PROCEDURE set_info(VAR item: itemref; newinfo: longint);
+ BEGIN (* set_info *)
+ mkitem(tag_of(item), newinfo, item)
+ END;
+ (* set_info *)
+
+PROCEDURE set_tag(VAR item: itemref; newtag: itemtype);
+ BEGIN (* set_tag *)
+ mkitem(newtag, info_of(item), item)
+ END;
+ (* set_tag *)
+
+PROCEDURE mkident(id: integer; reg: integer);
+ (* make identifier "id" in register "reg" *)
+ BEGIN (* mkident *)
+ mkitem(idtag, id, r[reg]);
+ END;
+ (* mkident *)
+
+PROCEDURE mkint(int: longint; reg: integer);
+ BEGIN (* mkint *)
+ mkitem(inttag, int, r[reg]);
+ END;
+ (* mkint *)
+
+PROCEDURE mkpair(pr: integer; reg: integer);
+ BEGIN (* mkpair *)
+ mkitem(pairtag, pr, r[reg])
+ END;
+ (* mkpair *)
+
+PROCEDURE int_val(item: itemref; VAR number: longint);
+ (* returns integer value of item (int or bignum). *)
+ (* must return 'number' in var parameter instead *)
+ (* of function value since long integers are not *)
+ (* a legal function type in ucsd pascal. *)
+ BEGIN (* int_val *)
+ IF tag_of(item) = inttag THEN
+ number := info_of(item)
+ ELSE IF tag_of(item) = bigtag THEN
+ number := intspace[info_of(item)]
+ ELSE writeln('***** ILLEGAL DATA TYPE FOR NUMERIC OPERATION')
+ END;
+ (* int_val *)
+
+
+ (********************************************************)
+ (* *)
+ (* stack allocation *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xsetuniq; (* just here temporarily until i can *)
+ BEGIN (* xsetuniq *)(* figure out how to get them out of *)
+ END;
+ (* execute. *)
+ (* xsetuniq *)
+
+PROCEDURE xgetuniq;
+ BEGIN (* xgetuniq *)
+ END;
+ (* xgetuniq *)
+
+
+PROCEDURE alloc(n: integer);
+ BEGIN
+ IF n + st <= stksize THEN
+ st := n+st
+ ELSE
+ BEGIN
+ writeln('*****LISP STACK OVERFLOW');
+ writeln(' TRIED TO ALLOCATE ',n);
+ writeln(' CURRENT STACK TOP IS ',st);
+ END;
+ END;
+
+PROCEDURE dealloc(n: integer);
+ BEGIN
+ IF st - n >= 0 THEN
+ st := st - n
+ ELSE
+ writeln('*****LISP STACK UNDERFLOW');
+ END;
+
+ (* optimized allocs *)
+
+PROCEDURE alloc1;
+ BEGIN alloc(1) END;
+
+PROCEDURE dealloc1;
+ BEGIN dealloc(1) END;
+
+PROCEDURE alloc2;
+ BEGIN alloc(2) END;
+
+PROCEDURE dealloc2;
+ BEGIN dealloc(2) END;
+
+PROCEDURE alloc3;
+ BEGIN alloc(3) END;
+
+PROCEDURE dealloc3;
+ BEGIN dealloc(3) END;
+
+
+ (********************************************************)
+ (* *)
+ (* support for register model *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE load(reg: integer; sloc: integer);
+ BEGIN
+ IF sloc < 0 THEN r[reg] := r[-sloc]
+ ELSE r[reg] := stk[st-sloc];
+ (* will, fix for load (pos,pos) *)
+ END;
+
+PROCEDURE store(reg: integer; sloc: integer);
+ BEGIN
+ stk[st-sloc] := r[reg];
+ END;
+
+ (* optimized load/store. *)
+PROCEDURE load10;
+ BEGIN
+ load(1,0);
+ END;
+
+PROCEDURE store10;
+ BEGIN
+ store(1,0);
+ END;
+
+PROCEDURE storenil(sloc: integer);
+ BEGIN
+ stk[st-sloc] := nilref;
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* standard lisp functions *)
+ (* *)
+ (********************************************************)
+
+ (* the following standard lisp functions appear in *)
+ (* eval.red: reverse, append, memq, atsoc, get, *)
+ (* put, remprop, eq, null, equal, error, errorset, *)
+ (* abs, idp, numberp, atom, minusp, eval, xapply, *)
+ (* evlis, prin1, print, prin2t, list2 ... list5. *)
+
+FUNCTION atom(item : itemref): itemref;
+ BEGIN (* atom *)
+ IF tag_of(item) <> pairtag THEN atom := trueref
+ ELSE atom := nilref
+ END (* atom *);
+
+FUNCTION codep(item: itemref): itemref;
+ BEGIN (* codep *)
+ IF (tag_of(item) = codetag) AND (info_of(item) <> undefined) THEN
+ codep := trueref
+ ELSE codep := nilref
+ END (* codep *);
+
+FUNCTION idp(item: itemref): itemref;
+ BEGIN (* idp *)
+ IF tag_of(item) = idtag THEN idp := trueref
+ ELSE idp := nilref
+ END (* idp *);
+
+FUNCTION pairp(item: itemref): itemref;
+ BEGIN (* pairp *)
+ IF tag_of(item) = pairtag THEN pairp := trueref
+ ELSE pairp := nilref
+ END (* pairp *);
+
+FUNCTION constantp(item: itemref): itemref;
+ BEGIN (* constantp *)
+ IF NOT((pairp(item) = trueref) OR (idp(item) = trueref)) THEN
+ constantp := trueref
+ ELSE constantp := nilref
+ END (* constantp *);
+
+FUNCTION eq(u, v: itemref): itemref;
+ BEGIN (* eq *)
+ IF u = v THEN eq := trueref
+ ELSE eq := nilref
+ END (* eq *);
+
+FUNCTION eqn(u, v: itemref): itemref;
+ VAR i, j: longint;
+
+ BEGIN (* eqn *)
+ int_val(u, i);
+ int_val(v, j);
+ IF i = j THEN eqn := trueref
+ ELSE eqn := nilref
+ END (* eqn *);
+
+FUNCTION fixp(item: itemref): itemref;
+ BEGIN (* fixp *)
+ IF (tag_of(item) = inttag) OR (tag_of(item) = bigtag) THEN
+ fixp := trueref
+ ELSE fixp := nilref
+ END (* fixp *);
+
+FUNCTION floatp(item: itemref): itemref;
+ BEGIN (* floatp *)
+ IF tag_of(item) = flotag THEN floatp := trueref
+ ELSE floatp := nilref
+ END (* floatp *);
+
+FUNCTION numberp(item: itemref): itemref;
+ BEGIN (* numberp *)
+ numberp := fixp(item) (* will have to be fixed for floats *)
+ END (* numberp *);
+
+
+ (********************************************************)
+ (* *)
+ (* identifier lookup & entry *)
+ (* *)
+ (********************************************************)
+
+FUNCTION nmhash(nm: stringp): integer;
+ CONST
+ hashc = 256;
+ VAR
+ i,tmp: integer;
+ BEGIN
+ tmp := 0;
+ i := 1; (* get hash code from first three chars of string. *)
+ WHILE (i <= 3) AND (strspace[nm+i] <> chr(eos)) DO
+ BEGIN
+ tmp := ord(strspace[nm+i]) + hashc*tmp;
+ i := i + 1;
+ END;
+ nmhash := abs(tmp) MOD hidmax; (* abs because mod is screwy. *)
+ END;
+
+FUNCTION eqstr(s1,s2: stringp): boolean;
+ BEGIN
+ WHILE (strspace[s1] = strspace[s2]) AND (strspace[s1] <> chr(eos)) DO
+ BEGIN
+ s1 := s1 + 1;
+ s2 := s2 + 1;
+ END;
+ eqstr := (strspace[s1] = strspace[s2]);
+ END;
+
+PROCEDURE nmlookup(nm: stringp; VAR found: boolean; VAR hash: integer;
+ VAR loc: itemref);
+ (* lookup a name in "identifier space". *)
+ (* "hash" returns the hash value for the name. *)
+ (* "loc" returns the location in the space for the (possibly new) *)
+ (* identifier. *)
+ BEGIN
+ hash := nmhash(nm);
+ mkitem(idtag, idhead[hash], loc);
+ (* default is identifier, but may be "error". *)
+ (* start at appropriate hash chain. *)
+
+ found := false;
+ WHILE (info_of(loc) <> nillnk) AND (NOT found) DO
+ BEGIN
+ found := eqstr(nm, idspace[info_of(loc)].idname);
+ IF NOT found THEN
+ set_info(loc, idspace[info_of(loc)].idhlink);
+ (* next id in chain *)
+ END;
+ IF NOT found THEN (* find spot for new identifier *)
+ BEGIN
+ IF freeident=nillnk THEN (* no more free identifiers. *)
+ mkitem(errtag, noidspace, loc)
+ ELSE
+ BEGIN
+ set_info(loc, freeident);
+ freeident := idspace[freeident].idhlink;
+ END;
+ END;
+ END;
+
+PROCEDURE putnm(nm: stringp; VAR z: itemref; VAR found: boolean);
+ (* put a new name into identifier space, or return old location *)
+ (* if it's already there. *)
+ VAR
+ tmp: ident;
+ hash: integer;
+ BEGIN
+ nmlookup(nm, found, hash, z);
+ IF (NOT found) AND (tag_of(z) = idtag) THEN
+ BEGIN
+ tmp.idname := nm;
+ tmp.idhlink := idhead[hash]; (* put new ident at head of chain *)
+ tmp.val := nilref; (* initialize value and property list *)
+ tmp.plist := nilref;
+ tmp.funcell := nilref; (* also, the function cell *)
+ idhead[hash] := info_of(z);
+ idspace[info_of(z)] := tmp;
+ END;
+ END;
+
+PROCEDURE xfaststat;
+ (* give quick summary of statistics gathered *)
+ BEGIN
+ writeln('CONSES:',consknt);
+ writeln('PAIRS :',pairknt);
+ writeln('CONSES/PAIRS: ',consknt/pairknt);
+ writeln('ST :',st);
+ END;
+
+
+ (********************************************************)
+ (* *)
+ (* the garbage collector *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xgcollect;
+ VAR
+ i: integer;
+ markedk: integer; (* counts the number of pairs marked *)
+ freedk: integer; (* counts the number of pairs freed. *)
+ gcstkp: 0..maxgcstk; (* note the garbage collection stack *)
+ mxgcstk: 0..maxgcstk; (* is local to this procedure. *)
+ gcstk: ARRAY[1..maxgcstk] OF integer;
+
+ PROCEDURE pushref(pr: itemref);
+ (* push the address of an unmarked pair, if that's what it is. *)
+ BEGIN
+ IF tag_of(pr) = pairtag THEN
+ IF NOT prspace[info_of(pr)].markflg THEN
+ BEGIN
+ IF gcstkp < maxgcstk THEN
+ BEGIN
+ gcstkp := gcstkp + 1;
+ gcstk[gcstkp] := info_of(pr);
+ IF gcstkp > mxgcstk THEN
+ mxgcstk := gcstkp;
+ END
+ ELSE
+ BEGIN
+ writeln('*****GARBAGE STACK OVERFLOW');
+ halt; (* fatal error *)
+ END;
+ END;
+ END;
+
+ PROCEDURE mark;
+ (* "recursively" mark pairs referred to from gcstk. gcstk is used to *)
+ (* simulate recursion. *)
+ VAR
+ prloc: integer;
+ BEGIN
+ WHILE gcstkp > 0 DO
+ BEGIN
+ prloc := gcstk[gcstkp];
+ gcstkp := gcstkp - 1;
+ prspace[prloc].markflg := true;
+ pushref(prspace[prloc].prcdr);
+ pushref(prspace[prloc].prcar); (* trace the car first. *)
+ END;
+ END;
+
+ BEGIN (* xgcollect *)
+ writeln('***GARBAGE COLLECTOR CALLED');
+ gccount := gccount + 1; (* count garbage collections. *)
+ xfaststat; (* give summary of statistics collected *)
+ consknt := 0; (* clear out the cons/pair counters *)
+ pairknt := 0;
+ gcstkp := 0; (* initialize the garbage stack pointer. *)
+ mxgcstk := 0; (* keeps track of max stack depth. *)
+
+ (* mark things from the "computation" stack. *)
+ FOR i := 1 TO st DO
+ BEGIN
+ pushref(stk[i]);
+ mark;
+ END;
+ (* mark things from identifier space. *)
+ FOR i := 1 TO maxident DO
+ BEGIN
+ pushref(idspace[i].val);
+ mark;
+ pushref(idspace[i].plist);
+ mark;
+ pushref(idspace[i].funcell);
+ mark;
+ END;
+
+ (* reconstruct free list by adding things to the head. *)
+ freedk := 0;
+ markedk := 0;
+ FOR i:= 1 TO maxpair - 1 DO
+ BEGIN
+ IF prspace[i].markflg THEN
+ BEGIN
+ markedk := markedk + 1;
+ prspace[i].markflg := false
+ END
+ ELSE
+ BEGIN
+ prspace[i].prcar := nilref;
+ mkitem(pairtag, freepair, prspace[i].prcdr);
+ freepair := i;
+ freedk := freedk + 1
+ END
+ END;
+ writeln(freedk,' PAIRS FREED.');
+ writeln(markedk,' PAIRS IN USE.');
+ writeln('MAX GC STACK WAS ',mxgcstk);
+ END;
+ (* xgcollect *)
+
+ (********************************************************)
+ (* *)
+ (* lisp primitives *)
+ (* *)
+ (********************************************************)
+
+ (* return r[1].r[2] in r[1] *)
+PROCEDURE xcons;
+ VAR p: integer;
+
+ BEGIN
+ (* push args onto stack, in case we need to garbage collect the *)
+ (* references will be detected. *)
+ alloc(2);
+ stk[st] := r[1];
+ stk[st-1] := r[2];
+
+ IF prspace[freepair].prcdr = nilref THEN xgcollect;
+
+ p := freepair;
+ freepair := info_of(prspace[p].prcdr);
+ prspace[p].prcar := stk[st];
+ prspace[p].prcdr := stk[st - 1];
+ mkpair(p, 1); (* leave r[1] pointing at new pair. *)
+
+ pairknt := pairknt + 1;
+ consknt := consknt + 1;
+ dealloc(2);
+ END;
+
+PROCEDURE xncons;
+ BEGIN r[2] := nilref;
+ xcons;
+ END;
+
+PROCEDURE xxcons;
+ BEGIN rxx := r[1];
+ r[1] := r[2];
+ r[2] := rxx;
+ xcons;
+ END;
+
+ (* return car of r[1] in r[1] *)
+PROCEDURE xcar;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcar
+ ELSE
+ mkitem(errtag, notpair, r[1]);
+ END;
+
+PROCEDURE xcdr;
+ BEGIN
+ IF tag_of(r[1]) = pairtag THEN
+ r[1] := prspace[info_of(r[1])].prcdr
+ ELSE
+ mkitem(errtag, notpair, r[1]);
+ END;
+
+ (* anyreg car and cdr *)
+PROCEDURE anycar(VAR a, b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcar
+ ELSE
+ mkitem(errtag, notpair, b);
+ END;
+
+PROCEDURE anycdr(VAR a, b: itemref);
+ BEGIN
+ IF tag_of(a) = pairtag THEN
+ b := prspace[info_of(a)].prcdr
+ ELSE
+ mkitem(errtag, notpair, b);
+ END;
+
+ (********************************************************)
+ (* *)
+ (* i/o primitives *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE xterpri;
+ (* need to change for multiple output channels. *)
+ (* improve choice of break/nobreak. *)
+ BEGIN
+ writeln(output);
+ END;
+
+
+PROCEDURE xwrtok;
+ (* doesn't expand escaped characters in identifier names *)
+ VAR
+ i: integer;
+ BEGIN
+ IF tag_of(r[1]) = inttag THEN
+ BEGIN
+ IF info_of(r[1]) = 0 THEN
+ write('0')
+ ELSE
+ write(info_of(r[1]): 2+trunc(log(abs(info_of(r[1])))));
+ END
+
+ ELSE IF tag_of(r[1]) = bigtag THEN
+ write(intspace[info_of(r[1])])
+
+ ELSE IF tag_of(r[1]) = flotag THEN
+ write(flospace[info_of(r[1])])
+
+ ELSE IF tag_of(r[1]) = idtag THEN
+ BEGIN
+ i := idspace[info_of(r[1])].idname;
+ WHILE (i <= maxstrsp) AND (strspace[i] <> chr(eos)) DO
+ BEGIN
+ write(strspace[i]);
+ i:= i + 1;
+ END;
+ END
+
+ ELSE IF tag_of(r[1]) = chartag THEN
+ write(chr(info_of(r[1]) - choffset))
+
+ ELSE
+ writeln('XWRTOK GIVEN ',tag_of(r[1]), info_of(r[1]));
+ END;
+
+PROCEDURE rdchnl(chnlnum: integer; VAR ch: onechar);
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ writeln('*****BAD INPUT CHANNEL FOR RDCHNL')
+ ELSE
+ CASE chnlnum OF
+ 1: BEGIN
+ ch := symin^; (* a little strange, but avoids *)
+ get(symin); (* initialization problems *)
+ ichrbuf[inchnl] := symin^;
+ END;
+
+ 2: BEGIN
+ ch := input^;
+ get(input);
+ ichrbuf[inchnl] := input^;
+ END;
+ END;
+ (* case *)
+ END;
+ (* rdchnl *)
+
+FUNCTION eofchnl(chnlnum: integer): boolean;
+ BEGIN
+ IF (chnlnum < 1) OR (chnlnum > inchns) THEN
+ writeln('*****BAD INPUT CHANNEL FOR EOFCHNL')
+ ELSE
+ CASE chnlnum OF
+ 1: eofchnl := eof(symin);
+ 2: eofchnl := eof(input);
+ END;
+ END;
+
+ (********************************************************)
+ (* *)
+ (* token scanner *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xrdtok;
+ VAR
+ ch: onechar;
+ i: integer;
+ anint: longint;
+ moreid: boolean;
+ found: boolean;
+
+ FUNCTION digit(ch: onechar): boolean;
+ BEGIN
+ digit := ( '0' <= ch ) AND ( ch <= '9');
+ END;
+
+ FUNCTION escalpha(VAR ch: onechar): boolean;
+ (* test for alphabetic or escaped character. *)
+ (* note possible side effect. *)
+ BEGIN
+ IF ( 'A' <= ch ) AND ( ch <= 'Z') THEN
+ escalpha := true
+ ELSE IF ( ord('A')+32 <= ord(ch)) AND ( ord(ch) <= ord('Z')+32) THEN
+ escalpha := true (* lower case alphabetics *)
+ ELSE IF ch='!' THEN
+ BEGIN
+ rdchnl(inchnl,ch);
+ escalpha := true;
+ END
+ ELSE
+ escalpha := false;
+ END;
+
+ FUNCTION alphanum(VAR ch: onechar): boolean;
+ (* test if escalfa or digit *)
+ VAR b: boolean;
+ BEGIN
+ b := digit(ch);
+ IF NOT b THEN b := escalpha(ch);
+ alphanum := b;
+ END;
+
+ function whitesp(ch: onechar): boolean; *)
+ var asccode: integer; *)
+ begin
+ asccode := ord(ch); (* ascii character code *)
+ WHITESP := (CH = SP) OR (ASCCODE = CR) OR (ASCCODE = LF)
+ OR (asccode = ht) or (asccode = nul); (* null?? *)
+ end;
+ (* end of terak version *)
+
+ (* reads bignums...need to read flonums too *)
+ BEGIN (* xrdtok *)
+ IF NOT eofchnl(inchnl) THEN
+ REPEAT (* skip leading white space. *)
+ rdchnl(inchnl,ch)
+ UNTIL (NOT whitesp(ch)) OR eofchnl(inchnl);
+ IF eofchnl(inchnl) THEN
+ mkitem(chartag, eofcode + choffset, r[1])
+ (* should really return !$eof!$ *)
+ ELSE
+ BEGIN
+ IF digit(ch) THEN
+ set_tag(r[1], inttag)
+ ELSE IF escalpha(ch) THEN
+ set_tag(r[1], idtag)
+ ELSE
+ set_tag(r[1], chartag);
+
+ CASE tag_of(r[1]) OF
+ chartag: BEGIN
+ set_tag(r[1], idtag);
+ mkitem(inttag, chartype, idspace[xtoktype].val);
+ set_info(r[1], ord(ch) + choffset);
+ END;
+ inttag: BEGIN
+ mkitem(inttag, inttype, idspace[xtoktype].val);
+ anint := ord(ch) - ord('0');
+ WHILE digit(ichrbuf[inchnl]) DO
+ BEGIN
+ rdchnl(inchnl,ch);
+ anint := 10 * anint + (ord(ch) - ord('0'))
+ END;
+ set_info(r[1], anint)
+ END;
+ idtag: BEGIN
+ mkitem(inttag, idtype, idspace[xtoktype].val);
+ i := freestr; (* point to possible new string *)
+ moreid := true;
+ WHILE (i < maxstrsp) AND moreid DO
+ BEGIN
+ strspace[i] := ch;
+ i:= i + 1;
+ moreid := alphanum(ichrbuf[inchnl]);
+ IF moreid THEN
+ rdchnl(inchnl,ch);
+ END;
+ strspace[i] := chr(eos); (* terminate string *)
+ IF (i >= maxstrsp) THEN
+ writeln('*****STRING SPACE EXHAUSTED')
+ ELSE (* look the name up, return itemref for it *)
+ BEGIN
+ putnm(freestr, r[1], found);
+ IF NOT found THEN
+ freestr := i + 1;
+ END;
+ END;
+ (* of case idtag *)
+ END;
+ (* of case *)
+ END;
+ END;
+ (* xrdtok *)
+
+ (********************************************************)
+ (* *)
+ (* initialization *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xread;
+ FORWARD;
+
+PROCEDURE init;
+ (* initialization procedure depends on *)
+ (* ability to load stack with constants *)
+ (* from a file. *)
+ VAR
+ strptr: stringp;
+ nam: PACKED ARRAY[1..3] OF onechar;
+ (* holds 'nil', other strings? *)
+ i, n: integer;
+ idref: itemref;
+ found: boolean;
+
+ (* init is divided into two parts so it can compile on terak *)
+ PROCEDURE init1;
+ BEGIN
+ (* initialize top of stack *)
+ st := 0;
+
+ freefloat := 1;
+ freeint := 1;
+
+ (* define nilref - the id, nil, is defined a little later. *)
+ freeident := 1;
+ mkitem(idtag, freeident, nilref);
+
+ (* initialize pair space. *)
+ FOR i := 1 TO maxpair - 1 DO (* initialize free list. *)
+ BEGIN
+ prspace[i].markflg := false; (* redundant? *)
+ prspace[i].prcar := nilref; (* just for fun *)
+ mkitem(pairtag, i + 1, prspace[i].prcdr);
+ END;
+ prspace[maxpair].prcar := nilref;
+ prspace[maxpair].prcdr := nilref; (* end flag *)
+ freepair := 1; (* point to first free pair *)
+
+
+ (* initialize identifier space and string space. *)
+ freestr := 1;
+ FOR i := 0 TO hidmax - 1 DO
+ idhead[i] := nillnk;
+ FOR i := 1 TO maxident DO
+ BEGIN
+ IF i < maxident THEN
+ idspace[i].idhlink := i + 1
+ ELSE (* nil to mark the final identifier in the table. *)
+ idspace[i].idhlink := nillnk;
+ (* set function cells to undefined *)
+ mkitem(errtag, undefined, idspace[i].funcell);
+ END;
+
+ (* nil must be the first identifier in the table--id #1 *)
+ (* must fill in fields by hand for nilref.*)
+ (* putnm can handle any later additions. *)
+ nam := 'NIL';
+ strptr := freestr;
+ FOR i := 1 TO 3 DO
+ BEGIN
+ strspace[strptr] := nam[i];
+ strptr:= strptr + 1;
+ END;
+ strspace[strptr] := chr(eos);
+ putnm(freestr, nilref, found);
+ IF NOT found THEN
+ freestr := strptr + 1;
+
+ (* make the single character ascii identifiers, except nul(=eos). *)
+ FOR i := 1 TO 127 DO
+ BEGIN
+ strspace[freestr] := chr(i);
+ strspace[freestr + 1] := chr(eos);
+ putnm(freestr, idref, found);
+ IF NOT found THEN
+ freestr := freestr + 2;
+ IF i = ord('T') THEN
+ trueref := idref;
+ (* returns location for 't. *)
+ END;
+
+ (* clear the counters *)
+ gccount := 0;
+ consknt := 0;
+ pairknt := 0;
+ END;
+ (* init1 *)
+
+ PROCEDURE init2;
+ BEGIN
+ (* load "symbol table" with identifiers, constants, and functions. *)
+ inchnl := 1; (* select symbol input file. *)
+ reset(symin,'#5:paslsp.data'); (* for terak *)
+
+ xrdtok; (* get count of identifiers. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED AT START');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ xrdtok;
+ (* reading token magically loads it into id space. *)
+ xrdtok; (* look for zero terminator. *)
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER IDENTIFIERS');
+
+ xrdtok; (* count of constants *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE CONSTANTS');
+ n := info_of(r[1]);
+ alloc(n); (* space for constants on the stack *)
+ FOR i := 1 TO n DO
+ BEGIN
+ xread;
+ stk[i] := r[1];
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER CONSTANTS');
+
+ xrdtok; (* count of functions. *)
+ IF tag_of(r[1]) <> inttag THEN
+ writeln('*****BAD SYMBOL TABLE, INTEGER EXPECTED BEFORE FUNCTIONS');
+ n := info_of(r[1]);
+ FOR i := 1 TO n DO
+ (* for each function *)
+ (* store associated code *)
+ BEGIN
+ xrdtok;
+ mkitem(codetag, i, idspace[info_of(r[1])].funcell);
+ END;
+ xrdtok;
+ IF (tag_of(r[1]) <> inttag) OR (info_of(r[1]) <> 0) THEN
+ writeln('*****BAD SYMBOL TABLE, ZERO EXPECTED AFTER FUNCTIONS');
+
+ inchnl := 2; (* select standard input. *)
+ END;
+ (* init2 *)
+ BEGIN (* init *)
+ init1;
+ init2;
+ END;
+ (* init *)
+
+ (********************************************************)
+ (* *)
+ (* arithmetic functions *)
+ (* *)
+ (********************************************************)
+
+PROCEDURE xadd1;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(i + 1, 1)
+ END;
+
+PROCEDURE xdifference;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 - i2, 1)
+ END;
+
+PROCEDURE xdivide; (* returns dotted pair (quotient . remainder). *)
+ VAR quot, rem: integer;
+ i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ mkint(i1 DIV i2, 1);
+ mkint(i1 MOD i2, 2);
+ xcons
+ END;
+
+PROCEDURE xgreaterp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 > i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xlessp;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+
+ IF i1 < i2 THEN
+ r[1] := trueref
+ ELSE
+ r[1] := nilref;
+ END;
+
+PROCEDURE xminus;
+ VAR i: longint;
+
+ BEGIN
+ int_val(r[1], i);
+ mkint(-i, 1)
+ END;
+
+PROCEDURE xplus2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 + i2, 1)
+ END;
+
+PROCEDURE xquotient;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 DIV i2, 1)
+ END;
+
+PROCEDURE xremainder;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 MOD i2, 1)
+ END;
+
+PROCEDURE xtimes2;
+ VAR i1, i2: longint;
+
+ BEGIN
+ int_val(r[1], i1);
+ int_val(r[2], i2);
+ mkint(i1 * i2, 1)
+ END;
+ (* xtimes2 *)
+
+
+ (********************************************************)
+ (* *)
+ (* support for eval *)
+ (* *)
+ (********************************************************)
+
+
+PROCEDURE execute(code: integer);
+ FORWARD;
+
+ (* apply(fn,arglist)-- "fn" is an operation code. *)
+PROCEDURE xapply;
+ VAR
+ i: integer;
+ code: integer;
+ tmp: itemref;
+ tmpreg: ARRAY[1..maxreg] OF itemref;
+ BEGIN
+ code := info_of(r[1]);
+ r[1] := r[2];
+ i := 1;
+ (* spread the arguments *)
+ WHILE (r[1] <> nilref) AND (i <= maxreg) DO
+ BEGIN
+ tmp := r[1];
+ xcar;
+ tmpreg[i] := r[1];
+ i := i + 1;
+ r[1] := tmp;
+ xcdr;
+ END;
+ WHILE i > 1 DO
+ BEGIN
+ i := i - 1;
+ r[i] := tmpreg[i];
+ END;
+ execute(code);
+ END;
+
+ (* rest of pas1...pasn follow *)
+
ADDED perq-pascal-lisp-project/user.sli
Index: perq-pascal-lisp-project/user.sli
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/user.sli
@@ -0,0 +1,10 @@
+% user LISP init for PASLSP
+
+(PRINT "User Init Start")
+(DN LIST (AA) AA)
+(SETQ INITFORM!* '(RDEVPR))
+(DF ON (X) (SET (CAR X) T))
+(DF OFF (X) (SET (CAR X) NIL))
+(ON !*RAISE)
+(OFF !*ECHO)
+(PRINT "User Init End")
ADDED perq-pascal-lisp-project/wicat-paslsp.aux
Index: perq-pascal-lisp-project/wicat-paslsp.aux
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/wicat-paslsp.aux
@@ -0,0 +1,8 @@
+@Comment{AUXFILE of WICAT-PASLSP.MSS.1 by Scribe 3C(1250) on 1 March 1982 at 15:57}
+@AuxCitation{BENSON81$=(1;;)}
+@AuxCitation{BRANDT81$=(2;;)}
+@AuxCitation{GRISS79$=(3;;)}
+@AuxCitation{GRISS81$=(4;;)}
+@AuxCitation{GRISS81E$=(5;;)}
+@AuxCitation{HEARN73$=(6;;)}
+@AuxCitation{MARTI79$=(7;;)}
ADDED perq-pascal-lisp-project/wicat-paslsp.err
Index: perq-pascal-lisp-project/wicat-paslsp.err
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/wicat-paslsp.err
@@ -0,0 +1,5 @@
+@Comment{ErrLog of WICAT-PASLSP.MSS.1 by Scribe 3C(1250) on 1 March 1982 at 15:57}
+
+Error found while finishing up after the end of the manuscript:
+Cross references to 7 labels could be wrong.
+Run the file through Scribe again if you need to be sure they are right.
ADDED perq-pascal-lisp-project/wicat-paslsp.lpt
Index: perq-pascal-lisp-project/wicat-paslsp.lpt
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/wicat-paslsp.lpt
@@ -0,0 +1,808 @@
+Utah Symbolic Computation Group December 1981
+Operating Note 60
+
+
+
+
+
+
+
+
+
+
+ A PASCAL Based Standard LISP for the Wicat 100
A PASCAL Based Standard LISP for the Wicat 100
A PASCAL Based Standard LISP for the Wicat 100
+
+
+ by
+
+ M. L. Griss and R. Ottenheimer
+
+ Department of Computer Science
+ University of Utah
+ Salt Lake City, Utah 84112
+
+ Preliminary Version
Preliminary Version
Preliminary Version
+
+ Last Revision: 1 March 1982
+
+
+
+
+
+
+ ABSTRACT
ABSTRACT
ABSTRACT
+
+
+This report describes an interim implementation of Standard LISP
+for the Wicat 100. This LISP is based upon the Standard LISP
+report, and a newly developing Portable Standard LISP. This
+interim implementation is designed to explore LISP
+implementations in PASCAL on the Wicat 100 and similar machines.
+The system consists of a kernel, handcoded in PASCAL, with the
+rest of the system written in LISP and compiled to PASCAL.
+
+
+
+
+
+
+
+
+
+Work supported in part by the National Science Foundation under
+Grant No. MCS80-07034.
Wicat Pascal LISP 1 March 1982 1
+
+
+1. Introduction
1. Introduction
1. Introduction
+
+ In this preliminary report, we describe an implementation of
+Standard LISP in PASCAL, PASLSP. Versions of PASLSP have been run
+on a number of machines, ranging from an LSI-11 based TERAK to
+Apollo and PERQ. This report concentrates on the Wicat 100
+implementation. This report is to be read in conjunction with the
+Standard LISP report [Marti79]; we will highlight the differences
+from the functions documented in the Standard LISP, describe the
+implementation strategy, and discuss future work.
+
+
+ PASLSP is based on a series of small and medium sized LISP
+interpreters that have been developed at the University of Utah
+to explore LISP implementations in higher level languages. Each
+of these LISP systems consists of a small kernel handcoded in
+some language, with the rest of the system written in LISP and
+compiled to the target language. We have used FORTRAN, PASCAL
+and assembly language as targets. The PASLSP series use PASCAL
+for the kernel, and have a LISP to PASCAL compiler for the rest
+of the system.
+
+
+ Recent work has concentrated on reducing the size of the
+hand-coded kernel, and extending the compiler to handle systems
+level constructs. This has resulted in a new Portable Standard
+LISP, PSL, running on the DEC-20 and
+VAX-11/750 [Benson81, Griss81]. An implementation of PSL for
+MC68000 is underway. The PSL system is a modern, efficient LISP,
+written entirely in itself; it uses an efficient LISP to machine
+code compiler to produce the kernel, and then the rest of LISP is
+loaded. In the future we hope to produce a complete PSL targeted
+at a higher level languages, such as PASCAL, C or ADA, and this
+will replace the current PASLSP.
+
+
+1.1. History of PASLSP
1.1. History of PASLSP
1.1. History of PASLSP
+
+ The system now called PASLSP was originally developed (by
+M. Griss and W. Galway), as a small LISP like kernel to support a
+small computer algebra system on an LSI-11 TERAK; this was to be
+used as an answer analysis module within a CAI system [Brandt81],
+written entirely in PASCAL. It was decided to hand-code a very
+small kernel, and compile additional functions written in LISP
+(LISP support functions, parser and simplifier) to PASCAL, using
+a modified Portable LISP compiler [griss79]. This version (call
+it V0) did not even have user defined functions, since space on
+the TERAK was at a premium.
+
+
+ About June 1981, PASLSP came to the attention of a number
+people evaluating Apollo's and PERQ's, and it was suggested that
Wicat Pascal LISP 1 March 1982 2
+
+
+we enhance V0 PASLSP for this purpose. During the space of a few
+days, features taken from the Standard LISP Report and newly
+developing PSL files were added to produce PASLSP-V1, running on
+a DEC-20 and Terak. This was a fairly complete LISP (including
+Catch and Throw), but lacked a few features (OPEN, CLOSE, RDS,
+WRS, PROG, GO, RETURN, COMPRESS, EXPLODE, Vectors and Strings,
+etc.). V1 PASLSP was adapted to a PERQ, VAX and Apollo by Paul
+Milazo of Schlumberge in the space of a few weeks (we did not
+have a PERQ or Apollo at that time).
+
+
+ We subsequently obtained a PERQ, Apollo and a Wicat, and recent
+work has been aimed at producing an enhanced PASLSP for these
+machines, maintaining all versions in one set of source files.
+The current system, PASLSP-V2, is produced from a single PASCAL
+kernel and set of LISP support files; the machine specific
+features are handled by a simple Source Code Conditionalizer,
+changing the definition of certain constants and data types. Only
+a few features of the Standard LISP report are missing, and there
+are a number of additions.
+
+
+1.2. Acknowledgement
1.2. Acknowledgement
1.2. Acknowledgement
+
+ We would like to acknowledge the contributions and support of
+Eric Benson, Dick Brandt, Will Galway, and Paul Milazo.
+
+
+
+2. Features of PASLSP and relation to Standard LISP
2. Features of PASLSP and relation to Standard LISP
2. Features of PASLSP and relation to Standard LISP
+
+ PASLSP as far as possible provides all the functions mentioned
+in the attached Standard LISP Report (note the hand-written
+comments added to this appendix); some of the functions are
+simply stubs, so that a Standard LISP Test-file can be run
+without major modification.
+
+
+ PASLSP-V2 does not implement the following features of Standard
+LISP:
+
+
+ a. VECTORS (only a simple garbage collector is used).
+ b. Strings are implemented as identifiers (not garbage
+ collected).
+ c. Integers are limited in size (INTs and FIXNUMs, no
+ BIGNUMs).
+ d. FLOATING Point is not implemented.
+ e. IDs can not be REMOB'ed or INTERN'd.
+ f. Only 3 Input Channels and 2 Output Channels are
+ available to OPEN, RDS, WRS, and CLOSE. Thus file
+ input statements can not be nested very deeply in
Wicat Pascal LISP 1 March 1982 3
+
+
+ files.
+ g. Line, Page and Character counting (POSN, LPOSN, etc)
+ are not implemented.
+
+
+ PASLSP-V2 provides some extensions over Standard LISP:
+
+
+ a. (CATCH form) and (THROW form) and the tagged versions:
+ (TCATCH tag form) and (TTHROW tag form) are used to
+ implement error and errorset, and higher level control
+ functions.
+ b. Implicit PROGN in COND, and LAMBDA expressions.
+ c. (WHILE pred action-1 action-2 ... action-n).
+ d. (DSKIN 'filename) or (DSKIN "filename")
+
+
+ PASLSP-V2 has not been extensively tested, and there may still
+be a number of bugs. While some effort has been spent in
+adjusting PASLSP to the Wicat, it is clear that the various heap
+sizes are not yet optimal. See appendix A for current list of
+functions, and appendix B for a copy of the Standard LISP Report
+annotated to reflect the current status of PASLSP.
+
+
+
+3. Using PASLSP on the Wicat 100
3. Using PASLSP on the Wicat 100
3. Using PASLSP on the Wicat 100
+
+ Initializing the system from the floppy looks like this:
+
+
+Create a directory (call it pl):
+Mount the floppy:
+Copy the files of interest:
+
+ The files copied will be: paslsp (executable file)
+ paslsp.ini (initialization file)
+ paslsp.tst (a test file)
+
+
+ Run paslsp as you would any other file. If you get an error it
+is most likely because the paslsp.ini file couldn't be found. If
+this happens, locate paslsp.ini and try again. If it still
+hangs, try calling Ralph Ottenheimer at (801) 355-0226 or
+M. Griss at (801) 581-6542.
+
+
+ Previously prepared files of LISP (e.g., library procedures)
+can be input by using the function "DSKIN". For Example,
+
+
+(DSKIN 'Paslsp!.tst) or (DSKIN "Paslsp.tst")
Wicat Pascal LISP 1 March 1982 4
+
+
+would load the paslsp test file. The PASLSP test is adapted from
+an extensive test of Standard LISP (avoiding features not yet
+implemented). This is a good excercise, try it. [Note that if
+the filename is given as an ID, that special characters should be
+prefaced by an "escape character", ! . This is also the case for
+filenames in OPEN. Alternately the string form may be used, in
+that case special characters need not be escaped.]
+
+
+ Paslsp is "case-sensitive" with regard to identifiers. All of
+the kernel procedures have upper-case identifiers associated with
+them. This means that ordinarily the expression (dskin
+'paslsp!.tst) would not be recognized since "dskin" is in
+lowercase. However, there is a global flag !*RAISE which if true
+will convert all lower-case typin to upper-case. This Wicat 100
+paslsp implementation sets !*RAISE to T as a default by having
+(SETQ !*RAISE T) in the paslsp.ini file. You may put any special
+initialization code you like at the end of paslsp.ini as
+indicated by the comments in the file. Toggling would be
+accomplished by typing the following lisp-expressions:
+
+
+ (ON !*RAISE) equivalent to (SETQ !*RAISE T)
+ (OFF !*RAISE) equivalent to (SETQ !*RAISE NIL)
+
+
+ Any Wicat 100 filename (60 characters maximum)is allowable as a
+paslsp filename. Remember to prefix all special characters with
+an exclamation-mark: "!". Special characters include all
+non-alphanumerics. For example: !*RAISE goforit!! paslsp!.test
+!/login!/smith!/foo!.sl .
+
+
+ If the global !*ECHO is not NIL (default is NIL), input will be
+echoed to the selected output channel. It is sometimes
+convienient to put:
+
+
+ (SETQ !*ECHO T)
+
+
+at the beginning of a file to be read by DSKIN, and:
+
+
+ (SETQ !*ECHO NIL)
+
+
+at the end. This will echo the file to the screen (or to a file)
+as it is read.
+
+
+ Certain low level errors do not display any explanatory message
Wicat Pascal LISP 1 March 1982 5
+
+
+but instead display a numeric code (such as *** # 2), below is a
+summary of these codes and their meanings:
+
+
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on non-pair.*)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells *)
+ noint = 5; (* no free integer space after gc. *)
+ notid = 6; (* id was expected *)
+
+
+
+4. Implementation of PASLSP
4. Implementation of PASLSP
4. Implementation of PASLSP
+
+
+4.1. Building PASLSP
4.1. Building PASLSP
4.1. Building PASLSP
+
+ PASLSP is built in the following steps:
+
+
+ ______ _____
Kernel files, PAS0.PRE, and trailer file (main program)
+PASN.PRE are run through a filter program to produce PAS0.PAS and
+PASN.PAS, tailored to the Wicat 100 (appropriate Include files,
+Consts, etc). This kernel provides the Basic I/O (Token reading
+and printing), handcoded storage allocator and garbage collector,
+lowlevel arithmetic primitives, lowlevel calls (via Case
+statement) from LISP to kernel, etc.
+
+
+ ____ __ ____
Rest of LISP, currently files PAS1.RED, PAS2.RED and PAS3.RED
+are compiled to PASCAL using a version of the Portable LISP
+Compiler (PLC) [griss79]. During compilation, a Symbol Table
+file, PASn.SYM is read in and written out. These files record
+(for "incremental" compilation) the names and ID table locations
+of each ID encountered, so that the compiler can refer to an ID
+by its offset in the ID table. LISP constants are also recorded
+in the PASn.SYM files. PAS0.SYM is modified by hand as the kernel
+is changed.
+
+
+ The compilation model used is that of a Register Machine:
+Arguments to LISP functions are passed in registers (a PASCAL
+array), and the result returned in Register 1. Space is allocated
+on a software stack (not the PASCAL recursion stack), for any
+temporaries or save arguments required. Short functions usually
+do not require any stack. The reason for this choice was the
+existence of the PLC (targeted at comventional machines), and the
+fact that inline access to the register array compiles quite
+well, while a "PUSH/POP" stack would be much less efficient.
Wicat Pascal LISP 1 March 1982 6
+
+
+ ______________
Initialization. After the PAS0.PAS,..PASN.PAS are produced,
+the symbol table file (pas3.sym) is converted into a file
+PASLSP.INI, which contains the names of all ID's, the LISP
+constants used, and also ID's for all kernel functions that
+should be known to the user LISP level. Also produced is a file,
+EXEC.PAS, that contains a case statement associating each user
+callable kernel function with an integer. The PAS0.PAS ...
+PASN.PAS and EXEC.PAS are compiled and linked into an executable
+file. When this file is executed, PASLSP.INI is read in: each id
+is read and stored in the appropriate location in the
+symbol-table, the kernel function names have the associated Case
+index put into a function cell, and the LISP s-expressions are
+READ in. Finally, some s-expressions will be executed (with care,
+the user can add his own expressions, including requests to
+(DSKIN 'library), etc.
+
+
+4.2. Internal data structures
4.2. Internal data structures
4.2. Internal data structures
+
+ The data spaces (or heaps) in PASLSP are divided into 4
+sections: the pair space, id space (the oblist), string space and
+large integer (fixnum) space. These are all arrays of objects of
+the appropriate type (see declarations below). The system is
+fully tagged, that is, every LISP item has associated with it a
+tag field which denotes the type of the item and an 'info' field
+which either points to the item in an array (in the case of
+pairs, identifiers and fixnums), or contains the information
+itself (in the case of inums, character codes and error
+conditions). The info field of a code pointer contains the index
+into a case staement (see procedure 'execute') by means of which
+any LISP callable function may be invoked.
+
+
+itemref = RECORD
+ tag: integer; (* Small integer denoting type. *)
+ info: integer; (* Item or a pointer to it *)
+ (* depending upon the type. *)
+ END;
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ END;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
Wicat Pascal LISP 1 March 1982 7
+
+
+4.3. Adding user functions to the kernel
4.3. Adding user functions to the kernel
4.3. Adding user functions to the kernel
+
+ It is fairly easy to add handcoded Pascal functions to the
+kernel so that they can be called from LISP. For example,
+consider adding the function SQR(x), that squares its integer
+argument. Since SQR is already the name of an existing PASCAL
+function, we will call it "Xsqr" in PASCAL, and SQR in LISP.
+
+
+ The function Xsqr has to take its argument from R[1], check
+that it is an integer, square the information part, and retag as
+integer:
+
+
+PROCEDURE Xsqr;
+ VAR i1 : longint;
+
+ BEGIN
+ int_val(r[1], i1); (* Test type and extract Info *)
+ mkint(i1 * i1, 1) (* Square, retag, and put in R[1] *)
+ END;
+
+
+ Now procedure Xsqr needs be to be installed into the EXECUTE
+table, so that it can be found as the N'th code item. The number
+of defined procedures will have to be increased by 1 in the 3'rd
+line of procedure EXECUTE, (currently 201 defined), and an
+additional case added:
+
+
+202: Xsqr;
+
+
+ Note also that this table gives the Internal names of each
+available procedure, should one of these be required in your
+handcoded procedure. Finally, the Identifier SQR needs to be
+associated with case 202 in PASLSP.INI. Note that PASLAP.INI has
+3 tables of objects, each prefixed by a count and terminated by a
+0. The first is the Random ID table, consisting of special ID's
+used for messages etc. The second block is for S-expression
+constants, which get loaded into the base of the stack as
+Globals. The next batch are the names of LISP callable functions
+in the order corresponding to the EXECUTE procedure. Simply
+modify the count form 201 to 202 (or whatever), and add SQR at
+the end, just before the 0.
+
+
+ In general, look for a sample procedure in the kernel if
+possible, or in the compiled part (although these are hard to
+follow), and adapt to the specific needs. Note the use of the
+ALLOC(n) and DEALLOC(n) procedures to allocate a block of
+temporaries on the stack. These should be used, rather than
Wicat Pascal LISP 1 March 1982 8
+
+
+PASCAL VAR's, since the garbage collector may need to trace from
+one of the saved objects.
+
+
+
+5. Future work on PASLSP
5. Future work on PASLSP
5. Future work on PASLSP
+
+ PASLSP V2 is based on a fairly old model of a portable LISP,
+and has been used mainly to explore the capbilities of PASCAL as
+a target language. In particular, V2 PASCAL is not yet powerful
+enough to run the PLC compiler itself; instead, the PLC is run on
+our PSL system on the DEC-20. In order for the full benefits of
+PASLSP (or PSL) to be realized, the user should be able to
+compile his own LISP modules into PASCAL and link them with the
+kernel. In order to make the system even more adapatable, we
+would like to write even less of the kernel in PASCAL by hand.
+This goal has lead us to the development of PSL.
+
+
+5.1. Goals of the Utah PSL Project
5.1. Goals of the Utah PSL Project
5.1. Goals of the Utah PSL Project
+
+ The goal of the PSL project is to produce an efficient and
+transportable Standard LISP system that may be used to:
+
+
+ a. Experimentally explore a variety of LISP
+ implementation issues (storage management, binding,
+ environments, etc.).
+
+ b. Effectively support the REDUCE computer algebra
+ system [hearn73] on a number of machines.
+
+ c. Provide the same, uniform, modern LISP programming
+ environment on all of the machines that we use
+ (DEC-20, VAX/750, PDP-11/45, PERQ, Wicat and Apollo),
+ of the power and complexity of UCI-LISP, FranzLISP or
+ MACLISP, with some extensions and enhancements derived
+ from LISP Machine LISP or CommonLISP.
+
+
+ entire
entire
The approach we have been using is to write the entire LISP
+system in PSL (using LISP extensions for dealing with machine
+words and operations), and to bootstrap it to the desired target
+machine in two steps:
+
+
+ a. Cross compile an appropriate kernel to the assembly
+ language of the target machine;
+
+ b. Once the kernel is running, use a resident compiler
+ and loader, or fast-loader, to build the rest of the
+ system.
Wicat Pascal LISP 1 March 1982 9
+
+
+ The PASLSP system, and other early implementations, have the
+problem that the implementation language (PASCAL) is a distinct
+language from LISP, so that communication between "system" code
+and "LISP" code was difficult. We have incorporated all of the
+good features of the earlier work into a new efficient LISP-like
+systems language, SYSLISP, recoded all useful modules into
+SYSLISP, and proceeded from there. SYSLISP currently produces
+targeted assembly code; earlier verisions were targeted at
+high-level languages such as FORTRAN, PASCAL, C or ADA. The goal
+is a portability strategy that leads to an efficient enough
+system for a production quality, yet portable system. We
+currently think of the extensions to Standard LISP as having two
+levels: the SYSLISP level, dealing with words and bytes and
+machine operations, enabling us to write essentially all of the
+kernel in Standard LISP; and, the LISP level, incorporating all
+of the features that make PSL into a modern LISP. Both modes of
+PSL are compiled by an improved version of the Portable Standard
+LISP Compiler. The SYSLISP mode of the PSL compiler does
+compile-time folding of constants, and more comprehensive
+register allocation than the previous LISP-only version of the
+compiler.
+
+
+ The current state of PSL is fully described in an "overview"
+document obtainable from the authors [griss81e]. Currently PSL
+runs on the DEC-20 under TOPS-20, and on the DEC VAX-11/750 under
+Unix. We are now concentrating on the MC68000 PSL for the
+Apollo. All of the code-generators and assembler support is
+complete, and a number of large files have been compiled from
+LISP to assembly code, and correctly assembled and executed on
+the Apollo, testing basic I/O and arithmetic. We are now in the
+process of writing the PSL support code (small functions in LAP),
+and testing that various decisions about register and memory
+usage are correct. Based on the development history on the VAX,
+we are about 1-2 months away from a preliminary PSL on the
+Apollo.
+
+
+
+6. References
6. References
6. References
+
+[1] Benson, E. and Griss, M. L.
+ _______ _ ________ ____ _____ _______ ______________
SYSLISP: A portable LISP based systems implementation
+ ________
language.
+ Utah Symbolic Computation Group, Report UCP-81, University
+ of Utah, February, 1981.
+
+[2] Brandt, R. C. and Knapp, B. H.
+ The University of Utah Video Computer Authoring System.
+ ___________ __ ___ _________ __ ________ __________
In Proceedings of the Symposium on Learning Technology,
+ pages 18-23. Orlando, Florida, Feb, 1981.
Wicat Pascal LISP 1 March 1982 10
+
+
+[3] Griss, M. L.; Kessler, R. R.; and Maguire, G. Q. Jr.
+ TLISP - A Portable LISP Implemented in P-code.
+ ___________ __ _______ __
In Proceedings of EUROSAM 79, pages 490-502. ACM, June,
+ 1979.
+
+[4] Griss, M. L. and Morrison, B.
+ ___ ________ ________ ____ _____ ______
The Portable Standard LISP Users Manual.
+ Utah Symbolic Computation Group, TR-10, University of
+ Utah, March, 1981.
+
+[5] Griss, M. L.
+ ________ ________ ____ _ _____ ________
Portable Standard LISP: A Brief Overview.
+ Utah Symbolic Computation Group, Operating Note 58,
+ University of Utah, October, 1981.
+
+[6] Hearn, A. C.
+ ______ _ _____ ______
REDUCE 2 Users Manual.
+ Utah Symbolic Computation Group UCP-19, University of Utah,
+ 1973.
+
+[7] Marti, J. B., et al.
+ Standard LISP Report.
+ _______ _______
SIGPLAN Notices 14(10):48-68, October, 1979.
+
+
+
+APPENDIX A: A List of Current PASLSP Functions and Globals
APPENDIX A: A List of Current PASLSP Functions and Globals
APPENDIX A: A List of Current PASLSP Functions and Globals
+
+
+____ ________ __________ ___ ________ ____ ______
Lisp Callable Functions, see Standard LISP Report
+!*FIRST!-PROCEDURE The top loop LISP reader
+ABS
+ADD1
+AND
+APPEND
+APPLY
+APPLY1 (APPLY f (LIST u))
+ASSOC
+ATOM
+ATSOC
+CAAAAR
+CAAADR
+CAAAR
+CAADAR
+CAADDR
+CAADR
+CAAR
+CADAAR
+CADADR
+CADAR
+CADDAR
+CADDDR
Wicat Pascal LISP 1 March 1982 11
+
+
+CADDR
+CADR
+CAR
+CATCH
+CDAAAR
+CDAADR
+CDAAR
+CDADAR
+CDADDR
+CDADR
+CDAR
+CDDAAR
+CDDADR
+CDDAR
+CDDDAR
+CDDDDR
+CDDDR
+CDDR
+CDR
+CLOSE
+CODEP
+COMPRESS
+COND
+CONS
+CONSTANTP
+DE
+DEFLIST
+DELATQ (DELATQ 'X alist) deletes (X . any) from alist
+DELETE
+DELQ Efficient DELETE (using EQ)
+DF
+DIFFERENCE
+DIGIT
+DIVIDE
+DM
+DN
+DSKIN (DSKIN file-id)
+EOFP (EOFP channel)
+EQ
+EQCAR
+EQN
+EQUAL
+ERROR
+ERRORSET
+ERRPRT Prints message with *'s
+EVAL
+EVLAM Evaluates a LAMBDA expression
+EVLIS
+EXPAND
+EXPLODE
+EXPT
+FASTSTAT Prints RECLAIM message
Wicat Pascal LISP 1 March 1982 12
+
+
+FIX
+FIXP
+FLAG
+FLAG1 (FLAG (LIST x) y)
+FLAGP
+FLOAT
+FLOATP
+FLUID
+FLUIDP
+FUNCELL Accesses function cell
+FUNCTION
+GENSYM
+GET
+GETD
+GETV
+GLOBAL
+GLOBALP
+GO
+GREATERP
+IDP
+INTERN
+LBIND1 Binds a single ID in LAMBDA
+LBINDN
+LENGTH
+LESSP
+LIST2 For efficent LIST compilation
+LIST3
+LIST4
+LIST5
+LITER
+MAP
+MAPC
+MAPCAN
+MAPCAR
+MAPCON
+MAPLIST
+MAX
+MAX2
+MEMBER
+MEMQ
+MIN
+MIN2
+MINUS
+MINUSP
+MKVECT
+MSGPRT
+NCONC
+NCONS
+NOT
+NULL
+NUMBERP
+ONEP
Wicat Pascal LISP 1 March 1982 13
+
+
+OPEN
+OR
+ORDERP
+P!.N Evaluates Implicit PROGNs
+PAIR
+PAIRP
+PBIND1 PROG binding
+PBINDN
+PLIST Access full property list
+PLUS
+PLUS2
+PRIN1
+PRIN2
+PRIN2T
+PRIN2TL
+PRINC
+PRINT
+PROG
+PROG2
+PROGG0131
+PROGN
+PUT
+PUTC
+PUTD
+PUTL
+PUTV
+QUOTIENT
+RDEVPR A read-eval-print loop
+RDS
+RDTOK
+READ
+READCH
+RECLAIM
+REMAINDER
+REMD
+REMFLAG
+REMFLAG1
+REMOB
+REMPROP
+RETURN
+REV
+REVERSE
+REVX
+RLIST
+RPLACA
+RPLACD
+SASSOC
+SET
+SETFUNCELL
+SETPLIST
+SETVALUE
+STRINGP Equivalent to IDP
Wicat Pascal LISP 1 March 1982 14
+
+
+SUB1
+SUBLIS
+SUBST
+TCATCH
+TERPRI
+THROW
+TIMES
+TIMES2
+TOKEN
+TTHROW
+UNBIND1
+UNBINDN
+UNBINDTO
+UNFLUID
+UPBV
+VALUE
+VECTORP
+WHILE
+WRS
+WRTOK
+XAPPLY
+XCONS
+ZEROP
+___________ _______
Interesting Globals
+!*RAISE Raise lower case typing to upper case if not NIL
+!*ECHO Selected input to selected output if not NIL.
+BSTK!* Holds old values of rebound IDS
+EMSG!* Error message in most recent call on ERROR
+ENUM!* Error number in most recent call on ERROR.
+INITFORM!* First Expression EVAL'ed
+THROWING!* Indicates if throwing
+THROWTAG!* Indicates TAG in TTHROW
+TOK!* Holds last token scanned
+TOKTYPE Indicates type of token scanned:
+ 1: integer
+ 2: id
+ 3: character
Wicat Pascal LISP 1 March 1982 i
+
+
+ Table of Contents
Table of Contents
Table of Contents
+
+1. Introduction 1
+ 1.1. History of PASLSP 1
+ 1.2. Acknowledgement 2
+2. Features of PASLSP and relation to Standard LISP 2
+3. Using PASLSP on the Wicat 100 3
+4. Implementation of PASLSP 5
+ 4.1. Building PASLSP 5
+ 4.2. Internal data structures 6
+ 4.3. Adding user functions to the kernel 7
+5. Future work on PASLSP 8
+ 5.1. Goals of the Utah PSL Project 8
+6. References 9
+APPENDIX A: A List of Current PASLSP Functions and Globals 10
ADDED perq-pascal-lisp-project/wicat-paslsp.mss
Index: perq-pascal-lisp-project/wicat-paslsp.mss
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/wicat-paslsp.mss
@@ -0,0 +1,442 @@
+@Device(lpt)
+@style(justification yes)
+@style(spacing 1)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@make(article)
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(appendix,numbered=<APPENDIX @A: >)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+@define(up,use text,capitalized on, break off)
+@define(mac,use text, underline off, break off)
+@define(LISPmac,use text, underline alphanumerics, break off)
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "December 1981",
+ Line "Operating Note 60"
+ )
+@set(page=1)
+@newpage()
+@begin(titlepage)
+@begin(titlebox)
+@b(A PASCAL Based Standard LISP for the Wicat 100)
+@center[
+by
+
+M. L. Griss and R. Ottenheimer
+
+Department of Computer Science
+University of Utah
+Salt Lake City, Utah 84112
+
+@b(Preliminary Version)
+
+Last Revision: @value(date)]
+
+@end(titlebox)
+@begin(abstract)
+This report describes an interim implementation of Standard LISP for the
+Wicat 100. This LISP is based upon the Standard LISP report, and a
+newly developing Portable Standard LISP. This interim implementation is
+designed to explore LISP implementations in PASCAL on the Wicat 100 and
+similar machines. The system consists of a kernel, handcoded in PASCAL,
+with the rest of the system written in LISP and compiled to PASCAL.
+@End(abstract)
+@begin(Researchcredit)
+Work supported in part by the National Science Foundation
+under Grant No. MCS80-07034.
+@end(Researchcredit)
+@end(titlepage)
+@pageheading(Left "Wicat Pascal LISP",Center "@value(date)",
+ Right "@value(Page)"
+ )
+@set(page=1)
+@newpage
+@section(Introduction)
+In this preliminary report, we describe an implementation of Standard LISP
+in PASCAL, PASLSP. Versions of PASLSP have been run on a number of
+machines, ranging from an LSI-11 based TERAK to Apollo and PERQ. This report
+concentrates on the Wicat 100 implementation. This report is to be read in
+conjunction with the Standard LISP report@cite(Marti79); we will
+highlight the differences from the functions documented in the Standard
+LISP, describe the implementation strategy, and discuss future work.
+
+PASLSP is based on a series of small and medium sized LISP interpreters
+that have been developed at the University of Utah to explore LISP
+implementations in higher level languages. Each of these LISP systems
+consists of a small kernel handcoded in some language, with the rest of the
+system written in LISP and compiled to the target language. We have used
+FORTRAN, PASCAL and assembly language as targets. The PASLSP series use
+PASCAL for the kernel, and have a LISP to PASCAL compiler for the rest of
+the system.
+
+Recent work has concentrated on reducing the size of the hand-coded kernel,
+and extending the compiler to handle systems level constructs. This has
+resulted in a new Portable Standard LISP, PSL, running on the DEC-20 and
+VAX-11/750@cite(Benson81,Griss81). An implementation of PSL for MC68000 is
+underway. The PSL system is a modern, efficient LISP, written entirely in
+itself; it uses an efficient LISP to machine code compiler to produce the
+kernel, and then the rest of LISP is loaded. In the future we hope to
+produce a complete PSL targeted at a higher level languages, such as
+PASCAL, C or ADA, and this will replace the current PASLSP.
+
+@subsection(History of PASLSP)
+The system now called PASLSP was originally developed (by M. Griss and W.
+Galway), as a small LISP like kernel to support a small computer algebra
+system on an LSI-11 TERAK; this was to be used as an answer analysis module
+within a CAI system@cite(Brandt81), written entirely in PASCAL. It was
+decided to hand-code a very small kernel, and compile additional functions
+written in LISP (LISP support functions, parser and
+simplifier) to PASCAL,
+using a modified Portable LISP compiler@cite(griss79). This version (call
+it V0) did not even have user defined functions, since space on the TERAK
+was at a premium.
+
+About June 1981, PASLSP came to the attention of a number people evaluating
+Apollo's and PERQ's, and it was suggested that we enhance V0 PASLSP for
+this purpose. During the space of a few days, features taken from the
+Standard LISP Report and newly developing PSL files were added to produce
+PASLSP-V1, running on a DEC-20 and Terak. This was a fairly complete LISP
+(including Catch and Throw), but lacked a few features (OPEN, CLOSE, RDS,
+WRS, PROG, GO, RETURN, COMPRESS, EXPLODE, Vectors and Strings, etc.). V1
+PASLSP was adapted to a PERQ, VAX and Apollo by Paul Milazo of Schlumberge
+in the space of a few weeks (we did not have a PERQ or Apollo at that
+time).
+
+We subsequently obtained a PERQ, Apollo and a Wicat, and recent work has been
+aimed at producing an enhanced PASLSP for these machines, maintaining all
+versions in one set of source files. The current system, PASLSP-V2, is
+produced from a single PASCAL kernel and set of LISP support files; the
+machine specific features are handled by a simple Source Code
+Conditionalizer, changing the definition of certain constants and data
+types. Only a few features of the Standard LISP report are missing,
+and there are a number of additions.
+
+@subsection(Acknowledgement)
+
+We would like to acknowledge the contributions and support of
+Eric Benson, Dick Brandt, Will Galway, and Paul Milazo.
+
+@section(Features of PASLSP and relation to Standard LISP)
+PASLSP as far as possible provides all the functions mentioned
+in the attached Standard LISP Report (note the hand-written
+comments added to this appendix); some of the functions are simply
+stubs, so that a Standard LISP Test-file can be run without major
+modification.
+
+PASLSP-V2 does not implement the following features of Standard LISP:
+@begin(enumeration,spread 0)
+VECTORS (only a simple garbage collector is used).
+
+Strings are implemented as identifiers (not garbage collected).
+
+Integers are limited in size (INTs and FIXNUMs, no BIGNUMs).
+
+FLOATING Point is not implemented.
+
+IDs can not be REMOB'ed or INTERN'd.
+
+Only 3 Input Channels and 2 Output Channels are available to OPEN,
+RDS, WRS, and CLOSE. Thus file input statements can not be nested
+very deeply in files.
+
+Line, Page and Character counting (POSN, LPOSN, etc) are not implemented.
+@end(enumeration)
+
+PASLSP-V2 provides some extensions over Standard LISP:
+@begin(enumerate,spread 0)
+(CATCH form) and (THROW form) and the tagged versions: (TCATCH tag form)
+and (TTHROW tag form) are used to implement error and errorset,
+and higher level control functions.
+
+Implicit PROGN in COND, and LAMBDA expressions.
+
+(WHILE pred action-1 action-2 ... action-n).
+
+(DSKIN 'filename) or (DSKIN "filename")
+@end(enumerate)
+
+PASLSP-V2 has not been extensively tested, and there may still be a number
+of bugs. While some effort has been spent in adjusting PASLSP to the Wicat,
+it is clear that the various heap sizes are not yet optimal.
+See appendix A for current list of functions, and appendix B for a copy
+of the Standard LISP Report annotated to reflect the current status of
+PASLSP.
+
+@section(Using PASLSP on the Wicat 100)
+ Initializing the system from the floppy looks like this:
+@begin(verbatim)
+Create a directory (call it pl):
+Mount the floppy:
+Copy the files of interest:
+
+ The files copied will be: paslsp (executable file)
+ paslsp.ini (initialization file)
+ paslsp.tst (a test file)
+@end(verbatim)
+
+Run paslsp as you would any other file. If you
+get an error it is most likely because the paslsp.ini file couldn't be found.
+If this happens, locate paslsp.ini and try again. If it still hangs,
+try calling Ralph Ottenheimer at (801) 355-0226 or M. Griss at (801) 581-6542.
+
+
+Previously prepared files of LISP (e.g., library procedures)
+can be input by
+using the function "DSKIN". For Example,
+@begin(verbatim)
+(DSKIN 'Paslsp!.tst) or (DSKIN "Paslsp.tst")
+@end
+would load the paslsp test file. The PASLSP test is adapted from an extensive
+test of Standard LISP (avoiding features not yet implemented). This is a
+good excercise, try it. [Note that if the filename is given as an ID,
+that special characters should be prefaced by an "escape character",
+! . This is also the case for filenames in OPEN. Alternately the string
+form may be used, in that case special characters need not be escaped.]
+
+ Paslsp is "case-sensitive" with regard to identifiers. All of the
+kernel procedures have upper-case identifiers associated with them. This
+means that ordinarily the expression (dskin 'paslsp!.tst) would not be
+recognized since "dskin" is in lowercase. However, there is a global flag
+!*RAISE which if true will convert all lower-case typin to upper-case.
+This Wicat 100 paslsp implementation sets !*RAISE to T as a default by
+having (SETQ !*RAISE T) in the paslsp.ini file. You may put any special
+initialization code you like at the end of paslsp.ini as indicated by the
+comments in the file.
+Toggling would be accomplished by typing the following lisp-expressions:
+@begin(verbatim)
+ (ON !*RAISE) equivalent to (SETQ !*RAISE T)
+ (OFF !*RAISE) equivalent to (SETQ !*RAISE NIL)
+@end(verbatim)
+
+ Any Wicat 100 filename (60 characters maximum)is allowable
+ as a paslsp filename.
+Remember to prefix all special characters with an exclamation-mark: "!".
+Special characters include all non-alphanumerics. For example: !*RAISE
+ goforit!! paslsp!.test !/login!/smith!/foo!.sl .
+
+If the global !*ECHO is not NIL (default is NIL), input will be echoed to
+the selected output channel. It is sometimes convienient to put:
+@begin(verbatim)
+ (SETQ !*ECHO T)
+@end(verbatim)
+at the beginning of a file to be read by DSKIN, and:
+@begin(verbatim)
+ (SETQ !*ECHO NIL)
+@end(verbatim)
+at the end. This will echo the file to the screen (or to a file) as it is
+read.
+
+Certain low level errors do not display any explanatory message but
+instead display a numeric code (such as *** # 2), below is a summary of these
+codes and their meanings:
+
+@begin(verbatim)
+ (* error codes. corresponding to tag = errtag. *)
+ noprspace = 1; (* no more "pair space"--can't cons. *)
+ notpair = 2; (* a pair operation attempted on non-pair.*)
+ noidspace = 3; (* no more free identifiers *)
+ undefined = 4; (* used to mark undefined function cells *)
+ noint = 5; (* no free integer space after gc. *)
+ notid = 6; (* id was expected *)
+@end(verbatim)
+
+
+@section(Implementation of PASLSP)
+@subsection(Building PASLSP)
+PASLSP is built in the following steps:
+
+@u(Kernel files), PAS0.PRE, and trailer file (main program) PASN.PRE
+are run through a filter program to produce PAS0.PAS and PASN.PAS,
+tailored to the Wicat 100 (appropriate Include files, Consts, etc).
+This kernel provides the Basic I/O (Token reading and printing),
+handcoded storage allocator and garbage collector, lowlevel arithmetic
+primitives, lowlevel calls (via Case statement) from LISP to kernel, etc.
+
+@u(Rest of LISP), currently files PAS1.RED, PAS2.RED and PAS3.RED are
+compiled to PASCAL using a version of the Portable LISP Compiler
+(PLC)@cite(griss79). During compilation, a Symbol Table file, PASn.SYM is
+read in and written out. These files record (for "incremental" compilation)
+the names and ID table locations of each ID encountered, so that the compiler
+can refer to an ID by its offset in the ID table. LISP constants are also
+recorded in the PASn.SYM files. PAS0.SYM is modified by hand as the kernel
+is changed.
+
+The compilation model used is that of a Register Machine: Arguments to LISP
+functions are passed in registers (a PASCAL array), and the result returned
+in Register 1. Space is allocated on a software stack (not the PASCAL
+recursion stack), for any temporaries or save arguments required. Short
+functions usually do not require any stack. The reason for this choice was
+the existence of the PLC (targeted at comventional machines), and the fact
+that inline access to the register array compiles quite well, while a
+"PUSH/POP" stack would be much less efficient.
+
+@u(Initialization).
+After the PAS0.PAS,..PASN.PAS are produced,
+the symbol table file (pas3.sym) is converted into a file
+PASLSP.INI, which contains the names of all ID's, the LISP constants
+used, and also ID's for all kernel functions that should be known to the
+user LISP level. Also produced is a file, EXEC.PAS, that contains a case
+statement associating each user callable kernel function with an integer.
+The PAS0.PAS ... PASN.PAS and EXEC.PAS are compiled and linked into an
+executable file. When this file is executed, PASLSP.INI is read in:
+each id is read and stored in the appropriate location in the symbol-table,
+the kernel function names have the associated Case index put into
+a function cell, and the LISP s-expressions are READ in. Finally,
+some s-expressions will be executed (with care, the user can add his own
+expressions, including requests to (DSKIN 'library), etc.
+@subsection(Internal data structures)
+The data spaces (or heaps) in PASLSP are divided into 4 sections: the
+pair space, id space (the oblist), string space and large integer
+(fixnum) space. These are all arrays of objects of the appropriate type
+(see declarations below). The system is fully tagged, that is, every LISP
+item has associated with it a tag field which denotes the type of the item
+and an 'info' field which either points to the item in an array (in the
+case of pairs, identifiers and fixnums), or contains the information
+itself (in the case of inums, character codes and error conditions). The
+info field of a code pointer contains the index into a case staement (see
+procedure 'execute') by means of which any LISP callable function may be
+invoked.
+
+@begin(verbatim,leftmargin 0)
+itemref = RECORD
+ tag: integer; (* Small integer denoting type. *)
+ info: integer; (* Item or a pointer to it *)
+ (* depending upon the type. *)
+ END;
+
+ pair = PACKED RECORD
+ prcar: itemref;
+ prcdr: itemref;
+ END;
+
+ ident = PACKED RECORD (* identifier *)
+ idname: stringp;
+ val: itemref; (* value *)
+ plist: itemref; (* property list *)
+ funcell: itemref; (* function cell *)
+ idhlink: id_ptr; (* hash link *)
+ END;
+@end(verbatim)
+@subsection(Adding user functions to the kernel)
+It is fairly easy to add handcoded Pascal functions to
+the kernel so that they can be called from LISP. For example,
+consider adding the function SQR(x), that squares its integer argument.
+Since SQR is already the name of an existing PASCAL function, we will
+call it "Xsqr" in PASCAL, and SQR in LISP.
+
+The function Xsqr has to take its argument from R[1], check that it is
+an integer, square the information part, and retag as integer:
+@begin(verbatim)
+PROCEDURE Xsqr;
+ VAR i1 : longint;
+
+ BEGIN
+ int_val(r[1], i1); (* Test type and extract Info *)
+ mkint(i1 * i1, 1) (* Square, retag, and put in R[1] *)
+ END;
+@end(verbatim)
+
+Now procedure Xsqr needs be to be installed into the EXECUTE table, so that
+it can be found as the N'th code item. The number of defined procedures
+will have to be increased by 1 in the 3'rd line of procedure EXECUTE,
+(currently 201 defined), and an additional case added:
+@begin(verbatim)
+202: Xsqr;
+@end(verbatim)
+
+Note also that this table gives the Internal names of each available
+procedure, should one of these be required in your handcoded procedure.
+Finally, the Identifier SQR needs to be associated with case 202 in
+PASLSP.INI. Note that PASLAP.INI has 3 tables of objects, each prefixed by
+a count and terminated by a 0. The first is the Random ID table, consisting
+of special ID's used for messages etc. The second block is for S-expression
+constants, which get loaded into the base of the stack as Globals. The
+next batch are the names of LISP callable functions in the order
+corresponding to the EXECUTE procedure. Simply modify the count form
+201 to 202 (or whatever), and add SQR at the end, just before the 0.
+
+In general, look for a sample procedure in the kernel if possible,
+or in the compiled part (although these are hard to follow), and adapt
+to the specific needs. Note the use of the ALLOC(n) and DEALLOC(n)
+procedures to allocate a block of temporaries on the stack.
+These should be used, rather than PASCAL VAR's, since the garbage collector
+may need to trace from one of the saved objects.
+@Section(Future work on PASLSP)
+PASLSP V2 is based on a fairly old model of a portable LISP, and
+has been used mainly to explore the capbilities of PASCAL as a
+target language. In particular, V2 PASCAL is not yet powerful enough to
+run the PLC compiler itself;
+instead, the PLC is run on our PSL system on the DEC-20. In order for the
+full benefits of PASLSP (or PSL) to be realized, the user should be able to
+compile his own LISP modules into PASCAL and link them with the kernel.
+In order to make the system even more adapatable, we would like to write
+even less of the kernel in PASCAL by hand. This goal has lead us to the
+development of PSL.
+
+@subsection(Goals of the Utah PSL Project)
+
+The goal of the PSL project is to produce an efficient and transportable
+Standard LISP system that may be used to:
+@begin(enumeration)
+Experimentally explore
+a variety of LISP implementation issues (storage management, binding,
+environments, etc.).
+
+Effectively support the REDUCE computer algebra system@cite(hearn73)
+on a number of machines.
+
+Provide the same, uniform, modern LISP programming environment on all of
+the machines that we use (DEC-20, VAX/750, PDP-11/45, PERQ, Wicat and
+Apollo), of the power and complexity of UCI-LISP, FranzLISP or MACLISP,
+with some extensions and enhancements derived from LISP Machine LISP or
+CommonLISP.
+@end(enumeration)
+
+The approach we have been using is to write the @b(entire) LISP system in
+PSL (using LISP extensions for dealing with
+machine words and operations), and to bootstrap it to the desired target
+machine
+in two steps:
+@begin(enumeration)
+Cross compile an appropriate kernel to the assembly language of the
+target machine;
+
+Once the kernel is running, use a resident compiler and loader, or
+fast-loader, to build the rest of the system.
+@end(enumeration)
+
+ The PASLSP system, and other early implementations, have the problem that
+the implementation language (PASCAL) is a distinct language from LISP, so
+that communication between "system" code and "LISP" code was difficult. We
+have incorporated all of the good features of the earlier work into a new
+efficient LISP-like systems language, SYSLISP, recoded all useful modules
+into SYSLISP, and proceeded from there. SYSLISP currently produces
+targeted assembly code; earlier verisions were targeted at high-level
+languages such as FORTRAN, PASCAL, C or ADA. The goal is a portability
+strategy that leads to an efficient enough system for a production quality,
+yet portable system. We currently think of the extensions to Standard LISP
+as having two levels: the SYSLISP level, dealing with words and bytes and
+machine operations, enabling us to write essentially all of the kernel in
+Standard LISP; and, the LISP level, incorporating all of the features that
+make PSL into a modern LISP. Both modes of PSL are compiled by an improved
+version of the Portable Standard LISP Compiler. The SYSLISP mode of the PSL
+compiler does compile-time folding of constants, and more comprehensive
+register allocation than the previous LISP-only version of the compiler.
+
+The current state of PSL is fully described in an "overview" document
+obtainable from the authors @cite(griss81e). Currently PSL runs on the
+DEC-20 under TOPS-20, and on the DEC VAX-11/750 under Unix. We are now
+concentrating on the MC68000 PSL for the Apollo. All of the code-generators
+and assembler support is complete, and a number of large files have been
+compiled from LISP to assembly code, and correctly assembled and executed
+on the Apollo, testing basic I/O and arithmetic. We are now in the process
+of writing the PSL support code (small functions in LAP), and testing that
+various decisions about register and memory usage are correct. Based on the
+development history on the VAX, we are about 1-2 months away from a
+preliminary PSL on the Apollo.
+@section(References)
+@Bibliography
+@appendix(A List of Current PASLSP Functions and Globals)
+@begin(verbatim,leftmargin 0)
+@include(Appendix-A.table)
+@end(verbatim)
ADDED perq-pascal-lisp-project/wicat-paslsp.otl
Index: perq-pascal-lisp-project/wicat-paslsp.otl
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/wicat-paslsp.otl
@@ -0,0 +1,19 @@
+@Comment{OUTLINE of WICAT-PASLSP.MSS.1 by Scribe 3C(1250) on 1 March 1982 at 15:57}
+1. Introduction 1 WICAT-PASLSP.MSS.1 line 54
+ 1.1. History of PASLSP 1 WICAT-PASLSP.MSS.1 line 82
+ 1.2. Acknowledgement 2 WICAT-PASLSP.MSS.1 line 114
+2. Features of PASLSP and relation to Standard LISP 2 WICAT-PASLSP.MSS.1 line 119
+3. Using PASLSP on the Wicat 100 3 WICAT-PASLSP.MSS.1 line 165
+4. Implementation of PASLSP 5 WICAT-PASLSP.MSS.1 line 244
+ 4.1. Building PASLSP 5 WICAT-PASLSP.MSS.1 line 245
+ 4.2. Internal data structures 6 WICAT-PASLSP.MSS.1 line 287
+ 4.3. Adding user functions to the kernel 7 WICAT-PASLSP.MSS.1 line 320
+5. Future work on PASLSP 8 WICAT-PASLSP.MSS.1 line 364
+ 5.1. Goals of the Utah PSL Project 8 WICAT-PASLSP.MSS.1 line 376
+6. References 9 WICAT-PASLSP.MSS.1 line 437
+APPENDIX A: A List of Current PASLSP Functions and Glo 10 WICAT-PASLSP.MSS.1 line 439
+ Table of Contents 1 -SCRIBE-SCRATCH-.13-27-1.100013 line 3
+ Alphabetic Listing of Cross-Reference Tags and Labels
+
+Tag or Label Name Page Label Value Source file Location
+-----------------------------------------------------------------------------
ADDED perq-pascal-lisp-project/wicat-problems.txt
Index: perq-pascal-lisp-project/wicat-problems.txt
==================================================================
--- /dev/null
+++ perq-pascal-lisp-project/wicat-problems.txt
@@ -0,0 +1,4 @@
+what is the relationship between 'a string', "a string" and arrays?
+
+buildup of old files
+
ADDED psl-1983/20-comp/dec20-asm.b
Index: psl-1983/20-comp/dec20-asm.b
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-asm.b
cannot compute difference between binary files
ADDED psl-1983/20-comp/dec20-asm.build
Index: psl-1983/20-comp/dec20-asm.build
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-asm.build
@@ -0,0 +1,10 @@
+CompileTime <<
+load If!-System;
+load SysLisp;
+off UserMode;
+>>;
+CompileTime if_system(PDP10, NIL, <<
+in "DEC20-DATA-MACHINE.RED"$
+in "PC:DATA-MACHINE.RED"$
+>>)$
+in "DEC20-ASM.RED"$
ADDED psl-1983/20-comp/dec20-asm.ctl
Index: psl-1983/20-comp/dec20-asm.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-asm.ctl
@@ -0,0 +1,10 @@
+; Rebuild the ASM module
+@term page 0
+@get psl:rlisp
+@st
+*loaddirectories!*:='("pl:");
+*load build;
+*build "DEC20-ASM";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/20-comp/dec20-asm.log
Index: psl-1983/20-comp/dec20-asm.log
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-asm.log
cannot compute difference between binary files
ADDED psl-1983/20-comp/dec20-asm.red
Index: psl-1983/20-comp/dec20-asm.red
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-asm.red
@@ -0,0 +1,214 @@
+
+% 20-ASM.RED - Dec-20 specific information for LAP-TO-ASM
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.20-COMP>20-ASM.RED.1, 25-Feb-82 16:46:44, Edit by BENSON
+% Converted from VAX version
+
+fluid '(CodeFileNameFormat!*
+ DataFileNameFormat!*
+ InputSymFile!*
+ OutputSymFile!*
+ CommentFormat!*
+ LabelFormat!*
+ ExternalDeclarationFormat!*
+ ExportedDeclarationFormat!*
+ FullWordFormat!*
+ DoubleFloatFormat!*
+ ReserveZeroBlockFormat!*
+ ReserveDataBlockFormat!*
+ DefinedFunctionCellFormat!*
+ UndefinedFunctionCellInstructions!*
+ MainEntryPointName!*
+ !*MainFound
+ CodeOut!*
+ DataOut!*
+ !*Lower
+ ASMOpenParen!*
+ ASMCloseParen!*
+ NumericRegisterNames!*);
+
+CodeFileNameFormat!* := "%w.mac";
+DataFileNameFormat!* := "d%w.mac";
+InputSymFile!* := "20.sym";
+OutputSymFile!* := "20.sym";
+GlobalDataFileName!* := "global-data.red"$
+MainEntryPointName!* := 'MAIN!.;
+NumericRegisterNames!* := '[0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15];
+CommentFormat!* := "; %p%n";
+LabelFormat!* := "%w:";
+ExternalDeclarationFormat!* := " extern %w%n";
+ExportedDeclarationFormat!* := " intern %w%n";
+FullWordFormat!* := " %e%n"; % FullWord expects %e for parameter
+DoubleFloatFormat!* := " %w%n 0%n";
+ReserveZeroBlockFormat!* := "%w: block %e%n";
+ReserveDataBlockFormat!* := " block %e%n";
+DefinedFunctionCellFormat!* := " jrst %w##%n";
+UndefinedFunctionCellInstructions!* :=
+ '((jsp (reg t5) (Entry UndefinedFunction)));
+ASMOpenParen!* := '!<;
+ASMCloseParen!* := '!>;
+
+DefList('((LAnd !&)
+ (LOr !!)
+ (LXor !^!!)
+ (LSH !_)), 'BinaryASMOp);
+
+put('LNot, 'UnaryASMOp, '!^!-);
+
+DefList('((t1 6)
+ (t2 7)
+ (t3 8)
+ (t4 9)
+ (t5 10)
+ (t6 11)
+ (nil 0)
+ (st 15)), 'RegisterName);
+
+put('MkItem, 'ASMExpressionFormat, "<%e_31>+%e");
+
+lisp procedure CodeFileHeader();
+ CodePrintF " search monsym%n radix 10%n";
+
+lisp procedure DataFileHeader();
+ DataPrintF " radix 10%n";
+
+lisp procedure CodeFileTrailer();
+ CodePrintF(if !*MainFound then " end MAIN.%n" else " end%n");
+
+lisp procedure DataFileTrailer();
+ DataPrintF " end%n";
+
+lisp procedure CodeBlockHeader();
+ NIL;
+
+lisp procedure CodeBlockTrailer();
+ NIL;
+
+lisp procedure DataAlignFullWord();
+ NIL;
+
+lisp procedure PrintString S;
+begin scalar N;
+ N := Size S;
+ PrintF " byte(7)";
+ for I := 0 step 1 until N do
+ << PrintExpression Indx(S, I);
+ Prin2 '!, >>;
+ PrintExpression 0;
+ TerPri();
+end;
+
+lisp procedure PrintByteList L;
+ if null L then NIL else
+ << PrintF " byte(7)";
+ while cdr L do
+ << PrintExpression car L;
+ Prin2 '!,;
+ L := cdr L >>;
+ PrintExpression car L;
+ TerPri() >>;
+
+lisp procedure PrintByte X;
+<< PrintF " byte(7)";
+ PrintExpression X;
+ TerPri() >>;
+
+lisp procedure PrintHalfWordList L;
+ if null L then NIL else
+ << PrintF " byte(18)";
+ while cdr L do
+ << PrintExpression car L;
+ Prin2 '!,;
+ L := cdr L >>;
+ PrintExpression car L;
+ TerPri() >>;
+
+lisp procedure PrintOpcode X;
+ Prin2 X;
+
+lisp procedure SpecialActionForMainEntryPoint();
+ CodePrintF " intern MAIN.%nMAIN.:";
+
+lisp procedure ASMSymbolP X;
+ Radix50SymbolP(if IDP X then ID2String X else X);
+
+lisp procedure Radix50SymbolP X;
+begin scalar N, C, I;
+ N := Size X;
+ if N > 5 then return NIL;
+ C := Indx(X, 0);
+ if not (C >= char A and C <= char Z
+ or C = char !% or C = char !. or C = char !$) then return NIL;
+ I := 1;
+Loop:
+ if I > N then return T;
+ C := Indx(X, I);
+ if not (C >= char A and C <= char Z
+ or C >= char !0 and C <= char !9
+ or C = char !% or C = char !. or C = char !$) then return NIL;
+ I := I + 1;
+ goto Loop;
+end;
+
+lisp procedure PrintNumericOperand X;
+ if ImmediateP X then Prin2 X else PrintF("[%w]", X);
+
+lisp procedure OperandPrintIndirect X;
+<< Prin2 '!@;
+ PrintOperand cadr X >>;
+
+put('Indirect, 'OperandPrintFunction, 'OperandPrintIndirect);
+
+lisp procedure OperandPrintIndexed X;
+<< X := cdr X;
+ PrintExpression cadr X;
+ Prin2 '!(;
+ PrintOperand car X;
+ Prin2 '!) >>;
+
+put('Indexed, 'OperandPrintFunction, 'OperandPrintIndexed);
+
+macro procedure Immediate X; % immediate does nothing on the 20
+ cadr X;
+
+lisp procedure ASMPseudoFieldPointer U;
+%
+% (FieldPointer Operand StartingBit Length)
+%
+<< U := cdr U;
+ Prin2 "point ";
+ PrintExpression third U;
+ Prin2 '!, ;
+ PrintOperand first U;
+ Prin2 '!, ;
+ PrintExpression list('difference, list('plus2, second U, third U), 1) >>;
+
+put('FieldPointer, 'ASMExpressionFunction, 'ASMPseudoFieldPointer);
+
+procedure MCPrint(x); % Echo of MC's
+ CodePrintF("; %p%n",x);
+
+procedure InstructionPrint(x);
+ CodePrintF( "; %p%n",x);
+
+procedure !*cerror x;
+ begin scalar i;
+ i:=wrs Nil;
+ printf( "%n *** CERROR: %r %n ",x);
+ wrs i;
+ return list list('cerror,x);
+ end;
+
+put('cerror,'asmpseudoop,'printcomment);
+
+DefCmacro !*cerror;
+
+END;
ADDED psl-1983/20-comp/dec20-cmac.b
Index: psl-1983/20-comp/dec20-cmac.b
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cmac.b
cannot compute difference between binary files
ADDED psl-1983/20-comp/dec20-cmac.build
Index: psl-1983/20-comp/dec20-cmac.build
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cmac.build
@@ -0,0 +1,9 @@
+CompileTime <<
+on EolInStringOK;
+macro procedure !* U;
+ NIL;
+flag('(TagNumber InumP), 'lose);
+>>;
+imports '(dec20-comp);
+in "pc:tags.red"$
+in "dec20-cmac.sl"$
ADDED psl-1983/20-comp/dec20-cmac.ctl
Index: psl-1983/20-comp/dec20-cmac.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cmac.ctl
@@ -0,0 +1,9 @@
+; Rebuild the CMAC module
+@term page 0
+@get psl:rlisp
+@st
+*load build;
+*build "DEC20-CMAC";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/20-comp/dec20-cmac.log
Index: psl-1983/20-comp/dec20-cmac.log
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cmac.log
@@ -0,0 +1,45 @@
+
+LINK FROM GRISS, TTY 141
+
+[DO: Execution of PS:<PSL.20-COMP>DEC20-CMAC.CTL.2 started at 22-Aug-82 09:28:39]
+
+ TOPS-20 Command processor 5(712)
+ End of <GRISS>COMAND.CMD.10
+@; Rebuild the CMAC module
+term page 0
+@def PL: dsK:, Plap:
+@psl:rlisp
+PSL 3.0 Rlisp, 19-Aug-82
+[1] load build;
+NIL
+[2] build "DEC20-CMAC";
+FASLOUT: IN files; or type in expressions
+When all done execute FASLEND;
+CompileTime <<
+on EolInStringOK;
+macro procedure !* U;
+ NIL;
+flag('(TagNumber InumP), 'lose);
+>>;
+imports '(dec20-comp);
+in "pc:tags.red"$
+in "dec20-cmac.sl"$
+*** Function `BITMASK' has been redefined
+BITMASK
+*** Function `BIT' has been redefined
+BIT EXPANDBIT
+*** `INUMP' has not been defined, because it is flagged LOSE
+*** `TAGNUMBER' has not been defined, because it is flagged LOSE
+IMMEDIATEP MEMORYP NEGATIVEIMMEDIATEP EIGHTEENP NONINDIRECTP
+FAKEREGISTERNUMBERP !*FOREIGNLINK
+*** Init code length is 184
+*** Garbage collection starting
+*** GC 3: time 3082 ms
+*** 70801 recovered, 774 stable, 28425 active, 70801 free
+*** Garbage collection starting
+*** GC 4: time 4127 ms
+*** 18114 recovered, 29161 stable, 52724 active, 18115 free
+!*!*FASL!*!*INITCODE!*!*NIL
+[3] quit;
+@
+[DO: Execution finished at 22-Aug-82 09:31:16]
ADDED psl-1983/20-comp/dec20-cmac.sl
Index: psl-1983/20-comp/dec20-cmac.sl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cmac.sl
@@ -0,0 +1,748 @@
+%
+% 20-CMAC.SL - Patterns and predicates for Dec-20 PSL cmacro expansion
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 14 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.20-COMP>20-CMAC.SL.1, 21 October 1982, Griss
+% Fixed foreign function for CROSS compiler
+
+% <PSL.20-COMP>20-CMAC.SL.1, 24-Feb-82 12:08:45, Edit by BENSON
+% Adapted VAX version for Dec-20
+
+
+(fluid '(AddressingUnitsPerItem
+ CharactersPerWord
+ StackDirection
+ !*ImmediateQuote
+ AddressingUnitsPerFunctionCell))
+
+(setq AddressingUnitsPerItem 1)
+
+(setq CharactersPerWord 5)
+
+(setq AddressingUnitsPerFunctionCell 1)
+
+(setq StackDirection 1)
+
+(setq !*ImmediateQuote NIL)
+(*
+(* "MkItem may be used when evaluating WConst expressions.")
+
+(de MkItem (TagPart InfPart)
+ (lor (lsh TagPart 27) (land InfPart 16#7ffffff)))
+)
+
+(ds BitMask (Start End)
+ (land (lsh -1 (minus Start)) (lsh -1 (difference 35 End))))
+
+(dm Bit (U)
+ (progn (setq U (cdr U))
+ (cond ((null U) 0)
+ (t (ExpandBit U)))))
+
+(de ExpandBit (U)
+ (cond ((null (cdr U)) (list 'lsh 1 (list 'difference 35 (car U))))
+ (t (list 'lor
+ (list 'lsh 1 (list 'difference 35 (car U)))
+ (ExpandBit (cdr U))))))
+
+(* "InumP tells what numbers can be immediate operands on the target machine.")
+
+(de InumP (Expression)
+ (and (FixP Expression)
+ (leq Expression 8#777777) % 8#177777777777 for extended
+ (geq Expression (minus 8#1000000)))) % 8#200000000000
+
+(de TagNumber (X)
+ (cond ((IDP X) (get 'ID 'WConst))
+ ((PairP X) (get 'PAIR 'WConst))
+ ((StringP X) (get 'STR 'WConst))
+ ((InumP X) (cond ((MinusP X) 31) (t 0)))
+ ((CodeP X) (get 'CODE 'WConst))
+ ((FloatP X) (get 'FltN 'WConst))
+ ((VectorP X) (get 'VECT 'WConst))
+ ((FixP X) (get 'FixN 'WConst))))
+
+(de ImmediateP (X)
+ (or (EqCar X 'Immediate)
+ (and (FixP X) (leq X 8#777777) (geq X (minus 8#777777)))))
+
+(de MemoryP (X)
+ (not (ImmediateP X)))
+
+(de NegativeImmediateP (X)
+ (and (FixP X)
+ (MinusP X)
+ (geq X (minus 8#777777))))
+
+(de EighteenP (X)
+ (equal X 18))
+
+(de NonIndirectP (Expression)
+ (not (EqCar Expression 'Indirect)))
+
+(de FakeRegisterNumberP (Expression)
+ (and (IntP Expression) (GreaterP Expression 5)))
+
+
+(* "Leave Indexed and Indirect alone in recursive c-macro")
+
+(flag '(Indexed Indirect UnImmediate) 'TerminalOperand)
+
+(DefAnyreg CAR
+ AnyregCAR
+ ((RegisterP) (Indexed SOURCE 0))
+ ((move REGISTER SOURCE) (Indexed REGISTER 0)))
+
+(DefAnyreg CDR
+ AnyregCDR
+ ((RegisterP) (Indexed SOURCE 1))
+ ((move REGISTER SOURCE) (Indexed REGISTER 1)))
+
+(DefAnyreg QUOTE
+ AnyregQUOTE
+ ((Null) (REG NIL))
+ ((EqTP) (FLUID T))
+ ((InumP) SOURCE)
+ ((QUOTE SOURCE)))
+
+(DefAnyreg WVAR
+ AnyregWVAR
+ ((RegisterNameP) (REG SOURCE))
+ ((WVAR SOURCE)))
+
+(DefAnyreg MEMORY
+ AnyregMEMORY
+ ((RegisterP AnyP) (Indexed SOURCE ARGTWO))
+ ((AddressConstantP ZeroP) (UnImmediate SOURCE))
+ ((NonIndirectP ZeroP) (Indirect SOURCE))
+ ((!*MOVE SOURCE REGISTER)
+ (Indexed REGISTER ARGTWO)))
+
+(DefAnyreg FRAME
+ AnyregFRAME
+ ((Indexed (REG st) SOURCE)))
+
+(DefAnyreg REG
+ AnyregREG
+ ((FakeRegisterNumberP) (ExtraReg SOURCE))
+ ((REG SOURCE)))
+
+(DefCMacro !*Call
+ ((InternallyCallableP) (pushj (reg st) (InternalEntry ARGONE)))
+ ((pushj (reg st) (Entry ARGONE))))
+
+(DefCMacro !*JCall
+ ((InternallyCallableP) (jrst (InternalEntry ARGONE)))
+ ((jrst (Entry ARGONE))))
+
+(DefCMacro !*Move
+ (Equal)
+ ((ZeroP AnyP) (setzm ARGTWO))
+ ((MinusOneP AnyP) (setom ARGTWO))
+ ((NegativeImmediateP RegisterP)
+ (movni ARGTWO (minus ARGONE)))
+ ((ImmediateP RegisterP) (hrrzi ARGTWO ARGONE))
+ ((AnyP RegisterP) (move ARGTWO ARGONE))
+ ((RegisterP AnyP) (movem ARGONE ARGTWO))
+ ((!*MOVE ARGONE (reg t1)) (movem (reg t1) ARGTWO)))
+
+(DefCMacro !*Alloc
+ ((ZeroP))
+ ((adjsp (REG st) ARGONE)))
+
+(DefCMacro !*DeAlloc
+ ((ZeroP))
+ ((adjsp (REG st) (minus ARGONE))))
+
+(DefCMacro !*Exit
+ ((!*DeAlloc ARGONE)
+ (popj (reg st) 0)))
+
+(DefCMacro !*Jump
+ ((jrst ARGONE)))
+
+(DefCMacro !*Lbl
+ (ARGONE))
+
+(DefCMacro !*WPlus2
+ ((AnyP OneP) (aos ARGONE))
+ ((AnyP MinusOneP) (sos ARGONE))
+ ((AnyP RegisterP) (addm ARGTWO ARGONE))
+ ((RegisterP NegativeImmediateP) (subi ARGONE (minus ARGTWO)))
+ ((RegisterP ImmediateP) (addi ARGONE ARGTWO))
+ ((RegisterP AnyP) (add ARGONE ARGTWO))
+ ((!*MOVE ARGTWO (reg t2)) (addm (reg t2) ARGONE)))
+
+(DefCMacro !*WDifference
+ ((AnyP OneP) (sos ARGONE))
+ ((AnyP MinusOneP) (aos ARGONE))
+ ((RegisterP NegativeImmediateP) (addi ARGONE (minus ARGTWO)))
+ ((RegisterP ImmediateP) (subi ARGONE ARGTWO))
+ ((RegisterP AnyP) (sub ARGONE ARGTWO))
+ ((!*WMINUS (reg t2) ARGTWO) (addm (reg t2) ARGONE)))
+
+(DefCMacro !*WTimes2
+ ((AnyP MinusOneP) (!*WMINUS ARGONE ARGONE))
+ ((RegisterP NegativeImmediateP)
+ (imul ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (imuli ARGONE ARGTWO))
+ ((RegisterP AnyP) (imul ARGONE ARGTWO))
+ ((AnyP RegisterP) (imulm ARGTWO ARGONE))
+ ((!*MOVE ARGTWO (reg t2)) (imulm (reg t2) ARGONE)))
+
+(DefCMacro !*WAnd
+ ((RegisterP NegativeImmediateP)
+ (and ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (andi ARGONE ARGTWO))
+ ((RegisterP AnyP) (and ARGONE ARGTWO))
+ ((AnyP RegisterP) (andm ARGTWO ARGONE))
+ ((!*MOVE (reg t2) ARGTWO) (andm (reg t2) ARGONE)))
+
+(DefCMacro !*WOr
+ ((RegisterP NegativeImmediateP)
+ (ior ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (iori ARGONE ARGTWO))
+ ((RegisterP AnyP) (ior ARGONE ARGTWO))
+ ((AnyP RegisterP) (iorm ARGTWO ARGONE))
+ ((!*MOVE (reg t2) ARGTWO) (iorm (reg t2) ARGONE)))
+
+(DefCMacro !*WXOr
+ ((RegisterP NegativeImmediateP)
+ (xor ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (xori ARGONE ARGTWO))
+ ((RegisterP AnyP) (xor ARGONE ARGTWO))
+ ((AnyP RegisterP) (xorm ARGTWO ARGONE))
+ ((!*MOVE (reg t2) ARGTWO) (xorm (reg t2) ARGONE)))
+
+(DefCMacro !*AShift
+ ((RegisterP ImmediateP) (ash ARGONE ARGTWO))
+ ((RegisterP RegisterP) (ash ARGONE (Indexed ARGTWO 0)))
+ ((RegisterP AnyP)
+ (move (reg t2) ARGTWO)
+ (ash ARGONE (Indexed (reg t2) 0)))
+ ((AnyP ImmediateP)
+ (move (reg t3) ARGONE)
+ (ash (reg t3) ARGTWO)
+ (movem (reg t3) ARGONE))
+ ((AnyP RegisterP)
+ (move (reg t3) ARGONE)
+ (ash (reg t3) (Indexed ARGTWO 0))
+ (movem (reg t3) ARGONE))
+ ((move (reg t2) ARGTWO)
+ (move (reg t3) ARGONE)
+ (ash (reg t3) (Indexed (reg t2) 0))
+ (movem (reg t3) ARGONE)))
+
+(DefCMacro !*WShift
+ ((RegisterP ImmediateP) (lsh ARGONE ARGTWO))
+ ((RegisterP RegisterP) (lsh ARGONE (Indexed ARGTWO 0)))
+ ((RegisterP AnyP)
+ (move (reg t2) ARGTWO)
+ (lsh ARGONE (Indexed (reg t2) 0)))
+ ((AnyP ImmediateP)
+ (move (reg t3) ARGONE)
+ (lsh (reg t3) ARGTWO)
+ (movem (reg t3) ARGONE))
+ ((AnyP RegisterP)
+ (move (reg t3) ARGONE)
+ (lsh (reg t3) (Indexed ARGTWO 0))
+ (movem (reg t3) ARGONE))
+ ((move (reg t2) ARGTWO)
+ (move (reg t3) ARGONE)
+ (lsh (reg t3) (Indexed (reg t2) 0))
+ (movem (reg t3) ARGONE)))
+
+(DefCMacro !*WNot
+ (Equal (setcmm ARGONE))
+ ((RegisterP AnyP) (setcm ARGONE ARGTWO))
+ ((AnyP RegisterP) (setcam ARGTWO ARGONE))
+ ((move (reg t1) ARGTWO) (setcam (reg t1) ARGONE)))
+
+(DefCMacro !*WMinus
+ (Equal (movns ARGONE))
+ ((RegisterP AnyP) (movn ARGONE ARGTWO))
+ ((AnyP RegisterP) (movnm ARGTWO ARGONE))
+ ((move (reg t1) ARGTWO) (movnm (reg t1) ARGONE)))
+
+(DefCMacro !*MkItem
+ ((RegisterP ImmediateP)
+ (tlz ARGONE 2#111110000000000000)
+ (tlo ARGONE (lsh ARGTWO 13)))
+ ((AnyP RegisterP)
+ (dpb ARGTWO (lit (fullword (FieldPointer ARGONE 0 5)))))
+ ((!*MOVE ARGTWO (reg t1))
+ (dpb (reg t1) (lit (fullword (FieldPointer ARGONE 0 5))))))
+
+(DefCMacro !*JumpType
+ ((RegisterP ZeroP)
+ (tlnn ARGONE 2#111110000000000000)
+ (jrst ARGTHREE))
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 5))))
+ (!*JUMPEQ ARGTHREE (reg t6) ARGTWO)))
+
+(DefCMacro !*JumpNotType
+ ((RegisterP ZeroP)
+ (tlne ARGONE 2#111110000000000000)
+ (jrst ARGTHREE))
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 5))))
+ (!*JUMPNOTEQ ARGTHREE (reg t6) ARGTWO)))
+
+(DefCMacro !*JumpInType
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 5))))
+ (caig (reg t6) ARGTWO)
+ (jrst ARGTHREE)
+ (cain (reg t6) 31)
+ (jrst ARGTHREE))) % (WConst NegInt)
+
+(DefCMacro !*JumpNotInType
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 5))))
+ (cain (reg t6) 31) % (WConst NegInt)
+ (jrst TEMPLABEL)
+ (caile (reg t6) ARGTWO)
+ (jrst ARGTHREE)
+ TEMPLABEL))
+
+(DefCMacro !*JumpEQ
+ ((RegisterP ZeroP) (jumpe ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpe ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipn ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipn ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camn ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camn ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (cain ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (cain ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camn ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camn ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpNotEQ
+ ((RegisterP ZeroP) (jumpn ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpn ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipe ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipe ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (came ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (came ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caie ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caie ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (came ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (came ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPNOTEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPNOTEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWLessP
+ ((RegisterP ZeroP) (jumpl ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpg ARGTWO ARGTHREE))
+ ((RegisterP OneP) (jumple ARGONE ARGTHREE))
+ ((MinusOneP RegisterP) (jumpge ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipge ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skiple ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP OneP)
+ (skipg ARGONE)
+ (jrst ARGTHREE))
+ ((MinusOneP AnyP)
+ (skipl ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camge ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camle ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caige ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caile ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camge ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camle ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWLESSP ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWLESSP ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWGreaterP
+ ((RegisterP ZeroP) (jumpg ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpl ARGTWO ARGTHREE))
+ ((RegisterP MinusOneP) (jumpge ARGONE ARGTHREE))
+ ((OneP RegisterP) (jumple ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skiple ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipge ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP MinusOneP)
+ (skipl ARGONE)
+ (jrst ARGTHREE))
+ ((OneP AnyP)
+ (skipg ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camle ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camge ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caile ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caige ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camle ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camge ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWGreaterP ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWGreaterP ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWLEQ
+ ((RegisterP ZeroP) (jumple ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpge ARGTWO ARGTHREE))
+ ((RegisterP MinusOneP) (jumpl ARGONE ARGTHREE))
+ ((OneP RegisterP) (jumpg ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipg ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipl ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP MinusOneP)
+ (skipge ARGONE)
+ (jrst ARGTHREE))
+ ((OneP AnyP)
+ (skiple ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camg ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (caml ARGTWO (lit ARGTHREE))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caig ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (cail ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camg ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (caml ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWLEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWLEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWGEQ
+ ((RegisterP ZeroP) (jumpge ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumple ARGTWO ARGTHREE))
+ ((RegisterP OneP) (jumpg ARGONE ARGTHREE))
+ ((MinusOneP RegisterP) (jumpl ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipl ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipg ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP OneP)
+ (skiple ARGONE)
+ (jrst ARGTHREE))
+ ((MinusOneP AnyP)
+ (skipge ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (caml ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camg ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (cail ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caig ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (caml ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camg ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWGEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWGEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*Push
+ ((ImmediateP) (push (reg st) (lit (fullword ARGONE))))
+ ((push (reg st) ARGONE)))
+
+(DefCMacro !*Pop
+ ((ImmediateP) (pop (reg st) (lit (fullword ARGONE))))
+ ((pop (reg st) ARGONE)))
+
+(DefCMacro !*Freerstr
+ ((jsp (reg t5) (Entry FastUnbind)) (fullword ARGONE)))
+
+(DefCMacro !*Loc
+ ((RegisterP AnyP) (movei ARGONE ARGTWO))
+ ((movei (reg t2) ARGTWO) (movem (reg t2) ARGONE)))
+
+(DefCMacro !*Field
+ ((RegisterP AnyP ZeroP EighteenP) (hlrz ARGONE ARGTWO))
+ ((RegisterP AnyP EighteenP EighteenP) (hrrz ARGONE ARGTWO))
+ ((AnyP RegisterP ZeroP EighteenP) (hlrzm ARGTWO ARGONE))
+ ((AnyP RegisterP EighteenP EighteenP) (hrrzm ARGTWO ARGONE))
+ ((RegisterP)
+ (ldb ARGONE
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR)))))
+ ((ldb (reg t2)
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR))))
+ (movem (reg t2) ARGONE)))
+
+(DefCMacro !*SignedField
+ ((RegisterP AnyP ZeroP EighteenP) (hlre ARGONE ARGTWO))
+ ((RegisterP AnyP EighteenP EighteenP) (hrre ARGONE ARGTWO))
+ ((AnyP RegisterP ZeroP EighteenP) (hlrem ARGTWO ARGONE))
+ ((AnyP RegisterP EighteenP EighteenP) (hrrem ARGTWO ARGONE))
+ ((RegisterP)
+ % could optimize to use tlne tlo trne tro
+ (ldb ARGONE
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR))))
+ (tdne ARGONE (lit (fullword (bit ARGTHREE))))
+ (tdo ARGONE (lit (fullword (bitmask 0 ARGTHREE)))))
+ ((ldb (reg t2)
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR))))
+ (tdne (reg t2) (lit (fullword (bit ARGTHREE))))
+ (tdo (reg t2) (lit (fullword (bitmask 0 ARGTHREE))))
+ (movem (reg t2) ARGONE)))
+
+(DefCMacro !*PutField
+ ((RegisterP)
+ (dpb ARGONE
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR)))))
+ ((!*MOVE ARGONE (reg t1))
+ (dpb (reg t1)
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR))))))
+
+(DefCMacro !*ADJSP
+ ((RegisterP ImmediateP) (adjsp ARGONE ARGTWO))
+ ((RegisterP RegisterP) (adjsp ARGONE (Indexed ARGTWO 0)))
+ ((RegisterP)
+ (move (reg t2) ARGTWO)
+ (adjsp ARGONE (Indexed (reg t2) 0)))
+ ((move (reg t1) ARGONE)
+ (!*ADJSP (reg t1) ARGTWO)
+ (movem (reg t1) ARGONE)))
+
+(DefList '((WQuotient ((idiv (reg 1) (reg 2))))
+ (WRemainder ((idiv (reg 1) (reg 2)) (move (reg 1) (reg 2)))))
+ 'OpenCode)
+
+(!&Tworeg '(WQuotient WRemainder))
+
+(loadtime
+(DefList '((Byte ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 7))))
+ (ldb (reg 1) (reg 2))))
+ (PutByte ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 7))))
+ (dpb (reg 3) (reg 2))))
+ (HalfWord ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 18))))
+ (ldb (reg 1) (reg 2))))
+ (PutHalfWord ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 18))))
+ (dpb (reg 3) (reg 2))))
+ (BitTable ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 2))))
+ (ldb (reg 1) (reg 2))))
+ (PutBitTable ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 2))))
+ (dpb (reg 3) (reg 2)))))
+ 'OpenCode))
+
+(loadtime
+(!&TwoReg '(Byte PutByte HalfWord PutHalfWord BitTable PutBitTable)))
+
+(DefList '((IDApply0 ((pushj (reg st)
+ (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 ((pushj (reg st)
+ (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 ((pushj (reg st)
+ (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 ((pushj (reg st)
+ (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 ((pushj (reg st)
+ (Indexed (reg 5) (WArray SymFnc))))))
+ 'OpenCode)
+
+(DefList '((IDApply0 ((jrst (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 ((jrst (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 ((jrst (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 ((jrst (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 ((jrst (Indexed (reg 5) (WArray SymFnc))))))
+ 'ExitOpenCode)
+
+(DefList '((CodeApply0 ((pushj (reg st) (Indexed (reg 1) 0))))
+ (CodeApply1 ((pushj (reg st) (Indexed (reg 2) 0))))
+ (CodeApply2 ((pushj (reg st) (Indexed (reg 3) 0))))
+ (CodeApply3 ((pushj (reg st) (Indexed (reg 4) 0))))
+ (CodeApply4 ((pushj (reg st) (Indexed (reg 5) 0)))))
+ 'OpenCode)
+
+(DefList '((CodeApply0 ((jrst (Indexed (reg 1) 0))))
+ (CodeApply1 ((jrst (Indexed (reg 2) 0))))
+ (CodeApply2 ((jrst (Indexed (reg 3) 0))))
+ (CodeApply3 ((jrst (Indexed (reg 4) 0))))
+ (CodeApply4 ((jrst (Indexed (reg 5) 0)))))
+ 'ExitOpenCode)
+
+(DefList '((AddressApply0 ((pushj (reg st) (Indexed (reg 1) 0))))
+ (AddressApply1 ((pushj (reg st) (Indexed (reg 2) 0))))
+ (AddressApply2 ((pushj (reg st) (Indexed (reg 3) 0))))
+ (AddressApply3 ((pushj (reg st) (Indexed (reg 4) 0))))
+ (AddressApply4 ((pushj (reg st) (Indexed (reg 5) 0)))))
+ 'OpenCode)
+
+(DefList '((AddressApply0 ((jrst (Indexed (reg 1) 0))))
+ (AddressApply1 ((jrst (Indexed (reg 2) 0))))
+ (AddressApply2 ((jrst (Indexed (reg 3) 0))))
+ (AddressApply3 ((jrst (Indexed (reg 4) 0))))
+ (AddressApply4 ((jrst (Indexed (reg 5) 0)))))
+ 'ExitOpenCode)
+
+(* "*FEQ, *FGreaterP and !*FLessP can only occur once in a function.")
+
+(DefList '((!*WFix ((fix (reg 1) (indexed (reg 1) 0))))
+ (!*WFloat ((fltr (reg 2) (reg 2))
+ (movem (reg 2) (indexed (reg 1) 0))
+ (setzm (indexed (reg 1) 1))))
+ (!*FAssign ((dmove (reg 2) (indexed (reg 2) 0))
+ (dmovem (reg 2) (indexed (reg 1) 0))))
+ (!*FEQ ((dmove (reg 3) (indexed (reg 2) 0))
+ (came (reg 3) (indexed (reg 1) 0))
+ (jrst !*NotEQ!*)
+ (camn (reg 4) (indexed (reg 1) 1))
+ !*NotEQ!*
+ (move (reg 1) (reg nil))))
+ (!*FGreaterP ((dmove (reg 3) (indexed (reg 2) 0))
+ (camge (reg 3) (indexed (reg 1) 0))
+ (jrst !*IsGreaterP!*)
+ (camn (reg 3) (indexed (reg 1) 0))
+ (caml (reg 4) (indexed (reg 1) 1))
+ (move (reg 1) (reg nil))
+ !*IsGreaterP!*))
+ (!*FLessP ((dmove (reg 3) (indexed (reg 2) 0))
+ (camle (reg 3) (indexed (reg 1) 0))
+ (jrst !*IsLessP!*)
+ (camn (reg 3) (indexed (reg 1) 0))
+ (camg (reg 4) (indexed (reg 1) 1))
+ (move (reg 1) (reg nil))
+ !*IsLessP!*))
+ (!*FPlus2 ((dmove (reg 3) (indexed (reg 3) 0))
+ (dfad (reg 3) (indexed (reg 2) 0))
+ (dmovem (reg 3) (indexed (reg 1) 0))))
+ (!*FDifference ((dmove (reg 4) (indexed (reg 2) 0))
+ (dfsb (reg 4) (indexed (reg 3) 0))
+ (dmovem (reg 4) (indexed (reg 1) 0))))
+ (!*FTimes2 ((dmove (reg 3) (indexed (reg 3) 0))
+ (dfmp (reg 3) (indexed (reg 2) 0))
+ (dmovem (reg 3) (indexed (reg 1) 0))))
+ (!*FQuotient ((dmove (reg 4) (indexed (reg 2) 0))
+ (dfdv (reg 4) (indexed (reg 3) 0))
+ (dmovem (reg 4) (indexed (reg 1) 0)))))
+ 'OpenCode)
+
+% Later, do as FORTRAN call?
+(DE !*ForeignLink (FunctionName FunctionType NumberOfArguments)
+ (prog NIL
+ (CodeDeclareExternal FunctionName) % To emit Extern
+ (return (LIST (LIST 'Pushj '(REG st) (LIST 'InternalEntry FunctionName))))
+))
+
+(DefCMacro !*ForeignLink)
ADDED psl-1983/20-comp/dec20-comp.b
Index: psl-1983/20-comp/dec20-comp.b
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-comp.b
cannot compute difference between binary files
ADDED psl-1983/20-comp/dec20-comp.build
Index: psl-1983/20-comp/dec20-comp.build
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-comp.build
@@ -0,0 +1,1 @@
+in "dec20-comp.red"$
ADDED psl-1983/20-comp/dec20-comp.ctl
Index: psl-1983/20-comp/dec20-comp.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-comp.ctl
@@ -0,0 +1,9 @@
+; Rebuild the COMP module
+@term page 0
+@get psl:rlisp
+@st
+*load build;
+*build "DEC20-COMP";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/20-comp/dec20-comp.red
Index: psl-1983/20-comp/dec20-comp.red
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-comp.red
@@ -0,0 +1,163 @@
+%
+% 20-COMP.RED - Compiler patterns for Dec-20 PSL, plus a few cmacro expanders
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.20-COMP>20-COMP.RED.1, 25-Feb-82 16:34:42, Edit by BENSON
+% Converted from VAX version
+
+
+PUT('TVPAT,'PATTERN,'(
+ !®MEM ('!*DESTROY DEST)
+ ((DEST ANY) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((ANY DEST) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((USESDEST ANY) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((ANY USESDEST) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ (ANY ('!*LOAD DEST '(QUOTE T)) (MAC L1 A1 A2)
+ ('!*LOAD DEST '(QUOTE NIL)) ('!*LBL L1))));
+
+
+PUT('TVPAT1,'PATTERN,'(
+ !®MEM ('!*DESTROY DEST)
+ ((DEST) (MAC L1 A1 P2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((USESDEST) (MAC L1 A1 P2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ (ANY ('!*LOAD DEST '(QUOTE T)) (MAC L1 A1 P2)
+ ('!*LOAD DEST '(QUOTE NIL)) ('!*LBL L1))));
+
+
+PUT('TSTPAT,'PATTERN,'(
+ NIL
+ !&FIXREGTEST
+ ((REGN ANY) (MAC DEST A1 A2))
+ (ANY (MAC DEST A2 A1))));
+
+PUT('TSTPATC,'PATTERN,'(
+ NIL
+ !&SETREGS1
+ ((REGN ANY) (MAC DEST A1 A2))
+ (ANY (P2 DEST A2 A1))));
+
+PUT('TSTPAT2, 'PATTERN, '(
+ NIL !&SETREGS1
+ (ANY (MAC DEST A1 P2))));
+
+PUT('SETQPAT,'PATTERN,'(
+ NIL NIL
+ ((NOVAL ANY NOTANYREG) ('!*STORE A2 A1))
+ ((NOVAL DEST ANY) ('!*STORE A2 DEST))
+ ((NOVAL USESDEST ANY) ('!*LOAD T1 A2) ('!*STORE T1 A1))
+ ((NOVAL ANY ANY) ('!*LOAD DEST A2) ('!*STORE DEST A1))
+ ((ANY DEST) ('!*STORE DEST A1))
+ ((DEST ANY) ('!*STORE A2 DEST))
+ ((USESDEST ANY) ('!*STORE A2 A1) ('!*STORE A2 DEST))
+ (ANY ('!*LOAD DEST A2) ('!*STORE DEST A1))));
+
+PUT('RPLACPAT,'PATTERN,'(
+ NIL NIL
+ ((NOVAL ANY ANY) ('!*STORE A2 (MAC A1)))
+ ((DEST ANY) ('!*STORE A2 (MAC A1)))
+ ((USESDEST ANY) ('!*STORE A2 (MAC A1)) ('!*LOAD DEST A1))
+ ((ANY DEST) ('!*STORE A2 (MAC A1)) ('!*LOAD DEST A1))
+ ((ANY USESDEST) ('!*STORE A2 (MAC A1)) ('!*LOAD DEST A1))
+ (ANY ('!*LOAD DEST A1) ('!*STORE A2 (MAC DEST)))));
+
+PUT('ASSOCPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2))
+ ((DEST ANY) (MAC A1 A2))
+ ((ANY DEST) (MAC A2 A1))
+ ((USESDEST USESDEST) ('!*LOAD T1 A1) ('!*LOAD DEST A2) (MAC DEST T1))
+ ((ANY USESDEST) ('!*LOAD DEST A2) (MAC DEST A1))
+ (ANY ('!*LOAD DEST A1) (MAC DEST A2))));
+
+PUT('SUBPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2))
+ ((DEST ANY) (MAC A1 A2))
+ ((ANY DEST) ('!*WMINUS DEST DEST) ('!*WPLUS2 A2 A1))
+ (ANY ('!*LOAD DEST A1) (MAC DEST A2))));
+
+PUT('NONASSOCPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2))
+ ((DEST ANY) (MAC A1 A2))
+ ((ANY USESDEST) ('!*LOAD T1 A2) ('!*LOAD DEST A1) (MAC DEST T1))
+ (ANY ('!*LOAD DEST A1) (MAC DEST A2))));
+
+PUT('FIELDPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2 A3))
+ (ANY (MAC DEST A1 A2 A3))));
+
+PUT('PUTFIELDPAT,'PATTERN,'(
+ NIL NIL
+ ((NOVAL ANY ANY ANY ANY) (MAC A1 A2 A3 A4))
+ (ANY (MAC A1 A2 A3 A4) ('!*STORE A1 DEST))));
+
+PUT('UNARYPAT,'PATTERN,'(
+ !&NOANYREG ('!*SET DEST (FN A1))
+ (ANY (MAC DEST A1))));
+
+PUT('MODMEMPAT,'PATTERN,'(
+ NIL NIL
+ (ANY (MAC A1 A2))));
+
+PUT('MODMEMPAT1,'PATTERN,'(
+ NIL NIL
+ (ANY (MAC A1 A1))));
+
+lisp procedure !*LamBind(Regs, FLst);
+begin scalar X, Y;
+ FLst := reverse cdr FLst;
+ Regs := reverse cdr Regs;
+ while FLst do
+ << if null Regs then
+ X := 0
+ else
+ << X := cadr car Regs;
+ Regs := cdr Regs >>;
+ Y := list('halfword, X, list('IDLoc, cadar FLst)) . Y;
+ FLst := cdr FLst >>;
+ return '(jsp (reg t5) (Entry FastBind)) . Y;
+end;
+
+DefCMacro !*Lambind;
+
+lisp procedure !*JumpOn(Register, LowerBound, UpperBound, LabelList);
+begin scalar ExitLbl, BaseLbl, Result;
+ ExitLbl := GenSym();
+ BaseLbl := GenSym();
+ Result := NIL . NIL;
+ TConc(Result,if LowerBound < 0 then
+ list('caml, Register, list('lit, LowerBound))
+ else
+ list('cail, Register, LowerBound));
+ TConc(Result,if UpperBound < 0 then
+ list('camle, Register, list('lit, UpperBound))
+ else
+ list('caile, Register, UpperBound));
+ TConc(Result,list('jrst, ExitLbl));
+ TConc(Result,
+ list('jrst,
+ list('Indirect,
+ list('Indexed,
+ Register,
+ list('difference, BaseLbl, LowerBound)))));
+ TConc(Result, BaseLbl);
+ for each X in LabelList do
+ TConc(Result, list('fullword, cadr X));
+ TConc(Result, ExitLbl);
+ return car Result;
+end;
+
+DefCMacro !*JumpOn;
+
+END;
ADDED psl-1983/20-comp/dec20-cross.ctl
Index: psl-1983/20-comp/dec20-cross.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cross.ctl
@@ -0,0 +1,14 @@
+
+@get PSL:RLISP
+@st
+*Options!*:=NIL; % Force reload of ALL
+*LoadDirectories!*:='("pl:"); % Only look at <psl.lap>
+*load(zboot, syslisp, if!-system, lap!-to!-asm);
+*load(dec20!-comp,dec20!-cmac,dec20!-asm);
+* %/ old:? remflag('(extrareg),'terminaloperand);
+* %/ to fix HRRZI for ExtraReg... why was it here
+*off usermode;
+*Date!* := "Dec 20 cross compiler";
+*Dumplisp "S:DEC20-CROSS.EXE";
+*Quit;
+@reset .
ADDED psl-1983/20-comp/dec20-cross.log
Index: psl-1983/20-comp/dec20-cross.log
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-cross.log
cannot compute difference between binary files
ADDED psl-1983/20-comp/dec20-data-machine.red
Index: psl-1983/20-comp/dec20-data-machine.red
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-data-machine.red
@@ -0,0 +1,68 @@
+%
+% 20-DATA-MACHINE.RED - Lisp item constructors & selectors for Dec-20 Syslisp
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 July 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.20-COMP>20-DATA-MACHINE.RED.1, 25-Feb-82 17:24:56, Edit by BENSON
+% Converted from VAX version (which was previously converted from 20 version!)
+
+% Primitives handled by the compiler are BYTE, PUTBYTE, GETMEM, PUTMEM,
+% MKITEM, FIELD, SIGNEDFIELD, PUTFIELD
+
+fluid '(system_list!*);
+
+system_list!* := '(Dec20 PDP10 Tops20 KL10);
+
+BothTimes <<
+exported WConst TagStartingBit = 0,
+ TagBitLength = 5,
+ InfStartingBit = 18,
+ InfBitLength = 18,
+ GCStartingBit = 5,
+ GCBitLength = 13,
+ AddressingUnitsPerItem = 1,
+ CharactersPerWord = 5,
+ BitsPerWord = 36,
+ AddressingUnitsPerFunctionCell = 1,
+ StackDirection = 1;
+>>;
+
+syslsp macro procedure GCField U;
+ list('Field, cadr U, '(WConst GCStartingBit), '(WConst GCBitLength));
+
+syslsp macro procedure PutGCField U;
+ list('PutField, cadr U, '(WConst GCStartingBit), '(WConst GCBitLength),
+ caddr U);
+
+% Retrieve the address stored in the function cell
+
+syslsp macro procedure SymFnc U;
+ list('WGetV, '(WConst SymFnc), cadr U);
+
+
+syslsp macro procedure PutSymFnc U;
+ list('WPutV, '(WConst SymFnc), cadr U, caddr U);
+
+% Macros for building stack pointers
+
+syslsp macro procedure MakeStackPointerFromAddress U;
+ list('WOr, list('WShift, list('WDifference, 0, caddr U), 18),
+ list('WDifference, cadr U, 1));
+
+syslsp macro procedure MakeAddressFromStackPointer U;
+ list('Field, cadr U, 18, 18);
+
+put('AdjustStackPointer,'OpenFn,'(NonAssocPat !*ADJSP));
+
+lisp procedure !*ADJSP(Arg1, Arg2);
+ Expand2OperandCMacro(Arg1, Arg2, '!*ADJSP);
+
+put('EOF, 'CharConst, char cntrl Z);
+
+END;
ADDED psl-1983/20-comp/dec20-lap.build
Index: psl-1983/20-comp/dec20-lap.build
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-lap.build
@@ -0,0 +1,6 @@
+CompileTime <<
+load Syslisp;
+>>;
+in "p20:system-faslout.red"$
+in "dec20-lap.red"$
+in "instrs.sl"$
ADDED psl-1983/20-comp/dec20-lap.red
Index: psl-1983/20-comp/dec20-lap.red
==================================================================
--- /dev/null
+++ psl-1983/20-comp/dec20-lap.red
@@ -0,0 +1,442 @@
+%
+% 20-LAP.RED - Dec-20 PSL assembler
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 1 February 1982
+% Copyright (c) 1982 University of Utah
+%
+
+fluid '(LabelOffsets!* CurrentOffset!* CodeSize!* CodeBase!* Entries!*
+ ForwardInternalReferences!*
+ NewBitTableEntry!* LapReturnValue!*
+ !*WritingFaslFile InitOffset!* !*PGWD !*PWrds);
+
+CompileTime <<
+
+flag('(SaveEntry DefineEntries DepositInstruction
+ OpcodeValue OperandValue DepositWord DepositWordExpression
+ DepositHalfWords LabelValue DepositItem DepositHalfWordIDNumber
+ FindLabels OneLapLength MakeRelocInf MakeRelocWord),
+ 'InternalFunction);
+
+smacro procedure LabelP X;
+ atom X;
+
+>>;
+
+LoadTime <<
+
+!*PWrds := T;
+
+>>;
+
+lisp procedure Lap U;
+begin scalar LapReturnValue!*, LabelOffsets!*, Entries!*;
+ if not !*WritingFaslFile then
+ CurrentOffset!* := 0;
+ U := Pass1Lap U;
+ FindLabels U;
+ if !*PGWD then for each X in U do
+ if atom X then Prin2 X else PrintF(" %p%n", X);
+ if not !*WritingFaslFile then
+ CodeBase!* := GTBPS CodeSize!*;
+ for each X in U do
+ if not LabelP X then
+ if first X = '!*entry then SaveEntry X
+ else DepositInstruction X;
+ DefineEntries();
+ if not !*WritingFaslFile and !*PWrds then
+ ErrorPrintF("*** %p: base %o, length %d words",
+ for each X in Entries!* collect first car X,
+ CodeBase!*, CodeSize!*);
+ return MkCODE LapReturnValue!*;
+end;
+
+lisp procedure SaveEntry X;
+ if second X = '!*!*!*Code!*!*Pointer!*!*!* then
+ LapReturnValue!* := % Magic token that tells LAP to return
+ (if !*WritingFaslFile then CurrentOffset!* % a code pointer
+ else IPlus2(CodeBase!*, CurrentOffset!*))
+ else if not !*WritingFaslFile then
+ << Entries!* := (rest X . CurrentOffset!*) . Entries!*;
+ if not LapReturnValue!* then LapReturnValue!* :=
+ IPlus2(CodeBase!*, CurrentOffset!*) >>
+ else if second X = '!*!*Fasl!*!*InitCode!*!* then
+ InitOffset!* := CurrentOffset!*
+ else if FlagP(second X, 'InternalFunction) then
+ put(second X, 'InternalEntryOffset, CurrentOffset!*)
+ else
+ << FindIDNumber second X;
+ DFPrintFasl list('PutEntry, MkQuote second X,
+ MkQuote third X,
+ CurrentOffset!*) >>;
+
+lisp procedure DefineEntries();
+ for each X in Entries!* do
+ PutD(first car X, second car X, MkCODE IPlus2(CodeBase!*, cdr X));
+
+lisp procedure DepositInstruction X;
+%
+% Legal forms are:
+% (special_form . any)
+% (opcode)
+% (opcode address)
+% (opcode ac address)
+%
+begin scalar Op, Y, A, E;
+ return if (Y := get(first X, 'InstructionDepositFunction)) then
+ Apply(Y, list X)
+ else
+ << NewBitTableEntry!* := 0;
+ Op := OpcodeValue first X;
+ if null(Y := rest X) then
+ A := E := 0
+ else
+ << E := OperandValue first Y;
+ if null(Y := rest Y) then
+ A := 0
+ else
+ << A := E;
+ E := OperandValue first Y >> >>;
+ UpdateBitTable(1, NewBitTableEntry!*);
+ DepositAllFields(Op, A, E) >>;
+end;
+
+lisp procedure DepositAllFields(Op, A, E);
+<< @IPlus2(CodeBase!*, CurrentOffset!*) :=
+ ILOR(ILSH(Op, 27), ILOR(ILSH(A, 23), E));
+ CurrentOffset!* := IAdd1 CurrentOffset!* >>;
+
+lisp procedure OpcodeValue U;
+ if PosIntP U then U
+ else get(U, 'OpcodeValue) or StdError BldMsg("Unknown opcode %r", U);
+
+lisp procedure OperandValue U;
+%
+% Legal forms are:
+% number
+% other atom (label)
+% (special . any) fluid, global, etc.
+% (indexed register address)
+% (indirect other_op)
+%
+begin scalar X;
+ return if PosIntP U then U
+ else if NegIntP U then ILAND(U, 8#777777)
+ else if LabelP U then LabelValue U
+ else if (X := get(first U, 'OperandValueFunction)) then
+ Apply(X, list U)
+ else if (X := WConstEvaluable U) then OperandValue X
+ else StdError BldMsg("Unknown operand %r", U);
+end;
+
+lisp procedure BinaryOperand U;
+%
+% (op x x) can occur in expressions
+%
+begin scalar X;
+ return if (X := WConstEvaluable U) then X
+ else
+ << X := if GetD first U then first U else get(first U, 'DOFN);
+ U := rest U;
+ if NumberP first U then
+ Apply(X, list(first U, LabelValue second U))
+ else if NumberP second U then
+ Apply(X, list(LabelValue first U, second U))
+ else StdError BldMsg("Expression too complicated in LAP %r", U) >>;
+end;
+
+% Add others to this list if they arise
+
+put('difference, 'OperandValueFunction, 'BinaryOperand);
+put('WPlus2, 'OperandValueFunction, 'BinaryOperand);
+
+lisp procedure RegisterOperand U;
+begin scalar V;
+ U := second U;
+ return if PosIntP U then U
+ else if (V := get(U, 'RegisterNumber)) then V
+ else StdError BldMsg("Unknown register %r", U);
+end;
+
+put('REG, 'OperandValueFunction, 'RegisterOperand);
+
+DefList('((nil 0)
+ (t1 6)
+ (t2 7)
+ (t3 8)
+ (t4 9)
+ (t5 10)
+ (t6 11)
+ (st 8#17)), 'RegisterNumber);
+
+lisp procedure ImmediateOperand U;
+ OperandValue second U; % immediate does nothing on the PDP10
+
+put('immediate, 'OperandValueFunction, 'ImmediateOperand);
+
+lisp procedure IndexedOperand U;
+begin scalar V;
+ V := OperandValue second U;
+ U := OperandValue third U;
+ return ILOR(ILSH(V, 18), U);
+end;
+
+put('indexed, 'OperandValueFunction, 'IndexedOperand);
+
+lisp procedure LapValueCell U;
+ ValueCellLocation second U;
+
+DefList('((fluid LapValueCell)
+ (!$fluid LapValueCell)
+ (global LapValueCell)
+ (!$global LapValueCell)), 'OperandValueFunction);
+
+lisp procedure LapEntry U;
+ FunctionCellLocation second U;
+
+put('entry, 'OperandValueFunction, 'LapEntry);
+
+lisp procedure LapInternalEntry U;
+begin scalar X;
+ U := second U;
+ NewBitTableEntry!* := const RELOC_HALFWORD;
+ return if (X := Atsoc(U, LabelOffsets!*)) then
+ << X := cdr X;
+ if !*WritingFaslFile then X else IPlus2(CodeBase!*, X) >>
+ else
+ << if not !*WritingFaslFile then FunctionCellLocation U
+ else if (X := get(U, 'InternalEntryOffset)) then X
+ else
+ << ForwardInternalReferences!* :=
+ (CurrentOffset!* . U) . ForwardInternalReferences!*;
+ 0 >> >>; % will be modified later
+end;
+
+put('InternalEntry, 'OperandValueFunction, 'LapInternalEntry);
+
+lisp procedure DepositWordBlock X;
+ for each Y in cdr X do DepositWordExpression Y;
+
+put('fullword, 'InstructionDepositFunction, 'DepositWordBlock);
+
+lisp procedure DepositHalfWordBlock X;
+begin scalar L, R;
+ X := rest X;
+ while not null X do
+ << L := first X;
+ X := rest X;
+ if null X then
+ R := 0
+ else
+ << R := first X;
+ X := rest X >>;
+ DepositHalfWords(L, R) >>;
+end;
+
+put('halfword, 'InstructionDepositFunction, 'DepositHalfWordBlock);
+
+CommentOutCode <<
+lisp procedure DepositByteBlock X;
+ case length X of
+ 0: DepositWord 0;
+ 1: DepositBytes(first X, 0, 0, 0, 0);
+ 2: DepositBytes(first X, second X, 0, 0, 0);
+ 3: DepositBytes(first X, second X, third X, 0, 0);
+ 4: DepositBytes(first X, second X, third X, fourth X, 0);
+ default:
+ << DepositBytes(first X, second X, third X, fourth X, fourth rest X);
+ DepositByteBlock rest rest rest rest rest X >>;
+ end;
+
+put('byte, 'InstructionDepositFunction, 'DepositByteBlock);
+>>;
+
+lisp procedure DepositString X;
+begin scalar Y;
+ X := StrInf second X;
+ Y := StrPack StrLen X;
+ for I := 1 step 1 until Y do DepositWord @IPlus2(X, I);
+end;
+
+put('string, 'InstructionDepositFunction, 'DepositString);
+
+lisp procedure DepositFloat X; % this will not work in cross-assembly
+<< X := second X; % don't need to strip tag on PDP10
+ DepositWord FloatHighOrder X;
+ DepositWord FloatLowOrder X >>;
+
+put('float, 'InstructionDepositFunction, 'DepositFloat);
+
+lisp procedure DepositWord X;
+<< @IPlus2(CodeBase!*, CurrentOffset!*) := X;
+ UpdateBitTable(1, 0);
+ CurrentOffset!* := IAdd1 CurrentOffset!* >>;
+
+lisp procedure DepositWordExpression X; % Only limited expressions now handled
+begin scalar Y;
+ return if FixP X then DepositWord Int2Sys X
+ else if LabelP X then
+ << @IPlus2(CodeBase!*, CurrentOffset!*) := LabelValue X;
+ UpdateBitTable(1, const RELOC_HALFWORD);
+ CurrentOffset!* := IAdd1 CurrentOffset!* >>
+ else if first X = 'MkItem then DepositItem(second X, third X)
+ else if first X = 'FieldPointer then
+ DepositFieldPointer(second X, third X, fourth X)
+ else if (Y := WConstEvaluable X) then DepositWord Int2Sys Y
+ else StdError BldMsg("Expression too complicated %r", X);
+end;
+
+lisp procedure DepositHalfWords(L, R);
+begin scalar Y;
+ if not (FixP L or (L := WConstEvaluable L))
+ then StdError "Left half too complex";
+ if PairP R and first R = 'IDLoc then
+ DepositHalfWordIDNumber(L, second R)
+ else if (Y := WConstEvaluable R) then DepositWord ILOR(ILSH(L, 18), Y)
+ else StdError BldMsg("Halfword expression too complicated %r", R);
+end;
+
+lisp procedure LabelValue U;
+begin scalar V;
+ return if CodeP U then Inf U
+ else if (V := Atsoc(U, LabelOffsets!*)) then
+ << V := cdr V;
+ if !*WritingFaslFile then
+ << NewBitTableEntry!* := const RELOC_HALFWORD;
+ V >>
+ else IPlus2(CodeBase!*, V) >>
+ else StdError BldMsg("Unknown label %r in LAP", U);
+end;
+
+lisp procedure DepositItem(TagPart, InfPart);
+ if not !*WritingFaslFile then
+ DepositWord MkItem(TagPart, if LabelP InfPart then
+ LabelValue InfPart
+ else if first InfPart = 'IDLoc then
+ IDInf second InfPart
+ else
+ StdError BldMsg("Unknown inf in MkItem %r",
+ InfPart))
+ else
+ << if LabelP InfPart then
+ @IPlus2(CodeBase!*, CurrentOffset!*) := % RELOC_CODE_OFFSET = 0
+ MkItem(TagPart, LabelValue InfPart)
+ else if first InfPart = 'IDLoc then
+ @IPlus2(CodeBase!*, CurrentOffset!*) :=
+ MkItem(TagPart,
+ MakeRelocInf(const RELOC_ID_NUMBER,
+ FindIDNumber second InfPart))
+ else StdError BldMsg("Unknown inf in MkItem %r", InfPart);
+ CurrentOffset!* := IAdd1 CurrentOffset!*;
+ UpdateBitTable(1, const RELOC_INF) >>;
+
+lisp procedure DepositHalfWordIDNumber(LHS, X);
+ if not !*WritingFaslFile or ILEQ(IDInf X, 128) then
+ DepositWord ILOR(ILSH(LHS, 18), IDInf X)
+ else
+ << @IPlus2(CodeBase!*, CurrentOffset!*) := ILOR(ILSH(LHS, 18),
+ MakeRelocHalfWord(const RELOC_ID_NUMBER, FindIDNumber X));
+ CurrentOffset!* := IAdd1 CurrentOffset!*;
+ UpdateBitTable(1, const RELOC_HALFWORD) >>;
+
+lisp procedure SystemFaslFixup();
+<< while not null ForwardInternalReferences!* do
+ << Field(@IPlus2(CodeBase!*,
+ car first ForwardInternalReferences!*),
+ 18, 18) :=
+ get(cdr first ForwardInternalReferences!*, 'InternalEntryOffset)
+ or << ErrorPrintF(
+"***** %r not defined in this module; normal function call being used",
+ cdr first ForwardInternalReferences!*);
+ MakeRelocHalfWord(const RELOC_FUNCTION_CELL,
+ FindIDNumber cdr first
+ ForwardInternalReferences!*) >>;
+ ForwardInternalReferences!* := cdr ForwardInternalReferences!* >>;
+ MapObl function lambda(X);
+ RemProp(X, 'InternalEntryOffset) >>;
+
+
+fluid '(LapCodeList!*);
+
+lisp procedure FindLabels LapCodeList!*;
+<< CodeSize!* := 0;
+ for each X in LapCodeList!* do
+ CodeSize!* := IPlus2(CodeSize!*, OneLapLength X) >>;
+
+lisp procedure OneLapLength U;
+begin scalar X;
+ return if atom U then
+ << LabelOffsets!* := (U . IPlus2(CurrentOffset!*, CodeSize!*))
+ . LabelOffsets!*;
+ 0 >>
+ else if (X := get(car U, 'LapLength)) then
+ if PosIntP X then X
+ else Apply(X, list U)
+ else % minor klugde for long constants
+ << if length U = 3 and FixP(X := third U) and not ImmediateP X then
+ begin scalar Y;
+ RPlaca(rest rest U, Y := StringGensym());
+ NConc(LapCodeList!*, list(Y, list('fullword, X)));
+ end;
+ 1 >>;
+end;
+
+DefList('((!*entry LapEntryLength)
+ (float 2)
+ (string LapStringLength)
+ (fullword LapWordLength)
+ (halfword LapHalfwordLength)
+ (byte LapByteLength)), 'LapLength);
+
+lisp procedure LapEntryLength U;
+<< LabelOffsets!* := (second U . IPlus2(CurrentOffset!*, CodeSize!*))
+ . LabelOffsets!*;
+ 0 >>;
+
+lisp procedure LapStringLength U;
+ StrPack StrLen StrInf second U;
+
+lisp procedure LapWordLength U;
+ length rest U;
+
+lisp procedure LapHalfwordLength U;
+ ILSH(IAdd1 length rest U, -1);
+
+lisp procedure LapByteLength U;
+ StrPack length rest U;
+
+on SysLisp;
+
+syslsp procedure DepositFieldPointer(Opr, Start, Len);
+<< LispVar NewBitTableEntry!* := 0;
+ Opr := OperandValue Opr;
+ @IPlus2(LispVar CodeBase!*, LispVar CurrentOffset!*) :=
+ ILOR(ILSH(36 - (Start + Len), 30), ILOR(ILSH(Len, 24), Opr));
+ UpdateBitTable(1, LispVar NewBitTableEntry!*);
+ LispVar CurrentOffset!* := IAdd1 LispVar CurrentOffset!* >>;
+
+syslsp procedure IndirectOperand U;
+ ILOR(ILSH(1, 22), OperandValue second U);
+
+put('Indirect, 'OperandValueFunction, 'IndirectOperand);
+
+% ExtraRegLocation is in 20-FASL
+
+put('ExtraReg, 'OperandValueFunction, 'ExtraRegLocation);
+
+syslsp procedure MakeRelocWord(RelocTag, RelocInf);
+ LSH(RelocTag, 34) + Field(RelocInf, 2, 34);
+
+syslsp procedure MakeRelocInf(RelocTag, RelocInf);
+ LSH(RelocTag, 16) + Field(RelocInf, 20, 16);
+
+syslsp procedure MakeRelocHalfWord(RelocTag, RelocInf);
+ LSH(RelocTag, 16) + Field(RelocInf, 20, 16);
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-comp/instrs.sl
Index: psl-1983/20-comp/instrs.sl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/instrs.sl
@@ -0,0 +1,47 @@
+(compiletime
+(dm DEFINEOPCODERANGEFROM (U)
+ (prog (start args)
+ (setq start (sub1 (second U)))
+ (setq args (second (third U)))
+ (return (cons 'progn
+ (foreach X in args collect (list 'put
+ (mkquote X)
+ ''opcodevalue
+ (setq start (add1 start))))))))
+)
+(DEFINEOPCODERANGEFROM 68 (QUOTE (JSYS ADJSP)))
+(DEFINEOPCODERANGEFROM 91 (QUOTE (ADJBP)))
+(DEFINEOPCODERANGEFROM 72 (QUOTE (DFAD DFSB DFMP DFDV)))
+(DEFINEOPCODERANGEFROM 80 (QUOTE (DMOVE DMOVN FIX)))
+(DEFINEOPCODERANGEFROM 84 (QUOTE (DMOVEM DMOVNM FIXR FLTR UFA DFN FSC IBP
+ILDB LDB IDPB DPB FAD FADL FADM FADB FADR FADRI FADRM FADRB FSB FSBL FSBM
+FSBB FSBR FSBRI FSBRM FSBRB FMP FMPL FMPM FMPB FMPR FMPRI FMPRM FMPRB FDV
+FDVL FDVM FDVB FDVR FDVRI FDVRM FDVRB MOVE MOVEI MOVEM MOVES MOVS MOVSI
+MOVSM MOVSS MOVN MOVNI MOVNM MOVNS MOVM MOVMI MOVMM MOVMS IMUL IMULI IMULM
+IMULB MUL MULI MULM MULB IDIV IDIVI IDIVM IDIVB DIV DIVI DIVM DIVB ASH ROT
+LSH JFFO ASHC ROTC LSHC)))
+(DEFINEOPCODERANGEFROM 168 (QUOTE (EXCH BLT AOBJP AOBJN JRST JFCL XCT MAP
+PUSHJ PUSH POP POPJ JSR JSP JSA JRA ADD ADDI ADDM ADDB SUB SUBI SUBM SUBB
+CAI CAIL CAIE CAILE CAIA CAIGE CAIN CAIG CAM CAML CAME CAMLE CAMA CAMGE CAMN
+CAMG)))
+(DEFINEOPCODERANGEFROM 208 (QUOTE (JUMP JUMPL JUMPE JUMPLE JUMPA JUMPGE
+JUMPN JUMPG SKIP SKIPL SKIPE SKIPLE SKIPA SKIPGE SKIPN SKIPG AOJ AOJL AOJE
+AOJLE AOJA AOJGE AOJN AOJG AOS AOSL AOSE AOSLE AOSA AOSGE AOSN AOSG SOJ SOJL
+SOJE SOJLE SOJA SOJGE SOJN SOJG SOS SOSL SOSE SOSLE SOSA SOSGE SOSN SOSG)))
+(DEFINEOPCODERANGEFROM 256 (QUOTE (SETZ SETZI SETZM SETZB AND ANDI ANDM ANDB
+ANDCA ANDCAI ANDCAM ANDCAB SETM SETMI SETMM SETMB ANDCM ANDCMI ANDCMM ANDCMB)))
+(DEFINEOPCODERANGEFROM 276 (QUOTE (SETA SETAI SETAM SETAB XOR XORI XORM XORB
+IOR IORI IORM IORB ANDCB ANDCBI ANDCBM ANDCBB EQV EQVI EQVM EQVB SETCA
+SETCAI SETCAM SETCAB ORCA ORCAI ORCAM ORCAB SETCM SETCMI SETCMM SETCMB ORCM
+ORCMI ORCMM ORCMB ORCB ORCBI ORCBM ORCBB SETO SETOI SETOM SETOB)))
+(DEFINEOPCODERANGEFROM 320 (QUOTE (HLL HLLI HLLM HLLS HRL HRLI HRLM HRLS
+HLLZ HLLZI HLLZM HLLZS HRLZ HRLZI HRLZM HRLZS HLLO HLLOI HLLOM HLLOS HRLO
+HRLOI HRLOM HRLOS HLLE HLLEI HLLEM HLLES HRLE HRLEI HRLEM HRLES HRR HRRI
+HRRM HRRS HLR HLRI HLRM HLRS HRRZ HRRZI HRRZM HRRZS HLRZ HLRZI HLRZM HLRZS
+HRRO HRROI HRROM HRROS HLRO HLROI HLROM HLROS HRRE HRREI HRREM HRRES HLRE
+HLREI HLREM HLRES)))
+(DEFINEOPCODERANGEFROM 384 (QUOTE (TRN TLN TRNE TLNE TRNA TLNA TRNN TLNN TDN
+TSN TDNE TSNE TDNA TSNA TDNN TSNN TRZ TLZ TRZE TLZE TRZA TLZA TRZN TLZN TDZ
+TSZ TDZE TSZE TDZA TSZA TDZN TSZN TRC TLC TRCE TLCE TRCA TLCA TRCN TLCN TDC
+TSC TDCE TSCE TDCA TSCA TDCN TSCN TRO TLO TROE TLOE TROA TLOA TRON TLON TDO
+TSO TDOE TSOE TDOA TSOA TDON TSON)))
ADDED psl-1983/20-comp/non-kl-comp.build
Index: psl-1983/20-comp/non-kl-comp.build
==================================================================
--- /dev/null
+++ psl-1983/20-comp/non-kl-comp.build
@@ -0,0 +1,1 @@
+in "non-kl-comp.sl"$
ADDED psl-1983/20-comp/non-kl-comp.sl
Index: psl-1983/20-comp/non-kl-comp.sl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/non-kl-comp.sl
@@ -0,0 +1,35 @@
+%
+% NON-KL-COMP.SL - Patches to compiler for KI processor
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.COMP-20>NON-KL-COMP.SL.6, 13-Oct-82 13:39:27, Edit by BENSON
+% Removed unnecessary patch of floating point arith for DMOVE
+
+(setq system_list* (delete 'KL10 system_list*))_
+
+(DefCMacro !*Alloc
+ ((ZeroP))
+ ((add (REG st) (lit (halfword ARGONE ARGONE)))
+ (jumpge (REG st) (Entry StackOverflow))))
+
+(DefCMacro !*DeAlloc
+ ((ZeroP))
+ ((sub (REG st) (lit (halfword ARGONE ARGONE)))))
+
+(ForEach X in '(Byte PutByte HalfWord PutHalfWord BitTable PutBitTable) do
+ (RemProp X 'OpenCode)
+ (RemProp X 'Destroys))
+
+(RemProp 'AdjustStackPointer 'OpenFn)
+
+(dm AdjustStackPointer (U)
+ (list 'WPlus2
+ (cadr U)
+ (list 'WPlus2 (caddr U) (list 'WShift (caddr U) 18))))
ADDED psl-1983/20-comp/readme
Index: psl-1983/20-comp/readme
==================================================================
--- /dev/null
+++ psl-1983/20-comp/readme
@@ -0,0 +1,2 @@
+This directory contains sources which are specific to the Dec-20 version
+of Portable Standard LISP.
ADDED psl-1983/20-comp/tenex-asm.build
Index: psl-1983/20-comp/tenex-asm.build
==================================================================
--- /dev/null
+++ psl-1983/20-comp/tenex-asm.build
@@ -0,0 +1,1 @@
+in "tenex-asm.sl"$
ADDED psl-1983/20-comp/tenex-asm.sl
Index: psl-1983/20-comp/tenex-asm.sl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/tenex-asm.sl
@@ -0,0 +1,15 @@
+%
+% TENEX-ASM.SL - Patch to 20-ASM for TENEX
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Not much to do...
+
+(de CodeFileHeader ()
+ (CodePrintF " search stenex%n radix 10%n"))
ADDED psl-1983/20-comp/tenex-build-patch.ctl
Index: psl-1983/20-comp/tenex-build-patch.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-comp/tenex-build-patch.ctl
@@ -0,0 +1,7 @@
+; Run this after BUILD-20-CROSS.CTL
+S:DEC20-CROSS
+load Tenex!-Asm, Non!-KL!-Comp;
+system_list!* := Delete('Tops20, system_list!*);
+system_list!* := Delete('KL10, system_list!*);
+system_list!* := Adjoin('Tenex, system_list!*);
+DumpLisp "S:TENEX-CROSS.EXE";
ADDED psl-1983/20-comp/tenex-build-patch.log
Index: psl-1983/20-comp/tenex-build-patch.log
==================================================================
--- /dev/null
+++ psl-1983/20-comp/tenex-build-patch.log
cannot compute difference between binary files
ADDED psl-1983/20-comp/test-dec20-cross.mic
Index: psl-1983/20-comp/test-dec20-cross.mic
==================================================================
--- /dev/null
+++ psl-1983/20-comp/test-dec20-cross.mic
@@ -0,0 +1,10 @@
+@reset RLISP
+@PSL:RLISP
+*Options!* := nil; % Force reload
+*load(zboot, syslisp, if!-system, lap!-to!-asm);
+*load(dec20!-comp,dec20!-cmac,dec20!-asm);
+*remflag(''(extrareg),''terminaloperand);
+*off usermode;
+*Date!* := "Dec 20 cross compiler";
+*Dumplisp "S:DEC20-CROSS.EXE";
+*Quit;
ADDED psl-1983/20-dist.lpt
Index: psl-1983/20-dist.lpt
==================================================================
--- /dev/null
+++ psl-1983/20-dist.lpt
@@ -0,0 +1,728 @@
+Utah Symbolic Computation Group April 1982
+Operating Note No. 62
+
+
+
+
+
+
+
+
+
+
+
+
+ Release Notes
+
+ DEC-20 V3.1 PSL System
DEC-20 V3.1 PSL System
DEC-20 V3.1 PSL System
+
+
+ M. L. Griss, E. Benson and R. R. Kessler
+
+ Utah Symbolic Computation Group
+ Computer Science Department
+ University of Utah
+ Salt Lake City, Utah 84112
+ (801)-581-5017
+
+ 8 March 1983
+
+
+
+
+ ABSTRACT
ABSTRACT
ABSTRACT
+
+
+This note describes how to install the DEC-20 version of PSL.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Work supported in part by the National Science Foundation under
+Grants MCS80-07034 and MCS81-21750, and by development grants
+from Boeing, Patil Systems, Lucas Film, Wicat and Hewlett
+Packard.
DEC-20 PSL Release Page 2
+
+
+1. INTRODUCTION
1. INTRODUCTION
1. INTRODUCTION
+
+ The attached DUMPER format tape contains most of the files
+needed to use and maintain the DEC-20 PSL system. At UTAH we have
+a <PSL> main directory, with a number of sub-directories, each
+containing a separate class of file, such as common interpreter
+and compiler sources, DEC-20 sources, VAX sources, 68000 sources,
+help files, etc. This multi-directory structure enables us to
+manage the sources for all machines in a reasonable way. Most
+people running PSL on the DEC-20 will not be interested in all of
+the files, and certainly will not want to have them all on line.
+
+
+ We have therefore created the tape to enable either a
+multi-directory or single directory model; a set of logical
+device definitions will be TAKEn by the user (usually inserted in
+the LOGIN.CMD file). Each separate distribution directory is a
+separate SAVESET on the attached dumper format tape, and so may
+be individually restored into a common (<PSL> at Utah) directory,
+or into appropriate sub-directories (<PSL.*> at Utah).
+
+
+
+2. DISCLAIMER
2. DISCLAIMER
2. DISCLAIMER
+
+ Please be aware that this is a PRELIMINARY release, and some of
+the files and documentation are not quite complete; we may also
+have forgotten some files, or sent incorrect versions. We are
+releasing this preliminary version to you at this time to enhance
+our collaborative research, and we expect the files to continue
+to change quite rapidly as the system and distribution is tested.
+
+
+ For these reasons please:
+
+
+ a. Make a note of ANY problems, concerns, suggestions you
+ have, and send this information to us to aid in
+ improving the system and this distribution mechanism.
+
+ b. Please do not REDISTRIBUTE any of these files,
+ listings or machine readable form to anyone, and try
+ to restrict access to a small group of users.
DEC-20 PSL Release Page 3
+
+
+3. CONTENTS OF THE TAPE
3. CONTENTS OF THE TAPE
3. CONTENTS OF THE TAPE
+
+ Attached to this note is a copy of the DUMPER run that created
+the tape, indicating the savesets, the file names, and sizes
+needed to restore each saveset.
+
+
+ The tape contains the following SAVESETS (current logical names
+are included in [] after each saveset definition):
+
+
+PSL The executable files (PSL.EXE and RLISP.EXE),
+ this 20-DIST.DOC file, .CMD files to define
+ appropriate logical names and a sample message to
+ announce PSL availability. Also, included are a
+ number of news files announcing new features and
+ changes, some files associated with the NMODE
+ editor and a version of psl (PSLCOMP.EXE) that
+ will compile the argument on the execution line.
+ [psl:]
+
+
+COMP Common compiler, LAP, FASL sources. [pc:]
+
+
+20COMP DEC-20 specific compiler, LAP and FASL sources.
+ [p20c:]
+
+
+DOC Miscellaneous documentation files, including
+ random notes on new features. [pd:]
+
+
+DOCNMODE NMODE documentation files. [pnd:]
+
+
+EMODE The EMODE screen editor sources and documentation
+ to permit Driver Customization. *.b files for
+ drivers other than TELERAY are on LAP directory,
+ have to load after loading EMODE itself. [pe:]
+
+
+GLISP An object oriented LISP. [pg:]
+
+
+HELP A set of *.HLP files, describing major modules.
+ [ph:]
+
+
+KERNEL Machine Independent kernel sources. [pk:]
DEC-20 PSL Release Page 4
+
+
+P20 DecSystem 20 dependent kernel sources. [p20:]
+
+
+LAP Mostly binary FASL (*.B) files, with some LISP
+ files (*.LAP) for loading multiple .B files of
+ loadable (optional) modules. [pl:]
+
+
+LPT The PSL manual in printable form (has
+ overprinting and underlining), as SCRIBE .LPT
+ files. [plpt:]
+
+
+NMODE The NMODE text editor sources, which is a newer
+ version of EMODE developed at HP Research
+ Laboratories. [pn:]
+
+
+NONKERNEL The sources that are not in the kernel, but are
+ kernel related. [pnk:]
+
+
+PT A set of timing and test files. [pt:]
+
+
+PT20 DecSystem 20 specific test files. [p20t:]
+
+
+UTIL Sources for most utilities, useful as examples of
+ PSL and RLISP code, and for customization. [pu:]
+
+
+WINDOWS The window support functions used by NMODE. [pw:]
DEC-20 PSL Release Page 5
+
+
+4. INSTALLING PSL
4. INSTALLING PSL
4. INSTALLING PSL
+
+ When installing the PSL system, you have two options for the
+directory structure. You may utilize a single directory for all
+of the file, or you may create a directory tree using
+subdirectories. The Utah group utilizes a directory tree
+structure and recommends its use when installing a "full" system
+(that includes all of the sources and the capability of
+rebuilding any part of the system). However, if only a minimal
+system is desired, it can be accomplished using a single
+directory.
+
+
+4.1. Retrieve Control Files
4.1. Retrieve Control Files
4.1. Retrieve Control Files
+
+ Whether building a single directory system or multiple
+directory system, logical name definition files and file restore
+control files must be first retrieved. Therefore, first mount
+the dumper tape, at 1600 BPI (verify that there is no write ring
+in the tape). Then, define X: as the appropriate tape device,
+MTAn:, or use MOUNT if running a labeled tape system:
+
+
+@DEFINE X: MTAn: or @MOUNT TAPE X:
+@ASSIGN X:
+
+
+ Restore from the first saveset (PSL) the .cmd and .ctl files
+
+
+ @DUMPER
+ *tape X:
+ *density 1600
+ *files
+ *account system-default
+ *restore <*>*.c* *.*
+ *rewind
+ *exit
+
+
+These files will be restored to your connected directory, and
+should be copied to your main PSL directory after their creation.
+
+
+4.2. Create a single subdirectory
4.2. Create a single subdirectory
4.2. Create a single subdirectory
+
+ Create a directory, call it <name> and define a logical device
+PSL: (a size of about 2600 should be sufficient).
+
+
+ Any <name> will do, since the logical device name PSL: will be
+used.
DEC-20 PSL Release Page 6
+
+
+ @DEF PSL: <name>
+
+
+ Copy the minimal-* restored files to PSL
+
+
+ @COPY minimal-*.* PSL:*.*
+
+
+ Now edit the file PSL:minimal-logical-names.cmd to reflect the
+your choice of <name>.
+
+
+ Also put @TAKE <name>minimal-logical-names.cmd in your
+LOGIN.CMD.
+
+
+ Finally, restore the minimal system by DOing the minimal-
+restore.ctl file:
+
+
+ @DO MINIMAL-RESTORE
+ @DEASSIGN X: or @DISMOUNT X:
DEC-20 PSL Release Page 7
+
+
+4.3. A MULTIPLE SUB-DIRECTORY SYSTEM
4.3. A MULTIPLE SUB-DIRECTORY SYSTEM
4.3. A MULTIPLE SUB-DIRECTORY SYSTEM
+
+ If you plan to do much source modification, or a significant
+number of rebuilds, or maintain a compatible multiple-machine
+version of PSL, or attempt retargeting of PSL, a multiple-
+directory structure such as that at UTAH should be built.
+
+
+ The file FULL-LOGICAL-NAMES.CMD, retrieved above should be used
+as a guide to building the sub-directories. We use at least 16
+sub-directories for the Common Sources and DEC-20 specific
+sources, and have at least an extra two for each new machine.
+Consult the 20-DIST.LOG file supplied with the PSL tape as a
+guide for the amount of space required for each sub-directory.
+The current set of directories for DEC-20 PSL, the logical names
+that we use, and rough space estimate follows. Build the
+sub-directories with a somewhat larger working space allocation.
+
+
+ Now edit the file PSL:full-logical-names.cmd to reflect the
+your choice of <name>.
+
+
+ Also put @TAKE <name>full-logical-names.cmd in your LOGIN.CMD.
+
+
+4.4. Build Sub-Directories
4.4. Build Sub-Directories
4.4. Build Sub-Directories
+
+ Then use the system command, BUILD, to build each sub-directory
+with the name Pxxx:, as follows. Assistance from the system
+manager may be required to permit the creation of
+sub-directories, and the appropriate choice of sub-directory
+parameters:
+
+
+ @BUILD Pxxx:
+ @@PERM nnnn ! choose appropriate size
+ @@WORK wwww ! nnnn+extra
+ @@FILES-ONLY ! Can't login
+ @@GEN 2 ! Retain 1 previous version
+ @@PROTECTION 777700 ! Give group access
+ @@DEFAULT 777700
+ @ ! that are permitted access
+
+
+ To make this process easier, we have created a control file:
+CREATE-DIRECTORIES.CTL that will build all of the subdirectories
+with sizes such that restoration of the files will succeed.
+Therefore, after editing the full-logical-names.cmd file above to
+reflect the correct logical names, simply DO the CTL file (some
+systems use MIC instead of DO, so that may be substituted in the
+following examples) :
DEC-20 PSL Release Page 8
+
+
+ @DO CREATE-DIRECTORIES.CTL
+
+
+ This will create directories with the following sizes (note the
+recommended names):
+
+
+define psl: <psl> ! Executable files and misc.
+ ! -- About 6300 for all psl
+ ! -- 1000 for it alone
+define pc: <psl.comp> ! Compiler sources
+ ! -- 125 pages
+define p20c: <psl.20-comp> ! 20 Specific Compiler sources
+ ! -- 75 pages
+define pd: <psl.doc> ! Documentation files
+ ! -- 275 pages
+define pnd: <psl.doc-nmode> ! NMODE documentation files
+ ! -- 150 pages
+define pe: <psl.emode> ! EMODE support and drivers
+ ! -- 225 pages
+define pg: <psl.glisp> ! GLISP sources
+ ! -- 425 pages
+define ph: <psl.help> ! Help files
+ ! -- 125 pages
+define pk: <psl.kernel> ! Kernel Source files
+ ! -- 225 pages
+define p20k: <psl.20-kernel> ! 20 Specific Kernel Sources
+ ! -- 500 pages
+define pl: <psl.lap> ! LAP files
+ ! -- 700 pages
+define plpt: <psl.lpt> ! Printer version of Docs
+ ! -- 450 pages
+define pn: <psl.nmode> ! NMODE editor files
+ ! -- 375 pages
+define pnk: <psl.nonkernel> ! Nonkernel Sources
+ ! -- 5 pages
+define pt: <psl.tests> ! Test files
+ ! -- 200 pages
+define p20t: <psl.20-tests> ! 20 Specific Test files
+ ! -- 600 pages
+define pu: <psl.util> ! Utility program sources
+ ! -- 600 pages
+define p20u: <psl.20-util> ! 20 Specific Utility files
+ ! -- 75 pages
+define pw: <psl.windows> ! NMODE Window files
+ ! -- 75 pages
+
+
+ Finally, restore the full system by DOing the full-restore.ctl
+file:
DEC-20 PSL Release Page 9
+
+
+ @DO FULL-RESTORE
+ @DEASSIGN X: or @DISMOUNT X:
+
+
+4.5. Announce the System
4.5. Announce the System
4.5. Announce the System
+
+ Send out a Message to all those interested in using PSL. The
+file BBOARD.MSG is a suggested start.
+
+
+ Edit as you see fit, but please REMIND people not to
+re-distribute the PSL system and sources.
+
+
+ You may also want to set the directory protection to 775200 and
+limit access only to those that you feel should have access at
+this time.
+
+
+4.6. Summary of Restoration Process
4.6. Summary of Restoration Process
4.6. Summary of Restoration Process
+
+ In summary, first retrieve the cmd and ctl files from the first
+saveset on the DUMPER tape. Then choose a single or multiple
+directory system and edit the appropriate logical name file to
+reflect the directory name(s). If creating a multiple directory
+system use the create-directories.ctl control file to build each
+directory. Then run the appropriate file retrieval control file.
+Finally, announce the system to any interested users.
+
+
+
+5. REBUILDING LOADABLE MODULES
5. REBUILDING LOADABLE MODULES
5. REBUILDING LOADABLE MODULES
+
+ Most of the utilities, and many of the more experimental parts
+of the system are kept as binary FASL files (with extensions .b)
+on the PL: directory. EMODE and NMODE are currently the only
+major sub-systems that have there own set of sub-directories. In
+some cases (usually large sub-systems, or sub-systems that share
+modules) there are a number of .B files, and a .LAP file that
+loads each .B file in turn. The PSL LOAD function will look first
+for a .B file, then a .LAP file first on the user directory, then
+on PL: (both this "search" path and the order of extensions can
+be changed).
+
+
+ In order to ease the task of rebuilding and modifying the .B
+files, we have a small utility, BUILD. To use BUILD for a module
+you call xxxx, prepare a file called xxxx.BUILD, which has RLISP
+syntax commands for loading the appropriate source files. The
+file can also have various CompileTime options, including the
+loading of various .B files to set up the correct compilation
+environment.
DEC-20 PSL Release Page 10
+
+
+ Then run PSL:RLISP, LOAD BUILD; and finally enter BUILD 'xxxx;
+this will do a FASLOUT to "PL:xxxx", input the xxxx.BUILD file,
+and finally close the FASL file.
+
+
+ The target file "PL:xxxx" is constructed using the variable
+"BuildFileFormat!*", initialized in the file PU:Build.Red .
+
+
+ For example, consider the contents of PU:Gsort.Build:
+
+
+ CompileTime load Syslisp;
+ in "gsort.red"$
+
+
+ Note that the SYSLISP module is required, since some of the
+fast sorting functions in GSORT are written in SYSLISP mode.
+
+
+ GSORT is then rebuilt by the sequence:
+
+
+ PSL:RLISP
+ LOAD BUILD;
+ BUILD 'GSORT;
+ QUIT;
+
+
+ This is such a common sequence that a MIC file (MIC is a
+parameterized DO facility) PU:BUILD.MIC is provided, and is used
+by passing the module name to MIC, after connecting to PU:
+
+
+ @mic BUILD GSORT
+
+
+ is all that is required.
+
+
+
+6. REBUILDING THE INTERPRETER
6. REBUILDING THE INTERPRETER
6. REBUILDING THE INTERPRETER
+
+ A running `rlisp' is required to rebuild the basic interpreter,
+since the entire system is written in itself. The kernel
+modules, rather than being compiled to FASL files, are compiled
+ _____ ____
to assembly code (MACRO) and linked using the system loader LINK.
+ ____ _____ _____ ___
The command file P20C:DEC20-cross.CTL is executed to produce the
+ _ _____ _____
cross compiler, S:DEC20-cross (S: should be set to an appropriate
+scratch directory). The modules in the kernel are represented by
+ ___ _____ __ ______ __ __
the files P20:*.build. There is a program PU:kernel.sl or
+__ ______ _
PL:kernel.b which generates command files for building the kernel
DEC-20 PSL Release Page 11
+
+
+ ___ __ ______ ___ __
when parameterized for Tops-20 by P20:20-kernel-gen.sl. The
+specific modules which are in the kernel are only listed in this
+ ______
file, in the call to the function kernel. This generates a file
+____ ___ ____ _____
xxxx.CTL for each xxxx.build.
+
+
+6.1. Complete Kernel Rebuild
6.1. Complete Kernel Rebuild
6.1. Complete Kernel Rebuild
+
+ A complete rebuild is accomplished by the following steps. At
+Utah we use a <scratch> directory for some intermediate files.
+Define S: to be this directory or some other appropriate
+location that can be deleted when done. Below we use @SUBMIT
+xxxx.CTL to run batch jobs; on some systems, @DO xxxx.CTL can be
+used instead, or on others, @MIC xxxx.CTL may be used.
+
+
+ Begin by defining S: as <scratch> or other scratch directory:
+
+
+ @DEFINE S: <scratch>
+
+
+ Now connect to <psl.20-comp> and rebuild NEW-DEC20-CROSS.EXE:
+
+
+ @CONN P20C:
+
+
+ @SUBMIT NEW-DEC20-CROSS.CTL
+
+
+ Copy the <psl.comp>BARE-PSL.SYM to 20.SYM, and regenerate the
+appropriate .CTL files. This saves the old 20.SYM as
+PREVIOUS-20.SYM:
+
+
+ @CONN P20:
+
+
+ @SUBMIT P20:FRESH-KERNEL.CTL
+
+
+ Rebuild each module (xxxx) in turn, using its xxxx.CTL. This
+creates xxxx.MAC and Dxxxx.MAC files, and assembles each to make
+xxxx.REL and Dxxxx.REL. The entire set is submitted with the
+file ALL-KERNEL.CTL, which submits each file in turn. (Note that
+these must be done sequentially, not simultaneously. If you have
+more than one batch stream, make sure that these are run one at a
+time):
+
+
+ @SUBMIT ALL-KERNEL.CTL
DEC-20 PSL Release Page 12
+
+
+ Build the main module, which converts the accumulated 20.SYM
+into heap and symbol-table initialization:
+
+
+ @SUBMIT P20:MAIN.CTL
+
+
+ Finally LINK the xxxx.REL and Dxxxx.REL files to produce
+S:BARE-PSL.EXE:
+
+
+ @SUBMIT P20:PSL-LINK.CTL
+
+
+ Execute and save as PSL.EXE, reading appropriate xxxx.INIT
+files (note, each site usually customizes the PSL environment to
+suit their needs, therefore we recommend that you create your own
+version of Make-psl.ctl to perform this task).
+
+
+ @SUBMIT P20:MAKE-PSL.CTL
+
+
+ Finally, run MAKE-RLISP.CTL as needed:
+
+
+ @SUBMIT P20:MAKE-RLISP.CTL
+
+
+ Rlisp.exe and Psl.exe will be saved on the <PSL> directory.
+You now may want to delete any xxx.log files that where created.
+
+
+ @DEL P20:*.LOG
+ @DEL P20C:*.LOG
+
+
+6.2. Partial or Incremental Kernel Rebuild
6.2. Partial or Incremental Kernel Rebuild
6.2. Partial or Incremental Kernel Rebuild
+
+ Often, only a single kernel file needs to be changed, and a
+complete rebuild is not needed. The PSL kernel building process
+permits a (semi-)independent rebuilding of modules, by
+maintaining the 20.SYM file to record Identifier Numbers, etc.
+The 20.SYM file from the recent full-rebuild, and xxxx.INIT files
+are required, as are the "xxxx.REL" and "Dxxxx.REL". The partial
+rebuild will replace the "mmmm.REL", "Dmmmm.REL" and "mmmm.INIT"
+files, modify "20.SYM", and then rebuild the MAIN module.
+Assuming that a recent full rebuild has been done, a partial
+rebuild of module "mmmm", is accomplished by the following steps.
+
+
+ As above, S: is required for "Scratch" space.
DEC-20 PSL Release Page 13
+
+
+ Define S: as <scratch> or other scratch directory:
+
+
+ @DEFINE S: <scratch>
+
+
+ Rebuild DEC20-CROSS.EXE, if needed:
+
+
+ @SUBMIT P20C:DEC20-CROSS.CTL
+
+
+ Rebuild the module (mmmm), using its mmmm.CTL. This creates
+mmmm.MAC and Dmmmm.MAC files, and assembled each to make mmmm.REL
+and Dmmmm.REL. See the file ALL-KERNEL.CTL for current modules.
+
+
+ @SUBMIT P20:mmmm.CTL
+ Other modules can be done after this
+
+
+ Rebuild the main module, which converts the accumulated 20.SYM
+into heap and symbol-table initialization: (This step can be
+omitted if 20.SYM has not been changed by the incremental
+recompilation.)
+
+
+ @SUBMIT P20:MAIN.CTL
+
+
+ Finally LINK the xxxx.REL and Dxxxx.REL files to produce
+S:BARE-PSL.EXE:
+
+
+ @SUBMIT P20:PSL-LINK.CTL
+
+
+ Execute and save as PSL.EXE, reading appropriate xxxx.INIT
+files:
+
+
+ @SUBMIT P20:MAKE-PSL.CTL
+
+
+ Finally, run MAKE-RLISP as needed:
+
+
+ @SUBMIT P20:MAKE-RLISP.CTL
+
+
+ Note that 20.SYM may be changed slightly to reflect any new
+symbols encountered, and certain generated symbols. Occasionally,
DEC-20 PSL Release Page 14
+
+
+repeated building of certain modules can cause 20.SYM to grow,
+and then a full rebuild may be required.
+
+
+6.3. Rebuilding RLISP.EXE from PSL.EXE
6.3. Rebuilding RLISP.EXE from PSL.EXE
6.3. Rebuilding RLISP.EXE from PSL.EXE
+
+ The PSL executable file, PSL.EXE, is a fairly bare system, and
+is usually extended by loading appropriate utilities, and then
+saving this as a new executable. We have provided RLISP.EXE,
+which includes the compiler, and the RLISP parser. RLISP.EXE is
+built from PSL.EXE by the following commands:
+
+
+ @TAKE PSL:minimal-logical-names.cmd
+ @PSL:PSL.EXE
+ (LOAD COMPILER RLISP INIT-FILE)
+ % Also LOAD any other modules that
+ % should be in your "standard" system
+ (SAVESYSTEM "PSL 3.1 Rlisp" "PSL:rlisp.exe" '((Read-init-file
+ "rlisp")))
+ % The string is the Welcome Message, the save file
+ % name and the startup expression to read rlisp.init.
+ (QUIT)
+
+
+ We have provided a command file, P20:MAKE-RLISP.CTL for this
+purpose. Edit it to reflect any modules that local usage desires
+in the basic system (EMODE, PRLISP, USEFUL, etc. are common
+choices).
+
+
+ In a similar fashion, a customized PSL.EXE could be maintained
+instead of the "bare" version we provide. In order to avoid
+destroying PSL entirely, we suggest that you maintain a copy of
+the supplied PSL.EXE as BARE-PSL.EXE, and customize your PSL.EXE
+from it.
+
+
+
+7. RELATIONSHIP TO PSL 3.0
7. RELATIONSHIP TO PSL 3.0
7. RELATIONSHIP TO PSL 3.0
+
+ This new version 3.1 is a complete release, and totally
+replaces the previous PSL 3.0 that underwent limited
+ __ ___ ___ ___ __ ____ ___
distribution. The files pd:bug-fix.log and pd:bugs.txt record
+many of the changes and bug fixes that occurred since version
+3.0.
DEC-20 PSL Release Page 15
+
+
+8. FUTURE UPDATES
8. FUTURE UPDATES
8. FUTURE UPDATES
+
+ It is currently envisioned that future updates will still be
+complete releases. It is therefore suggested that you
+
+
+ a. Retain this distribution tape in case you may have to
+ compare files.
+
+ b. Do not make any changes on these distributed
+ directories. If you must make your own bug fixes, it
+ is suggested that you put the changed files on some
+ ____
other directories, such as pnew:. They can then be
+ compared with any new files sent out in subsequent
+ releases.
DEC-20 PSL Release Page i
+
+
+ Table of Contents
Table of Contents
Table of Contents
+
+1. INTRODUCTION 2
+2. DISCLAIMER 2
+3. CONTENTS OF THE TAPE 3
+4. INSTALLING PSL 5
+ 4.1. Retrieve Control Files 5
+ 4.2. Create a single subdirectory 5
+ 4.3. A MULTIPLE SUB-DIRECTORY SYSTEM 7
+ 4.4. Build Sub-Directories 7
+ 4.5. Announce the System 9
+ 4.6. Summary of Restoration Process 9
+5. REBUILDING LOADABLE MODULES 9
+6. REBUILDING THE INTERPRETER 10
+ 6.1. Complete Kernel Rebuild 11
+ 6.2. Partial or Incremental Kernel Rebuild 12
+ 6.3. Rebuilding RLISP.EXE from PSL.EXE 14
+7. RELATIONSHIP TO PSL 3.0 14
+8. FUTURE UPDATES 15
ADDED psl-1983/20-kernel/20-kernel-gen.ctl
Index: psl-1983/20-kernel/20-kernel-gen.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/20-kernel-gen.ctl
@@ -0,0 +1,3 @@
+@psl:psl
+*(lapin "p20:20-kernel-gen.sl")
+*(quit)
ADDED psl-1983/20-kernel/20-kernel-gen.sl
Index: psl-1983/20-kernel/20-kernel-gen.sl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/20-kernel-gen.sl
@@ -0,0 +1,67 @@
+%
+% 20-KERNEL-GEN.SL - Generate scripts for building Dec-20 PSL kernel
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 26 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.20-INTERP>20-KERNEL-GEN.SL.15, 7-Jun-82 12:48:19, Edit by BENSON
+% Converted kernel-file-name* to all-kernel-script...
+% <PSL.20-INTERP>20-KERNEL-GEN.SL.14, 6-Jun-82 05:29:21, Edit by GRISS
+% Add kernel-file-name*
+
+
+(compiletime (load kernel))
+(compiletime (setq *EOLInStringOK T))
+(loadtime (imports '(kernel)))
+
+(setq command-file-name* "%w.ctl")
+
+(setq command-file-format*
+"define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut ""%w"";
+in ""%w.build"";
+ASMEnd;
+quit;
+compile %w.mac, d%w.mac
+delete %w.mac, d%w.mac
+")
+
+(setq init-file-name* "psl.init")
+
+(setq init-file-format* "(lapin ""%w.init"")
+")
+
+(setq all-kernel-script-name* "all-kernel.ctl")
+
+(setq all-kernel-script-format* "submit %w.ctl
+")
+
+(setq code-object-file-name* "%w.rel")
+
+(setq data-object-file-name* "d%w.rel")
+
+(setq link-script-name* "psl-link.ctl")
+
+(setq link-script-format*
+"cd S:
+define DSK:, DSK:, P20:
+LINK
+/nosymbol
+nil.rel
+/set:.low.:202
+%e
+/save s:bpsl.exe
+/go
+")
+
+(setq script-file-name-separator* "
+")
+
+(kernel '(types randm alloc arith debg error eval extra fasl io macro prop
+ symbl sysio tloop main heap))
ADDED psl-1983/20-kernel/20.sym
Index: psl-1983/20-kernel/20.sym
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/20.sym
@@ -0,0 +1,1741 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE
+FEXPR)) (PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR)) (PUT (QUOTE !') (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADQUOTEDEXPRESSION)) (PUT (QUOTE !() (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADLISTORDOTTEDPAIR)) (PUT (QUOTE !)) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADRIGHTPAREN)) (PUT (QUOTE ![) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADVECTOR)) (PUT (MKID (CHAR EOF)) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADEOF)) (INITOBLIST) (PUT (QUOTE EOF) (
+QUOTE CHARCONST) (CHAR (CNTRL Z))))))
+(SETQ ORDEREDIDLIST!* (QUOTE (ID2INT NONIDERROR INT2ID TYPEERROR
+NONINTEGERERROR INT2SYS LISP2CHAR NONCHARACTERERROR INT2CODE SYS2INT GTFIXN
+ID2STRING STRING2VECTOR GTVECT NONSTRINGERROR VECTOR2STRING GTSTR
+NONVECTORERROR LIST2STRING LENGTH NONPAIRERROR STRING2LIST CONS LIST2VECTOR
+VECTOR2LIST GETV BLDMSG STDERROR INDEXERROR PUTV UPBV EVECTORP EGETV EPUTV
+EUPBV INDX RANGEERROR NONSEQUENCEERROR SETINDX SUB SUBSEQ GTWRDS GTHALFWORDS
+NCONS TCONC SETSUB SETSUBSEQ CONCAT APPEND SIZE MKSTRING
+NONPOSITIVEINTEGERERROR MAKE!-BYTES MAKE!-HALFWORDS MAKE!-WORDS MAKE!-VECTOR
+STRING VECTOR CODEP EQ FLOATP BIGP IDP PAIRP STRINGP VECTORP CAR CDR RPLACA
+RPLACD FIXP DIGIT LITER EQN LISPEQUAL STRINGEQUAL EQSTR EQUAL CAAAAR CAAAR
+CAAADR CAADAR CAADR CAADDR CADAAR CADAR CADADR CADDAR CADDR CADDDR CDAAAR
+CDAAR CDAADR CDADAR CDADR CDADDR CDDAAR CDDAR CDDADR CDDDAR CDDDR CDDDDR
+CAAR CADR CDAR CDDR SAFECAR SAFECDR ATOM CONSTANTP NULL NUMBERP EXPT MKQUOTE
+LIST3 CONTINUABLEERROR GREATERP DIFFERENCE MINUSP TIMES2 ADD1 QUOTIENT PLUS2
+LIST EVLIS QUOTE EXPR DE LIST2 LIST4 PUTD FUNCTION LAMBDA FEXPR DF MACRO DM
+NEXPR DN SETQ EVAL SET PROG2 PROGN EVPROGN AND EVAND OR EVOR COND EVCOND NOT
+ABS MINUS DIVIDE ZEROP REMAINDER XCONS MAX ROBUSTEXPAND MAX2 LESSP MIN MIN2
+PLUS TIMES MAP FASTAPPLY MAPC MAPCAN NCONC MAPCON MAPCAR MAPLIST ASSOC
+SASSOC PAIR SUBLIS DEFLIST PUT DELETE MEMBER MEMQ REVERSE SUBST EXPAND
+CHANNELPRINT CHANNELPRIN1 CHANNELTERPRI PRINT OUT!* NEQ NE GEQ LEQ EQCAR
+EXPRP GETD MACROP FEXPRP NEXPRP COPYD RECIP FIRST SECOND THIRD FOURTH REST
+REVERSIP SUBSTIP DELETIP DELQ DEL DELQIP ATSOC ASS MEM RASSOC DELASC
+DELASCIP DELATQ DELATQIP SUBLA RPLACW LASTCAR LASTPAIR COPY NTH SUB1 PNTH
+ACONC LCONC MAP2 MAPC2 CHANNELPRIN2T CHANNELPRIN2 PRIN2T CHANNELSPACES
+CHANNELWRITECHAR SPACES CHANNELTAB CHANNELPOSN TAB FILEP PUTC SPACES2
+CHANNELSPACES2 LIST2SET LIST2SETQ ADJOIN ADJOINQ UNION UNIONQ XN XNQ
+INTERSECTION INTERSECTIONQ KNOWN!-FREE!-SPACE GTHEAP FATALERROR !%RECLAIM
+GC!-TRAP GC!-TRAP!-LEVEL SET!-GC!-TRAP!-LEVEL DELHEAP GTCONSTSTR GTBPS
+GTEVECT GTFLTN GTID RECLAIM DELBPS GTWARRAY DELWARRAY COPYSTRINGTOFROM
+COPYSTRING COPYWARRAY COPYVECTORTOFROM COPYVECTOR COPYWRDSTOFROM COPYWRDS
+TOTALCOPY MKVECT MKEVECTOR MKEVECT LIST5 !*GC GCTIME!* GCKNT!*
+HEAP!-WARN!-LEVEL ERRORPRINTF TIMC QUIT RETURNNIL RETURNFIRSTARG LAND LOR
+LXOR LSHIFT LSH LNOT FIX FLOAT ONEP DEBUG TR EVLOAD TRST QEDITFNS !*EXPERT
+!*VERBOSE EDITF EDIT YESP PROMPTSTRING!* FASTBIND TERPRI EDITORREADER!*
+EDITORPRINTER!* FASTUNBIND READ CL HELP BREAK EHELP PL UP OK DISPLAYHELPFILE
+EDITOR IGNOREDINBACKTRACE!* INTERPRETERFUNCTIONS!* INTERPBACKTRACE PRINTF
+BACKTRACE RETURNADDRESSP ADDR2ID VERBOSEBACKTRACE OPTIONS!* WRITECHAR
+CHANNELWRITEUNKNOWNITEM CODE!-ADDRESS!-TO!-SYMBOL PRIN1 ERROR NO YES RDS
+ERROUT!* WRS ERRORSET CURSYM!* !*SEMICOL!* ERRORFORM!* !*CONTINUABLEERROR
+EMSG!* !*BREAK !*EMSGP MAXBREAKLEVEL!* BREAKLEVEL!* FLATSIZE USAGETYPEERROR
+NONNUMBERERROR NONWORDS NONIOCHANNELERROR !*BACKTRACE !*INNER!*BACKTRACE
+THROW !$ERROR!$ ERRSET CATCH CATCHSETUP THROWSIGNAL!* !%UNCATCH
+CHANNELNOTOPEN CHANNELERROR WRITEONLYCHANNEL READONLYCHANNEL
+ILLEGALSTANDARDCHANNELCLOSE IOERROR CODEAPPLY CODEEVALAPPLY BINDEVAL LBIND1
+COMPILEDCALLINGINTERPRETED BSTACKOVERFLOW RESTOREENVIRONMENT !*LAMBDALINK
+UNDEFINEDFUNCTION UNBINDN APPLY FUNBOUNDP FCODEP GETFCODEPOINTER GET
+VALUECELL GETFNTYPE !&!&VALUE!&!& THROWTAG!* CATCH!-ALL UNWIND!-ALL
+!&!&THROWN!&!& !$UNWIND!-PROTECT!$ !&!&TAG!&!& !%THROW UNWIND!-PROTECT
+!*CATCH !*THROW RESET CAPTUREENVIRONMENT !%CLEAR!-CATCH!-STACK PROGBODY!*
+PROGJUMPTABLE!* PROG PBIND1 !$PROG!$ GO RETURN SYSTEM_LIST!* DATE DUMPLISP
+BINARYOPENREAD DEC20OPEN BINARYOPENWRITE VALUECELLLOCATION !*WRITINGFASLFILE
+NEWBITTABLEENTRY!* FINDIDNUMBER MAKERELOCHALFWORD EXTRAREGLOCATION
+FUNCTIONCELLLOCATION FASLIN INTERN PUTENTRY LOADDIRECTORIES!*
+LOADEXTENSIONS!* !*VERBOSELOAD !*PRINTLOADNAMES LOAD LOAD1 RELOAD EVRELOAD
+!*USERMODE !*REDEFMSG !*INSIDELOAD !*LOWER PENDINGLOADS!* IMPORTS
+PRETTYPRINT DEFSTRUCT STEP MINI EMODE INVOKE RCREF CREFON COMPILER COMPD
+FASLOUT BUG EXEC MM TERMINALINPUTHANDLER COMPRESSREADCHAR DEC20WRITECHAR
+TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR !$EOL!$ CHANNELREADCHAR
+READCHAR IN!* CHANNELUNREADCHAR UNREADCHAR OPEN SYSTEMOPENFILEFORINPUT
+SYSTEMOPENFILEFOROUTPUT SYSTEMOPENFILESPECIAL SPECIALREADFUNCTION!*
+SPECIALWRITEFUNCTION!* SPECIALCLOSEFUNCTION!* SPECIAL OUTPUT INPUT CLOSE
+SYSTEMMARKASCLOSEDCHANNEL SPECIALRDSACTION!* STDIN!* SPECIALWRSACTION!*
+STDOUT!* CHANNELEJECT EJECT CHANNELLINELENGTH LINELENGTH POSN CHANNELLPOSN
+LPOSN CHANNELREADCH !*RAISE READCH PRINC CHANNELPRINC
+CURRENTREADMACROINDICATOR!* CHANNELREADTOKENWITHHOOKS CHANNELREADTOKEN
+TOKTYPE!* CURRENTSCANTABLE!* CHANNELREAD LISPSCANTABLE!* LISPREADMACRO
+MAKEINPUTAVAILABLE !*INSIDESTRUCTUREREAD CHANNELREADEOF !$EOF!$
+CHANNELREADQUOTEDEXPRESSION CHANNELREADLISTORDOTTEDPAIR
+CHANNELREADRIGHTPAREN CHANNELREADVECTOR !*COMPRESSING !*EOLINSTRINGOK NEWID
+MAKESTRINGINTOLISPINTEGER DIGITTONUMBER PACKAGE CURRENTPACKAGE!* GLOBAL
+RATOM READLINE CHANNELREADLINE OUTPUTBASE!* IDESCAPECHAR!*
+CHANNELWRITESTRING WRITESTRING CHANNELWRITESYSINTEGER CHANNELWRITEBITSTRAUX
+WRITESYSINTEGER CHANNELWRITEFIXNUM CHANNELWRITEINTEGER CHANNELWRITESYSFLOAT
+WRITEFLOAT CHANNELWRITEFLOAT CHANNELPRINTSTRING CHANNELWRITEID
+CHANNELWRITEUNBOUND CHANNELPRINTID CHANNELPRINTUNBOUND
+CHANNELWRITECODEPOINTER CHANNELWRITEBLANKOREOL CHANNELWRITEPAIR PRINLEVEL
+PRINLENGTH RECURSIVECHANNELPRIN2 CHANNELPRINTPAIR RECURSIVECHANNELPRIN1
+CHANNELWRITEVECTOR CHANNELPRINTVECTOR CHANNELWRITEEVECTOR
+OBJECT!-GET!-HANDLER!-QUIETLY CHANNELPRIN CHANNELPRINTEVECTOR
+CHANNELWRITEWORDS CHANNELWRITEHALFWORDS CHANNELWRITEBYTES PRIN2
+FORMATFORPRINTF!* PRIN2L ERRPRIN CHANNELPRINTF EXPLODEENDPOINTER!* EXPLODE
+EXPLODE2 FLATSIZE2 COMPRESSERROR COMPRESSLIST!* CLEARCOMPRESSCHANNEL
+COMPRESS IMPLODE CHANNELTYI CHANNELTYO TYI TYO COMMENTOUTCODE COMPILETIME
+BOTHTIMES LOADTIME STARTUPTIME CONTERROR OTHERWISE DEFAULT CASE RANGE SETF
+EXPANDSETF SETF!-EXPAND ASSIGN!-OP ONOFF!* MKFLAGVAR SIMPFG ON OFF !#ARG DS
+DEFCONST EVDEFCONST CONST STRINGGENSYM STRINGGENSYM!* FOREACH COLLECT JOIN
+CONC IN DO EXIT !$LOOP!$ NEXT WHILE REPEAT FOR GENSYM MK!*SQ SIMP BIN
+FLAMBDALINKP MAKEFUNBOUND MAKEFLAMBDALINK MAKEFCODE PROP SETPROP FLAGP TYPE
+FLAG FLAG1 REMFLAG REMFLAG1 REMPROP REMPROPL UNBOUNDP VARTYPE FLUID FLUID1
+FLUIDP GLOBAL1 GLOBALP UNFLUID UNFLUID1 REMD !*COMP USER LOSE
+CODE!-NUMBER!-OF!-ARGUMENTS BSTACKUNDERFLOW CLEARBINDINGS MAKEUNBOUND
+HASHFUNCTION REMOB INTERNP INTERNGENSYM MAPOBL GLOBALLOOKUP GLOBALINSTALL
+GLOBALREMOVE INITOBLIST DEC20READCHAR !*ECHO CLEARIO DEC20CLOSECHANNEL !*DEFN
+BREAKVALUE!* !*QUITBREAK BREAKIN!* BREAKOUT!* TOPLOOPNAME!* TOPLOOPEVAL!*
+BREAKEVAL!* BREAKNAME!* TOPLOOPPRINT!* TOPLOOPREAD!* TOPLOOP !$BREAK!$
+BREAKEVAL BREAKFUNCTION BREAKQUIT BREAKCONTINUE BREAKRETRY HELPBREAK
+BREAKERRMSG BREAKEDIT TOPLOOPLEVEL!* HISTORYCOUNT!* LISPBANNER!* !*OUTPUT
+SEMIC!* HISTORYLIST!* !*TIME TIME !*NONIL !$EXITTOPLOOP!$ DFPRINT!* IGNORE
+INP REDO ANS HIST CLEAR STANDARDLISP PRINTWITHFRESHLINE SAVESYSTEM
+INITFORMS!* EVALINITFORMS DSKIN DSKINEVAL LAPIN)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 841))
+(SETQ STRINGGENSYM!* (QUOTE "L3692"))
+(PUT (QUOTE TWOARGDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1368"))
+(PUT (QUOTE RELOAD) (QUOTE ENTRYPOINT) (QUOTE RELOAD))
+(PUT (QUOTE RELOAD) (QUOTE IDNUMBER) (QUOTE 568))
+(PUT (QUOTE TWOARGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1385"))
+(PUT (QUOTE INTLESSP) (QUOTE ENTRYPOINT) (QUOTE "L1515"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE NEQ) (QUOTE ENTRYPOINT) (QUOTE NEQ))
+(PUT (QUOTE NEQ) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE LIST2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0059"))
+(PUT (QUOTE LIST2STRING) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE SPECIALRDSACTION!*) (QUOTE IDNUMBER) (QUOTE 614))
+(FLAG (QUOTE (SPECIALRDSACTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GLOBALLOOKUP) (QUOTE ENTRYPOINT) (QUOTE "L3479"))
+(PUT (QUOTE GLOBALLOOKUP) (QUOTE IDNUMBER) (QUOTE 787))
+(PUT (QUOTE CLEARCOMPRESSCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L2911"))
+(PUT (QUOTE CLEARCOMPRESSCHANNEL) (QUOTE IDNUMBER) (QUOTE 702))
+(PUT (QUOTE DEFSTRUCT) (QUOTE ENTRYPOINT) (QUOTE "L2240"))
+(PUT (QUOTE DEFSTRUCT) (QUOTE IDNUMBER) (QUOTE 577))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE MAKERELOCHALFWORD) (QUOTE IDNUMBER) (QUOTE 556))
+(PUT (QUOTE BACKTRACE1) (QUOTE ENTRYPOINT) (QUOTE "L1704"))
+(PUT (QUOTE DO) (QUOTE IDNUMBER) (QUOTE 740))
+(PUT (QUOTE THROWSIGNAL!*) (QUOTE IDNUMBER) (QUOTE 500))
+(FLAG (QUOTE (THROWSIGNAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE REMFLAG) (QUOTE ENTRYPOINT) (QUOTE "L3218"))
+(PUT (QUOTE REMFLAG) (QUOTE IDNUMBER) (QUOTE 761))
+(PUT (QUOTE PRINLEVEL) (QUOTE IDNUMBER) (QUOTE 677))
+(FLAG (QUOTE (PRINLEVEL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EJECT) (QUOTE ENTRYPOINT) (QUOTE EJECT))
+(PUT (QUOTE EJECT) (QUOTE IDNUMBER) (QUOTE 619))
+(PUT (QUOTE LISPREADMACRO) (QUOTE IDNUMBER) (QUOTE 637))
+(PUT (QUOTE STRING2LIST) (QUOTE ENTRYPOINT) (QUOTE "L0068"))
+(PUT (QUOTE STRING2LIST) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE EXIT) (QUOTE ENTRYPOINT) (QUOTE EXIT))
+(PUT (QUOTE EXIT) (QUOTE IDNUMBER) (QUOTE 741))
+(PUT (QUOTE DEC20CLOSECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L3527"))
+(PUT (QUOTE DEC20CLOSECHANNEL) (QUOTE IDNUMBER) (QUOTE 794))
+(PUT (QUOTE ONEARGDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1397"))
+(PUT (QUOTE STRING2VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0041"))
+(PUT (QUOTE STRING2VECTOR) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1851"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE BACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1699"))
+(PUT (QUOTE BACKTRACE) (QUOTE IDNUMBER) (QUOTE 463))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1847"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 507))
+(PUT (QUOTE RETURNNIL) (QUOTE ENTRYPOINT) (QUOTE "L1422"))
+(PUT (QUOTE RETURNNIL) (QUOTE IDNUMBER) (QUOTE 422))
+(PUT (QUOTE CHANNELWRITESYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2584"))
+(PUT (QUOTE CHANNELWRITESYSINTEGER) (QUOTE IDNUMBER) (QUOTE 661))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1109"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE GENSYM) (QUOTE ENTRYPOINT) (QUOTE GENSYM))
+(PUT (QUOTE GENSYM) (QUOTE IDNUMBER) (QUOTE 747))
+(PUT (QUOTE ONEARGPREDICATEDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1410"))
+(PUT (QUOTE VERBOSEBACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1716"))
+(PUT (QUOTE VERBOSEBACKTRACE) (QUOTE IDNUMBER) (QUOTE 466))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 477))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE ENTRYPOINT) (QUOTE "L3533"))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 603))
+(PUT (QUOTE !*EMSGP) (QUOTE IDNUMBER) (QUOTE 485))
+(PUT (QUOTE !*EMSGP) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE TYI) (QUOTE ENTRYPOINT) (QUOTE TYI))
+(PUT (QUOTE TYI) (QUOTE IDNUMBER) (QUOTE 707))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L3141"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 519))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L1732"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 744))
+(PUT (QUOTE STANDARDLISP) (QUOTE ENTRYPOINT) (QUOTE "L3650"))
+(PUT (QUOTE STANDARDLISP) (QUOTE IDNUMBER) (QUOTE 833))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE !*OUTPUT) (QUOTE IDNUMBER) (QUOTE 819))
+(PUT (QUOTE !*OUTPUT) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE SECOND) (QUOTE ENTRYPOINT) (QUOTE SECOND))
+(PUT (QUOTE SECOND) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 693))
+(PUT (QUOTE CURSYM!*) (QUOTE IDNUMBER) (QUOTE 479))
+(PUT (QUOTE CHANNELTYI) (QUOTE ENTRYPOINT) (QUOTE "L2917"))
+(PUT (QUOTE CHANNELTYI) (QUOTE IDNUMBER) (QUOTE 705))
+(PUT (QUOTE FLOATREMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1471"))
+(PUT (QUOTE SASSOC) (QUOTE ENTRYPOINT) (QUOTE SASSOC))
+(PUT (QUOTE SASSOC) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE ADDR2ID) (QUOTE IDNUMBER) (QUOTE 465))
+(PUT (QUOTE GC!-TRAP) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE ROBUSTEXPAND) (QUOTE ENTRYPOINT) (QUOTE "L0815"))
+(PUT (QUOTE ROBUSTEXPAND) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE INTREMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1470"))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 445))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 8209))
+(PUT (QUOTE TWOARGDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1369"))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE DEFNPRINT) (QUOTE ENTRYPOINT) (QUOTE "L3609"))
+(PUT (QUOTE CURRENTPACKAGE!*) (QUOTE IDNUMBER) (QUOTE 652))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE ENTRYPOINT) (QUOTE "L2048"))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 538))
+(PUT (QUOTE SETSUBSEQ) (QUOTE ENTRYPOINT) (QUOTE "L0233"))
+(PUT (QUOTE SETSUBSEQ) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE PNTH) (QUOTE ENTRYPOINT) (QUOTE PNTH))
+(PUT (QUOTE PNTH) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE PACKAGE) (QUOTE ENTRYPOINT) (QUOTE "L2572"))
+(PUT (QUOTE PACKAGE) (QUOTE IDNUMBER) (QUOTE 651))
+(PUT (QUOTE MAKEDS) (QUOTE ENTRYPOINT) (QUOTE MAKEDS))
+(PUT (QUOTE !*USERMODE) (QUOTE IDNUMBER) (QUOTE 570))
+(FLAG (QUOTE (!*USERMODE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !*REDEFMSG) (QUOTE IDNUMBER) (QUOTE 571))
+(PUT (QUOTE !*REDEFMSG) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE SAVE!-INTO!-FILE) (QUOTE ENTRYPOINT) (QUOTE "L2114"))
+(PUT (QUOTE CHANNELPRINTID) (QUOTE ENTRYPOINT) (QUOTE "L2617"))
+(PUT (QUOTE CHANNELPRINTID) (QUOTE IDNUMBER) (QUOTE 672))
+(PUT (QUOTE BUG) (QUOTE ENTRYPOINT) (QUOTE BUG))
+(PUT (QUOTE BUG) (QUOTE IDNUMBER) (QUOTE 587))
+(PUT (QUOTE DEFAULT) (QUOTE IDNUMBER) (QUOTE 716))
+(PUT (QUOTE IGNOREDINBACKTRACE!*) (QUOTE IDNUMBER) (QUOTE 459))
+(PUT (QUOTE IGNOREDINBACKTRACE!*) (QUOTE INITIALVALUE) (QUOTE (EVAL APPLY
+FASTAPPLY CODEAPPLY CODEEVALAPPLY CATCH ERRORSET EVPROGN TOPLOOP BREAKEVAL
+BINDEVAL BREAK MAIN)))
+(PUT (QUOTE CLEAR) (QUOTE IDNUMBER) (QUOTE 832))
+(PUT (QUOTE LPOSN) (QUOTE ENTRYPOINT) (QUOTE LPOSN))
+(PUT (QUOTE LPOSN) (QUOTE IDNUMBER) (QUOTE 624))
+(PUT (QUOTE DOPNTH) (QUOTE ENTRYPOINT) (QUOTE DOPNTH))
+(PUT (QUOTE BREAKOUT!*) (QUOTE IDNUMBER) (QUOTE 799))
+(FLAG (QUOTE (BREAKOUT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 268))
+(PUT (QUOTE STRINGGENSYM) (QUOTE ENTRYPOINT) (QUOTE "L3050"))
+(PUT (QUOTE STRINGGENSYM) (QUOTE IDNUMBER) (QUOTE 733))
+(PUT (QUOTE FLOATSUB1) (QUOTE ENTRYPOINT) (QUOTE "L1531"))
+(PUT (QUOTE TAB) (QUOTE ENTRYPOINT) (QUOTE TAB))
+(PUT (QUOTE TAB) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE COPYWRDSTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1144"))
+(PUT (QUOTE COPYWRDSTOFROM) (QUOTE IDNUMBER) (QUOTE 408))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L3274"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 772))
+(PUT (QUOTE MEMBER) (QUOTE ENTRYPOINT) (QUOTE MEMBER))
+(PUT (QUOTE MEMBER) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE EXPRP) (QUOTE ENTRYPOINT) (QUOTE EXPRP))
+(PUT (QUOTE EXPRP) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE LNOT) (QUOTE ENTRYPOINT) (QUOTE LNOT))
+(PUT (QUOTE LNOT) (QUOTE IDNUMBER) (QUOTE 429))
+(PUT (QUOTE ONEARGPREDICATEDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1409"))
+(PUT (QUOTE ACONC) (QUOTE ENTRYPOINT) (QUOTE ACONC))
+(PUT (QUOTE ACONC) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE PRETTYPRINT) (QUOTE ENTRYPOINT) (QUOTE "L2236"))
+(PUT (QUOTE PRETTYPRINT) (QUOTE IDNUMBER) (QUOTE 576))
+(PUT (QUOTE !$PROG!$) (QUOTE IDNUMBER) (QUOTE 543))
+(PUT (QUOTE ERRSET) (QUOTE ENTRYPOINT) (QUOTE ERRSET))
+(PUT (QUOTE ERRSET) (QUOTE IDNUMBER) (QUOTE 497))
+(PUT (QUOTE DIVIDE) (QUOTE ENTRYPOINT) (QUOTE DIVIDE))
+(PUT (QUOTE DIVIDE) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE DELETE) (QUOTE ENTRYPOINT) (QUOTE DELETE))
+(PUT (QUOTE DELETE) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE NONINTEGER2ERROR) (QUOTE ENTRYPOINT) (QUOTE "L1391"))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0392"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 611))
+(PUT (QUOTE PRINLENGTH) (QUOTE IDNUMBER) (QUOTE 678))
+(FLAG (QUOTE (PRINLENGTH)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE XNQ) (QUOTE ENTRYPOINT) (QUOTE XNQ))
+(PUT (QUOTE XNQ) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE TYO) (QUOTE ENTRYPOINT) (QUOTE TYO))
+(PUT (QUOTE TYO) (QUOTE IDNUMBER) (QUOTE 708))
+(PUT (QUOTE REMD) (QUOTE ENTRYPOINT) (QUOTE REMD))
+(PUT (QUOTE REMD) (QUOTE IDNUMBER) (QUOTE 774))
+(PUT (QUOTE !*THROW) (QUOTE ENTRYPOINT) (QUOTE "L2036"))
+(PUT (QUOTE !*THROW) (QUOTE IDNUMBER) (QUOTE 535))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0686"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE ERRORFORM!*) (QUOTE IDNUMBER) (QUOTE 481))
+(FLAG (QUOTE (ERRORFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !*INSIDELOAD) (QUOTE IDNUMBER) (QUOTE 572))
+(FLAG (QUOTE (!*INSIDELOAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLOATMINUSP) (QUOTE ENTRYPOINT) (QUOTE "L1567"))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 511))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE MAP) (QUOTE ENTRYPOINT) (QUOTE MAP))
+(PUT (QUOTE MAP) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE FOURTH) (QUOTE ENTRYPOINT) (QUOTE FOURTH))
+(PUT (QUOTE FOURTH) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE LXOR) (QUOTE ENTRYPOINT) (QUOTE LXOR))
+(PUT (QUOTE LXOR) (QUOTE IDNUMBER) (QUOTE 426))
+(PUT (QUOTE COMPD) (QUOTE ENTRYPOINT) (QUOTE COMPD))
+(PUT (QUOTE COMPD) (QUOTE IDNUMBER) (QUOTE 585))
+(PUT (QUOTE CHANNELPRINTVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2711"))
+(PUT (QUOTE CHANNELPRINTVECTOR) (QUOTE IDNUMBER) (QUOTE 683))
+(PUT (QUOTE UNFLUID1) (QUOTE ENTRYPOINT) (QUOTE "L3279"))
+(PUT (QUOTE UNFLUID1) (QUOTE IDNUMBER) (QUOTE 773))
+(PUT (QUOTE BOTHTIMES) (QUOTE ENTRYPOINT) (QUOTE "L2921"))
+(PUT (QUOTE BOTHTIMES) (QUOTE IDNUMBER) (QUOTE 711))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2275"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L3172"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 521))
+(PUT (QUOTE VALUECELL) (QUOTE ENTRYPOINT) (QUOTE "L3388"))
+(PUT (QUOTE VALUECELL) (QUOTE IDNUMBER) (QUOTE 523))
+(PUT (QUOTE CHANNELPRINTPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2678"))
+(PUT (QUOTE CHANNELPRINTPAIR) (QUOTE IDNUMBER) (QUOTE 680))
+(PUT (QUOTE WRITESYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2596"))
+(PUT (QUOTE WRITESYSINTEGER) (QUOTE IDNUMBER) (QUOTE 663))
+(PUT (QUOTE BACKTRACERANGE) (QUOTE ENTRYPOINT) (QUOTE "L1696"))
+(PUT (QUOTE KNOWN!-FREE!-SPACE) (QUOTE ENTRYPOINT) (QUOTE "L1095"))
+(PUT (QUOTE KNOWN!-FREE!-SPACE) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE DIGIT) (QUOTE ENTRYPOINT) (QUOTE DIGIT))
+(PUT (QUOTE DIGIT) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE FASLIN) (QUOTE ENTRYPOINT) (QUOTE FASLIN))
+(PUT (QUOTE FASLIN) (QUOTE IDNUMBER) (QUOTE 559))
+(PUT (QUOTE LIST2SETQ) (QUOTE ENTRYPOINT) (QUOTE "L1060"))
+(PUT (QUOTE LIST2SETQ) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE DSKIN) (QUOTE ENTRYPOINT) (QUOTE DSKIN))
+(PUT (QUOTE DSKIN) (QUOTE IDNUMBER) (QUOTE 838))
+(PUT (QUOTE CHANNELWRITEINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2598"))
+(PUT (QUOTE CHANNELWRITEINTEGER) (QUOTE IDNUMBER) (QUOTE 665))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE PUTC) (QUOTE ENTRYPOINT) (QUOTE PUTC))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE DELASC) (QUOTE ENTRYPOINT) (QUOTE DELASC))
+(PUT (QUOTE DELASC) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE FOREACH) (QUOTE ENTRYPOINT) (QUOTE "L3070"))
+(PUT (QUOTE FOREACH) (QUOTE IDNUMBER) (QUOTE 735))
+(PUT (QUOTE MARKFROMSYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1214"))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 786))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L1881"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 512))
+(PUT (QUOTE MM) (QUOTE ENTRYPOINT) (QUOTE MM))
+(PUT (QUOTE MM) (QUOTE IDNUMBER) (QUOTE 589))
+(PUT (QUOTE FLOATINTARG) (QUOTE ENTRYPOINT) (QUOTE "L1565"))
+(PUT (QUOTE MKEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1184"))
+(PUT (QUOTE MKEVECTOR) (QUOTE IDNUMBER) (QUOTE 412))
+(PUT (QUOTE MAKEBUFINTOLISPINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2420"))
+(PUT (QUOTE DELASCIP) (QUOTE ENTRYPOINT) (QUOTE "L0957"))
+(PUT (QUOTE DELASCIP) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE ZEROP) (QUOTE ENTRYPOINT) (QUOTE ZEROP))
+(PUT (QUOTE ZEROP) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE TOPLOOPLEVEL!*) (QUOTE IDNUMBER) (QUOTE 816))
+(PUT (QUOTE TOPLOOPLEVEL!*) (QUOTE INITIALVALUE) (QUOTE -1))
+(PUT (QUOTE FLOATGREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1511"))
+(PUT (QUOTE GLOBALREMOVE) (QUOTE ENTRYPOINT) (QUOTE "L3486"))
+(PUT (QUOTE GLOBALREMOVE) (QUOTE IDNUMBER) (QUOTE 789))
+(PUT (QUOTE NTHENTRY) (QUOTE ENTRYPOINT) (QUOTE "L3627"))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE CHANNELREADVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2390"))
+(PUT (QUOTE CHANNELREADVECTOR) (QUOTE IDNUMBER) (QUOTE 645))
+(PUT (QUOTE GCERROR) (QUOTE ENTRYPOINT) (QUOTE "L1281"))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE DELASCIP1) (QUOTE ENTRYPOINT) (QUOTE "L0950"))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 270))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 599))
+(PUT (QUOTE IN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE INTLSHIFT) (QUOTE ENTRYPOINT) (QUOTE "L1502"))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MAPC2) (QUOTE ENTRYPOINT) (QUOTE MAPC2))
+(PUT (QUOTE MAPC2) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE ANS) (QUOTE ENTRYPOINT) (QUOTE ANS))
+(PUT (QUOTE ANS) (QUOTE IDNUMBER) (QUOTE 830))
+(PUT (QUOTE HIST) (QUOTE ENTRYPOINT) (QUOTE HIST))
+(PUT (QUOTE HIST) (QUOTE IDNUMBER) (QUOTE 831))
+(PUT (QUOTE EVALINITFORMS) (QUOTE ENTRYPOINT) (QUOTE "L3658"))
+(PUT (QUOTE EVALINITFORMS) (QUOTE IDNUMBER) (QUOTE 837))
+(PUT (QUOTE EDITORPRINTER!*) (QUOTE IDNUMBER) (QUOTE 447))
+(FLAG (QUOTE (EDITORPRINTER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE LOOKUPORADDTOOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3412"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1091"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE CHANNELWRITEBYTES) (QUOTE ENTRYPOINT) (QUOTE "L2781"))
+(PUT (QUOTE CHANNELWRITEBYTES) (QUOTE IDNUMBER) (QUOTE 690))
+(PUT (QUOTE EXPLODE) (QUOTE ENTRYPOINT) (QUOTE "L2900"))
+(PUT (QUOTE EXPLODE) (QUOTE IDNUMBER) (QUOTE 697))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SPECIAL) (QUOTE IDNUMBER) (QUOTE 609))
+(PUT (QUOTE RCREF) (QUOTE IDNUMBER) (QUOTE 582))
+(PUT (QUOTE EVRELOAD) (QUOTE ENTRYPOINT) (QUOTE "L2197"))
+(PUT (QUOTE EVRELOAD) (QUOTE IDNUMBER) (QUOTE 569))
+(PUT (QUOTE INTERPRETERFUNCTIONS!*) (QUOTE IDNUMBER) (QUOTE 460))
+(PUT (QUOTE INTERPRETERFUNCTIONS!*) (QUOTE INITIALVALUE) (QUOTE (COND PROG
+AND OR PROGN SETQ)))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 633))
+(FLAG (QUOTE (TOKTYPE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE INTSUB1) (QUOTE ENTRYPOINT) (QUOTE "L1530"))
+(PUT (QUOTE MIN) (QUOTE ENTRYPOINT) (QUOTE MIN))
+(PUT (QUOTE MIN) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE INP) (QUOTE ENTRYPOINT) (QUOTE INP))
+(PUT (QUOTE INP) (QUOTE IDNUMBER) (QUOTE 828))
+(PUT (QUOTE CHANNELWRITEEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2724"))
+(PUT (QUOTE CHANNELWRITEEVECTOR) (QUOTE IDNUMBER) (QUOTE 684))
+(PUT (QUOTE CHANNELPOSN) (QUOTE ENTRYPOINT) (QUOTE "L2352"))
+(PUT (QUOTE CHANNELPOSN) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 475))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE FLAGP) (QUOTE ENTRYPOINT) (QUOTE FLAGP))
+(PUT (QUOTE FLAGP) (QUOTE IDNUMBER) (QUOTE 757))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1855"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 508))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE REMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1469"))
+(PUT (QUOTE REMAINDER) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE !*VERBOSELOAD) (QUOTE IDNUMBER) (QUOTE 564))
+(FLAG (QUOTE (!*VERBOSELOAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYSTRINGTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1131"))
+(PUT (QUOTE COPYSTRINGTOFROM) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE ID2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0036"))
+(PUT (QUOTE ID2STRING) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE REDO) (QUOTE ENTRYPOINT) (QUOTE REDO))
+(PUT (QUOTE REDO) (QUOTE IDNUMBER) (QUOTE 829))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L2890"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 694))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L1090"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L1116"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L2879"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 419))
+(PUT (QUOTE !*VERBOSE) (QUOTE IDNUMBER) (QUOTE 439))
+(FLAG (QUOTE (!*VERBOSE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L3356"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 780))
+(PUT (QUOTE EUPBV) (QUOTE ENTRYPOINT) (QUOTE EUPBV))
+(PUT (QUOTE EUPBV) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1092"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE NEWBITTABLEENTRY!*) (QUOTE IDNUMBER) (QUOTE 554))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE ENTRYPOINT) (QUOTE "L2577"))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 659))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0607"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE GETV) (QUOTE ENTRYPOINT) (QUOTE GETV))
+(PUT (QUOTE GETV) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE !*INSIDESTRUCTUREREAD) (QUOTE IDNUMBER) (QUOTE 639))
+(FLAG (QUOTE (!*INSIDESTRUCTUREREAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLOATLESSP) (QUOTE ENTRYPOINT) (QUOTE "L1516"))
+(PUT (QUOTE MARKFROMALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1206"))
+(PUT (QUOTE CL) (QUOTE IDNUMBER) (QUOTE 450))
+(FLAG (QUOTE (CL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MACROP) (QUOTE ENTRYPOINT) (QUOTE MACROP))
+(PUT (QUOTE MACROP) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CONTERROR) (QUOTE ENTRYPOINT) (QUOTE "L2929"))
+(PUT (QUOTE CONTERROR) (QUOTE IDNUMBER) (QUOTE 714))
+(PUT (QUOTE FLOATONEP) (QUOTE ENTRYPOINT) (QUOTE "L1576"))
+(PUT (QUOTE ONEP) (QUOTE ENTRYPOINT) (QUOTE ONEP))
+(PUT (QUOTE ONEP) (QUOTE IDNUMBER) (QUOTE 432))
+(PUT (QUOTE LOAD) (QUOTE ENTRYPOINT) (QUOTE LOAD))
+(PUT (QUOTE LOAD) (QUOTE IDNUMBER) (QUOTE 566))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE VECTOR) (QUOTE ENTRYPOINT) (QUOTE VECTOR))
+(PUT (QUOTE VECTOR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE GTHEAP1) (QUOTE ENTRYPOINT) (QUOTE "L1097"))
+(PUT (QUOTE GC!-TRAP!-LEVEL) (QUOTE ENTRYPOINT) (QUOTE "L1104"))
+(PUT (QUOTE GC!-TRAP!-LEVEL) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1862"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 509))
+(PUT (QUOTE LOADDIRECTORIES!*) (QUOTE IDNUMBER) (QUOTE 562))
+(PUT (QUOTE LOADDIRECTORIES!*) (QUOTE INITIALVALUE) (QUOTE ("" "pl:")))
+(PUT (QUOTE WRITENUMBER1) (QUOTE ENTRYPOINT) (QUOTE "L2588"))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE THIRD) (QUOTE ENTRYPOINT) (QUOTE THIRD))
+(PUT (QUOTE THIRD) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE SETF) (QUOTE ENTRYPOINT) (QUOTE SETF))
+(PUT (QUOTE SETF) (QUOTE IDNUMBER) (QUOTE 719))
+(PUT (QUOTE QEDNTH) (QUOTE ENTRYPOINT) (QUOTE QEDNTH))
+(PUT (QUOTE EXTRAREGLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2132"))
+(PUT (QUOTE EXTRAREGLOCATION) (QUOTE IDNUMBER) (QUOTE 557))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 691))
+(PUT (QUOTE LASTPAIR) (QUOTE ENTRYPOINT) (QUOTE "L1000"))
+(PUT (QUOTE LASTPAIR) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE ERRORSET) (QUOTE ENTRYPOINT) (QUOTE "L1831"))
+(PUT (QUOTE ERRORSET) (QUOTE IDNUMBER) (QUOTE 478))
+(PUT (QUOTE COMPILER) (QUOTE IDNUMBER) (QUOTE 584))
+(PUT (QUOTE UPDATEREGION) (QUOTE ENTRYPOINT) (QUOTE "L1291"))
+(PUT (QUOTE VECTOR2LIST) (QUOTE ENTRYPOINT) (QUOTE "L0083"))
+(PUT (QUOTE VECTOR2LIST) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PUTV) (QUOTE ENTRYPOINT) (QUOTE PUTV))
+(PUT (QUOTE PUTV) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE YESP) (QUOTE ENTRYPOINT) (QUOTE YESP))
+(PUT (QUOTE YESP) (QUOTE IDNUMBER) (QUOTE 442))
+(PUT (QUOTE NCONC) (QUOTE ENTRYPOINT) (QUOTE NCONC))
+(PUT (QUOTE NCONC) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE IGNORE) (QUOTE IDNUMBER) (QUOTE 827))
+(PUT (QUOTE RETURNADDRESSP) (QUOTE ENTRYPOINT) (QUOTE "L2098"))
+(PUT (QUOTE RETURNADDRESSP) (QUOTE IDNUMBER) (QUOTE 464))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L1111"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE HELP) (QUOTE ENTRYPOINT) (QUOTE HELP))
+(PUT (QUOTE HELP) (QUOTE IDNUMBER) (QUOTE 451))
+(PUT (QUOTE OUTPUTBASE!*) (QUOTE IDNUMBER) (QUOTE 657))
+(PUT (QUOTE OUTPUTBASE!*) (QUOTE INITIALVALUE) (QUOTE 10))
+(PUT (QUOTE LOADTIME) (QUOTE ENTRYPOINT) (QUOTE "L2922"))
+(PUT (QUOTE LOADTIME) (QUOTE IDNUMBER) (QUOTE 712))
+(PUT (QUOTE ID2INT) (QUOTE ENTRYPOINT) (QUOTE ID2INT))
+(PUT (QUOTE ID2INT) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE CHANNELREADTOKEN) (QUOTE ENTRYPOINT) (QUOTE "L2453"))
+(PUT (QUOTE CHANNELREADTOKEN) (QUOTE IDNUMBER) (QUOTE 632))
+(PUT (QUOTE THROWAUX) (QUOTE ENTRYPOINT) (QUOTE "L2052"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1093"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE DFPRINT!*) (QUOTE IDNUMBER) (QUOTE 826))
+(FLAG (QUOTE (DFPRINT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !%THROW) (QUOTE ENTRYPOINT) (QUOTE !%THROW))
+(PUT (QUOTE !%THROW) (QUOTE IDNUMBER) (QUOTE 532))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 654))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 626))
+(PUT (QUOTE !*RAISE) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE NEXPRP) (QUOTE ENTRYPOINT) (QUOTE NEXPRP))
+(PUT (QUOTE NEXPRP) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE MKFLAGVAR) (QUOTE ENTRYPOINT) (QUOTE "L2985"))
+(PUT (QUOTE MKFLAGVAR) (QUOTE IDNUMBER) (QUOTE 724))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 443))
+(FLAG (QUOTE (PROMPTSTRING!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE STRINGEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0487"))
+(PUT (QUOTE STRINGEQUAL) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE NE) (QUOTE ENTRYPOINT) (QUOTE NE))
+(PUT (QUOTE NE) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2887"))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 593))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 612))
+(PUT (QUOTE BREAKVALUE!*) (QUOTE IDNUMBER) (QUOTE 796))
+(FLAG (QUOTE (BREAKVALUE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FINDIDNUMBER) (QUOTE IDNUMBER) (QUOTE 555))
+(PUT (QUOTE BREAKEDIT) (QUOTE ENTRYPOINT) (QUOTE "L3586"))
+(PUT (QUOTE BREAKEDIT) (QUOTE IDNUMBER) (QUOTE 815))
+(PUT (QUOTE TIMES) (QUOTE ENTRYPOINT) (QUOTE TIMES))
+(PUT (QUOTE TIMES) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE CHANNELREADRIGHTPAREN) (QUOTE ENTRYPOINT) (QUOTE "L2383"))
+(PUT (QUOTE CHANNELREADRIGHTPAREN) (QUOTE IDNUMBER) (QUOTE 644))
+(PUT (QUOTE FLOATMINUS) (QUOTE ENTRYPOINT) (QUOTE "L1548"))
+(PUT (QUOTE EXEC) (QUOTE ENTRYPOINT) (QUOTE EXEC))
+(PUT (QUOTE EXEC) (QUOTE IDNUMBER) (QUOTE 588))
+(PUT (QUOTE DELQIP1) (QUOTE ENTRYPOINT) (QUOTE "L0913"))
+(PUT (QUOTE EMODE) (QUOTE ENTRYPOINT) (QUOTE EMODE))
+(PUT (QUOTE EMODE) (QUOTE IDNUMBER) (QUOTE 580))
+(PUT (QUOTE READLINE) (QUOTE ENTRYPOINT) (QUOTE "L2564"))
+(PUT (QUOTE READLINE) (QUOTE IDNUMBER) (QUOTE 655))
+(PUT (QUOTE INTMINUS) (QUOTE ENTRYPOINT) (QUOTE "L1547"))
+(PUT (QUOTE DEFNPRINT1) (QUOTE ENTRYPOINT) (QUOTE "L3620"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1112"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE CHANNELWRITEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2696"))
+(PUT (QUOTE CHANNELWRITEVECTOR) (QUOTE IDNUMBER) (QUOTE 682))
+(PUT (QUOTE EVECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE EVECTORP) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 596))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE OBJECT!-GET!-HANDLER!-QUIETLY) (QUOTE IDNUMBER) (QUOTE 685))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE CHANNELWRITEPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2654"))
+(PUT (QUOTE CHANNELWRITEPAIR) (QUOTE IDNUMBER) (QUOTE 676))
+(PUT (QUOTE !*LOWER) (QUOTE IDNUMBER) (QUOTE 573))
+(FLAG (QUOTE (!*LOWER)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DUMPLISP) (QUOTE ENTRYPOINT) (QUOTE "L2111"))
+(PUT (QUOTE DUMPLISP) (QUOTE IDNUMBER) (QUOTE 548))
+(PUT (QUOTE EVAND) (QUOTE ENTRYPOINT) (QUOTE EVAND))
+(PUT (QUOTE EVAND) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE ASSIGN!-OP) (QUOTE IDNUMBER) (QUOTE 722))
+(PUT (QUOTE PLUS) (QUOTE ENTRYPOINT) (QUOTE PLUS))
+(PUT (QUOTE PLUS) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE !*ECHO) (QUOTE IDNUMBER) (QUOTE 792))
+(FLAG (QUOTE (!*ECHO)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 414))
+(PUT (QUOTE !$UNWIND!-PROTECT!$) (QUOTE IDNUMBER) (QUOTE 530))
+(PUT (QUOTE COMPRESS) (QUOTE ENTRYPOINT) (QUOTE "L2915"))
+(PUT (QUOTE COMPRESS) (QUOTE IDNUMBER) (QUOTE 703))
+(PUT (QUOTE MAPCON) (QUOTE ENTRYPOINT) (QUOTE MAPCON))
+(PUT (QUOTE MAPCON) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE MAPCAR) (QUOTE ENTRYPOINT) (QUOTE MAPCAR))
+(PUT (QUOTE MAPCAR) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L1737"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE SUBLIS) (QUOTE ENTRYPOINT) (QUOTE SUBLIS))
+(PUT (QUOTE SUBLIS) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE MAKEBUFINTOID) (QUOTE ENTRYPOINT) (QUOTE "L2411"))
+(PUT (QUOTE TOPLOOPNAME!*) (QUOTE IDNUMBER) (QUOTE 800))
+(FLAG (QUOTE (TOPLOOPNAME!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BREAKNAME!*) (QUOTE IDNUMBER) (QUOTE 803))
+(FLAG (QUOTE (BREAKNAME!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BREAKEVAL) (QUOTE ENTRYPOINT) (QUOTE "L3566"))
+(PUT (QUOTE BREAKEVAL) (QUOTE IDNUMBER) (QUOTE 808))
+(PUT (QUOTE PROG) (QUOTE ENTRYPOINT) (QUOTE PROG))
+(PUT (QUOTE PROG) (QUOTE IDNUMBER) (QUOTE 541))
+(PUT (QUOTE CURRENTREADMACROINDICATOR!*) (QUOTE IDNUMBER) (QUOTE 630))
+(PUT (QUOTE CURRENTREADMACROINDICATOR!*) (QUOTE INITIALVALUE) (QUOTE
+LISPREADMACRO))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE CHANNELWRITEID) (QUOTE ENTRYPOINT) (QUOTE "L2608"))
+(PUT (QUOTE CHANNELWRITEID) (QUOTE IDNUMBER) (QUOTE 670))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE ASMSYMBOL) (QUOTE "L2282"))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE WARRAY) (QUOTE JFNOFCHANNEL))
+(PUT (QUOTE CHANNELLPOSN) (QUOTE ENTRYPOINT) (QUOTE "L2353"))
+(PUT (QUOTE CHANNELLPOSN) (QUOTE IDNUMBER) (QUOTE 623))
+(PUT (QUOTE STRINGGENSYM1) (QUOTE ENTRYPOINT) (QUOTE "L3051"))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE FLOAT) (QUOTE ENTRYPOINT) (QUOTE FLOAT))
+(PUT (QUOTE FLOAT) (QUOTE IDNUMBER) (QUOTE 431))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 8000))
+(PUT (QUOTE FLOATZEROP) (QUOTE ENTRYPOINT) (QUOTE "L1467"))
+(PUT (QUOTE INDX) (QUOTE ENTRYPOINT) (QUOTE INDX))
+(PUT (QUOTE INDX) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 515))
+(PUT (QUOTE INTZEROP) (QUOTE ENTRYPOINT) (QUOTE "L1571"))
+(PUT (QUOTE FLOATADD1) (QUOTE ENTRYPOINT) (QUOTE "L1521"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1798"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CHANNELWRITEFIXNUM) (QUOTE ENTRYPOINT) (QUOTE "L2597"))
+(PUT (QUOTE CHANNELWRITEFIXNUM) (QUOTE IDNUMBER) (QUOTE 664))
+(PUT (QUOTE EPUTV) (QUOTE ENTRYPOINT) (QUOTE EPUTV))
+(PUT (QUOTE EPUTV) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE DECLAREFLUIDORGLOBAL) (QUOTE ENTRYPOINT) (QUOTE "L3247"))
+(PUT (QUOTE LISPSCANTABLE!*) (QUOTE IDNUMBER) (QUOTE 636))
+(PUT (QUOTE LISPSCANTABLE!*) (QUOTE INITIALVALUE) (QUOTE [17 10 10 10 10
+10 10 10 10 17 17 10 17 17 10 10 10 10 10 10 10 10 10 10 10 10 11 10 10
+10 10 10 17 14 15 10 10 12 10 11 11 11 10 19 10 18 20 10 0 1 2 3 4 5 6
+7 8 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 11 16 11 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+LISPDIPHTHONG]))
+(PUT (QUOTE UNREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2303"))
+(PUT (QUOTE UNREADCHAR) (QUOTE IDNUMBER) (QUOTE 601))
+(PUT (QUOTE MAKE!-WORDS) (QUOTE ENTRYPOINT) (QUOTE "L0364"))
+(PUT (QUOTE MAKE!-WORDS) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE FUNCTIONCELLLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2134"))
+(PUT (QUOTE FUNCTIONCELLLOCATION) (QUOTE IDNUMBER) (QUOTE 558))
+(PUT (QUOTE SIMPFG) (QUOTE IDNUMBER) (QUOTE 725))
+(PUT (QUOTE SETPROP) (QUOTE ENTRYPOINT) (QUOTE "L3179"))
+(PUT (QUOTE SETPROP) (QUOTE IDNUMBER) (QUOTE 756))
+(PUT (QUOTE SPECIALREADFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 606))
+(FLAG (QUOTE (SPECIALREADFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CHANNELPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L2898"))
+(PUT (QUOTE CHANNELPRINTF) (QUOTE IDNUMBER) (QUOTE 695))
+(PUT (QUOTE OR) (QUOTE ENTRYPOINT) (QUOTE OR))
+(PUT (QUOTE OR) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE MKQUOTE) (QUOTE ENTRYPOINT) (QUOTE "L0871"))
+(PUT (QUOTE MKQUOTE) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE !*PRINTLOADNAMES) (QUOTE IDNUMBER) (QUOTE 565))
+(FLAG (QUOTE (!*PRINTLOADNAMES)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 472))
+(PUT (QUOTE EDITORREADER!*) (QUOTE IDNUMBER) (QUOTE 446))
+(FLAG (QUOTE (EDITORREADER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SETF!-EXPAND) (QUOTE IDNUMBER) (QUOTE 721))
+(PUT (QUOTE SETSUB) (QUOTE ENTRYPOINT) (QUOTE SETSUB))
+(PUT (QUOTE SETSUB) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE SIZE) (QUOTE ENTRYPOINT) (QUOTE SIZE))
+(PUT (QUOTE SIZE) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE CHANNELREAD) (QUOTE ENTRYPOINT) (QUOTE "L2361"))
+(PUT (QUOTE CHANNELREAD) (QUOTE IDNUMBER) (QUOTE 635))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 536))
+(PUT (QUOTE !&!&VALUE!&!&) (QUOTE IDNUMBER) (QUOTE 525))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L3236"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 763))
+(PUT (QUOTE CHANNELSPACES) (QUOTE ENTRYPOINT) (QUOTE "L1046"))
+(PUT (QUOTE CHANNELSPACES) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE PRINTF2) (QUOTE ENTRYPOINT) (QUOTE "L2850"))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3490"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 790))
+(PUT (QUOTE LOSE) (QUOTE IDNUMBER) (QUOTE 777))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L1870"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 510))
+(PUT (QUOTE LISPEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0449"))
+(PUT (QUOTE LISPEQUAL) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE CLEARIO1) (QUOTE ENTRYPOINT) (QUOTE "L3503"))
+(PUT (QUOTE UNION) (QUOTE ENTRYPOINT) (QUOTE UNION))
+(PUT (QUOTE UNION) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE DELQIP) (QUOTE ENTRYPOINT) (QUOTE DELQIP))
+(PUT (QUOTE DELQIP) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE CHANNELTAB) (QUOTE ENTRYPOINT) (QUOTE "L1050"))
+(PUT (QUOTE CHANNELTAB) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE BIGFLOATFIX) (QUOTE ENTRYPOINT) (QUOTE "L1421"))
+(PUT (QUOTE INTLNOT) (QUOTE ENTRYPOINT) (QUOTE "L1540"))
+(PUT (QUOTE DSKINDEFNPRINT) (QUOTE ENTRYPOINT) (QUOTE "L3681"))
+(PUT (QUOTE MAX) (QUOTE ENTRYPOINT) (QUOTE MAX))
+(PUT (QUOTE MAX) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE INSTANTIATEINFORM) (QUOTE ENTRYPOINT) (QUOTE "L2991"))
+(PUT (QUOTE COPYWRDS) (QUOTE ENTRYPOINT) (QUOTE "L1147"))
+(PUT (QUOTE COPYWRDS) (QUOTE IDNUMBER) (QUOTE 409))
+(PUT (QUOTE CLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L3504"))
+(PUT (QUOTE CLEARIO) (QUOTE IDNUMBER) (QUOTE 793))
+(PUT (QUOTE BUILDRELOCATIONFIELDS) (QUOTE ENTRYPOINT) (QUOTE "L1208"))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L1163"))
+(PUT (QUOTE CHANNELPRINT) (QUOTE ENTRYPOINT) (QUOTE "L0822"))
+(PUT (QUOTE CHANNELPRINT) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE LOADEXTENSIONS!*) (QUOTE IDNUMBER) (QUOTE 563))
+(PUT (QUOTE LOADEXTENSIONS!*) (QUOTE INITIALVALUE) (QUOTE ((".b" . FASLIN) (
+".lap" . LAPIN) (".sl" . LAPIN))))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE UPDATEITEM) (QUOTE ENTRYPOINT) (QUOTE "L1295"))
+(PUT (QUOTE SAVESYSTEM) (QUOTE ENTRYPOINT) (QUOTE "L3656"))
+(PUT (QUOTE SAVESYSTEM) (QUOTE IDNUMBER) (QUOTE 835))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE FEXPRP) (QUOTE ENTRYPOINT) (QUOTE FEXPRP))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L2357"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE THROW) (QUOTE ENTRYPOINT) (QUOTE THROW))
+(PUT (QUOTE THROW) (QUOTE IDNUMBER) (QUOTE 495))
+(PUT (QUOTE FIX) (QUOTE ENTRYPOINT) (QUOTE FIX))
+(PUT (QUOTE FIX) (QUOTE IDNUMBER) (QUOTE 430))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0395"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE IDNUMBER) (QUOTE 418))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE INITIALVALUE) (QUOTE 1000))
+(PUT (QUOTE TCONC) (QUOTE ENTRYPOINT) (QUOTE TCONC))
+(PUT (QUOTE TCONC) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1128"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE !*QUITBREAK) (QUOTE IDNUMBER) (QUOTE 797))
+(FLAG (QUOTE (!*QUITBREAK)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE CONST) (QUOTE ENTRYPOINT) (QUOTE CONST))
+(PUT (QUOTE CONST) (QUOTE IDNUMBER) (QUOTE 732))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 767))
+(PUT (QUOTE EGETV) (QUOTE ENTRYPOINT) (QUOTE EGETV))
+(PUT (QUOTE EGETV) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE UNDEFINEDFUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L1895"))
+(PUT (QUOTE UNDEFINEDFUNCTION) (QUOTE IDNUMBER) (QUOTE 516))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE DS) (QUOTE ENTRYPOINT) (QUOTE DS))
+(PUT (QUOTE DS) (QUOTE IDNUMBER) (QUOTE 729))
+(PUT (QUOTE WORDSEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0446"))
+(PUT (QUOTE INTERNGENSYM) (QUOTE ENTRYPOINT) (QUOTE "L3465"))
+(PUT (QUOTE INTERNGENSYM) (QUOTE IDNUMBER) (QUOTE 785))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1844"))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 506))
+(PUT (QUOTE COMPRESSLIST!*) (QUOTE IDNUMBER) (QUOTE 701))
+(FLAG (QUOTE (COMPRESSLIST!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYVECTORTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1140"))
+(PUT (QUOTE COPYVECTORTOFROM) (QUOTE IDNUMBER) (QUOTE 406))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2899"))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 594))
+(PUT (QUOTE SPECIALWRSACTION!*) (QUOTE IDNUMBER) (QUOTE 616))
+(FLAG (QUOTE (SPECIALWRSACTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE TOPLOOPPRINT!*) (QUOTE IDNUMBER) (QUOTE 804))
+(FLAG (QUOTE (TOPLOOPPRINT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODE!-ADDRESS!-TO!-SYMBOL) (QUOTE IDNUMBER) (QUOTE 470))
+(PUT (QUOTE MAPLIST) (QUOTE ENTRYPOINT) (QUOTE "L0747"))
+(PUT (QUOTE MAPLIST) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1772"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE !*EXPERT) (QUOTE IDNUMBER) (QUOTE 438))
+(FLAG (QUOTE (!*EXPERT)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CONC) (QUOTE IDNUMBER) (QUOTE 738))
+(PUT (QUOTE CHANNELPRIN1) (QUOTE ENTRYPOINT) (QUOTE "L2814"))
+(PUT (QUOTE CHANNELPRIN1) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE PRINTF1) (QUOTE ENTRYPOINT) (QUOTE "L2849"))
+(PUT (QUOTE !*COMP) (QUOTE IDNUMBER) (QUOTE 775))
+(FLAG (QUOTE (!*COMP)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MARKFROMBASE) (QUOTE ENTRYPOINT) (QUOTE "L1219"))
+(PUT (QUOTE ABS) (QUOTE ENTRYPOINT) (QUOTE ABS))
+(PUT (QUOTE ABS) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1807"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 491))
+(PUT (QUOTE OTHERWISE) (QUOTE IDNUMBER) (QUOTE 715))
+(PUT (QUOTE FASLOUT) (QUOTE ENTRYPOINT) (QUOTE "L2265"))
+(PUT (QUOTE FASLOUT) (QUOTE IDNUMBER) (QUOTE 586))
+(PUT (QUOTE CHANNELWRITEHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L2765"))
+(PUT (QUOTE CHANNELWRITEHALFWORDS) (QUOTE IDNUMBER) (QUOTE 689))
+(PUT (QUOTE SUBSEQ) (QUOTE ENTRYPOINT) (QUOTE SUBSEQ))
+(PUT (QUOTE SUBSEQ) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE LSHIFT) (QUOTE ENTRYPOINT) (QUOTE LSHIFT))
+(PUT (QUOTE LSHIFT) (QUOTE IDNUMBER) (QUOTE 427))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L1780"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L3417"))
+(PUT (QUOTE MARKFROMRANGE) (QUOTE ENTRYPOINT) (QUOTE "L1215"))
+(PUT (QUOTE XCHANGE) (QUOTE ENTRYPOINT) (QUOTE "L1637"))
+(PUT (QUOTE COMPRESSERROR) (QUOTE ENTRYPOINT) (QUOTE "L2914"))
+(PUT (QUOTE COMPRESSERROR) (QUOTE IDNUMBER) (QUOTE 700))
+(PUT (QUOTE READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2290"))
+(PUT (QUOTE READCHAR) (QUOTE IDNUMBER) (QUOTE 598))
+(PUT (QUOTE FLOATDIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1436"))
+(PUT (QUOTE CURRENTSCANTABLE!*) (QUOTE IDNUMBER) (QUOTE 634))
+(PUT (QUOTE CURRENTSCANTABLE!*) (QUOTE INITIALVALUE) (QUOTE [17 10 10 10
+10 10 10 10 10 17 17 10 17 17 10 10 10 10 10 10 10 10 10 10 10 10 11 10
+10 10 10 10 17 14 15 10 10 12 10 11 11 11 10 19 10 18 20 10 0 1 2 3 4 5
+6 7 8 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 LISPDIPHTHONG]))
+(PUT (QUOTE UPDATESYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1290"))
+(PUT (QUOTE GCMESSAGE) (QUOTE ENTRYPOINT) (QUOTE "L1212"))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE CHANNELREADCH) (QUOTE ENTRYPOINT) (QUOTE "L2354"))
+(PUT (QUOTE CHANNELREADCH) (QUOTE IDNUMBER) (QUOTE 625))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COPYVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1143"))
+(PUT (QUOTE COPYVECTOR) (QUOTE IDNUMBER) (QUOTE 407))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 411))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 641))
+(FLAG (QUOTE (!$EOF!$)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DELQ) (QUOTE ENTRYPOINT) (QUOTE DELQ))
+(PUT (QUOTE DELQ) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1792"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1193"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE CREFON) (QUOTE ENTRYPOINT) (QUOTE CREFON))
+(PUT (QUOTE CREFON) (QUOTE IDNUMBER) (QUOTE 583))
+(PUT (QUOTE FOR) (QUOTE ENTRYPOINT) (QUOTE FOR))
+(PUT (QUOTE FOR) (QUOTE IDNUMBER) (QUOTE 746))
+(PUT (QUOTE BIN) (QUOTE IDNUMBER) (QUOTE 750))
+(PUT (QUOTE DSKINEVAL) (QUOTE ENTRYPOINT) (QUOTE "L3679"))
+(PUT (QUOTE DSKINEVAL) (QUOTE IDNUMBER) (QUOTE 839))
+(PUT (QUOTE CHANNELREADTOKENWITHHOOKS) (QUOTE ENTRYPOINT) (QUOTE "L2358"))
+(PUT (QUOTE CHANNELREADTOKENWITHHOOKS) (QUOTE IDNUMBER) (QUOTE 631))
+(PUT (QUOTE INT2CODE) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE INT2CODE) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE BREAK) (QUOTE ENTRYPOINT) (QUOTE BREAK))
+(PUT (QUOTE BREAK) (QUOTE IDNUMBER) (QUOTE 452))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1891"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L3524"))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 613))
+(PUT (QUOTE INTADD1) (QUOTE ENTRYPOINT) (QUOTE "L1520"))
+(PUT (QUOTE FLAG) (QUOTE ENTRYPOINT) (QUOTE FLAG))
+(PUT (QUOTE FLAG) (QUOTE IDNUMBER) (QUOTE 759))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2294"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 471))
+(PUT (QUOTE IN) (QUOTE IDNUMBER) (QUOTE 739))
+(PUT (QUOTE REMOB) (QUOTE ENTRYPOINT) (QUOTE REMOB))
+(PUT (QUOTE REMOB) (QUOTE IDNUMBER) (QUOTE 783))
+(PUT (QUOTE BREAKFUNCTION) (QUOTE IDNUMBER) (QUOTE 809))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE ASMSYMBOL) (QUOTE "L1094"))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE WVAR) (QUOTE HEAPTRAPPED))
+(PUT (QUOTE !*EOLINSTRINGOK) (QUOTE IDNUMBER) (QUOTE 647))
+(FLAG (QUOTE (!*EOLINSTRINGOK)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE INOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3406"))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE MIN2) (QUOTE ENTRYPOINT) (QUOTE MIN2))
+(PUT (QUOTE MIN2) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE ASS) (QUOTE ENTRYPOINT) (QUOTE ASS))
+(PUT (QUOTE ASS) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE VARTYPE) (QUOTE IDNUMBER) (QUOTE 766))
+(PUT (QUOTE HISTPRINT) (QUOTE ENTRYPOINT) (QUOTE "L3638"))
+(PUT (QUOTE CHANNELUNREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2302"))
+(PUT (QUOTE CHANNELUNREADCHAR) (QUOTE IDNUMBER) (QUOTE 600))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE CHANNELWRITEUNKNOWNITEM) (QUOTE ENTRYPOINT) (QUOTE "L2636"))
+(PUT (QUOTE CHANNELWRITEUNKNOWNITEM) (QUOTE IDNUMBER) (QUOTE 469))
+(PUT (QUOTE FLUID1) (QUOTE ENTRYPOINT) (QUOTE FLUID1))
+(PUT (QUOTE FLUID1) (QUOTE IDNUMBER) (QUOTE 768))
+(PUT (QUOTE EVDEFCONST) (QUOTE ENTRYPOINT) (QUOTE "L3045"))
+(PUT (QUOTE EVDEFCONST) (QUOTE IDNUMBER) (QUOTE 731))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE CASE) (QUOTE ENTRYPOINT) (QUOTE CASE))
+(PUT (QUOTE CASE) (QUOTE IDNUMBER) (QUOTE 717))
+(PUT (QUOTE SCANNERERROR) (QUOTE ENTRYPOINT) (QUOTE "L2482"))
+(PUT (QUOTE RETURNFIRSTARG) (QUOTE ENTRYPOINT) (QUOTE "L1423"))
+(PUT (QUOTE RETURNFIRSTARG) (QUOTE IDNUMBER) (QUOTE 423))
+(PUT (QUOTE !*DEFN) (QUOTE IDNUMBER) (QUOTE 795))
+(FLAG (QUOTE (!*DEFN)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0427"))
+(PUT (QUOTE LAPIN) (QUOTE ENTRYPOINT) (QUOTE LAPIN))
+(PUT (QUOTE LAPIN) (QUOTE IDNUMBER) (QUOTE 840))
+(PUT (QUOTE MAKE!-HALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0354"))
+(PUT (QUOTE MAKE!-HALFWORDS) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE STRINGGENSYM!*) (QUOTE IDNUMBER) (QUOTE 734))
+(FLAG (QUOTE (STRINGGENSYM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE HELPBREAK) (QUOTE ENTRYPOINT) (QUOTE "L3579"))
+(PUT (QUOTE HELPBREAK) (QUOTE IDNUMBER) (QUOTE 813))
+(PUT (QUOTE UNMAP!-SPACE) (QUOTE ENTRYPOINT) (QUOTE "L2113"))
+(PUT (QUOTE !*CATCH) (QUOTE ENTRYPOINT) (QUOTE "L2035"))
+(PUT (QUOTE !*CATCH) (QUOTE IDNUMBER) (QUOTE 534))
+(PUT (QUOTE MINUSP) (QUOTE ENTRYPOINT) (QUOTE MINUSP))
+(PUT (QUOTE MINUSP) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BPSSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BPSSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BPSSIZE) (QUOTE WCONST) (QUOTE 100000))
+(PUT (QUOTE IMPLODE) (QUOTE ENTRYPOINT) (QUOTE "L2916"))
+(PUT (QUOTE IMPLODE) (QUOTE IDNUMBER) (QUOTE 704))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1795"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE FASTBIND) (QUOTE ENTRYPOINT) (QUOTE "L3367"))
+(PUT (QUOTE FASTBIND) (QUOTE IDNUMBER) (QUOTE 444))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1918"))
+(PUT (QUOTE CHANNELWRITEFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2601"))
+(PUT (QUOTE CHANNELWRITEFLOAT) (QUOTE IDNUMBER) (QUOTE 668))
+(PUT (QUOTE CHECKLINEFIT) (QUOTE ENTRYPOINT) (QUOTE "L2574"))
+(PUT (QUOTE !%UNCATCH) (QUOTE ENTRYPOINT) (QUOTE "L2047"))
+(PUT (QUOTE !%UNCATCH) (QUOTE IDNUMBER) (QUOTE 501))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L1804"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE WCONST) (QUOTE 8))
+(PUT (QUOTE CHANNELPRINTUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L2629"))
+(PUT (QUOTE CHANNELPRINTUNBOUND) (QUOTE IDNUMBER) (QUOTE 673))
+(PUT (QUOTE HASHFUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L3419"))
+(PUT (QUOTE HASHFUNCTION) (QUOTE IDNUMBER) (QUOTE 782))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1509"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE MAPC) (QUOTE ENTRYPOINT) (QUOTE MAPC))
+(PUT (QUOTE MAPC) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1838"))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 504))
+(PUT (QUOTE SYSTEM_LIST!*) (QUOTE IDNUMBER) (QUOTE 546))
+(PUT (QUOTE SYSTEM_LIST!*) (QUOTE INITIALVALUE) (QUOTE (DEC20 PDP10 TOPS20
+KL10)))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE MAKESTRINGINTOBITSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2540"))
+(PUT (QUOTE HISTORYCOUNT!*) (QUOTE IDNUMBER) (QUOTE 817))
+(PUT (QUOTE HISTORYCOUNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE UPBV) (QUOTE ENTRYPOINT) (QUOTE UPBV))
+(PUT (QUOTE UPBV) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE LCONC) (QUOTE ENTRYPOINT) (QUOTE LCONC))
+(PUT (QUOTE LCONC) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE EDCOPY) (QUOTE ENTRYPOINT) (QUOTE EDCOPY))
+(PUT (QUOTE FLOATFIX) (QUOTE ENTRYPOINT) (QUOTE "L1557"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1775"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 489))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 542))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE DEL) (QUOTE ENTRYPOINT) (QUOTE DEL))
+(PUT (QUOTE DEL) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE MAKE!-BYTES) (QUOTE ENTRYPOINT) (QUOTE "L0343"))
+(PUT (QUOTE MAKE!-BYTES) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE !*GC) (QUOTE IDNUMBER) (QUOTE 415))
+(PUT (QUOTE !*GC) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE FIRST) (QUOTE ENTRYPOINT) (QUOTE FIRST))
+(PUT (QUOTE FIRST) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE DATE) (QUOTE ENTRYPOINT) (QUOTE DATE))
+(PUT (QUOTE DATE) (QUOTE IDNUMBER) (QUOTE 547))
+(PUT (QUOTE SEMIC!*) (QUOTE IDNUMBER) (QUOTE 820))
+(FLAG (QUOTE (SEMIC!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DOTCONTEXTERROR) (QUOTE ENTRYPOINT) (QUOTE "L2373"))
+(PUT (QUOTE SYSPOWEROF2P) (QUOTE ENTRYPOINT) (QUOTE "L2538"))
+(PUT (QUOTE LOAD1) (QUOTE ENTRYPOINT) (QUOTE LOAD1))
+(PUT (QUOTE LOAD1) (QUOTE IDNUMBER) (QUOTE 567))
+(PUT (QUOTE LISP2CHAR) (QUOTE ENTRYPOINT) (QUOTE "L0023"))
+(PUT (QUOTE LISP2CHAR) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE MEM) (QUOTE ENTRYPOINT) (QUOTE MEM))
+(PUT (QUOTE MEM) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE EHELP) (QUOTE ENTRYPOINT) (QUOTE EHELP))
+(PUT (QUOTE EHELP) (QUOTE IDNUMBER) (QUOTE 453))
+(PUT (QUOTE EDIT0) (QUOTE ENTRYPOINT) (QUOTE EDIT0))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE MAKEBUFINTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2415"))
+(PUT (QUOTE INTMINUSP) (QUOTE ENTRYPOINT) (QUOTE "L1566"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE ENTRYPOINT) (QUOTE "L3529"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 605))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1801"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE INTERPBACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1695"))
+(PUT (QUOTE INTERPBACKTRACE) (QUOTE IDNUMBER) (QUOTE 461))
+(PUT (QUOTE !$ERROR!$) (QUOTE IDNUMBER) (QUOTE 496))
+(PUT (QUOTE INTGREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1510"))
+(PUT (QUOTE UNMAP!-PAGES) (QUOTE ENTRYPOINT) (QUOTE "L2116"))
+(PUT (QUOTE CHANNELLINELENGTH) (QUOTE ENTRYPOINT) (QUOTE "L2348"))
+(PUT (QUOTE CHANNELLINELENGTH) (QUOTE IDNUMBER) (QUOTE 620))
+(PUT (QUOTE TOPLOOPEVAL!*) (QUOTE IDNUMBER) (QUOTE 801))
+(FLAG (QUOTE (TOPLOOPEVAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE USER) (QUOTE IDNUMBER) (QUOTE 776))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE SCANPOSSIBLEDIPHTHONG) (QUOTE ENTRYPOINT) (QUOTE "L2476"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE ENTRYPOINT) (QUOTE "L3512"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 590))
+(PUT (QUOTE CHANNELREADQUOTEDEXPRESSION) (QUOTE ENTRYPOINT) (QUOTE "L2367"))
+(PUT (QUOTE CHANNELREADQUOTEDEXPRESSION) (QUOTE IDNUMBER) (QUOTE 642))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE OUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE EXPANDSETF) (QUOTE ENTRYPOINT) (QUOTE "L2965"))
+(PUT (QUOTE EXPANDSETF) (QUOTE IDNUMBER) (QUOTE 720))
+(PUT (QUOTE GO) (QUOTE ENTRYPOINT) (QUOTE GO))
+(PUT (QUOTE GO) (QUOTE IDNUMBER) (QUOTE 544))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 617))
+(PUT (QUOTE STDOUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L3520"))
+(PUT (QUOTE REST) (QUOTE ENTRYPOINT) (QUOTE REST))
+(PUT (QUOTE REST) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE SIMP) (QUOTE IDNUMBER) (QUOTE 749))
+(PUT (QUOTE INVOKE) (QUOTE ENTRYPOINT) (QUOTE INVOKE))
+(PUT (QUOTE INVOKE) (QUOTE IDNUMBER) (QUOTE 581))
+(PUT (QUOTE !*BACKTRACE) (QUOTE IDNUMBER) (QUOTE 493))
+(FLAG (QUOTE (!*BACKTRACE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !&!&TAG!&!&) (QUOTE IDNUMBER) (QUOTE 531))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 758))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE TR) (QUOTE ENTRYPOINT) (QUOTE TR))
+(PUT (QUOTE TR) (QUOTE IDNUMBER) (QUOTE 434))
+(PUT (QUOTE UP) (QUOTE IDNUMBER) (QUOTE 455))
+(PUT (QUOTE EMSG!*) (QUOTE IDNUMBER) (QUOTE 483))
+(FLAG (QUOTE (EMSG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAKE!-VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0374"))
+(PUT (QUOTE MAKE!-VECTOR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 462))
+(PUT (QUOTE FLATSIZE) (QUOTE ENTRYPOINT) (QUOTE "L2904"))
+(PUT (QUOTE FLATSIZE) (QUOTE IDNUMBER) (QUOTE 488))
+(PUT (QUOTE PROGBODY!*) (QUOTE IDNUMBER) (QUOTE 539))
+(FLAG (QUOTE (PROGBODY!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SPECIALWRITEFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 607))
+(FLAG (QUOTE (SPECIALWRITEFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE READINBUF) (QUOTE ENTRYPOINT) (QUOTE "L2407"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE ENTRYPOINT) (QUOTE "L2032"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE IDNUMBER) (QUOTE 533))
+(PUT (QUOTE SUBSTIP1) (QUOTE ENTRYPOINT) (QUOTE "L0883"))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0612"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE INTLXOR) (QUOTE ENTRYPOINT) (QUOTE "L1495"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L3157"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 752))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE HISTORYLIST!*) (QUOTE IDNUMBER) (QUOTE 821))
+(FLAG (QUOTE (HISTORYLIST!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNIONQ) (QUOTE ENTRYPOINT) (QUOTE UNIONQ))
+(PUT (QUOTE UNIONQ) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE MAKESTRINGINTOSYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2418"))
+(PUT (QUOTE NTH) (QUOTE ENTRYPOINT) (QUOTE NTH))
+(PUT (QUOTE NTH) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE PL) (QUOTE IDNUMBER) (QUOTE 454))
+(PUT (QUOTE JOIN) (QUOTE IDNUMBER) (QUOTE 737))
+(PUT (QUOTE SUBSTIP) (QUOTE ENTRYPOINT) (QUOTE "L0888"))
+(PUT (QUOTE SUBSTIP) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE TIME) (QUOTE ENTRYPOINT) (QUOTE TIME))
+(PUT (QUOTE TIME) (QUOTE IDNUMBER) (QUOTE 823))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE SPECIALCLOSEFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 608))
+(FLAG (QUOTE (SPECIALCLOSEFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 755))
+(PUT (QUOTE STARTUPTIME) (QUOTE ENTRYPOINT) (QUOTE "L2922"))
+(PUT (QUOTE STARTUPTIME) (QUOTE IDNUMBER) (QUOTE 713))
+(PUT (QUOTE INTERSECTIONQ) (QUOTE ENTRYPOINT) (QUOTE XNQ))
+(PUT (QUOTE INTERSECTIONQ) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE !$BREAK!$) (QUOTE IDNUMBER) (QUOTE 807))
+(PUT (QUOTE EDITOR) (QUOTE IDNUMBER) (QUOTE 458))
+(PUT (QUOTE FLOATQUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1453"))
+(PUT (QUOTE BREAKLEVEL!*) (QUOTE IDNUMBER) (QUOTE 487))
+(PUT (QUOTE BREAKLEVEL!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1763"))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE MAKEBUFINTOSYSNUMBER) (QUOTE ENTRYPOINT) (QUOTE "L2417"))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE CHANNELWRITECODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L2632"))
+(PUT (QUOTE CHANNELWRITECODEPOINTER) (QUOTE IDNUMBER) (QUOTE 674))
+(PUT (QUOTE BINARYOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L2123"))
+(PUT (QUOTE BINARYOPENREAD) (QUOTE IDNUMBER) (QUOTE 549))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2276"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE INT2SYS) (QUOTE ENTRYPOINT) (QUOTE "L0016"))
+(PUT (QUOTE INT2SYS) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE ENTRYPOINT) (QUOTE "L3343"))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE IDNUMBER) (QUOTE 778))
+(PUT (QUOTE ON) (QUOTE ENTRYPOINT) (QUOTE ON))
+(PUT (QUOTE ON) (QUOTE IDNUMBER) (QUOTE 726))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1125"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE INTPLUS2) (QUOTE ENTRYPOINT) (QUOTE "L1426"))
+(PUT (QUOTE TIMC) (QUOTE ENTRYPOINT) (QUOTE TIMC))
+(PUT (QUOTE TIMC) (QUOTE IDNUMBER) (QUOTE 420))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L3499"))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 592))
+(PUT (QUOTE INTQUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1452"))
+(PUT (QUOTE PROG2) (QUOTE ENTRYPOINT) (QUOTE PROG2))
+(PUT (QUOTE PROG2) (QUOTE IDNUMBER) (QUOTE 271))
+(PUT (QUOTE MK!*SQ) (QUOTE IDNUMBER) (QUOTE 748))
+(PUT (QUOTE LIST2SET) (QUOTE ENTRYPOINT) (QUOTE "L1054"))
+(PUT (QUOTE LIST2SET) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE YES) (QUOTE IDNUMBER) (QUOTE 474))
+(PUT (QUOTE REMPROPL) (QUOTE ENTRYPOINT) (QUOTE "L3242"))
+(PUT (QUOTE REMPROPL) (QUOTE IDNUMBER) (QUOTE 764))
+(PUT (QUOTE FLAG1) (QUOTE ENTRYPOINT) (QUOTE FLAG1))
+(PUT (QUOTE FLAG1) (QUOTE IDNUMBER) (QUOTE 760))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L3353"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 514))
+(PUT (QUOTE !*WRITINGFASLFILE) (QUOTE IDNUMBER) (QUOTE 553))
+(PUT (QUOTE DELETIP1) (QUOTE ENTRYPOINT) (QUOTE "L0894"))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1789"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 490))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 518))
+(PUT (QUOTE OFF) (QUOTE ENTRYPOINT) (QUOTE OFF))
+(PUT (QUOTE OFF) (QUOTE IDNUMBER) (QUOTE 727))
+(PUT (QUOTE QEDITFNS) (QUOTE IDNUMBER) (QUOTE 437))
+(FLAG (QUOTE (QEDITFNS)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MARKFROMVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1247"))
+(PUT (QUOTE CHANNELPRIN2T) (QUOTE ENTRYPOINT) (QUOTE "L1045"))
+(PUT (QUOTE CHANNELPRIN2T) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE COLLECT) (QUOTE IDNUMBER) (QUOTE 736))
+(PUT (QUOTE GLOBAL1) (QUOTE ENTRYPOINT) (QUOTE "L3268"))
+(PUT (QUOTE GLOBAL1) (QUOTE IDNUMBER) (QUOTE 770))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 449))
+(PUT (QUOTE CHANNELWRITEBLANKOREOL) (QUOTE ENTRYPOINT) (QUOTE "L2637"))
+(PUT (QUOTE CHANNELWRITEBLANKOREOL) (QUOTE IDNUMBER) (QUOTE 675))
+(PUT (QUOTE !*INNER!*BACKTRACE) (QUOTE IDNUMBER) (QUOTE 494))
+(FLAG (QUOTE (!*INNER!*BACKTRACE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYSTRING) (QUOTE ENTRYPOINT) (QUOTE "L1135"))
+(PUT (QUOTE COPYSTRING) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L3352"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 537))
+(PUT (QUOTE RDTTY) (QUOTE ENTRYPOINT) (QUOTE RDTTY))
+(PUT (QUOTE TOTALCOPY) (QUOTE ENTRYPOINT) (QUOTE "L1149"))
+(PUT (QUOTE TOTALCOPY) (QUOTE IDNUMBER) (QUOTE 410))
+(PUT (QUOTE OPTIONS!*) (QUOTE IDNUMBER) (QUOTE 467))
+(FLAG (QUOTE (OPTIONS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L3192"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 524))
+(PUT (QUOTE SET!-GC!-TRAP!-LEVEL) (QUOTE ENTRYPOINT) (QUOTE "L1107"))
+(PUT (QUOTE SET!-GC!-TRAP!-LEVEL) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE LINELENGTH) (QUOTE ENTRYPOINT) (QUOTE "L2351"))
+(PUT (QUOTE LINELENGTH) (QUOTE IDNUMBER) (QUOTE 621))
+(PUT (QUOTE CHANNELWRITEBITSTRAUX) (QUOTE ENTRYPOINT) (QUOTE "L2594"))
+(PUT (QUOTE CHANNELWRITEBITSTRAUX) (QUOTE IDNUMBER) (QUOTE 662))
+(PUT (QUOTE RANGE) (QUOTE IDNUMBER) (QUOTE 718))
+(PUT (QUOTE PUTENTRY) (QUOTE ENTRYPOINT) (QUOTE "L2189"))
+(PUT (QUOTE PUTENTRY) (QUOTE IDNUMBER) (QUOTE 561))
+(PUT (QUOTE BREAKERRMSG) (QUOTE ENTRYPOINT) (QUOTE "L3582"))
+(PUT (QUOTE BREAKERRMSG) (QUOTE IDNUMBER) (QUOTE 814))
+(PUT (QUOTE CHANNELPRINTSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2603"))
+(PUT (QUOTE CHANNELPRINTSTRING) (QUOTE IDNUMBER) (QUOTE 669))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2903"))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 595))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE INT2ID) (QUOTE ENTRYPOINT) (QUOTE INT2ID))
+(PUT (QUOTE INT2ID) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE INTDIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1435"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L3348"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 513))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE MAX2) (QUOTE ENTRYPOINT) (QUOTE MAX2))
+(PUT (QUOTE MAX2) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE VALUECELLLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2130"))
+(PUT (QUOTE VALUECELLLOCATION) (QUOTE IDNUMBER) (QUOTE 552))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE PRINC) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRINC) (QUOTE IDNUMBER) (QUOTE 628))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L2278"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE MINI) (QUOTE ENTRYPOINT) (QUOTE MINI))
+(PUT (QUOTE MINI) (QUOTE IDNUMBER) (QUOTE 579))
+(PUT (QUOTE EXPLODE2) (QUOTE ENTRYPOINT) (QUOTE "L2901"))
+(PUT (QUOTE EXPLODE2) (QUOTE IDNUMBER) (QUOTE 698))
+(PUT (QUOTE !*TIME) (QUOTE IDNUMBER) (QUOTE 822))
+(FLAG (QUOTE (!*TIME)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L2279"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE PAIR) (QUOTE ENTRYPOINT) (QUOTE PAIR))
+(PUT (QUOTE PAIR) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE REVERSIP) (QUOTE ENTRYPOINT) (QUOTE "L0878"))
+(PUT (QUOTE REVERSIP) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE CHANNELWRITEUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L2615"))
+(PUT (QUOTE CHANNELWRITEUNBOUND) (QUOTE IDNUMBER) (QUOTE 671))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L2136"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 560))
+(PUT (QUOTE LISPBANNER!*) (QUOTE IDNUMBER) (QUOTE 818))
+(PUT (QUOTE LISPBANNER!*) (QUOTE INITIALVALUE) (QUOTE "Portable Standard LISP"))
+(PUT (QUOTE RANGEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1736"))
+(PUT (QUOTE RANGEERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE PENDINGLOADS!*) (QUOTE IDNUMBER) (QUOTE 574))
+(FLAG (QUOTE (PENDINGLOADS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE QUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1451"))
+(PUT (QUOTE QUOTIENT) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE SPACES) (QUOTE ENTRYPOINT) (QUOTE SPACES))
+(PUT (QUOTE SPACES) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0033"))
+(PUT (QUOTE UNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L3376"))
+(PUT (QUOTE UNBOUNDP) (QUOTE IDNUMBER) (QUOTE 765))
+(PUT (QUOTE CHANNELPRINTEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2735"))
+(PUT (QUOTE CHANNELPRINTEVECTOR) (QUOTE IDNUMBER) (QUOTE 687))
+(PUT (QUOTE CATCH) (QUOTE ENTRYPOINT) (QUOTE CATCH))
+(PUT (QUOTE CATCH) (QUOTE IDNUMBER) (QUOTE 498))
+(PUT (QUOTE IDESCAPECHAR!*) (QUOTE IDNUMBER) (QUOTE 658))
+(PUT (QUOTE IDESCAPECHAR!*) (QUOTE INITIALVALUE) (QUOTE 33))
+(PUT (QUOTE CHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L1850"))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 503))
+(PUT (QUOTE WRITESTRING) (QUOTE ENTRYPOINT) (QUOTE "L2580"))
+(PUT (QUOTE WRITESTRING) (QUOTE IDNUMBER) (QUOTE 660))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE !%RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1204"))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE CHANNELREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2285"))
+(PUT (QUOTE CHANNELREADCHAR) (QUOTE IDNUMBER) (QUOTE 597))
+(PUT (QUOTE DELATQIP1) (QUOTE ENTRYPOINT) (QUOTE "L0972"))
+(PUT (QUOTE SPACES2) (QUOTE ENTRYPOINT) (QUOTE TAB))
+(PUT (QUOTE SPACES2) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L3351"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 779))
+(PUT (QUOTE ASSOC) (QUOTE ENTRYPOINT) (QUOTE ASSOC))
+(PUT (QUOTE ASSOC) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE IMPORTS) (QUOTE ENTRYPOINT) (QUOTE "L2227"))
+(PUT (QUOTE IMPORTS) (QUOTE IDNUMBER) (QUOTE 575))
+(PUT (QUOTE EQN) (QUOTE ENTRYPOINT) (QUOTE EQN))
+(PUT (QUOTE EQN) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE DELETIP) (QUOTE ENTRYPOINT) (QUOTE "L0900"))
+(PUT (QUOTE DELETIP) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE FLOATTIMES2) (QUOTE ENTRYPOINT) (QUOTE "L1444"))
+(PUT (QUOTE REPEAT) (QUOTE ENTRYPOINT) (QUOTE REPEAT))
+(PUT (QUOTE REPEAT) (QUOTE IDNUMBER) (QUOTE 745))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE AND) (QUOTE ENTRYPOINT) (QUOTE AND))
+(PUT (QUOTE AND) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE EXPLODEENDPOINTER!*) (QUOTE IDNUMBER) (QUOTE 696))
+(FLAG (QUOTE (EXPLODEENDPOINTER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L3161"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 753))
+(PUT (QUOTE HEAPSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE HEAPSIZE) (QUOTE WCONST) (QUOTE 90000))
+(PUT (QUOTE !&!&THROWN!&!&) (QUOTE IDNUMBER) (QUOTE 529))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2908"))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 591))
+(PUT (QUOTE RECIP) (QUOTE ENTRYPOINT) (QUOTE RECIP))
+(PUT (QUOTE RECIP) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 433))
+(PUT (QUOTE MAXBREAKLEVEL!*) (QUOTE IDNUMBER) (QUOTE 486))
+(PUT (QUOTE MAXBREAKLEVEL!*) (QUOTE INITIALVALUE) (QUOTE 5))
+(PUT (QUOTE DELATQIP) (QUOTE ENTRYPOINT) (QUOTE "L0978"))
+(PUT (QUOTE DELATQIP) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE READCH) (QUOTE ENTRYPOINT) (QUOTE READCH))
+(PUT (QUOTE READCH) (QUOTE IDNUMBER) (QUOTE 627))
+(PUT (QUOTE INITFORMS!*) (QUOTE IDNUMBER) (QUOTE 836))
+(FLAG (QUOTE (INITFORMS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 769))
+(PUT (QUOTE DEC20READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L3495"))
+(PUT (QUOTE DEC20READCHAR) (QUOTE IDNUMBER) (QUOTE 791))
+(PUT (QUOTE TOPLOOP) (QUOTE ENTRYPOINT) (QUOTE "L3604"))
+(PUT (QUOTE TOPLOOP) (QUOTE IDNUMBER) (QUOTE 806))
+(PUT (QUOTE LITER) (QUOTE ENTRYPOINT) (QUOTE LITER))
+(PUT (QUOTE LITER) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE NEXT) (QUOTE ENTRYPOINT) (QUOTE NEXT))
+(PUT (QUOTE NEXT) (QUOTE IDNUMBER) (QUOTE 743))
+(PUT (QUOTE !$EXITTOPLOOP!$) (QUOTE IDNUMBER) (QUOTE 825))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 476))
+(PUT (QUOTE ERROUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1191"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE !*NONIL) (QUOTE IDNUMBER) (QUOTE 824))
+(FLAG (QUOTE (!*NONIL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L2008"))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE IDNUMBER) (QUOTE 528))
+(PUT (QUOTE XINS) (QUOTE ENTRYPOINT) (QUOTE XINS))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L1813"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 492))
+(PUT (QUOTE CHANNELWRITEWORDS) (QUOTE ENTRYPOINT) (QUOTE "L2749"))
+(PUT (QUOTE CHANNELWRITEWORDS) (QUOTE IDNUMBER) (QUOTE 688))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE STACKSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE STACKSIZE) (QUOTE WCONST) (QUOTE 10000))
+(PUT (QUOTE DEFLIST) (QUOTE ENTRYPOINT) (QUOTE "L0782"))
+(PUT (QUOTE DEFLIST) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE CHANNELTYO) (QUOTE ENTRYPOINT) (QUOTE "L2918"))
+(PUT (QUOTE CHANNELTYO) (QUOTE IDNUMBER) (QUOTE 706))
+(PUT (QUOTE CHANNELREADLINE) (QUOTE ENTRYPOINT) (QUOTE "L2568"))
+(PUT (QUOTE CHANNELREADLINE) (QUOTE IDNUMBER) (QUOTE 656))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1903"))
+(PUT (QUOTE SUB) (QUOTE ENTRYPOINT) (QUOTE SUB))
+(PUT (QUOTE SUB) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1884"))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE CHANNELSPACES2) (QUOTE ENTRYPOINT) (QUOTE "L1050"))
+(PUT (QUOTE CHANNELSPACES2) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE BREAKIN!*) (QUOTE IDNUMBER) (QUOTE 798))
+(FLAG (QUOTE (BREAKIN!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L2281"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE VECTOR2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0049"))
+(PUT (QUOTE VECTOR2STRING) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE CHANNELREADEOF) (QUOTE ENTRYPOINT) (QUOTE "L2364"))
+(PUT (QUOTE CHANNELREADEOF) (QUOTE IDNUMBER) (QUOTE 640))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L1117"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE FIXP) (QUOTE ENTRYPOINT) (QUOTE FIXP))
+(PUT (QUOTE FIXP) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE ADJOIN) (QUOTE ENTRYPOINT) (QUOTE ADJOIN))
+(PUT (QUOTE ADJOIN) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE CHANNELREADLISTORDOTTEDPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2370"))
+(PUT (QUOTE CHANNELREADLISTORDOTTEDPAIR) (QUOTE IDNUMBER) (QUOTE 643))
+(PUT (QUOTE EXPAND) (QUOTE ENTRYPOINT) (QUOTE EXPAND))
+(PUT (QUOTE EXPAND) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE HALFWORDSEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0478"))
+(PUT (QUOTE MAKEFIXNUM) (QUOTE ENTRYPOINT) (QUOTE "L1418"))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0332"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE CHANNELTERPRI) (QUOTE ENTRYPOINT) (QUOTE "L2356"))
+(PUT (QUOTE CHANNELTERPRI) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE LASTCAR) (QUOTE ENTRYPOINT) (QUOTE "L0996"))
+(PUT (QUOTE LASTCAR) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE INTERNP) (QUOTE ENTRYPOINT) (QUOTE "L3451"))
+(PUT (QUOTE INTERNP) (QUOTE IDNUMBER) (QUOTE 784))
+(PUT (QUOTE UPDATEALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1209"))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0635"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE !*BREAK) (QUOTE IDNUMBER) (QUOTE 484))
+(PUT (QUOTE !*BREAK) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE THROWTAG!*) (QUOTE IDNUMBER) (QUOTE 526))
+(FLAG (QUOTE (THROWTAG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EXPT) (QUOTE ENTRYPOINT) (QUOTE EXPT))
+(PUT (QUOTE EXPT) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE EVOR) (QUOTE ENTRYPOINT) (QUOTE EVOR))
+(PUT (QUOTE EVOR) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE MAPCAN) (QUOTE ENTRYPOINT) (QUOTE MAPCAN))
+(PUT (QUOTE MAPCAN) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE LAND) (QUOTE ENTRYPOINT) (QUOTE LAND))
+(PUT (QUOTE LAND) (QUOTE IDNUMBER) (QUOTE 424))
+(PUT (QUOTE LSH) (QUOTE ENTRYPOINT) (QUOTE LSHIFT))
+(PUT (QUOTE LSH) (QUOTE IDNUMBER) (QUOTE 428))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE COMPILETIME) (QUOTE ENTRYPOINT) (QUOTE "L2920"))
+(PUT (QUOTE COMPILETIME) (QUOTE IDNUMBER) (QUOTE 710))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE PAGEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE PAGEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L2280"))
+(PUT (QUOTE PAGEPOSITION) (QUOTE WARRAY) (QUOTE PAGEPOSITION))
+(PUT (QUOTE STEP) (QUOTE ENTRYPOINT) (QUOTE STEP))
+(PUT (QUOTE STEP) (QUOTE IDNUMBER) (QUOTE 578))
+(PUT (QUOTE DEFCONST) (QUOTE ENTRYPOINT) (QUOTE "L3041"))
+(PUT (QUOTE DEFCONST) (QUOTE IDNUMBER) (QUOTE 730))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 522))
+(PUT (QUOTE GCTIME!*) (QUOTE IDNUMBER) (QUOTE 416))
+(PUT (QUOTE GCTIME!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 653))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1434"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE BPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BPS) (QUOTE ASMSYMBOL) (QUOTE BPS))
+(PUT (QUOTE BPS) (QUOTE WARRAY) (QUOTE BPS))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2301"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 468))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1810"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE EQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0449"))
+(PUT (QUOTE EQUAL) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 648))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2277"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE FINDCATCHMARKANDTHROW) (QUOTE ENTRYPOINT) (QUOTE "L2053"))
+(PUT (QUOTE NO) (QUOTE IDNUMBER) (QUOTE 473))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE INTLAND) (QUOTE ENTRYPOINT) (QUOTE "L1482"))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE MAKEUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L3381"))
+(PUT (QUOTE MAKEUNBOUND) (QUOTE IDNUMBER) (QUOTE 781))
+(PUT (QUOTE RPLACEALL) (QUOTE ENTRYPOINT) (QUOTE "L1638"))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1841"))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 505))
+(PUT (QUOTE CATCHSETUPAUX) (QUOTE ENTRYPOINT) (QUOTE "L2040"))
+(PUT (QUOTE GCKNT!*) (QUOTE IDNUMBER) (QUOTE 417))
+(PUT (QUOTE GCKNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE INTHISCASE) (QUOTE ENTRYPOINT) (QUOTE "L2948"))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE BREAKEVAL!*) (QUOTE IDNUMBER) (QUOTE 802))
+(FLAG (QUOTE (BREAKEVAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE ENTRYPOINT) (QUOTE "L2919"))
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE IDNUMBER) (QUOTE 709))
+(PUT (QUOTE HEAP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAP) (QUOTE ASMSYMBOL) (QUOTE HEAP))
+(PUT (QUOTE HEAP) (QUOTE WARRAY) (QUOTE HEAP))
+(PUT (QUOTE COPYWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1136"))
+(PUT (QUOTE COPYWARRAY) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE INTTIMES2) (QUOTE ENTRYPOINT) (QUOTE "L1443"))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE LIST2VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0075"))
+(PUT (QUOTE LIST2VECTOR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE SUBST) (QUOTE ENTRYPOINT) (QUOTE SUBST))
+(PUT (QUOTE SUBST) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE DECLAREFLUIDORGLOBAL1) (QUOTE ENTRYPOINT) (QUOTE "L3251"))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L3357"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 517))
+(PUT (QUOTE BREAKRETRY) (QUOTE ENTRYPOINT) (QUOTE "L3574"))
+(PUT (QUOTE BREAKRETRY) (QUOTE IDNUMBER) (QUOTE 812))
+(PUT (QUOTE !*COMPRESSING) (QUOTE IDNUMBER) (QUOTE 646))
+(FLAG (QUOTE (!*COMPRESSING)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE XN) (QUOTE ENTRYPOINT) (QUOTE XN))
+(PUT (QUOTE XN) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE LOR) (QUOTE ENTRYPOINT) (QUOTE LOR))
+(PUT (QUOTE LOR) (QUOTE IDNUMBER) (QUOTE 425))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L1783"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0804"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE WRITEFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2845"))
+(PUT (QUOTE WRITEFLOAT) (QUOTE IDNUMBER) (QUOTE 667))
+(PUT (QUOTE ONOFF!*) (QUOTE ENTRYPOINT) (QUOTE "L2976"))
+(PUT (QUOTE ONOFF!*) (QUOTE IDNUMBER) (QUOTE 723))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L3146"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 751))
+(PUT (QUOTE FLATSIZE2) (QUOTE ENTRYPOINT) (QUOTE "L2905"))
+(PUT (QUOTE FLATSIZE2) (QUOTE IDNUMBER) (QUOTE 699))
+(PUT (QUOTE PROGJUMPTABLE!*) (QUOTE IDNUMBER) (QUOTE 540))
+(FLAG (QUOTE (PROGJUMPTABLE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE NONINTEGER1ERROR) (QUOTE ENTRYPOINT) (QUOTE "L1394"))
+(PUT (QUOTE RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1199"))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0821"))
+(PUT (QUOTE FUNCTION) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE NUMBERP) (QUOTE ENTRYPOINT) (QUOTE "L0642"))
+(PUT (QUOTE NUMBERP) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE TOPLOOPREAD!*) (QUOTE IDNUMBER) (QUOTE 805))
+(FLAG (QUOTE (TOPLOOPREAD!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BREAKCONTINUE) (QUOTE ENTRYPOINT) (QUOTE "L3570"))
+(PUT (QUOTE BREAKCONTINUE) (QUOTE IDNUMBER) (QUOTE 811))
+(PUT (QUOTE CONCAT) (QUOTE ENTRYPOINT) (QUOTE CONCAT))
+(PUT (QUOTE CONCAT) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE SETMACROREFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L3003"))
+(PUT (QUOTE !*SEMICOL!*) (QUOTE IDNUMBER) (QUOTE 480))
+(PUT (QUOTE INTONEP) (QUOTE ENTRYPOINT) (QUOTE "L1575"))
+(PUT (QUOTE COPY) (QUOTE ENTRYPOINT) (QUOTE COPY))
+(PUT (QUOTE COPY) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE EDITF) (QUOTE ENTRYPOINT) (QUOTE EDITF))
+(PUT (QUOTE EDITF) (QUOTE IDNUMBER) (QUOTE 440))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L1786"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE CHANNELEJECT) (QUOTE ENTRYPOINT) (QUOTE "L2343"))
+(PUT (QUOTE CHANNELEJECT) (QUOTE IDNUMBER) (QUOTE 618))
+(PUT (QUOTE SUBLA) (QUOTE ENTRYPOINT) (QUOTE SUBLA))
+(PUT (QUOTE SUBLA) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 615))
+(PUT (QUOTE STDIN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE FASTUNBIND) (QUOTE ENTRYPOINT) (QUOTE "L3370"))
+(PUT (QUOTE FASTUNBIND) (QUOTE IDNUMBER) (QUOTE 448))
+(PUT (QUOTE RASSOC) (QUOTE ENTRYPOINT) (QUOTE RASSOC))
+(PUT (QUOTE RASSOC) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE STATICINTFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L1386"))
+(PUT (QUOTE PRINTWITHFRESHLINE) (QUOTE ENTRYPOINT) (QUOTE "L3653"))
+(PUT (QUOTE PRINTWITHFRESHLINE) (QUOTE IDNUMBER) (QUOTE 834))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 610))
+(PUT (QUOTE EVLOAD) (QUOTE ENTRYPOINT) (QUOTE EVLOAD))
+(PUT (QUOTE EVLOAD) (QUOTE IDNUMBER) (QUOTE 435))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE CATCH!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1996"))
+(PUT (QUOTE CATCH!-ALL) (QUOTE IDNUMBER) (QUOTE 527))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE ENTRYPOINT) (QUOTE "L1835"))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 502))
+(PUT (QUOTE SETINDX) (QUOTE ENTRYPOINT) (QUOTE "L0159"))
+(PUT (QUOTE SETINDX) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE ENTRYPOINT) (QUOTE "L3540"))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 604))
+(PUT (QUOTE ADDTOOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3402"))
+(PUT (QUOTE ADJOINQ) (QUOTE ENTRYPOINT) (QUOTE "L1066"))
+(PUT (QUOTE ADJOINQ) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE MAKEBUFINTOFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2425"))
+(PUT (QUOTE CATCHSETUP) (QUOTE ENTRYPOINT) (QUOTE "L2039"))
+(PUT (QUOTE CATCHSETUP) (QUOTE IDNUMBER) (QUOTE 499))
+(PUT (QUOTE BREAKQUIT) (QUOTE ENTRYPOINT) (QUOTE "L3569"))
+(PUT (QUOTE BREAKQUIT) (QUOTE IDNUMBER) (QUOTE 810))
+(PUT (QUOTE CONTOPENERROR) (QUOTE ENTRYPOINT) (QUOTE "L3536"))
+(PUT (QUOTE GENSYM1) (QUOTE ENTRYPOINT) (QUOTE "L3460"))
+(PUT (QUOTE FORMATFORPRINTF!*) (QUOTE IDNUMBER) (QUOTE 692))
+(FLAG (QUOTE (FORMATFORPRINTF!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DIGITTONUMBER) (QUOTE ENTRYPOINT) (QUOTE "L2534"))
+(PUT (QUOTE DIGITTONUMBER) (QUOTE IDNUMBER) (QUOTE 650))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 520))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L3167"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 754))
+(PUT (QUOTE GLOBALINSTALL) (QUOTE ENTRYPOINT) (QUOTE "L3483"))
+(PUT (QUOTE GLOBALINSTALL) (QUOTE IDNUMBER) (QUOTE 788))
+(PUT (QUOTE CHANNELPRIN) (QUOTE IDNUMBER) (QUOTE 686))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE DISPLAYHELPFILE) (QUOTE IDNUMBER) (QUOTE 457))
+(PUT (QUOTE !$LOOP!$) (QUOTE IDNUMBER) (QUOTE 742))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L3271"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 771))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1192"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE MAKESTRINGINTOLISPINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2536"))
+(PUT (QUOTE MAKESTRINGINTOLISPINTEGER) (QUOTE IDNUMBER) (QUOTE 649))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L2107"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 602))
+(PUT (QUOTE UPDATEHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1296"))
+(PUT (QUOTE RETURN) (QUOTE ENTRYPOINT) (QUOTE RETURN))
+(PUT (QUOTE RETURN) (QUOTE IDNUMBER) (QUOTE 545))
+(PUT (QUOTE BINARYOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L2128"))
+(PUT (QUOTE BINARYOPENWRITE) (QUOTE IDNUMBER) (QUOTE 551))
+(PUT (QUOTE ONEARGDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1396"))
+(PUT (QUOTE INTLOR) (QUOTE ENTRYPOINT) (QUOTE INTLOR))
+(PUT (QUOTE ONEARGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1405"))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE ENTRYPOINT) (QUOTE "L1207"))
+(PUT (QUOTE CHANNELPRINC) (QUOTE ENTRYPOINT) (QUOTE "L2357"))
+(PUT (QUOTE CHANNELPRINC) (QUOTE IDNUMBER) (QUOTE 629))
+(PUT (QUOTE RECURSIVECHANNELPRIN1) (QUOTE ENTRYPOINT) (QUOTE "L2824"))
+(PUT (QUOTE RECURSIVECHANNELPRIN1) (QUOTE IDNUMBER) (QUOTE 681))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE REMFLAG1) (QUOTE ENTRYPOINT) (QUOTE "L3225"))
+(PUT (QUOTE REMFLAG1) (QUOTE IDNUMBER) (QUOTE 762))
+(PUT (QUOTE !*CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 482))
+(FLAG (QUOTE (!*CONTINUABLEERROR)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE VECTOREQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0466"))
+(PUT (QUOTE INTERSECTION) (QUOTE ENTRYPOINT) (QUOTE XN))
+(PUT (QUOTE INTERSECTION) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE MAKEINPUTAVAILABLE) (QUOTE ENTRYPOINT) (QUOTE "L2573"))
+(PUT (QUOTE MAKEINPUTAVAILABLE) (QUOTE IDNUMBER) (QUOTE 638))
+(PUT (QUOTE EVAND1) (QUOTE ENTRYPOINT) (QUOTE EVAND1))
+(PUT (QUOTE RPLACW) (QUOTE ENTRYPOINT) (QUOTE RPLACW))
+(PUT (QUOTE RPLACW) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE FINDFIRST) (QUOTE ENTRYPOINT) (QUOTE "L1640"))
+(PUT (QUOTE DEC20OPEN) (QUOTE ENTRYPOINT) (QUOTE "L3534"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 550))
+(PUT (QUOTE MKEVECT) (QUOTE IDNUMBER) (QUOTE 413))
+(PUT (QUOTE COMPACTHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1210"))
+(PUT (QUOTE CHANNELWRITEBITSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2586"))
+(PUT (QUOTE QUIT) (QUOTE ENTRYPOINT) (QUOTE QUIT))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 421))
+(PUT (QUOTE TRST) (QUOTE ENTRYPOINT) (QUOTE TRST))
+(PUT (QUOTE TRST) (QUOTE IDNUMBER) (QUOTE 436))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE FILEP) (QUOTE ENTRYPOINT) (QUOTE FILEP))
+(PUT (QUOTE FILEP) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE FLOATPLUS2) (QUOTE ENTRYPOINT) (QUOTE "L1427"))
+(PUT (QUOTE CHANNELWRITESYSFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2600"))
+(PUT (QUOTE CHANNELWRITESYSFLOAT) (QUOTE IDNUMBER) (QUOTE 666))
+(PUT (QUOTE !#ARG) (QUOTE IDNUMBER) (QUOTE 728))
+(PUT (QUOTE MAP2) (QUOTE ENTRYPOINT) (QUOTE MAP2))
+(PUT (QUOTE MAP2) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE EDIT) (QUOTE ENTRYPOINT) (QUOTE EDIT))
+(PUT (QUOTE EDIT) (QUOTE IDNUMBER) (QUOTE 441))
+(PUT (QUOTE STRING) (QUOTE ENTRYPOINT) (QUOTE STRING))
+(PUT (QUOTE STRING) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE RECURSIVECHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L2796"))
+(PUT (QUOTE RECURSIVECHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 679))
+(PUT (QUOTE MARKFROMONESYMBOL) (QUOTE ENTRYPOINT) (QUOTE "L1223"))
+(PUT (QUOTE OK) (QUOTE IDNUMBER) (QUOTE 456))
+(PUT (QUOTE POSN) (QUOTE ENTRYPOINT) (QUOTE POSN))
+(PUT (QUOTE POSN) (QUOTE IDNUMBER) (QUOTE 622))
ADDED psl-1983/20-kernel/all-kernel.ctl
Index: psl-1983/20-kernel/all-kernel.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/all-kernel.ctl
@@ -0,0 +1,16 @@
+submit types.ctl
+submit randm.ctl
+submit alloc.ctl
+submit arith.ctl
+submit debg.ctl
+submit error.ctl
+submit eval.ctl
+submit extra.ctl
+submit fasl.ctl
+submit io.ctl
+submit macro.ctl
+submit prop.ctl
+submit symbl.ctl
+submit sysio.ctl
+submit tloop.ctl
+submit heap.ctl
ADDED psl-1983/20-kernel/all-kernel.log
Index: psl-1983/20-kernel/all-kernel.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/all-kernel.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/alloc.ctl
Index: psl-1983/20-kernel/alloc.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/alloc.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "alloc";
+in "alloc.build";
+ASMEnd;
+quit;
+compile alloc.mac, dalloc.mac
+delete alloc.mac, dalloc.mac
ADDED psl-1983/20-kernel/alloc.init
Index: psl-1983/20-kernel/alloc.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/alloc.init
@@ -0,0 +1,1 @@
+(FLUID (QUOTE (!*GC GCTIME!* GCKNT!* HEAP!-WARN!-LEVEL)))
ADDED psl-1983/20-kernel/alloc.log
Index: psl-1983/20-kernel/alloc.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/alloc.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/alloc.rel
Index: psl-1983/20-kernel/alloc.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/alloc.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/apply-lap.red
Index: psl-1983/20-kernel/apply-lap.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/apply-lap.red
@@ -0,0 +1,347 @@
+%
+% APPLY-LAP.RED - LAP support for EVAL and APPLY
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.NEW>APPLY-LAP.RED.2, 9-Dec-82 18:13:02, Edit by PERDUE
+% Modified UndefinedFunction to make it continuable
+
+CompileTime flag('(FastLambdaApply), 'InternalFunction);
+
+on SysLisp;
+
+external WVar BndStkPtr, BndStkUpperBound;
+
+% TAG( CodeApply )
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure CodeApply(CodePtr, ArgList);
+% begin scalar N;
+% N := 0;
+% while PairP ArgList do
+% << N := N + 1;
+% ArgumentRegister[N] := car ArgList;
+% ArgList := cdr ArgList >>;
+% (jump to address of code pointer)
+% end;
+
+lap '((!*entry CodeApply expr 2) %. CodeApply(CodePointer, ArgList)
+%
+% r1 is code pointer, r2 is list of arguments
+%
+ (!*MOVE (reg 1) (reg t1))
+ (!*MOVE (reg 2) (reg t2))
+ (!*MOVE (WConst 1) (reg t3))
+Loop
+ (!*JUMPNOTTYPE (MEMORY (REG T1) (WConst 0)) (reg t2) PAIR)
+ % jump to code if list is exhauseted
+ (!*MOVE (CAR (reg t2)) (reg t4))
+ (!*MOVE (reg t4) (MEMORY (reg t3) 0)) % load argument register
+ (!*MOVE (CDR (reg t2)) (reg t2))
+ (!*WPLUS2 (reg t3) (WConst 1)) % increment register pointer
+ (cain (reg t3) (plus2 (WConst MaxRealRegs) 1)) % skip if neq MaxRegs+1
+ (!*MOVE (WConst ArgumentBlock) (reg t3)) % else switch to extra args
+ (!*JUMPWLEQ (Label Loop)
+ (reg t3)
+ (WConst (plus2 9 (WConst ArgumentBlock))))
+ (!*MOVE (QUOTE "Too many arguments to function") (reg 1))
+ (!*JCALL StdError)
+);
+
+% TAG( CodeEvalApply )
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure CodeEvalApply(CodePtr, ArgList);
+% begin scalar N;
+% N := 0;
+% while PairP ArgList do
+% << N := N + 1;
+% ArgumentRegister[N] := Eval car ArgList;
+% ArgList := cdr ArgList >>;
+% (jump to address of code pointer)
+% end;
+
+lap '((!*entry CodeEvalApply expr 2) %. CodeApply(CodePointer, EvLis Args)
+%
+% r1 is code pointer, r2 is list of arguments to be evaled
+%
+ (!*PUSH (reg 1)) % code pointer goes on the bottom
+ (!*PUSH (WConst 0)) % then arg count
+Loop % if it's not a pair, then we're done
+ (!*JUMPNOTTYPE (Label Done) (reg 2) PAIR)
+ (!*JUMPWLESSP (Label ArgOverflow) (frame 1) (WConst -15))
+ (!*MOVE (CAR (reg 2)) (reg 1))
+ (!*MOVE (CDR (reg 2)) (reg 2))
+ (!*PUSH (reg 2)) % save the cdr
+ (!*CALL Eval) % eval the car
+ (!*POP (reg 2)) % grab the list in r2 again
+ (!*POP (reg 3)) % get count in r3
+ (!*WDIFFERENCE (reg 3) (WConst 1)) % decrement count
+ (!*PUSH (reg 1)) % push the evaled arg
+ (!*PUSH (reg 3)) % and the decremented count
+ (!*JUMP (Label Loop))
+Done
+ (!*POP (reg 3)) % count in r3, == -no. of args to pop
+ (!*JUMP (MEMORY (reg 3) (Label ZeroArgs))) % indexed jump
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 9)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 8)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 7)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 6)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 5)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 4)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 3)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 2)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 1)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 0)) (WConst 0)))
+ (!*POP (reg 5))
+ (!*POP (reg 4))
+ (!*POP (reg 3))
+ (!*POP (reg 2))
+ (!*POP (reg 1))
+ZeroArgs
+ (!*POP (reg t1)) % code pointer in (reg t1)
+ (!*JUMP (MEMORY (reg t1) (WConst 0))) % jump to address
+ArgOverflow
+ (!*MOVE (QUOTE "Too many arguments to function") (reg 1))
+ (!*JCALL StdError)
+);
+
+% TAG( BindEval )
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure BindEval(Formals, Args);
+% begin scalar N;
+% N := 0;
+% while PairP Args and PairP Formals do
+% << N := N + 1;
+% Push Eval car ArgList;
+% Push car Formals;
+% ArgList := cdr ArgList >>;
+% if PairP Args or PairP Formals then return -1;
+% for I := 1 step 1 until N do
+% LBind1(Pop(), Pop());
+% return N;
+% end;
+
+lap '((!*entry BindEval expr 2) %. BindEval(FormalsList, ArgsToBeEvaledList);
+%
+% r1 is list of formals, r2 is list of arguments to be evaled
+%
+ (!*PUSH (WConst 0)) % count on the bottom
+ (!*MOVE (WConst 0) (reg 4))
+ (!*MOVE (reg 1) (reg 3)) % shift arg1 to r3
+EvalLoop % if it's not a pair, then we're done
+ (!*JUMPNOTTYPE (Label DoneEval) (reg 2) PAIR)
+ (!*MOVE (CAR (reg 2)) (reg 1))
+ (!*MOVE (CDR (reg 2)) (reg 2))
+ (!*PUSH (reg 3)) % save the formals
+ (!*PUSH (reg 2)) % save the rest of args
+ (!*CALL Eval) % eval the car
+ (!*POP (reg 2)) % save then rest of arglist
+ (!*POP (reg 3)) % and the rest of formals
+ (!*POP (reg 4)) % and the count
+ (!*JUMPNOTTYPE (Label ReturnError) (reg 3) PAIR)
+ % if it's not a pair, then error
+ (!*WPLUS2 (reg 4) (WConst 1)) % increment the count
+ (!*MOVE (CAR (reg 3)) (reg 5))
+ (!*MOVE (CDR (reg 3)) (reg 3))
+ (!*PUSH (reg 1)) % push the evaluated argument
+ (!*PUSH (reg 5)) % and next formal
+ (!*PUSH (reg 4)) % and new count
+ (!*JUMP (Label EvalLoop))
+ReturnError
+ (!*WSHIFT (reg 4) (WConst 1)) % multiply count by 2
+ (hrl (reg 4) (reg 4)) % in both halves
+ (sub (reg st) (reg 4)) % move the stack ptr back
+ (!*MOVE (WConst -1) (reg 1)) % return -1 as error indicator
+ (!*EXIT 0)
+DoneEval
+ (!*DEALLOC 1) % removed saved values at top of stack
+ (!*JUMPTYPE (Label ReturnError) (reg 3) PAIR) % if more formals, error
+ (!*MOVE (reg 4) (reg 3)) % r3 gets decremented, r4 saved for return
+BindLoop
+ (!*JUMPEQ (Label NormalReturn) (reg 3) (WConst 0))
+ % if count is zero, then return
+ (!*POP (reg 1)) % pop ID to bind
+ (!*POP (reg 2)) % and value
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 4))
+ (!*CALL LBind1)
+ (!*POP (reg 4))
+ (!*POP (reg 3))
+ (soja (reg 3) BindLoop)
+NormalReturn
+ (!*MOVE (reg 4) (reg 1)) % return count
+ (!*EXIT 0)
+);
+
+% TAG( CompiledCallingInterpreted )
+
+% This is pretty gross, but it is essentially the same as LambdaApply, taking
+% values from the argument registers instead of a list.
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure CompiledCallingInterpreted IDOfFunction;
+% begin scalar LForm, LArgs, N, Result;
+% LForm := get(IDOfFunction, '!*LambdaLink);
+% LArgs := cadr LForm;
+% LForm := cddr LForm;
+% N := 1;
+% while PairP LArgs do
+% << LBind1(car LArgs, ArgumentRegister[N];
+% LArgs := cdr LArgs;
+% N := N + 1 >>;
+% Result := EvProgN LForm;
+% UnBindN(N - 1);
+% return Result;
+% end;
+
+lap '((!*entry CompiledCallingInterpreted expr 0) %. link for lambda
+%
+% called by JSP T5, from function cell
+%
+ (!*MOVE (reg t5) (reg t1))
+ (!*WDIFFERENCE (reg t1) (WConst (plus2 (WConst SymFnc) 1)))
+ (!*MKITEM (reg t1) (WConst BtrTag))
+ (!*PUSH (reg t1)) % make stack mark for btrace
+ (!*MOVE (MEMORY (reg t1) (WConst SymPrp)) (reg t1)) % load prop list
+LoopFindProp
+ (!*JUMPNOTTYPE (Label PropNotFound) (reg t1) PAIR)
+ (!*MOVE (CAR (reg t1)) (reg t2)) % get car of prop list
+ (!*MOVE (CDR (reg t1)) (reg t1)) % cdr down
+ (!*JUMPNOTTYPE (Label LoopFindProp) (reg t2) PAIR)
+ (!*MOVE (CAR (reg t2)) (reg t3)) % its a pair, look at car
+ (!*JUMPNOTEQ (Label LoopFindProp) (reg t3) '!*LambdaLink)
+ (!*MOVE (CDR (reg t2)) (reg t2)) % yes, get lambda form
+ (!*entry FastLambdaApply expr 0) % called from FastApply
+ (!*MOVE (CDR (reg t2)) (reg t2)) % get cdr of lambda form
+ (!*MOVE (CDR (reg t2)) (reg t1)) % save cddr in (reg t1)
+ (!*MOVE (CAR (reg t2)) (reg t2)) % cadr of lambda == arg list
+ (!*MOVE (WConst 1) (reg t3)) % pointer to arg register in t3
+ (!*MOVE (WVar BndStkPtr) (reg t4)) % binding stack pointer in t4
+ (!*PUSH (reg t4)) % save it on the stack
+LoopBindingFormals
+ (!*JUMPNOTTYPE (Label DoneBindingFormals) (reg t2) PAIR)
+ (!*WPLUS2 (reg t4) (WConst 2)) % adjust binding stack pointer up 2
+ (caml (reg t4) (WVar BndStkUpperBound)) % if overflow occured
+ (!*JCALL BStackOverflow) % then error
+ (!*MOVE (CAR (reg t2)) (reg t5)) % get formal in t5
+ (hrrzm (reg t5) (Indexed (reg t4) -1)) % store ID number in BndStk
+ (!*MOVE (MEMORY (reg t5) (WArray SymVal)) (reg t6)) % get old value
+ (!*MOVE (reg t6) (MEMORY (reg t4) (WConst 0))) % store value in BndStk
+ (!*MOVE (MEMORY (reg t3) (WConst 0)) (reg t6)) % get reg value in t6
+ (!*MOVE (reg t6) (MEMORY (reg t5) (WConst SymVal))) % put in value cell
+ (!*MOVE (CDR (reg t2)) (reg t2)) % cdr down argument list
+ (!*WPLUS2 (reg t3) (WConst 1)) % increment register pointer
+ (cain (reg t3) (plus2 (WConst MaxRealRegs) 1)) % Go to extra args?
+ (movei (reg t3) (WArray ArgumentBlock)) % Yes
+ (!*JUMP (Label LoopBindingFormals)) % No
+DoneBindingFormals
+ (!*MOVE (reg t4) (WVar BndStkPtr)) % store binding stack
+ (!*MOVE (reg t1) (reg 1)) % get cddr of lambda form to eval
+ (!*CALL EvProgN) % implicit progn
+ (exch (reg 1) (Indexed (reg st) 0)) % save result, get old bind stk ptr
+ (!*CALL RestoreEnvironment)
+ (!*POP (reg 1)) % restore old bindings and pickup value
+ (!*EXIT 1) % throw away backtrace mark and return
+PropNotFound
+ (!*MOVE (QUOTE
+"Internal error in function calling mechanism; consult a wizard") (reg 1))
+ (!*JCALL StdError)
+);
+
+
+% TAG( FastApply )
+
+lap '((!*entry FastApply expr 0) %. Apply with arguments loaded
+%
+% Called with arguments in the registers and functional form in (reg t1)
+%
+ (!*FIELD (reg t2) (reg t1)
+ (WConst TagStartingBit)
+ (WConst TagBitLength))
+ (!*JUMPEQ (MEMORY (reg t1) (WConst SymFnc)) (reg t2) (WConst ID))
+ (!*JUMPEQ (MEMORY (reg t1) (WConst 0)) (reg t2) (WConst CODE))
+ (!*JUMPNOTEQ (Label IllegalFunctionalForm) (reg t2) (WConst PAIR))
+ (!*MOVE (CAR (reg t1)) (reg t2))
+ (!*JUMPNOTEQ IllegalFunctionalForm (reg t2) (QUOTE LAMBDA))
+ (!*MOVE (reg t1) (reg t2)) % put lambda form in (reg t2)
+ (!*PUSH '()) % align stack
+ (!*JCALL FastLambdaApply)
+IllegalFunctionalForm
+ (!*MOVE (QUOTE "Illegal functional form %r in Apply") (reg 1))
+ (!*MOVE (reg t1) (reg 2))
+ (!*CALL BldMsg)
+ (!*JCALL StdError)
+);
+
+% TAG( UndefinedFunction )
+
+lap '((!*entry UndefinedFunction expr 0) %. Error Handler for non code
+%
+% also called by JSP T5,
+%
+ (!*WDIFFERENCE (reg t5) (wconst 1))
+ % T5 now points to the function entry slot of the atom that
+ % is undefined as a function.
+ % We will push the entry address onto the stack and transfer
+ % to it by a POPJ at the end of this routine.
+ (!*PUSH (reg t5))
+ (!*PUSH (reg 1)) % Save all the regs (including fakes) (args)
+ (!*PUSH (reg 2))
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 4))
+ (!*PUSH (reg 5))
+ (!*PUSH (reg 6))
+ (!*PUSH (reg 7))
+ (!*PUSH (reg 8))
+ (!*PUSH (reg 9))
+ (!*PUSH (reg 10))
+ (!*PUSH (reg 11))
+ (!*PUSH (reg 12))
+ (!*PUSH (reg 13))
+ (!*PUSH (reg 14))
+ (!*PUSH (reg 15))
+
+ (!*WDIFFERENCE (reg t5) (WConst SymFnc))
+ (!*MKITEM (reg t5) (WConst ID))
+ (!*MOVE (reg t5) (reg 2))
+ (!*MOVE (QUOTE "Undefined function %r called from compiled code")
+ (reg 1))
+ (!*CALL BldMsg)
+ (!*MOVE (reg 1) (reg 2))
+ (!*MOVE (WConst 0) (reg 1))
+ (!*MOVE (reg NIL) (reg 3))
+ (!*CALL ContinuableError)
+
+ (!*POP (reg 15)) % Restore all those possible arguments
+ (!*POP (reg 14))
+ (!*POP (reg 13))
+ (!*POP (reg 12))
+ (!*POP (reg 11))
+ (!*POP (reg 10))
+ (!*POP (reg 9))
+ (!*POP (reg 8))
+ (!*POP (reg 7))
+ (!*POP (reg 6))
+ (!*POP (reg 5))
+ (!*POP (reg 4))
+ (!*POP (reg 3))
+ (!*POP (reg 2))
+ (!*POP (reg 1))
+ (!*EXIT 0)
+);
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/arith.ctl
Index: psl-1983/20-kernel/arith.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/arith.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "arith";
+in "arith.build";
+ASMEnd;
+quit;
+compile arith.mac, darith.mac
+delete arith.mac, darith.mac
ADDED psl-1983/20-kernel/arith.init
Index: psl-1983/20-kernel/arith.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/arith.init
ADDED psl-1983/20-kernel/arith.log
Index: psl-1983/20-kernel/arith.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/arith.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/arith.rel
Index: psl-1983/20-kernel/arith.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/arith.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/bare-psl.sym
Index: psl-1983/20-kernel/bare-psl.sym
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/bare-psl.sym
@@ -0,0 +1,4 @@
+(setq OrderedIDList!* (NCons NIL))
+(setq UncompiledExpressions!* (NCons NIL))
+(setq ToBeCompiledExpressions!* (NCons NIL))
+(setq NextIDNumber!* 129)
ADDED psl-1983/20-kernel/cvtmail.:ej
Index: psl-1983/20-kernel/cvtmail.:ej
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/cvtmail.:ej
cannot compute difference between binary files
ADDED psl-1983/20-kernel/cvtmail.emacs
Index: psl-1983/20-kernel/cvtmail.emacs
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/cvtmail.emacs
@@ -0,0 +1,88 @@
+!~Filename~:! !For dealing with PSL bug reports.!
+CVTMAIL
+
+!Cut Header:! !C Removes unwanted fields from a mail header.
+One must already be positioned at the start of a mail header.
+Cursor is left at the beginning of the next mail header.!
+[1 [2
+k
+.u1
+-l .,.+9:fb------- !* Kill preceding mail trailer, if any!
+"L -l ki
+'"# q1j'
+MM&_Fix_Mail-From
+l !* Skip initial date line!
+!loop! !* Kill uninteresting header lines!
+.u1 l .-q1-2"E Odone'
+q1j
+.,.+6:fbFrom:_ "LOmatch'
+.,.+9:fbSubject:_ "LOmatch'
+.,.+7:fbClass:_ "LOmatch'
+k Oloop
+!match!
+l Oloop
+!done!
+MM^R_Set/Pop_Mark
+<MM&_Header? !* Find a mail header line!
+ q0"E l'"# 1;' !* Exit loop if found!
+>
+-l
+2MM^R_Indent_Rigidly !* Indent the body of the message!
+l
+
+
+!& Header?:! !C -1 if current line is header line else 0.!
+.u0 0l
+z-.-24 :"G Onomatch'
+3a- - "N Onomatch'
+7a- - "N Onomatch'
+13a- : "N Onomatch'
+16a- : "N Onomatch'
+19a- - "N Onomatch'
+23a- , "N Onomatch'
+q0j
+-1u0
+
+!nomatch!
+q0j
+0u0
+
+
+!& Fix Mail-From:! !C Fixes up any initial "Mail-from:" line.
+Some "date" lines actually begin with "Mail-from" and contain
+additional information not wanted here. Cursor is left at the
+beginning of the same line it started on.!
+.,.+10:FBMail-from: :"L Oend'
+0l
+iDate:
+1MM^R_Kill_Word
+1MM^R_Kill_Word
+1MM^R_Kill_Word
+1MM^R_Kill_Word
+!end!
+0l
+
+
+!Reverse Mail List:! !C Reverses a bufferful of mail messages.
+The idea is to move forward through the file putting messages
+found later in front of all found sooner.!
+[0 [1 [2 [3
+.u2 !* q2 has loc of last header found!
+<
+ .-z "E ' !* Stop reversing if at end of buffer!
+
+ < !* Find "end of message"!
+ l !* Go to next line!
+ .-z @; !* Exit if at end of buffer!
+ MM&_Header?
+ q0 :@; !* Exit if header line (q0 nonzero)!
+ >
+ !* End of message now found!
+ q2u1 !* Now q1 has prev. header!
+ .u2 !* q2 has next header loc!
+ q1,q2x3 !* Save message in q3!
+ q1,q2k !* Kill message!
+ bj g3 !* Put at front of buffer!
+ q2j !* Go to where left off!
+>
+
ADDED psl-1983/20-kernel/dalloc.rel
Index: psl-1983/20-kernel/dalloc.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dalloc.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/darith.rel
Index: psl-1983/20-kernel/darith.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/darith.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/ddebg.rel
Index: psl-1983/20-kernel/ddebg.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ddebg.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/debg.ctl
Index: psl-1983/20-kernel/debg.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/debg.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "debg";
+in "debg.build";
+ASMEnd;
+quit;
+compile debg.mac, ddebg.mac
+delete debg.mac, ddebg.mac
ADDED psl-1983/20-kernel/debg.init
Index: psl-1983/20-kernel/debg.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/debg.init
@@ -0,0 +1,9 @@
+(PUT (QUOTE TR) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE TRST) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (QEDITFNS !*EXPERT !*VERBOSE PROMPTSTRING!* EDITORREADER!*
+EDITORPRINTER!* CL)))
+(UNFLUID (QUOTE (CL)))
+(PUT (QUOTE EDIT) (QUOTE HELPFUNCTION) (QUOTE EHELP))
+(PUT (QUOTE EDITF) (QUOTE HELPFUNCTION) (QUOTE EHELP))
+(PUT (QUOTE EDITOR) (QUOTE HELPFUNCTION) (QUOTE EHELP))
+(FLUID (QUOTE (IGNOREDINBACKTRACE!* OPTIONS!* INTERPRETERFUNCTIONS!*)))
ADDED psl-1983/20-kernel/debg.log
Index: psl-1983/20-kernel/debg.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/debg.log
@@ -0,0 +1,70 @@
+
+ 7-Mar-83 15:32:02
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job DEBG Req #258 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:20:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 796
+
+ Input from => PS:<PSL.KERNEL.20>DEBG.CTL.2
+ Output to => PS:<PSL.KERNEL.20>DEBG.LOG
+
+
+
+15:32:03 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+15:32:03 MONTR @SET TIME-LIMIT 1200
+15:32:03 MONTR @LOGIN KESSLER SMALL
+15:32:07 MONTR Job 12 on TTY225 7-Mar-83 15:32:07
+15:32:07 MONTR Previous login at 7-Mar-83 15:29:04
+15:32:08 MONTR There is 1 other job logged in as user KESSLER
+15:32:31 MONTR @
+15:32:31 MONTR [PS Mounted]
+15:32:31 MONTR
+15:32:31 MONTR [CONNECTED TO PS:<PSL.KERNEL.20>]
+15:32:31 MONTR define DSK: DSK:, P20:, PI:
+15:32:32 MONTR @S:DEC20-CROSS.EXE
+15:32:35 USER Dec 20 cross compiler
+15:32:36 USER [8] ASMOut "debg";
+15:32:38 USER ASMOUT: IN files; or type in expressions
+15:32:38 USER When all done execute ASMEND;
+15:33:11 USER [9] in "debg.build";
+15:33:11 USER %
+15:33:11 USER % DEBG.BUILD - Minor debugging tools in the interpreter
+15:33:11 USER %
+15:33:11 USER % Author: Eric Benson
+15:33:11 USER % Symbolic Computation Group
+15:33:11 USER % Computer Science Dept.
+15:33:11 USER % University of Utah
+15:33:11 USER % Date: 19 May 1982
+15:33:11 USER % Copyright (c) 1982 University of Utah
+15:33:12 USER %
+15:33:12 USER
+15:33:12 USER PathIn "mini-trace.red"$
+15:33:13 USER *** Function `TR' has been redefined
+15:33:14 USER *** Function `TRST' has been redefined
+15:33:15 USER % simple function tracing
+15:33:15 USER PathIn "mini-editor.red"$
+15:33:46 USER *** Garbage collection starting
+15:34:08 USER *** GC 4: time 3081 ms
+15:34:08 USER *** 76422 recovered, 564 stable, 13013 active, 76423 free
+15:34:12 USER
+15:34:12 USER PathIn "backtrace.red"$ % Stack backtrace
+15:34:21 USER [10] ASMEnd;
+15:34:50 USER NIL
+15:34:51 USER [11] quit;
+15:34:52 MONTR @compile debg.mac, ddebg.mac
+15:34:58 USER MACRO: .MAIN
+15:35:08 USER MACRO: .MAIN
+15:35:09 USER
+15:35:09 USER EXIT
+15:35:09 MONTR @delete debg.mac, ddebg.mac
+15:35:09 MONTR DEBG.MAC.1 [OK]
+15:35:09 MONTR DDEBG.MAC.1 [OK]
+15:35:09 MONTR @
+15:35:15 MONTR Killed by OPERATOR, TTY 221
+15:35:15 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 225,
+15:35:15 MONTR at 7-Mar-83 15:35:14, Used 0:00:55 in 0:03:07
ADDED psl-1983/20-kernel/debg.rel
Index: psl-1983/20-kernel/debg.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/debg.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/derror.rel
Index: psl-1983/20-kernel/derror.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/derror.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/deval.rel
Index: psl-1983/20-kernel/deval.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/deval.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dextra.rel
Index: psl-1983/20-kernel/dextra.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dextra.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dfasl.rel
Index: psl-1983/20-kernel/dfasl.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dfasl.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dheap.rel
Index: psl-1983/20-kernel/dheap.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dheap.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dio.rel
Index: psl-1983/20-kernel/dio.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dio.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dmacro.rel
Index: psl-1983/20-kernel/dmacro.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dmacro.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dmain.mac
Index: psl-1983/20-kernel/dmain.mac
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dmain.mac
@@ -0,0 +1,11992 @@
+ radix 10
+STACK: block 4001
+ intern STACK
+L1191: STACK+0
+ intern L1191
+L2107: STACK+4000
+ intern L2107
+L0002: block 10
+ intern L0002
+L0003: block 4105
+ intern L0003
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <29_31>+133
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ <29_31>+151
+ <29_31>+152
+ <29_31>+153
+ <29_31>+154
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ <29_31>+160
+ <29_31>+161
+ <29_31>+162
+ <29_31>+163
+ <29_31>+164
+ <29_31>+165
+ <29_31>+166
+ <29_31>+167
+ <29_31>+168
+ <29_31>+169
+ <29_31>+170
+ <29_31>+171
+ <29_31>+172
+ <29_31>+173
+ <29_31>+174
+ <29_31>+175
+ <29_31>+176
+ <29_31>+177
+ <29_31>+178
+ <29_31>+179
+ <29_31>+180
+ <29_31>+181
+ <29_31>+182
+ <29_31>+183
+ <29_31>+184
+ <29_31>+185
+ <29_31>+186
+ <29_31>+187
+ <29_31>+188
+ <29_31>+189
+ <29_31>+190
+ <29_31>+191
+ <29_31>+192
+ <29_31>+193
+ <29_31>+194
+ <29_31>+195
+ <29_31>+196
+ <29_31>+197
+ <29_31>+198
+ <29_31>+199
+ <29_31>+200
+ <29_31>+201
+ <29_31>+202
+ <29_31>+203
+ <29_31>+204
+ <29_31>+205
+ <29_31>+206
+ <29_31>+207
+ <29_31>+208
+ <29_31>+209
+ <29_31>+210
+ <29_31>+211
+ <29_31>+212
+ <29_31>+213
+ <29_31>+214
+ <29_31>+215
+ <29_31>+216
+ <29_31>+217
+ <29_31>+218
+ <29_31>+219
+ <29_31>+220
+ <29_31>+221
+ <29_31>+222
+ <29_31>+223
+ <29_31>+224
+ <29_31>+225
+ <29_31>+226
+ <29_31>+227
+ <29_31>+228
+ <29_31>+229
+ <29_31>+230
+ <29_31>+231
+ <29_31>+232
+ <29_31>+233
+ <29_31>+234
+ <29_31>+235
+ <29_31>+236
+ <29_31>+237
+ <29_31>+238
+ <29_31>+239
+ <29_31>+240
+ <29_31>+241
+ <29_31>+242
+ <29_31>+243
+ <29_31>+244
+ <29_31>+245
+ <29_31>+246
+ <29_31>+247
+ <29_31>+248
+ <29_31>+249
+ <29_31>+250
+ <29_31>+251
+ <29_31>+252
+ <29_31>+253
+ <29_31>+254
+ <29_31>+255
+ <29_31>+256
+ <29_31>+257
+ <29_31>+258
+ <29_31>+259
+ <29_31>+260
+ <29_31>+261
+ <29_31>+262
+ <29_31>+263
+ <29_31>+264
+ <29_31>+265
+ <29_31>+266
+ <29_31>+267
+ <29_31>+268
+ <29_31>+269
+ <29_31>+270
+ <29_31>+271
+ <29_31>+272
+ <29_31>+273
+ <29_31>+274
+ <29_31>+275
+ <29_31>+276
+ <29_31>+277
+ <29_31>+278
+ <29_31>+279
+ <29_31>+280
+ <29_31>+281
+ <29_31>+282
+ <29_31>+283
+ <29_31>+284
+ <29_31>+285
+ <29_31>+286
+ <29_31>+287
+ <29_31>+288
+ <29_31>+289
+ <29_31>+290
+ <29_31>+291
+ <29_31>+292
+ <29_31>+293
+ <29_31>+294
+ <29_31>+295
+ <29_31>+296
+ <29_31>+297
+ <29_31>+298
+ <29_31>+299
+ <29_31>+300
+ <29_31>+301
+ <29_31>+302
+ <29_31>+303
+ <29_31>+304
+ <29_31>+305
+ <29_31>+306
+ <29_31>+307
+ <29_31>+308
+ <29_31>+309
+ <29_31>+310
+ <29_31>+311
+ <29_31>+312
+ <29_31>+313
+ <29_31>+314
+ <29_31>+315
+ <29_31>+316
+ <29_31>+317
+ <29_31>+318
+ 1
+ <29_31>+320
+ <29_31>+321
+ <29_31>+322
+ <29_31>+323
+ <29_31>+324
+ <29_31>+325
+ <29_31>+326
+ <29_31>+327
+ <29_31>+328
+ <29_31>+329
+ <29_31>+330
+ <29_31>+331
+ <29_31>+332
+ <29_31>+333
+ <29_31>+334
+ <29_31>+335
+ <29_31>+336
+ <29_31>+337
+ <29_31>+338
+ <29_31>+339
+ <29_31>+340
+ <29_31>+341
+ <29_31>+342
+ <29_31>+343
+ <29_31>+344
+ <29_31>+345
+ <29_31>+346
+ <29_31>+347
+ <29_31>+348
+ <29_31>+349
+ <29_31>+350
+ <29_31>+351
+ <29_31>+352
+ <29_31>+353
+ <29_31>+354
+ <29_31>+355
+ <29_31>+356
+ <29_31>+357
+ <29_31>+358
+ <29_31>+359
+ <29_31>+360
+ <29_31>+361
+ <29_31>+362
+ <29_31>+363
+ <29_31>+364
+ <29_31>+365
+ <29_31>+366
+ <29_31>+367
+ <29_31>+368
+ <29_31>+369
+ <29_31>+370
+ <29_31>+371
+ <29_31>+372
+ <29_31>+373
+ <29_31>+374
+ <29_31>+375
+ <29_31>+376
+ <29_31>+377
+ <29_31>+378
+ <29_31>+379
+ <29_31>+380
+ <29_31>+381
+ <29_31>+382
+ <29_31>+383
+ <29_31>+384
+ <29_31>+385
+ <29_31>+386
+ <29_31>+387
+ <29_31>+388
+ <29_31>+389
+ <29_31>+390
+ <29_31>+391
+ <29_31>+392
+ <29_31>+393
+ <29_31>+394
+ <29_31>+395
+ <29_31>+396
+ <29_31>+397
+ <29_31>+398
+ <29_31>+399
+ <29_31>+400
+ <29_31>+401
+ <29_31>+402
+ <29_31>+403
+ <29_31>+404
+ <29_31>+405
+ <29_31>+406
+ <29_31>+407
+ <29_31>+408
+ <29_31>+409
+ <29_31>+410
+ <29_31>+411
+ <29_31>+412
+ <29_31>+413
+ <29_31>+414
+ <30_31>+84
+ 0
+ 0
+ 1000
+ <29_31>+419
+ <29_31>+420
+ <29_31>+421
+ <29_31>+422
+ <29_31>+423
+ <29_31>+424
+ <29_31>+425
+ <29_31>+426
+ <29_31>+427
+ <29_31>+428
+ <29_31>+429
+ <29_31>+430
+ <29_31>+431
+ <29_31>+432
+ <29_31>+433
+ <29_31>+434
+ <29_31>+435
+ <29_31>+436
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <29_31>+440
+ <29_31>+441
+ <29_31>+442
+ <30_31>+128
+ <29_31>+444
+ <29_31>+445
+ <30_31>+128
+ <30_31>+128
+ <29_31>+448
+ <29_31>+449
+ <30_31>+128
+ <29_31>+451
+ <29_31>+452
+ <29_31>+453
+ <29_31>+454
+ <29_31>+455
+ <29_31>+456
+ <29_31>+457
+ <29_31>+458
+ extern L3717
+ <9_31>+L3717
+ extern L3730
+ <9_31>+L3730
+ <29_31>+461
+ <29_31>+462
+ <29_31>+463
+ <29_31>+464
+ <29_31>+465
+ <29_31>+466
+ <30_31>+128
+ <29_31>+468
+ <29_31>+469
+ <29_31>+470
+ <29_31>+471
+ <29_31>+472
+ <29_31>+473
+ <29_31>+474
+ <29_31>+475
+ 1
+ <29_31>+477
+ <29_31>+478
+ <29_31>+479
+ <29_31>+480
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+84
+ <30_31>+84
+ 5
+ 0
+ <29_31>+488
+ <29_31>+489
+ <29_31>+490
+ <29_31>+491
+ <29_31>+492
+ <30_31>+128
+ <30_31>+128
+ <29_31>+495
+ <29_31>+496
+ <29_31>+497
+ <29_31>+498
+ <29_31>+499
+ <30_31>+128
+ <29_31>+501
+ <29_31>+502
+ <29_31>+503
+ <29_31>+504
+ <29_31>+505
+ <29_31>+506
+ <29_31>+507
+ <29_31>+508
+ <29_31>+509
+ <29_31>+510
+ <29_31>+511
+ <29_31>+512
+ <29_31>+513
+ <29_31>+514
+ <29_31>+515
+ <29_31>+516
+ <29_31>+517
+ <29_31>+518
+ <29_31>+519
+ <29_31>+520
+ <29_31>+521
+ <29_31>+522
+ <29_31>+523
+ <29_31>+524
+ <29_31>+525
+ <30_31>+128
+ <29_31>+527
+ <29_31>+528
+ <29_31>+529
+ <29_31>+530
+ <29_31>+531
+ <29_31>+532
+ <29_31>+533
+ <29_31>+534
+ <29_31>+535
+ <29_31>+536
+ <29_31>+537
+ <29_31>+538
+ <30_31>+128
+ <30_31>+128
+ <29_31>+541
+ <29_31>+542
+ <29_31>+543
+ <29_31>+544
+ <29_31>+545
+ extern L3736
+ <9_31>+L3736
+ <29_31>+547
+ <29_31>+548
+ <29_31>+549
+ <29_31>+550
+ <29_31>+551
+ <29_31>+552
+ <29_31>+553
+ <29_31>+554
+ <29_31>+555
+ <29_31>+556
+ <29_31>+557
+ <29_31>+558
+ <29_31>+559
+ <29_31>+560
+ <29_31>+561
+ extern L3740
+ <9_31>+L3740
+ extern L3744
+ <9_31>+L3744
+ <30_31>+128
+ <30_31>+128
+ <29_31>+566
+ <29_31>+567
+ <29_31>+568
+ <29_31>+569
+ <30_31>+128
+ <30_31>+84
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <29_31>+575
+ <29_31>+576
+ <29_31>+577
+ <29_31>+578
+ <29_31>+579
+ <29_31>+580
+ <29_31>+581
+ <29_31>+582
+ <29_31>+583
+ <29_31>+584
+ <29_31>+585
+ <29_31>+586
+ <29_31>+587
+ <29_31>+588
+ <29_31>+589
+ <29_31>+590
+ <29_31>+591
+ <29_31>+592
+ <29_31>+593
+ <29_31>+594
+ <29_31>+595
+ <30_31>+10
+ <29_31>+597
+ <29_31>+598
+ 0
+ <29_31>+600
+ <29_31>+601
+ <29_31>+602
+ <29_31>+603
+ <29_31>+604
+ <29_31>+605
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <29_31>+609
+ <29_31>+610
+ <29_31>+611
+ <29_31>+612
+ <29_31>+613
+ <30_31>+128
+ 0
+ <30_31>+128
+ 1
+ <29_31>+618
+ <29_31>+619
+ <29_31>+620
+ <29_31>+621
+ <29_31>+622
+ <29_31>+623
+ <29_31>+624
+ <29_31>+625
+ <30_31>+84
+ <29_31>+627
+ <29_31>+628
+ <29_31>+629
+ <30_31>+637
+ <29_31>+631
+ <29_31>+632
+ <30_31>+128
+ extern L3753
+ <8_31>+L3753
+ <29_31>+635
+ extern L3754
+ <8_31>+L3754
+ <29_31>+637
+ <29_31>+638
+ <30_31>+128
+ <29_31>+640
+ <30_31>+26
+ <29_31>+642
+ <29_31>+643
+ <29_31>+644
+ <29_31>+645
+ <30_31>+128
+ <30_31>+128
+ <29_31>+648
+ <29_31>+649
+ <29_31>+650
+ <29_31>+651
+ <29_31>+652
+ <29_31>+653
+ <29_31>+654
+ <29_31>+655
+ <29_31>+656
+ 10
+ 33
+ <29_31>+659
+ <29_31>+660
+ <29_31>+661
+ <29_31>+662
+ <29_31>+663
+ <29_31>+664
+ <29_31>+665
+ <29_31>+666
+ <29_31>+667
+ <29_31>+668
+ <29_31>+669
+ <29_31>+670
+ <29_31>+671
+ <29_31>+672
+ <29_31>+673
+ <29_31>+674
+ <29_31>+675
+ <29_31>+676
+ <30_31>+128
+ <30_31>+128
+ <29_31>+679
+ <29_31>+680
+ <29_31>+681
+ <29_31>+682
+ <29_31>+683
+ <29_31>+684
+ <29_31>+685
+ <29_31>+686
+ <29_31>+687
+ <29_31>+688
+ <29_31>+689
+ <29_31>+690
+ <29_31>+691
+ <30_31>+128
+ <29_31>+693
+ <29_31>+694
+ <29_31>+695
+ <30_31>+128
+ <29_31>+697
+ <29_31>+698
+ <29_31>+699
+ <29_31>+700
+ <30_31>+128
+ <29_31>+702
+ <29_31>+703
+ <29_31>+704
+ <29_31>+705
+ <29_31>+706
+ <29_31>+707
+ <29_31>+708
+ <29_31>+709
+ <29_31>+710
+ <29_31>+711
+ <29_31>+712
+ <29_31>+713
+ <29_31>+714
+ <29_31>+715
+ <29_31>+716
+ <29_31>+717
+ <29_31>+718
+ <29_31>+719
+ <29_31>+720
+ <29_31>+721
+ <29_31>+722
+ <29_31>+723
+ <29_31>+724
+ <29_31>+725
+ <29_31>+726
+ <29_31>+727
+ <29_31>+728
+ <29_31>+729
+ <29_31>+730
+ <29_31>+731
+ <29_31>+732
+ <29_31>+733
+ <30_31>+128
+ <29_31>+735
+ <29_31>+736
+ <29_31>+737
+ <29_31>+738
+ <29_31>+739
+ <29_31>+740
+ <29_31>+741
+ <29_31>+742
+ <29_31>+743
+ <29_31>+744
+ <29_31>+745
+ <29_31>+746
+ <29_31>+747
+ <29_31>+748
+ <29_31>+749
+ <29_31>+750
+ <29_31>+751
+ <29_31>+752
+ <29_31>+753
+ <29_31>+754
+ <29_31>+755
+ <29_31>+756
+ <29_31>+757
+ <29_31>+758
+ <29_31>+759
+ <29_31>+760
+ <29_31>+761
+ <29_31>+762
+ <29_31>+763
+ <29_31>+764
+ <29_31>+765
+ <29_31>+766
+ <29_31>+767
+ <29_31>+768
+ <29_31>+769
+ <29_31>+770
+ <29_31>+771
+ <29_31>+772
+ <29_31>+773
+ <29_31>+774
+ <30_31>+128
+ <29_31>+776
+ <29_31>+777
+ <29_31>+778
+ <29_31>+779
+ <29_31>+780
+ <29_31>+781
+ <29_31>+782
+ <29_31>+783
+ <29_31>+784
+ <29_31>+785
+ <29_31>+786
+ <29_31>+787
+ <29_31>+788
+ <29_31>+789
+ <29_31>+790
+ <29_31>+791
+ <30_31>+128
+ <29_31>+793
+ <29_31>+794
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <29_31>+806
+ <29_31>+807
+ <29_31>+808
+ <29_31>+809
+ <29_31>+810
+ <29_31>+811
+ <29_31>+812
+ <29_31>+813
+ <29_31>+814
+ <29_31>+815
+ -1
+ 0
+ extern L3755
+ <4_31>+L3755
+ <30_31>+84
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <29_31>+823
+ <30_31>+128
+ <29_31>+825
+ <30_31>+128
+ <29_31>+827
+ <29_31>+828
+ <29_31>+829
+ <29_31>+830
+ <29_31>+831
+ <29_31>+832
+ <29_31>+833
+ <29_31>+834
+ <29_31>+835
+ <30_31>+128
+ <29_31>+837
+ <29_31>+838
+ <29_31>+839
+ <29_31>+840
+ <29_31>+841
+ <29_31>+842
+ <29_31>+843
+ <29_31>+844
+ <29_31>+845
+ <29_31>+846
+ <29_31>+847
+ <29_31>+848
+ <29_31>+849
+ <29_31>+850
+ <29_31>+851
+ block 7149
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 7149
+SYMNAM: intern SYMNAM
+ extern L3756
+ <4_31>+L3756
+ extern L3757
+ <4_31>+L3757
+ extern L3758
+ <4_31>+L3758
+ extern L3759
+ <4_31>+L3759
+ extern L3760
+ <4_31>+L3760
+ extern L3761
+ <4_31>+L3761
+ extern L3762
+ <4_31>+L3762
+ extern L3763
+ <4_31>+L3763
+ extern L3764
+ <4_31>+L3764
+ extern L3765
+ <4_31>+L3765
+ extern L3766
+ <4_31>+L3766
+ extern L3767
+ <4_31>+L3767
+ extern L3768
+ <4_31>+L3768
+ extern L3769
+ <4_31>+L3769
+ extern L3770
+ <4_31>+L3770
+ extern L3771
+ <4_31>+L3771
+ extern L3772
+ <4_31>+L3772
+ extern L3773
+ <4_31>+L3773
+ extern L3774
+ <4_31>+L3774
+ extern L3775
+ <4_31>+L3775
+ extern L3776
+ <4_31>+L3776
+ extern L3777
+ <4_31>+L3777
+ extern L3778
+ <4_31>+L3778
+ extern L3779
+ <4_31>+L3779
+ extern L3780
+ <4_31>+L3780
+ extern L3781
+ <4_31>+L3781
+ extern L3782
+ <4_31>+L3782
+ extern L3783
+ <4_31>+L3783
+ extern L3784
+ <4_31>+L3784
+ extern L3785
+ <4_31>+L3785
+ extern L3786
+ <4_31>+L3786
+ extern L3787
+ <4_31>+L3787
+ extern L3788
+ <4_31>+L3788
+ extern L3789
+ <4_31>+L3789
+ extern L3790
+ <4_31>+L3790
+ extern L3791
+ <4_31>+L3791
+ extern L3792
+ <4_31>+L3792
+ extern L3793
+ <4_31>+L3793
+ extern L3794
+ <4_31>+L3794
+ extern L3795
+ <4_31>+L3795
+ extern L3796
+ <4_31>+L3796
+ extern L3797
+ <4_31>+L3797
+ extern L3798
+ <4_31>+L3798
+ extern L3799
+ <4_31>+L3799
+ extern L3800
+ <4_31>+L3800
+ extern L3801
+ <4_31>+L3801
+ extern L3802
+ <4_31>+L3802
+ extern L3803
+ <4_31>+L3803
+ extern L3804
+ <4_31>+L3804
+ extern L3805
+ <4_31>+L3805
+ extern L3806
+ <4_31>+L3806
+ extern L3807
+ <4_31>+L3807
+ extern L3808
+ <4_31>+L3808
+ extern L3809
+ <4_31>+L3809
+ extern L3810
+ <4_31>+L3810
+ extern L3811
+ <4_31>+L3811
+ extern L3812
+ <4_31>+L3812
+ extern L3813
+ <4_31>+L3813
+ extern L3814
+ <4_31>+L3814
+ extern L3815
+ <4_31>+L3815
+ extern L3816
+ <4_31>+L3816
+ extern L3817
+ <4_31>+L3817
+ extern L3818
+ <4_31>+L3818
+ extern L3819
+ <4_31>+L3819
+ extern L3820
+ <4_31>+L3820
+ extern L3821
+ <4_31>+L3821
+ extern L3822
+ <4_31>+L3822
+ extern L3823
+ <4_31>+L3823
+ extern L3824
+ <4_31>+L3824
+ extern L3825
+ <4_31>+L3825
+ extern L3826
+ <4_31>+L3826
+ extern L3827
+ <4_31>+L3827
+ extern L3828
+ <4_31>+L3828
+ extern L3829
+ <4_31>+L3829
+ extern L3830
+ <4_31>+L3830
+ extern L3831
+ <4_31>+L3831
+ extern L3832
+ <4_31>+L3832
+ extern L3833
+ <4_31>+L3833
+ extern L3834
+ <4_31>+L3834
+ extern L3835
+ <4_31>+L3835
+ extern L3836
+ <4_31>+L3836
+ extern L3837
+ <4_31>+L3837
+ extern L3838
+ <4_31>+L3838
+ extern L3839
+ <4_31>+L3839
+ extern L3840
+ <4_31>+L3840
+ extern L3841
+ <4_31>+L3841
+ extern L3842
+ <4_31>+L3842
+ extern L3843
+ <4_31>+L3843
+ extern L3844
+ <4_31>+L3844
+ extern L3845
+ <4_31>+L3845
+ extern L3846
+ <4_31>+L3846
+ extern L3847
+ <4_31>+L3847
+ extern L3848
+ <4_31>+L3848
+ extern L3849
+ <4_31>+L3849
+ extern L3850
+ <4_31>+L3850
+ extern L3851
+ <4_31>+L3851
+ extern L3852
+ <4_31>+L3852
+ extern L3853
+ <4_31>+L3853
+ extern L3854
+ <4_31>+L3854
+ extern L3855
+ <4_31>+L3855
+ extern L3856
+ <4_31>+L3856
+ extern L3857
+ <4_31>+L3857
+ extern L3858
+ <4_31>+L3858
+ extern L3859
+ <4_31>+L3859
+ extern L3860
+ <4_31>+L3860
+ extern L3861
+ <4_31>+L3861
+ extern L3862
+ <4_31>+L3862
+ extern L3863
+ <4_31>+L3863
+ extern L3864
+ <4_31>+L3864
+ extern L3865
+ <4_31>+L3865
+ extern L3866
+ <4_31>+L3866
+ extern L3867
+ <4_31>+L3867
+ extern L3868
+ <4_31>+L3868
+ extern L3869
+ <4_31>+L3869
+ extern L3870
+ <4_31>+L3870
+ extern L3871
+ <4_31>+L3871
+ extern L3872
+ <4_31>+L3872
+ extern L3873
+ <4_31>+L3873
+ extern L3874
+ <4_31>+L3874
+ extern L3875
+ <4_31>+L3875
+ extern L3876
+ <4_31>+L3876
+ extern L3877
+ <4_31>+L3877
+ extern L3878
+ <4_31>+L3878
+ extern L3879
+ <4_31>+L3879
+ extern L3880
+ <4_31>+L3880
+ extern L3881
+ <4_31>+L3881
+ extern L3882
+ <4_31>+L3882
+ extern L3883
+ <4_31>+L3883
+ extern L3884
+ <4_31>+L3884
+ extern L3885
+ <4_31>+L3885
+ extern L3886
+ <4_31>+L3886
+ extern L3887
+ <4_31>+L3887
+ extern L3888
+ <4_31>+L3888
+ extern L3889
+ <4_31>+L3889
+ extern L3890
+ <4_31>+L3890
+ extern L3891
+ <4_31>+L3891
+ extern L3892
+ <4_31>+L3892
+ extern L3893
+ <4_31>+L3893
+ extern L3894
+ <4_31>+L3894
+ extern L3895
+ <4_31>+L3895
+ extern L3896
+ <4_31>+L3896
+ extern L3897
+ <4_31>+L3897
+ extern L3898
+ <4_31>+L3898
+ extern L3899
+ <4_31>+L3899
+ extern L3900
+ <4_31>+L3900
+ extern L3901
+ <4_31>+L3901
+ extern L3902
+ <4_31>+L3902
+ extern L3903
+ <4_31>+L3903
+ extern L3904
+ <4_31>+L3904
+ extern L3905
+ <4_31>+L3905
+ extern L3906
+ <4_31>+L3906
+ extern L3907
+ <4_31>+L3907
+ extern L3908
+ <4_31>+L3908
+ extern L3909
+ <4_31>+L3909
+ extern L3910
+ <4_31>+L3910
+ extern L3911
+ <4_31>+L3911
+ extern L3912
+ <4_31>+L3912
+ extern L3913
+ <4_31>+L3913
+ extern L3914
+ <4_31>+L3914
+ extern L3915
+ <4_31>+L3915
+ extern L3916
+ <4_31>+L3916
+ extern L3917
+ <4_31>+L3917
+ extern L3918
+ <4_31>+L3918
+ extern L3919
+ <4_31>+L3919
+ extern L3920
+ <4_31>+L3920
+ extern L3921
+ <4_31>+L3921
+ extern L3922
+ <4_31>+L3922
+ extern L3923
+ <4_31>+L3923
+ extern L3924
+ <4_31>+L3924
+ extern L3925
+ <4_31>+L3925
+ extern L3926
+ <4_31>+L3926
+ extern L3927
+ <4_31>+L3927
+ extern L3928
+ <4_31>+L3928
+ extern L3929
+ <4_31>+L3929
+ extern L3930
+ <4_31>+L3930
+ extern L3931
+ <4_31>+L3931
+ extern L3932
+ <4_31>+L3932
+ extern L3933
+ <4_31>+L3933
+ extern L3934
+ <4_31>+L3934
+ extern L3935
+ <4_31>+L3935
+ extern L3936
+ <4_31>+L3936
+ extern L3937
+ <4_31>+L3937
+ extern L3938
+ <4_31>+L3938
+ extern L3939
+ <4_31>+L3939
+ extern L3940
+ <4_31>+L3940
+ extern L3941
+ <4_31>+L3941
+ extern L3942
+ <4_31>+L3942
+ extern L3943
+ <4_31>+L3943
+ extern L3944
+ <4_31>+L3944
+ extern L3945
+ <4_31>+L3945
+ extern L3946
+ <4_31>+L3946
+ extern L3947
+ <4_31>+L3947
+ extern L3948
+ <4_31>+L3948
+ extern L3949
+ <4_31>+L3949
+ extern L3950
+ <4_31>+L3950
+ extern L3951
+ <4_31>+L3951
+ extern L3952
+ <4_31>+L3952
+ extern L3953
+ <4_31>+L3953
+ extern L3954
+ <4_31>+L3954
+ extern L3955
+ <4_31>+L3955
+ extern L3956
+ <4_31>+L3956
+ extern L3957
+ <4_31>+L3957
+ extern L3958
+ <4_31>+L3958
+ extern L3959
+ <4_31>+L3959
+ extern L3960
+ <4_31>+L3960
+ extern L3961
+ <4_31>+L3961
+ extern L3962
+ <4_31>+L3962
+ extern L3963
+ <4_31>+L3963
+ extern L3964
+ <4_31>+L3964
+ extern L3965
+ <4_31>+L3965
+ extern L3966
+ <4_31>+L3966
+ extern L3967
+ <4_31>+L3967
+ extern L3968
+ <4_31>+L3968
+ extern L3969
+ <4_31>+L3969
+ extern L3970
+ <4_31>+L3970
+ extern L3971
+ <4_31>+L3971
+ extern L3972
+ <4_31>+L3972
+ extern L3973
+ <4_31>+L3973
+ extern L3974
+ <4_31>+L3974
+ extern L3975
+ <4_31>+L3975
+ extern L3976
+ <4_31>+L3976
+ extern L3977
+ <4_31>+L3977
+ extern L3978
+ <4_31>+L3978
+ extern L3979
+ <4_31>+L3979
+ extern L3980
+ <4_31>+L3980
+ extern L3981
+ <4_31>+L3981
+ extern L3982
+ <4_31>+L3982
+ extern L3983
+ <4_31>+L3983
+ extern L3984
+ <4_31>+L3984
+ extern L3985
+ <4_31>+L3985
+ extern L3986
+ <4_31>+L3986
+ extern L3987
+ <4_31>+L3987
+ extern L3988
+ <4_31>+L3988
+ extern L3989
+ <4_31>+L3989
+ extern L3990
+ <4_31>+L3990
+ extern L3991
+ <4_31>+L3991
+ extern L3992
+ <4_31>+L3992
+ extern L3993
+ <4_31>+L3993
+ extern L3994
+ <4_31>+L3994
+ extern L3995
+ <4_31>+L3995
+ extern L3996
+ <4_31>+L3996
+ extern L3997
+ <4_31>+L3997
+ extern L3998
+ <4_31>+L3998
+ extern L3999
+ <4_31>+L3999
+ extern L4000
+ <4_31>+L4000
+ extern L4001
+ <4_31>+L4001
+ extern L4002
+ <4_31>+L4002
+ extern L4003
+ <4_31>+L4003
+ extern L4004
+ <4_31>+L4004
+ extern L4005
+ <4_31>+L4005
+ extern L4006
+ <4_31>+L4006
+ extern L4007
+ <4_31>+L4007
+ extern L4008
+ <4_31>+L4008
+ extern L4009
+ <4_31>+L4009
+ extern L4010
+ <4_31>+L4010
+ extern L4011
+ <4_31>+L4011
+ extern L4012
+ <4_31>+L4012
+ extern L4013
+ <4_31>+L4013
+ extern L4014
+ <4_31>+L4014
+ extern L4015
+ <4_31>+L4015
+ extern L4016
+ <4_31>+L4016
+ extern L4017
+ <4_31>+L4017
+ extern L4018
+ <4_31>+L4018
+ extern L4019
+ <4_31>+L4019
+ extern L4020
+ <4_31>+L4020
+ extern L4021
+ <4_31>+L4021
+ extern L4022
+ <4_31>+L4022
+ extern L4023
+ <4_31>+L4023
+ extern L4024
+ <4_31>+L4024
+ extern L4025
+ <4_31>+L4025
+ extern L4026
+ <4_31>+L4026
+ extern L4027
+ <4_31>+L4027
+ extern L4028
+ <4_31>+L4028
+ extern L4029
+ <4_31>+L4029
+ extern L4030
+ <4_31>+L4030
+ extern L4031
+ <4_31>+L4031
+ extern L4032
+ <4_31>+L4032
+ extern L4033
+ <4_31>+L4033
+ extern L4034
+ <4_31>+L4034
+ extern L4035
+ <4_31>+L4035
+ extern L4036
+ <4_31>+L4036
+ extern L4037
+ <4_31>+L4037
+ extern L4038
+ <4_31>+L4038
+ extern L4039
+ <4_31>+L4039
+ extern L4040
+ <4_31>+L4040
+ extern L4041
+ <4_31>+L4041
+ extern L4042
+ <4_31>+L4042
+ extern L4043
+ <4_31>+L4043
+ extern L4044
+ <4_31>+L4044
+ extern L4045
+ <4_31>+L4045
+ extern L4046
+ <4_31>+L4046
+ extern L4047
+ <4_31>+L4047
+ extern L4048
+ <4_31>+L4048
+ extern L4049
+ <4_31>+L4049
+ extern L4050
+ <4_31>+L4050
+ extern L4051
+ <4_31>+L4051
+ extern L4052
+ <4_31>+L4052
+ extern L4053
+ <4_31>+L4053
+ extern L4054
+ <4_31>+L4054
+ extern L4055
+ <4_31>+L4055
+ extern L4056
+ <4_31>+L4056
+ extern L4057
+ <4_31>+L4057
+ extern L4058
+ <4_31>+L4058
+ extern L4059
+ <4_31>+L4059
+ extern L4060
+ <4_31>+L4060
+ extern L4061
+ <4_31>+L4061
+ extern L4062
+ <4_31>+L4062
+ extern L4063
+ <4_31>+L4063
+ extern L4064
+ <4_31>+L4064
+ extern L4065
+ <4_31>+L4065
+ extern L4066
+ <4_31>+L4066
+ extern L4067
+ <4_31>+L4067
+ extern L4068
+ <4_31>+L4068
+ extern L4069
+ <4_31>+L4069
+ extern L4070
+ <4_31>+L4070
+ extern L4071
+ <4_31>+L4071
+ extern L4072
+ <4_31>+L4072
+ extern L4073
+ <4_31>+L4073
+ extern L4074
+ <4_31>+L4074
+ extern L4075
+ <4_31>+L4075
+ extern L4076
+ <4_31>+L4076
+ extern L4077
+ <4_31>+L4077
+ extern L4078
+ <4_31>+L4078
+ extern L4079
+ <4_31>+L4079
+ extern L4080
+ <4_31>+L4080
+ extern L4081
+ <4_31>+L4081
+ extern L4082
+ <4_31>+L4082
+ extern L4083
+ <4_31>+L4083
+ extern L4084
+ <4_31>+L4084
+ extern L4085
+ <4_31>+L4085
+ extern L4086
+ <4_31>+L4086
+ extern L4087
+ <4_31>+L4087
+ extern L4088
+ <4_31>+L4088
+ extern L4089
+ <4_31>+L4089
+ extern L4090
+ <4_31>+L4090
+ extern L4091
+ <4_31>+L4091
+ extern L4092
+ <4_31>+L4092
+ extern L4093
+ <4_31>+L4093
+ extern L4094
+ <4_31>+L4094
+ extern L4095
+ <4_31>+L4095
+ extern L4096
+ <4_31>+L4096
+ extern L4097
+ <4_31>+L4097
+ extern L4098
+ <4_31>+L4098
+ extern L4099
+ <4_31>+L4099
+ extern L4100
+ <4_31>+L4100
+ extern L4101
+ <4_31>+L4101
+ extern L4102
+ <4_31>+L4102
+ extern L4103
+ <4_31>+L4103
+ extern L4104
+ <4_31>+L4104
+ extern L4105
+ <4_31>+L4105
+ extern L4106
+ <4_31>+L4106
+ extern L4107
+ <4_31>+L4107
+ extern L4108
+ <4_31>+L4108
+ extern L4109
+ <4_31>+L4109
+ extern L4110
+ <4_31>+L4110
+ extern L4111
+ <4_31>+L4111
+ extern L4112
+ <4_31>+L4112
+ extern L4113
+ <4_31>+L4113
+ extern L4114
+ <4_31>+L4114
+ extern L4115
+ <4_31>+L4115
+ extern L4116
+ <4_31>+L4116
+ extern L4117
+ <4_31>+L4117
+ extern L4118
+ <4_31>+L4118
+ extern L4119
+ <4_31>+L4119
+ extern L4120
+ <4_31>+L4120
+ extern L4121
+ <4_31>+L4121
+ extern L4122
+ <4_31>+L4122
+ extern L4123
+ <4_31>+L4123
+ extern L4124
+ <4_31>+L4124
+ extern L4125
+ <4_31>+L4125
+ extern L4126
+ <4_31>+L4126
+ extern L4127
+ <4_31>+L4127
+ extern L4128
+ <4_31>+L4128
+ extern L4129
+ <4_31>+L4129
+ extern L4130
+ <4_31>+L4130
+ extern L4131
+ <4_31>+L4131
+ extern L4132
+ <4_31>+L4132
+ extern L4133
+ <4_31>+L4133
+ extern L4134
+ <4_31>+L4134
+ extern L4135
+ <4_31>+L4135
+ extern L4136
+ <4_31>+L4136
+ extern L4137
+ <4_31>+L4137
+ extern L4138
+ <4_31>+L4138
+ extern L4139
+ <4_31>+L4139
+ extern L4140
+ <4_31>+L4140
+ extern L4141
+ <4_31>+L4141
+ extern L4142
+ <4_31>+L4142
+ extern L4143
+ <4_31>+L4143
+ extern L4144
+ <4_31>+L4144
+ extern L4145
+ <4_31>+L4145
+ extern L4146
+ <4_31>+L4146
+ extern L4147
+ <4_31>+L4147
+ extern L4148
+ <4_31>+L4148
+ extern L4149
+ <4_31>+L4149
+ extern L4150
+ <4_31>+L4150
+ extern L4151
+ <4_31>+L4151
+ extern L4152
+ <4_31>+L4152
+ extern L4153
+ <4_31>+L4153
+ extern L4154
+ <4_31>+L4154
+ extern L4155
+ <4_31>+L4155
+ extern L4156
+ <4_31>+L4156
+ extern L4157
+ <4_31>+L4157
+ extern L4158
+ <4_31>+L4158
+ extern L4159
+ <4_31>+L4159
+ extern L4160
+ <4_31>+L4160
+ extern L4161
+ <4_31>+L4161
+ extern L4162
+ <4_31>+L4162
+ extern L4163
+ <4_31>+L4163
+ extern L4164
+ <4_31>+L4164
+ extern L4165
+ <4_31>+L4165
+ extern L4166
+ <4_31>+L4166
+ extern L4167
+ <4_31>+L4167
+ extern L4168
+ <4_31>+L4168
+ extern L4169
+ <4_31>+L4169
+ extern L4170
+ <4_31>+L4170
+ extern L4171
+ <4_31>+L4171
+ extern L4172
+ <4_31>+L4172
+ extern L4173
+ <4_31>+L4173
+ extern L4174
+ <4_31>+L4174
+ extern L4175
+ <4_31>+L4175
+ extern L4176
+ <4_31>+L4176
+ extern L4177
+ <4_31>+L4177
+ extern L4178
+ <4_31>+L4178
+ extern L4179
+ <4_31>+L4179
+ extern L4180
+ <4_31>+L4180
+ extern L4181
+ <4_31>+L4181
+ extern L4182
+ <4_31>+L4182
+ extern L4183
+ <4_31>+L4183
+ extern L4184
+ <4_31>+L4184
+ extern L4185
+ <4_31>+L4185
+ extern L4186
+ <4_31>+L4186
+ extern L4187
+ <4_31>+L4187
+ extern L4188
+ <4_31>+L4188
+ extern L4189
+ <4_31>+L4189
+ extern L4190
+ <4_31>+L4190
+ extern L4191
+ <4_31>+L4191
+ extern L4192
+ <4_31>+L4192
+ extern L4193
+ <4_31>+L4193
+ extern L4194
+ <4_31>+L4194
+ extern L4195
+ <4_31>+L4195
+ extern L4196
+ <4_31>+L4196
+ extern L4197
+ <4_31>+L4197
+ extern L4198
+ <4_31>+L4198
+ extern L4199
+ <4_31>+L4199
+ extern L4200
+ <4_31>+L4200
+ extern L4201
+ <4_31>+L4201
+ extern L4202
+ <4_31>+L4202
+ extern L4203
+ <4_31>+L4203
+ extern L4204
+ <4_31>+L4204
+ extern L4205
+ <4_31>+L4205
+ extern L4206
+ <4_31>+L4206
+ extern L4207
+ <4_31>+L4207
+ extern L4208
+ <4_31>+L4208
+ extern L4209
+ <4_31>+L4209
+ extern L4210
+ <4_31>+L4210
+ extern L4211
+ <4_31>+L4211
+ extern L4212
+ <4_31>+L4212
+ extern L4213
+ <4_31>+L4213
+ extern L4214
+ <4_31>+L4214
+ extern L4215
+ <4_31>+L4215
+ extern L4216
+ <4_31>+L4216
+ extern L4217
+ <4_31>+L4217
+ extern L4218
+ <4_31>+L4218
+ extern L4219
+ <4_31>+L4219
+ extern L4220
+ <4_31>+L4220
+ extern L4221
+ <4_31>+L4221
+ extern L4222
+ <4_31>+L4222
+ extern L4223
+ <4_31>+L4223
+ extern L4224
+ <4_31>+L4224
+ extern L4225
+ <4_31>+L4225
+ extern L4226
+ <4_31>+L4226
+ extern L4227
+ <4_31>+L4227
+ extern L4228
+ <4_31>+L4228
+ extern L4229
+ <4_31>+L4229
+ extern L4230
+ <4_31>+L4230
+ extern L4231
+ <4_31>+L4231
+ extern L4232
+ <4_31>+L4232
+ extern L4233
+ <4_31>+L4233
+ extern L4234
+ <4_31>+L4234
+ extern L4235
+ <4_31>+L4235
+ extern L4236
+ <4_31>+L4236
+ extern L4237
+ <4_31>+L4237
+ extern L4238
+ <4_31>+L4238
+ extern L4239
+ <4_31>+L4239
+ extern L4240
+ <4_31>+L4240
+ extern L4241
+ <4_31>+L4241
+ extern L4242
+ <4_31>+L4242
+ extern L4243
+ <4_31>+L4243
+ extern L4244
+ <4_31>+L4244
+ extern L4245
+ <4_31>+L4245
+ extern L4246
+ <4_31>+L4246
+ extern L4247
+ <4_31>+L4247
+ extern L4248
+ <4_31>+L4248
+ extern L4249
+ <4_31>+L4249
+ extern L4250
+ <4_31>+L4250
+ extern L4251
+ <4_31>+L4251
+ extern L4252
+ <4_31>+L4252
+ extern L4253
+ <4_31>+L4253
+ extern L4254
+ <4_31>+L4254
+ extern L4255
+ <4_31>+L4255
+ extern L4256
+ <4_31>+L4256
+ extern L4257
+ <4_31>+L4257
+ extern L4258
+ <4_31>+L4258
+ extern L4259
+ <4_31>+L4259
+ extern L4260
+ <4_31>+L4260
+ extern L4261
+ <4_31>+L4261
+ extern L4262
+ <4_31>+L4262
+ extern L4263
+ <4_31>+L4263
+ extern L4264
+ <4_31>+L4264
+ extern L4265
+ <4_31>+L4265
+ extern L4266
+ <4_31>+L4266
+ extern L4267
+ <4_31>+L4267
+ extern L4268
+ <4_31>+L4268
+ extern L4269
+ <4_31>+L4269
+ extern L4270
+ <4_31>+L4270
+ extern L4271
+ <4_31>+L4271
+ extern L4272
+ <4_31>+L4272
+ extern L4273
+ <4_31>+L4273
+ extern L4274
+ <4_31>+L4274
+ extern L4275
+ <4_31>+L4275
+ extern L4276
+ <4_31>+L4276
+ extern L4277
+ <4_31>+L4277
+ extern L4278
+ <4_31>+L4278
+ extern L4279
+ <4_31>+L4279
+ extern L4280
+ <4_31>+L4280
+ extern L4281
+ <4_31>+L4281
+ extern L4282
+ <4_31>+L4282
+ extern L4283
+ <4_31>+L4283
+ extern L4284
+ <4_31>+L4284
+ extern L4285
+ <4_31>+L4285
+ extern L4286
+ <4_31>+L4286
+ extern L4287
+ <4_31>+L4287
+ extern L4288
+ <4_31>+L4288
+ extern L4289
+ <4_31>+L4289
+ extern L4290
+ <4_31>+L4290
+ extern L4291
+ <4_31>+L4291
+ extern L4292
+ <4_31>+L4292
+ extern L4293
+ <4_31>+L4293
+ extern L4294
+ <4_31>+L4294
+ extern L4295
+ <4_31>+L4295
+ extern L4296
+ <4_31>+L4296
+ extern L4297
+ <4_31>+L4297
+ extern L4298
+ <4_31>+L4298
+ extern L4299
+ <4_31>+L4299
+ extern L4300
+ <4_31>+L4300
+ extern L4301
+ <4_31>+L4301
+ extern L4302
+ <4_31>+L4302
+ extern L4303
+ <4_31>+L4303
+ extern L4304
+ <4_31>+L4304
+ extern L4305
+ <4_31>+L4305
+ extern L4306
+ <4_31>+L4306
+ extern L4307
+ <4_31>+L4307
+ extern L4308
+ <4_31>+L4308
+ extern L4309
+ <4_31>+L4309
+ extern L4310
+ <4_31>+L4310
+ extern L4311
+ <4_31>+L4311
+ extern L4312
+ <4_31>+L4312
+ extern L4313
+ <4_31>+L4313
+ extern L4314
+ <4_31>+L4314
+ extern L4315
+ <4_31>+L4315
+ extern L4316
+ <4_31>+L4316
+ extern L4317
+ <4_31>+L4317
+ extern L4318
+ <4_31>+L4318
+ extern L4319
+ <4_31>+L4319
+ extern L4320
+ <4_31>+L4320
+ extern L4321
+ <4_31>+L4321
+ extern L4322
+ <4_31>+L4322
+ extern L4323
+ <4_31>+L4323
+ extern L4324
+ <4_31>+L4324
+ extern L4325
+ <4_31>+L4325
+ extern L4326
+ <4_31>+L4326
+ extern L4327
+ <4_31>+L4327
+ extern L4328
+ <4_31>+L4328
+ extern L4329
+ <4_31>+L4329
+ extern L4330
+ <4_31>+L4330
+ extern L4331
+ <4_31>+L4331
+ extern L4332
+ <4_31>+L4332
+ extern L4333
+ <4_31>+L4333
+ extern L4334
+ <4_31>+L4334
+ extern L4335
+ <4_31>+L4335
+ extern L4336
+ <4_31>+L4336
+ extern L4337
+ <4_31>+L4337
+ extern L4338
+ <4_31>+L4338
+ extern L4339
+ <4_31>+L4339
+ extern L4340
+ <4_31>+L4340
+ extern L4341
+ <4_31>+L4341
+ extern L4342
+ <4_31>+L4342
+ extern L4343
+ <4_31>+L4343
+ extern L4344
+ <4_31>+L4344
+ extern L4345
+ <4_31>+L4345
+ extern L4346
+ <4_31>+L4346
+ extern L4347
+ <4_31>+L4347
+ extern L4348
+ <4_31>+L4348
+ extern L4349
+ <4_31>+L4349
+ extern L4350
+ <4_31>+L4350
+ extern L4351
+ <4_31>+L4351
+ extern L4352
+ <4_31>+L4352
+ extern L4353
+ <4_31>+L4353
+ extern L4354
+ <4_31>+L4354
+ extern L4355
+ <4_31>+L4355
+ extern L4356
+ <4_31>+L4356
+ extern L4357
+ <4_31>+L4357
+ extern L4358
+ <4_31>+L4358
+ extern L4359
+ <4_31>+L4359
+ extern L4360
+ <4_31>+L4360
+ extern L4361
+ <4_31>+L4361
+ extern L4362
+ <4_31>+L4362
+ extern L4363
+ <4_31>+L4363
+ extern L4364
+ <4_31>+L4364
+ extern L4365
+ <4_31>+L4365
+ extern L4366
+ <4_31>+L4366
+ extern L4367
+ <4_31>+L4367
+ extern L4368
+ <4_31>+L4368
+ extern L4369
+ <4_31>+L4369
+ extern L4370
+ <4_31>+L4370
+ extern L4371
+ <4_31>+L4371
+ extern L4372
+ <4_31>+L4372
+ extern L4373
+ <4_31>+L4373
+ extern L4374
+ <4_31>+L4374
+ extern L4375
+ <4_31>+L4375
+ extern L4376
+ <4_31>+L4376
+ extern L4377
+ <4_31>+L4377
+ extern L4378
+ <4_31>+L4378
+ extern L4379
+ <4_31>+L4379
+ extern L4380
+ <4_31>+L4380
+ extern L4381
+ <4_31>+L4381
+ extern L4382
+ <4_31>+L4382
+ extern L4383
+ <4_31>+L4383
+ extern L4384
+ <4_31>+L4384
+ extern L4385
+ <4_31>+L4385
+ extern L4386
+ <4_31>+L4386
+ extern L4387
+ <4_31>+L4387
+ extern L4388
+ <4_31>+L4388
+ extern L4389
+ <4_31>+L4389
+ extern L4390
+ <4_31>+L4390
+ extern L4391
+ <4_31>+L4391
+ extern L4392
+ <4_31>+L4392
+ extern L4393
+ <4_31>+L4393
+ extern L4394
+ <4_31>+L4394
+ extern L4395
+ <4_31>+L4395
+ extern L4396
+ <4_31>+L4396
+ extern L4397
+ <4_31>+L4397
+ extern L4398
+ <4_31>+L4398
+ extern L4399
+ <4_31>+L4399
+ extern L4400
+ <4_31>+L4400
+ extern L4401
+ <4_31>+L4401
+ extern L4402
+ <4_31>+L4402
+ extern L4403
+ <4_31>+L4403
+ extern L4404
+ <4_31>+L4404
+ extern L4405
+ <4_31>+L4405
+ extern L4406
+ <4_31>+L4406
+ extern L4407
+ <4_31>+L4407
+ extern L4408
+ <4_31>+L4408
+ extern L4409
+ <4_31>+L4409
+ extern L4410
+ <4_31>+L4410
+ extern L4411
+ <4_31>+L4411
+ extern L4412
+ <4_31>+L4412
+ extern L4413
+ <4_31>+L4413
+ extern L4414
+ <4_31>+L4414
+ extern L4415
+ <4_31>+L4415
+ extern L4416
+ <4_31>+L4416
+ extern L4417
+ <4_31>+L4417
+ extern L4418
+ <4_31>+L4418
+ extern L4419
+ <4_31>+L4419
+ extern L4420
+ <4_31>+L4420
+ extern L4421
+ <4_31>+L4421
+ extern L4422
+ <4_31>+L4422
+ extern L4423
+ <4_31>+L4423
+ extern L4424
+ <4_31>+L4424
+ extern L4425
+ <4_31>+L4425
+ extern L4426
+ <4_31>+L4426
+ extern L4427
+ <4_31>+L4427
+ extern L4428
+ <4_31>+L4428
+ extern L4429
+ <4_31>+L4429
+ extern L4430
+ <4_31>+L4430
+ extern L4431
+ <4_31>+L4431
+ extern L4432
+ <4_31>+L4432
+ extern L4433
+ <4_31>+L4433
+ extern L4434
+ <4_31>+L4434
+ extern L4435
+ <4_31>+L4435
+ extern L4436
+ <4_31>+L4436
+ extern L4437
+ <4_31>+L4437
+ extern L4438
+ <4_31>+L4438
+ extern L4439
+ <4_31>+L4439
+ extern L4440
+ <4_31>+L4440
+ extern L4441
+ <4_31>+L4441
+ extern L4442
+ <4_31>+L4442
+ extern L4443
+ <4_31>+L4443
+ extern L4444
+ <4_31>+L4444
+ extern L4445
+ <4_31>+L4445
+ extern L4446
+ <4_31>+L4446
+ extern L4447
+ <4_31>+L4447
+ extern L4448
+ <4_31>+L4448
+ extern L4449
+ <4_31>+L4449
+ extern L4450
+ <4_31>+L4450
+ extern L4451
+ <4_31>+L4451
+ extern L4452
+ <4_31>+L4452
+ extern L4453
+ <4_31>+L4453
+ extern L4454
+ <4_31>+L4454
+ extern L4455
+ <4_31>+L4455
+ extern L4456
+ <4_31>+L4456
+ extern L4457
+ <4_31>+L4457
+ extern L4458
+ <4_31>+L4458
+ extern L4459
+ <4_31>+L4459
+ extern L4460
+ <4_31>+L4460
+ extern L4461
+ <4_31>+L4461
+ extern L4462
+ <4_31>+L4462
+ extern L4463
+ <4_31>+L4463
+ extern L4464
+ <4_31>+L4464
+ extern L4465
+ <4_31>+L4465
+ extern L4466
+ <4_31>+L4466
+ extern L4467
+ <4_31>+L4467
+ extern L4468
+ <4_31>+L4468
+ extern L4469
+ <4_31>+L4469
+ extern L4470
+ <4_31>+L4470
+ extern L4471
+ <4_31>+L4471
+ extern L4472
+ <4_31>+L4472
+ extern L4473
+ <4_31>+L4473
+ extern L4474
+ <4_31>+L4474
+ extern L4475
+ <4_31>+L4475
+ extern L4476
+ <4_31>+L4476
+ extern L4477
+ <4_31>+L4477
+ extern L4478
+ <4_31>+L4478
+ extern L4479
+ <4_31>+L4479
+ extern L4480
+ <4_31>+L4480
+ extern L4481
+ <4_31>+L4481
+ extern L4482
+ <4_31>+L4482
+ extern L4483
+ <4_31>+L4483
+ extern L4484
+ <4_31>+L4484
+ extern L4485
+ <4_31>+L4485
+ extern L4486
+ <4_31>+L4486
+ extern L4487
+ <4_31>+L4487
+ extern L4488
+ <4_31>+L4488
+ extern L4489
+ <4_31>+L4489
+ extern L4490
+ <4_31>+L4490
+ extern L4491
+ <4_31>+L4491
+ extern L4492
+ <4_31>+L4492
+ extern L4493
+ <4_31>+L4493
+ extern L4494
+ <4_31>+L4494
+ extern L4495
+ <4_31>+L4495
+ extern L4496
+ <4_31>+L4496
+ extern L4497
+ <4_31>+L4497
+ extern L4498
+ <4_31>+L4498
+ extern L4499
+ <4_31>+L4499
+ extern L4500
+ <4_31>+L4500
+ extern L4501
+ <4_31>+L4501
+ extern L4502
+ <4_31>+L4502
+ extern L4503
+ <4_31>+L4503
+ extern L4504
+ <4_31>+L4504
+ extern L4505
+ <4_31>+L4505
+ extern L4506
+ <4_31>+L4506
+ extern L4507
+ <4_31>+L4507
+ extern L4508
+ <4_31>+L4508
+ extern L4509
+ <4_31>+L4509
+ extern L4510
+ <4_31>+L4510
+ extern L4511
+ <4_31>+L4511
+ extern L4512
+ <4_31>+L4512
+ extern L4513
+ <4_31>+L4513
+ extern L4514
+ <4_31>+L4514
+ extern L4515
+ <4_31>+L4515
+ extern L4516
+ <4_31>+L4516
+ extern L4517
+ <4_31>+L4517
+ extern L4518
+ <4_31>+L4518
+ extern L4519
+ <4_31>+L4519
+ extern L4520
+ <4_31>+L4520
+ extern L4521
+ <4_31>+L4521
+ extern L4522
+ <4_31>+L4522
+ extern L4523
+ <4_31>+L4523
+ extern L4524
+ <4_31>+L4524
+ extern L4525
+ <4_31>+L4525
+ extern L4526
+ <4_31>+L4526
+ extern L4527
+ <4_31>+L4527
+ extern L4528
+ <4_31>+L4528
+ extern L4529
+ <4_31>+L4529
+ extern L4530
+ <4_31>+L4530
+ extern L4531
+ <4_31>+L4531
+ extern L4532
+ <4_31>+L4532
+ extern L4533
+ <4_31>+L4533
+ extern L4534
+ <4_31>+L4534
+ extern L4535
+ <4_31>+L4535
+ extern L4536
+ <4_31>+L4536
+ extern L4537
+ <4_31>+L4537
+ extern L4538
+ <4_31>+L4538
+ extern L4539
+ <4_31>+L4539
+ extern L4540
+ <4_31>+L4540
+ extern L4541
+ <4_31>+L4541
+ extern L4542
+ <4_31>+L4542
+ extern L4543
+ <4_31>+L4543
+ extern L4544
+ <4_31>+L4544
+ extern L4545
+ <4_31>+L4545
+ extern L4546
+ <4_31>+L4546
+ extern L4547
+ <4_31>+L4547
+ extern L4548
+ <4_31>+L4548
+ extern L4549
+ <4_31>+L4549
+ extern L4550
+ <4_31>+L4550
+ extern L4551
+ <4_31>+L4551
+ extern L4552
+ <4_31>+L4552
+ extern L4553
+ <4_31>+L4553
+ extern L4554
+ <4_31>+L4554
+ extern L4555
+ <4_31>+L4555
+ extern L4556
+ <4_31>+L4556
+ extern L4557
+ <4_31>+L4557
+ extern L4558
+ <4_31>+L4558
+ extern L4559
+ <4_31>+L4559
+ extern L4560
+ <4_31>+L4560
+ extern L4561
+ <4_31>+L4561
+ extern L4562
+ <4_31>+L4562
+ extern L4563
+ <4_31>+L4563
+ extern L4564
+ <4_31>+L4564
+ extern L4565
+ <4_31>+L4565
+ extern L4566
+ <4_31>+L4566
+ extern L4567
+ <4_31>+L4567
+ extern L4568
+ <4_31>+L4568
+ extern L4569
+ <4_31>+L4569
+ extern L4570
+ <4_31>+L4570
+ extern L4571
+ <4_31>+L4571
+ extern L4572
+ <4_31>+L4572
+ extern L4573
+ <4_31>+L4573
+ extern L4574
+ <4_31>+L4574
+ extern L4575
+ <4_31>+L4575
+ extern L4576
+ <4_31>+L4576
+ extern L4577
+ <4_31>+L4577
+ extern L4578
+ <4_31>+L4578
+ extern L4579
+ <4_31>+L4579
+ extern L4580
+ <4_31>+L4580
+ extern L4581
+ <4_31>+L4581
+ extern L4582
+ <4_31>+L4582
+ extern L4583
+ <4_31>+L4583
+ extern L4584
+ <4_31>+L4584
+ extern L4585
+ <4_31>+L4585
+ extern L4586
+ <4_31>+L4586
+ extern L4587
+ <4_31>+L4587
+ extern L4588
+ <4_31>+L4588
+ extern L4589
+ <4_31>+L4589
+ extern L4590
+ <4_31>+L4590
+ extern L4591
+ <4_31>+L4591
+ extern L4592
+ <4_31>+L4592
+ extern L4593
+ <4_31>+L4593
+ extern L4594
+ <4_31>+L4594
+ extern L4595
+ <4_31>+L4595
+ extern L4596
+ <4_31>+L4596
+ extern L4597
+ <4_31>+L4597
+ extern L4598
+ <4_31>+L4598
+ extern L4599
+ <4_31>+L4599
+ extern L4600
+ <4_31>+L4600
+ extern L4601
+ <4_31>+L4601
+ extern L4602
+ <4_31>+L4602
+ extern L4603
+ <4_31>+L4603
+ extern L4604
+ <4_31>+L4604
+ extern L4605
+ <4_31>+L4605
+ extern L4606
+ <4_31>+L4606
+ extern L4607
+ <4_31>+L4607
+ 853
+ 854
+ 855
+ 856
+ 857
+ 858
+ 859
+ 860
+ 861
+ 862
+ 863
+ 864
+ 865
+ 866
+ 867
+ 868
+ 869
+ 870
+ 871
+ 872
+ 873
+ 874
+ 875
+ 876
+ 877
+ 878
+ 879
+ 880
+ 881
+ 882
+ 883
+ 884
+ 885
+ 886
+ 887
+ 888
+ 889
+ 890
+ 891
+ 892
+ 893
+ 894
+ 895
+ 896
+ 897
+ 898
+ 899
+ 900
+ 901
+ 902
+ 903
+ 904
+ 905
+ 906
+ 907
+ 908
+ 909
+ 910
+ 911
+ 912
+ 913
+ 914
+ 915
+ 916
+ 917
+ 918
+ 919
+ 920
+ 921
+ 922
+ 923
+ 924
+ 925
+ 926
+ 927
+ 928
+ 929
+ 930
+ 931
+ 932
+ 933
+ 934
+ 935
+ 936
+ 937
+ 938
+ 939
+ 940
+ 941
+ 942
+ 943
+ 944
+ 945
+ 946
+ 947
+ 948
+ 949
+ 950
+ 951
+ 952
+ 953
+ 954
+ 955
+ 956
+ 957
+ 958
+ 959
+ 960
+ 961
+ 962
+ 963
+ 964
+ 965
+ 966
+ 967
+ 968
+ 969
+ 970
+ 971
+ 972
+ 973
+ 974
+ 975
+ 976
+ 977
+ 978
+ 979
+ 980
+ 981
+ 982
+ 983
+ 984
+ 985
+ 986
+ 987
+ 988
+ 989
+ 990
+ 991
+ 992
+ 993
+ 994
+ 995
+ 996
+ 997
+ 998
+ 999
+ 1000
+ 1001
+ 1002
+ 1003
+ 1004
+ 1005
+ 1006
+ 1007
+ 1008
+ 1009
+ 1010
+ 1011
+ 1012
+ 1013
+ 1014
+ 1015
+ 1016
+ 1017
+ 1018
+ 1019
+ 1020
+ 1021
+ 1022
+ 1023
+ 1024
+ 1025
+ 1026
+ 1027
+ 1028
+ 1029
+ 1030
+ 1031
+ 1032
+ 1033
+ 1034
+ 1035
+ 1036
+ 1037
+ 1038
+ 1039
+ 1040
+ 1041
+ 1042
+ 1043
+ 1044
+ 1045
+ 1046
+ 1047
+ 1048
+ 1049
+ 1050
+ 1051
+ 1052
+ 1053
+ 1054
+ 1055
+ 1056
+ 1057
+ 1058
+ 1059
+ 1060
+ 1061
+ 1062
+ 1063
+ 1064
+ 1065
+ 1066
+ 1067
+ 1068
+ 1069
+ 1070
+ 1071
+ 1072
+ 1073
+ 1074
+ 1075
+ 1076
+ 1077
+ 1078
+ 1079
+ 1080
+ 1081
+ 1082
+ 1083
+ 1084
+ 1085
+ 1086
+ 1087
+ 1088
+ 1089
+ 1090
+ 1091
+ 1092
+ 1093
+ 1094
+ 1095
+ 1096
+ 1097
+ 1098
+ 1099
+ 1100
+ 1101
+ 1102
+ 1103
+ 1104
+ 1105
+ 1106
+ 1107
+ 1108
+ 1109
+ 1110
+ 1111
+ 1112
+ 1113
+ 1114
+ 1115
+ 1116
+ 1117
+ 1118
+ 1119
+ 1120
+ 1121
+ 1122
+ 1123
+ 1124
+ 1125
+ 1126
+ 1127
+ 1128
+ 1129
+ 1130
+ 1131
+ 1132
+ 1133
+ 1134
+ 1135
+ 1136
+ 1137
+ 1138
+ 1139
+ 1140
+ 1141
+ 1142
+ 1143
+ 1144
+ 1145
+ 1146
+ 1147
+ 1148
+ 1149
+ 1150
+ 1151
+ 1152
+ 1153
+ 1154
+ 1155
+ 1156
+ 1157
+ 1158
+ 1159
+ 1160
+ 1161
+ 1162
+ 1163
+ 1164
+ 1165
+ 1166
+ 1167
+ 1168
+ 1169
+ 1170
+ 1171
+ 1172
+ 1173
+ 1174
+ 1175
+ 1176
+ 1177
+ 1178
+ 1179
+ 1180
+ 1181
+ 1182
+ 1183
+ 1184
+ 1185
+ 1186
+ 1187
+ 1188
+ 1189
+ 1190
+ 1191
+ 1192
+ 1193
+ 1194
+ 1195
+ 1196
+ 1197
+ 1198
+ 1199
+ 1200
+ 1201
+ 1202
+ 1203
+ 1204
+ 1205
+ 1206
+ 1207
+ 1208
+ 1209
+ 1210
+ 1211
+ 1212
+ 1213
+ 1214
+ 1215
+ 1216
+ 1217
+ 1218
+ 1219
+ 1220
+ 1221
+ 1222
+ 1223
+ 1224
+ 1225
+ 1226
+ 1227
+ 1228
+ 1229
+ 1230
+ 1231
+ 1232
+ 1233
+ 1234
+ 1235
+ 1236
+ 1237
+ 1238
+ 1239
+ 1240
+ 1241
+ 1242
+ 1243
+ 1244
+ 1245
+ 1246
+ 1247
+ 1248
+ 1249
+ 1250
+ 1251
+ 1252
+ 1253
+ 1254
+ 1255
+ 1256
+ 1257
+ 1258
+ 1259
+ 1260
+ 1261
+ 1262
+ 1263
+ 1264
+ 1265
+ 1266
+ 1267
+ 1268
+ 1269
+ 1270
+ 1271
+ 1272
+ 1273
+ 1274
+ 1275
+ 1276
+ 1277
+ 1278
+ 1279
+ 1280
+ 1281
+ 1282
+ 1283
+ 1284
+ 1285
+ 1286
+ 1287
+ 1288
+ 1289
+ 1290
+ 1291
+ 1292
+ 1293
+ 1294
+ 1295
+ 1296
+ 1297
+ 1298
+ 1299
+ 1300
+ 1301
+ 1302
+ 1303
+ 1304
+ 1305
+ 1306
+ 1307
+ 1308
+ 1309
+ 1310
+ 1311
+ 1312
+ 1313
+ 1314
+ 1315
+ 1316
+ 1317
+ 1318
+ 1319
+ 1320
+ 1321
+ 1322
+ 1323
+ 1324
+ 1325
+ 1326
+ 1327
+ 1328
+ 1329
+ 1330
+ 1331
+ 1332
+ 1333
+ 1334
+ 1335
+ 1336
+ 1337
+ 1338
+ 1339
+ 1340
+ 1341
+ 1342
+ 1343
+ 1344
+ 1345
+ 1346
+ 1347
+ 1348
+ 1349
+ 1350
+ 1351
+ 1352
+ 1353
+ 1354
+ 1355
+ 1356
+ 1357
+ 1358
+ 1359
+ 1360
+ 1361
+ 1362
+ 1363
+ 1364
+ 1365
+ 1366
+ 1367
+ 1368
+ 1369
+ 1370
+ 1371
+ 1372
+ 1373
+ 1374
+ 1375
+ 1376
+ 1377
+ 1378
+ 1379
+ 1380
+ 1381
+ 1382
+ 1383
+ 1384
+ 1385
+ 1386
+ 1387
+ 1388
+ 1389
+ 1390
+ 1391
+ 1392
+ 1393
+ 1394
+ 1395
+ 1396
+ 1397
+ 1398
+ 1399
+ 1400
+ 1401
+ 1402
+ 1403
+ 1404
+ 1405
+ 1406
+ 1407
+ 1408
+ 1409
+ 1410
+ 1411
+ 1412
+ 1413
+ 1414
+ 1415
+ 1416
+ 1417
+ 1418
+ 1419
+ 1420
+ 1421
+ 1422
+ 1423
+ 1424
+ 1425
+ 1426
+ 1427
+ 1428
+ 1429
+ 1430
+ 1431
+ 1432
+ 1433
+ 1434
+ 1435
+ 1436
+ 1437
+ 1438
+ 1439
+ 1440
+ 1441
+ 1442
+ 1443
+ 1444
+ 1445
+ 1446
+ 1447
+ 1448
+ 1449
+ 1450
+ 1451
+ 1452
+ 1453
+ 1454
+ 1455
+ 1456
+ 1457
+ 1458
+ 1459
+ 1460
+ 1461
+ 1462
+ 1463
+ 1464
+ 1465
+ 1466
+ 1467
+ 1468
+ 1469
+ 1470
+ 1471
+ 1472
+ 1473
+ 1474
+ 1475
+ 1476
+ 1477
+ 1478
+ 1479
+ 1480
+ 1481
+ 1482
+ 1483
+ 1484
+ 1485
+ 1486
+ 1487
+ 1488
+ 1489
+ 1490
+ 1491
+ 1492
+ 1493
+ 1494
+ 1495
+ 1496
+ 1497
+ 1498
+ 1499
+ 1500
+ 1501
+ 1502
+ 1503
+ 1504
+ 1505
+ 1506
+ 1507
+ 1508
+ 1509
+ 1510
+ 1511
+ 1512
+ 1513
+ 1514
+ 1515
+ 1516
+ 1517
+ 1518
+ 1519
+ 1520
+ 1521
+ 1522
+ 1523
+ 1524
+ 1525
+ 1526
+ 1527
+ 1528
+ 1529
+ 1530
+ 1531
+ 1532
+ 1533
+ 1534
+ 1535
+ 1536
+ 1537
+ 1538
+ 1539
+ 1540
+ 1541
+ 1542
+ 1543
+ 1544
+ 1545
+ 1546
+ 1547
+ 1548
+ 1549
+ 1550
+ 1551
+ 1552
+ 1553
+ 1554
+ 1555
+ 1556
+ 1557
+ 1558
+ 1559
+ 1560
+ 1561
+ 1562
+ 1563
+ 1564
+ 1565
+ 1566
+ 1567
+ 1568
+ 1569
+ 1570
+ 1571
+ 1572
+ 1573
+ 1574
+ 1575
+ 1576
+ 1577
+ 1578
+ 1579
+ 1580
+ 1581
+ 1582
+ 1583
+ 1584
+ 1585
+ 1586
+ 1587
+ 1588
+ 1589
+ 1590
+ 1591
+ 1592
+ 1593
+ 1594
+ 1595
+ 1596
+ 1597
+ 1598
+ 1599
+ 1600
+ 1601
+ 1602
+ 1603
+ 1604
+ 1605
+ 1606
+ 1607
+ 1608
+ 1609
+ 1610
+ 1611
+ 1612
+ 1613
+ 1614
+ 1615
+ 1616
+ 1617
+ 1618
+ 1619
+ 1620
+ 1621
+ 1622
+ 1623
+ 1624
+ 1625
+ 1626
+ 1627
+ 1628
+ 1629
+ 1630
+ 1631
+ 1632
+ 1633
+ 1634
+ 1635
+ 1636
+ 1637
+ 1638
+ 1639
+ 1640
+ 1641
+ 1642
+ 1643
+ 1644
+ 1645
+ 1646
+ 1647
+ 1648
+ 1649
+ 1650
+ 1651
+ 1652
+ 1653
+ 1654
+ 1655
+ 1656
+ 1657
+ 1658
+ 1659
+ 1660
+ 1661
+ 1662
+ 1663
+ 1664
+ 1665
+ 1666
+ 1667
+ 1668
+ 1669
+ 1670
+ 1671
+ 1672
+ 1673
+ 1674
+ 1675
+ 1676
+ 1677
+ 1678
+ 1679
+ 1680
+ 1681
+ 1682
+ 1683
+ 1684
+ 1685
+ 1686
+ 1687
+ 1688
+ 1689
+ 1690
+ 1691
+ 1692
+ 1693
+ 1694
+ 1695
+ 1696
+ 1697
+ 1698
+ 1699
+ 1700
+ 1701
+ 1702
+ 1703
+ 1704
+ 1705
+ 1706
+ 1707
+ 1708
+ 1709
+ 1710
+ 1711
+ 1712
+ 1713
+ 1714
+ 1715
+ 1716
+ 1717
+ 1718
+ 1719
+ 1720
+ 1721
+ 1722
+ 1723
+ 1724
+ 1725
+ 1726
+ 1727
+ 1728
+ 1729
+ 1730
+ 1731
+ 1732
+ 1733
+ 1734
+ 1735
+ 1736
+ 1737
+ 1738
+ 1739
+ 1740
+ 1741
+ 1742
+ 1743
+ 1744
+ 1745
+ 1746
+ 1747
+ 1748
+ 1749
+ 1750
+ 1751
+ 1752
+ 1753
+ 1754
+ 1755
+ 1756
+ 1757
+ 1758
+ 1759
+ 1760
+ 1761
+ 1762
+ 1763
+ 1764
+ 1765
+ 1766
+ 1767
+ 1768
+ 1769
+ 1770
+ 1771
+ 1772
+ 1773
+ 1774
+ 1775
+ 1776
+ 1777
+ 1778
+ 1779
+ 1780
+ 1781
+ 1782
+ 1783
+ 1784
+ 1785
+ 1786
+ 1787
+ 1788
+ 1789
+ 1790
+ 1791
+ 1792
+ 1793
+ 1794
+ 1795
+ 1796
+ 1797
+ 1798
+ 1799
+ 1800
+ 1801
+ 1802
+ 1803
+ 1804
+ 1805
+ 1806
+ 1807
+ 1808
+ 1809
+ 1810
+ 1811
+ 1812
+ 1813
+ 1814
+ 1815
+ 1816
+ 1817
+ 1818
+ 1819
+ 1820
+ 1821
+ 1822
+ 1823
+ 1824
+ 1825
+ 1826
+ 1827
+ 1828
+ 1829
+ 1830
+ 1831
+ 1832
+ 1833
+ 1834
+ 1835
+ 1836
+ 1837
+ 1838
+ 1839
+ 1840
+ 1841
+ 1842
+ 1843
+ 1844
+ 1845
+ 1846
+ 1847
+ 1848
+ 1849
+ 1850
+ 1851
+ 1852
+ 1853
+ 1854
+ 1855
+ 1856
+ 1857
+ 1858
+ 1859
+ 1860
+ 1861
+ 1862
+ 1863
+ 1864
+ 1865
+ 1866
+ 1867
+ 1868
+ 1869
+ 1870
+ 1871
+ 1872
+ 1873
+ 1874
+ 1875
+ 1876
+ 1877
+ 1878
+ 1879
+ 1880
+ 1881
+ 1882
+ 1883
+ 1884
+ 1885
+ 1886
+ 1887
+ 1888
+ 1889
+ 1890
+ 1891
+ 1892
+ 1893
+ 1894
+ 1895
+ 1896
+ 1897
+ 1898
+ 1899
+ 1900
+ 1901
+ 1902
+ 1903
+ 1904
+ 1905
+ 1906
+ 1907
+ 1908
+ 1909
+ 1910
+ 1911
+ 1912
+ 1913
+ 1914
+ 1915
+ 1916
+ 1917
+ 1918
+ 1919
+ 1920
+ 1921
+ 1922
+ 1923
+ 1924
+ 1925
+ 1926
+ 1927
+ 1928
+ 1929
+ 1930
+ 1931
+ 1932
+ 1933
+ 1934
+ 1935
+ 1936
+ 1937
+ 1938
+ 1939
+ 1940
+ 1941
+ 1942
+ 1943
+ 1944
+ 1945
+ 1946
+ 1947
+ 1948
+ 1949
+ 1950
+ 1951
+ 1952
+ 1953
+ 1954
+ 1955
+ 1956
+ 1957
+ 1958
+ 1959
+ 1960
+ 1961
+ 1962
+ 1963
+ 1964
+ 1965
+ 1966
+ 1967
+ 1968
+ 1969
+ 1970
+ 1971
+ 1972
+ 1973
+ 1974
+ 1975
+ 1976
+ 1977
+ 1978
+ 1979
+ 1980
+ 1981
+ 1982
+ 1983
+ 1984
+ 1985
+ 1986
+ 1987
+ 1988
+ 1989
+ 1990
+ 1991
+ 1992
+ 1993
+ 1994
+ 1995
+ 1996
+ 1997
+ 1998
+ 1999
+ 2000
+ 2001
+ 2002
+ 2003
+ 2004
+ 2005
+ 2006
+ 2007
+ 2008
+ 2009
+ 2010
+ 2011
+ 2012
+ 2013
+ 2014
+ 2015
+ 2016
+ 2017
+ 2018
+ 2019
+ 2020
+ 2021
+ 2022
+ 2023
+ 2024
+ 2025
+ 2026
+ 2027
+ 2028
+ 2029
+ 2030
+ 2031
+ 2032
+ 2033
+ 2034
+ 2035
+ 2036
+ 2037
+ 2038
+ 2039
+ 2040
+ 2041
+ 2042
+ 2043
+ 2044
+ 2045
+ 2046
+ 2047
+ 2048
+ 2049
+ 2050
+ 2051
+ 2052
+ 2053
+ 2054
+ 2055
+ 2056
+ 2057
+ 2058
+ 2059
+ 2060
+ 2061
+ 2062
+ 2063
+ 2064
+ 2065
+ 2066
+ 2067
+ 2068
+ 2069
+ 2070
+ 2071
+ 2072
+ 2073
+ 2074
+ 2075
+ 2076
+ 2077
+ 2078
+ 2079
+ 2080
+ 2081
+ 2082
+ 2083
+ 2084
+ 2085
+ 2086
+ 2087
+ 2088
+ 2089
+ 2090
+ 2091
+ 2092
+ 2093
+ 2094
+ 2095
+ 2096
+ 2097
+ 2098
+ 2099
+ 2100
+ 2101
+ 2102
+ 2103
+ 2104
+ 2105
+ 2106
+ 2107
+ 2108
+ 2109
+ 2110
+ 2111
+ 2112
+ 2113
+ 2114
+ 2115
+ 2116
+ 2117
+ 2118
+ 2119
+ 2120
+ 2121
+ 2122
+ 2123
+ 2124
+ 2125
+ 2126
+ 2127
+ 2128
+ 2129
+ 2130
+ 2131
+ 2132
+ 2133
+ 2134
+ 2135
+ 2136
+ 2137
+ 2138
+ 2139
+ 2140
+ 2141
+ 2142
+ 2143
+ 2144
+ 2145
+ 2146
+ 2147
+ 2148
+ 2149
+ 2150
+ 2151
+ 2152
+ 2153
+ 2154
+ 2155
+ 2156
+ 2157
+ 2158
+ 2159
+ 2160
+ 2161
+ 2162
+ 2163
+ 2164
+ 2165
+ 2166
+ 2167
+ 2168
+ 2169
+ 2170
+ 2171
+ 2172
+ 2173
+ 2174
+ 2175
+ 2176
+ 2177
+ 2178
+ 2179
+ 2180
+ 2181
+ 2182
+ 2183
+ 2184
+ 2185
+ 2186
+ 2187
+ 2188
+ 2189
+ 2190
+ 2191
+ 2192
+ 2193
+ 2194
+ 2195
+ 2196
+ 2197
+ 2198
+ 2199
+ 2200
+ 2201
+ 2202
+ 2203
+ 2204
+ 2205
+ 2206
+ 2207
+ 2208
+ 2209
+ 2210
+ 2211
+ 2212
+ 2213
+ 2214
+ 2215
+ 2216
+ 2217
+ 2218
+ 2219
+ 2220
+ 2221
+ 2222
+ 2223
+ 2224
+ 2225
+ 2226
+ 2227
+ 2228
+ 2229
+ 2230
+ 2231
+ 2232
+ 2233
+ 2234
+ 2235
+ 2236
+ 2237
+ 2238
+ 2239
+ 2240
+ 2241
+ 2242
+ 2243
+ 2244
+ 2245
+ 2246
+ 2247
+ 2248
+ 2249
+ 2250
+ 2251
+ 2252
+ 2253
+ 2254
+ 2255
+ 2256
+ 2257
+ 2258
+ 2259
+ 2260
+ 2261
+ 2262
+ 2263
+ 2264
+ 2265
+ 2266
+ 2267
+ 2268
+ 2269
+ 2270
+ 2271
+ 2272
+ 2273
+ 2274
+ 2275
+ 2276
+ 2277
+ 2278
+ 2279
+ 2280
+ 2281
+ 2282
+ 2283
+ 2284
+ 2285
+ 2286
+ 2287
+ 2288
+ 2289
+ 2290
+ 2291
+ 2292
+ 2293
+ 2294
+ 2295
+ 2296
+ 2297
+ 2298
+ 2299
+ 2300
+ 2301
+ 2302
+ 2303
+ 2304
+ 2305
+ 2306
+ 2307
+ 2308
+ 2309
+ 2310
+ 2311
+ 2312
+ 2313
+ 2314
+ 2315
+ 2316
+ 2317
+ 2318
+ 2319
+ 2320
+ 2321
+ 2322
+ 2323
+ 2324
+ 2325
+ 2326
+ 2327
+ 2328
+ 2329
+ 2330
+ 2331
+ 2332
+ 2333
+ 2334
+ 2335
+ 2336
+ 2337
+ 2338
+ 2339
+ 2340
+ 2341
+ 2342
+ 2343
+ 2344
+ 2345
+ 2346
+ 2347
+ 2348
+ 2349
+ 2350
+ 2351
+ 2352
+ 2353
+ 2354
+ 2355
+ 2356
+ 2357
+ 2358
+ 2359
+ 2360
+ 2361
+ 2362
+ 2363
+ 2364
+ 2365
+ 2366
+ 2367
+ 2368
+ 2369
+ 2370
+ 2371
+ 2372
+ 2373
+ 2374
+ 2375
+ 2376
+ 2377
+ 2378
+ 2379
+ 2380
+ 2381
+ 2382
+ 2383
+ 2384
+ 2385
+ 2386
+ 2387
+ 2388
+ 2389
+ 2390
+ 2391
+ 2392
+ 2393
+ 2394
+ 2395
+ 2396
+ 2397
+ 2398
+ 2399
+ 2400
+ 2401
+ 2402
+ 2403
+ 2404
+ 2405
+ 2406
+ 2407
+ 2408
+ 2409
+ 2410
+ 2411
+ 2412
+ 2413
+ 2414
+ 2415
+ 2416
+ 2417
+ 2418
+ 2419
+ 2420
+ 2421
+ 2422
+ 2423
+ 2424
+ 2425
+ 2426
+ 2427
+ 2428
+ 2429
+ 2430
+ 2431
+ 2432
+ 2433
+ 2434
+ 2435
+ 2436
+ 2437
+ 2438
+ 2439
+ 2440
+ 2441
+ 2442
+ 2443
+ 2444
+ 2445
+ 2446
+ 2447
+ 2448
+ 2449
+ 2450
+ 2451
+ 2452
+ 2453
+ 2454
+ 2455
+ 2456
+ 2457
+ 2458
+ 2459
+ 2460
+ 2461
+ 2462
+ 2463
+ 2464
+ 2465
+ 2466
+ 2467
+ 2468
+ 2469
+ 2470
+ 2471
+ 2472
+ 2473
+ 2474
+ 2475
+ 2476
+ 2477
+ 2478
+ 2479
+ 2480
+ 2481
+ 2482
+ 2483
+ 2484
+ 2485
+ 2486
+ 2487
+ 2488
+ 2489
+ 2490
+ 2491
+ 2492
+ 2493
+ 2494
+ 2495
+ 2496
+ 2497
+ 2498
+ 2499
+ 2500
+ 2501
+ 2502
+ 2503
+ 2504
+ 2505
+ 2506
+ 2507
+ 2508
+ 2509
+ 2510
+ 2511
+ 2512
+ 2513
+ 2514
+ 2515
+ 2516
+ 2517
+ 2518
+ 2519
+ 2520
+ 2521
+ 2522
+ 2523
+ 2524
+ 2525
+ 2526
+ 2527
+ 2528
+ 2529
+ 2530
+ 2531
+ 2532
+ 2533
+ 2534
+ 2535
+ 2536
+ 2537
+ 2538
+ 2539
+ 2540
+ 2541
+ 2542
+ 2543
+ 2544
+ 2545
+ 2546
+ 2547
+ 2548
+ 2549
+ 2550
+ 2551
+ 2552
+ 2553
+ 2554
+ 2555
+ 2556
+ 2557
+ 2558
+ 2559
+ 2560
+ 2561
+ 2562
+ 2563
+ 2564
+ 2565
+ 2566
+ 2567
+ 2568
+ 2569
+ 2570
+ 2571
+ 2572
+ 2573
+ 2574
+ 2575
+ 2576
+ 2577
+ 2578
+ 2579
+ 2580
+ 2581
+ 2582
+ 2583
+ 2584
+ 2585
+ 2586
+ 2587
+ 2588
+ 2589
+ 2590
+ 2591
+ 2592
+ 2593
+ 2594
+ 2595
+ 2596
+ 2597
+ 2598
+ 2599
+ 2600
+ 2601
+ 2602
+ 2603
+ 2604
+ 2605
+ 2606
+ 2607
+ 2608
+ 2609
+ 2610
+ 2611
+ 2612
+ 2613
+ 2614
+ 2615
+ 2616
+ 2617
+ 2618
+ 2619
+ 2620
+ 2621
+ 2622
+ 2623
+ 2624
+ 2625
+ 2626
+ 2627
+ 2628
+ 2629
+ 2630
+ 2631
+ 2632
+ 2633
+ 2634
+ 2635
+ 2636
+ 2637
+ 2638
+ 2639
+ 2640
+ 2641
+ 2642
+ 2643
+ 2644
+ 2645
+ 2646
+ 2647
+ 2648
+ 2649
+ 2650
+ 2651
+ 2652
+ 2653
+ 2654
+ 2655
+ 2656
+ 2657
+ 2658
+ 2659
+ 2660
+ 2661
+ 2662
+ 2663
+ 2664
+ 2665
+ 2666
+ 2667
+ 2668
+ 2669
+ 2670
+ 2671
+ 2672
+ 2673
+ 2674
+ 2675
+ 2676
+ 2677
+ 2678
+ 2679
+ 2680
+ 2681
+ 2682
+ 2683
+ 2684
+ 2685
+ 2686
+ 2687
+ 2688
+ 2689
+ 2690
+ 2691
+ 2692
+ 2693
+ 2694
+ 2695
+ 2696
+ 2697
+ 2698
+ 2699
+ 2700
+ 2701
+ 2702
+ 2703
+ 2704
+ 2705
+ 2706
+ 2707
+ 2708
+ 2709
+ 2710
+ 2711
+ 2712
+ 2713
+ 2714
+ 2715
+ 2716
+ 2717
+ 2718
+ 2719
+ 2720
+ 2721
+ 2722
+ 2723
+ 2724
+ 2725
+ 2726
+ 2727
+ 2728
+ 2729
+ 2730
+ 2731
+ 2732
+ 2733
+ 2734
+ 2735
+ 2736
+ 2737
+ 2738
+ 2739
+ 2740
+ 2741
+ 2742
+ 2743
+ 2744
+ 2745
+ 2746
+ 2747
+ 2748
+ 2749
+ 2750
+ 2751
+ 2752
+ 2753
+ 2754
+ 2755
+ 2756
+ 2757
+ 2758
+ 2759
+ 2760
+ 2761
+ 2762
+ 2763
+ 2764
+ 2765
+ 2766
+ 2767
+ 2768
+ 2769
+ 2770
+ 2771
+ 2772
+ 2773
+ 2774
+ 2775
+ 2776
+ 2777
+ 2778
+ 2779
+ 2780
+ 2781
+ 2782
+ 2783
+ 2784
+ 2785
+ 2786
+ 2787
+ 2788
+ 2789
+ 2790
+ 2791
+ 2792
+ 2793
+ 2794
+ 2795
+ 2796
+ 2797
+ 2798
+ 2799
+ 2800
+ 2801
+ 2802
+ 2803
+ 2804
+ 2805
+ 2806
+ 2807
+ 2808
+ 2809
+ 2810
+ 2811
+ 2812
+ 2813
+ 2814
+ 2815
+ 2816
+ 2817
+ 2818
+ 2819
+ 2820
+ 2821
+ 2822
+ 2823
+ 2824
+ 2825
+ 2826
+ 2827
+ 2828
+ 2829
+ 2830
+ 2831
+ 2832
+ 2833
+ 2834
+ 2835
+ 2836
+ 2837
+ 2838
+ 2839
+ 2840
+ 2841
+ 2842
+ 2843
+ 2844
+ 2845
+ 2846
+ 2847
+ 2848
+ 2849
+ 2850
+ 2851
+ 2852
+ 2853
+ 2854
+ 2855
+ 2856
+ 2857
+ 2858
+ 2859
+ 2860
+ 2861
+ 2862
+ 2863
+ 2864
+ 2865
+ 2866
+ 2867
+ 2868
+ 2869
+ 2870
+ 2871
+ 2872
+ 2873
+ 2874
+ 2875
+ 2876
+ 2877
+ 2878
+ 2879
+ 2880
+ 2881
+ 2882
+ 2883
+ 2884
+ 2885
+ 2886
+ 2887
+ 2888
+ 2889
+ 2890
+ 2891
+ 2892
+ 2893
+ 2894
+ 2895
+ 2896
+ 2897
+ 2898
+ 2899
+ 2900
+ 2901
+ 2902
+ 2903
+ 2904
+ 2905
+ 2906
+ 2907
+ 2908
+ 2909
+ 2910
+ 2911
+ 2912
+ 2913
+ 2914
+ 2915
+ 2916
+ 2917
+ 2918
+ 2919
+ 2920
+ 2921
+ 2922
+ 2923
+ 2924
+ 2925
+ 2926
+ 2927
+ 2928
+ 2929
+ 2930
+ 2931
+ 2932
+ 2933
+ 2934
+ 2935
+ 2936
+ 2937
+ 2938
+ 2939
+ 2940
+ 2941
+ 2942
+ 2943
+ 2944
+ 2945
+ 2946
+ 2947
+ 2948
+ 2949
+ 2950
+ 2951
+ 2952
+ 2953
+ 2954
+ 2955
+ 2956
+ 2957
+ 2958
+ 2959
+ 2960
+ 2961
+ 2962
+ 2963
+ 2964
+ 2965
+ 2966
+ 2967
+ 2968
+ 2969
+ 2970
+ 2971
+ 2972
+ 2973
+ 2974
+ 2975
+ 2976
+ 2977
+ 2978
+ 2979
+ 2980
+ 2981
+ 2982
+ 2983
+ 2984
+ 2985
+ 2986
+ 2987
+ 2988
+ 2989
+ 2990
+ 2991
+ 2992
+ 2993
+ 2994
+ 2995
+ 2996
+ 2997
+ 2998
+ 2999
+ 3000
+ 3001
+ 3002
+ 3003
+ 3004
+ 3005
+ 3006
+ 3007
+ 3008
+ 3009
+ 3010
+ 3011
+ 3012
+ 3013
+ 3014
+ 3015
+ 3016
+ 3017
+ 3018
+ 3019
+ 3020
+ 3021
+ 3022
+ 3023
+ 3024
+ 3025
+ 3026
+ 3027
+ 3028
+ 3029
+ 3030
+ 3031
+ 3032
+ 3033
+ 3034
+ 3035
+ 3036
+ 3037
+ 3038
+ 3039
+ 3040
+ 3041
+ 3042
+ 3043
+ 3044
+ 3045
+ 3046
+ 3047
+ 3048
+ 3049
+ 3050
+ 3051
+ 3052
+ 3053
+ 3054
+ 3055
+ 3056
+ 3057
+ 3058
+ 3059
+ 3060
+ 3061
+ 3062
+ 3063
+ 3064
+ 3065
+ 3066
+ 3067
+ 3068
+ 3069
+ 3070
+ 3071
+ 3072
+ 3073
+ 3074
+ 3075
+ 3076
+ 3077
+ 3078
+ 3079
+ 3080
+ 3081
+ 3082
+ 3083
+ 3084
+ 3085
+ 3086
+ 3087
+ 3088
+ 3089
+ 3090
+ 3091
+ 3092
+ 3093
+ 3094
+ 3095
+ 3096
+ 3097
+ 3098
+ 3099
+ 3100
+ 3101
+ 3102
+ 3103
+ 3104
+ 3105
+ 3106
+ 3107
+ 3108
+ 3109
+ 3110
+ 3111
+ 3112
+ 3113
+ 3114
+ 3115
+ 3116
+ 3117
+ 3118
+ 3119
+ 3120
+ 3121
+ 3122
+ 3123
+ 3124
+ 3125
+ 3126
+ 3127
+ 3128
+ 3129
+ 3130
+ 3131
+ 3132
+ 3133
+ 3134
+ 3135
+ 3136
+ 3137
+ 3138
+ 3139
+ 3140
+ 3141
+ 3142
+ 3143
+ 3144
+ 3145
+ 3146
+ 3147
+ 3148
+ 3149
+ 3150
+ 3151
+ 3152
+ 3153
+ 3154
+ 3155
+ 3156
+ 3157
+ 3158
+ 3159
+ 3160
+ 3161
+ 3162
+ 3163
+ 3164
+ 3165
+ 3166
+ 3167
+ 3168
+ 3169
+ 3170
+ 3171
+ 3172
+ 3173
+ 3174
+ 3175
+ 3176
+ 3177
+ 3178
+ 3179
+ 3180
+ 3181
+ 3182
+ 3183
+ 3184
+ 3185
+ 3186
+ 3187
+ 3188
+ 3189
+ 3190
+ 3191
+ 3192
+ 3193
+ 3194
+ 3195
+ 3196
+ 3197
+ 3198
+ 3199
+ 3200
+ 3201
+ 3202
+ 3203
+ 3204
+ 3205
+ 3206
+ 3207
+ 3208
+ 3209
+ 3210
+ 3211
+ 3212
+ 3213
+ 3214
+ 3215
+ 3216
+ 3217
+ 3218
+ 3219
+ 3220
+ 3221
+ 3222
+ 3223
+ 3224
+ 3225
+ 3226
+ 3227
+ 3228
+ 3229
+ 3230
+ 3231
+ 3232
+ 3233
+ 3234
+ 3235
+ 3236
+ 3237
+ 3238
+ 3239
+ 3240
+ 3241
+ 3242
+ 3243
+ 3244
+ 3245
+ 3246
+ 3247
+ 3248
+ 3249
+ 3250
+ 3251
+ 3252
+ 3253
+ 3254
+ 3255
+ 3256
+ 3257
+ 3258
+ 3259
+ 3260
+ 3261
+ 3262
+ 3263
+ 3264
+ 3265
+ 3266
+ 3267
+ 3268
+ 3269
+ 3270
+ 3271
+ 3272
+ 3273
+ 3274
+ 3275
+ 3276
+ 3277
+ 3278
+ 3279
+ 3280
+ 3281
+ 3282
+ 3283
+ 3284
+ 3285
+ 3286
+ 3287
+ 3288
+ 3289
+ 3290
+ 3291
+ 3292
+ 3293
+ 3294
+ 3295
+ 3296
+ 3297
+ 3298
+ 3299
+ 3300
+ 3301
+ 3302
+ 3303
+ 3304
+ 3305
+ 3306
+ 3307
+ 3308
+ 3309
+ 3310
+ 3311
+ 3312
+ 3313
+ 3314
+ 3315
+ 3316
+ 3317
+ 3318
+ 3319
+ 3320
+ 3321
+ 3322
+ 3323
+ 3324
+ 3325
+ 3326
+ 3327
+ 3328
+ 3329
+ 3330
+ 3331
+ 3332
+ 3333
+ 3334
+ 3335
+ 3336
+ 3337
+ 3338
+ 3339
+ 3340
+ 3341
+ 3342
+ 3343
+ 3344
+ 3345
+ 3346
+ 3347
+ 3348
+ 3349
+ 3350
+ 3351
+ 3352
+ 3353
+ 3354
+ 3355
+ 3356
+ 3357
+ 3358
+ 3359
+ 3360
+ 3361
+ 3362
+ 3363
+ 3364
+ 3365
+ 3366
+ 3367
+ 3368
+ 3369
+ 3370
+ 3371
+ 3372
+ 3373
+ 3374
+ 3375
+ 3376
+ 3377
+ 3378
+ 3379
+ 3380
+ 3381
+ 3382
+ 3383
+ 3384
+ 3385
+ 3386
+ 3387
+ 3388
+ 3389
+ 3390
+ 3391
+ 3392
+ 3393
+ 3394
+ 3395
+ 3396
+ 3397
+ 3398
+ 3399
+ 3400
+ 3401
+ 3402
+ 3403
+ 3404
+ 3405
+ 3406
+ 3407
+ 3408
+ 3409
+ 3410
+ 3411
+ 3412
+ 3413
+ 3414
+ 3415
+ 3416
+ 3417
+ 3418
+ 3419
+ 3420
+ 3421
+ 3422
+ 3423
+ 3424
+ 3425
+ 3426
+ 3427
+ 3428
+ 3429
+ 3430
+ 3431
+ 3432
+ 3433
+ 3434
+ 3435
+ 3436
+ 3437
+ 3438
+ 3439
+ 3440
+ 3441
+ 3442
+ 3443
+ 3444
+ 3445
+ 3446
+ 3447
+ 3448
+ 3449
+ 3450
+ 3451
+ 3452
+ 3453
+ 3454
+ 3455
+ 3456
+ 3457
+ 3458
+ 3459
+ 3460
+ 3461
+ 3462
+ 3463
+ 3464
+ 3465
+ 3466
+ 3467
+ 3468
+ 3469
+ 3470
+ 3471
+ 3472
+ 3473
+ 3474
+ 3475
+ 3476
+ 3477
+ 3478
+ 3479
+ 3480
+ 3481
+ 3482
+ 3483
+ 3484
+ 3485
+ 3486
+ 3487
+ 3488
+ 3489
+ 3490
+ 3491
+ 3492
+ 3493
+ 3494
+ 3495
+ 3496
+ 3497
+ 3498
+ 3499
+ 3500
+ 3501
+ 3502
+ 3503
+ 3504
+ 3505
+ 3506
+ 3507
+ 3508
+ 3509
+ 3510
+ 3511
+ 3512
+ 3513
+ 3514
+ 3515
+ 3516
+ 3517
+ 3518
+ 3519
+ 3520
+ 3521
+ 3522
+ 3523
+ 3524
+ 3525
+ 3526
+ 3527
+ 3528
+ 3529
+ 3530
+ 3531
+ 3532
+ 3533
+ 3534
+ 3535
+ 3536
+ 3537
+ 3538
+ 3539
+ 3540
+ 3541
+ 3542
+ 3543
+ 3544
+ 3545
+ 3546
+ 3547
+ 3548
+ 3549
+ 3550
+ 3551
+ 3552
+ 3553
+ 3554
+ 3555
+ 3556
+ 3557
+ 3558
+ 3559
+ 3560
+ 3561
+ 3562
+ 3563
+ 3564
+ 3565
+ 3566
+ 3567
+ 3568
+ 3569
+ 3570
+ 3571
+ 3572
+ 3573
+ 3574
+ 3575
+ 3576
+ 3577
+ 3578
+ 3579
+ 3580
+ 3581
+ 3582
+ 3583
+ 3584
+ 3585
+ 3586
+ 3587
+ 3588
+ 3589
+ 3590
+ 3591
+ 3592
+ 3593
+ 3594
+ 3595
+ 3596
+ 3597
+ 3598
+ 3599
+ 3600
+ 3601
+ 3602
+ 3603
+ 3604
+ 3605
+ 3606
+ 3607
+ 3608
+ 3609
+ 3610
+ 3611
+ 3612
+ 3613
+ 3614
+ 3615
+ 3616
+ 3617
+ 3618
+ 3619
+ 3620
+ 3621
+ 3622
+ 3623
+ 3624
+ 3625
+ 3626
+ 3627
+ 3628
+ 3629
+ 3630
+ 3631
+ 3632
+ 3633
+ 3634
+ 3635
+ 3636
+ 3637
+ 3638
+ 3639
+ 3640
+ 3641
+ 3642
+ 3643
+ 3644
+ 3645
+ 3646
+ 3647
+ 3648
+ 3649
+ 3650
+ 3651
+ 3652
+ 3653
+ 3654
+ 3655
+ 3656
+ 3657
+ 3658
+ 3659
+ 3660
+ 3661
+ 3662
+ 3663
+ 3664
+ 3665
+ 3666
+ 3667
+ 3668
+ 3669
+ 3670
+ 3671
+ 3672
+ 3673
+ 3674
+ 3675
+ 3676
+ 3677
+ 3678
+ 3679
+ 3680
+ 3681
+ 3682
+ 3683
+ 3684
+ 3685
+ 3686
+ 3687
+ 3688
+ 3689
+ 3690
+ 3691
+ 3692
+ 3693
+ 3694
+ 3695
+ 3696
+ 3697
+ 3698
+ 3699
+ 3700
+ 3701
+ 3702
+ 3703
+ 3704
+ 3705
+ 3706
+ 3707
+ 3708
+ 3709
+ 3710
+ 3711
+ 3712
+ 3713
+ 3714
+ 3715
+ 3716
+ 3717
+ 3718
+ 3719
+ 3720
+ 3721
+ 3722
+ 3723
+ 3724
+ 3725
+ 3726
+ 3727
+ 3728
+ 3729
+ 3730
+ 3731
+ 3732
+ 3733
+ 3734
+ 3735
+ 3736
+ 3737
+ 3738
+ 3739
+ 3740
+ 3741
+ 3742
+ 3743
+ 3744
+ 3745
+ 3746
+ 3747
+ 3748
+ 3749
+ 3750
+ 3751
+ 3752
+ 3753
+ 3754
+ 3755
+ 3756
+ 3757
+ 3758
+ 3759
+ 3760
+ 3761
+ 3762
+ 3763
+ 3764
+ 3765
+ 3766
+ 3767
+ 3768
+ 3769
+ 3770
+ 3771
+ 3772
+ 3773
+ 3774
+ 3775
+ 3776
+ 3777
+ 3778
+ 3779
+ 3780
+ 3781
+ 3782
+ 3783
+ 3784
+ 3785
+ 3786
+ 3787
+ 3788
+ 3789
+ 3790
+ 3791
+ 3792
+ 3793
+ 3794
+ 3795
+ 3796
+ 3797
+ 3798
+ 3799
+ 3800
+ 3801
+ 3802
+ 3803
+ 3804
+ 3805
+ 3806
+ 3807
+ 3808
+ 3809
+ 3810
+ 3811
+ 3812
+ 3813
+ 3814
+ 3815
+ 3816
+ 3817
+ 3818
+ 3819
+ 3820
+ 3821
+ 3822
+ 3823
+ 3824
+ 3825
+ 3826
+ 3827
+ 3828
+ 3829
+ 3830
+ 3831
+ 3832
+ 3833
+ 3834
+ 3835
+ 3836
+ 3837
+ 3838
+ 3839
+ 3840
+ 3841
+ 3842
+ 3843
+ 3844
+ 3845
+ 3846
+ 3847
+ 3848
+ 3849
+ 3850
+ 3851
+ 3852
+ 3853
+ 3854
+ 3855
+ 3856
+ 3857
+ 3858
+ 3859
+ 3860
+ 3861
+ 3862
+ 3863
+ 3864
+ 3865
+ 3866
+ 3867
+ 3868
+ 3869
+ 3870
+ 3871
+ 3872
+ 3873
+ 3874
+ 3875
+ 3876
+ 3877
+ 3878
+ 3879
+ 3880
+ 3881
+ 3882
+ 3883
+ 3884
+ 3885
+ 3886
+ 3887
+ 3888
+ 3889
+ 3890
+ 3891
+ 3892
+ 3893
+ 3894
+ 3895
+ 3896
+ 3897
+ 3898
+ 3899
+ 3900
+ 3901
+ 3902
+ 3903
+ 3904
+ 3905
+ 3906
+ 3907
+ 3908
+ 3909
+ 3910
+ 3911
+ 3912
+ 3913
+ 3914
+ 3915
+ 3916
+ 3917
+ 3918
+ 3919
+ 3920
+ 3921
+ 3922
+ 3923
+ 3924
+ 3925
+ 3926
+ 3927
+ 3928
+ 3929
+ 3930
+ 3931
+ 3932
+ 3933
+ 3934
+ 3935
+ 3936
+ 3937
+ 3938
+ 3939
+ 3940
+ 3941
+ 3942
+ 3943
+ 3944
+ 3945
+ 3946
+ 3947
+ 3948
+ 3949
+ 3950
+ 3951
+ 3952
+ 3953
+ 3954
+ 3955
+ 3956
+ 3957
+ 3958
+ 3959
+ 3960
+ 3961
+ 3962
+ 3963
+ 3964
+ 3965
+ 3966
+ 3967
+ 3968
+ 3969
+ 3970
+ 3971
+ 3972
+ 3973
+ 3974
+ 3975
+ 3976
+ 3977
+ 3978
+ 3979
+ 3980
+ 3981
+ 3982
+ 3983
+ 3984
+ 3985
+ 3986
+ 3987
+ 3988
+ 3989
+ 3990
+ 3991
+ 3992
+ 3993
+ 3994
+ 3995
+ 3996
+ 3997
+ 3998
+ 3999
+ 4000
+ 4001
+ 4002
+ 4003
+ 4004
+ 4005
+ 4006
+ 4007
+ 4008
+ 4009
+ 4010
+ 4011
+ 4012
+ 4013
+ 4014
+ 4015
+ 4016
+ 4017
+ 4018
+ 4019
+ 4020
+ 4021
+ 4022
+ 4023
+ 4024
+ 4025
+ 4026
+ 4027
+ 4028
+ 4029
+ 4030
+ 4031
+ 4032
+ 4033
+ 4034
+ 4035
+ 4036
+ 4037
+ 4038
+ 4039
+ 4040
+ 4041
+ 4042
+ 4043
+ 4044
+ 4045
+ 4046
+ 4047
+ 4048
+ 4049
+ 4050
+ 4051
+ 4052
+ 4053
+ 4054
+ 4055
+ 4056
+ 4057
+ 4058
+ 4059
+ 4060
+ 4061
+ 4062
+ 4063
+ 4064
+ 4065
+ 4066
+ 4067
+ 4068
+ 4069
+ 4070
+ 4071
+ 4072
+ 4073
+ 4074
+ 4075
+ 4076
+ 4077
+ 4078
+ 4079
+ 4080
+ 4081
+ 4082
+ 4083
+ 4084
+ 4085
+ 4086
+ 4087
+ 4088
+ 4089
+ 4090
+ 4091
+ 4092
+ 4093
+ 4094
+ 4095
+ 4096
+ 4097
+ 4098
+ 4099
+ 4100
+ 4101
+ 4102
+ 4103
+ 4104
+ 4105
+ 4106
+ 4107
+ 4108
+ 4109
+ 4110
+ 4111
+ 4112
+ 4113
+ 4114
+ 4115
+ 4116
+ 4117
+ 4118
+ 4119
+ 4120
+ 4121
+ 4122
+ 4123
+ 4124
+ 4125
+ 4126
+ 4127
+ 4128
+ 4129
+ 4130
+ 4131
+ 4132
+ 4133
+ 4134
+ 4135
+ 4136
+ 4137
+ 4138
+ 4139
+ 4140
+ 4141
+ 4142
+ 4143
+ 4144
+ 4145
+ 4146
+ 4147
+ 4148
+ 4149
+ 4150
+ 4151
+ 4152
+ 4153
+ 4154
+ 4155
+ 4156
+ 4157
+ 4158
+ 4159
+ 4160
+ 4161
+ 4162
+ 4163
+ 4164
+ 4165
+ 4166
+ 4167
+ 4168
+ 4169
+ 4170
+ 4171
+ 4172
+ 4173
+ 4174
+ 4175
+ 4176
+ 4177
+ 4178
+ 4179
+ 4180
+ 4181
+ 4182
+ 4183
+ 4184
+ 4185
+ 4186
+ 4187
+ 4188
+ 4189
+ 4190
+ 4191
+ 4192
+ 4193
+ 4194
+ 4195
+ 4196
+ 4197
+ 4198
+ 4199
+ 4200
+ 4201
+ 4202
+ 4203
+ 4204
+ 4205
+ 4206
+ 4207
+ 4208
+ 4209
+ 4210
+ 4211
+ 4212
+ 4213
+ 4214
+ 4215
+ 4216
+ 4217
+ 4218
+ 4219
+ 4220
+ 4221
+ 4222
+ 4223
+ 4224
+ 4225
+ 4226
+ 4227
+ 4228
+ 4229
+ 4230
+ 4231
+ 4232
+ 4233
+ 4234
+ 4235
+ 4236
+ 4237
+ 4238
+ 4239
+ 4240
+ 4241
+ 4242
+ 4243
+ 4244
+ 4245
+ 4246
+ 4247
+ 4248
+ 4249
+ 4250
+ 4251
+ 4252
+ 4253
+ 4254
+ 4255
+ 4256
+ 4257
+ 4258
+ 4259
+ 4260
+ 4261
+ 4262
+ 4263
+ 4264
+ 4265
+ 4266
+ 4267
+ 4268
+ 4269
+ 4270
+ 4271
+ 4272
+ 4273
+ 4274
+ 4275
+ 4276
+ 4277
+ 4278
+ 4279
+ 4280
+ 4281
+ 4282
+ 4283
+ 4284
+ 4285
+ 4286
+ 4287
+ 4288
+ 4289
+ 4290
+ 4291
+ 4292
+ 4293
+ 4294
+ 4295
+ 4296
+ 4297
+ 4298
+ 4299
+ 4300
+ 4301
+ 4302
+ 4303
+ 4304
+ 4305
+ 4306
+ 4307
+ 4308
+ 4309
+ 4310
+ 4311
+ 4312
+ 4313
+ 4314
+ 4315
+ 4316
+ 4317
+ 4318
+ 4319
+ 4320
+ 4321
+ 4322
+ 4323
+ 4324
+ 4325
+ 4326
+ 4327
+ 4328
+ 4329
+ 4330
+ 4331
+ 4332
+ 4333
+ 4334
+ 4335
+ 4336
+ 4337
+ 4338
+ 4339
+ 4340
+ 4341
+ 4342
+ 4343
+ 4344
+ 4345
+ 4346
+ 4347
+ 4348
+ 4349
+ 4350
+ 4351
+ 4352
+ 4353
+ 4354
+ 4355
+ 4356
+ 4357
+ 4358
+ 4359
+ 4360
+ 4361
+ 4362
+ 4363
+ 4364
+ 4365
+ 4366
+ 4367
+ 4368
+ 4369
+ 4370
+ 4371
+ 4372
+ 4373
+ 4374
+ 4375
+ 4376
+ 4377
+ 4378
+ 4379
+ 4380
+ 4381
+ 4382
+ 4383
+ 4384
+ 4385
+ 4386
+ 4387
+ 4388
+ 4389
+ 4390
+ 4391
+ 4392
+ 4393
+ 4394
+ 4395
+ 4396
+ 4397
+ 4398
+ 4399
+ 4400
+ 4401
+ 4402
+ 4403
+ 4404
+ 4405
+ 4406
+ 4407
+ 4408
+ 4409
+ 4410
+ 4411
+ 4412
+ 4413
+ 4414
+ 4415
+ 4416
+ 4417
+ 4418
+ 4419
+ 4420
+ 4421
+ 4422
+ 4423
+ 4424
+ 4425
+ 4426
+ 4427
+ 4428
+ 4429
+ 4430
+ 4431
+ 4432
+ 4433
+ 4434
+ 4435
+ 4436
+ 4437
+ 4438
+ 4439
+ 4440
+ 4441
+ 4442
+ 4443
+ 4444
+ 4445
+ 4446
+ 4447
+ 4448
+ 4449
+ 4450
+ 4451
+ 4452
+ 4453
+ 4454
+ 4455
+ 4456
+ 4457
+ 4458
+ 4459
+ 4460
+ 4461
+ 4462
+ 4463
+ 4464
+ 4465
+ 4466
+ 4467
+ 4468
+ 4469
+ 4470
+ 4471
+ 4472
+ 4473
+ 4474
+ 4475
+ 4476
+ 4477
+ 4478
+ 4479
+ 4480
+ 4481
+ 4482
+ 4483
+ 4484
+ 4485
+ 4486
+ 4487
+ 4488
+ 4489
+ 4490
+ 4491
+ 4492
+ 4493
+ 4494
+ 4495
+ 4496
+ 4497
+ 4498
+ 4499
+ 4500
+ 4501
+ 4502
+ 4503
+ 4504
+ 4505
+ 4506
+ 4507
+ 4508
+ 4509
+ 4510
+ 4511
+ 4512
+ 4513
+ 4514
+ 4515
+ 4516
+ 4517
+ 4518
+ 4519
+ 4520
+ 4521
+ 4522
+ 4523
+ 4524
+ 4525
+ 4526
+ 4527
+ 4528
+ 4529
+ 4530
+ 4531
+ 4532
+ 4533
+ 4534
+ 4535
+ 4536
+ 4537
+ 4538
+ 4539
+ 4540
+ 4541
+ 4542
+ 4543
+ 4544
+ 4545
+ 4546
+ 4547
+ 4548
+ 4549
+ 4550
+ 4551
+ 4552
+ 4553
+ 4554
+ 4555
+ 4556
+ 4557
+ 4558
+ 4559
+ 4560
+ 4561
+ 4562
+ 4563
+ 4564
+ 4565
+ 4566
+ 4567
+ 4568
+ 4569
+ 4570
+ 4571
+ 4572
+ 4573
+ 4574
+ 4575
+ 4576
+ 4577
+ 4578
+ 4579
+ 4580
+ 4581
+ 4582
+ 4583
+ 4584
+ 4585
+ 4586
+ 4587
+ 4588
+ 4589
+ 4590
+ 4591
+ 4592
+ 4593
+ 4594
+ 4595
+ 4596
+ 4597
+ 4598
+ 4599
+ 4600
+ 4601
+ 4602
+ 4603
+ 4604
+ 4605
+ 4606
+ 4607
+ 4608
+ 4609
+ 4610
+ 4611
+ 4612
+ 4613
+ 4614
+ 4615
+ 4616
+ 4617
+ 4618
+ 4619
+ 4620
+ 4621
+ 4622
+ 4623
+ 4624
+ 4625
+ 4626
+ 4627
+ 4628
+ 4629
+ 4630
+ 4631
+ 4632
+ 4633
+ 4634
+ 4635
+ 4636
+ 4637
+ 4638
+ 4639
+ 4640
+ 4641
+ 4642
+ 4643
+ 4644
+ 4645
+ 4646
+ 4647
+ 4648
+ 4649
+ 4650
+ 4651
+ 4652
+ 4653
+ 4654
+ 4655
+ 4656
+ 4657
+ 4658
+ 4659
+ 4660
+ 4661
+ 4662
+ 4663
+ 4664
+ 4665
+ 4666
+ 4667
+ 4668
+ 4669
+ 4670
+ 4671
+ 4672
+ 4673
+ 4674
+ 4675
+ 4676
+ 4677
+ 4678
+ 4679
+ 4680
+ 4681
+ 4682
+ 4683
+ 4684
+ 4685
+ 4686
+ 4687
+ 4688
+ 4689
+ 4690
+ 4691
+ 4692
+ 4693
+ 4694
+ 4695
+ 4696
+ 4697
+ 4698
+ 4699
+ 4700
+ 4701
+ 4702
+ 4703
+ 4704
+ 4705
+ 4706
+ 4707
+ 4708
+ 4709
+ 4710
+ 4711
+ 4712
+ 4713
+ 4714
+ 4715
+ 4716
+ 4717
+ 4718
+ 4719
+ 4720
+ 4721
+ 4722
+ 4723
+ 4724
+ 4725
+ 4726
+ 4727
+ 4728
+ 4729
+ 4730
+ 4731
+ 4732
+ 4733
+ 4734
+ 4735
+ 4736
+ 4737
+ 4738
+ 4739
+ 4740
+ 4741
+ 4742
+ 4743
+ 4744
+ 4745
+ 4746
+ 4747
+ 4748
+ 4749
+ 4750
+ 4751
+ 4752
+ 4753
+ 4754
+ 4755
+ 4756
+ 4757
+ 4758
+ 4759
+ 4760
+ 4761
+ 4762
+ 4763
+ 4764
+ 4765
+ 4766
+ 4767
+ 4768
+ 4769
+ 4770
+ 4771
+ 4772
+ 4773
+ 4774
+ 4775
+ 4776
+ 4777
+ 4778
+ 4779
+ 4780
+ 4781
+ 4782
+ 4783
+ 4784
+ 4785
+ 4786
+ 4787
+ 4788
+ 4789
+ 4790
+ 4791
+ 4792
+ 4793
+ 4794
+ 4795
+ 4796
+ 4797
+ 4798
+ 4799
+ 4800
+ 4801
+ 4802
+ 4803
+ 4804
+ 4805
+ 4806
+ 4807
+ 4808
+ 4809
+ 4810
+ 4811
+ 4812
+ 4813
+ 4814
+ 4815
+ 4816
+ 4817
+ 4818
+ 4819
+ 4820
+ 4821
+ 4822
+ 4823
+ 4824
+ 4825
+ 4826
+ 4827
+ 4828
+ 4829
+ 4830
+ 4831
+ 4832
+ 4833
+ 4834
+ 4835
+ 4836
+ 4837
+ 4838
+ 4839
+ 4840
+ 4841
+ 4842
+ 4843
+ 4844
+ 4845
+ 4846
+ 4847
+ 4848
+ 4849
+ 4850
+ 4851
+ 4852
+ 4853
+ 4854
+ 4855
+ 4856
+ 4857
+ 4858
+ 4859
+ 4860
+ 4861
+ 4862
+ 4863
+ 4864
+ 4865
+ 4866
+ 4867
+ 4868
+ 4869
+ 4870
+ 4871
+ 4872
+ 4873
+ 4874
+ 4875
+ 4876
+ 4877
+ 4878
+ 4879
+ 4880
+ 4881
+ 4882
+ 4883
+ 4884
+ 4885
+ 4886
+ 4887
+ 4888
+ 4889
+ 4890
+ 4891
+ 4892
+ 4893
+ 4894
+ 4895
+ 4896
+ 4897
+ 4898
+ 4899
+ 4900
+ 4901
+ 4902
+ 4903
+ 4904
+ 4905
+ 4906
+ 4907
+ 4908
+ 4909
+ 4910
+ 4911
+ 4912
+ 4913
+ 4914
+ 4915
+ 4916
+ 4917
+ 4918
+ 4919
+ 4920
+ 4921
+ 4922
+ 4923
+ 4924
+ 4925
+ 4926
+ 4927
+ 4928
+ 4929
+ 4930
+ 4931
+ 4932
+ 4933
+ 4934
+ 4935
+ 4936
+ 4937
+ 4938
+ 4939
+ 4940
+ 4941
+ 4942
+ 4943
+ 4944
+ 4945
+ 4946
+ 4947
+ 4948
+ 4949
+ 4950
+ 4951
+ 4952
+ 4953
+ 4954
+ 4955
+ 4956
+ 4957
+ 4958
+ 4959
+ 4960
+ 4961
+ 4962
+ 4963
+ 4964
+ 4965
+ 4966
+ 4967
+ 4968
+ 4969
+ 4970
+ 4971
+ 4972
+ 4973
+ 4974
+ 4975
+ 4976
+ 4977
+ 4978
+ 4979
+ 4980
+ 4981
+ 4982
+ 4983
+ 4984
+ 4985
+ 4986
+ 4987
+ 4988
+ 4989
+ 4990
+ 4991
+ 4992
+ 4993
+ 4994
+ 4995
+ 4996
+ 4997
+ 4998
+ 4999
+ 5000
+ 5001
+ 5002
+ 5003
+ 5004
+ 5005
+ 5006
+ 5007
+ 5008
+ 5009
+ 5010
+ 5011
+ 5012
+ 5013
+ 5014
+ 5015
+ 5016
+ 5017
+ 5018
+ 5019
+ 5020
+ 5021
+ 5022
+ 5023
+ 5024
+ 5025
+ 5026
+ 5027
+ 5028
+ 5029
+ 5030
+ 5031
+ 5032
+ 5033
+ 5034
+ 5035
+ 5036
+ 5037
+ 5038
+ 5039
+ 5040
+ 5041
+ 5042
+ 5043
+ 5044
+ 5045
+ 5046
+ 5047
+ 5048
+ 5049
+ 5050
+ 5051
+ 5052
+ 5053
+ 5054
+ 5055
+ 5056
+ 5057
+ 5058
+ 5059
+ 5060
+ 5061
+ 5062
+ 5063
+ 5064
+ 5065
+ 5066
+ 5067
+ 5068
+ 5069
+ 5070
+ 5071
+ 5072
+ 5073
+ 5074
+ 5075
+ 5076
+ 5077
+ 5078
+ 5079
+ 5080
+ 5081
+ 5082
+ 5083
+ 5084
+ 5085
+ 5086
+ 5087
+ 5088
+ 5089
+ 5090
+ 5091
+ 5092
+ 5093
+ 5094
+ 5095
+ 5096
+ 5097
+ 5098
+ 5099
+ 5100
+ 5101
+ 5102
+ 5103
+ 5104
+ 5105
+ 5106
+ 5107
+ 5108
+ 5109
+ 5110
+ 5111
+ 5112
+ 5113
+ 5114
+ 5115
+ 5116
+ 5117
+ 5118
+ 5119
+ 5120
+ 5121
+ 5122
+ 5123
+ 5124
+ 5125
+ 5126
+ 5127
+ 5128
+ 5129
+ 5130
+ 5131
+ 5132
+ 5133
+ 5134
+ 5135
+ 5136
+ 5137
+ 5138
+ 5139
+ 5140
+ 5141
+ 5142
+ 5143
+ 5144
+ 5145
+ 5146
+ 5147
+ 5148
+ 5149
+ 5150
+ 5151
+ 5152
+ 5153
+ 5154
+ 5155
+ 5156
+ 5157
+ 5158
+ 5159
+ 5160
+ 5161
+ 5162
+ 5163
+ 5164
+ 5165
+ 5166
+ 5167
+ 5168
+ 5169
+ 5170
+ 5171
+ 5172
+ 5173
+ 5174
+ 5175
+ 5176
+ 5177
+ 5178
+ 5179
+ 5180
+ 5181
+ 5182
+ 5183
+ 5184
+ 5185
+ 5186
+ 5187
+ 5188
+ 5189
+ 5190
+ 5191
+ 5192
+ 5193
+ 5194
+ 5195
+ 5196
+ 5197
+ 5198
+ 5199
+ 5200
+ 5201
+ 5202
+ 5203
+ 5204
+ 5205
+ 5206
+ 5207
+ 5208
+ 5209
+ 5210
+ 5211
+ 5212
+ 5213
+ 5214
+ 5215
+ 5216
+ 5217
+ 5218
+ 5219
+ 5220
+ 5221
+ 5222
+ 5223
+ 5224
+ 5225
+ 5226
+ 5227
+ 5228
+ 5229
+ 5230
+ 5231
+ 5232
+ 5233
+ 5234
+ 5235
+ 5236
+ 5237
+ 5238
+ 5239
+ 5240
+ 5241
+ 5242
+ 5243
+ 5244
+ 5245
+ 5246
+ 5247
+ 5248
+ 5249
+ 5250
+ 5251
+ 5252
+ 5253
+ 5254
+ 5255
+ 5256
+ 5257
+ 5258
+ 5259
+ 5260
+ 5261
+ 5262
+ 5263
+ 5264
+ 5265
+ 5266
+ 5267
+ 5268
+ 5269
+ 5270
+ 5271
+ 5272
+ 5273
+ 5274
+ 5275
+ 5276
+ 5277
+ 5278
+ 5279
+ 5280
+ 5281
+ 5282
+ 5283
+ 5284
+ 5285
+ 5286
+ 5287
+ 5288
+ 5289
+ 5290
+ 5291
+ 5292
+ 5293
+ 5294
+ 5295
+ 5296
+ 5297
+ 5298
+ 5299
+ 5300
+ 5301
+ 5302
+ 5303
+ 5304
+ 5305
+ 5306
+ 5307
+ 5308
+ 5309
+ 5310
+ 5311
+ 5312
+ 5313
+ 5314
+ 5315
+ 5316
+ 5317
+ 5318
+ 5319
+ 5320
+ 5321
+ 5322
+ 5323
+ 5324
+ 5325
+ 5326
+ 5327
+ 5328
+ 5329
+ 5330
+ 5331
+ 5332
+ 5333
+ 5334
+ 5335
+ 5336
+ 5337
+ 5338
+ 5339
+ 5340
+ 5341
+ 5342
+ 5343
+ 5344
+ 5345
+ 5346
+ 5347
+ 5348
+ 5349
+ 5350
+ 5351
+ 5352
+ 5353
+ 5354
+ 5355
+ 5356
+ 5357
+ 5358
+ 5359
+ 5360
+ 5361
+ 5362
+ 5363
+ 5364
+ 5365
+ 5366
+ 5367
+ 5368
+ 5369
+ 5370
+ 5371
+ 5372
+ 5373
+ 5374
+ 5375
+ 5376
+ 5377
+ 5378
+ 5379
+ 5380
+ 5381
+ 5382
+ 5383
+ 5384
+ 5385
+ 5386
+ 5387
+ 5388
+ 5389
+ 5390
+ 5391
+ 5392
+ 5393
+ 5394
+ 5395
+ 5396
+ 5397
+ 5398
+ 5399
+ 5400
+ 5401
+ 5402
+ 5403
+ 5404
+ 5405
+ 5406
+ 5407
+ 5408
+ 5409
+ 5410
+ 5411
+ 5412
+ 5413
+ 5414
+ 5415
+ 5416
+ 5417
+ 5418
+ 5419
+ 5420
+ 5421
+ 5422
+ 5423
+ 5424
+ 5425
+ 5426
+ 5427
+ 5428
+ 5429
+ 5430
+ 5431
+ 5432
+ 5433
+ 5434
+ 5435
+ 5436
+ 5437
+ 5438
+ 5439
+ 5440
+ 5441
+ 5442
+ 5443
+ 5444
+ 5445
+ 5446
+ 5447
+ 5448
+ 5449
+ 5450
+ 5451
+ 5452
+ 5453
+ 5454
+ 5455
+ 5456
+ 5457
+ 5458
+ 5459
+ 5460
+ 5461
+ 5462
+ 5463
+ 5464
+ 5465
+ 5466
+ 5467
+ 5468
+ 5469
+ 5470
+ 5471
+ 5472
+ 5473
+ 5474
+ 5475
+ 5476
+ 5477
+ 5478
+ 5479
+ 5480
+ 5481
+ 5482
+ 5483
+ 5484
+ 5485
+ 5486
+ 5487
+ 5488
+ 5489
+ 5490
+ 5491
+ 5492
+ 5493
+ 5494
+ 5495
+ 5496
+ 5497
+ 5498
+ 5499
+ 5500
+ 5501
+ 5502
+ 5503
+ 5504
+ 5505
+ 5506
+ 5507
+ 5508
+ 5509
+ 5510
+ 5511
+ 5512
+ 5513
+ 5514
+ 5515
+ 5516
+ 5517
+ 5518
+ 5519
+ 5520
+ 5521
+ 5522
+ 5523
+ 5524
+ 5525
+ 5526
+ 5527
+ 5528
+ 5529
+ 5530
+ 5531
+ 5532
+ 5533
+ 5534
+ 5535
+ 5536
+ 5537
+ 5538
+ 5539
+ 5540
+ 5541
+ 5542
+ 5543
+ 5544
+ 5545
+ 5546
+ 5547
+ 5548
+ 5549
+ 5550
+ 5551
+ 5552
+ 5553
+ 5554
+ 5555
+ 5556
+ 5557
+ 5558
+ 5559
+ 5560
+ 5561
+ 5562
+ 5563
+ 5564
+ 5565
+ 5566
+ 5567
+ 5568
+ 5569
+ 5570
+ 5571
+ 5572
+ 5573
+ 5574
+ 5575
+ 5576
+ 5577
+ 5578
+ 5579
+ 5580
+ 5581
+ 5582
+ 5583
+ 5584
+ 5585
+ 5586
+ 5587
+ 5588
+ 5589
+ 5590
+ 5591
+ 5592
+ 5593
+ 5594
+ 5595
+ 5596
+ 5597
+ 5598
+ 5599
+ 5600
+ 5601
+ 5602
+ 5603
+ 5604
+ 5605
+ 5606
+ 5607
+ 5608
+ 5609
+ 5610
+ 5611
+ 5612
+ 5613
+ 5614
+ 5615
+ 5616
+ 5617
+ 5618
+ 5619
+ 5620
+ 5621
+ 5622
+ 5623
+ 5624
+ 5625
+ 5626
+ 5627
+ 5628
+ 5629
+ 5630
+ 5631
+ 5632
+ 5633
+ 5634
+ 5635
+ 5636
+ 5637
+ 5638
+ 5639
+ 5640
+ 5641
+ 5642
+ 5643
+ 5644
+ 5645
+ 5646
+ 5647
+ 5648
+ 5649
+ 5650
+ 5651
+ 5652
+ 5653
+ 5654
+ 5655
+ 5656
+ 5657
+ 5658
+ 5659
+ 5660
+ 5661
+ 5662
+ 5663
+ 5664
+ 5665
+ 5666
+ 5667
+ 5668
+ 5669
+ 5670
+ 5671
+ 5672
+ 5673
+ 5674
+ 5675
+ 5676
+ 5677
+ 5678
+ 5679
+ 5680
+ 5681
+ 5682
+ 5683
+ 5684
+ 5685
+ 5686
+ 5687
+ 5688
+ 5689
+ 5690
+ 5691
+ 5692
+ 5693
+ 5694
+ 5695
+ 5696
+ 5697
+ 5698
+ 5699
+ 5700
+ 5701
+ 5702
+ 5703
+ 5704
+ 5705
+ 5706
+ 5707
+ 5708
+ 5709
+ 5710
+ 5711
+ 5712
+ 5713
+ 5714
+ 5715
+ 5716
+ 5717
+ 5718
+ 5719
+ 5720
+ 5721
+ 5722
+ 5723
+ 5724
+ 5725
+ 5726
+ 5727
+ 5728
+ 5729
+ 5730
+ 5731
+ 5732
+ 5733
+ 5734
+ 5735
+ 5736
+ 5737
+ 5738
+ 5739
+ 5740
+ 5741
+ 5742
+ 5743
+ 5744
+ 5745
+ 5746
+ 5747
+ 5748
+ 5749
+ 5750
+ 5751
+ 5752
+ 5753
+ 5754
+ 5755
+ 5756
+ 5757
+ 5758
+ 5759
+ 5760
+ 5761
+ 5762
+ 5763
+ 5764
+ 5765
+ 5766
+ 5767
+ 5768
+ 5769
+ 5770
+ 5771
+ 5772
+ 5773
+ 5774
+ 5775
+ 5776
+ 5777
+ 5778
+ 5779
+ 5780
+ 5781
+ 5782
+ 5783
+ 5784
+ 5785
+ 5786
+ 5787
+ 5788
+ 5789
+ 5790
+ 5791
+ 5792
+ 5793
+ 5794
+ 5795
+ 5796
+ 5797
+ 5798
+ 5799
+ 5800
+ 5801
+ 5802
+ 5803
+ 5804
+ 5805
+ 5806
+ 5807
+ 5808
+ 5809
+ 5810
+ 5811
+ 5812
+ 5813
+ 5814
+ 5815
+ 5816
+ 5817
+ 5818
+ 5819
+ 5820
+ 5821
+ 5822
+ 5823
+ 5824
+ 5825
+ 5826
+ 5827
+ 5828
+ 5829
+ 5830
+ 5831
+ 5832
+ 5833
+ 5834
+ 5835
+ 5836
+ 5837
+ 5838
+ 5839
+ 5840
+ 5841
+ 5842
+ 5843
+ 5844
+ 5845
+ 5846
+ 5847
+ 5848
+ 5849
+ 5850
+ 5851
+ 5852
+ 5853
+ 5854
+ 5855
+ 5856
+ 5857
+ 5858
+ 5859
+ 5860
+ 5861
+ 5862
+ 5863
+ 5864
+ 5865
+ 5866
+ 5867
+ 5868
+ 5869
+ 5870
+ 5871
+ 5872
+ 5873
+ 5874
+ 5875
+ 5876
+ 5877
+ 5878
+ 5879
+ 5880
+ 5881
+ 5882
+ 5883
+ 5884
+ 5885
+ 5886
+ 5887
+ 5888
+ 5889
+ 5890
+ 5891
+ 5892
+ 5893
+ 5894
+ 5895
+ 5896
+ 5897
+ 5898
+ 5899
+ 5900
+ 5901
+ 5902
+ 5903
+ 5904
+ 5905
+ 5906
+ 5907
+ 5908
+ 5909
+ 5910
+ 5911
+ 5912
+ 5913
+ 5914
+ 5915
+ 5916
+ 5917
+ 5918
+ 5919
+ 5920
+ 5921
+ 5922
+ 5923
+ 5924
+ 5925
+ 5926
+ 5927
+ 5928
+ 5929
+ 5930
+ 5931
+ 5932
+ 5933
+ 5934
+ 5935
+ 5936
+ 5937
+ 5938
+ 5939
+ 5940
+ 5941
+ 5942
+ 5943
+ 5944
+ 5945
+ 5946
+ 5947
+ 5948
+ 5949
+ 5950
+ 5951
+ 5952
+ 5953
+ 5954
+ 5955
+ 5956
+ 5957
+ 5958
+ 5959
+ 5960
+ 5961
+ 5962
+ 5963
+ 5964
+ 5965
+ 5966
+ 5967
+ 5968
+ 5969
+ 5970
+ 5971
+ 5972
+ 5973
+ 5974
+ 5975
+ 5976
+ 5977
+ 5978
+ 5979
+ 5980
+ 5981
+ 5982
+ 5983
+ 5984
+ 5985
+ 5986
+ 5987
+ 5988
+ 5989
+ 5990
+ 5991
+ 5992
+ 5993
+ 5994
+ 5995
+ 5996
+ 5997
+ 5998
+ 5999
+ 6000
+ 6001
+ 6002
+ 6003
+ 6004
+ 6005
+ 6006
+ 6007
+ 6008
+ 6009
+ 6010
+ 6011
+ 6012
+ 6013
+ 6014
+ 6015
+ 6016
+ 6017
+ 6018
+ 6019
+ 6020
+ 6021
+ 6022
+ 6023
+ 6024
+ 6025
+ 6026
+ 6027
+ 6028
+ 6029
+ 6030
+ 6031
+ 6032
+ 6033
+ 6034
+ 6035
+ 6036
+ 6037
+ 6038
+ 6039
+ 6040
+ 6041
+ 6042
+ 6043
+ 6044
+ 6045
+ 6046
+ 6047
+ 6048
+ 6049
+ 6050
+ 6051
+ 6052
+ 6053
+ 6054
+ 6055
+ 6056
+ 6057
+ 6058
+ 6059
+ 6060
+ 6061
+ 6062
+ 6063
+ 6064
+ 6065
+ 6066
+ 6067
+ 6068
+ 6069
+ 6070
+ 6071
+ 6072
+ 6073
+ 6074
+ 6075
+ 6076
+ 6077
+ 6078
+ 6079
+ 6080
+ 6081
+ 6082
+ 6083
+ 6084
+ 6085
+ 6086
+ 6087
+ 6088
+ 6089
+ 6090
+ 6091
+ 6092
+ 6093
+ 6094
+ 6095
+ 6096
+ 6097
+ 6098
+ 6099
+ 6100
+ 6101
+ 6102
+ 6103
+ 6104
+ 6105
+ 6106
+ 6107
+ 6108
+ 6109
+ 6110
+ 6111
+ 6112
+ 6113
+ 6114
+ 6115
+ 6116
+ 6117
+ 6118
+ 6119
+ 6120
+ 6121
+ 6122
+ 6123
+ 6124
+ 6125
+ 6126
+ 6127
+ 6128
+ 6129
+ 6130
+ 6131
+ 6132
+ 6133
+ 6134
+ 6135
+ 6136
+ 6137
+ 6138
+ 6139
+ 6140
+ 6141
+ 6142
+ 6143
+ 6144
+ 6145
+ 6146
+ 6147
+ 6148
+ 6149
+ 6150
+ 6151
+ 6152
+ 6153
+ 6154
+ 6155
+ 6156
+ 6157
+ 6158
+ 6159
+ 6160
+ 6161
+ 6162
+ 6163
+ 6164
+ 6165
+ 6166
+ 6167
+ 6168
+ 6169
+ 6170
+ 6171
+ 6172
+ 6173
+ 6174
+ 6175
+ 6176
+ 6177
+ 6178
+ 6179
+ 6180
+ 6181
+ 6182
+ 6183
+ 6184
+ 6185
+ 6186
+ 6187
+ 6188
+ 6189
+ 6190
+ 6191
+ 6192
+ 6193
+ 6194
+ 6195
+ 6196
+ 6197
+ 6198
+ 6199
+ 6200
+ 6201
+ 6202
+ 6203
+ 6204
+ 6205
+ 6206
+ 6207
+ 6208
+ 6209
+ 6210
+ 6211
+ 6212
+ 6213
+ 6214
+ 6215
+ 6216
+ 6217
+ 6218
+ 6219
+ 6220
+ 6221
+ 6222
+ 6223
+ 6224
+ 6225
+ 6226
+ 6227
+ 6228
+ 6229
+ 6230
+ 6231
+ 6232
+ 6233
+ 6234
+ 6235
+ 6236
+ 6237
+ 6238
+ 6239
+ 6240
+ 6241
+ 6242
+ 6243
+ 6244
+ 6245
+ 6246
+ 6247
+ 6248
+ 6249
+ 6250
+ 6251
+ 6252
+ 6253
+ 6254
+ 6255
+ 6256
+ 6257
+ 6258
+ 6259
+ 6260
+ 6261
+ 6262
+ 6263
+ 6264
+ 6265
+ 6266
+ 6267
+ 6268
+ 6269
+ 6270
+ 6271
+ 6272
+ 6273
+ 6274
+ 6275
+ 6276
+ 6277
+ 6278
+ 6279
+ 6280
+ 6281
+ 6282
+ 6283
+ 6284
+ 6285
+ 6286
+ 6287
+ 6288
+ 6289
+ 6290
+ 6291
+ 6292
+ 6293
+ 6294
+ 6295
+ 6296
+ 6297
+ 6298
+ 6299
+ 6300
+ 6301
+ 6302
+ 6303
+ 6304
+ 6305
+ 6306
+ 6307
+ 6308
+ 6309
+ 6310
+ 6311
+ 6312
+ 6313
+ 6314
+ 6315
+ 6316
+ 6317
+ 6318
+ 6319
+ 6320
+ 6321
+ 6322
+ 6323
+ 6324
+ 6325
+ 6326
+ 6327
+ 6328
+ 6329
+ 6330
+ 6331
+ 6332
+ 6333
+ 6334
+ 6335
+ 6336
+ 6337
+ 6338
+ 6339
+ 6340
+ 6341
+ 6342
+ 6343
+ 6344
+ 6345
+ 6346
+ 6347
+ 6348
+ 6349
+ 6350
+ 6351
+ 6352
+ 6353
+ 6354
+ 6355
+ 6356
+ 6357
+ 6358
+ 6359
+ 6360
+ 6361
+ 6362
+ 6363
+ 6364
+ 6365
+ 6366
+ 6367
+ 6368
+ 6369
+ 6370
+ 6371
+ 6372
+ 6373
+ 6374
+ 6375
+ 6376
+ 6377
+ 6378
+ 6379
+ 6380
+ 6381
+ 6382
+ 6383
+ 6384
+ 6385
+ 6386
+ 6387
+ 6388
+ 6389
+ 6390
+ 6391
+ 6392
+ 6393
+ 6394
+ 6395
+ 6396
+ 6397
+ 6398
+ 6399
+ 6400
+ 6401
+ 6402
+ 6403
+ 6404
+ 6405
+ 6406
+ 6407
+ 6408
+ 6409
+ 6410
+ 6411
+ 6412
+ 6413
+ 6414
+ 6415
+ 6416
+ 6417
+ 6418
+ 6419
+ 6420
+ 6421
+ 6422
+ 6423
+ 6424
+ 6425
+ 6426
+ 6427
+ 6428
+ 6429
+ 6430
+ 6431
+ 6432
+ 6433
+ 6434
+ 6435
+ 6436
+ 6437
+ 6438
+ 6439
+ 6440
+ 6441
+ 6442
+ 6443
+ 6444
+ 6445
+ 6446
+ 6447
+ 6448
+ 6449
+ 6450
+ 6451
+ 6452
+ 6453
+ 6454
+ 6455
+ 6456
+ 6457
+ 6458
+ 6459
+ 6460
+ 6461
+ 6462
+ 6463
+ 6464
+ 6465
+ 6466
+ 6467
+ 6468
+ 6469
+ 6470
+ 6471
+ 6472
+ 6473
+ 6474
+ 6475
+ 6476
+ 6477
+ 6478
+ 6479
+ 6480
+ 6481
+ 6482
+ 6483
+ 6484
+ 6485
+ 6486
+ 6487
+ 6488
+ 6489
+ 6490
+ 6491
+ 6492
+ 6493
+ 6494
+ 6495
+ 6496
+ 6497
+ 6498
+ 6499
+ 6500
+ 6501
+ 6502
+ 6503
+ 6504
+ 6505
+ 6506
+ 6507
+ 6508
+ 6509
+ 6510
+ 6511
+ 6512
+ 6513
+ 6514
+ 6515
+ 6516
+ 6517
+ 6518
+ 6519
+ 6520
+ 6521
+ 6522
+ 6523
+ 6524
+ 6525
+ 6526
+ 6527
+ 6528
+ 6529
+ 6530
+ 6531
+ 6532
+ 6533
+ 6534
+ 6535
+ 6536
+ 6537
+ 6538
+ 6539
+ 6540
+ 6541
+ 6542
+ 6543
+ 6544
+ 6545
+ 6546
+ 6547
+ 6548
+ 6549
+ 6550
+ 6551
+ 6552
+ 6553
+ 6554
+ 6555
+ 6556
+ 6557
+ 6558
+ 6559
+ 6560
+ 6561
+ 6562
+ 6563
+ 6564
+ 6565
+ 6566
+ 6567
+ 6568
+ 6569
+ 6570
+ 6571
+ 6572
+ 6573
+ 6574
+ 6575
+ 6576
+ 6577
+ 6578
+ 6579
+ 6580
+ 6581
+ 6582
+ 6583
+ 6584
+ 6585
+ 6586
+ 6587
+ 6588
+ 6589
+ 6590
+ 6591
+ 6592
+ 6593
+ 6594
+ 6595
+ 6596
+ 6597
+ 6598
+ 6599
+ 6600
+ 6601
+ 6602
+ 6603
+ 6604
+ 6605
+ 6606
+ 6607
+ 6608
+ 6609
+ 6610
+ 6611
+ 6612
+ 6613
+ 6614
+ 6615
+ 6616
+ 6617
+ 6618
+ 6619
+ 6620
+ 6621
+ 6622
+ 6623
+ 6624
+ 6625
+ 6626
+ 6627
+ 6628
+ 6629
+ 6630
+ 6631
+ 6632
+ 6633
+ 6634
+ 6635
+ 6636
+ 6637
+ 6638
+ 6639
+ 6640
+ 6641
+ 6642
+ 6643
+ 6644
+ 6645
+ 6646
+ 6647
+ 6648
+ 6649
+ 6650
+ 6651
+ 6652
+ 6653
+ 6654
+ 6655
+ 6656
+ 6657
+ 6658
+ 6659
+ 6660
+ 6661
+ 6662
+ 6663
+ 6664
+ 6665
+ 6666
+ 6667
+ 6668
+ 6669
+ 6670
+ 6671
+ 6672
+ 6673
+ 6674
+ 6675
+ 6676
+ 6677
+ 6678
+ 6679
+ 6680
+ 6681
+ 6682
+ 6683
+ 6684
+ 6685
+ 6686
+ 6687
+ 6688
+ 6689
+ 6690
+ 6691
+ 6692
+ 6693
+ 6694
+ 6695
+ 6696
+ 6697
+ 6698
+ 6699
+ 6700
+ 6701
+ 6702
+ 6703
+ 6704
+ 6705
+ 6706
+ 6707
+ 6708
+ 6709
+ 6710
+ 6711
+ 6712
+ 6713
+ 6714
+ 6715
+ 6716
+ 6717
+ 6718
+ 6719
+ 6720
+ 6721
+ 6722
+ 6723
+ 6724
+ 6725
+ 6726
+ 6727
+ 6728
+ 6729
+ 6730
+ 6731
+ 6732
+ 6733
+ 6734
+ 6735
+ 6736
+ 6737
+ 6738
+ 6739
+ 6740
+ 6741
+ 6742
+ 6743
+ 6744
+ 6745
+ 6746
+ 6747
+ 6748
+ 6749
+ 6750
+ 6751
+ 6752
+ 6753
+ 6754
+ 6755
+ 6756
+ 6757
+ 6758
+ 6759
+ 6760
+ 6761
+ 6762
+ 6763
+ 6764
+ 6765
+ 6766
+ 6767
+ 6768
+ 6769
+ 6770
+ 6771
+ 6772
+ 6773
+ 6774
+ 6775
+ 6776
+ 6777
+ 6778
+ 6779
+ 6780
+ 6781
+ 6782
+ 6783
+ 6784
+ 6785
+ 6786
+ 6787
+ 6788
+ 6789
+ 6790
+ 6791
+ 6792
+ 6793
+ 6794
+ 6795
+ 6796
+ 6797
+ 6798
+ 6799
+ 6800
+ 6801
+ 6802
+ 6803
+ 6804
+ 6805
+ 6806
+ 6807
+ 6808
+ 6809
+ 6810
+ 6811
+ 6812
+ 6813
+ 6814
+ 6815
+ 6816
+ 6817
+ 6818
+ 6819
+ 6820
+ 6821
+ 6822
+ 6823
+ 6824
+ 6825
+ 6826
+ 6827
+ 6828
+ 6829
+ 6830
+ 6831
+ 6832
+ 6833
+ 6834
+ 6835
+ 6836
+ 6837
+ 6838
+ 6839
+ 6840
+ 6841
+ 6842
+ 6843
+ 6844
+ 6845
+ 6846
+ 6847
+ 6848
+ 6849
+ 6850
+ 6851
+ 6852
+ 6853
+ 6854
+ 6855
+ 6856
+ 6857
+ 6858
+ 6859
+ 6860
+ 6861
+ 6862
+ 6863
+ 6864
+ 6865
+ 6866
+ 6867
+ 6868
+ 6869
+ 6870
+ 6871
+ 6872
+ 6873
+ 6874
+ 6875
+ 6876
+ 6877
+ 6878
+ 6879
+ 6880
+ 6881
+ 6882
+ 6883
+ 6884
+ 6885
+ 6886
+ 6887
+ 6888
+ 6889
+ 6890
+ 6891
+ 6892
+ 6893
+ 6894
+ 6895
+ 6896
+ 6897
+ 6898
+ 6899
+ 6900
+ 6901
+ 6902
+ 6903
+ 6904
+ 6905
+ 6906
+ 6907
+ 6908
+ 6909
+ 6910
+ 6911
+ 6912
+ 6913
+ 6914
+ 6915
+ 6916
+ 6917
+ 6918
+ 6919
+ 6920
+ 6921
+ 6922
+ 6923
+ 6924
+ 6925
+ 6926
+ 6927
+ 6928
+ 6929
+ 6930
+ 6931
+ 6932
+ 6933
+ 6934
+ 6935
+ 6936
+ 6937
+ 6938
+ 6939
+ 6940
+ 6941
+ 6942
+ 6943
+ 6944
+ 6945
+ 6946
+ 6947
+ 6948
+ 6949
+ 6950
+ 6951
+ 6952
+ 6953
+ 6954
+ 6955
+ 6956
+ 6957
+ 6958
+ 6959
+ 6960
+ 6961
+ 6962
+ 6963
+ 6964
+ 6965
+ 6966
+ 6967
+ 6968
+ 6969
+ 6970
+ 6971
+ 6972
+ 6973
+ 6974
+ 6975
+ 6976
+ 6977
+ 6978
+ 6979
+ 6980
+ 6981
+ 6982
+ 6983
+ 6984
+ 6985
+ 6986
+ 6987
+ 6988
+ 6989
+ 6990
+ 6991
+ 6992
+ 6993
+ 6994
+ 6995
+ 6996
+ 6997
+ 6998
+ 6999
+ 7000
+ 7001
+ 7002
+ 7003
+ 7004
+ 7005
+ 7006
+ 7007
+ 7008
+ 7009
+ 7010
+ 7011
+ 7012
+ 7013
+ 7014
+ 7015
+ 7016
+ 7017
+ 7018
+ 7019
+ 7020
+ 7021
+ 7022
+ 7023
+ 7024
+ 7025
+ 7026
+ 7027
+ 7028
+ 7029
+ 7030
+ 7031
+ 7032
+ 7033
+ 7034
+ 7035
+ 7036
+ 7037
+ 7038
+ 7039
+ 7040
+ 7041
+ 7042
+ 7043
+ 7044
+ 7045
+ 7046
+ 7047
+ 7048
+ 7049
+ 7050
+ 7051
+ 7052
+ 7053
+ 7054
+ 7055
+ 7056
+ 7057
+ 7058
+ 7059
+ 7060
+ 7061
+ 7062
+ 7063
+ 7064
+ 7065
+ 7066
+ 7067
+ 7068
+ 7069
+ 7070
+ 7071
+ 7072
+ 7073
+ 7074
+ 7075
+ 7076
+ 7077
+ 7078
+ 7079
+ 7080
+ 7081
+ 7082
+ 7083
+ 7084
+ 7085
+ 7086
+ 7087
+ 7088
+ 7089
+ 7090
+ 7091
+ 7092
+ 7093
+ 7094
+ 7095
+ 7096
+ 7097
+ 7098
+ 7099
+ 7100
+ 7101
+ 7102
+ 7103
+ 7104
+ 7105
+ 7106
+ 7107
+ 7108
+ 7109
+ 7110
+ 7111
+ 7112
+ 7113
+ 7114
+ 7115
+ 7116
+ 7117
+ 7118
+ 7119
+ 7120
+ 7121
+ 7122
+ 7123
+ 7124
+ 7125
+ 7126
+ 7127
+ 7128
+ 7129
+ 7130
+ 7131
+ 7132
+ 7133
+ 7134
+ 7135
+ 7136
+ 7137
+ 7138
+ 7139
+ 7140
+ 7141
+ 7142
+ 7143
+ 7144
+ 7145
+ 7146
+ 7147
+ 7148
+ 7149
+ 7150
+ 7151
+ 7152
+ 7153
+ 7154
+ 7155
+ 7156
+ 7157
+ 7158
+ 7159
+ 7160
+ 7161
+ 7162
+ 7163
+ 7164
+ 7165
+ 7166
+ 7167
+ 7168
+ 7169
+ 7170
+ 7171
+ 7172
+ 7173
+ 7174
+ 7175
+ 7176
+ 7177
+ 7178
+ 7179
+ 7180
+ 7181
+ 7182
+ 7183
+ 7184
+ 7185
+ 7186
+ 7187
+ 7188
+ 7189
+ 7190
+ 7191
+ 7192
+ 7193
+ 7194
+ 7195
+ 7196
+ 7197
+ 7198
+ 7199
+ 7200
+ 7201
+ 7202
+ 7203
+ 7204
+ 7205
+ 7206
+ 7207
+ 7208
+ 7209
+ 7210
+ 7211
+ 7212
+ 7213
+ 7214
+ 7215
+ 7216
+ 7217
+ 7218
+ 7219
+ 7220
+ 7221
+ 7222
+ 7223
+ 7224
+ 7225
+ 7226
+ 7227
+ 7228
+ 7229
+ 7230
+ 7231
+ 7232
+ 7233
+ 7234
+ 7235
+ 7236
+ 7237
+ 7238
+ 7239
+ 7240
+ 7241
+ 7242
+ 7243
+ 7244
+ 7245
+ 7246
+ 7247
+ 7248
+ 7249
+ 7250
+ 7251
+ 7252
+ 7253
+ 7254
+ 7255
+ 7256
+ 7257
+ 7258
+ 7259
+ 7260
+ 7261
+ 7262
+ 7263
+ 7264
+ 7265
+ 7266
+ 7267
+ 7268
+ 7269
+ 7270
+ 7271
+ 7272
+ 7273
+ 7274
+ 7275
+ 7276
+ 7277
+ 7278
+ 7279
+ 7280
+ 7281
+ 7282
+ 7283
+ 7284
+ 7285
+ 7286
+ 7287
+ 7288
+ 7289
+ 7290
+ 7291
+ 7292
+ 7293
+ 7294
+ 7295
+ 7296
+ 7297
+ 7298
+ 7299
+ 7300
+ 7301
+ 7302
+ 7303
+ 7304
+ 7305
+ 7306
+ 7307
+ 7308
+ 7309
+ 7310
+ 7311
+ 7312
+ 7313
+ 7314
+ 7315
+ 7316
+ 7317
+ 7318
+ 7319
+ 7320
+ 7321
+ 7322
+ 7323
+ 7324
+ 7325
+ 7326
+ 7327
+ 7328
+ 7329
+ 7330
+ 7331
+ 7332
+ 7333
+ 7334
+ 7335
+ 7336
+ 7337
+ 7338
+ 7339
+ 7340
+ 7341
+ 7342
+ 7343
+ 7344
+ 7345
+ 7346
+ 7347
+ 7348
+ 7349
+ 7350
+ 7351
+ 7352
+ 7353
+ 7354
+ 7355
+ 7356
+ 7357
+ 7358
+ 7359
+ 7360
+ 7361
+ 7362
+ 7363
+ 7364
+ 7365
+ 7366
+ 7367
+ 7368
+ 7369
+ 7370
+ 7371
+ 7372
+ 7373
+ 7374
+ 7375
+ 7376
+ 7377
+ 7378
+ 7379
+ 7380
+ 7381
+ 7382
+ 7383
+ 7384
+ 7385
+ 7386
+ 7387
+ 7388
+ 7389
+ 7390
+ 7391
+ 7392
+ 7393
+ 7394
+ 7395
+ 7396
+ 7397
+ 7398
+ 7399
+ 7400
+ 7401
+ 7402
+ 7403
+ 7404
+ 7405
+ 7406
+ 7407
+ 7408
+ 7409
+ 7410
+ 7411
+ 7412
+ 7413
+ 7414
+ 7415
+ 7416
+ 7417
+ 7418
+ 7419
+ 7420
+ 7421
+ 7422
+ 7423
+ 7424
+ 7425
+ 7426
+ 7427
+ 7428
+ 7429
+ 7430
+ 7431
+ 7432
+ 7433
+ 7434
+ 7435
+ 7436
+ 7437
+ 7438
+ 7439
+ 7440
+ 7441
+ 7442
+ 7443
+ 7444
+ 7445
+ 7446
+ 7447
+ 7448
+ 7449
+ 7450
+ 7451
+ 7452
+ 7453
+ 7454
+ 7455
+ 7456
+ 7457
+ 7458
+ 7459
+ 7460
+ 7461
+ 7462
+ 7463
+ 7464
+ 7465
+ 7466
+ 7467
+ 7468
+ 7469
+ 7470
+ 7471
+ 7472
+ 7473
+ 7474
+ 7475
+ 7476
+ 7477
+ 7478
+ 7479
+ 7480
+ 7481
+ 7482
+ 7483
+ 7484
+ 7485
+ 7486
+ 7487
+ 7488
+ 7489
+ 7490
+ 7491
+ 7492
+ 7493
+ 7494
+ 7495
+ 7496
+ 7497
+ 7498
+ 7499
+ 7500
+ 7501
+ 7502
+ 7503
+ 7504
+ 7505
+ 7506
+ 7507
+ 7508
+ 7509
+ 7510
+ 7511
+ 7512
+ 7513
+ 7514
+ 7515
+ 7516
+ 7517
+ 7518
+ 7519
+ 7520
+ 7521
+ 7522
+ 7523
+ 7524
+ 7525
+ 7526
+ 7527
+ 7528
+ 7529
+ 7530
+ 7531
+ 7532
+ 7533
+ 7534
+ 7535
+ 7536
+ 7537
+ 7538
+ 7539
+ 7540
+ 7541
+ 7542
+ 7543
+ 7544
+ 7545
+ 7546
+ 7547
+ 7548
+ 7549
+ 7550
+ 7551
+ 7552
+ 7553
+ 7554
+ 7555
+ 7556
+ 7557
+ 7558
+ 7559
+ 7560
+ 7561
+ 7562
+ 7563
+ 7564
+ 7565
+ 7566
+ 7567
+ 7568
+ 7569
+ 7570
+ 7571
+ 7572
+ 7573
+ 7574
+ 7575
+ 7576
+ 7577
+ 7578
+ 7579
+ 7580
+ 7581
+ 7582
+ 7583
+ 7584
+ 7585
+ 7586
+ 7587
+ 7588
+ 7589
+ 7590
+ 7591
+ 7592
+ 7593
+ 7594
+ 7595
+ 7596
+ 7597
+ 7598
+ 7599
+ 7600
+ 7601
+ 7602
+ 7603
+ 7604
+ 7605
+ 7606
+ 7607
+ 7608
+ 7609
+ 7610
+ 7611
+ 7612
+ 7613
+ 7614
+ 7615
+ 7616
+ 7617
+ 7618
+ 7619
+ 7620
+ 7621
+ 7622
+ 7623
+ 7624
+ 7625
+ 7626
+ 7627
+ 7628
+ 7629
+ 7630
+ 7631
+ 7632
+ 7633
+ 7634
+ 7635
+ 7636
+ 7637
+ 7638
+ 7639
+ 7640
+ 7641
+ 7642
+ 7643
+ 7644
+ 7645
+ 7646
+ 7647
+ 7648
+ 7649
+ 7650
+ 7651
+ 7652
+ 7653
+ 7654
+ 7655
+ 7656
+ 7657
+ 7658
+ 7659
+ 7660
+ 7661
+ 7662
+ 7663
+ 7664
+ 7665
+ 7666
+ 7667
+ 7668
+ 7669
+ 7670
+ 7671
+ 7672
+ 7673
+ 7674
+ 7675
+ 7676
+ 7677
+ 7678
+ 7679
+ 7680
+ 7681
+ 7682
+ 7683
+ 7684
+ 7685
+ 7686
+ 7687
+ 7688
+ 7689
+ 7690
+ 7691
+ 7692
+ 7693
+ 7694
+ 7695
+ 7696
+ 7697
+ 7698
+ 7699
+ 7700
+ 7701
+ 7702
+ 7703
+ 7704
+ 7705
+ 7706
+ 7707
+ 7708
+ 7709
+ 7710
+ 7711
+ 7712
+ 7713
+ 7714
+ 7715
+ 7716
+ 7717
+ 7718
+ 7719
+ 7720
+ 7721
+ 7722
+ 7723
+ 7724
+ 7725
+ 7726
+ 7727
+ 7728
+ 7729
+ 7730
+ 7731
+ 7732
+ 7733
+ 7734
+ 7735
+ 7736
+ 7737
+ 7738
+ 7739
+ 7740
+ 7741
+ 7742
+ 7743
+ 7744
+ 7745
+ 7746
+ 7747
+ 7748
+ 7749
+ 7750
+ 7751
+ 7752
+ 7753
+ 7754
+ 7755
+ 7756
+ 7757
+ 7758
+ 7759
+ 7760
+ 7761
+ 7762
+ 7763
+ 7764
+ 7765
+ 7766
+ 7767
+ 7768
+ 7769
+ 7770
+ 7771
+ 7772
+ 7773
+ 7774
+ 7775
+ 7776
+ 7777
+ 7778
+ 7779
+ 7780
+ 7781
+ 7782
+ 7783
+ 7784
+ 7785
+ 7786
+ 7787
+ 7788
+ 7789
+ 7790
+ 7791
+ 7792
+ 7793
+ 7794
+ 7795
+ 7796
+ 7797
+ 7798
+ 7799
+ 7800
+ 7801
+ 7802
+ 7803
+ 7804
+ 7805
+ 7806
+ 7807
+ 7808
+ 7809
+ 7810
+ 7811
+ 7812
+ 7813
+ 7814
+ 7815
+ 7816
+ 7817
+ 7818
+ 7819
+ 7820
+ 7821
+ 7822
+ 7823
+ 7824
+ 7825
+ 7826
+ 7827
+ 7828
+ 7829
+ 7830
+ 7831
+ 7832
+ 7833
+ 7834
+ 7835
+ 7836
+ 7837
+ 7838
+ 7839
+ 7840
+ 7841
+ 7842
+ 7843
+ 7844
+ 7845
+ 7846
+ 7847
+ 7848
+ 7849
+ 7850
+ 7851
+ 7852
+ 7853
+ 7854
+ 7855
+ 7856
+ 7857
+ 7858
+ 7859
+ 7860
+ 7861
+ 7862
+ 7863
+ 7864
+ 7865
+ 7866
+ 7867
+ 7868
+ 7869
+ 7870
+ 7871
+ 7872
+ 7873
+ 7874
+ 7875
+ 7876
+ 7877
+ 7878
+ 7879
+ 7880
+ 7881
+ 7882
+ 7883
+ 7884
+ 7885
+ 7886
+ 7887
+ 7888
+ 7889
+ 7890
+ 7891
+ 7892
+ 7893
+ 7894
+ 7895
+ 7896
+ 7897
+ 7898
+ 7899
+ 7900
+ 7901
+ 7902
+ 7903
+ 7904
+ 7905
+ 7906
+ 7907
+ 7908
+ 7909
+ 7910
+ 7911
+ 7912
+ 7913
+ 7914
+ 7915
+ 7916
+ 7917
+ 7918
+ 7919
+ 7920
+ 7921
+ 7922
+ 7923
+ 7924
+ 7925
+ 7926
+ 7927
+ 7928
+ 7929
+ 7930
+ 7931
+ 7932
+ 7933
+ 7934
+ 7935
+ 7936
+ 7937
+ 7938
+ 7939
+ 7940
+ 7941
+ 7942
+ 7943
+ 7944
+ 7945
+ 7946
+ 7947
+ 7948
+ 7949
+ 7950
+ 7951
+ 7952
+ 7953
+ 7954
+ 7955
+ 7956
+ 7957
+ 7958
+ 7959
+ 7960
+ 7961
+ 7962
+ 7963
+ 7964
+ 7965
+ 7966
+ 7967
+ 7968
+ 7969
+ 7970
+ 7971
+ 7972
+ 7973
+ 7974
+ 7975
+ 7976
+ 7977
+ 7978
+ 7979
+ 7980
+ 7981
+ 7982
+ 7983
+ 7984
+ 7985
+ 7986
+ 7987
+ 7988
+ 7989
+ 7990
+ 7991
+ 7992
+ 7993
+ 7994
+ 7995
+ 7996
+ 7997
+ 7998
+ 7999
+ 8000
+ 0
+SYMFNC: intern SYMFNC
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern ID2INT
+ jrst ID2INT##
+ extern L1786
+ jrst L1786##
+ extern INT2ID
+ jrst INT2ID##
+ extern L1772
+ jrst L1772##
+ extern L1792
+ jrst L1792##
+ extern L0016
+ jrst L0016##
+ extern L0023
+ jrst L0023##
+ extern L1798
+ jrst L1798##
+ extern L0027
+ jrst L0027##
+ extern L0031
+ jrst L0031##
+ extern GTFIXN
+ jrst GTFIXN##
+ extern L0036
+ jrst L0036##
+ extern L0041
+ jrst L0041##
+ extern GTVECT
+ jrst GTVECT##
+ extern L1801
+ jrst L1801##
+ extern L0049
+ jrst L0049##
+ extern GTSTR
+ jrst GTSTR##
+ extern L1804
+ jrst L1804##
+ extern L0059
+ jrst L0059##
+ extern LENGTH
+ jrst LENGTH##
+ extern L1783
+ jrst L1783##
+ extern L0068
+ jrst L0068##
+ extern CONS
+ jrst CONS##
+ extern L0075
+ jrst L0075##
+ extern L0083
+ jrst L0083##
+ extern GETV
+ jrst GETV##
+ extern BLDMSG
+ jrst BLDMSG##
+ extern L1737
+ jrst L1737##
+ extern L1780
+ jrst L1780##
+ extern PUTV
+ jrst PUTV##
+ extern UPBV
+ jrst UPBV##
+ extern L0111
+ jrst L0111##
+ extern EGETV
+ jrst EGETV##
+ extern EPUTV
+ jrst EPUTV##
+ extern EUPBV
+ jrst EUPBV##
+ extern INDX
+ jrst INDX##
+ extern L1736
+ jrst L1736##
+ extern L1810
+ jrst L1810##
+ extern L0159
+ jrst L0159##
+ extern SUB
+ jrst SUB##
+ extern SUBSEQ
+ jrst SUBSEQ##
+ extern GTWRDS
+ jrst GTWRDS##
+ extern L1112
+ jrst L1112##
+ extern NCONS
+ jrst NCONS##
+ extern TCONC
+ jrst TCONC##
+ extern SETSUB
+ jrst SETSUB##
+ extern L0233
+ jrst L0233##
+ extern CONCAT
+ jrst CONCAT##
+ extern APPEND
+ jrst APPEND##
+ extern SIZE
+ jrst SIZE##
+ extern L0332
+ jrst L0332##
+ extern L1795
+ jrst L1795##
+ extern L0343
+ jrst L0343##
+ extern L0354
+ jrst L0354##
+ extern L0364
+ jrst L0364##
+ extern L0374
+ jrst L0374##
+ extern STRING
+ jrst STRING##
+ extern VECTOR
+ jrst VECTOR##
+ extern CODEP
+ jrst CODEP##
+ extern EQ
+ jrst EQ##
+ extern FLOATP
+ jrst FLOATP##
+ extern BIGP
+ jrst BIGP##
+ extern IDP
+ jrst IDP##
+ extern PAIRP
+ jrst PAIRP##
+ extern L0392
+ jrst L0392##
+ extern L0395
+ jrst L0395##
+ extern CAR
+ jrst CAR##
+ extern CDR
+ jrst CDR##
+ extern RPLACA
+ jrst RPLACA##
+ extern RPLACD
+ jrst RPLACD##
+ extern FIXP
+ jrst FIXP##
+ extern DIGIT
+ jrst DIGIT##
+ extern LITER
+ jrst LITER##
+ extern EQN
+ jrst EQN##
+ extern L0449
+ jrst L0449##
+ extern L0487
+ jrst L0487##
+ extern EQSTR
+ jrst EQSTR##
+ jrst L0449##
+ extern CAAAAR
+ jrst CAAAAR##
+ extern CAAAR
+ jrst CAAAR##
+ extern CAAADR
+ jrst CAAADR##
+ extern CAADAR
+ jrst CAADAR##
+ extern CAADR
+ jrst CAADR##
+ extern CAADDR
+ jrst CAADDR##
+ extern CADAAR
+ jrst CADAAR##
+ extern CADAR
+ jrst CADAR##
+ extern CADADR
+ jrst CADADR##
+ extern CADDAR
+ jrst CADDAR##
+ extern CADDR
+ jrst CADDR##
+ extern CADDDR
+ jrst CADDDR##
+ extern CDAAAR
+ jrst CDAAAR##
+ extern CDAAR
+ jrst CDAAR##
+ extern CDAADR
+ jrst CDAADR##
+ extern CDADAR
+ jrst CDADAR##
+ extern CDADR
+ jrst CDADR##
+ extern CDADDR
+ jrst CDADDR##
+ extern CDDAAR
+ jrst CDDAAR##
+ extern CDDAR
+ jrst CDDAR##
+ extern CDDADR
+ jrst CDDADR##
+ extern CDDDAR
+ jrst CDDDAR##
+ extern CDDDR
+ jrst CDDDR##
+ extern CDDDDR
+ jrst CDDDDR##
+ extern CAAR
+ jrst CAAR##
+ extern CADR
+ jrst CADR##
+ extern CDAR
+ jrst CDAR##
+ extern CDDR
+ jrst CDDR##
+ extern L0607
+ jrst L0607##
+ extern L0612
+ jrst L0612##
+ extern ATOM
+ jrst ATOM##
+ extern L0635
+ jrst L0635##
+ extern NULL
+ jrst NULL##
+ extern L0642
+ jrst L0642##
+ extern EXPT
+ jrst EXPT##
+ extern L0871
+ jrst L0871##
+ extern LIST3
+ jrst LIST3##
+ extern L1763
+ jrst L1763##
+ extern L1509
+ jrst L1509##
+ extern L1434
+ jrst L1434##
+ extern MINUSP
+ jrst MINUSP##
+ extern TIMES2
+ jrst TIMES2##
+ extern ADD1
+ jrst ADD1##
+ extern L1451
+ jrst L1451##
+ extern PLUS2
+ jrst PLUS2##
+ extern LIST
+ jrst LIST##
+ extern EVLIS
+ jrst EVLIS##
+ extern QUOTE
+ jrst QUOTE##
+ JSP 10,SYMFNC+516
+ extern DE
+ jrst DE##
+ extern LIST2
+ jrst LIST2##
+ extern LIST4
+ jrst LIST4##
+ extern PUTD
+ jrst PUTD##
+ extern L0821
+ jrst L0821##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern DF
+ jrst DF##
+ JSP 10,SYMFNC+516
+ extern DM
+ jrst DM##
+ JSP 10,SYMFNC+516
+ extern DN
+ jrst DN##
+ extern SETQ
+ jrst SETQ##
+ extern EVAL
+ jrst EVAL##
+ extern SET
+ jrst SET##
+ extern PROG2
+ jrst PROG2##
+ extern PROGN
+ jrst PROGN##
+ extern L0686
+ jrst L0686##
+ extern AND
+ jrst AND##
+ extern EVAND
+ jrst EVAND##
+ extern OR
+ jrst OR##
+ extern EVOR
+ jrst EVOR##
+ extern COND
+ jrst COND##
+ extern EVCOND
+ jrst EVCOND##
+ extern NOT
+ jrst NOT##
+ extern ABS
+ jrst ABS##
+ extern MINUS
+ jrst MINUS##
+ extern DIVIDE
+ jrst DIVIDE##
+ extern ZEROP
+ jrst ZEROP##
+ extern L1469
+ jrst L1469##
+ extern XCONS
+ jrst XCONS##
+ extern MAX
+ jrst MAX##
+ extern L0815
+ jrst L0815##
+ extern MAX2
+ jrst MAX2##
+ extern LESSP
+ jrst LESSP##
+ extern MIN
+ jrst MIN##
+ extern MIN2
+ jrst MIN2##
+ extern PLUS
+ jrst PLUS##
+ extern TIMES
+ jrst TIMES##
+ extern MAP
+ jrst MAP##
+ extern L1891
+ jrst L1891##
+ extern MAPC
+ jrst MAPC##
+ extern MAPCAN
+ jrst MAPCAN##
+ extern NCONC
+ jrst NCONC##
+ extern MAPCON
+ jrst MAPCON##
+ extern MAPCAR
+ jrst MAPCAR##
+ extern L0747
+ jrst L0747##
+ extern ASSOC
+ jrst ASSOC##
+ extern SASSOC
+ jrst SASSOC##
+ extern PAIR
+ jrst PAIR##
+ extern SUBLIS
+ jrst SUBLIS##
+ extern L0782
+ jrst L0782##
+ extern PUT
+ jrst PUT##
+ extern DELETE
+ jrst DELETE##
+ extern MEMBER
+ jrst MEMBER##
+ extern MEMQ
+ jrst MEMQ##
+ extern L0804
+ jrst L0804##
+ extern SUBST
+ jrst SUBST##
+ extern EXPAND
+ jrst EXPAND##
+ extern L0822
+ jrst L0822##
+ extern L2814
+ jrst L2814##
+ extern L2356
+ jrst L2356##
+ extern PRINT
+ jrst PRINT##
+ JSP 10,SYMFNC+516
+ extern NEQ
+ jrst NEQ##
+ extern NE
+ jrst NE##
+ extern GEQ
+ jrst GEQ##
+ extern LEQ
+ jrst LEQ##
+ extern EQCAR
+ jrst EQCAR##
+ extern EXPRP
+ jrst EXPRP##
+ extern GETD
+ jrst GETD##
+ extern MACROP
+ jrst MACROP##
+ extern FEXPRP
+ jrst FEXPRP##
+ extern NEXPRP
+ jrst NEXPRP##
+ extern COPYD
+ jrst COPYD##
+ extern RECIP
+ jrst RECIP##
+ extern FIRST
+ jrst FIRST##
+ extern SECOND
+ jrst SECOND##
+ extern THIRD
+ jrst THIRD##
+ extern FOURTH
+ jrst FOURTH##
+ extern REST
+ jrst REST##
+ extern L0878
+ jrst L0878##
+ extern L0888
+ jrst L0888##
+ extern L0900
+ jrst L0900##
+ extern DELQ
+ jrst DELQ##
+ extern DEL
+ jrst DEL##
+ extern DELQIP
+ jrst DELQIP##
+ extern ATSOC
+ jrst ATSOC##
+ extern ASS
+ jrst ASS##
+ extern MEM
+ jrst MEM##
+ extern RASSOC
+ jrst RASSOC##
+ extern DELASC
+ jrst DELASC##
+ extern L0957
+ jrst L0957##
+ extern DELATQ
+ jrst DELATQ##
+ extern L0978
+ jrst L0978##
+ extern SUBLA
+ jrst SUBLA##
+ extern RPLACW
+ jrst RPLACW##
+ extern L0996
+ jrst L0996##
+ extern L1000
+ jrst L1000##
+ extern COPY
+ jrst COPY##
+ extern NTH
+ jrst NTH##
+ extern SUB1
+ jrst SUB1##
+ extern PNTH
+ jrst PNTH##
+ extern ACONC
+ jrst ACONC##
+ extern LCONC
+ jrst LCONC##
+ extern MAP2
+ jrst MAP2##
+ extern MAPC2
+ jrst MAPC2##
+ extern L1045
+ jrst L1045##
+ extern L2357
+ jrst L2357##
+ extern PRIN2T
+ jrst PRIN2T##
+ extern L1046
+ jrst L1046##
+ extern L2294
+ jrst L2294##
+ extern SPACES
+ jrst SPACES##
+ extern L1050
+ jrst L1050##
+ extern L2352
+ jrst L2352##
+ extern TAB
+ jrst TAB##
+ extern FILEP
+ jrst FILEP##
+ extern PUTC
+ jrst PUTC##
+ jrst TAB##
+ jrst L1050##
+ extern L1054
+ jrst L1054##
+ extern L1060
+ jrst L1060##
+ extern ADJOIN
+ jrst ADJOIN##
+ extern L1066
+ jrst L1066##
+ extern UNION
+ jrst UNION##
+ extern UNIONQ
+ jrst UNIONQ##
+ extern XN
+ jrst XN##
+ extern XNQ
+ jrst XNQ##
+ jrst XN##
+ jrst XNQ##
+ extern L1095
+ jrst L1095##
+ extern GTHEAP
+ jrst GTHEAP##
+ extern L1732
+ jrst L1732##
+ extern L1204
+ jrst L1204##
+ JSP 10,SYMFNC+516
+ extern L1104
+ jrst L1104##
+ extern L1107
+ jrst L1107##
+ extern L1109
+ jrst L1109##
+ extern L1111
+ jrst L1111##
+ extern GTBPS
+ jrst GTBPS##
+ jrst GTVECT##
+ extern GTFLTN
+ jrst GTFLTN##
+ extern GTID
+ jrst GTID##
+ extern L1199
+ jrst L1199##
+ extern DELBPS
+ jrst DELBPS##
+ extern L1125
+ jrst L1125##
+ extern L1128
+ jrst L1128##
+ extern L1131
+ jrst L1131##
+ extern L1135
+ jrst L1135##
+ extern L1136
+ jrst L1136##
+ extern L1140
+ jrst L1140##
+ extern L1143
+ jrst L1143##
+ extern L1144
+ jrst L1144##
+ extern L1147
+ jrst L1147##
+ extern L1149
+ jrst L1149##
+ extern MKVECT
+ jrst MKVECT##
+ extern L1184
+ jrst L1184##
+ JSP 10,SYMFNC+516
+ extern LIST5
+ jrst LIST5##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2879
+ jrst L2879##
+ extern TIMC
+ jrst TIMC##
+ extern QUIT
+ jrst QUIT##
+ extern L1422
+ jrst L1422##
+ extern L1423
+ jrst L1423##
+ extern LAND
+ jrst LAND##
+ extern LOR
+ jrst LOR##
+ extern LXOR
+ jrst LXOR##
+ extern LSHIFT
+ jrst LSHIFT##
+ jrst LSHIFT##
+ extern LNOT
+ jrst LNOT##
+ extern FIX
+ jrst FIX##
+ extern FLOAT
+ jrst FLOAT##
+ extern ONEP
+ jrst ONEP##
+ JSP 10,SYMFNC+516
+ extern TR
+ jrst TR##
+ extern EVLOAD
+ jrst EVLOAD##
+ extern TRST
+ jrst TRST##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern EDITF
+ jrst EDITF##
+ extern EDIT
+ jrst EDIT##
+ extern YESP
+ jrst YESP##
+ JSP 10,SYMFNC+516
+ extern L3367
+ jrst L3367##
+ extern TERPRI
+ jrst TERPRI##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3370
+ jrst L3370##
+ extern READ
+ jrst READ##
+ JSP 10,SYMFNC+516
+ extern HELP
+ jrst HELP##
+ extern BREAK
+ jrst BREAK##
+ extern EHELP
+ jrst EHELP##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L1695
+ jrst L1695##
+ extern PRINTF
+ jrst PRINTF##
+ extern L1699
+ jrst L1699##
+ extern L2098
+ jrst L2098##
+ JSP 10,SYMFNC+516
+ extern L1716
+ jrst L1716##
+ JSP 10,SYMFNC+516
+ extern L2301
+ jrst L2301##
+ extern L2636
+ jrst L2636##
+ JSP 10,SYMFNC+516
+ extern PRIN1
+ jrst PRIN1##
+ extern ERROR
+ jrst ERROR##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern RDS
+ jrst RDS##
+ JSP 10,SYMFNC+516
+ extern WRS
+ jrst WRS##
+ extern L1831
+ jrst L1831##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2904
+ jrst L2904##
+ extern L1775
+ jrst L1775##
+ extern L1789
+ jrst L1789##
+ extern L1807
+ jrst L1807##
+ extern L1813
+ jrst L1813##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern THROW
+ jrst THROW##
+ JSP 10,SYMFNC+516
+ extern ERRSET
+ jrst ERRSET##
+ extern CATCH
+ jrst CATCH##
+ extern L2039
+ jrst L2039##
+ JSP 10,SYMFNC+516
+ extern L2047
+ jrst L2047##
+ extern L1835
+ jrst L1835##
+ extern L1850
+ jrst L1850##
+ extern L1838
+ jrst L1838##
+ extern L1841
+ jrst L1841##
+ extern L1844
+ jrst L1844##
+ extern L1847
+ jrst L1847##
+ extern L1855
+ jrst L1855##
+ extern L1862
+ jrst L1862##
+ extern L1870
+ jrst L1870##
+ extern LBIND1
+ jrst LBIND1##
+ extern L1881
+ jrst L1881##
+ extern L3348
+ jrst L3348##
+ extern L3353
+ jrst L3353##
+ JSP 10,SYMFNC+516
+ extern L1895
+ jrst L1895##
+ extern L3357
+ jrst L3357##
+ extern APPLY
+ jrst APPLY##
+ extern L3141
+ jrst L3141##
+ extern FCODEP
+ jrst FCODEP##
+ extern L3172
+ jrst L3172##
+ extern GET
+ jrst GET##
+ extern L3388
+ jrst L3388##
+ extern L3192
+ jrst L3192##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L1996
+ jrst L1996##
+ extern L2008
+ jrst L2008##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern %THROW
+ jrst %THROW##
+ extern L2032
+ jrst L2032##
+ extern L2035
+ jrst L2035##
+ extern L2036
+ jrst L2036##
+ extern RESET
+ jrst RESET##
+ extern L3352
+ jrst L3352##
+ extern L2048
+ jrst L2048##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern PROG
+ jrst PROG##
+ extern PBIND1
+ jrst PBIND1##
+ JSP 10,SYMFNC+516
+ extern GO
+ jrst GO##
+ extern RETURN
+ jrst RETURN##
+ JSP 10,SYMFNC+516
+ extern DATE
+ jrst DATE##
+ extern L2111
+ jrst L2111##
+ extern L2123
+ jrst L2123##
+ extern L3534
+ jrst L3534##
+ extern L2128
+ jrst L2128##
+ extern L2130
+ jrst L2130##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2132
+ jrst L2132##
+ extern L2134
+ jrst L2134##
+ extern FASLIN
+ jrst FASLIN##
+ extern INTERN
+ jrst INTERN##
+ extern L2189
+ jrst L2189##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern LOAD
+ jrst LOAD##
+ extern LOAD1
+ jrst LOAD1##
+ extern RELOAD
+ jrst RELOAD##
+ extern L2197
+ jrst L2197##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2227
+ jrst L2227##
+ extern L2236
+ jrst L2236##
+ extern L2240
+ jrst L2240##
+ extern STEP
+ jrst STEP##
+ extern MINI
+ jrst MINI##
+ extern EMODE
+ jrst EMODE##
+ extern INVOKE
+ jrst INVOKE##
+ JSP 10,SYMFNC+516
+ extern CREFON
+ jrst CREFON##
+ JSP 10,SYMFNC+516
+ extern COMPD
+ jrst COMPD##
+ extern L2265
+ jrst L2265##
+ extern BUG
+ jrst BUG##
+ extern EXEC
+ jrst EXEC##
+ extern MM
+ jrst MM##
+ extern L3512
+ jrst L3512##
+ extern L2908
+ jrst L2908##
+ extern L3499
+ jrst L3499##
+ extern L2887
+ jrst L2887##
+ extern L2899
+ jrst L2899##
+ extern L2903
+ jrst L2903##
+ JSP 10,SYMFNC+516
+ extern L2285
+ jrst L2285##
+ extern L2290
+ jrst L2290##
+ JSP 10,SYMFNC+516
+ extern L2302
+ jrst L2302##
+ extern L2303
+ jrst L2303##
+ extern OPEN
+ jrst OPEN##
+ extern L3533
+ jrst L3533##
+ extern L3540
+ jrst L3540##
+ extern L3529
+ jrst L3529##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern CLOSE
+ jrst CLOSE##
+ extern L3524
+ jrst L3524##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2343
+ jrst L2343##
+ extern EJECT
+ jrst EJECT##
+ extern L2348
+ jrst L2348##
+ extern L2351
+ jrst L2351##
+ extern POSN
+ jrst POSN##
+ extern L2353
+ jrst L2353##
+ extern LPOSN
+ jrst LPOSN##
+ extern L2354
+ jrst L2354##
+ JSP 10,SYMFNC+516
+ extern READCH
+ jrst READCH##
+ extern PRIN2
+ jrst PRIN2##
+ jrst L2357##
+ JSP 10,SYMFNC+516
+ extern L2358
+ jrst L2358##
+ extern L2453
+ jrst L2453##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2361
+ jrst L2361##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2573
+ jrst L2573##
+ JSP 10,SYMFNC+516
+ extern L2364
+ jrst L2364##
+ JSP 10,SYMFNC+516
+ extern L2367
+ jrst L2367##
+ extern L2370
+ jrst L2370##
+ extern L2383
+ jrst L2383##
+ extern L2390
+ jrst L2390##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern NEWID
+ jrst NEWID##
+ extern L2536
+ jrst L2536##
+ extern L2534
+ jrst L2534##
+ extern L2572
+ jrst L2572##
+ JSP 10,SYMFNC+516
+ extern GLOBAL
+ jrst GLOBAL##
+ extern RATOM
+ jrst RATOM##
+ extern L2564
+ jrst L2564##
+ extern L2568
+ jrst L2568##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2577
+ jrst L2577##
+ extern L2580
+ jrst L2580##
+ extern L2584
+ jrst L2584##
+ extern L2594
+ jrst L2594##
+ extern L2596
+ jrst L2596##
+ extern L2597
+ jrst L2597##
+ extern L2598
+ jrst L2598##
+ extern L2600
+ jrst L2600##
+ extern L2845
+ jrst L2845##
+ extern L2601
+ jrst L2601##
+ extern L2603
+ jrst L2603##
+ extern L2608
+ jrst L2608##
+ extern L2615
+ jrst L2615##
+ extern L2617
+ jrst L2617##
+ extern L2629
+ jrst L2629##
+ extern L2632
+ jrst L2632##
+ extern L2637
+ jrst L2637##
+ extern L2654
+ jrst L2654##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2796
+ jrst L2796##
+ extern L2678
+ jrst L2678##
+ extern L2824
+ jrst L2824##
+ extern L2696
+ jrst L2696##
+ extern L2711
+ jrst L2711##
+ extern L2724
+ jrst L2724##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2735
+ jrst L2735##
+ extern L2749
+ jrst L2749##
+ extern L2765
+ jrst L2765##
+ extern L2781
+ jrst L2781##
+ jrst PRIN2##
+ JSP 10,SYMFNC+516
+ extern PRIN2L
+ jrst PRIN2L##
+ extern L2890
+ jrst L2890##
+ extern L2898
+ jrst L2898##
+ JSP 10,SYMFNC+516
+ extern L2900
+ jrst L2900##
+ extern L2901
+ jrst L2901##
+ extern L2905
+ jrst L2905##
+ extern L2914
+ jrst L2914##
+ JSP 10,SYMFNC+516
+ extern L2911
+ jrst L2911##
+ extern L2915
+ jrst L2915##
+ extern L2916
+ jrst L2916##
+ extern L2917
+ jrst L2917##
+ extern L2918
+ jrst L2918##
+ extern TYI
+ jrst TYI##
+ extern TYO
+ jrst TYO##
+ extern L2919
+ jrst L2919##
+ extern L2920
+ jrst L2920##
+ extern L2921
+ jrst L2921##
+ extern L2922
+ jrst L2922##
+ jrst L2922##
+ extern L2929
+ jrst L2929##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern CASE
+ jrst CASE##
+ JSP 10,SYMFNC+516
+ extern SETF
+ jrst SETF##
+ extern L2965
+ jrst L2965##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2976
+ jrst L2976##
+ extern L2985
+ jrst L2985##
+ JSP 10,SYMFNC+516
+ extern ON
+ jrst ON##
+ extern OFF
+ jrst OFF##
+ JSP 10,SYMFNC+516
+ extern DS
+ jrst DS##
+ extern L3041
+ jrst L3041##
+ extern L3045
+ jrst L3045##
+ extern CONST
+ jrst CONST##
+ extern L3050
+ jrst L3050##
+ JSP 10,SYMFNC+516
+ extern L3070
+ jrst L3070##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern EXIT
+ jrst EXIT##
+ JSP 10,SYMFNC+516
+ extern NEXT
+ jrst NEXT##
+ extern WHILE
+ jrst WHILE##
+ extern REPEAT
+ jrst REPEAT##
+ extern FOR
+ jrst FOR##
+ extern GENSYM
+ jrst GENSYM##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3146
+ jrst L3146##
+ extern L3157
+ jrst L3157##
+ extern L3161
+ jrst L3161##
+ extern L3167
+ jrst L3167##
+ extern PROP
+ jrst PROP##
+ extern L3179
+ jrst L3179##
+ extern FLAGP
+ jrst FLAGP##
+ JSP 10,SYMFNC+516
+ extern FLAG
+ jrst FLAG##
+ extern FLAG1
+ jrst FLAG1##
+ extern L3218
+ jrst L3218##
+ extern L3225
+ jrst L3225##
+ extern L3236
+ jrst L3236##
+ extern L3242
+ jrst L3242##
+ extern L3376
+ jrst L3376##
+ JSP 10,SYMFNC+516
+ extern FLUID
+ jrst FLUID##
+ extern FLUID1
+ jrst FLUID1##
+ extern FLUIDP
+ jrst FLUIDP##
+ extern L3268
+ jrst L3268##
+ extern L3271
+ jrst L3271##
+ extern L3274
+ jrst L3274##
+ extern L3279
+ jrst L3279##
+ extern REMD
+ jrst REMD##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3343
+ jrst L3343##
+ extern L3351
+ jrst L3351##
+ extern L3356
+ jrst L3356##
+ extern L3381
+ jrst L3381##
+ extern L3419
+ jrst L3419##
+ extern REMOB
+ jrst REMOB##
+ extern L3451
+ jrst L3451##
+ extern L3465
+ jrst L3465##
+ extern MAPOBL
+ jrst MAPOBL##
+ extern L3479
+ jrst L3479##
+ extern L3483
+ jrst L3483##
+ extern L3486
+ jrst L3486##
+ extern L3490
+ jrst L3490##
+ extern L3495
+ jrst L3495##
+ JSP 10,SYMFNC+516
+ extern L3504
+ jrst L3504##
+ extern L3527
+ jrst L3527##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3604
+ jrst L3604##
+ JSP 10,SYMFNC+516
+ extern L3566
+ jrst L3566##
+ JSP 10,SYMFNC+516
+ extern L3569
+ jrst L3569##
+ extern L3570
+ jrst L3570##
+ extern L3574
+ jrst L3574##
+ extern L3579
+ jrst L3579##
+ extern L3582
+ jrst L3582##
+ extern L3586
+ jrst L3586##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern TIME
+ jrst TIME##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern INP
+ jrst INP##
+ extern REDO
+ jrst REDO##
+ extern ANS
+ jrst ANS##
+ extern HIST
+ jrst HIST##
+ JSP 10,SYMFNC+516
+ extern L3650
+ jrst L3650##
+ extern L3653
+ jrst L3653##
+ extern L3656
+ jrst L3656##
+ JSP 10,SYMFNC+516
+ extern L3658
+ jrst L3658##
+ extern DSKIN
+ jrst DSKIN##
+ extern L3679
+ jrst L3679##
+ extern LAPIN
+ jrst LAPIN##
+ extern MAIN.
+ jrst MAIN.##
+ extern L3697
+ jrst L3697##
+ extern MAIN
+ jrst MAIN##
+ extern L3716
+ jrst L3716##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ block 7149
+L0001: intern L0001
+ 852
+ end
ADDED psl-1983/20-kernel/dmain.rel
Index: psl-1983/20-kernel/dmain.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dmain.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dprop.rel
Index: psl-1983/20-kernel/dprop.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dprop.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/drandm.rel
Index: psl-1983/20-kernel/drandm.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/drandm.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dsymbl.rel
Index: psl-1983/20-kernel/dsymbl.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dsymbl.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dsysio.rel
Index: psl-1983/20-kernel/dsysio.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dsysio.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dtloop.rel
Index: psl-1983/20-kernel/dtloop.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dtloop.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dtypes.rel
Index: psl-1983/20-kernel/dtypes.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dtypes.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/dumplisp.red
Index: psl-1983/20-kernel/dumplisp.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/dumplisp.red
@@ -0,0 +1,80 @@
+%
+% DUMPLISP.RED - Dump running Lisp into a file
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 25 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.KERNEL-20>DUMPLISP.RED.2, 5-Oct-82 10:57:34, Edit by BENSON
+% Removed DumpFileName!* added filename arg to Dumplisp
+% <PSL.20-INTERP>DUMPLISP.RED.7, 3-Sep-82 10:22:46, Edit by BENSON
+% Fixed page boundary bug when unmapping stack
+
+CompileTime <<
+
+flag('(unmap!-space unmap!-pages save!-into!-file), 'InternalFunction);
+
+>>;
+
+on Syslisp;
+
+external WVar HeapLast, HeapUpperBound, NextBPS, LastBPS, StackUpperBound;
+
+syslsp procedure DumpLisp Filename;
+<< if not StringP Filename then
+ StdError "Dumplisp requires a filename argument";
+ Reclaim;
+ unmap!-space(HeapLast, HeapUpperBound);
+ unmap!-space(NextBPS, LastBPS);
+ %% Add some slack to the end of the stack fo the call to unmap-space!
+ unmap!-space(MakeAddressFromStackPointer ST + 10, StackUpperBound);
+ save!-into!-file Filename >>;
+
+syslsp procedure unmap!-space(Lo, Hi);
+begin scalar LoPage, HiPage;
+ LoPage := LSH(Lo + 8#777, -9);
+ HiPage := LSH(Hi - 8#1000, -9);
+ return if not (LoPage >= HiPage) then
+ unmap!-pages(LoPage, HiPage - LoPage);
+end;
+
+lap '((!*entry unmap!-pages expr 2)
+ (hrlzi 3 2#100000000000000000) % pm%cnt in AC3
+ (hrr 3 2) % page count in rh AC3
+ (hrlzi 2 8#400000) % .fhslf in lh AC2
+ (hrr 2 1) % starting page in rh AC2
+ (!*MOVE (WConst -1) (REG 1)) % -1 in AC1
+ (pmap) % do it
+ (!*EXIT 0)
+);
+
+lap '((!*entry save!-into!-file expr 1)
+ (!*MOVE (reg 1) (reg 5)) % save in 5
+ (move 2 1) % file name in 2
+ (hrli 2 8#10700) % make a byte pointer
+ (hrlzi 1 2#100000000000000001) % gj%fou + gj%sht
+ (gtjfn)
+ (jrst CouldntOpen)
+ (hrli 1 8#400000) % .fhslf
+ (hrrzi 2 2#101010000000000000) % ss%cpy, ss%rd, ss%exe, all pages
+ (hrli 2 -8#1000) % for Release 4 and before, 1000 pages
+%/ Change previous line to following line for extended addressing
+% (tlo 2 8#400000) % large negative number
+ (!*MOVE (WConst 0) (REG 3))
+ (ssave)
+ (!*MOVE (WConst 0) (REG 1))
+ (!*EXIT 0)
+CouldntOpen
+ (!*MOVE '"Couldn't GTJFN `%w' for Dumplisp" (reg 1))
+ (!*MOVE (reg 5) (reg 2))
+ (!*CALL BldMsg)
+ (!*JCALL StdError)
+);
+
+off Syslisp;
+
+END;
ADDED psl-1983/20-kernel/error.ctl
Index: psl-1983/20-kernel/error.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/error.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "error";
+in "error.build";
+ASMEnd;
+quit;
+compile error.mac, derror.mac
+delete error.mac, derror.mac
ADDED psl-1983/20-kernel/error.init
Index: psl-1983/20-kernel/error.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/error.init
@@ -0,0 +1,7 @@
+(FLUID (QUOTE (!*CONTINUABLEERROR ERRORFORM!* BREAKLEVEL!* MAXBREAKLEVEL!*
+!*EMSGP)))
+(GLOBAL (QUOTE (EMSG!*)))
+(GLOBAL (QUOTE (EMSG!*)))
+(FLUID (QUOTE (!*BACKTRACE !*INNER!*BACKTRACE !*EMSGP !*BREAK BREAKLEVEL!*
+MAXBREAKLEVEL!* !*CONTINUABLEERROR)))
+(PUT (QUOTE ERRSET) (QUOTE TYPE) (QUOTE MACRO))
ADDED psl-1983/20-kernel/error.log
Index: psl-1983/20-kernel/error.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/error.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/error.rel
Index: psl-1983/20-kernel/error.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/error.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/eval.ctl
Index: psl-1983/20-kernel/eval.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/eval.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "eval";
+in "eval.build";
+ASMEnd;
+quit;
+compile eval.mac, deval.mac
+delete eval.mac, deval.mac
ADDED psl-1983/20-kernel/eval.init
Index: psl-1983/20-kernel/eval.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/eval.init
@@ -0,0 +1,9 @@
+(FLUID (QUOTE (THROWSIGNAL!* EMSG!* THROWTAG!*)))
+(PUT (QUOTE CATCH!-ALL) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE CATCH) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE !*CATCH) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (PROGJUMPTABLE!* PROGBODY!*)))
+(PUT (QUOTE PROG) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE GO) (QUOTE TYPE) (QUOTE FEXPR))
ADDED psl-1983/20-kernel/eval.log
Index: psl-1983/20-kernel/eval.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/eval.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/eval.rel
Index: psl-1983/20-kernel/eval.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/eval.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/extra.ctl
Index: psl-1983/20-kernel/extra.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/extra.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "extra";
+in "extra.build";
+ASMEnd;
+quit;
+compile extra.mac, dextra.mac
+delete extra.mac, dextra.mac
ADDED psl-1983/20-kernel/extra.init
Index: psl-1983/20-kernel/extra.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/extra.init
@@ -0,0 +1,2 @@
+(FLUID (QUOTE (SYSTEM_LIST!*)))
+(COPYD (QUOTE EXITLISP) (QUOTE QUIT))
ADDED psl-1983/20-kernel/extra.log
Index: psl-1983/20-kernel/extra.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/extra.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/extra.rel
Index: psl-1983/20-kernel/extra.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/extra.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/fasl.ctl
Index: psl-1983/20-kernel/fasl.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fasl.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "fasl";
+in "fasl.build";
+ASMEnd;
+quit;
+compile fasl.mac, dfasl.mac
+delete fasl.mac, dfasl.mac
ADDED psl-1983/20-kernel/fasl.init
Index: psl-1983/20-kernel/fasl.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fasl.init
@@ -0,0 +1,8 @@
+(FLUID (QUOTE (LOADDIRECTORIES!* LOADEXTENSIONS!* PENDINGLOADS!* !*LOWER
+!*REDEFMSG !*USERMODE !*INSIDELOAD !*VERBOSELOAD !*PRINTLOADNAMES OPTIONS!*)))
+(PUT (QUOTE LOAD) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE RELOAD) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DEFSTRUCT) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE HELP) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE CREF) (QUOTE SIMPFG) (QUOTE ((T (CREFON)) (NIL (CREFOFF)))))
+(PUT (QUOTE SYSLISP) (QUOTE SIMPFG) (QUOTE ((T (LOAD SYSLISP)))))
ADDED psl-1983/20-kernel/fasl.log
Index: psl-1983/20-kernel/fasl.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fasl.log
@@ -0,0 +1,75 @@
+
+ 7-Mar-83 15:48:41
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job FASL Req #262 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:20:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 800
+
+ Input from => PS:<PSL.KERNEL.20>FASL.CTL.2
+ Output to => PS:<PSL.KERNEL.20>FASL.LOG
+
+
+
+15:48:42 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+15:48:42 MONTR @SET TIME-LIMIT 1200
+15:48:42 MONTR @LOGIN KESSLER SMALL
+15:48:46 MONTR Job 13 on TTY225 7-Mar-83 15:48:46
+15:48:46 MONTR Previous login at 7-Mar-83 15:44:26
+15:48:46 MONTR There is 1 other job logged in as user KESSLER
+15:48:59 MONTR @
+15:48:59 MONTR [PS Mounted]
+15:48:59 MONTR
+15:48:59 MONTR [CONNECTED TO PS:<PSL.KERNEL.20>]
+15:48:59 MONTR define DSK: DSK:, P20:, PI:
+15:49:03 MONTR @S:DEC20-CROSS.EXE
+15:49:05 USER Dec 20 cross compiler
+15:49:07 USER [8] ASMOut "fasl";
+15:49:08 USER ASMOUT: IN files; or type in expressions
+15:49:09 USER When all done execute ASMEND;
+15:50:57 USER [9] in "fasl.build";
+15:50:59 USER %
+15:50:59 USER % FASL.BUILD - Files used for Fasl in the interpreter
+15:50:59 USER %
+15:50:59 USER % Author: Eric Benson
+15:50:59 USER % Symbolic Computation Group
+15:50:59 USER % Computer Science Dept.
+15:50:59 USER % University of Utah
+15:50:59 USER % Date: 19 May 1982
+15:50:59 USER % Copyright (c) 1982 University of Utah
+15:50:59 USER %
+15:50:59 USER
+15:50:59 USER PathIn "system-faslout.red"$
+15:51:02 USER PathIn "system-faslin.red"$
+15:51:12 USER PathIn "faslin.red"$
+15:51:42 USER *** Garbage collection starting
+15:52:01 USER *** GC 4: time 3388 ms
+15:52:01 USER *** 68004 recovered, 564 stable, 21432 active, 68004 free
+15:52:15 USER
+15:52:15 USER PathIn "load.red"$
+15:52:18 USER *** Function `LOAD' has been redefined
+15:52:21 USER *** Function `RELOAD' has been redefined
+15:52:35 USER % Standard module FASL loader
+15:52:35 USER PathIn "autoload.red"$ % stubs to load modules
+15:52:53 USER [10] ASMEnd;
+15:53:51 USER *** Garbage collection starting
+15:54:19 USER *** GC 5: time 3087 ms
+15:54:19 USER *** 73806 recovered, 13587 stable, 2607 active, 73806 free
+15:54:51 USER NIL
+15:54:52 USER [11] quit;
+15:54:55 MONTR @compile fasl.mac, dfasl.mac
+15:55:01 USER MACRO: .MAIN
+15:55:09 USER MACRO: .MAIN
+15:55:10 USER
+15:55:10 USER EXIT
+15:55:13 MONTR @delete fasl.mac, dfasl.mac
+15:55:13 MONTR FASL.MAC.1 [OK]
+15:55:14 MONTR DFASL.MAC.1 [OK]
+15:55:20 MONTR @
+15:55:27 MONTR Killed by OPERATOR, TTY 221
+15:55:27 MONTR Killed Job 13, User KESSLER, Account SMALL, TTY 225,
+15:55:27 MONTR at 7-Mar-83 15:55:26, Used 0:01:14 in 0:06:40
ADDED psl-1983/20-kernel/fasl.rel
Index: psl-1983/20-kernel/fasl.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fasl.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/fast-binder.red
Index: psl-1983/20-kernel/fast-binder.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fast-binder.red
@@ -0,0 +1,79 @@
+%
+% FAST-BINDER.RED - Fast binding and unbinding routines in LAP for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 12 July 1981
+% Copyright (c) 1981 University of Utah
+%
+
+on SysLisp;
+
+external WVar BndStkPtr, % The binding stack pointer
+ BndStkLowerBound, % Bottom of the binding stack
+ BndStkUpperBound; % Top of the binding stack
+
+% TAG( FastBind )
+
+lap '((!*Entry FastBind expr 0) % Bind IDs to values in registers
+%
+% FastBind is called with JSP T5, followed by
+% regnum,,idnum
+% ...
+%
+ (!*MOVE (WVar BndStkPtr) (reg t2)) % load binding stack pointer
+Loop
+ (!*MOVE (Indexed (reg t5) (WConst 0)) (reg t1)) % get next entry
+ (tlnn (reg t1) 8#777000) % if it's not an instruction
+ (!*JUMP (Label MoreLeft)) % keep binding
+ (!*MOVE (reg t2) (WVar BndStkPtr)) % Otherwise store bind stack pointer
+ (!*JUMP (MEMORY (reg t5) (WConst 0))) % and return
+MoreLeft
+ (!*WPLUS2 (reg t2) (WConst 2)) % add 2 to binding stack pointer
+ (caml (reg t2) (WVar BndStkUpperBound)) % if overflow occured
+ (!*JCALL BStackOverflow) % then error
+ (hlrz (reg t3) (reg t1)) % stick register number in t3
+ (caile (reg t3) (WConst MaxRealRegs)) % is it a real register?
+ (!*WPLUS2 (reg t3) % no, move to arg block
+ (WConst (difference (WArray ArgumentBlock)
+ (plus (WConst MaxRealRegs) 1))))
+ (hrrzm (reg t1) (Indexed (reg t2) (WConst -1)))
+ % store ID number in BndStk
+ (!*MOVE (MEMORY (reg t1) (WConst SymVal)) (reg t4))
+ % get old value for ID in t4
+ (!*MOVE (reg t4) (MEMORY (reg t2) (WConst 0))) % store value in BndStk
+ (!*MOVE (MEMORY (reg t3) (WConst 0)) (reg t3)) % get reg value in t3
+ (!*MOVE (reg t3) (MEMORY (reg t1) (WConst SymVal)))
+ % store in ID value cell
+ (aoja (reg t5) Loop) % try again
+);
+
+% TAG( FastUnBind )
+
+lap '((!*Entry FastUnBind expr 0) % Unbind last N entries in bind stack
+%
+% FastUnBind is called with JSP T5, followed by word containing count to
+% unbind.
+%
+ (!*MOVE (WVar BndStkPtr) (reg t1)) % get binding stack pointer in t1
+ (!*MOVE (MEMORY (reg t5) (WConst 0)) (reg t2)) % count in t2
+Loop
+ (!*JUMPWGREATERP (Label MoreLeft) (reg t2) (WConst 0))
+ % continue if count is > zero
+ (!*MOVE (reg t1) (WVar BndStkPtr)) % otherwise store bind stack pointer
+ (!*JUMP (MEMORY (reg t5) (WConst 1))) % and return
+MoreLeft
+ (camge (reg t1) (WVar BndStkLowerBound)) % check for underflow
+ (!*JCALL BStackUnderflow)
+ (dmove (reg t3) (Indexed (reg t1) -1)) % get ID # in t3, value in t4
+ (!*MOVE (reg t4) (MEMORY (reg t3) (WConst SymVal)))
+ % restore to value cell
+ (!*WDIFFERENCE (reg t1) (WConst 2)) % adjust binding stack pointer -2
+ (soja (reg t2) Loop) % and count down by 1, then try again
+);
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/fresh-kernel.ctl
Index: psl-1983/20-kernel/fresh-kernel.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fresh-kernel.ctl
@@ -0,0 +1,5 @@
+rename 20.SYM PREVIOUS-20.SYM
+copy PC:BARE-PSL.SYM 20.SYM
+; To regenerate the .CTL files:
+; PSL:PSL
+; (dskin "20-kernel-gen.sl")
ADDED psl-1983/20-kernel/fresh-kernel.log
Index: psl-1983/20-kernel/fresh-kernel.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fresh-kernel.log
@@ -0,0 +1,15 @@
+
+LINK FROM KESSLER, TTY 101
+
+[DO: Execution of PS:<PSL.KERNEL.20>FRESH-KERNEL.CTL.3 started at 7-Mar-83 15:11:40]
+
+ TOPS-20 Command processor 5(712)-1
+@rename 20.SYM PREVIOUS-20.SYM
+%No such filename - 20.SYM
+@copy PC:BARE-PSL.SYM 20.SYM
+ <PSL.COMP>BARE-PSL.SYM.1 => 20.SYM.27 [OK]
+@; To regenerate the .CTL files:
+; PSL:PSL
+; (dskin "20-kernel-gen.sl")
+
+[DO: Execution finished at 7-Mar-83 15:11:56]
ADDED psl-1983/20-kernel/fresh.mic
Index: psl-1983/20-kernel/fresh.mic
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/fresh.mic
@@ -0,0 +1,8 @@
+;; Independant compilation of a DEC20 program
+;
+; MIC FRESH modulename
+;
+; Initialize for new sequence of builds
+;
+@delete 'a.SYM
+@copy P20:bare-20.sym 'A.sym
ADDED psl-1983/20-kernel/function-primitives.red
Index: psl-1983/20-kernel/function-primitives.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/function-primitives.red
@@ -0,0 +1,87 @@
+%
+% FUNCTION-PRIMITIVES.RED - primitives used by PUTD/GETD and EVAL/APPLY
+% P20: version
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Every ID has a "function cell". It does not necessarily contain a legal
+% Lisp item, and therefore should not be accessed directly by Lisp functions.
+% In this implementation the function cell contains an instruction to be
+% executed. There are 3 possibilites for this instruction, for which the
+% following predicates and updating functions exist:
+%
+% FUnBoundP(ID) -- the function is not defined
+% FLambdaLinkP(ID) -- the function is interpreted
+% FCodeP(ID) -- the function is compiled
+%
+% MakeFUnBound(ID) -- undefine the function
+% MakeFLambdaLink(ID) -- specify that the function is interpreted
+% MakeFCode(ID, CodePtr) -- specify that the function is compiled,
+% and that the code resides at the address
+% associated with CodePtr
+%
+% GetFCodePointer(ID) -- returns the contents of the function cell as a
+% code pointer
+
+% These functions currently check that they have proper arguments, but this may
+% change since they are only used by functions that have checked them already.
+
+% Note that MakeFCode is necessarily machine-dependent -- this file currently
+% contains the PDP-10 version. This function should be moved to a file of
+% system-dependent routines. Of course, other things in this file will
+% probably have to change for a different machine as well.
+
+on SysLisp;
+
+internal WVar UnDefn = 8#265500000000 + &SymFnc IDLoc UndefinedFunction;
+internal WVar LamLnk = 8#265500000000 % JSP T5,xxx
+ + &SymFnc IDLoc CompiledCallingInterpreted;
+
+% currently the WVars UnDefn and LamLnk contain the instructions which will
+% be found in the function cells of undefined and interpreted functions.
+
+syslsp procedure FUnBoundP U; %. does U not have a function defn?
+ if IDP U then SymFnc U eq UnDefn
+ else NonIDError(U, 'FUnBoundP);
+
+syslsp procedure FLambdaLinkP U; %. is U an interpreted function?
+ if IDP U then SymFnc U eq LamLnk
+ else NonIDError(U, 'FLambdaLinkP);
+
+syslsp procedure FCodeP U; %. is U a compiled function?
+ if IDP U then SymFnc U neq UnDefn and SymFnc U neq LamLnk
+ else NonIDError(U, 'FCodeP);
+
+syslsp procedure MakeFUnBound U; %. Make U an undefined function
+ if IDP U then
+ << SymFnc U := UnDefn;
+ NIL >>
+ else NonIDError(U, 'MakeFUnBound);
+
+syslsp procedure MakeFLambdaLink U; %. Make U an interpreted function
+ if IDP U then
+ << SymFnc U := LamLnk;
+ NIL >>
+ else NonIDError(U, 'MakeFLambdaLink);
+
+
+syslsp procedure MakeFCode(U, CodePtr); %. Make U a compiled function
+ if IDP U then
+ if CodeP CodePtr then
+ << SymFnc U := CodePtr;
+ PutField(SymFnc U, 0, 9, 8#254); % JRST
+ NIL >>
+ else NonIDError(U, 'MakeFCode);
+
+syslsp procedure GetFCodePointer U; %. Get code pointer for U
+ if IDP U then MkCODE SymFnc U
+ else NonIDError(U, 'GetFCodePointer);
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/gc.red
Index: psl-1983/20-kernel/gc.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/gc.red
@@ -0,0 +1,1 @@
+in "compacting-gc.red"$
ADDED psl-1983/20-kernel/global-data.red
Index: psl-1983/20-kernel/global-data.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/global-data.red
@@ -0,0 +1,39 @@
+%
+% GLOBAL-DATA.RED - Data used by everyone
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 1 September 1981
+% Revised: 31 January 1983
+% Copyright (c) 1981 University of Utah
+%
+% 31-Jan-83 Nancy Kendzierski
+% Increased BPSSize to 100000 from 90000; decreased HeapSize to 90000
+% from 100000.
+
+on SysLisp;
+
+exported WConst MaxSymbols = 8000,
+ HeapSize = 90000,
+ MaxObArray = 8209, % first prime above 8192
+ StackSize = 10000,
+ BPSSize = 100000;
+
+exported WConst CompressedBinaryRadix = 8;
+
+external WArray SymNam, SymVal, SymFnc, SymPrp;
+
+external WVar NextSymbol;
+
+exported WConst MaxRealRegs = 5,
+ MaxArgs = 15;
+
+external WArray ArgumentBlock;
+
+external WArray HashTable;
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/heap.build
Index: psl-1983/20-kernel/heap.build
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/heap.build
@@ -0,0 +1,19 @@
+%
+% HEAP.BUILD - Declaration of the heap and BPS
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+on Syslisp;
+
+exported WArray BPS[BPSSize],
+ Heap[HeapSize];
+
+off Syslisp;
+
+END;
ADDED psl-1983/20-kernel/heap.ctl
Index: psl-1983/20-kernel/heap.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/heap.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "heap";
+in "heap.build";
+ASMEnd;
+quit;
+compile heap.mac, dheap.mac
+delete heap.mac, dheap.mac
ADDED psl-1983/20-kernel/heap.init
Index: psl-1983/20-kernel/heap.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/heap.init
ADDED psl-1983/20-kernel/heap.log
Index: psl-1983/20-kernel/heap.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/heap.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/heap.rel
Index: psl-1983/20-kernel/heap.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/heap.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/ibmize.clu
Index: psl-1983/20-kernel/ibmize.clu
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.clu
@@ -0,0 +1,184 @@
+%
+% IBMIZE -- Extract underline and boldface info. from a
+% lineprinter file (and convert for the IBM)
+%
+% Control chararacters handled: TAB, NL, FF, CR
+% Other control characters assumed to be printing.
+% Tab stops assumed every 8 columns.
+
+% 9/14/82 Added handling of empty lines at end of page.
+% Somewhat ugly change.
+
+% The pgstream represents the state of output. Pgline
+% is the current line within the page, beginning at 1.
+% Emptycount keeps track of saved up lines with no visible
+% contents. These will be output if a nonempty line arrives
+% before end of page.
+pgstream = record[pgline: int, s: stream, emptycount: int]
+
+ac = array[char]
+
+% Line with possible underscore and/or boldface
+u_b_line = record[line: array[char],
+ underscore: array[bool],
+ bold: array[bool]]
+
+LINE_LENGTH = 150 % maximum printing length of output line
+
+main = proc ()
+ sin: stream := get_io("read", "Input file: ", "lpt")
+ except others: return end
+ sout: stream := get_io("write", "Output file: ", "ibm")
+ except others: return end
+ process_file(sin, pgstream${s: sout, pgline: 1, emptycount: 0})
+ stream$close(sin)
+ stream$close(sout)
+ end main
+
+% process_file(sin: stream, lout: pgstream)
+% Reads from sin until end of file, process each line to make
+% overstriking work, and keeps track of the position on the current
+% page, inserting form feeds as it deems necessary.
+process_file = proc (sin: stream, lout: pgstream)
+ oline: u_b_line :=
+ u_b_line${line: ac$fill(0, LINE_LENGTH, ' '),
+ underscore: array[bool]$fill(0, LINE_LENGTH, false),
+ bold: array[bool]$fill(0, LINE_LENGTH, false)}
+ sout: stream := lout.s
+ while true do
+ process_line(sin, lout, oline)
+ end except others: end
+ %% stream$putc(sout,'\p')
+end process_file
+
+process_line = proc (sin: stream, lout: pgstream, oline: u_b_line)
+ signals (done)
+
+ sout: stream := lout.s
+ line: string := get_line(sin)
+ except others: signal done end
+
+ %% Insert FF if needed.
+ %% if lout.pgline > 60 cand ~ char$equal(string$fetch(line,1),'\p')
+ %% then
+ %% stream$putc (sout, '\p')
+ %% lout.pgline := 1
+ %% lout.emptycount := 0
+ %% end
+
+ for i: int in int$from_to(0,LINE_LENGTH - 1) do
+ oline.line[i] := ' '
+ oline.underscore[i] := false
+ oline.bold[i] := false
+ end
+ col: int := 0
+
+ for c: char in string$chars (line) do
+
+ %% Special handling for non-printing chars and '_'
+
+ if c = ' ' then col := col + 1
+ elseif c = '\r' then col := 0
+ elseif c = '\n' then lout.pgline := lout.pgline + 1
+ elseif c = '\b' then col := col - 1
+ elseif c = '\t' then col := col + 8 - (col // 8)
+ elseif c = '\p' then
+ col := 0
+ lout.pgline := 1
+ elseif c = '_' then
+ oline.underscore[col] := true
+ col := col + 1
+ else
+ oc: char := oline.line[col]
+ if oc = ' ' then
+ oline.line[col] := c
+ elseif oc = c then
+ oline.bold[col] := true
+ end
+ col := col + 1
+ end
+ end
+
+ emptyp: bool := true
+
+ for i: int in int$from_to(0,LINE_LENGTH - 1) do
+ if oline.line[i] ~= ' ' cor
+ oline.underscore[i] then
+ emptyp := false
+ break;
+ end
+ end
+
+ if emptyp then
+ lout.emptycount := lout.emptycount + 1
+ else
+ %% Put out any saved-up empty lines first
+ for i:int in int$from_to(1,lout.emptycount) do
+ stream$putc(sout,'\n')
+ end
+ lout.emptycount := 0
+ %% Print out everything involved in the line.
+ output_line(oline, sout)
+ end
+
+ %% Print the formfeed that came with (terminating) the line.
+ if char$equal('\p',string$fetch(line,string$size(line))) then
+ stream$putc(sout,'\p')
+ %% Throw away any empty lines just preceding \p
+ lout.emptycount := 0
+ elseif ~emptyp then
+ stream$putc(sout,'\n')
+ end
+
+end process_line
+
+% output_line(oline, sout: stream)
+output_line = proc(oline: u_b_line, sout: stream)
+ high: int := line_high(oline)
+ for i: int in int$from_to (0, high) do
+ stream$putc(sout, oline.line[i])
+ if oline.underscore[i] then
+ stream$putc(sout, '\b')
+ stream$putc(sout, '_')
+ end
+ end
+ %% stream$putc (sout, '\n')
+end output_line
+
+% line_high (line: u_b_line) returns (int)
+% Returns the index in the line of the last printing character.
+% If none exists, returns the minimum index minus 1.
+line_high = proc(oline: u_b_line) returns (int)
+ for i: int in
+ int$from_to_by(ac$high(oline.line), ac$low(oline.line), -1)
+ do
+ if oline.line[i] ~= ' '
+ cor oline.underscore[i]
+ then return(i) end
+ end
+ return(ac$low(oline.line) - 1)
+end line_high
+
+% get_line (sin: stream) returns (string) signals (end_of_file)
+% Reads from the stream characters through the first \n or \p.
+% If end of file is reached before any characters are entered,
+% end of file is signalled, otherwise not.
+% All characters read are returned.
+get_line = proc (sin: stream) returns (string) signals (end_of_file)
+ a: ac := ac$new ()
+ while true do
+ c: char := stream$getc_image (sin)
+ except others:
+ if ac$size (a) = 0 then signal end_of_file end
+ break
+ end
+ ac$addh (a, c)
+ if c = '\n' cor c = '\p' then break end
+ end
+ %% if ac$top (a) = '\r' then ac$remh (a) end except when bounds: end
+ return (string$ac2s (a))
+end get_line
+%%% Defines: get_line line_high main output_line process_file process_line
+%%% Edited: 14 September 1982 10:41:36
+%%% Uses: get_io
+%%% Written: 14 September 1982 10:45:04
ADDED psl-1983/20-kernel/ibmize.cluprog
Index: psl-1983/20-kernel/ibmize.cluprog
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.cluprog
@@ -0,0 +1,9 @@
+%%% DebugFile: ps:<hp-psl.misc>ibmize.debug
+%%% ExecutableFile: ps:<hp-psl.misc>ibmize.exe
+%%% MainProcedure: main
+%%% MakeFile: ps:<hp-psl.misc>ibmize.cmd
+%%% Optimize: F
+%%% ProgramFile: ps:<hp-psl.misc>ibmize.cluprog
+%%% SourceFiles: ps:<hp-psl.misc>ibmize.clu ps:<clu.tlib>msg.clu
+%%% ps:<perdue.utils>get_io.clu
+%%% XloadFile: ps:<hp-psl.misc>ibmize.xload
ADDED psl-1983/20-kernel/ibmize.cmd
Index: psl-1983/20-kernel/ibmize.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.cmd
@@ -0,0 +1,1 @@
+tlink &ps:<hp-psl.misc>ibmize.xload \search:<clu.tlib> \main:main ^ps:<hp-psl.misc>ibmize.exe
ADDED psl-1983/20-kernel/ibmize.debug
Index: psl-1983/20-kernel/ibmize.debug
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.debug
@@ -0,0 +1,1 @@
+tlink &ps:<hp-psl.misc>ibmize.xload \search:<clu.tlib> \debug
ADDED psl-1983/20-kernel/ibmize.exe
Index: psl-1983/20-kernel/ibmize.exe
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.exe
cannot compute difference between binary files
ADDED psl-1983/20-kernel/ibmize.tbin
Index: psl-1983/20-kernel/ibmize.tbin
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.tbin
cannot compute difference between binary files
ADDED psl-1983/20-kernel/ibmize.xload
Index: psl-1983/20-kernel/ibmize.xload
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/ibmize.xload
@@ -0,0 +1,3 @@
+ps:<hp-psl.misc>ibmize
+ps:<clu.tlib>msg
+ps:<perdue.utils>get_io
ADDED psl-1983/20-kernel/io-data.red
Index: psl-1983/20-kernel/io-data.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/io-data.red
@@ -0,0 +1,136 @@
+%
+% IO-DATA.RED - Data structures used by input and output
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL-20>IO-DATA.RED.2, 29-Dec-82 12:19:36, Edit by PERDUE
+% Added PagePosition array to support LPOSN
+
+on SysLisp;
+
+internal WConst MaxTokenSize = 5000;
+
+exported WString TokenBuffer[MaxTokenSize];
+
+exported WConst MaxChannels = 31;
+
+exported WArray ReadFunction = ['TerminalInputHandler,
+ 'WriteOnlyChannel,
+ 'WriteOnlyChannel,
+ 'CompressReadChar,
+ 'WriteOnlyChannel,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ WriteFunction = ['ReadOnlyChannel,
+ 'Dec20WriteChar,
+ 'ToStringWriteChar,
+ 'ExplodeWriteChar,
+ 'FlatSizeWriteChar,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ CloseFunction = ['IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ UnReadBuffer[MaxChannels],
+ LinePosition[MaxChannels],
+ PagePosition[MaxChannels],
+ MaxLine = [0, 80,80, 10000, 10000,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+ JFNOfChannel = [8#100,8#101,-1,-1,-1,
+ 0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0];
+
+
+off SysLisp;
+
+global '(!$EOL!$);
+LoadTime(!$EOL!$ := '!
+);
+
+END;
ADDED psl-1983/20-kernel/io.ctl
Index: psl-1983/20-kernel/io.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/io.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "io";
+in "io.build";
+ASMEnd;
+quit;
+compile io.mac, dio.mac
+delete io.mac, dio.mac
ADDED psl-1983/20-kernel/io.init
Index: psl-1983/20-kernel/io.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/io.init
@@ -0,0 +1,18 @@
+(GLOBAL (QUOTE (!$EOL!$)))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (SPECIALREADFUNCTION!* SPECIALWRITEFUNCTION!*
+SPECIALCLOSEFUNCTION!*)))
+(GLOBAL (QUOTE (SPECIALRDSACTION!* SPECIALWRSACTION!* IN!* OUT!*)))
+(FLUID (QUOTE (STDIN!* STDOUT!*)))
+(GLOBAL (QUOTE (OUT!*)))
+(FLUID (QUOTE (!*RAISE)))
+(FLUID (QUOTE (CURRENTREADMACROINDICATOR!* CURRENTSCANTABLE!*
+!*INSIDESTRUCTUREREAD)))
+(GLOBAL (QUOTE (TOKTYPE!* LISPSCANTABLE!* IN!* !$EOF!$)))
+(FLUID (QUOTE (CURRENTSCANTABLE!* !*RAISE !*COMPRESSING !*EOLINSTRINGOK)))
+(FLUID (QUOTE (OUTPUTBASE!* PRINLENGTH PRINLEVEL CURRENTSCANTABLE!*
+IDESCAPECHAR!* !*LOWER)))
+(GLOBAL (QUOTE (LISPSCANTABLE!*)))
+(FLUID (QUOTE (FORMATFORPRINTF!*)))
+(FLUID (QUOTE (EXPLODEENDPOINTER!* COMPRESSLIST!* !*COMPRESSING)))
+(GLOBAL (QUOTE (IN!* OUT!*)))
ADDED psl-1983/20-kernel/io.log
Index: psl-1983/20-kernel/io.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/io.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/io.rel
Index: psl-1983/20-kernel/io.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/io.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/killdir.mic
Index: psl-1983/20-kernel/killdir.mic
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/killdir.mic
@@ -0,0 +1,4 @@
+build ss:<psl.'A>
+kill
+
+
ADDED psl-1983/20-kernel/macro.ctl
Index: psl-1983/20-kernel/macro.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/macro.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "macro";
+in "macro.build";
+ASMEnd;
+quit;
+compile macro.mac, dmacro.mac
+delete macro.mac, dmacro.mac
ADDED psl-1983/20-kernel/macro.init
Index: psl-1983/20-kernel/macro.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/macro.init
@@ -0,0 +1,26 @@
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE TYPE) (QUOTE MACRO))
+(FLAG (QUOTE (COMMENTOUTCODE COMPILETIME)) (QUOTE IGNORE))
+(FLAG (QUOTE (BOTHTIMES)) (QUOTE EVAL))
+(REMFLAG (QUOTE (LOADTIME)) (QUOTE IGNORE))
+(REMFLAG (QUOTE (LOADTIME)) (QUOTE EVAL))
+(PUT (QUOTE CONTERROR) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE CASE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE SETF) (QUOTE TYPE) (QUOTE MACRO))
+(DEFLIST (QUOTE ((GETV PUTV) (CAR RPLACA) (CDR RPLACD) (INDX SETINDX) (SUB
+SETSUB) (NTH (LAMBDA (L I X) (RPLACA (PNTH L I) X) X)) (EVAL SET) (VALUE SET)))
+(QUOTE ASSIGN!-OP))
+(PUT (QUOTE ON) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE OFF) (QUOTE TYPE) (QUOTE MACRO))
+(FLAG (QUOTE (ON OFF)) (QUOTE IGNORE))
+(PUT (QUOTE DS) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DEFCONST) (QUOTE TYPE) (QUOTE MACRO))
+(FLAG (QUOTE (DEFCONST)) (QUOTE EVAL))
+(PUT (QUOTE CONST) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (STRINGGENSYM!*)))
+(SETQ STRINGGENSYM!* (COPYSTRING "L0000"))
+(PUT (QUOTE FOREACH) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE EXIT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE NEXT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE WHILE) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE REPEAT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE FOR) (QUOTE TYPE) (QUOTE MACRO))
ADDED psl-1983/20-kernel/macro.log
Index: psl-1983/20-kernel/macro.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/macro.log
@@ -0,0 +1,98 @@
+
+ 7-Mar-83 16:04:44
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job MACRO Req #264 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:20:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 802
+
+ Input from => PS:<PSL.KERNEL.20>MACRO.CTL.2
+ Output to => PS:<PSL.KERNEL.20>MACRO.LOG
+
+
+
+16:04:44 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+16:04:44 MONTR @SET TIME-LIMIT 1200
+16:04:45 MONTR @LOGIN KESSLER SMALL
+16:04:48 MONTR Job 13 on TTY225 7-Mar-83 16:04:48
+16:04:48 MONTR Previous login at 7-Mar-83 15:55:36
+16:04:48 MONTR There is 1 other job logged in as user KESSLER
+16:04:57 MONTR @
+16:04:57 MONTR [PS Mounted]
+16:04:57 MONTR
+16:04:57 MONTR [CONNECTED TO PS:<PSL.KERNEL.20>]
+16:04:57 MONTR define DSK: DSK:, P20:, PI:
+16:04:58 MONTR @S:DEC20-CROSS.EXE
+16:05:00 USER Dec 20 cross compiler
+16:05:03 USER [8] ASMOut "macro";
+16:05:07 USER ASMOUT: IN files; or type in expressions
+16:05:07 USER When all done execute ASMEND;
+16:06:20 USER [9] in "macro.build";
+16:06:21 USER %
+16:06:21 USER % MACRO.BUILD - Files of macros defined in the interpreter
+16:06:21 USER %
+16:06:21 USER % Author: Eric Benson
+16:06:21 USER % Symbolic Computation Group
+16:06:21 USER % Computer Science Dept.
+16:06:21 USER % University of Utah
+16:06:21 USER % Date: 19 May 1982
+16:06:21 USER % Copyright (c) 1982 University of Utah
+16:06:21 USER %
+16:06:21 USER
+16:06:21 USER % <PSL.KERNEL>MACRO.BUILD.2, 2-Feb-83 15:36:40, Edit by PERDUE
+16:06:21 USER % Removed char.red. It is now pnk:char-macro.red
+16:06:21 USER
+16:06:21 USER PathIn "eval-when.red"$
+16:06:22 USER *** Function `COMMENTOUTCODE' has been redefined
+16:06:26 USER % control evaluation time
+16:06:26 USER PathIn "cont-error.red"$
+16:06:31 USER *** Function `CONTERROR' has been redefined
+16:06:44 USER % macro for ContinuableError
+16:06:44 USER PathIn "lisp-macros.red"$
+16:06:56 USER *** Function `SETF' has been redefined
+16:06:57 USER % Various macros for readability
+16:06:58 USER PathIn "onoff.red"$
+16:07:01 USER *** Function `ON' has been redefined
+16:07:02 USER *** Function `OFF' has been redefined
+16:07:02 USER *** Garbage collection starting
+16:07:27 USER *** GC 4: time 3242 ms
+16:07:27 USER *** 73050 recovered, 564 stable, 16385 active, 73051 free
+16:07:37 USER % (on xxx yyy) and (off xxx yyy)
+16:07:37 USER PathIn "define-smacro.red"$
+16:07:57 USER *** Function `DS' has been redefined
+16:08:15 USER
+16:08:15 USER PathIn "defconst.red"$
+16:08:16 USER *** Function `DEFCONST' has been redefined
+16:08:18 USER *** Function `CONST' has been redefined
+16:08:19 USER
+16:08:19 USER PathIn "string-gensym.red"$
+16:08:23 USER PathIn "loop-macros.red"$
+16:08:25 USER *** Function `FOREACH' has been redefined
+16:08:31 USER *** Function `EXIT' has been redefined
+16:08:32 USER *** Function `NEXT' has been redefined
+16:08:32 USER *** Function `WHILE' has been redefined
+16:08:34 USER *** Function `REPEAT' has been redefined
+16:08:43 USER *** Function `FOR' has been redefined
+16:08:44 USER *** Garbage collection starting
+16:09:04 USER *** GC 5: time 2950 ms
+16:09:04 USER *** 70120 recovered, 16605 stable, 3275 active, 70120 free
+16:09:13 USER % Various macros for readability
+16:09:14 USER [10] ASMEnd;
+16:10:31 USER NIL
+16:10:32 USER [11] quit;
+16:10:33 MONTR @compile macro.mac, dmacro.mac
+16:10:37 USER MACRO: .MAIN
+16:10:51 USER MACRO: .MAIN
+16:10:52 USER
+16:10:52 USER EXIT
+16:10:52 MONTR @delete macro.mac, dmacro.mac
+16:10:56 MONTR MACRO.MAC.1 [OK]
+16:10:56 MONTR DMACRO.MAC.1 [OK]
+16:10:56 MONTR @
+16:10:58 MONTR Killed by OPERATOR, TTY 221
+16:10:58 MONTR Killed Job 13, User KESSLER, Account SMALL, TTY 225,
+16:10:58 MONTR at 7-Mar-83 16:10:58, Used 0:01:27 in 0:06:10
ADDED psl-1983/20-kernel/macro.rel
Index: psl-1983/20-kernel/macro.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/macro.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/main-start.red
Index: psl-1983/20-kernel/main-start.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main-start.red
@@ -0,0 +1,63 @@
+%
+% MAIN-START.RED - First routine called on startup
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 15 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL-20>MAIN-START.RED.4, 5-Oct-82 10:42:14, Edit by BENSON
+% Added call to EvalInitForms in MAIN!.
+
+on SysLisp;
+
+internal WConst StackSize = 4000;
+
+internal WArray Stack[StackSize];
+
+exported WVar StackLowerBound = &Stack[0],
+ StackUpperBound = &Stack[StackSize];
+
+external WVar ST;
+
+internal WConst MaxArgBlock = (MaxArgs - MaxRealRegs) - 1;
+
+% 0..MaxArgBlock are arguments (MaxRealRegs + 1)..MaxArgs
+
+exported WArray ArgumentBlock[MaxArgBlock];
+
+exported WArray HashTable[MaxObArray/2];
+
+lap '((!*entry Main!. expr 0)
+Forever
+ (move (reg st) (lit (halfword (minus (WConst StackSize))
+ (difference (WConst Stack) 1))))
+ (move (reg nil) (fluid nil))
+ (!*CALL pre!-main)
+ (jrst Forever)
+);
+
+syslsp procedure Reset();
+ Throw('Reset, 'Reset);
+
+syslsp procedure pre!-main();
+<< ClearBindings();
+ ClearIO();
+ EvalInitForms();
+ if Catch('Reset, Main()) = 'Reset then pre!-main() >>;
+
+syslsp procedure Main(); %. initialization function
+%
+% A new system can be created by redefining this function to call whatever
+% top loop is desired.
+%
+<< InitCode(); % special code accumulated in compiler
+ SymFnc IDLoc Main := SymFnc IDLoc StandardLisp; % don't do it again
+ StandardLisp() >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/main.ctl
Index: psl-1983/20-kernel/main.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "main";
+in "main.build";
+ASMEnd;
+quit;
+compile main.mac, dmain.mac
+delete main.mac, dmain.mac
ADDED psl-1983/20-kernel/main.init
Index: psl-1983/20-kernel/main.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main.init
ADDED psl-1983/20-kernel/main.log
Index: psl-1983/20-kernel/main.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/main.mac
Index: psl-1983/20-kernel/main.mac
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main.mac
@@ -0,0 +1,3010 @@
+ search monsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern STACK
+ extern L1191
+ extern L2107
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.:L3694: MOVE 15,L3693
+ MOVE 0,SYMVAL+128
+ PUSHJ 15,SYMFNC+842
+ JRST L3694
+L3693: byte(18)-4000,STACK-1
+ 0
+; (!*ENTRY RESET EXPR 0)
+RESET: intern RESET
+ MOVE 2,L3695
+ MOVE 1,L3695
+ JRST SYMFNC+495
+L3695: <30_31>+536
+ 0
+; (!*ENTRY PRE!-MAIN EXPR 0)
+L3697: intern L3697
+ ADJSP 15,2
+L3698: PUSHJ 15,SYMFNC+780
+ PUSHJ 15,SYMFNC+793
+ PUSHJ 15,SYMFNC+837
+ MOVE 1,L3696
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,0(15)
+ CAME 0,SYMVAL+500
+ JRST L3699
+ PUSHJ 15,SYMFNC+843
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+501
+ MOVE 1,-1(15)
+L3699: CAMN 1,L3696
+ JRST L3698
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L3696: <30_31>+536
+ 0
+; (!*ENTRY MAIN EXPR 0)
+MAIN: intern MAIN
+ PUSHJ 15,SYMFNC+844
+ MOVE 6,833+SYMFNC
+ MOVEM 6,843+SYMFNC
+ JRST SYMFNC+833
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L3716: intern L3716
+ MOVE 3,L3700
+ MOVE 2,L3701
+ MOVE 1,L3702
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L3700
+ MOVE 2,L3701
+ MOVE 1,L3703
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L3704
+ MOVE 2,L3705
+ MOVE 1,L3706
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L3707
+ MOVE 2,L3705
+ MOVE 1,L3708
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L3709
+ MOVE 2,L3705
+ MOVE 1,L3710
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L3711
+ MOVE 2,L3705
+ MOVE 1,L3712
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L3713
+ MOVE 2,L3705
+ HRRZI 1,26
+ TLZ 1,253952
+ TLO 1,245760
+ PUSHJ 15,SYMFNC+308
+ PUSHJ 15,SYMFNC+790
+ HRRZI 3,26
+ MOVE 2,L3714
+ MOVE 1,L3715
+ JRST SYMFNC+308
+L3715: <30_31>+845
+L3714: <30_31>+846
+L3713: <30_31>+640
+L3712: <30_31>+91
+L3711: <30_31>+645
+L3710: <30_31>+41
+L3709: <30_31>+644
+L3708: <30_31>+40
+L3707: <30_31>+643
+L3706: <30_31>+39
+L3705: <30_31>+637
+L3704: <30_31>+642
+L3703: <30_31>+254
+L3702: <30_31>+272
+L3701: <30_31>+758
+L3700: <30_31>+262
+L3717: <30_31>+269
+ <9_31>+L3718
+L3718: <30_31>+518
+ <9_31>+L3719
+L3719: <30_31>+296
+ <9_31>+L3720
+L3720: <30_31>+508
+ <9_31>+L3721
+L3721: <30_31>+509
+ <9_31>+L3722
+L3722: <30_31>+498
+ <9_31>+L3723
+L3723: <30_31>+478
+ <9_31>+L3724
+L3724: <30_31>+273
+ <9_31>+L3725
+L3725: <30_31>+806
+ <9_31>+L3726
+L3726: <30_31>+808
+ <9_31>+L3727
+L3727: <30_31>+510
+ <9_31>+L3728
+L3728: <30_31>+452
+ <9_31>+L3729
+L3729: <30_31>+843
+ <30_31>+128
+ intern L3717
+L3730: <30_31>+278
+ <9_31>+L3731
+L3731: <30_31>+541
+ <9_31>+L3732
+L3732: <30_31>+274
+ <9_31>+L3733
+L3733: <30_31>+276
+ <9_31>+L3734
+L3734: <30_31>+272
+ <9_31>+L3735
+L3735: <30_31>+268
+ <30_31>+128
+ intern L3730
+L3736: <30_31>+847
+ <9_31>+L3737
+L3737: <30_31>+848
+ <9_31>+L3738
+L3738: <30_31>+849
+ <9_31>+L3739
+L3739: <30_31>+850
+ <30_31>+128
+ intern L3736
+L3740: <4_31>+L3741
+ <9_31>+L3742
+L3741: -1
+ byte(7)0
+L3742: <4_31>+L3743
+ <30_31>+128
+L3743: 2
+ byte(7)112,108,58,0
+ intern L3740
+L3744: <9_31>+L3745
+ <9_31>+L3746
+L3745: <4_31>+L3747
+ <30_31>+559
+L3746: <9_31>+L3748
+ <9_31>+L3749
+L3747: 1
+ byte(7)46,98,0
+L3748: <4_31>+L3750
+ <30_31>+840
+L3749: <9_31>+L3751
+ <30_31>+128
+L3750: 3
+ byte(7)46,108,97,112,0
+L3751: <4_31>+L3752
+ <30_31>+840
+L3752: 2
+ byte(7)46,115,108,0
+ intern L3744
+L3753: 128
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 17
+ 10
+ 17
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 14
+ 15
+ 10
+ 10
+ 12
+ 10
+ 11
+ 11
+ 11
+ 10
+ 19
+ 10
+ 18
+ 20
+ 10
+ 0
+ 1
+ 2
+ 3
+ 4
+ 5
+ 6
+ 7
+ 8
+ 9
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 16
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ <30_31>+851
+ intern L3753
+L3754: 128
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 17
+ 10
+ 17
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 14
+ 15
+ 10
+ 10
+ 12
+ 10
+ 11
+ 11
+ 11
+ 10
+ 19
+ 10
+ 18
+ 20
+ 10
+ 0
+ 1
+ 2
+ 3
+ 4
+ 5
+ 6
+ 7
+ 8
+ 9
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 16
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ <30_31>+851
+ intern L3754
+L3755: 21
+ byte(7)80,111,114,116,97,98,108,101,32,83,116,97,110,100,97,114,100,32,76,73,83,80,0
+ intern L3755
+L3756: 0
+ byte(7)0,0
+ intern L3756
+L3757: 0
+ byte(7)1,0
+ intern L3757
+L3758: 0
+ byte(7)2,0
+ intern L3758
+L3759: 0
+ byte(7)3,0
+ intern L3759
+L3760: 0
+ byte(7)4,0
+ intern L3760
+L3761: 0
+ byte(7)5,0
+ intern L3761
+L3762: 0
+ byte(7)6,0
+ intern L3762
+L3763: 0
+ byte(7)7,0
+ intern L3763
+L3764: 0
+ byte(7)8,0
+ intern L3764
+L3765: 0
+ byte(7)9,0
+ intern L3765
+L3766: 0
+ byte(7)10,0
+ intern L3766
+L3767: 0
+ byte(7)11,0
+ intern L3767
+L3768: 0
+ byte(7)12,0
+ intern L3768
+L3769: 0
+ byte(7)13,0
+ intern L3769
+L3770: 0
+ byte(7)14,0
+ intern L3770
+L3771: 0
+ byte(7)15,0
+ intern L3771
+L3772: 0
+ byte(7)16,0
+ intern L3772
+L3773: 0
+ byte(7)17,0
+ intern L3773
+L3774: 0
+ byte(7)18,0
+ intern L3774
+L3775: 0
+ byte(7)19,0
+ intern L3775
+L3776: 0
+ byte(7)20,0
+ intern L3776
+L3777: 0
+ byte(7)21,0
+ intern L3777
+L3778: 0
+ byte(7)22,0
+ intern L3778
+L3779: 0
+ byte(7)23,0
+ intern L3779
+L3780: 0
+ byte(7)24,0
+ intern L3780
+L3781: 0
+ byte(7)25,0
+ intern L3781
+L3782: 0
+ byte(7)26,0
+ intern L3782
+L3783: 0
+ byte(7)27,0
+ intern L3783
+L3784: 0
+ byte(7)28,0
+ intern L3784
+L3785: 0
+ byte(7)29,0
+ intern L3785
+L3786: 0
+ byte(7)30,0
+ intern L3786
+L3787: 0
+ byte(7)31,0
+ intern L3787
+L3788: 0
+ byte(7)32,0
+ intern L3788
+L3789: 0
+ byte(7)33,0
+ intern L3789
+L3790: 0
+ byte(7)34,0
+ intern L3790
+L3791: 0
+ byte(7)35,0
+ intern L3791
+L3792: 0
+ byte(7)36,0
+ intern L3792
+L3793: 0
+ byte(7)37,0
+ intern L3793
+L3794: 0
+ byte(7)38,0
+ intern L3794
+L3795: 0
+ byte(7)39,0
+ intern L3795
+L3796: 0
+ byte(7)40,0
+ intern L3796
+L3797: 0
+ byte(7)41,0
+ intern L3797
+L3798: 0
+ byte(7)42,0
+ intern L3798
+L3799: 0
+ byte(7)43,0
+ intern L3799
+L3800: 0
+ byte(7)44,0
+ intern L3800
+L3801: 0
+ byte(7)45,0
+ intern L3801
+L3802: 0
+ byte(7)46,0
+ intern L3802
+L3803: 0
+ byte(7)47,0
+ intern L3803
+L3804: 0
+ byte(7)48,0
+ intern L3804
+L3805: 0
+ byte(7)49,0
+ intern L3805
+L3806: 0
+ byte(7)50,0
+ intern L3806
+L3807: 0
+ byte(7)51,0
+ intern L3807
+L3808: 0
+ byte(7)52,0
+ intern L3808
+L3809: 0
+ byte(7)53,0
+ intern L3809
+L3810: 0
+ byte(7)54,0
+ intern L3810
+L3811: 0
+ byte(7)55,0
+ intern L3811
+L3812: 0
+ byte(7)56,0
+ intern L3812
+L3813: 0
+ byte(7)57,0
+ intern L3813
+L3814: 0
+ byte(7)58,0
+ intern L3814
+L3815: 0
+ byte(7)59,0
+ intern L3815
+L3816: 0
+ byte(7)60,0
+ intern L3816
+L3817: 0
+ byte(7)61,0
+ intern L3817
+L3818: 0
+ byte(7)62,0
+ intern L3818
+L3819: 0
+ byte(7)63,0
+ intern L3819
+L3820: 0
+ byte(7)64,0
+ intern L3820
+L3821: 0
+ byte(7)65,0
+ intern L3821
+L3822: 0
+ byte(7)66,0
+ intern L3822
+L3823: 0
+ byte(7)67,0
+ intern L3823
+L3824: 0
+ byte(7)68,0
+ intern L3824
+L3825: 0
+ byte(7)69,0
+ intern L3825
+L3826: 0
+ byte(7)70,0
+ intern L3826
+L3827: 0
+ byte(7)71,0
+ intern L3827
+L3828: 0
+ byte(7)72,0
+ intern L3828
+L3829: 0
+ byte(7)73,0
+ intern L3829
+L3830: 0
+ byte(7)74,0
+ intern L3830
+L3831: 0
+ byte(7)75,0
+ intern L3831
+L3832: 0
+ byte(7)76,0
+ intern L3832
+L3833: 0
+ byte(7)77,0
+ intern L3833
+L3834: 0
+ byte(7)78,0
+ intern L3834
+L3835: 0
+ byte(7)79,0
+ intern L3835
+L3836: 0
+ byte(7)80,0
+ intern L3836
+L3837: 0
+ byte(7)81,0
+ intern L3837
+L3838: 0
+ byte(7)82,0
+ intern L3838
+L3839: 0
+ byte(7)83,0
+ intern L3839
+L3840: 0
+ byte(7)84,0
+ intern L3840
+L3841: 0
+ byte(7)85,0
+ intern L3841
+L3842: 0
+ byte(7)86,0
+ intern L3842
+L3843: 0
+ byte(7)87,0
+ intern L3843
+L3844: 0
+ byte(7)88,0
+ intern L3844
+L3845: 0
+ byte(7)89,0
+ intern L3845
+L3846: 0
+ byte(7)90,0
+ intern L3846
+L3847: 0
+ byte(7)91,0
+ intern L3847
+L3848: 0
+ byte(7)92,0
+ intern L3848
+L3849: 0
+ byte(7)93,0
+ intern L3849
+L3850: 0
+ byte(7)94,0
+ intern L3850
+L3851: 0
+ byte(7)95,0
+ intern L3851
+L3852: 0
+ byte(7)96,0
+ intern L3852
+L3853: 0
+ byte(7)97,0
+ intern L3853
+L3854: 0
+ byte(7)98,0
+ intern L3854
+L3855: 0
+ byte(7)99,0
+ intern L3855
+L3856: 0
+ byte(7)100,0
+ intern L3856
+L3857: 0
+ byte(7)101,0
+ intern L3857
+L3858: 0
+ byte(7)102,0
+ intern L3858
+L3859: 0
+ byte(7)103,0
+ intern L3859
+L3860: 0
+ byte(7)104,0
+ intern L3860
+L3861: 0
+ byte(7)105,0
+ intern L3861
+L3862: 0
+ byte(7)106,0
+ intern L3862
+L3863: 0
+ byte(7)107,0
+ intern L3863
+L3864: 0
+ byte(7)108,0
+ intern L3864
+L3865: 0
+ byte(7)109,0
+ intern L3865
+L3866: 0
+ byte(7)110,0
+ intern L3866
+L3867: 0
+ byte(7)111,0
+ intern L3867
+L3868: 0
+ byte(7)112,0
+ intern L3868
+L3869: 0
+ byte(7)113,0
+ intern L3869
+L3870: 0
+ byte(7)114,0
+ intern L3870
+L3871: 0
+ byte(7)115,0
+ intern L3871
+L3872: 0
+ byte(7)116,0
+ intern L3872
+L3873: 0
+ byte(7)117,0
+ intern L3873
+L3874: 0
+ byte(7)118,0
+ intern L3874
+L3875: 0
+ byte(7)119,0
+ intern L3875
+L3876: 0
+ byte(7)120,0
+ intern L3876
+L3877: 0
+ byte(7)121,0
+ intern L3877
+L3878: 0
+ byte(7)122,0
+ intern L3878
+L3879: 0
+ byte(7)123,0
+ intern L3879
+L3880: 0
+ byte(7)124,0
+ intern L3880
+L3881: 0
+ byte(7)125,0
+ intern L3881
+L3882: 0
+ byte(7)126,0
+ intern L3882
+L3883: 0
+ byte(7)127,0
+ intern L3883
+L3884: 2
+ byte(7)78,73,76,0
+ intern L3884
+L3885: 5
+ byte(7)73,68,50,73,78,84,0
+ intern L3885
+L3886: 9
+ byte(7)78,79,78,73,68,69,82,82,79,82,0
+ intern L3886
+L3887: 5
+ byte(7)73,78,84,50,73,68,0
+ intern L3887
+L3888: 8
+ byte(7)84,89,80,69,69,82,82,79,82,0
+ intern L3888
+L3889: 14
+ byte(7)78,79,78,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L3889
+L3890: 6
+ byte(7)73,78,84,50,83,89,83,0
+ intern L3890
+L3891: 8
+ byte(7)76,73,83,80,50,67,72,65,82,0
+ intern L3891
+L3892: 16
+ byte(7)78,79,78,67,72,65,82,65,67,84,69,82,69,82,82,79,82,0
+ intern L3892
+L3893: 7
+ byte(7)73,78,84,50,67,79,68,69,0
+ intern L3893
+L3894: 6
+ byte(7)83,89,83,50,73,78,84,0
+ intern L3894
+L3895: 5
+ byte(7)71,84,70,73,88,78,0
+ intern L3895
+L3896: 8
+ byte(7)73,68,50,83,84,82,73,78,71,0
+ intern L3896
+L3897: 12
+ byte(7)83,84,82,73,78,71,50,86,69,67,84,79,82,0
+ intern L3897
+L3898: 5
+ byte(7)71,84,86,69,67,84,0
+ intern L3898
+L3899: 13
+ byte(7)78,79,78,83,84,82,73,78,71,69,82,82,79,82,0
+ intern L3899
+L3900: 12
+ byte(7)86,69,67,84,79,82,50,83,84,82,73,78,71,0
+ intern L3900
+L3901: 4
+ byte(7)71,84,83,84,82,0
+ intern L3901
+L3902: 13
+ byte(7)78,79,78,86,69,67,84,79,82,69,82,82,79,82,0
+ intern L3902
+L3903: 10
+ byte(7)76,73,83,84,50,83,84,82,73,78,71,0
+ intern L3903
+L3904: 5
+ byte(7)76,69,78,71,84,72,0
+ intern L3904
+L3905: 11
+ byte(7)78,79,78,80,65,73,82,69,82,82,79,82,0
+ intern L3905
+L3906: 10
+ byte(7)83,84,82,73,78,71,50,76,73,83,84,0
+ intern L3906
+L3907: 3
+ byte(7)67,79,78,83,0
+ intern L3907
+L3908: 10
+ byte(7)76,73,83,84,50,86,69,67,84,79,82,0
+ intern L3908
+L3909: 10
+ byte(7)86,69,67,84,79,82,50,76,73,83,84,0
+ intern L3909
+L3910: 3
+ byte(7)71,69,84,86,0
+ intern L3910
+L3911: 5
+ byte(7)66,76,68,77,83,71,0
+ intern L3911
+L3912: 7
+ byte(7)83,84,68,69,82,82,79,82,0
+ intern L3912
+L3913: 9
+ byte(7)73,78,68,69,88,69,82,82,79,82,0
+ intern L3913
+L3914: 3
+ byte(7)80,85,84,86,0
+ intern L3914
+L3915: 3
+ byte(7)85,80,66,86,0
+ intern L3915
+L3916: 7
+ byte(7)69,86,69,67,84,79,82,80,0
+ intern L3916
+L3917: 4
+ byte(7)69,71,69,84,86,0
+ intern L3917
+L3918: 4
+ byte(7)69,80,85,84,86,0
+ intern L3918
+L3919: 4
+ byte(7)69,85,80,66,86,0
+ intern L3919
+L3920: 3
+ byte(7)73,78,68,88,0
+ intern L3920
+L3921: 9
+ byte(7)82,65,78,71,69,69,82,82,79,82,0
+ intern L3921
+L3922: 15
+ byte(7)78,79,78,83,69,81,85,69,78,67,69,69,82,82,79,82,0
+ intern L3922
+L3923: 6
+ byte(7)83,69,84,73,78,68,88,0
+ intern L3923
+L3924: 2
+ byte(7)83,85,66,0
+ intern L3924
+L3925: 5
+ byte(7)83,85,66,83,69,81,0
+ intern L3925
+L3926: 5
+ byte(7)71,84,87,82,68,83,0
+ intern L3926
+L3927: 10
+ byte(7)71,84,72,65,76,70,87,79,82,68,83,0
+ intern L3927
+L3928: 4
+ byte(7)78,67,79,78,83,0
+ intern L3928
+L3929: 4
+ byte(7)84,67,79,78,67,0
+ intern L3929
+L3930: 5
+ byte(7)83,69,84,83,85,66,0
+ intern L3930
+L3931: 8
+ byte(7)83,69,84,83,85,66,83,69,81,0
+ intern L3931
+L3932: 5
+ byte(7)67,79,78,67,65,84,0
+ intern L3932
+L3933: 5
+ byte(7)65,80,80,69,78,68,0
+ intern L3933
+L3934: 3
+ byte(7)83,73,90,69,0
+ intern L3934
+L3935: 7
+ byte(7)77,75,83,84,82,73,78,71,0
+ intern L3935
+L3936: 22
+ byte(7)78,79,78,80,79,83,73,84,73,86,69,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L3936
+L3937: 9
+ byte(7)77,65,75,69,45,66,89,84,69,83,0
+ intern L3937
+L3938: 13
+ byte(7)77,65,75,69,45,72,65,76,70,87,79,82,68,83,0
+ intern L3938
+L3939: 9
+ byte(7)77,65,75,69,45,87,79,82,68,83,0
+ intern L3939
+L3940: 10
+ byte(7)77,65,75,69,45,86,69,67,84,79,82,0
+ intern L3940
+L3941: 5
+ byte(7)83,84,82,73,78,71,0
+ intern L3941
+L3942: 5
+ byte(7)86,69,67,84,79,82,0
+ intern L3942
+L3943: 4
+ byte(7)67,79,68,69,80,0
+ intern L3943
+L3944: 1
+ byte(7)69,81,0
+ intern L3944
+L3945: 5
+ byte(7)70,76,79,65,84,80,0
+ intern L3945
+L3946: 3
+ byte(7)66,73,71,80,0
+ intern L3946
+L3947: 2
+ byte(7)73,68,80,0
+ intern L3947
+L3948: 4
+ byte(7)80,65,73,82,80,0
+ intern L3948
+L3949: 6
+ byte(7)83,84,82,73,78,71,80,0
+ intern L3949
+L3950: 6
+ byte(7)86,69,67,84,79,82,80,0
+ intern L3950
+L3951: 2
+ byte(7)67,65,82,0
+ intern L3951
+L3952: 2
+ byte(7)67,68,82,0
+ intern L3952
+L3953: 5
+ byte(7)82,80,76,65,67,65,0
+ intern L3953
+L3954: 5
+ byte(7)82,80,76,65,67,68,0
+ intern L3954
+L3955: 3
+ byte(7)70,73,88,80,0
+ intern L3955
+L3956: 4
+ byte(7)68,73,71,73,84,0
+ intern L3956
+L3957: 4
+ byte(7)76,73,84,69,82,0
+ intern L3957
+L3958: 2
+ byte(7)69,81,78,0
+ intern L3958
+L3959: 8
+ byte(7)76,73,83,80,69,81,85,65,76,0
+ intern L3959
+L3960: 10
+ byte(7)83,84,82,73,78,71,69,81,85,65,76,0
+ intern L3960
+L3961: 4
+ byte(7)69,81,83,84,82,0
+ intern L3961
+L3962: 4
+ byte(7)69,81,85,65,76,0
+ intern L3962
+L3963: 5
+ byte(7)67,65,65,65,65,82,0
+ intern L3963
+L3964: 4
+ byte(7)67,65,65,65,82,0
+ intern L3964
+L3965: 5
+ byte(7)67,65,65,65,68,82,0
+ intern L3965
+L3966: 5
+ byte(7)67,65,65,68,65,82,0
+ intern L3966
+L3967: 4
+ byte(7)67,65,65,68,82,0
+ intern L3967
+L3968: 5
+ byte(7)67,65,65,68,68,82,0
+ intern L3968
+L3969: 5
+ byte(7)67,65,68,65,65,82,0
+ intern L3969
+L3970: 4
+ byte(7)67,65,68,65,82,0
+ intern L3970
+L3971: 5
+ byte(7)67,65,68,65,68,82,0
+ intern L3971
+L3972: 5
+ byte(7)67,65,68,68,65,82,0
+ intern L3972
+L3973: 4
+ byte(7)67,65,68,68,82,0
+ intern L3973
+L3974: 5
+ byte(7)67,65,68,68,68,82,0
+ intern L3974
+L3975: 5
+ byte(7)67,68,65,65,65,82,0
+ intern L3975
+L3976: 4
+ byte(7)67,68,65,65,82,0
+ intern L3976
+L3977: 5
+ byte(7)67,68,65,65,68,82,0
+ intern L3977
+L3978: 5
+ byte(7)67,68,65,68,65,82,0
+ intern L3978
+L3979: 4
+ byte(7)67,68,65,68,82,0
+ intern L3979
+L3980: 5
+ byte(7)67,68,65,68,68,82,0
+ intern L3980
+L3981: 5
+ byte(7)67,68,68,65,65,82,0
+ intern L3981
+L3982: 4
+ byte(7)67,68,68,65,82,0
+ intern L3982
+L3983: 5
+ byte(7)67,68,68,65,68,82,0
+ intern L3983
+L3984: 5
+ byte(7)67,68,68,68,65,82,0
+ intern L3984
+L3985: 4
+ byte(7)67,68,68,68,82,0
+ intern L3985
+L3986: 5
+ byte(7)67,68,68,68,68,82,0
+ intern L3986
+L3987: 3
+ byte(7)67,65,65,82,0
+ intern L3987
+L3988: 3
+ byte(7)67,65,68,82,0
+ intern L3988
+L3989: 3
+ byte(7)67,68,65,82,0
+ intern L3989
+L3990: 3
+ byte(7)67,68,68,82,0
+ intern L3990
+L3991: 6
+ byte(7)83,65,70,69,67,65,82,0
+ intern L3991
+L3992: 6
+ byte(7)83,65,70,69,67,68,82,0
+ intern L3992
+L3993: 3
+ byte(7)65,84,79,77,0
+ intern L3993
+L3994: 8
+ byte(7)67,79,78,83,84,65,78,84,80,0
+ intern L3994
+L3995: 3
+ byte(7)78,85,76,76,0
+ intern L3995
+L3996: 6
+ byte(7)78,85,77,66,69,82,80,0
+ intern L3996
+L3997: 3
+ byte(7)69,88,80,84,0
+ intern L3997
+L3998: 6
+ byte(7)77,75,81,85,79,84,69,0
+ intern L3998
+L3999: 4
+ byte(7)76,73,83,84,51,0
+ intern L3999
+L4000: 15
+ byte(7)67,79,78,84,73,78,85,65,66,76,69,69,82,82,79,82,0
+ intern L4000
+L4001: 7
+ byte(7)71,82,69,65,84,69,82,80,0
+ intern L4001
+L4002: 9
+ byte(7)68,73,70,70,69,82,69,78,67,69,0
+ intern L4002
+L4003: 5
+ byte(7)77,73,78,85,83,80,0
+ intern L4003
+L4004: 5
+ byte(7)84,73,77,69,83,50,0
+ intern L4004
+L4005: 3
+ byte(7)65,68,68,49,0
+ intern L4005
+L4006: 7
+ byte(7)81,85,79,84,73,69,78,84,0
+ intern L4006
+L4007: 4
+ byte(7)80,76,85,83,50,0
+ intern L4007
+L4008: 3
+ byte(7)76,73,83,84,0
+ intern L4008
+L4009: 4
+ byte(7)69,86,76,73,83,0
+ intern L4009
+L4010: 4
+ byte(7)81,85,79,84,69,0
+ intern L4010
+L4011: 3
+ byte(7)69,88,80,82,0
+ intern L4011
+L4012: 1
+ byte(7)68,69,0
+ intern L4012
+L4013: 4
+ byte(7)76,73,83,84,50,0
+ intern L4013
+L4014: 4
+ byte(7)76,73,83,84,52,0
+ intern L4014
+L4015: 3
+ byte(7)80,85,84,68,0
+ intern L4015
+L4016: 7
+ byte(7)70,85,78,67,84,73,79,78,0
+ intern L4016
+L4017: 5
+ byte(7)76,65,77,66,68,65,0
+ intern L4017
+L4018: 4
+ byte(7)70,69,88,80,82,0
+ intern L4018
+L4019: 1
+ byte(7)68,70,0
+ intern L4019
+L4020: 4
+ byte(7)77,65,67,82,79,0
+ intern L4020
+L4021: 1
+ byte(7)68,77,0
+ intern L4021
+L4022: 4
+ byte(7)78,69,88,80,82,0
+ intern L4022
+L4023: 1
+ byte(7)68,78,0
+ intern L4023
+L4024: 3
+ byte(7)83,69,84,81,0
+ intern L4024
+L4025: 3
+ byte(7)69,86,65,76,0
+ intern L4025
+L4026: 2
+ byte(7)83,69,84,0
+ intern L4026
+L4027: 4
+ byte(7)80,82,79,71,50,0
+ intern L4027
+L4028: 4
+ byte(7)80,82,79,71,78,0
+ intern L4028
+L4029: 6
+ byte(7)69,86,80,82,79,71,78,0
+ intern L4029
+L4030: 2
+ byte(7)65,78,68,0
+ intern L4030
+L4031: 4
+ byte(7)69,86,65,78,68,0
+ intern L4031
+L4032: 1
+ byte(7)79,82,0
+ intern L4032
+L4033: 3
+ byte(7)69,86,79,82,0
+ intern L4033
+L4034: 3
+ byte(7)67,79,78,68,0
+ intern L4034
+L4035: 5
+ byte(7)69,86,67,79,78,68,0
+ intern L4035
+L4036: 2
+ byte(7)78,79,84,0
+ intern L4036
+L4037: 2
+ byte(7)65,66,83,0
+ intern L4037
+L4038: 4
+ byte(7)77,73,78,85,83,0
+ intern L4038
+L4039: 5
+ byte(7)68,73,86,73,68,69,0
+ intern L4039
+L4040: 4
+ byte(7)90,69,82,79,80,0
+ intern L4040
+L4041: 8
+ byte(7)82,69,77,65,73,78,68,69,82,0
+ intern L4041
+L4042: 4
+ byte(7)88,67,79,78,83,0
+ intern L4042
+L4043: 2
+ byte(7)77,65,88,0
+ intern L4043
+L4044: 11
+ byte(7)82,79,66,85,83,84,69,88,80,65,78,68,0
+ intern L4044
+L4045: 3
+ byte(7)77,65,88,50,0
+ intern L4045
+L4046: 4
+ byte(7)76,69,83,83,80,0
+ intern L4046
+L4047: 2
+ byte(7)77,73,78,0
+ intern L4047
+L4048: 3
+ byte(7)77,73,78,50,0
+ intern L4048
+L4049: 3
+ byte(7)80,76,85,83,0
+ intern L4049
+L4050: 4
+ byte(7)84,73,77,69,83,0
+ intern L4050
+L4051: 2
+ byte(7)77,65,80,0
+ intern L4051
+L4052: 8
+ byte(7)70,65,83,84,65,80,80,76,89,0
+ intern L4052
+L4053: 3
+ byte(7)77,65,80,67,0
+ intern L4053
+L4054: 5
+ byte(7)77,65,80,67,65,78,0
+ intern L4054
+L4055: 4
+ byte(7)78,67,79,78,67,0
+ intern L4055
+L4056: 5
+ byte(7)77,65,80,67,79,78,0
+ intern L4056
+L4057: 5
+ byte(7)77,65,80,67,65,82,0
+ intern L4057
+L4058: 6
+ byte(7)77,65,80,76,73,83,84,0
+ intern L4058
+L4059: 4
+ byte(7)65,83,83,79,67,0
+ intern L4059
+L4060: 5
+ byte(7)83,65,83,83,79,67,0
+ intern L4060
+L4061: 3
+ byte(7)80,65,73,82,0
+ intern L4061
+L4062: 5
+ byte(7)83,85,66,76,73,83,0
+ intern L4062
+L4063: 6
+ byte(7)68,69,70,76,73,83,84,0
+ intern L4063
+L4064: 2
+ byte(7)80,85,84,0
+ intern L4064
+L4065: 5
+ byte(7)68,69,76,69,84,69,0
+ intern L4065
+L4066: 5
+ byte(7)77,69,77,66,69,82,0
+ intern L4066
+L4067: 3
+ byte(7)77,69,77,81,0
+ intern L4067
+L4068: 6
+ byte(7)82,69,86,69,82,83,69,0
+ intern L4068
+L4069: 4
+ byte(7)83,85,66,83,84,0
+ intern L4069
+L4070: 5
+ byte(7)69,88,80,65,78,68,0
+ intern L4070
+L4071: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,0
+ intern L4071
+L4072: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,49,0
+ intern L4072
+L4073: 12
+ byte(7)67,72,65,78,78,69,76,84,69,82,80,82,73,0
+ intern L4073
+L4074: 4
+ byte(7)80,82,73,78,84,0
+ intern L4074
+L4075: 3
+ byte(7)79,85,84,42,0
+ intern L4075
+L4076: 2
+ byte(7)78,69,81,0
+ intern L4076
+L4077: 1
+ byte(7)78,69,0
+ intern L4077
+L4078: 2
+ byte(7)71,69,81,0
+ intern L4078
+L4079: 2
+ byte(7)76,69,81,0
+ intern L4079
+L4080: 4
+ byte(7)69,81,67,65,82,0
+ intern L4080
+L4081: 4
+ byte(7)69,88,80,82,80,0
+ intern L4081
+L4082: 3
+ byte(7)71,69,84,68,0
+ intern L4082
+L4083: 5
+ byte(7)77,65,67,82,79,80,0
+ intern L4083
+L4084: 5
+ byte(7)70,69,88,80,82,80,0
+ intern L4084
+L4085: 5
+ byte(7)78,69,88,80,82,80,0
+ intern L4085
+L4086: 4
+ byte(7)67,79,80,89,68,0
+ intern L4086
+L4087: 4
+ byte(7)82,69,67,73,80,0
+ intern L4087
+L4088: 4
+ byte(7)70,73,82,83,84,0
+ intern L4088
+L4089: 5
+ byte(7)83,69,67,79,78,68,0
+ intern L4089
+L4090: 4
+ byte(7)84,72,73,82,68,0
+ intern L4090
+L4091: 5
+ byte(7)70,79,85,82,84,72,0
+ intern L4091
+L4092: 3
+ byte(7)82,69,83,84,0
+ intern L4092
+L4093: 7
+ byte(7)82,69,86,69,82,83,73,80,0
+ intern L4093
+L4094: 6
+ byte(7)83,85,66,83,84,73,80,0
+ intern L4094
+L4095: 6
+ byte(7)68,69,76,69,84,73,80,0
+ intern L4095
+L4096: 3
+ byte(7)68,69,76,81,0
+ intern L4096
+L4097: 2
+ byte(7)68,69,76,0
+ intern L4097
+L4098: 5
+ byte(7)68,69,76,81,73,80,0
+ intern L4098
+L4099: 4
+ byte(7)65,84,83,79,67,0
+ intern L4099
+L4100: 2
+ byte(7)65,83,83,0
+ intern L4100
+L4101: 2
+ byte(7)77,69,77,0
+ intern L4101
+L4102: 5
+ byte(7)82,65,83,83,79,67,0
+ intern L4102
+L4103: 5
+ byte(7)68,69,76,65,83,67,0
+ intern L4103
+L4104: 7
+ byte(7)68,69,76,65,83,67,73,80,0
+ intern L4104
+L4105: 5
+ byte(7)68,69,76,65,84,81,0
+ intern L4105
+L4106: 7
+ byte(7)68,69,76,65,84,81,73,80,0
+ intern L4106
+L4107: 4
+ byte(7)83,85,66,76,65,0
+ intern L4107
+L4108: 5
+ byte(7)82,80,76,65,67,87,0
+ intern L4108
+L4109: 6
+ byte(7)76,65,83,84,67,65,82,0
+ intern L4109
+L4110: 7
+ byte(7)76,65,83,84,80,65,73,82,0
+ intern L4110
+L4111: 3
+ byte(7)67,79,80,89,0
+ intern L4111
+L4112: 2
+ byte(7)78,84,72,0
+ intern L4112
+L4113: 3
+ byte(7)83,85,66,49,0
+ intern L4113
+L4114: 3
+ byte(7)80,78,84,72,0
+ intern L4114
+L4115: 4
+ byte(7)65,67,79,78,67,0
+ intern L4115
+L4116: 4
+ byte(7)76,67,79,78,67,0
+ intern L4116
+L4117: 3
+ byte(7)77,65,80,50,0
+ intern L4117
+L4118: 4
+ byte(7)77,65,80,67,50,0
+ intern L4118
+L4119: 12
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,84,0
+ intern L4119
+L4120: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L4120
+L4121: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L4121
+L4122: 12
+ byte(7)67,72,65,78,78,69,76,83,80,65,67,69,83,0
+ intern L4122
+L4123: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,72,65,82,0
+ intern L4123
+L4124: 5
+ byte(7)83,80,65,67,69,83,0
+ intern L4124
+L4125: 9
+ byte(7)67,72,65,78,78,69,76,84,65,66,0
+ intern L4125
+L4126: 10
+ byte(7)67,72,65,78,78,69,76,80,79,83,78,0
+ intern L4126
+L4127: 2
+ byte(7)84,65,66,0
+ intern L4127
+L4128: 4
+ byte(7)70,73,76,69,80,0
+ intern L4128
+L4129: 3
+ byte(7)80,85,84,67,0
+ intern L4129
+L4130: 6
+ byte(7)83,80,65,67,69,83,50,0
+ intern L4130
+L4131: 13
+ byte(7)67,72,65,78,78,69,76,83,80,65,67,69,83,50,0
+ intern L4131
+L4132: 7
+ byte(7)76,73,83,84,50,83,69,84,0
+ intern L4132
+L4133: 8
+ byte(7)76,73,83,84,50,83,69,84,81,0
+ intern L4133
+L4134: 5
+ byte(7)65,68,74,79,73,78,0
+ intern L4134
+L4135: 6
+ byte(7)65,68,74,79,73,78,81,0
+ intern L4135
+L4136: 4
+ byte(7)85,78,73,79,78,0
+ intern L4136
+L4137: 5
+ byte(7)85,78,73,79,78,81,0
+ intern L4137
+L4138: 1
+ byte(7)88,78,0
+ intern L4138
+L4139: 2
+ byte(7)88,78,81,0
+ intern L4139
+L4140: 11
+ byte(7)73,78,84,69,82,83,69,67,84,73,79,78,0
+ intern L4140
+L4141: 12
+ byte(7)73,78,84,69,82,83,69,67,84,73,79,78,81,0
+ intern L4141
+L4142: 15
+ byte(7)75,78,79,87,78,45,70,82,69,69,45,83,80,65,67,69,0
+ intern L4142
+L4143: 5
+ byte(7)71,84,72,69,65,80,0
+ intern L4143
+L4144: 9
+ byte(7)70,65,84,65,76,69,82,82,79,82,0
+ intern L4144
+L4145: 7
+ byte(7)37,82,69,67,76,65,73,77,0
+ intern L4145
+L4146: 6
+ byte(7)71,67,45,84,82,65,80,0
+ intern L4146
+L4147: 12
+ byte(7)71,67,45,84,82,65,80,45,76,69,86,69,76,0
+ intern L4147
+L4148: 16
+ byte(7)83,69,84,45,71,67,45,84,82,65,80,45,76,69,86,69,76,0
+ intern L4148
+L4149: 6
+ byte(7)68,69,76,72,69,65,80,0
+ intern L4149
+L4150: 9
+ byte(7)71,84,67,79,78,83,84,83,84,82,0
+ intern L4150
+L4151: 4
+ byte(7)71,84,66,80,83,0
+ intern L4151
+L4152: 6
+ byte(7)71,84,69,86,69,67,84,0
+ intern L4152
+L4153: 5
+ byte(7)71,84,70,76,84,78,0
+ intern L4153
+L4154: 3
+ byte(7)71,84,73,68,0
+ intern L4154
+L4155: 6
+ byte(7)82,69,67,76,65,73,77,0
+ intern L4155
+L4156: 5
+ byte(7)68,69,76,66,80,83,0
+ intern L4156
+L4157: 7
+ byte(7)71,84,87,65,82,82,65,89,0
+ intern L4157
+L4158: 8
+ byte(7)68,69,76,87,65,82,82,65,89,0
+ intern L4158
+L4159: 15
+ byte(7)67,79,80,89,83,84,82,73,78,71,84,79,70,82,79,77,0
+ intern L4159
+L4160: 9
+ byte(7)67,79,80,89,83,84,82,73,78,71,0
+ intern L4160
+L4161: 9
+ byte(7)67,79,80,89,87,65,82,82,65,89,0
+ intern L4161
+L4162: 15
+ byte(7)67,79,80,89,86,69,67,84,79,82,84,79,70,82,79,77,0
+ intern L4162
+L4163: 9
+ byte(7)67,79,80,89,86,69,67,84,79,82,0
+ intern L4163
+L4164: 13
+ byte(7)67,79,80,89,87,82,68,83,84,79,70,82,79,77,0
+ intern L4164
+L4165: 7
+ byte(7)67,79,80,89,87,82,68,83,0
+ intern L4165
+L4166: 8
+ byte(7)84,79,84,65,76,67,79,80,89,0
+ intern L4166
+L4167: 5
+ byte(7)77,75,86,69,67,84,0
+ intern L4167
+L4168: 8
+ byte(7)77,75,69,86,69,67,84,79,82,0
+ intern L4168
+L4169: 6
+ byte(7)77,75,69,86,69,67,84,0
+ intern L4169
+L4170: 4
+ byte(7)76,73,83,84,53,0
+ intern L4170
+L4171: 2
+ byte(7)42,71,67,0
+ intern L4171
+L4172: 6
+ byte(7)71,67,84,73,77,69,42,0
+ intern L4172
+L4173: 5
+ byte(7)71,67,75,78,84,42,0
+ intern L4173
+L4174: 14
+ byte(7)72,69,65,80,45,87,65,82,78,45,76,69,86,69,76,0
+ intern L4174
+L4175: 10
+ byte(7)69,82,82,79,82,80,82,73,78,84,70,0
+ intern L4175
+L4176: 3
+ byte(7)84,73,77,67,0
+ intern L4176
+L4177: 3
+ byte(7)81,85,73,84,0
+ intern L4177
+L4178: 8
+ byte(7)82,69,84,85,82,78,78,73,76,0
+ intern L4178
+L4179: 13
+ byte(7)82,69,84,85,82,78,70,73,82,83,84,65,82,71,0
+ intern L4179
+L4180: 3
+ byte(7)76,65,78,68,0
+ intern L4180
+L4181: 2
+ byte(7)76,79,82,0
+ intern L4181
+L4182: 3
+ byte(7)76,88,79,82,0
+ intern L4182
+L4183: 5
+ byte(7)76,83,72,73,70,84,0
+ intern L4183
+L4184: 2
+ byte(7)76,83,72,0
+ intern L4184
+L4185: 3
+ byte(7)76,78,79,84,0
+ intern L4185
+L4186: 2
+ byte(7)70,73,88,0
+ intern L4186
+L4187: 4
+ byte(7)70,76,79,65,84,0
+ intern L4187
+L4188: 3
+ byte(7)79,78,69,80,0
+ intern L4188
+L4189: 4
+ byte(7)68,69,66,85,71,0
+ intern L4189
+L4190: 1
+ byte(7)84,82,0
+ intern L4190
+L4191: 5
+ byte(7)69,86,76,79,65,68,0
+ intern L4191
+L4192: 3
+ byte(7)84,82,83,84,0
+ intern L4192
+L4193: 7
+ byte(7)81,69,68,73,84,70,78,83,0
+ intern L4193
+L4194: 6
+ byte(7)42,69,88,80,69,82,84,0
+ intern L4194
+L4195: 7
+ byte(7)42,86,69,82,66,79,83,69,0
+ intern L4195
+L4196: 4
+ byte(7)69,68,73,84,70,0
+ intern L4196
+L4197: 3
+ byte(7)69,68,73,84,0
+ intern L4197
+L4198: 3
+ byte(7)89,69,83,80,0
+ intern L4198
+L4199: 12
+ byte(7)80,82,79,77,80,84,83,84,82,73,78,71,42,0
+ intern L4199
+L4200: 7
+ byte(7)70,65,83,84,66,73,78,68,0
+ intern L4200
+L4201: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L4201
+L4202: 12
+ byte(7)69,68,73,84,79,82,82,69,65,68,69,82,42,0
+ intern L4202
+L4203: 13
+ byte(7)69,68,73,84,79,82,80,82,73,78,84,69,82,42,0
+ intern L4203
+L4204: 9
+ byte(7)70,65,83,84,85,78,66,73,78,68,0
+ intern L4204
+L4205: 3
+ byte(7)82,69,65,68,0
+ intern L4205
+L4206: 1
+ byte(7)67,76,0
+ intern L4206
+L4207: 3
+ byte(7)72,69,76,80,0
+ intern L4207
+L4208: 4
+ byte(7)66,82,69,65,75,0
+ intern L4208
+L4209: 4
+ byte(7)69,72,69,76,80,0
+ intern L4209
+L4210: 1
+ byte(7)80,76,0
+ intern L4210
+L4211: 1
+ byte(7)85,80,0
+ intern L4211
+L4212: 1
+ byte(7)79,75,0
+ intern L4212
+L4213: 14
+ byte(7)68,73,83,80,76,65,89,72,69,76,80,70,73,76,69,0
+ intern L4213
+L4214: 5
+ byte(7)69,68,73,84,79,82,0
+ intern L4214
+L4215: 18
+ byte(7)73,71,78,79,82,69,68,73,78,66,65,67,75,84,82,65,67,69,42,0
+ intern L4215
+L4216: 20
+ byte(7)73,78,84,69,82,80,82,69,84,69,82,70,85,78,67,84,73,79,78,83,42,0
+ intern L4216
+L4217: 14
+ byte(7)73,78,84,69,82,80,66,65,67,75,84,82,65,67,69,0
+ intern L4217
+L4218: 5
+ byte(7)80,82,73,78,84,70,0
+ intern L4218
+L4219: 8
+ byte(7)66,65,67,75,84,82,65,67,69,0
+ intern L4219
+L4220: 13
+ byte(7)82,69,84,85,82,78,65,68,68,82,69,83,83,80,0
+ intern L4220
+L4221: 6
+ byte(7)65,68,68,82,50,73,68,0
+ intern L4221
+L4222: 15
+ byte(7)86,69,82,66,79,83,69,66,65,67,75,84,82,65,67,69,0
+ intern L4222
+L4223: 7
+ byte(7)79,80,84,73,79,78,83,42,0
+ intern L4223
+L4224: 8
+ byte(7)87,82,73,84,69,67,72,65,82,0
+ intern L4224
+L4225: 22
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,85,78,75,78,79,87,78,73,84,69,77,0
+ intern L4225
+L4226: 21
+ byte(7)67,79,68,69,45,65,68,68,82,69,83,83,45,84,79,45,83,89,77,66,79,76,0
+ intern L4226
+L4227: 4
+ byte(7)80,82,73,78,49,0
+ intern L4227
+L4228: 4
+ byte(7)69,82,82,79,82,0
+ intern L4228
+L4229: 1
+ byte(7)78,79,0
+ intern L4229
+L4230: 2
+ byte(7)89,69,83,0
+ intern L4230
+L4231: 2
+ byte(7)82,68,83,0
+ intern L4231
+L4232: 6
+ byte(7)69,82,82,79,85,84,42,0
+ intern L4232
+L4233: 2
+ byte(7)87,82,83,0
+ intern L4233
+L4234: 7
+ byte(7)69,82,82,79,82,83,69,84,0
+ intern L4234
+L4235: 6
+ byte(7)67,85,82,83,89,77,42,0
+ intern L4235
+L4236: 8
+ byte(7)42,83,69,77,73,67,79,76,42,0
+ intern L4236
+L4237: 9
+ byte(7)69,82,82,79,82,70,79,82,77,42,0
+ intern L4237
+L4238: 16
+ byte(7)42,67,79,78,84,73,78,85,65,66,76,69,69,82,82,79,82,0
+ intern L4238
+L4239: 4
+ byte(7)69,77,83,71,42,0
+ intern L4239
+L4240: 5
+ byte(7)42,66,82,69,65,75,0
+ intern L4240
+L4241: 5
+ byte(7)42,69,77,83,71,80,0
+ intern L4241
+L4242: 13
+ byte(7)77,65,88,66,82,69,65,75,76,69,86,69,76,42,0
+ intern L4242
+L4243: 10
+ byte(7)66,82,69,65,75,76,69,86,69,76,42,0
+ intern L4243
+L4244: 7
+ byte(7)70,76,65,84,83,73,90,69,0
+ intern L4244
+L4245: 13
+ byte(7)85,83,65,71,69,84,89,80,69,69,82,82,79,82,0
+ intern L4245
+L4246: 13
+ byte(7)78,79,78,78,85,77,66,69,82,69,82,82,79,82,0
+ intern L4246
+L4247: 7
+ byte(7)78,79,78,87,79,82,68,83,0
+ intern L4247
+L4248: 16
+ byte(7)78,79,78,73,79,67,72,65,78,78,69,76,69,82,82,79,82,0
+ intern L4248
+L4249: 9
+ byte(7)42,66,65,67,75,84,82,65,67,69,0
+ intern L4249
+L4250: 15
+ byte(7)42,73,78,78,69,82,42,66,65,67,75,84,82,65,67,69,0
+ intern L4250
+L4251: 4
+ byte(7)84,72,82,79,87,0
+ intern L4251
+L4252: 6
+ byte(7)36,69,82,82,79,82,36,0
+ intern L4252
+L4253: 5
+ byte(7)69,82,82,83,69,84,0
+ intern L4253
+L4254: 4
+ byte(7)67,65,84,67,72,0
+ intern L4254
+L4255: 9
+ byte(7)67,65,84,67,72,83,69,84,85,80,0
+ intern L4255
+L4256: 11
+ byte(7)84,72,82,79,87,83,73,71,78,65,76,42,0
+ intern L4256
+L4257: 7
+ byte(7)37,85,78,67,65,84,67,72,0
+ intern L4257
+L4258: 13
+ byte(7)67,72,65,78,78,69,76,78,79,84,79,80,69,78,0
+ intern L4258
+L4259: 11
+ byte(7)67,72,65,78,78,69,76,69,82,82,79,82,0
+ intern L4259
+L4260: 15
+ byte(7)87,82,73,84,69,79,78,76,89,67,72,65,78,78,69,76,0
+ intern L4260
+L4261: 14
+ byte(7)82,69,65,68,79,78,76,89,67,72,65,78,78,69,76,0
+ intern L4261
+L4262: 26
+ byte(7)73,76,76,69,71,65,76,83,84,65,78,68,65,82,68,67,72,65,78,78,69,76,67,76,79,83,69,0
+ intern L4262
+L4263: 6
+ byte(7)73,79,69,82,82,79,82,0
+ intern L4263
+L4264: 8
+ byte(7)67,79,68,69,65,80,80,76,89,0
+ intern L4264
+L4265: 12
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,0
+ intern L4265
+L4266: 7
+ byte(7)66,73,78,68,69,86,65,76,0
+ intern L4266
+L4267: 5
+ byte(7)76,66,73,78,68,49,0
+ intern L4267
+L4268: 25
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,0
+ intern L4268
+L4269: 13
+ byte(7)66,83,84,65,67,75,79,86,69,82,70,76,79,87,0
+ intern L4269
+L4270: 17
+ byte(7)82,69,83,84,79,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L4270
+L4271: 10
+ byte(7)42,76,65,77,66,68,65,76,73,78,75,0
+ intern L4271
+L4272: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L4272
+L4273: 6
+ byte(7)85,78,66,73,78,68,78,0
+ intern L4273
+L4274: 4
+ byte(7)65,80,80,76,89,0
+ intern L4274
+L4275: 8
+ byte(7)70,85,78,66,79,85,78,68,80,0
+ intern L4275
+L4276: 5
+ byte(7)70,67,79,68,69,80,0
+ intern L4276
+L4277: 14
+ byte(7)71,69,84,70,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L4277
+L4278: 2
+ byte(7)71,69,84,0
+ intern L4278
+L4279: 8
+ byte(7)86,65,76,85,69,67,69,76,76,0
+ intern L4279
+L4280: 8
+ byte(7)71,69,84,70,78,84,89,80,69,0
+ intern L4280
+L4281: 8
+ byte(7)38,38,86,65,76,85,69,38,38,0
+ intern L4281
+L4282: 8
+ byte(7)84,72,82,79,87,84,65,71,42,0
+ intern L4282
+L4283: 8
+ byte(7)67,65,84,67,72,45,65,76,76,0
+ intern L4283
+L4284: 9
+ byte(7)85,78,87,73,78,68,45,65,76,76,0
+ intern L4284
+L4285: 9
+ byte(7)38,38,84,72,82,79,87,78,38,38,0
+ intern L4285
+L4286: 15
+ byte(7)36,85,78,87,73,78,68,45,80,82,79,84,69,67,84,36,0
+ intern L4286
+L4287: 6
+ byte(7)38,38,84,65,71,38,38,0
+ intern L4287
+L4288: 5
+ byte(7)37,84,72,82,79,87,0
+ intern L4288
+L4289: 13
+ byte(7)85,78,87,73,78,68,45,80,82,79,84,69,67,84,0
+ intern L4289
+L4290: 5
+ byte(7)42,67,65,84,67,72,0
+ intern L4290
+L4291: 5
+ byte(7)42,84,72,82,79,87,0
+ intern L4291
+L4292: 4
+ byte(7)82,69,83,69,84,0
+ intern L4292
+L4293: 17
+ byte(7)67,65,80,84,85,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L4293
+L4294: 17
+ byte(7)37,67,76,69,65,82,45,67,65,84,67,72,45,83,84,65,67,75,0
+ intern L4294
+L4295: 8
+ byte(7)80,82,79,71,66,79,68,89,42,0
+ intern L4295
+L4296: 13
+ byte(7)80,82,79,71,74,85,77,80,84,65,66,76,69,42,0
+ intern L4296
+L4297: 3
+ byte(7)80,82,79,71,0
+ intern L4297
+L4298: 5
+ byte(7)80,66,73,78,68,49,0
+ intern L4298
+L4299: 5
+ byte(7)36,80,82,79,71,36,0
+ intern L4299
+L4300: 1
+ byte(7)71,79,0
+ intern L4300
+L4301: 5
+ byte(7)82,69,84,85,82,78,0
+ intern L4301
+L4302: 11
+ byte(7)83,89,83,84,69,77,95,76,73,83,84,42,0
+ intern L4302
+L4303: 3
+ byte(7)68,65,84,69,0
+ intern L4303
+L4304: 7
+ byte(7)68,85,77,80,76,73,83,80,0
+ intern L4304
+L4305: 13
+ byte(7)66,73,78,65,82,89,79,80,69,78,82,69,65,68,0
+ intern L4305
+L4306: 8
+ byte(7)68,69,67,50,48,79,80,69,78,0
+ intern L4306
+L4307: 14
+ byte(7)66,73,78,65,82,89,79,80,69,78,87,82,73,84,69,0
+ intern L4307
+L4308: 16
+ byte(7)86,65,76,85,69,67,69,76,76,76,79,67,65,84,73,79,78,0
+ intern L4308
+L4309: 15
+ byte(7)42,87,82,73,84,73,78,71,70,65,83,76,70,73,76,69,0
+ intern L4309
+L4310: 16
+ byte(7)78,69,87,66,73,84,84,65,66,76,69,69,78,84,82,89,42,0
+ intern L4310
+L4311: 11
+ byte(7)70,73,78,68,73,68,78,85,77,66,69,82,0
+ intern L4311
+L4312: 16
+ byte(7)77,65,75,69,82,69,76,79,67,72,65,76,70,87,79,82,68,0
+ intern L4312
+L4313: 15
+ byte(7)69,88,84,82,65,82,69,71,76,79,67,65,84,73,79,78,0
+ intern L4313
+L4314: 19
+ byte(7)70,85,78,67,84,73,79,78,67,69,76,76,76,79,67,65,84,73,79,78,0
+ intern L4314
+L4315: 5
+ byte(7)70,65,83,76,73,78,0
+ intern L4315
+L4316: 5
+ byte(7)73,78,84,69,82,78,0
+ intern L4316
+L4317: 7
+ byte(7)80,85,84,69,78,84,82,89,0
+ intern L4317
+L4318: 15
+ byte(7)76,79,65,68,68,73,82,69,67,84,79,82,73,69,83,42,0
+ intern L4318
+L4319: 14
+ byte(7)76,79,65,68,69,88,84,69,78,83,73,79,78,83,42,0
+ intern L4319
+L4320: 11
+ byte(7)42,86,69,82,66,79,83,69,76,79,65,68,0
+ intern L4320
+L4321: 14
+ byte(7)42,80,82,73,78,84,76,79,65,68,78,65,77,69,83,0
+ intern L4321
+L4322: 3
+ byte(7)76,79,65,68,0
+ intern L4322
+L4323: 4
+ byte(7)76,79,65,68,49,0
+ intern L4323
+L4324: 5
+ byte(7)82,69,76,79,65,68,0
+ intern L4324
+L4325: 7
+ byte(7)69,86,82,69,76,79,65,68,0
+ intern L4325
+L4326: 8
+ byte(7)42,85,83,69,82,77,79,68,69,0
+ intern L4326
+L4327: 8
+ byte(7)42,82,69,68,69,70,77,83,71,0
+ intern L4327
+L4328: 10
+ byte(7)42,73,78,83,73,68,69,76,79,65,68,0
+ intern L4328
+L4329: 5
+ byte(7)42,76,79,87,69,82,0
+ intern L4329
+L4330: 12
+ byte(7)80,69,78,68,73,78,71,76,79,65,68,83,42,0
+ intern L4330
+L4331: 6
+ byte(7)73,77,80,79,82,84,83,0
+ intern L4331
+L4332: 10
+ byte(7)80,82,69,84,84,89,80,82,73,78,84,0
+ intern L4332
+L4333: 8
+ byte(7)68,69,70,83,84,82,85,67,84,0
+ intern L4333
+L4334: 3
+ byte(7)83,84,69,80,0
+ intern L4334
+L4335: 3
+ byte(7)77,73,78,73,0
+ intern L4335
+L4336: 4
+ byte(7)69,77,79,68,69,0
+ intern L4336
+L4337: 5
+ byte(7)73,78,86,79,75,69,0
+ intern L4337
+L4338: 4
+ byte(7)82,67,82,69,70,0
+ intern L4338
+L4339: 5
+ byte(7)67,82,69,70,79,78,0
+ intern L4339
+L4340: 7
+ byte(7)67,79,77,80,73,76,69,82,0
+ intern L4340
+L4341: 4
+ byte(7)67,79,77,80,68,0
+ intern L4341
+L4342: 6
+ byte(7)70,65,83,76,79,85,84,0
+ intern L4342
+L4343: 2
+ byte(7)66,85,71,0
+ intern L4343
+L4344: 3
+ byte(7)69,88,69,67,0
+ intern L4344
+L4345: 1
+ byte(7)77,77,0
+ intern L4345
+L4346: 19
+ byte(7)84,69,82,77,73,78,65,76,73,78,80,85,84,72,65,78,68,76,69,82,0
+ intern L4346
+L4347: 15
+ byte(7)67,79,77,80,82,69,83,83,82,69,65,68,67,72,65,82,0
+ intern L4347
+L4348: 13
+ byte(7)68,69,67,50,48,87,82,73,84,69,67,72,65,82,0
+ intern L4348
+L4349: 16
+ byte(7)84,79,83,84,82,73,78,71,87,82,73,84,69,67,72,65,82,0
+ intern L4349
+L4350: 15
+ byte(7)69,88,80,76,79,68,69,87,82,73,84,69,67,72,65,82,0
+ intern L4350
+L4351: 16
+ byte(7)70,76,65,84,83,73,90,69,87,82,73,84,69,67,72,65,82,0
+ intern L4351
+L4352: 4
+ byte(7)36,69,79,76,36,0
+ intern L4352
+L4353: 14
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,67,72,65,82,0
+ intern L4353
+L4354: 7
+ byte(7)82,69,65,68,67,72,65,82,0
+ intern L4354
+L4355: 2
+ byte(7)73,78,42,0
+ intern L4355
+L4356: 16
+ byte(7)67,72,65,78,78,69,76,85,78,82,69,65,68,67,72,65,82,0
+ intern L4356
+L4357: 9
+ byte(7)85,78,82,69,65,68,67,72,65,82,0
+ intern L4357
+L4358: 3
+ byte(7)79,80,69,78,0
+ intern L4358
+L4359: 21
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,70,79,82,73,78,80,85,84,0
+ intern L4359
+L4360: 22
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,70,79,82,79,85,84,80,85,84,0
+ intern L4360
+L4361: 20
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,83,80,69,67,73,65,76,0
+ intern L4361
+L4362: 19
+ byte(7)83,80,69,67,73,65,76,82,69,65,68,70,85,78,67,84,73,79,78,42,0
+ intern L4362
+L4363: 20
+ byte(7)83,80,69,67,73,65,76,87,82,73,84,69,70,85,78,67,84,73,79,78,42,0
+ intern L4363
+L4364: 20
+ byte(7)83,80,69,67,73,65,76,67,76,79,83,69,70,85,78,67,84,73,79,78,42,0
+ intern L4364
+L4365: 6
+ byte(7)83,80,69,67,73,65,76,0
+ intern L4365
+L4366: 5
+ byte(7)79,85,84,80,85,84,0
+ intern L4366
+L4367: 4
+ byte(7)73,78,80,85,84,0
+ intern L4367
+L4368: 4
+ byte(7)67,76,79,83,69,0
+ intern L4368
+L4369: 24
+ byte(7)83,89,83,84,69,77,77,65,82,75,65,83,67,76,79,83,69,68,67,72,65,78,78,69,76,0
+ intern L4369
+L4370: 16
+ byte(7)83,80,69,67,73,65,76,82,68,83,65,67,84,73,79,78,42,0
+ intern L4370
+L4371: 5
+ byte(7)83,84,68,73,78,42,0
+ intern L4371
+L4372: 16
+ byte(7)83,80,69,67,73,65,76,87,82,83,65,67,84,73,79,78,42,0
+ intern L4372
+L4373: 6
+ byte(7)83,84,68,79,85,84,42,0
+ intern L4373
+L4374: 11
+ byte(7)67,72,65,78,78,69,76,69,74,69,67,84,0
+ intern L4374
+L4375: 4
+ byte(7)69,74,69,67,84,0
+ intern L4375
+L4376: 16
+ byte(7)67,72,65,78,78,69,76,76,73,78,69,76,69,78,71,84,72,0
+ intern L4376
+L4377: 9
+ byte(7)76,73,78,69,76,69,78,71,84,72,0
+ intern L4377
+L4378: 3
+ byte(7)80,79,83,78,0
+ intern L4378
+L4379: 11
+ byte(7)67,72,65,78,78,69,76,76,80,79,83,78,0
+ intern L4379
+L4380: 4
+ byte(7)76,80,79,83,78,0
+ intern L4380
+L4381: 12
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,67,72,0
+ intern L4381
+L4382: 5
+ byte(7)42,82,65,73,83,69,0
+ intern L4382
+L4383: 5
+ byte(7)82,69,65,68,67,72,0
+ intern L4383
+L4384: 4
+ byte(7)80,82,73,78,67,0
+ intern L4384
+L4385: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,67,0
+ intern L4385
+L4386: 25
+ byte(7)67,85,82,82,69,78,84,82,69,65,68,77,65,67,82,79,73,78,68,73,67,65,84,79,82,42,0
+ intern L4386
+L4387: 24
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,84,79,75,69,78,87,73,84,72,72,79,79,75,83,0
+ intern L4387
+L4388: 15
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,84,79,75,69,78,0
+ intern L4388
+L4389: 7
+ byte(7)84,79,75,84,89,80,69,42,0
+ intern L4389
+L4390: 16
+ byte(7)67,85,82,82,69,78,84,83,67,65,78,84,65,66,76,69,42,0
+ intern L4390
+L4391: 10
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,0
+ intern L4391
+L4392: 13
+ byte(7)76,73,83,80,83,67,65,78,84,65,66,76,69,42,0
+ intern L4392
+L4393: 12
+ byte(7)76,73,83,80,82,69,65,68,77,65,67,82,79,0
+ intern L4393
+L4394: 17
+ byte(7)77,65,75,69,73,78,80,85,84,65,86,65,73,76,65,66,76,69,0
+ intern L4394
+L4395: 19
+ byte(7)42,73,78,83,73,68,69,83,84,82,85,67,84,85,82,69,82,69,65,68,0
+ intern L4395
+L4396: 13
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,69,79,70,0
+ intern L4396
+L4397: 4
+ byte(7)36,69,79,70,36,0
+ intern L4397
+L4398: 26
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,81,85,79,84,69,68,69,88,80,82,69,83,83,73,79,78,0
+ intern L4398
+L4399: 26
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,76,73,83,84,79,82,68,79,84,84,69,68,80,65,73,82,0
+ intern L4399
+L4400: 20
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,82,73,71,72,84,80,65,82,69,78,0
+ intern L4400
+L4401: 16
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,86,69,67,84,79,82,0
+ intern L4401
+L4402: 11
+ byte(7)42,67,79,77,80,82,69,83,83,73,78,71,0
+ intern L4402
+L4403: 13
+ byte(7)42,69,79,76,73,78,83,84,82,73,78,71,79,75,0
+ intern L4403
+L4404: 4
+ byte(7)78,69,87,73,68,0
+ intern L4404
+L4405: 24
+ byte(7)77,65,75,69,83,84,82,73,78,71,73,78,84,79,76,73,83,80,73,78,84,69,71,69,82,0
+ intern L4405
+L4406: 12
+ byte(7)68,73,71,73,84,84,79,78,85,77,66,69,82,0
+ intern L4406
+L4407: 6
+ byte(7)80,65,67,75,65,71,69,0
+ intern L4407
+L4408: 14
+ byte(7)67,85,82,82,69,78,84,80,65,67,75,65,71,69,42,0
+ intern L4408
+L4409: 5
+ byte(7)71,76,79,66,65,76,0
+ intern L4409
+L4410: 4
+ byte(7)82,65,84,79,77,0
+ intern L4410
+L4411: 7
+ byte(7)82,69,65,68,76,73,78,69,0
+ intern L4411
+L4412: 14
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,76,73,78,69,0
+ intern L4412
+L4413: 10
+ byte(7)79,85,84,80,85,84,66,65,83,69,42,0
+ intern L4413
+L4414: 12
+ byte(7)73,68,69,83,67,65,80,69,67,72,65,82,42,0
+ intern L4414
+L4415: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,84,82,73,78,71,0
+ intern L4415
+L4416: 10
+ byte(7)87,82,73,84,69,83,84,82,73,78,71,0
+ intern L4416
+L4417: 21
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,89,83,73,78,84,69,71,69,82,0
+ intern L4417
+L4418: 20
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,66,73,84,83,84,82,65,85,88,0
+ intern L4418
+L4419: 14
+ byte(7)87,82,73,84,69,83,89,83,73,78,84,69,71,69,82,0
+ intern L4419
+L4420: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,70,73,88,78,85,77,0
+ intern L4420
+L4421: 18
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,73,78,84,69,71,69,82,0
+ intern L4421
+L4422: 19
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,89,83,70,76,79,65,84,0
+ intern L4422
+L4423: 9
+ byte(7)87,82,73,84,69,70,76,79,65,84,0
+ intern L4423
+L4424: 16
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,70,76,79,65,84,0
+ intern L4424
+L4425: 17
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,83,84,82,73,78,71,0
+ intern L4425
+L4426: 13
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,73,68,0
+ intern L4426
+L4427: 18
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,85,78,66,79,85,78,68,0
+ intern L4427
+L4428: 13
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,73,68,0
+ intern L4428
+L4429: 18
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,85,78,66,79,85,78,68,0
+ intern L4429
+L4430: 22
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L4430
+L4431: 21
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,66,76,65,78,75,79,82,69,79,76,0
+ intern L4431
+L4432: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,80,65,73,82,0
+ intern L4432
+L4433: 8
+ byte(7)80,82,73,78,76,69,86,69,76,0
+ intern L4433
+L4434: 9
+ byte(7)80,82,73,78,76,69,78,71,84,72,0
+ intern L4434
+L4435: 20
+ byte(7)82,69,67,85,82,83,73,86,69,67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L4435
+L4436: 15
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,80,65,73,82,0
+ intern L4436
+L4437: 20
+ byte(7)82,69,67,85,82,83,73,86,69,67,72,65,78,78,69,76,80,82,73,78,49,0
+ intern L4437
+L4438: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,86,69,67,84,79,82,0
+ intern L4438
+L4439: 17
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,86,69,67,84,79,82,0
+ intern L4439
+L4440: 18
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,69,86,69,67,84,79,82,0
+ intern L4440
+L4441: 25
+ byte(7)79,66,74,69,67,84,45,71,69,84,45,72,65,78,68,76,69,82,45,81,85,73,69,84,76,89,0
+ intern L4441
+L4442: 10
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,0
+ intern L4442
+L4443: 18
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,69,86,69,67,84,79,82,0
+ intern L4443
+L4444: 16
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,87,79,82,68,83,0
+ intern L4444
+L4445: 20
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,72,65,76,70,87,79,82,68,83,0
+ intern L4445
+L4446: 16
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,66,89,84,69,83,0
+ intern L4446
+L4447: 4
+ byte(7)80,82,73,78,50,0
+ intern L4447
+L4448: 15
+ byte(7)70,79,82,77,65,84,70,79,82,80,82,73,78,84,70,42,0
+ intern L4448
+L4449: 5
+ byte(7)80,82,73,78,50,76,0
+ intern L4449
+L4450: 6
+ byte(7)69,82,82,80,82,73,78,0
+ intern L4450
+L4451: 12
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,70,0
+ intern L4451
+L4452: 17
+ byte(7)69,88,80,76,79,68,69,69,78,68,80,79,73,78,84,69,82,42,0
+ intern L4452
+L4453: 6
+ byte(7)69,88,80,76,79,68,69,0
+ intern L4453
+L4454: 7
+ byte(7)69,88,80,76,79,68,69,50,0
+ intern L4454
+L4455: 8
+ byte(7)70,76,65,84,83,73,90,69,50,0
+ intern L4455
+L4456: 12
+ byte(7)67,79,77,80,82,69,83,83,69,82,82,79,82,0
+ intern L4456
+L4457: 12
+ byte(7)67,79,77,80,82,69,83,83,76,73,83,84,42,0
+ intern L4457
+L4458: 19
+ byte(7)67,76,69,65,82,67,79,77,80,82,69,83,83,67,72,65,78,78,69,76,0
+ intern L4458
+L4459: 7
+ byte(7)67,79,77,80,82,69,83,83,0
+ intern L4459
+L4460: 6
+ byte(7)73,77,80,76,79,68,69,0
+ intern L4460
+L4461: 9
+ byte(7)67,72,65,78,78,69,76,84,89,73,0
+ intern L4461
+L4462: 9
+ byte(7)67,72,65,78,78,69,76,84,89,79,0
+ intern L4462
+L4463: 2
+ byte(7)84,89,73,0
+ intern L4463
+L4464: 2
+ byte(7)84,89,79,0
+ intern L4464
+L4465: 13
+ byte(7)67,79,77,77,69,78,84,79,85,84,67,79,68,69,0
+ intern L4465
+L4466: 10
+ byte(7)67,79,77,80,73,76,69,84,73,77,69,0
+ intern L4466
+L4467: 8
+ byte(7)66,79,84,72,84,73,77,69,83,0
+ intern L4467
+L4468: 7
+ byte(7)76,79,65,68,84,73,77,69,0
+ intern L4468
+L4469: 10
+ byte(7)83,84,65,82,84,85,80,84,73,77,69,0
+ intern L4469
+L4470: 8
+ byte(7)67,79,78,84,69,82,82,79,82,0
+ intern L4470
+L4471: 8
+ byte(7)79,84,72,69,82,87,73,83,69,0
+ intern L4471
+L4472: 6
+ byte(7)68,69,70,65,85,76,84,0
+ intern L4472
+L4473: 3
+ byte(7)67,65,83,69,0
+ intern L4473
+L4474: 4
+ byte(7)82,65,78,71,69,0
+ intern L4474
+L4475: 3
+ byte(7)83,69,84,70,0
+ intern L4475
+L4476: 9
+ byte(7)69,88,80,65,78,68,83,69,84,70,0
+ intern L4476
+L4477: 10
+ byte(7)83,69,84,70,45,69,88,80,65,78,68,0
+ intern L4477
+L4478: 8
+ byte(7)65,83,83,73,71,78,45,79,80,0
+ intern L4478
+L4479: 5
+ byte(7)79,78,79,70,70,42,0
+ intern L4479
+L4480: 8
+ byte(7)77,75,70,76,65,71,86,65,82,0
+ intern L4480
+L4481: 5
+ byte(7)83,73,77,80,70,71,0
+ intern L4481
+L4482: 1
+ byte(7)79,78,0
+ intern L4482
+L4483: 2
+ byte(7)79,70,70,0
+ intern L4483
+L4484: 3
+ byte(7)35,65,82,71,0
+ intern L4484
+L4485: 1
+ byte(7)68,83,0
+ intern L4485
+L4486: 7
+ byte(7)68,69,70,67,79,78,83,84,0
+ intern L4486
+L4487: 9
+ byte(7)69,86,68,69,70,67,79,78,83,84,0
+ intern L4487
+L4488: 4
+ byte(7)67,79,78,83,84,0
+ intern L4488
+L4489: 11
+ byte(7)83,84,82,73,78,71,71,69,78,83,89,77,0
+ intern L4489
+L4490: 12
+ byte(7)83,84,82,73,78,71,71,69,78,83,89,77,42,0
+ intern L4490
+L4491: 6
+ byte(7)70,79,82,69,65,67,72,0
+ intern L4491
+L4492: 6
+ byte(7)67,79,76,76,69,67,84,0
+ intern L4492
+L4493: 3
+ byte(7)74,79,73,78,0
+ intern L4493
+L4494: 3
+ byte(7)67,79,78,67,0
+ intern L4494
+L4495: 1
+ byte(7)73,78,0
+ intern L4495
+L4496: 1
+ byte(7)68,79,0
+ intern L4496
+L4497: 3
+ byte(7)69,88,73,84,0
+ intern L4497
+L4498: 5
+ byte(7)36,76,79,79,80,36,0
+ intern L4498
+L4499: 3
+ byte(7)78,69,88,84,0
+ intern L4499
+L4500: 4
+ byte(7)87,72,73,76,69,0
+ intern L4500
+L4501: 5
+ byte(7)82,69,80,69,65,84,0
+ intern L4501
+L4502: 2
+ byte(7)70,79,82,0
+ intern L4502
+L4503: 5
+ byte(7)71,69,78,83,89,77,0
+ intern L4503
+L4504: 4
+ byte(7)77,75,42,83,81,0
+ intern L4504
+L4505: 3
+ byte(7)83,73,77,80,0
+ intern L4505
+L4506: 2
+ byte(7)66,73,78,0
+ intern L4506
+L4507: 11
+ byte(7)70,76,65,77,66,68,65,76,73,78,75,80,0
+ intern L4507
+L4508: 11
+ byte(7)77,65,75,69,70,85,78,66,79,85,78,68,0
+ intern L4508
+L4509: 14
+ byte(7)77,65,75,69,70,76,65,77,66,68,65,76,73,78,75,0
+ intern L4509
+L4510: 8
+ byte(7)77,65,75,69,70,67,79,68,69,0
+ intern L4510
+L4511: 3
+ byte(7)80,82,79,80,0
+ intern L4511
+L4512: 6
+ byte(7)83,69,84,80,82,79,80,0
+ intern L4512
+L4513: 4
+ byte(7)70,76,65,71,80,0
+ intern L4513
+L4514: 3
+ byte(7)84,89,80,69,0
+ intern L4514
+L4515: 3
+ byte(7)70,76,65,71,0
+ intern L4515
+L4516: 4
+ byte(7)70,76,65,71,49,0
+ intern L4516
+L4517: 6
+ byte(7)82,69,77,70,76,65,71,0
+ intern L4517
+L4518: 7
+ byte(7)82,69,77,70,76,65,71,49,0
+ intern L4518
+L4519: 6
+ byte(7)82,69,77,80,82,79,80,0
+ intern L4519
+L4520: 7
+ byte(7)82,69,77,80,82,79,80,76,0
+ intern L4520
+L4521: 7
+ byte(7)85,78,66,79,85,78,68,80,0
+ intern L4521
+L4522: 6
+ byte(7)86,65,82,84,89,80,69,0
+ intern L4522
+L4523: 4
+ byte(7)70,76,85,73,68,0
+ intern L4523
+L4524: 5
+ byte(7)70,76,85,73,68,49,0
+ intern L4524
+L4525: 5
+ byte(7)70,76,85,73,68,80,0
+ intern L4525
+L4526: 6
+ byte(7)71,76,79,66,65,76,49,0
+ intern L4526
+L4527: 6
+ byte(7)71,76,79,66,65,76,80,0
+ intern L4527
+L4528: 6
+ byte(7)85,78,70,76,85,73,68,0
+ intern L4528
+L4529: 7
+ byte(7)85,78,70,76,85,73,68,49,0
+ intern L4529
+L4530: 3
+ byte(7)82,69,77,68,0
+ intern L4530
+L4531: 4
+ byte(7)42,67,79,77,80,0
+ intern L4531
+L4532: 3
+ byte(7)85,83,69,82,0
+ intern L4532
+L4533: 3
+ byte(7)76,79,83,69,0
+ intern L4533
+L4534: 23
+ byte(7)67,79,68,69,45,78,85,77,66,69,82,45,79,70,45,65,82,71,85,77,69,78,84,83,0
+ intern L4534
+L4535: 14
+ byte(7)66,83,84,65,67,75,85,78,68,69,82,70,76,79,87,0
+ intern L4535
+L4536: 12
+ byte(7)67,76,69,65,82,66,73,78,68,73,78,71,83,0
+ intern L4536
+L4537: 10
+ byte(7)77,65,75,69,85,78,66,79,85,78,68,0
+ intern L4537
+L4538: 11
+ byte(7)72,65,83,72,70,85,78,67,84,73,79,78,0
+ intern L4538
+L4539: 4
+ byte(7)82,69,77,79,66,0
+ intern L4539
+L4540: 6
+ byte(7)73,78,84,69,82,78,80,0
+ intern L4540
+L4541: 11
+ byte(7)73,78,84,69,82,78,71,69,78,83,89,77,0
+ intern L4541
+L4542: 5
+ byte(7)77,65,80,79,66,76,0
+ intern L4542
+L4543: 11
+ byte(7)71,76,79,66,65,76,76,79,79,75,85,80,0
+ intern L4543
+L4544: 12
+ byte(7)71,76,79,66,65,76,73,78,83,84,65,76,76,0
+ intern L4544
+L4545: 11
+ byte(7)71,76,79,66,65,76,82,69,77,79,86,69,0
+ intern L4545
+L4546: 9
+ byte(7)73,78,73,84,79,66,76,73,83,84,0
+ intern L4546
+L4547: 12
+ byte(7)68,69,67,50,48,82,69,65,68,67,72,65,82,0
+ intern L4547
+L4548: 4
+ byte(7)42,69,67,72,79,0
+ intern L4548
+L4549: 6
+ byte(7)67,76,69,65,82,73,79,0
+ intern L4549
+L4550: 16
+ byte(7)68,69,67,50,48,67,76,79,83,69,67,72,65,78,78,69,76,0
+ intern L4550
+L4551: 4
+ byte(7)42,68,69,70,78,0
+ intern L4551
+L4552: 10
+ byte(7)66,82,69,65,75,86,65,76,85,69,42,0
+ intern L4552
+L4553: 9
+ byte(7)42,81,85,73,84,66,82,69,65,75,0
+ intern L4553
+L4554: 7
+ byte(7)66,82,69,65,75,73,78,42,0
+ intern L4554
+L4555: 8
+ byte(7)66,82,69,65,75,79,85,84,42,0
+ intern L4555
+L4556: 11
+ byte(7)84,79,80,76,79,79,80,78,65,77,69,42,0
+ intern L4556
+L4557: 11
+ byte(7)84,79,80,76,79,79,80,69,86,65,76,42,0
+ intern L4557
+L4558: 9
+ byte(7)66,82,69,65,75,69,86,65,76,42,0
+ intern L4558
+L4559: 9
+ byte(7)66,82,69,65,75,78,65,77,69,42,0
+ intern L4559
+L4560: 12
+ byte(7)84,79,80,76,79,79,80,80,82,73,78,84,42,0
+ intern L4560
+L4561: 11
+ byte(7)84,79,80,76,79,79,80,82,69,65,68,42,0
+ intern L4561
+L4562: 6
+ byte(7)84,79,80,76,79,79,80,0
+ intern L4562
+L4563: 6
+ byte(7)36,66,82,69,65,75,36,0
+ intern L4563
+L4564: 8
+ byte(7)66,82,69,65,75,69,86,65,76,0
+ intern L4564
+L4565: 12
+ byte(7)66,82,69,65,75,70,85,78,67,84,73,79,78,0
+ intern L4565
+L4566: 8
+ byte(7)66,82,69,65,75,81,85,73,84,0
+ intern L4566
+L4567: 12
+ byte(7)66,82,69,65,75,67,79,78,84,73,78,85,69,0
+ intern L4567
+L4568: 9
+ byte(7)66,82,69,65,75,82,69,84,82,89,0
+ intern L4568
+L4569: 8
+ byte(7)72,69,76,80,66,82,69,65,75,0
+ intern L4569
+L4570: 10
+ byte(7)66,82,69,65,75,69,82,82,77,83,71,0
+ intern L4570
+L4571: 8
+ byte(7)66,82,69,65,75,69,68,73,84,0
+ intern L4571
+L4572: 12
+ byte(7)84,79,80,76,79,79,80,76,69,86,69,76,42,0
+ intern L4572
+L4573: 12
+ byte(7)72,73,83,84,79,82,89,67,79,85,78,84,42,0
+ intern L4573
+L4574: 10
+ byte(7)76,73,83,80,66,65,78,78,69,82,42,0
+ intern L4574
+L4575: 6
+ byte(7)42,79,85,84,80,85,84,0
+ intern L4575
+L4576: 5
+ byte(7)83,69,77,73,67,42,0
+ intern L4576
+L4577: 11
+ byte(7)72,73,83,84,79,82,89,76,73,83,84,42,0
+ intern L4577
+L4578: 4
+ byte(7)42,84,73,77,69,0
+ intern L4578
+L4579: 3
+ byte(7)84,73,77,69,0
+ intern L4579
+L4580: 5
+ byte(7)42,78,79,78,73,76,0
+ intern L4580
+L4581: 12
+ byte(7)36,69,88,73,84,84,79,80,76,79,79,80,36,0
+ intern L4581
+L4582: 7
+ byte(7)68,70,80,82,73,78,84,42,0
+ intern L4582
+L4583: 5
+ byte(7)73,71,78,79,82,69,0
+ intern L4583
+L4584: 2
+ byte(7)73,78,80,0
+ intern L4584
+L4585: 3
+ byte(7)82,69,68,79,0
+ intern L4585
+L4586: 2
+ byte(7)65,78,83,0
+ intern L4586
+L4587: 3
+ byte(7)72,73,83,84,0
+ intern L4587
+L4588: 4
+ byte(7)67,76,69,65,82,0
+ intern L4588
+L4589: 11
+ byte(7)83,84,65,78,68,65,82,68,76,73,83,80,0
+ intern L4589
+L4590: 17
+ byte(7)80,82,73,78,84,87,73,84,72,70,82,69,83,72,76,73,78,69,0
+ intern L4590
+L4591: 9
+ byte(7)83,65,86,69,83,89,83,84,69,77,0
+ intern L4591
+L4592: 9
+ byte(7)73,78,73,84,70,79,82,77,83,42,0
+ intern L4592
+L4593: 12
+ byte(7)69,86,65,76,73,78,73,84,70,79,82,77,83,0
+ intern L4593
+L4594: 4
+ byte(7)68,83,75,73,78,0
+ intern L4594
+L4595: 8
+ byte(7)68,83,75,73,78,69,86,65,76,0
+ intern L4595
+L4596: 4
+ byte(7)76,65,80,73,78,0
+ intern L4596
+L4597: 4
+ byte(7)77,65,73,78,46,0
+ intern L4597
+L4598: 7
+ byte(7)80,82,69,45,77,65,73,78,0
+ intern L4598
+L4599: 3
+ byte(7)77,65,73,78,0
+ intern L4599
+L4600: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L4600
+L4601: 2
+ byte(7)69,79,70,0
+ intern L4601
+L4602: 8
+ byte(7)67,72,65,82,67,79,78,83,84,0
+ intern L4602
+L4603: 4
+ byte(7)68,69,67,50,48,0
+ intern L4603
+L4604: 4
+ byte(7)80,68,80,49,48,0
+ intern L4604
+L4605: 5
+ byte(7)84,79,80,83,50,48,0
+ intern L4605
+L4606: 3
+ byte(7)75,76,49,48,0
+ intern L4606
+L4607: 12
+ byte(7)76,73,83,80,68,73,80,72,84,72,79,78,71,0
+ intern L4607
+ end MAIN.
ADDED psl-1983/20-kernel/main.mic
Index: psl-1983/20-kernel/main.mic
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main.mic
@@ -0,0 +1,27 @@
+;; Independent compilation a program for the 20
+;; MAIN module and data_segement, do last
+; MIC MAIN modulename
+; modulename=symboltablename
+@define DSK:, DSK:, P20:, PV:, PI:
+@delete 'A.mac
+@delete D'A.mac
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@s:DEC20-CROSS.EXE
+off break; % avoid obnoxios breaks
+InputSymFile!* := "'A.sym"$
+OutputSymFile!* := "'A.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''T;
+ ModName!*:='' 'A;
+ASMOUT "'A"$
+off StandAlone$ % Should emit SYMFNC inits
+IN "'A.red"$
+off pcmac,pgwd; % Suppress echo before INIT
+ASMEnd$
+quit$
+@terminal length 24
+@macro
+*'A.rel='A.mac
+*D'A.rel=D'A.mac
ADDED psl-1983/20-kernel/main.rel
Index: psl-1983/20-kernel/main.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/main.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/make-bare-psl.ctl
Index: psl-1983/20-kernel/make-bare-psl.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-bare-psl.ctl
@@ -0,0 +1,7 @@
+@define dsk: dsk:,p20:
+@S:BPSL.EXE
+*(lapin "psl.init")
+*(savesystem "Bare PSL 3.1" "s:bare-psl.exe" ())
+*(quit)
+;@rename S:BARE-PSL.EXE PSL:BARE-PSL.EXE
+;@set file autokeep PSL:BARE-PSL.EXE
ADDED psl-1983/20-kernel/make-bare-psl.log
Index: psl-1983/20-kernel/make-bare-psl.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-bare-psl.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/make-nmode.ctl
Index: psl-1983/20-kernel/make-nmode.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-nmode.ctl
@@ -0,0 +1,19 @@
+@; This file constructs a version of NMODE, including
+@;
+@; The NMODE (EMACS-like) editor and Lisp interface.
+@; A set of "useful" things described in the manual.
+@;
+@; It creates a new executable file S:NMODE.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@; PSL:NMODE.EXE.
+@;
+@delete s:nmode.exe,
+@expunge
+@
+@psl:bare-psl random-argument-to-get-a-new-fork
+*(load useful nmode init-file)
+*(nmode-initialize)
+*(setq nmode-auto-start t)
+*(savesystem "NMODE PSL 3.1" "s:nmode.exe" nil) %((read-init-file "nmode")))
+*(quit)
+@reset .
ADDED psl-1983/20-kernel/make-psl.ctl
Index: psl-1983/20-kernel/make-psl.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-psl.ctl
@@ -0,0 +1,22 @@
+@; This file constructs a new PSL containing many useful things, including:
+@;
+@; The NMODE (EMACS-like) editor and Lisp interface.
+@; The Lisp Machine Defstruct Facility.
+@; A set of "useful" things described in the manual.
+@;
+@; It creates a new executable file S:PSL.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@; PSL:PSL.EXE.
+@;
+@delete s:psl.exe
+@expunge s:
+@psl:bare-psl random-argument-to-get-a-new-fork
+*(load useful nstruct debug find nmode init-file)
+*(nmode-initialize)
+*(nmode-switch-windows) % Switch to "OUTPUT" window
+*(set-message
+*"C-] E executes Lisp form on current line; C-] L gets normal PSL interface")
+*(savesystem "PSL 3.1" "s:psl.exe" '((read-init-file "psl")))
+*(quit)
+@reset .
+@set file autokeep s:psl.exe
ADDED psl-1983/20-kernel/make-pslcomp.ctl
Index: psl-1983/20-kernel/make-pslcomp.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-pslcomp.ctl
@@ -0,0 +1,18 @@
+@; This file constructs a new PSLCOMP.
+@;
+@; It creates a new executable file S:PSLCOMP.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@; PSL:PSLCOMP.EXE.
+@;
+@delete s:pslcomp.exe
+@expunge s:
+@psl:bare-psl random-argument-to-get-a-new-fork
+* (load pslcomp-main init-file)
+* % The following things are loaded because their definitions are useful
+* % when users compile things:
+* (load objects common strings pathnames fast-vector nstruct)
+* (savesystem "UTAH-PSL Compiler 3.1"
+* "s:pslcomp.exe"
+* '((read-init-file "pslcomp")))
+* (quit)
+@reset .
ADDED psl-1983/20-kernel/make-rlisp.ctl
Index: psl-1983/20-kernel/make-rlisp.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-rlisp.ctl
@@ -0,0 +1,5 @@
+@PSL:BARE-PSL.EXE random-argument-to-get-a-new-fork
+*(load rlisp compiler init-file)
+*(SaveSystem "PSL 3.1 RLisp" "S:RLISP.EXE" '((read-init-file "rlisp")))
+*(quit)
+@reset .
ADDED psl-1983/20-kernel/make-rlisp.log
Index: psl-1983/20-kernel/make-rlisp.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-rlisp.log
@@ -0,0 +1,22 @@
+
+LINK FROM KESSLER, TTY 101
+
+[DO: Execution of PS:<PSL.KERNEL.20>MAKE-RLISP.CTL.1 started at 7-Mar-83 09:29:25]
+
+ TOPS-20 Command processor 5(712)-1
+@PSL:BARE-PSL.EXE random-argument-to-get-a-new-fork
+Bare PSL 3.1, 7-Mar-83
+1 lisp> (load rlisp compiler init-file)
+*** FLUID `SEMIC*' cannot become GLOBAL
+*** FLUID `SEMIC*' cannot become GLOBAL
+*** FLUID `*OUTPUT' cannot become GLOBAL
+NIL
+2 lisp> (SaveSystem "PSL 3.1 RLisp" "S:RLISP.EXE" '((read-init-file "rlisp")))
+*** Garbage collection starting
+*** GC 2: time 841 ms
+*** 512 recovered, 32 stable, 6880 active, 83088 free
+NIL
+3 lisp> (quit)
+@reset .
+@
+[DO: Execution finished at 7-Mar-83 09:30:38]
ADDED psl-1983/20-kernel/make-utah-psl.ctl
Index: psl-1983/20-kernel/make-utah-psl.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-utah-psl.ctl
@@ -0,0 +1,10 @@
+@; This file constructs a new PSL containing many useful things, including:
+@; It creates a new executable file S:PSL.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@;
+@s:bare-psl random-argument-to-get-a-new-fork
+*(load init-file homedir)
+*(savesystem "PSL 3.1" "s:psl.exe" '((read-init-file "psl")))
+*(quit)
+@reset .
+@set file autokeep s:psl.exe
ADDED psl-1983/20-kernel/make-utah-psl.log
Index: psl-1983/20-kernel/make-utah-psl.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/make-utah-psl.log
@@ -0,0 +1,41 @@
+
+LINK FROM KESSLER, TTY 101
+
+[DO: Execution of PS:<PSL.KERNEL.20>MAKE-UTAH-PSL.CTL.1 started at 7-Mar-83 09:26:47]
+
+ TOPS-20 Command processor 5(712)-1
+@; This file constructs a new PSL containing many useful things, including:
+@; It creates a new executable file S:PSL.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@;
+@psl:bare-psl random-argument-to-get-a-new-fork
+?Unrecognized command - File not found - "psl:bare-psl"
+@
+[DO: End of control file while searching for %ERR::]
+[DO: Execution aborted at 7-Mar-83 09:26:59]
+
+LINK FROM KESSLER, TTY 101
+
+[DO: Execution of PS:<PSL.KERNEL.20>MAKE-UTAH-PSL.CTL.2 started at 7-Mar-83 09:27:25]
+
+ TOPS-20 Command processor 5(712)-1
+@; This file constructs a new PSL containing many useful things, including:
+@; It creates a new executable file S:PSL.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@;
+@s:bare-psl random-argument-to-get-a-new-fork
+Bare PSL 3.1, 7-Mar-83
+1 lisp> (load init-file homedir)
+NIL
+2 lisp> (savesystem "PSL 3.1" "s:psl.exe" '((read-init-file "psl")))
+*** Garbage collection starting
+*** GC 2: time 443 ms
+*** 139 recovered, 32 stable, 789 active, 89179 free
+NIL
+3 lisp> (quit)
+@reset .
+@set file autokeep s:psl.exe
+?Does not match switch or keyword - "autokeep"
+@
+[DO: End of control file while searching for %ERR::]
+[DO: Execution aborted at 7-Mar-83 09:27:48]
ADDED psl-1983/20-kernel/mini-trace.red
Index: psl-1983/20-kernel/mini-trace.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/mini-trace.red
@@ -0,0 +1,2 @@
+PathIn "autoload-trace.red"$
+END;
ADDED psl-1983/20-kernel/module.mic
Index: psl-1983/20-kernel/module.mic
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/module.mic
@@ -0,0 +1,26 @@
+;; independant compilation a program for the 20
+; MIC MODULE modulename,symbolmname
+@define DSK:, DSK:, P20:, PI:
+@delete 'a.mac
+@delete D'a.mac
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@s:DEC20-cross.exe
+off break; %kill obnoxious break loops
+off USERMODE ;
+InputSymFile!* := "'B.sym"$
+OutputSymFile!* := "'B.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''NIL;
+ ModName!*:='''A;
+ASMOUT "'A"$
+off StandAlone$ % Should emit SYMFNC inits
+IN "'A.red"$
+off pcmac,pgwd; % Suppress echo before INIT
+ASMEnd$
+quit$
+@terminal length 24
+@macro
+*'A.rel='A.mac
+*D'A.rel=D'A.mac
ADDED psl-1983/20-kernel/newdir.mic
Index: psl-1983/20-kernel/newdir.mic
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/newdir.mic
@@ -0,0 +1,6 @@
+build ss:<psl.'A>
+files
+dir 100
+work 'B
+perm 'B
+
ADDED psl-1983/20-kernel/nil.mac
Index: psl-1983/20-kernel/nil.mac
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/nil.mac
@@ -0,0 +1,5 @@
+ radix 10
+ loc 128
+ <30_31>+128
+ <30_31>+128
+ end
ADDED psl-1983/20-kernel/nil.rel
Index: psl-1983/20-kernel/nil.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/nil.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/non-kl-run.sl
Index: psl-1983/20-kernel/non-kl-run.sl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/non-kl-run.sl
@@ -0,0 +1,81 @@
+%
+% NON-KL-RUN.SL - Extra runtime support for KI processors
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Basic problem is lack of ADJBP instruction
+
+(lap '((!*entry Byte expr 2)
+ (idivi 2 5) % divide word offset by 5
+ (add 2 1) % add word address to word offset
+ (ldb 1 (indexed 3 BytePointerTable)) % fetch byte using remainder
+ (!*EXIT 0)
+ (!*entry PutByte expr 3)
+ (move 4 3) % save byte in 4
+ (idivi 2 5)
+ (add 2 1)
+ (dpb 4 (indexed 3 BytePointerTable))
+ (!*EXIT 0)
+BytePointerTable
+ (fullword (FieldPointer (indexed 2 0) 0 7))
+ (fullword (FieldPointer (indexed 2 0) 7 7))
+ (fullword (FieldPointer (indexed 2 0) 14 7))
+ (fullword (FieldPointer (indexed 2 0) 21 7))
+ (fullword (FieldPointer (indexed 2 0) 28 7))
+))
+
+(lap '((!*entry BitTable expr 2)
+ (idivi 2 18) % divide word offset by 18
+ (add 2 1) % add word address to word offset
+ (ldb 1 (indexed 3 BytePointerTable)) % fetch byte using remainder
+ (!*EXIT 0)
+ (!*entry PutBitTable expr 3)
+ (move 4 3) % save byte in 4
+ (idivi 2 18)
+ (add 2 1)
+ (dpb 4 (indexed 3 BytePointerTable))
+ (!*EXIT 0)
+BytePointerTable
+ (fullword (FieldPointer (indexed 2 0) 0 2))
+ (fullword (FieldPointer (indexed 2 0) 2 2))
+ (fullword (FieldPointer (indexed 2 0) 4 2))
+ (fullword (FieldPointer (indexed 2 0) 6 2))
+ (fullword (FieldPointer (indexed 2 0) 8 2))
+ (fullword (FieldPointer (indexed 2 0) 10 2))
+ (fullword (FieldPointer (indexed 2 0) 12 2))
+ (fullword (FieldPointer (indexed 2 0) 14 2))
+ (fullword (FieldPointer (indexed 2 0) 16 2))
+ (fullword (FieldPointer (indexed 2 0) 18 2))
+ (fullword (FieldPointer (indexed 2 0) 20 2))
+ (fullword (FieldPointer (indexed 2 0) 22 2))
+ (fullword (FieldPointer (indexed 2 0) 24 2))
+ (fullword (FieldPointer (indexed 2 0) 26 2))
+ (fullword (FieldPointer (indexed 2 0) 28 2))
+ (fullword (FieldPointer (indexed 2 0) 30 2))
+ (fullword (FieldPointer (indexed 2 0) 32 2))
+ (fullword (FieldPointer (indexed 2 0) 34 2))
+))
+
+(lap '((!*entry HalfWord expr 2)
+ (rot 2 -1) % make halfword offset into word offset
+ (add 1 2) % add word base to word offset
+ (jumpl 1 (lit (hrrz 1 (indexed 1 0)) % test sign bit (from rot)
+ (!*EXIT 0)))
+ (hlrz 1 (indexed 1 0))
+ (!*EXIT 0)
+))
+
+(lap '((!*entry PutHalfWord expr 3)
+ (rot 2 -1)
+ (add 1 2)
+ (jumpl 1 (lit (hrrm 3 (indexed 1 0))
+ (!*EXIT 0)))
+ (hrlm 3 (indexed 1 0))
+ (!*EXIT 0)
+))
ADDED psl-1983/20-kernel/nonkl.build
Index: psl-1983/20-kernel/nonkl.build
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/nonkl.build
@@ -0,0 +1,1 @@
+in "non-kl-run.sl"$
ADDED psl-1983/20-kernel/previous-20.sym
Index: psl-1983/20-kernel/previous-20.sym
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/previous-20.sym
@@ -0,0 +1,1770 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE
+FEXPR)) (PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR)) (PUT (QUOTE !') (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADQUOTEDEXPRESSION)) (PUT (QUOTE !() (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADLISTORDOTTEDPAIR)) (PUT (QUOTE !)) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADRIGHTPAREN)) (PUT (QUOTE ![) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADVECTOR)) (PUT (MKID (CHAR EOF)) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADEOF)) (INITOBLIST))))
+(SETQ ORDEREDIDLIST!* (QUOTE (ID2INT NONIDERROR INT2ID TYPEERROR
+NONINTEGERERROR INT2SYS LISP2CHAR NONCHARACTERERROR INT2CODE SYS2INT GTFIXN
+ID2STRING STRING2VECTOR GTVECT NONSTRINGERROR VECTOR2STRING GTSTR
+NONVECTORERROR LIST2STRING LENGTH NONPAIRERROR STRING2LIST CONS LIST2VECTOR
+VECTOR2LIST GETV BLDMSG STDERROR INDEXERROR PUTV UPBV INDX RANGEERROR
+NONSEQUENCEERROR SETINDX SUB SUBSEQ GTWRDS GTHALFWORDS NCONS TCONC SETSUB
+SETSUBSEQ CONCAT APPEND SIZE MAKE!-STRING NONPOSITIVEINTEGERERROR MKSTRING
+MAKE!-BYTES MAKE!-HALFWORDS MAKE!-WORDS MAKE!-VECTOR STRING VECTOR CODEP EQ
+FLOATP BIGP IDP PAIRP STRINGP VECTORP CAR CDR RPLACA RPLACD FIXP DIGIT LITER
+EQN LISPEQUAL STRINGEQUAL EQSTR EQUAL CAAAAR CAAAR CAAADR CAADAR CAADR
+CAADDR CADAAR CADAR CADADR CADDAR CADDR CADDDR CDAAAR CDAAR CDAADR CDADAR
+CDADR CDADDR CDDAAR CDDAR CDDADR CDDDAR CDDDR CDDDDR CAAR CADR CDAR CDDR
+SAFECAR SAFECDR ATOM CONSTANTP NULL NUMBERP EXPT MKQUOTE LIST3
+CONTINUABLEERROR GREATERP DIFFERENCE MINUSP TIMES2 ADD1 QUOTIENT PLUS2 LIST
+EVLIS QUOTE EXPR DE LIST2 LIST4 PUTD FUNCTION LAMBDA FEXPR DF MACRO DM NEXPR
+DN SETQ EVAL SET PROG2 PROGN EVPROGN AND EVAND OR EVOR COND EVCOND NOT ABS
+MINUS DIVIDE ZEROP REMAINDER XCONS MAX ROBUSTEXPAND MAX2 LESSP MIN MIN2 PLUS
+TIMES MAP FASTAPPLY MAPC MAPCAN NCONC MAPCON MAPCAR MAPLIST ASSOC SASSOC
+PAIR SUBLIS DEFLIST PUT DELETE MEMBER MEMQ REVERSE SUBST EXPAND CHANNELPRINT
+CHANNELPRIN1 CHANNELTERPRI PRINT OUT!* NEQ NE GEQ LEQ EQCAR EXPRP GETD
+MACROP FEXPRP NEXPRP COPYD RECIP FIRST SECOND THIRD FOURTH REST REVERSIP
+SUBSTIP DELETIP DELQ DEL DELQIP ATSOC ASS MEM RASSOC DELASC DELASCIP DELATQ
+DELATQIP SUBLA RPLACW LASTCAR LASTPAIR COPY NTH SUB1 PNTH ACONC LCONC MAP2
+MAPC2 CHANNELPRIN2T CHANNELPRIN2 PRIN2T CHANNELSPACES CHANNELWRITECHAR
+SPACES CHANNELTAB CHANNELPOSN TAB FILEP PUTC SPACES2 CHANNELSPACES2 LIST2SET
+LIST2SETQ ADJOIN ADJOINQ UNION UNIONQ XN XNQ INTERSECTION INTERSECTIONQ
+GTHEAP !%RECLAIM FATALERROR DELHEAP GTCONSTSTR GTBPS GTFLTN GTID RECLAIM
+DELBPS GTWARRAY DELWARRAY COPYSTRINGTOFROM COPYSTRING COPYWARRAY
+COPYVECTORTOFROM COPYVECTOR COPYWRDSTOFROM COPYWRDS TOTALCOPY MKVECT LIST5
+!*GC GCTIME!* GCKNT!* ERRORPRINTF TIMC QUIT RETURNNIL RETURNFIRSTARG LAND
+LOR LXOR LSHIFT LSH LNOT FIX FLOAT ONEP DEBUG TR EVLOAD TRST QEDITFNS
+!*EXPERT !*VERBOSE EDITF EDIT YESP PROMPTSTRING!* FASTBIND TERPRI
+EDITORREADER!* EDITORPRINTER!* FASTUNBIND READ CL HELP BREAK EHELP PL UP OK
+DISPLAYHELPFILE EDITOR IGNOREDINBACKTRACE!* INTERPRETERFUNCTIONS!*
+INTERPBACKTRACE PRINTF BACKTRACE RETURNADDRESSP ADDR2ID VERBOSEBACKTRACE
+OPTIONS!* WRITECHAR CHANNELWRITEUNKNOWNITEM CODE!-ADDRESS!-TO!-SYMBOL PRIN1
+ERROR NO YES RDS ERROUT!* WRS ERRORSET CURSYM!* !*SEMICOL!* ERRORFORM!*
+!*CONTINUABLEERROR EMSG!* !*BREAK !*EMSGP MAXBREAKLEVEL!* BREAKLEVEL!*
+FLATSIZE USAGETYPEERROR NONNUMBERERROR NONWORDS !*BACKTRACE !*INNER!*BACKTRACE
+THROW !$ERROR!$ CATCHSETUP THROWSIGNAL!* !%UNCATCH CHANNELNOTOPEN
+CHANNELERROR WRITEONLYCHANNEL READONLYCHANNEL ILLEGALSTANDARDCHANNELCLOSE
+IOERROR CODEAPPLY CODEEVALAPPLY BINDEVAL LBIND1 COMPILEDCALLINGINTERPRETED
+BSTACKOVERFLOW RESTOREENVIRONMENT !*LAMBDALINK UNDEFINEDFUNCTION UNBINDN
+APPLY FUNBOUNDP FCODEP GETFCODEPOINTER GET VALUECELL GETFNTYPE !&!&VALUE!&!&
+THROWTAG!* CATCH!-ALL CATCH UNWIND!-ALL !&!&THROWN!&!& !$UNWIND!-PROTECT!$
+!&!&TAG!&!& !%THROW UNWIND!-PROTECT ERRSET !*CATCH !*THROW
+CAPTUREENVIRONMENT PROGBODY!* PROGJUMPTABLE!* PROG PBIND1 !$PROG!$ GO RETURN
+SYSTEM_LIST!* DATE DUMPLISP BINARYOPENREAD DEC20OPEN BINARYOPENWRITE
+VALUECELLLOCATION !*WRITINGFASLFILE NEWBITTABLEENTRY!* FINDIDNUMBER
+MAKERELOCHALFWORD EXTRAREGLOCATION FUNCTIONCELLLOCATION FASLIN INTERN
+PUTENTRY LOADDIRECTORIES!* LOADEXTENSIONS!* LOAD LOAD1 RELOAD EVRELOAD
+!*USERMODE !*REDEFMSG !*INSIDELOAD !*LOWER PENDINGLOADS!* IMPORTS
+PRETTYPRINT DEFSTRUCT STEP MINI EMODE INVOKE RCREF CREFON COMPILER COMPD
+FASLOUT BUG EXEC MM TERMINALINPUTHANDLER COMPRESSREADCHAR DEC20WRITECHAR
+TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR !$EOL!$ CHANNELREADCHAR
+READCHAR IN!* CHANNELUNREADCHAR UNREADCHAR OPEN SYSTEMOPENFILEFORINPUT
+SYSTEMOPENFILEFOROUTPUT SYSTEMOPENFILESPECIAL SPECIALREADFUNCTION!*
+SPECIALWRITEFUNCTION!* SPECIALCLOSEFUNCTION!* SPECIAL OUTPUT INPUT CLOSE
+SYSTEMMARKASCLOSEDCHANNEL SPECIALRDSACTION!* STDIN!* SPECIALWRSACTION!*
+STDOUT!* CHANNELEJECT EJECT CHANNELLINELENGTH LINELENGTH POSN CHANNELREADCH
+!*RAISE READCH PRINC CHANNELPRINC CURRENTREADMACROINDICATOR!*
+CHANNELREADTOKENWITHHOOKS CHANNELREADTOKEN TOKTYPE!* CURRENTSCANTABLE!*
+CHANNELREAD LISPSCANTABLE!* LISPREADMACRO MAKEINPUTAVAILABLE
+!*INSIDESTRUCTUREREAD CHANNELREADEOF !$EOF!$ CHANNELREADQUOTEDEXPRESSION
+CHANNELREADLISTORDOTTEDPAIR CHANNELREADRIGHTPAREN CHANNELREADVECTOR
+!*COMPRESSING !*EOLINSTRINGOK NEWID MAKESTRINGINTOLISPINTEGER PACKAGE
+CURRENTPACKAGE!* GLOBAL RATOM READLINE CHANNELREADLINE OUTPUTBASE!*
+IDESCAPECHAR!* CHANNELWRITESTRING WRITESTRING CHANNELWRITESYSINTEGER
+WRITESYSINTEGER CHANNELWRITEFIXNUM CHANNELWRITEINTEGER CHANNELWRITESYSFLOAT
+WRITEFLOAT CHANNELWRITEFLOAT CHANNELPRINTSTRING CHANNELWRITEID
+CHANNELWRITEUNBOUND CHANNELPRINTID CHANNELPRINTUNBOUND
+CHANNELWRITECODEPOINTER CHANNELWRITEBLANKOREOL CHANNELWRITEPAIR PRINLEVEL
+PRINLENGTH RECURSIVECHANNELPRIN2 CHANNELPRINTPAIR RECURSIVECHANNELPRIN1
+CHANNELWRITEVECTOR CHANNELPRINTVECTOR CHANNELWRITEWORDS
+CHANNELWRITEHALFWORDS CHANNELWRITEBYTES PRIN2 FORMATFORPRINTF!* PRIN2L
+ERRPRIN CHANNELPRINTF EXPLODEENDPOINTER!* EXPLODE EXPLODE2 FLATSIZE2
+COMPRESSERROR COMPRESSLIST!* CLEARCOMPRESSCHANNEL COMPRESS IMPLODE
+CHANNELTYI CHANNELTYO TYI TYO COMMENTOUTCODE COMPILETIME BOTHTIMES LOADTIME
+STARTUPTIME CONTERROR OTHERWISE DEFAULT CASE RANGE SETF EXPANDSETF
+SETF!-EXPAND ASSIGN!-OP CHAR DOCHAR CNTRL CONTROL CHARERROR META LOWER
+CHARCONST ONOFF!* MKFLAGVAR SIMPFG ON OFF !#ARG DS DEFCONST EVDEFCONST CONST
+STRINGGENSYM STRINGGENSYM!* FOREACH COLLECT JOIN CONC IN DO EXIT !$LOOP!$
+NEXT WHILE REPEAT FOR GENSYM MK!*SQ SIMP BIN FLAMBDALINKP MAKEFUNBOUND
+MAKEFLAMBDALINK MAKEFCODE PROP SETPROP FLAGP TYPE FLAG FLAG1 REMFLAG
+REMFLAG1 REMPROP REMPROPL UNBOUNDP VARTYPE FLUID FLUID1 FLUIDP GLOBAL1
+GLOBALP UNFLUID UNFLUID1 REMD !*COMP USER LOSE CODE!-NUMBER!-OF!-ARGUMENTS
+RESET BSTACKUNDERFLOW CLEARBINDINGS MAKEUNBOUND HASHFUNCTION REMOB INTERNP
+INTERNGENSYM MAPOBL GLOBALLOOKUP GLOBALINSTALL GLOBALREMOVE INITOBLIST
+DEC20READCHAR !*ECHO CLEARIO DEC20CLOSECHANNEL !*DEFN BREAKVALUE!*
+!*QUITBREAK BREAKIN!* BREAKOUT!* TOPLOOPNAME!* TOPLOOPEVAL!* BREAKEVAL!*
+BREAKNAME!* TOPLOOPPRINT!* TOPLOOPREAD!* TOPLOOP !$BREAK!$ BREAKEVAL
+BREAKFUNCTION BREAKQUIT BREAKCONTINUE BREAKRETRY HELPBREAK BREAKERRMSG
+BREAKEDIT TOPLOOPLEVEL!* HISTORYCOUNT!* LISPBANNER!* HISTORYLIST!* !*TIME
+TIME !$EXITTOPLOOP!$ DFPRINT!* IGNORE INP REDO ANS HIST CLEAR STANDARDLISP
+PRINTWITHFRESHLINE SAVESYSTEM INITFORMS!* EVALINITFORMS DSKIN DSKINEVAL
+LAPIN !%CLEAR!-CATCH!-STACK CHANNELLPOSN LPOSN DIGITTONUMBER !*OUTPUT SEMIC!*
+!*NONIL NONIOCHANNELERROR CHANNELWRITEEVECTOR OBJECT!-GET!-HANDLER!-QUIETLY
+CHANNELPRIN CHANNELPRINTEVECTOR EVECTORP EGETV EPUTV EUPBV EVECINF GTEVECT
+MKEVECTOR MKEVECT CHANNELWRITEBITSTRAUX)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 844))
+(SETQ STRINGGENSYM!* (QUOTE "M1146"))
+(PUT (QUOTE INFBITLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE INFBITLENGTH) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE INFBITLENGTH) (QUOTE WCONST) (QUOTE 18))
+(PUT (QUOTE TWOARGDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1319"))
+(PUT (QUOTE RELOAD) (QUOTE ENTRYPOINT) (QUOTE RELOAD))
+(PUT (QUOTE RELOAD) (QUOTE IDNUMBER) (QUOTE 552))
+(PUT (QUOTE TWOARGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1336"))
+(PUT (QUOTE INTLESSP) (QUOTE ENTRYPOINT) (QUOTE "L1465"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE NEQ) (QUOTE ENTRYPOINT) (QUOTE NEQ))
+(PUT (QUOTE NEQ) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE LIST2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0059"))
+(PUT (QUOTE LIST2STRING) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE SPECIALRDSACTION!*) (QUOTE IDNUMBER) (QUOTE 598))
+(FLAG (QUOTE (SPECIALRDSACTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GLOBALLOOKUP) (QUOTE ENTRYPOINT) (QUOTE "L3389"))
+(PUT (QUOTE GLOBALLOOKUP) (QUOTE IDNUMBER) (QUOTE 772))
+(PUT (QUOTE CLEARCOMPRESSCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L2793"))
+(PUT (QUOTE CLEARCOMPRESSCHANNEL) (QUOTE IDNUMBER) (QUOTE 678))
+(PUT (QUOTE DEFSTRUCT) (QUOTE ENTRYPOINT) (QUOTE "L2164"))
+(PUT (QUOTE DEFSTRUCT) (QUOTE IDNUMBER) (QUOTE 561))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE MAKERELOCHALFWORD) (QUOTE IDNUMBER) (QUOTE 542))
+(PUT (QUOTE BACKTRACE1) (QUOTE ENTRYPOINT) (QUOTE "L1654"))
+(PUT (QUOTE DO) (QUOTE IDNUMBER) (QUOTE 724))
+(PUT (QUOTE THROWSIGNAL!*) (QUOTE IDNUMBER) (QUOTE 486))
+(FLAG (QUOTE (THROWSIGNAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE REMFLAG) (QUOTE ENTRYPOINT) (QUOTE "L3122"))
+(PUT (QUOTE REMFLAG) (QUOTE IDNUMBER) (QUOTE 745))
+(PUT (QUOTE PRINLEVEL) (QUOTE IDNUMBER) (QUOTE 657))
+(FLAG (QUOTE (PRINLEVEL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EJECT) (QUOTE ENTRYPOINT) (QUOTE EJECT))
+(PUT (QUOTE EJECT) (QUOTE IDNUMBER) (QUOTE 603))
+(PUT (QUOTE LISPREADMACRO) (QUOTE IDNUMBER) (QUOTE 619))
+(PUT (QUOTE STRING2LIST) (QUOTE ENTRYPOINT) (QUOTE "L0068"))
+(PUT (QUOTE STRING2LIST) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE EXIT) (QUOTE ENTRYPOINT) (QUOTE EXIT))
+(PUT (QUOTE EXIT) (QUOTE IDNUMBER) (QUOTE 725))
+(PUT (QUOTE DEC20CLOSECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L3437"))
+(PUT (QUOTE DEC20CLOSECHANNEL) (QUOTE IDNUMBER) (QUOTE 779))
+(PUT (QUOTE ONEARGDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1348"))
+(PUT (QUOTE STRING2VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0041"))
+(PUT (QUOTE STRING2VECTOR) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1785"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE BACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1649"))
+(PUT (QUOTE BACKTRACE) (QUOTE IDNUMBER) (QUOTE 452))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1781"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 493))
+(PUT (QUOTE RETURNNIL) (QUOTE ENTRYPOINT) (QUOTE "L1373"))
+(PUT (QUOTE RETURNNIL) (QUOTE IDNUMBER) (QUOTE 411))
+(PUT (QUOTE CHANNELWRITESYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2491"))
+(PUT (QUOTE CHANNELWRITESYSINTEGER) (QUOTE IDNUMBER) (QUOTE 642))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1075"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE GENSYM) (QUOTE ENTRYPOINT) (QUOTE GENSYM))
+(PUT (QUOTE GENSYM) (QUOTE IDNUMBER) (QUOTE 731))
+(PUT (QUOTE ONEARGPREDICATEDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1361"))
+(PUT (QUOTE VERBOSEBACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1666"))
+(PUT (QUOTE VERBOSEBACKTRACE) (QUOTE IDNUMBER) (QUOTE 455))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 466))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE ENTRYPOINT) (QUOTE "L3443"))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 587))
+(PUT (QUOTE !*EMSGP) (QUOTE IDNUMBER) (QUOTE 474))
+(PUT (QUOTE !*EMSGP) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE TYI) (QUOTE ENTRYPOINT) (QUOTE TYI))
+(PUT (QUOTE TYI) (QUOTE IDNUMBER) (QUOTE 683))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L3045"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 505))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L1682"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 728))
+(PUT (QUOTE STANDARDLISP) (QUOTE ENTRYPOINT) (QUOTE "L3557"))
+(PUT (QUOTE STANDARDLISP) (QUOTE IDNUMBER) (QUOTE 815))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE !*OUTPUT) (QUOTE IDNUMBER) (QUOTE 827))
+(PUT (QUOTE !*OUTPUT) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE SECOND) (QUOTE ENTRYPOINT) (QUOTE SECOND))
+(PUT (QUOTE SECOND) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 669))
+(PUT (QUOTE CURSYM!*) (QUOTE IDNUMBER) (QUOTE 468))
+(PUT (QUOTE CHANNELTYI) (QUOTE ENTRYPOINT) (QUOTE "L2799"))
+(PUT (QUOTE CHANNELTYI) (QUOTE IDNUMBER) (QUOTE 681))
+(PUT (QUOTE FLOATREMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1421"))
+(PUT (QUOTE SASSOC) (QUOTE ENTRYPOINT) (QUOTE SASSOC))
+(PUT (QUOTE SASSOC) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE ADDR2ID) (QUOTE IDNUMBER) (QUOTE 454))
+(PUT (QUOTE ROBUSTEXPAND) (QUOTE ENTRYPOINT) (QUOTE "L0792"))
+(PUT (QUOTE ROBUSTEXPAND) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE INTREMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1420"))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 434))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 8209))
+(PUT (QUOTE TWOARGDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1320"))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE DEFNPRINT) (QUOTE ENTRYPOINT) (QUOTE "L3518"))
+(PUT (QUOTE CURRENTPACKAGE!*) (QUOTE IDNUMBER) (QUOTE 633))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE ENTRYPOINT) (QUOTE "L4346"))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 823))
+(PUT (QUOTE SETSUBSEQ) (QUOTE ENTRYPOINT) (QUOTE "L0210"))
+(PUT (QUOTE SETSUBSEQ) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE PNTH) (QUOTE ENTRYPOINT) (QUOTE PNTH))
+(PUT (QUOTE PNTH) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE PACKAGE) (QUOTE ENTRYPOINT) (QUOTE "L2480"))
+(PUT (QUOTE PACKAGE) (QUOTE IDNUMBER) (QUOTE 632))
+(PUT (QUOTE MAKEDS) (QUOTE ENTRYPOINT) (QUOTE MAKEDS))
+(PUT (QUOTE !*USERMODE) (QUOTE IDNUMBER) (QUOTE 554))
+(FLAG (QUOTE (!*USERMODE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !*REDEFMSG) (QUOTE IDNUMBER) (QUOTE 555))
+(PUT (QUOTE !*REDEFMSG) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE SAVE!-INTO!-FILE) (QUOTE ENTRYPOINT) (QUOTE "L2048"))
+(PUT (QUOTE CHANNELPRINTID) (QUOTE ENTRYPOINT) (QUOTE "L2523"))
+(PUT (QUOTE CHANNELPRINTID) (QUOTE IDNUMBER) (QUOTE 652))
+(PUT (QUOTE BUG) (QUOTE ENTRYPOINT) (QUOTE BUG))
+(PUT (QUOTE BUG) (QUOTE IDNUMBER) (QUOTE 571))
+(PUT (QUOTE DEFAULT) (QUOTE IDNUMBER) (QUOTE 692))
+(PUT (QUOTE IGNOREDINBACKTRACE!*) (QUOTE IDNUMBER) (QUOTE 448))
+(PUT (QUOTE IGNOREDINBACKTRACE!*) (QUOTE INITIALVALUE) (QUOTE (EVAL APPLY
+FASTAPPLY CODEAPPLY CODEEVALAPPLY CATCH ERRORSET EVPROGN TOPLOOP BREAKEVAL
+BINDEVAL BREAK MAIN)))
+(PUT (QUOTE CLEAR) (QUOTE IDNUMBER) (QUOTE 814))
+(PUT (QUOTE LPOSN) (QUOTE ENTRYPOINT) (QUOTE LPOSN))
+(PUT (QUOTE LPOSN) (QUOTE IDNUMBER) (QUOTE 825))
+(PUT (QUOTE DOPNTH) (QUOTE ENTRYPOINT) (QUOTE DOPNTH))
+(PUT (QUOTE BREAKOUT!*) (QUOTE IDNUMBER) (QUOTE 784))
+(FLAG (QUOTE (BREAKOUT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE STRINGGENSYM) (QUOTE ENTRYPOINT) (QUOTE "L2954"))
+(PUT (QUOTE STRINGGENSYM) (QUOTE IDNUMBER) (QUOTE 717))
+(PUT (QUOTE FLOATSUB1) (QUOTE ENTRYPOINT) (QUOTE "L1481"))
+(PUT (QUOTE TAB) (QUOTE ENTRYPOINT) (QUOTE TAB))
+(PUT (QUOTE TAB) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE COPYWRDSTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1110"))
+(PUT (QUOTE COPYWRDSTOFROM) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L3178"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 756))
+(PUT (QUOTE MEMBER) (QUOTE ENTRYPOINT) (QUOTE MEMBER))
+(PUT (QUOTE MEMBER) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE EXPRP) (QUOTE ENTRYPOINT) (QUOTE EXPRP))
+(PUT (QUOTE EXPRP) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE LNOT) (QUOTE ENTRYPOINT) (QUOTE LNOT))
+(PUT (QUOTE LNOT) (QUOTE IDNUMBER) (QUOTE 418))
+(PUT (QUOTE ONEARGPREDICATEDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1360"))
+(PUT (QUOTE ACONC) (QUOTE ENTRYPOINT) (QUOTE ACONC))
+(PUT (QUOTE ACONC) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE PRETTYPRINT) (QUOTE ENTRYPOINT) (QUOTE "L2160"))
+(PUT (QUOTE PRETTYPRINT) (QUOTE IDNUMBER) (QUOTE 560))
+(PUT (QUOTE !$PROG!$) (QUOTE IDNUMBER) (QUOTE 529))
+(PUT (QUOTE ERRSET) (QUOTE ENTRYPOINT) (QUOTE ERRSET))
+(PUT (QUOTE ERRSET) (QUOTE IDNUMBER) (QUOTE 521))
+(PUT (QUOTE DIVIDE) (QUOTE ENTRYPOINT) (QUOTE DIVIDE))
+(PUT (QUOTE DIVIDE) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE DELETE) (QUOTE ENTRYPOINT) (QUOTE DELETE))
+(PUT (QUOTE DELETE) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE NONINTEGER2ERROR) (QUOTE ENTRYPOINT) (QUOTE "L1342"))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0369"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 595))
+(PUT (QUOTE PRINLENGTH) (QUOTE IDNUMBER) (QUOTE 658))
+(FLAG (QUOTE (PRINLENGTH)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE XNQ) (QUOTE ENTRYPOINT) (QUOTE XNQ))
+(PUT (QUOTE XNQ) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE TYO) (QUOTE ENTRYPOINT) (QUOTE TYO))
+(PUT (QUOTE TYO) (QUOTE IDNUMBER) (QUOTE 684))
+(PUT (QUOTE REMD) (QUOTE ENTRYPOINT) (QUOTE REMD))
+(PUT (QUOTE REMD) (QUOTE IDNUMBER) (QUOTE 758))
+(PUT (QUOTE !*THROW) (QUOTE ENTRYPOINT) (QUOTE "L1980"))
+(PUT (QUOTE !*THROW) (QUOTE IDNUMBER) (QUOTE 523))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0663"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 270))
+(PUT (QUOTE ERRORFORM!*) (QUOTE IDNUMBER) (QUOTE 470))
+(FLAG (QUOTE (ERRORFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !*INSIDELOAD) (QUOTE IDNUMBER) (QUOTE 556))
+(FLAG (QUOTE (!*INSIDELOAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLOATMINUSP) (QUOTE ENTRYPOINT) (QUOTE "L1517"))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 497))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE MAP) (QUOTE ENTRYPOINT) (QUOTE MAP))
+(PUT (QUOTE MAP) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE FOURTH) (QUOTE ENTRYPOINT) (QUOTE FOURTH))
+(PUT (QUOTE FOURTH) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE LXOR) (QUOTE ENTRYPOINT) (QUOTE LXOR))
+(PUT (QUOTE LXOR) (QUOTE IDNUMBER) (QUOTE 415))
+(PUT (QUOTE COMPD) (QUOTE ENTRYPOINT) (QUOTE COMPD))
+(PUT (QUOTE COMPD) (QUOTE IDNUMBER) (QUOTE 569))
+(PUT (QUOTE CHANNELPRINTVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2617"))
+(PUT (QUOTE CHANNELPRINTVECTOR) (QUOTE IDNUMBER) (QUOTE 663))
+(PUT (QUOTE UNFLUID1) (QUOTE ENTRYPOINT) (QUOTE "L3183"))
+(PUT (QUOTE UNFLUID1) (QUOTE IDNUMBER) (QUOTE 757))
+(PUT (QUOTE BOTHTIMES) (QUOTE ENTRYPOINT) (QUOTE "L2803"))
+(PUT (QUOTE BOTHTIMES) (QUOTE IDNUMBER) (QUOTE 687))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2199"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L3076"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 507))
+(PUT (QUOTE VALUECELL) (QUOTE ENTRYPOINT) (QUOTE "L3298"))
+(PUT (QUOTE VALUECELL) (QUOTE IDNUMBER) (QUOTE 509))
+(PUT (QUOTE CHANNELPRINTPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2584"))
+(PUT (QUOTE CHANNELPRINTPAIR) (QUOTE IDNUMBER) (QUOTE 660))
+(PUT (QUOTE WRITESYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2502"))
+(PUT (QUOTE WRITESYSINTEGER) (QUOTE IDNUMBER) (QUOTE 643))
+(PUT (QUOTE BACKTRACERANGE) (QUOTE ENTRYPOINT) (QUOTE "L1646"))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE DIGIT) (QUOTE ENTRYPOINT) (QUOTE DIGIT))
+(PUT (QUOTE DIGIT) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE FASLIN) (QUOTE ENTRYPOINT) (QUOTE FASLIN))
+(PUT (QUOTE FASLIN) (QUOTE IDNUMBER) (QUOTE 545))
+(PUT (QUOTE LIST2SETQ) (QUOTE ENTRYPOINT) (QUOTE "L1037"))
+(PUT (QUOTE LIST2SETQ) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE DSKIN) (QUOTE ENTRYPOINT) (QUOTE DSKIN))
+(PUT (QUOTE DSKIN) (QUOTE IDNUMBER) (QUOTE 820))
+(PUT (QUOTE CHANNELWRITEINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2504"))
+(PUT (QUOTE CHANNELWRITEINTEGER) (QUOTE IDNUMBER) (QUOTE 645))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE PUTC) (QUOTE ENTRYPOINT) (QUOTE PUTC))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE DELASC) (QUOTE ENTRYPOINT) (QUOTE DELASC))
+(PUT (QUOTE DELASC) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE FOREACH) (QUOTE ENTRYPOINT) (QUOTE "L2974"))
+(PUT (QUOTE FOREACH) (QUOTE IDNUMBER) (QUOTE 719))
+(PUT (QUOTE MARKFROMSYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1165"))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 771))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L1815"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 498))
+(PUT (QUOTE MM) (QUOTE ENTRYPOINT) (QUOTE MM))
+(PUT (QUOTE MM) (QUOTE IDNUMBER) (QUOTE 573))
+(PUT (QUOTE FLOATINTARG) (QUOTE ENTRYPOINT) (QUOTE "L1515"))
+(PUT (QUOTE MKEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L6227"))
+(PUT (QUOTE MKEVECTOR) (QUOTE IDNUMBER) (QUOTE 841))
+(PUT (QUOTE MAKEBUFINTOLISPINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2329"))
+(PUT (QUOTE DELASCIP) (QUOTE ENTRYPOINT) (QUOTE "L0934"))
+(PUT (QUOTE DELASCIP) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE MAKE!-STRING) (QUOTE ENTRYPOINT) (QUOTE "L0309"))
+(PUT (QUOTE MAKE!-STRING) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE ZEROP) (QUOTE ENTRYPOINT) (QUOTE ZEROP))
+(PUT (QUOTE ZEROP) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE TOPLOOPLEVEL!*) (QUOTE IDNUMBER) (QUOTE 801))
+(PUT (QUOTE TOPLOOPLEVEL!*) (QUOTE INITIALVALUE) (QUOTE -1))
+(PUT (QUOTE FLOATGREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1461"))
+(PUT (QUOTE GLOBALREMOVE) (QUOTE ENTRYPOINT) (QUOTE "L3396"))
+(PUT (QUOTE GLOBALREMOVE) (QUOTE IDNUMBER) (QUOTE 774))
+(PUT (QUOTE NTHENTRY) (QUOTE ENTRYPOINT) (QUOTE "L3534"))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE CHANNELREADVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2299"))
+(PUT (QUOTE CHANNELREADVECTOR) (QUOTE IDNUMBER) (QUOTE 627))
+(PUT (QUOTE GCERROR) (QUOTE ENTRYPOINT) (QUOTE "L1232"))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE DELASCIP1) (QUOTE ENTRYPOINT) (QUOTE "L0927"))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 583))
+(PUT (QUOTE IN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE INTLSHIFT) (QUOTE ENTRYPOINT) (QUOTE "L1452"))
+(PUT (QUOTE CHARERROR) (QUOTE ENTRYPOINT) (QUOTE "L2874"))
+(PUT (QUOTE CHARERROR) (QUOTE IDNUMBER) (QUOTE 703))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE MAPC2) (QUOTE ENTRYPOINT) (QUOTE MAPC2))
+(PUT (QUOTE MAPC2) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE ANS) (QUOTE ENTRYPOINT) (QUOTE ANS))
+(PUT (QUOTE ANS) (QUOTE IDNUMBER) (QUOTE 812))
+(PUT (QUOTE HIST) (QUOTE ENTRYPOINT) (QUOTE HIST))
+(PUT (QUOTE HIST) (QUOTE IDNUMBER) (QUOTE 813))
+(PUT (QUOTE EVALINITFORMS) (QUOTE ENTRYPOINT) (QUOTE "L3565"))
+(PUT (QUOTE EVALINITFORMS) (QUOTE IDNUMBER) (QUOTE 819))
+(PUT (QUOTE EDITORPRINTER!*) (QUOTE IDNUMBER) (QUOTE 436))
+(FLAG (QUOTE (EDITORPRINTER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE LOOKUPORADDTOOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3322"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1069"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE CHANNELWRITEBYTES) (QUOTE ENTRYPOINT) (QUOTE "L2665"))
+(PUT (QUOTE CHANNELWRITEBYTES) (QUOTE IDNUMBER) (QUOTE 666))
+(PUT (QUOTE EXPLODE) (QUOTE ENTRYPOINT) (QUOTE "L2782"))
+(PUT (QUOTE EXPLODE) (QUOTE IDNUMBER) (QUOTE 673))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SPECIAL) (QUOTE IDNUMBER) (QUOTE 593))
+(PUT (QUOTE RCREF) (QUOTE IDNUMBER) (QUOTE 566))
+(PUT (QUOTE EVRELOAD) (QUOTE ENTRYPOINT) (QUOTE "L2131"))
+(PUT (QUOTE EVRELOAD) (QUOTE IDNUMBER) (QUOTE 553))
+(PUT (QUOTE INTERPRETERFUNCTIONS!*) (QUOTE IDNUMBER) (QUOTE 449))
+(PUT (QUOTE INTERPRETERFUNCTIONS!*) (QUOTE INITIALVALUE) (QUOTE (COND PROG
+AND OR PROGN SETQ)))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 615))
+(FLAG (QUOTE (TOKTYPE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE INTSUB1) (QUOTE ENTRYPOINT) (QUOTE "L1480"))
+(PUT (QUOTE MIN) (QUOTE ENTRYPOINT) (QUOTE MIN))
+(PUT (QUOTE MIN) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE INP) (QUOTE ENTRYPOINT) (QUOTE INP))
+(PUT (QUOTE INP) (QUOTE IDNUMBER) (QUOTE 810))
+(PUT (QUOTE CHANNELWRITEEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L5551"))
+(PUT (QUOTE CHANNELWRITEEVECTOR) (QUOTE IDNUMBER) (QUOTE 831))
+(PUT (QUOTE CHANNELPOSN) (QUOTE ENTRYPOINT) (QUOTE "L2262"))
+(PUT (QUOTE CHANNELPOSN) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 464))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE FLAGP) (QUOTE ENTRYPOINT) (QUOTE FLAGP))
+(PUT (QUOTE FLAGP) (QUOTE IDNUMBER) (QUOTE 741))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1789"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 494))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE REMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1419"))
+(PUT (QUOTE REMAINDER) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE COPYSTRINGTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1097"))
+(PUT (QUOTE COPYSTRINGTOFROM) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE ID2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0036"))
+(PUT (QUOTE ID2STRING) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE REDO) (QUOTE ENTRYPOINT) (QUOTE REDO))
+(PUT (QUOTE REDO) (QUOTE IDNUMBER) (QUOTE 811))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L2772"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 670))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L1067"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L1082"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L2761"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 408))
+(PUT (QUOTE !*VERBOSE) (QUOTE IDNUMBER) (QUOTE 428))
+(FLAG (QUOTE (!*VERBOSE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L3266"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 765))
+(PUT (QUOTE EUPBV) (QUOTE ENTRYPOINT) (QUOTE EUPBV))
+(PUT (QUOTE EUPBV) (QUOTE IDNUMBER) (QUOTE 838))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1070"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE NEWBITTABLEENTRY!*) (QUOTE IDNUMBER) (QUOTE 540))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE ENTRYPOINT) (QUOTE "L2485"))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 640))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0584"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE GETV) (QUOTE ENTRYPOINT) (QUOTE GETV))
+(PUT (QUOTE GETV) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE !*INSIDESTRUCTUREREAD) (QUOTE IDNUMBER) (QUOTE 621))
+(FLAG (QUOTE (!*INSIDESTRUCTUREREAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLOATLESSP) (QUOTE ENTRYPOINT) (QUOTE "L1466"))
+(PUT (QUOTE MARKFROMALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1158"))
+(PUT (QUOTE CL) (QUOTE IDNUMBER) (QUOTE 439))
+(FLAG (QUOTE (CL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MACROP) (QUOTE ENTRYPOINT) (QUOTE MACROP))
+(PUT (QUOTE MACROP) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE CONTERROR) (QUOTE ENTRYPOINT) (QUOTE "L2811"))
+(PUT (QUOTE CONTERROR) (QUOTE IDNUMBER) (QUOTE 690))
+(PUT (QUOTE FLOATONEP) (QUOTE ENTRYPOINT) (QUOTE "L1526"))
+(PUT (QUOTE ONEP) (QUOTE ENTRYPOINT) (QUOTE ONEP))
+(PUT (QUOTE ONEP) (QUOTE IDNUMBER) (QUOTE 421))
+(PUT (QUOTE LOAD) (QUOTE ENTRYPOINT) (QUOTE LOAD))
+(PUT (QUOTE LOAD) (QUOTE IDNUMBER) (QUOTE 550))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE VECTOR) (QUOTE ENTRYPOINT) (QUOTE VECTOR))
+(PUT (QUOTE VECTOR) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1796"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 495))
+(PUT (QUOTE LOADDIRECTORIES!*) (QUOTE IDNUMBER) (QUOTE 548))
+(PUT (QUOTE LOADDIRECTORIES!*) (QUOTE INITIALVALUE) (QUOTE ("" "pl:")))
+(PUT (QUOTE WRITENUMBER1) (QUOTE ENTRYPOINT) (QUOTE "L2497"))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE THIRD) (QUOTE ENTRYPOINT) (QUOTE THIRD))
+(PUT (QUOTE THIRD) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE SETF) (QUOTE ENTRYPOINT) (QUOTE SETF))
+(PUT (QUOTE SETF) (QUOTE IDNUMBER) (QUOTE 695))
+(PUT (QUOTE QEDNTH) (QUOTE ENTRYPOINT) (QUOTE QEDNTH))
+(PUT (QUOTE EXTRAREGLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2066"))
+(PUT (QUOTE EXTRAREGLOCATION) (QUOTE IDNUMBER) (QUOTE 543))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 667))
+(PUT (QUOTE LASTPAIR) (QUOTE ENTRYPOINT) (QUOTE "L0977"))
+(PUT (QUOTE LASTPAIR) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE ERRORSET) (QUOTE ENTRYPOINT) (QUOTE "L1764"))
+(PUT (QUOTE ERRORSET) (QUOTE IDNUMBER) (QUOTE 467))
+(PUT (QUOTE COMPILER) (QUOTE IDNUMBER) (QUOTE 568))
+(PUT (QUOTE UPDATEREGION) (QUOTE ENTRYPOINT) (QUOTE "L1242"))
+(PUT (QUOTE VECTOR2LIST) (QUOTE ENTRYPOINT) (QUOTE "L0083"))
+(PUT (QUOTE VECTOR2LIST) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PUTV) (QUOTE ENTRYPOINT) (QUOTE PUTV))
+(PUT (QUOTE PUTV) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE YESP) (QUOTE ENTRYPOINT) (QUOTE YESP))
+(PUT (QUOTE YESP) (QUOTE IDNUMBER) (QUOTE 431))
+(PUT (QUOTE NCONC) (QUOTE ENTRYPOINT) (QUOTE NCONC))
+(PUT (QUOTE NCONC) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE IGNORE) (QUOTE IDNUMBER) (QUOTE 809))
+(PUT (QUOTE TAGBITLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TAGBITLENGTH) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE TAGBITLENGTH) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE RETURNADDRESSP) (QUOTE ENTRYPOINT) (QUOTE "L2032"))
+(PUT (QUOTE RETURNADDRESSP) (QUOTE IDNUMBER) (QUOTE 453))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L1077"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE HELP) (QUOTE ENTRYPOINT) (QUOTE HELP))
+(PUT (QUOTE HELP) (QUOTE IDNUMBER) (QUOTE 440))
+(PUT (QUOTE OUTPUTBASE!*) (QUOTE IDNUMBER) (QUOTE 638))
+(PUT (QUOTE OUTPUTBASE!*) (QUOTE INITIALVALUE) (QUOTE 10))
+(PUT (QUOTE LOADTIME) (QUOTE ENTRYPOINT) (QUOTE "L2804"))
+(PUT (QUOTE LOADTIME) (QUOTE IDNUMBER) (QUOTE 688))
+(PUT (QUOTE ID2INT) (QUOTE ENTRYPOINT) (QUOTE ID2INT))
+(PUT (QUOTE ID2INT) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE CHANNELREADTOKEN) (QUOTE ENTRYPOINT) (QUOTE "L2359"))
+(PUT (QUOTE CHANNELREADTOKEN) (QUOTE IDNUMBER) (QUOTE 614))
+(PUT (QUOTE THROWAUX) (QUOTE ENTRYPOINT) (QUOTE "L1990"))
+(PUT (QUOTE DFPRINT!*) (QUOTE IDNUMBER) (QUOTE 808))
+(FLAG (QUOTE (DFPRINT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !%THROW) (QUOTE ENTRYPOINT) (QUOTE !%THROW))
+(PUT (QUOTE !%THROW) (QUOTE IDNUMBER) (QUOTE 519))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 635))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 608))
+(PUT (QUOTE !*RAISE) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE NEXPRP) (QUOTE ENTRYPOINT) (QUOTE NEXPRP))
+(PUT (QUOTE NEXPRP) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE MKFLAGVAR) (QUOTE ENTRYPOINT) (QUOTE "L2889"))
+(PUT (QUOTE MKFLAGVAR) (QUOTE IDNUMBER) (QUOTE 708))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 432))
+(FLAG (QUOTE (PROMPTSTRING!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE STRINGEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0464"))
+(PUT (QUOTE STRINGEQUAL) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE NE) (QUOTE ENTRYPOINT) (QUOTE NE))
+(PUT (QUOTE NE) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2769"))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 577))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 596))
+(PUT (QUOTE BREAKVALUE!*) (QUOTE IDNUMBER) (QUOTE 781))
+(FLAG (QUOTE (BREAKVALUE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FINDIDNUMBER) (QUOTE IDNUMBER) (QUOTE 541))
+(PUT (QUOTE BREAKEDIT) (QUOTE ENTRYPOINT) (QUOTE "L3496"))
+(PUT (QUOTE BREAKEDIT) (QUOTE IDNUMBER) (QUOTE 800))
+(PUT (QUOTE TIMES) (QUOTE ENTRYPOINT) (QUOTE TIMES))
+(PUT (QUOTE TIMES) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE CHANNELREADRIGHTPAREN) (QUOTE ENTRYPOINT) (QUOTE "L2292"))
+(PUT (QUOTE CHANNELREADRIGHTPAREN) (QUOTE IDNUMBER) (QUOTE 626))
+(PUT (QUOTE FLOATMINUS) (QUOTE ENTRYPOINT) (QUOTE "L1498"))
+(PUT (QUOTE EXEC) (QUOTE ENTRYPOINT) (QUOTE EXEC))
+(PUT (QUOTE EXEC) (QUOTE IDNUMBER) (QUOTE 572))
+(PUT (QUOTE DELQIP1) (QUOTE ENTRYPOINT) (QUOTE "L0890"))
+(PUT (QUOTE EMODE) (QUOTE ENTRYPOINT) (QUOTE EMODE))
+(PUT (QUOTE EMODE) (QUOTE IDNUMBER) (QUOTE 564))
+(PUT (QUOTE READLINE) (QUOTE ENTRYPOINT) (QUOTE "L2472"))
+(PUT (QUOTE READLINE) (QUOTE IDNUMBER) (QUOTE 636))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE INTMINUS) (QUOTE ENTRYPOINT) (QUOTE "L1497"))
+(PUT (QUOTE DEFNPRINT1) (QUOTE ENTRYPOINT) (QUOTE "L3527"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1078"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE CHANNELWRITEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2602"))
+(PUT (QUOTE CHANNELWRITEVECTOR) (QUOTE IDNUMBER) (QUOTE 662))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 580))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE EVECTORP) (QUOTE ENTRYPOINT) (QUOTE "L5902"))
+(PUT (QUOTE EVECTORP) (QUOTE IDNUMBER) (QUOTE 835))
+(PUT (QUOTE OBJECT!-GET!-HANDLER!-QUIETLY) (QUOTE IDNUMBER) (QUOTE 832))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE CHANNELWRITEPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2560"))
+(PUT (QUOTE CHANNELWRITEPAIR) (QUOTE IDNUMBER) (QUOTE 656))
+(PUT (QUOTE !*LOWER) (QUOTE IDNUMBER) (QUOTE 557))
+(FLAG (QUOTE (!*LOWER)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DUMPLISP) (QUOTE ENTRYPOINT) (QUOTE "L2045"))
+(PUT (QUOTE DUMPLISP) (QUOTE IDNUMBER) (QUOTE 534))
+(PUT (QUOTE EVAND) (QUOTE ENTRYPOINT) (QUOTE EVAND))
+(PUT (QUOTE EVAND) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE LOWER) (QUOTE IDNUMBER) (QUOTE 705))
+(PUT (QUOTE ASSIGN!-OP) (QUOTE IDNUMBER) (QUOTE 698))
+(PUT (QUOTE PLUS) (QUOTE ENTRYPOINT) (QUOTE PLUS))
+(PUT (QUOTE PLUS) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE !*ECHO) (QUOTE IDNUMBER) (QUOTE 777))
+(FLAG (QUOTE (!*ECHO)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE !$UNWIND!-PROTECT!$) (QUOTE IDNUMBER) (QUOTE 517))
+(PUT (QUOTE COMPRESS) (QUOTE ENTRYPOINT) (QUOTE "L2797"))
+(PUT (QUOTE COMPRESS) (QUOTE IDNUMBER) (QUOTE 679))
+(PUT (QUOTE MAPCON) (QUOTE ENTRYPOINT) (QUOTE MAPCON))
+(PUT (QUOTE MAPCON) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE MAPCAR) (QUOTE ENTRYPOINT) (QUOTE MAPCAR))
+(PUT (QUOTE MAPCAR) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L1687"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE SUBLIS) (QUOTE ENTRYPOINT) (QUOTE SUBLIS))
+(PUT (QUOTE SUBLIS) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE MAKEBUFINTOID) (QUOTE ENTRYPOINT) (QUOTE "L2320"))
+(PUT (QUOTE TOPLOOPNAME!*) (QUOTE IDNUMBER) (QUOTE 785))
+(FLAG (QUOTE (TOPLOOPNAME!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BREAKNAME!*) (QUOTE IDNUMBER) (QUOTE 788))
+(FLAG (QUOTE (BREAKNAME!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BREAKEVAL) (QUOTE ENTRYPOINT) (QUOTE "L3476"))
+(PUT (QUOTE BREAKEVAL) (QUOTE IDNUMBER) (QUOTE 793))
+(PUT (QUOTE PROG) (QUOTE ENTRYPOINT) (QUOTE PROG))
+(PUT (QUOTE PROG) (QUOTE IDNUMBER) (QUOTE 527))
+(PUT (QUOTE CURRENTREADMACROINDICATOR!*) (QUOTE IDNUMBER) (QUOTE 612))
+(PUT (QUOTE CURRENTREADMACROINDICATOR!*) (QUOTE INITIALVALUE) (QUOTE
+LISPREADMACRO))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE CHANNELWRITEID) (QUOTE ENTRYPOINT) (QUOTE "L2514"))
+(PUT (QUOTE CHANNELWRITEID) (QUOTE IDNUMBER) (QUOTE 650))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE ASMSYMBOL) (QUOTE "L2205"))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE WARRAY) (QUOTE JFNOFCHANNEL))
+(PUT (QUOTE CHANNELLPOSN) (QUOTE ENTRYPOINT) (QUOTE "L4459"))
+(PUT (QUOTE CHANNELLPOSN) (QUOTE IDNUMBER) (QUOTE 824))
+(PUT (QUOTE STRINGGENSYM1) (QUOTE ENTRYPOINT) (QUOTE "L2955"))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE FLOAT) (QUOTE ENTRYPOINT) (QUOTE FLOAT))
+(PUT (QUOTE FLOAT) (QUOTE IDNUMBER) (QUOTE 420))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 8000))
+(PUT (QUOTE FLOATZEROP) (QUOTE ENTRYPOINT) (QUOTE "L1417"))
+(PUT (QUOTE INDX) (QUOTE ENTRYPOINT) (QUOTE INDX))
+(PUT (QUOTE INDX) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE INTZEROP) (QUOTE ENTRYPOINT) (QUOTE "L1521"))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 501))
+(PUT (QUOTE FLOATADD1) (QUOTE ENTRYPOINT) (QUOTE "L1471"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1744"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CHANNELWRITEFIXNUM) (QUOTE ENTRYPOINT) (QUOTE "L2503"))
+(PUT (QUOTE CHANNELWRITEFIXNUM) (QUOTE IDNUMBER) (QUOTE 644))
+(PUT (QUOTE EPUTV) (QUOTE ENTRYPOINT) (QUOTE EPUTV))
+(PUT (QUOTE EPUTV) (QUOTE IDNUMBER) (QUOTE 837))
+(PUT (QUOTE DECLAREFLUIDORGLOBAL) (QUOTE ENTRYPOINT) (QUOTE "L3151"))
+(PUT (QUOTE LISPSCANTABLE!*) (QUOTE IDNUMBER) (QUOTE 618))
+(PUT (QUOTE LISPSCANTABLE!*) (QUOTE INITIALVALUE) (QUOTE [17 10 10 10 10
+10 10 10 10 17 17 10 17 17 10 10 10 10 10 10 10 10 10 10 10 10 11 10 10
+10 10 10 17 14 15 10 10 12 10 11 11 11 10 19 10 18 20 10 0 1 2 3 4 5 6
+7 8 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 11 16 11 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+LISPDIPHTHONG]))
+(PUT (QUOTE UNREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2216"))
+(PUT (QUOTE UNREADCHAR) (QUOTE IDNUMBER) (QUOTE 585))
+(PUT (QUOTE MAKE!-WORDS) (QUOTE ENTRYPOINT) (QUOTE "L0341"))
+(PUT (QUOTE MAKE!-WORDS) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE FUNCTIONCELLLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2068"))
+(PUT (QUOTE FUNCTIONCELLLOCATION) (QUOTE IDNUMBER) (QUOTE 544))
+(PUT (QUOTE SIMPFG) (QUOTE IDNUMBER) (QUOTE 709))
+(PUT (QUOTE SETPROP) (QUOTE ENTRYPOINT) (QUOTE "L3083"))
+(PUT (QUOTE SETPROP) (QUOTE IDNUMBER) (QUOTE 740))
+(PUT (QUOTE SPECIALREADFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 590))
+(FLAG (QUOTE (SPECIALREADFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CHANNELPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L2780"))
+(PUT (QUOTE CHANNELPRINTF) (QUOTE IDNUMBER) (QUOTE 671))
+(PUT (QUOTE OR) (QUOTE ENTRYPOINT) (QUOTE OR))
+(PUT (QUOTE OR) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE MKQUOTE) (QUOTE ENTRYPOINT) (QUOTE "L0848"))
+(PUT (QUOTE MKQUOTE) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 461))
+(PUT (QUOTE EDITORREADER!*) (QUOTE IDNUMBER) (QUOTE 435))
+(FLAG (QUOTE (EDITORREADER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GCSTARTINGBIT) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE GCSTARTINGBIT) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE GCSTARTINGBIT) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE SETF!-EXPAND) (QUOTE IDNUMBER) (QUOTE 697))
+(PUT (QUOTE SETSUB) (QUOTE ENTRYPOINT) (QUOTE SETSUB))
+(PUT (QUOTE SETSUB) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE SIZE) (QUOTE ENTRYPOINT) (QUOTE SIZE))
+(PUT (QUOTE SIZE) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE CHANNELREAD) (QUOTE ENTRYPOINT) (QUOTE "L2270"))
+(PUT (QUOTE CHANNELREAD) (QUOTE IDNUMBER) (QUOTE 617))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 763))
+(PUT (QUOTE !&!&VALUE!&!&) (QUOTE IDNUMBER) (QUOTE 511))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L3140"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 747))
+(PUT (QUOTE CHANNELSPACES) (QUOTE ENTRYPOINT) (QUOTE "L1023"))
+(PUT (QUOTE CHANNELSPACES) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE PRINTF2) (QUOTE ENTRYPOINT) (QUOTE "L2732"))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3400"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 775))
+(PUT (QUOTE LOSE) (QUOTE IDNUMBER) (QUOTE 761))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L1804"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 496))
+(PUT (QUOTE LISPEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0426"))
+(PUT (QUOTE LISPEQUAL) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE CLEARIO1) (QUOTE ENTRYPOINT) (QUOTE "L3413"))
+(PUT (QUOTE UNION) (QUOTE ENTRYPOINT) (QUOTE UNION))
+(PUT (QUOTE UNION) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE DELQIP) (QUOTE ENTRYPOINT) (QUOTE DELQIP))
+(PUT (QUOTE DELQIP) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE CHANNELTAB) (QUOTE ENTRYPOINT) (QUOTE "L1027"))
+(PUT (QUOTE CHANNELTAB) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE BIGFLOATFIX) (QUOTE ENTRYPOINT) (QUOTE "L1372"))
+(PUT (QUOTE INTLNOT) (QUOTE ENTRYPOINT) (QUOTE "L1490"))
+(PUT (QUOTE DSKINDEFNPRINT) (QUOTE ENTRYPOINT) (QUOTE "L3588"))
+(PUT (QUOTE MAX) (QUOTE ENTRYPOINT) (QUOTE MAX))
+(PUT (QUOTE MAX) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE INSTANTIATEINFORM) (QUOTE ENTRYPOINT) (QUOTE "L2895"))
+(PUT (QUOTE COPYWRDS) (QUOTE ENTRYPOINT) (QUOTE "L1113"))
+(PUT (QUOTE COPYWRDS) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE CLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L3414"))
+(PUT (QUOTE CLEARIO) (QUOTE IDNUMBER) (QUOTE 778))
+(PUT (QUOTE BUILDRELOCATIONFIELDS) (QUOTE ENTRYPOINT) (QUOTE "L1160"))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L1129"))
+(PUT (QUOTE CHANNELPRINT) (QUOTE ENTRYPOINT) (QUOTE "L0799"))
+(PUT (QUOTE CHANNELPRINT) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE LOADEXTENSIONS!*) (QUOTE IDNUMBER) (QUOTE 549))
+(PUT (QUOTE LOADEXTENSIONS!*) (QUOTE INITIALVALUE) (QUOTE ((".b" . FASLIN) (
+".lap" . LAPIN) (".sl" . LAPIN))))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE UPDATEITEM) (QUOTE ENTRYPOINT) (QUOTE "L1246"))
+(PUT (QUOTE SAVESYSTEM) (QUOTE ENTRYPOINT) (QUOTE "L3563"))
+(PUT (QUOTE SAVESYSTEM) (QUOTE IDNUMBER) (QUOTE 817))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE FEXPRP) (QUOTE ENTRYPOINT) (QUOTE FEXPRP))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L2266"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE THROW) (QUOTE ENTRYPOINT) (QUOTE THROW))
+(PUT (QUOTE THROW) (QUOTE IDNUMBER) (QUOTE 483))
+(PUT (QUOTE FIX) (QUOTE ENTRYPOINT) (QUOTE FIX))
+(PUT (QUOTE FIX) (QUOTE IDNUMBER) (QUOTE 419))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0372"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE TCONC) (QUOTE ENTRYPOINT) (QUOTE TCONC))
+(PUT (QUOTE TCONC) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1094"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE !*QUITBREAK) (QUOTE IDNUMBER) (QUOTE 782))
+(FLAG (QUOTE (!*QUITBREAK)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE CONST) (QUOTE ENTRYPOINT) (QUOTE CONST))
+(PUT (QUOTE CONST) (QUOTE IDNUMBER) (QUOTE 716))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 751))
+(PUT (QUOTE EGETV) (QUOTE ENTRYPOINT) (QUOTE EGETV))
+(PUT (QUOTE EGETV) (QUOTE IDNUMBER) (QUOTE 836))
+(PUT (QUOTE UNDEFINEDFUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L1829"))
+(PUT (QUOTE UNDEFINEDFUNCTION) (QUOTE IDNUMBER) (QUOTE 502))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE DS) (QUOTE ENTRYPOINT) (QUOTE DS))
+(PUT (QUOTE DS) (QUOTE IDNUMBER) (QUOTE 713))
+(PUT (QUOTE WORDSEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0423"))
+(PUT (QUOTE INTERNGENSYM) (QUOTE ENTRYPOINT) (QUOTE "L3375"))
+(PUT (QUOTE INTERNGENSYM) (QUOTE IDNUMBER) (QUOTE 770))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1778"))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 492))
+(PUT (QUOTE COMPRESSLIST!*) (QUOTE IDNUMBER) (QUOTE 677))
+(FLAG (QUOTE (COMPRESSLIST!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYVECTORTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1106"))
+(PUT (QUOTE COPYVECTORTOFROM) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2781"))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 578))
+(PUT (QUOTE SPECIALWRSACTION!*) (QUOTE IDNUMBER) (QUOTE 600))
+(FLAG (QUOTE (SPECIALWRSACTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE TOPLOOPPRINT!*) (QUOTE IDNUMBER) (QUOTE 789))
+(FLAG (QUOTE (TOPLOOPPRINT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODE!-ADDRESS!-TO!-SYMBOL) (QUOTE IDNUMBER) (QUOTE 459))
+(PUT (QUOTE MAPLIST) (QUOTE ENTRYPOINT) (QUOTE "L0724"))
+(PUT (QUOTE MAPLIST) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1718"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE !*EXPERT) (QUOTE IDNUMBER) (QUOTE 427))
+(FLAG (QUOTE (!*EXPERT)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CONC) (QUOTE IDNUMBER) (QUOTE 722))
+(PUT (QUOTE CHANNELPRIN1) (QUOTE ENTRYPOINT) (QUOTE "L2697"))
+(PUT (QUOTE CHANNELPRIN1) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE PRINTF1) (QUOTE ENTRYPOINT) (QUOTE "L2731"))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE WCONST) (QUOTE 1))
+(PUT (QUOTE !*COMP) (QUOTE IDNUMBER) (QUOTE 759))
+(FLAG (QUOTE (!*COMP)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MARKFROMBASE) (QUOTE ENTRYPOINT) (QUOTE "L1170"))
+(PUT (QUOTE ABS) (QUOTE ENTRYPOINT) (QUOTE ABS))
+(PUT (QUOTE ABS) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1753"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 480))
+(PUT (QUOTE OTHERWISE) (QUOTE IDNUMBER) (QUOTE 691))
+(PUT (QUOTE FASLOUT) (QUOTE ENTRYPOINT) (QUOTE "L2189"))
+(PUT (QUOTE FASLOUT) (QUOTE IDNUMBER) (QUOTE 570))
+(PUT (QUOTE CHANNELWRITEHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L2649"))
+(PUT (QUOTE CHANNELWRITEHALFWORDS) (QUOTE IDNUMBER) (QUOTE 665))
+(PUT (QUOTE SUBSEQ) (QUOTE ENTRYPOINT) (QUOTE SUBSEQ))
+(PUT (QUOTE SUBSEQ) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE LSHIFT) (QUOTE ENTRYPOINT) (QUOTE LSHIFT))
+(PUT (QUOTE LSHIFT) (QUOTE IDNUMBER) (QUOTE 416))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L1726"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L3327"))
+(PUT (QUOTE MARKFROMRANGE) (QUOTE ENTRYPOINT) (QUOTE "L1166"))
+(PUT (QUOTE XCHANGE) (QUOTE ENTRYPOINT) (QUOTE "L1587"))
+(PUT (QUOTE COMPRESSERROR) (QUOTE ENTRYPOINT) (QUOTE "L2796"))
+(PUT (QUOTE COMPRESSERROR) (QUOTE IDNUMBER) (QUOTE 676))
+(PUT (QUOTE READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2208"))
+(PUT (QUOTE READCHAR) (QUOTE IDNUMBER) (QUOTE 582))
+(PUT (QUOTE FLOATDIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1386"))
+(PUT (QUOTE CURRENTSCANTABLE!*) (QUOTE IDNUMBER) (QUOTE 616))
+(PUT (QUOTE CURRENTSCANTABLE!*) (QUOTE INITIALVALUE) (QUOTE [17 10 10 10
+10 10 10 10 10 17 17 10 17 17 10 10 10 10 10 10 10 10 10 10 10 10 11 10
+10 10 10 10 17 14 15 10 10 12 10 11 11 11 10 19 10 18 20 10 0 1 2 3 4 5
+6 7 8 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 LISPDIPHTHONG]))
+(PUT (QUOTE UPDATESYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1241"))
+(PUT (QUOTE GCMESSAGE) (QUOTE ENTRYPOINT) (QUOTE "L1164"))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE CHANNELREADCH) (QUOTE ENTRYPOINT) (QUOTE "L2263"))
+(PUT (QUOTE CHANNELREADCH) (QUOTE IDNUMBER) (QUOTE 607))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE COPYVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1109"))
+(PUT (QUOTE COPYVECTOR) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 623))
+(FLAG (QUOTE (!$EOF!$)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DELQ) (QUOTE ENTRYPOINT) (QUOTE DELQ))
+(PUT (QUOTE DELQ) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1738"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1147"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE CREFON) (QUOTE ENTRYPOINT) (QUOTE CREFON))
+(PUT (QUOTE CREFON) (QUOTE IDNUMBER) (QUOTE 567))
+(PUT (QUOTE FOR) (QUOTE ENTRYPOINT) (QUOTE FOR))
+(PUT (QUOTE FOR) (QUOTE IDNUMBER) (QUOTE 730))
+(PUT (QUOTE BIN) (QUOTE IDNUMBER) (QUOTE 734))
+(PUT (QUOTE DSKINEVAL) (QUOTE ENTRYPOINT) (QUOTE "L3586"))
+(PUT (QUOTE DSKINEVAL) (QUOTE IDNUMBER) (QUOTE 821))
+(PUT (QUOTE CHANNELREADTOKENWITHHOOKS) (QUOTE ENTRYPOINT) (QUOTE "L2267"))
+(PUT (QUOTE CHANNELREADTOKENWITHHOOKS) (QUOTE IDNUMBER) (QUOTE 613))
+(PUT (QUOTE INT2CODE) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE INT2CODE) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE BREAK) (QUOTE ENTRYPOINT) (QUOTE BREAK))
+(PUT (QUOTE BREAK) (QUOTE IDNUMBER) (QUOTE 441))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1825"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L3434"))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 597))
+(PUT (QUOTE INTADD1) (QUOTE ENTRYPOINT) (QUOTE "L1470"))
+(PUT (QUOTE FLAG) (QUOTE ENTRYPOINT) (QUOTE FLAG))
+(PUT (QUOTE FLAG) (QUOTE IDNUMBER) (QUOTE 743))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2210"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 460))
+(PUT (QUOTE IN) (QUOTE IDNUMBER) (QUOTE 723))
+(PUT (QUOTE REMOB) (QUOTE ENTRYPOINT) (QUOTE REMOB))
+(PUT (QUOTE REMOB) (QUOTE IDNUMBER) (QUOTE 768))
+(PUT (QUOTE BREAKFUNCTION) (QUOTE IDNUMBER) (QUOTE 794))
+(PUT (QUOTE !*EOLINSTRINGOK) (QUOTE IDNUMBER) (QUOTE 629))
+(FLAG (QUOTE (!*EOLINSTRINGOK)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE INOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3316"))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE MIN2) (QUOTE ENTRYPOINT) (QUOTE MIN2))
+(PUT (QUOTE MIN2) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE ASS) (QUOTE ENTRYPOINT) (QUOTE ASS))
+(PUT (QUOTE ASS) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE VARTYPE) (QUOTE IDNUMBER) (QUOTE 750))
+(PUT (QUOTE HISTPRINT) (QUOTE ENTRYPOINT) (QUOTE "L3545"))
+(PUT (QUOTE CHANNELUNREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2215"))
+(PUT (QUOTE CHANNELUNREADCHAR) (QUOTE IDNUMBER) (QUOTE 584))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE CHANNELWRITEUNKNOWNITEM) (QUOTE ENTRYPOINT) (QUOTE "L2542"))
+(PUT (QUOTE CHANNELWRITEUNKNOWNITEM) (QUOTE IDNUMBER) (QUOTE 458))
+(PUT (QUOTE FLUID1) (QUOTE ENTRYPOINT) (QUOTE FLUID1))
+(PUT (QUOTE FLUID1) (QUOTE IDNUMBER) (QUOTE 752))
+(PUT (QUOTE EVDEFCONST) (QUOTE ENTRYPOINT) (QUOTE "L2949"))
+(PUT (QUOTE EVDEFCONST) (QUOTE IDNUMBER) (QUOTE 715))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CASE) (QUOTE ENTRYPOINT) (QUOTE CASE))
+(PUT (QUOTE CASE) (QUOTE IDNUMBER) (QUOTE 693))
+(PUT (QUOTE SCANNERERROR) (QUOTE ENTRYPOINT) (QUOTE "L2388"))
+(PUT (QUOTE RETURNFIRSTARG) (QUOTE ENTRYPOINT) (QUOTE "L1374"))
+(PUT (QUOTE RETURNFIRSTARG) (QUOTE IDNUMBER) (QUOTE 412))
+(PUT (QUOTE !*DEFN) (QUOTE IDNUMBER) (QUOTE 780))
+(FLAG (QUOTE (!*DEFN)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0404"))
+(PUT (QUOTE LAPIN) (QUOTE ENTRYPOINT) (QUOTE LAPIN))
+(PUT (QUOTE LAPIN) (QUOTE IDNUMBER) (QUOTE 822))
+(PUT (QUOTE MAKE!-HALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0331"))
+(PUT (QUOTE MAKE!-HALFWORDS) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE STRINGGENSYM!*) (QUOTE IDNUMBER) (QUOTE 718))
+(FLAG (QUOTE (STRINGGENSYM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE HELPBREAK) (QUOTE ENTRYPOINT) (QUOTE "L3489"))
+(PUT (QUOTE HELPBREAK) (QUOTE IDNUMBER) (QUOTE 798))
+(PUT (QUOTE UNMAP!-SPACE) (QUOTE ENTRYPOINT) (QUOTE "L2047"))
+(PUT (QUOTE !*CATCH) (QUOTE ENTRYPOINT) (QUOTE "L1979"))
+(PUT (QUOTE !*CATCH) (QUOTE IDNUMBER) (QUOTE 522))
+(PUT (QUOTE EVECINF) (QUOTE IDNUMBER) (QUOTE 839))
+(PUT (QUOTE MINUSP) (QUOTE ENTRYPOINT) (QUOTE MINUSP))
+(PUT (QUOTE MINUSP) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE BPSSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BPSSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BPSSIZE) (QUOTE WCONST) (QUOTE 100000))
+(PUT (QUOTE IMPLODE) (QUOTE ENTRYPOINT) (QUOTE "L2798"))
+(PUT (QUOTE IMPLODE) (QUOTE IDNUMBER) (QUOTE 680))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1741"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE FASTBIND) (QUOTE ENTRYPOINT) (QUOTE "L3277"))
+(PUT (QUOTE FASTBIND) (QUOTE IDNUMBER) (QUOTE 433))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1852"))
+(PUT (QUOTE CHANNELWRITEFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2507"))
+(PUT (QUOTE CHANNELWRITEFLOAT) (QUOTE IDNUMBER) (QUOTE 648))
+(PUT (QUOTE CHECKLINEFIT) (QUOTE ENTRYPOINT) (QUOTE "L2482"))
+(PUT (QUOTE !%UNCATCH) (QUOTE ENTRYPOINT) (QUOTE "L1986"))
+(PUT (QUOTE !%UNCATCH) (QUOTE IDNUMBER) (QUOTE 487))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L1750"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE WCONST) (QUOTE 8))
+(PUT (QUOTE CHANNELPRINTUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L2535"))
+(PUT (QUOTE CHANNELPRINTUNBOUND) (QUOTE IDNUMBER) (QUOTE 653))
+(PUT (QUOTE HASHFUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L3329"))
+(PUT (QUOTE HASHFUNCTION) (QUOTE IDNUMBER) (QUOTE 767))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1459"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE MAPC) (QUOTE ENTRYPOINT) (QUOTE MAPC))
+(PUT (QUOTE MAPC) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1772"))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 490))
+(PUT (QUOTE SYSTEM_LIST!*) (QUOTE IDNUMBER) (QUOTE 532))
+(PUT (QUOTE SYSTEM_LIST!*) (QUOTE INITIALVALUE) (QUOTE (DEC20 PDP10 TOPS20
+KL10)))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE MAKESTRINGINTOBITSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2444"))
+(PUT (QUOTE HISTORYCOUNT!*) (QUOTE IDNUMBER) (QUOTE 802))
+(PUT (QUOTE HISTORYCOUNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE UPBV) (QUOTE ENTRYPOINT) (QUOTE UPBV))
+(PUT (QUOTE UPBV) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE LCONC) (QUOTE ENTRYPOINT) (QUOTE LCONC))
+(PUT (QUOTE LCONC) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE EDCOPY) (QUOTE ENTRYPOINT) (QUOTE EDCOPY))
+(PUT (QUOTE FLOATFIX) (QUOTE ENTRYPOINT) (QUOTE "L1507"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1721"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 478))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 528))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE DEL) (QUOTE ENTRYPOINT) (QUOTE DEL))
+(PUT (QUOTE DEL) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE MAKE!-BYTES) (QUOTE ENTRYPOINT) (QUOTE "L0320"))
+(PUT (QUOTE MAKE!-BYTES) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE !*GC) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE !*GC) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE FIRST) (QUOTE ENTRYPOINT) (QUOTE FIRST))
+(PUT (QUOTE FIRST) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE DATE) (QUOTE ENTRYPOINT) (QUOTE DATE))
+(PUT (QUOTE DATE) (QUOTE IDNUMBER) (QUOTE 533))
+(PUT (QUOTE SEMIC!*) (QUOTE IDNUMBER) (QUOTE 828))
+(FLAG (QUOTE (SEMIC!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DOTCONTEXTERROR) (QUOTE ENTRYPOINT) (QUOTE "L2282"))
+(PUT (QUOTE SYSPOWEROF2P) (QUOTE ENTRYPOINT) (QUOTE "L2442"))
+(PUT (QUOTE GCBITLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE GCBITLENGTH) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE GCBITLENGTH) (QUOTE WCONST) (QUOTE 13))
+(PUT (QUOTE LOAD1) (QUOTE ENTRYPOINT) (QUOTE LOAD1))
+(PUT (QUOTE LOAD1) (QUOTE IDNUMBER) (QUOTE 551))
+(PUT (QUOTE LISP2CHAR) (QUOTE ENTRYPOINT) (QUOTE "L0023"))
+(PUT (QUOTE LISP2CHAR) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE MEM) (QUOTE ENTRYPOINT) (QUOTE MEM))
+(PUT (QUOTE MEM) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE EHELP) (QUOTE ENTRYPOINT) (QUOTE EHELP))
+(PUT (QUOTE EHELP) (QUOTE IDNUMBER) (QUOTE 442))
+(PUT (QUOTE DOCHAR) (QUOTE ENTRYPOINT) (QUOTE DOCHAR))
+(PUT (QUOTE DOCHAR) (QUOTE IDNUMBER) (QUOTE 700))
+(PUT (QUOTE EDIT0) (QUOTE ENTRYPOINT) (QUOTE EDIT0))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE MAKEBUFINTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2324"))
+(PUT (QUOTE INTMINUSP) (QUOTE ENTRYPOINT) (QUOTE "L1516"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE ENTRYPOINT) (QUOTE "L3439"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 589))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1747"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE INTERPBACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1645"))
+(PUT (QUOTE INTERPBACKTRACE) (QUOTE IDNUMBER) (QUOTE 450))
+(PUT (QUOTE !$ERROR!$) (QUOTE IDNUMBER) (QUOTE 484))
+(PUT (QUOTE INTGREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1460"))
+(PUT (QUOTE UNMAP!-PAGES) (QUOTE ENTRYPOINT) (QUOTE "L2050"))
+(PUT (QUOTE CHANNELLINELENGTH) (QUOTE ENTRYPOINT) (QUOTE "L2258"))
+(PUT (QUOTE CHANNELLINELENGTH) (QUOTE IDNUMBER) (QUOTE 604))
+(PUT (QUOTE TOPLOOPEVAL!*) (QUOTE IDNUMBER) (QUOTE 786))
+(FLAG (QUOTE (TOPLOOPEVAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE USER) (QUOTE IDNUMBER) (QUOTE 760))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE SCANPOSSIBLEDIPHTHONG) (QUOTE ENTRYPOINT) (QUOTE "L8129"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE ENTRYPOINT) (QUOTE "L3422"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 574))
+(PUT (QUOTE CHANNELREADQUOTEDEXPRESSION) (QUOTE ENTRYPOINT) (QUOTE "L2276"))
+(PUT (QUOTE CHANNELREADQUOTEDEXPRESSION) (QUOTE IDNUMBER) (QUOTE 624))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE OUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE EXPANDSETF) (QUOTE ENTRYPOINT) (QUOTE "L2847"))
+(PUT (QUOTE EXPANDSETF) (QUOTE IDNUMBER) (QUOTE 696))
+(PUT (QUOTE GO) (QUOTE ENTRYPOINT) (QUOTE GO))
+(PUT (QUOTE GO) (QUOTE IDNUMBER) (QUOTE 530))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 601))
+(PUT (QUOTE STDOUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L1068"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L3430"))
+(PUT (QUOTE REST) (QUOTE ENTRYPOINT) (QUOTE REST))
+(PUT (QUOTE REST) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE SIMP) (QUOTE IDNUMBER) (QUOTE 733))
+(PUT (QUOTE INVOKE) (QUOTE ENTRYPOINT) (QUOTE INVOKE))
+(PUT (QUOTE INVOKE) (QUOTE IDNUMBER) (QUOTE 565))
+(PUT (QUOTE !*BACKTRACE) (QUOTE IDNUMBER) (QUOTE 481))
+(FLAG (QUOTE (!*BACKTRACE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !&!&TAG!&!&) (QUOTE IDNUMBER) (QUOTE 518))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 742))
+(PUT (QUOTE TAGSTARTINGBIT) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TAGSTARTINGBIT) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE TAGSTARTINGBIT) (QUOTE WCONST) (QUOTE 0))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE TR) (QUOTE ENTRYPOINT) (QUOTE TR))
+(PUT (QUOTE TR) (QUOTE IDNUMBER) (QUOTE 423))
+(PUT (QUOTE UP) (QUOTE IDNUMBER) (QUOTE 444))
+(PUT (QUOTE EMSG!*) (QUOTE IDNUMBER) (QUOTE 472))
+(FLAG (QUOTE (EMSG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAKE!-VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0351"))
+(PUT (QUOTE MAKE!-VECTOR) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE CHAR) (QUOTE ENTRYPOINT) (QUOTE CHAR))
+(PUT (QUOTE CHAR) (QUOTE IDNUMBER) (QUOTE 699))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 451))
+(PUT (QUOTE FLATSIZE) (QUOTE ENTRYPOINT) (QUOTE "L2786"))
+(PUT (QUOTE FLATSIZE) (QUOTE IDNUMBER) (QUOTE 477))
+(PUT (QUOTE PROGBODY!*) (QUOTE IDNUMBER) (QUOTE 525))
+(FLAG (QUOTE (PROGBODY!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SPECIALWRITEFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 591))
+(FLAG (QUOTE (SPECIALWRITEFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE READINBUF) (QUOTE ENTRYPOINT) (QUOTE "L2316"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE ENTRYPOINT) (QUOTE "L1966"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE IDNUMBER) (QUOTE 520))
+(PUT (QUOTE SUBSTIP1) (QUOTE ENTRYPOINT) (QUOTE "L0860"))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0589"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE INTLXOR) (QUOTE ENTRYPOINT) (QUOTE "L1445"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L3061"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 736))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE HISTORYLIST!*) (QUOTE IDNUMBER) (QUOTE 804))
+(FLAG (QUOTE (HISTORYLIST!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNIONQ) (QUOTE ENTRYPOINT) (QUOTE UNIONQ))
+(PUT (QUOTE UNIONQ) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE MAKESTRINGINTOSYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2327"))
+(PUT (QUOTE NTH) (QUOTE ENTRYPOINT) (QUOTE NTH))
+(PUT (QUOTE NTH) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE PL) (QUOTE IDNUMBER) (QUOTE 443))
+(PUT (QUOTE JOIN) (QUOTE IDNUMBER) (QUOTE 721))
+(PUT (QUOTE SUBSTIP) (QUOTE ENTRYPOINT) (QUOTE "L0865"))
+(PUT (QUOTE SUBSTIP) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE TIME) (QUOTE ENTRYPOINT) (QUOTE TIME))
+(PUT (QUOTE TIME) (QUOTE IDNUMBER) (QUOTE 806))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 840))
+(PUT (QUOTE SPECIALCLOSEFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 592))
+(FLAG (QUOTE (SPECIALCLOSEFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 739))
+(PUT (QUOTE STARTUPTIME) (QUOTE ENTRYPOINT) (QUOTE "L2804"))
+(PUT (QUOTE STARTUPTIME) (QUOTE IDNUMBER) (QUOTE 689))
+(PUT (QUOTE INTERSECTIONQ) (QUOTE ENTRYPOINT) (QUOTE XNQ))
+(PUT (QUOTE INTERSECTIONQ) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE !$BREAK!$) (QUOTE IDNUMBER) (QUOTE 792))
+(PUT (QUOTE EDITOR) (QUOTE IDNUMBER) (QUOTE 447))
+(PUT (QUOTE CHARACTERSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHARACTERSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE CHARACTERSPERWORD) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE FLOATQUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1403"))
+(PUT (QUOTE BREAKLEVEL!*) (QUOTE IDNUMBER) (QUOTE 476))
+(PUT (QUOTE BREAKLEVEL!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1711"))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE MAKEBUFINTOSYSNUMBER) (QUOTE ENTRYPOINT) (QUOTE "L2326"))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE CHANNELWRITECODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L2538"))
+(PUT (QUOTE CHANNELWRITECODEPOINTER) (QUOTE IDNUMBER) (QUOTE 654))
+(PUT (QUOTE BINARYOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L2057"))
+(PUT (QUOTE BINARYOPENREAD) (QUOTE IDNUMBER) (QUOTE 535))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2200"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE META) (QUOTE IDNUMBER) (QUOTE 704))
+(PUT (QUOTE INT2SYS) (QUOTE ENTRYPOINT) (QUOTE "L0016"))
+(PUT (QUOTE INT2SYS) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE ENTRYPOINT) (QUOTE "L3253"))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE IDNUMBER) (QUOTE 762))
+(PUT (QUOTE ON) (QUOTE ENTRYPOINT) (QUOTE ON))
+(PUT (QUOTE ON) (QUOTE IDNUMBER) (QUOTE 710))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1091"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE INTPLUS2) (QUOTE ENTRYPOINT) (QUOTE "L1376"))
+(PUT (QUOTE STACKDIRECTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKDIRECTION) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE STACKDIRECTION) (QUOTE WCONST) (QUOTE 1))
+(PUT (QUOTE TIMC) (QUOTE ENTRYPOINT) (QUOTE TIMC))
+(PUT (QUOTE TIMC) (QUOTE IDNUMBER) (QUOTE 409))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L3409"))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 576))
+(PUT (QUOTE INTQUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1402"))
+(PUT (QUOTE PROG2) (QUOTE ENTRYPOINT) (QUOTE PROG2))
+(PUT (QUOTE PROG2) (QUOTE IDNUMBER) (QUOTE 268))
+(PUT (QUOTE MK!*SQ) (QUOTE IDNUMBER) (QUOTE 732))
+(PUT (QUOTE LIST2SET) (QUOTE ENTRYPOINT) (QUOTE "L1031"))
+(PUT (QUOTE LIST2SET) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE YES) (QUOTE IDNUMBER) (QUOTE 463))
+(PUT (QUOTE REMPROPL) (QUOTE ENTRYPOINT) (QUOTE "L3146"))
+(PUT (QUOTE REMPROPL) (QUOTE IDNUMBER) (QUOTE 748))
+(PUT (QUOTE FLAG1) (QUOTE ENTRYPOINT) (QUOTE FLAG1))
+(PUT (QUOTE FLAG1) (QUOTE IDNUMBER) (QUOTE 744))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L3263"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 500))
+(PUT (QUOTE !*WRITINGFASLFILE) (QUOTE IDNUMBER) (QUOTE 539))
+(PUT (QUOTE DELETIP1) (QUOTE ENTRYPOINT) (QUOTE "L0871"))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1735"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 479))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 504))
+(PUT (QUOTE OFF) (QUOTE ENTRYPOINT) (QUOTE OFF))
+(PUT (QUOTE OFF) (QUOTE IDNUMBER) (QUOTE 711))
+(PUT (QUOTE QEDITFNS) (QUOTE IDNUMBER) (QUOTE 426))
+(FLAG (QUOTE (QEDITFNS)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MARKFROMVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1198"))
+(PUT (QUOTE CHANNELPRIN2T) (QUOTE ENTRYPOINT) (QUOTE "L1022"))
+(PUT (QUOTE CHANNELPRIN2T) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE COLLECT) (QUOTE IDNUMBER) (QUOTE 720))
+(PUT (QUOTE GLOBAL1) (QUOTE ENTRYPOINT) (QUOTE "L3172"))
+(PUT (QUOTE GLOBAL1) (QUOTE IDNUMBER) (QUOTE 754))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 438))
+(PUT (QUOTE CHANNELWRITEBLANKOREOL) (QUOTE ENTRYPOINT) (QUOTE "L2543"))
+(PUT (QUOTE CHANNELWRITEBLANKOREOL) (QUOTE IDNUMBER) (QUOTE 655))
+(PUT (QUOTE !*INNER!*BACKTRACE) (QUOTE IDNUMBER) (QUOTE 482))
+(FLAG (QUOTE (!*INNER!*BACKTRACE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYSTRING) (QUOTE ENTRYPOINT) (QUOTE "L1101"))
+(PUT (QUOTE COPYSTRING) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L3262"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 524))
+(PUT (QUOTE RDTTY) (QUOTE ENTRYPOINT) (QUOTE RDTTY))
+(PUT (QUOTE TOTALCOPY) (QUOTE ENTRYPOINT) (QUOTE "L1115"))
+(PUT (QUOTE TOTALCOPY) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE OPTIONS!*) (QUOTE IDNUMBER) (QUOTE 456))
+(FLAG (QUOTE (OPTIONS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L3096"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 510))
+(PUT (QUOTE LINELENGTH) (QUOTE ENTRYPOINT) (QUOTE "L2261"))
+(PUT (QUOTE LINELENGTH) (QUOTE IDNUMBER) (QUOTE 605))
+(PUT (QUOTE CHANNELWRITEBITSTRAUX) (QUOTE ENTRYPOINT) (QUOTE "M0663"))
+(PUT (QUOTE CHANNELWRITEBITSTRAUX) (QUOTE IDNUMBER) (QUOTE 843))
+(PUT (QUOTE RANGE) (QUOTE IDNUMBER) (QUOTE 694))
+(PUT (QUOTE PUTENTRY) (QUOTE ENTRYPOINT) (QUOTE "L2123"))
+(PUT (QUOTE PUTENTRY) (QUOTE IDNUMBER) (QUOTE 547))
+(PUT (QUOTE BREAKERRMSG) (QUOTE ENTRYPOINT) (QUOTE "L3492"))
+(PUT (QUOTE BREAKERRMSG) (QUOTE IDNUMBER) (QUOTE 799))
+(PUT (QUOTE CHANNELPRINTSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2509"))
+(PUT (QUOTE CHANNELPRINTSTRING) (QUOTE IDNUMBER) (QUOTE 649))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2785"))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 579))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE INT2ID) (QUOTE ENTRYPOINT) (QUOTE INT2ID))
+(PUT (QUOTE INT2ID) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE INTDIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1385"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L3258"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 499))
+(PUT (QUOTE ADDRESSINGUNITSPERITEM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ADDRESSINGUNITSPERITEM) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ADDRESSINGUNITSPERITEM) (QUOTE WCONST) (QUOTE 1))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MAX2) (QUOTE ENTRYPOINT) (QUOTE MAX2))
+(PUT (QUOTE MAX2) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE VALUECELLLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2064"))
+(PUT (QUOTE VALUECELLLOCATION) (QUOTE IDNUMBER) (QUOTE 538))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE PRINC) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRINC) (QUOTE IDNUMBER) (QUOTE 610))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L2202"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE MINI) (QUOTE ENTRYPOINT) (QUOTE MINI))
+(PUT (QUOTE MINI) (QUOTE IDNUMBER) (QUOTE 563))
+(PUT (QUOTE EXPLODE2) (QUOTE ENTRYPOINT) (QUOTE "L2783"))
+(PUT (QUOTE EXPLODE2) (QUOTE IDNUMBER) (QUOTE 674))
+(PUT (QUOTE !*TIME) (QUOTE IDNUMBER) (QUOTE 805))
+(FLAG (QUOTE (!*TIME)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L2203"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE PAIR) (QUOTE ENTRYPOINT) (QUOTE PAIR))
+(PUT (QUOTE PAIR) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE REVERSIP) (QUOTE ENTRYPOINT) (QUOTE "L0855"))
+(PUT (QUOTE REVERSIP) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE CHANNELWRITEUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L2521"))
+(PUT (QUOTE CHANNELWRITEUNBOUND) (QUOTE IDNUMBER) (QUOTE 651))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L2070"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 546))
+(PUT (QUOTE LISPBANNER!*) (QUOTE IDNUMBER) (QUOTE 803))
+(PUT (QUOTE LISPBANNER!*) (QUOTE INITIALVALUE) (QUOTE "Portable Standard LISP"))
+(PUT (QUOTE RANGEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1686"))
+(PUT (QUOTE RANGEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE CHARCONST) (QUOTE IDNUMBER) (QUOTE 706))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE PENDINGLOADS!*) (QUOTE IDNUMBER) (QUOTE 558))
+(FLAG (QUOTE (PENDINGLOADS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE QUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1401"))
+(PUT (QUOTE QUOTIENT) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE SPACES) (QUOTE ENTRYPOINT) (QUOTE SPACES))
+(PUT (QUOTE SPACES) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0033"))
+(PUT (QUOTE UNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L3286"))
+(PUT (QUOTE UNBOUNDP) (QUOTE IDNUMBER) (QUOTE 749))
+(PUT (QUOTE CHANNELPRINTEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L5562"))
+(PUT (QUOTE CHANNELPRINTEVECTOR) (QUOTE IDNUMBER) (QUOTE 834))
+(PUT (QUOTE CATCH) (QUOTE ENTRYPOINT) (QUOTE CATCH))
+(PUT (QUOTE CATCH) (QUOTE IDNUMBER) (QUOTE 514))
+(PUT (QUOTE IDESCAPECHAR!*) (QUOTE IDNUMBER) (QUOTE 639))
+(PUT (QUOTE IDESCAPECHAR!*) (QUOTE INITIALVALUE) (QUOTE 33))
+(PUT (QUOTE CHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L1784"))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 489))
+(PUT (QUOTE WRITESTRING) (QUOTE ENTRYPOINT) (QUOTE "L2488"))
+(PUT (QUOTE WRITESTRING) (QUOTE IDNUMBER) (QUOTE 641))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE !%RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1156"))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE CHANNELREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2206"))
+(PUT (QUOTE CHANNELREADCHAR) (QUOTE IDNUMBER) (QUOTE 581))
+(PUT (QUOTE DELATQIP1) (QUOTE ENTRYPOINT) (QUOTE "L0949"))
+(PUT (QUOTE SPACES2) (QUOTE ENTRYPOINT) (QUOTE TAB))
+(PUT (QUOTE SPACES2) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L3261"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 764))
+(PUT (QUOTE ASSOC) (QUOTE ENTRYPOINT) (QUOTE ASSOC))
+(PUT (QUOTE ASSOC) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE IMPORTS) (QUOTE ENTRYPOINT) (QUOTE "L2153"))
+(PUT (QUOTE IMPORTS) (QUOTE IDNUMBER) (QUOTE 559))
+(PUT (QUOTE EQN) (QUOTE ENTRYPOINT) (QUOTE EQN))
+(PUT (QUOTE EQN) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE DELETIP) (QUOTE ENTRYPOINT) (QUOTE "L0877"))
+(PUT (QUOTE DELETIP) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE FLOATTIMES2) (QUOTE ENTRYPOINT) (QUOTE "L1394"))
+(PUT (QUOTE REPEAT) (QUOTE ENTRYPOINT) (QUOTE REPEAT))
+(PUT (QUOTE REPEAT) (QUOTE IDNUMBER) (QUOTE 729))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE AND) (QUOTE ENTRYPOINT) (QUOTE AND))
+(PUT (QUOTE AND) (QUOTE IDNUMBER) (QUOTE 271))
+(PUT (QUOTE EXPLODEENDPOINTER!*) (QUOTE IDNUMBER) (QUOTE 672))
+(FLAG (QUOTE (EXPLODEENDPOINTER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L3065"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 737))
+(PUT (QUOTE HEAPSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE HEAPSIZE) (QUOTE WCONST) (QUOTE 90000))
+(PUT (QUOTE !&!&THROWN!&!&) (QUOTE IDNUMBER) (QUOTE 516))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2790"))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 575))
+(PUT (QUOTE RECIP) (QUOTE ENTRYPOINT) (QUOTE RECIP))
+(PUT (QUOTE RECIP) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 422))
+(PUT (QUOTE MAXBREAKLEVEL!*) (QUOTE IDNUMBER) (QUOTE 475))
+(PUT (QUOTE MAXBREAKLEVEL!*) (QUOTE INITIALVALUE) (QUOTE 5))
+(PUT (QUOTE DELATQIP) (QUOTE ENTRYPOINT) (QUOTE "L0955"))
+(PUT (QUOTE DELATQIP) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE SCANPOSSIBLEDIPTHONG) (QUOTE ENTRYPOINT) (QUOTE "L2382"))
+(PUT (QUOTE READCH) (QUOTE ENTRYPOINT) (QUOTE READCH))
+(PUT (QUOTE READCH) (QUOTE IDNUMBER) (QUOTE 609))
+(PUT (QUOTE INITFORMS!*) (QUOTE IDNUMBER) (QUOTE 818))
+(FLAG (QUOTE (INITFORMS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 753))
+(PUT (QUOTE DEC20READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L3405"))
+(PUT (QUOTE DEC20READCHAR) (QUOTE IDNUMBER) (QUOTE 776))
+(PUT (QUOTE TOPLOOP) (QUOTE ENTRYPOINT) (QUOTE "L3513"))
+(PUT (QUOTE TOPLOOP) (QUOTE IDNUMBER) (QUOTE 791))
+(PUT (QUOTE LITER) (QUOTE ENTRYPOINT) (QUOTE LITER))
+(PUT (QUOTE LITER) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE NEXT) (QUOTE ENTRYPOINT) (QUOTE NEXT))
+(PUT (QUOTE NEXT) (QUOTE IDNUMBER) (QUOTE 727))
+(PUT (QUOTE !$EXITTOPLOOP!$) (QUOTE IDNUMBER) (QUOTE 807))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 465))
+(PUT (QUOTE ERROUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1145"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE !*NONIL) (QUOTE IDNUMBER) (QUOTE 829))
+(FLAG (QUOTE (!*NONIL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1942"))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE IDNUMBER) (QUOTE 515))
+(PUT (QUOTE XINS) (QUOTE ENTRYPOINT) (QUOTE XINS))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L5785"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 830))
+(PUT (QUOTE CHANNELWRITEWORDS) (QUOTE ENTRYPOINT) (QUOTE "L2633"))
+(PUT (QUOTE CHANNELWRITEWORDS) (QUOTE IDNUMBER) (QUOTE 664))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE STACKSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE STACKSIZE) (QUOTE WCONST) (QUOTE 10000))
+(PUT (QUOTE DEFLIST) (QUOTE ENTRYPOINT) (QUOTE "L0759"))
+(PUT (QUOTE DEFLIST) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE CHANNELTYO) (QUOTE ENTRYPOINT) (QUOTE "L2800"))
+(PUT (QUOTE CHANNELTYO) (QUOTE IDNUMBER) (QUOTE 682))
+(PUT (QUOTE CHANNELREADLINE) (QUOTE ENTRYPOINT) (QUOTE "L2476"))
+(PUT (QUOTE CHANNELREADLINE) (QUOTE IDNUMBER) (QUOTE 637))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1837"))
+(PUT (QUOTE SUB) (QUOTE ENTRYPOINT) (QUOTE SUB))
+(PUT (QUOTE SUB) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1818"))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE CHANNELSPACES2) (QUOTE ENTRYPOINT) (QUOTE "L1027"))
+(PUT (QUOTE CHANNELSPACES2) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE BREAKIN!*) (QUOTE IDNUMBER) (QUOTE 783))
+(FLAG (QUOTE (BREAKIN!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L2204"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE VECTOR2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0049"))
+(PUT (QUOTE VECTOR2STRING) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE CHANNELREADEOF) (QUOTE ENTRYPOINT) (QUOTE "L2273"))
+(PUT (QUOTE CHANNELREADEOF) (QUOTE IDNUMBER) (QUOTE 622))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L1083"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE FIXP) (QUOTE ENTRYPOINT) (QUOTE FIXP))
+(PUT (QUOTE FIXP) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE ADJOIN) (QUOTE ENTRYPOINT) (QUOTE ADJOIN))
+(PUT (QUOTE ADJOIN) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE CHANNELREADLISTORDOTTEDPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2279"))
+(PUT (QUOTE CHANNELREADLISTORDOTTEDPAIR) (QUOTE IDNUMBER) (QUOTE 625))
+(PUT (QUOTE EXPAND) (QUOTE ENTRYPOINT) (QUOTE EXPAND))
+(PUT (QUOTE EXPAND) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE HALFWORDSEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0455"))
+(PUT (QUOTE MAKEFIXNUM) (QUOTE ENTRYPOINT) (QUOTE "L1369"))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0309"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE CHANNELTERPRI) (QUOTE ENTRYPOINT) (QUOTE "L2265"))
+(PUT (QUOTE CHANNELTERPRI) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE LASTCAR) (QUOTE ENTRYPOINT) (QUOTE "L0973"))
+(PUT (QUOTE LASTCAR) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE INTERNP) (QUOTE ENTRYPOINT) (QUOTE "L3361"))
+(PUT (QUOTE INTERNP) (QUOTE IDNUMBER) (QUOTE 769))
+(PUT (QUOTE UPDATEALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1161"))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0612"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE CONTROL) (QUOTE IDNUMBER) (QUOTE 702))
+(PUT (QUOTE !*BREAK) (QUOTE IDNUMBER) (QUOTE 473))
+(PUT (QUOTE !*BREAK) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE THROWTAG!*) (QUOTE IDNUMBER) (QUOTE 512))
+(FLAG (QUOTE (THROWTAG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EXPT) (QUOTE ENTRYPOINT) (QUOTE EXPT))
+(PUT (QUOTE EXPT) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE EVOR) (QUOTE ENTRYPOINT) (QUOTE EVOR))
+(PUT (QUOTE EVOR) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE MAPCAN) (QUOTE ENTRYPOINT) (QUOTE MAPCAN))
+(PUT (QUOTE MAPCAN) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE LAND) (QUOTE ENTRYPOINT) (QUOTE LAND))
+(PUT (QUOTE LAND) (QUOTE IDNUMBER) (QUOTE 413))
+(PUT (QUOTE LSH) (QUOTE ENTRYPOINT) (QUOTE LSHIFT))
+(PUT (QUOTE LSH) (QUOTE IDNUMBER) (QUOTE 417))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE COMPILETIME) (QUOTE ENTRYPOINT) (QUOTE "L2802"))
+(PUT (QUOTE COMPILETIME) (QUOTE IDNUMBER) (QUOTE 686))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE PAGEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE PAGEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L4410"))
+(PUT (QUOTE PAGEPOSITION) (QUOTE WARRAY) (QUOTE PAGEPOSITION))
+(PUT (QUOTE STEP) (QUOTE ENTRYPOINT) (QUOTE STEP))
+(PUT (QUOTE STEP) (QUOTE IDNUMBER) (QUOTE 562))
+(PUT (QUOTE DEFCONST) (QUOTE ENTRYPOINT) (QUOTE "L2945"))
+(PUT (QUOTE DEFCONST) (QUOTE IDNUMBER) (QUOTE 714))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 508))
+(PUT (QUOTE GCTIME!*) (QUOTE IDNUMBER) (QUOTE 406))
+(PUT (QUOTE GCTIME!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 634))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1384"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE BPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BPS) (QUOTE ASMSYMBOL) (QUOTE BPS))
+(PUT (QUOTE BPS) (QUOTE WARRAY) (QUOTE BPS))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2214"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 457))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1756"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE EQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0426"))
+(PUT (QUOTE EQUAL) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 630))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2201"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE FINDCATCHMARKANDTHROW) (QUOTE ENTRYPOINT) (QUOTE "L1991"))
+(PUT (QUOTE NO) (QUOTE IDNUMBER) (QUOTE 462))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE INTLAND) (QUOTE ENTRYPOINT) (QUOTE "L1432"))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE MAKEUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L3291"))
+(PUT (QUOTE MAKEUNBOUND) (QUOTE IDNUMBER) (QUOTE 766))
+(PUT (QUOTE RPLACEALL) (QUOTE ENTRYPOINT) (QUOTE "L1588"))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1775"))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 491))
+(PUT (QUOTE CATCHSETUPAUX) (QUOTE ENTRYPOINT) (QUOTE "L1984"))
+(PUT (QUOTE GCKNT!*) (QUOTE IDNUMBER) (QUOTE 407))
+(PUT (QUOTE GCKNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE INTHISCASE) (QUOTE ENTRYPOINT) (QUOTE "L2830"))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE BREAKEVAL!*) (QUOTE IDNUMBER) (QUOTE 787))
+(FLAG (QUOTE (BREAKEVAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE ENTRYPOINT) (QUOTE "L2801"))
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE IDNUMBER) (QUOTE 685))
+(PUT (QUOTE HEAP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAP) (QUOTE ASMSYMBOL) (QUOTE HEAP))
+(PUT (QUOTE HEAP) (QUOTE WARRAY) (QUOTE HEAP))
+(PUT (QUOTE COPYWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1102"))
+(PUT (QUOTE COPYWARRAY) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE INTTIMES2) (QUOTE ENTRYPOINT) (QUOTE "L1393"))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LIST2VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0075"))
+(PUT (QUOTE LIST2VECTOR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE SUBST) (QUOTE ENTRYPOINT) (QUOTE SUBST))
+(PUT (QUOTE SUBST) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE DECLAREFLUIDORGLOBAL1) (QUOTE ENTRYPOINT) (QUOTE "L3155"))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L3267"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 503))
+(PUT (QUOTE BREAKRETRY) (QUOTE ENTRYPOINT) (QUOTE "L3484"))
+(PUT (QUOTE BREAKRETRY) (QUOTE IDNUMBER) (QUOTE 797))
+(PUT (QUOTE !*COMPRESSING) (QUOTE IDNUMBER) (QUOTE 628))
+(FLAG (QUOTE (!*COMPRESSING)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE XN) (QUOTE ENTRYPOINT) (QUOTE XN))
+(PUT (QUOTE XN) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE LOR) (QUOTE ENTRYPOINT) (QUOTE LOR))
+(PUT (QUOTE LOR) (QUOTE IDNUMBER) (QUOTE 414))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L1729"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0781"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE WRITEFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2727"))
+(PUT (QUOTE WRITEFLOAT) (QUOTE IDNUMBER) (QUOTE 647))
+(PUT (QUOTE ONOFF!*) (QUOTE ENTRYPOINT) (QUOTE "L2880"))
+(PUT (QUOTE ONOFF!*) (QUOTE IDNUMBER) (QUOTE 707))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L3050"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 735))
+(PUT (QUOTE FLATSIZE2) (QUOTE ENTRYPOINT) (QUOTE "L2787"))
+(PUT (QUOTE FLATSIZE2) (QUOTE IDNUMBER) (QUOTE 675))
+(PUT (QUOTE PROGJUMPTABLE!*) (QUOTE IDNUMBER) (QUOTE 526))
+(FLAG (QUOTE (PROGJUMPTABLE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE NONINTEGER1ERROR) (QUOTE ENTRYPOINT) (QUOTE "L1345"))
+(PUT (QUOTE RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1153"))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0798"))
+(PUT (QUOTE FUNCTION) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE NUMBERP) (QUOTE ENTRYPOINT) (QUOTE "L0619"))
+(PUT (QUOTE NUMBERP) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE TOPLOOPREAD!*) (QUOTE IDNUMBER) (QUOTE 790))
+(FLAG (QUOTE (TOPLOOPREAD!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BREAKCONTINUE) (QUOTE ENTRYPOINT) (QUOTE "L3480"))
+(PUT (QUOTE BREAKCONTINUE) (QUOTE IDNUMBER) (QUOTE 796))
+(PUT (QUOTE INFSTARTINGBIT) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE INFSTARTINGBIT) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE INFSTARTINGBIT) (QUOTE WCONST) (QUOTE 18))
+(PUT (QUOTE CONCAT) (QUOTE ENTRYPOINT) (QUOTE CONCAT))
+(PUT (QUOTE CONCAT) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE SETMACROREFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L2907"))
+(PUT (QUOTE !*SEMICOL!*) (QUOTE IDNUMBER) (QUOTE 469))
+(PUT (QUOTE INTONEP) (QUOTE ENTRYPOINT) (QUOTE "L1525"))
+(PUT (QUOTE COPY) (QUOTE ENTRYPOINT) (QUOTE COPY))
+(PUT (QUOTE COPY) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE EDITF) (QUOTE ENTRYPOINT) (QUOTE EDITF))
+(PUT (QUOTE EDITF) (QUOTE IDNUMBER) (QUOTE 429))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L1732"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE CHANNELEJECT) (QUOTE ENTRYPOINT) (QUOTE "L2253"))
+(PUT (QUOTE CHANNELEJECT) (QUOTE IDNUMBER) (QUOTE 602))
+(PUT (QUOTE SUBLA) (QUOTE ENTRYPOINT) (QUOTE SUBLA))
+(PUT (QUOTE SUBLA) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 599))
+(PUT (QUOTE STDIN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE FASTUNBIND) (QUOTE ENTRYPOINT) (QUOTE "L3280"))
+(PUT (QUOTE FASTUNBIND) (QUOTE IDNUMBER) (QUOTE 437))
+(PUT (QUOTE RASSOC) (QUOTE ENTRYPOINT) (QUOTE RASSOC))
+(PUT (QUOTE RASSOC) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE STATICINTFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L1337"))
+(PUT (QUOTE PRINTWITHFRESHLINE) (QUOTE ENTRYPOINT) (QUOTE "L3560"))
+(PUT (QUOTE PRINTWITHFRESHLINE) (QUOTE IDNUMBER) (QUOTE 816))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 594))
+(PUT (QUOTE EVLOAD) (QUOTE ENTRYPOINT) (QUOTE EVLOAD))
+(PUT (QUOTE EVLOAD) (QUOTE IDNUMBER) (QUOTE 424))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE CATCH!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1930"))
+(PUT (QUOTE CATCH!-ALL) (QUOTE IDNUMBER) (QUOTE 513))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE ENTRYPOINT) (QUOTE "L1769"))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 488))
+(PUT (QUOTE SETINDX) (QUOTE ENTRYPOINT) (QUOTE "L0136"))
+(PUT (QUOTE SETINDX) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE ENTRYPOINT) (QUOTE "L3450"))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 588))
+(PUT (QUOTE ADDTOOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L3312"))
+(PUT (QUOTE ADJOINQ) (QUOTE ENTRYPOINT) (QUOTE "L1043"))
+(PUT (QUOTE ADJOINQ) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE MAKEBUFINTOFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2333"))
+(PUT (QUOTE CATCHSETUP) (QUOTE ENTRYPOINT) (QUOTE "L1983"))
+(PUT (QUOTE CATCHSETUP) (QUOTE IDNUMBER) (QUOTE 485))
+(PUT (QUOTE BREAKQUIT) (QUOTE ENTRYPOINT) (QUOTE "L3479"))
+(PUT (QUOTE BREAKQUIT) (QUOTE IDNUMBER) (QUOTE 795))
+(PUT (QUOTE CONTOPENERROR) (QUOTE ENTRYPOINT) (QUOTE "L3446"))
+(PUT (QUOTE GENSYM1) (QUOTE ENTRYPOINT) (QUOTE "L3370"))
+(PUT (QUOTE FORMATFORPRINTF!*) (QUOTE IDNUMBER) (QUOTE 668))
+(FLAG (QUOTE (FORMATFORPRINTF!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DIGITTONUMBER) (QUOTE ENTRYPOINT) (QUOTE "L4619"))
+(PUT (QUOTE DIGITTONUMBER) (QUOTE IDNUMBER) (QUOTE 826))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 506))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L3071"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 738))
+(PUT (QUOTE GLOBALINSTALL) (QUOTE ENTRYPOINT) (QUOTE "L3393"))
+(PUT (QUOTE GLOBALINSTALL) (QUOTE IDNUMBER) (QUOTE 773))
+(PUT (QUOTE CHANNELPRIN) (QUOTE IDNUMBER) (QUOTE 833))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE DISPLAYHELPFILE) (QUOTE IDNUMBER) (QUOTE 446))
+(PUT (QUOTE !$LOOP!$) (QUOTE IDNUMBER) (QUOTE 726))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L3175"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 755))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1146"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE MAKESTRINGINTOLISPINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2440"))
+(PUT (QUOTE MAKESTRINGINTOLISPINTEGER) (QUOTE IDNUMBER) (QUOTE 631))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L2041"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 586))
+(PUT (QUOTE CNTRL) (QUOTE IDNUMBER) (QUOTE 701))
+(PUT (QUOTE UPDATEHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1247"))
+(PUT (QUOTE RETURN) (QUOTE ENTRYPOINT) (QUOTE RETURN))
+(PUT (QUOTE RETURN) (QUOTE IDNUMBER) (QUOTE 531))
+(PUT (QUOTE BINARYOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L2062"))
+(PUT (QUOTE BINARYOPENWRITE) (QUOTE IDNUMBER) (QUOTE 537))
+(PUT (QUOTE ONEARGDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1347"))
+(PUT (QUOTE INTLOR) (QUOTE ENTRYPOINT) (QUOTE INTLOR))
+(PUT (QUOTE ONEARGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1356"))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE ENTRYPOINT) (QUOTE "L1159"))
+(PUT (QUOTE CHANNELPRINC) (QUOTE ENTRYPOINT) (QUOTE "L2266"))
+(PUT (QUOTE CHANNELPRINC) (QUOTE IDNUMBER) (QUOTE 611))
+(PUT (QUOTE RECURSIVECHANNELPRIN1) (QUOTE ENTRYPOINT) (QUOTE "L2707"))
+(PUT (QUOTE RECURSIVECHANNELPRIN1) (QUOTE IDNUMBER) (QUOTE 661))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE REMFLAG1) (QUOTE ENTRYPOINT) (QUOTE "L3129"))
+(PUT (QUOTE REMFLAG1) (QUOTE IDNUMBER) (QUOTE 746))
+(PUT (QUOTE !*CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 471))
+(FLAG (QUOTE (!*CONTINUABLEERROR)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE VECTOREQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0443"))
+(PUT (QUOTE INTERSECTION) (QUOTE ENTRYPOINT) (QUOTE XN))
+(PUT (QUOTE INTERSECTION) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE MAKEINPUTAVAILABLE) (QUOTE ENTRYPOINT) (QUOTE "L2481"))
+(PUT (QUOTE MAKEINPUTAVAILABLE) (QUOTE IDNUMBER) (QUOTE 620))
+(PUT (QUOTE EVAND1) (QUOTE ENTRYPOINT) (QUOTE EVAND1))
+(PUT (QUOTE RPLACW) (QUOTE ENTRYPOINT) (QUOTE RPLACW))
+(PUT (QUOTE RPLACW) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE FINDFIRST) (QUOTE ENTRYPOINT) (QUOTE "L1590"))
+(PUT (QUOTE DEC20OPEN) (QUOTE ENTRYPOINT) (QUOTE "L3444"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 536))
+(PUT (QUOTE MKEVECT) (QUOTE IDNUMBER) (QUOTE 842))
+(PUT (QUOTE COMPACTHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1162"))
+(PUT (QUOTE CHANNELWRITEBITSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2496"))
+(PUT (QUOTE QUIT) (QUOTE ENTRYPOINT) (QUOTE QUIT))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 410))
+(PUT (QUOTE TRST) (QUOTE ENTRYPOINT) (QUOTE TRST))
+(PUT (QUOTE TRST) (QUOTE IDNUMBER) (QUOTE 425))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE FILEP) (QUOTE ENTRYPOINT) (QUOTE FILEP))
+(PUT (QUOTE FILEP) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE FLOATPLUS2) (QUOTE ENTRYPOINT) (QUOTE "L1377"))
+(PUT (QUOTE CHANNELWRITESYSFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2506"))
+(PUT (QUOTE CHANNELWRITESYSFLOAT) (QUOTE IDNUMBER) (QUOTE 646))
+(PUT (QUOTE !#ARG) (QUOTE IDNUMBER) (QUOTE 712))
+(PUT (QUOTE MAP2) (QUOTE ENTRYPOINT) (QUOTE MAP2))
+(PUT (QUOTE MAP2) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE EDIT) (QUOTE ENTRYPOINT) (QUOTE EDIT))
+(PUT (QUOTE EDIT) (QUOTE IDNUMBER) (QUOTE 430))
+(PUT (QUOTE STRING) (QUOTE ENTRYPOINT) (QUOTE STRING))
+(PUT (QUOTE STRING) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE RECURSIVECHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L2680"))
+(PUT (QUOTE RECURSIVECHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 659))
+(PUT (QUOTE MARKFROMONESYMBOL) (QUOTE ENTRYPOINT) (QUOTE "L1174"))
+(PUT (QUOTE OK) (QUOTE IDNUMBER) (QUOTE 445))
+(PUT (QUOTE POSN) (QUOTE ENTRYPOINT) (QUOTE POSN))
+(PUT (QUOTE POSN) (QUOTE IDNUMBER) (QUOTE 606))
ADDED psl-1983/20-kernel/prop.ctl
Index: psl-1983/20-kernel/prop.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/prop.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "prop";
+in "prop.build";
+ASMEnd;
+quit;
+compile prop.mac, dprop.mac
+delete prop.mac, dprop.mac
ADDED psl-1983/20-kernel/prop.init
Index: psl-1983/20-kernel/prop.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/prop.init
@@ -0,0 +1,2 @@
+(FLUID (QUOTE (!*REDEFMSG !*USERMODE)))
+(FLUID (QUOTE (!*COMP PROMPTSTRING!*)))
ADDED psl-1983/20-kernel/prop.log
Index: psl-1983/20-kernel/prop.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/prop.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/prop.rel
Index: psl-1983/20-kernel/prop.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/prop.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/psl-link.ctl
Index: psl-1983/20-kernel/psl-link.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/psl-link.ctl
@@ -0,0 +1,42 @@
+cd S:
+define DSK:, DSK:, P20:
+LINK
+/nosymbol
+p20:nil.rel
+/set:.low.:202
+p20:types.rel
+p20:randm.rel
+p20:alloc.rel
+p20:arith.rel
+p20:debg.rel
+p20:error.rel
+p20:eval.rel
+p20:extra.rel
+p20:fasl.rel
+p20:io.rel
+p20:macro.rel
+p20:prop.rel
+p20:symbl.rel
+p20:sysio.rel
+p20:tloop.rel
+p20:main.rel
+p20:heap.rel
+p20:dtypes.rel
+p20:drandm.rel
+p20:dalloc.rel
+p20:darith.rel
+p20:ddebg.rel
+p20:derror.rel
+p20:deval.rel
+p20:dextra.rel
+p20:dfasl.rel
+p20:dio.rel
+p20:dmacro.rel
+p20:dprop.rel
+p20:dsymbl.rel
+p20:dsysio.rel
+p20:dtloop.rel
+p20:dmain.rel
+p20:dheap.rel
+/save s:bpsl.exe
+/go
ADDED psl-1983/20-kernel/psl-link.log
Index: psl-1983/20-kernel/psl-link.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/psl-link.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/psl.init
Index: psl-1983/20-kernel/psl.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/psl.init
@@ -0,0 +1,17 @@
+(lapin "types.init")
+(lapin "randm.init")
+(lapin "alloc.init")
+(lapin "arith.init")
+(lapin "debg.init")
+(lapin "error.init")
+(lapin "eval.init")
+(lapin "extra.init")
+(lapin "fasl.init")
+(lapin "io.init")
+(lapin "macro.init")
+(lapin "prop.init")
+(lapin "symbl.init")
+(lapin "sysio.init")
+(lapin "tloop.init")
+(lapin "main.init")
+(lapin "heap.init")
ADDED psl-1983/20-kernel/randm.ctl
Index: psl-1983/20-kernel/randm.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/randm.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "randm";
+in "randm.build";
+ASMEnd;
+quit;
+compile randm.mac, drandm.mac
+delete randm.mac, drandm.mac
ADDED psl-1983/20-kernel/randm.init
Index: psl-1983/20-kernel/randm.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/randm.init
@@ -0,0 +1,21 @@
+(PUT (QUOTE LIST) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DE) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DF) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DM) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DN) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE SETQ) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE AND) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE OR) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE COND) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE MAX) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE MIN) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE PLUS) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE TIMES) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE FUNCTION) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE FIRST) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE SECOND) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE THIRD) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE FOURTH) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE REST) (QUOTE TYPE) (QUOTE MACRO))
ADDED psl-1983/20-kernel/randm.log
Index: psl-1983/20-kernel/randm.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/randm.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/randm.rel
Index: psl-1983/20-kernel/randm.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/randm.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/scan-table.red
Index: psl-1983/20-kernel/scan-table.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/scan-table.red
@@ -0,0 +1,34 @@
+%
+% SCAN-TABLE.RED - Lisp character table for DEC-20
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 November 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL-20>SCAN-TABLE.RED.6, 10-Feb-83 16:12:38, Edit by PERDUE
+% Changed the "put EOF" to be a STARTUPTIME form
+% Edit by Cris Perdue, 28 Jan 1983 2039-PST
+% LispDipthong -> LispDiphthong
+
+fluid '(LispScanTable!* CurrentScanTable!*);
+
+LispScanTable!* := '
+[17 10 10 10 10 10 10 10 10 17 17 10 17 17 10 10 10 10 10 10 10 10 10 10
+10 10 11 10 10 10 10 10 17 14 15 10 10 12 10 11 11 11 10 19 10 18 20 10
+0 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 LispDiphthong];
+
+CurrentScanTable!* := LispScanTable!*;
+
+% Done as "startuptime" because "char" is available at compile
+% time but not necessarily init time /csp
+startuptime
+ put('EOF, 'CharConst, char cntrl Z);
+
+END;
ADDED psl-1983/20-kernel/symbl.ctl
Index: psl-1983/20-kernel/symbl.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/symbl.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "symbl";
+in "symbl.build";
+ASMEnd;
+quit;
+compile symbl.mac, dsymbl.mac
+delete symbl.mac, dsymbl.mac
ADDED psl-1983/20-kernel/symbl.init
Index: psl-1983/20-kernel/symbl.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/symbl.init
ADDED psl-1983/20-kernel/symbl.log
Index: psl-1983/20-kernel/symbl.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/symbl.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/symbl.rel
Index: psl-1983/20-kernel/symbl.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/symbl.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/sysio.ctl
Index: psl-1983/20-kernel/sysio.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/sysio.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "sysio";
+in "sysio.build";
+ASMEnd;
+quit;
+compile sysio.mac, dsysio.mac
+delete sysio.mac, dsysio.mac
ADDED psl-1983/20-kernel/sysio.init
Index: psl-1983/20-kernel/sysio.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/sysio.init
@@ -0,0 +1,3 @@
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (STDIN!* STDOUT!* ERROUT!* !*ECHO)))
+(FLUID (QUOTE (LISPSCANTABLE!* CURRENTSCANTABLE!*)))
ADDED psl-1983/20-kernel/sysio.log
Index: psl-1983/20-kernel/sysio.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/sysio.log
@@ -0,0 +1,67 @@
+
+ 7-Mar-83 16:19:52
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job SYSIO Req #267 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:20:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 805
+
+ Input from => PS:<PSL.KERNEL.20>SYSIO.CTL.2
+ Output to => PS:<PSL.KERNEL.20>SYSIO.LOG
+
+
+
+16:19:53 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+16:19:53 MONTR @SET TIME-LIMIT 1200
+16:19:54 MONTR @LOGIN KESSLER SMALL
+16:19:57 MONTR Job 13 on TTY225 7-Mar-83 16:19:56
+16:19:57 MONTR Previous login at 7-Mar-83 16:16:23
+16:19:57 MONTR There is 1 other job logged in as user KESSLER
+16:20:06 MONTR @
+16:20:06 MONTR [PS Mounted]
+16:20:06 MONTR
+16:20:06 MONTR [CONNECTED TO PS:<PSL.KERNEL.20>]
+16:20:06 MONTR define DSK: DSK:, P20:, PI:
+16:20:08 MONTR @S:DEC20-CROSS.EXE
+16:20:09 USER Dec 20 cross compiler
+16:20:10 USER [8] ASMOut "sysio";
+16:20:11 USER ASMOUT: IN files; or type in expressions
+16:20:11 USER When all done execute ASMEND;
+16:21:12 USER [9] in "sysio.build";
+16:21:13 USER %
+16:21:13 USER % SYSIO.BUILD - Files for system-dependent input and output
+16:21:13 USER %
+16:21:13 USER % Author: Eric Benson
+16:21:13 USER % Symbolic Computation Group
+16:21:13 USER % Computer Science Dept.
+16:21:13 USER % University of Utah
+16:21:13 USER % Date: 19 May 1982
+16:21:14 USER % Copyright (c) 1982 University of Utah
+16:21:14 USER %
+16:21:14 USER
+16:21:14 USER PathIn "system-io.red"$ % system dependent IO functions
+16:21:28 USER PathIn "scan-table.red"$
+16:21:29 USER *** GLOBAL `LISPSCANTABLE!*' cannot become FLUID
+16:21:31 USER % change scan table for system
+16:21:31 USER [10] ASMEnd;
+16:22:00 USER *** Garbage collection starting
+16:22:16 USER *** GC 4: time 3296 ms
+16:22:16 USER *** 72563 recovered, 564 stable, 16873 active, 72563 free
+16:22:44 USER NIL
+16:22:44 USER [11] quit;
+16:22:46 MONTR @compile sysio.mac, dsysio.mac
+16:22:51 USER MACRO: .MAIN
+16:23:03 USER MACRO: .MAIN
+16:23:04 USER
+16:23:04 USER EXIT
+16:23:07 MONTR @delete sysio.mac, dsysio.mac
+16:23:08 MONTR SYSIO.MAC.1 [OK]
+16:23:08 MONTR DSYSIO.MAC.1 [OK]
+16:23:08 MONTR @
+16:23:11 MONTR Killed by OPERATOR, TTY 221
+16:23:11 MONTR Killed Job 13, User KESSLER, Account SMALL, TTY 225,
+16:23:11 MONTR at 7-Mar-83 16:23:13, Used 0:01:12 in 0:03:17
ADDED psl-1983/20-kernel/sysio.rel
Index: psl-1983/20-kernel/sysio.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/sysio.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/system-extras.red
Index: psl-1983/20-kernel/system-extras.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/system-extras.red
@@ -0,0 +1,65 @@
+%
+% 20-EXTRAS.RED - System-specific functions for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 4 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.KERNEL-20>SYSTEM-EXTRAS.RED.3, 5-Jan-83 16:46:34, Edit by PERDUE
+% Added ExitLISP, for the DEC-20 a synonym of QUIT
+
+fluid '(system_list!*);
+
+if_system(Tenex,
+ if_system(KL10,
+ system_list!* := '(Dec20 PDP10 Tenex KL10),
+ system_list!* := '(Dec20 PDP10 Tenex)),
+ system_list!* := '(Dec20 PDP10 Tops20 KL10));
+
+lap '((!*entry Quit expr 0)
+ (haltf)
+ (!*MOVE '"Continued" (reg 1))
+ (!*EXIT 0)
+);
+
+CopyD('ExitLISP, 'Quit);
+
+lap '((!*entry Date expr 0)
+ (!*MOVE (WConst 8) (reg 1)) % allocate a 9 character string
+ (!*CALL GtStr)
+ (!*MOVE (reg 1) (reg 4)) % save it in 4
+ (!*WPLUS2 (reg 1) (WConst 1))
+ (hrli 1 8#440700) % create a byte pointer to it
+ (!*MOVE (WConst -1) (reg 2)) % current date
+ (hrlzi (reg 3) 2#0000000001) % ot%ntm, don't output time
+ (odtim)
+ (!*MOVE (reg 4) (reg 1))
+ (!*MKITEM (reg 1) (WConst STR)) % tag it as a string
+ (!*EXIT 0)
+);
+
+if_system(KL10, NIL,
+lap '((!*Entry StackOverflow expr 0)
+ (sub (reg ST) (lit (halfword 1000 1000))) % back up stack
+ (!*MOVE '"Stack overflow" (reg 1))
+ (!*JCALL StdError)
+));
+
+on SysLisp;
+
+syslsp procedure ReturnAddressP X;
+begin scalar Y, Z;
+ Z := SymFnc;
+ return Field(X, 0, 18) = 2#011001000000000000 % PC flags
+ and Field(@(X - 1), 0, 18) = 8#260740 % pushj 17,
+ and (Y := Field(@(X - 1), 18, 18) - Z) > 0 and Y < MaxSymbols
+ and MkID Y;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/system-faslin.red
Index: psl-1983/20-kernel/system-faslin.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/system-faslin.red
@@ -0,0 +1,67 @@
+%
+% 20-FASLIN.RED - Functions needed by faslin
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.KERNEL-20>SYSTEM-FASLIN.RED.4, 7-Oct-82 13:37:56, Edit by BENSON
+% Changed 0 byte size to 36 byte size, for Tenex compatibility
+
+on Syslisp;
+
+syslsp procedure BinaryOpenRead FileName;
+begin scalar F;
+ F := Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 36*of%bsz of%rd
+ 2#100100000000000000010000000000000000);
+ return if F eq 0 then
+ ContError(99, "Couldn't open binary file for input",
+ BinaryOpenRead FileName)
+ else F;
+end;
+
+syslsp procedure BinaryOpenWrite FileName;
+begin scalar F;
+ F := Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 36*of%bsz of%wr
+ 2#100100000000000000001000000000000000);
+ return if F eq 0 then
+ ContError(99, "Couldn't open binary file for output",
+ BinaryOpenWrite FileName)
+ else F;
+end;
+
+syslsp procedure ValueCellLocation X;
+ if not LispVar !*WritingFaslFile then
+ &SymVal IDInf X
+ else
+ << LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
+ MakeRelocHalfWord(const RELOC_VALUE_CELL, FindIDNumber X) >>;
+
+syslsp procedure ExtraRegLocation X;
+<< X := second X;
+ if not LispVar !*WritingFaslFile then
+ &ArgumentBlock[X - (MaxRealRegs + 1)]
+ else
+ << LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
+ MakeRelocHalfWord(const RELOC_VALUE_CELL, X + 8150) >> >>;
+
+syslsp procedure FunctionCellLocation X;
+ if not LispVar !*WritingFaslFile then
+ &SymFnc IDInf X
+ else
+ << LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
+ MakeRelocHalfWord(const RELOC_FUNCTION_CELL, FindIDNumber X) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-kernel/system-faslout.red
Index: psl-1983/20-kernel/system-faslout.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/system-faslout.red
@@ -0,0 +1,63 @@
+%
+% 20-FASLOUT.RED - 20-specific stuff for FASL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 February 1982
+% Copyright (c) 1982 University of Utah
+%
+
+CompileTime DefConst(AddressingUnitsPerItem, 1,
+ BitTableEntriesPerWord, 18,
+ FASL_MAGIC_NUMBER, 99,
+ RELOC_ID_NUMBER, 1,
+ RELOC_VALUE_CELL, 2,
+ RELOC_FUNCTION_CELL, 3,
+ RELOC_WORD, 1,
+ RELOC_HALFWORD, 2,
+ RELOC_INF, 3);
+
+on SysLisp;
+
+CompileTime <<
+smacro procedure RelocRightHalfTag X;
+ Field(X, 18, 2);
+
+smacro procedure RelocRightHalfInf X;
+ Field(X, 20, 16);
+
+smacro procedure RelocInfTag X;
+ Field(X, 18, 2);
+
+smacro procedure RelocInfInf X;
+ Field(X, 20, 16);
+
+smacro procedure RelocWordTag X;
+ Field(X, 0, 2);
+
+smacro procedure RelocWordInf X;
+ Field(X, 2, 34);
+
+smacro procedure PutRightHalf(Where, What);
+ PutField(Where, 18, 18, What);
+
+put('RightHalf, 'Assign!-Op, 'PutRightHalf);
+>>;
+
+CompileTime DefList('((BinaryWrite ((bout)))
+ (BinaryRead ((bin) (move (reg 1) (reg 2))))
+ (BinaryClose ((closf) (jfcl)))
+ (BinaryWriteBlock
+ ((hrli (reg 2) 8#444400) % point 36,
+ (movns (reg 3))
+ (sout)))
+ (BinaryReadBlock
+ ((hrli (reg 2) 8#444400) % point 36,
+ (movns (reg 3))
+ (sin)))), 'OpenCode);
+
+off Syslisp;
+
+END;
ADDED psl-1983/20-kernel/system-gc.red
Index: psl-1983/20-kernel/system-gc.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/system-gc.red
@@ -0,0 +1,28 @@
+%
+% SYSTEM-GC.RED - System dependent before and after GC hooks
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Do nothing on the Dec-20
+
+on Syslisp;
+
+CompileTime <<
+
+syslsp smacro procedure BeforeGCSystemHook();
+ NIL;
+
+syslsp smacro procedure AfterGCSystemHook();
+ NIL;
+
+>>;
+
+off Syslisp;
+
+END;
ADDED psl-1983/20-kernel/system-io.red
Index: psl-1983/20-kernel/system-io.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/system-io.red
@@ -0,0 +1,283 @@
+%
+% SYSTEM-IO.RED - System dependent IO routines for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 16 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+global '(IN!* OUT!*);
+LoadTime <<
+IN!* := 0;
+OUT!* := 1;
+>>;
+
+fluid '(StdIN!* StdOUT!* ErrOUT!* !*Echo);
+LoadTime <<
+StdIN!* := 0;
+StdOUT!* := 1;
+ErrOUT!* := 1;
+>>;
+
+CompileTime flag('(RDTTY FindFreeChannel Dec20Open ContOpenError ClearIO1),
+ 'InternalFunction);
+
+on SysLisp;
+
+external WArray JFNOfChannel, ReadFunction, WriteFunction, CLoseFunction;
+
+if_system(Tops20,
+lap '((!*entry Dec20ReadChar expr 1)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+Loop % get JFN for channel
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+ (!*PUSH (reg 1)) % yes, save char
+ (!*CALL WriteChar) % and write it
+ (!*POP (reg 1)) % restore it
+ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+));
+
+if_system(Tenex,
+lap '((!*entry Dec20ReadChar expr 1)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+Loop % get JFN for channel
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (cain (reg 2) (WConst 8#37)) % TENEX EOL
+ (!*MOVE (WConst 8#12) (reg 2)) % replace it with a linefeed
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+ (!*PUSH (reg 1)) % yes, save char
+ (!*CALL WriteChar) % and write it
+ (!*POP (reg 1)) % restore it
+ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+));
+
+lap '((!*entry Dec20WriteChar expr 2)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+ % get JFN for channel
+ (!*JUMPEQ (Label CRLF) (reg 2) (WConst 8#12)) % if LF, echo CRLF
+ (bout) % no, just echo char
+ (!*EXIT 0) % return
+CRLF
+ (!*MOVE (WConst 8#15) (reg 2)) % write carriage-return
+ (bout)
+ (!*MOVE (WConst 8#12) (reg 2)) % write linefeed
+ (bout)
+ (!*EXIT 0) % return
+);
+
+internal WConst MaxTerminalBuffer = 200;
+internal WVar NextTerminalChar = 1;
+internal WString TerminalInputBuffer[MaxTerminalBuffer];
+
+lap '((!*entry ClearIO1 expr 0)
+%
+% ^C from RDTTY and restart causes trouble, but we don't want a full RESET
+% (don't want to close files or kill forks), so we'll just do the
+% part of RESET that we want, for terminal input
+%
+ (!*MOVE (WConst 8#100) (reg 1)) % .priin
+ (rfmod)
+ (tro 2 2#001111100001000000) % tt%wak + tt%eco + .ttasi, like RESET
+ (sfmod)
+ (!*EXIT 0)
+);
+
+syslsp procedure ClearIO();
+<< ClearIO1();
+ TerminalInputBuffer[0] := -1;
+ NextTerminalChar := 0;
+ LispVar IN!* := LispVar STDIN!*;
+ LispVar OUT!* := LispVar STDOUT!* >>;
+
+if_system(Tops20,
+lap '((!*entry RDTTY expr 3)
+ (dmove (reg t1) (reg 1))
+ (!*MOVE (WConst 8#101) (reg 1)) % .priou
+ (rfmod) % read mode word
+ (tlze (reg 2) 2#100000000000000000) % if tt%osp is 0, then skip
+ (sfmod) % otherwise turn on output
+ (dmove (reg 1) (reg t1))
+ (!*MOVE (reg 2) (reg 4)) % save original count in r4
+ (!*WPLUS2 (reg 1) (WConst 1)) % make input buffer into byte pointer
+ (hrli (reg 1) 8#440700)
+ (!*WPLUS2 (reg 3) (WConst 1)) % make prompt string into byte pointer
+ (hrli (reg 3) 8#440700)
+ (!*MOVE (reg 1) (reg 5)) % print it once
+ (!*MOVE (reg 3) (reg 1))
+ (psout)
+ (!*MOVE (reg 5) (reg 1))
+ (hrli (reg 2) 2#000110000000000000) % rd%bel + rd%crf
+ (jsys 8#523) % RDTTY
+ (!*JUMP (Label CantRDTTY))
+ (!*MOVE (reg 4) (reg 1)) % move original count to r1
+ (hrrzs (reg 2)) % clear flag bits in r2
+ (!*WDIFFERENCE (reg 1) (reg 2)) % return # chars read, not # available
+ (!*EXIT 0)
+CantRDTTY
+ (!*MOVE (QUOTE "Can't read from terminal") (reg 1))
+ (!*JCALL IOError)
+));
+
+if_system(Tenex,
+lap '((!*entry RDTTY expr 3)
+ (move (reg t1) (reg 1))
+ (move (reg t2) (reg 2))
+ (!*MOVE (WConst 8#101) (reg 1)) % .priou
+ (rfmod) % read mode word
+ (tlze (reg 2) 2#100000000000000000) % if tt%osp is 0, then skip
+ (sfmod) % otherwise turn on output
+ (move (reg 1) (reg t1))
+ (move (reg 2) (reg t2))
+ (!*MOVE (reg 2) (reg 4)) % save original count in r4
+ (!*WPLUS2 (reg 1) (WConst 1)) % make input buffer into byte pointer
+ (hrli (reg 1) 8#440700)
+ (!*WPLUS2 (reg 3) (WConst 1)) % make prompt string into byte pointer
+ (hrli (reg 3) 8#440700)
+ (!*MOVE (reg 1) (reg 5)) % print it once
+ (!*MOVE (reg 3) (reg 1))
+ (psout)
+ (!*MOVE (reg 5) (reg 1))
+% (hrli (reg 2) 2#000110000000000000) % rd%bel + rd%crf
+% (jsys 8#523) % RDTTY
+% (!*JUMP (Label CantRDTTY))
+ (!*MOVE (WConst MaxTerminalBuffer) (reg 2)) % # of chars
+ (setz 3 0) % clear 3
+ (jsys 8#611) % PSTIN, IMSSS JSYS
+ (!*MOVE (WConst 8#12) (reg 3)) % put linefeed at end of buffer
+ (dpb (reg 3) (reg 1)) % 1 points to end of what's been read
+ (!*MOVE (reg 4) (reg 1)) % move original count to r1
+ (hrrzs (reg 2)) % clear flag bits in r2
+ (!*WDIFFERENCE (reg 1) (reg 2)) % return # chars read, not # available
+ (!*EXIT 0)
+));
+
+syslsp procedure TerminalInputHandler Chn;
+begin scalar Ch;
+ while NextTerminalChar >= StrLen TerminalInputBuffer do
+ << NextTerminalChar := 0;
+ TerminalInputBuffer[0] := RDTTY(TerminalInputBuffer,
+ MaxTerminalBuffer,
+ if StringP LispVar PromptString!*
+ then LispVar PromptString!*
+ else ">") >>;
+ Ch := StrByt(TerminalInputBuffer, NextTerminalChar);
+ NextTerminalChar := NextTerminalChar + 1;
+ return Ch;
+end;
+
+syslsp procedure FindFreeChannel();
+begin scalar Chn;
+ Chn := 0;
+ while JfnOfChannel[Chn] neq 0 do
+ << if Chn >= MaxChannels then IOError("No free channels left");
+ Chn := Chn + 1 >>;
+ return Chn;
+end;
+
+syslsp procedure SystemMarkAsClosedChannel FileDes;
+ JFNOfChannel[IntInf FileDes] := 0;
+
+lap '((!*entry Dec20CloseChannel expr 1)
+ (!*MOVE (reg 1) (reg 2)) % save in case of error
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+ (closf)
+ (!*JUMP (Label CloseError))
+ (!*EXIT 0)
+CloseError
+ (!*MOVE (QUOTE "Channel could not be closed") (reg 1))
+ (!*JCALL ChannelError)
+);
+
+syslsp procedure SystemOpenFileSpecial FileName;
+<< JFNOfChannel[FileName := FindFreeChannel()] := -1;
+ FileName >>;
+
+syslsp procedure SystemOpenFileForInput FileName;
+begin scalar Chn, JFN;
+ Chn := FindFreeChannel();
+ JFN := Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 7*of%bsz of%rd
+ 2#000111000000000000010000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'INPUT);
+ JFNOfChannel[Chn] := JFN;
+ ReadFunction[Chn] := 'Dec20ReadChar;
+ CloseFunction[Chn] := 'Dec20CloseChannel;
+ return Chn;
+end;
+
+syslsp procedure SystemOpenFileForOutput FileName;
+begin scalar Chn, JFN;
+ Chn := FindFreeChannel();
+ JFN := Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 7*of%bsz of%wr
+ 2#000111000000000000001000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'OUTPUT);
+ JFNOfChannel[Chn] := JFN;
+ WriteFunction[Chn] := 'Dec20WriteChar;
+ CloseFunction[Chn] := 'Dec20CloseChannel;
+ return Chn;
+end;
+
+lap '((!*entry Dec20Open expr 3)
+%
+% Dec20Open(Filename string, GTJFN bits, OPENF bits)
+%
+ (!*WPLUS2 (reg 1) (WConst 1)) % increment r1 to point to characters
+ (hrli (reg 1) 8#440700) % turn r1 into a byte pointer
+ (!*MOVE (reg 1) (reg 4)) % save filename string in r4
+ (!*MOVE (reg 2) (reg 1)) % GTJFN flag bits in r1
+ (!*MOVE (reg 4) (reg 2)) % string in r2
+ (gtjfn)
+ (!*JUMP (Label CantOpen))
+ (!*MOVE (reg 3) (reg 2)) % OPENF bits in r2, JFN in r1
+ (openf)
+CantOpen
+ (!*MOVE (WConst 0) (reg 1)) % return 0 on error
+ (!*EXIT 0) % else return the JFN
+);
+
+off SysLisp;
+
+lisp procedure ContOpenError(FileName, AccessMode);
+ ContinuableError(99,
+ BldMsg("`%s' cannot be open for %w",
+ FileName, AccessMode),
+ list('OPEN, MkSTR FileName, MkQuote AccessMode));
+
+END;
ADDED psl-1983/20-kernel/tags.fai
Index: psl-1983/20-kernel/tags.fai
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/tags.fai
@@ -0,0 +1,992 @@
+;MRC:<EMACS>TAGS.FAI.49, 10-Sep-81 12:22:29, Edit by ADMIN.JQJ
+;add dummy SCRIBE routine.
+
+ title tags
+ search monsym
+
+ subttl Definitions
+
+ifndef tnxsw,< ife .osfail-<sixbit /TENEX/>,< tnxsw __ -1>>
+ifndef tnxsw,< tnxsw __ 0>
+t20sw __ tnxsw
+
+define tnx <ifn tnxsw>
+define t20 <ifn t20sw>
+
+tnx,< prints \TENEX version.
+\
+ opdef pstin [jsys 611]
+>
+t20,< prints \TOPS-20 version.
+\>
+
+f_0 ; Flags
+t_7 ; Temp
+u_10 ; Temp
+s_11 ; String and temp
+s1_12 ; Second part for string
+n_13 ; Counter of functions found
+ch_14 ; Character
+l_15 ; Language type
+bp_16 ; Byte pointer
+p_17 ; Guess
+
+; LH flags
+f%f1 __ 400000 ; Temp flags
+f%f2 __ 200000
+
+; RH flags
+f%oldf __ 400000 ; Using old tags file, not making one
+f%eoff __ 200000 ; EOF seen on old file
+f%lgvn __ 100000 ; Language specified by user with /
+
+opdef call [pushj p, 0]
+opdef ret [popj p, 0]
+opdef uerr [1b8]
+
+define error (x)
+ < uerr [asciz /x/]
+ >
+
+loc 41
+ call uuoh
+reloc
+
+ subttl Impure storage
+
+tagjfb: block 2 ; Flags and jfns
+ block 3 ; Device, dir, name
+ point 7, [asciz /TAGS/] ; Extension
+ block 4
+
+injfn: 0
+tagjfn: 0
+oldjfn: 0
+
+nfiles: 0
+nfunct: 0
+
+nchars: 0
+filptr: 0
+hdrptr: 0
+zroptr: 0
+
+indefq: 0 ; Non-zero => inside DEFINEQ for INTERLISP
+nparen: 0 ; <paren depth> - 1 for INTERLISP
+arpdp: 0 ; Pushdown pointer for [] paren pdl
+parpdl: block 100 ; Stack itself
+
+defext: block 10
+
+strbsz __ 100
+strbuf: block strbsz
+
+npdl __ 17
+pdl: block npdl
+
+ subttl Pure storage
+
+defjfb: gj%old!gj%cfm!gj%ifg!gj%xtn
+ .priin,,.priou
+ block 3
+ point 7, defext
+ block 3
+ 3
+ block 2
+ point 7, [asciz /*/]
+
+minus1::
+zromsk: byte (7) 177, 177, 177, 177, 177 (1) 1
+ byte (7) 000, 177, 177, 177, 177 (1) 1
+ byte (7) 000, 000, 177, 177, 177 (1) 1
+ byte (7) 000, 000, 000, 177, 177 (1) 1
+ byte (7) 000, 000, 000, 000, 177 (1) 1
+
+crlf: byte (7) 15, 12, 0
+
+squozp: repeat "#"-0+1,<0> ; ^@ - #
+ repeat "%"-"$"+1,<-1> ; $ - %
+ repeat "-"-"&"+1,<0> ; & - -
+ repeat "."-"."+1,<-1> ; .
+ repeat "/"-"/"+1,<0> ; /
+ repeat "9"-"0"+1,<-1> ; 0 - 9
+ repeat "@"-":"+1,<0> ; : - @
+ repeat "Z"-"A"+1,<-1> ; A - Z
+ repeat "`"-"["+1,<0> ; [ - `
+ repeat "z"-"a"+1,<-1> ; a - z
+ repeat 177-"{"+1,<0> ; { - rubout
+
+ subttl Languages we know about
+
+;lang(language name, default extension, dispatch tag prefix)
+;The maximum length of the default extension is 5 characters.
+define langs
+ < lang(BLISS,BLI,BLI)
+ lang(BLISS11,B11,B11)
+ lang(FAIL,FAI,FAI)
+ lang(FORTRAN,FOR,FOR)
+ lang(H316,H16,H16)
+ lang(INTERLISP,ILSP,LSP)
+ lang(MACLISP,LSP,MCL)
+ lang(MACN11,M11,M11)
+ lang(MACRO,MAC,MAC)
+ lang(MIDAS,MID,MID)
+ lang(PAL11X,P11,P11)
+ lang(PSL,SL,SL) ; "Portable Standard Lisp" or "Standard Lisp"
+ lang(REDUCE,RED,RED) ; Reduce and Rlisp files.
+ lang(SAIL,SAI,SAI)
+ lang(SCRIBE,MSS,SCR)
+ lang(TECO,EMACS,TEC)
+ >
+
+; Indexes for languages
+define lang ' (x,y,z)
+ < lt.'z __ nlangs
+ nlangs __ nlangs+1
+ >
+nlangs __ 0
+langs
+
+; Table of filename extensions
+define lang ' (x,y,z)
+ < <asciz /y/>
+ >
+
+langex: langs
+
+; Table of language names
+define lang(x,y,z)
+ < [asciz /x/]
+ >
+
+langtb: langs
+
+; Table of dispatch routines for them
+define lang ' (x,y,z)
+ < z'lin
+ >
+
+langds: langs
+
+ subttl Hairy string macro
+
+; Reset string
+define strini (str)
+ { define str {0,}
+ }
+
+define strcn1 ' (str,str2,dummy,str1)
+ { define str {0,str1'str2}
+ }
+
+; Add str2 to str1's current value
+define strcnc (str1,str2)
+ { strcn1 (str1,str2,\str1)
+ }
+
+define strget ' (ac,cond,dummy,str)
+ { ifdif {str},{},{cam'cond ac, [ascii /str/]}
+ ifidn {str},{},{cai'cond ac, 0}
+ }
+
+; Get the resultant string
+define strevl (ac,cond,str)
+ { strget (ac,cond,\str)
+ }
+
+; Go to jmp if string in s and s1 matches str
+; Or if jmp not spec, return unless matches
+define strmat (str, jmp)
+ { strini(str1)
+ strini(str2)
+ strcnt __ 0
+ for char e {str}
+ { ifl strcnt-5,{ strcnc(str1,char)}
+ ifge strcnt-5,{ strcnc(str2,char)}
+ strcnt __ strcnt+1
+ }
+ purge strcnt
+ strevl(s,n,str1)
+ strevl(s1,e,str2)
+ ifidn {jmp},{},{ret}
+ ifdif {jmp},{},{caia
+ jrst jmp}
+ }
+
+ subttl Main program
+
+go: reset
+ setzb f, nfiles
+ move p, [iowd npdl, pdl]
+ call dorscn ; Check for filename in rscan line
+ call filini ; Get output file
+ hrroi 1, [asciz / Type filenames, end with blank line
+/]
+ trnn f, f%oldf
+ psout ; Unless using old file, give prompt
+ setzm injfn ; Make sure we dont thing there's a file
+floop: call nxtfil ; Get the next file to do
+ jrst done ; All done
+ call inifil ; Set up to start this file
+lloop: call nxtlin ; Get the next line
+ jrst lloopf ; End of this file
+ call @langds(l) ; Do this line
+ jrst lloop
+lloopf: call finfil ; Finish up this file
+ jrst floop
+
+done: call finish ; Finish up the output tags file
+ haltf
+ jrst go
+
+ subttl Top level subroutines
+
+; Get command line
+dorscn: trz f, f%oldf ; Clear out flag
+t20,< setz 1,
+ rscan
+ tdza 1, 1
+ jumpe 1, cpopj ; No command line
+ movni 3, (1)
+ movei 1, .cttrm
+ hrroi 2, strbuf
+ sin ; Read command line
+ move bp, [point 7, strbuf]
+dorsc1: ildb 1, bp
+ cain 1, 12 ; EOL?
+ ret ; Yes, return to get from tty
+ caie 1, " " ; Space?
+ jrst dorsc1 ; No, keep going
+>
+tnx,< movei 1, .priin
+ bkjfn
+ jfcl
+ pbin ; Get terminator of command line
+ caie 1, " "
+ ret ; Return if not space to get from tty
+>
+
+; Get file from command line
+t20,< dmove 1, [gj%old
+ .nulio,,.nulio]
+ dmovem 1, tagjfb
+ movei 1, tagjfb ; Default to .TAGS
+ move 2, bp
+>
+tnx,< movsi 1, (gj%old!gj%cfm!gj%msg)
+ movem 1, tagjfb
+ move 1, [.priin,,.priou]
+ movem 1, tagjfb+.gjsrc
+ movei 1, tagjfb
+ setz 2,
+>
+ gtjfn
+ jrst dorscx
+ move 2, [7b5+of%rd]
+ openf
+ jrst dorscx
+ movem 1, oldjfn ; And save jfn of old file
+ tro f, f%oldf
+ ret
+
+dorscx: call jerror ; Print jsys error message
+ haltf
+ jrst go
+
+; Set up output file
+filini: setzm defext ; Reset default extension
+ trne f, f%oldf ; If reparsing,
+ jrst filin2 ; Get next version of old file
+filin1: hrroi 1, [asciz / Output tags file: /]
+ psout
+t20,< dmove 1, [gj%fou!gj%cfm!gj%msg
+ .priin,,.priou]
+ dmovem 1, tagjfb
+>
+tnx,< movsi 1, (gj%fou!gj%cfm!gj%msg)
+ movem 1, tagjfb
+ move 1, [.priin,,.priou]
+ movem 1, tagjfb+.gjsrc
+>
+ movei 1, tagjfb
+ setz 2,
+ gtjfn
+ jrst filix1
+ move 2, [7b5+of%wr] ; Open for write
+ openf
+ jrst filix1
+ movem 1, tagjfn
+ ret
+
+filin2: hrroi 1, strbuf
+ move 2, oldjfn ; Name of old file
+ move 3, [111100,,1] ; DEV:<DIR>NAM.EXT (no gen number)
+ jfns
+ movsi 1, (gj%fou!gj%sht)
+ hrroi 2, strbuf
+ gtjfn
+ jrst filix2
+ move 2, [7b5+of%wr]
+ openf
+ jrst filix2
+ movem 1, tagjfn
+ ret
+
+filix1: call jerror
+ jrst filin1 ; Try again
+
+filix2: call jerror
+ haltf
+ jrst filini
+
+; Get the next file to process
+nxtfil: trne f, f%oldf ; If from old file
+ jrst nxtfl2 ; Read next one from that file
+nxtfl0: skipe 1, injfn ; See if more in this filespec
+ gnjfn
+ jrst nxtfl1 ; Nope
+ andi 1, -1
+ move 2, [7b5+of%rd]
+ openf
+ jrst nxtfl0
+ aos (p) ; Will skip return
+ trne f, f%lgvn ; If got language from user with /,
+ ret ; Use it again, else
+ jrst nxtf1e ; Try to match from extension
+nxtfl1: movei 1, "*"
+ pbout ; Prompt
+ movei 1, defjfb ; String with last default in it
+ setz 2,
+ gtjfn
+ jrst nxtfx1
+ movem 1, injfn
+ andi 1, -1
+ move 2, [7b5+of%rd]
+ openf
+ jrst nxtfx1
+ aos (p) ; Will skip return
+ trz f, f%lgvn ; Reset language from user flag
+ movei 1, .priin ; Get confirming char
+ bkjfn
+ ret
+ pbin
+ caie 1, "/" ; Was it a slash?
+ jrst nxtf1e ; No, get language from extension
+ tro f, f%lgvn ; Say language was given by user
+ jrst getlng ; Get language from user and return
+
+nxtf1e: setz s,
+ hrroi 1, s
+ hrrz 2, injfn
+ movsi 3, 000100 ; Just file type
+ jfns
+ movsi l, -nlangs ; Pointer for language options
+nxtf1f: came s, langex(l) ; Extension matches?
+ aobjn l, nxtf1f ; No, keep trying
+ jumpge l, getlnx ; If not found, go ask for it
+ ret ; Else return
+
+nxtfx1: cain 1, gjfx33 ; Filename not spec?
+ ret ; Yes, single return
+ call jerror
+ jrst nxtfl1
+
+
+nxtfl2: trne f, f%eoff ; EOF last time
+ ret ; Yes, single return this time then
+ aos (p) ; Else prepare for skip return
+ movsi 1, (gj%old!gj%fns!gj%sht)
+ movei 2, .nulio
+ hrl 2, oldjfn ; Source if old file
+ gtjfn
+ jrst nxtfx2
+ move 2, [7b5+of%rd]
+ openf
+ jrst nxtfx2
+ movem 1, injfn
+ move 1, oldjfn ; Find language type in file
+nxtf2a: bin
+ caie 2, "," ; Find the comma
+ jrst nxtf2a
+ setzm strbuf
+ setzm strbuf+1
+ hrroi 2, strbuf
+ movei 3, strbsz*5
+ movei 4, 15 ; Until CR
+ sin
+ setz 3,
+ dpb 3, 2 ; Mark end of line with null
+nxtf2b: bin
+ jumpe 2, nxtf2z ; Maybe EOF
+ caie 2, 37 ; Find the ^_
+ jrst nxtf2b
+ bin
+ caie 2, 15 ; Followed by CRLF
+ jrst nxtf2b
+ bin
+ caie 2, 12
+ jrst nxtf2b
+ bin ; Peek next char
+ bkjfn
+ trn
+ skipn 2 ; See if EOF now
+nxtf2c: tro f, f%eoff ; Yes, say so
+ jrst getln2 ; Lookup language name
+
+nxtfx2: call jerror
+ haltf
+ jrst nxtfil
+
+nxtf2z: gtsts
+ tlnn 2, (gs%eof) ; EOF?
+ jrst nxtf2b ; No
+ jrst nxtf2c
+
+; Init variables for this file, etc.
+inifil: move 1, tagjfn ; Output file
+ rfptr ; Get current position
+ seto 2,
+ movem 2, hdrptr ; Save pointer to start of this header
+ hrrz 2, injfn
+ move 3, [111100,,1] ; DEV:<DIR>NAM.EXT
+ jfns
+t20,< hrroi 2, [asciz /.0
+00000,/]
+>
+tnx,< hrroi 2, [asciz /;0
+00000,/]
+>
+ setz 3,
+ sout
+ rfptr ; Get current position in file
+ seto 2,
+ subi 2, 6 ; Position just before 1st of 0's
+ movem 2, zroptr ; Save it for later
+ andi l, -1 ; Clear any index
+ hrro 2, langtb(l) ; Get language name
+ sout
+ hrroi 2, crlf
+ sout
+
+ setzb n, filptr ; Reset counters
+ setzm nchars
+ aos nfiles ; Count one more file
+cpopj: ret
+
+; Get the next line
+nxtlin: move 1, nchars ; Get number of chars from last time
+ addm 1, filptr ; Update current position in file
+ hrrz 1, injfn
+ hrroi 2, strbuf
+ movei 3, strbsz*5
+ movei 4, 12 ; Read till LF
+ sin
+ subi 3, strbsz*5 ; Get number of characters read
+ jumpe 3, cpopj ; None, EOF then
+ movnm 3, nchars ; Save number of characters read
+ move bp, [point 7, strbuf]
+cpopj1: aos (p)
+ ret ; Skip return
+
+; Finish up the current file
+finfil: move 1, tagjfn ; Output file
+ hrroi 2, [byte (7) 37, 15, 12, 0] ; ^_CRLF
+ setz 3,
+ sout
+ rfptr ; Get current position now
+ setz 2,
+ sub 2, hdrptr ; Less start of this block
+ push p, 2 ; Save it
+ move 2, zroptr ; Start of zero block
+ sfptr
+ error (SFPTR failed)
+ pop p, 2
+ move 3, [no%lfl+no%zro+5b17+=10] ; Size in decimal
+ nout
+ trn
+ seto 2, ; Back to then end now
+ sfptr
+ error (SFPTR failed)
+
+ hrrz 2, injfn
+ trne f, f%oldf ; If getting from the tty,
+ jrst finfl2
+ hrroi 1, defext
+ movsi 3, 000100 ; Set the default type for next time
+ jfns
+finfl2: movei 1, .priou ; Tell the user what is happenning
+ setz 3,
+ jfns
+ hrroi 2, [asciz / - /]
+ sout
+ movei 2, (n) ; Number of functions written
+ movei 3, =10
+ nout
+ trn
+ hrroi 1, [asciz /. functions found.
+/]
+ psout
+ addm n, nfunct ; Keep track of grand totals
+
+ move 1, injfn
+ tlnn 1, (gj%dev!gj%dir!gj%nam!gj%ext) ; Wildcards given?
+ tlza 1, -1 ; No, clear random bits
+ hrli 1, (co%nrj) ; Yes, keep the jfn then for next time
+ closf ; Done with the file
+ trn
+ ret
+
+; Finish up everything
+finish: movei 1, .priou
+ move 2, tagjfn ; Output file
+ setz 3,
+ jfns
+ hrroi 2, [asciz / - /]
+ sout
+ movei 3, =10
+ move 2, nfunct ; Number of functions done
+ nout
+ trn
+ hrroi 1, [asciz /. functions in /]
+ psout
+ movei 1, .priou
+ move 2, nfiles ; Number of files used
+ nout
+ trn
+ hrroi 1, [asciz /. files.
+/]
+ psout
+
+ move 1, tagjfn
+ closf ; Close the output file
+ trn
+ ret
+
+ subttl Lower level subroutines
+
+; Get the language type
+getlnx: hrroi 1, [asciz /? Language type not recognised
+ Please specify for /]
+ psout
+ movei 1, .priou
+ hrrz 2, injfn
+ setz 3,
+ jfns
+ hrroi 1, [asciz / : /]
+ psout
+getlng: hrroi 1, strbuf
+t20,< move 2, [rd%rai+rd%crf+strbsz*5]
+ setz 3,
+ rdtty
+ error (RDTTY failed)
+>
+tnx,< movei 2, strbsz*5
+ pstin
+>
+ andi 2, -1 ; Get number of chars used
+ subi 2, strbsz*5-1 ; Clear terminator too
+ movm 2, 2
+ idivi 2, 5 ; Get number of words used
+ move 3, zromsk(3)
+ andcam 3, strbuf(2)
+ setzm strbuf+1(2) ; Clear next word for good measure
+getln2:
+t20,< dmove s, strbuf ; Get first two words of string
+>
+tnx,< move s, strbuf
+ move s1, strbuf+1
+>
+ movsi l, -nlangs
+ camn s, [asciz /?/]
+ jumpe s1, getln5 ; Try to help the guy out if he asks
+getln3: hrrz 2, langtb(l)
+ came s, (2) ; First word matches?
+ jrst getln4 ; No
+ jumpe s1, cpopj ; If only one word, matched
+ camn s1, 1(2)
+ ret ; Found it.
+getln4: aobjn l, getln3
+ jrst getlnx ; Not found
+getln5: hrroi 1, [asciz / one of:
+/]
+ psout
+getln6: hrro 1, langtb(l)
+ psout
+ hrroi 1, crlf
+ psout
+ aobjn l, getln6
+ jrst getlnx
+
+; Write out line before the current LF
+outtlf: add bp, [7b5]
+ skipge bp
+ sub bp, [43b5+1]
+ ldb ch, bp ; Get char before LF
+ cain ch, 15 ; Is it CR?
+ add bp, [7b5] ; Yes, back over it too
+; Write out the beginning of the current line and the current position
+; To the tags output file
+outtag: setz 3,
+ idpb 3, bp ; Mark end with a null
+ move 1, tagjfn ; Output file
+ hrroi 2, strbuf
+ sout ; Write out start of line
+ movei 2, 177 ; And rubout
+ bout
+ movei 2, -strbuf(bp) ; Get number of words
+ imuli 2, 5 ; Into characters
+ ldb 3, [point 6, bp, 5] ; Get current position
+ idivi 3, 7
+ subi 3, 4
+ sub 2, 3 ; Get current position
+ add 2, filptr ; Make it absolute
+ movei 3, =10 ; Decimal
+ nout
+ trn
+ hrroi 2, crlf
+ setz 3,
+ sout ; And CRLF
+ aoj n, ; Count another one done
+ ret
+
+; Error handler
+uuoh: movei 1, "?"
+ pbout
+ hrro 1, 40
+ psout
+ haltf
+ ret
+
+; Print JSYS error message
+jerror: movei 1, "?"
+ pbout
+ movei 1, .priou
+ hrloi 2, .fhslf
+ setz 3,
+ erstr
+ trn
+ trn
+ hrroi 1, crlf
+ psout
+ ret
+
+ subttl Language dependant subroutines
+
+; Assembly language subroutines
+failin: m11lin: maclin: midlin: p11lin: h16lin:
+asmlin: setzb t, s
+asmln0: ildb ch, bp ; Get first character
+ cain ch, "L"-100 ; Allow formfeed
+ jrst asmln0
+ caie ch, "" ; For fail,
+ cain ch, "^" ; Allow arrows at start of line
+ caie l, lt.fai
+ jrst asmln2
+ jrst asmln0 ; So get another char
+asmln1: movei t, (ch) ; Save previous char
+ ildb ch, bp
+asmln2: skipe squozp(ch) ; Is this legal squoze char?
+ aoja s, asmln1 ; Yes, keep looking
+asmln3: caie ch, ":" ; If it's a : or
+ cain ch, "=" ; =,
+ jrst asmln4 ; We found one maybe
+ caie l, lt.fai ; For fail
+ cain l, lt.p11 ; Or pal11x,
+ caia
+ ret
+ cain ch, "_" ; Allow _ too
+ jrst asmln4
+ caie ch, 11 ; And tabs before the :'s
+ cain ch, " " ; Or spaces
+ caia
+ ret ; Else no tag here
+ ildb ch, bp ; Get another char and try it
+ jrst asmln3
+asmln4: caie l, lt.m11 ; For MACN11 ...
+ cain l, lt.p11 ; Or pal11x ...
+ jrst asmln6 ; Check for local labels
+asmln5: jumpe s, cpopj ; = isnt a label (as in =24 for fail)
+ cain t, "." ; If label is not just dot
+ caie s, 1
+ jrst outtag ; Found one
+ ret
+asmln6: move t, [point 7, strbuf] ; Start of line again
+asmln7: ildb ch, t
+ cain ch, "L"-100 ; Dont be confused by ff
+ jrst asmln7
+ cail ch, "0" ; See if it is a digit
+ caile ch, "9"
+ jrst asmln5 ; It isnt
+ ret ; It is, flush it
+
+; SCRIBE subroutine (null for now)
+scrlin: ret
+
+; TECO subroutine
+teclin: ildb ch, bp ; Get first character
+ caie ch, "!" ; Only lines starting with ! pass
+ ret
+ setz s, ; Reset found pointer
+tecln1: ildb ch, bp ; Get next character
+ cain ch, 12 ; End of line
+ jrst tecln2 ; Go see if we found anything
+ caie ch, ":" ; Must have had : just before a !
+ jrst tecln1
+ ildb ch, bp ; Get next char
+ cain ch, "!"
+ move s, bp ; If label, save the current pointer
+ jrst tecln1
+tecln2: skipn bp, s ; Get last label we had
+ ret ; None found
+ jrst outtag ; And output that many
+
+; SAIL subroutine
+sailin: call ratom ; Get the first word
+ strmat SIMPLE, sailin
+ strmat RECURSIVE, sailin
+ strmat BOOLEAN, sailn3
+ strmat INTEGER, sailn3
+ strmat REAL, sailn3
+ strmat STRING, sailn3
+sailn1: strmat PROCEDURE
+ setz s, ; Reset paren level
+sailn2: ildb ch, bp ; Get a char
+ cain ch, 12 ; If end of line
+ jrst outtlf ; Write the whole line then
+ cain ch, "(" ; Count one more left paren
+ aoja s, sailn2
+ cain ch, ")" ; Count one less paren
+ soja s, sailn2
+ cain ch, ";" ; Now, if to the ;
+ jumple s, outtag ; Output it if not inside parens
+ jrst sailn2 ; Else keep going
+
+sailn3: call ratom ; Get another word
+ jrst sailn1 ; And try it
+
+; Bliss subroutines
+b11lin:
+blilin: call ratom ; Get word
+ strmat GLOBAL, bliln3
+bliln1: strmat ROUTINE, bliln2
+ caie l, lt.bli ; Bliss-10 has FUNCTIONS too
+ ret ; Not a function decl
+ strmat FUNCTION
+bliln2: ildb ch, bp ; Get chars
+ caie ch, "=" ; Until =
+ cain ch, 12 ; Or end of this line
+ jrst outtag
+ jrst bliln2
+bliln3: call ratom
+ jrst bliln1
+
+; Fortran subroutine
+forlin: call ratom ; Get a word
+ strmat PROGRAM,forln1
+ strmat SUBROUTINE,forln1
+ strmat DOUBLE,forln6
+forln4: strmat INTEGER,forln7
+ strmat REAL,forln7
+ strmat COMPLEX,forln7
+forln5: strmat FUNCTION
+forln1: ildb ch, bp ; Get a character
+ cain ch, 12 ; If eol here,
+ jrst outtlf ; Use whole line
+ caie ch, "(" ; Look for start of args
+ jrst forln1
+forln2: movei s, 1 ; Init paren level
+forln3: ildb ch, bp ; Get character
+ cain ch, 12 ; If eol,
+ jrst outtlf ; Write whole line
+ cain ch, "(" ; Keep track of paren level
+ aoja s, forln3
+ cain ch, ")" ; And look for matching close
+ sojle s, outtag
+ jrst forln3
+forln6: call ratom
+ jrst forln4
+forln7: call ratom
+ jrst forln5
+
+; MACLISP subroutines
+mcllin:
+for zot e {(DEF} ; Do all lines that begin with (DEF
+ {
+ ildb ch, bp
+ caie ch, "zot"
+ ifg "zot"-100,{
+ cain ch, "zot"+40
+ caia
+ }
+ ret
+ }
+ movei u, 1
+mclln1: ildb ch, bp
+ cain ch, 12
+ jrst outtlf
+ caie ch, " "
+ jrst mclln1
+ sojge u, mclln1
+ jrst outtag
+
+; INTERLISP routines
+lsplin: skipe indefq ; Already inside a DEFINEQ?
+ jrst lspln1 ; Yes, see if this is a new form
+ call ratom ; Else get the beginning of the line
+ strmat {(DEFINEQ} ; And try for start of new one
+ setom indefq ; Remember are inside one
+ setzm nparen ; And initialize paren depth
+ move t, [iowd 100, parpdl] ; Initialise bracket pdl
+lspln0: movem t, parpdp
+lspln1: ildb ch, bp ; Get next character
+ cain ch, 12 ; End of line?
+ ret
+ cain ch, "%" ; Char quoted?
+ jrst [ildb ch, bp ; Yes, just gobble one
+ jrst lspln1]
+ cain ch, "[" ; Super open paren
+ jrst lspln4
+ cain ch, "]" ; Super close
+ jrst lspln5
+ cain ch, "(" ; Go down a level
+ jrst lspln2
+ cain ch, ")" ; Close one level of parens
+ sosl nparen ; And see if this finishes the DEFINEQ
+ jrst lspln1 ; Doesnt, get next character
+ setzm indefq ; No longer inside a DEFINEQ
+ ret ; Rest of this line no good to us
+lspln4: exch t, parpdp ; [ - save the curren paren depth
+ push t, nparen
+ exch t, parpdp ; And fall thru for one more open
+lspln2: aos t, nparen
+ caie t, 1 ; Start of a new definition within the defineq?
+ jrst lspln1 ; No, keep trying
+lspln3: ildb ch, bp ; Get next character
+ cain ch, 12 ; End of line is end of atom of functions name
+ jrst outtlf
+ cain ch, " " ; Or a space also
+ jrst outtag ; Yes, output this line then
+ jrst lspln3 ; Keep looking
+lspln5: move t, parpdp ; ] - restore from last ]
+ pop t, nparen
+ jrst lspln0 ; And continue
+
+; PSL routines
+; Portable Standard Lisp (PSL) handler (simple minded version). Also
+; handles other Utah flavors of Lisp.
+sllin: call ratom
+ strmat {(DE},sl1 ; Look for one of "(DE", (Define Expr),
+ strmat {(DF},sl1 ; "(DF", (Define Fexpr),
+ strmat {(DM},sl1 ; "(DM", (Define Macro),
+ strmat {(DN},sl1 ; "(DN", (Define Nexpr),
+ strmat {(DS},sl1 ; "(DS", (Define Substitution Macro),
+ strmat {(DEFUN},sl1 ; "(DEFUN", (Define Expr),
+ strmat {(DEFVAR},sl1 ; "(DEFVAR", (Define fluid variable),
+ strmat {(DEFCONST},sl1 ; "(DEFCONST", (Define constant),
+ strmat {(LAP},sl1 ; "(LAP", ("Lisp Assembler Program"?)
+ ; Might be better to look for "!*entry" ?
+ strmat {(DEFMACRO},sl1 ; "(DEFMACRO", (an alternate way to define
+ ; macros)
+ strmat {(DEFFLAVOR},sl1 ; "(DEFFLAVOR", (Define Flavor),
+ strmat {(DEFMETHOD} ; "(DEFMETHOD", (Define Method)
+
+sl1: ; Write the tag out
+ ildb ch, bp ; Scan for end of line.
+ cain ch, 12 ; (I.e. End of Line)
+ jrst outtlf ; Write the line if EOL seen
+ jrst sl1 ; Keep looping till found
+
+; REDUCE subroutine
+redlin: call Satom ; Get the first word
+ strmat SYMBOLIC, redlin ; ftypes (of REDUCE)
+ strmat ALGEBRAIC, redlin
+ strmat BOOLEAN, redlin
+ strmat INTEGER, redlin
+ strmat FEXPR, redlin
+ strmat EXPR, redlin
+ strmat LISP, redlin
+ strmat MACRO, redlin
+ strmat SMACRO, redlin
+ strmat NMACRO, redlin
+ strmat SYSLSP, redlin
+
+ strmat LAP, redn2 ; Might be better to look for !*entry ?
+ strmat MODE, redn2
+ strmat GLOBAL, redn1
+redn1: strmat PROCEDURE
+ setz s, ; Reset paren level
+ jrst sailn2
+
+redn2: ildb ch,bp ; get chars
+ cain ch,"=" ; Until =
+ jrst outtag
+ cain ch,12 ; or until the end of line
+ jrst outtlf
+ jrst redn2
+
+
+; A hacked-up version of ratom to allow reading "RECORD!POINTER"
+; Read the next word into s and s1
+Satom: ildb ch, bp ; Get a character
+ cain ch, 12 ; If end of line here
+ jrst Satom3 ; Return to callers caller
+ caie ch, " " ; Flush white space
+ cain ch, 11
+ jrst Satom
+ cain ch, "L"-100 ; Or ff
+ jrst Satom
+ setzb s, s1
+ move t, [point 7, s]
+ movei u, =10 ; Max number of chars
+Satom1: caie ch, "!"
+ cain ch, ""
+ jrst satom ; Start over if "!" or "^X"
+ cail ch, "a"
+ caile ch, "z"
+ caia
+ trz ch, "a"-"A" ; Uppercase it
+ idpb ch, t
+ ildb ch, bp
+ cain ch, "("
+ movei ch, " " ; Change "(" to space
+ caile ch, " " ; Until terminator
+ sojg u, Satom1
+ jumple u, Satom3 ; Too long for us
+ add bp, [7b5] ; Back up over teminator
+ ret ; And return
+Satom3: pop p, garb# ; Flush callers return
+ ret ; And return to callers caller
+
+; Read the next word into s and s1
+ratom: ildb ch, bp ; Get a character
+ cain ch, 12 ; If end of line here
+ jrst ratom3 ; Return to callers caller
+ caie ch, " " ; Flush white space
+ cain ch, 11
+ jrst ratom
+ cain ch, "L"-100 ; Or ff
+ jrst ratom
+ setzb s, s1
+ move t, [point 7, s]
+ movei u, =10 ; Max number of chars
+ratom1: cail ch, "a"
+ caile ch, "z"
+ caia
+ trz ch, "a"-"A" ; Uppercase it
+ idpb ch, t
+ ildb ch, bp
+ caile ch, " " ; Until terminator
+ sojg u, ratom1
+ jumple u, ratom3 ; Too long for us
+ add bp, [7b5] ; Back up over teminator
+ ret ; And return
+ratom3: pop p, garb# ; Flush callers return
+ ret ; And return to callers caller
+
+; Local modes:
+; Mode: FAIL
+; Comment col:40
+; Comment start:;
+; End:
+
+ end go
ADDED psl-1983/20-kernel/test-psl-link.ctl
Index: psl-1983/20-kernel/test-psl-link.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/test-psl-link.ctl
@@ -0,0 +1,42 @@
+cd S:
+define DSK:, DSK:, P20:
+LINK
+/nosymbol
+nil.rel
+/set:.low.:202
+types.rel
+randm.rel
+alloc.rel
+arith.rel
+debg.rel
+error.rel
+eval.rel
+extra.rel
+fasl.rel
+io.rel
+macro.rel
+prop.rel
+symbl.rel
+sysio.rel
+tloop.rel
+main.rel
+heap.rel
+dtypes.rel
+drandm.rel
+dalloc.rel
+darith.rel
+ddebg.rel
+derror.rel
+deval.rel
+dextra.rel
+dfasl.rel
+dio.rel
+dmacro.rel
+dprop.rel
+dsymbl.rel
+dsysio.rel
+dtloop.rel
+dmain.rel
+dheap.rel
+/save s:bpsl.exe
+/go
ADDED psl-1983/20-kernel/timc.red
Index: psl-1983/20-kernel/timc.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/timc.red
@@ -0,0 +1,18 @@
+%
+% TIMC.RED - get run time in milliseconds
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 1 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+lap '((!*entry TimC expr 0)
+ (!*MOVE (WConst -5) (reg 1))
+ (runtm)
+ (!*EXIT 0)
+);
+
+end;
ADDED psl-1983/20-kernel/tloop.ctl
Index: psl-1983/20-kernel/tloop.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/tloop.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "tloop";
+in "tloop.build";
+ASMEnd;
+quit;
+compile tloop.mac, dtloop.mac
+delete tloop.mac, dtloop.mac
ADDED psl-1983/20-kernel/tloop.init
Index: psl-1983/20-kernel/tloop.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/tloop.init
@@ -0,0 +1,14 @@
+(FLUID (QUOTE (!*BREAK !*QUITBREAK BREAKEVAL!* BREAKNAME!* BREAKVALUE!*
+ERRORFORM!* BREAKLEVEL!* MAXBREAKLEVEL!* TOPLOOPNAME!* TOPLOOPEVAL!*
+TOPLOOPREAD!* TOPLOOPPRINT!* !*DEFN BREAKIN!* BREAKOUT!*)))
+(DEFLIST (QUOTE ((Q BREAKQUIT) (!? HELPBREAK) (A RESET) (M BREAKERRMSG) (E
+BREAKEDIT) (C BREAKCONTINUE) (R BREAKRETRY) (I INTERPBACKTRACE) (V
+VERBOSEBACKTRACE) (T BACKTRACE))) (QUOTE BREAKFUNCTION))
+(FLUID (QUOTE (TOPLOOPREAD!* TOPLOOPPRINT!* TOPLOOPEVAL!* TOPLOOPNAME!*
+TOPLOOPLEVEL!* HISTORYCOUNT!* HISTORYLIST!* PROMPTSTRING!* LISPBANNER!*
+!*EMSGP !*BACKTRACE !*TIME GCTIME!* !*DEFN DFPRINT!* !*OUTPUT SEMIC!* !*NONIL
+INITFORMS!*)))
+(FLUID (QUOTE (!*BREAK)))
+(PUT (QUOTE HIST) (QUOTE TYPE) (QUOTE NEXPR))
+(FLAG (QUOTE (DSKIN)) (QUOTE IGNORE))
+(FLUID (QUOTE (!*REDEFMSG !*ECHO)))
ADDED psl-1983/20-kernel/tloop.log
Index: psl-1983/20-kernel/tloop.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/tloop.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/tloop.rel
Index: psl-1983/20-kernel/tloop.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/tloop.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/trap.red
Index: psl-1983/20-kernel/trap.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/trap.red
@@ -0,0 +1,1 @@
+end;
ADDED psl-1983/20-kernel/types.ctl
Index: psl-1983/20-kernel/types.ctl
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/types.ctl
@@ -0,0 +1,8 @@
+define DSK: DSK:, P20:, PI:
+S:DEC20-CROSS.EXE
+ASMOut "types";
+in "types.build";
+ASMEnd;
+quit;
+compile types.mac, dtypes.mac
+delete types.mac, dtypes.mac
ADDED psl-1983/20-kernel/types.init
Index: psl-1983/20-kernel/types.init
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/types.init
@@ -0,0 +1,2 @@
+(PUT (QUOTE STRING) (QUOTE TYPE) (QUOTE NEXPR))
+(PUT (QUOTE VECTOR) (QUOTE TYPE) (QUOTE NEXPR))
ADDED psl-1983/20-kernel/types.log
Index: psl-1983/20-kernel/types.log
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/types.log
cannot compute difference between binary files
ADDED psl-1983/20-kernel/types.rel
Index: psl-1983/20-kernel/types.rel
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/types.rel
cannot compute difference between binary files
ADDED psl-1983/20-kernel/write-float.red
Index: psl-1983/20-kernel/write-float.red
==================================================================
--- /dev/null
+++ psl-1983/20-kernel/write-float.red
@@ -0,0 +1,45 @@
+%
+% WRITE-FLOAT.RED - format a floating point number into a string
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 26 November 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL-20>WRITE-FLOAT.RED.3, 28-Sep-82 15:44:53, Edit by BENSON
+% Changed DMOVE to 2 moves, so this will run on a KI10 Tenex
+
+lap '((!*entry WriteFloat expr 2) % convert float to string
+%
+% r1 is string pointer, r2 is pointer to 2 word float
+% puts characters in string buffer with terminating null char and count
+%
+ (!*MOVE (reg 1) (reg t1)) % save pointer to string count
+ (!*WPLUS2 (reg 1) (WConst 1)) % move to chars
+ (hrli (reg 1) 8#440700) % make r1 a byte pointer
+ (!*MOVE (reg 1) (reg t2)) % save starting byte pointer
+ (move (reg 3) (Indexed (reg 2) 1)) % load r2 and r3 with the number
+ (move (reg 2) (Indexed (reg 2) 0))
+ (move (reg 4) (lit (fullword 2#000010100000001000000000010000000000)))
+ % fl%one + fl%pnt + 16 fl%rnd
+ (dfout)
+ (!*JUMP (Label Error))
+ (!*MOVE (WConst -1) (reg 4)) % count := -1
+Count
+ (!*JUMPEQ (Label DoneCounting) (reg 1) (reg t2)) % byte pointers equal?
+ (ibp (reg t2))
+ (aoja (reg 4) Count) % Count := Count + 1
+DoneCounting
+ (!*MOVE (reg 4) (MEMORY (reg t1) (WConst 0))) % deposit count
+ (!*MOVE (WConst 0) (reg 2))
+ (idpb (reg 4) (reg 1)) % deposit null byte
+ (!*EXIT 0)
+Error
+ (!*MOVE (QUOTE "Couldn't print float") (reg 1))
+ (!*JCALL IOError)
+);
+
+END;
ADDED psl-1983/20-tests/20-test-global-data.red
Index: psl-1983/20-tests/20-test-global-data.red
==================================================================
--- /dev/null
+++ psl-1983/20-tests/20-test-global-data.red
@@ -0,0 +1,43 @@
+% 20-TEST-GLOBAL-DATA - Data used by everyone, test version
+%
+% Author: Eric Benson, M Griss, S Lowder
+% Computer Science Dept.
+% University of Utah
+% Date: 1 September 1981
+% Copyright (c) 1981 University of Utah
+
+on SysLisp;
+
+% For testing with MAINn, see P20T:XXX-HEADER.RED
+% Want a small SYMTAB and HEAP
+
+exported WConst MaxSymbols = 1000,
+ MaxChannels = 31,
+ MaxObArray = 1000,
+ MaxRealRegs = 5,
+ MaxArgs = 15;
+
+% BitPositions for testing, etc:
+
+exported Wconst BitsPerWord=36;
+
+% The STACK stuff
+external WVAR ST, StackLowerBound, StackUpperBound;
+
+% "standard" Symbol table Data structures, handled
+% specially in Compiler
+
+external Warray Symnam,SymVal,SymFnc,SymPrp;
+external WVar NextSymbol;
+
+% For extra arguments not in Real registers
+external WArray ArgumentBlock;
+
+% For the Foreign Function Calling Protocol
+
+external Wvar Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,
+ Arg10,Arg11,Arg12,Arg13,Arg14,Arg15;
+
+off SysLisp;
+
+END;
ADDED psl-1983/20-tests/20-test.output
Index: psl-1983/20-tests/20-test.output
==================================================================
--- /dev/null
+++ psl-1983/20-tests/20-test.output
@@ -0,0 +1,259 @@
+@@ex @@main1
+LINK: Loading
+[LNKXCT MAIN1 execution]
+Call on Init
+AB
+9
+10
+8
+90
+7
+720
+6
+5040
+5
+30240
+4
+151200
+3
+604800
+2
+1814400
+1
+3628800
+3628800
+
+Ctime: 98662 ms, 98662 ms
+
+
+Ctime: 99412 ms, 750 ms
+
+
+Ctime: 99450 ms, 38 ms
+ 7
+
+Ctime: 99913 ms, 463 ms
+
+Quitting
+@NEWPAGE()
+@@ex @@main2
+LINK: Loading
+[LNKXCT MAIN2 execution]
+Call on Init
+StrInf
+55688 55688
+Strlen
+51 51
+Byte
+0 65 A
+1 97 a
+2 66 B
+3 98 b
+4 67 C
+5 99 c
+6 68 D
+7 100 d
+8 69 E
+9 101 e
+10 70 F
+String
+AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUnVvWwXxYyZz
+"----- Now input characters until #"
+
+11223344556677
+
+aaaabbbbccddeeffgg
+
+#"----- First Print Called"
+1
+ANATOM
+(1 . 2)
+(AA (B1 . B2 ) . B3 )
+(AA (B1 ) )
+
+Quitting
+@NEWPAGE()
+@@ex @@main3
+LINK: Loading
+[LNKXCT MAIN3 execution]
+Call on Init
+"MAIN3: Casetest"
+Test case from -1 to 11
+Will classify argument
+Show for N=-1, expect default case
+Show for N=0, expect 0 case
+Show for N=1, expect 1,2,3 case
+Show for N=2, expect 1,2,3 case
+Show for N=3, expect 1,2,3 case
+Show for N=4, expect default case
+Show for N=5, expect default case
+Show for N=6, expect 6 ... 10 case
+Show for N=7, expect 6 ... 10 case
+Show for N=8, expect 6 ... 10 case
+Show for N=9, expect 6 ... 10 case
+Show for N=10, expect 6 ... 10 case
+Show for N=11, expect default case
+Show for N=12, expect default case
+"MAIN3: test CONS"
+(2 . 1)
+(3 2 . 1)
+(4 3 2 . 1)
+(5 4 3 2 . 1)
+(6 5 4 3 2 . 1)
+(7 6 5 4 3 2 . 1)
+(8 7 6 5 4 3 2 . 1)
+(9 8 7 6 5 4 3 2 . 1)
+
+Quitting
+@NEWPAGE()
+@@ex @@main4
+LINK: Loading
+[LNKXCT MAIN4 execution]
+1. --- Test EQSTR
+----- For EqStr(AB,AB) T should be T OK ------
+----- For EqStr(AB,AB) T should be T OK ------
+----- For EqStr(AB,Ab) NIL should be NIL OK ------
+----- For EqStr(AB,ABC) NIL should be NIL OK ------
+2. --- Test FindId on existing ID's
+Lookup string="A"
+Found In LookUpId=65
+----- For FindId(A) A should be A OK ------
+Lookup string="AB"
+Found In LookUpId=190
+----- For FindId(AB) AB should be AB OK ------
+3. --- Test FindId on new ID, make sure same place
+Lookup string="ABC"
+Not Found in LookupId
+New ID# 192
+Lookup string="ABC"
+Found In LookUpId=192
+----- For FindId(ABC) ABC should be ABC OK ------
+Lookup string="FOO"
+Not Found in LookupId
+New ID# 193
+Lookup string="ABC"
+Found In LookUpId=192
+----- For FindId(ABC) again ABC should be ABC OK ------
+4. --- Test RATOM loop. Type various ID's, STRING's and INTEGER's
+ Move to next part of test by typing the id Q
+ Inspect printout carefully
+NextSymbol =194
+1
+Item read= <0:1> 1
+"123"Item read= <4:5890> "123"
+A
+Lookup string="A"
+Found In LookUpId=65
+Item read= <30:65> A
+a
+Lookup string="a"
+Found In LookUpId=97
+Item read= <30:97> a
+AA
+Lookup string="AA"
+Not Found in LookupId
+New ID# 194
+Item read= <30:194> AA
+aa
+Lookup string="aa"
+Not Found in LookupId
+New ID# 195
+Item read= <30:195> aa
+abc
+Lookup string="abc"
+Not Found in LookupId
+New ID# 196
+Item read= <30:196> abc
+ABC
+Lookup string="ABC"
+Found In LookUpId=192
+Item read= <30:192> ABC
+abc
+Lookup string="abc"
+Found In LookUpId=196
+Item read= <30:196> abc
+Q
+Lookup string="Q"
+Found In LookUpId=81
+Item read= <30:81> Q
+5. --- Test READ loop. Type various S-expressions
+ Move to next part of test by typing the id Q
+ Inspect printout carefully
+'A
+ Item read= <9:5912> (QUOTE A )
+(12 '(34) (5 (6))) Item read= <9:5930> (12 (QUOTE (34) ) (5 (6) ) )
+
+Q
+ Item read= <30:81> Q
+
+Quitting
+@NEWPAGE()
+@@ex @@main5
+LINK: Loading
+[LNKXCT MAIN5 execution]
+(very) MINI-PSL: A Read-Eval-Print Loop, terminate with Q
+1 lisp> 1
+
+1
+2 lisp> 'A
+
+A
+3 lisp> (SETQ A 3)
+3
+4 lisp> A
+
+3
+5 lisp> (PRINT (CONS A A))
+(3 . 3)
+(3 . 3)
+6 lisp> (QUIT)
+
+Quitting
+@NEWPAGE()
+@@ex @@main6
+LINK: Loading
+%LNKFTH Fullword value RESET being truncated to halfword
+%LNKMDS Multiply-defined global symbol RESET
+ Detected in module .MAIN from file DSK:SUB6.REL
+ Defined value = 104000000147, this value = 163306
+[LNKXCT MAIN6 execution]
+Test BINDING Primitives
+----- For 3rd bound AA 3 should be 3 OK ------
+----- For 2rd bound AA NIL should be NIL OK ------
+----- For Original AA 1 should be 1 OK ------
+MINI-PSL: A Read-Eval-Print Loop, terminate with Q
+1 lisp> (DE FOO (X) (COND ((NULL X) 2) (T 3)))
+FOO
+2 lisp> (FOO NIL)
+2
+3 lisp> (FOO 2)
+3
+4 lisp> (DF E (TIM) (TIMEEVAL TIM))
+E
+5 lisp> (TESTSETUP)
+(SETQ FOO (CADR (QUOTE (1 2 3) ) ) )
+6 lisp> (E EMPTYTEST 10000)
+
+Ctime: 118090 ms, 118090 ms
+
+Ctime: 118127 ms, 37 ms
+ 37
+7 lisp> (E SLOWEMPTYTEST 10000)
+
+Ctime: 118259 ms, 132 ms
+
+Ctime: 118413 ms, 154 ms
+ 154
+8 lisp> (E LISTONLYCDRTEST1)
+
+Ctime: 118534 ms, 121 ms
+
+Ctime: 120275 ms, 1741 ms
+ 1741
+9 lisp> (FUM)
+ **** Uncompiled function in APPLY: FUM NIL
+NIL
+10 lisp> (QUIT)
+
+Quitting
+
ADDED psl-1983/20-tests/20io.mac
Index: psl-1983/20-tests/20io.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/20io.mac
@@ -0,0 +1,81 @@
+; 20IO: simple 20 Support routines
+TITLE 20IO
+SEARCH MONSYM
+RADIX ^D10
+ENTRY GETC20,PUTC20,INIT20,QUIT20,TIMC20,ERR20,PUTI20
+
+ST=15
+INIT20: HRROI 1,[Asciz/
+Call on Init
+/]
+ PSOUT
+ JFCL
+ POPJ ST,0
+
+GETC20: PBIN
+ JFCL
+ POPJ ST,0
+
+PUTC20: PBOUT
+ JFCL
+ CAIE 1,10 ; Is it EOL
+ POPJ ST,0 ; No
+ MOVEI 1,13
+ PBOUT
+ JFCL
+ MOVEI 1,10
+ POPJ ST,0
+
+PUTI20: MOVEM 1,JUNK
+ MOVE 2,1
+ MOVEI 1,^O101
+ MOVEI 3,^D10
+ NOUT
+ JFCL
+ MOVE 1,JUNK
+ POPJ ST,0
+
+ERR20: MOVEM 1,Junk
+ HRROI 1,[ASCIZ/
+*** ERR20: /]
+ PSOUT
+ MOVE 1,Junk
+ PUSHJ ST,PUTI20
+ MOVEI 1,10
+ PBOUT
+ HALTF
+ HALTF
+ POPJ ST,0
+
+Junk: Block 1
+
+QUIT20: Hrroi 1,[ASCIZ/
+Quitting
+/]
+ PSOUT
+ HALTF
+
+TIMC20: MOVEI 1,-5
+ RUNTM
+ JFCL
+ MOVEM 1,NTIME
+; Hrroi 1,[ASCIZ/
+;Ctime: /]
+; PSOUT
+; MOVE 1,NTIME
+; PUSHJ ST,PutI20
+; Hrroi 1,[ASCIZ/ ms, /]
+; PSOUT
+ MOVE 1,NTIME
+; SUB 1,OTIME
+; PUSHJ ST,PutI20
+; Hrroi 1,[ASCIZ/ ms
+; /]
+; PSOUT
+ MOVE 1,NTIME
+ MOVEM 1,OTIME
+ POPJ ST,0
+Otime: 0
+Ntime: 0
+ END
+
ADDED psl-1983/20-tests/20io.rel
Index: psl-1983/20-tests/20io.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/20io.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/20main.mac
Index: psl-1983/20-tests/20main.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/20main.mac
@@ -0,0 +1,15 @@
+; 20-main: simple driver to test MACRO version of 20 tests
+TITLE MAIN
+SEARCH MONSYM
+RADIX ^D10
+EXTERN INIT20,MAIN20,QUIT20
+
+ST=15
+MAIN: RESET
+ MOVE ST,[-1000,Stack]
+ PUSHJ ST,INIT20
+ PUSHJ ST,MAIN20
+ PUSHJ ST,QUIT20
+
+stack: block 1000
+ END MAIN
ADDED psl-1983/20-tests/20test.mac
Index: psl-1983/20-tests/20test.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/20test.mac
@@ -0,0 +1,57 @@
+; 20-TEST SIMPLE I/O TESTS, HANDCODED
+TITLE 20TEST
+; MLG, 20 JULY 1982
+
+SEARCH MONSYM
+RADIX ^D10
+EXTERN GETC20,PUTC20,PUTI20,ERR20,TIMC20,QUIT20
+ENTRY MAIN20
+ST=15
+MAIN20: MOVEI 1,1
+ PUSHJ ST, PUTI20 ; Print a 1 for first test
+ MOVEI 1,10
+ PUSHJ ST, PUTC20 ; EOL to flush line
+
+ MOVEI 1,2
+ PUSHJ ST, PUTI20 ; Second test
+ MOVEI 1,65
+ PUSHJ ST, PUTC20 ; A capital A
+ MOVEI 1,66
+ PUSHJ ST, PUTC20 ; A capital B
+ MOVEI 1,10
+ PUSHJ ST, PUTC20 ; EOL to flush line
+
+ MOVEI 1,3
+ PUSHJ ST, PUTI20 ; Third test, type in AB <cr>
+ PUSHJ ST, GETC20
+ PUSHJ ST, PUTC20 ; Should print A65
+ PUSHJ ST, PUTI20
+ MOVEI 1,10
+ PUSHJ ST,PUTC20
+
+ PUSHJ ST, GETC20
+ PUSHJ ST, PUTC20 ; Should print B66
+ PUSHJ ST, PUTI20
+ MOVEI 1,10
+ PUSHJ ST,PUTC20
+
+ PUSHJ ST, GETC20
+ PUSHJ ST, PUTI20 ; should print 10 and EOL
+ PUSHJ ST, PUTC20
+ MOVEI 1,10
+ PUSHJ ST,PUTC20
+
+ movei 1,4
+ pushj st, puti20 ; last test
+ Pushj st,timc20
+ PushJ st, puti20
+
+ movei 1,100
+ pushj st, err20
+
+ movei 1,26
+ pushj st, putc20 ; eof to flush buffer
+ movei 1,0
+ pushj st, quit20
+ POPJ ST,
+ END
ADDED psl-1983/20-tests/dec20-patches.sl
Index: psl-1983/20-tests/dec20-patches.sl
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dec20-patches.sl
@@ -0,0 +1,118 @@
+% DEC20-PATCHES.SL
+% to convert to Portable, 2 reg for LINK model
+% From DEC20-Asm.RED
+% These will now be simpler than 20, just JRST
+% Should even be InternalEntry for efficiency, avoid circular defns
+% Right now, expect same as !%Store!-JCALL would install
+
+(SETQ UndefinedFunctionCellInstructions!*
+ '((!*JCALL UndefinedFunction)))
+
+(SETQ LambdaFunctionCellInstructions!*
+ '((!*JCALL CompiledCallingInterpreted)))
+
+(Put 'LinkReg 'RegisterName 12)
+(Put 'NargReg 'RegisterName 13)
+
+% From PC:Common-Cmacros.sl
+
+(de MakeLinkRegs(Fn Nargs)
+ (cond ((FlagP Fn 'NoLinkage) NIL)
+ (T (list (list '!*Move (list 'IdLoc FunctionName) '(reg LinkReg) )
+ (list '!*Move (list 'Wconst NumberofArguments) '(reg NargReg) )
+ ))))
+
+(FLAG '(IDapply0 IDapply1 IDapply2 IDapply3 IDapply4) 'NoLinkage)
+
+(de !*Link (FunctionName FunctionType NumberOfArguments)
+ (cond ((FlagP FunctionName 'ForeignFunction)
+ (list (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments)))
+ (t (append (MakeLinkRegs FunctionName NumberofArguments)
+ (list (list '!*Call FunctionName))))))
+
+
+(de !*LinkE (DeAllocCount FunctionName FunctionType NumberOfArguments)
+ (cons (list '!*DeAlloc DeAllocCount)
+ (cond ((FlagP FunctionName 'ForeignFunction)
+ (list (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments)
+ '(!*Exit 0)))
+ (t (Append (MakeLinkRegs FunctionName NumberofArguments)
+ (list (list '!*JCall FunctionName)))))))
+
+(DefList '((IDApply0 (
+ (!*move (Wconst 0) (reg NargReg))
+ (!*move (reg 1) (reg LinkReg))
+ % (!*Wtimes2 (reg 1) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 (
+ (!*move (Wconst 1) (reg NargReg))
+ (!*move (reg 2) (reg LinkReg))
+ % (!*Wtimes2 (reg 2) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 (
+ (!*move (Wconst 2) (reg NargReg))
+ (!*move (reg 3) (reg LinkReg))
+ % (!*Wtimes2 (reg 3) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 (
+ (!*move (Wconst 3) (reg NargReg))
+ (!*move (reg 4) (reg LinkReg))
+ % (!*Wtimes2 (reg 4) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 (
+ (!*move (Wconst 4) (reg NargReg))
+ (!*move (reg 5) (reg LinkReg))
+ % (!*Wtimes2 (reg 5) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 5) (WArray SymFnc)))))
+) 'OpenCode)
+
+
+(DefList '((IDApply0 (
+ (!*move (Wconst 0) (reg NargReg))
+ (!*move (reg 1) (reg LinkReg))
+ % (!*wtimes2 (reg 1) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 (
+ (!*move (Wconst 1) (reg NargReg))
+ (!*move (reg 2) (reg LinkReg))
+ % (!*wtimes2 (reg 2) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 (
+ (!*move (Wconst 2) (reg NargReg))
+ (!*move (reg 3) (reg LinkReg))
+ % (!*wtimes2 (reg 3) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 (
+ (!*move (Wconst 3) (reg NargReg))
+ (!*move (reg 4) (reg LinkReg))
+ % (!*wtimes2 (reg 4) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 (
+ (!*move (Wconst 4) (reg NargReg))
+ (!*move (reg 5) (reg LinkReg))
+ % (!*wtimes2 (reg 5) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 5) (WArray SymFnc)))))
+) 'ExitOpenCode)
+
+% From PC:lap-to-asm.red
+
+(de DataPrintUndefinedFunctionCell ()
+ (Prog (OldOut)
+ (setq OldOut (WRS DataOut!*))
+ (foreach X in (Pass1Lap UndefinedFunctionCellInstructions!*) do
+ (ASMOutLap1 X))
+ (WRS OldOut)))
+
+(DSKIN "PC:P-LAMBIND.SL")
+
+% new SYSLISP bug, perhaps useful refefined it?
+
+(off usermode)
+
+(dm for(u) ( MkFor1 u))
ADDED psl-1983/20-tests/dfield.mac
Index: psl-1983/20-tests/dfield.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dfield.mac
@@ -0,0 +1,875 @@
+ radix 10
+STACK: block 301
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+300
+ intern L0002
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <29_31>+133
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ block 50
+SYMNAM: intern SYMNAM
+ extern L0063
+ <4_31>+L0063
+ extern L0064
+ <4_31>+L0064
+ extern L0065
+ <4_31>+L0065
+ extern L0066
+ <4_31>+L0066
+ extern L0067
+ <4_31>+L0067
+ extern L0068
+ <4_31>+L0068
+ extern L0069
+ <4_31>+L0069
+ extern L0070
+ <4_31>+L0070
+ extern L0071
+ <4_31>+L0071
+ extern L0072
+ <4_31>+L0072
+ extern L0073
+ <4_31>+L0073
+ extern L0074
+ <4_31>+L0074
+ extern L0075
+ <4_31>+L0075
+ extern L0076
+ <4_31>+L0076
+ extern L0077
+ <4_31>+L0077
+ extern L0078
+ <4_31>+L0078
+ extern L0079
+ <4_31>+L0079
+ extern L0080
+ <4_31>+L0080
+ extern L0081
+ <4_31>+L0081
+ extern L0082
+ <4_31>+L0082
+ extern L0083
+ <4_31>+L0083
+ extern L0084
+ <4_31>+L0084
+ extern L0085
+ <4_31>+L0085
+ extern L0086
+ <4_31>+L0086
+ extern L0087
+ <4_31>+L0087
+ extern L0088
+ <4_31>+L0088
+ extern L0089
+ <4_31>+L0089
+ extern L0090
+ <4_31>+L0090
+ extern L0091
+ <4_31>+L0091
+ extern L0092
+ <4_31>+L0092
+ extern L0093
+ <4_31>+L0093
+ extern L0094
+ <4_31>+L0094
+ extern L0095
+ <4_31>+L0095
+ extern L0096
+ <4_31>+L0096
+ extern L0097
+ <4_31>+L0097
+ extern L0098
+ <4_31>+L0098
+ extern L0099
+ <4_31>+L0099
+ extern L0100
+ <4_31>+L0100
+ extern L0101
+ <4_31>+L0101
+ extern L0102
+ <4_31>+L0102
+ extern L0103
+ <4_31>+L0103
+ extern L0104
+ <4_31>+L0104
+ extern L0105
+ <4_31>+L0105
+ extern L0106
+ <4_31>+L0106
+ extern L0107
+ <4_31>+L0107
+ extern L0108
+ <4_31>+L0108
+ extern L0109
+ <4_31>+L0109
+ extern L0110
+ <4_31>+L0110
+ extern L0111
+ <4_31>+L0111
+ extern L0112
+ <4_31>+L0112
+ extern L0113
+ <4_31>+L0113
+ extern L0114
+ <4_31>+L0114
+ extern L0115
+ <4_31>+L0115
+ extern L0116
+ <4_31>+L0116
+ extern L0117
+ <4_31>+L0117
+ extern L0118
+ <4_31>+L0118
+ extern L0119
+ <4_31>+L0119
+ extern L0120
+ <4_31>+L0120
+ extern L0121
+ <4_31>+L0121
+ extern L0122
+ <4_31>+L0122
+ extern L0123
+ <4_31>+L0123
+ extern L0124
+ <4_31>+L0124
+ extern L0125
+ <4_31>+L0125
+ extern L0126
+ <4_31>+L0126
+ extern L0127
+ <4_31>+L0127
+ extern L0128
+ <4_31>+L0128
+ extern L0129
+ <4_31>+L0129
+ extern L0130
+ <4_31>+L0130
+ extern L0131
+ <4_31>+L0131
+ extern L0132
+ <4_31>+L0132
+ extern L0133
+ <4_31>+L0133
+ extern L0134
+ <4_31>+L0134
+ extern L0135
+ <4_31>+L0135
+ extern L0136
+ <4_31>+L0136
+ extern L0137
+ <4_31>+L0137
+ extern L0138
+ <4_31>+L0138
+ extern L0139
+ <4_31>+L0139
+ extern L0140
+ <4_31>+L0140
+ extern L0141
+ <4_31>+L0141
+ extern L0142
+ <4_31>+L0142
+ extern L0143
+ <4_31>+L0143
+ extern L0144
+ <4_31>+L0144
+ extern L0145
+ <4_31>+L0145
+ extern L0146
+ <4_31>+L0146
+ extern L0147
+ <4_31>+L0147
+ extern L0148
+ <4_31>+L0148
+ extern L0149
+ <4_31>+L0149
+ extern L0150
+ <4_31>+L0150
+ extern L0151
+ <4_31>+L0151
+ extern L0152
+ <4_31>+L0152
+ extern L0153
+ <4_31>+L0153
+ extern L0154
+ <4_31>+L0154
+ extern L0155
+ <4_31>+L0155
+ extern L0156
+ <4_31>+L0156
+ extern L0157
+ <4_31>+L0157
+ extern L0158
+ <4_31>+L0158
+ extern L0159
+ <4_31>+L0159
+ extern L0160
+ <4_31>+L0160
+ extern L0161
+ <4_31>+L0161
+ extern L0162
+ <4_31>+L0162
+ extern L0163
+ <4_31>+L0163
+ extern L0164
+ <4_31>+L0164
+ extern L0165
+ <4_31>+L0165
+ extern L0166
+ <4_31>+L0166
+ extern L0167
+ <4_31>+L0167
+ extern L0168
+ <4_31>+L0168
+ extern L0169
+ <4_31>+L0169
+ extern L0170
+ <4_31>+L0170
+ extern L0171
+ <4_31>+L0171
+ extern L0172
+ <4_31>+L0172
+ extern L0173
+ <4_31>+L0173
+ extern L0174
+ <4_31>+L0174
+ extern L0175
+ <4_31>+L0175
+ extern L0176
+ <4_31>+L0176
+ extern L0177
+ <4_31>+L0177
+ extern L0178
+ <4_31>+L0178
+ extern L0179
+ <4_31>+L0179
+ extern L0180
+ <4_31>+L0180
+ extern L0181
+ <4_31>+L0181
+ extern L0182
+ <4_31>+L0182
+ extern L0183
+ <4_31>+L0183
+ extern L0184
+ <4_31>+L0184
+ extern L0185
+ <4_31>+L0185
+ extern L0186
+ <4_31>+L0186
+ extern L0187
+ <4_31>+L0187
+ extern L0188
+ <4_31>+L0188
+ extern L0189
+ <4_31>+L0189
+ extern L0190
+ <4_31>+L0190
+ extern L0191
+ <4_31>+L0191
+ extern L0192
+ <4_31>+L0192
+ extern L0193
+ <4_31>+L0193
+ extern L0194
+ <4_31>+L0194
+ extern L0195
+ <4_31>+L0195
+ extern L0196
+ <4_31>+L0196
+ extern L0197
+ <4_31>+L0197
+ extern L0198
+ <4_31>+L0198
+ extern L0199
+ <4_31>+L0199
+ extern L0200
+ <4_31>+L0200
+ extern L0201
+ <4_31>+L0201
+ extern L0202
+ <4_31>+L0202
+ extern L0203
+ <4_31>+L0203
+ extern L0204
+ <4_31>+L0204
+ extern L0205
+ <4_31>+L0205
+ extern L0206
+ <4_31>+L0206
+ extern L0207
+ <4_31>+L0207
+ extern L0208
+ <4_31>+L0208
+ extern L0209
+ <4_31>+L0209
+ extern L0210
+ <4_31>+L0210
+ extern L0211
+ <4_31>+L0211
+ extern L0212
+ <4_31>+L0212
+ extern L0213
+ <4_31>+L0213
+ block 50
+SYMFNC: intern SYMFNC
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ extern MAIN.
+ jrst MAIN.##
+ extern L0008
+ jrst L0008##
+ extern INIT
+ jrst INIT##
+ extern GETC
+ jrst GETC##
+ extern TIMC
+ jrst TIMC##
+ extern PUTC
+ jrst PUTC##
+ extern QUIT
+ jrst QUIT##
+ extern PUTINT
+ jrst PUTINT##
+ extern L0006
+ jrst L0006##
+ extern FLAG
+ jrst FLAG##
+ extern L0007
+ jrst L0007##
+ extern MSG5
+ jrst MSG5##
+ extern TESTOK
+ jrst TESTOK##
+ extern L0059
+ jrst L0059##
+ JSP 10,SYMFNC+137
+ extern L0014
+ jrst L0014##
+ extern L0028
+ jrst L0028##
+ extern L0043
+ jrst L0043##
+ extern L0061
+ jrst L0061##
+ extern L0058
+ jrst L0058##
+ extern L0060
+ jrst L0060##
+ extern L0062
+ jrst L0062##
+ block 50
+L0003: intern L0003
+ 151
+ end
ADDED psl-1983/20-tests/dfoo.mac
Index: psl-1983/20-tests/dfoo.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dfoo.mac
@@ -0,0 +1,2 @@
+ radix 10
+ end
ADDED psl-1983/20-tests/dfoo.rel
Index: psl-1983/20-tests/dfoo.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dfoo.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dmain1.mac
Index: psl-1983/20-tests/dmain1.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain1.mac
@@ -0,0 +1,1224 @@
+ radix 10
+STACK: block 5001
+ intern STACK
+HEAP: block 50001
+ intern HEAP
+L0001: STACK+0
+ intern L0001
+L0002: STACK+5000
+ intern L0002
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <30_31>+128
+ <30_31>+128
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <30_31>+128
+ <30_31>+128
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ <29_31>+151
+ <29_31>+152
+ <29_31>+153
+ <29_31>+154
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ <29_31>+160
+ <29_31>+161
+ block 339
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 339
+SYMNAM: intern SYMNAM
+ extern L0033
+ <4_31>+L0033
+ extern L0034
+ <4_31>+L0034
+ extern L0035
+ <4_31>+L0035
+ extern L0036
+ <4_31>+L0036
+ extern L0037
+ <4_31>+L0037
+ extern L0038
+ <4_31>+L0038
+ extern L0039
+ <4_31>+L0039
+ extern L0040
+ <4_31>+L0040
+ extern L0041
+ <4_31>+L0041
+ extern L0042
+ <4_31>+L0042
+ extern L0043
+ <4_31>+L0043
+ extern L0044
+ <4_31>+L0044
+ extern L0045
+ <4_31>+L0045
+ extern L0046
+ <4_31>+L0046
+ extern L0047
+ <4_31>+L0047
+ extern L0048
+ <4_31>+L0048
+ extern L0049
+ <4_31>+L0049
+ extern L0050
+ <4_31>+L0050
+ extern L0051
+ <4_31>+L0051
+ extern L0052
+ <4_31>+L0052
+ extern L0053
+ <4_31>+L0053
+ extern L0054
+ <4_31>+L0054
+ extern L0055
+ <4_31>+L0055
+ extern L0056
+ <4_31>+L0056
+ extern L0057
+ <4_31>+L0057
+ extern L0058
+ <4_31>+L0058
+ extern L0059
+ <4_31>+L0059
+ extern L0060
+ <4_31>+L0060
+ extern L0061
+ <4_31>+L0061
+ extern L0062
+ <4_31>+L0062
+ extern L0063
+ <4_31>+L0063
+ extern L0064
+ <4_31>+L0064
+ extern L0065
+ <4_31>+L0065
+ extern L0066
+ <4_31>+L0066
+ extern L0067
+ <4_31>+L0067
+ extern L0068
+ <4_31>+L0068
+ extern L0069
+ <4_31>+L0069
+ extern L0070
+ <4_31>+L0070
+ extern L0071
+ <4_31>+L0071
+ extern L0072
+ <4_31>+L0072
+ extern L0073
+ <4_31>+L0073
+ extern L0074
+ <4_31>+L0074
+ extern L0075
+ <4_31>+L0075
+ extern L0076
+ <4_31>+L0076
+ extern L0077
+ <4_31>+L0077
+ extern L0078
+ <4_31>+L0078
+ extern L0079
+ <4_31>+L0079
+ extern L0080
+ <4_31>+L0080
+ extern L0081
+ <4_31>+L0081
+ extern L0082
+ <4_31>+L0082
+ extern L0083
+ <4_31>+L0083
+ extern L0084
+ <4_31>+L0084
+ extern L0085
+ <4_31>+L0085
+ extern L0086
+ <4_31>+L0086
+ extern L0087
+ <4_31>+L0087
+ extern L0088
+ <4_31>+L0088
+ extern L0089
+ <4_31>+L0089
+ extern L0090
+ <4_31>+L0090
+ extern L0091
+ <4_31>+L0091
+ extern L0092
+ <4_31>+L0092
+ extern L0093
+ <4_31>+L0093
+ extern L0094
+ <4_31>+L0094
+ extern L0095
+ <4_31>+L0095
+ extern L0096
+ <4_31>+L0096
+ extern L0097
+ <4_31>+L0097
+ extern L0098
+ <4_31>+L0098
+ extern L0099
+ <4_31>+L0099
+ extern L0100
+ <4_31>+L0100
+ extern L0101
+ <4_31>+L0101
+ extern L0102
+ <4_31>+L0102
+ extern L0103
+ <4_31>+L0103
+ extern L0104
+ <4_31>+L0104
+ extern L0105
+ <4_31>+L0105
+ extern L0106
+ <4_31>+L0106
+ extern L0107
+ <4_31>+L0107
+ extern L0108
+ <4_31>+L0108
+ extern L0109
+ <4_31>+L0109
+ extern L0110
+ <4_31>+L0110
+ extern L0111
+ <4_31>+L0111
+ extern L0112
+ <4_31>+L0112
+ extern L0113
+ <4_31>+L0113
+ extern L0114
+ <4_31>+L0114
+ extern L0115
+ <4_31>+L0115
+ extern L0116
+ <4_31>+L0116
+ extern L0117
+ <4_31>+L0117
+ extern L0118
+ <4_31>+L0118
+ extern L0119
+ <4_31>+L0119
+ extern L0120
+ <4_31>+L0120
+ extern L0121
+ <4_31>+L0121
+ extern L0122
+ <4_31>+L0122
+ extern L0123
+ <4_31>+L0123
+ extern L0124
+ <4_31>+L0124
+ extern L0125
+ <4_31>+L0125
+ extern L0126
+ <4_31>+L0126
+ extern L0127
+ <4_31>+L0127
+ extern L0128
+ <4_31>+L0128
+ extern L0129
+ <4_31>+L0129
+ extern L0130
+ <4_31>+L0130
+ extern L0131
+ <4_31>+L0131
+ extern L0132
+ <4_31>+L0132
+ extern L0133
+ <4_31>+L0133
+ extern L0134
+ <4_31>+L0134
+ extern L0135
+ <4_31>+L0135
+ extern L0136
+ <4_31>+L0136
+ extern L0137
+ <4_31>+L0137
+ extern L0138
+ <4_31>+L0138
+ extern L0139
+ <4_31>+L0139
+ extern L0140
+ <4_31>+L0140
+ extern L0141
+ <4_31>+L0141
+ extern L0142
+ <4_31>+L0142
+ extern L0143
+ <4_31>+L0143
+ extern L0144
+ <4_31>+L0144
+ extern L0145
+ <4_31>+L0145
+ extern L0146
+ <4_31>+L0146
+ extern L0147
+ <4_31>+L0147
+ extern L0148
+ <4_31>+L0148
+ extern L0149
+ <4_31>+L0149
+ extern L0150
+ <4_31>+L0150
+ extern L0151
+ <4_31>+L0151
+ extern L0152
+ <4_31>+L0152
+ extern L0153
+ <4_31>+L0153
+ extern L0154
+ <4_31>+L0154
+ extern L0155
+ <4_31>+L0155
+ extern L0156
+ <4_31>+L0156
+ extern L0157
+ <4_31>+L0157
+ extern L0158
+ <4_31>+L0158
+ extern L0159
+ <4_31>+L0159
+ extern L0160
+ <4_31>+L0160
+ extern L0161
+ <4_31>+L0161
+ extern L0162
+ <4_31>+L0162
+ extern L0163
+ <4_31>+L0163
+ extern L0164
+ <4_31>+L0164
+ extern L0165
+ <4_31>+L0165
+ extern L0166
+ <4_31>+L0166
+ extern L0167
+ <4_31>+L0167
+ extern L0168
+ <4_31>+L0168
+ extern L0169
+ <4_31>+L0169
+ extern L0170
+ <4_31>+L0170
+ extern L0171
+ <4_31>+L0171
+ extern L0172
+ <4_31>+L0172
+ extern L0173
+ <4_31>+L0173
+ extern L0174
+ <4_31>+L0174
+ extern L0175
+ <4_31>+L0175
+ extern L0176
+ <4_31>+L0176
+ extern L0177
+ <4_31>+L0177
+ extern L0178
+ <4_31>+L0178
+ extern L0179
+ <4_31>+L0179
+ extern L0180
+ <4_31>+L0180
+ extern L0181
+ <4_31>+L0181
+ extern L0182
+ <4_31>+L0182
+ extern L0183
+ <4_31>+L0183
+ extern L0184
+ <4_31>+L0184
+ extern L0185
+ <4_31>+L0185
+ extern L0186
+ <4_31>+L0186
+ extern L0187
+ <4_31>+L0187
+ extern L0188
+ <4_31>+L0188
+ extern L0189
+ <4_31>+L0189
+ extern L0190
+ <4_31>+L0190
+ extern L0191
+ <4_31>+L0191
+ extern L0192
+ <4_31>+L0192
+ extern L0193
+ <4_31>+L0193
+ extern L0194
+ <4_31>+L0194
+ 163
+ 164
+ 165
+ 166
+ 167
+ 168
+ 169
+ 170
+ 171
+ 172
+ 173
+ 174
+ 175
+ 176
+ 177
+ 178
+ 179
+ 180
+ 181
+ 182
+ 183
+ 184
+ 185
+ 186
+ 187
+ 188
+ 189
+ 190
+ 191
+ 192
+ 193
+ 194
+ 195
+ 196
+ 197
+ 198
+ 199
+ 200
+ 201
+ 202
+ 203
+ 204
+ 205
+ 206
+ 207
+ 208
+ 209
+ 210
+ 211
+ 212
+ 213
+ 214
+ 215
+ 216
+ 217
+ 218
+ 219
+ 220
+ 221
+ 222
+ 223
+ 224
+ 225
+ 226
+ 227
+ 228
+ 229
+ 230
+ 231
+ 232
+ 233
+ 234
+ 235
+ 236
+ 237
+ 238
+ 239
+ 240
+ 241
+ 242
+ 243
+ 244
+ 245
+ 246
+ 247
+ 248
+ 249
+ 250
+ 251
+ 252
+ 253
+ 254
+ 255
+ 256
+ 257
+ 258
+ 259
+ 260
+ 261
+ 262
+ 263
+ 264
+ 265
+ 266
+ 267
+ 268
+ 269
+ 270
+ 271
+ 272
+ 273
+ 274
+ 275
+ 276
+ 277
+ 278
+ 279
+ 280
+ 281
+ 282
+ 283
+ 284
+ 285
+ 286
+ 287
+ 288
+ 289
+ 290
+ 291
+ 292
+ 293
+ 294
+ 295
+ 296
+ 297
+ 298
+ 299
+ 300
+ 301
+ 302
+ 303
+ 304
+ 305
+ 306
+ 307
+ 308
+ 309
+ 310
+ 311
+ 312
+ 313
+ 314
+ 315
+ 316
+ 317
+ 318
+ 319
+ 320
+ 321
+ 322
+ 323
+ 324
+ 325
+ 326
+ 327
+ 328
+ 329
+ 330
+ 331
+ 332
+ 333
+ 334
+ 335
+ 336
+ 337
+ 338
+ 339
+ 340
+ 341
+ 342
+ 343
+ 344
+ 345
+ 346
+ 347
+ 348
+ 349
+ 350
+ 351
+ 352
+ 353
+ 354
+ 355
+ 356
+ 357
+ 358
+ 359
+ 360
+ 361
+ 362
+ 363
+ 364
+ 365
+ 366
+ 367
+ 368
+ 369
+ 370
+ 371
+ 372
+ 373
+ 374
+ 375
+ 376
+ 377
+ 378
+ 379
+ 380
+ 381
+ 382
+ 383
+ 384
+ 385
+ 386
+ 387
+ 388
+ 389
+ 390
+ 391
+ 392
+ 393
+ 394
+ 395
+ 396
+ 397
+ 398
+ 399
+ 400
+ 401
+ 402
+ 403
+ 404
+ 405
+ 406
+ 407
+ 408
+ 409
+ 410
+ 411
+ 412
+ 413
+ 414
+ 415
+ 416
+ 417
+ 418
+ 419
+ 420
+ 421
+ 422
+ 423
+ 424
+ 425
+ 426
+ 427
+ 428
+ 429
+ 430
+ 431
+ 432
+ 433
+ 434
+ 435
+ 436
+ 437
+ 438
+ 439
+ 440
+ 441
+ 442
+ 443
+ 444
+ 445
+ 446
+ 447
+ 448
+ 449
+ 450
+ 451
+ 452
+ 453
+ 454
+ 455
+ 456
+ 457
+ 458
+ 459
+ 460
+ 461
+ 462
+ 463
+ 464
+ 465
+ 466
+ 467
+ 468
+ 469
+ 470
+ 471
+ 472
+ 473
+ 474
+ 475
+ 476
+ 477
+ 478
+ 479
+ 480
+ 481
+ 482
+ 483
+ 484
+ 485
+ 486
+ 487
+ 488
+ 489
+ 490
+ 491
+ 492
+ 493
+ 494
+ 495
+ 496
+ 497
+ 498
+ 499
+ 500
+ 0
+SYMFNC: intern SYMFNC
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ extern L0014
+ jrst L0014##
+ extern MAIN.
+ jrst MAIN.##
+ extern INIT
+ jrst INIT##
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ extern GETC
+ jrst GETC##
+ extern TIMC
+ jrst TIMC##
+ JRST SYMFNC+143
+ extern PUTC
+ jrst PUTC##
+ extern QUIT
+ jrst QUIT##
+ extern PUTINT
+ jrst PUTINT##
+ extern L0008
+ jrst L0008##
+ extern L0009
+ jrst L0009##
+ extern L0010
+ jrst L0010##
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ JRST SYMFNC+143
+ extern FLAG
+ jrst FLAG##
+ extern L0011
+ jrst L0011##
+ JRST SYMFNC+143
+ extern L0012
+ jrst L0012##
+ JRST SYMFNC+143
+ extern L0013
+ jrst L0013##
+ extern TERPRI
+ jrst TERPRI##
+ extern IFACT
+ jrst IFACT##
+ extern L0015
+ jrst L0015##
+ extern L0021
+ jrst L0021##
+ extern L0017
+ jrst L0017##
+ extern FACT
+ jrst FACT##
+ extern L0022
+ jrst L0022##
+ extern TAK
+ jrst TAK##
+ extern L0032
+ jrst L0032##
+ block 339
+L0003: intern L0003
+ 162
+ end
ADDED psl-1983/20-tests/dmain5.mac
Index: psl-1983/20-tests/dmain5.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain5.mac
@@ -0,0 +1,2246 @@
+ radix 10
+STACK: block 5001
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+5000
+ intern L0002
+HEAP: block 150001
+ intern HEAP
+L0183: HEAP+0
+ intern L0183
+L0184: HEAP+150000
+ intern L0184
+L0185: 0
+ intern L0185
+L0186: 0
+ intern L0186
+BPS: block 501
+ intern BPS
+L1005: BPS+0
+ intern L1005
+L1006: BPS+0
+ intern L1006
+L1007: BPS+500
+ intern L1007
+L1008: BPS+500
+ intern L1008
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <29_31>+133
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ <29_31>+151
+ <29_31>+152
+ <29_31>+153
+ <30_31>+128
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ <29_31>+160
+ <29_31>+161
+ <29_31>+162
+ <29_31>+163
+ <29_31>+164
+ <29_31>+165
+ <29_31>+166
+ <29_31>+167
+ <29_31>+168
+ <29_31>+169
+ <29_31>+170
+ <29_31>+171
+ <29_31>+172
+ <29_31>+173
+ <29_31>+174
+ <29_31>+175
+ <29_31>+176
+ <29_31>+177
+ <29_31>+178
+ <29_31>+179
+ <29_31>+180
+ <29_31>+181
+ <29_31>+182
+ <29_31>+183
+ <29_31>+184
+ <29_31>+185
+ <29_31>+186
+ <29_31>+187
+ <29_31>+188
+ <29_31>+189
+ <29_31>+190
+ <29_31>+191
+ <29_31>+192
+ <29_31>+193
+ <29_31>+194
+ <29_31>+195
+ <29_31>+196
+ <29_31>+197
+ <29_31>+198
+ <29_31>+199
+ <29_31>+200
+ <29_31>+201
+ <29_31>+202
+ <29_31>+203
+ <29_31>+204
+ <29_31>+205
+ <29_31>+206
+ <29_31>+207
+ <29_31>+208
+ <29_31>+209
+ <29_31>+210
+ <29_31>+211
+ <29_31>+212
+ <29_31>+213
+ <29_31>+214
+ <29_31>+215
+ <29_31>+216
+ <29_31>+217
+ <29_31>+218
+ <29_31>+219
+ <29_31>+220
+ <29_31>+221
+ <29_31>+222
+ <29_31>+223
+ <29_31>+224
+ <29_31>+225
+ <29_31>+226
+ <29_31>+227
+ <29_31>+228
+ <29_31>+229
+ <29_31>+230
+ <29_31>+231
+ <29_31>+232
+ <29_31>+233
+ <29_31>+234
+ <29_31>+235
+ <29_31>+236
+ <29_31>+237
+ <29_31>+238
+ <29_31>+239
+ <29_31>+240
+ <30_31>+128
+ <29_31>+242
+ <30_31>+128
+ <30_31>+128
+ <29_31>+245
+ <29_31>+246
+ <29_31>+247
+ <29_31>+248
+ <29_31>+249
+ <29_31>+250
+ <29_31>+251
+ <29_31>+252
+ <29_31>+253
+ <29_31>+254
+ <29_31>+255
+ <29_31>+256
+ <29_31>+257
+ <29_31>+258
+ <29_31>+259
+ <29_31>+260
+ <29_31>+261
+ <29_31>+262
+ <29_31>+263
+ <29_31>+264
+ <29_31>+265
+ <29_31>+266
+ <29_31>+267
+ <29_31>+268
+ <29_31>+269
+ <29_31>+270
+ <29_31>+271
+ <29_31>+272
+ <29_31>+273
+ <29_31>+274
+ <29_31>+275
+ <29_31>+276
+ <29_31>+277
+ <29_31>+278
+ <29_31>+279
+ <29_31>+280
+ <29_31>+281
+ <29_31>+282
+ <29_31>+283
+ <29_31>+284
+ <29_31>+285
+ <29_31>+286
+ <29_31>+287
+ <29_31>+288
+ <29_31>+289
+ <29_31>+290
+ <29_31>+291
+ <29_31>+292
+ <29_31>+293
+ <29_31>+294
+ <29_31>+295
+ <29_31>+296
+ <29_31>+297
+ <29_31>+298
+ <29_31>+299
+ <29_31>+300
+ <29_31>+301
+ <29_31>+302
+ <29_31>+303
+ <29_31>+304
+ <29_31>+305
+ <29_31>+306
+ <29_31>+307
+ <29_31>+308
+ <29_31>+309
+ <29_31>+310
+ <29_31>+311
+ <29_31>+312
+ <29_31>+313
+ <29_31>+314
+ <29_31>+315
+ <29_31>+316
+ <29_31>+317
+ <29_31>+318
+ <29_31>+319
+ <29_31>+320
+ <29_31>+321
+ <29_31>+322
+ <29_31>+323
+ <29_31>+324
+ <29_31>+325
+ <29_31>+326
+ <29_31>+327
+ <29_31>+328
+ <29_31>+329
+ <29_31>+330
+ <29_31>+331
+ <29_31>+332
+ <29_31>+333
+ <29_31>+334
+ <29_31>+335
+ <29_31>+336
+ <29_31>+337
+ <29_31>+338
+ <29_31>+339
+ <29_31>+340
+ <29_31>+341
+ <30_31>+128
+ <29_31>+343
+ <29_31>+344
+ <29_31>+345
+ <29_31>+346
+ <29_31>+347
+ <29_31>+348
+ <30_31>+128
+ <30_31>+128
+ <29_31>+351
+ <29_31>+352
+ <29_31>+353
+ <29_31>+354
+ <29_31>+355
+ <29_31>+356
+ <29_31>+357
+ <29_31>+358
+ <29_31>+359
+ <29_31>+360
+ <29_31>+361
+ <29_31>+362
+ <30_31>+26
+ <29_31>+364
+ <29_31>+365
+ <29_31>+366
+ <29_31>+367
+ <29_31>+368
+ <29_31>+369
+ <29_31>+370
+ block 130
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 130
+SYMNAM: intern SYMNAM
+ extern L1105
+ <4_31>+L1105
+ extern L1106
+ <4_31>+L1106
+ extern L1107
+ <4_31>+L1107
+ extern L1108
+ <4_31>+L1108
+ extern L1109
+ <4_31>+L1109
+ extern L1110
+ <4_31>+L1110
+ extern L1111
+ <4_31>+L1111
+ extern L1112
+ <4_31>+L1112
+ extern L1113
+ <4_31>+L1113
+ extern L1114
+ <4_31>+L1114
+ extern L1115
+ <4_31>+L1115
+ extern L1116
+ <4_31>+L1116
+ extern L1117
+ <4_31>+L1117
+ extern L1118
+ <4_31>+L1118
+ extern L1119
+ <4_31>+L1119
+ extern L1120
+ <4_31>+L1120
+ extern L1121
+ <4_31>+L1121
+ extern L1122
+ <4_31>+L1122
+ extern L1123
+ <4_31>+L1123
+ extern L1124
+ <4_31>+L1124
+ extern L1125
+ <4_31>+L1125
+ extern L1126
+ <4_31>+L1126
+ extern L1127
+ <4_31>+L1127
+ extern L1128
+ <4_31>+L1128
+ extern L1129
+ <4_31>+L1129
+ extern L1130
+ <4_31>+L1130
+ extern L1131
+ <4_31>+L1131
+ extern L1132
+ <4_31>+L1132
+ extern L1133
+ <4_31>+L1133
+ extern L1134
+ <4_31>+L1134
+ extern L1135
+ <4_31>+L1135
+ extern L1136
+ <4_31>+L1136
+ extern L1137
+ <4_31>+L1137
+ extern L1138
+ <4_31>+L1138
+ extern L1139
+ <4_31>+L1139
+ extern L1140
+ <4_31>+L1140
+ extern L1141
+ <4_31>+L1141
+ extern L1142
+ <4_31>+L1142
+ extern L1143
+ <4_31>+L1143
+ extern L1144
+ <4_31>+L1144
+ extern L1145
+ <4_31>+L1145
+ extern L1146
+ <4_31>+L1146
+ extern L1147
+ <4_31>+L1147
+ extern L1148
+ <4_31>+L1148
+ extern L1149
+ <4_31>+L1149
+ extern L1150
+ <4_31>+L1150
+ extern L1151
+ <4_31>+L1151
+ extern L1152
+ <4_31>+L1152
+ extern L1153
+ <4_31>+L1153
+ extern L1154
+ <4_31>+L1154
+ extern L1155
+ <4_31>+L1155
+ extern L1156
+ <4_31>+L1156
+ extern L1157
+ <4_31>+L1157
+ extern L1158
+ <4_31>+L1158
+ extern L1159
+ <4_31>+L1159
+ extern L1160
+ <4_31>+L1160
+ extern L1161
+ <4_31>+L1161
+ extern L1162
+ <4_31>+L1162
+ extern L1163
+ <4_31>+L1163
+ extern L1164
+ <4_31>+L1164
+ extern L1165
+ <4_31>+L1165
+ extern L1166
+ <4_31>+L1166
+ extern L1167
+ <4_31>+L1167
+ extern L1168
+ <4_31>+L1168
+ extern L1169
+ <4_31>+L1169
+ extern L1170
+ <4_31>+L1170
+ extern L1171
+ <4_31>+L1171
+ extern L1172
+ <4_31>+L1172
+ extern L1173
+ <4_31>+L1173
+ extern L1174
+ <4_31>+L1174
+ extern L1175
+ <4_31>+L1175
+ extern L1176
+ <4_31>+L1176
+ extern L1177
+ <4_31>+L1177
+ extern L1178
+ <4_31>+L1178
+ extern L1179
+ <4_31>+L1179
+ extern L1180
+ <4_31>+L1180
+ extern L1181
+ <4_31>+L1181
+ extern L1182
+ <4_31>+L1182
+ extern L1183
+ <4_31>+L1183
+ extern L1184
+ <4_31>+L1184
+ extern L1185
+ <4_31>+L1185
+ extern L1186
+ <4_31>+L1186
+ extern L1187
+ <4_31>+L1187
+ extern L1188
+ <4_31>+L1188
+ extern L1189
+ <4_31>+L1189
+ extern L1190
+ <4_31>+L1190
+ extern L1191
+ <4_31>+L1191
+ extern L1192
+ <4_31>+L1192
+ extern L1193
+ <4_31>+L1193
+ extern L1194
+ <4_31>+L1194
+ extern L1195
+ <4_31>+L1195
+ extern L1196
+ <4_31>+L1196
+ extern L1197
+ <4_31>+L1197
+ extern L1198
+ <4_31>+L1198
+ extern L1199
+ <4_31>+L1199
+ extern L1200
+ <4_31>+L1200
+ extern L1201
+ <4_31>+L1201
+ extern L1202
+ <4_31>+L1202
+ extern L1203
+ <4_31>+L1203
+ extern L1204
+ <4_31>+L1204
+ extern L1205
+ <4_31>+L1205
+ extern L1206
+ <4_31>+L1206
+ extern L1207
+ <4_31>+L1207
+ extern L1208
+ <4_31>+L1208
+ extern L1209
+ <4_31>+L1209
+ extern L1210
+ <4_31>+L1210
+ extern L1211
+ <4_31>+L1211
+ extern L1212
+ <4_31>+L1212
+ extern L1213
+ <4_31>+L1213
+ extern L1214
+ <4_31>+L1214
+ extern L1215
+ <4_31>+L1215
+ extern L1216
+ <4_31>+L1216
+ extern L1217
+ <4_31>+L1217
+ extern L1218
+ <4_31>+L1218
+ extern L1219
+ <4_31>+L1219
+ extern L1220
+ <4_31>+L1220
+ extern L1221
+ <4_31>+L1221
+ extern L1222
+ <4_31>+L1222
+ extern L1223
+ <4_31>+L1223
+ extern L1224
+ <4_31>+L1224
+ extern L1225
+ <4_31>+L1225
+ extern L1226
+ <4_31>+L1226
+ extern L1227
+ <4_31>+L1227
+ extern L1228
+ <4_31>+L1228
+ extern L1229
+ <4_31>+L1229
+ extern L1230
+ <4_31>+L1230
+ extern L1231
+ <4_31>+L1231
+ extern L1232
+ <4_31>+L1232
+ extern L1233
+ <4_31>+L1233
+ extern L1234
+ <4_31>+L1234
+ extern L1235
+ <4_31>+L1235
+ extern L1236
+ <4_31>+L1236
+ extern L1237
+ <4_31>+L1237
+ extern L1238
+ <4_31>+L1238
+ extern L1239
+ <4_31>+L1239
+ extern L1240
+ <4_31>+L1240
+ extern L1241
+ <4_31>+L1241
+ extern L1242
+ <4_31>+L1242
+ extern L1243
+ <4_31>+L1243
+ extern L1244
+ <4_31>+L1244
+ extern L1245
+ <4_31>+L1245
+ extern L1246
+ <4_31>+L1246
+ extern L1247
+ <4_31>+L1247
+ extern L1248
+ <4_31>+L1248
+ extern L1249
+ <4_31>+L1249
+ extern L1250
+ <4_31>+L1250
+ extern L1251
+ <4_31>+L1251
+ extern L1252
+ <4_31>+L1252
+ extern L1253
+ <4_31>+L1253
+ extern L1254
+ <4_31>+L1254
+ extern L1255
+ <4_31>+L1255
+ extern L1256
+ <4_31>+L1256
+ extern L1257
+ <4_31>+L1257
+ extern L1258
+ <4_31>+L1258
+ extern L1259
+ <4_31>+L1259
+ extern L1260
+ <4_31>+L1260
+ extern L1261
+ <4_31>+L1261
+ extern L1262
+ <4_31>+L1262
+ extern L1263
+ <4_31>+L1263
+ extern L1264
+ <4_31>+L1264
+ extern L1265
+ <4_31>+L1265
+ extern L1266
+ <4_31>+L1266
+ extern L1267
+ <4_31>+L1267
+ extern L1268
+ <4_31>+L1268
+ extern L1269
+ <4_31>+L1269
+ extern L1270
+ <4_31>+L1270
+ extern L1271
+ <4_31>+L1271
+ extern L1272
+ <4_31>+L1272
+ extern L1273
+ <4_31>+L1273
+ extern L1274
+ <4_31>+L1274
+ extern L1275
+ <4_31>+L1275
+ extern L1276
+ <4_31>+L1276
+ extern L1277
+ <4_31>+L1277
+ extern L1278
+ <4_31>+L1278
+ extern L1279
+ <4_31>+L1279
+ extern L1280
+ <4_31>+L1280
+ extern L1281
+ <4_31>+L1281
+ extern L1282
+ <4_31>+L1282
+ extern L1283
+ <4_31>+L1283
+ extern L1284
+ <4_31>+L1284
+ extern L1285
+ <4_31>+L1285
+ extern L1286
+ <4_31>+L1286
+ extern L1287
+ <4_31>+L1287
+ extern L1288
+ <4_31>+L1288
+ extern L1289
+ <4_31>+L1289
+ extern L1290
+ <4_31>+L1290
+ extern L1291
+ <4_31>+L1291
+ extern L1292
+ <4_31>+L1292
+ extern L1293
+ <4_31>+L1293
+ extern L1294
+ <4_31>+L1294
+ extern L1295
+ <4_31>+L1295
+ extern L1296
+ <4_31>+L1296
+ extern L1297
+ <4_31>+L1297
+ extern L1298
+ <4_31>+L1298
+ extern L1299
+ <4_31>+L1299
+ extern L1300
+ <4_31>+L1300
+ extern L1301
+ <4_31>+L1301
+ extern L1302
+ <4_31>+L1302
+ extern L1303
+ <4_31>+L1303
+ extern L1304
+ <4_31>+L1304
+ extern L1305
+ <4_31>+L1305
+ extern L1306
+ <4_31>+L1306
+ extern L1307
+ <4_31>+L1307
+ extern L1308
+ <4_31>+L1308
+ extern L1309
+ <4_31>+L1309
+ extern L1310
+ <4_31>+L1310
+ extern L1311
+ <4_31>+L1311
+ extern L1312
+ <4_31>+L1312
+ extern L1313
+ <4_31>+L1313
+ extern L1314
+ <4_31>+L1314
+ extern L1315
+ <4_31>+L1315
+ extern L1316
+ <4_31>+L1316
+ extern L1317
+ <4_31>+L1317
+ extern L1318
+ <4_31>+L1318
+ extern L1319
+ <4_31>+L1319
+ extern L1320
+ <4_31>+L1320
+ extern L1321
+ <4_31>+L1321
+ extern L1322
+ <4_31>+L1322
+ extern L1323
+ <4_31>+L1323
+ extern L1324
+ <4_31>+L1324
+ extern L1325
+ <4_31>+L1325
+ extern L1326
+ <4_31>+L1326
+ extern L1327
+ <4_31>+L1327
+ extern L1328
+ <4_31>+L1328
+ extern L1329
+ <4_31>+L1329
+ extern L1330
+ <4_31>+L1330
+ extern L1331
+ <4_31>+L1331
+ extern L1332
+ <4_31>+L1332
+ extern L1333
+ <4_31>+L1333
+ extern L1334
+ <4_31>+L1334
+ extern L1335
+ <4_31>+L1335
+ extern L1336
+ <4_31>+L1336
+ extern L1337
+ <4_31>+L1337
+ extern L1338
+ <4_31>+L1338
+ extern L1339
+ <4_31>+L1339
+ extern L1340
+ <4_31>+L1340
+ extern L1341
+ <4_31>+L1341
+ extern L1342
+ <4_31>+L1342
+ extern L1343
+ <4_31>+L1343
+ extern L1344
+ <4_31>+L1344
+ extern L1345
+ <4_31>+L1345
+ extern L1346
+ <4_31>+L1346
+ extern L1347
+ <4_31>+L1347
+ extern L1348
+ <4_31>+L1348
+ extern L1349
+ <4_31>+L1349
+ extern L1350
+ <4_31>+L1350
+ extern L1351
+ <4_31>+L1351
+ extern L1352
+ <4_31>+L1352
+ extern L1353
+ <4_31>+L1353
+ extern L1354
+ <4_31>+L1354
+ extern L1355
+ <4_31>+L1355
+ extern L1356
+ <4_31>+L1356
+ extern L1357
+ <4_31>+L1357
+ extern L1358
+ <4_31>+L1358
+ extern L1359
+ <4_31>+L1359
+ extern L1360
+ <4_31>+L1360
+ extern L1361
+ <4_31>+L1361
+ extern L1362
+ <4_31>+L1362
+ extern L1363
+ <4_31>+L1363
+ extern L1364
+ <4_31>+L1364
+ extern L1365
+ <4_31>+L1365
+ extern L1366
+ <4_31>+L1366
+ extern L1367
+ <4_31>+L1367
+ extern L1368
+ <4_31>+L1368
+ extern L1369
+ <4_31>+L1369
+ extern L1370
+ <4_31>+L1370
+ extern L1371
+ <4_31>+L1371
+ extern L1372
+ <4_31>+L1372
+ extern L1373
+ <4_31>+L1373
+ extern L1374
+ <4_31>+L1374
+ extern L1375
+ <4_31>+L1375
+ extern L1376
+ <4_31>+L1376
+ extern L1377
+ <4_31>+L1377
+ extern L1378
+ <4_31>+L1378
+ extern L1379
+ <4_31>+L1379
+ extern L1380
+ <4_31>+L1380
+ extern L1381
+ <4_31>+L1381
+ extern L1382
+ <4_31>+L1382
+ extern L1383
+ <4_31>+L1383
+ extern L1384
+ <4_31>+L1384
+ extern L1385
+ <4_31>+L1385
+ extern L1386
+ <4_31>+L1386
+ extern L1387
+ <4_31>+L1387
+ extern L1388
+ <4_31>+L1388
+ extern L1389
+ <4_31>+L1389
+ extern L1390
+ <4_31>+L1390
+ extern L1391
+ <4_31>+L1391
+ extern L1392
+ <4_31>+L1392
+ extern L1393
+ <4_31>+L1393
+ extern L1394
+ <4_31>+L1394
+ extern L1395
+ <4_31>+L1395
+ extern L1396
+ <4_31>+L1396
+ extern L1397
+ <4_31>+L1397
+ extern L1398
+ <4_31>+L1398
+ extern L1399
+ <4_31>+L1399
+ extern L1400
+ <4_31>+L1400
+ extern L1401
+ <4_31>+L1401
+ extern L1402
+ <4_31>+L1402
+ extern L1403
+ <4_31>+L1403
+ extern L1404
+ <4_31>+L1404
+ extern L1405
+ <4_31>+L1405
+ extern L1406
+ <4_31>+L1406
+ extern L1407
+ <4_31>+L1407
+ extern L1408
+ <4_31>+L1408
+ extern L1409
+ <4_31>+L1409
+ extern L1410
+ <4_31>+L1410
+ extern L1411
+ <4_31>+L1411
+ extern L1412
+ <4_31>+L1412
+ extern L1413
+ <4_31>+L1413
+ extern L1414
+ <4_31>+L1414
+ extern L1415
+ <4_31>+L1415
+ extern L1416
+ <4_31>+L1416
+ extern L1417
+ <4_31>+L1417
+ extern L1418
+ <4_31>+L1418
+ extern L1419
+ <4_31>+L1419
+ extern L1420
+ <4_31>+L1420
+ extern L1421
+ <4_31>+L1421
+ extern L1422
+ <4_31>+L1422
+ extern L1423
+ <4_31>+L1423
+ extern L1424
+ <4_31>+L1424
+ extern L1425
+ <4_31>+L1425
+ extern L1426
+ <4_31>+L1426
+ extern L1427
+ <4_31>+L1427
+ extern L1428
+ <4_31>+L1428
+ extern L1429
+ <4_31>+L1429
+ extern L1430
+ <4_31>+L1430
+ extern L1431
+ <4_31>+L1431
+ extern L1432
+ <4_31>+L1432
+ extern L1433
+ <4_31>+L1433
+ extern L1434
+ <4_31>+L1434
+ extern L1435
+ <4_31>+L1435
+ extern L1436
+ <4_31>+L1436
+ extern L1437
+ <4_31>+L1437
+ extern L1438
+ <4_31>+L1438
+ extern L1439
+ <4_31>+L1439
+ extern L1440
+ <4_31>+L1440
+ extern L1441
+ <4_31>+L1441
+ extern L1442
+ <4_31>+L1442
+ extern L1443
+ <4_31>+L1443
+ extern L1444
+ <4_31>+L1444
+ extern L1445
+ <4_31>+L1445
+ extern L1446
+ <4_31>+L1446
+ extern L1447
+ <4_31>+L1447
+ extern L1448
+ <4_31>+L1448
+ extern L1449
+ <4_31>+L1449
+ extern L1450
+ <4_31>+L1450
+ extern L1451
+ <4_31>+L1451
+ extern L1452
+ <4_31>+L1452
+ extern L1453
+ <4_31>+L1453
+ extern L1454
+ <4_31>+L1454
+ extern L1455
+ <4_31>+L1455
+ extern L1456
+ <4_31>+L1456
+ extern L1457
+ <4_31>+L1457
+ extern L1458
+ <4_31>+L1458
+ extern L1459
+ <4_31>+L1459
+ extern L1460
+ <4_31>+L1460
+ extern L1461
+ <4_31>+L1461
+ extern L1462
+ <4_31>+L1462
+ extern L1463
+ <4_31>+L1463
+ extern L1464
+ <4_31>+L1464
+ extern L1465
+ <4_31>+L1465
+ extern L1466
+ <4_31>+L1466
+ extern L1467
+ <4_31>+L1467
+ extern L1468
+ <4_31>+L1468
+ extern L1469
+ <4_31>+L1469
+ extern L1470
+ <4_31>+L1470
+ extern L1471
+ <4_31>+L1471
+ extern L1472
+ <4_31>+L1472
+ extern L1473
+ <4_31>+L1473
+ extern L1474
+ <4_31>+L1474
+ extern L1475
+ <4_31>+L1475
+ 372
+ 373
+ 374
+ 375
+ 376
+ 377
+ 378
+ 379
+ 380
+ 381
+ 382
+ 383
+ 384
+ 385
+ 386
+ 387
+ 388
+ 389
+ 390
+ 391
+ 392
+ 393
+ 394
+ 395
+ 396
+ 397
+ 398
+ 399
+ 400
+ 401
+ 402
+ 403
+ 404
+ 405
+ 406
+ 407
+ 408
+ 409
+ 410
+ 411
+ 412
+ 413
+ 414
+ 415
+ 416
+ 417
+ 418
+ 419
+ 420
+ 421
+ 422
+ 423
+ 424
+ 425
+ 426
+ 427
+ 428
+ 429
+ 430
+ 431
+ 432
+ 433
+ 434
+ 435
+ 436
+ 437
+ 438
+ 439
+ 440
+ 441
+ 442
+ 443
+ 444
+ 445
+ 446
+ 447
+ 448
+ 449
+ 450
+ 451
+ 452
+ 453
+ 454
+ 455
+ 456
+ 457
+ 458
+ 459
+ 460
+ 461
+ 462
+ 463
+ 464
+ 465
+ 466
+ 467
+ 468
+ 469
+ 470
+ 471
+ 472
+ 473
+ 474
+ 475
+ 476
+ 477
+ 478
+ 479
+ 480
+ 481
+ 482
+ 483
+ 484
+ 485
+ 486
+ 487
+ 488
+ 489
+ 490
+ 491
+ 492
+ 493
+ 494
+ 495
+ 496
+ 497
+ 498
+ 499
+ 500
+ 0
+SYMFNC: intern SYMFNC
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L0024
+ jrst L0024##
+ extern L0017
+ jrst L0017##
+ extern L0026
+ jrst L0026##
+ extern L0034
+ jrst L0034##
+ extern PRTITM
+ jrst PRTITM##
+ extern PRIN1
+ jrst PRIN1##
+ extern L0025
+ jrst L0025##
+ extern L0028
+ jrst L0028##
+ extern L0042
+ jrst L0042##
+ extern PRIN2
+ jrst PRIN2##
+ extern TERPRI
+ jrst TERPRI##
+ extern PRINT
+ jrst PRINT##
+ extern PRIN2T
+ jrst PRIN2T##
+ extern PUTC
+ jrst PUTC##
+ extern PBLANK
+ jrst PBLANK##
+ extern L0021
+ jrst L0021##
+ extern L1022
+ jrst L1022##
+ extern L1023
+ jrst L1023##
+ JRST SYMFNC+348
+ extern QUIT
+ jrst QUIT##
+ extern ERROR
+ jrst ERROR##
+ extern L0093
+ jrst L0093##
+ extern L0094
+ jrst L0094##
+ JRST SYMFNC+348
+ extern L0095
+ jrst L0095##
+ JRST SYMFNC+348
+ extern L0098
+ jrst L0098##
+ extern L0099
+ jrst L0099##
+ extern L0102
+ jrst L0102##
+ extern L0103
+ jrst L0103##
+ extern L0106
+ jrst L0106##
+ JRST SYMFNC+348
+ extern L0156
+ jrst L0156##
+ extern L0165
+ jrst L0165##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L0172
+ jrst L0172##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L1101
+ jrst L1101##
+ extern L0177
+ jrst L0177##
+ extern L0182
+ jrst L0182##
+ JRST SYMFNC+348
+ extern L1026
+ jrst L1026##
+ extern GTHEAP
+ jrst GTHEAP##
+ extern GTSTR
+ jrst GTSTR##
+ extern GTVECT
+ jrst GTVECT##
+ extern L0191
+ jrst L0191##
+ extern GTID
+ jrst GTID##
+ extern L0192
+ jrst L0192##
+ extern CONS
+ jrst CONS##
+ extern XCONS
+ jrst XCONS##
+ extern NCONS
+ jrst NCONS##
+ extern MKVECT
+ jrst MKVECT##
+ extern LIST2
+ jrst LIST2##
+ extern LIST3
+ jrst LIST3##
+ extern LIST4
+ jrst LIST4##
+ extern LIST5
+ jrst LIST5##
+ JRST SYMFNC+348
+ extern L0209
+ jrst L0209##
+ extern EQSTR
+ jrst EQSTR##
+ extern L0222
+ jrst L0222##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L0224
+ jrst L0224##
+ extern L0230
+ jrst L0230##
+ extern L0233
+ jrst L0233##
+ extern L0246
+ jrst L0246##
+ extern DIGITP
+ jrst DIGITP##
+ extern L0237
+ jrst L0237##
+ extern L0297
+ jrst L0297##
+ extern READID
+ jrst READID##
+ extern RATOM
+ jrst RATOM##
+ extern WHITEP
+ jrst WHITEP##
+ extern GETC
+ jrst GETC##
+ extern L1021
+ jrst L1021##
+ extern L0241
+ jrst L0241##
+ extern L0252
+ jrst L0252##
+ extern L0301
+ jrst L0301##
+ extern INTERN
+ jrst INTERN##
+ extern L0295
+ jrst L0295##
+ extern ALPHAP
+ jrst ALPHAP##
+ extern L0291
+ jrst L0291##
+ extern L0270
+ jrst L0270##
+ extern L0263
+ jrst L0263##
+ extern L0330
+ jrst L0330##
+ extern L0287
+ jrst L0287##
+ extern L0299
+ jrst L0299##
+ extern READ1
+ jrst READ1##
+ extern READ
+ jrst READ##
+ extern L0310
+ jrst L0310##
+ extern QUOTE
+ jrst QUOTE##
+ JRST SYMFNC+348
+ extern L0321
+ jrst L0321##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L0325
+ jrst L0325##
+ extern L1019
+ jrst L1019##
+ extern L0360
+ jrst L0360##
+ extern L0334
+ jrst L0334##
+ extern L1018
+ jrst L1018##
+ extern L0339
+ jrst L0339##
+ extern FCODEP
+ jrst FCODEP##
+ extern L0350
+ jrst L0350##
+ extern L0355
+ jrst L0355##
+ extern L0359
+ jrst L0359##
+ JRST SYMFNC+348
+ extern L0370
+ jrst L0370##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L0436
+ jrst L0436##
+ extern L0365
+ jrst L0365##
+ extern L0437
+ jrst L0437##
+ JRST SYMFNC+348
+ extern L0371
+ jrst L0371##
+ extern L1060
+ jrst L1060##
+ extern L0375
+ jrst L0375##
+ extern L0398
+ jrst L0398##
+ extern L0402
+ jrst L0402##
+ extern EVAL
+ jrst EVAL##
+ extern L0429
+ jrst L0429##
+ extern L0425
+ jrst L0425##
+ extern LBIND1
+ jrst LBIND1##
+ extern GET
+ jrst GET##
+ extern L0443
+ jrst L0443##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L0515
+ jrst L0515##
+ extern L0674
+ jrst L0674##
+ extern PLUS2
+ jrst PLUS2##
+ extern MINUS
+ jrst MINUS##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern ADD1
+ jrst ADD1##
+ JRST SYMFNC+348
+ extern SUB1
+ jrst SUB1##
+ extern L0471
+ jrst L0471##
+ extern LESSP
+ jrst LESSP##
+ extern L0483
+ jrst L0483##
+ extern TIMES2
+ jrst TIMES2##
+ extern CAR
+ jrst CAR##
+ extern CDR
+ jrst CDR##
+ extern CAAR
+ jrst CAAR##
+ extern CADR
+ jrst CADR##
+ extern CDAR
+ jrst CDAR##
+ extern CDDR
+ jrst CDDR##
+ extern ATOM
+ jrst ATOM##
+ extern APPEND
+ jrst APPEND##
+ extern MEMQ
+ jrst MEMQ##
+ extern L0509
+ jrst L0509##
+ extern EVLIS
+ jrst EVLIS##
+ extern PROGN
+ jrst PROGN##
+ extern EVCOND
+ jrst EVCOND##
+ extern COND
+ jrst COND##
+ extern SET
+ jrst SET##
+ extern SETQ
+ jrst SETQ##
+ JRST SYMFNC+348
+ extern DE
+ jrst DE##
+ JRST SYMFNC+348
+ extern DF
+ jrst DF##
+ JRST SYMFNC+348
+ extern DN
+ jrst DN##
+ JRST SYMFNC+348
+ extern DM
+ jrst DM##
+ JRST SYMFNC+348
+ extern LIST
+ jrst LIST##
+ extern ATSOC
+ jrst ATSOC##
+ extern GEQ
+ jrst GEQ##
+ extern LEQ
+ jrst LEQ##
+ extern EQCAR
+ jrst EQCAR##
+ JRST SYMFNC+348
+ extern COPYD
+ jrst COPYD##
+ extern DELATQ
+ jrst DELATQ##
+ extern PUT
+ jrst PUT##
+ extern L0569
+ jrst L0569##
+ extern WHILE
+ jrst WHILE##
+ JRST SYMFNC+348
+ extern L0614
+ jrst L0614##
+ extern L0620
+ jrst L0620##
+ extern L0604
+ jrst L0604##
+ extern L0665
+ jrst L0665##
+ extern L0603
+ jrst L0603##
+ extern APPLY
+ jrst APPLY##
+ extern L0607
+ jrst L0607##
+ extern LENGTH
+ jrst LENGTH##
+ extern CODEP
+ jrst CODEP##
+ extern PAIRP
+ jrst PAIRP##
+ extern IDP
+ jrst IDP##
+ extern EQ
+ jrst EQ##
+ extern NULL
+ jrst NULL##
+ extern NOT
+ jrst NOT##
+ extern L0634
+ jrst L0634##
+ extern MAPOBL
+ jrst MAPOBL##
+ extern L0642
+ jrst L0642##
+ extern L0643
+ jrst L0643##
+ JRST SYMFNC+348
+ extern L0646
+ jrst L0646##
+ extern L0647
+ jrst L0647##
+ extern PROP
+ jrst PROP##
+ extern L0660
+ jrst L0660##
+ extern L0679
+ jrst L0679##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L1009
+ jrst L1009##
+ extern L1076
+ jrst L1076##
+ extern MAIN.
+ jrst MAIN.##
+ extern INIT
+ jrst INIT##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern TIMC
+ jrst TIMC##
+ extern DATE
+ jrst DATE##
+ extern L1017
+ jrst L1017##
+ extern PUTINT
+ jrst PUTINT##
+ extern L1020
+ jrst L1020##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern FLAG
+ jrst FLAG##
+ JRST SYMFNC+348
+ extern L1034
+ jrst L1034##
+ extern L1029
+ jrst L1029##
+ extern SPACED
+ jrst SPACED##
+ extern DASHED
+ jrst DASHED##
+ extern DOTTED
+ jrst DOTTED##
+ extern L1051
+ jrst L1051##
+ extern INF
+ jrst INF##
+ extern TAG
+ jrst TAG##
+ extern MKITEM
+ jrst MKITEM##
+ extern L1095
+ jrst L1095##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L1098
+ jrst L1098##
+ extern L1083
+ jrst L1083##
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ JRST SYMFNC+348
+ extern L1104
+ jrst L1104##
+ block 130
+L0003: intern L0003
+ 371
+ end
ADDED psl-1983/20-tests/dmain5.rel
Index: psl-1983/20-tests/dmain5.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain5.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dmain6.mac
Index: psl-1983/20-tests/dmain6.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain6.mac
@@ -0,0 +1,2435 @@
+ radix 10
+STACK: block 5001
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+5000
+ intern L0002
+HEAP: block 150001
+ intern HEAP
+L0183: HEAP+0
+ intern L0183
+L0184: HEAP+150000
+ intern L0184
+L0185: 0
+ intern L0185
+L0186: 0
+ intern L0186
+BPS: block 501
+ intern BPS
+L1074: BPS+0
+ intern L1074
+L1075: BPS+0
+ intern L1075
+L1076: BPS+500
+ intern L1076
+L1077: BPS+500
+ intern L1077
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <29_31>+133
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ <29_31>+151
+ <29_31>+152
+ <29_31>+153
+ <30_31>+128
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ <29_31>+160
+ <29_31>+161
+ <29_31>+162
+ <29_31>+163
+ <29_31>+164
+ <29_31>+165
+ <29_31>+166
+ <29_31>+167
+ <29_31>+168
+ <29_31>+169
+ <29_31>+170
+ <29_31>+171
+ <29_31>+172
+ <29_31>+173
+ <29_31>+174
+ <29_31>+175
+ <29_31>+176
+ <29_31>+177
+ <29_31>+178
+ <29_31>+179
+ <29_31>+180
+ <29_31>+181
+ <29_31>+182
+ <29_31>+183
+ <29_31>+184
+ <29_31>+185
+ <29_31>+186
+ <29_31>+187
+ <29_31>+188
+ <29_31>+189
+ <29_31>+190
+ <29_31>+191
+ <29_31>+192
+ <29_31>+193
+ <29_31>+194
+ <29_31>+195
+ <29_31>+196
+ <29_31>+197
+ <29_31>+198
+ <29_31>+199
+ <29_31>+200
+ <29_31>+201
+ <29_31>+202
+ <29_31>+203
+ <29_31>+204
+ <29_31>+205
+ <29_31>+206
+ <29_31>+207
+ <29_31>+208
+ <29_31>+209
+ <29_31>+210
+ <29_31>+211
+ <29_31>+212
+ <29_31>+213
+ <29_31>+214
+ <29_31>+215
+ <29_31>+216
+ <29_31>+217
+ <29_31>+218
+ <29_31>+219
+ <29_31>+220
+ <29_31>+221
+ <29_31>+222
+ <29_31>+223
+ <29_31>+224
+ <29_31>+225
+ <29_31>+226
+ <29_31>+227
+ <29_31>+228
+ <29_31>+229
+ <29_31>+230
+ <29_31>+231
+ <29_31>+232
+ <29_31>+233
+ <29_31>+234
+ <29_31>+235
+ <29_31>+236
+ <29_31>+237
+ <29_31>+238
+ <29_31>+239
+ <29_31>+240
+ <30_31>+128
+ <29_31>+242
+ <30_31>+128
+ <30_31>+128
+ <29_31>+245
+ <29_31>+246
+ <29_31>+247
+ <29_31>+248
+ <29_31>+249
+ <29_31>+250
+ <29_31>+251
+ <29_31>+252
+ <29_31>+253
+ <29_31>+254
+ <29_31>+255
+ <29_31>+256
+ <29_31>+257
+ <29_31>+258
+ <29_31>+259
+ <29_31>+260
+ <29_31>+261
+ <29_31>+262
+ <29_31>+263
+ <29_31>+264
+ <29_31>+265
+ <29_31>+266
+ <29_31>+267
+ <29_31>+268
+ <29_31>+269
+ <29_31>+270
+ <29_31>+271
+ <29_31>+272
+ <29_31>+273
+ <29_31>+274
+ <29_31>+275
+ <29_31>+276
+ <29_31>+277
+ <29_31>+278
+ <29_31>+279
+ <29_31>+280
+ <29_31>+281
+ <29_31>+282
+ <29_31>+283
+ <29_31>+284
+ <29_31>+285
+ <29_31>+286
+ <29_31>+287
+ <29_31>+288
+ <29_31>+289
+ <29_31>+290
+ <29_31>+291
+ <29_31>+292
+ <29_31>+293
+ <29_31>+294
+ <29_31>+295
+ <29_31>+296
+ <29_31>+297
+ <29_31>+298
+ <29_31>+299
+ <29_31>+300
+ <29_31>+301
+ <29_31>+302
+ <29_31>+303
+ <29_31>+304
+ <29_31>+305
+ <29_31>+306
+ <29_31>+307
+ <29_31>+308
+ <29_31>+309
+ <29_31>+310
+ <29_31>+311
+ <29_31>+312
+ <29_31>+313
+ <29_31>+314
+ <29_31>+315
+ <29_31>+316
+ <29_31>+317
+ <29_31>+318
+ <29_31>+319
+ <29_31>+320
+ <29_31>+321
+ <29_31>+322
+ <29_31>+323
+ <29_31>+324
+ <29_31>+325
+ <29_31>+326
+ <29_31>+327
+ <29_31>+328
+ <29_31>+329
+ <29_31>+330
+ <29_31>+331
+ <29_31>+332
+ <29_31>+333
+ <29_31>+334
+ <29_31>+335
+ <29_31>+336
+ <29_31>+337
+ <29_31>+338
+ <29_31>+339
+ <29_31>+340
+ <29_31>+341
+ <29_31>+342
+ <29_31>+343
+ <29_31>+344
+ <29_31>+345
+ <29_31>+346
+ <29_31>+347
+ <29_31>+348
+ <29_31>+349
+ <29_31>+350
+ <29_31>+351
+ <30_31>+128
+ <29_31>+353
+ <29_31>+354
+ <29_31>+355
+ <29_31>+356
+ <29_31>+357
+ <29_31>+358
+ <30_31>+128
+ <30_31>+128
+ <29_31>+361
+ <29_31>+362
+ <29_31>+363
+ <29_31>+364
+ <29_31>+365
+ <29_31>+366
+ <29_31>+367
+ <29_31>+368
+ <29_31>+369
+ <29_31>+370
+ <29_31>+371
+ <29_31>+372
+ <29_31>+373
+ <29_31>+374
+ <30_31>+26
+ <29_31>+376
+ <29_31>+377
+ <29_31>+378
+ <29_31>+379
+ <29_31>+380
+ <29_31>+381
+ <29_31>+382
+ <29_31>+383
+ <29_31>+384
+ <29_31>+385
+ <29_31>+386
+ <29_31>+387
+ <29_31>+388
+ <29_31>+389
+ <29_31>+390
+ <29_31>+391
+ <29_31>+392
+ <30_31>+128
+ <30_31>+128
+ <29_31>+395
+ <29_31>+396
+ <29_31>+397
+ <29_31>+398
+ <29_31>+399
+ <29_31>+400
+ <29_31>+401
+ <29_31>+402
+ <29_31>+403
+ <29_31>+404
+ <29_31>+405
+ <29_31>+406
+ <29_31>+407
+ <29_31>+408
+ <29_31>+409
+ <29_31>+410
+ <29_31>+411
+ <29_31>+412
+ block 88
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 88
+SYMNAM: intern SYMNAM
+ extern L1305
+ <4_31>+L1305
+ extern L1306
+ <4_31>+L1306
+ extern L1307
+ <4_31>+L1307
+ extern L1308
+ <4_31>+L1308
+ extern L1309
+ <4_31>+L1309
+ extern L1310
+ <4_31>+L1310
+ extern L1311
+ <4_31>+L1311
+ extern L1312
+ <4_31>+L1312
+ extern L1313
+ <4_31>+L1313
+ extern L1314
+ <4_31>+L1314
+ extern L1315
+ <4_31>+L1315
+ extern L1316
+ <4_31>+L1316
+ extern L1317
+ <4_31>+L1317
+ extern L1318
+ <4_31>+L1318
+ extern L1319
+ <4_31>+L1319
+ extern L1320
+ <4_31>+L1320
+ extern L1321
+ <4_31>+L1321
+ extern L1322
+ <4_31>+L1322
+ extern L1323
+ <4_31>+L1323
+ extern L1324
+ <4_31>+L1324
+ extern L1325
+ <4_31>+L1325
+ extern L1326
+ <4_31>+L1326
+ extern L1327
+ <4_31>+L1327
+ extern L1328
+ <4_31>+L1328
+ extern L1329
+ <4_31>+L1329
+ extern L1330
+ <4_31>+L1330
+ extern L1331
+ <4_31>+L1331
+ extern L1332
+ <4_31>+L1332
+ extern L1333
+ <4_31>+L1333
+ extern L1334
+ <4_31>+L1334
+ extern L1335
+ <4_31>+L1335
+ extern L1336
+ <4_31>+L1336
+ extern L1337
+ <4_31>+L1337
+ extern L1338
+ <4_31>+L1338
+ extern L1339
+ <4_31>+L1339
+ extern L1340
+ <4_31>+L1340
+ extern L1341
+ <4_31>+L1341
+ extern L1342
+ <4_31>+L1342
+ extern L1343
+ <4_31>+L1343
+ extern L1344
+ <4_31>+L1344
+ extern L1345
+ <4_31>+L1345
+ extern L1346
+ <4_31>+L1346
+ extern L1347
+ <4_31>+L1347
+ extern L1348
+ <4_31>+L1348
+ extern L1349
+ <4_31>+L1349
+ extern L1350
+ <4_31>+L1350
+ extern L1351
+ <4_31>+L1351
+ extern L1352
+ <4_31>+L1352
+ extern L1353
+ <4_31>+L1353
+ extern L1354
+ <4_31>+L1354
+ extern L1355
+ <4_31>+L1355
+ extern L1356
+ <4_31>+L1356
+ extern L1357
+ <4_31>+L1357
+ extern L1358
+ <4_31>+L1358
+ extern L1359
+ <4_31>+L1359
+ extern L1360
+ <4_31>+L1360
+ extern L1361
+ <4_31>+L1361
+ extern L1362
+ <4_31>+L1362
+ extern L1363
+ <4_31>+L1363
+ extern L1364
+ <4_31>+L1364
+ extern L1365
+ <4_31>+L1365
+ extern L1366
+ <4_31>+L1366
+ extern L1367
+ <4_31>+L1367
+ extern L1368
+ <4_31>+L1368
+ extern L1369
+ <4_31>+L1369
+ extern L1370
+ <4_31>+L1370
+ extern L1371
+ <4_31>+L1371
+ extern L1372
+ <4_31>+L1372
+ extern L1373
+ <4_31>+L1373
+ extern L1374
+ <4_31>+L1374
+ extern L1375
+ <4_31>+L1375
+ extern L1376
+ <4_31>+L1376
+ extern L1377
+ <4_31>+L1377
+ extern L1378
+ <4_31>+L1378
+ extern L1379
+ <4_31>+L1379
+ extern L1380
+ <4_31>+L1380
+ extern L1381
+ <4_31>+L1381
+ extern L1382
+ <4_31>+L1382
+ extern L1383
+ <4_31>+L1383
+ extern L1384
+ <4_31>+L1384
+ extern L1385
+ <4_31>+L1385
+ extern L1386
+ <4_31>+L1386
+ extern L1387
+ <4_31>+L1387
+ extern L1388
+ <4_31>+L1388
+ extern L1389
+ <4_31>+L1389
+ extern L1390
+ <4_31>+L1390
+ extern L1391
+ <4_31>+L1391
+ extern L1392
+ <4_31>+L1392
+ extern L1393
+ <4_31>+L1393
+ extern L1394
+ <4_31>+L1394
+ extern L1395
+ <4_31>+L1395
+ extern L1396
+ <4_31>+L1396
+ extern L1397
+ <4_31>+L1397
+ extern L1398
+ <4_31>+L1398
+ extern L1399
+ <4_31>+L1399
+ extern L1400
+ <4_31>+L1400
+ extern L1401
+ <4_31>+L1401
+ extern L1402
+ <4_31>+L1402
+ extern L1403
+ <4_31>+L1403
+ extern L1404
+ <4_31>+L1404
+ extern L1405
+ <4_31>+L1405
+ extern L1406
+ <4_31>+L1406
+ extern L1407
+ <4_31>+L1407
+ extern L1408
+ <4_31>+L1408
+ extern L1409
+ <4_31>+L1409
+ extern L1410
+ <4_31>+L1410
+ extern L1411
+ <4_31>+L1411
+ extern L1412
+ <4_31>+L1412
+ extern L1413
+ <4_31>+L1413
+ extern L1414
+ <4_31>+L1414
+ extern L1415
+ <4_31>+L1415
+ extern L1416
+ <4_31>+L1416
+ extern L1417
+ <4_31>+L1417
+ extern L1418
+ <4_31>+L1418
+ extern L1419
+ <4_31>+L1419
+ extern L1420
+ <4_31>+L1420
+ extern L1421
+ <4_31>+L1421
+ extern L1422
+ <4_31>+L1422
+ extern L1423
+ <4_31>+L1423
+ extern L1424
+ <4_31>+L1424
+ extern L1425
+ <4_31>+L1425
+ extern L1426
+ <4_31>+L1426
+ extern L1427
+ <4_31>+L1427
+ extern L1428
+ <4_31>+L1428
+ extern L1429
+ <4_31>+L1429
+ extern L1430
+ <4_31>+L1430
+ extern L1431
+ <4_31>+L1431
+ extern L1432
+ <4_31>+L1432
+ extern L1433
+ <4_31>+L1433
+ extern L1434
+ <4_31>+L1434
+ extern L1435
+ <4_31>+L1435
+ extern L1436
+ <4_31>+L1436
+ extern L1437
+ <4_31>+L1437
+ extern L1438
+ <4_31>+L1438
+ extern L1439
+ <4_31>+L1439
+ extern L1440
+ <4_31>+L1440
+ extern L1441
+ <4_31>+L1441
+ extern L1442
+ <4_31>+L1442
+ extern L1443
+ <4_31>+L1443
+ extern L1444
+ <4_31>+L1444
+ extern L1445
+ <4_31>+L1445
+ extern L1446
+ <4_31>+L1446
+ extern L1447
+ <4_31>+L1447
+ extern L1448
+ <4_31>+L1448
+ extern L1449
+ <4_31>+L1449
+ extern L1450
+ <4_31>+L1450
+ extern L1451
+ <4_31>+L1451
+ extern L1452
+ <4_31>+L1452
+ extern L1453
+ <4_31>+L1453
+ extern L1454
+ <4_31>+L1454
+ extern L1455
+ <4_31>+L1455
+ extern L1456
+ <4_31>+L1456
+ extern L1457
+ <4_31>+L1457
+ extern L1458
+ <4_31>+L1458
+ extern L1459
+ <4_31>+L1459
+ extern L1460
+ <4_31>+L1460
+ extern L1461
+ <4_31>+L1461
+ extern L1462
+ <4_31>+L1462
+ extern L1463
+ <4_31>+L1463
+ extern L1464
+ <4_31>+L1464
+ extern L1465
+ <4_31>+L1465
+ extern L1466
+ <4_31>+L1466
+ extern L1467
+ <4_31>+L1467
+ extern L1468
+ <4_31>+L1468
+ extern L1469
+ <4_31>+L1469
+ extern L1470
+ <4_31>+L1470
+ extern L1471
+ <4_31>+L1471
+ extern L1472
+ <4_31>+L1472
+ extern L1473
+ <4_31>+L1473
+ extern L1474
+ <4_31>+L1474
+ extern L1475
+ <4_31>+L1475
+ extern L1476
+ <4_31>+L1476
+ extern L1477
+ <4_31>+L1477
+ extern L1478
+ <4_31>+L1478
+ extern L1479
+ <4_31>+L1479
+ extern L1480
+ <4_31>+L1480
+ extern L1481
+ <4_31>+L1481
+ extern L1482
+ <4_31>+L1482
+ extern L1483
+ <4_31>+L1483
+ extern L1484
+ <4_31>+L1484
+ extern L1485
+ <4_31>+L1485
+ extern L1486
+ <4_31>+L1486
+ extern L1487
+ <4_31>+L1487
+ extern L1488
+ <4_31>+L1488
+ extern L1489
+ <4_31>+L1489
+ extern L1490
+ <4_31>+L1490
+ extern L1491
+ <4_31>+L1491
+ extern L1492
+ <4_31>+L1492
+ extern L1493
+ <4_31>+L1493
+ extern L1494
+ <4_31>+L1494
+ extern L1495
+ <4_31>+L1495
+ extern L1496
+ <4_31>+L1496
+ extern L1497
+ <4_31>+L1497
+ extern L1498
+ <4_31>+L1498
+ extern L1499
+ <4_31>+L1499
+ extern L1500
+ <4_31>+L1500
+ extern L1501
+ <4_31>+L1501
+ extern L1502
+ <4_31>+L1502
+ extern L1503
+ <4_31>+L1503
+ extern L1504
+ <4_31>+L1504
+ extern L1505
+ <4_31>+L1505
+ extern L1506
+ <4_31>+L1506
+ extern L1507
+ <4_31>+L1507
+ extern L1508
+ <4_31>+L1508
+ extern L1509
+ <4_31>+L1509
+ extern L1510
+ <4_31>+L1510
+ extern L1511
+ <4_31>+L1511
+ extern L1512
+ <4_31>+L1512
+ extern L1513
+ <4_31>+L1513
+ extern L1514
+ <4_31>+L1514
+ extern L1515
+ <4_31>+L1515
+ extern L1516
+ <4_31>+L1516
+ extern L1517
+ <4_31>+L1517
+ extern L1518
+ <4_31>+L1518
+ extern L1519
+ <4_31>+L1519
+ extern L1520
+ <4_31>+L1520
+ extern L1521
+ <4_31>+L1521
+ extern L1522
+ <4_31>+L1522
+ extern L1523
+ <4_31>+L1523
+ extern L1524
+ <4_31>+L1524
+ extern L1525
+ <4_31>+L1525
+ extern L1526
+ <4_31>+L1526
+ extern L1527
+ <4_31>+L1527
+ extern L1528
+ <4_31>+L1528
+ extern L1529
+ <4_31>+L1529
+ extern L1530
+ <4_31>+L1530
+ extern L1531
+ <4_31>+L1531
+ extern L1532
+ <4_31>+L1532
+ extern L1533
+ <4_31>+L1533
+ extern L1534
+ <4_31>+L1534
+ extern L1535
+ <4_31>+L1535
+ extern L1536
+ <4_31>+L1536
+ extern L1537
+ <4_31>+L1537
+ extern L1538
+ <4_31>+L1538
+ extern L1539
+ <4_31>+L1539
+ extern L1540
+ <4_31>+L1540
+ extern L1541
+ <4_31>+L1541
+ extern L1542
+ <4_31>+L1542
+ extern L1543
+ <4_31>+L1543
+ extern L1544
+ <4_31>+L1544
+ extern L1545
+ <4_31>+L1545
+ extern L1546
+ <4_31>+L1546
+ extern L1547
+ <4_31>+L1547
+ extern L1548
+ <4_31>+L1548
+ extern L1549
+ <4_31>+L1549
+ extern L1550
+ <4_31>+L1550
+ extern L1551
+ <4_31>+L1551
+ extern L1552
+ <4_31>+L1552
+ extern L1553
+ <4_31>+L1553
+ extern L1554
+ <4_31>+L1554
+ extern L1555
+ <4_31>+L1555
+ extern L1556
+ <4_31>+L1556
+ extern L1557
+ <4_31>+L1557
+ extern L1558
+ <4_31>+L1558
+ extern L1559
+ <4_31>+L1559
+ extern L1560
+ <4_31>+L1560
+ extern L1561
+ <4_31>+L1561
+ extern L1562
+ <4_31>+L1562
+ extern L1563
+ <4_31>+L1563
+ extern L1564
+ <4_31>+L1564
+ extern L1565
+ <4_31>+L1565
+ extern L1566
+ <4_31>+L1566
+ extern L1567
+ <4_31>+L1567
+ extern L1568
+ <4_31>+L1568
+ extern L1569
+ <4_31>+L1569
+ extern L1570
+ <4_31>+L1570
+ extern L1571
+ <4_31>+L1571
+ extern L1572
+ <4_31>+L1572
+ extern L1573
+ <4_31>+L1573
+ extern L1574
+ <4_31>+L1574
+ extern L1575
+ <4_31>+L1575
+ extern L1576
+ <4_31>+L1576
+ extern L1577
+ <4_31>+L1577
+ extern L1578
+ <4_31>+L1578
+ extern L1579
+ <4_31>+L1579
+ extern L1580
+ <4_31>+L1580
+ extern L1581
+ <4_31>+L1581
+ extern L1582
+ <4_31>+L1582
+ extern L1583
+ <4_31>+L1583
+ extern L1584
+ <4_31>+L1584
+ extern L1585
+ <4_31>+L1585
+ extern L1586
+ <4_31>+L1586
+ extern L1587
+ <4_31>+L1587
+ extern L1588
+ <4_31>+L1588
+ extern L1589
+ <4_31>+L1589
+ extern L1590
+ <4_31>+L1590
+ extern L1591
+ <4_31>+L1591
+ extern L1592
+ <4_31>+L1592
+ extern L1593
+ <4_31>+L1593
+ extern L1594
+ <4_31>+L1594
+ extern L1595
+ <4_31>+L1595
+ extern L1596
+ <4_31>+L1596
+ extern L1597
+ <4_31>+L1597
+ extern L1598
+ <4_31>+L1598
+ extern L1599
+ <4_31>+L1599
+ extern L1600
+ <4_31>+L1600
+ extern L1601
+ <4_31>+L1601
+ extern L1602
+ <4_31>+L1602
+ extern L1603
+ <4_31>+L1603
+ extern L1604
+ <4_31>+L1604
+ extern L1605
+ <4_31>+L1605
+ extern L1606
+ <4_31>+L1606
+ extern L1607
+ <4_31>+L1607
+ extern L1608
+ <4_31>+L1608
+ extern L1609
+ <4_31>+L1609
+ extern L1610
+ <4_31>+L1610
+ extern L1611
+ <4_31>+L1611
+ extern L1612
+ <4_31>+L1612
+ extern L1613
+ <4_31>+L1613
+ extern L1614
+ <4_31>+L1614
+ extern L1615
+ <4_31>+L1615
+ extern L1616
+ <4_31>+L1616
+ extern L1617
+ <4_31>+L1617
+ extern L1618
+ <4_31>+L1618
+ extern L1619
+ <4_31>+L1619
+ extern L1620
+ <4_31>+L1620
+ extern L1621
+ <4_31>+L1621
+ extern L1622
+ <4_31>+L1622
+ extern L1623
+ <4_31>+L1623
+ extern L1624
+ <4_31>+L1624
+ extern L1625
+ <4_31>+L1625
+ extern L1626
+ <4_31>+L1626
+ extern L1627
+ <4_31>+L1627
+ extern L1628
+ <4_31>+L1628
+ extern L1629
+ <4_31>+L1629
+ extern L1630
+ <4_31>+L1630
+ extern L1631
+ <4_31>+L1631
+ extern L1632
+ <4_31>+L1632
+ extern L1633
+ <4_31>+L1633
+ extern L1634
+ <4_31>+L1634
+ extern L1635
+ <4_31>+L1635
+ extern L1636
+ <4_31>+L1636
+ extern L1637
+ <4_31>+L1637
+ extern L1638
+ <4_31>+L1638
+ extern L1639
+ <4_31>+L1639
+ extern L1640
+ <4_31>+L1640
+ extern L1641
+ <4_31>+L1641
+ extern L1642
+ <4_31>+L1642
+ extern L1643
+ <4_31>+L1643
+ extern L1644
+ <4_31>+L1644
+ extern L1645
+ <4_31>+L1645
+ extern L1646
+ <4_31>+L1646
+ extern L1647
+ <4_31>+L1647
+ extern L1648
+ <4_31>+L1648
+ extern L1649
+ <4_31>+L1649
+ extern L1650
+ <4_31>+L1650
+ extern L1651
+ <4_31>+L1651
+ extern L1652
+ <4_31>+L1652
+ extern L1653
+ <4_31>+L1653
+ extern L1654
+ <4_31>+L1654
+ extern L1655
+ <4_31>+L1655
+ extern L1656
+ <4_31>+L1656
+ extern L1657
+ <4_31>+L1657
+ extern L1658
+ <4_31>+L1658
+ extern L1659
+ <4_31>+L1659
+ extern L1660
+ <4_31>+L1660
+ extern L1661
+ <4_31>+L1661
+ extern L1662
+ <4_31>+L1662
+ extern L1663
+ <4_31>+L1663
+ extern L1664
+ <4_31>+L1664
+ extern L1665
+ <4_31>+L1665
+ extern L1666
+ <4_31>+L1666
+ extern L1667
+ <4_31>+L1667
+ extern L1668
+ <4_31>+L1668
+ extern L1669
+ <4_31>+L1669
+ extern L1670
+ <4_31>+L1670
+ extern L1671
+ <4_31>+L1671
+ extern L1672
+ <4_31>+L1672
+ extern L1673
+ <4_31>+L1673
+ extern L1674
+ <4_31>+L1674
+ extern L1675
+ <4_31>+L1675
+ extern L1676
+ <4_31>+L1676
+ extern L1677
+ <4_31>+L1677
+ extern L1678
+ <4_31>+L1678
+ extern L1679
+ <4_31>+L1679
+ extern L1680
+ <4_31>+L1680
+ extern L1681
+ <4_31>+L1681
+ extern L1682
+ <4_31>+L1682
+ extern L1683
+ <4_31>+L1683
+ extern L1684
+ <4_31>+L1684
+ extern L1685
+ <4_31>+L1685
+ extern L1686
+ <4_31>+L1686
+ extern L1687
+ <4_31>+L1687
+ extern L1688
+ <4_31>+L1688
+ extern L1689
+ <4_31>+L1689
+ extern L1690
+ <4_31>+L1690
+ extern L1691
+ <4_31>+L1691
+ extern L1692
+ <4_31>+L1692
+ extern L1693
+ <4_31>+L1693
+ extern L1694
+ <4_31>+L1694
+ extern L1695
+ <4_31>+L1695
+ extern L1696
+ <4_31>+L1696
+ extern L1697
+ <4_31>+L1697
+ extern L1698
+ <4_31>+L1698
+ extern L1699
+ <4_31>+L1699
+ extern L1700
+ <4_31>+L1700
+ extern L1701
+ <4_31>+L1701
+ extern L1702
+ <4_31>+L1702
+ extern L1703
+ <4_31>+L1703
+ extern L1704
+ <4_31>+L1704
+ extern L1705
+ <4_31>+L1705
+ extern L1706
+ <4_31>+L1706
+ extern L1707
+ <4_31>+L1707
+ extern L1708
+ <4_31>+L1708
+ extern L1709
+ <4_31>+L1709
+ extern L1710
+ <4_31>+L1710
+ extern L1711
+ <4_31>+L1711
+ extern L1712
+ <4_31>+L1712
+ extern L1713
+ <4_31>+L1713
+ extern L1714
+ <4_31>+L1714
+ extern L1715
+ <4_31>+L1715
+ extern L1716
+ <4_31>+L1716
+ extern L1717
+ <4_31>+L1717
+ 414
+ 415
+ 416
+ 417
+ 418
+ 419
+ 420
+ 421
+ 422
+ 423
+ 424
+ 425
+ 426
+ 427
+ 428
+ 429
+ 430
+ 431
+ 432
+ 433
+ 434
+ 435
+ 436
+ 437
+ 438
+ 439
+ 440
+ 441
+ 442
+ 443
+ 444
+ 445
+ 446
+ 447
+ 448
+ 449
+ 450
+ 451
+ 452
+ 453
+ 454
+ 455
+ 456
+ 457
+ 458
+ 459
+ 460
+ 461
+ 462
+ 463
+ 464
+ 465
+ 466
+ 467
+ 468
+ 469
+ 470
+ 471
+ 472
+ 473
+ 474
+ 475
+ 476
+ 477
+ 478
+ 479
+ 480
+ 481
+ 482
+ 483
+ 484
+ 485
+ 486
+ 487
+ 488
+ 489
+ 490
+ 491
+ 492
+ 493
+ 494
+ 495
+ 496
+ 497
+ 498
+ 499
+ 500
+ 0
+SYMFNC: intern SYMFNC
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern L0024
+ jrst L0024##
+ extern L0017
+ jrst L0017##
+ extern L0026
+ jrst L0026##
+ extern L0034
+ jrst L0034##
+ extern PRTITM
+ jrst PRTITM##
+ extern PRIN1
+ jrst PRIN1##
+ extern L0025
+ jrst L0025##
+ extern L0028
+ jrst L0028##
+ extern L0042
+ jrst L0042##
+ extern PRIN2
+ jrst PRIN2##
+ extern TERPRI
+ jrst TERPRI##
+ extern PRINT
+ jrst PRINT##
+ extern PRIN2T
+ jrst PRIN2T##
+ extern PUTC
+ jrst PUTC##
+ extern PBLANK
+ jrst PBLANK##
+ extern L0021
+ jrst L0021##
+ extern L1091
+ jrst L1091##
+ extern L1092
+ jrst L1092##
+ JRST SYMFNC+358
+ extern QUIT
+ jrst QUIT##
+ extern ERROR
+ jrst ERROR##
+ extern L0093
+ jrst L0093##
+ extern L0094
+ jrst L0094##
+ JRST SYMFNC+358
+ extern L0095
+ jrst L0095##
+ JRST SYMFNC+358
+ extern L0098
+ jrst L0098##
+ extern L0099
+ jrst L0099##
+ extern L0102
+ jrst L0102##
+ extern L0103
+ jrst L0103##
+ extern L0106
+ jrst L0106##
+ JRST SYMFNC+358
+ extern L0156
+ jrst L0156##
+ extern L0165
+ jrst L0165##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern L0172
+ jrst L0172##
+ JRST SYMFNC+358
+ extern L1029
+ jrst L1029##
+ extern L1019
+ jrst L1019##
+ extern L0177
+ jrst L0177##
+ extern L0182
+ jrst L0182##
+ JRST SYMFNC+358
+ extern L1095
+ jrst L1095##
+ extern GTHEAP
+ jrst GTHEAP##
+ extern GTSTR
+ jrst GTSTR##
+ extern GTVECT
+ jrst GTVECT##
+ extern L0191
+ jrst L0191##
+ extern GTID
+ jrst GTID##
+ extern L0192
+ jrst L0192##
+ extern CONS
+ jrst CONS##
+ extern XCONS
+ jrst XCONS##
+ extern NCONS
+ jrst NCONS##
+ extern MKVECT
+ jrst MKVECT##
+ extern LIST2
+ jrst LIST2##
+ extern LIST3
+ jrst LIST3##
+ extern LIST4
+ jrst LIST4##
+ extern LIST5
+ jrst LIST5##
+ JRST SYMFNC+358
+ extern L0209
+ jrst L0209##
+ extern EQSTR
+ jrst EQSTR##
+ extern L0222
+ jrst L0222##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern L0224
+ jrst L0224##
+ extern L0230
+ jrst L0230##
+ extern L0233
+ jrst L0233##
+ extern L0246
+ jrst L0246##
+ extern DIGITP
+ jrst DIGITP##
+ extern L0237
+ jrst L0237##
+ extern L0297
+ jrst L0297##
+ extern READID
+ jrst READID##
+ extern RATOM
+ jrst RATOM##
+ extern WHITEP
+ jrst WHITEP##
+ extern GETC
+ jrst GETC##
+ extern L1090
+ jrst L1090##
+ extern L0241
+ jrst L0241##
+ extern L0252
+ jrst L0252##
+ extern L0301
+ jrst L0301##
+ extern INTERN
+ jrst INTERN##
+ extern L0295
+ jrst L0295##
+ extern ALPHAP
+ jrst ALPHAP##
+ extern L0291
+ jrst L0291##
+ extern L0270
+ jrst L0270##
+ extern L0263
+ jrst L0263##
+ extern L0330
+ jrst L0330##
+ extern L0287
+ jrst L0287##
+ extern L0299
+ jrst L0299##
+ extern READ1
+ jrst READ1##
+ extern READ
+ jrst READ##
+ extern L0310
+ jrst L0310##
+ extern QUOTE
+ jrst QUOTE##
+ JRST SYMFNC+358
+ extern L0321
+ jrst L0321##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern L0325
+ jrst L0325##
+ extern L1088
+ jrst L1088##
+ extern L0360
+ jrst L0360##
+ extern L0334
+ jrst L0334##
+ extern L1087
+ jrst L1087##
+ extern L0339
+ jrst L0339##
+ extern FCODEP
+ jrst FCODEP##
+ extern L0350
+ jrst L0350##
+ extern L0355
+ jrst L0355##
+ extern L0359
+ jrst L0359##
+ JRST SYMFNC+358
+ extern L0370
+ jrst L0370##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern L0436
+ jrst L0436##
+ extern L0365
+ jrst L0365##
+ extern L0437
+ jrst L0437##
+ JRST SYMFNC+358
+ extern L0371
+ jrst L0371##
+ extern L1129
+ jrst L1129##
+ extern L0375
+ jrst L0375##
+ extern L0398
+ jrst L0398##
+ extern L0402
+ jrst L0402##
+ extern EVAL
+ jrst EVAL##
+ extern L0429
+ jrst L0429##
+ extern L0425
+ jrst L0425##
+ extern LBIND1
+ jrst LBIND1##
+ extern GET
+ jrst GET##
+ extern L0443
+ jrst L0443##
+ JRST SYMFNC+358
+ extern BLDMSG
+ jrst BLDMSG##
+ extern L0515
+ jrst L0515##
+ extern L0674
+ jrst L0674##
+ extern PLUS2
+ jrst PLUS2##
+ extern MINUS
+ jrst MINUS##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern ADD1
+ jrst ADD1##
+ JRST SYMFNC+358
+ extern SUB1
+ jrst SUB1##
+ extern L0471
+ jrst L0471##
+ extern LESSP
+ jrst LESSP##
+ extern L0483
+ jrst L0483##
+ extern TIMES2
+ jrst TIMES2##
+ extern CAR
+ jrst CAR##
+ extern CDR
+ jrst CDR##
+ extern CAAR
+ jrst CAAR##
+ extern CADR
+ jrst CADR##
+ extern CDAR
+ jrst CDAR##
+ extern CDDR
+ jrst CDDR##
+ extern ATOM
+ jrst ATOM##
+ extern APPEND
+ jrst APPEND##
+ extern MEMQ
+ jrst MEMQ##
+ extern L0509
+ jrst L0509##
+ extern EVLIS
+ jrst EVLIS##
+ extern PROGN
+ jrst PROGN##
+ extern EVCOND
+ jrst EVCOND##
+ extern COND
+ jrst COND##
+ extern SET
+ jrst SET##
+ extern SETQ
+ jrst SETQ##
+ extern PUTD
+ jrst PUTD##
+ extern DE
+ jrst DE##
+ JRST SYMFNC+358
+ extern DF
+ jrst DF##
+ JRST SYMFNC+358
+ extern DN
+ jrst DN##
+ JRST SYMFNC+358
+ extern DM
+ jrst DM##
+ JRST SYMFNC+358
+ extern LIST
+ jrst LIST##
+ extern ATSOC
+ jrst ATSOC##
+ extern GEQ
+ jrst GEQ##
+ extern LEQ
+ jrst LEQ##
+ extern EQCAR
+ jrst EQCAR##
+ extern GETD
+ jrst GETD##
+ extern COPYD
+ jrst COPYD##
+ extern DELATQ
+ jrst DELATQ##
+ extern PUT
+ jrst PUT##
+ extern L0569
+ jrst L0569##
+ extern WHILE
+ jrst WHILE##
+ JRST SYMFNC+358
+ extern L0614
+ jrst L0614##
+ extern L0620
+ jrst L0620##
+ extern L0604
+ jrst L0604##
+ extern L0665
+ jrst L0665##
+ extern L0603
+ jrst L0603##
+ extern APPLY
+ jrst APPLY##
+ extern L0607
+ jrst L0607##
+ extern LENGTH
+ jrst LENGTH##
+ extern CODEP
+ jrst CODEP##
+ extern PAIRP
+ jrst PAIRP##
+ extern IDP
+ jrst IDP##
+ extern EQ
+ jrst EQ##
+ extern NULL
+ jrst NULL##
+ extern NOT
+ jrst NOT##
+ extern L0634
+ jrst L0634##
+ extern MAPOBL
+ jrst MAPOBL##
+ extern L0642
+ jrst L0642##
+ extern L0643
+ jrst L0643##
+ JRST SYMFNC+358
+ extern L0646
+ jrst L0646##
+ extern L0647
+ jrst L0647##
+ extern PROP
+ jrst PROP##
+ extern L0660
+ jrst L0660##
+ extern L0679
+ jrst L0679##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern RESET
+ jrst RESET##
+ extern L1010
+ jrst L1010##
+ JRST SYMFNC+358
+ extern L1013
+ jrst L1013##
+ extern L1014
+ jrst L1014##
+ extern L1015
+ jrst L1015##
+ JRST SYMFNC+358
+ extern L1018
+ jrst L1018##
+ extern PBIND1
+ jrst PBIND1##
+ extern L1032
+ jrst L1032##
+ extern L1078
+ jrst L1078##
+ extern L1148
+ jrst L1148##
+ extern MAIN.
+ jrst MAIN.##
+ extern INIT
+ jrst INIT##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern TIMC
+ jrst TIMC##
+ extern DATE
+ jrst DATE##
+ extern L1086
+ jrst L1086##
+ extern PUTINT
+ jrst PUTINT##
+ extern L1089
+ jrst L1089##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern FLAG
+ jrst FLAG##
+ JRST SYMFNC+358
+ extern L1103
+ jrst L1103##
+ extern L1098
+ jrst L1098##
+ extern SPACED
+ jrst SPACED##
+ extern DASHED
+ jrst DASHED##
+ extern DOTTED
+ jrst DOTTED##
+ extern L1120
+ jrst L1120##
+ extern INF
+ jrst INF##
+ extern TAG
+ jrst TAG##
+ extern MKITEM
+ jrst MKITEM##
+ extern TIME
+ jrst TIME##
+ extern L1134
+ jrst L1134##
+ extern L1304
+ jrst L1304##
+ JRST SYMFNC+358
+ extern L1163
+ jrst L1163##
+ extern L1244
+ jrst L1244##
+ extern L1282
+ jrst L1282##
+ extern L1153
+ jrst L1153##
+ JRST SYMFNC+358
+ extern L1254
+ jrst L1254##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern L1270
+ jrst L1270##
+ extern L1262
+ jrst L1262##
+ JRST SYMFNC+358
+ extern L1245
+ jrst L1245##
+ JRST SYMFNC+358
+ extern CBIND1
+ jrst CBIND1##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ extern CBIND2
+ jrst CBIND2##
+ JRST SYMFNC+358
+ JRST SYMFNC+358
+ block 88
+L0003: intern L0003
+ 413
+ end
ADDED psl-1983/20-tests/dmain6.rel
Index: psl-1983/20-tests/dmain6.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain6.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dmain7.mac
Index: psl-1983/20-tests/dmain7.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain7.mac
@@ -0,0 +1,2703 @@
+ radix 10
+STACK: block 5001
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+5000
+ intern L0002
+HEAP: block 150001
+ intern HEAP
+L0183: HEAP+0
+ intern L0183
+L0184: HEAP+150000
+ intern L0184
+L0185: 0
+ intern L0185
+L0186: 0
+ intern L0186
+BPS: block 501
+ intern BPS
+L1185: BPS+0
+ intern L1185
+L1186: BPS+0
+ intern L1186
+L1187: BPS+500
+ intern L1187
+L1188: BPS+500
+ intern L1188
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <29_31>+133
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ <29_31>+151
+ <29_31>+152
+ <29_31>+153
+ 1
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ <29_31>+160
+ <29_31>+161
+ <29_31>+162
+ <29_31>+163
+ <29_31>+164
+ <29_31>+165
+ <29_31>+166
+ <29_31>+167
+ <29_31>+168
+ <29_31>+169
+ <29_31>+170
+ <29_31>+171
+ <29_31>+172
+ <29_31>+173
+ <29_31>+174
+ <29_31>+175
+ <29_31>+176
+ <29_31>+177
+ <29_31>+178
+ <29_31>+179
+ <29_31>+180
+ <29_31>+181
+ <29_31>+182
+ <29_31>+183
+ <29_31>+184
+ <29_31>+185
+ <29_31>+186
+ <29_31>+187
+ <29_31>+188
+ <29_31>+189
+ <29_31>+190
+ <29_31>+191
+ <29_31>+192
+ <29_31>+193
+ <29_31>+194
+ <29_31>+195
+ <29_31>+196
+ <29_31>+197
+ <29_31>+198
+ <29_31>+199
+ <29_31>+200
+ <29_31>+201
+ <29_31>+202
+ <29_31>+203
+ <29_31>+204
+ <29_31>+205
+ <29_31>+206
+ <29_31>+207
+ <29_31>+208
+ <29_31>+209
+ <29_31>+210
+ <29_31>+211
+ <29_31>+212
+ <29_31>+213
+ <29_31>+214
+ <29_31>+215
+ <29_31>+216
+ <29_31>+217
+ <29_31>+218
+ <29_31>+219
+ <29_31>+220
+ <29_31>+221
+ <29_31>+222
+ <29_31>+223
+ <29_31>+224
+ <29_31>+225
+ <29_31>+226
+ <29_31>+227
+ <29_31>+228
+ <29_31>+229
+ <29_31>+230
+ <29_31>+231
+ <29_31>+232
+ <29_31>+233
+ <29_31>+234
+ <29_31>+235
+ <29_31>+236
+ <29_31>+237
+ <29_31>+238
+ <29_31>+239
+ <29_31>+240
+ <30_31>+128
+ <29_31>+242
+ <30_31>+128
+ <30_31>+128
+ <29_31>+245
+ <29_31>+246
+ <29_31>+247
+ <29_31>+248
+ <29_31>+249
+ <29_31>+250
+ <29_31>+251
+ <29_31>+252
+ <29_31>+253
+ <29_31>+254
+ <29_31>+255
+ <29_31>+256
+ <29_31>+257
+ <29_31>+258
+ <29_31>+259
+ <29_31>+260
+ <29_31>+261
+ <29_31>+262
+ <29_31>+263
+ <29_31>+264
+ <29_31>+265
+ <29_31>+266
+ <29_31>+267
+ <29_31>+268
+ <29_31>+269
+ <29_31>+270
+ <29_31>+271
+ <29_31>+272
+ <29_31>+273
+ <29_31>+274
+ <29_31>+275
+ <29_31>+276
+ <29_31>+277
+ <29_31>+278
+ <29_31>+279
+ <29_31>+280
+ <29_31>+281
+ <29_31>+282
+ <29_31>+283
+ <29_31>+284
+ <29_31>+285
+ <29_31>+286
+ <29_31>+287
+ <29_31>+288
+ <29_31>+289
+ <29_31>+290
+ <29_31>+291
+ <29_31>+292
+ <29_31>+293
+ <29_31>+294
+ <29_31>+295
+ <29_31>+296
+ <29_31>+297
+ <29_31>+298
+ <29_31>+299
+ <29_31>+300
+ <29_31>+301
+ <29_31>+302
+ <29_31>+303
+ <29_31>+304
+ <29_31>+305
+ <29_31>+306
+ <29_31>+307
+ <29_31>+308
+ <29_31>+309
+ <29_31>+310
+ <29_31>+311
+ <29_31>+312
+ <29_31>+313
+ <29_31>+314
+ <29_31>+315
+ <29_31>+316
+ <29_31>+317
+ <29_31>+318
+ <29_31>+319
+ <29_31>+320
+ <29_31>+321
+ <29_31>+322
+ <29_31>+323
+ <29_31>+324
+ <29_31>+325
+ <29_31>+326
+ <29_31>+327
+ <29_31>+328
+ <29_31>+329
+ <29_31>+330
+ <29_31>+331
+ <29_31>+332
+ <29_31>+333
+ <29_31>+334
+ <29_31>+335
+ <29_31>+336
+ <29_31>+337
+ <29_31>+338
+ <29_31>+339
+ 5
+ <29_31>+341
+ <29_31>+342
+ <29_31>+343
+ <29_31>+344
+ <29_31>+345
+ <29_31>+346
+ <29_31>+347
+ <29_31>+348
+ <29_31>+349
+ <29_31>+350
+ <29_31>+351
+ <29_31>+352
+ <29_31>+353
+ <29_31>+354
+ <29_31>+355
+ <29_31>+356
+ <29_31>+357
+ <29_31>+358
+ <29_31>+359
+ <29_31>+360
+ <29_31>+361
+ <29_31>+362
+ <29_31>+363
+ <29_31>+364
+ <29_31>+365
+ <29_31>+366
+ <29_31>+367
+ <29_31>+368
+ <30_31>+10
+ <29_31>+370
+ <29_31>+371
+ <29_31>+372
+ <29_31>+373
+ <29_31>+374
+ <29_31>+375
+ <29_31>+376
+ <30_31>+26
+ <30_31>+128
+ <30_31>+128
+ <29_31>+380
+ <29_31>+381
+ <29_31>+382
+ <29_31>+383
+ <29_31>+384
+ 0
+ 0
+ 1
+ 6
+ <29_31>+389
+ <29_31>+390
+ <29_31>+391
+ <29_31>+392
+ <29_31>+393
+ <29_31>+394
+ <29_31>+395
+ <29_31>+396
+ <29_31>+397
+ <29_31>+398
+ <29_31>+399
+ <29_31>+400
+ <29_31>+401
+ <29_31>+402
+ <29_31>+403
+ <29_31>+404
+ <29_31>+405
+ <29_31>+406
+ <29_31>+407
+ <30_31>+128
+ <30_31>+128
+ <29_31>+410
+ <29_31>+411
+ <29_31>+412
+ <29_31>+413
+ <29_31>+414
+ <29_31>+415
+ <29_31>+416
+ <29_31>+417
+ <29_31>+418
+ <29_31>+419
+ <29_31>+420
+ <29_31>+421
+ <29_31>+422
+ <29_31>+423
+ <29_31>+424
+ <29_31>+425
+ <29_31>+426
+ <29_31>+427
+ <29_31>+428
+ <29_31>+429
+ <29_31>+430
+ <29_31>+431
+ <29_31>+432
+ <29_31>+433
+ <29_31>+434
+ <29_31>+435
+ <29_31>+436
+ <29_31>+437
+ <29_31>+438
+ <29_31>+439
+ <29_31>+440
+ <29_31>+441
+ <29_31>+442
+ <29_31>+443
+ <29_31>+444
+ <29_31>+445
+ <29_31>+446
+ <29_31>+447
+ <29_31>+448
+ <29_31>+449
+ <29_31>+450
+ <29_31>+451
+ <29_31>+452
+ <29_31>+453
+ <29_31>+454
+ <29_31>+455
+ <29_31>+456
+ <29_31>+457
+ <29_31>+458
+ <29_31>+459
+ <29_31>+460
+ <29_31>+461
+ <30_31>+128
+ <29_31>+463
+ <29_31>+464
+ <29_31>+465
+ block 35
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 35
+SYMNAM: intern SYMNAM
+ extern L1444
+ <4_31>+L1444
+ extern L1445
+ <4_31>+L1445
+ extern L1446
+ <4_31>+L1446
+ extern L1447
+ <4_31>+L1447
+ extern L1448
+ <4_31>+L1448
+ extern L1449
+ <4_31>+L1449
+ extern L1450
+ <4_31>+L1450
+ extern L1451
+ <4_31>+L1451
+ extern L1452
+ <4_31>+L1452
+ extern L1453
+ <4_31>+L1453
+ extern L1454
+ <4_31>+L1454
+ extern L1455
+ <4_31>+L1455
+ extern L1456
+ <4_31>+L1456
+ extern L1457
+ <4_31>+L1457
+ extern L1458
+ <4_31>+L1458
+ extern L1459
+ <4_31>+L1459
+ extern L1460
+ <4_31>+L1460
+ extern L1461
+ <4_31>+L1461
+ extern L1462
+ <4_31>+L1462
+ extern L1463
+ <4_31>+L1463
+ extern L1464
+ <4_31>+L1464
+ extern L1465
+ <4_31>+L1465
+ extern L1466
+ <4_31>+L1466
+ extern L1467
+ <4_31>+L1467
+ extern L1468
+ <4_31>+L1468
+ extern L1469
+ <4_31>+L1469
+ extern L1470
+ <4_31>+L1470
+ extern L1471
+ <4_31>+L1471
+ extern L1472
+ <4_31>+L1472
+ extern L1473
+ <4_31>+L1473
+ extern L1474
+ <4_31>+L1474
+ extern L1475
+ <4_31>+L1475
+ extern L1476
+ <4_31>+L1476
+ extern L1477
+ <4_31>+L1477
+ extern L1478
+ <4_31>+L1478
+ extern L1479
+ <4_31>+L1479
+ extern L1480
+ <4_31>+L1480
+ extern L1481
+ <4_31>+L1481
+ extern L1482
+ <4_31>+L1482
+ extern L1483
+ <4_31>+L1483
+ extern L1484
+ <4_31>+L1484
+ extern L1485
+ <4_31>+L1485
+ extern L1486
+ <4_31>+L1486
+ extern L1487
+ <4_31>+L1487
+ extern L1488
+ <4_31>+L1488
+ extern L1489
+ <4_31>+L1489
+ extern L1490
+ <4_31>+L1490
+ extern L1491
+ <4_31>+L1491
+ extern L1492
+ <4_31>+L1492
+ extern L1493
+ <4_31>+L1493
+ extern L1494
+ <4_31>+L1494
+ extern L1495
+ <4_31>+L1495
+ extern L1496
+ <4_31>+L1496
+ extern L1497
+ <4_31>+L1497
+ extern L1498
+ <4_31>+L1498
+ extern L1499
+ <4_31>+L1499
+ extern L1500
+ <4_31>+L1500
+ extern L1501
+ <4_31>+L1501
+ extern L1502
+ <4_31>+L1502
+ extern L1503
+ <4_31>+L1503
+ extern L1504
+ <4_31>+L1504
+ extern L1505
+ <4_31>+L1505
+ extern L1506
+ <4_31>+L1506
+ extern L1507
+ <4_31>+L1507
+ extern L1508
+ <4_31>+L1508
+ extern L1509
+ <4_31>+L1509
+ extern L1510
+ <4_31>+L1510
+ extern L1511
+ <4_31>+L1511
+ extern L1512
+ <4_31>+L1512
+ extern L1513
+ <4_31>+L1513
+ extern L1514
+ <4_31>+L1514
+ extern L1515
+ <4_31>+L1515
+ extern L1516
+ <4_31>+L1516
+ extern L1517
+ <4_31>+L1517
+ extern L1518
+ <4_31>+L1518
+ extern L1519
+ <4_31>+L1519
+ extern L1520
+ <4_31>+L1520
+ extern L1521
+ <4_31>+L1521
+ extern L1522
+ <4_31>+L1522
+ extern L1523
+ <4_31>+L1523
+ extern L1524
+ <4_31>+L1524
+ extern L1525
+ <4_31>+L1525
+ extern L1526
+ <4_31>+L1526
+ extern L1527
+ <4_31>+L1527
+ extern L1528
+ <4_31>+L1528
+ extern L1529
+ <4_31>+L1529
+ extern L1530
+ <4_31>+L1530
+ extern L1531
+ <4_31>+L1531
+ extern L1532
+ <4_31>+L1532
+ extern L1533
+ <4_31>+L1533
+ extern L1534
+ <4_31>+L1534
+ extern L1535
+ <4_31>+L1535
+ extern L1536
+ <4_31>+L1536
+ extern L1537
+ <4_31>+L1537
+ extern L1538
+ <4_31>+L1538
+ extern L1539
+ <4_31>+L1539
+ extern L1540
+ <4_31>+L1540
+ extern L1541
+ <4_31>+L1541
+ extern L1542
+ <4_31>+L1542
+ extern L1543
+ <4_31>+L1543
+ extern L1544
+ <4_31>+L1544
+ extern L1545
+ <4_31>+L1545
+ extern L1546
+ <4_31>+L1546
+ extern L1547
+ <4_31>+L1547
+ extern L1548
+ <4_31>+L1548
+ extern L1549
+ <4_31>+L1549
+ extern L1550
+ <4_31>+L1550
+ extern L1551
+ <4_31>+L1551
+ extern L1552
+ <4_31>+L1552
+ extern L1553
+ <4_31>+L1553
+ extern L1554
+ <4_31>+L1554
+ extern L1555
+ <4_31>+L1555
+ extern L1556
+ <4_31>+L1556
+ extern L1557
+ <4_31>+L1557
+ extern L1558
+ <4_31>+L1558
+ extern L1559
+ <4_31>+L1559
+ extern L1560
+ <4_31>+L1560
+ extern L1561
+ <4_31>+L1561
+ extern L1562
+ <4_31>+L1562
+ extern L1563
+ <4_31>+L1563
+ extern L1564
+ <4_31>+L1564
+ extern L1565
+ <4_31>+L1565
+ extern L1566
+ <4_31>+L1566
+ extern L1567
+ <4_31>+L1567
+ extern L1568
+ <4_31>+L1568
+ extern L1569
+ <4_31>+L1569
+ extern L1570
+ <4_31>+L1570
+ extern L1571
+ <4_31>+L1571
+ extern L1572
+ <4_31>+L1572
+ extern L1573
+ <4_31>+L1573
+ extern L1574
+ <4_31>+L1574
+ extern L1575
+ <4_31>+L1575
+ extern L1576
+ <4_31>+L1576
+ extern L1577
+ <4_31>+L1577
+ extern L1578
+ <4_31>+L1578
+ extern L1579
+ <4_31>+L1579
+ extern L1580
+ <4_31>+L1580
+ extern L1581
+ <4_31>+L1581
+ extern L1582
+ <4_31>+L1582
+ extern L1583
+ <4_31>+L1583
+ extern L1584
+ <4_31>+L1584
+ extern L1585
+ <4_31>+L1585
+ extern L1586
+ <4_31>+L1586
+ extern L1587
+ <4_31>+L1587
+ extern L1588
+ <4_31>+L1588
+ extern L1589
+ <4_31>+L1589
+ extern L1590
+ <4_31>+L1590
+ extern L1591
+ <4_31>+L1591
+ extern L1592
+ <4_31>+L1592
+ extern L1593
+ <4_31>+L1593
+ extern L1594
+ <4_31>+L1594
+ extern L1595
+ <4_31>+L1595
+ extern L1596
+ <4_31>+L1596
+ extern L1597
+ <4_31>+L1597
+ extern L1598
+ <4_31>+L1598
+ extern L1599
+ <4_31>+L1599
+ extern L1600
+ <4_31>+L1600
+ extern L1601
+ <4_31>+L1601
+ extern L1602
+ <4_31>+L1602
+ extern L1603
+ <4_31>+L1603
+ extern L1604
+ <4_31>+L1604
+ extern L1605
+ <4_31>+L1605
+ extern L1606
+ <4_31>+L1606
+ extern L1607
+ <4_31>+L1607
+ extern L1608
+ <4_31>+L1608
+ extern L1609
+ <4_31>+L1609
+ extern L1610
+ <4_31>+L1610
+ extern L1611
+ <4_31>+L1611
+ extern L1612
+ <4_31>+L1612
+ extern L1613
+ <4_31>+L1613
+ extern L1614
+ <4_31>+L1614
+ extern L1615
+ <4_31>+L1615
+ extern L1616
+ <4_31>+L1616
+ extern L1617
+ <4_31>+L1617
+ extern L1618
+ <4_31>+L1618
+ extern L1619
+ <4_31>+L1619
+ extern L1620
+ <4_31>+L1620
+ extern L1621
+ <4_31>+L1621
+ extern L1622
+ <4_31>+L1622
+ extern L1623
+ <4_31>+L1623
+ extern L1624
+ <4_31>+L1624
+ extern L1625
+ <4_31>+L1625
+ extern L1626
+ <4_31>+L1626
+ extern L1627
+ <4_31>+L1627
+ extern L1628
+ <4_31>+L1628
+ extern L1629
+ <4_31>+L1629
+ extern L1630
+ <4_31>+L1630
+ extern L1631
+ <4_31>+L1631
+ extern L1632
+ <4_31>+L1632
+ extern L1633
+ <4_31>+L1633
+ extern L1634
+ <4_31>+L1634
+ extern L1635
+ <4_31>+L1635
+ extern L1636
+ <4_31>+L1636
+ extern L1637
+ <4_31>+L1637
+ extern L1638
+ <4_31>+L1638
+ extern L1639
+ <4_31>+L1639
+ extern L1640
+ <4_31>+L1640
+ extern L1641
+ <4_31>+L1641
+ extern L1642
+ <4_31>+L1642
+ extern L1643
+ <4_31>+L1643
+ extern L1644
+ <4_31>+L1644
+ extern L1645
+ <4_31>+L1645
+ extern L1646
+ <4_31>+L1646
+ extern L1647
+ <4_31>+L1647
+ extern L1648
+ <4_31>+L1648
+ extern L1649
+ <4_31>+L1649
+ extern L1650
+ <4_31>+L1650
+ extern L1651
+ <4_31>+L1651
+ extern L1652
+ <4_31>+L1652
+ extern L1653
+ <4_31>+L1653
+ extern L1654
+ <4_31>+L1654
+ extern L1655
+ <4_31>+L1655
+ extern L1656
+ <4_31>+L1656
+ extern L1657
+ <4_31>+L1657
+ extern L1658
+ <4_31>+L1658
+ extern L1659
+ <4_31>+L1659
+ extern L1660
+ <4_31>+L1660
+ extern L1661
+ <4_31>+L1661
+ extern L1662
+ <4_31>+L1662
+ extern L1663
+ <4_31>+L1663
+ extern L1664
+ <4_31>+L1664
+ extern L1665
+ <4_31>+L1665
+ extern L1666
+ <4_31>+L1666
+ extern L1667
+ <4_31>+L1667
+ extern L1668
+ <4_31>+L1668
+ extern L1669
+ <4_31>+L1669
+ extern L1670
+ <4_31>+L1670
+ extern L1671
+ <4_31>+L1671
+ extern L1672
+ <4_31>+L1672
+ extern L1673
+ <4_31>+L1673
+ extern L1674
+ <4_31>+L1674
+ extern L1675
+ <4_31>+L1675
+ extern L1676
+ <4_31>+L1676
+ extern L1677
+ <4_31>+L1677
+ extern L1678
+ <4_31>+L1678
+ extern L1679
+ <4_31>+L1679
+ extern L1680
+ <4_31>+L1680
+ extern L1681
+ <4_31>+L1681
+ extern L1682
+ <4_31>+L1682
+ extern L1683
+ <4_31>+L1683
+ extern L1684
+ <4_31>+L1684
+ extern L1685
+ <4_31>+L1685
+ extern L1686
+ <4_31>+L1686
+ extern L1687
+ <4_31>+L1687
+ extern L1688
+ <4_31>+L1688
+ extern L1689
+ <4_31>+L1689
+ extern L1690
+ <4_31>+L1690
+ extern L1691
+ <4_31>+L1691
+ extern L1692
+ <4_31>+L1692
+ extern L1693
+ <4_31>+L1693
+ extern L1694
+ <4_31>+L1694
+ extern L1695
+ <4_31>+L1695
+ extern L1696
+ <4_31>+L1696
+ extern L1697
+ <4_31>+L1697
+ extern L1698
+ <4_31>+L1698
+ extern L1699
+ <4_31>+L1699
+ extern L1700
+ <4_31>+L1700
+ extern L1701
+ <4_31>+L1701
+ extern L1702
+ <4_31>+L1702
+ extern L1703
+ <4_31>+L1703
+ extern L1704
+ <4_31>+L1704
+ extern L1705
+ <4_31>+L1705
+ extern L1706
+ <4_31>+L1706
+ extern L1707
+ <4_31>+L1707
+ extern L1708
+ <4_31>+L1708
+ extern L1709
+ <4_31>+L1709
+ extern L1710
+ <4_31>+L1710
+ extern L1711
+ <4_31>+L1711
+ extern L1712
+ <4_31>+L1712
+ extern L1713
+ <4_31>+L1713
+ extern L1714
+ <4_31>+L1714
+ extern L1715
+ <4_31>+L1715
+ extern L1716
+ <4_31>+L1716
+ extern L1717
+ <4_31>+L1717
+ extern L1718
+ <4_31>+L1718
+ extern L1719
+ <4_31>+L1719
+ extern L1720
+ <4_31>+L1720
+ extern L1721
+ <4_31>+L1721
+ extern L1722
+ <4_31>+L1722
+ extern L1723
+ <4_31>+L1723
+ extern L1724
+ <4_31>+L1724
+ extern L1725
+ <4_31>+L1725
+ extern L1726
+ <4_31>+L1726
+ extern L1727
+ <4_31>+L1727
+ extern L1728
+ <4_31>+L1728
+ extern L1729
+ <4_31>+L1729
+ extern L1730
+ <4_31>+L1730
+ extern L1731
+ <4_31>+L1731
+ extern L1732
+ <4_31>+L1732
+ extern L1733
+ <4_31>+L1733
+ extern L1734
+ <4_31>+L1734
+ extern L1735
+ <4_31>+L1735
+ extern L1736
+ <4_31>+L1736
+ extern L1737
+ <4_31>+L1737
+ extern L1738
+ <4_31>+L1738
+ extern L1739
+ <4_31>+L1739
+ extern L1740
+ <4_31>+L1740
+ extern L1741
+ <4_31>+L1741
+ extern L1742
+ <4_31>+L1742
+ extern L1743
+ <4_31>+L1743
+ extern L1744
+ <4_31>+L1744
+ extern L1745
+ <4_31>+L1745
+ extern L1746
+ <4_31>+L1746
+ extern L1747
+ <4_31>+L1747
+ extern L1748
+ <4_31>+L1748
+ extern L1749
+ <4_31>+L1749
+ extern L1750
+ <4_31>+L1750
+ extern L1751
+ <4_31>+L1751
+ extern L1752
+ <4_31>+L1752
+ extern L1753
+ <4_31>+L1753
+ extern L1754
+ <4_31>+L1754
+ extern L1755
+ <4_31>+L1755
+ extern L1756
+ <4_31>+L1756
+ extern L1757
+ <4_31>+L1757
+ extern L1758
+ <4_31>+L1758
+ extern L1759
+ <4_31>+L1759
+ extern L1760
+ <4_31>+L1760
+ extern L1761
+ <4_31>+L1761
+ extern L1762
+ <4_31>+L1762
+ extern L1763
+ <4_31>+L1763
+ extern L1764
+ <4_31>+L1764
+ extern L1765
+ <4_31>+L1765
+ extern L1766
+ <4_31>+L1766
+ extern L1767
+ <4_31>+L1767
+ extern L1768
+ <4_31>+L1768
+ extern L1769
+ <4_31>+L1769
+ extern L1770
+ <4_31>+L1770
+ extern L1771
+ <4_31>+L1771
+ extern L1772
+ <4_31>+L1772
+ extern L1773
+ <4_31>+L1773
+ extern L1774
+ <4_31>+L1774
+ extern L1775
+ <4_31>+L1775
+ extern L1776
+ <4_31>+L1776
+ extern L1777
+ <4_31>+L1777
+ extern L1778
+ <4_31>+L1778
+ extern L1779
+ <4_31>+L1779
+ extern L1780
+ <4_31>+L1780
+ extern L1781
+ <4_31>+L1781
+ extern L1782
+ <4_31>+L1782
+ extern L1783
+ <4_31>+L1783
+ extern L1784
+ <4_31>+L1784
+ extern L1785
+ <4_31>+L1785
+ extern L1786
+ <4_31>+L1786
+ extern L1787
+ <4_31>+L1787
+ extern L1788
+ <4_31>+L1788
+ extern L1789
+ <4_31>+L1789
+ extern L1790
+ <4_31>+L1790
+ extern L1791
+ <4_31>+L1791
+ extern L1792
+ <4_31>+L1792
+ extern L1793
+ <4_31>+L1793
+ extern L1794
+ <4_31>+L1794
+ extern L1795
+ <4_31>+L1795
+ extern L1796
+ <4_31>+L1796
+ extern L1797
+ <4_31>+L1797
+ extern L1798
+ <4_31>+L1798
+ extern L1799
+ <4_31>+L1799
+ extern L1800
+ <4_31>+L1800
+ extern L1801
+ <4_31>+L1801
+ extern L1802
+ <4_31>+L1802
+ extern L1803
+ <4_31>+L1803
+ extern L1804
+ <4_31>+L1804
+ extern L1805
+ <4_31>+L1805
+ extern L1806
+ <4_31>+L1806
+ extern L1807
+ <4_31>+L1807
+ extern L1808
+ <4_31>+L1808
+ extern L1809
+ <4_31>+L1809
+ extern L1810
+ <4_31>+L1810
+ extern L1811
+ <4_31>+L1811
+ extern L1812
+ <4_31>+L1812
+ extern L1813
+ <4_31>+L1813
+ extern L1814
+ <4_31>+L1814
+ extern L1815
+ <4_31>+L1815
+ extern L1816
+ <4_31>+L1816
+ extern L1817
+ <4_31>+L1817
+ extern L1818
+ <4_31>+L1818
+ extern L1819
+ <4_31>+L1819
+ extern L1820
+ <4_31>+L1820
+ extern L1821
+ <4_31>+L1821
+ extern L1822
+ <4_31>+L1822
+ extern L1823
+ <4_31>+L1823
+ extern L1824
+ <4_31>+L1824
+ extern L1825
+ <4_31>+L1825
+ extern L1826
+ <4_31>+L1826
+ extern L1827
+ <4_31>+L1827
+ extern L1828
+ <4_31>+L1828
+ extern L1829
+ <4_31>+L1829
+ extern L1830
+ <4_31>+L1830
+ extern L1831
+ <4_31>+L1831
+ extern L1832
+ <4_31>+L1832
+ extern L1833
+ <4_31>+L1833
+ extern L1834
+ <4_31>+L1834
+ extern L1835
+ <4_31>+L1835
+ extern L1836
+ <4_31>+L1836
+ extern L1837
+ <4_31>+L1837
+ extern L1838
+ <4_31>+L1838
+ extern L1839
+ <4_31>+L1839
+ extern L1840
+ <4_31>+L1840
+ extern L1841
+ <4_31>+L1841
+ extern L1842
+ <4_31>+L1842
+ extern L1843
+ <4_31>+L1843
+ extern L1844
+ <4_31>+L1844
+ extern L1845
+ <4_31>+L1845
+ extern L1846
+ <4_31>+L1846
+ extern L1847
+ <4_31>+L1847
+ extern L1848
+ <4_31>+L1848
+ extern L1849
+ <4_31>+L1849
+ extern L1850
+ <4_31>+L1850
+ extern L1851
+ <4_31>+L1851
+ extern L1852
+ <4_31>+L1852
+ extern L1853
+ <4_31>+L1853
+ extern L1854
+ <4_31>+L1854
+ extern L1855
+ <4_31>+L1855
+ extern L1856
+ <4_31>+L1856
+ extern L1857
+ <4_31>+L1857
+ extern L1858
+ <4_31>+L1858
+ extern L1859
+ <4_31>+L1859
+ extern L1860
+ <4_31>+L1860
+ extern L1861
+ <4_31>+L1861
+ extern L1862
+ <4_31>+L1862
+ extern L1863
+ <4_31>+L1863
+ extern L1864
+ <4_31>+L1864
+ extern L1865
+ <4_31>+L1865
+ extern L1866
+ <4_31>+L1866
+ extern L1867
+ <4_31>+L1867
+ extern L1868
+ <4_31>+L1868
+ extern L1869
+ <4_31>+L1869
+ extern L1870
+ <4_31>+L1870
+ extern L1871
+ <4_31>+L1871
+ extern L1872
+ <4_31>+L1872
+ extern L1873
+ <4_31>+L1873
+ extern L1874
+ <4_31>+L1874
+ extern L1875
+ <4_31>+L1875
+ extern L1876
+ <4_31>+L1876
+ extern L1877
+ <4_31>+L1877
+ extern L1878
+ <4_31>+L1878
+ extern L1879
+ <4_31>+L1879
+ extern L1880
+ <4_31>+L1880
+ extern L1881
+ <4_31>+L1881
+ extern L1882
+ <4_31>+L1882
+ extern L1883
+ <4_31>+L1883
+ extern L1884
+ <4_31>+L1884
+ extern L1885
+ <4_31>+L1885
+ extern L1886
+ <4_31>+L1886
+ extern L1887
+ <4_31>+L1887
+ extern L1888
+ <4_31>+L1888
+ extern L1889
+ <4_31>+L1889
+ extern L1890
+ <4_31>+L1890
+ extern L1891
+ <4_31>+L1891
+ extern L1892
+ <4_31>+L1892
+ extern L1893
+ <4_31>+L1893
+ extern L1894
+ <4_31>+L1894
+ extern L1895
+ <4_31>+L1895
+ extern L1896
+ <4_31>+L1896
+ extern L1897
+ <4_31>+L1897
+ extern L1898
+ <4_31>+L1898
+ extern L1899
+ <4_31>+L1899
+ extern L1900
+ <4_31>+L1900
+ extern L1901
+ <4_31>+L1901
+ extern L1902
+ <4_31>+L1902
+ extern L1903
+ <4_31>+L1903
+ extern L1904
+ <4_31>+L1904
+ extern L1905
+ <4_31>+L1905
+ extern L1906
+ <4_31>+L1906
+ extern L1907
+ <4_31>+L1907
+ extern L1908
+ <4_31>+L1908
+ extern L1909
+ <4_31>+L1909
+ 467
+ 468
+ 469
+ 470
+ 471
+ 472
+ 473
+ 474
+ 475
+ 476
+ 477
+ 478
+ 479
+ 480
+ 481
+ 482
+ 483
+ 484
+ 485
+ 486
+ 487
+ 488
+ 489
+ 490
+ 491
+ 492
+ 493
+ 494
+ 495
+ 496
+ 497
+ 498
+ 499
+ 500
+ 0
+SYMFNC: intern SYMFNC
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L0024
+ jrst L0024##
+ extern L0017
+ jrst L0017##
+ extern L0026
+ jrst L0026##
+ extern L0034
+ jrst L0034##
+ extern PRTITM
+ jrst PRTITM##
+ extern PRIN1
+ jrst PRIN1##
+ extern L0025
+ jrst L0025##
+ extern L0028
+ jrst L0028##
+ extern L0042
+ jrst L0042##
+ extern PRIN2
+ jrst PRIN2##
+ extern TERPRI
+ jrst TERPRI##
+ extern PRINT
+ jrst PRINT##
+ extern PRIN2T
+ jrst PRIN2T##
+ extern PUTC
+ jrst PUTC##
+ extern PBLANK
+ jrst PBLANK##
+ extern L0021
+ jrst L0021##
+ extern L1202
+ jrst L1202##
+ extern L1203
+ jrst L1203##
+ JRST SYMFNC+407
+ extern QUIT
+ jrst QUIT##
+ extern ERROR
+ jrst ERROR##
+ extern L0093
+ jrst L0093##
+ extern L0094
+ jrst L0094##
+ extern L1161
+ jrst L1161##
+ extern L0095
+ jrst L0095##
+ JRST SYMFNC+407
+ extern L0098
+ jrst L0098##
+ extern L0099
+ jrst L0099##
+ extern L0102
+ jrst L0102##
+ extern L0103
+ jrst L0103##
+ extern L0106
+ jrst L0106##
+ JRST SYMFNC+407
+ extern L0156
+ jrst L0156##
+ extern L0165
+ jrst L0165##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L0172
+ jrst L0172##
+ JRST SYMFNC+407
+ extern L1029
+ jrst L1029##
+ extern L1019
+ jrst L1019##
+ extern L0177
+ jrst L0177##
+ extern L0182
+ jrst L0182##
+ JRST SYMFNC+407
+ extern L1206
+ jrst L1206##
+ extern GTHEAP
+ jrst GTHEAP##
+ extern GTSTR
+ jrst GTSTR##
+ extern GTVECT
+ jrst GTVECT##
+ extern L0191
+ jrst L0191##
+ extern GTID
+ jrst GTID##
+ extern L0192
+ jrst L0192##
+ extern CONS
+ jrst CONS##
+ extern XCONS
+ jrst XCONS##
+ extern NCONS
+ jrst NCONS##
+ extern MKVECT
+ jrst MKVECT##
+ extern LIST2
+ jrst LIST2##
+ extern LIST3
+ jrst LIST3##
+ extern LIST4
+ jrst LIST4##
+ extern LIST5
+ jrst LIST5##
+ JRST SYMFNC+407
+ extern L0209
+ jrst L0209##
+ extern EQSTR
+ jrst EQSTR##
+ extern L0222
+ jrst L0222##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L0224
+ jrst L0224##
+ extern L0230
+ jrst L0230##
+ extern L0233
+ jrst L0233##
+ extern L0246
+ jrst L0246##
+ extern DIGITP
+ jrst DIGITP##
+ extern L0237
+ jrst L0237##
+ extern L0297
+ jrst L0297##
+ extern READID
+ jrst READID##
+ extern RATOM
+ jrst RATOM##
+ extern WHITEP
+ jrst WHITEP##
+ extern GETC
+ jrst GETC##
+ extern L1201
+ jrst L1201##
+ extern L0241
+ jrst L0241##
+ extern L0252
+ jrst L0252##
+ extern L0301
+ jrst L0301##
+ extern INTERN
+ jrst INTERN##
+ extern L0295
+ jrst L0295##
+ extern ALPHAP
+ jrst ALPHAP##
+ extern L0291
+ jrst L0291##
+ extern L0270
+ jrst L0270##
+ extern L0263
+ jrst L0263##
+ extern L0330
+ jrst L0330##
+ extern L0287
+ jrst L0287##
+ extern L0299
+ jrst L0299##
+ extern READ1
+ jrst READ1##
+ extern READ
+ jrst READ##
+ extern L0310
+ jrst L0310##
+ extern QUOTE
+ jrst QUOTE##
+ JRST SYMFNC+407
+ extern L0321
+ jrst L0321##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L0325
+ jrst L0325##
+ extern L1199
+ jrst L1199##
+ extern L0360
+ jrst L0360##
+ extern L0334
+ jrst L0334##
+ extern L1198
+ jrst L1198##
+ extern L0339
+ jrst L0339##
+ extern FCODEP
+ jrst FCODEP##
+ extern L0350
+ jrst L0350##
+ extern L0355
+ jrst L0355##
+ extern L0359
+ jrst L0359##
+ JRST SYMFNC+407
+ extern L0370
+ jrst L0370##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L0436
+ jrst L0436##
+ extern L0365
+ jrst L0365##
+ extern L0437
+ jrst L0437##
+ JRST SYMFNC+407
+ extern L0371
+ jrst L0371##
+ extern L1240
+ jrst L1240##
+ extern L0375
+ jrst L0375##
+ extern L0398
+ jrst L0398##
+ extern L0402
+ jrst L0402##
+ extern EVAL
+ jrst EVAL##
+ extern L0429
+ jrst L0429##
+ extern L0425
+ jrst L0425##
+ extern LBIND1
+ jrst LBIND1##
+ extern GET
+ jrst GET##
+ extern L0443
+ jrst L0443##
+ JRST SYMFNC+407
+ extern BLDMSG
+ jrst BLDMSG##
+ extern L0515
+ jrst L0515##
+ extern L0674
+ jrst L0674##
+ extern PLUS2
+ jrst PLUS2##
+ extern MINUS
+ jrst MINUS##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern ADD1
+ jrst ADD1##
+ JRST SYMFNC+407
+ extern SUB1
+ jrst SUB1##
+ extern L0471
+ jrst L0471##
+ extern LESSP
+ jrst LESSP##
+ extern L0483
+ jrst L0483##
+ extern TIMES2
+ jrst TIMES2##
+ extern CAR
+ jrst CAR##
+ extern CDR
+ jrst CDR##
+ extern CAAR
+ jrst CAAR##
+ extern CADR
+ jrst CADR##
+ extern CDAR
+ jrst CDAR##
+ extern CDDR
+ jrst CDDR##
+ extern ATOM
+ jrst ATOM##
+ extern APPEND
+ jrst APPEND##
+ extern MEMQ
+ jrst MEMQ##
+ extern L0509
+ jrst L0509##
+ extern EVLIS
+ jrst EVLIS##
+ extern PROGN
+ jrst PROGN##
+ extern EVCOND
+ jrst EVCOND##
+ extern COND
+ jrst COND##
+ extern SET
+ jrst SET##
+ extern SETQ
+ jrst SETQ##
+ extern PUTD
+ jrst PUTD##
+ extern DE
+ jrst DE##
+ JRST SYMFNC+407
+ extern DF
+ jrst DF##
+ JRST SYMFNC+407
+ extern DN
+ jrst DN##
+ JRST SYMFNC+407
+ extern DM
+ jrst DM##
+ JRST SYMFNC+407
+ extern LIST
+ jrst LIST##
+ extern ATSOC
+ jrst ATSOC##
+ extern GEQ
+ jrst GEQ##
+ extern LEQ
+ jrst LEQ##
+ extern EQCAR
+ jrst EQCAR##
+ extern GETD
+ jrst GETD##
+ extern COPYD
+ jrst COPYD##
+ extern DELATQ
+ jrst DELATQ##
+ extern PUT
+ jrst PUT##
+ extern L0569
+ jrst L0569##
+ extern WHILE
+ jrst WHILE##
+ JRST SYMFNC+407
+ extern L0614
+ jrst L0614##
+ extern L0620
+ jrst L0620##
+ extern L0604
+ jrst L0604##
+ extern L0665
+ jrst L0665##
+ extern L0603
+ jrst L0603##
+ extern APPLY
+ jrst APPLY##
+ extern L0607
+ jrst L0607##
+ extern LENGTH
+ jrst LENGTH##
+ extern CODEP
+ jrst CODEP##
+ extern PAIRP
+ jrst PAIRP##
+ extern IDP
+ jrst IDP##
+ extern EQ
+ jrst EQ##
+ extern NULL
+ jrst NULL##
+ extern NOT
+ jrst NOT##
+ extern L0634
+ jrst L0634##
+ extern MAPOBL
+ jrst MAPOBL##
+ extern L0642
+ jrst L0642##
+ extern L0643
+ jrst L0643##
+ JRST SYMFNC+407
+ extern L0646
+ jrst L0646##
+ extern L0647
+ jrst L0647##
+ extern PROP
+ jrst PROP##
+ extern L0660
+ jrst L0660##
+ extern L0679
+ jrst L0679##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern RESET
+ jrst RESET##
+ extern L1010
+ jrst L1010##
+ JRST SYMFNC+407
+ extern L1013
+ jrst L1013##
+ extern L1014
+ jrst L1014##
+ extern L1015
+ jrst L1015##
+ JRST SYMFNC+407
+ extern L1018
+ jrst L1018##
+ extern PBIND1
+ jrst PBIND1##
+ extern L1032
+ jrst L1032##
+ extern L1074
+ jrst L1074##
+ extern L1077
+ jrst L1077##
+ extern L1075
+ jrst L1075##
+ extern L1076
+ jrst L1076##
+ extern L1087
+ jrst L1087##
+ extern L1080
+ jrst L1080##
+ extern L1115
+ jrst L1115##
+ extern L1096
+ jrst L1096##
+ extern L1092
+ jrst L1092##
+ extern L1100
+ jrst L1100##
+ JRST SYMFNC+407
+ extern L1102
+ jrst L1102##
+ extern L1180
+ jrst L1180##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern RDS
+ jrst RDS##
+ extern WRS
+ jrst WRS##
+ extern OPEN
+ jrst OPEN##
+ extern CLOSE
+ jrst CLOSE##
+ extern L1117
+ jrst L1117##
+ JRST SYMFNC+407
+ extern DSKIN
+ jrst DSKIN##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern LAPIN
+ jrst LAPIN##
+ extern L1145
+ jrst L1145##
+ extern L1149
+ jrst L1149##
+ JRST SYMFNC+407
+ extern L1166
+ jrst L1166##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L1138
+ jrst L1138##
+ JRST SYMFNC+407
+ extern L1157
+ jrst L1157##
+ extern L1150
+ jrst L1150##
+ extern L1153
+ jrst L1153##
+ extern L1165
+ jrst L1165##
+ extern L1168
+ jrst L1168##
+ extern L1174
+ jrst L1174##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L1189
+ jrst L1189##
+ extern L1408
+ jrst L1408##
+ extern MAIN.
+ jrst MAIN.##
+ extern INIT
+ jrst INIT##
+ extern TIMC
+ jrst TIMC##
+ extern DATE
+ jrst DATE##
+ extern L1197
+ jrst L1197##
+ extern PUTINT
+ jrst PUTINT##
+ extern L1200
+ jrst L1200##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern FLAG
+ jrst FLAG##
+ JRST SYMFNC+407
+ extern L1214
+ jrst L1214##
+ extern L1209
+ jrst L1209##
+ extern SPACED
+ jrst SPACED##
+ extern DASHED
+ jrst DASHED##
+ extern DOTTED
+ jrst DOTTED##
+ extern L1231
+ jrst L1231##
+ extern INF
+ jrst INF##
+ extern TAG
+ jrst TAG##
+ extern MKITEM
+ jrst MKITEM##
+ extern TIME
+ jrst TIME##
+ extern L1245
+ jrst L1245##
+ extern L1289
+ jrst L1289##
+ extern L1285
+ jrst L1285##
+ JRST SYMFNC+407
+ extern L1257
+ jrst L1257##
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ JRST SYMFNC+407
+ extern L1294
+ jrst L1294##
+ extern L1297
+ jrst L1297##
+ extern L1300
+ jrst L1300##
+ extern L1303
+ jrst L1303##
+ extern L1306
+ jrst L1306##
+ extern L1311
+ jrst L1311##
+ extern L1316
+ jrst L1316##
+ extern L1319
+ jrst L1319##
+ extern L1323
+ jrst L1323##
+ extern L1328
+ jrst L1328##
+ extern L1338
+ jrst L1338##
+ extern L1333
+ jrst L1333##
+ extern L1347
+ jrst L1347##
+ extern L1343
+ jrst L1343##
+ extern L1352
+ jrst L1352##
+ extern FACT
+ jrst FACT##
+ extern L1359
+ jrst L1359##
+ extern L1364
+ jrst L1364##
+ extern L1368
+ jrst L1368##
+ extern TAK
+ jrst TAK##
+ extern L1369
+ jrst L1369##
+ extern GTAK
+ jrst GTAK##
+ extern L1373
+ jrst L1373##
+ extern GTSTA
+ jrst GTSTA##
+ extern GTSTB
+ jrst GTSTB##
+ extern G0
+ jrst G0##
+ extern G1
+ jrst G1##
+ extern L1387
+ jrst L1387##
+ extern L1385
+ jrst L1385##
+ extern NNILS
+ jrst NNILS##
+ extern NILS
+ jrst NILS##
+ JRST SYMFNC+407
+ extern NR
+ jrst NR##
+ extern L1443
+ jrst L1443##
+ extern IOTEST
+ jrst IOTEST##
+ block 35
+L0003: intern L0003
+ 466
+ end
ADDED psl-1983/20-tests/dmain7.rel
Index: psl-1983/20-tests/dmain7.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dmain7.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dsub2.mac
Index: psl-1983/20-tests/dsub2.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub2.mac
@@ -0,0 +1,25 @@
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ end
ADDED psl-1983/20-tests/dsub2.rel
Index: psl-1983/20-tests/dsub2.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub2.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dsub20.mac
Index: psl-1983/20-tests/dsub20.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub20.mac
@@ -0,0 +1,23 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ end
ADDED psl-1983/20-tests/dsub3.mac
Index: psl-1983/20-tests/dsub3.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub3.mac
@@ -0,0 +1,29 @@
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ extern L0183
+ extern L0184
+ extern L0185
+ extern L0186
+ end
ADDED psl-1983/20-tests/dsub3.rel
Index: psl-1983/20-tests/dsub3.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub3.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dsub4.mac
Index: psl-1983/20-tests/dsub4.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub4.mac
@@ -0,0 +1,27 @@
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+BUFFER: block 21
+ intern BUFFER
+ end
ADDED psl-1983/20-tests/dsub4.rel
Index: psl-1983/20-tests/dsub4.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub4.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dsub5.mac
Index: psl-1983/20-tests/dsub5.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub5.mac
@@ -0,0 +1,27 @@
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+L0369: block 16
+ intern L0369
+ end
ADDED psl-1983/20-tests/dsub5.rel
Index: psl-1983/20-tests/dsub5.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub5.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dsub6.mac
Index: psl-1983/20-tests/dsub6.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub6.mac
@@ -0,0 +1,33 @@
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+BNDSTK: block 2001
+ intern BNDSTK
+L1005: BNDSTK+0
+ intern L1005
+L1006: BNDSTK+1999
+ intern L1006
+L1007: BNDSTK+0
+ intern L1007
+ end
ADDED psl-1983/20-tests/dsub6.rel
Index: psl-1983/20-tests/dsub6.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub6.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/dsub7.mac
Index: psl-1983/20-tests/dsub7.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub7.mac
@@ -0,0 +1,204 @@
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+L1103: block 1001
+ intern L1103
+L1104: <30_31>+360
+ <30_31>+361
+ <30_31>+361
+ <30_31>+362
+ <30_31>+361
+ <30_31>+361
+ <30_31>+361
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ intern L1104
+L1105: <30_31>+364
+ <30_31>+152
+ <30_31>+365
+ <30_31>+366
+ <30_31>+367
+ <30_31>+152
+ <30_31>+152
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ intern L1105
+L1106: <30_31>+368
+ <30_31>+368
+ <30_31>+368
+ <30_31>+368
+ <30_31>+368
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ <30_31>+363
+ intern L1106
+L1107: block 32
+ intern L1107
+L1108: block 32
+ intern L1108
+L1109: 0
+ 80
+ 80
+ 10000
+ 10000
+ 80
+ 80
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ intern L1109
+L1110: 1
+ 2
+ 3
+ 3
+ 3
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ intern L1110
+L1111: block 32
+ intern L1111
+L1112: block 32
+ intern L1112
+L1113: block 32
+ intern L1113
+L1114: block 32
+ intern L1114
+ end
ADDED psl-1983/20-tests/dsub7.rel
Index: psl-1983/20-tests/dsub7.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/dsub7.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/fiddle.bar
Index: psl-1983/20-tests/fiddle.bar
==================================================================
--- /dev/null
+++ psl-1983/20-tests/fiddle.bar
@@ -0,0 +1,1 @@
+THIS IS A STRING OF N
ADDED psl-1983/20-tests/field.init
Index: psl-1983/20-tests/field.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/field.init
@@ -0,0 +1,1 @@
+(FLAG '(INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20) 'INTERNALFUNCTION)
ADDED psl-1983/20-tests/field.mac
Index: psl-1983/20-tests/field.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/field.mac
@@ -0,0 +1,1600 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern L0001
+ extern L0002
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L0005
+ JRST SYMFNC+130
+L0005: byte(18)-300,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 INIT20 EXPR 1)
+; (JRST (INTERNALENTRY INIT20))
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ JRST INIT20
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+; (JRST (INTERNALENTRY GETC20))
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SETZM 1
+ JRST GETC20
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+; (JRST (INTERNALENTRY TIMC20))
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ JRST TIMC20
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTC20 EXPR 1)
+; (JRST (INTERNALENTRY PUTC20))
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ JRST PUTC20
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+; (JRST (INTERNALENTRY QUIT20))
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ JRST QUIT20
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+; (JRST (INTERNALENTRY PUTI20))
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ JRST PUTI20
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 1)
+; (!*MOVE 1 (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*LINK ERR20 EXPR 1)
+; (PUSHJ (REG ST) (INTERNALENTRY ERR20))
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 1)
+L0006: intern L0006
+ HRRZI 1,1
+ PUSHJ 15,ERR20
+; (!*ENTRY FLAG EXPR 2)
+; (!*MOVE 2 (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINK ERR20 EXPR 1)
+; (PUSHJ (REG ST) (INTERNALENTRY ERR20))
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ HRRZI 1,2
+ PUSHJ 15,ERR20
+; (!*ENTRY !*WTIMES32 EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*ENTRY !*WTIMES32 EXPR 2)
+L0007: intern L0007
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE 'NIL (FRAME 1))
+; (MOVEM (REG NIL) (INDEXED (REG ST) 0))
+; (!*MOVE (WCONST 10) (REG 5))
+; (HRRZI (REG 5) 10)
+; (!*MOVE (WCONST 32) (REG 4))
+; (HRRZI (REG 4) 32)
+; (!*MOVE (WCONST 71) (REG 3))
+; (HRRZI (REG 3) 71)
+; (!*MOVE (WCONST 83) (REG 2))
+; (HRRZI (REG 2) 83)
+; (!*MOVE (WCONST 77) (REG 1))
+; (HRRZI (REG 1) 77)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (WCONST 63) (REG 1))
+; (HRRZI (REG 1) 63)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*MOVE (WCONST 63) (REG 1))
+; (HRRZI (REG 1) 63)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*MOVE (WCONST 36) (FRAME 2))
+; (HRRZI (REG T1) 36)
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*JUMPNOTEQ (LABEL G0005) (FRAME 2) (WCONST 64))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAIE (REG T1) 64)
+; (JRST (LABEL G0005))
+; (!*MOVE (WCONST 32374509039) (FRAME 1))
+; (MOVE (REG T1) 32374509039)
+; (MOVEM (REG T1) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTEQ (LABEL G0006) (FRAME 2) (WCONST 32))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAIE (REG T1) 32)
+; (JRST (LABEL G0006))
+; (!*MOVE (WCONST 19088743) (FRAME 1))
+; (MOVE (REG T1) 19088743)
+; (MOVEM (REG T1) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0006))
+; (!*JUMPNOTEQ (LABEL G0007) (FRAME 2) (WCONST 36))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAIE (REG T1) 36)
+; (JRST (LABEL G0007))
+; (!*MOVE (WCONST 305419896) (FRAME 1))
+; (MOVE (REG T1) 305419896)
+; (MOVEM (REG T1) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0007))
+; (!*MOVE (WCONST 99) (REG 1))
+; (HRRZI (REG 1) 99)
+; (!*LINK ERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY ERR))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK ASHIFTTEST EXPR 1)
+; (PUSHJ (REG ST) (ENTRY ASHIFTTEST))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK FIELDTEST EXPR 1)
+; (PUSHJ (REG ST) (ENTRY FIELDTEST))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LSHIFTTEST EXPR 1)
+; (PUSHJ (REG ST) (ENTRY LSHIFTTEST))
+; (!*LINK QUIT EXPR 0)
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE 'NIL (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (!*ENTRY FIRSTCALL EXPR 0)
+L0008: intern L0008
+ ADJSP 15,2
+ MOVEM 0,0(15)
+ HRRZI 5,10
+ HRRZI 4,32
+ HRRZI 3,71
+ HRRZI 2,83
+ HRRZI 1,77
+ PUSHJ 15,SYMFNC+140
+ HRRZI 1,63
+ PUSHJ 15,SYMFNC+141
+ HRRZI 1,63
+ PUSHJ 15,SYMFNC+142
+ HRRZI 6,36
+ MOVEM 6,-1(15)
+ MOVE 6,-1(15)
+ CAIE 6,64
+ JRST L0009
+ MOVE 6,[32374509039]
+ MOVEM 6,0(15)
+ JRST L0010
+L0009: MOVE 6,-1(15)
+ CAIE 6,32
+ JRST L0011
+ MOVE 6,[19088743]
+ MOVEM 6,0(15)
+ JRST L0010
+L0011: MOVE 6,-1(15)
+ CAIE 6,36
+ JRST L0012
+ MOVE 6,[305419896]
+ MOVEM 6,0(15)
+ JRST L0010
+L0012: HRRZI 1,99
+ PUSHJ 15,SYMFNC+143
+L0010: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+144
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+145
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+146
+ PUSHJ 15,SYMFNC+135
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+; (!*ENTRY ASHIFTTEST EXPR 1)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (WCONST 70) (REG 5))
+; (HRRZI (REG 5) 70)
+; (!*MOVE (WCONST 73) (REG 4))
+; (HRRZI (REG 4) 73)
+; (!*MOVE (WCONST 72) (REG 3))
+; (HRRZI (REG 3) 72)
+; (!*MOVE (WCONST 83) (REG 2))
+; (HRRZI (REG 2) 83)
+; (!*MOVE (WCONST 65) (REG 1))
+; (HRRZI (REG 1) 65)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (WCONST 10) (REG 5))
+; (HRRZI (REG 5) 10)
+; (!*MOVE (WCONST 32) (REG 4))
+; (HRRZI (REG 4) 32)
+; (!*MOVE (WCONST 32) (REG 3))
+; (HRRZI (REG 3) 32)
+; (!*MOVE (WCONST 32) (REG 2))
+; (HRRZI (REG 2) 32)
+; (!*MOVE (WCONST 84) (REG 1))
+; (HRRZI (REG 1) 84)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (WCONST 10) (FRAME 2))
+; (HRRZI (REG T1) 10)
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*WTIMES2 (FRAME 2) (WCONST 4))
+; (MOVE (REG T3) (INDEXED (REG ST) -1))
+; (ASH (REG T3) 2)
+; (MOVEM (REG T3) (INDEXED (REG ST) -1))
+; (!*JUMPEQ (LABEL G0005) (FRAME 2) (WCONST 40))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAIN (REG T1) 40)
+; (JRST (LABEL G0005))
+; (!*MOVE (WCONST 49) (REG 1))
+; (HRRZI (REG 1) 49)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (WCONST 49) (REG 1))
+; (HRRZI (REG 1) 49)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (WCONST -5) (FRAME 2))
+; (MOVNI (REG T1) (MINUS -5))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*WTIMES2 (FRAME 2) (WCONST 16))
+; (MOVE (REG T3) (INDEXED (REG ST) -1))
+; (ASH (REG T3) 4)
+; (MOVEM (REG T3) (INDEXED (REG ST) -1))
+; (!*JUMPEQ (LABEL G0008) (FRAME 2) (WCONST -80))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMN (REG T1) (LIT (FULLWORD -80)))
+; (JRST (LABEL G0008))
+; (!*MOVE (WCONST 50) (REG 1))
+; (HRRZI (REG 1) 50)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0007))
+; (JRST (LABEL G0007))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (WCONST 50) (REG 1))
+; (HRRZI (REG 1) 50)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0007))
+; (!*MOVE (WCONST 6) (FRAME 2))
+; (HRRZI (REG T1) 6)
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 4) (FRAME 1))
+; (HRRZI (REG T1) 4)
+; (MOVEM (REG T1) (INDEXED (REG ST) 0))
+; (!*WTIMES2 (FRAME 2) (WCONST 4))
+; (MOVE (REG T3) (INDEXED (REG ST) -1))
+; (ASH (REG T3) 2)
+; (MOVEM (REG T3) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*WTIMES2 (REG 1) (WCONST 6))
+; (IMULI (REG 1) 6)
+; (!*JUMPEQ (LABEL G0011) (FRAME 2) (REG 1))
+; (CAMN (REG 1) (INDEXED (REG ST) -1))
+; (JRST (LABEL G0011))
+; (!*MOVE (WCONST 51) (REG 1))
+; (HRRZI (REG 1) 51)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0010))
+; (JRST (LABEL G0010))
+; (!*LBL (LABEL G0011))
+; (!*MOVE (WCONST 51) (REG 1))
+; (HRRZI (REG 1) 51)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0010))
+; (!*MOVE 'NIL (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD -80)
+; (!*ENTRY ASHIFTTEST EXPR 1)
+L0014: intern L0014
+ ADJSP 15,2
+ HRRZI 5,70
+ HRRZI 4,73
+ HRRZI 3,72
+ HRRZI 2,83
+ HRRZI 1,65
+ PUSHJ 15,SYMFNC+140
+ HRRZI 5,10
+ HRRZI 4,32
+ HRRZI 3,32
+ HRRZI 2,32
+ HRRZI 1,84
+ PUSHJ 15,SYMFNC+140
+ HRRZI 6,10
+ MOVEM 6,-1(15)
+ MOVE 8,-1(15)
+ ASH 8,2
+ MOVEM 8,-1(15)
+ MOVE 6,-1(15)
+ CAIN 6,40
+ JRST L0015
+ HRRZI 1,49
+ PUSHJ 15,SYMFNC+142
+ JRST L0016
+L0015: HRRZI 1,49
+ PUSHJ 15,SYMFNC+141
+L0016: MOVNI 6,5
+ MOVEM 6,-1(15)
+ MOVE 8,-1(15)
+ ASH 8,4
+ MOVEM 8,-1(15)
+ MOVE 6,-1(15)
+ CAMN 6,L0013
+ JRST L0017
+ HRRZI 1,50
+ PUSHJ 15,SYMFNC+142
+ JRST L0018
+L0017: HRRZI 1,50
+ PUSHJ 15,SYMFNC+141
+L0018: HRRZI 6,6
+ MOVEM 6,-1(15)
+ HRRZI 6,4
+ MOVEM 6,0(15)
+ MOVE 8,-1(15)
+ ASH 8,2
+ MOVEM 8,-1(15)
+ MOVE 1,0(15)
+ IMULI 1,6
+ CAMN 1,-1(15)
+ JRST L0019
+ HRRZI 1,51
+ PUSHJ 15,SYMFNC+142
+ JRST L0020
+L0019: HRRZI 1,51
+ PUSHJ 15,SYMFNC+141
+L0020: MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L0013: -80
+; (!*ENTRY FIELDTEST EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (WCONST 68) (REG 5))
+; (HRRZI (REG 5) 68)
+; (!*MOVE (WCONST 76) (REG 4))
+; (HRRZI (REG 4) 76)
+; (!*MOVE (WCONST 69) (REG 3))
+; (HRRZI (REG 3) 69)
+; (!*MOVE (WCONST 73) (REG 2))
+; (HRRZI (REG 2) 73)
+; (!*MOVE (WCONST 70) (REG 1))
+; (HRRZI (REG 1) 70)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 0) (WCONST 36))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 36))))
+; (!*JUMPEQ (LABEL G0005) (REG 1) (FRAME 1))
+; (CAMN (REG 1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (WCONST 49) (REG 1))
+; (HRRZI (REG 1) 49)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (WCONST 49) (REG 1))
+; (HRRZI (REG 1) 49)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0004))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 0) (WCONST 8))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 8))))
+; (!*JUMPEQ (LABEL G0008) (REG 1) (WCONST 1))
+; (CAIN (REG 1) 1)
+; (JRST (LABEL G0008))
+; (!*MOVE (WCONST 50) (REG 1))
+; (HRRZI (REG 1) 50)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0007))
+; (JRST (LABEL G0007))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (WCONST 50) (REG 1))
+; (HRRZI (REG 1) 50)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0007))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 8) (WCONST 8))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 8 8))))
+; (!*JUMPEQ (LABEL G0011) (REG 1) (WCONST 35))
+; (CAIN (REG 1) 35)
+; (JRST (LABEL G0011))
+; (!*MOVE (WCONST 51) (REG 1))
+; (HRRZI (REG 1) 51)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0010))
+; (JRST (LABEL G0010))
+; (!*LBL (LABEL G0011))
+; (!*MOVE (WCONST 51) (REG 1))
+; (HRRZI (REG 1) 51)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0010))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 16) (WCONST 8))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 16 8))))
+; (!*JUMPEQ (LABEL G0014) (REG 1) (WCONST 69))
+; (CAIN (REG 1) 69)
+; (JRST (LABEL G0014))
+; (!*MOVE (WCONST 52) (REG 1))
+; (HRRZI (REG 1) 52)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0013))
+; (JRST (LABEL G0013))
+; (!*LBL (LABEL G0014))
+; (!*MOVE (WCONST 52) (REG 1))
+; (HRRZI (REG 1) 52)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0013))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 24) (WCONST 8))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 24 8))))
+; (!*JUMPEQ (LABEL G0017) (REG 1) (WCONST 103))
+; (CAIN (REG 1) 103)
+; (JRST (LABEL G0017))
+; (!*MOVE (WCONST 53) (REG 1))
+; (HRRZI (REG 1) 53)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0016))
+; (JRST (LABEL G0016))
+; (!*LBL (LABEL G0017))
+; (!*MOVE (WCONST 53) (REG 1))
+; (HRRZI (REG 1) 53)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0016))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 0) (WCONST 16))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 16))))
+; (!*JUMPEQ (LABEL G0020) (REG 1) (WCONST 291))
+; (CAIN (REG 1) 291)
+; (JRST (LABEL G0020))
+; (!*MOVE (WCONST 54) (REG 1))
+; (HRRZI (REG 1) 54)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0019))
+; (JRST (LABEL G0019))
+; (!*LBL (LABEL G0020))
+; (!*MOVE (WCONST 54) (REG 1))
+; (HRRZI (REG 1) 54)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0019))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 16) (WCONST 16))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 16 16))))
+; (!*JUMPEQ (LABEL G0023) (REG 1) (WCONST 17767))
+; (CAIN (REG 1) 17767)
+; (JRST (LABEL G0023))
+; (!*MOVE (WCONST 55) (REG 1))
+; (HRRZI (REG 1) 55)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0022))
+; (JRST (LABEL G0022))
+; (!*LBL (LABEL G0023))
+; (!*MOVE (WCONST 55) (REG 1))
+; (HRRZI (REG 1) 55)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0022))
+; (!*MOVE 'NIL (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 36))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 8))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 8 8))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 16 8))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 24 8))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 16))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 16 16))
+; (!*ENTRY FIELDTEST EXPR 1)
+L0028: intern L0028
+ PUSH 15,1
+ HRRZI 5,68
+ HRRZI 4,76
+ HRRZI 3,69
+ HRRZI 2,73
+ HRRZI 1,70
+ PUSHJ 15,SYMFNC+140
+ HRRZI 1,10
+ PUSHJ 15,SYMFNC+134
+ LDB 1,L0021
+ CAMN 1,0(15)
+ JRST L0029
+ HRRZI 1,49
+ PUSHJ 15,SYMFNC+142
+ JRST L0030
+L0029: HRRZI 1,49
+ PUSHJ 15,SYMFNC+141
+L0030: LDB 1,L0022
+ CAIN 1,1
+ JRST L0031
+ HRRZI 1,50
+ PUSHJ 15,SYMFNC+142
+ JRST L0032
+L0031: HRRZI 1,50
+ PUSHJ 15,SYMFNC+141
+L0032: LDB 1,L0023
+ CAIN 1,35
+ JRST L0033
+ HRRZI 1,51
+ PUSHJ 15,SYMFNC+142
+ JRST L0034
+L0033: HRRZI 1,51
+ PUSHJ 15,SYMFNC+141
+L0034: LDB 1,L0024
+ CAIN 1,69
+ JRST L0035
+ HRRZI 1,52
+ PUSHJ 15,SYMFNC+142
+ JRST L0036
+L0035: HRRZI 1,52
+ PUSHJ 15,SYMFNC+141
+L0036: LDB 1,L0025
+ CAIN 1,103
+ JRST L0037
+ HRRZI 1,53
+ PUSHJ 15,SYMFNC+142
+ JRST L0038
+L0037: HRRZI 1,53
+ PUSHJ 15,SYMFNC+141
+L0038: LDB 1,L0026
+ CAIN 1,291
+ JRST L0039
+ HRRZI 1,54
+ PUSHJ 15,SYMFNC+142
+ JRST L0040
+L0039: HRRZI 1,54
+ PUSHJ 15,SYMFNC+141
+L0040: LDB 1,L0027
+ CAIN 1,17767
+ JRST L0041
+ HRRZI 1,55
+ PUSHJ 15,SYMFNC+142
+ JRST L0042
+L0041: HRRZI 1,55
+ PUSHJ 15,SYMFNC+141
+L0042: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+L0021: point 36,0(15),35
+L0022: point 8,0(15),7
+L0023: point 8,0(15),15
+L0024: point 8,0(15),23
+L0025: point 8,0(15),31
+L0026: point 16,0(15),15
+L0027: point 16,0(15),31
+; (!*ENTRY LSHIFTTEST EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (WCONST 70) (REG 5))
+; (HRRZI (REG 5) 70)
+; (!*MOVE (WCONST 73) (REG 4))
+; (HRRZI (REG 4) 73)
+; (!*MOVE (WCONST 72) (REG 3))
+; (HRRZI (REG 3) 72)
+; (!*MOVE (WCONST 83) (REG 2))
+; (HRRZI (REG 2) 83)
+; (!*MOVE (WCONST 76) (REG 1))
+; (HRRZI (REG 1) 76)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (WCONST 10) (REG 5))
+; (HRRZI (REG 5) 10)
+; (!*MOVE (WCONST 32) (REG 4))
+; (HRRZI (REG 4) 32)
+; (!*MOVE (WCONST 32) (REG 3))
+; (HRRZI (REG 3) 32)
+; (!*MOVE (WCONST 32) (REG 2))
+; (HRRZI (REG 2) 32)
+; (!*MOVE (WCONST 84) (REG 1))
+; (HRRZI (REG 1) 84)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (WCONST 36) (REG 3))
+; (HRRZI (REG 3) 36)
+; (!*MOVE (WCONST 0) (REG 2))
+; (SETZM (REG 2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0006) (REG 1) (FRAME 1))
+; (CAMN (REG 1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0006))
+; (!*MOVE (WCONST 49) (REG 1))
+; (HRRZI (REG 1) 49)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (WCONST 49) (REG 1))
+; (HRRZI (REG 1) 49)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (WCONST 8) (REG 3))
+; (HRRZI (REG 3) 8)
+; (!*MOVE (WCONST 0) (REG 2))
+; (SETZM (REG 2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0010) (REG 1) (WCONST 1))
+; (CAIN (REG 1) 1)
+; (JRST (LABEL G0010))
+; (!*MOVE (WCONST 50) (REG 1))
+; (HRRZI (REG 1) 50)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0009))
+; (JRST (LABEL G0009))
+; (!*LBL (LABEL G0010))
+; (!*MOVE (WCONST 50) (REG 1))
+; (HRRZI (REG 1) 50)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0009))
+; (!*MOVE (WCONST 8) (REG 3))
+; (HRRZI (REG 3) 8)
+; (!*MOVE (WCONST 8) (REG 2))
+; (HRRZI (REG 2) 8)
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0014) (REG 1) (WCONST 35))
+; (CAIN (REG 1) 35)
+; (JRST (LABEL G0014))
+; (!*MOVE (WCONST 51) (REG 1))
+; (HRRZI (REG 1) 51)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0013))
+; (JRST (LABEL G0013))
+; (!*LBL (LABEL G0014))
+; (!*MOVE (WCONST 51) (REG 1))
+; (HRRZI (REG 1) 51)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0013))
+; (!*MOVE (WCONST 8) (REG 3))
+; (HRRZI (REG 3) 8)
+; (!*MOVE (WCONST 16) (REG 2))
+; (HRRZI (REG 2) 16)
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0018) (REG 1) (WCONST 69))
+; (CAIN (REG 1) 69)
+; (JRST (LABEL G0018))
+; (!*MOVE (WCONST 52) (REG 1))
+; (HRRZI (REG 1) 52)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0017))
+; (JRST (LABEL G0017))
+; (!*LBL (LABEL G0018))
+; (!*MOVE (WCONST 52) (REG 1))
+; (HRRZI (REG 1) 52)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0017))
+; (!*MOVE (WCONST 8) (REG 3))
+; (HRRZI (REG 3) 8)
+; (!*MOVE (WCONST 24) (REG 2))
+; (HRRZI (REG 2) 24)
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0022) (REG 1) (WCONST 103))
+; (CAIN (REG 1) 103)
+; (JRST (LABEL G0022))
+; (!*MOVE (WCONST 53) (REG 1))
+; (HRRZI (REG 1) 53)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0021))
+; (JRST (LABEL G0021))
+; (!*LBL (LABEL G0022))
+; (!*MOVE (WCONST 53) (REG 1))
+; (HRRZI (REG 1) 53)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0021))
+; (!*MOVE (WCONST 16) (REG 3))
+; (HRRZI (REG 3) 16)
+; (!*MOVE (WCONST 0) (REG 2))
+; (SETZM (REG 2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0026) (REG 1) (WCONST 291))
+; (CAIN (REG 1) 291)
+; (JRST (LABEL G0026))
+; (!*MOVE (WCONST 54) (REG 1))
+; (HRRZI (REG 1) 54)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0025))
+; (JRST (LABEL G0025))
+; (!*LBL (LABEL G0026))
+; (!*MOVE (WCONST 54) (REG 1))
+; (HRRZI (REG 1) 54)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0025))
+; (!*MOVE (WCONST 16) (REG 3))
+; (HRRZI (REG 3) 16)
+; (!*MOVE (WCONST 16) (REG 2))
+; (HRRZI (REG 2) 16)
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EXTRACT EXPR 3)
+; (PUSHJ (REG ST) (ENTRY EXTRACT))
+; (!*JUMPEQ (LABEL G0030) (REG 1) (WCONST 17767))
+; (CAIN (REG 1) 17767)
+; (JRST (LABEL G0030))
+; (!*MOVE (WCONST 55) (REG 1))
+; (HRRZI (REG 1) 55)
+; (!*LINK TESTERR EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTERR))
+; (!*JUMP (LABEL G0029))
+; (JRST (LABEL G0029))
+; (!*LBL (LABEL G0030))
+; (!*MOVE (WCONST 55) (REG 1))
+; (HRRZI (REG 1) 55)
+; (!*LINK TESTOK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTOK))
+; (!*LBL (LABEL G0029))
+; (!*MOVE 'NIL (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (!*ENTRY LSHIFTTEST EXPR 1)
+L0043: intern L0043
+ PUSH 15,1
+ HRRZI 5,70
+ HRRZI 4,73
+ HRRZI 3,72
+ HRRZI 2,83
+ HRRZI 1,76
+ PUSHJ 15,SYMFNC+140
+ HRRZI 5,10
+ HRRZI 4,32
+ HRRZI 3,32
+ HRRZI 2,32
+ HRRZI 1,84
+ PUSHJ 15,SYMFNC+140
+ HRRZI 3,36
+ SETZM 2
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAMN 1,0(15)
+ JRST L0044
+ HRRZI 1,49
+ PUSHJ 15,SYMFNC+142
+ JRST L0045
+L0044: HRRZI 1,49
+ PUSHJ 15,SYMFNC+141
+L0045: HRRZI 3,8
+ SETZM 2
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAIN 1,1
+ JRST L0046
+ HRRZI 1,50
+ PUSHJ 15,SYMFNC+142
+ JRST L0047
+L0046: HRRZI 1,50
+ PUSHJ 15,SYMFNC+141
+L0047: HRRZI 3,8
+ HRRZI 2,8
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAIN 1,35
+ JRST L0048
+ HRRZI 1,51
+ PUSHJ 15,SYMFNC+142
+ JRST L0049
+L0048: HRRZI 1,51
+ PUSHJ 15,SYMFNC+141
+L0049: HRRZI 3,8
+ HRRZI 2,16
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAIN 1,69
+ JRST L0050
+ HRRZI 1,52
+ PUSHJ 15,SYMFNC+142
+ JRST L0051
+L0050: HRRZI 1,52
+ PUSHJ 15,SYMFNC+141
+L0051: HRRZI 3,8
+ HRRZI 2,24
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAIN 1,103
+ JRST L0052
+ HRRZI 1,53
+ PUSHJ 15,SYMFNC+142
+ JRST L0053
+L0052: HRRZI 1,53
+ PUSHJ 15,SYMFNC+141
+L0053: HRRZI 3,16
+ SETZM 2
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAIN 1,291
+ JRST L0054
+ HRRZI 1,54
+ PUSHJ 15,SYMFNC+142
+ JRST L0055
+L0054: HRRZI 1,54
+ PUSHJ 15,SYMFNC+141
+L0055: HRRZI 3,16
+ HRRZI 2,16
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+147
+ CAIN 1,17767
+ JRST L0056
+ HRRZI 1,55
+ PUSHJ 15,SYMFNC+142
+ JRST L0057
+L0056: HRRZI 1,55
+ PUSHJ 15,SYMFNC+141
+L0057: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY MSG5 EXPR 5)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 2) (FRAME 1))
+; (MOVEM (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 3) (FRAME 2))
+; (MOVEM (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 4) (FRAME 3))
+; (MOVEM (REG 4) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 5) (FRAME 4))
+; (MOVEM (REG 5) (INDEXED (REG ST) -3))
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*LINKE 4 PUTC EXPR 1)
+; (ADJSP (REG ST) (MINUS 4))
+; (JRST (ENTRY PUTC))
+; (!*ENTRY MSG5 EXPR 5)
+MSG5: intern MSG5
+ ADJSP 15,4
+ MOVEM 2,0(15)
+ MOVEM 3,-1(15)
+ MOVEM 4,-2(15)
+ MOVEM 5,-3(15)
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,-3(15)
+ ADJSP 15,-4
+ JRST SYMFNC+134
+; (!*ENTRY TESTNUM EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (WCONST 32) (REG 5))
+; (HRRZI (REG 5) 32)
+; (!*MOVE (WCONST 116) (REG 4))
+; (HRRZI (REG 4) 116)
+; (!*MOVE (WCONST 115) (REG 3))
+; (HRRZI (REG 3) 115)
+; (!*MOVE (WCONST 101) (REG 2))
+; (HRRZI (REG 2) 101)
+; (!*MOVE (WCONST 84) (REG 1))
+; (HRRZI (REG 1) 84)
+; (!*LINK MSG5 EXPR 5)
+; (PUSHJ (REG ST) (ENTRY MSG5))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 32) (REG 1))
+; (HRRZI (REG 1) 32)
+; (!*LINK PUTC EXPR 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE 'NIL (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (!*ENTRY TESTNUM EXPR 1)
+L0058: intern L0058
+ PUSH 15,1
+ HRRZI 5,32
+ HRRZI 4,116
+ HRRZI 3,115
+ HRRZI 2,101
+ HRRZI 1,84
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+134
+ HRRZI 1,32
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY TESTERR EXPR 1)
+; (!*ALLOC 0)
+; (!*LINK TESTNUM EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTNUM))
+; (!*MOVE (WCONST 10) (REG 5))
+; (HRRZI (REG 5) 10)
+; (!*MOVE (WCONST 32) (REG 4))
+; (HRRZI (REG 4) 32)
+; (!*MOVE (WCONST 114) (REG 3))
+; (HRRZI (REG 3) 114)
+; (!*MOVE (WCONST 114) (REG 2))
+; (HRRZI (REG 2) 114)
+; (!*MOVE (WCONST 69) (REG 1))
+; (HRRZI (REG 1) 69)
+; (!*LINKE 0 MSG5 EXPR 5)
+; (JRST (ENTRY MSG5))
+; (!*ENTRY TESTERR EXPR 1)
+L0059: intern L0059
+ PUSHJ 15,SYMFNC+148
+ HRRZI 5,10
+ HRRZI 4,32
+ HRRZI 3,114
+ HRRZI 2,114
+ HRRZI 1,69
+ JRST SYMFNC+140
+; (!*ENTRY TESTOK EXPR 1)
+; (!*ALLOC 0)
+; (!*LINK TESTNUM EXPR 1)
+; (PUSHJ (REG ST) (ENTRY TESTNUM))
+; (!*MOVE (WCONST 10) (REG 5))
+; (HRRZI (REG 5) 10)
+; (!*MOVE (WCONST 32) (REG 4))
+; (HRRZI (REG 4) 32)
+; (!*MOVE (WCONST 32) (REG 3))
+; (HRRZI (REG 3) 32)
+; (!*MOVE (WCONST 107) (REG 2))
+; (HRRZI (REG 2) 107)
+; (!*MOVE (WCONST 79) (REG 1))
+; (HRRZI (REG 1) 79)
+; (!*LINKE 0 MSG5 EXPR 5)
+; (JRST (ENTRY MSG5))
+; (!*ENTRY TESTOK EXPR 1)
+TESTOK: intern TESTOK
+ PUSHJ 15,SYMFNC+148
+ HRRZI 5,10
+ HRRZI 4,32
+ HRRZI 3,32
+ HRRZI 2,107
+ HRRZI 1,79
+ JRST SYMFNC+140
+; (!*ENTRY MAKEMASK EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (WCONST 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*WSHIFT (REG 1) (REG 2))
+; (LSH (REG 1) (INDEXED (REG 2) 0))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*ENTRY MAKEMASK EXPR 1)
+L0060: intern L0060
+ MOVE 2,1
+ HRRZI 1,1
+ LSH 1,0(2)
+ SOS 1
+ POPJ 15,0
+; (!*ENTRY EXTRACT EXPR 3)
+; (!*ALLOC 5)
+; (ADJSP (REG ST) 5)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*LINK MAKEMASK EXPR 1)
+; (PUSHJ (REG ST) (ENTRY MAKEMASK))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 2) (FRAME 3))
+; (ADD (REG 2) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 2) (WCONST -36))
+; (SUBI (REG 2) (MINUS -36))
+; (!*MOVE (REG 2) (FRAME 5))
+; (MOVEM (REG 2) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*WSHIFT (REG 3) (REG 2))
+; (LSH (REG 3) (INDEXED (REG 2) 0))
+; (!*WAND (REG 1) (REG 3))
+; (AND (REG 1) (REG 3))
+; (!*EXIT 5)
+; (ADJSP (REG ST) (MINUS 5))
+; (POPJ (REG ST) 0)
+; (!*ENTRY EXTRACT EXPR 3)
+L0061: intern L0061
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+149
+ MOVEM 1,-3(15)
+ MOVE 2,-1(15)
+ ADD 2,-2(15)
+ SUBI 2,36
+ MOVEM 2,-4(15)
+ MOVE 3,0(15)
+ LSH 3,0(2)
+ AND 1,3
+ ADJSP 15,-5
+ POPJ 15,0
+; (!*ENTRY INITCODE EXPR 0)
+L0062: intern L0062
+ MOVE 1,0
+ POPJ 15,0
+ extern SYMPRP
+ extern SYMVAL
+ extern SYMNAM
+L0063: 0
+ byte(7)0,0
+ intern L0063
+L0064: 0
+ byte(7)1,0
+ intern L0064
+L0065: 0
+ byte(7)2,0
+ intern L0065
+L0066: 0
+ byte(7)3,0
+ intern L0066
+L0067: 0
+ byte(7)4,0
+ intern L0067
+L0068: 0
+ byte(7)5,0
+ intern L0068
+L0069: 0
+ byte(7)6,0
+ intern L0069
+L0070: 0
+ byte(7)7,0
+ intern L0070
+L0071: 0
+ byte(7)8,0
+ intern L0071
+L0072: 0
+ byte(7)9,0
+ intern L0072
+L0073: 0
+ byte(7)10,0
+ intern L0073
+L0074: 0
+ byte(7)11,0
+ intern L0074
+L0075: 0
+ byte(7)12,0
+ intern L0075
+L0076: 0
+ byte(7)13,0
+ intern L0076
+L0077: 0
+ byte(7)14,0
+ intern L0077
+L0078: 0
+ byte(7)15,0
+ intern L0078
+L0079: 0
+ byte(7)16,0
+ intern L0079
+L0080: 0
+ byte(7)17,0
+ intern L0080
+L0081: 0
+ byte(7)18,0
+ intern L0081
+L0082: 0
+ byte(7)19,0
+ intern L0082
+L0083: 0
+ byte(7)20,0
+ intern L0083
+L0084: 0
+ byte(7)21,0
+ intern L0084
+L0085: 0
+ byte(7)22,0
+ intern L0085
+L0086: 0
+ byte(7)23,0
+ intern L0086
+L0087: 0
+ byte(7)24,0
+ intern L0087
+L0088: 0
+ byte(7)25,0
+ intern L0088
+L0089: 0
+ byte(7)26,0
+ intern L0089
+L0090: 0
+ byte(7)27,0
+ intern L0090
+L0091: 0
+ byte(7)28,0
+ intern L0091
+L0092: 0
+ byte(7)29,0
+ intern L0092
+L0093: 0
+ byte(7)30,0
+ intern L0093
+L0094: 0
+ byte(7)31,0
+ intern L0094
+L0095: 0
+ byte(7)32,0
+ intern L0095
+L0096: 0
+ byte(7)33,0
+ intern L0096
+L0097: 0
+ byte(7)34,0
+ intern L0097
+L0098: 0
+ byte(7)35,0
+ intern L0098
+L0099: 0
+ byte(7)36,0
+ intern L0099
+L0100: 0
+ byte(7)37,0
+ intern L0100
+L0101: 0
+ byte(7)38,0
+ intern L0101
+L0102: 0
+ byte(7)39,0
+ intern L0102
+L0103: 0
+ byte(7)40,0
+ intern L0103
+L0104: 0
+ byte(7)41,0
+ intern L0104
+L0105: 0
+ byte(7)42,0
+ intern L0105
+L0106: 0
+ byte(7)43,0
+ intern L0106
+L0107: 0
+ byte(7)44,0
+ intern L0107
+L0108: 0
+ byte(7)45,0
+ intern L0108
+L0109: 0
+ byte(7)46,0
+ intern L0109
+L0110: 0
+ byte(7)47,0
+ intern L0110
+L0111: 0
+ byte(7)48,0
+ intern L0111
+L0112: 0
+ byte(7)49,0
+ intern L0112
+L0113: 0
+ byte(7)50,0
+ intern L0113
+L0114: 0
+ byte(7)51,0
+ intern L0114
+L0115: 0
+ byte(7)52,0
+ intern L0115
+L0116: 0
+ byte(7)53,0
+ intern L0116
+L0117: 0
+ byte(7)54,0
+ intern L0117
+L0118: 0
+ byte(7)55,0
+ intern L0118
+L0119: 0
+ byte(7)56,0
+ intern L0119
+L0120: 0
+ byte(7)57,0
+ intern L0120
+L0121: 0
+ byte(7)58,0
+ intern L0121
+L0122: 0
+ byte(7)59,0
+ intern L0122
+L0123: 0
+ byte(7)60,0
+ intern L0123
+L0124: 0
+ byte(7)61,0
+ intern L0124
+L0125: 0
+ byte(7)62,0
+ intern L0125
+L0126: 0
+ byte(7)63,0
+ intern L0126
+L0127: 0
+ byte(7)64,0
+ intern L0127
+L0128: 0
+ byte(7)65,0
+ intern L0128
+L0129: 0
+ byte(7)66,0
+ intern L0129
+L0130: 0
+ byte(7)67,0
+ intern L0130
+L0131: 0
+ byte(7)68,0
+ intern L0131
+L0132: 0
+ byte(7)69,0
+ intern L0132
+L0133: 0
+ byte(7)70,0
+ intern L0133
+L0134: 0
+ byte(7)71,0
+ intern L0134
+L0135: 0
+ byte(7)72,0
+ intern L0135
+L0136: 0
+ byte(7)73,0
+ intern L0136
+L0137: 0
+ byte(7)74,0
+ intern L0137
+L0138: 0
+ byte(7)75,0
+ intern L0138
+L0139: 0
+ byte(7)76,0
+ intern L0139
+L0140: 0
+ byte(7)77,0
+ intern L0140
+L0141: 0
+ byte(7)78,0
+ intern L0141
+L0142: 0
+ byte(7)79,0
+ intern L0142
+L0143: 0
+ byte(7)80,0
+ intern L0143
+L0144: 0
+ byte(7)81,0
+ intern L0144
+L0145: 0
+ byte(7)82,0
+ intern L0145
+L0146: 0
+ byte(7)83,0
+ intern L0146
+L0147: 0
+ byte(7)84,0
+ intern L0147
+L0148: 0
+ byte(7)85,0
+ intern L0148
+L0149: 0
+ byte(7)86,0
+ intern L0149
+L0150: 0
+ byte(7)87,0
+ intern L0150
+L0151: 0
+ byte(7)88,0
+ intern L0151
+L0152: 0
+ byte(7)89,0
+ intern L0152
+L0153: 0
+ byte(7)90,0
+ intern L0153
+L0154: 0
+ byte(7)91,0
+ intern L0154
+L0155: 0
+ byte(7)92,0
+ intern L0155
+L0156: 0
+ byte(7)93,0
+ intern L0156
+L0157: 0
+ byte(7)94,0
+ intern L0157
+L0158: 0
+ byte(7)95,0
+ intern L0158
+L0159: 0
+ byte(7)96,0
+ intern L0159
+L0160: 0
+ byte(7)97,0
+ intern L0160
+L0161: 0
+ byte(7)98,0
+ intern L0161
+L0162: 0
+ byte(7)99,0
+ intern L0162
+L0163: 0
+ byte(7)100,0
+ intern L0163
+L0164: 0
+ byte(7)101,0
+ intern L0164
+L0165: 0
+ byte(7)102,0
+ intern L0165
+L0166: 0
+ byte(7)103,0
+ intern L0166
+L0167: 0
+ byte(7)104,0
+ intern L0167
+L0168: 0
+ byte(7)105,0
+ intern L0168
+L0169: 0
+ byte(7)106,0
+ intern L0169
+L0170: 0
+ byte(7)107,0
+ intern L0170
+L0171: 0
+ byte(7)108,0
+ intern L0171
+L0172: 0
+ byte(7)109,0
+ intern L0172
+L0173: 0
+ byte(7)110,0
+ intern L0173
+L0174: 0
+ byte(7)111,0
+ intern L0174
+L0175: 0
+ byte(7)112,0
+ intern L0175
+L0176: 0
+ byte(7)113,0
+ intern L0176
+L0177: 0
+ byte(7)114,0
+ intern L0177
+L0178: 0
+ byte(7)115,0
+ intern L0178
+L0179: 0
+ byte(7)116,0
+ intern L0179
+L0180: 0
+ byte(7)117,0
+ intern L0180
+L0181: 0
+ byte(7)118,0
+ intern L0181
+L0182: 0
+ byte(7)119,0
+ intern L0182
+L0183: 0
+ byte(7)120,0
+ intern L0183
+L0184: 0
+ byte(7)121,0
+ intern L0184
+L0185: 0
+ byte(7)122,0
+ intern L0185
+L0186: 0
+ byte(7)123,0
+ intern L0186
+L0187: 0
+ byte(7)124,0
+ intern L0187
+L0188: 0
+ byte(7)125,0
+ intern L0188
+L0189: 0
+ byte(7)126,0
+ intern L0189
+L0190: 0
+ byte(7)127,0
+ intern L0190
+L0191: 2
+ byte(7)78,73,76,0
+ intern L0191
+L0192: 4
+ byte(7)77,65,73,78,46,0
+ intern L0192
+L0193: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L0193
+L0194: 3
+ byte(7)73,78,73,84,0
+ intern L0194
+L0195: 3
+ byte(7)71,69,84,67,0
+ intern L0195
+L0196: 3
+ byte(7)84,73,77,67,0
+ intern L0196
+L0197: 3
+ byte(7)80,85,84,67,0
+ intern L0197
+L0198: 3
+ byte(7)81,85,73,84,0
+ intern L0198
+L0199: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L0199
+L0200: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L0200
+L0201: 3
+ byte(7)70,76,65,71,0
+ intern L0201
+L0202: 8
+ byte(7)42,87,84,73,77,69,83,51,50,0
+ intern L0202
+L0203: 3
+ byte(7)77,83,71,53,0
+ intern L0203
+L0204: 5
+ byte(7)84,69,83,84,79,75,0
+ intern L0204
+L0205: 6
+ byte(7)84,69,83,84,69,82,82,0
+ intern L0205
+L0206: 2
+ byte(7)69,82,82,0
+ intern L0206
+L0207: 9
+ byte(7)65,83,72,73,70,84,84,69,83,84,0
+ intern L0207
+L0208: 8
+ byte(7)70,73,69,76,68,84,69,83,84,0
+ intern L0208
+L0209: 9
+ byte(7)76,83,72,73,70,84,84,69,83,84,0
+ intern L0209
+L0210: 6
+ byte(7)69,88,84,82,65,67,84,0
+ intern L0210
+L0211: 6
+ byte(7)84,69,83,84,78,85,77,0
+ intern L0211
+L0212: 7
+ byte(7)77,65,75,69,77,65,83,75,0
+ intern L0212
+L0213: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L0213
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/20-tests/fresh.init
Index: psl-1983/20-tests/fresh.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/fresh.init
ADDED psl-1983/20-tests/fresh.mic
Index: psl-1983/20-tests/fresh.mic
==================================================================
--- /dev/null
+++ psl-1983/20-tests/fresh.mic
@@ -0,0 +1,27 @@
+;; Independant compilation of a PSL program
+;
+; MIC FRESH modulename
+;
+; Initialize for new sequence of builds
+;
+@delete 'a.SYM
+@copy pc:bare-psl.sym 'A.sym
+@define DSK:, DSK:, PT:, P20:, PI:
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@reset dec20-cross
+@s:DEC20-cross.exe
+off break; %kill obnoxious break loops
+off USERMODE ;
+InputSymFile!* := "'A.sym"$
+OutputSymFile!* := "'A.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''NIL;
+ ModName!*:='''A;
+ASMOUT "FRESH"$
+ASMEnd$
+quit$
+@terminal length 24
+@delete Fresh.mac
+@delete DFresh.mac
ADDED psl-1983/20-tests/junk.it
Index: psl-1983/20-tests/junk.it
==================================================================
--- /dev/null
+++ psl-1983/20-tests/junk.it
@@ -0,0 +1,3 @@
+This is the Test.It file.
+It has 3 lines (this is Line 2)
+This is the last line.
ADDED psl-1983/20-tests/junk.junk
Index: psl-1983/20-tests/junk.junk
==================================================================
--- /dev/null
+++ psl-1983/20-tests/junk.junk
@@ -0,0 +1,3 @@
+Line 1
+Line 2
+Line 3 (last)
ADDED psl-1983/20-tests/main1.cmd
Index: psl-1983/20-tests/main1.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main1.cmd
@@ -0,0 +1,2 @@
+main1,Dmain1,20io
+
ADDED psl-1983/20-tests/main1.init
Index: psl-1983/20-tests/main1.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main1.init
@@ -0,0 +1,4 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/20-tests/main1.mac
Index: psl-1983/20-tests/main1.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main1.mac
@@ -0,0 +1,1265 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern HEAP
+ extern L0001
+ extern L0002
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (MOVE (REG NIL) (FLUID NIL))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (HRRZI (REG LINKREG) 129)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L0005
+ MOVE 0,SYMVAL+128
+ HRRZI 12,129
+ SETZM 13
+ JRST SYMFNC+129
+L0005: byte(18)-5000,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK INIT20 EXPR 1)
+ extern INIT20
+; (PUSHJ (REG ST) (INTERNALENTRY INIT20))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ PUSHJ 15,INIT20
+ SETZM SYMVAL+132
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+133
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 0) (!$FLUID IN!*))
+; (SKIPE (!$FLUID IN!*))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+ extern GETC20
+; (PUSHJ (REG ST) (INTERNALENTRY GETC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID IN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID IN!*))
+; (!*LINKE 0 INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTREADCHAR))
+ 0
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SKIPE SYMVAL+132
+ JRST L0006
+ SETZM 1
+ PUSHJ 15,GETC20
+ POPJ 15,0
+L0006: MOVE 1,SYMVAL+132
+ HRRZI 12,134
+ HRRZI 13,1
+ JRST SYMFNC+134
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+ extern TIMC20
+; (PUSHJ (REG ST) (INTERNALENTRY TIMC20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ PUSHJ 15,TIMC20
+ POPJ 15,0
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 1) (!$FLUID OUT!*))
+; (MOVE (REG T2) (!$FLUID OUT!*))
+; (CAIE (REG T2) 1)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PUTC20 EXPR 1)
+ extern PUTC20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID OUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 137)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ MOVE 7,SYMVAL+133
+ CAIE 7,1
+ JRST L0007
+ PUSHJ 15,PUTC20
+ POPJ 15,0
+L0007: MOVE 2,1
+ MOVE 1,SYMVAL+133
+ HRRZI 12,137
+ HRRZI 13,2
+ JRST SYMFNC+137
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+ extern QUIT20
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+ extern PUTI20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTI20))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ PUSHJ 15,PUTI20
+ POPJ 15,0
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+; (!*WOR (REG 1) 23085449216)
+; (IOR (REG 1) 23085449216)
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+L0008: intern L0008
+ IOR 1,[23085449216]
+ MOVEM 1,0(2)
+ POPJ 15,0
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+; (!*MOVE (MEMORY (REG 1) (WCONST 0)) (MEMORY (REG 2) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG 1) 0))
+; (MOVEM (REG T1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+L0009: intern L0009
+ MOVE 6,0(1)
+ MOVEM 6,0(2)
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 1)
+; (!*MOVE (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (MOVEM (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (!*MOVE (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (MOVEM (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (!*JCALL UNDEFINEDFUNCTIONAUX)
+; (JRST (ENTRY UNDEFINEDFUNCTIONAUX))
+ 1
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 1)
+L0010: intern L0010
+ MOVEM 12,SYMVAL+144
+ MOVEM 13,SYMVAL+145
+ JRST SYMFNC+146
+; (!*ENTRY FLAG EXPR 2)
+; (!*MOVE 2 (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINK ERR20 EXPR 1)
+ extern ERR20
+; (PUSHJ (REG ST) (INTERNALENTRY ERR20))
+ 2
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ HRRZI 1,2
+ PUSHJ 15,ERR20
+; (!*ENTRY LONGTIMES EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGTIMES EXPR 2)
+L0011: intern L0011
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY LONGDIV EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 149)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGDIV EXPR 2)
+L0012: intern L0012
+ HRRZI 12,149
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+; (!*ENTRY LONGREMAINDER EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 151)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (MOVE (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGREMAINDER EXPR 2)
+L0013: intern L0013
+ HRRZI 12,151
+ HRRZI 13,2
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK INIT EXPR 0)
+; (HRRZI (REG LINKREG) 131)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INIT))
+; (!*MOVE (WCONST 65) (REG 1))
+; (HRRZI (REG 1) 65)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 66) (REG 1))
+; (HRRZI (REG 1) 66)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINK IFACT EXPR 1)
+; (HRRZI (REG LINKREG) 154)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY IFACT))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TESTFACT EXPR 0)
+; (HRRZI (REG LINKREG) 155)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TESTFACT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TESTTAK EXPR 0)
+; (HRRZI (REG LINKREG) 156)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TESTTAK))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY FIRSTCALL EXPR 0)
+L0014: intern L0014
+ HRRZI 12,131
+ SETZM 13
+ PUSHJ 15,SYMFNC+131
+ HRRZI 1,65
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 1,66
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ HRRZI 1,10
+ HRRZI 12,154
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+154
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ HRRZI 12,155
+ SETZM 13
+ PUSHJ 15,SYMFNC+155
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ HRRZI 12,156
+ SETZM 13
+ PUSHJ 15,SYMFNC+156
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY TERPRI EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINKE 0 PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+ 0
+; (!*ENTRY TERPRI EXPR 0)
+TERPRI: intern TERPRI
+ HRRZI 1,10
+ HRRZI 12,138
+ HRRZI 13,1
+ JRST SYMFNC+138
+; (!*ENTRY TESTFACT EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 136)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (WCONST 10000) (REG 1))
+; (HRRZI (REG 1) 10000)
+; (!*LINK ARITHMETICTEST EXPR 1)
+; (HRRZI (REG LINKREG) 157)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ARITHMETICTEST))
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 136)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TESTFACT EXPR 0)
+L0015: intern L0015
+ HRRZI 12,136
+ SETZM 13
+ PUSHJ 15,SYMFNC+136
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ HRRZI 1,10000
+ HRRZI 12,157
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+157
+ HRRZI 12,136
+ SETZM 13
+ PUSHJ 15,SYMFNC+136
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY ARITHMETICTEST EXPR 1)
+; (!*PUSH (WCONST 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (WCONST 9) (REG 1))
+; (HRRZI (REG 1) 9)
+; (!*LINK FACT EXPR 1)
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FACT))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY ARITHMETICTEST EXPR 1)
+L0017: intern L0017
+ PUSH 15,L0016
+ PUSH 15,1
+L0018: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L0019
+ MOVE 1,0
+ JRST L0020
+L0019: HRRZI 1,9
+ HRRZI 12,158
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+158
+ AOS -1(15)
+ JRST L0018
+L0020: ADJSP 15,-2
+ POPJ 15,0
+L0016: 0
+; (!*ENTRY TESTTAK EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 136)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*MOVE (WCONST 6) (REG 3))
+; (HRRZI (REG 3) 6)
+; (!*MOVE (WCONST 12) (REG 2))
+; (HRRZI (REG 2) 12)
+; (!*MOVE (WCONST 18) (REG 1))
+; (HRRZI (REG 1) 18)
+; (!*LINK TOPLEVELTAK EXPR 3)
+; (HRRZI (REG LINKREG) 159)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TOPLEVELTAK))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 136)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TESTTAK EXPR 0)
+L0021: intern L0021
+ HRRZI 12,136
+ SETZM 13
+ PUSHJ 15,SYMFNC+136
+ HRRZI 3,6
+ HRRZI 2,12
+ HRRZI 1,18
+ HRRZI 12,159
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+159
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ HRRZI 12,136
+ SETZM 13
+ PUSHJ 15,SYMFNC+136
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY TOPLEVELTAK EXPR 3)
+; (!*ALLOC 0)
+; (!*LINKE 0 TAK EXPR 3)
+; (HRRZI (REG LINKREG) 160)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY TAK))
+ 3
+; (!*ENTRY TOPLEVELTAK EXPR 3)
+L0022: intern L0022
+ HRRZI 12,160
+ HRRZI 13,3
+ JRST SYMFNC+160
+; (!*ENTRY TAK EXPR 3)
+; (!*ALLOC 5)
+; (ADJSP (REG ST) 5)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*JUMPWLESSP (LABEL G0004) (REG 2) (REG 1))
+; (CAMGE (REG 2) (REG 1))
+; (JRST (LABEL G0004))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 160)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 160)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (FRAME 5))
+; (MOVEM (REG 1) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 160)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 5) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 5)
+; (ADJSP (REG ST) (MINUS 5))
+; (POPJ (REG ST) 0)
+ 3
+; (!*ENTRY TAK EXPR 3)
+TAK: intern TAK
+ ADJSP 15,5
+L0023: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ CAMGE 2,1
+ JRST L0024
+ MOVE 1,3
+ JRST L0025
+L0024: SOS 1
+ HRRZI 12,160
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVEM 1,-3(15)
+ MOVE 3,0(15)
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ SOS 1
+ HRRZI 12,160
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVEM 1,-4(15)
+ MOVE 3,-1(15)
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ SOS 1
+ HRRZI 12,160
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVE 3,1
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ JRST L0023
+L0025: ADJSP 15,-5
+ POPJ 15,0
+; (!*ENTRY FACT EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPWGEQ (LABEL G0004) (REG 1) (WCONST 2))
+; (CAIL (REG 1) 2)
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK FACT EXPR 1)
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY FACT))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 LONGTIMES EXPR 2)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 148)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY LONGTIMES))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY FACT EXPR 1)
+FACT: intern FACT
+ PUSH 15,1
+ CAIL 1,2
+ JRST L0026
+ HRRZI 1,1
+ JRST L0027
+L0026: SOS 1
+ HRRZI 12,158
+ HRRZI 13,1
+ PUSHJ 15,FACT
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,148
+ HRRZI 13,2
+ JRST SYMFNC+148
+L0027: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY IFACT EXPR 1)
+; (!*PUSH (WCONST 1))
+; (PUSH (REG ST) (LIT (FULLWORD 1)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTEQ (LABEL G0005) (FRAME 1) (WCONST 1))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (CAIE (REG T1) 1)
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LONGTIMES EXPR 2)
+; (HRRZI (REG LINKREG) 148)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LONGTIMES))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (FRAME 1) (WCONST -1))
+; (SOS (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 153)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 1)
+ 1
+; (!*ENTRY IFACT EXPR 1)
+IFACT: intern IFACT
+ PUSH 15,L0028
+ PUSH 15,1
+L0029: MOVE 6,0(15)
+ CAIE 6,1
+ JRST L0030
+ MOVE 1,-1(15)
+ JRST L0031
+L0030: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ HRRZI 12,148
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+148
+ MOVEM 1,-1(15)
+ SOS 0(15)
+ MOVE 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ MOVE 1,-1(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ HRRZI 12,153
+ SETZM 13
+ PUSHJ 15,SYMFNC+153
+ JRST L0029
+L0031: ADJSP 15,-2
+ POPJ 15,0
+L0028: 1
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L0032: intern L0032
+ MOVE 1,0
+ POPJ 15,0
+ extern SYMVAL
+ extern SYMPRP
+ extern SYMNAM
+L0033: 0
+ byte(7)0,0
+ intern L0033
+L0034: 0
+ byte(7)1,0
+ intern L0034
+L0035: 0
+ byte(7)2,0
+ intern L0035
+L0036: 0
+ byte(7)3,0
+ intern L0036
+L0037: 0
+ byte(7)4,0
+ intern L0037
+L0038: 0
+ byte(7)5,0
+ intern L0038
+L0039: 0
+ byte(7)6,0
+ intern L0039
+L0040: 0
+ byte(7)7,0
+ intern L0040
+L0041: 0
+ byte(7)8,0
+ intern L0041
+L0042: 0
+ byte(7)9,0
+ intern L0042
+L0043: 0
+ byte(7)10,0
+ intern L0043
+L0044: 0
+ byte(7)11,0
+ intern L0044
+L0045: 0
+ byte(7)12,0
+ intern L0045
+L0046: 0
+ byte(7)13,0
+ intern L0046
+L0047: 0
+ byte(7)14,0
+ intern L0047
+L0048: 0
+ byte(7)15,0
+ intern L0048
+L0049: 0
+ byte(7)16,0
+ intern L0049
+L0050: 0
+ byte(7)17,0
+ intern L0050
+L0051: 0
+ byte(7)18,0
+ intern L0051
+L0052: 0
+ byte(7)19,0
+ intern L0052
+L0053: 0
+ byte(7)20,0
+ intern L0053
+L0054: 0
+ byte(7)21,0
+ intern L0054
+L0055: 0
+ byte(7)22,0
+ intern L0055
+L0056: 0
+ byte(7)23,0
+ intern L0056
+L0057: 0
+ byte(7)24,0
+ intern L0057
+L0058: 0
+ byte(7)25,0
+ intern L0058
+L0059: 0
+ byte(7)26,0
+ intern L0059
+L0060: 0
+ byte(7)27,0
+ intern L0060
+L0061: 0
+ byte(7)28,0
+ intern L0061
+L0062: 0
+ byte(7)29,0
+ intern L0062
+L0063: 0
+ byte(7)30,0
+ intern L0063
+L0064: 0
+ byte(7)31,0
+ intern L0064
+L0065: 0
+ byte(7)32,0
+ intern L0065
+L0066: 0
+ byte(7)33,0
+ intern L0066
+L0067: 0
+ byte(7)34,0
+ intern L0067
+L0068: 0
+ byte(7)35,0
+ intern L0068
+L0069: 0
+ byte(7)36,0
+ intern L0069
+L0070: 0
+ byte(7)37,0
+ intern L0070
+L0071: 0
+ byte(7)38,0
+ intern L0071
+L0072: 0
+ byte(7)39,0
+ intern L0072
+L0073: 0
+ byte(7)40,0
+ intern L0073
+L0074: 0
+ byte(7)41,0
+ intern L0074
+L0075: 0
+ byte(7)42,0
+ intern L0075
+L0076: 0
+ byte(7)43,0
+ intern L0076
+L0077: 0
+ byte(7)44,0
+ intern L0077
+L0078: 0
+ byte(7)45,0
+ intern L0078
+L0079: 0
+ byte(7)46,0
+ intern L0079
+L0080: 0
+ byte(7)47,0
+ intern L0080
+L0081: 0
+ byte(7)48,0
+ intern L0081
+L0082: 0
+ byte(7)49,0
+ intern L0082
+L0083: 0
+ byte(7)50,0
+ intern L0083
+L0084: 0
+ byte(7)51,0
+ intern L0084
+L0085: 0
+ byte(7)52,0
+ intern L0085
+L0086: 0
+ byte(7)53,0
+ intern L0086
+L0087: 0
+ byte(7)54,0
+ intern L0087
+L0088: 0
+ byte(7)55,0
+ intern L0088
+L0089: 0
+ byte(7)56,0
+ intern L0089
+L0090: 0
+ byte(7)57,0
+ intern L0090
+L0091: 0
+ byte(7)58,0
+ intern L0091
+L0092: 0
+ byte(7)59,0
+ intern L0092
+L0093: 0
+ byte(7)60,0
+ intern L0093
+L0094: 0
+ byte(7)61,0
+ intern L0094
+L0095: 0
+ byte(7)62,0
+ intern L0095
+L0096: 0
+ byte(7)63,0
+ intern L0096
+L0097: 0
+ byte(7)64,0
+ intern L0097
+L0098: 0
+ byte(7)65,0
+ intern L0098
+L0099: 0
+ byte(7)66,0
+ intern L0099
+L0100: 0
+ byte(7)67,0
+ intern L0100
+L0101: 0
+ byte(7)68,0
+ intern L0101
+L0102: 0
+ byte(7)69,0
+ intern L0102
+L0103: 0
+ byte(7)70,0
+ intern L0103
+L0104: 0
+ byte(7)71,0
+ intern L0104
+L0105: 0
+ byte(7)72,0
+ intern L0105
+L0106: 0
+ byte(7)73,0
+ intern L0106
+L0107: 0
+ byte(7)74,0
+ intern L0107
+L0108: 0
+ byte(7)75,0
+ intern L0108
+L0109: 0
+ byte(7)76,0
+ intern L0109
+L0110: 0
+ byte(7)77,0
+ intern L0110
+L0111: 0
+ byte(7)78,0
+ intern L0111
+L0112: 0
+ byte(7)79,0
+ intern L0112
+L0113: 0
+ byte(7)80,0
+ intern L0113
+L0114: 0
+ byte(7)81,0
+ intern L0114
+L0115: 0
+ byte(7)82,0
+ intern L0115
+L0116: 0
+ byte(7)83,0
+ intern L0116
+L0117: 0
+ byte(7)84,0
+ intern L0117
+L0118: 0
+ byte(7)85,0
+ intern L0118
+L0119: 0
+ byte(7)86,0
+ intern L0119
+L0120: 0
+ byte(7)87,0
+ intern L0120
+L0121: 0
+ byte(7)88,0
+ intern L0121
+L0122: 0
+ byte(7)89,0
+ intern L0122
+L0123: 0
+ byte(7)90,0
+ intern L0123
+L0124: 0
+ byte(7)91,0
+ intern L0124
+L0125: 0
+ byte(7)92,0
+ intern L0125
+L0126: 0
+ byte(7)93,0
+ intern L0126
+L0127: 0
+ byte(7)94,0
+ intern L0127
+L0128: 0
+ byte(7)95,0
+ intern L0128
+L0129: 0
+ byte(7)96,0
+ intern L0129
+L0130: 0
+ byte(7)97,0
+ intern L0130
+L0131: 0
+ byte(7)98,0
+ intern L0131
+L0132: 0
+ byte(7)99,0
+ intern L0132
+L0133: 0
+ byte(7)100,0
+ intern L0133
+L0134: 0
+ byte(7)101,0
+ intern L0134
+L0135: 0
+ byte(7)102,0
+ intern L0135
+L0136: 0
+ byte(7)103,0
+ intern L0136
+L0137: 0
+ byte(7)104,0
+ intern L0137
+L0138: 0
+ byte(7)105,0
+ intern L0138
+L0139: 0
+ byte(7)106,0
+ intern L0139
+L0140: 0
+ byte(7)107,0
+ intern L0140
+L0141: 0
+ byte(7)108,0
+ intern L0141
+L0142: 0
+ byte(7)109,0
+ intern L0142
+L0143: 0
+ byte(7)110,0
+ intern L0143
+L0144: 0
+ byte(7)111,0
+ intern L0144
+L0145: 0
+ byte(7)112,0
+ intern L0145
+L0146: 0
+ byte(7)113,0
+ intern L0146
+L0147: 0
+ byte(7)114,0
+ intern L0147
+L0148: 0
+ byte(7)115,0
+ intern L0148
+L0149: 0
+ byte(7)116,0
+ intern L0149
+L0150: 0
+ byte(7)117,0
+ intern L0150
+L0151: 0
+ byte(7)118,0
+ intern L0151
+L0152: 0
+ byte(7)119,0
+ intern L0152
+L0153: 0
+ byte(7)120,0
+ intern L0153
+L0154: 0
+ byte(7)121,0
+ intern L0154
+L0155: 0
+ byte(7)122,0
+ intern L0155
+L0156: 0
+ byte(7)123,0
+ intern L0156
+L0157: 0
+ byte(7)124,0
+ intern L0157
+L0158: 0
+ byte(7)125,0
+ intern L0158
+L0159: 0
+ byte(7)126,0
+ intern L0159
+L0160: 0
+ byte(7)127,0
+ intern L0160
+L0161: 2
+ byte(7)78,73,76,0
+ intern L0161
+L0162: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L0162
+L0163: 4
+ byte(7)77,65,73,78,46,0
+ intern L0163
+L0164: 3
+ byte(7)73,78,73,84,0
+ intern L0164
+L0165: 2
+ byte(7)73,78,42,0
+ intern L0165
+L0166: 3
+ byte(7)79,85,84,42,0
+ intern L0166
+L0167: 18
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,82,69,65,68,67,72,65,82,0
+ intern L0167
+L0168: 3
+ byte(7)71,69,84,67,0
+ intern L0168
+L0169: 3
+ byte(7)84,73,77,67,0
+ intern L0169
+L0170: 19
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,87,82,73,84,69,67,72,65,82,0
+ intern L0170
+L0171: 3
+ byte(7)80,85,84,67,0
+ intern L0171
+L0172: 3
+ byte(7)81,85,73,84,0
+ intern L0172
+L0173: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L0173
+L0174: 11
+ byte(7)37,83,84,79,82,69,45,74,67,65,76,76,0
+ intern L0174
+L0175: 18
+ byte(7)37,67,79,80,89,45,70,85,78,67,84,73,79,78,45,67,69,76,76,0
+ intern L0175
+L0176: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L0176
+L0177: 10
+ byte(7)85,78,68,69,70,78,67,79,68,69,42,0
+ intern L0177
+L0178: 10
+ byte(7)85,78,68,69,70,78,78,65,82,71,42,0
+ intern L0178
+L0179: 19
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,0
+ intern L0179
+L0180: 3
+ byte(7)70,76,65,71,0
+ intern L0180
+L0181: 8
+ byte(7)76,79,78,71,84,73,77,69,83,0
+ intern L0181
+L0182: 8
+ byte(7)87,81,85,79,84,73,69,78,84,0
+ intern L0182
+L0183: 6
+ byte(7)76,79,78,71,68,73,86,0
+ intern L0183
+L0184: 9
+ byte(7)87,82,69,77,65,73,78,68,69,82,0
+ intern L0184
+L0185: 12
+ byte(7)76,79,78,71,82,69,77,65,73,78,68,69,82,0
+ intern L0185
+L0186: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L0186
+L0187: 4
+ byte(7)73,70,65,67,84,0
+ intern L0187
+L0188: 7
+ byte(7)84,69,83,84,70,65,67,84,0
+ intern L0188
+L0189: 6
+ byte(7)84,69,83,84,84,65,75,0
+ intern L0189
+L0190: 13
+ byte(7)65,82,73,84,72,77,69,84,73,67,84,69,83,84,0
+ intern L0190
+L0191: 3
+ byte(7)70,65,67,84,0
+ intern L0191
+L0192: 10
+ byte(7)84,79,80,76,69,86,69,76,84,65,75,0
+ intern L0192
+L0193: 2
+ byte(7)84,65,75,0
+ intern L0193
+L0194: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L0194
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/20-tests/main1.sym
Index: psl-1983/20-tests/main1.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main1.sym
@@ -0,0 +1,131 @@
+(SAVEFORCOMPILATION '(PROGN))
+(SETQ ORDEREDIDLIST!* 'NIL)
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* '129)
+(SETQ STRINGGENSYM!* '"L0004")
+(PUT 'INFBITLENGTH 'SCOPE 'EXTERNAL)
+(PUT 'INFBITLENGTH 'ASMSYMBOL 'NIL)
+(PUT 'INFBITLENGTH 'WCONST '18)
+(PUT 'ST 'SCOPE 'EXTERNAL)
+(PUT 'ST 'ASMSYMBOL 'NIL)
+(PUT 'ST 'WVAR 'ST)
+(PUT 'ARG14 'SCOPE 'EXTERNAL)
+(PUT 'ARG14 'ASMSYMBOL 'ARG14)
+(PUT 'ARG14 'WVAR 'ARG14)
+(PUT 'SYMFNC 'SCOPE 'EXTERNAL)
+(PUT 'SYMFNC 'ASMSYMBOL 'SYMFNC)
+(PUT 'SYMFNC 'WARRAY 'SYMFNC)
+(PUT 'MAXOBARRAY 'SCOPE 'EXTERNAL)
+(PUT 'MAXOBARRAY 'ASMSYMBOL 'NIL)
+(PUT 'MAXOBARRAY 'WCONST '500)
+(PUT 'ARG10 'SCOPE 'EXTERNAL)
+(PUT 'ARG10 'ASMSYMBOL 'ARG10)
+(PUT 'ARG10 'WVAR 'ARG10)
+(PUT 'SYMNAM 'SCOPE 'EXTERNAL)
+(PUT 'SYMNAM 'ASMSYMBOL 'SYMNAM)
+(PUT 'SYMNAM 'WARRAY 'SYMNAM)
+(PUT 'MAXREALREGS 'SCOPE 'EXTERNAL)
+(PUT 'MAXREALREGS 'ASMSYMBOL 'NIL)
+(PUT 'MAXREALREGS 'WCONST '5)
+(PUT 'SYMPRP 'SCOPE 'EXTERNAL)
+(PUT 'SYMPRP 'ASMSYMBOL 'SYMPRP)
+(PUT 'SYMPRP 'WARRAY 'SYMPRP)
+(PUT 'TAGBITLENGTH 'SCOPE 'EXTERNAL)
+(PUT 'TAGBITLENGTH 'ASMSYMBOL 'NIL)
+(PUT 'TAGBITLENGTH 'WCONST '5)
+(PUT 'BITSPERWORD 'SCOPE 'EXTERNAL)
+(PUT 'BITSPERWORD 'ASMSYMBOL 'NIL)
+(PUT 'BITSPERWORD 'WCONST '36)
+(PUT 'ARG13 'SCOPE 'EXTERNAL)
+(PUT 'ARG13 'ASMSYMBOL 'ARG13)
+(PUT 'ARG13 'WVAR 'ARG13)
+(PUT 'MAXSYMBOLS 'SCOPE 'EXTERNAL)
+(PUT 'MAXSYMBOLS 'ASMSYMBOL 'NIL)
+(PUT 'MAXSYMBOLS 'WCONST '500)
+(PUT 'ARG9 'SCOPE 'EXTERNAL)
+(PUT 'ARG9 'ASMSYMBOL 'ARG9)
+(PUT 'ARG9 'WVAR 'ARG9)
+(PUT 'GCSTARTINGBIT 'SCOPE 'EXTERNAL)
+(PUT 'GCSTARTINGBIT 'ASMSYMBOL 'NIL)
+(PUT 'GCSTARTINGBIT 'WCONST '5)
+(PUT 'ARG7 'SCOPE 'EXTERNAL)
+(PUT 'ARG7 'ASMSYMBOL 'ARG7)
+(PUT 'ARG7 'WVAR 'ARG7)
+(PUT 'ARG5 'SCOPE 'EXTERNAL)
+(PUT 'ARG5 'ASMSYMBOL 'ARG5)
+(PUT 'ARG5 'WVAR 'ARG5)
+(PUT 'ADDRESSINGUNITSPERFUNCTIONCELL 'SCOPE 'EXTERNAL)
+(PUT 'ADDRESSINGUNITSPERFUNCTIONCELL 'ASMSYMBOL 'NIL)
+(PUT 'ADDRESSINGUNITSPERFUNCTIONCELL 'WCONST '1)
+(PUT 'ARG3 'SCOPE 'EXTERNAL)
+(PUT 'ARG3 'ASMSYMBOL 'ARG3)
+(PUT 'ARG3 'WVAR 'ARG3)
+(PUT 'ARG1 'SCOPE 'EXTERNAL)
+(PUT 'ARG1 'ASMSYMBOL 'ARG1)
+(PUT 'ARG1 'WVAR 'ARG1)
+(PUT 'BPSSIZE 'SCOPE 'EXTERNAL)
+(PUT 'BPSSIZE 'ASMSYMBOL 'NIL)
+(PUT 'BPSSIZE 'WCONST '40)
+(PUT 'GCBITLENGTH 'SCOPE 'EXTERNAL)
+(PUT 'GCBITLENGTH 'ASMSYMBOL 'NIL)
+(PUT 'GCBITLENGTH 'WCONST '13)
+(PUT 'MAXCHANNELS 'SCOPE 'EXTERNAL)
+(PUT 'MAXCHANNELS 'ASMSYMBOL 'NIL)
+(PUT 'MAXCHANNELS 'WCONST '31)
+(PUT 'ARG12 'SCOPE 'EXTERNAL)
+(PUT 'ARG12 'ASMSYMBOL 'ARG12)
+(PUT 'ARG12 'WVAR 'ARG12)
+(PUT 'TAGSTARTINGBIT 'SCOPE 'EXTERNAL)
+(PUT 'TAGSTARTINGBIT 'ASMSYMBOL 'NIL)
+(PUT 'TAGSTARTINGBIT 'WCONST '0)
+(PUT 'CHARACTERSPERWORD 'SCOPE 'EXTERNAL)
+(PUT 'CHARACTERSPERWORD 'ASMSYMBOL 'NIL)
+(PUT 'CHARACTERSPERWORD 'WCONST '5)
+(PUT 'STACKDIRECTION 'SCOPE 'EXTERNAL)
+(PUT 'STACKDIRECTION 'ASMSYMBOL 'NIL)
+(PUT 'STACKDIRECTION 'WCONST '1)
+(PUT 'ADDRESSINGUNITSPERITEM 'SCOPE 'EXTERNAL)
+(PUT 'ADDRESSINGUNITSPERITEM 'ASMSYMBOL 'NIL)
+(PUT 'ADDRESSINGUNITSPERITEM 'WCONST '1)
+(PUT 'HEAPSIZE 'SCOPE 'EXTERNAL)
+(PUT 'HEAPSIZE 'ASMSYMBOL 'NIL)
+(PUT 'HEAPSIZE 'WCONST '50000)
+(PUT 'STACKLOWERBOUND 'SCOPE 'EXTERNAL)
+(PUT 'STACKLOWERBOUND 'ASMSYMBOL '"L0001")
+(PUT 'STACKLOWERBOUND 'WVAR 'STACKLOWERBOUND)
+(PUT 'MAXARGS 'SCOPE 'EXTERNAL)
+(PUT 'MAXARGS 'ASMSYMBOL 'NIL)
+(PUT 'MAXARGS 'WCONST '15)
+(PUT 'ARG15 'SCOPE 'EXTERNAL)
+(PUT 'ARG15 'ASMSYMBOL 'ARG15)
+(PUT 'ARG15 'WVAR 'ARG15)
+(PUT 'SYMVAL 'SCOPE 'EXTERNAL)
+(PUT 'SYMVAL 'ASMSYMBOL 'SYMVAL)
+(PUT 'SYMVAL 'WARRAY 'SYMVAL)
+(PUT 'ARGUMENTBLOCK 'SCOPE 'EXTERNAL)
+(PUT 'ARGUMENTBLOCK 'ASMSYMBOL '"L0004")
+(PUT 'ARGUMENTBLOCK 'WARRAY 'ARGUMENTBLOCK)
+(PUT 'ARG11 'SCOPE 'EXTERNAL)
+(PUT 'ARG11 'ASMSYMBOL 'ARG11)
+(PUT 'ARG11 'WVAR 'ARG11)
+(PUT 'ARG8 'SCOPE 'EXTERNAL)
+(PUT 'ARG8 'ASMSYMBOL 'ARG8)
+(PUT 'ARG8 'WVAR 'ARG8)
+(PUT 'NEXTSYMBOL 'SCOPE 'EXTERNAL)
+(PUT 'NEXTSYMBOL 'ASMSYMBOL '"L0003")
+(PUT 'NEXTSYMBOL 'WVAR 'NEXTSYMBOL)
+(PUT 'ARG6 'SCOPE 'EXTERNAL)
+(PUT 'ARG6 'ASMSYMBOL 'ARG6)
+(PUT 'ARG6 'WVAR 'ARG6)
+(PUT 'INFSTARTINGBIT 'SCOPE 'EXTERNAL)
+(PUT 'INFSTARTINGBIT 'ASMSYMBOL 'NIL)
+(PUT 'INFSTARTINGBIT 'WCONST '18)
+(PUT 'ARG4 'SCOPE 'EXTERNAL)
+(PUT 'ARG4 'ASMSYMBOL 'ARG4)
+(PUT 'ARG4 'WVAR 'ARG4)
+(PUT 'STACKUPPERBOUND 'SCOPE 'EXTERNAL)
+(PUT 'STACKUPPERBOUND 'ASMSYMBOL '"L0002")
+(PUT 'STACKUPPERBOUND 'WVAR 'STACKUPPERBOUND)
+(PUT 'ARG2 'SCOPE 'EXTERNAL)
+(PUT 'ARG2 'ASMSYMBOL 'ARG2)
+(PUT 'ARG2 'WVAR 'ARG2)
ADDED psl-1983/20-tests/main2.cmd
Index: psl-1983/20-tests/main2.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main2.cmd
@@ -0,0 +1,2 @@
+main2,Dmain2,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/main2.init
Index: psl-1983/20-tests/main2.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main2.init
@@ -0,0 +1,5 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/20-tests/main2.sym
Index: psl-1983/20-tests/main2.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main2.sym
@@ -0,0 +1,172 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM
+PRIN1 PRIN2ID PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PUTC PBLANK
+PRIN1INTX LONGDIV LONGREMAINDER BYTE QUIT ERROR CHANNELPRIN2
+CHANNELWRITECHAR INDEPENDENTWRITECHAR WRITECHAR OUT!* ERRORHEADER
+ERRORTRAILER FATALERROR STDERROR NONIDERROR PRIN1T TYPEERROR USAGETYPEERROR
+FN OFFENDER NONNUMBERERROR LAMBINDARGS!* LAMBIND UNBINDN NONINTEGERERROR
+NONPOSITIVEINTEGERERROR)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 171))
+(SETQ STRINGGENSYM!* (QUOTE "L0182"))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0025"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE PRIN1T) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0103"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0098"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0093"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0156"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0177"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0094"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0182"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0021"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0034"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE FN) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0172"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0017"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0099"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE OFFENDER) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0095"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0106"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 148))
ADDED psl-1983/20-tests/main3.cmd
Index: psl-1983/20-tests/main3.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main3.cmd
@@ -0,0 +1,2 @@
+main3,Dmain3,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/main3.init
Index: psl-1983/20-tests/main3.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main3.init
@@ -0,0 +1,5 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/20-tests/main3.sym
Index: psl-1983/20-tests/main3.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main3.sym
@@ -0,0 +1,219 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM
+PRIN1 PRIN2ID PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PUTC PBLANK
+PRIN1INTX LONGDIV LONGREMAINDER BYTE QUIT ERROR CHANNELPRIN2
+CHANNELWRITECHAR INDEPENDENTWRITECHAR WRITECHAR OUT!* ERRORHEADER
+ERRORTRAILER FATALERROR STDERROR NONIDERROR PRIN1T TYPEERROR USAGETYPEERROR
+FN OFFENDER NONNUMBERERROR LAMBINDARGS!* LAMBIND UNBINDN NONINTEGERERROR
+NONPOSITIVEINTEGERERROR WQUOTIENT !%RECLAIM GTHEAP GTSTR GTVECT GTWARRAY
+GTID HARDCONS CONS XCONS NCONS MKVECT LIST2 LIST3 LIST4 LIST5 PUTBYTE
+MKSTRING)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 189))
+(SETQ STRINGGENSYM!* (QUOTE "L0214"))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0025"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0183"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0185"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0184"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE PRIN1T) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0103"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0098"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0192"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0093"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0156"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0177"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0094"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0182"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0021"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0186"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0034"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0191"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE FN) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0172"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0017"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0099"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE OFFENDER) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0095"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0106"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 148))
ADDED psl-1983/20-tests/main4.cmd
Index: psl-1983/20-tests/main4.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main4.cmd
@@ -0,0 +1,2 @@
+main4,Dmain4,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/main4.init
Index: psl-1983/20-tests/main4.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main4.init
@@ -0,0 +1,7 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(PUT (QUOTE SYMFNCBASE) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (CODEPTR!* CODEFORM!* CODENARG!*)))
+(FLUID (QUOTE (CODEPTR!* CODEFORM!* CODENARG!*)))
ADDED psl-1983/20-tests/main4.sym
Index: psl-1983/20-tests/main4.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main4.sym
@@ -0,0 +1,284 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM
+PRIN1 PRIN2ID PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PUTC PBLANK
+PRIN1INTX LONGDIV LONGREMAINDER BYTE QUIT ERROR CHANNELPRIN2
+CHANNELWRITECHAR INDEPENDENTWRITECHAR WRITECHAR OUT!* ERRORHEADER
+ERRORTRAILER FATALERROR STDERROR NONIDERROR PRIN1T TYPEERROR USAGETYPEERROR
+FN OFFENDER NONNUMBERERROR LAMBINDARGS!* LAMBIND UNBINDN NONINTEGERERROR
+NONPOSITIVEINTEGERERROR WQUOTIENT !%RECLAIM GTHEAP GTSTR GTVECT GTWARRAY
+GTID HARDCONS CONS XCONS NCONS MKVECT LIST2 LIST3 LIST4 LIST5 PUTBYTE
+MKSTRING EQSTR INITREAD !*RAISE CH!* TOK!* TOKTYPE!* DEBUG SETRAISE
+CLEARWHITE CLEARCOMMENT READSTR DIGITP READINT ALPHAESCP READID RATOM WHITEP
+GETC LONGTIMES BUFFERTOSTRING RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP
+LOWERCASEP LOOKUPID INITNEWID MAKEFUNBOUND UPPERCASEP ALPHANUMP READ1 READ
+READLIST QUOTE)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 224))
+(SETQ STRINGGENSYM!* (QUOTE "L0313"))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0237"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0025"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0230"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0183"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0185"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0184"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE PRIN1T) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0299"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0301"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0103"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0098"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE LOOKUPID) (QUOTE ENTRYPOINT) (QUOTE "L0270"))
+(PUT (QUOTE LOOKUPID) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0192"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0093"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0156"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0287"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0263"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0177"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0094"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0182"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0021"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0186"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0034"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0191"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE FN) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0297"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0172"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0291"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0017"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0222"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0099"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE OFFENDER) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0095"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0224"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0241"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0106"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0295"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0310"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0233"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 198))
ADDED psl-1983/20-tests/main5.cmd
Index: psl-1983/20-tests/main5.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main5.cmd
@@ -0,0 +1,2 @@
+main5,Dmain5,sub5,Dsub5,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/main5.init
Index: psl-1983/20-tests/main5.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main5.init
@@ -0,0 +1,5 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/20-tests/main5.mac
Index: psl-1983/20-tests/main5.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main5.mac
@@ -0,0 +1,2480 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern L0001
+ extern L0002
+ extern HEAP
+ extern L0183
+ extern L0184
+ extern L0185
+ extern L0186
+ extern BPS
+ extern L1005
+ extern L1006
+ extern L1007
+ extern L1008
+; (!*ENTRY INITHEAP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR HEAPLOWERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPLOWERBOUND))
+; (MOVEM (REG T1) (WVAR HEAPLAST))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*MOVE (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (MOVEM (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INITHEAP EXPR 0)
+L1009: intern L1009
+ MOVE 6,L0183
+ MOVEM 6,L0185
+ SETZM 1
+ MOVEM 1,L0186
+ POPJ 15,0
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (MOVE (REG NIL) (FLUID NIL))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (HRRZI (REG LINKREG) 339)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L1010
+ MOVE 0,SYMVAL+128
+ HRRZI 12,339
+ SETZM 13
+ JRST SYMFNC+339
+L1010: byte(18)-5000,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK INIT20 EXPR 1)
+ extern INIT20
+; (PUSHJ (REG ST) (INTERNALENTRY INIT20))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ PUSHJ 15,INIT20
+ SETZM SYMVAL+342
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+154
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 0) (!$FLUID IN!*))
+; (SKIPE (!$FLUID IN!*))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+ extern GETC20
+; (PUSHJ (REG ST) (INTERNALENTRY GETC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID IN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID IN!*))
+; (!*LINKE 0 INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 343)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTREADCHAR))
+ 0
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SKIPE SYMVAL+342
+ JRST L1011
+ SETZM 1
+ PUSHJ 15,GETC20
+ POPJ 15,0
+L1011: MOVE 1,SYMVAL+342
+ HRRZI 12,343
+ HRRZI 13,1
+ JRST SYMFNC+343
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+ extern TIMC20
+; (PUSHJ (REG ST) (INTERNALENTRY TIMC20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ PUSHJ 15,TIMC20
+ POPJ 15,0
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 1) (!$FLUID OUT!*))
+; (MOVE (REG T2) (!$FLUID OUT!*))
+; (CAIE (REG T2) 1)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PUTC20 EXPR 1)
+ extern PUTC20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID OUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 152)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ MOVE 7,SYMVAL+154
+ CAIE 7,1
+ JRST L1012
+ PUSHJ 15,PUTC20
+ POPJ 15,0
+L1012: MOVE 2,1
+ MOVE 1,SYMVAL+154
+ HRRZI 12,152
+ HRRZI 13,2
+ JRST SYMFNC+152
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+ extern QUIT20
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY DATE EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "No-Date-Yet") (REG 1))
+; (MOVE (REG 1) (QUOTE "No-Date-Yet"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1014: 10
+ byte(7)78,111,45,68,97,116,101,45,89,101,116,0
+ 0
+; (!*ENTRY DATE EXPR 0)
+DATE: intern DATE
+ MOVE 1,L1013
+ POPJ 15,0
+L1013: <4_31>+L1014
+; (!*ENTRY VERSIONNAME EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "DEC-20 test system") (REG 1))
+; (MOVE (REG 1) (QUOTE "DEC-20 test system"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1016: 17
+ byte(7)68,69,67,45,50,48,32,116,101,115,116,32,115,121,115,116,101,109,0
+ 0
+; (!*ENTRY VERSIONNAME EXPR 0)
+L1017: intern L1017
+ MOVE 1,L1015
+ POPJ 15,0
+L1015: <4_31>+L1016
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+ extern PUTI20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTI20))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ PUSHJ 15,PUTI20
+ POPJ 15,0
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*WOR (REG 1) 23085449216)
+; (IOR (REG 1) 23085449216)
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+L1018: intern L1018
+ IOR 1,[23085449216]
+ MOVEM 1,0(2)
+ POPJ 15,0
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (MEMORY (REG 1) (WCONST 0)) (MEMORY (REG 2) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG 1) 0))
+; (MOVEM (REG T1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+L1019: intern L1019
+ MOVE 6,0(1)
+ MOVEM 6,0(2)
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+; (!*MOVE (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (MOVEM (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (!*MOVE (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (MOVEM (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (!*JCALL UNDEFINEDFUNCTIONAUX)
+; (JRST (ENTRY UNDEFINEDFUNCTIONAUX))
+ 0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+L1020: intern L1020
+ MOVEM 12,SYMVAL+349
+ MOVEM 13,SYMVAL+350
+ JRST SYMFNC+249
+; (!*ENTRY FLAG EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE 2 (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINKE 0 ERR20 EXPR 1)
+ extern ERR20
+; (PUSHJ (REG ST) (INTERNALENTRY ERR20))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ HRRZI 1,2
+ PUSHJ 15,ERR20
+ POPJ 15,0
+; (!*ENTRY LONGTIMES EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGTIMES EXPR 2)
+L1021: intern L1021
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY LONGDIV EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGDIV EXPR 2)
+L1022: intern L1022
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+; (!*ENTRY LONGREMAINDER EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 352)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (MOVE (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGREMAINDER EXPR 2)
+L1023: intern L1023
+ HRRZI 12,352
+ HRRZI 13,2
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY !%RECLAIM EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE " *** Dummy !%RECLAIM: ") (REG 1))
+; (MOVE (REG 1) (QUOTE " *** Dummy !%RECLAIM: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINKE 0 HEAPINFO EXPR 0)
+; (HRRZI (REG LINKREG) 353)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY HEAPINFO))
+L1025: 21
+ byte(7)32,42,42,42,32,68,117,109,109,121,32,33,37,82,69,67,76,65,73,77,58,32,0
+ 0
+; (!*ENTRY !%RECLAIM EXPR 0)
+L1026: intern L1026
+ MOVE 1,L1024
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,353
+ SETZM 13
+ JRST SYMFNC+353
+L1024: <4_31>+L1025
+; (!*ENTRY RECLAIM EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "*** Dummy RECLAIM: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Dummy RECLAIM: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINKE 0 HEAPINFO EXPR 0)
+; (HRRZI (REG LINKREG) 353)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY HEAPINFO))
+L1028: 18
+ byte(7)42,42,42,32,68,117,109,109,121,32,82,69,67,76,65,73,77,58,32,0
+ 0
+; (!*ENTRY RECLAIM EXPR 0)
+L1029: intern L1029
+ MOVE 1,L1027
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,353
+ SETZM 13
+ JRST SYMFNC+353
+L1027: <4_31>+L1028
+; (!*ENTRY HEAPINFO EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPLAST) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPLAST))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLOWERBOUND))
+; (SUB (REG 1) (WVAR HEAPLOWERBOUND))
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " Items used, ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Items used, "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPUPPERBOUND) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPUPPERBOUND))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLAST))
+; (SUB (REG 1) (WVAR HEAPLAST))
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " Items left.") (REG 1))
+; (MOVE (REG 1) (QUOTE " Items left."))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1032: 11
+ byte(7)32,73,116,101,109,115,32,108,101,102,116,46,0
+L1033: 12
+ byte(7)32,73,116,101,109,115,32,117,115,101,100,44,32,0
+ 0
+; (!*ENTRY HEAPINFO EXPR 0)
+L1034: intern L1034
+ HRRZI 2,1
+ MOVE 1,L0185
+ SUB 1,L0183
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1030
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 2,1
+ MOVE 1,L0184
+ SUB 1,L0185
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1031
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ SETZM 1
+ POPJ 15,0
+L1031: <4_31>+L1032
+L1030: <4_31>+L1033
+; (!*ENTRY SPACED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1036: 10
+ byte(7)32,32,32,32,32,32,32,32,32,32,32,0
+ 1
+; (!*ENTRY SPACED EXPR 1)
+SPACED: intern SPACED
+ PUSH 15,1
+ MOVE 1,L1035
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1035: <4_31>+L1036
+; (!*ENTRY DASHED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE "---------- ") (REG 1))
+; (MOVE (REG 1) (QUOTE "---------- "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1038: 10
+ byte(7)45,45,45,45,45,45,45,45,45,45,32,0
+ 1
+; (!*ENTRY DASHED EXPR 1)
+DASHED: intern DASHED
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1037
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1037: <4_31>+L1038
+; (!*ENTRY DOTTED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE " ....... ") (REG 1))
+; (MOVE (REG 1) (QUOTE " ....... "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1040: 10
+ byte(7)32,32,32,46,46,46,46,46,46,46,32,0
+ 1
+; (!*ENTRY DOTTED EXPR 1)
+DOTTED: intern DOTTED
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1039
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1039: <4_31>+L1040
+; (!*ENTRY SHOULDBE EXPR 3)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE " ....... For ") (REG 1))
+; (MOVE (REG 1) (QUOTE " ....... For "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " should be ") (REG 1))
+; (MOVE (REG 1) (QUOTE " should be "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*JUMPNOTEQ (LABEL G0004) (FRAME 2) (FRAME 3))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAME (REG T1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE " [OK ]") (REG 1))
+; (MOVE (REG 1) (QUOTE " [OK ]"))
+; (!*JUMP (LABEL G0006))
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE " [BAD] *******") (REG 1))
+; (MOVE (REG 1) (QUOTE " [BAD] *******"))
+; (!*LBL (LABEL G0006))
+; (!*LINKE 3 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1046: 15
+ byte(7)32,32,32,91,66,65,68,93,32,42,42,42,42,42,42,42,0
+L1047: 6
+ byte(7)32,32,91,79,75,32,93,0
+L1048: 10
+ byte(7)32,115,104,111,117,108,100,32,98,101,32,0
+L1049: 0
+ byte(7)32,0
+L1050: 14
+ byte(7)32,32,32,46,46,46,46,46,46,46,32,70,111,114,32,0
+ 3
+; (!*ENTRY SHOULDBE EXPR 3)
+L1051: intern L1051
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 1,L1041
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1042
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1043
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-2(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 6,-1(15)
+ CAME 6,-2(15)
+ JRST L1052
+ MOVE 1,L1044
+ JRST L1053
+L1052: MOVE 1,L1045
+L1053: ADJSP 15,-3
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1045: <4_31>+L1046
+L1044: <4_31>+L1047
+L1043: <4_31>+L1048
+L1042: <4_31>+L1049
+L1041: <4_31>+L1050
+; (!*ENTRY UNDEFINEDFUNCTIONAUXAUX EXPR 0)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (!$FLUID UNDEFNNARG!*) (FRAME 2))
+; (MOVE (REG T1) (!$FLUID UNDEFNNARG!*))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*MOVE (!$FLUID UNDEFNCODE!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID UNDEFNCODE!*))
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE "Undefined Function ") (REG 1))
+; (MOVE (REG 1) (QUOTE "Undefined Function "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " called with ") (REG 1))
+; (MOVE (REG 1) (QUOTE " called with "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " args from compiled code") (REG 1))
+; (MOVE (REG 1) (QUOTE " args from compiled code"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+L1057: 23
+ byte(7)32,97,114,103,115,32,102,114,111,109,32,99,111,109,112,105,108,101,100,32,99,111,100,101,0
+L1058: 12
+ byte(7)32,99,97,108,108,101,100,32,119,105,116,104,32,0
+L1059: 18
+ byte(7)85,110,100,101,102,105,110,101,100,32,70,117,110,99,116,105,111,110,32,0
+ 0
+; (!*ENTRY UNDEFINEDFUNCTIONAUXAUX EXPR 0)
+L1060: intern L1060
+ ADJSP 15,2
+ MOVE 6,SYMVAL+350
+ MOVEM 6,-1(15)
+ MOVE 1,SYMVAL+349
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,0(15)
+ MOVE 1,L1054
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1055
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1056
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L1056: <4_31>+L1057
+L1055: <4_31>+L1058
+L1054: <4_31>+L1059
+; (!*ENTRY INF EXPR 1)
+; (!*ALLOC 0)
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY INF EXPR 1)
+INF: intern INF
+ HRRZ 1,1
+ POPJ 15,0
+; (!*ENTRY TAG EXPR 1)
+; (!*ALLOC 0)
+; (!*FIELD (REG 1) (REG 1) (WCONST 0) (WCONST 5))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 1
+; (!*ENTRY TAG EXPR 1)
+TAG: intern TAG
+ LDB 1,L1061
+ POPJ 15,0
+L1061: point 5,1,4
+; (!*ENTRY MKITEM EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*MKITEM (REG 1) (REG 3))
+; (DPB (REG 3) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 2
+; (!*ENTRY MKITEM EXPR 2)
+MKITEM: intern MKITEM
+ MOVE 3,1
+ MOVE 1,2
+ DPB 3,L1062
+ POPJ 15,0
+L1062: point 5,1,4
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (QUOTE NIL) (FRAME 1))
+; (MOVEM (REG NIL) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*LINK INIT EXPR 0)
+; (HRRZI (REG LINKREG) 341)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INIT))
+; (!*LINK INITHEAP EXPR 0)
+; (HRRZI (REG LINKREG) 338)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITHEAP))
+; (!*LINK TESTGET EXPR 0)
+; (HRRZI (REG LINKREG) 362)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TESTGET))
+; (!*LINK INITEVAL EXPR 0)
+; (HRRZI (REG LINKREG) 309)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITEVAL))
+; (!*MOVE (QUOTE "(very) MINI-PSL: A Read-Eval-Print Loop, terminate with Q") (REG 1))
+; (MOVE (REG 1) (QUOTE "(very) MINI-PSL: A Read-Eval-Print Loop, terminate with Q"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " !*RAISE and !*PVAL have been set T") (REG 1))
+; (MOVE (REG 1) (QUOTE " !*RAISE and !*PVAL have been set T"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " Should be able to execute any COMPILED expressions") (REG 1))
+; (MOVE (REG 1) (QUOTE " Should be able to execute any COMPILED expressions"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " typed in. Run (TESTSERIES) when ready") (REG 1))
+; (MOVE (REG 1) (QUOTE " typed in. Run (TESTSERIES) when ready"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*MOVE (REG 1) (!$FLUID DEBUG))
+; (MOVEM (REG 1) (!$FLUID DEBUG))
+; (!*LINK INITREAD EXPR 0)
+; (HRRZI (REG LINKREG) 190)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITREAD))
+; (!*MOVE (WCONST 26) (REG 1))
+; (HRRZI (REG 1) 26)
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (!$FLUID !$EOF!$))
+; (MOVEM (REG 1) (!$FLUID !$EOF!$))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*MOVE (REG 1) (!$FLUID !*RAISE))
+; (MOVEM (REG 1) (!$FLUID !*RAISE))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTEQ (LABEL G0004) (FRAME 2) (QUOTE NIL))
+; (CAME (REG NIL) (INDEXED (REG ST) -1))
+; (JRST (LABEL G0004))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " lisp> ") (REG 1))
+; (MOVE (REG 1) (QUOTE " lisp> "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPNOTEQ (LABEL G0011) (REG 1) (QUOTE Q))
+; (CAME (REG 1) (QUOTE Q))
+; (JRST (LABEL G0011))
+; (!*MOVE (QUOTE T) (FRAME 2))
+; (MOVE (REG T1) (FLUID T))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0011))
+; (!*JUMPNOTEQ (LABEL G0012) (REG 1) (!$GLOBAL !$EOF!$))
+; (CAME (REG 1) (!$GLOBAL !$EOF!$))
+; (JRST (LABEL G0012))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE " **** Top Level EOF ****") (REG 1))
+; (MOVE (REG 1) (QUOTE " **** Top Level EOF ****"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0012))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EVAL EXPR 1)
+; (HRRZI (REG LINKREG) 254)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY EVAL))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPEQ (LABEL G0005) (QUOTE NIL) (!$FLUID !*PVAL))
+; (CAMN (REG NIL) (!$FLUID !*PVAL))
+; (JRST (LABEL G0005))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+L1070: 23
+ byte(7)32,42,42,42,42,32,84,111,112,32,76,101,118,101,108,32,69,79,70,32,42,42,42,42,0
+L1071: 6
+ byte(7)32,108,105,115,112,62,32,0
+L1072: 43
+ byte(7)32,32,32,32,32,32,32,116,121,112,101,100,32,105,110,46,32,82,117,110,32,40,84,69,83,84,83,69,82,73,69,83,41,32,119,104,101,110,32,114,101,97,100,121,0
+L1073: 56
+ byte(7)32,32,32,32,32,32,32,83,104,111,117,108,100,32,98,101,32,97,98,108,101,32,116,111,32,101,120,101,99,117,116,101,32,97,110,121,32,67,79,77,80,73,76,69,68,32,101,120,112,114,101,115,115,105,111,110,115,0
+L1074: 40
+ byte(7)32,32,32,32,32,32,32,33,42,82,65,73,83,69,32,97,110,100,32,33,42,80,86,65,76,32,104,97,118,101,32,98,101,101,110,32,115,101,116,32,84,0
+L1075: 56
+ byte(7)40,118,101,114,121,41,32,77,73,78,73,45,80,83,76,58,32,65,32,82,101,97,100,45,69,118,97,108,45,80,114,105,110,116,32,76,111,111,112,44,32,116,101,114,109,105,110,97,116,101,32,119,105,116,104,32,81,0
+ 0
+; (!*ENTRY FIRSTCALL EXPR 0)
+L1076: intern L1076
+ ADJSP 15,3
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ HRRZI 12,341
+ SETZM 13
+ PUSHJ 15,SYMFNC+341
+ HRRZI 12,338
+ SETZM 13
+ PUSHJ 15,SYMFNC+338
+ HRRZI 12,362
+ SETZM 13
+ PUSHJ 15,SYMFNC+362
+ HRRZI 12,309
+ SETZM 13
+ PUSHJ 15,SYMFNC+309
+ MOVE 1,L1063
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1064
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1065
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1066
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,0
+ MOVEM 1,SYMVAL+195
+ HRRZI 12,190
+ SETZM 13
+ PUSHJ 15,SYMFNC+190
+ HRRZI 1,26
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,SYMVAL+363
+ SETZM -2(15)
+ MOVE 1,SYMVAL+84
+ MOVEM 1,SYMVAL+191
+L1077: CAME 0,-1(15)
+ JRST L1078
+ AOS -2(15)
+ MOVE 1,-2(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1067
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ MOVEM 1,0(15)
+ CAME 1,L1068
+ JRST L1079
+ MOVE 6,SYMVAL+84
+ MOVEM 6,-1(15)
+ JRST L1077
+L1079: CAME 1,SYMVAL+363
+ JRST L1080
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1069
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ JRST L1077
+L1080: HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,0(15)
+ HRRZI 12,254
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+254
+ MOVEM 1,0(15)
+ CAMN 0,SYMVAL+364
+ JRST L1077
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ JRST L1077
+L1078: HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L1069: <4_31>+L1070
+L1068: <30_31>+81
+L1067: <4_31>+L1071
+L1066: <4_31>+L1072
+L1065: <4_31>+L1073
+L1064: <4_31>+L1074
+L1063: <4_31>+L1075
+; (!*ENTRY TESTSERIES EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "TESTs called by TESTSERIES") (REG 1))
+; (MOVE (REG 1) (QUOTE "TESTs called by TESTSERIES"))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 356)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*LINKE 0 TESTUNDEFINED EXPR 0)
+; (HRRZI (REG LINKREG) 365)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY TESTUNDEFINED))
+L1082: 25
+ byte(7)84,69,83,84,115,32,99,97,108,108,101,100,32,98,121,32,84,69,83,84,83,69,82,73,69,83,0
+ 0
+; (!*ENTRY TESTSERIES EXPR 0)
+L1083: intern L1083
+ MOVE 1,L1081
+ HRRZI 12,356
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+356
+ HRRZI 12,365
+ SETZM 13
+ JRST SYMFNC+365
+L1081: <4_31>+L1082
+; (!*ENTRY TESTGET EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Tests of GET and PUT") (REG 1))
+; (MOVE (REG 1) (QUOTE "Tests of GET and PUT"))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 356)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (QUOTE FEE) (REG 2))
+; (MOVE (REG 2) (QUOTE FEE))
+; (!*MOVE (QUOTE FOO) (REG 1))
+; (MOVE (REG 1) (QUOTE FOO))
+; (!*LINK GET EXPR 2)
+; (HRRZI (REG LINKREG) 258)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY GET))
+; (!*MOVE (QUOTE NIL) (REG 3))
+; (MOVE (REG 3) (REG NIL))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE "GET('FOO,'FEE)") (REG 1))
+; (MOVE (REG 1) (QUOTE "GET('FOO,'FEE)"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 358)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE FUM) (REG 3))
+; (MOVE (REG 3) (QUOTE FUM))
+; (!*MOVE (QUOTE FEE) (REG 2))
+; (MOVE (REG 2) (QUOTE FEE))
+; (!*MOVE (QUOTE FOO) (REG 1))
+; (MOVE (REG 1) (QUOTE FOO))
+; (!*LINK PUT EXPR 3)
+; (HRRZI (REG LINKREG) 308)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY PUT))
+; (!*MOVE (QUOTE FUM) (REG 3))
+; (MOVE (REG 3) (QUOTE FUM))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE "PUT('FOO,'FEE,'FUM)") (REG 1))
+; (MOVE (REG 1) (QUOTE "PUT('FOO,'FEE,'FUM)"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 358)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE FEE) (REG 2))
+; (MOVE (REG 2) (QUOTE FEE))
+; (!*MOVE (QUOTE FOO) (REG 1))
+; (MOVE (REG 1) (QUOTE FOO))
+; (!*LINK GET EXPR 2)
+; (HRRZI (REG LINKREG) 258)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY GET))
+; (!*MOVE (QUOTE FUM) (REG 3))
+; (MOVE (REG 3) (QUOTE FUM))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE "GET('FOO,'FEE)") (REG 1))
+; (MOVE (REG 1) (QUOTE "GET('FOO,'FEE)"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 358)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE FEE) (REG 2))
+; (MOVE (REG 2) (QUOTE FEE))
+; (!*MOVE (QUOTE FOO) (REG 1))
+; (MOVE (REG 1) (QUOTE FOO))
+; (!*LINK REMPROP EXPR 2)
+; (HRRZI (REG LINKREG) 334)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY REMPROP))
+; (!*MOVE (QUOTE FUM) (REG 3))
+; (MOVE (REG 3) (QUOTE FUM))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE "REMPROP('FOO,'FEE)") (REG 1))
+; (MOVE (REG 1) (QUOTE "REMPROP('FOO,'FEE)"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 358)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE FEE) (REG 2))
+; (MOVE (REG 2) (QUOTE FEE))
+; (!*MOVE (QUOTE FOO) (REG 1))
+; (MOVE (REG 1) (QUOTE FOO))
+; (!*LINK GET EXPR 2)
+; (HRRZI (REG LINKREG) 258)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY GET))
+; (!*MOVE (QUOTE NIL) (REG 3))
+; (MOVE (REG 3) (REG NIL))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE "GET('FOO,'FEE)") (REG 1))
+; (MOVE (REG 1) (QUOTE "GET('FOO,'FEE)"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 358)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1091: 17
+ byte(7)82,69,77,80,82,79,80,40,39,70,79,79,44,39,70,69,69,41,0
+L1092: 18
+ byte(7)80,85,84,40,39,70,79,79,44,39,70,69,69,44,39,70,85,77,41,0
+L1093: 13
+ byte(7)71,69,84,40,39,70,79,79,44,39,70,69,69,41,0
+L1094: 19
+ byte(7)84,101,115,116,115,32,111,102,32,71,69,84,32,97,110,100,32,80,85,84,0
+ 0
+; (!*ENTRY TESTGET EXPR 0)
+L1095: intern L1095
+ MOVE 1,L1084
+ HRRZI 12,356
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+356
+ MOVE 2,L1085
+ MOVE 1,L1086
+ HRRZI 12,258
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+258
+ MOVE 3,0
+ MOVE 2,1
+ MOVE 1,L1087
+ HRRZI 12,358
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+358
+ MOVE 3,L1088
+ MOVE 2,L1085
+ MOVE 1,L1086
+ HRRZI 12,308
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+308
+ MOVE 3,L1088
+ MOVE 2,1
+ MOVE 1,L1089
+ HRRZI 12,358
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+358
+ MOVE 2,L1085
+ MOVE 1,L1086
+ HRRZI 12,258
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+258
+ MOVE 3,L1088
+ MOVE 2,1
+ MOVE 1,L1087
+ HRRZI 12,358
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+358
+ MOVE 2,L1085
+ MOVE 1,L1086
+ HRRZI 12,334
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+334
+ MOVE 3,L1088
+ MOVE 2,1
+ MOVE 1,L1090
+ HRRZI 12,358
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+358
+ MOVE 2,L1085
+ MOVE 1,L1086
+ HRRZI 12,258
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+258
+ MOVE 3,0
+ MOVE 2,1
+ MOVE 1,L1087
+ HRRZI 12,358
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+358
+ MOVE 1,0
+ POPJ 15,0
+L1090: <4_31>+L1091
+L1089: <4_31>+L1092
+L1088: <30_31>+367
+L1087: <4_31>+L1093
+L1086: <30_31>+368
+L1085: <30_31>+369
+L1084: <4_31>+L1094
+; (!*ENTRY TESTUNDEFINED EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Calling SHOULDBEUNDEFINED") (REG 1))
+; (MOVE (REG 1) (QUOTE "Calling SHOULDBEUNDEFINED"))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (WCONST 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*LINKE 0 SHOULDBEUNDEFINED EXPR 1)
+; (HRRZI (REG LINKREG) 230)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY SHOULDBEUNDEFINED))
+L1097: 24
+ byte(7)67,97,108,108,105,110,103,32,83,72,79,85,76,68,66,69,85,78,68,69,70,73,78,69,68,0
+ 0
+; (!*ENTRY TESTUNDEFINED EXPR 0)
+L1098: intern L1098
+ MOVE 1,L1096
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ HRRZI 1,1
+ HRRZI 12,230
+ HRRZI 13,1
+ JRST SYMFNC+230
+L1096: <4_31>+L1097
+; (!*ENTRY UNBINDN EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "UNBIND only added at MAIN6") (REG 1))
+; (MOVE (REG 1) (QUOTE "UNBIND only added at MAIN6"))
+; (!*LINKE 0 STDERROR EXPR 1)
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY STDERROR))
+L1100: 25
+ byte(7)85,78,66,73,78,68,32,111,110,108,121,32,97,100,100,101,100,32,97,116,32,77,65,73,78,54,0
+ 1
+; (!*ENTRY UNBINDN EXPR 1)
+L1101: intern L1101
+ MOVE 1,L1099
+ HRRZI 12,158
+ HRRZI 13,1
+ JRST SYMFNC+158
+L1099: <4_31>+L1100
+; (!*ENTRY LBIND1 EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "LBIND1 only added at MAIN6") (REG 1))
+; (MOVE (REG 1) (QUOTE "LBIND1 only added at MAIN6"))
+; (!*LINKE 0 STDERROR EXPR 1)
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY STDERROR))
+L1103: 25
+ byte(7)76,66,73,78,68,49,32,111,110,108,121,32,97,100,100,101,100,32,97,116,32,77,65,73,78,54,0
+ 2
+; (!*ENTRY LBIND1 EXPR 2)
+LBIND1: intern LBIND1
+ MOVE 1,L1102
+ HRRZI 12,158
+ HRRZI 13,1
+ JRST SYMFNC+158
+L1102: <4_31>+L1103
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L1104: intern L1104
+ MOVE 1,0
+ POPJ 15,0
+ extern SYMVAL
+ extern SYMPRP
+ extern SYMNAM
+L1105: 0
+ byte(7)0,0
+ intern L1105
+L1106: 0
+ byte(7)1,0
+ intern L1106
+L1107: 0
+ byte(7)2,0
+ intern L1107
+L1108: 0
+ byte(7)3,0
+ intern L1108
+L1109: 0
+ byte(7)4,0
+ intern L1109
+L1110: 0
+ byte(7)5,0
+ intern L1110
+L1111: 0
+ byte(7)6,0
+ intern L1111
+L1112: 0
+ byte(7)7,0
+ intern L1112
+L1113: 0
+ byte(7)8,0
+ intern L1113
+L1114: 0
+ byte(7)9,0
+ intern L1114
+L1115: 0
+ byte(7)10,0
+ intern L1115
+L1116: 0
+ byte(7)11,0
+ intern L1116
+L1117: 0
+ byte(7)12,0
+ intern L1117
+L1118: 0
+ byte(7)13,0
+ intern L1118
+L1119: 0
+ byte(7)14,0
+ intern L1119
+L1120: 0
+ byte(7)15,0
+ intern L1120
+L1121: 0
+ byte(7)16,0
+ intern L1121
+L1122: 0
+ byte(7)17,0
+ intern L1122
+L1123: 0
+ byte(7)18,0
+ intern L1123
+L1124: 0
+ byte(7)19,0
+ intern L1124
+L1125: 0
+ byte(7)20,0
+ intern L1125
+L1126: 0
+ byte(7)21,0
+ intern L1126
+L1127: 0
+ byte(7)22,0
+ intern L1127
+L1128: 0
+ byte(7)23,0
+ intern L1128
+L1129: 0
+ byte(7)24,0
+ intern L1129
+L1130: 0
+ byte(7)25,0
+ intern L1130
+L1131: 0
+ byte(7)26,0
+ intern L1131
+L1132: 0
+ byte(7)27,0
+ intern L1132
+L1133: 0
+ byte(7)28,0
+ intern L1133
+L1134: 0
+ byte(7)29,0
+ intern L1134
+L1135: 0
+ byte(7)30,0
+ intern L1135
+L1136: 0
+ byte(7)31,0
+ intern L1136
+L1137: 0
+ byte(7)32,0
+ intern L1137
+L1138: 0
+ byte(7)33,0
+ intern L1138
+L1139: 0
+ byte(7)34,0
+ intern L1139
+L1140: 0
+ byte(7)35,0
+ intern L1140
+L1141: 0
+ byte(7)36,0
+ intern L1141
+L1142: 0
+ byte(7)37,0
+ intern L1142
+L1143: 0
+ byte(7)38,0
+ intern L1143
+L1144: 0
+ byte(7)39,0
+ intern L1144
+L1145: 0
+ byte(7)40,0
+ intern L1145
+L1146: 0
+ byte(7)41,0
+ intern L1146
+L1147: 0
+ byte(7)42,0
+ intern L1147
+L1148: 0
+ byte(7)43,0
+ intern L1148
+L1149: 0
+ byte(7)44,0
+ intern L1149
+L1150: 0
+ byte(7)45,0
+ intern L1150
+L1151: 0
+ byte(7)46,0
+ intern L1151
+L1152: 0
+ byte(7)47,0
+ intern L1152
+L1153: 0
+ byte(7)48,0
+ intern L1153
+L1154: 0
+ byte(7)49,0
+ intern L1154
+L1155: 0
+ byte(7)50,0
+ intern L1155
+L1156: 0
+ byte(7)51,0
+ intern L1156
+L1157: 0
+ byte(7)52,0
+ intern L1157
+L1158: 0
+ byte(7)53,0
+ intern L1158
+L1159: 0
+ byte(7)54,0
+ intern L1159
+L1160: 0
+ byte(7)55,0
+ intern L1160
+L1161: 0
+ byte(7)56,0
+ intern L1161
+L1162: 0
+ byte(7)57,0
+ intern L1162
+L1163: 0
+ byte(7)58,0
+ intern L1163
+L1164: 0
+ byte(7)59,0
+ intern L1164
+L1165: 0
+ byte(7)60,0
+ intern L1165
+L1166: 0
+ byte(7)61,0
+ intern L1166
+L1167: 0
+ byte(7)62,0
+ intern L1167
+L1168: 0
+ byte(7)63,0
+ intern L1168
+L1169: 0
+ byte(7)64,0
+ intern L1169
+L1170: 0
+ byte(7)65,0
+ intern L1170
+L1171: 0
+ byte(7)66,0
+ intern L1171
+L1172: 0
+ byte(7)67,0
+ intern L1172
+L1173: 0
+ byte(7)68,0
+ intern L1173
+L1174: 0
+ byte(7)69,0
+ intern L1174
+L1175: 0
+ byte(7)70,0
+ intern L1175
+L1176: 0
+ byte(7)71,0
+ intern L1176
+L1177: 0
+ byte(7)72,0
+ intern L1177
+L1178: 0
+ byte(7)73,0
+ intern L1178
+L1179: 0
+ byte(7)74,0
+ intern L1179
+L1180: 0
+ byte(7)75,0
+ intern L1180
+L1181: 0
+ byte(7)76,0
+ intern L1181
+L1182: 0
+ byte(7)77,0
+ intern L1182
+L1183: 0
+ byte(7)78,0
+ intern L1183
+L1184: 0
+ byte(7)79,0
+ intern L1184
+L1185: 0
+ byte(7)80,0
+ intern L1185
+L1186: 0
+ byte(7)81,0
+ intern L1186
+L1187: 0
+ byte(7)82,0
+ intern L1187
+L1188: 0
+ byte(7)83,0
+ intern L1188
+L1189: 0
+ byte(7)84,0
+ intern L1189
+L1190: 0
+ byte(7)85,0
+ intern L1190
+L1191: 0
+ byte(7)86,0
+ intern L1191
+L1192: 0
+ byte(7)87,0
+ intern L1192
+L1193: 0
+ byte(7)88,0
+ intern L1193
+L1194: 0
+ byte(7)89,0
+ intern L1194
+L1195: 0
+ byte(7)90,0
+ intern L1195
+L1196: 0
+ byte(7)91,0
+ intern L1196
+L1197: 0
+ byte(7)92,0
+ intern L1197
+L1198: 0
+ byte(7)93,0
+ intern L1198
+L1199: 0
+ byte(7)94,0
+ intern L1199
+L1200: 0
+ byte(7)95,0
+ intern L1200
+L1201: 0
+ byte(7)96,0
+ intern L1201
+L1202: 0
+ byte(7)97,0
+ intern L1202
+L1203: 0
+ byte(7)98,0
+ intern L1203
+L1204: 0
+ byte(7)99,0
+ intern L1204
+L1205: 0
+ byte(7)100,0
+ intern L1205
+L1206: 0
+ byte(7)101,0
+ intern L1206
+L1207: 0
+ byte(7)102,0
+ intern L1207
+L1208: 0
+ byte(7)103,0
+ intern L1208
+L1209: 0
+ byte(7)104,0
+ intern L1209
+L1210: 0
+ byte(7)105,0
+ intern L1210
+L1211: 0
+ byte(7)106,0
+ intern L1211
+L1212: 0
+ byte(7)107,0
+ intern L1212
+L1213: 0
+ byte(7)108,0
+ intern L1213
+L1214: 0
+ byte(7)109,0
+ intern L1214
+L1215: 0
+ byte(7)110,0
+ intern L1215
+L1216: 0
+ byte(7)111,0
+ intern L1216
+L1217: 0
+ byte(7)112,0
+ intern L1217
+L1218: 0
+ byte(7)113,0
+ intern L1218
+L1219: 0
+ byte(7)114,0
+ intern L1219
+L1220: 0
+ byte(7)115,0
+ intern L1220
+L1221: 0
+ byte(7)116,0
+ intern L1221
+L1222: 0
+ byte(7)117,0
+ intern L1222
+L1223: 0
+ byte(7)118,0
+ intern L1223
+L1224: 0
+ byte(7)119,0
+ intern L1224
+L1225: 0
+ byte(7)120,0
+ intern L1225
+L1226: 0
+ byte(7)121,0
+ intern L1226
+L1227: 0
+ byte(7)122,0
+ intern L1227
+L1228: 0
+ byte(7)123,0
+ intern L1228
+L1229: 0
+ byte(7)124,0
+ intern L1229
+L1230: 0
+ byte(7)125,0
+ intern L1230
+L1231: 0
+ byte(7)126,0
+ intern L1231
+L1232: 0
+ byte(7)127,0
+ intern L1232
+L1233: 2
+ byte(7)78,73,76,0
+ intern L1233
+L1234: 6
+ byte(7)80,82,73,78,49,73,68,0
+ intern L1234
+L1235: 7
+ byte(7)80,82,73,78,49,73,78,84,0
+ intern L1235
+L1236: 10
+ byte(7)80,82,73,78,49,83,84,82,73,78,71,0
+ intern L1236
+L1237: 8
+ byte(7)80,82,73,78,49,80,65,73,82,0
+ intern L1237
+L1238: 5
+ byte(7)80,82,84,73,84,77,0
+ intern L1238
+L1239: 4
+ byte(7)80,82,73,78,49,0
+ intern L1239
+L1240: 6
+ byte(7)80,82,73,78,50,73,68,0
+ intern L1240
+L1241: 10
+ byte(7)80,82,73,78,50,83,84,82,73,78,71,0
+ intern L1241
+L1242: 8
+ byte(7)80,82,73,78,50,80,65,73,82,0
+ intern L1242
+L1243: 4
+ byte(7)80,82,73,78,50,0
+ intern L1243
+L1244: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L1244
+L1245: 4
+ byte(7)80,82,73,78,84,0
+ intern L1245
+L1246: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L1246
+L1247: 3
+ byte(7)80,85,84,67,0
+ intern L1247
+L1248: 5
+ byte(7)80,66,76,65,78,75,0
+ intern L1248
+L1249: 8
+ byte(7)80,82,73,78,49,73,78,84,88,0
+ intern L1249
+L1250: 6
+ byte(7)76,79,78,71,68,73,86,0
+ intern L1250
+L1251: 12
+ byte(7)76,79,78,71,82,69,77,65,73,78,68,69,82,0
+ intern L1251
+L1252: 3
+ byte(7)66,89,84,69,0
+ intern L1252
+L1253: 3
+ byte(7)81,85,73,84,0
+ intern L1253
+L1254: 4
+ byte(7)69,82,82,79,82,0
+ intern L1254
+L1255: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L1255
+L1256: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,72,65,82,0
+ intern L1256
+L1257: 19
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,87,82,73,84,69,67,72,65,82,0
+ intern L1257
+L1258: 8
+ byte(7)87,82,73,84,69,67,72,65,82,0
+ intern L1258
+L1259: 3
+ byte(7)79,85,84,42,0
+ intern L1259
+L1260: 10
+ byte(7)69,82,82,79,82,72,69,65,68,69,82,0
+ intern L1260
+L1261: 11
+ byte(7)69,82,82,79,82,84,82,65,73,76,69,82,0
+ intern L1261
+L1262: 9
+ byte(7)70,65,84,65,76,69,82,82,79,82,0
+ intern L1262
+L1263: 7
+ byte(7)83,84,68,69,82,82,79,82,0
+ intern L1263
+L1264: 9
+ byte(7)78,79,78,73,68,69,82,82,79,82,0
+ intern L1264
+L1265: 5
+ byte(7)80,82,73,78,49,84,0
+ intern L1265
+L1266: 8
+ byte(7)84,89,80,69,69,82,82,79,82,0
+ intern L1266
+L1267: 13
+ byte(7)85,83,65,71,69,84,89,80,69,69,82,82,79,82,0
+ intern L1267
+L1268: 1
+ byte(7)70,78,0
+ intern L1268
+L1269: 7
+ byte(7)79,70,70,69,78,68,69,82,0
+ intern L1269
+L1270: 13
+ byte(7)78,79,78,78,85,77,66,69,82,69,82,82,79,82,0
+ intern L1270
+L1271: 11
+ byte(7)76,65,77,66,73,78,68,65,82,71,83,42,0
+ intern L1271
+L1272: 6
+ byte(7)76,65,77,66,73,78,68,0
+ intern L1272
+L1273: 6
+ byte(7)85,78,66,73,78,68,78,0
+ intern L1273
+L1274: 14
+ byte(7)78,79,78,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L1274
+L1275: 22
+ byte(7)78,79,78,80,79,83,73,84,73,86,69,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L1275
+L1276: 8
+ byte(7)87,81,85,79,84,73,69,78,84,0
+ intern L1276
+L1277: 7
+ byte(7)37,82,69,67,76,65,73,77,0
+ intern L1277
+L1278: 5
+ byte(7)71,84,72,69,65,80,0
+ intern L1278
+L1279: 4
+ byte(7)71,84,83,84,82,0
+ intern L1279
+L1280: 5
+ byte(7)71,84,86,69,67,84,0
+ intern L1280
+L1281: 7
+ byte(7)71,84,87,65,82,82,65,89,0
+ intern L1281
+L1282: 3
+ byte(7)71,84,73,68,0
+ intern L1282
+L1283: 7
+ byte(7)72,65,82,68,67,79,78,83,0
+ intern L1283
+L1284: 3
+ byte(7)67,79,78,83,0
+ intern L1284
+L1285: 4
+ byte(7)88,67,79,78,83,0
+ intern L1285
+L1286: 4
+ byte(7)78,67,79,78,83,0
+ intern L1286
+L1287: 5
+ byte(7)77,75,86,69,67,84,0
+ intern L1287
+L1288: 4
+ byte(7)76,73,83,84,50,0
+ intern L1288
+L1289: 4
+ byte(7)76,73,83,84,51,0
+ intern L1289
+L1290: 4
+ byte(7)76,73,83,84,52,0
+ intern L1290
+L1291: 4
+ byte(7)76,73,83,84,53,0
+ intern L1291
+L1292: 6
+ byte(7)80,85,84,66,89,84,69,0
+ intern L1292
+L1293: 7
+ byte(7)77,75,83,84,82,73,78,71,0
+ intern L1293
+L1294: 4
+ byte(7)69,81,83,84,82,0
+ intern L1294
+L1295: 7
+ byte(7)73,78,73,84,82,69,65,68,0
+ intern L1295
+L1296: 5
+ byte(7)42,82,65,73,83,69,0
+ intern L1296
+L1297: 2
+ byte(7)67,72,42,0
+ intern L1297
+L1298: 3
+ byte(7)84,79,75,42,0
+ intern L1298
+L1299: 7
+ byte(7)84,79,75,84,89,80,69,42,0
+ intern L1299
+L1300: 4
+ byte(7)68,69,66,85,71,0
+ intern L1300
+L1301: 7
+ byte(7)83,69,84,82,65,73,83,69,0
+ intern L1301
+L1302: 9
+ byte(7)67,76,69,65,82,87,72,73,84,69,0
+ intern L1302
+L1303: 11
+ byte(7)67,76,69,65,82,67,79,77,77,69,78,84,0
+ intern L1303
+L1304: 6
+ byte(7)82,69,65,68,83,84,82,0
+ intern L1304
+L1305: 5
+ byte(7)68,73,71,73,84,80,0
+ intern L1305
+L1306: 6
+ byte(7)82,69,65,68,73,78,84,0
+ intern L1306
+L1307: 8
+ byte(7)65,76,80,72,65,69,83,67,80,0
+ intern L1307
+L1308: 5
+ byte(7)82,69,65,68,73,68,0
+ intern L1308
+L1309: 4
+ byte(7)82,65,84,79,77,0
+ intern L1309
+L1310: 5
+ byte(7)87,72,73,84,69,80,0
+ intern L1310
+L1311: 3
+ byte(7)71,69,84,67,0
+ intern L1311
+L1312: 8
+ byte(7)76,79,78,71,84,73,77,69,83,0
+ intern L1312
+L1313: 13
+ byte(7)66,85,70,70,69,82,84,79,83,84,82,73,78,71,0
+ intern L1313
+L1314: 8
+ byte(7)82,65,73,83,69,67,72,65,82,0
+ intern L1314
+L1315: 11
+ byte(7)65,76,80,72,65,78,85,77,69,83,67,80,0
+ intern L1315
+L1316: 5
+ byte(7)73,78,84,69,82,78,0
+ intern L1316
+L1317: 6
+ byte(7)69,83,67,65,80,69,80,0
+ intern L1317
+L1318: 5
+ byte(7)65,76,80,72,65,80,0
+ intern L1318
+L1319: 9
+ byte(7)76,79,87,69,82,67,65,83,69,80,0
+ intern L1319
+L1320: 7
+ byte(7)76,79,79,75,85,80,73,68,0
+ intern L1320
+L1321: 8
+ byte(7)73,78,73,84,78,69,87,73,68,0
+ intern L1321
+L1322: 11
+ byte(7)77,65,75,69,70,85,78,66,79,85,78,68,0
+ intern L1322
+L1323: 9
+ byte(7)85,80,80,69,82,67,65,83,69,80,0
+ intern L1323
+L1324: 8
+ byte(7)65,76,80,72,65,78,85,77,80,0
+ intern L1324
+L1325: 4
+ byte(7)82,69,65,68,49,0
+ intern L1325
+L1326: 3
+ byte(7)82,69,65,68,0
+ intern L1326
+L1327: 7
+ byte(7)82,69,65,68,76,73,83,84,0
+ intern L1327
+L1328: 4
+ byte(7)81,85,79,84,69,0
+ intern L1328
+L1329: 6
+ byte(7)83,65,70,69,67,68,82,0
+ intern L1329
+L1330: 9
+ byte(7)83,89,77,70,78,67,66,65,83,69,0
+ intern L1330
+L1331: 5
+ byte(7)87,80,76,85,83,50,0
+ intern L1331
+L1332: 5
+ byte(7)83,89,77,70,78,67,0
+ intern L1332
+L1333: 6
+ byte(7)87,84,73,77,69,83,50,0
+ intern L1333
+L1334: 29
+ byte(7)65,68,68,82,69,83,83,73,78,71,85,78,73,84,83,80,69,82,70,85,78,67,84,73,79,78,67,69,76,76,0
+ intern L1334
+L1335: 16
+ byte(7)83,72,79,85,76,68,66,69,85,78,68,69,70,73,78,69,68,0
+ intern L1335
+L1336: 8
+ byte(7)70,85,78,66,79,85,78,68,80,0
+ intern L1336
+L1337: 18
+ byte(7)37,67,79,80,89,45,70,85,78,67,84,73,79,78,45,67,69,76,76,0
+ intern L1337
+L1338: 25
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,0
+ intern L1338
+L1339: 11
+ byte(7)70,76,65,77,66,68,65,76,73,78,75,80,0
+ intern L1339
+L1340: 11
+ byte(7)37,83,84,79,82,69,45,74,67,65,76,76,0
+ intern L1340
+L1341: 14
+ byte(7)77,65,75,69,70,76,65,77,66,68,65,76,73,78,75,0
+ intern L1341
+L1342: 5
+ byte(7)70,67,79,68,69,80,0
+ intern L1342
+L1343: 8
+ byte(7)77,65,75,69,70,67,79,68,69,0
+ intern L1343
+L1344: 14
+ byte(7)71,69,84,70,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L1344
+L1345: 12
+ byte(7)67,79,68,69,80,82,73,77,73,84,73,86,69,0
+ intern L1345
+L1346: 7
+ byte(7)67,79,68,69,80,84,82,42,0
+ intern L1346
+L1347: 12
+ byte(7)83,65,86,69,82,69,71,73,83,84,69,82,83,0
+ intern L1347
+L1348: 8
+ byte(7)67,79,68,69,70,79,82,77,42,0
+ intern L1348
+L1349: 8
+ byte(7)67,79,68,69,78,65,82,71,42,0
+ intern L1349
+L1350: 28
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,65,85,88,0
+ intern L1350
+L1351: 8
+ byte(7)70,65,83,84,65,80,80,76,89,0
+ intern L1351
+L1352: 14
+ byte(7)70,65,83,84,76,65,77,66,68,65,65,80,80,76,89,0
+ intern L1352
+L1353: 5
+ byte(7)76,65,77,66,68,65,0
+ intern L1353
+L1354: 19
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,0
+ intern L1354
+L1355: 22
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,65,85,88,0
+ intern L1355
+L1356: 8
+ byte(7)67,79,68,69,65,80,80,76,89,0
+ intern L1356
+L1357: 12
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,0
+ intern L1357
+L1358: 15
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,65,85,88,0
+ intern L1358
+L1359: 3
+ byte(7)69,86,65,76,0
+ intern L1359
+L1360: 10
+ byte(7)66,73,78,68,69,86,65,76,65,85,88,0
+ intern L1360
+L1361: 7
+ byte(7)66,73,78,68,69,86,65,76,0
+ intern L1361
+L1362: 5
+ byte(7)76,66,73,78,68,49,0
+ intern L1362
+L1363: 2
+ byte(7)71,69,84,0
+ intern L1363
+L1364: 31
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,65,85,88,65,85,88,0
+ intern L1364
+L1365: 10
+ byte(7)42,76,65,77,66,68,65,76,73,78,75,0
+ intern L1365
+L1366: 5
+ byte(7)66,76,68,77,83,71,0
+ intern L1366
+L1367: 6
+ byte(7)69,86,80,82,79,71,78,0
+ intern L1367
+L1368: 6
+ byte(7)83,89,83,50,73,78,84,0
+ intern L1368
+L1369: 4
+ byte(7)80,76,85,83,50,0
+ intern L1369
+L1370: 4
+ byte(7)77,73,78,85,83,0
+ intern L1370
+L1371: 4
+ byte(7)87,65,68,68,49,0
+ intern L1371
+L1372: 3
+ byte(7)69,76,83,69,0
+ intern L1372
+L1373: 3
+ byte(7)65,68,68,49,0
+ intern L1373
+L1374: 4
+ byte(7)87,83,85,66,49,0
+ intern L1374
+L1375: 3
+ byte(7)83,85,66,49,0
+ intern L1375
+L1376: 7
+ byte(7)71,82,69,65,84,69,82,80,0
+ intern L1376
+L1377: 4
+ byte(7)76,69,83,83,80,0
+ intern L1377
+L1378: 9
+ byte(7)68,73,70,70,69,82,69,78,67,69,0
+ intern L1378
+L1379: 5
+ byte(7)84,73,77,69,83,50,0
+ intern L1379
+L1380: 2
+ byte(7)67,65,82,0
+ intern L1380
+L1381: 2
+ byte(7)67,68,82,0
+ intern L1381
+L1382: 3
+ byte(7)67,65,65,82,0
+ intern L1382
+L1383: 3
+ byte(7)67,65,68,82,0
+ intern L1383
+L1384: 3
+ byte(7)67,68,65,82,0
+ intern L1384
+L1385: 3
+ byte(7)67,68,68,82,0
+ intern L1385
+L1386: 3
+ byte(7)65,84,79,77,0
+ intern L1386
+L1387: 5
+ byte(7)65,80,80,69,78,68,0
+ intern L1387
+L1388: 3
+ byte(7)77,69,77,81,0
+ intern L1388
+L1389: 6
+ byte(7)82,69,86,69,82,83,69,0
+ intern L1389
+L1390: 4
+ byte(7)69,86,76,73,83,0
+ intern L1390
+L1391: 4
+ byte(7)80,82,79,71,78,0
+ intern L1391
+L1392: 5
+ byte(7)69,86,67,79,78,68,0
+ intern L1392
+L1393: 3
+ byte(7)67,79,78,68,0
+ intern L1393
+L1394: 2
+ byte(7)83,69,84,0
+ intern L1394
+L1395: 3
+ byte(7)83,69,84,81,0
+ intern L1395
+L1396: 3
+ byte(7)80,85,84,68,0
+ intern L1396
+L1397: 1
+ byte(7)68,69,0
+ intern L1397
+L1398: 3
+ byte(7)69,88,80,82,0
+ intern L1398
+L1399: 1
+ byte(7)68,70,0
+ intern L1399
+L1400: 4
+ byte(7)70,69,88,80,82,0
+ intern L1400
+L1401: 1
+ byte(7)68,78,0
+ intern L1401
+L1402: 4
+ byte(7)78,69,88,80,82,0
+ intern L1402
+L1403: 1
+ byte(7)68,77,0
+ intern L1403
+L1404: 4
+ byte(7)77,65,67,82,79,0
+ intern L1404
+L1405: 3
+ byte(7)76,73,83,84,0
+ intern L1405
+L1406: 4
+ byte(7)65,84,83,79,67,0
+ intern L1406
+L1407: 2
+ byte(7)71,69,81,0
+ intern L1407
+L1408: 2
+ byte(7)76,69,81,0
+ intern L1408
+L1409: 4
+ byte(7)69,81,67,65,82,0
+ intern L1409
+L1410: 3
+ byte(7)71,69,84,68,0
+ intern L1410
+L1411: 4
+ byte(7)67,79,80,89,68,0
+ intern L1411
+L1412: 5
+ byte(7)68,69,76,65,84,81,0
+ intern L1412
+L1413: 2
+ byte(7)80,85,84,0
+ intern L1413
+L1414: 7
+ byte(7)73,78,73,84,69,86,65,76,0
+ intern L1414
+L1415: 4
+ byte(7)87,72,73,76,69,0
+ intern L1415
+L1416: 4
+ byte(7)70,84,89,80,69,0
+ intern L1416
+L1417: 6
+ byte(7)76,65,77,66,68,65,80,0
+ intern L1417
+L1418: 8
+ byte(7)71,69,84,76,65,77,66,68,65,0
+ intern L1418
+L1419: 14
+ byte(7)76,65,77,66,68,65,69,86,65,76,65,80,80,76,89,0
+ intern L1419
+L1420: 8
+ byte(7)71,69,84,70,78,84,89,80,69,0
+ intern L1420
+L1421: 10
+ byte(7)76,65,77,66,68,65,65,80,80,76,89,0
+ intern L1421
+L1422: 4
+ byte(7)65,80,80,76,89,0
+ intern L1422
+L1423: 7
+ byte(7)68,79,76,65,77,66,68,65,0
+ intern L1423
+L1424: 5
+ byte(7)76,69,78,71,84,72,0
+ intern L1424
+L1425: 4
+ byte(7)67,79,68,69,80,0
+ intern L1425
+L1426: 4
+ byte(7)80,65,73,82,80,0
+ intern L1426
+L1427: 2
+ byte(7)73,68,80,0
+ intern L1427
+L1428: 1
+ byte(7)69,81,0
+ intern L1428
+L1429: 3
+ byte(7)78,85,76,76,0
+ intern L1429
+L1430: 2
+ byte(7)78,79,84,0
+ intern L1430
+L1431: 6
+ byte(7)76,69,78,71,84,72,49,0
+ intern L1431
+L1432: 5
+ byte(7)77,65,80,79,66,76,0
+ intern L1432
+L1433: 10
+ byte(7)80,82,73,78,84,70,69,88,80,82,83,0
+ intern L1433
+L1434: 10
+ byte(7)80,82,73,78,84,49,70,69,88,80,82,0
+ intern L1434
+L1435: 5
+ byte(7)70,69,88,80,82,80,0
+ intern L1435
+L1436: 13
+ byte(7)80,82,73,78,84,70,85,78,67,84,73,79,78,83,0
+ intern L1436
+L1437: 13
+ byte(7)80,82,73,78,84,49,70,85,78,67,84,73,79,78,0
+ intern L1437
+L1438: 3
+ byte(7)80,82,79,80,0
+ intern L1438
+L1439: 6
+ byte(7)82,69,77,80,82,79,80,0
+ intern L1439
+L1440: 7
+ byte(7)83,89,83,50,70,73,88,78,0
+ intern L1440
+L1441: 13
+ byte(7)73,78,70,83,84,65,82,84,73,78,71,66,73,84,0
+ intern L1441
+L1442: 11
+ byte(7)73,78,70,66,73,84,76,69,78,71,84,72,0
+ intern L1442
+L1443: 7
+ byte(7)73,78,73,84,72,69,65,80,0
+ intern L1443
+L1444: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L1444
+L1445: 4
+ byte(7)77,65,73,78,46,0
+ intern L1445
+L1446: 3
+ byte(7)73,78,73,84,0
+ intern L1446
+L1447: 2
+ byte(7)73,78,42,0
+ intern L1447
+L1448: 18
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,82,69,65,68,67,72,65,82,0
+ intern L1448
+L1449: 3
+ byte(7)84,73,77,67,0
+ intern L1449
+L1450: 3
+ byte(7)68,65,84,69,0
+ intern L1450
+L1451: 10
+ byte(7)86,69,82,83,73,79,78,78,65,77,69,0
+ intern L1451
+L1452: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L1452
+L1453: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L1453
+L1454: 10
+ byte(7)85,78,68,69,70,78,67,79,68,69,42,0
+ intern L1454
+L1455: 10
+ byte(7)85,78,68,69,70,78,78,65,82,71,42,0
+ intern L1455
+L1456: 3
+ byte(7)70,76,65,71,0
+ intern L1456
+L1457: 9
+ byte(7)87,82,69,77,65,73,78,68,69,82,0
+ intern L1457
+L1458: 7
+ byte(7)72,69,65,80,73,78,70,79,0
+ intern L1458
+L1459: 6
+ byte(7)82,69,67,76,65,73,77,0
+ intern L1459
+L1460: 5
+ byte(7)83,80,65,67,69,68,0
+ intern L1460
+L1461: 5
+ byte(7)68,65,83,72,69,68,0
+ intern L1461
+L1462: 5
+ byte(7)68,79,84,84,69,68,0
+ intern L1462
+L1463: 7
+ byte(7)83,72,79,85,76,68,66,69,0
+ intern L1463
+L1464: 2
+ byte(7)73,78,70,0
+ intern L1464
+L1465: 2
+ byte(7)84,65,71,0
+ intern L1465
+L1466: 5
+ byte(7)77,75,73,84,69,77,0
+ intern L1466
+L1467: 6
+ byte(7)84,69,83,84,71,69,84,0
+ intern L1467
+L1468: 4
+ byte(7)36,69,79,70,36,0
+ intern L1468
+L1469: 4
+ byte(7)42,80,86,65,76,0
+ intern L1469
+L1470: 12
+ byte(7)84,69,83,84,85,78,68,69,70,73,78,69,68,0
+ intern L1470
+L1471: 9
+ byte(7)84,69,83,84,83,69,82,73,69,83,0
+ intern L1471
+L1472: 2
+ byte(7)70,85,77,0
+ intern L1472
+L1473: 2
+ byte(7)70,79,79,0
+ intern L1473
+L1474: 2
+ byte(7)70,69,69,0
+ intern L1474
+L1475: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L1475
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/20-tests/main5.rel
Index: psl-1983/20-tests/main5.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main5.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/main5.sym
Index: psl-1983/20-tests/main5.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main5.sym
@@ -0,0 +1,506 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM
+PRIN1 PRIN2ID PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PUTC PBLANK
+PRIN1INTX LONGDIV LONGREMAINDER BYTE QUIT ERROR CHANNELPRIN2
+CHANNELWRITECHAR INDEPENDENTWRITECHAR WRITECHAR OUT!* ERRORHEADER
+ERRORTRAILER FATALERROR STDERROR NONIDERROR PRIN1T TYPEERROR USAGETYPEERROR
+FN OFFENDER NONNUMBERERROR LAMBINDARGS!* LAMBIND UNBINDN NONINTEGERERROR
+NONPOSITIVEINTEGERERROR WQUOTIENT !%RECLAIM GTHEAP GTSTR GTVECT GTWARRAY
+GTID HARDCONS CONS XCONS NCONS MKVECT LIST2 LIST3 LIST4 LIST5 PUTBYTE
+MKSTRING EQSTR INITREAD !*RAISE CH!* TOK!* TOKTYPE!* DEBUG SETRAISE
+CLEARWHITE CLEARCOMMENT READSTR DIGITP READINT ALPHAESCP READID RATOM WHITEP
+GETC LONGTIMES BUFFERTOSTRING RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP
+LOWERCASEP LOOKUPID INITNEWID MAKEFUNBOUND UPPERCASEP ALPHANUMP READ1 READ
+READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED FUNBOUNDP
+!%COPY!-FUNCTION!-CELL COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL
+MAKEFLAMBDALINK FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!*
+SAVEREGISTERS CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL BINDEVALAUX BINDEVAL LBIND1
+GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK BLDMSG EVPROGN SYS2INT
+PLUS2 MINUS WADD1 ELSE ADD1 WSUB1 SUB1 GREATERP LESSP DIFFERENCE TIMES2 CAR
+CDR CAAR CADR CDAR CDDR ATOM APPEND MEMQ REVERSE EVLIS PROGN EVCOND COND SET
+SETQ PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO LIST ATSOC GEQ LEQ EQCAR GETD
+COPYD DELATQ PUT INITEVAL WHILE FTYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY
+GETFNTYPE LAMBDAAPPLY APPLY DOLAMBDA LENGTH CODEP PAIRP IDP EQ NULL NOT
+LENGTH1 MAPOBL PRINTFEXPRS PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION
+PROP REMPROP SYS2FIXN INFSTARTINGBIT INFBITLENGTH)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 338))
+(SETQ STRINGGENSYM!* (QUOTE "L1004"))
+(PUT (QUOTE INFBITLENGTH) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0643"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0237"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0321"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0325"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0025"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0569"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE FTYPE) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0515"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE WADD1) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0355"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0360"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0230"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 270))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0436"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0443")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0183"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0375"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0185"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0184"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE PRIN1T) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0398"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0299"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0674"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0301"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 243))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0369"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0103"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0098"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WSUB1) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0370"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE LOOKUPID) (QUOTE ENTRYPOINT) (QUOTE "L0270"))
+(PUT (QUOTE LOOKUPID) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0660"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0425"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0192"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0093"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0156"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0287"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0263"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0177"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0094"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0634"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0182"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0603"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0471"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 271))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0021"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0647"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0186"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0034"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0330"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 244))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0191"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE FN) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0297"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0172"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0291"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0665"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0620"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0646"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0017"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0614"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0402"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0679"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0607"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0222"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0339"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0642"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0604"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0437"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0371"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0099"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE OFFENDER) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0483"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0095"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 268))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0429"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0224"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0509"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0334"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0241"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE INFSTARTINGBIT) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0106"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0295"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0350"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0310"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 241))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0233"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 198))
ADDED psl-1983/20-tests/main6.cmd
Index: psl-1983/20-tests/main6.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main6.cmd
@@ -0,0 +1,2 @@
+main6,Dmain6,sub6,Dsub6,sub5,Dsub5,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/main6.init
Index: psl-1983/20-tests/main6.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main6.init
@@ -0,0 +1,6 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(GLOBAL (QUOTE (LAMBDA1 LAMBDA2 CODEFORM!*)))
ADDED psl-1983/20-tests/main6.mac
Index: psl-1983/20-tests/main6.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main6.mac
@@ -0,0 +1,3652 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern L0001
+ extern L0002
+ extern HEAP
+ extern L0183
+ extern L0184
+ extern L0185
+ extern L0186
+ extern BPS
+ extern L1074
+ extern L1075
+ extern L1076
+ extern L1077
+; (!*ENTRY INITHEAP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR HEAPLOWERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPLOWERBOUND))
+; (MOVEM (REG T1) (WVAR HEAPLAST))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*MOVE (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (MOVEM (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INITHEAP EXPR 0)
+L1078: intern L1078
+ MOVE 6,L0183
+ MOVEM 6,L0185
+ SETZM 1
+ MOVEM 1,L0186
+ POPJ 15,0
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (MOVE (REG NIL) (FLUID NIL))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (HRRZI (REG LINKREG) 349)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L1079
+ MOVE 0,SYMVAL+128
+ HRRZI 12,349
+ SETZM 13
+ JRST SYMFNC+349
+L1079: byte(18)-5000,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK INIT20 EXPR 1)
+ extern INIT20
+; (PUSHJ (REG ST) (INTERNALENTRY INIT20))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ PUSHJ 15,INIT20
+ SETZM SYMVAL+352
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+154
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 0) (!$FLUID IN!*))
+; (SKIPE (!$FLUID IN!*))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+ extern GETC20
+; (PUSHJ (REG ST) (INTERNALENTRY GETC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID IN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID IN!*))
+; (!*LINKE 0 INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 353)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTREADCHAR))
+ 0
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SKIPE SYMVAL+352
+ JRST L1080
+ SETZM 1
+ PUSHJ 15,GETC20
+ POPJ 15,0
+L1080: MOVE 1,SYMVAL+352
+ HRRZI 12,353
+ HRRZI 13,1
+ JRST SYMFNC+353
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+ extern TIMC20
+; (PUSHJ (REG ST) (INTERNALENTRY TIMC20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ PUSHJ 15,TIMC20
+ POPJ 15,0
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 1) (!$FLUID OUT!*))
+; (MOVE (REG T2) (!$FLUID OUT!*))
+; (CAIE (REG T2) 1)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PUTC20 EXPR 1)
+ extern PUTC20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID OUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 152)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ MOVE 7,SYMVAL+154
+ CAIE 7,1
+ JRST L1081
+ PUSHJ 15,PUTC20
+ POPJ 15,0
+L1081: MOVE 2,1
+ MOVE 1,SYMVAL+154
+ HRRZI 12,152
+ HRRZI 13,2
+ JRST SYMFNC+152
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+ extern QUIT20
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY DATE EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "No-Date-Yet") (REG 1))
+; (MOVE (REG 1) (QUOTE "No-Date-Yet"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1083: 10
+ byte(7)78,111,45,68,97,116,101,45,89,101,116,0
+ 0
+; (!*ENTRY DATE EXPR 0)
+DATE: intern DATE
+ MOVE 1,L1082
+ POPJ 15,0
+L1082: <4_31>+L1083
+; (!*ENTRY VERSIONNAME EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "DEC-20 test system") (REG 1))
+; (MOVE (REG 1) (QUOTE "DEC-20 test system"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1085: 17
+ byte(7)68,69,67,45,50,48,32,116,101,115,116,32,115,121,115,116,101,109,0
+ 0
+; (!*ENTRY VERSIONNAME EXPR 0)
+L1086: intern L1086
+ MOVE 1,L1084
+ POPJ 15,0
+L1084: <4_31>+L1085
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+ extern PUTI20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTI20))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ PUSHJ 15,PUTI20
+ POPJ 15,0
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*WOR (REG 1) 23085449216)
+; (IOR (REG 1) 23085449216)
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+L1087: intern L1087
+ IOR 1,[23085449216]
+ MOVEM 1,0(2)
+ POPJ 15,0
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (MEMORY (REG 1) (WCONST 0)) (MEMORY (REG 2) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG 1) 0))
+; (MOVEM (REG T1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+L1088: intern L1088
+ MOVE 6,0(1)
+ MOVEM 6,0(2)
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+; (!*MOVE (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (MOVEM (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (!*MOVE (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (MOVEM (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (!*JCALL UNDEFINEDFUNCTIONAUX)
+; (JRST (ENTRY UNDEFINEDFUNCTIONAUX))
+ 0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+L1089: intern L1089
+ MOVEM 12,SYMVAL+359
+ MOVEM 13,SYMVAL+360
+ JRST SYMFNC+249
+; (!*ENTRY FLAG EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE 2 (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINKE 0 ERR20 EXPR 1)
+ extern ERR20
+; (PUSHJ (REG ST) (INTERNALENTRY ERR20))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ HRRZI 1,2
+ PUSHJ 15,ERR20
+ POPJ 15,0
+; (!*ENTRY LONGTIMES EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGTIMES EXPR 2)
+L1090: intern L1090
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY LONGDIV EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGDIV EXPR 2)
+L1091: intern L1091
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+; (!*ENTRY LONGREMAINDER EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 362)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (MOVE (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGREMAINDER EXPR 2)
+L1092: intern L1092
+ HRRZI 12,362
+ HRRZI 13,2
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY !%RECLAIM EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE " *** Dummy !%RECLAIM: ") (REG 1))
+; (MOVE (REG 1) (QUOTE " *** Dummy !%RECLAIM: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINKE 0 HEAPINFO EXPR 0)
+; (HRRZI (REG LINKREG) 363)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY HEAPINFO))
+L1094: 21
+ byte(7)32,42,42,42,32,68,117,109,109,121,32,33,37,82,69,67,76,65,73,77,58,32,0
+ 0
+; (!*ENTRY !%RECLAIM EXPR 0)
+L1095: intern L1095
+ MOVE 1,L1093
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,363
+ SETZM 13
+ JRST SYMFNC+363
+L1093: <4_31>+L1094
+; (!*ENTRY RECLAIM EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "*** Dummy RECLAIM: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Dummy RECLAIM: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINKE 0 HEAPINFO EXPR 0)
+; (HRRZI (REG LINKREG) 363)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY HEAPINFO))
+L1097: 18
+ byte(7)42,42,42,32,68,117,109,109,121,32,82,69,67,76,65,73,77,58,32,0
+ 0
+; (!*ENTRY RECLAIM EXPR 0)
+L1098: intern L1098
+ MOVE 1,L1096
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,363
+ SETZM 13
+ JRST SYMFNC+363
+L1096: <4_31>+L1097
+; (!*ENTRY HEAPINFO EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPLAST) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPLAST))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLOWERBOUND))
+; (SUB (REG 1) (WVAR HEAPLOWERBOUND))
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " Items used, ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Items used, "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPUPPERBOUND) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPUPPERBOUND))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLAST))
+; (SUB (REG 1) (WVAR HEAPLAST))
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " Items left.") (REG 1))
+; (MOVE (REG 1) (QUOTE " Items left."))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1101: 11
+ byte(7)32,73,116,101,109,115,32,108,101,102,116,46,0
+L1102: 12
+ byte(7)32,73,116,101,109,115,32,117,115,101,100,44,32,0
+ 0
+; (!*ENTRY HEAPINFO EXPR 0)
+L1103: intern L1103
+ HRRZI 2,1
+ MOVE 1,L0185
+ SUB 1,L0183
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1099
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 2,1
+ MOVE 1,L0184
+ SUB 1,L0185
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1100
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ SETZM 1
+ POPJ 15,0
+L1100: <4_31>+L1101
+L1099: <4_31>+L1102
+; (!*ENTRY SPACED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1105: 10
+ byte(7)32,32,32,32,32,32,32,32,32,32,32,0
+ 1
+; (!*ENTRY SPACED EXPR 1)
+SPACED: intern SPACED
+ PUSH 15,1
+ MOVE 1,L1104
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1104: <4_31>+L1105
+; (!*ENTRY DASHED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE "---------- ") (REG 1))
+; (MOVE (REG 1) (QUOTE "---------- "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1107: 10
+ byte(7)45,45,45,45,45,45,45,45,45,45,32,0
+ 1
+; (!*ENTRY DASHED EXPR 1)
+DASHED: intern DASHED
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1106
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1106: <4_31>+L1107
+; (!*ENTRY DOTTED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE " ....... ") (REG 1))
+; (MOVE (REG 1) (QUOTE " ....... "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1109: 10
+ byte(7)32,32,32,46,46,46,46,46,46,46,32,0
+ 1
+; (!*ENTRY DOTTED EXPR 1)
+DOTTED: intern DOTTED
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1108
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1108: <4_31>+L1109
+; (!*ENTRY SHOULDBE EXPR 3)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE " ....... For ") (REG 1))
+; (MOVE (REG 1) (QUOTE " ....... For "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " should be ") (REG 1))
+; (MOVE (REG 1) (QUOTE " should be "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*JUMPNOTEQ (LABEL G0004) (FRAME 2) (FRAME 3))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAME (REG T1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE " [OK ]") (REG 1))
+; (MOVE (REG 1) (QUOTE " [OK ]"))
+; (!*JUMP (LABEL G0006))
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE " [BAD] *******") (REG 1))
+; (MOVE (REG 1) (QUOTE " [BAD] *******"))
+; (!*LBL (LABEL G0006))
+; (!*LINKE 3 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1115: 15
+ byte(7)32,32,32,91,66,65,68,93,32,42,42,42,42,42,42,42,0
+L1116: 6
+ byte(7)32,32,91,79,75,32,93,0
+L1117: 10
+ byte(7)32,115,104,111,117,108,100,32,98,101,32,0
+L1118: 0
+ byte(7)32,0
+L1119: 14
+ byte(7)32,32,32,46,46,46,46,46,46,46,32,70,111,114,32,0
+ 3
+; (!*ENTRY SHOULDBE EXPR 3)
+L1120: intern L1120
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 1,L1110
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1111
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1112
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-2(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 6,-1(15)
+ CAME 6,-2(15)
+ JRST L1121
+ MOVE 1,L1113
+ JRST L1122
+L1121: MOVE 1,L1114
+L1122: ADJSP 15,-3
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1114: <4_31>+L1115
+L1113: <4_31>+L1116
+L1112: <4_31>+L1117
+L1111: <4_31>+L1118
+L1110: <4_31>+L1119
+; (!*ENTRY UNDEFINEDFUNCTIONAUXAUX EXPR 0)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (!$FLUID UNDEFNNARG!*) (FRAME 2))
+; (MOVE (REG T1) (!$FLUID UNDEFNNARG!*))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*MOVE (!$FLUID UNDEFNCODE!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID UNDEFNCODE!*))
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE "Undefined Function ") (REG 1))
+; (MOVE (REG 1) (QUOTE "Undefined Function "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " called with ") (REG 1))
+; (MOVE (REG 1) (QUOTE " called with "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " args from compiled code") (REG 1))
+; (MOVE (REG 1) (QUOTE " args from compiled code"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+L1126: 23
+ byte(7)32,97,114,103,115,32,102,114,111,109,32,99,111,109,112,105,108,101,100,32,99,111,100,101,0
+L1127: 12
+ byte(7)32,99,97,108,108,101,100,32,119,105,116,104,32,0
+L1128: 18
+ byte(7)85,110,100,101,102,105,110,101,100,32,70,117,110,99,116,105,111,110,32,0
+ 0
+; (!*ENTRY UNDEFINEDFUNCTIONAUXAUX EXPR 0)
+L1129: intern L1129
+ ADJSP 15,2
+ MOVE 6,SYMVAL+360
+ MOVEM 6,-1(15)
+ MOVE 1,SYMVAL+359
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,0(15)
+ MOVE 1,L1123
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1124
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1125
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L1125: <4_31>+L1126
+L1124: <4_31>+L1127
+L1123: <4_31>+L1128
+; (!*ENTRY INF EXPR 1)
+; (!*ALLOC 0)
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY INF EXPR 1)
+INF: intern INF
+ HRRZ 1,1
+ POPJ 15,0
+; (!*ENTRY TAG EXPR 1)
+; (!*ALLOC 0)
+; (!*FIELD (REG 1) (REG 1) (WCONST 0) (WCONST 5))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 1
+; (!*ENTRY TAG EXPR 1)
+TAG: intern TAG
+ LDB 1,L1130
+ POPJ 15,0
+L1130: point 5,1,4
+; (!*ENTRY MKITEM EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*MKITEM (REG 1) (REG 3))
+; (DPB (REG 3) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 2
+; (!*ENTRY MKITEM EXPR 2)
+MKITEM: intern MKITEM
+ MOVE 3,1
+ MOVE 1,2
+ DPB 3,L1131
+ POPJ 15,0
+L1131: point 5,1,4
+; (!*ENTRY BLDMSG EXPR 7)
+; (!*ALLOC 7)
+; (ADJSP (REG ST) 7)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 4) (FRAME 4))
+; (MOVEM (REG 4) (INDEXED (REG ST) -3))
+; (!*MOVE (REG 5) (FRAME 5))
+; (MOVEM (REG 5) (INDEXED (REG ST) -4))
+; (!*MOVE (REG 6) (FRAME 6))
+; (HRRZI (REG T1) (IMMEDIATE (EXTRAREG 6)))
+; (MOVEM (REG T1) (INDEXED (REG ST) -5))
+; (!*MOVE (REG 7) (FRAME 7))
+; (HRRZI (REG T1) (IMMEDIATE (EXTRAREG 7)))
+; (MOVEM (REG T1) (INDEXED (REG ST) -6))
+; (!*MOVE (QUOTE "BldMsg called") (REG 1))
+; (MOVE (REG 1) (QUOTE "BldMsg called"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (FRAME 4) (REG 4))
+; (MOVE (REG 4) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 3) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LIST4 EXPR 4)
+; (HRRZI (REG LINKREG) 185)
+; (HRRZI (REG NARGREG) 4)
+; (PUSHJ (REG ST) (ENTRY LIST4))
+; (!*LINKE 7 PRINT EXPR 1)
+; (ADJSP (REG ST) (MINUS 7))
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRINT))
+L1133: 12
+ byte(7)66,108,100,77,115,103,32,99,97,108,108,101,100,0
+ 7
+; (!*ENTRY BLDMSG EXPR 7)
+BLDMSG: intern BLDMSG
+ ADJSP 15,7
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVEM 5,-4(15)
+ HRRZI 6,L0004+0
+ MOVEM 6,-5(15)
+ HRRZI 6,L0004+1
+ MOVEM 6,-6(15)
+ MOVE 1,L1132
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 4,-3(15)
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ HRRZI 12,185
+ HRRZI 13,4
+ PUSHJ 15,SYMFNC+185
+ ADJSP 15,-7
+ HRRZI 12,140
+ HRRZI 13,1
+ JRST SYMFNC+140
+L1132: <4_31>+L1133
+; (!*ENTRY TIME EXPR 0)
+; (!*ALLOC 0)
+; (!*LINKE 0 TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 354)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY TIMC))
+ 0
+; (!*ENTRY TIME EXPR 0)
+TIME: intern TIME
+ HRRZI 12,354
+ SETZM 13
+ JRST SYMFNC+354
+; (!*ENTRY FUNCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 3))
+; (MOVE (REG 3) (REG 2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*LINKE 0 IDAPPLY1 EXPR 2)
+; (HRRZI (REG NARGREG) 1)
+; (MOVE (REG LINKREG) (REG 2))
+; (JRST (INDEXED (REG 2) (WARRAY SYMFNC)))
+ 2
+; (!*ENTRY FUNCALL EXPR 2)
+L1134: intern L1134
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,3
+ HRRZI 13,1
+ MOVE 12,2
+ JRST SYMFNC(2)
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (QUOTE NIL) (FRAME 1))
+; (MOVEM (REG NIL) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*LINK INIT EXPR 0)
+; (HRRZI (REG LINKREG) 351)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INIT))
+; (!*LINK INITHEAP EXPR 0)
+; (HRRZI (REG LINKREG) 348)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITHEAP))
+; (!*LINK INITEVAL EXPR 0)
+; (HRRZI (REG LINKREG) 309)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITEVAL))
+; (!*MOVE (QUOTE "MINI-PSL: A Read-Eval-Print Loop, terminate with Q") (REG 1))
+; (MOVE (REG 1) (QUOTE "MINI-PSL: A Read-Eval-Print Loop, terminate with Q"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " !*RAISE has been set T") (REG 1))
+; (MOVE (REG 1) (QUOTE " !*RAISE has been set T"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " Run (TESTSERIES) to check BINDING etc") (REG 1))
+; (MOVE (REG 1) (QUOTE " Run (TESTSERIES) to check BINDING etc"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*MOVE (REG 1) (!$FLUID DEBUG))
+; (MOVEM (REG 1) (!$FLUID DEBUG))
+; (!*LINK INITREAD EXPR 0)
+; (HRRZI (REG LINKREG) 190)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITREAD))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*MOVE (REG 1) (!$FLUID !*RAISE))
+; (MOVEM (REG 1) (!$FLUID !*RAISE))
+; (!*MOVE (WCONST 26) (REG 1))
+; (HRRZI (REG 1) 26)
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (!$FLUID !$EOF!$))
+; (MOVEM (REG 1) (!$FLUID !$EOF!$))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE " .... Now Call INITCODE") (REG 1))
+; (MOVE (REG 1) (QUOTE " .... Now Call INITCODE"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK INITCODE EXPR 0)
+; (HRRZI (REG LINKREG) 374)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITCODE))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTEQ (LABEL G0004) (FRAME 2) (QUOTE NIL))
+; (CAME (REG NIL) (INDEXED (REG ST) -1))
+; (JRST (LABEL G0004))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " lisp> ") (REG 1))
+; (MOVE (REG 1) (QUOTE " lisp> "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPNOTEQ (LABEL G0011) (REG 1) (QUOTE Q))
+; (CAME (REG 1) (QUOTE Q))
+; (JRST (LABEL G0011))
+; (!*MOVE (QUOTE T) (FRAME 2))
+; (MOVE (REG T1) (FLUID T))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0011))
+; (!*JUMPNOTEQ (LABEL G0012) (REG 1) (!$GLOBAL !$EOF!$))
+; (CAME (REG 1) (!$GLOBAL !$EOF!$))
+; (JRST (LABEL G0012))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE " **** Top Level EOF **** ") (REG 1))
+; (MOVE (REG 1) (QUOTE " **** Top Level EOF **** "))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0012))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EVAL EXPR 1)
+; (HRRZI (REG LINKREG) 254)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY EVAL))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+L1142: 24
+ byte(7)32,42,42,42,42,32,84,111,112,32,76,101,118,101,108,32,69,79,70,32,42,42,42,42,32,0
+L1143: 6
+ byte(7)32,108,105,115,112,62,32,0
+L1144: 22
+ byte(7)32,46,46,46,46,32,78,111,119,32,67,97,108,108,32,73,78,73,84,67,79,68,69,0
+L1145: 42
+ byte(7)32,32,32,32,32,32,82,117,110,32,40,84,69,83,84,83,69,82,73,69,83,41,32,116,111,32,99,104,101,99,107,32,66,73,78,68,73,78,71,32,101,116,99,0
+L1146: 27
+ byte(7)32,32,32,32,32,32,33,42,82,65,73,83,69,32,104,97,115,32,98,101,101,110,32,115,101,116,32,84,0
+L1147: 49
+ byte(7)77,73,78,73,45,80,83,76,58,32,65,32,82,101,97,100,45,69,118,97,108,45,80,114,105,110,116,32,76,111,111,112,44,32,116,101,114,109,105,110,97,116,101,32,119,105,116,104,32,81,0
+ 0
+; (!*ENTRY FIRSTCALL EXPR 0)
+L1148: intern L1148
+ ADJSP 15,3
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ HRRZI 12,351
+ SETZM 13
+ PUSHJ 15,SYMFNC+351
+ HRRZI 12,348
+ SETZM 13
+ PUSHJ 15,SYMFNC+348
+ HRRZI 12,309
+ SETZM 13
+ PUSHJ 15,SYMFNC+309
+ MOVE 1,L1135
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1136
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1137
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,0
+ MOVEM 1,SYMVAL+195
+ HRRZI 12,190
+ SETZM 13
+ PUSHJ 15,SYMFNC+190
+ MOVE 1,SYMVAL+84
+ MOVEM 1,SYMVAL+191
+ HRRZI 1,26
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,SYMVAL+375
+ SETZM -2(15)
+ MOVE 1,L1138
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,374
+ SETZM 13
+ PUSHJ 15,SYMFNC+374
+L1149: CAME 0,-1(15)
+ JRST L1150
+ AOS -2(15)
+ MOVE 1,-2(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1139
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ MOVEM 1,0(15)
+ CAME 1,L1140
+ JRST L1151
+ MOVE 6,SYMVAL+84
+ MOVEM 6,-1(15)
+ JRST L1149
+L1151: CAME 1,SYMVAL+375
+ JRST L1152
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1141
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ JRST L1149
+L1152: HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,0(15)
+ HRRZI 12,254
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+254
+ MOVEM 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ JRST L1149
+L1150: HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L1141: <4_31>+L1142
+L1140: <30_31>+81
+L1139: <4_31>+L1143
+L1138: <4_31>+L1144
+L1137: <4_31>+L1145
+L1136: <4_31>+L1146
+L1135: <4_31>+L1147
+; (!*ENTRY TESTSERIES EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK BINDINGTEST EXPR 0)
+; (HRRZI (REG LINKREG) 376)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY BINDINGTEST))
+; (!*LINK INTERPTEST EXPR 0)
+; (HRRZI (REG LINKREG) 377)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INTERPTEST))
+; (!*LINK COMPBINDTEST EXPR 0)
+; (HRRZI (REG LINKREG) 378)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY COMPBINDTEST))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TESTSERIES EXPR 0)
+L1153: intern L1153
+ HRRZI 12,376
+ SETZM 13
+ PUSHJ 15,SYMFNC+376
+ HRRZI 12,377
+ SETZM 13
+ PUSHJ 15,SYMFNC+377
+ HRRZI 12,378
+ SETZM 13
+ PUSHJ 15,SYMFNC+378
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY BINDINGTEST EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Test BINDING Primitives") (REG 1))
+; (MOVE (REG 1) (QUOTE "Test BINDING Primitives"))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 366)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (WCONST 1) (!$FLUID AA))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID AA))
+; (!*MOVE (QUOTE AA) (REG 1))
+; (MOVE (REG 1) (QUOTE AA))
+; (!*LINK PBIND1 EXPR 1)
+; (HRRZI (REG LINKREG) 346)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PBIND1))
+; (!*MOVE (WCONST 3) (REG 2))
+; (HRRZI (REG 2) 3)
+; (!*MOVE (QUOTE AA) (REG 1))
+; (MOVE (REG 1) (QUOTE AA))
+; (!*LINK LBIND1 EXPR 2)
+; (HRRZI (REG LINKREG) 257)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LBIND1))
+; (!*MOVE (WCONST 3) (REG 3))
+; (HRRZI (REG 3) 3)
+; (!*MOVE (!$FLUID AA) (REG 2))
+; (MOVE (REG 2) (!$FLUID AA))
+; (!*MOVE (QUOTE "3rd bound AA") (REG 1))
+; (MOVE (REG 1) (QUOTE "3rd bound AA"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (WCONST 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*LINK UNBINDN EXPR 1)
+; (HRRZI (REG LINKREG) 168)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*MOVE (QUOTE NIL) (REG 3))
+; (MOVE (REG 3) (REG NIL))
+; (!*MOVE (!$FLUID AA) (REG 2))
+; (MOVE (REG 2) (!$FLUID AA))
+; (!*MOVE (QUOTE "2rd bound AA") (REG 1))
+; (MOVE (REG 1) (QUOTE "2rd bound AA"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (WCONST 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*LINK UNBINDN EXPR 1)
+; (HRRZI (REG LINKREG) 168)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*MOVE (WCONST 1) (REG 3))
+; (HRRZI (REG 3) 1)
+; (!*MOVE (!$FLUID AA) (REG 2))
+; (MOVE (REG 2) (!$FLUID AA))
+; (!*MOVE (QUOTE "Original AA") (REG 1))
+; (MOVE (REG 1) (QUOTE "Original AA"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1159: 10
+ byte(7)79,114,105,103,105,110,97,108,32,65,65,0
+L1160: 11
+ byte(7)50,114,100,32,98,111,117,110,100,32,65,65,0
+L1161: 11
+ byte(7)51,114,100,32,98,111,117,110,100,32,65,65,0
+L1162: 22
+ byte(7)84,101,115,116,32,66,73,78,68,73,78,71,32,80,114,105,109,105,116,105,118,101,115,0
+ 0
+; (!*ENTRY BINDINGTEST EXPR 0)
+L1163: intern L1163
+ MOVE 1,L1154
+ HRRZI 12,366
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+366
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+380
+ MOVE 1,L1155
+ HRRZI 12,346
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+346
+ HRRZI 2,3
+ MOVE 1,L1155
+ HRRZI 12,257
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+257
+ HRRZI 3,3
+ MOVE 2,SYMVAL+380
+ MOVE 1,L1156
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ HRRZI 1,1
+ HRRZI 12,168
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+168
+ MOVE 3,0
+ MOVE 2,SYMVAL+380
+ MOVE 1,L1157
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ HRRZI 1,1
+ HRRZI 12,168
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+168
+ HRRZI 3,1
+ MOVE 2,SYMVAL+380
+ MOVE 1,L1158
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 1,0
+ POPJ 15,0
+L1158: <4_31>+L1159
+L1157: <4_31>+L1160
+L1156: <4_31>+L1161
+L1155: <30_31>+380
+L1154: <4_31>+L1162
+; (!*ENTRY INTERPTEST EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "TEST of Interpreter Primitives for LAMBDA's ") (REG 1))
+; (MOVE (REG 1) (QUOTE "TEST of Interpreter Primitives for LAMBDA's "))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 366)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (QUOTE (LAMBDA (X1 X2) (PRINT (LIST (QUOTE LAMBDA1) X1 X2)) (QUOTE L1))) (!$GLOBAL LAMBDA1))
+; (MOVE (REG T1) (QUOTE (LAMBDA (X1 X2) (PRINT (LIST (QUOTE LAMBDA1) X1 X2)) (QUOTE L1))))
+; (MOVEM (REG T1) (!$GLOBAL LAMBDA1))
+; (!*MOVE (QUOTE (LAMBDA (Y1 Y2) (PRINT (LIST (QUOTE LAMBDA2) Y1 Y2)) (QUOTE L2))) (!$GLOBAL LAMBDA2))
+; (MOVE (REG T1) (QUOTE (LAMBDA (Y1 Y2) (PRINT (LIST (QUOTE LAMBDA2) Y1 Y2)) (QUOTE L2))))
+; (MOVEM (REG T1) (!$GLOBAL LAMBDA2))
+; (!*MOVE (QUOTE "LAMBDA1: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "LAMBDA1: "))
+; (!*LINK SPACED EXPR 1)
+; (HRRZI (REG LINKREG) 365)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY SPACED))
+; (!*MOVE (!$GLOBAL LAMBDA1) (REG 1))
+; (MOVE (REG 1) (!$GLOBAL LAMBDA1))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (QUOTE "FastLambdaApply on Lambda1") (REG 1))
+; (MOVE (REG 1) (QUOTE "FastLambdaApply on Lambda1"))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 366)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (!$GLOBAL LAMBDA1) (!$GLOBAL CODEFORM!*))
+; (MOVE (REG T1) (!$GLOBAL LAMBDA1))
+; (MOVEM (REG T1) (!$GLOBAL CODEFORM!*))
+; (!*MOVE (WCONST 20) (REG 2))
+; (HRRZI (REG 2) 20)
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINK FASTLAMBDAAPPLY EXPR 2)
+; (HRRZI (REG LINKREG) 247)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY FASTLAMBDAAPPLY))
+; (!*MOVE (QUOTE L1) (REG 3))
+; (MOVE (REG 3) (QUOTE L1))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE "FastLambdaApply") (REG 1))
+; (MOVE (REG 1) (QUOTE "FastLambdaApply"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE "Now Test FASTAPPLY") (REG 1))
+; (MOVE (REG 1) (QUOTE "Now Test FASTAPPLY"))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 366)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (QUOTE C1) (REG 3))
+; (MOVE (REG 3) (QUOTE C1))
+; (!*MOVE (QUOTE COMPILED1) (REG 2))
+; (MOVE (REG 2) (QUOTE COMPILED1))
+; (!*MOVE (QUOTE " Compiled ID 1 ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Compiled ID 1 "))
+; (!*LINK TESTAPPLY EXPR 3)
+; (HRRZI (REG LINKREG) 381)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TESTAPPLY))
+; (!*MOVE (QUOTE COMPILED2) (REG 1))
+; (MOVE (REG 1) (QUOTE COMPILED2))
+; (!*LINK GETFCODEPOINTER EXPR 1)
+; (HRRZI (REG LINKREG) 239)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GETFCODEPOINTER))
+; (!*MOVE (QUOTE C2) (REG 3))
+; (MOVE (REG 3) (QUOTE C2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE " CodePointer 2 ") (REG 1))
+; (MOVE (REG 1) (QUOTE " CodePointer 2 "))
+; (!*LINK TESTAPPLY EXPR 3)
+; (HRRZI (REG LINKREG) 381)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TESTAPPLY))
+; (!*MOVE (QUOTE L1) (REG 3))
+; (MOVE (REG 3) (QUOTE L1))
+; (!*MOVE (!$GLOBAL LAMBDA1) (REG 2))
+; (MOVE (REG 2) (!$GLOBAL LAMBDA1))
+; (!*MOVE (QUOTE " Lambda Expression 1 ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Lambda Expression 1 "))
+; (!*LINK TESTAPPLY EXPR 3)
+; (HRRZI (REG LINKREG) 381)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TESTAPPLY))
+; (!*MOVE (QUOTE "Test a compiled call on Interpreted code ") (REG 1))
+; (MOVE (REG 1) (QUOTE "Test a compiled call on Interpreted code "))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 366)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (QUOTE (LAMBDA (AG1 AG2 AG3) (PRINT (LIST (QUOTE INTERPRETED3) AG1 AG2 AG3)) (QUOTE L3))) (REG 3))
+; (MOVE (REG 3) (QUOTE (LAMBDA (AG1 AG2 AG3) (PRINT (LIST (QUOTE INTERPRETED3) AG1 AG2 AG3)) (QUOTE L3))))
+; (!*MOVE (QUOTE EXPR) (REG 2))
+; (MOVE (REG 2) (QUOTE EXPR))
+; (!*MOVE (QUOTE INTERPRETED3) (REG 1))
+; (MOVE (REG 1) (QUOTE INTERPRETED3))
+; (!*LINK PUTD EXPR 3)
+; (HRRZI (REG LINKREG) 291)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY PUTD))
+; (!*MOVE (QUOTE INTERPRETED3) (REG 1))
+; (MOVE (REG 1) (QUOTE INTERPRETED3))
+; (!*LINK FLAMBDALINKP EXPR 1)
+; (HRRZI (REG LINKREG) 234)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FLAMBDALINKP))
+; (!*MOVE (QUOTE T) (REG 3))
+; (MOVE (REG 3) (FLUID T))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE " FlambdaLinkP") (REG 1))
+; (MOVE (REG 1) (QUOTE " FlambdaLinkP"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (WCONST 320) (REG 3))
+; (HRRZI (REG 3) 320)
+; (!*MOVE (WCONST 310) (REG 2))
+; (HRRZI (REG 2) 310)
+; (!*MOVE (WCONST 300) (REG 1))
+; (HRRZI (REG 1) 300)
+; (!*LINK INTERPRETED3 EXPR 3)
+; (HRRZI (REG LINKREG) 382)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY INTERPRETED3))
+; (!*MOVE (QUOTE L3) (REG 3))
+; (MOVE (REG 3) (QUOTE L3))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE " Interp3") (REG 1))
+; (MOVE (REG 1) (QUOTE " Interp3"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (!$GLOBAL LAMBDA2) (REG 3))
+; (MOVE (REG 3) (!$GLOBAL LAMBDA2))
+; (!*MOVE (QUOTE EXPR) (REG 2))
+; (MOVE (REG 2) (QUOTE EXPR))
+; (!*MOVE (QUOTE INTERPRETED2) (REG 1))
+; (MOVE (REG 1) (QUOTE INTERPRETED2))
+; (!*LINK PUTD EXPR 3)
+; (HRRZI (REG LINKREG) 291)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY PUTD))
+; (!*MOVE (QUOTE L2) (REG 3))
+; (MOVE (REG 3) (QUOTE L2))
+; (!*MOVE (QUOTE INTERPRETED2) (REG 2))
+; (MOVE (REG 2) (QUOTE INTERPRETED2))
+; (!*MOVE (QUOTE " Interpreted ID 2 ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Interpreted ID 2 "))
+; (!*LINK TESTAPPLY EXPR 3)
+; (HRRZI (REG LINKREG) 381)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TESTAPPLY))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1189: 17
+ byte(7)32,73,110,116,101,114,112,114,101,116,101,100,32,73,68,32,50,32,0
+L1190: 7
+ byte(7)32,73,110,116,101,114,112,51,0
+L1191: 12
+ byte(7)32,70,108,97,109,98,100,97,76,105,110,107,80,0
+L1192: <30_31>+248
+ <9_31>+L1204
+L1193: 40
+ byte(7)84,101,115,116,32,97,32,99,111,109,112,105,108,101,100,32,99,97,108,108,32,111,110,32,73,110,116,101,114,112,114,101,116,101,100,32,99,111,100,101,32,0
+L1194: 20
+ byte(7)32,76,97,109,98,100,97,32,69,120,112,114,101,115,115,105,111,110,32,49,32,0
+L1195: 14
+ byte(7)32,67,111,100,101,80,111,105,110,116,101,114,32,50,32,0
+L1196: 14
+ byte(7)32,67,111,109,112,105,108,101,100,32,73,68,32,49,32,0
+L1197: 17
+ byte(7)78,111,119,32,84,101,115,116,32,70,65,83,84,65,80,80,76,89,0
+L1198: 14
+ byte(7)70,97,115,116,76,97,109,98,100,97,65,112,112,108,121,0
+L1199: 25
+ byte(7)70,97,115,116,76,97,109,98,100,97,65,112,112,108,121,32,111,110,32,76,97,109,98,100,97,49,0
+L1200: 8
+ byte(7)76,65,77,66,68,65,49,58,32,0
+L1201: <30_31>+248
+ <9_31>+L1205
+L1202: <30_31>+248
+ <9_31>+L1206
+L1203: 43
+ byte(7)84,69,83,84,32,111,102,32,73,110,116,101,114,112,114,101,116,101,114,32,80,114,105,109,105,116,105,118,101,115,32,102,111,114,32,76,65,77,66,68,65,39,115,32,0
+L1204: <9_31>+L1207
+ <9_31>+L1208
+L1205: <9_31>+L1209
+ <9_31>+L1210
+L1206: <9_31>+L1211
+ <9_31>+L1212
+L1207: <30_31>+383
+ <9_31>+L1213
+L1208: <9_31>+L1214
+ <9_31>+L1215
+L1209: <30_31>+384
+ <9_31>+L1216
+L1210: <9_31>+L1217
+ <9_31>+L1218
+L1211: <30_31>+385
+ <9_31>+L1219
+L1212: <9_31>+L1220
+ <9_31>+L1221
+L1213: <30_31>+386
+ <9_31>+L1222
+L1214: <30_31>+140
+ <9_31>+L1223
+L1215: <9_31>+L1224
+ <30_31>+128
+L1216: <30_31>+387
+ <30_31>+128
+L1217: <30_31>+140
+ <9_31>+L1225
+L1218: <9_31>+L1226
+ <30_31>+128
+L1219: <30_31>+388
+ <30_31>+128
+L1220: <30_31>+140
+ <9_31>+L1227
+L1221: <9_31>+L1228
+ <30_31>+128
+L1222: <30_31>+389
+ <30_31>+128
+L1223: <9_31>+L1229
+ <30_31>+128
+L1224: <30_31>+223
+ <9_31>+L1230
+L1225: <9_31>+L1231
+ <30_31>+128
+L1226: <30_31>+223
+ <9_31>+L1232
+L1227: <9_31>+L1233
+ <30_31>+128
+L1228: <30_31>+223
+ <9_31>+L1234
+L1229: <30_31>+300
+ <9_31>+L1235
+L1230: <30_31>+390
+ <30_31>+128
+L1231: <30_31>+300
+ <9_31>+L1236
+L1232: <30_31>+391
+ <30_31>+128
+L1233: <30_31>+300
+ <9_31>+L1237
+L1234: <30_31>+392
+ <30_31>+128
+L1235: <9_31>+L1238
+ <9_31>+L1207
+L1236: <9_31>+L1239
+ <9_31>+L1209
+L1237: <9_31>+L1240
+ <9_31>+L1211
+L1238: <30_31>+223
+ <9_31>+L1241
+L1239: <30_31>+223
+ <9_31>+L1242
+L1240: <30_31>+223
+ <9_31>+L1243
+L1241: <30_31>+382
+ <30_31>+128
+L1242: <30_31>+393
+ <30_31>+128
+L1243: <30_31>+394
+ <30_31>+128
+ 0
+; (!*ENTRY INTERPTEST EXPR 0)
+L1244: intern L1244
+ MOVE 1,L1164
+ HRRZI 12,366
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+366
+ MOVE 6,L1165
+ MOVEM 6,SYMVAL+394
+ MOVE 6,L1166
+ MOVEM 6,SYMVAL+393
+ MOVE 1,L1167
+ HRRZI 12,365
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+365
+ MOVE 1,SYMVAL+394
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,L1168
+ HRRZI 12,366
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+366
+ MOVE 6,SYMVAL+394
+ MOVEM 6,SYMVAL+243
+ HRRZI 2,20
+ HRRZI 1,10
+ HRRZI 12,247
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+247
+ MOVE 3,L1169
+ MOVE 2,1
+ MOVE 1,L1170
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 1,L1171
+ HRRZI 12,366
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+366
+ MOVE 3,L1172
+ MOVE 2,L1173
+ MOVE 1,L1174
+ HRRZI 12,381
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+381
+ MOVE 1,L1175
+ HRRZI 12,239
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+239
+ MOVE 3,L1176
+ MOVE 2,1
+ MOVE 1,L1177
+ HRRZI 12,381
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+381
+ MOVE 3,L1169
+ MOVE 2,SYMVAL+394
+ MOVE 1,L1178
+ HRRZI 12,381
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+381
+ MOVE 1,L1179
+ HRRZI 12,366
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+366
+ MOVE 3,L1180
+ MOVE 2,L1181
+ MOVE 1,L1182
+ HRRZI 12,291
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+291
+ MOVE 1,L1182
+ HRRZI 12,234
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,SYMVAL+84
+ MOVE 2,1
+ MOVE 1,L1183
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ HRRZI 3,320
+ HRRZI 2,310
+ HRRZI 1,300
+ HRRZI 12,382
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+382
+ MOVE 3,L1184
+ MOVE 2,1
+ MOVE 1,L1185
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,SYMVAL+393
+ MOVE 2,L1181
+ MOVE 1,L1186
+ HRRZI 12,291
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+291
+ MOVE 3,L1187
+ MOVE 2,L1186
+ MOVE 1,L1188
+ HRRZI 12,381
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+381
+ MOVE 1,0
+ POPJ 15,0
+L1188: <4_31>+L1189
+L1187: <30_31>+391
+L1186: <30_31>+395
+L1185: <4_31>+L1190
+L1184: <30_31>+390
+L1183: <4_31>+L1191
+L1182: <30_31>+382
+L1181: <30_31>+293
+L1180: <9_31>+L1192
+L1179: <4_31>+L1193
+L1178: <4_31>+L1194
+L1177: <4_31>+L1195
+L1176: <30_31>+396
+L1175: <30_31>+397
+L1174: <4_31>+L1196
+L1173: <30_31>+398
+L1172: <30_31>+399
+L1171: <4_31>+L1197
+L1170: <4_31>+L1198
+L1169: <30_31>+392
+L1168: <4_31>+L1199
+L1167: <4_31>+L1200
+L1166: <9_31>+L1201
+L1165: <9_31>+L1202
+L1164: <4_31>+L1203
+; (!*ENTRY TESTFASTAPPLY EXPR 0)
+; (!*MOVE (FLUID TESTCODE!*) (REG T1))
+; (MOVE (REG T1) (FLUID TESTCODE!*))
+; (!*JCALL FASTAPPLY)
+; (JRST (ENTRY FASTAPPLY))
+ 0
+; (!*ENTRY TESTFASTAPPLY EXPR 0)
+L1245: intern L1245
+ MOVE 6,SYMVAL+401
+ JRST SYMFNC+246
+; (!*ENTRY TESTAPPLY EXPR 3)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE " Testapply case ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Testapply case "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " given ") (REG 1))
+; (MOVE (REG 1) (QUOTE " given "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (FRAME 2) (!$FLUID TESTCODE!*))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (MOVEM (REG T1) (!$FLUID TESTCODE!*))
+; (!*MOVE (QUOTE B) (REG 2))
+; (MOVE (REG 2) (QUOTE B))
+; (!*MOVE (QUOTE A) (REG 1))
+; (MOVE (REG 1) (QUOTE A))
+; (!*LINK TESTFASTAPPLY EXPR 2)
+; (HRRZI (REG LINKREG) 400)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY TESTFASTAPPLY))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 3) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (QUOTE " answer") (REG 1))
+; (MOVE (REG 1) (QUOTE " answer"))
+; (!*LINKE 4 SHOULDBE EXPR 3)
+; (ADJSP (REG ST) (MINUS 4))
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY SHOULDBE))
+L1251: 7
+ byte(7)32,32,97,110,115,119,101,114,0
+L1252: 6
+ byte(7)32,103,105,118,101,110,32,0
+L1253: 17
+ byte(7)32,32,32,84,101,115,116,97,112,112,108,121,32,99,97,115,101,32,0
+ 3
+; (!*ENTRY TESTAPPLY EXPR 3)
+L1254: intern L1254
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 1,L1246
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1247
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ MOVE 6,-1(15)
+ MOVEM 6,SYMVAL+401
+ MOVE 2,L1248
+ MOVE 1,L1249
+ HRRZI 12,400
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+400
+ MOVEM 1,-3(15)
+ MOVE 3,-2(15)
+ MOVE 2,1
+ MOVE 1,L1250
+ ADJSP 15,-4
+ HRRZI 12,368
+ HRRZI 13,3
+ JRST SYMFNC+368
+L1250: <4_31>+L1251
+L1249: <30_31>+65
+L1248: <30_31>+66
+L1247: <4_31>+L1252
+L1246: <4_31>+L1253
+; (!*ENTRY COMPILED1 EXPR 2)
+; (!*PUSH (REG 2))
+; (PUSH (REG ST) (REG 2))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE " Compiled1(") (REG 1))
+; (MOVE (REG 1) (QUOTE " Compiled1("))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE ")") (REG 1))
+; (MOVE (REG 1) (QUOTE ")"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE C1) (REG 1))
+; (MOVE (REG 1) (QUOTE C1))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+L1259: 0
+ byte(7)41,0
+L1260: 0
+ byte(7)32,0
+L1261: 14
+ byte(7)32,32,32,32,32,67,111,109,112,105,108,101,100,49,40,0
+ 2
+; (!*ENTRY COMPILED1 EXPR 2)
+L1262: intern L1262
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 1,L1255
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1256
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1257
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1258
+ ADJSP 15,-2
+ POPJ 15,0
+L1258: <30_31>+399
+L1257: <4_31>+L1259
+L1256: <4_31>+L1260
+L1255: <4_31>+L1261
+; (!*ENTRY COMPILED2 EXPR 2)
+; (!*PUSH (REG 2))
+; (PUSH (REG ST) (REG 2))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE " Compiled2(") (REG 1))
+; (MOVE (REG 1) (QUOTE " Compiled2("))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE ")") (REG 1))
+; (MOVE (REG 1) (QUOTE ")"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE C2) (REG 1))
+; (MOVE (REG 1) (QUOTE C2))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+L1267: 0
+ byte(7)41,0
+L1268: 0
+ byte(7)32,0
+L1269: 14
+ byte(7)32,32,32,32,32,67,111,109,112,105,108,101,100,50,40,0
+ 2
+; (!*ENTRY COMPILED2 EXPR 2)
+L1270: intern L1270
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 1,L1263
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1264
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1265
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1266
+ ADJSP 15,-2
+ POPJ 15,0
+L1266: <30_31>+396
+L1265: <4_31>+L1267
+L1264: <4_31>+L1268
+L1263: <4_31>+L1269
+; (!*ENTRY COMPBINDTEST EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Test LAMBIND and PROGBIND in compiled code") (REG 1))
+; (MOVE (REG 1) (QUOTE "Test LAMBIND and PROGBIND in compiled code"))
+; (!*LINK DASHED EXPR 1)
+; (HRRZI (REG LINKREG) 366)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DASHED))
+; (!*MOVE (QUOTE TOP1) (!$FLUID CFL1))
+; (MOVE (REG T1) (QUOTE TOP1))
+; (MOVEM (REG T1) (!$FLUID CFL1))
+; (!*MOVE (QUOTE TOP2) (!$FLUID CFL2))
+; (MOVE (REG T1) (QUOTE TOP2))
+; (MOVEM (REG T1) (!$FLUID CFL2))
+; (!*MOVE (QUOTE MID2) (REG 3))
+; (MOVE (REG 3) (QUOTE MID2))
+; (!*MOVE (QUOTE MID1) (REG 2))
+; (MOVE (REG 2) (QUOTE MID1))
+; (!*MOVE (QUOTE MID0) (REG 1))
+; (MOVE (REG 1) (QUOTE MID0))
+; (!*LINK CBIND1 EXPR 3)
+; (HRRZI (REG LINKREG) 402)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY CBIND1))
+; (!*MOVE (QUOTE TOP1) (REG 3))
+; (MOVE (REG 3) (QUOTE TOP1))
+; (!*MOVE (!$FLUID CFL1) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL1))
+; (!*MOVE (QUOTE "CFL1") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL1"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE TOP2) (REG 3))
+; (MOVE (REG 3) (QUOTE TOP2))
+; (!*MOVE (!$FLUID CFL2) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL2))
+; (!*MOVE (QUOTE "CFL2") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL2"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1279: 3
+ byte(7)67,70,76,50,0
+L1280: 3
+ byte(7)67,70,76,49,0
+L1281: 41
+ byte(7)84,101,115,116,32,76,65,77,66,73,78,68,32,97,110,100,32,80,82,79,71,66,73,78,68,32,105,110,32,99,111,109,112,105,108,101,100,32,99,111,100,101,0
+ 0
+; (!*ENTRY COMPBINDTEST EXPR 0)
+L1282: intern L1282
+ MOVE 1,L1271
+ HRRZI 12,366
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+366
+ MOVE 6,L1272
+ MOVEM 6,SYMVAL+403
+ MOVE 6,L1273
+ MOVEM 6,SYMVAL+404
+ MOVE 3,L1274
+ MOVE 2,L1275
+ MOVE 1,L1276
+ HRRZI 12,402
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+402
+ MOVE 3,L1272
+ MOVE 2,SYMVAL+403
+ MOVE 1,L1277
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1273
+ MOVE 2,SYMVAL+404
+ MOVE 1,L1278
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 1,0
+ POPJ 15,0
+L1278: <4_31>+L1279
+L1277: <4_31>+L1280
+L1276: <30_31>+405
+L1275: <30_31>+406
+L1274: <30_31>+407
+L1273: <30_31>+408
+L1272: <30_31>+409
+L1271: <4_31>+L1281
+; (!*ENTRY CBIND1 EXPR 3)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LAMBIND (REGISTERS (REG 3) (REG 2)) (NONLOCALVARS (!$FLUID CFL2) (!$FLUID CFL1)))
+; (MOVEM (REG 3) (INDIRECT (FLUID LAMBINDARGS!*)))
+; (MOVE (REG 3) (FLUID LAMBINDARGS!*))
+; (MOVEM (REG 2) (INDEXED (REG 3) 1))
+; (MOVE (REG 1) (QUOTE [CFL2 CFL1]))
+; (PUSHJ (REG ST) (ENTRY LAMBIND))
+; (!*MOVE (QUOTE MID0) (REG 3))
+; (MOVE (REG 3) (QUOTE MID0))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE "x ") (REG 1))
+; (MOVE (REG 1) (QUOTE "x "))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE MID1) (REG 3))
+; (MOVE (REG 3) (QUOTE MID1))
+; (!*MOVE (!$FLUID CFL1) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL1))
+; (!*MOVE (QUOTE "CFL1") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL1"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE MID2) (REG 3))
+; (MOVE (REG 3) (QUOTE MID2))
+; (!*MOVE (!$FLUID CFL2) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL2))
+; (!*MOVE (QUOTE "CFL2") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL2"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*LINK CBIND2 EXPR 0)
+; (HRRZI (REG LINKREG) 410)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY CBIND2))
+; (!*MOVE (QUOTE BOT1) (REG 3))
+; (MOVE (REG 3) (QUOTE BOT1))
+; (!*MOVE (!$FLUID CFL1) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL1))
+; (!*MOVE (QUOTE "CFL1") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL1"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE MID2) (REG 3))
+; (MOVE (REG 3) (QUOTE MID2))
+; (!*MOVE (!$FLUID CFL2) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL2))
+; (!*MOVE (QUOTE "CFL2") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL2"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*FREERSTR (NONLOCALVARS (!$FLUID CFL2) (!$FLUID CFL1)))
+; (HRRZI (REG 1) 2)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+L1291: 3
+ byte(7)67,70,76,50,0
+L1292: 3
+ byte(7)67,70,76,49,0
+L1293: 3
+ byte(7)120,32,32,32,0
+L1294: 1
+ <30_31>+404
+ <30_31>+403
+ 3
+; (!*ENTRY CBIND1 EXPR 3)
+CBIND1: intern CBIND1
+ PUSH 15,1
+ MOVEM 3,@SYMVAL+166
+ MOVE 3,SYMVAL+166
+ MOVEM 2,1(3)
+ MOVE 1,L1283
+ PUSHJ 15,SYMFNC+167
+ MOVE 3,L1284
+ MOVE 2,0(15)
+ MOVE 1,L1285
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1286
+ MOVE 2,SYMVAL+403
+ MOVE 1,L1287
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1288
+ MOVE 2,SYMVAL+404
+ MOVE 1,L1289
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ HRRZI 12,410
+ SETZM 13
+ PUSHJ 15,SYMFNC+410
+ MOVE 3,L1290
+ MOVE 2,SYMVAL+403
+ MOVE 1,L1287
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1288
+ MOVE 2,SYMVAL+404
+ MOVE 1,L1289
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 1,0
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+168
+ ADJSP 15,-1
+ POPJ 15,0
+L1290: <30_31>+411
+L1289: <4_31>+L1291
+L1288: <30_31>+407
+L1287: <4_31>+L1292
+L1286: <30_31>+406
+L1285: <4_31>+L1293
+L1284: <30_31>+405
+L1283: <8_31>+L1294
+; (!*ENTRY CBIND2 EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE MID1) (REG 3))
+; (MOVE (REG 3) (QUOTE MID1))
+; (!*MOVE (!$FLUID CFL1) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL1))
+; (!*MOVE (QUOTE "CFL1") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL1"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE MID2) (REG 3))
+; (MOVE (REG 3) (QUOTE MID2))
+; (!*MOVE (!$FLUID CFL2) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL2))
+; (!*MOVE (QUOTE "CFL2") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL2"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*PROGBIND (NONLOCALVARS (!$FLUID CFL2)))
+; (MOVE (REG 1) (QUOTE CFL2))
+; (PUSHJ (REG ST) (ENTRY PBIND1))
+; (!*MOVE (QUOTE BOT1) (!$FLUID CFL1))
+; (MOVE (REG T1) (QUOTE BOT1))
+; (MOVEM (REG T1) (!$FLUID CFL1))
+; (!*MOVE (QUOTE BOT2) (!$FLUID CFL2))
+; (MOVE (REG T1) (QUOTE BOT2))
+; (MOVEM (REG T1) (!$FLUID CFL2))
+; (!*MOVE (QUOTE BOT1) (REG 3))
+; (MOVE (REG 3) (QUOTE BOT1))
+; (!*MOVE (!$FLUID CFL1) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL1))
+; (!*MOVE (QUOTE "CFL1") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL1"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE BOT2) (REG 3))
+; (MOVE (REG 3) (QUOTE BOT2))
+; (!*MOVE (!$FLUID CFL2) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL2))
+; (!*MOVE (QUOTE "CFL2") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL2"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*FREERSTR (NONLOCALVARS (!$FLUID CFL2)))
+; (HRRZI (REG 1) 1)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*MOVE (QUOTE BOT1) (REG 3))
+; (MOVE (REG 3) (QUOTE BOT1))
+; (!*MOVE (!$FLUID CFL1) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL1))
+; (!*MOVE (QUOTE "CFL1") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL1"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE MID2) (REG 3))
+; (MOVE (REG 3) (QUOTE MID2))
+; (!*MOVE (!$FLUID CFL2) (REG 2))
+; (MOVE (REG 2) (!$FLUID CFL2))
+; (!*MOVE (QUOTE "CFL2") (REG 1))
+; (MOVE (REG 1) (QUOTE "CFL2"))
+; (!*LINK SHOULDBE EXPR 3)
+; (HRRZI (REG LINKREG) 368)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SHOULDBE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1302: 3
+ byte(7)67,70,76,50,0
+L1303: 3
+ byte(7)67,70,76,49,0
+ 0
+; (!*ENTRY CBIND2 EXPR 0)
+CBIND2: intern CBIND2
+ MOVE 3,L1295
+ MOVE 2,SYMVAL+403
+ MOVE 1,L1296
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1297
+ MOVE 2,SYMVAL+404
+ MOVE 1,L1298
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 1,L1299
+ PUSHJ 15,SYMFNC+346
+ MOVE 6,L1300
+ MOVEM 6,SYMVAL+403
+ MOVE 6,L1301
+ MOVEM 6,SYMVAL+404
+ MOVE 3,L1300
+ MOVE 2,SYMVAL+403
+ MOVE 1,L1296
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1301
+ MOVE 2,SYMVAL+404
+ MOVE 1,L1298
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ HRRZI 1,1
+ PUSHJ 15,SYMFNC+168
+ MOVE 3,L1300
+ MOVE 2,SYMVAL+403
+ MOVE 1,L1296
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 3,L1297
+ MOVE 2,SYMVAL+404
+ MOVE 1,L1298
+ HRRZI 12,368
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+368
+ MOVE 1,0
+ POPJ 15,0
+L1301: <30_31>+412
+L1300: <30_31>+411
+L1299: <30_31>+404
+L1298: <4_31>+L1302
+L1297: <30_31>+407
+L1296: <4_31>+L1303
+L1295: <30_31>+406
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L1304: intern L1304
+ HRRZI 1,15
+ HRRZI 12,176
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+176
+ MOVEM 1,SYMVAL+166
+ POPJ 15,0
+ extern SYMVAL
+ extern SYMPRP
+ extern SYMNAM
+L1305: 0
+ byte(7)0,0
+ intern L1305
+L1306: 0
+ byte(7)1,0
+ intern L1306
+L1307: 0
+ byte(7)2,0
+ intern L1307
+L1308: 0
+ byte(7)3,0
+ intern L1308
+L1309: 0
+ byte(7)4,0
+ intern L1309
+L1310: 0
+ byte(7)5,0
+ intern L1310
+L1311: 0
+ byte(7)6,0
+ intern L1311
+L1312: 0
+ byte(7)7,0
+ intern L1312
+L1313: 0
+ byte(7)8,0
+ intern L1313
+L1314: 0
+ byte(7)9,0
+ intern L1314
+L1315: 0
+ byte(7)10,0
+ intern L1315
+L1316: 0
+ byte(7)11,0
+ intern L1316
+L1317: 0
+ byte(7)12,0
+ intern L1317
+L1318: 0
+ byte(7)13,0
+ intern L1318
+L1319: 0
+ byte(7)14,0
+ intern L1319
+L1320: 0
+ byte(7)15,0
+ intern L1320
+L1321: 0
+ byte(7)16,0
+ intern L1321
+L1322: 0
+ byte(7)17,0
+ intern L1322
+L1323: 0
+ byte(7)18,0
+ intern L1323
+L1324: 0
+ byte(7)19,0
+ intern L1324
+L1325: 0
+ byte(7)20,0
+ intern L1325
+L1326: 0
+ byte(7)21,0
+ intern L1326
+L1327: 0
+ byte(7)22,0
+ intern L1327
+L1328: 0
+ byte(7)23,0
+ intern L1328
+L1329: 0
+ byte(7)24,0
+ intern L1329
+L1330: 0
+ byte(7)25,0
+ intern L1330
+L1331: 0
+ byte(7)26,0
+ intern L1331
+L1332: 0
+ byte(7)27,0
+ intern L1332
+L1333: 0
+ byte(7)28,0
+ intern L1333
+L1334: 0
+ byte(7)29,0
+ intern L1334
+L1335: 0
+ byte(7)30,0
+ intern L1335
+L1336: 0
+ byte(7)31,0
+ intern L1336
+L1337: 0
+ byte(7)32,0
+ intern L1337
+L1338: 0
+ byte(7)33,0
+ intern L1338
+L1339: 0
+ byte(7)34,0
+ intern L1339
+L1340: 0
+ byte(7)35,0
+ intern L1340
+L1341: 0
+ byte(7)36,0
+ intern L1341
+L1342: 0
+ byte(7)37,0
+ intern L1342
+L1343: 0
+ byte(7)38,0
+ intern L1343
+L1344: 0
+ byte(7)39,0
+ intern L1344
+L1345: 0
+ byte(7)40,0
+ intern L1345
+L1346: 0
+ byte(7)41,0
+ intern L1346
+L1347: 0
+ byte(7)42,0
+ intern L1347
+L1348: 0
+ byte(7)43,0
+ intern L1348
+L1349: 0
+ byte(7)44,0
+ intern L1349
+L1350: 0
+ byte(7)45,0
+ intern L1350
+L1351: 0
+ byte(7)46,0
+ intern L1351
+L1352: 0
+ byte(7)47,0
+ intern L1352
+L1353: 0
+ byte(7)48,0
+ intern L1353
+L1354: 0
+ byte(7)49,0
+ intern L1354
+L1355: 0
+ byte(7)50,0
+ intern L1355
+L1356: 0
+ byte(7)51,0
+ intern L1356
+L1357: 0
+ byte(7)52,0
+ intern L1357
+L1358: 0
+ byte(7)53,0
+ intern L1358
+L1359: 0
+ byte(7)54,0
+ intern L1359
+L1360: 0
+ byte(7)55,0
+ intern L1360
+L1361: 0
+ byte(7)56,0
+ intern L1361
+L1362: 0
+ byte(7)57,0
+ intern L1362
+L1363: 0
+ byte(7)58,0
+ intern L1363
+L1364: 0
+ byte(7)59,0
+ intern L1364
+L1365: 0
+ byte(7)60,0
+ intern L1365
+L1366: 0
+ byte(7)61,0
+ intern L1366
+L1367: 0
+ byte(7)62,0
+ intern L1367
+L1368: 0
+ byte(7)63,0
+ intern L1368
+L1369: 0
+ byte(7)64,0
+ intern L1369
+L1370: 0
+ byte(7)65,0
+ intern L1370
+L1371: 0
+ byte(7)66,0
+ intern L1371
+L1372: 0
+ byte(7)67,0
+ intern L1372
+L1373: 0
+ byte(7)68,0
+ intern L1373
+L1374: 0
+ byte(7)69,0
+ intern L1374
+L1375: 0
+ byte(7)70,0
+ intern L1375
+L1376: 0
+ byte(7)71,0
+ intern L1376
+L1377: 0
+ byte(7)72,0
+ intern L1377
+L1378: 0
+ byte(7)73,0
+ intern L1378
+L1379: 0
+ byte(7)74,0
+ intern L1379
+L1380: 0
+ byte(7)75,0
+ intern L1380
+L1381: 0
+ byte(7)76,0
+ intern L1381
+L1382: 0
+ byte(7)77,0
+ intern L1382
+L1383: 0
+ byte(7)78,0
+ intern L1383
+L1384: 0
+ byte(7)79,0
+ intern L1384
+L1385: 0
+ byte(7)80,0
+ intern L1385
+L1386: 0
+ byte(7)81,0
+ intern L1386
+L1387: 0
+ byte(7)82,0
+ intern L1387
+L1388: 0
+ byte(7)83,0
+ intern L1388
+L1389: 0
+ byte(7)84,0
+ intern L1389
+L1390: 0
+ byte(7)85,0
+ intern L1390
+L1391: 0
+ byte(7)86,0
+ intern L1391
+L1392: 0
+ byte(7)87,0
+ intern L1392
+L1393: 0
+ byte(7)88,0
+ intern L1393
+L1394: 0
+ byte(7)89,0
+ intern L1394
+L1395: 0
+ byte(7)90,0
+ intern L1395
+L1396: 0
+ byte(7)91,0
+ intern L1396
+L1397: 0
+ byte(7)92,0
+ intern L1397
+L1398: 0
+ byte(7)93,0
+ intern L1398
+L1399: 0
+ byte(7)94,0
+ intern L1399
+L1400: 0
+ byte(7)95,0
+ intern L1400
+L1401: 0
+ byte(7)96,0
+ intern L1401
+L1402: 0
+ byte(7)97,0
+ intern L1402
+L1403: 0
+ byte(7)98,0
+ intern L1403
+L1404: 0
+ byte(7)99,0
+ intern L1404
+L1405: 0
+ byte(7)100,0
+ intern L1405
+L1406: 0
+ byte(7)101,0
+ intern L1406
+L1407: 0
+ byte(7)102,0
+ intern L1407
+L1408: 0
+ byte(7)103,0
+ intern L1408
+L1409: 0
+ byte(7)104,0
+ intern L1409
+L1410: 0
+ byte(7)105,0
+ intern L1410
+L1411: 0
+ byte(7)106,0
+ intern L1411
+L1412: 0
+ byte(7)107,0
+ intern L1412
+L1413: 0
+ byte(7)108,0
+ intern L1413
+L1414: 0
+ byte(7)109,0
+ intern L1414
+L1415: 0
+ byte(7)110,0
+ intern L1415
+L1416: 0
+ byte(7)111,0
+ intern L1416
+L1417: 0
+ byte(7)112,0
+ intern L1417
+L1418: 0
+ byte(7)113,0
+ intern L1418
+L1419: 0
+ byte(7)114,0
+ intern L1419
+L1420: 0
+ byte(7)115,0
+ intern L1420
+L1421: 0
+ byte(7)116,0
+ intern L1421
+L1422: 0
+ byte(7)117,0
+ intern L1422
+L1423: 0
+ byte(7)118,0
+ intern L1423
+L1424: 0
+ byte(7)119,0
+ intern L1424
+L1425: 0
+ byte(7)120,0
+ intern L1425
+L1426: 0
+ byte(7)121,0
+ intern L1426
+L1427: 0
+ byte(7)122,0
+ intern L1427
+L1428: 0
+ byte(7)123,0
+ intern L1428
+L1429: 0
+ byte(7)124,0
+ intern L1429
+L1430: 0
+ byte(7)125,0
+ intern L1430
+L1431: 0
+ byte(7)126,0
+ intern L1431
+L1432: 0
+ byte(7)127,0
+ intern L1432
+L1433: 2
+ byte(7)78,73,76,0
+ intern L1433
+L1434: 6
+ byte(7)80,82,73,78,49,73,68,0
+ intern L1434
+L1435: 7
+ byte(7)80,82,73,78,49,73,78,84,0
+ intern L1435
+L1436: 10
+ byte(7)80,82,73,78,49,83,84,82,73,78,71,0
+ intern L1436
+L1437: 8
+ byte(7)80,82,73,78,49,80,65,73,82,0
+ intern L1437
+L1438: 5
+ byte(7)80,82,84,73,84,77,0
+ intern L1438
+L1439: 4
+ byte(7)80,82,73,78,49,0
+ intern L1439
+L1440: 6
+ byte(7)80,82,73,78,50,73,68,0
+ intern L1440
+L1441: 10
+ byte(7)80,82,73,78,50,83,84,82,73,78,71,0
+ intern L1441
+L1442: 8
+ byte(7)80,82,73,78,50,80,65,73,82,0
+ intern L1442
+L1443: 4
+ byte(7)80,82,73,78,50,0
+ intern L1443
+L1444: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L1444
+L1445: 4
+ byte(7)80,82,73,78,84,0
+ intern L1445
+L1446: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L1446
+L1447: 3
+ byte(7)80,85,84,67,0
+ intern L1447
+L1448: 5
+ byte(7)80,66,76,65,78,75,0
+ intern L1448
+L1449: 8
+ byte(7)80,82,73,78,49,73,78,84,88,0
+ intern L1449
+L1450: 6
+ byte(7)76,79,78,71,68,73,86,0
+ intern L1450
+L1451: 12
+ byte(7)76,79,78,71,82,69,77,65,73,78,68,69,82,0
+ intern L1451
+L1452: 3
+ byte(7)66,89,84,69,0
+ intern L1452
+L1453: 3
+ byte(7)81,85,73,84,0
+ intern L1453
+L1454: 4
+ byte(7)69,82,82,79,82,0
+ intern L1454
+L1455: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L1455
+L1456: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,72,65,82,0
+ intern L1456
+L1457: 19
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,87,82,73,84,69,67,72,65,82,0
+ intern L1457
+L1458: 8
+ byte(7)87,82,73,84,69,67,72,65,82,0
+ intern L1458
+L1459: 3
+ byte(7)79,85,84,42,0
+ intern L1459
+L1460: 10
+ byte(7)69,82,82,79,82,72,69,65,68,69,82,0
+ intern L1460
+L1461: 11
+ byte(7)69,82,82,79,82,84,82,65,73,76,69,82,0
+ intern L1461
+L1462: 9
+ byte(7)70,65,84,65,76,69,82,82,79,82,0
+ intern L1462
+L1463: 7
+ byte(7)83,84,68,69,82,82,79,82,0
+ intern L1463
+L1464: 9
+ byte(7)78,79,78,73,68,69,82,82,79,82,0
+ intern L1464
+L1465: 5
+ byte(7)80,82,73,78,49,84,0
+ intern L1465
+L1466: 8
+ byte(7)84,89,80,69,69,82,82,79,82,0
+ intern L1466
+L1467: 13
+ byte(7)85,83,65,71,69,84,89,80,69,69,82,82,79,82,0
+ intern L1467
+L1468: 1
+ byte(7)70,78,0
+ intern L1468
+L1469: 7
+ byte(7)79,70,70,69,78,68,69,82,0
+ intern L1469
+L1470: 13
+ byte(7)78,79,78,78,85,77,66,69,82,69,82,82,79,82,0
+ intern L1470
+L1471: 11
+ byte(7)76,65,77,66,73,78,68,65,82,71,83,42,0
+ intern L1471
+L1472: 6
+ byte(7)76,65,77,66,73,78,68,0
+ intern L1472
+L1473: 6
+ byte(7)85,78,66,73,78,68,78,0
+ intern L1473
+L1474: 14
+ byte(7)78,79,78,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L1474
+L1475: 22
+ byte(7)78,79,78,80,79,83,73,84,73,86,69,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L1475
+L1476: 8
+ byte(7)87,81,85,79,84,73,69,78,84,0
+ intern L1476
+L1477: 7
+ byte(7)37,82,69,67,76,65,73,77,0
+ intern L1477
+L1478: 5
+ byte(7)71,84,72,69,65,80,0
+ intern L1478
+L1479: 4
+ byte(7)71,84,83,84,82,0
+ intern L1479
+L1480: 5
+ byte(7)71,84,86,69,67,84,0
+ intern L1480
+L1481: 7
+ byte(7)71,84,87,65,82,82,65,89,0
+ intern L1481
+L1482: 3
+ byte(7)71,84,73,68,0
+ intern L1482
+L1483: 7
+ byte(7)72,65,82,68,67,79,78,83,0
+ intern L1483
+L1484: 3
+ byte(7)67,79,78,83,0
+ intern L1484
+L1485: 4
+ byte(7)88,67,79,78,83,0
+ intern L1485
+L1486: 4
+ byte(7)78,67,79,78,83,0
+ intern L1486
+L1487: 5
+ byte(7)77,75,86,69,67,84,0
+ intern L1487
+L1488: 4
+ byte(7)76,73,83,84,50,0
+ intern L1488
+L1489: 4
+ byte(7)76,73,83,84,51,0
+ intern L1489
+L1490: 4
+ byte(7)76,73,83,84,52,0
+ intern L1490
+L1491: 4
+ byte(7)76,73,83,84,53,0
+ intern L1491
+L1492: 6
+ byte(7)80,85,84,66,89,84,69,0
+ intern L1492
+L1493: 7
+ byte(7)77,75,83,84,82,73,78,71,0
+ intern L1493
+L1494: 4
+ byte(7)69,81,83,84,82,0
+ intern L1494
+L1495: 7
+ byte(7)73,78,73,84,82,69,65,68,0
+ intern L1495
+L1496: 5
+ byte(7)42,82,65,73,83,69,0
+ intern L1496
+L1497: 2
+ byte(7)67,72,42,0
+ intern L1497
+L1498: 3
+ byte(7)84,79,75,42,0
+ intern L1498
+L1499: 7
+ byte(7)84,79,75,84,89,80,69,42,0
+ intern L1499
+L1500: 4
+ byte(7)68,69,66,85,71,0
+ intern L1500
+L1501: 7
+ byte(7)83,69,84,82,65,73,83,69,0
+ intern L1501
+L1502: 9
+ byte(7)67,76,69,65,82,87,72,73,84,69,0
+ intern L1502
+L1503: 11
+ byte(7)67,76,69,65,82,67,79,77,77,69,78,84,0
+ intern L1503
+L1504: 6
+ byte(7)82,69,65,68,83,84,82,0
+ intern L1504
+L1505: 5
+ byte(7)68,73,71,73,84,80,0
+ intern L1505
+L1506: 6
+ byte(7)82,69,65,68,73,78,84,0
+ intern L1506
+L1507: 8
+ byte(7)65,76,80,72,65,69,83,67,80,0
+ intern L1507
+L1508: 5
+ byte(7)82,69,65,68,73,68,0
+ intern L1508
+L1509: 4
+ byte(7)82,65,84,79,77,0
+ intern L1509
+L1510: 5
+ byte(7)87,72,73,84,69,80,0
+ intern L1510
+L1511: 3
+ byte(7)71,69,84,67,0
+ intern L1511
+L1512: 8
+ byte(7)76,79,78,71,84,73,77,69,83,0
+ intern L1512
+L1513: 13
+ byte(7)66,85,70,70,69,82,84,79,83,84,82,73,78,71,0
+ intern L1513
+L1514: 8
+ byte(7)82,65,73,83,69,67,72,65,82,0
+ intern L1514
+L1515: 11
+ byte(7)65,76,80,72,65,78,85,77,69,83,67,80,0
+ intern L1515
+L1516: 5
+ byte(7)73,78,84,69,82,78,0
+ intern L1516
+L1517: 6
+ byte(7)69,83,67,65,80,69,80,0
+ intern L1517
+L1518: 5
+ byte(7)65,76,80,72,65,80,0
+ intern L1518
+L1519: 9
+ byte(7)76,79,87,69,82,67,65,83,69,80,0
+ intern L1519
+L1520: 7
+ byte(7)76,79,79,75,85,80,73,68,0
+ intern L1520
+L1521: 8
+ byte(7)73,78,73,84,78,69,87,73,68,0
+ intern L1521
+L1522: 11
+ byte(7)77,65,75,69,70,85,78,66,79,85,78,68,0
+ intern L1522
+L1523: 9
+ byte(7)85,80,80,69,82,67,65,83,69,80,0
+ intern L1523
+L1524: 8
+ byte(7)65,76,80,72,65,78,85,77,80,0
+ intern L1524
+L1525: 4
+ byte(7)82,69,65,68,49,0
+ intern L1525
+L1526: 3
+ byte(7)82,69,65,68,0
+ intern L1526
+L1527: 7
+ byte(7)82,69,65,68,76,73,83,84,0
+ intern L1527
+L1528: 4
+ byte(7)81,85,79,84,69,0
+ intern L1528
+L1529: 6
+ byte(7)83,65,70,69,67,68,82,0
+ intern L1529
+L1530: 9
+ byte(7)83,89,77,70,78,67,66,65,83,69,0
+ intern L1530
+L1531: 5
+ byte(7)87,80,76,85,83,50,0
+ intern L1531
+L1532: 5
+ byte(7)83,89,77,70,78,67,0
+ intern L1532
+L1533: 6
+ byte(7)87,84,73,77,69,83,50,0
+ intern L1533
+L1534: 29
+ byte(7)65,68,68,82,69,83,83,73,78,71,85,78,73,84,83,80,69,82,70,85,78,67,84,73,79,78,67,69,76,76,0
+ intern L1534
+L1535: 16
+ byte(7)83,72,79,85,76,68,66,69,85,78,68,69,70,73,78,69,68,0
+ intern L1535
+L1536: 8
+ byte(7)70,85,78,66,79,85,78,68,80,0
+ intern L1536
+L1537: 18
+ byte(7)37,67,79,80,89,45,70,85,78,67,84,73,79,78,45,67,69,76,76,0
+ intern L1537
+L1538: 25
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,0
+ intern L1538
+L1539: 11
+ byte(7)70,76,65,77,66,68,65,76,73,78,75,80,0
+ intern L1539
+L1540: 11
+ byte(7)37,83,84,79,82,69,45,74,67,65,76,76,0
+ intern L1540
+L1541: 14
+ byte(7)77,65,75,69,70,76,65,77,66,68,65,76,73,78,75,0
+ intern L1541
+L1542: 5
+ byte(7)70,67,79,68,69,80,0
+ intern L1542
+L1543: 8
+ byte(7)77,65,75,69,70,67,79,68,69,0
+ intern L1543
+L1544: 14
+ byte(7)71,69,84,70,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L1544
+L1545: 12
+ byte(7)67,79,68,69,80,82,73,77,73,84,73,86,69,0
+ intern L1545
+L1546: 7
+ byte(7)67,79,68,69,80,84,82,42,0
+ intern L1546
+L1547: 12
+ byte(7)83,65,86,69,82,69,71,73,83,84,69,82,83,0
+ intern L1547
+L1548: 8
+ byte(7)67,79,68,69,70,79,82,77,42,0
+ intern L1548
+L1549: 8
+ byte(7)67,79,68,69,78,65,82,71,42,0
+ intern L1549
+L1550: 28
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,65,85,88,0
+ intern L1550
+L1551: 8
+ byte(7)70,65,83,84,65,80,80,76,89,0
+ intern L1551
+L1552: 14
+ byte(7)70,65,83,84,76,65,77,66,68,65,65,80,80,76,89,0
+ intern L1552
+L1553: 5
+ byte(7)76,65,77,66,68,65,0
+ intern L1553
+L1554: 19
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,0
+ intern L1554
+L1555: 22
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,65,85,88,0
+ intern L1555
+L1556: 8
+ byte(7)67,79,68,69,65,80,80,76,89,0
+ intern L1556
+L1557: 12
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,0
+ intern L1557
+L1558: 15
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,65,85,88,0
+ intern L1558
+L1559: 3
+ byte(7)69,86,65,76,0
+ intern L1559
+L1560: 10
+ byte(7)66,73,78,68,69,86,65,76,65,85,88,0
+ intern L1560
+L1561: 7
+ byte(7)66,73,78,68,69,86,65,76,0
+ intern L1561
+L1562: 5
+ byte(7)76,66,73,78,68,49,0
+ intern L1562
+L1563: 2
+ byte(7)71,69,84,0
+ intern L1563
+L1564: 31
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,65,85,88,65,85,88,0
+ intern L1564
+L1565: 10
+ byte(7)42,76,65,77,66,68,65,76,73,78,75,0
+ intern L1565
+L1566: 5
+ byte(7)66,76,68,77,83,71,0
+ intern L1566
+L1567: 6
+ byte(7)69,86,80,82,79,71,78,0
+ intern L1567
+L1568: 6
+ byte(7)83,89,83,50,73,78,84,0
+ intern L1568
+L1569: 4
+ byte(7)80,76,85,83,50,0
+ intern L1569
+L1570: 4
+ byte(7)77,73,78,85,83,0
+ intern L1570
+L1571: 4
+ byte(7)87,65,68,68,49,0
+ intern L1571
+L1572: 3
+ byte(7)69,76,83,69,0
+ intern L1572
+L1573: 3
+ byte(7)65,68,68,49,0
+ intern L1573
+L1574: 4
+ byte(7)87,83,85,66,49,0
+ intern L1574
+L1575: 3
+ byte(7)83,85,66,49,0
+ intern L1575
+L1576: 7
+ byte(7)71,82,69,65,84,69,82,80,0
+ intern L1576
+L1577: 4
+ byte(7)76,69,83,83,80,0
+ intern L1577
+L1578: 9
+ byte(7)68,73,70,70,69,82,69,78,67,69,0
+ intern L1578
+L1579: 5
+ byte(7)84,73,77,69,83,50,0
+ intern L1579
+L1580: 2
+ byte(7)67,65,82,0
+ intern L1580
+L1581: 2
+ byte(7)67,68,82,0
+ intern L1581
+L1582: 3
+ byte(7)67,65,65,82,0
+ intern L1582
+L1583: 3
+ byte(7)67,65,68,82,0
+ intern L1583
+L1584: 3
+ byte(7)67,68,65,82,0
+ intern L1584
+L1585: 3
+ byte(7)67,68,68,82,0
+ intern L1585
+L1586: 3
+ byte(7)65,84,79,77,0
+ intern L1586
+L1587: 5
+ byte(7)65,80,80,69,78,68,0
+ intern L1587
+L1588: 3
+ byte(7)77,69,77,81,0
+ intern L1588
+L1589: 6
+ byte(7)82,69,86,69,82,83,69,0
+ intern L1589
+L1590: 4
+ byte(7)69,86,76,73,83,0
+ intern L1590
+L1591: 4
+ byte(7)80,82,79,71,78,0
+ intern L1591
+L1592: 5
+ byte(7)69,86,67,79,78,68,0
+ intern L1592
+L1593: 3
+ byte(7)67,79,78,68,0
+ intern L1593
+L1594: 2
+ byte(7)83,69,84,0
+ intern L1594
+L1595: 3
+ byte(7)83,69,84,81,0
+ intern L1595
+L1596: 3
+ byte(7)80,85,84,68,0
+ intern L1596
+L1597: 1
+ byte(7)68,69,0
+ intern L1597
+L1598: 3
+ byte(7)69,88,80,82,0
+ intern L1598
+L1599: 1
+ byte(7)68,70,0
+ intern L1599
+L1600: 4
+ byte(7)70,69,88,80,82,0
+ intern L1600
+L1601: 1
+ byte(7)68,78,0
+ intern L1601
+L1602: 4
+ byte(7)78,69,88,80,82,0
+ intern L1602
+L1603: 1
+ byte(7)68,77,0
+ intern L1603
+L1604: 4
+ byte(7)77,65,67,82,79,0
+ intern L1604
+L1605: 3
+ byte(7)76,73,83,84,0
+ intern L1605
+L1606: 4
+ byte(7)65,84,83,79,67,0
+ intern L1606
+L1607: 2
+ byte(7)71,69,81,0
+ intern L1607
+L1608: 2
+ byte(7)76,69,81,0
+ intern L1608
+L1609: 4
+ byte(7)69,81,67,65,82,0
+ intern L1609
+L1610: 3
+ byte(7)71,69,84,68,0
+ intern L1610
+L1611: 4
+ byte(7)67,79,80,89,68,0
+ intern L1611
+L1612: 5
+ byte(7)68,69,76,65,84,81,0
+ intern L1612
+L1613: 2
+ byte(7)80,85,84,0
+ intern L1613
+L1614: 7
+ byte(7)73,78,73,84,69,86,65,76,0
+ intern L1614
+L1615: 4
+ byte(7)87,72,73,76,69,0
+ intern L1615
+L1616: 4
+ byte(7)70,84,89,80,69,0
+ intern L1616
+L1617: 6
+ byte(7)76,65,77,66,68,65,80,0
+ intern L1617
+L1618: 8
+ byte(7)71,69,84,76,65,77,66,68,65,0
+ intern L1618
+L1619: 14
+ byte(7)76,65,77,66,68,65,69,86,65,76,65,80,80,76,89,0
+ intern L1619
+L1620: 8
+ byte(7)71,69,84,70,78,84,89,80,69,0
+ intern L1620
+L1621: 10
+ byte(7)76,65,77,66,68,65,65,80,80,76,89,0
+ intern L1621
+L1622: 4
+ byte(7)65,80,80,76,89,0
+ intern L1622
+L1623: 7
+ byte(7)68,79,76,65,77,66,68,65,0
+ intern L1623
+L1624: 5
+ byte(7)76,69,78,71,84,72,0
+ intern L1624
+L1625: 4
+ byte(7)67,79,68,69,80,0
+ intern L1625
+L1626: 4
+ byte(7)80,65,73,82,80,0
+ intern L1626
+L1627: 2
+ byte(7)73,68,80,0
+ intern L1627
+L1628: 1
+ byte(7)69,81,0
+ intern L1628
+L1629: 3
+ byte(7)78,85,76,76,0
+ intern L1629
+L1630: 2
+ byte(7)78,79,84,0
+ intern L1630
+L1631: 6
+ byte(7)76,69,78,71,84,72,49,0
+ intern L1631
+L1632: 5
+ byte(7)77,65,80,79,66,76,0
+ intern L1632
+L1633: 10
+ byte(7)80,82,73,78,84,70,69,88,80,82,83,0
+ intern L1633
+L1634: 10
+ byte(7)80,82,73,78,84,49,70,69,88,80,82,0
+ intern L1634
+L1635: 5
+ byte(7)70,69,88,80,82,80,0
+ intern L1635
+L1636: 13
+ byte(7)80,82,73,78,84,70,85,78,67,84,73,79,78,83,0
+ intern L1636
+L1637: 13
+ byte(7)80,82,73,78,84,49,70,85,78,67,84,73,79,78,0
+ intern L1637
+L1638: 3
+ byte(7)80,82,79,80,0
+ intern L1638
+L1639: 6
+ byte(7)82,69,77,80,82,79,80,0
+ intern L1639
+L1640: 7
+ byte(7)83,89,83,50,70,73,88,78,0
+ intern L1640
+L1641: 13
+ byte(7)73,78,70,83,84,65,82,84,73,78,71,66,73,84,0
+ intern L1641
+L1642: 11
+ byte(7)73,78,70,66,73,84,76,69,78,71,84,72,0
+ intern L1642
+L1643: 4
+ byte(7)82,69,83,69,84,0
+ intern L1643
+L1644: 13
+ byte(7)66,83,84,65,67,75,79,86,69,82,70,76,79,87,0
+ intern L1644
+L1645: 6
+ byte(7)69,82,82,79,85,84,42,0
+ intern L1645
+L1646: 14
+ byte(7)66,83,84,65,67,75,85,78,68,69,82,70,76,79,87,0
+ intern L1646
+L1647: 17
+ byte(7)67,65,80,84,85,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L1647
+L1648: 17
+ byte(7)82,69,83,84,79,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L1648
+L1649: 17
+ byte(7)37,67,76,69,65,82,45,67,65,84,67,72,45,83,84,65,67,75,0
+ intern L1649
+L1650: 12
+ byte(7)67,76,69,65,82,66,73,78,68,73,78,71,83,0
+ intern L1650
+L1651: 5
+ byte(7)80,66,73,78,68,49,0
+ intern L1651
+L1652: 7
+ byte(7)80,82,79,71,66,73,78,68,0
+ intern L1652
+L1653: 7
+ byte(7)73,78,73,84,72,69,65,80,0
+ intern L1653
+L1654: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L1654
+L1655: 4
+ byte(7)77,65,73,78,46,0
+ intern L1655
+L1656: 3
+ byte(7)73,78,73,84,0
+ intern L1656
+L1657: 2
+ byte(7)73,78,42,0
+ intern L1657
+L1658: 18
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,82,69,65,68,67,72,65,82,0
+ intern L1658
+L1659: 3
+ byte(7)84,73,77,67,0
+ intern L1659
+L1660: 3
+ byte(7)68,65,84,69,0
+ intern L1660
+L1661: 10
+ byte(7)86,69,82,83,73,79,78,78,65,77,69,0
+ intern L1661
+L1662: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L1662
+L1663: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L1663
+L1664: 10
+ byte(7)85,78,68,69,70,78,67,79,68,69,42,0
+ intern L1664
+L1665: 10
+ byte(7)85,78,68,69,70,78,78,65,82,71,42,0
+ intern L1665
+L1666: 3
+ byte(7)70,76,65,71,0
+ intern L1666
+L1667: 9
+ byte(7)87,82,69,77,65,73,78,68,69,82,0
+ intern L1667
+L1668: 7
+ byte(7)72,69,65,80,73,78,70,79,0
+ intern L1668
+L1669: 6
+ byte(7)82,69,67,76,65,73,77,0
+ intern L1669
+L1670: 5
+ byte(7)83,80,65,67,69,68,0
+ intern L1670
+L1671: 5
+ byte(7)68,65,83,72,69,68,0
+ intern L1671
+L1672: 5
+ byte(7)68,79,84,84,69,68,0
+ intern L1672
+L1673: 7
+ byte(7)83,72,79,85,76,68,66,69,0
+ intern L1673
+L1674: 2
+ byte(7)73,78,70,0
+ intern L1674
+L1675: 2
+ byte(7)84,65,71,0
+ intern L1675
+L1676: 5
+ byte(7)77,75,73,84,69,77,0
+ intern L1676
+L1677: 3
+ byte(7)84,73,77,69,0
+ intern L1677
+L1678: 6
+ byte(7)70,85,78,67,65,76,76,0
+ intern L1678
+L1679: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L1679
+L1680: 4
+ byte(7)36,69,79,70,36,0
+ intern L1680
+L1681: 10
+ byte(7)66,73,78,68,73,78,71,84,69,83,84,0
+ intern L1681
+L1682: 9
+ byte(7)73,78,84,69,82,80,84,69,83,84,0
+ intern L1682
+L1683: 11
+ byte(7)67,79,77,80,66,73,78,68,84,69,83,84,0
+ intern L1683
+L1684: 9
+ byte(7)84,69,83,84,83,69,82,73,69,83,0
+ intern L1684
+L1685: 1
+ byte(7)65,65,0
+ intern L1685
+L1686: 8
+ byte(7)84,69,83,84,65,80,80,76,89,0
+ intern L1686
+L1687: 11
+ byte(7)73,78,84,69,82,80,82,69,84,69,68,51,0
+ intern L1687
+L1688: 2
+ byte(7)65,71,49,0
+ intern L1688
+L1689: 1
+ byte(7)89,49,0
+ intern L1689
+L1690: 1
+ byte(7)88,49,0
+ intern L1690
+L1691: 2
+ byte(7)65,71,50,0
+ intern L1691
+L1692: 1
+ byte(7)89,50,0
+ intern L1692
+L1693: 1
+ byte(7)88,50,0
+ intern L1693
+L1694: 2
+ byte(7)65,71,51,0
+ intern L1694
+L1695: 1
+ byte(7)76,51,0
+ intern L1695
+L1696: 1
+ byte(7)76,50,0
+ intern L1696
+L1697: 1
+ byte(7)76,49,0
+ intern L1697
+L1698: 6
+ byte(7)76,65,77,66,68,65,50,0
+ intern L1698
+L1699: 6
+ byte(7)76,65,77,66,68,65,49,0
+ intern L1699
+L1700: 11
+ byte(7)73,78,84,69,82,80,82,69,84,69,68,50,0
+ intern L1700
+L1701: 1
+ byte(7)67,50,0
+ intern L1701
+L1702: 8
+ byte(7)67,79,77,80,73,76,69,68,50,0
+ intern L1702
+L1703: 8
+ byte(7)67,79,77,80,73,76,69,68,49,0
+ intern L1703
+L1704: 1
+ byte(7)67,49,0
+ intern L1704
+L1705: 12
+ byte(7)84,69,83,84,70,65,83,84,65,80,80,76,89,0
+ intern L1705
+L1706: 8
+ byte(7)84,69,83,84,67,79,68,69,42,0
+ intern L1706
+L1707: 5
+ byte(7)67,66,73,78,68,49,0
+ intern L1707
+L1708: 3
+ byte(7)67,70,76,49,0
+ intern L1708
+L1709: 3
+ byte(7)67,70,76,50,0
+ intern L1709
+L1710: 3
+ byte(7)77,73,68,48,0
+ intern L1710
+L1711: 3
+ byte(7)77,73,68,49,0
+ intern L1711
+L1712: 3
+ byte(7)77,73,68,50,0
+ intern L1712
+L1713: 3
+ byte(7)84,79,80,50,0
+ intern L1713
+L1714: 3
+ byte(7)84,79,80,49,0
+ intern L1714
+L1715: 5
+ byte(7)67,66,73,78,68,50,0
+ intern L1715
+L1716: 3
+ byte(7)66,79,84,49,0
+ intern L1716
+L1717: 3
+ byte(7)66,79,84,50,0
+ intern L1717
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/20-tests/main6.rel
Index: psl-1983/20-tests/main6.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main6.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/main6.sym
Index: psl-1983/20-tests/main6.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main6.sym
@@ -0,0 +1,540 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (SETQ LAMBINDARGS!* (GTWARRAY 15)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM
+PRIN1 PRIN2ID PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PUTC PBLANK
+PRIN1INTX LONGDIV LONGREMAINDER BYTE QUIT ERROR CHANNELPRIN2
+CHANNELWRITECHAR INDEPENDENTWRITECHAR WRITECHAR OUT!* ERRORHEADER
+ERRORTRAILER FATALERROR STDERROR NONIDERROR PRIN1T TYPEERROR USAGETYPEERROR
+FN OFFENDER NONNUMBERERROR LAMBINDARGS!* LAMBIND UNBINDN NONINTEGERERROR
+NONPOSITIVEINTEGERERROR WQUOTIENT !%RECLAIM GTHEAP GTSTR GTVECT GTWARRAY
+GTID HARDCONS CONS XCONS NCONS MKVECT LIST2 LIST3 LIST4 LIST5 PUTBYTE
+MKSTRING EQSTR INITREAD !*RAISE CH!* TOK!* TOKTYPE!* DEBUG SETRAISE
+CLEARWHITE CLEARCOMMENT READSTR DIGITP READINT ALPHAESCP READID RATOM WHITEP
+GETC LONGTIMES BUFFERTOSTRING RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP
+LOWERCASEP LOOKUPID INITNEWID MAKEFUNBOUND UPPERCASEP ALPHANUMP READ1 READ
+READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED FUNBOUNDP
+!%COPY!-FUNCTION!-CELL COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL
+MAKEFLAMBDALINK FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!*
+SAVEREGISTERS CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL BINDEVALAUX BINDEVAL LBIND1
+GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK BLDMSG EVPROGN SYS2INT
+PLUS2 MINUS WADD1 ELSE ADD1 WSUB1 SUB1 GREATERP LESSP DIFFERENCE TIMES2 CAR
+CDR CAAR CADR CDAR CDDR ATOM APPEND MEMQ REVERSE EVLIS PROGN EVCOND COND SET
+SETQ PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO LIST ATSOC GEQ LEQ EQCAR GETD
+COPYD DELATQ PUT INITEVAL WHILE FTYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY
+GETFNTYPE LAMBDAAPPLY APPLY DOLAMBDA LENGTH CODEP PAIRP IDP EQ NULL NOT
+LENGTH1 MAPOBL PRINTFEXPRS PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION
+PROP REMPROP SYS2FIXN INFSTARTINGBIT INFBITLENGTH RESET BSTACKOVERFLOW
+ERROUT!* BSTACKUNDERFLOW CAPTUREENVIRONMENT RESTOREENVIRONMENT
+!%CLEAR!-CATCH!-STACK CLEARBINDINGS PBIND1 PROGBIND)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 348))
+(SETQ STRINGGENSYM!* (QUOTE "L1073"))
+(PUT (QUOTE INFBITLENGTH) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0643"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0237"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0321"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1006"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0325"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0025"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0569"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBIND) (QUOTE ENTRYPOINT) (QUOTE "L1029"))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE FTYPE) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0515"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE WADD1) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0355"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0360"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0230"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 270))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0436"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0443")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0183"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0375"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0185"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L1018"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0184"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE PRIN1T) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0398"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0299"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0674"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0301"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 243))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0369"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0103"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0098"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WSUB1) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0370"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE LOOKUPID) (QUOTE ENTRYPOINT) (QUOTE "L0270"))
+(PUT (QUOTE LOOKUPID) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE RESET) (QUOTE ENTRYPOINT) (QUOTE RESET))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0660"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0425"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0192"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0093"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0156"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0287"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0263"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0177"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1007"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE PROGBIND) (QUOTE ENTRYPOINT) (QUOTE "L1032"))
+(PUT (QUOTE PROGBIND) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0094"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0634"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0182"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0603"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0471"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 271))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0021"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0647"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0186"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0034"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0330"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 244))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0191"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE FN) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0297"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1015"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0172"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0291"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1014"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0665"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0620"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1010"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0646"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0017"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0614"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0402"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0679"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0607"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1013"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0222"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0339"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0642"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0604"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0437"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0371"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0099"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE OFFENDER) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0483"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0095"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 268))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0429"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0224"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L1019"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0509"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0334"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0241"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE INFSTARTINGBIT) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0106"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0295"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0350"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1005"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0310"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 241))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0233"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 198))
ADDED psl-1983/20-tests/main7.cmd
Index: psl-1983/20-tests/main7.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main7.cmd
@@ -0,0 +1,2 @@
+main7,dmain7,sub7,Dsub7,sub6,Dsub6,sub5,Dsub5,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/main7.init
Index: psl-1983/20-tests/main7.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main7.init
@@ -0,0 +1,6 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(GLOBAL (QUOTE (TESTGLOBALVAR)))
ADDED psl-1983/20-tests/main7.mac
Index: psl-1983/20-tests/main7.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main7.mac
@@ -0,0 +1,4766 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern L0001
+ extern L0002
+ extern HEAP
+ extern L0183
+ extern L0184
+ extern L0185
+ extern L0186
+ extern BPS
+ extern L1185
+ extern L1186
+ extern L1187
+ extern L1188
+; (!*ENTRY INITHEAP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR HEAPLOWERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPLOWERBOUND))
+; (MOVEM (REG T1) (WVAR HEAPLAST))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*MOVE (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (MOVEM (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INITHEAP EXPR 0)
+L1189: intern L1189
+ MOVE 6,L0183
+ MOVEM 6,L0185
+ SETZM 1
+ MOVEM 1,L0186
+ POPJ 15,0
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (MOVE (REG NIL) (FLUID NIL))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (HRRZI (REG LINKREG) 400)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L1190
+ MOVE 0,SYMVAL+128
+ HRRZI 12,400
+ SETZM 13
+ JRST SYMFNC+400
+L1190: byte(18)-5000,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK INIT20 EXPR 1)
+ extern INIT20
+; (PUSHJ (REG ST) (INTERNALENTRY INIT20))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ PUSHJ 15,INIT20
+ SETZM SYMVAL+385
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+154
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 0) (!$FLUID IN!*))
+; (SKIPE (!$FLUID IN!*))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+ extern GETC20
+; (PUSHJ (REG ST) (INTERNALENTRY GETC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID IN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID IN!*))
+; (!*LINKE 0 INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 391)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTREADCHAR))
+ 0
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SKIPE SYMVAL+385
+ JRST L1191
+ SETZM 1
+ PUSHJ 15,GETC20
+ POPJ 15,0
+L1191: MOVE 1,SYMVAL+385
+ HRRZI 12,391
+ HRRZI 13,1
+ JRST SYMFNC+391
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+ extern TIMC20
+; (PUSHJ (REG ST) (INTERNALENTRY TIMC20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ PUSHJ 15,TIMC20
+ POPJ 15,0
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 1) (!$FLUID OUT!*))
+; (MOVE (REG T2) (!$FLUID OUT!*))
+; (CAIE (REG T2) 1)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PUTC20 EXPR 1)
+ extern PUTC20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID OUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 152)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ MOVE 7,SYMVAL+154
+ CAIE 7,1
+ JRST L1192
+ PUSHJ 15,PUTC20
+ POPJ 15,0
+L1192: MOVE 2,1
+ MOVE 1,SYMVAL+154
+ HRRZI 12,152
+ HRRZI 13,2
+ JRST SYMFNC+152
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+ extern QUIT20
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY DATE EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "No-Date-Yet") (REG 1))
+; (MOVE (REG 1) (QUOTE "No-Date-Yet"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1194: 10
+ byte(7)78,111,45,68,97,116,101,45,89,101,116,0
+ 0
+; (!*ENTRY DATE EXPR 0)
+DATE: intern DATE
+ MOVE 1,L1193
+ POPJ 15,0
+L1193: <4_31>+L1194
+; (!*ENTRY VERSIONNAME EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "DEC-20 test system") (REG 1))
+; (MOVE (REG 1) (QUOTE "DEC-20 test system"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1196: 17
+ byte(7)68,69,67,45,50,48,32,116,101,115,116,32,115,121,115,116,101,109,0
+ 0
+; (!*ENTRY VERSIONNAME EXPR 0)
+L1197: intern L1197
+ MOVE 1,L1195
+ POPJ 15,0
+L1195: <4_31>+L1196
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+ extern PUTI20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTI20))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ PUSHJ 15,PUTI20
+ POPJ 15,0
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*WOR (REG 1) 23085449216)
+; (IOR (REG 1) 23085449216)
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+L1198: intern L1198
+ IOR 1,[23085449216]
+ MOVEM 1,0(2)
+ POPJ 15,0
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (MEMORY (REG 1) (WCONST 0)) (MEMORY (REG 2) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG 1) 0))
+; (MOVEM (REG T1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+L1199: intern L1199
+ MOVE 6,0(1)
+ MOVEM 6,0(2)
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+; (!*MOVE (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (MOVEM (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (!*MOVE (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (MOVEM (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (!*JCALL UNDEFINEDFUNCTIONAUX)
+; (JRST (ENTRY UNDEFINEDFUNCTIONAUX))
+ 0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+L1200: intern L1200
+ MOVEM 12,SYMVAL+408
+ MOVEM 13,SYMVAL+409
+ JRST SYMFNC+249
+; (!*ENTRY FLAG EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE 2 (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINKE 0 ERR20 EXPR 1)
+ extern ERR20
+; (PUSHJ (REG ST) (INTERNALENTRY ERR20))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ HRRZI 1,2
+ PUSHJ 15,ERR20
+ POPJ 15,0
+; (!*ENTRY LONGTIMES EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGTIMES EXPR 2)
+L1201: intern L1201
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY LONGDIV EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGDIV EXPR 2)
+L1202: intern L1202
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+; (!*ENTRY LONGREMAINDER EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 411)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (MOVE (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGREMAINDER EXPR 2)
+L1203: intern L1203
+ HRRZI 12,411
+ HRRZI 13,2
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY !%RECLAIM EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE " *** Dummy !%RECLAIM: ") (REG 1))
+; (MOVE (REG 1) (QUOTE " *** Dummy !%RECLAIM: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINKE 0 HEAPINFO EXPR 0)
+; (HRRZI (REG LINKREG) 412)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY HEAPINFO))
+L1205: 21
+ byte(7)32,42,42,42,32,68,117,109,109,121,32,33,37,82,69,67,76,65,73,77,58,32,0
+ 0
+; (!*ENTRY !%RECLAIM EXPR 0)
+L1206: intern L1206
+ MOVE 1,L1204
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,412
+ SETZM 13
+ JRST SYMFNC+412
+L1204: <4_31>+L1205
+; (!*ENTRY RECLAIM EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "*** Dummy RECLAIM: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Dummy RECLAIM: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINKE 0 HEAPINFO EXPR 0)
+; (HRRZI (REG LINKREG) 412)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY HEAPINFO))
+L1208: 18
+ byte(7)42,42,42,32,68,117,109,109,121,32,82,69,67,76,65,73,77,58,32,0
+ 0
+; (!*ENTRY RECLAIM EXPR 0)
+L1209: intern L1209
+ MOVE 1,L1207
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,412
+ SETZM 13
+ JRST SYMFNC+412
+L1207: <4_31>+L1208
+; (!*ENTRY HEAPINFO EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPLAST) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPLAST))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLOWERBOUND))
+; (SUB (REG 1) (WVAR HEAPLOWERBOUND))
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " Items used, ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Items used, "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPUPPERBOUND) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPUPPERBOUND))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLAST))
+; (SUB (REG 1) (WVAR HEAPLAST))
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " Items left.") (REG 1))
+; (MOVE (REG 1) (QUOTE " Items left."))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1212: 11
+ byte(7)32,73,116,101,109,115,32,108,101,102,116,46,0
+L1213: 12
+ byte(7)32,73,116,101,109,115,32,117,115,101,100,44,32,0
+ 0
+; (!*ENTRY HEAPINFO EXPR 0)
+L1214: intern L1214
+ HRRZI 2,1
+ MOVE 1,L0185
+ SUB 1,L0183
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1210
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 2,1
+ MOVE 1,L0184
+ SUB 1,L0185
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1211
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ SETZM 1
+ POPJ 15,0
+L1211: <4_31>+L1212
+L1210: <4_31>+L1213
+; (!*ENTRY SPACED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1216: 10
+ byte(7)32,32,32,32,32,32,32,32,32,32,32,0
+ 1
+; (!*ENTRY SPACED EXPR 1)
+SPACED: intern SPACED
+ PUSH 15,1
+ MOVE 1,L1215
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1215: <4_31>+L1216
+; (!*ENTRY DASHED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE "---------- ") (REG 1))
+; (MOVE (REG 1) (QUOTE "---------- "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1218: 10
+ byte(7)45,45,45,45,45,45,45,45,45,45,32,0
+ 1
+; (!*ENTRY DASHED EXPR 1)
+DASHED: intern DASHED
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1217
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1217: <4_31>+L1218
+; (!*ENTRY DOTTED EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE " ....... ") (REG 1))
+; (MOVE (REG 1) (QUOTE " ....... "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1220: 10
+ byte(7)32,32,32,46,46,46,46,46,46,46,32,0
+ 1
+; (!*ENTRY DOTTED EXPR 1)
+DOTTED: intern DOTTED
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1219
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1219: <4_31>+L1220
+; (!*ENTRY SHOULDBE EXPR 3)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE " ....... For ") (REG 1))
+; (MOVE (REG 1) (QUOTE " ....... For "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " should be ") (REG 1))
+; (MOVE (REG 1) (QUOTE " should be "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*JUMPNOTEQ (LABEL G0004) (FRAME 2) (FRAME 3))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAME (REG T1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE " [OK ]") (REG 1))
+; (MOVE (REG 1) (QUOTE " [OK ]"))
+; (!*JUMP (LABEL G0006))
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE " [BAD] *******") (REG 1))
+; (MOVE (REG 1) (QUOTE " [BAD] *******"))
+; (!*LBL (LABEL G0006))
+; (!*LINKE 3 PRIN2T EXPR 1)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2T))
+L1226: 15
+ byte(7)32,32,32,91,66,65,68,93,32,42,42,42,42,42,42,42,0
+L1227: 6
+ byte(7)32,32,91,79,75,32,93,0
+L1228: 10
+ byte(7)32,115,104,111,117,108,100,32,98,101,32,0
+L1229: 0
+ byte(7)32,0
+L1230: 14
+ byte(7)32,32,32,46,46,46,46,46,46,46,32,70,111,114,32,0
+ 3
+; (!*ENTRY SHOULDBE EXPR 3)
+L1231: intern L1231
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 1,L1221
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1222
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1223
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-2(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 6,-1(15)
+ CAME 6,-2(15)
+ JRST L1232
+ MOVE 1,L1224
+ JRST L1233
+L1232: MOVE 1,L1225
+L1233: ADJSP 15,-3
+ HRRZI 12,141
+ HRRZI 13,1
+ JRST SYMFNC+141
+L1225: <4_31>+L1226
+L1224: <4_31>+L1227
+L1223: <4_31>+L1228
+L1222: <4_31>+L1229
+L1221: <4_31>+L1230
+; (!*ENTRY UNDEFINEDFUNCTIONAUXAUX EXPR 0)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (!$FLUID UNDEFNNARG!*) (FRAME 2))
+; (MOVE (REG T1) (!$FLUID UNDEFNNARG!*))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*MOVE (!$FLUID UNDEFNCODE!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID UNDEFNCODE!*))
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE "Undefined Function ") (REG 1))
+; (MOVE (REG 1) (QUOTE "Undefined Function "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " called with ") (REG 1))
+; (MOVE (REG 1) (QUOTE " called with "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " args from compiled code") (REG 1))
+; (MOVE (REG 1) (QUOTE " args from compiled code"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+L1237: 23
+ byte(7)32,97,114,103,115,32,102,114,111,109,32,99,111,109,112,105,108,101,100,32,99,111,100,101,0
+L1238: 12
+ byte(7)32,99,97,108,108,101,100,32,119,105,116,104,32,0
+L1239: 18
+ byte(7)85,110,100,101,102,105,110,101,100,32,70,117,110,99,116,105,111,110,32,0
+ 0
+; (!*ENTRY UNDEFINEDFUNCTIONAUXAUX EXPR 0)
+L1240: intern L1240
+ ADJSP 15,2
+ MOVE 6,SYMVAL+409
+ MOVEM 6,-1(15)
+ MOVE 1,SYMVAL+408
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,0(15)
+ MOVE 1,L1234
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1235
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1236
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L1236: <4_31>+L1237
+L1235: <4_31>+L1238
+L1234: <4_31>+L1239
+; (!*ENTRY INF EXPR 1)
+; (!*ALLOC 0)
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY INF EXPR 1)
+INF: intern INF
+ HRRZ 1,1
+ POPJ 15,0
+; (!*ENTRY TAG EXPR 1)
+; (!*ALLOC 0)
+; (!*FIELD (REG 1) (REG 1) (WCONST 0) (WCONST 5))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 1
+; (!*ENTRY TAG EXPR 1)
+TAG: intern TAG
+ LDB 1,L1241
+ POPJ 15,0
+L1241: point 5,1,4
+; (!*ENTRY MKITEM EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*MKITEM (REG 1) (REG 3))
+; (DPB (REG 3) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 2
+; (!*ENTRY MKITEM EXPR 2)
+MKITEM: intern MKITEM
+ MOVE 3,1
+ MOVE 1,2
+ DPB 3,L1242
+ POPJ 15,0
+L1242: point 5,1,4
+; (!*ENTRY BLDMSG EXPR 7)
+; (!*ALLOC 7)
+; (ADJSP (REG ST) 7)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 4) (FRAME 4))
+; (MOVEM (REG 4) (INDEXED (REG ST) -3))
+; (!*MOVE (REG 5) (FRAME 5))
+; (MOVEM (REG 5) (INDEXED (REG ST) -4))
+; (!*MOVE (REG 6) (FRAME 6))
+; (HRRZI (REG T1) (IMMEDIATE (EXTRAREG 6)))
+; (MOVEM (REG T1) (INDEXED (REG ST) -5))
+; (!*MOVE (REG 7) (FRAME 7))
+; (HRRZI (REG T1) (IMMEDIATE (EXTRAREG 7)))
+; (MOVEM (REG T1) (INDEXED (REG ST) -6))
+; (!*MOVE (QUOTE "BldMsg called") (REG 1))
+; (MOVE (REG 1) (QUOTE "BldMsg called"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (FRAME 4) (REG 4))
+; (MOVE (REG 4) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 3) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LIST4 EXPR 4)
+; (HRRZI (REG LINKREG) 185)
+; (HRRZI (REG NARGREG) 4)
+; (PUSHJ (REG ST) (ENTRY LIST4))
+; (!*LINKE 7 PRINT EXPR 1)
+; (ADJSP (REG ST) (MINUS 7))
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRINT))
+L1244: 12
+ byte(7)66,108,100,77,115,103,32,99,97,108,108,101,100,0
+ 7
+; (!*ENTRY BLDMSG EXPR 7)
+BLDMSG: intern BLDMSG
+ ADJSP 15,7
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVEM 5,-4(15)
+ HRRZI 6,L0004+0
+ MOVEM 6,-5(15)
+ HRRZI 6,L0004+1
+ MOVEM 6,-6(15)
+ MOVE 1,L1243
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 4,-3(15)
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ HRRZI 12,185
+ HRRZI 13,4
+ PUSHJ 15,SYMFNC+185
+ ADJSP 15,-7
+ HRRZI 12,140
+ HRRZI 13,1
+ JRST SYMFNC+140
+L1243: <4_31>+L1244
+; (!*ENTRY TIME EXPR 0)
+; (!*ALLOC 0)
+; (!*LINKE 0 TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 403)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY TIMC))
+ 0
+; (!*ENTRY TIME EXPR 0)
+TIME: intern TIME
+ HRRZI 12,403
+ SETZM 13
+ JRST SYMFNC+403
+; (!*ENTRY FUNCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 3))
+; (MOVE (REG 3) (REG 2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*LINKE 0 IDAPPLY1 EXPR 2)
+; (HRRZI (REG NARGREG) 1)
+; (MOVE (REG LINKREG) (REG 2))
+; (JRST (INDEXED (REG 2) (WARRAY SYMFNC)))
+ 2
+; (!*ENTRY FUNCALL EXPR 2)
+L1245: intern L1245
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,3
+ HRRZI 13,1
+ MOVE 12,2
+ JRST SYMFNC(2)
+; (!*ENTRY TESTSETUP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE 1000) (REG 1))
+; (HRRZI (REG 1) 1000)
+; (!*LINK PREPARETEST EXPR 1)
+; (HRRZI (REG LINKREG) 423)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PREPARETEST))
+; (!*MOVE (REG 1) (!$FLUID TESTLIST))
+; (MOVEM (REG 1) (!$FLUID TESTLIST))
+; (!*MOVE (QUOTE 2000) (REG 1))
+; (HRRZI (REG 1) 2000)
+; (!*LINK PREPARETEST EXPR 1)
+; (HRRZI (REG LINKREG) 423)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PREPARETEST))
+; (!*MOVE (REG 1) (!$FLUID TESTLIST2))
+; (MOVEM (REG 1) (!$FLUID TESTLIST2))
+; (!*LINK MAKELONGLIST EXPR 0)
+; (HRRZI (REG LINKREG) 424)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY MAKELONGLIST))
+; (!*MOVE (QUOTE (SETQ FOO (CADR (QUOTE (1 2 3))))) (REG 1))
+; (MOVE (REG 1) (QUOTE (SETQ FOO (CADR (QUOTE (1 2 3))))))
+; (!*MOVE (REG 1) (!$FLUID EVALFORM))
+; (MOVEM (REG 1) (!$FLUID EVALFORM))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1247: <30_31>+290
+ <9_31>+L1248
+L1248: <30_31>+425
+ <9_31>+L1249
+L1249: <9_31>+L1250
+ <30_31>+128
+L1250: <30_31>+278
+ <9_31>+L1251
+L1251: <9_31>+L1252
+ <30_31>+128
+L1252: <30_31>+223
+ <9_31>+L1253
+L1253: <9_31>+L1254
+ <30_31>+128
+L1254: 1
+ <9_31>+L1255
+L1255: 2
+ <9_31>+L1256
+L1256: 3
+ <30_31>+128
+ 0
+; (!*ENTRY TESTSETUP EXPR 0)
+L1257: intern L1257
+ HRRZI 1,1000
+ HRRZI 12,423
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+423
+ MOVEM 1,SYMVAL+427
+ HRRZI 1,2000
+ HRRZI 12,423
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+423
+ MOVEM 1,SYMVAL+428
+ HRRZI 12,424
+ SETZM 13
+ PUSHJ 15,SYMFNC+424
+ MOVE 1,L1246
+ MOVEM 1,SYMVAL+429
+ POPJ 15,0
+L1246: <9_31>+L1247
+; (!*ENTRY MAKELONGLIST EXPR 0)
+; (!*ALLOC 1)
+; (ADJSP (REG ST) 1)
+; (!*MOVE (QUOTE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z)) (!$FLUID LONGLIST))
+; (MOVE (REG T1) (QUOTE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z)))
+; (MOVEM (REG T1) (!$FLUID LONGLIST))
+; (!*MOVE (QUOTE 0) (FRAME 1))
+; (SETZM (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 1) (QUOTE 5))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (CAIG (REG T1) 5)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (!$FLUID LONGLIST) (REG 2))
+; (MOVE (REG 2) (!$FLUID LONGLIST))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*LINK APPEND EXPR 2)
+; (HRRZI (REG LINKREG) 282)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY APPEND))
+; (!*MOVE (REG 1) (!$FLUID LONGLIST))
+; (MOVEM (REG 1) (!$FLUID LONGLIST))
+; (!*WPLUS2 (FRAME 1) (WCONST 1))
+; (AOS (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+L1259: <30_31>+65
+ <9_31>+L1260
+L1260: <30_31>+66
+ <9_31>+L1261
+L1261: <30_31>+67
+ <9_31>+L1262
+L1262: <30_31>+68
+ <9_31>+L1263
+L1263: <30_31>+69
+ <9_31>+L1264
+L1264: <30_31>+70
+ <9_31>+L1265
+L1265: <30_31>+71
+ <9_31>+L1266
+L1266: <30_31>+72
+ <9_31>+L1267
+L1267: <30_31>+73
+ <9_31>+L1268
+L1268: <30_31>+74
+ <9_31>+L1269
+L1269: <30_31>+75
+ <9_31>+L1270
+L1270: <30_31>+76
+ <9_31>+L1271
+L1271: <30_31>+77
+ <9_31>+L1272
+L1272: <30_31>+78
+ <9_31>+L1273
+L1273: <30_31>+79
+ <9_31>+L1274
+L1274: <30_31>+80
+ <9_31>+L1275
+L1275: <30_31>+81
+ <9_31>+L1276
+L1276: <30_31>+82
+ <9_31>+L1277
+L1277: <30_31>+83
+ <9_31>+L1278
+L1278: <30_31>+84
+ <9_31>+L1279
+L1279: <30_31>+85
+ <9_31>+L1280
+L1280: <30_31>+86
+ <9_31>+L1281
+L1281: <30_31>+87
+ <9_31>+L1282
+L1282: <30_31>+88
+ <9_31>+L1283
+L1283: <30_31>+89
+ <9_31>+L1284
+L1284: <30_31>+90
+ <30_31>+128
+ 0
+; (!*ENTRY MAKELONGLIST EXPR 0)
+L1285: intern L1285
+ ADJSP 15,1
+ MOVE 6,L1258
+ MOVEM 6,SYMVAL+430
+ SETZM 0(15)
+L1286: MOVE 6,0(15)
+ CAIG 6,5
+ JRST L1287
+ MOVE 1,0
+ JRST L1288
+L1287: MOVE 2,SYMVAL+430
+ MOVE 1,2
+ HRRZI 12,282
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+282
+ MOVEM 1,SYMVAL+430
+ AOS 0(15)
+ JRST L1286
+L1288: ADJSP 15,-1
+ POPJ 15,0
+L1258: <9_31>+L1259
+; (!*ENTRY PREPARETEST EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE -1) (FRAME 3))
+; (SETOM (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWGEQ (LABEL G0005) (FRAME 1) (FRAME 3))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (CAML (REG T1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LINK CONS EXPR 2)
+; (HRRZI (REG LINKREG) 179)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CONS))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PREPARETEST EXPR 1)
+L1289: intern L1289
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ SETOM -2(15)
+ MOVE 2,0
+ MOVEM 2,-1(15)
+L1290: MOVE 6,0(15)
+ CAML 6,-2(15)
+ JRST L1291
+ MOVE 1,-1(15)
+ JRST L1292
+L1291: AOS -2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0
+ HRRZI 12,179
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+179
+ MOVEM 1,-1(15)
+ JRST L1290
+L1292: ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY CDR1TEST EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 4))
+; (MOVE (REG 4) (REG 1))
+; (!*MOVE (QUOTE -1) (REG 3))
+; (SETOM (REG 3))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 3) (WCONST 1))
+; (AOS (REG 3))
+; (!*MOVE (!$FLUID LONGLIST) (REG 2))
+; (MOVE (REG 2) (!$FLUID LONGLIST))
+; (!*JUMPWLEQ (LABEL G0005) (REG 3) (REG 4))
+; (CAMG (REG 3) (REG 4))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (REG 2)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPTYPE (LABEL G0005) (REG 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 1
+; (!*ENTRY CDR1TEST EXPR 1)
+L1294: intern L1294
+ MOVE 4,1
+ SETOM 3
+L1295: AOS 3
+ MOVE 2,SYMVAL+430
+ CAMG 3,4
+ JRST L1296
+ MOVE 1,0
+ POPJ 15,0
+L1296: MOVE 1,1(2)
+ MOVE 2,1
+ LDB 11,L1293
+ CAIN 11,9
+ JRST L1296
+ JRST L1295
+L1293: point 5,1,4
+; (!*ENTRY CDR2TEST EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 4))
+; (MOVE (REG 4) (REG 1))
+; (!*MOVE (QUOTE -1) (REG 3))
+; (SETOM (REG 3))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 3) (WCONST 1))
+; (AOS (REG 3))
+; (!*MOVE (!$FLUID LONGLIST) (REG 2))
+; (MOVE (REG 2) (!$FLUID LONGLIST))
+; (!*JUMPWLEQ (LABEL G0005) (REG 3) (REG 4))
+; (CAMG (REG 3) (REG 4))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (REG 2)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+ 1
+; (!*ENTRY CDR2TEST EXPR 1)
+L1297: intern L1297
+ MOVE 4,1
+ SETOM 3
+L1298: AOS 3
+ MOVE 2,SYMVAL+430
+ CAMG 3,4
+ JRST L1299
+ MOVE 1,0
+ POPJ 15,0
+L1299: MOVE 1,1(2)
+ MOVE 2,1
+ CAME 1,0
+ JRST L1299
+ JRST L1298
+; (!*ENTRY CDDRTEST EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 4))
+; (MOVE (REG 4) (REG 1))
+; (!*MOVE (QUOTE -1) (REG 3))
+; (SETOM (REG 3))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 3) (WCONST 1))
+; (AOS (REG 3))
+; (!*MOVE (!$FLUID LONGLIST) (REG 2))
+; (MOVE (REG 2) (!$FLUID LONGLIST))
+; (!*JUMPWLEQ (LABEL G0005) (REG 3) (REG 4))
+; (CAMG (REG 3) (REG 4))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (CDR (REG 2))) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 2) 1))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+ 1
+; (!*ENTRY CDDRTEST EXPR 1)
+L1300: intern L1300
+ MOVE 4,1
+ SETOM 3
+L1301: AOS 3
+ MOVE 2,SYMVAL+430
+ CAMG 3,4
+ JRST L1302
+ MOVE 1,0
+ POPJ 15,0
+L1302: MOVE 1,1(2)
+ MOVE 1,1(1)
+ MOVE 2,1
+ CAME 1,0
+ JRST L1302
+ JRST L1301
+; (!*ENTRY LISTONLYCDRTEST1 EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (!$FLUID TESTLIST) (REG 4))
+; (MOVE (REG 4) (!$FLUID TESTLIST))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID TESTLIST) (REG 3))
+; (MOVE (REG 3) (!$FLUID TESTLIST))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (REG 3)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 3) 1))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*MOVE (CDR (REG 4)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 4) 1))
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 2) (QUOTE NIL))
+; (CAME (REG 2) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY LISTONLYCDRTEST1 EXPR 0)
+L1303: intern L1303
+ MOVE 4,SYMVAL+427
+L1304: MOVE 3,SYMVAL+427
+L1305: MOVE 1,1(3)
+ MOVE 3,1
+ CAME 1,0
+ JRST L1305
+ MOVE 2,1(4)
+ MOVE 4,2
+ CAME 2,0
+ JRST L1304
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY LISTONLYCDDRTEST1 EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (!$FLUID TESTLIST2) (REG 4))
+; (MOVE (REG 4) (!$FLUID TESTLIST2))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID TESTLIST2) (REG 3))
+; (MOVE (REG 3) (!$FLUID TESTLIST2))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (CDR (REG 3))) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 3) 1))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*MOVE (CDR (CDR (REG 4))) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 4) 1))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 2) (QUOTE NIL))
+; (CAME (REG 2) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY LISTONLYCDDRTEST1 EXPR 0)
+L1306: intern L1306
+ MOVE 4,SYMVAL+428
+L1307: MOVE 3,SYMVAL+428
+L1308: MOVE 1,1(3)
+ MOVE 1,1(1)
+ MOVE 3,1
+ CAME 1,0
+ JRST L1308
+ MOVE 2,1(4)
+ MOVE 2,1(2)
+ MOVE 4,2
+ CAME 2,0
+ JRST L1307
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY LISTONLYCDRTEST2 EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (!$FLUID TESTLIST) (REG 4))
+; (MOVE (REG 4) (!$FLUID TESTLIST))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID TESTLIST) (REG 3))
+; (MOVE (REG 3) (!$FLUID TESTLIST))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (REG 3)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 3) 1))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*JUMPTYPE (LABEL G0005) (REG 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*MOVE (CDR (REG 4)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 4) 1))
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*JUMPTYPE (LABEL G0004) (REG 2) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 2) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+; (FULLWORD (FIELDPOINTER (REG 2) 0 5))
+ 0
+; (!*ENTRY LISTONLYCDRTEST2 EXPR 0)
+L1311: intern L1311
+ MOVE 4,SYMVAL+427
+L1312: MOVE 3,SYMVAL+427
+L1313: MOVE 1,1(3)
+ MOVE 3,1
+ LDB 11,L1309
+ CAIN 11,9
+ JRST L1313
+ MOVE 2,1(4)
+ MOVE 4,2
+ LDB 11,L1310
+ CAIN 11,9
+ JRST L1312
+ MOVE 1,0
+ POPJ 15,0
+L1309: point 5,1,4
+L1310: point 5,2,4
+; (!*ENTRY LISTONLYCDDRTEST2 EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (!$FLUID TESTLIST2) (REG 4))
+; (MOVE (REG 4) (!$FLUID TESTLIST2))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID TESTLIST2) (REG 3))
+; (MOVE (REG 3) (!$FLUID TESTLIST2))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (CDR (CDR (REG 3))) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 3) 1))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*JUMPTYPE (LABEL G0005) (REG 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*MOVE (CDR (CDR (REG 4))) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 4) 1))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*JUMPTYPE (LABEL G0004) (REG 2) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 2) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+; (FULLWORD (FIELDPOINTER (REG 2) 0 5))
+ 0
+; (!*ENTRY LISTONLYCDDRTEST2 EXPR 0)
+L1316: intern L1316
+ MOVE 4,SYMVAL+428
+L1317: MOVE 3,SYMVAL+428
+L1318: MOVE 1,1(3)
+ MOVE 1,1(1)
+ MOVE 3,1
+ LDB 11,L1314
+ CAIN 11,9
+ JRST L1318
+ MOVE 2,1(4)
+ MOVE 2,1(2)
+ MOVE 4,2
+ LDB 11,L1315
+ CAIN 11,9
+ JRST L1317
+ MOVE 1,0
+ POPJ 15,0
+L1314: point 5,1,4
+L1315: point 5,2,4
+; (!*ENTRY EMPTYTEST EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (QUOTE 0) (REG 2))
+; (SETZM (REG 2))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (REG 2) (REG 3))
+; (CAMG (REG 2) (REG 3))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0005))
+; (!*WPLUS2 (REG 2) (WCONST 1))
+; (AOS (REG 2))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+ 1
+; (!*ENTRY EMPTYTEST EXPR 1)
+L1319: intern L1319
+ MOVE 3,1
+ SETZM 2
+L1320: CAMG 2,3
+ JRST L1321
+ MOVE 1,0
+ POPJ 15,0
+L1321: AOS 2
+ JRST L1320
+; (!*ENTRY SLOWEMPTYTEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK GREATERP EXPR 2)
+; (HRRZI (REG LINKREG) 271)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY GREATERP))
+; (!*JUMPEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK ADD1 EXPR 1)
+; (HRRZI (REG LINKREG) 268)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ADD1))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY SLOWEMPTYTEST EXPR 1)
+L1323: intern L1323
+ PUSH 15,L1322
+ PUSH 15,1
+L1324: MOVE 2,0(15)
+ MOVE 1,-1(15)
+ HRRZI 12,271
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+271
+ CAMN 1,0
+ JRST L1325
+ MOVE 1,0
+ JRST L1326
+L1325: MOVE 1,-1(15)
+ HRRZI 12,268
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+268
+ MOVEM 1,-1(15)
+ JRST L1324
+L1326: ADJSP 15,-2
+ POPJ 15,0
+L1322: 0
+; (!*ENTRY REVERSETEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (!$FLUID LONGLIST) (REG 1))
+; (MOVE (REG 1) (!$FLUID LONGLIST))
+; (!*LINK REVERSE EXPR 1)
+; (HRRZI (REG LINKREG) 284)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY REVERSE))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY REVERSETEST EXPR 1)
+L1328: intern L1328
+ PUSH 15,L1327
+ PUSH 15,1
+L1329: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L1330
+ MOVE 1,0
+ JRST L1331
+L1330: MOVE 1,SYMVAL+430
+ HRRZI 12,284
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+284
+ AOS -1(15)
+ JRST L1329
+L1331: ADJSP 15,-2
+ POPJ 15,0
+L1327: 0
+; (!*ENTRY MYREVERSE1TEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (!$FLUID LONGLIST) (REG 1))
+; (MOVE (REG 1) (!$FLUID LONGLIST))
+; (!*LINK MYREVERSE1 EXPR 1)
+; (HRRZI (REG LINKREG) 441)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY MYREVERSE1))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY MYREVERSE1TEST EXPR 1)
+L1333: intern L1333
+ PUSH 15,L1332
+ PUSH 15,1
+L1334: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L1335
+ MOVE 1,0
+ JRST L1336
+L1335: MOVE 1,SYMVAL+430
+ HRRZI 12,441
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+441
+ AOS -1(15)
+ JRST L1334
+L1336: ADJSP 15,-2
+ POPJ 15,0
+L1332: 0
+; (!*ENTRY MYREVERSE1 EXPR 1)
+; (!*PUSH (QUOTE NIL))
+; (PUSH (REG ST) (REG NIL))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPTYPE (LABEL G0005) (FRAME 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (CAR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINK CONS EXPR 2)
+; (HRRZI (REG LINKREG) 179)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CONS))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (CDR (FRAME 1)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 2) (FRAME 1))
+; (MOVEM (REG 2) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))
+ 1
+; (!*ENTRY MYREVERSE1 EXPR 1)
+L1338: intern L1338
+ PUSH 15,0
+ PUSH 15,1
+L1339: LDB 11,L1337
+ CAIN 11,9
+ JRST L1340
+ MOVE 1,-1(15)
+ JRST L1341
+L1340: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ HRRZI 12,179
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+179
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+ JRST L1339
+L1341: ADJSP 15,-2
+ POPJ 15,0
+L1337: point 5,0(15),4
+; (!*ENTRY MYREVERSE2TEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (!$FLUID LONGLIST) (REG 1))
+; (MOVE (REG 1) (!$FLUID LONGLIST))
+; (!*LINK MYREVERSE2 EXPR 1)
+; (HRRZI (REG LINKREG) 443)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY MYREVERSE2))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY MYREVERSE2TEST EXPR 1)
+L1343: intern L1343
+ PUSH 15,L1342
+ PUSH 15,1
+L1344: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L1345
+ MOVE 1,0
+ JRST L1346
+L1345: MOVE 1,SYMVAL+430
+ HRRZI 12,443
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+443
+ AOS -1(15)
+ JRST L1344
+L1346: ADJSP 15,-2
+ POPJ 15,0
+L1342: 0
+; (!*ENTRY MYREVERSE2 EXPR 1)
+; (!*PUSH (QUOTE NIL))
+; (PUSH (REG ST) (REG NIL))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTEQ (LABEL G0005) (FRAME 1) (QUOTE NIL))
+; (CAME (REG NIL) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (CAR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINK CONS EXPR 2)
+; (HRRZI (REG LINKREG) 179)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CONS))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (CDR (FRAME 1)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 2) (FRAME 1))
+; (MOVEM (REG 2) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY MYREVERSE2 EXPR 1)
+L1347: intern L1347
+ PUSH 15,0
+ PUSH 15,1
+L1348: CAME 0,0(15)
+ JRST L1349
+ MOVE 1,-1(15)
+ JRST L1350
+L1349: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ HRRZI 12,179
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+179
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+ JRST L1348
+L1350: ADJSP 15,-2
+ POPJ 15,0
+; (!*ENTRY LENGTHTEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (!$FLUID LONGLIST) (REG 1))
+; (MOVE (REG 1) (!$FLUID LONGLIST))
+; (!*LINK LENGTH EXPR 1)
+; (HRRZI (REG LINKREG) 319)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY LENGTH))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY LENGTHTEST EXPR 1)
+L1352: intern L1352
+ PUSH 15,L1351
+ PUSH 15,1
+L1353: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L1354
+ MOVE 1,0
+ JRST L1355
+L1354: MOVE 1,SYMVAL+430
+ HRRZI 12,319
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+319
+ AOS -1(15)
+ JRST L1353
+L1355: ADJSP 15,-2
+ POPJ 15,0
+L1351: 0
+; (!*ENTRY FACT EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPWGEQ (LABEL G0004) (REG 1) (QUOTE 2))
+; (CAIL (REG 1) 2)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK FACT EXPR 1)
+; (HRRZI (REG LINKREG) 446)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY FACT))
+; (!*WTIMES2 (REG 1) (FRAME 1))
+; (IMUL (REG 1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY FACT EXPR 1)
+FACT: intern FACT
+ PUSH 15,1
+ CAIL 1,2
+ JRST L1356
+ HRRZI 1,1
+ JRST L1357
+L1356: SOS 1
+ HRRZI 12,446
+ HRRZI 13,1
+ PUSHJ 15,FACT
+ IMUL 1,0(15)
+L1357: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY ARITHMETICTEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (QUOTE 9) (REG 1))
+; (HRRZI (REG 1) 9)
+; (!*LINK FACT EXPR 1)
+; (HRRZI (REG LINKREG) 446)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FACT))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY ARITHMETICTEST EXPR 1)
+L1359: intern L1359
+ PUSH 15,L1358
+ PUSH 15,1
+L1360: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L1361
+ MOVE 1,0
+ JRST L1362
+L1361: HRRZI 1,9
+ HRRZI 12,446
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+446
+ AOS -1(15)
+ JRST L1360
+L1362: ADJSP 15,-2
+ POPJ 15,0
+L1358: 0
+; (!*ENTRY EVALTEST EXPR 1)
+; (!*PUSH (QUOTE 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (!$FLUID EVALFORM) (REG 1))
+; (MOVE (REG 1) (!$FLUID EVALFORM))
+; (!*LINK EVAL EXPR 1)
+; (HRRZI (REG LINKREG) 254)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY EVAL))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY EVALTEST EXPR 1)
+L1364: intern L1364
+ PUSH 15,L1363
+ PUSH 15,1
+L1365: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L1366
+ MOVE 1,0
+ JRST L1367
+L1366: MOVE 1,SYMVAL+429
+ HRRZI 12,254
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+254
+ AOS -1(15)
+ JRST L1365
+L1367: ADJSP 15,-2
+ POPJ 15,0
+L1363: 0
+; (!*ENTRY TIMEEVAL EXPR 1)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK TIME EXPR 0)
+; (HRRZI (REG LINKREG) 421)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIME))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EVAL EXPR 1)
+; (HRRZI (REG LINKREG) 254)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY EVAL))
+; (!*LINK TIME EXPR 0)
+; (HRRZI (REG LINKREG) 421)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIME))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*LINKE 2 DIFFERENCE EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 273)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY DIFFERENCE))
+ 1
+; (!*ENTRY TIMEEVAL EXPR 1)
+L1368: intern L1368
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ HRRZI 12,421
+ SETZM 13
+ PUSHJ 15,SYMFNC+421
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ HRRZI 12,254
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+254
+ HRRZI 12,421
+ SETZM 13
+ PUSHJ 15,SYMFNC+421
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ HRRZI 12,273
+ HRRZI 13,2
+ JRST SYMFNC+273
+; (!*ENTRY TOPLEVELTAK EXPR 3)
+; (!*ALLOC 0)
+; (!*LINKE 0 TAK EXPR 3)
+; (HRRZI (REG LINKREG) 450)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY TAK))
+ 3
+; (!*ENTRY TOPLEVELTAK EXPR 3)
+L1369: intern L1369
+ HRRZI 12,450
+ HRRZI 13,3
+ JRST SYMFNC+450
+; (!*ENTRY TAK EXPR 3)
+; (!*ALLOC 5)
+; (ADJSP (REG ST) 5)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*JUMPWLESSP (LABEL G0004) (REG 2) (REG 1))
+; (CAMGE (REG 2) (REG 1))
+; (JRST (LABEL G0004))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 450)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 450)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (FRAME 5))
+; (MOVEM (REG 1) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 450)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 5) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 5)
+; (ADJSP (REG ST) (MINUS 5))
+; (POPJ (REG ST) 0)
+ 3
+; (!*ENTRY TAK EXPR 3)
+TAK: intern TAK
+ ADJSP 15,5
+L1370: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ CAMGE 2,1
+ JRST L1371
+ MOVE 1,3
+ JRST L1372
+L1371: SOS 1
+ HRRZI 12,450
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVEM 1,-3(15)
+ MOVE 3,0(15)
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ SOS 1
+ HRRZI 12,450
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVEM 1,-4(15)
+ MOVE 3,-1(15)
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ SOS 1
+ HRRZI 12,450
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVE 3,1
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ JRST L1370
+L1372: ADJSP 15,-5
+ POPJ 15,0
+; (!*ENTRY TOPLEVELGTAK EXPR 3)
+; (!*ALLOC 0)
+; (!*LINKE 0 GTAK EXPR 3)
+; (HRRZI (REG LINKREG) 452)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY GTAK))
+ 3
+; (!*ENTRY TOPLEVELGTAK EXPR 3)
+L1373: intern L1373
+ HRRZI 12,452
+ HRRZI 13,3
+ JRST SYMFNC+452
+; (!*ENTRY GTAK EXPR 3)
+; (!*ALLOC 5)
+; (ADJSP (REG ST) 5)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK LESSP EXPR 2)
+; (HRRZI (REG LINKREG) 272)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LESSP))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK SUB1 EXPR 1)
+; (HRRZI (REG LINKREG) 270)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY SUB1))
+; (!*MOVE (FRAME 3) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*LINK GTAK EXPR 3)
+; (HRRZI (REG LINKREG) 452)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY GTAK))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK SUB1 EXPR 1)
+; (HRRZI (REG LINKREG) 270)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY SUB1))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*LINK GTAK EXPR 3)
+; (HRRZI (REG LINKREG) 452)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY GTAK))
+; (!*MOVE (REG 1) (FRAME 5))
+; (MOVEM (REG 1) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK SUB1 EXPR 1)
+; (HRRZI (REG LINKREG) 270)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY SUB1))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINK GTAK EXPR 3)
+; (HRRZI (REG LINKREG) 452)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY GTAK))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 5) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 5)
+; (ADJSP (REG ST) (MINUS 5))
+; (POPJ (REG ST) 0)
+ 3
+; (!*ENTRY GTAK EXPR 3)
+GTAK: intern GTAK
+ ADJSP 15,5
+L1374: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ HRRZI 12,272
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+272
+ CAME 1,0
+ JRST L1375
+ MOVE 1,-2(15)
+ JRST L1376
+L1375: MOVE 1,0(15)
+ HRRZI 12,270
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+270
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ HRRZI 12,452
+ HRRZI 13,3
+ PUSHJ 15,GTAK
+ MOVEM 1,-3(15)
+ MOVE 1,-1(15)
+ HRRZI 12,270
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+270
+ MOVE 3,0(15)
+ MOVE 2,-2(15)
+ HRRZI 12,452
+ HRRZI 13,3
+ PUSHJ 15,GTAK
+ MOVEM 1,-4(15)
+ MOVE 1,-2(15)
+ HRRZI 12,270
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+270
+ MOVE 3,-1(15)
+ MOVE 2,0(15)
+ HRRZI 12,452
+ HRRZI 13,3
+ PUSHJ 15,GTAK
+ MOVE 3,1
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ JRST L1374
+L1376: ADJSP 15,-5
+ POPJ 15,0
+; (!*ENTRY GTSTA EXPR 1)
+; (!*PUSH (QUOTE 1))
+; (PUSH (REG ST) (LIT (FULLWORD 1)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (QUOTE 100000))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAIG (REG T1) 100000)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 2) (REG T1))
+; (MOVE (REG T1) (REG 2))
+; (!*LINK FASTAPPLY EXPR 1)
+; (HRRZI (REG LINKREG) 246)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FASTAPPLY))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 1)
+ 1
+; (!*ENTRY GTSTA EXPR 1)
+GTSTA: intern GTSTA
+ PUSH 15,L1377
+ PUSH 15,1
+L1378: MOVE 6,-1(15)
+ CAIG 6,100000
+ JRST L1379
+ MOVE 1,0
+ JRST L1380
+L1379: MOVE 2,0(15)
+ MOVE 1,-1(15)
+ MOVE 6,2
+ HRRZI 12,246
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+246
+ AOS -1(15)
+ JRST L1378
+L1380: ADJSP 15,-2
+ POPJ 15,0
+L1377: 1
+; (!*ENTRY GTSTB EXPR 1)
+; (!*PUSH (QUOTE 1))
+; (PUSH (REG ST) (LIT (FULLWORD 1)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (QUOTE 100000))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAIG (REG T1) 100000)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 2) (REG T1))
+; (MOVE (REG T1) (REG 2))
+; (!*LINK FASTAPPLY EXPR 1)
+; (HRRZI (REG LINKREG) 246)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FASTAPPLY))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 1)
+ 1
+; (!*ENTRY GTSTB EXPR 1)
+GTSTB: intern GTSTB
+ PUSH 15,L1381
+ PUSH 15,1
+L1382: MOVE 6,-1(15)
+ CAIG 6,100000
+ JRST L1383
+ MOVE 1,0
+ JRST L1384
+L1383: MOVE 2,0(15)
+ MOVE 1,-1(15)
+ MOVE 6,2
+ HRRZI 12,246
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+246
+ AOS -1(15)
+ JRST L1382
+L1384: ADJSP 15,-2
+ POPJ 15,0
+L1381: 1
+; (!*ENTRY G0 EXPR 1)
+; (!*ALLOC 0)
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY G0 EXPR 1)
+G0: intern G0
+ POPJ 15,0
+; (!*ENTRY G1 EXPR 1)
+; (!*ALLOC 0)
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY G1 EXPR 1)
+G1: intern G1
+ AOS 1
+ POPJ 15,0
+; (!*ENTRY NREVERSE EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*LINKE 0 NRECONC EXPR 2)
+; (HRRZI (REG LINKREG) 458)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY NRECONC))
+ 1
+; (!*ENTRY NREVERSE EXPR 1)
+L1385: intern L1385
+ MOVE 2,0
+ HRRZI 12,458
+ HRRZI 13,2
+ JRST SYMFNC+458
+; (!*ENTRY NRECONC EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 5))
+; (MOVE (REG 5) (REG 1))
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*MOVE (QUOTE NIL) (REG 3))
+; (MOVE (REG 3) (REG NIL))
+; (!*LBL (LABEL G0004))
+; (!*JUMPTYPE (LABEL G0005) (REG 5) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 5) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*MOVE (REG 4) (REG 1))
+; (MOVE (REG 1) (REG 4))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0005))
+; (!*MOVE (REG 5) (REG 3))
+; (MOVE (REG 3) (REG 5))
+; (!*MOVE (CDR (REG 5)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 5) 1))
+; (!*MOVE (REG 1) (REG 5))
+; (MOVE (REG 5) (REG 1))
+; (!*MOVE (REG 3) (REG 2))
+; (MOVE (REG 2) (REG 3))
+; (!*MOVE (REG 4) (CDR (REG 2)))
+; (MOVEM (REG 4) (INDEXED (REG 2) 1))
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (FULLWORD (FIELDPOINTER (REG 5) 0 5))
+ 2
+; (!*ENTRY NRECONC EXPR 2)
+L1387: intern L1387
+ MOVE 5,1
+ MOVE 4,2
+ MOVE 3,0
+L1388: LDB 11,L1386
+ CAIN 11,9
+ JRST L1389
+ MOVE 1,4
+ POPJ 15,0
+L1389: MOVE 3,5
+ MOVE 1,1(5)
+ MOVE 5,1
+ MOVE 2,3
+ MOVEM 4,1(2)
+ MOVE 4,2
+ JRST L1388
+L1386: point 5,5,4
+; (!*ENTRY NNILS EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 3) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -2))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LINK CONS EXPR 2)
+; (HRRZI (REG LINKREG) 179)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CONS))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY NNILS EXPR 1)
+NNILS: intern NNILS
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ SETZM -2(15)
+L1390: MOVE 6,-2(15)
+ CAMG 6,0(15)
+ JRST L1391
+ MOVE 1,-1(15)
+ JRST L1392
+L1391: MOVE 2,-1(15)
+ MOVE 1,0
+ HRRZI 12,179
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+179
+ MOVEM 1,-1(15)
+ AOS -2(15)
+ JRST L1390
+L1392: ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY NILS EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK NNILS EXPR 1)
+; (HRRZI (REG LINKREG) 460)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY NNILS))
+; (!*MOVE (REG 1) (!$GLOBAL TESTGLOBALVAR))
+; (MOVEM (REG 1) (!$GLOBAL TESTGLOBALVAR))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY NILS EXPR 1)
+NILS: intern NILS
+ PUSH 15,1
+ HRRZI 12,460
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+460
+ MOVEM 1,SYMVAL+462
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY NR EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (!$GLOBAL TESTGLOBALVAR) (REG 1))
+; (MOVE (REG 1) (!$GLOBAL TESTGLOBALVAR))
+; (!*LINK NREVERSE EXPR 1)
+; (HRRZI (REG LINKREG) 459)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY NREVERSE))
+; (!*MOVE (REG 1) (!$GLOBAL TESTGLOBALVAR))
+; (MOVEM (REG 1) (!$GLOBAL TESTGLOBALVAR))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY NR EXPR 0)
+NR: intern NR
+ MOVE 1,SYMVAL+462
+ HRRZI 12,459
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+459
+ MOVEM 1,SYMVAL+462
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (QUOTE NIL) (FRAME 1))
+; (MOVEM (REG NIL) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*LINK INIT EXPR 0)
+; (HRRZI (REG LINKREG) 402)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INIT))
+; (!*LINK INITHEAP EXPR 0)
+; (HRRZI (REG LINKREG) 399)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITHEAP))
+; (!*LINK INITEVAL EXPR 0)
+; (HRRZI (REG LINKREG) 309)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITEVAL))
+; (!*MOVE (QUOTE "MINI-PSL with File I/O") (REG 1))
+; (MOVE (REG 1) (QUOTE "MINI-PSL with File I/O"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " Type (IOTEST) to test basic file I/O") (REG 1))
+; (MOVE (REG 1) (QUOTE " Type (IOTEST) to test basic file I/O"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " Future tests will be READ in this way") (REG 1))
+; (MOVE (REG 1) (QUOTE " Future tests will be READ in this way"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE " !*RAISE and !*PVAL set T") (REG 1))
+; (MOVE (REG 1) (QUOTE " !*RAISE and !*PVAL set T"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*MOVE (REG 1) (!$FLUID DEBUG))
+; (MOVEM (REG 1) (!$FLUID DEBUG))
+; (!*LINK INITREAD EXPR 0)
+; (HRRZI (REG LINKREG) 190)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITREAD))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*MOVE (REG 1) (!$FLUID !*RAISE))
+; (MOVEM (REG 1) (!$FLUID !*RAISE))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*MOVE (REG 1) (!$FLUID !*PVAL))
+; (MOVEM (REG 1) (!$FLUID !*PVAL))
+; (!*MOVE (WCONST 26) (REG 1))
+; (HRRZI (REG 1) 26)
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (!$FLUID !$EOF!$))
+; (MOVEM (REG 1) (!$FLUID !$EOF!$))
+; (!*MOVE (QUOTE " .... Now we test INITCODE") (REG 1))
+; (MOVE (REG 1) (QUOTE " .... Now we test INITCODE"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK INITCODE EXPR 0)
+; (HRRZI (REG LINKREG) 464)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INITCODE))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LINK CLEARIO EXPR 0)
+; (HRRZI (REG LINKREG) 396)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY CLEARIO))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTEQ (LABEL G0004) (FRAME 2) (QUOTE NIL))
+; (CAME (REG NIL) (INDEXED (REG ST) -1))
+; (JRST (LABEL G0004))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " lisp> ") (REG 1))
+; (MOVE (REG 1) (QUOTE " lisp> "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPNOTEQ (LABEL G0011) (REG 1) (!$GLOBAL !$EOF!$))
+; (CAME (REG 1) (!$GLOBAL !$EOF!$))
+; (JRST (LABEL G0011))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE " *** Top Level EOF *** ") (REG 1))
+; (MOVE (REG 1) (QUOTE " *** Top Level EOF *** "))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0011))
+; (!*JUMPNOTEQ (LABEL G0012) (REG 1) (QUOTE QUIT))
+; (CAME (REG 1) (QUOTE QUIT))
+; (JRST (LABEL G0012))
+; (!*MOVE (QUOTE T) (FRAME 2))
+; (MOVE (REG T1) (FLUID T))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0012))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK EVAL EXPR 1)
+; (HRRZI (REG LINKREG) 254)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY EVAL))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPEQ (LABEL G0005) (QUOTE NIL) (!$FLUID !*PVAL))
+; (CAMN (REG NIL) (!$FLUID !*PVAL))
+; (JRST (LABEL G0005))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+L1401: 22
+ byte(7)32,42,42,42,32,84,111,112,32,76,101,118,101,108,32,69,79,70,32,42,42,42,32,0
+L1402: 6
+ byte(7)32,108,105,115,112,62,32,0
+L1403: 25
+ byte(7)32,46,46,46,46,32,78,111,119,32,119,101,32,116,101,115,116,32,73,78,73,84,67,79,68,69,0
+L1404: 26
+ byte(7)32,32,32,33,42,82,65,73,83,69,32,97,110,100,32,33,42,80,86,65,76,32,115,101,116,32,84,0
+L1405: 39
+ byte(7)32,32,32,70,117,116,117,114,101,32,116,101,115,116,115,32,119,105,108,108,32,98,101,32,82,69,65,68,32,105,110,32,116,104,105,115,32,119,97,121,0
+L1406: 38
+ byte(7)32,32,32,84,121,112,101,32,40,73,79,84,69,83,84,41,32,116,111,32,116,101,115,116,32,98,97,115,105,99,32,102,105,108,101,32,73,47,79,0
+L1407: 21
+ byte(7)77,73,78,73,45,80,83,76,32,119,105,116,104,32,70,105,108,101,32,73,47,79,0
+ 0
+; (!*ENTRY FIRSTCALL EXPR 0)
+L1408: intern L1408
+ ADJSP 15,3
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ HRRZI 12,402
+ SETZM 13
+ PUSHJ 15,SYMFNC+402
+ HRRZI 12,399
+ SETZM 13
+ PUSHJ 15,SYMFNC+399
+ HRRZI 12,309
+ SETZM 13
+ PUSHJ 15,SYMFNC+309
+ MOVE 1,L1393
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1394
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1395
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,L1396
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,0
+ MOVEM 1,SYMVAL+195
+ HRRZI 12,190
+ SETZM 13
+ PUSHJ 15,SYMFNC+190
+ MOVE 1,SYMVAL+84
+ MOVEM 1,SYMVAL+191
+ MOVE 1,SYMVAL+84
+ MOVEM 1,SYMVAL+378
+ HRRZI 1,26
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,SYMVAL+377
+ MOVE 1,L1397
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,464
+ SETZM 13
+ PUSHJ 15,SYMFNC+464
+ SETZM SYMVAL+385
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+154
+ SETZM -2(15)
+ HRRZI 12,396
+ SETZM 13
+ PUSHJ 15,SYMFNC+396
+L1409: CAME 0,-1(15)
+ JRST L1410
+ AOS -2(15)
+ MOVE 1,-2(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1398
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ MOVEM 1,0(15)
+ CAME 1,SYMVAL+377
+ JRST L1411
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,L1399
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ JRST L1409
+L1411: CAME 1,L1400
+ JRST L1412
+ MOVE 6,SYMVAL+84
+ MOVEM 6,-1(15)
+ JRST L1409
+L1412: HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,0(15)
+ HRRZI 12,254
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+254
+ MOVEM 1,0(15)
+ CAMN 0,SYMVAL+378
+ JRST L1409
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ JRST L1409
+L1410: HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L1400: <30_31>+148
+L1399: <4_31>+L1401
+L1398: <4_31>+L1402
+L1397: <4_31>+L1403
+L1396: <4_31>+L1404
+L1395: <4_31>+L1405
+L1394: <4_31>+L1406
+L1393: <4_31>+L1407
+; (!*ENTRY IOTEST EXPR 0)
+; (!*ALLOC 6)
+; (ADJSP (REG ST) 6)
+; (!*MOVE (QUOTE NIL) (FRAME 1))
+; (MOVEM (REG NIL) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (FRAME 3))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE NIL) (FRAME 4))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -3))
+; (!*MOVE (QUOTE NIL) (FRAME 6))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -5))
+; (!*MOVE (QUOTE "---- Test of File IO") (REG 1))
+; (MOVE (REG 1) (QUOTE "---- Test of File IO"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE 0) (!$GLOBAL IN!*))
+; (SETZM (!$GLOBAL IN!*))
+; (!*MOVE (QUOTE 1) (!$GLOBAL OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$GLOBAL OUT!*))
+; (!*MOVE (QUOTE " Test CLEARIO") (REG 1))
+; (MOVE (REG 1) (QUOTE " Test CLEARIO"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE " Input String for Input File") (REG 1))
+; (MOVE (REG 1) (QUOTE " Input String for Input File"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*MOVE (REG 1) (FRAME 5))
+; (MOVEM (REG 1) (INDEXED (REG ST) -4))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*JUMPNOTTYPE (LABEL G0004) (FRAME 5) STR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) -4) 0 5))))
+; (CAIE (REG T6) 4)
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (QUOTE " Input String for OutPut File") (REG 1))
+; (MOVE (REG 1) (QUOTE " Input String for OutPut File"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*MOVE (REG 1) (FRAME 6))
+; (MOVEM (REG 1) (INDEXED (REG ST) -5))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*JUMPNOTTYPE (LABEL G0005) (FRAME 6) STR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) -5) 0 5))))
+; (CAIE (REG T6) 4)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE INPUT) (REG 2))
+; (MOVE (REG 2) (QUOTE INPUT))
+; (!*MOVE (FRAME 5) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -4))
+; (!*LINK OPEN EXPR 2)
+; (HRRZI (REG LINKREG) 372)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY OPEN))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE " Input File Opened on ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Input File Opened on "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE ", copy to TTY ") (REG 1))
+; (MOVE (REG 1) (QUOTE ", copy to TTY "))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LBL (LABEL G0016))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 391)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY INDEPENDENTREADCHAR))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*JUMPEQ (LABEL G0015) (REG 1) (QUOTE 26))
+; (CAIN (REG 1) 26)
+; (JRST (LABEL G0015))
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*JUMP (LABEL G0016))
+; (JRST (LABEL G0016))
+; (!*LBL (LABEL G0015))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK CLOSE EXPR 1)
+; (HRRZI (REG LINKREG) 373)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY CLOSE))
+; (!*MOVE (QUOTE " File Closed, Input test done") (REG 1))
+; (MOVE (REG 1) (QUOTE " File Closed, Input test done"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE INPUT) (REG 2))
+; (MOVE (REG 2) (QUOTE INPUT))
+; (!*MOVE (FRAME 5) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -4))
+; (!*LINK OPEN EXPR 2)
+; (HRRZI (REG LINKREG) 372)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY OPEN))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE OUTPUT) (REG 2))
+; (MOVE (REG 2) (QUOTE OUTPUT))
+; (!*MOVE (FRAME 6) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -5))
+; (!*LINK OPEN EXPR 2)
+; (HRRZI (REG LINKREG) 372)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY OPEN))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE " Input File on ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Input File on "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE ", copy to Output File on") (REG 1))
+; (MOVE (REG 1) (QUOTE ", copy to Output File on"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LBL (LABEL G0024))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 391)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY INDEPENDENTREADCHAR))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*JUMPEQ (LABEL G0023) (REG 1) (QUOTE 26))
+; (CAIN (REG 1) 26)
+; (JRST (LABEL G0023))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 152)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY INDEPENDENTWRITECHAR))
+; (!*JUMP (LABEL G0024))
+; (JRST (LABEL G0024))
+; (!*LBL (LABEL G0023))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK CLOSE EXPR 1)
+; (HRRZI (REG LINKREG) 373)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY CLOSE))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK CLOSE EXPR 1)
+; (HRRZI (REG LINKREG) 373)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY CLOSE))
+; (!*MOVE (QUOTE "Both Files Closed, Inspect File:") (REG 1))
+; (MOVE (REG 1) (QUOTE "Both Files Closed, Inspect File:"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 6) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -5))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 6)
+; (ADJSP (REG ST) (MINUS 6))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) -4) 0 5))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) -5) 0 5))
+L1427: 31
+ byte(7)66,111,116,104,32,70,105,108,101,115,32,67,108,111,115,101,100,44,32,73,110,115,112,101,99,116,32,70,105,108,101,58,0
+L1428: 23
+ byte(7)44,32,99,111,112,121,32,116,111,32,79,117,116,112,117,116,32,70,105,108,101,32,111,110,0
+L1429: 20
+ byte(7)32,32,32,32,32,32,73,110,112,117,116,32,70,105,108,101,32,32,111,110,32,0
+L1430: 32
+ byte(7)32,32,32,32,32,70,105,108,101,32,67,108,111,115,101,100,44,32,73,110,112,117,116,32,116,101,115,116,32,100,111,110,101,0
+L1431: 13
+ byte(7)44,32,99,111,112,121,32,116,111,32,84,84,89,32,0
+L1432: 26
+ byte(7)32,32,32,32,32,32,73,110,112,117,116,32,70,105,108,101,32,79,112,101,110,101,100,32,111,110,32,0
+L1433: 32
+ byte(7)32,32,32,32,32,73,110,112,117,116,32,83,116,114,105,110,103,32,102,111,114,32,79,117,116,80,117,116,32,70,105,108,101,0
+L1434: 31
+ byte(7)32,32,32,32,32,73,110,112,117,116,32,83,116,114,105,110,103,32,102,111,114,32,73,110,112,117,116,32,70,105,108,101,0
+L1435: 16
+ byte(7)32,32,32,32,32,84,101,115,116,32,67,76,69,65,82,73,79,0
+L1436: 19
+ byte(7)45,45,45,45,32,84,101,115,116,32,111,102,32,70,105,108,101,32,73,79,0
+ 0
+; (!*ENTRY IOTEST EXPR 0)
+IOTEST: intern IOTEST
+ ADJSP 15,6
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-5(15)
+ MOVE 1,L1413
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ SETZM SYMVAL+385
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+154
+ MOVE 1,L1414
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+L1437: MOVE 1,L1415
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ MOVEM 1,-4(15)
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ LDB 11,L1416
+ CAIE 11,4
+ JRST L1437
+L1438: MOVE 1,L1417
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ MOVEM 1,-5(15)
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ LDB 11,L1418
+ CAIE 11,4
+ JRST L1438
+ MOVE 2,L1419
+ MOVE 1,-4(15)
+ HRRZI 12,372
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+372
+ MOVEM 1,0(15)
+ MOVE 1,L1420
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1421
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+L1439: MOVE 1,0(15)
+ HRRZI 12,391
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+391
+ MOVEM 1,-2(15)
+ CAIN 1,26
+ JRST L1440
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ JRST L1439
+L1440: MOVE 1,0(15)
+ HRRZI 12,373
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+373
+ MOVE 1,L1422
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 2,L1419
+ MOVE 1,-4(15)
+ HRRZI 12,372
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+372
+ MOVEM 1,0(15)
+ MOVE 2,L1423
+ MOVE 1,-5(15)
+ HRRZI 12,372
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+372
+ MOVEM 1,-1(15)
+ MOVE 1,L1424
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L1425
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+L1441: MOVE 1,0(15)
+ HRRZI 12,391
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+391
+ MOVEM 1,-2(15)
+ CAIN 1,26
+ JRST L1442
+ MOVE 2,1
+ MOVE 1,-1(15)
+ HRRZI 12,152
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+152
+ JRST L1441
+L1442: MOVE 1,0(15)
+ HRRZI 12,373
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+373
+ MOVE 1,-1(15)
+ HRRZI 12,373
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+373
+ MOVE 1,L1426
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-5(15)
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ MOVE 1,0
+ ADJSP 15,-6
+ POPJ 15,0
+L1416: point 5,-4(15),4
+L1418: point 5,-5(15),4
+L1426: <4_31>+L1427
+L1425: <4_31>+L1428
+L1424: <4_31>+L1429
+L1423: <30_31>+383
+L1422: <4_31>+L1430
+L1421: <4_31>+L1431
+L1420: <4_31>+L1432
+L1419: <30_31>+375
+L1417: <4_31>+L1433
+L1415: <4_31>+L1434
+L1414: <4_31>+L1435
+L1413: <4_31>+L1436
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L1443: intern L1443
+ HRRZI 1,15
+ HRRZI 12,176
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+176
+ MOVEM 1,SYMVAL+166
+ POPJ 15,0
+ extern SYMVAL
+ extern SYMPRP
+ extern SYMNAM
+L1444: 0
+ byte(7)0,0
+ intern L1444
+L1445: 0
+ byte(7)1,0
+ intern L1445
+L1446: 0
+ byte(7)2,0
+ intern L1446
+L1447: 0
+ byte(7)3,0
+ intern L1447
+L1448: 0
+ byte(7)4,0
+ intern L1448
+L1449: 0
+ byte(7)5,0
+ intern L1449
+L1450: 0
+ byte(7)6,0
+ intern L1450
+L1451: 0
+ byte(7)7,0
+ intern L1451
+L1452: 0
+ byte(7)8,0
+ intern L1452
+L1453: 0
+ byte(7)9,0
+ intern L1453
+L1454: 0
+ byte(7)10,0
+ intern L1454
+L1455: 0
+ byte(7)11,0
+ intern L1455
+L1456: 0
+ byte(7)12,0
+ intern L1456
+L1457: 0
+ byte(7)13,0
+ intern L1457
+L1458: 0
+ byte(7)14,0
+ intern L1458
+L1459: 0
+ byte(7)15,0
+ intern L1459
+L1460: 0
+ byte(7)16,0
+ intern L1460
+L1461: 0
+ byte(7)17,0
+ intern L1461
+L1462: 0
+ byte(7)18,0
+ intern L1462
+L1463: 0
+ byte(7)19,0
+ intern L1463
+L1464: 0
+ byte(7)20,0
+ intern L1464
+L1465: 0
+ byte(7)21,0
+ intern L1465
+L1466: 0
+ byte(7)22,0
+ intern L1466
+L1467: 0
+ byte(7)23,0
+ intern L1467
+L1468: 0
+ byte(7)24,0
+ intern L1468
+L1469: 0
+ byte(7)25,0
+ intern L1469
+L1470: 0
+ byte(7)26,0
+ intern L1470
+L1471: 0
+ byte(7)27,0
+ intern L1471
+L1472: 0
+ byte(7)28,0
+ intern L1472
+L1473: 0
+ byte(7)29,0
+ intern L1473
+L1474: 0
+ byte(7)30,0
+ intern L1474
+L1475: 0
+ byte(7)31,0
+ intern L1475
+L1476: 0
+ byte(7)32,0
+ intern L1476
+L1477: 0
+ byte(7)33,0
+ intern L1477
+L1478: 0
+ byte(7)34,0
+ intern L1478
+L1479: 0
+ byte(7)35,0
+ intern L1479
+L1480: 0
+ byte(7)36,0
+ intern L1480
+L1481: 0
+ byte(7)37,0
+ intern L1481
+L1482: 0
+ byte(7)38,0
+ intern L1482
+L1483: 0
+ byte(7)39,0
+ intern L1483
+L1484: 0
+ byte(7)40,0
+ intern L1484
+L1485: 0
+ byte(7)41,0
+ intern L1485
+L1486: 0
+ byte(7)42,0
+ intern L1486
+L1487: 0
+ byte(7)43,0
+ intern L1487
+L1488: 0
+ byte(7)44,0
+ intern L1488
+L1489: 0
+ byte(7)45,0
+ intern L1489
+L1490: 0
+ byte(7)46,0
+ intern L1490
+L1491: 0
+ byte(7)47,0
+ intern L1491
+L1492: 0
+ byte(7)48,0
+ intern L1492
+L1493: 0
+ byte(7)49,0
+ intern L1493
+L1494: 0
+ byte(7)50,0
+ intern L1494
+L1495: 0
+ byte(7)51,0
+ intern L1495
+L1496: 0
+ byte(7)52,0
+ intern L1496
+L1497: 0
+ byte(7)53,0
+ intern L1497
+L1498: 0
+ byte(7)54,0
+ intern L1498
+L1499: 0
+ byte(7)55,0
+ intern L1499
+L1500: 0
+ byte(7)56,0
+ intern L1500
+L1501: 0
+ byte(7)57,0
+ intern L1501
+L1502: 0
+ byte(7)58,0
+ intern L1502
+L1503: 0
+ byte(7)59,0
+ intern L1503
+L1504: 0
+ byte(7)60,0
+ intern L1504
+L1505: 0
+ byte(7)61,0
+ intern L1505
+L1506: 0
+ byte(7)62,0
+ intern L1506
+L1507: 0
+ byte(7)63,0
+ intern L1507
+L1508: 0
+ byte(7)64,0
+ intern L1508
+L1509: 0
+ byte(7)65,0
+ intern L1509
+L1510: 0
+ byte(7)66,0
+ intern L1510
+L1511: 0
+ byte(7)67,0
+ intern L1511
+L1512: 0
+ byte(7)68,0
+ intern L1512
+L1513: 0
+ byte(7)69,0
+ intern L1513
+L1514: 0
+ byte(7)70,0
+ intern L1514
+L1515: 0
+ byte(7)71,0
+ intern L1515
+L1516: 0
+ byte(7)72,0
+ intern L1516
+L1517: 0
+ byte(7)73,0
+ intern L1517
+L1518: 0
+ byte(7)74,0
+ intern L1518
+L1519: 0
+ byte(7)75,0
+ intern L1519
+L1520: 0
+ byte(7)76,0
+ intern L1520
+L1521: 0
+ byte(7)77,0
+ intern L1521
+L1522: 0
+ byte(7)78,0
+ intern L1522
+L1523: 0
+ byte(7)79,0
+ intern L1523
+L1524: 0
+ byte(7)80,0
+ intern L1524
+L1525: 0
+ byte(7)81,0
+ intern L1525
+L1526: 0
+ byte(7)82,0
+ intern L1526
+L1527: 0
+ byte(7)83,0
+ intern L1527
+L1528: 0
+ byte(7)84,0
+ intern L1528
+L1529: 0
+ byte(7)85,0
+ intern L1529
+L1530: 0
+ byte(7)86,0
+ intern L1530
+L1531: 0
+ byte(7)87,0
+ intern L1531
+L1532: 0
+ byte(7)88,0
+ intern L1532
+L1533: 0
+ byte(7)89,0
+ intern L1533
+L1534: 0
+ byte(7)90,0
+ intern L1534
+L1535: 0
+ byte(7)91,0
+ intern L1535
+L1536: 0
+ byte(7)92,0
+ intern L1536
+L1537: 0
+ byte(7)93,0
+ intern L1537
+L1538: 0
+ byte(7)94,0
+ intern L1538
+L1539: 0
+ byte(7)95,0
+ intern L1539
+L1540: 0
+ byte(7)96,0
+ intern L1540
+L1541: 0
+ byte(7)97,0
+ intern L1541
+L1542: 0
+ byte(7)98,0
+ intern L1542
+L1543: 0
+ byte(7)99,0
+ intern L1543
+L1544: 0
+ byte(7)100,0
+ intern L1544
+L1545: 0
+ byte(7)101,0
+ intern L1545
+L1546: 0
+ byte(7)102,0
+ intern L1546
+L1547: 0
+ byte(7)103,0
+ intern L1547
+L1548: 0
+ byte(7)104,0
+ intern L1548
+L1549: 0
+ byte(7)105,0
+ intern L1549
+L1550: 0
+ byte(7)106,0
+ intern L1550
+L1551: 0
+ byte(7)107,0
+ intern L1551
+L1552: 0
+ byte(7)108,0
+ intern L1552
+L1553: 0
+ byte(7)109,0
+ intern L1553
+L1554: 0
+ byte(7)110,0
+ intern L1554
+L1555: 0
+ byte(7)111,0
+ intern L1555
+L1556: 0
+ byte(7)112,0
+ intern L1556
+L1557: 0
+ byte(7)113,0
+ intern L1557
+L1558: 0
+ byte(7)114,0
+ intern L1558
+L1559: 0
+ byte(7)115,0
+ intern L1559
+L1560: 0
+ byte(7)116,0
+ intern L1560
+L1561: 0
+ byte(7)117,0
+ intern L1561
+L1562: 0
+ byte(7)118,0
+ intern L1562
+L1563: 0
+ byte(7)119,0
+ intern L1563
+L1564: 0
+ byte(7)120,0
+ intern L1564
+L1565: 0
+ byte(7)121,0
+ intern L1565
+L1566: 0
+ byte(7)122,0
+ intern L1566
+L1567: 0
+ byte(7)123,0
+ intern L1567
+L1568: 0
+ byte(7)124,0
+ intern L1568
+L1569: 0
+ byte(7)125,0
+ intern L1569
+L1570: 0
+ byte(7)126,0
+ intern L1570
+L1571: 0
+ byte(7)127,0
+ intern L1571
+L1572: 2
+ byte(7)78,73,76,0
+ intern L1572
+L1573: 6
+ byte(7)80,82,73,78,49,73,68,0
+ intern L1573
+L1574: 7
+ byte(7)80,82,73,78,49,73,78,84,0
+ intern L1574
+L1575: 10
+ byte(7)80,82,73,78,49,83,84,82,73,78,71,0
+ intern L1575
+L1576: 8
+ byte(7)80,82,73,78,49,80,65,73,82,0
+ intern L1576
+L1577: 5
+ byte(7)80,82,84,73,84,77,0
+ intern L1577
+L1578: 4
+ byte(7)80,82,73,78,49,0
+ intern L1578
+L1579: 6
+ byte(7)80,82,73,78,50,73,68,0
+ intern L1579
+L1580: 10
+ byte(7)80,82,73,78,50,83,84,82,73,78,71,0
+ intern L1580
+L1581: 8
+ byte(7)80,82,73,78,50,80,65,73,82,0
+ intern L1581
+L1582: 4
+ byte(7)80,82,73,78,50,0
+ intern L1582
+L1583: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L1583
+L1584: 4
+ byte(7)80,82,73,78,84,0
+ intern L1584
+L1585: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L1585
+L1586: 3
+ byte(7)80,85,84,67,0
+ intern L1586
+L1587: 5
+ byte(7)80,66,76,65,78,75,0
+ intern L1587
+L1588: 8
+ byte(7)80,82,73,78,49,73,78,84,88,0
+ intern L1588
+L1589: 6
+ byte(7)76,79,78,71,68,73,86,0
+ intern L1589
+L1590: 12
+ byte(7)76,79,78,71,82,69,77,65,73,78,68,69,82,0
+ intern L1590
+L1591: 3
+ byte(7)66,89,84,69,0
+ intern L1591
+L1592: 3
+ byte(7)81,85,73,84,0
+ intern L1592
+L1593: 4
+ byte(7)69,82,82,79,82,0
+ intern L1593
+L1594: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L1594
+L1595: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,72,65,82,0
+ intern L1595
+L1596: 19
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,87,82,73,84,69,67,72,65,82,0
+ intern L1596
+L1597: 8
+ byte(7)87,82,73,84,69,67,72,65,82,0
+ intern L1597
+L1598: 3
+ byte(7)79,85,84,42,0
+ intern L1598
+L1599: 10
+ byte(7)69,82,82,79,82,72,69,65,68,69,82,0
+ intern L1599
+L1600: 11
+ byte(7)69,82,82,79,82,84,82,65,73,76,69,82,0
+ intern L1600
+L1601: 9
+ byte(7)70,65,84,65,76,69,82,82,79,82,0
+ intern L1601
+L1602: 7
+ byte(7)83,84,68,69,82,82,79,82,0
+ intern L1602
+L1603: 9
+ byte(7)78,79,78,73,68,69,82,82,79,82,0
+ intern L1603
+L1604: 5
+ byte(7)80,82,73,78,49,84,0
+ intern L1604
+L1605: 8
+ byte(7)84,89,80,69,69,82,82,79,82,0
+ intern L1605
+L1606: 13
+ byte(7)85,83,65,71,69,84,89,80,69,69,82,82,79,82,0
+ intern L1606
+L1607: 1
+ byte(7)70,78,0
+ intern L1607
+L1608: 7
+ byte(7)79,70,70,69,78,68,69,82,0
+ intern L1608
+L1609: 13
+ byte(7)78,79,78,78,85,77,66,69,82,69,82,82,79,82,0
+ intern L1609
+L1610: 11
+ byte(7)76,65,77,66,73,78,68,65,82,71,83,42,0
+ intern L1610
+L1611: 6
+ byte(7)76,65,77,66,73,78,68,0
+ intern L1611
+L1612: 6
+ byte(7)85,78,66,73,78,68,78,0
+ intern L1612
+L1613: 14
+ byte(7)78,79,78,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L1613
+L1614: 22
+ byte(7)78,79,78,80,79,83,73,84,73,86,69,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L1614
+L1615: 8
+ byte(7)87,81,85,79,84,73,69,78,84,0
+ intern L1615
+L1616: 7
+ byte(7)37,82,69,67,76,65,73,77,0
+ intern L1616
+L1617: 5
+ byte(7)71,84,72,69,65,80,0
+ intern L1617
+L1618: 4
+ byte(7)71,84,83,84,82,0
+ intern L1618
+L1619: 5
+ byte(7)71,84,86,69,67,84,0
+ intern L1619
+L1620: 7
+ byte(7)71,84,87,65,82,82,65,89,0
+ intern L1620
+L1621: 3
+ byte(7)71,84,73,68,0
+ intern L1621
+L1622: 7
+ byte(7)72,65,82,68,67,79,78,83,0
+ intern L1622
+L1623: 3
+ byte(7)67,79,78,83,0
+ intern L1623
+L1624: 4
+ byte(7)88,67,79,78,83,0
+ intern L1624
+L1625: 4
+ byte(7)78,67,79,78,83,0
+ intern L1625
+L1626: 5
+ byte(7)77,75,86,69,67,84,0
+ intern L1626
+L1627: 4
+ byte(7)76,73,83,84,50,0
+ intern L1627
+L1628: 4
+ byte(7)76,73,83,84,51,0
+ intern L1628
+L1629: 4
+ byte(7)76,73,83,84,52,0
+ intern L1629
+L1630: 4
+ byte(7)76,73,83,84,53,0
+ intern L1630
+L1631: 6
+ byte(7)80,85,84,66,89,84,69,0
+ intern L1631
+L1632: 7
+ byte(7)77,75,83,84,82,73,78,71,0
+ intern L1632
+L1633: 4
+ byte(7)69,81,83,84,82,0
+ intern L1633
+L1634: 7
+ byte(7)73,78,73,84,82,69,65,68,0
+ intern L1634
+L1635: 5
+ byte(7)42,82,65,73,83,69,0
+ intern L1635
+L1636: 2
+ byte(7)67,72,42,0
+ intern L1636
+L1637: 3
+ byte(7)84,79,75,42,0
+ intern L1637
+L1638: 7
+ byte(7)84,79,75,84,89,80,69,42,0
+ intern L1638
+L1639: 4
+ byte(7)68,69,66,85,71,0
+ intern L1639
+L1640: 7
+ byte(7)83,69,84,82,65,73,83,69,0
+ intern L1640
+L1641: 9
+ byte(7)67,76,69,65,82,87,72,73,84,69,0
+ intern L1641
+L1642: 11
+ byte(7)67,76,69,65,82,67,79,77,77,69,78,84,0
+ intern L1642
+L1643: 6
+ byte(7)82,69,65,68,83,84,82,0
+ intern L1643
+L1644: 5
+ byte(7)68,73,71,73,84,80,0
+ intern L1644
+L1645: 6
+ byte(7)82,69,65,68,73,78,84,0
+ intern L1645
+L1646: 8
+ byte(7)65,76,80,72,65,69,83,67,80,0
+ intern L1646
+L1647: 5
+ byte(7)82,69,65,68,73,68,0
+ intern L1647
+L1648: 4
+ byte(7)82,65,84,79,77,0
+ intern L1648
+L1649: 5
+ byte(7)87,72,73,84,69,80,0
+ intern L1649
+L1650: 3
+ byte(7)71,69,84,67,0
+ intern L1650
+L1651: 8
+ byte(7)76,79,78,71,84,73,77,69,83,0
+ intern L1651
+L1652: 13
+ byte(7)66,85,70,70,69,82,84,79,83,84,82,73,78,71,0
+ intern L1652
+L1653: 8
+ byte(7)82,65,73,83,69,67,72,65,82,0
+ intern L1653
+L1654: 11
+ byte(7)65,76,80,72,65,78,85,77,69,83,67,80,0
+ intern L1654
+L1655: 5
+ byte(7)73,78,84,69,82,78,0
+ intern L1655
+L1656: 6
+ byte(7)69,83,67,65,80,69,80,0
+ intern L1656
+L1657: 5
+ byte(7)65,76,80,72,65,80,0
+ intern L1657
+L1658: 9
+ byte(7)76,79,87,69,82,67,65,83,69,80,0
+ intern L1658
+L1659: 7
+ byte(7)76,79,79,75,85,80,73,68,0
+ intern L1659
+L1660: 8
+ byte(7)73,78,73,84,78,69,87,73,68,0
+ intern L1660
+L1661: 11
+ byte(7)77,65,75,69,70,85,78,66,79,85,78,68,0
+ intern L1661
+L1662: 9
+ byte(7)85,80,80,69,82,67,65,83,69,80,0
+ intern L1662
+L1663: 8
+ byte(7)65,76,80,72,65,78,85,77,80,0
+ intern L1663
+L1664: 4
+ byte(7)82,69,65,68,49,0
+ intern L1664
+L1665: 3
+ byte(7)82,69,65,68,0
+ intern L1665
+L1666: 7
+ byte(7)82,69,65,68,76,73,83,84,0
+ intern L1666
+L1667: 4
+ byte(7)81,85,79,84,69,0
+ intern L1667
+L1668: 6
+ byte(7)83,65,70,69,67,68,82,0
+ intern L1668
+L1669: 9
+ byte(7)83,89,77,70,78,67,66,65,83,69,0
+ intern L1669
+L1670: 5
+ byte(7)87,80,76,85,83,50,0
+ intern L1670
+L1671: 5
+ byte(7)83,89,77,70,78,67,0
+ intern L1671
+L1672: 6
+ byte(7)87,84,73,77,69,83,50,0
+ intern L1672
+L1673: 29
+ byte(7)65,68,68,82,69,83,83,73,78,71,85,78,73,84,83,80,69,82,70,85,78,67,84,73,79,78,67,69,76,76,0
+ intern L1673
+L1674: 16
+ byte(7)83,72,79,85,76,68,66,69,85,78,68,69,70,73,78,69,68,0
+ intern L1674
+L1675: 8
+ byte(7)70,85,78,66,79,85,78,68,80,0
+ intern L1675
+L1676: 18
+ byte(7)37,67,79,80,89,45,70,85,78,67,84,73,79,78,45,67,69,76,76,0
+ intern L1676
+L1677: 25
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,0
+ intern L1677
+L1678: 11
+ byte(7)70,76,65,77,66,68,65,76,73,78,75,80,0
+ intern L1678
+L1679: 11
+ byte(7)37,83,84,79,82,69,45,74,67,65,76,76,0
+ intern L1679
+L1680: 14
+ byte(7)77,65,75,69,70,76,65,77,66,68,65,76,73,78,75,0
+ intern L1680
+L1681: 5
+ byte(7)70,67,79,68,69,80,0
+ intern L1681
+L1682: 8
+ byte(7)77,65,75,69,70,67,79,68,69,0
+ intern L1682
+L1683: 14
+ byte(7)71,69,84,70,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L1683
+L1684: 12
+ byte(7)67,79,68,69,80,82,73,77,73,84,73,86,69,0
+ intern L1684
+L1685: 7
+ byte(7)67,79,68,69,80,84,82,42,0
+ intern L1685
+L1686: 12
+ byte(7)83,65,86,69,82,69,71,73,83,84,69,82,83,0
+ intern L1686
+L1687: 8
+ byte(7)67,79,68,69,70,79,82,77,42,0
+ intern L1687
+L1688: 8
+ byte(7)67,79,68,69,78,65,82,71,42,0
+ intern L1688
+L1689: 28
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,65,85,88,0
+ intern L1689
+L1690: 8
+ byte(7)70,65,83,84,65,80,80,76,89,0
+ intern L1690
+L1691: 14
+ byte(7)70,65,83,84,76,65,77,66,68,65,65,80,80,76,89,0
+ intern L1691
+L1692: 5
+ byte(7)76,65,77,66,68,65,0
+ intern L1692
+L1693: 19
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,0
+ intern L1693
+L1694: 22
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,65,85,88,0
+ intern L1694
+L1695: 8
+ byte(7)67,79,68,69,65,80,80,76,89,0
+ intern L1695
+L1696: 12
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,0
+ intern L1696
+L1697: 15
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,65,85,88,0
+ intern L1697
+L1698: 3
+ byte(7)69,86,65,76,0
+ intern L1698
+L1699: 10
+ byte(7)66,73,78,68,69,86,65,76,65,85,88,0
+ intern L1699
+L1700: 7
+ byte(7)66,73,78,68,69,86,65,76,0
+ intern L1700
+L1701: 5
+ byte(7)76,66,73,78,68,49,0
+ intern L1701
+L1702: 2
+ byte(7)71,69,84,0
+ intern L1702
+L1703: 31
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,65,85,88,65,85,88,0
+ intern L1703
+L1704: 10
+ byte(7)42,76,65,77,66,68,65,76,73,78,75,0
+ intern L1704
+L1705: 5
+ byte(7)66,76,68,77,83,71,0
+ intern L1705
+L1706: 6
+ byte(7)69,86,80,82,79,71,78,0
+ intern L1706
+L1707: 6
+ byte(7)83,89,83,50,73,78,84,0
+ intern L1707
+L1708: 4
+ byte(7)80,76,85,83,50,0
+ intern L1708
+L1709: 4
+ byte(7)77,73,78,85,83,0
+ intern L1709
+L1710: 4
+ byte(7)87,65,68,68,49,0
+ intern L1710
+L1711: 3
+ byte(7)69,76,83,69,0
+ intern L1711
+L1712: 3
+ byte(7)65,68,68,49,0
+ intern L1712
+L1713: 4
+ byte(7)87,83,85,66,49,0
+ intern L1713
+L1714: 3
+ byte(7)83,85,66,49,0
+ intern L1714
+L1715: 7
+ byte(7)71,82,69,65,84,69,82,80,0
+ intern L1715
+L1716: 4
+ byte(7)76,69,83,83,80,0
+ intern L1716
+L1717: 9
+ byte(7)68,73,70,70,69,82,69,78,67,69,0
+ intern L1717
+L1718: 5
+ byte(7)84,73,77,69,83,50,0
+ intern L1718
+L1719: 2
+ byte(7)67,65,82,0
+ intern L1719
+L1720: 2
+ byte(7)67,68,82,0
+ intern L1720
+L1721: 3
+ byte(7)67,65,65,82,0
+ intern L1721
+L1722: 3
+ byte(7)67,65,68,82,0
+ intern L1722
+L1723: 3
+ byte(7)67,68,65,82,0
+ intern L1723
+L1724: 3
+ byte(7)67,68,68,82,0
+ intern L1724
+L1725: 3
+ byte(7)65,84,79,77,0
+ intern L1725
+L1726: 5
+ byte(7)65,80,80,69,78,68,0
+ intern L1726
+L1727: 3
+ byte(7)77,69,77,81,0
+ intern L1727
+L1728: 6
+ byte(7)82,69,86,69,82,83,69,0
+ intern L1728
+L1729: 4
+ byte(7)69,86,76,73,83,0
+ intern L1729
+L1730: 4
+ byte(7)80,82,79,71,78,0
+ intern L1730
+L1731: 5
+ byte(7)69,86,67,79,78,68,0
+ intern L1731
+L1732: 3
+ byte(7)67,79,78,68,0
+ intern L1732
+L1733: 2
+ byte(7)83,69,84,0
+ intern L1733
+L1734: 3
+ byte(7)83,69,84,81,0
+ intern L1734
+L1735: 3
+ byte(7)80,85,84,68,0
+ intern L1735
+L1736: 1
+ byte(7)68,69,0
+ intern L1736
+L1737: 3
+ byte(7)69,88,80,82,0
+ intern L1737
+L1738: 1
+ byte(7)68,70,0
+ intern L1738
+L1739: 4
+ byte(7)70,69,88,80,82,0
+ intern L1739
+L1740: 1
+ byte(7)68,78,0
+ intern L1740
+L1741: 4
+ byte(7)78,69,88,80,82,0
+ intern L1741
+L1742: 1
+ byte(7)68,77,0
+ intern L1742
+L1743: 4
+ byte(7)77,65,67,82,79,0
+ intern L1743
+L1744: 3
+ byte(7)76,73,83,84,0
+ intern L1744
+L1745: 4
+ byte(7)65,84,83,79,67,0
+ intern L1745
+L1746: 2
+ byte(7)71,69,81,0
+ intern L1746
+L1747: 2
+ byte(7)76,69,81,0
+ intern L1747
+L1748: 4
+ byte(7)69,81,67,65,82,0
+ intern L1748
+L1749: 3
+ byte(7)71,69,84,68,0
+ intern L1749
+L1750: 4
+ byte(7)67,79,80,89,68,0
+ intern L1750
+L1751: 5
+ byte(7)68,69,76,65,84,81,0
+ intern L1751
+L1752: 2
+ byte(7)80,85,84,0
+ intern L1752
+L1753: 7
+ byte(7)73,78,73,84,69,86,65,76,0
+ intern L1753
+L1754: 4
+ byte(7)87,72,73,76,69,0
+ intern L1754
+L1755: 4
+ byte(7)70,84,89,80,69,0
+ intern L1755
+L1756: 6
+ byte(7)76,65,77,66,68,65,80,0
+ intern L1756
+L1757: 8
+ byte(7)71,69,84,76,65,77,66,68,65,0
+ intern L1757
+L1758: 14
+ byte(7)76,65,77,66,68,65,69,86,65,76,65,80,80,76,89,0
+ intern L1758
+L1759: 8
+ byte(7)71,69,84,70,78,84,89,80,69,0
+ intern L1759
+L1760: 10
+ byte(7)76,65,77,66,68,65,65,80,80,76,89,0
+ intern L1760
+L1761: 4
+ byte(7)65,80,80,76,89,0
+ intern L1761
+L1762: 7
+ byte(7)68,79,76,65,77,66,68,65,0
+ intern L1762
+L1763: 5
+ byte(7)76,69,78,71,84,72,0
+ intern L1763
+L1764: 4
+ byte(7)67,79,68,69,80,0
+ intern L1764
+L1765: 4
+ byte(7)80,65,73,82,80,0
+ intern L1765
+L1766: 2
+ byte(7)73,68,80,0
+ intern L1766
+L1767: 1
+ byte(7)69,81,0
+ intern L1767
+L1768: 3
+ byte(7)78,85,76,76,0
+ intern L1768
+L1769: 2
+ byte(7)78,79,84,0
+ intern L1769
+L1770: 6
+ byte(7)76,69,78,71,84,72,49,0
+ intern L1770
+L1771: 5
+ byte(7)77,65,80,79,66,76,0
+ intern L1771
+L1772: 10
+ byte(7)80,82,73,78,84,70,69,88,80,82,83,0
+ intern L1772
+L1773: 10
+ byte(7)80,82,73,78,84,49,70,69,88,80,82,0
+ intern L1773
+L1774: 5
+ byte(7)70,69,88,80,82,80,0
+ intern L1774
+L1775: 13
+ byte(7)80,82,73,78,84,70,85,78,67,84,73,79,78,83,0
+ intern L1775
+L1776: 13
+ byte(7)80,82,73,78,84,49,70,85,78,67,84,73,79,78,0
+ intern L1776
+L1777: 3
+ byte(7)80,82,79,80,0
+ intern L1777
+L1778: 6
+ byte(7)82,69,77,80,82,79,80,0
+ intern L1778
+L1779: 7
+ byte(7)83,89,83,50,70,73,88,78,0
+ intern L1779
+L1780: 13
+ byte(7)73,78,70,83,84,65,82,84,73,78,71,66,73,84,0
+ intern L1780
+L1781: 11
+ byte(7)73,78,70,66,73,84,76,69,78,71,84,72,0
+ intern L1781
+L1782: 4
+ byte(7)82,69,83,69,84,0
+ intern L1782
+L1783: 13
+ byte(7)66,83,84,65,67,75,79,86,69,82,70,76,79,87,0
+ intern L1783
+L1784: 6
+ byte(7)69,82,82,79,85,84,42,0
+ intern L1784
+L1785: 14
+ byte(7)66,83,84,65,67,75,85,78,68,69,82,70,76,79,87,0
+ intern L1785
+L1786: 17
+ byte(7)67,65,80,84,85,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L1786
+L1787: 17
+ byte(7)82,69,83,84,79,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L1787
+L1788: 17
+ byte(7)37,67,76,69,65,82,45,67,65,84,67,72,45,83,84,65,67,75,0
+ intern L1788
+L1789: 12
+ byte(7)67,76,69,65,82,66,73,78,68,73,78,71,83,0
+ intern L1789
+L1790: 5
+ byte(7)80,66,73,78,68,49,0
+ intern L1790
+L1791: 7
+ byte(7)80,82,79,71,66,73,78,68,0
+ intern L1791
+L1792: 9
+ byte(7)83,89,83,67,76,69,65,82,73,79,0
+ intern L1792
+L1793: 8
+ byte(7)68,69,67,50,48,79,80,69,78,0
+ intern L1793
+L1794: 10
+ byte(7)83,89,83,79,80,69,78,82,69,65,68,0
+ intern L1794
+L1795: 11
+ byte(7)83,89,83,79,80,69,78,87,82,73,84,69,0
+ intern L1795
+L1796: 12
+ byte(7)68,69,67,50,48,82,69,65,68,67,72,65,82,0
+ intern L1796
+L1797: 9
+ byte(7)83,89,83,82,69,65,68,82,69,67,0
+ intern L1797
+L1798: 6
+ byte(7)73,79,69,82,82,79,82,0
+ intern L1798
+L1799: 13
+ byte(7)68,69,67,50,48,87,82,73,84,69,67,72,65,82,0
+ intern L1799
+L1800: 10
+ byte(7)83,89,83,87,82,73,84,69,82,69,67,0
+ intern L1800
+L1801: 7
+ byte(7)83,89,83,67,76,79,83,69,0
+ intern L1801
+L1802: 11
+ byte(7)67,72,65,78,78,69,76,69,82,82,79,82,0
+ intern L1802
+L1803: 11
+ byte(7)83,89,83,77,65,88,66,85,70,70,69,82,0
+ intern L1803
+L1804: 19
+ byte(7)84,69,82,77,73,78,65,76,73,78,80,85,84,72,65,78,68,76,69,82,0
+ intern L1804
+L1805: 15
+ byte(7)87,82,73,84,69,79,78,76,89,67,72,65,78,78,69,76,0
+ intern L1805
+L1806: 15
+ byte(7)67,79,77,80,82,69,83,83,82,69,65,68,67,72,65,82,0
+ intern L1806
+L1807: 13
+ byte(7)67,72,65,78,78,69,76,78,79,84,79,80,69,78,0
+ intern L1807
+L1808: 14
+ byte(7)82,69,65,68,79,78,76,89,67,72,65,78,78,69,76,0
+ intern L1808
+L1809: 16
+ byte(7)84,79,83,84,82,73,78,71,87,82,73,84,69,67,72,65,82,0
+ intern L1809
+L1810: 15
+ byte(7)69,88,80,76,79,68,69,87,82,73,84,69,67,72,65,82,0
+ intern L1810
+L1811: 16
+ byte(7)70,76,65,84,83,73,90,69,87,82,73,84,69,67,72,65,82,0
+ intern L1811
+L1812: 26
+ byte(7)73,76,76,69,71,65,76,83,84,65,78,68,65,82,68,67,72,65,78,78,69,76,67,76,79,83,69,0
+ intern L1812
+L1813: 4
+ byte(7)36,69,79,76,36,0
+ intern L1813
+L1814: 2
+ byte(7)82,68,83,0
+ intern L1814
+L1815: 2
+ byte(7)87,82,83,0
+ intern L1815
+L1816: 3
+ byte(7)79,80,69,78,0
+ intern L1816
+L1817: 4
+ byte(7)67,76,79,83,69,0
+ intern L1817
+L1818: 7
+ byte(7)84,89,80,69,70,73,76,69,0
+ intern L1818
+L1819: 4
+ byte(7)73,78,80,85,84,0
+ intern L1819
+L1820: 4
+ byte(7)68,83,75,73,78,0
+ intern L1820
+L1821: 4
+ byte(7)36,69,79,70,36,0
+ intern L1821
+L1822: 4
+ byte(7)42,80,86,65,76,0
+ intern L1822
+L1823: 4
+ byte(7)42,69,67,72,79,0
+ intern L1823
+L1824: 4
+ byte(7)76,65,80,73,78,0
+ intern L1824
+L1825: 21
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,70,79,82,73,78,80,85,84,0
+ intern L1825
+L1826: 22
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,70,79,82,79,85,84,80,85,84,0
+ intern L1826
+L1827: 5
+ byte(7)79,85,84,80,85,84,0
+ intern L1827
+L1828: 22
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,67,76,79,83,69,67,72,65,78,78,69,76,0
+ intern L1828
+L1829: 2
+ byte(7)73,78,42,0
+ intern L1829
+L1830: 5
+ byte(7)83,84,68,73,78,42,0
+ intern L1830
+L1831: 6
+ byte(7)83,84,68,79,85,84,42,0
+ intern L1831
+L1832: 9
+ byte(7)80,82,79,77,80,84,79,85,84,42,0
+ intern L1832
+L1833: 14
+ byte(7)70,73,78,68,70,82,69,69,67,72,65,78,78,69,76,0
+ intern L1833
+L1834: 7
+ byte(7)73,79,66,85,70,70,69,82,0
+ intern L1834
+L1835: 18
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,82,69,65,68,67,72,65,82,0
+ intern L1835
+L1836: 20
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,83,80,69,67,73,65,76,0
+ intern L1836
+L1837: 15
+ byte(7)84,69,83,84,76,69,71,65,76,67,72,65,78,78,69,76,0
+ intern L1837
+L1838: 24
+ byte(7)83,89,83,84,69,77,77,65,82,75,65,83,67,76,79,83,69,68,67,72,65,78,78,69,76,0
+ intern L1838
+L1839: 14
+ byte(7)67,76,69,65,82,79,78,69,67,72,65,78,78,69,76,0
+ intern L1839
+L1840: 6
+ byte(7)67,76,69,65,82,73,79,0
+ intern L1840
+L1841: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,84,82,73,78,71,0
+ intern L1841
+L1842: 12
+ byte(7)80,82,79,77,80,84,83,84,82,73,78,71,42,0
+ intern L1842
+L1843: 7
+ byte(7)73,78,73,84,72,69,65,80,0
+ intern L1843
+L1844: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L1844
+L1845: 4
+ byte(7)77,65,73,78,46,0
+ intern L1845
+L1846: 3
+ byte(7)73,78,73,84,0
+ intern L1846
+L1847: 3
+ byte(7)84,73,77,67,0
+ intern L1847
+L1848: 3
+ byte(7)68,65,84,69,0
+ intern L1848
+L1849: 10
+ byte(7)86,69,82,83,73,79,78,78,65,77,69,0
+ intern L1849
+L1850: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L1850
+L1851: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L1851
+L1852: 10
+ byte(7)85,78,68,69,70,78,67,79,68,69,42,0
+ intern L1852
+L1853: 10
+ byte(7)85,78,68,69,70,78,78,65,82,71,42,0
+ intern L1853
+L1854: 3
+ byte(7)70,76,65,71,0
+ intern L1854
+L1855: 9
+ byte(7)87,82,69,77,65,73,78,68,69,82,0
+ intern L1855
+L1856: 7
+ byte(7)72,69,65,80,73,78,70,79,0
+ intern L1856
+L1857: 6
+ byte(7)82,69,67,76,65,73,77,0
+ intern L1857
+L1858: 5
+ byte(7)83,80,65,67,69,68,0
+ intern L1858
+L1859: 5
+ byte(7)68,65,83,72,69,68,0
+ intern L1859
+L1860: 5
+ byte(7)68,79,84,84,69,68,0
+ intern L1860
+L1861: 7
+ byte(7)83,72,79,85,76,68,66,69,0
+ intern L1861
+L1862: 2
+ byte(7)73,78,70,0
+ intern L1862
+L1863: 2
+ byte(7)84,65,71,0
+ intern L1863
+L1864: 5
+ byte(7)77,75,73,84,69,77,0
+ intern L1864
+L1865: 3
+ byte(7)84,73,77,69,0
+ intern L1865
+L1866: 6
+ byte(7)70,85,78,67,65,76,76,0
+ intern L1866
+L1867: 10
+ byte(7)80,82,69,80,65,82,69,84,69,83,84,0
+ intern L1867
+L1868: 11
+ byte(7)77,65,75,69,76,79,78,71,76,73,83,84,0
+ intern L1868
+L1869: 2
+ byte(7)70,79,79,0
+ intern L1869
+L1870: 8
+ byte(7)84,69,83,84,83,69,84,85,80,0
+ intern L1870
+L1871: 7
+ byte(7)84,69,83,84,76,73,83,84,0
+ intern L1871
+L1872: 8
+ byte(7)84,69,83,84,76,73,83,84,50,0
+ intern L1872
+L1873: 7
+ byte(7)69,86,65,76,70,79,82,77,0
+ intern L1873
+L1874: 7
+ byte(7)76,79,78,71,76,73,83,84,0
+ intern L1874
+L1875: 7
+ byte(7)67,68,82,49,84,69,83,84,0
+ intern L1875
+L1876: 7
+ byte(7)67,68,82,50,84,69,83,84,0
+ intern L1876
+L1877: 7
+ byte(7)67,68,68,82,84,69,83,84,0
+ intern L1877
+L1878: 15
+ byte(7)76,73,83,84,79,78,76,89,67,68,82,84,69,83,84,49,0
+ intern L1878
+L1879: 16
+ byte(7)76,73,83,84,79,78,76,89,67,68,68,82,84,69,83,84,49,0
+ intern L1879
+L1880: 15
+ byte(7)76,73,83,84,79,78,76,89,67,68,82,84,69,83,84,50,0
+ intern L1880
+L1881: 16
+ byte(7)76,73,83,84,79,78,76,89,67,68,68,82,84,69,83,84,50,0
+ intern L1881
+L1882: 8
+ byte(7)69,77,80,84,89,84,69,83,84,0
+ intern L1882
+L1883: 12
+ byte(7)83,76,79,87,69,77,80,84,89,84,69,83,84,0
+ intern L1883
+L1884: 10
+ byte(7)82,69,86,69,82,83,69,84,69,83,84,0
+ intern L1884
+L1885: 9
+ byte(7)77,89,82,69,86,69,82,83,69,49,0
+ intern L1885
+L1886: 13
+ byte(7)77,89,82,69,86,69,82,83,69,49,84,69,83,84,0
+ intern L1886
+L1887: 9
+ byte(7)77,89,82,69,86,69,82,83,69,50,0
+ intern L1887
+L1888: 13
+ byte(7)77,89,82,69,86,69,82,83,69,50,84,69,83,84,0
+ intern L1888
+L1889: 9
+ byte(7)76,69,78,71,84,72,84,69,83,84,0
+ intern L1889
+L1890: 3
+ byte(7)70,65,67,84,0
+ intern L1890
+L1891: 13
+ byte(7)65,82,73,84,72,77,69,84,73,67,84,69,83,84,0
+ intern L1891
+L1892: 7
+ byte(7)69,86,65,76,84,69,83,84,0
+ intern L1892
+L1893: 7
+ byte(7)84,73,77,69,69,86,65,76,0
+ intern L1893
+L1894: 2
+ byte(7)84,65,75,0
+ intern L1894
+L1895: 10
+ byte(7)84,79,80,76,69,86,69,76,84,65,75,0
+ intern L1895
+L1896: 3
+ byte(7)71,84,65,75,0
+ intern L1896
+L1897: 11
+ byte(7)84,79,80,76,69,86,69,76,71,84,65,75,0
+ intern L1897
+L1898: 4
+ byte(7)71,84,83,84,65,0
+ intern L1898
+L1899: 4
+ byte(7)71,84,83,84,66,0
+ intern L1899
+L1900: 1
+ byte(7)71,48,0
+ intern L1900
+L1901: 1
+ byte(7)71,49,0
+ intern L1901
+L1902: 6
+ byte(7)78,82,69,67,79,78,67,0
+ intern L1902
+L1903: 7
+ byte(7)78,82,69,86,69,82,83,69,0
+ intern L1903
+L1904: 4
+ byte(7)78,78,73,76,83,0
+ intern L1904
+L1905: 3
+ byte(7)78,73,76,83,0
+ intern L1905
+L1906: 12
+ byte(7)84,69,83,84,71,76,79,66,65,76,86,65,82,0
+ intern L1906
+L1907: 1
+ byte(7)78,82,0
+ intern L1907
+L1908: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L1908
+L1909: 5
+ byte(7)73,79,84,69,83,84,0
+ intern L1909
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/20-tests/main7.rel
Index: psl-1983/20-tests/main7.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main7.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/main7.sym
Index: psl-1983/20-tests/main7.sym
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main7.sym
@@ -0,0 +1,677 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (SETQ LAMBINDARGS!* (GTWARRAY 15)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM
+PRIN1 PRIN2ID PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PUTC PBLANK
+PRIN1INTX LONGDIV LONGREMAINDER BYTE QUIT ERROR CHANNELPRIN2
+CHANNELWRITECHAR INDEPENDENTWRITECHAR WRITECHAR OUT!* ERRORHEADER
+ERRORTRAILER FATALERROR STDERROR NONIDERROR PRIN1T TYPEERROR USAGETYPEERROR
+FN OFFENDER NONNUMBERERROR LAMBINDARGS!* LAMBIND UNBINDN NONINTEGERERROR
+NONPOSITIVEINTEGERERROR WQUOTIENT !%RECLAIM GTHEAP GTSTR GTVECT GTWARRAY
+GTID HARDCONS CONS XCONS NCONS MKVECT LIST2 LIST3 LIST4 LIST5 PUTBYTE
+MKSTRING EQSTR INITREAD !*RAISE CH!* TOK!* TOKTYPE!* DEBUG SETRAISE
+CLEARWHITE CLEARCOMMENT READSTR DIGITP READINT ALPHAESCP READID RATOM WHITEP
+GETC LONGTIMES BUFFERTOSTRING RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP
+LOWERCASEP LOOKUPID INITNEWID MAKEFUNBOUND UPPERCASEP ALPHANUMP READ1 READ
+READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED FUNBOUNDP
+!%COPY!-FUNCTION!-CELL COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL
+MAKEFLAMBDALINK FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!*
+SAVEREGISTERS CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL BINDEVALAUX BINDEVAL LBIND1
+GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK BLDMSG EVPROGN SYS2INT
+PLUS2 MINUS WADD1 ELSE ADD1 WSUB1 SUB1 GREATERP LESSP DIFFERENCE TIMES2 CAR
+CDR CAAR CADR CDAR CDDR ATOM APPEND MEMQ REVERSE EVLIS PROGN EVCOND COND SET
+SETQ PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO LIST ATSOC GEQ LEQ EQCAR GETD
+COPYD DELATQ PUT INITEVAL WHILE FTYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY
+GETFNTYPE LAMBDAAPPLY APPLY DOLAMBDA LENGTH CODEP PAIRP IDP EQ NULL NOT
+LENGTH1 MAPOBL PRINTFEXPRS PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION
+PROP REMPROP SYS2FIXN INFSTARTINGBIT INFBITLENGTH RESET BSTACKOVERFLOW
+ERROUT!* BSTACKUNDERFLOW CAPTUREENVIRONMENT RESTOREENVIRONMENT
+!%CLEAR!-CATCH!-STACK CLEARBINDINGS PBIND1 PROGBIND SYSCLEARIO DEC20OPEN
+SYSOPENREAD SYSOPENWRITE DEC20READCHAR SYSREADREC IOERROR DEC20WRITECHAR
+SYSWRITEREC SYSCLOSE CHANNELERROR SYSMAXBUFFER TERMINALINPUTHANDLER
+WRITEONLYCHANNEL COMPRESSREADCHAR CHANNELNOTOPEN READONLYCHANNEL
+TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR
+ILLEGALSTANDARDCHANNELCLOSE !$EOL!$ RDS WRS OPEN CLOSE TYPEFILE INPUT DSKIN
+!$EOF!$ !*PVAL !*ECHO LAPIN SYSTEMOPENFILEFORINPUT SYSTEMOPENFILEFOROUTPUT
+OUTPUT INDEPENDENTCLOSECHANNEL IN!* STDIN!* STDOUT!* PROMPTOUT!*
+FINDFREECHANNEL IOBUFFER INDEPENDENTREADCHAR SYSTEMOPENFILESPECIAL
+TESTLEGALCHANNEL SYSTEMMARKASCLOSEDCHANNEL CLEARONECHANNEL CLEARIO
+CHANNELWRITESTRING PROMPTSTRING!*)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 399))
+(SETQ STRINGGENSYM!* (QUOTE "L1509"))
+(PUT (QUOTE INFBITLENGTH) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0643"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0237"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0321"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1006"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1115"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE MAXBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1111"))
+(PUT (QUOTE MAXBUFFER) (QUOTE WARRAY) (QUOTE MAXBUFFER))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE ENTRYPOINT) (QUOTE "L1145"))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0325"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L1076"))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0025"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0569"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBIND) (QUOTE ENTRYPOINT) (QUOTE "L1029"))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE FTYPE) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0515"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE WADD1) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1104"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0355"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE DSKIN) (QUOTE ENTRYPOINT) (QUOTE DSKIN))
+(PUT (QUOTE DSKIN) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE INITIALVALUE) (QUOTE 6))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0360"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0230"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 270))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE IN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0436"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0443")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE SYSCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1100"))
+(PUT (QUOTE SYSCLOSE) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1157"))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0183"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE SYSREADREC) (QUOTE ENTRYPOINT) (QUOTE "L1080"))
+(PUT (QUOTE SYSREADREC) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0375"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0185"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L1018"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0184"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE PRIN1T) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE SYSWRITEREC) (QUOTE ENTRYPOINT) (QUOTE "L1092"))
+(PUT (QUOTE SYSWRITEREC) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE IOBUFFER) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0398"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0299"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0674"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0301"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 243))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0369"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE !*ECHO) (QUOTE IDNUMBER) (QUOTE 379))
+(FLAG (QUOTE (!*ECHO)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0103"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0098"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 500))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WSUB1) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE !*PVAL) (QUOTE IDNUMBER) (QUOTE 378))
+(FLAG (QUOTE (!*PVAL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SYSCLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1074"))
+(PUT (QUOTE SYSCLEARIO) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0370"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE ASMSYMBOL) (QUOTE "L1110"))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE WARRAY) (QUOTE CHANNELSTATUS))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE LOOKUPID) (QUOTE ENTRYPOINT) (QUOTE "L0270"))
+(PUT (QUOTE LOOKUPID) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE RESET) (QUOTE ENTRYPOINT) (QUOTE RESET))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0660"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0425"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE CLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1174"))
+(PUT (QUOTE CLEARIO) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0192"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0093"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE NEXTPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1113"))
+(PUT (QUOTE NEXTPOSITION) (QUOTE WARRAY) (QUOTE NEXTPOSITION))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0156"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0287"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0263"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0177"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1007"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE PROGBIND) (QUOTE ENTRYPOINT) (QUOTE "L1032"))
+(PUT (QUOTE PROGBIND) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1165"))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0094"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE SYSOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L1075"))
+(PUT (QUOTE SYSOPENREAD) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0634"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE LAPIN) (QUOTE ENTRYPOINT) (QUOTE LAPIN))
+(PUT (QUOTE LAPIN) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0182"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0603"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0471"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 271))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE CHANNELTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELTABLE) (QUOTE ASMSYMBOL) (QUOTE "L1112"))
+(PUT (QUOTE CHANNELTABLE) (QUOTE WARRAY) (QUOTE CHANNELTABLE))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0021"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0647"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE ENTRYPOINT) (QUOTE "L1150"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1166"))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE ENTRYPOINT) (QUOTE "L1180"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE OUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE STDOUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0186"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1138"))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1161"))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0034"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0330"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 244))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1105"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1168"))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0191"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1096"))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE FN) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0297"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1102"))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1015"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0172"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE ASMSYMBOL) (QUOTE "L1114"))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE WARRAY) (QUOTE BUFFERLENGTH))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0291"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1014"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0665"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0620"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1010"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1107"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0646"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0017"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1108"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1103"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0614"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0402"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0679"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0607"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1013"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0222"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE TYPEFILE) (QUOTE ENTRYPOINT) (QUOTE "L1117"))
+(PUT (QUOTE TYPEFILE) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0339"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE DEC20READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1087"))
+(PUT (QUOTE DEC20READCHAR) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE ERROUT!*) (QUOTE INITIALVALUE) (QUOTE 5))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0642"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0604"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0437"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L1109"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0371"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0099"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE OFFENDER) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0483"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0095"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 268))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0429"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1106"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0224"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L1019"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0509"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0334"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0241"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE INFSTARTINGBIT) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0106"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE STDIN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE ENTRYPOINT) (QUOTE "L1149"))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0295"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0350"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1005"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1153"))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0310"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 241))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE DEC20OPEN) (QUOTE ENTRYPOINT) (QUOTE "L1077"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0233"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 198))
ADDED psl-1983/20-tests/main8.cmd
Index: psl-1983/20-tests/main8.cmd
==================================================================
--- /dev/null
+++ psl-1983/20-tests/main8.cmd
@@ -0,0 +1,2 @@
+main8,dmain8,sub8,dsub8,sub7,Dsub7,sub6,Dsub6,sub5,Dsub5,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/20-tests/module.mic
Index: psl-1983/20-tests/module.mic
==================================================================
--- /dev/null
+++ psl-1983/20-tests/module.mic
@@ -0,0 +1,32 @@
+;; independant compilation a program for the 20
+; MIC MODULE modulename,symbolmname
+@define DSK:, DSK:, PT:, P20:, PI:
+@delete 'A.mac,'A.rel,'A.init
+@delete D'A.mac,D'A.rel
+@exp
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@get s:TEST-DEC20-cross
+@st
+off break; %kill obnoxious break loops
+off USERMODE ;
+InputSymFile!* := "'B.sym"$
+OutputSymFile!* := "'B.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''NIL;
+ ModName!*:='''A;
+ASMOUT "'A"$
+off StandAlone$ % Should emit SYMFNC inits
+IN "'A.red"$
+off pcmac,pgwd; % Suppress echo before INIT
+ASMEnd$
+quit$
+@reset .
+@terminal length 24
+@get sys:macro.exe
+@st
+*'A.rel='A.mac
+*D'A.rel=D'A.mac
+
+@reset .
ADDED psl-1983/20-tests/pk-red.dir
Index: psl-1983/20-tests/pk-red.dir
==================================================================
--- /dev/null
+++ psl-1983/20-tests/pk-red.dir
@@ -0,0 +1,66 @@
+
+ SS:<PSL.KERNEL>
+ ALLOCATORS.RED.4
+ ARITHMETIC.RED.2
+ AUTOLOAD.RED.3
+ AUTOLOAD-TRACE.RED.7
+ BACKTRACE.RED.18
+ BINDING.RED.2
+ BREAK.RED.4
+ CARCDR.RED.1
+ CATCH-THROW.RED.14
+ CHAR-IO.RED.2,3
+ COMP-SUPPORT.RED.1
+ COMPACTING-GC.RED.9
+ CONS-MKVECT.RED.2
+ CONT-ERROR.RED.1
+ COPIERS.RED.2
+ COPYING-GC.RED.9
+ DEFCONST.RED.1
+ DEFINE-SMACRO.RED.3
+ DSKIN.RED.3
+ EASY-NON-SL.RED.5
+ EASY-SL.RED.3
+ EQUAL.RED.2
+ ERROR-ERRORSET.RED.5
+ ERROR-HANDLERS.RED.4
+ EVAL-APPLY.RED.5
+ EVAL-WHEN.RED.1
+ EXPLODE-COMPRESS.RED.3
+ FASL-INCLUDE.RED.1
+ FASLIN.RED.2
+ FAST-BINDER.RED.1
+ FLUID-GLOBAL.RED.1
+ IO-ERRORS.RED.1
+ IO-EXTENSIONS.RED.1
+ KNOWN-TO-COMP-SL.RED.1
+ LISP-MACROS.RED.1
+ LOAD.RED.12
+ LOOP-MACROS.RED.1
+ MINI-EDITOR.RED.3
+ MINI-TRACE.RED.2
+ OBLIST.RED.3
+ OLD-STRING-GENSYM.RED.1
+ ONOFF.RED.1
+ OPEN-CLOSE.RED.1,2
+ OTHER-IO.RED.5
+ OTHERS-SL.RED.1
+ P-APPLY-LAP.RED.1
+ PRINTERS.RED.15
+ PRINTF.RED.3
+ PROG-AND-FRIENDS.RED.2
+ PROPERTY-LIST.RED.1
+ PUTD-GETD.RED.3
+ RDS-WRS.RED.1
+ READ.RED.6
+ SEQUENCE.RED.2
+ SETS.RED.1
+ STRING-GENSYM.RED.2
+ SYMBOL-VALUES.RED.1
+ TOKEN-SCANNER.RED.4
+ TOP-LOOP.RED.12
+ TYPE-CONVERSIONS.RED.1
+ TYPE-ERRORS.RED.1,3
+ VECTORS.RED.2
+
+ Total of 140 pages in 65 files
ADDED psl-1983/20-tests/program.mic
Index: psl-1983/20-tests/program.mic
==================================================================
--- /dev/null
+++ psl-1983/20-tests/program.mic
@@ -0,0 +1,33 @@
+;; Independent compilation a program for the 20
+;; MAIN module and data_segement, do last
+; do PROGRAM modulename
+; modulename=symboltablename
+@define DSK:, DSK:, PT:, P20:, PV:, PI:
+@delete 'A.mac,'A.rel,'A.init
+@delete D'A.mac,D'A.rel
+@exp
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@get s:TEST-DEC20-CROSS.EXE
+@st
+off break; % avoid obnoxios breaks
+InputSymFile!* := "'A.sym"$
+OutputSymFile!* := "'A.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''T;
+ ModName!*:='' 'A;
+ASMOUT "'A"$
+off StandAlone$ % Should emit SYMFNC inits
+IN "'A.red"$
+off pcmac,pgwd; % Suppress echo before INIT
+ASMEnd$
+quit$
+@reset .
+@terminal length 24
+@get sys:macro
+@st
+*'A.rel='A.mac
+*D'A.rel=D'A.mac
+
+@reset .
ADDED psl-1983/20-tests/rand-psl.times
Index: psl-1983/20-tests/rand-psl.times
==================================================================
--- /dev/null
+++ psl-1983/20-tests/rand-psl.times
@@ -0,0 +1,25 @@
+RAND-RELAY (VAX 11/750-1Mb) RAND-UNIX (VAX 11/780 4Mb )
+
+*** GC 5: time 1122 ms,
+EmptyTest 10000 85 0
+SlowEmptyTest 10000 1122 663
+Cdr1Test 100 2074 1632
+Cdr2Test 100 1598 1224
+CddrTest 100 1326 1071
+ListOnlyCdrTest1 9435 7208
+ListOnlyCddrTest1 15283 12410
+ListOnlyCdrTest2 12189 9418
+ListOnlyCddrTest2 18105 15164
+ReverseTest 10 1054 748
+*** GC 6: time 1139 ms, 782 ms,
+MyReverse1Test 10 1156 697
+*** GC 7: time 1224 ms, 646ms
+MyReverse2Test 10 1003 629
+*** GC 8: time 1190 ms, 765 ms
+LengthTest 100 2210 1700
+ArithmeticTest 10000 1938 867
+EvalTest 10000 8687 5083
+tak 18 12 6 1326 765
+gtak 18 12 6 7361 4267
+gtsta g0 5253 2533
+gtsta g1 5355 2465
ADDED psl-1983/20-tests/sub2.init
Index: psl-1983/20-tests/sub2.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub2.init
ADDED psl-1983/20-tests/sub2.mac
Index: psl-1983/20-tests/sub2.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub2.mac
@@ -0,0 +1,1492 @@
+ search monsym
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY CHANNELWRITECHAR EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*LINKE 0 PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+ 2
+; (!*ENTRY CHANNELWRITECHAR EXPR 2)
+L0094: intern L0094
+ MOVE 1,2
+ HRRZI 12,142
+ HRRZI 13,1
+ JRST SYMFNC+142
+; (!*ENTRY WRITECHAR EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$GLOBAL OUT!*) (REG 1))
+; (MOVE (REG 1) (!$GLOBAL OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 152)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY WRITECHAR EXPR 1)
+L0095: intern L0095
+ MOVE 2,1
+ MOVE 1,SYMVAL+154
+ HRRZI 12,152
+ HRRZI 13,2
+ JRST SYMFNC+152
+; (!*ENTRY PRIN1 EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTTYPE (LABEL G0004) (REG 1) ID)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 30)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PRIN1ID EXPR 1)
+; (HRRZI (REG LINKREG) 129)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN1ID))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTINTYPE (LABEL G0005) (REG 1) POSINT)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 31)
+; (JRST "L0108")
+; (CAILE (REG T6) 0)
+; (JRST (LABEL G0005))
+; (!*LINKE 0 PRIN1INT EXPR 1)
+; (HRRZI (REG LINKREG) 130)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN1INT))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTTYPE (LABEL G0006) (REG 1) STR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 4)
+; (JRST (LABEL G0006))
+; (!*LINKE 0 PRIN1STRING EXPR 1)
+; (HRRZI (REG LINKREG) 131)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN1STRING))
+; (!*LBL (LABEL G0006))
+; (!*JUMPNOTTYPE (LABEL G0007) (REG 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 9)
+; (JRST (LABEL G0007))
+; (!*LINKE 0 PRIN1PAIR EXPR 1)
+; (HRRZI (REG LINKREG) 132)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN1PAIR))
+; (!*LBL (LABEL G0007))
+; (!*LINKE 0 PRTITM EXPR 1)
+; (HRRZI (REG LINKREG) 133)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRTITM))
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 1
+; (!*ENTRY PRIN1 EXPR 1)
+PRIN1: intern PRIN1
+ LDB 11,L0107
+ CAIE 11,30
+ JRST L0109
+ HRRZI 12,129
+ HRRZI 13,1
+ JRST SYMFNC+129
+L0109: LDB 11,L0107
+ CAIN 11,31
+ JRST L0108
+ CAILE 11,0
+ JRST L0110
+L0108: HRRZI 12,130
+ HRRZI 13,1
+ JRST SYMFNC+130
+L0110: LDB 11,L0107
+ CAIE 11,4
+ JRST L0111
+ HRRZI 12,131
+ HRRZI 13,1
+ JRST SYMFNC+131
+L0111: LDB 11,L0107
+ CAIE 11,9
+ JRST L0112
+ HRRZI 12,132
+ HRRZI 13,1
+ JRST SYMFNC+132
+L0112: HRRZI 12,133
+ HRRZI 13,1
+ JRST SYMFNC+133
+L0107: point 5,1,4
+; (!*ENTRY PRIN2 EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTTYPE (LABEL G0004) (REG 1) ID)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 30)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PRIN2ID EXPR 1)
+; (HRRZI (REG LINKREG) 135)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2ID))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTINTYPE (LABEL G0005) (REG 1) POSINT)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 31)
+; (JRST "L0114")
+; (CAILE (REG T6) 0)
+; (JRST (LABEL G0005))
+; (!*LINKE 0 PRIN1INT EXPR 1)
+; (HRRZI (REG LINKREG) 130)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN1INT))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTTYPE (LABEL G0006) (REG 1) STR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 4)
+; (JRST (LABEL G0006))
+; (!*LINKE 0 PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2STRING))
+; (!*LBL (LABEL G0006))
+; (!*JUMPNOTTYPE (LABEL G0007) (REG 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 9)
+; (JRST (LABEL G0007))
+; (!*LINKE 0 PRIN2PAIR EXPR 1)
+; (HRRZI (REG LINKREG) 137)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2PAIR))
+; (!*LBL (LABEL G0007))
+; (!*LINKE 0 PRTITM EXPR 1)
+; (HRRZI (REG LINKREG) 133)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRTITM))
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+ 1
+; (!*ENTRY PRIN2 EXPR 1)
+PRIN2: intern PRIN2
+ LDB 11,L0113
+ CAIE 11,30
+ JRST L0115
+ HRRZI 12,135
+ HRRZI 13,1
+ JRST SYMFNC+135
+L0115: LDB 11,L0113
+ CAIN 11,31
+ JRST L0114
+ CAILE 11,0
+ JRST L0116
+L0114: HRRZI 12,130
+ HRRZI 13,1
+ JRST SYMFNC+130
+L0116: LDB 11,L0113
+ CAIE 11,4
+ JRST L0117
+ HRRZI 12,136
+ HRRZI 13,1
+ JRST SYMFNC+136
+L0117: LDB 11,L0113
+ CAIE 11,9
+ JRST L0118
+ HRRZI 12,137
+ HRRZI 13,1
+ JRST SYMFNC+137
+L0118: HRRZI 12,133
+ HRRZI 13,1
+ JRST SYMFNC+133
+L0113: point 5,1,4
+; (!*ENTRY PRINT EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PRINT EXPR 1)
+PRINT: intern PRINT
+ PUSH 15,1
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY PRIN2T EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PRIN2T EXPR 1)
+PRIN2T: intern PRIN2T
+ PUSH 15,1
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY PBLANK EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 32) (REG 1))
+; (HRRZI (REG 1) 32)
+; (!*LINKE 0 PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+ 0
+; (!*ENTRY PBLANK EXPR 0)
+PBLANK: intern PBLANK
+ HRRZI 1,32
+ HRRZI 12,142
+ HRRZI 13,1
+ JRST SYMFNC+142
+; (!*ENTRY PRIN1INT EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (WCONST 0))
+; (JUMPN (REG 1) (LABEL G0004))
+; (!*MOVE (WCONST 48) (REG 1))
+; (HRRZI (REG 1) 48)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*JUMP (LABEL G0003))
+; (JRST (LABEL G0003))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWGEQ (LABEL G0005) (REG 1) (WCONST 0))
+; (JUMPGE (REG 1) (LABEL G0005))
+; (!*MOVE (WCONST 45) (REG 1))
+; (HRRZI (REG 1) 45)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*WMINUS (REG 1) (FRAME 1))
+; (MOVN (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1INT EXPR 1)
+; (HRRZI (REG LINKREG) 130)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY PRIN1INT))
+; (!*JUMP (LABEL G0003))
+; (JRST (LABEL G0003))
+; (!*LBL (LABEL G0005))
+; (!*LINK PRIN1INTX EXPR 1)
+; (HRRZI (REG LINKREG) 144)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1INTX))
+; (!*LBL (LABEL G0003))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PRIN1INT EXPR 1)
+L0017: intern L0017
+ PUSH 15,1
+ JUMPN 1,L0119
+ HRRZI 1,48
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ JRST L0120
+L0119: JUMPGE 1,L0121
+ HRRZI 1,45
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ MOVN 1,0(15)
+ HRRZI 12,130
+ HRRZI 13,1
+ PUSHJ 15,L0017
+ JRST L0120
+L0121: HRRZI 12,144
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+144
+L0120: MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY PRIN1INTX EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (WCONST 0))
+; (JUMPN (REG 1) (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (WCONST 10) (REG 2))
+; (HRRZI (REG 2) 10)
+; (!*LINK LONGDIV EXPR 2)
+; (HRRZI (REG LINKREG) 145)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LONGDIV))
+; (!*LINK PRIN1INTX EXPR 1)
+; (HRRZI (REG LINKREG) 144)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY PRIN1INTX))
+; (!*MOVE (WCONST 10) (REG 2))
+; (HRRZI (REG 2) 10)
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LONGREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LONGREMAINDER))
+; (!*WPLUS2 (REG 1) (WCONST 48))
+; (ADDI (REG 1) 48)
+; (!*LINKE 1 PUTC EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PRIN1INTX EXPR 1)
+L0021: intern L0021
+ PUSH 15,1
+ JUMPN 1,L0122
+ MOVE 1,0
+ JRST L0123
+L0122: HRRZI 2,10
+ HRRZI 12,145
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+145
+ HRRZI 12,144
+ HRRZI 13,1
+ PUSHJ 15,L0021
+ HRRZI 2,10
+ MOVE 1,0(15)
+ HRRZI 12,146
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+146
+ ADDI 1,48
+ ADJSP 15,-1
+ HRRZI 12,142
+ HRRZI 13,1
+ JRST SYMFNC+142
+L0123: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY PRIN1ID EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*MOVE (MEMORY (REG 1) (WCONST SYMNAM)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE SYMNAM)))
+; (!*LINK PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2STRING))
+; (!*LINK PBLANK EXPR 0)
+; (HRRZI (REG LINKREG) 143)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY PBLANK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PRIN1ID EXPR 1)
+L0024: intern L0024
+ PUSH 15,1
+ HRRZ 1,1
+ MOVE 1,SYMNAM(1)
+ HRRZI 12,136
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+136
+ HRRZI 12,143
+ SETZM 13
+ PUSHJ 15,SYMFNC+143
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY PRIN2ID EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PRIN1ID EXPR 1)
+; (HRRZI (REG LINKREG) 129)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN1ID))
+ 1
+; (!*ENTRY PRIN2ID EXPR 1)
+L0025: intern L0025
+ HRRZI 12,129
+ HRRZI 13,1
+ JRST SYMFNC+129
+; (!*ENTRY PRIN1STRING EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (WCONST 34) (REG 1))
+; (HRRZI (REG 1) 34)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2STRING))
+; (!*MOVE (WCONST 34) (REG 1))
+; (HRRZI (REG 1) 34)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK PBLANK EXPR 0)
+; (HRRZI (REG LINKREG) 143)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY PBLANK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PRIN1STRING EXPR 1)
+L0026: intern L0026
+ PUSH 15,1
+ HRRZI 1,34
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ MOVE 1,0(15)
+ HRRZI 12,136
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+136
+ HRRZI 1,34
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ HRRZI 12,143
+ SETZM 13
+ PUSHJ 15,SYMFNC+143
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY PRIN2STRING EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*FIELD (REG 2) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 2) (REG 1))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0005))
+; (!*SIGNEDFIELD (REG 1) (MEMORY (FRAME 2) (WCONST 0)) (WCONST 18) (WCONST 18))
+; (HRRE (REG 1) (INDIRECT (INDEXED (REG ST) -1)))
+; (!*JUMPWGREATERP (LABEL G0004) (FRAME 3) (REG 1))
+; (CAMGE (REG 1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0004))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 1
+; (!*ENTRY PRIN2STRING EXPR 1)
+L0028: intern L0028
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZ 2,1
+ MOVEM 2,-1(15)
+ SETZM -2(15)
+L0125: HRRE 1,@-1(15)
+ CAMGE 1,-2(15)
+ JRST L0126
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ AOS 1
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L0124
+ LDB 1,2
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ AOS -2(15)
+ JRST L0125
+L0126: MOVE 1,0(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L0124: point 7,0(1),6
+; (!*ENTRY PRIN1PAIR EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (WCONST 40) (REG 1))
+; (HRRZI (REG 1) 40)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (CAR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (CDR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0004))
+; (!*JUMPTYPE (LABEL G0005) (FRAME 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0003))
+; (JRST (LABEL G0003))
+; (!*LBL (LABEL G0005))
+; (!*LINK PBLANK EXPR 0)
+; (HRRZI (REG LINKREG) 143)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY PBLANK))
+; (!*MOVE (CAR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (CDR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0003))
+; (!*JUMPEQ (LABEL G0008) (FRAME 1) (QUOTE NIL))
+; (CAMN (REG NIL) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE " . ") (REG 1))
+; (MOVE (REG 1) (QUOTE " . "))
+; (!*LINK PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2STRING))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (WCONST 41) (REG 1))
+; (HRRZI (REG 1) 41)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK PBLANK EXPR 0)
+; (HRRZI (REG LINKREG) 143)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY PBLANK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))
+L0129: 2
+ byte(7)32,46,32,0
+ 1
+; (!*ENTRY PRIN1PAIR EXPR 1)
+L0034: intern L0034
+ PUSH 15,1
+ HRRZI 1,40
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+L0130: LDB 11,L0127
+ CAIN 11,9
+ JRST L0131
+ MOVE 1,0
+ JRST L0132
+L0131: HRRZI 12,143
+ SETZM 13
+ PUSHJ 15,SYMFNC+143
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0130
+L0132: CAMN 0,0(15)
+ JRST L0133
+ MOVE 1,L0128
+ HRRZI 12,136
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+136
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+L0133: HRRZI 1,41
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ HRRZI 12,143
+ SETZM 13
+ PUSHJ 15,SYMFNC+143
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L0127: point 5,0(15),4
+L0128: <4_31>+L0129
+; (!*ENTRY PRIN2PAIR EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (WCONST 40) (REG 1))
+; (HRRZI (REG 1) 40)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (CAR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (CDR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0004))
+; (!*JUMPTYPE (LABEL G0005) (FRAME 1) PAIR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))))
+; (CAIN (REG T6) 9)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0003))
+; (JRST (LABEL G0003))
+; (!*LBL (LABEL G0005))
+; (!*LINK PBLANK EXPR 0)
+; (HRRZI (REG LINKREG) 143)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY PBLANK))
+; (!*MOVE (CAR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (CDR (FRAME 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0003))
+; (!*JUMPEQ (LABEL G0008) (FRAME 1) (QUOTE NIL))
+; (CAMN (REG NIL) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE " . ") (REG 1))
+; (MOVE (REG 1) (QUOTE " . "))
+; (!*LINK PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2STRING))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (WCONST 41) (REG 1))
+; (HRRZI (REG 1) 41)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK PBLANK EXPR 0)
+; (HRRZI (REG LINKREG) 143)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY PBLANK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))
+L0136: 2
+ byte(7)32,46,32,0
+ 1
+; (!*ENTRY PRIN2PAIR EXPR 1)
+L0042: intern L0042
+ PUSH 15,1
+ HRRZI 1,40
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+L0137: LDB 11,L0134
+ CAIN 11,9
+ JRST L0138
+ MOVE 1,0
+ JRST L0139
+L0138: HRRZI 12,143
+ SETZM 13
+ PUSHJ 15,SYMFNC+143
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0137
+L0139: CAMN 0,0(15)
+ JRST L0140
+ MOVE 1,L0135
+ HRRZI 12,136
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+136
+ MOVE 1,0(15)
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+L0140: HRRZI 1,41
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ HRRZI 12,143
+ SETZM 13
+ PUSHJ 15,SYMFNC+143
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L0134: point 5,0(15),4
+L0135: <4_31>+L0136
+; (!*ENTRY TERPRI EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINKE 0 PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+ 0
+; (!*ENTRY TERPRI EXPR 0)
+TERPRI: intern TERPRI
+ HRRZI 1,10
+ HRRZI 12,142
+ HRRZI 13,1
+ JRST SYMFNC+142
+; (!*ENTRY PRTITM EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE " <") (REG 1))
+; (MOVE (REG 1) (QUOTE " <"))
+; (!*LINK PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2STRING))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 0) (WCONST 5))
+; (LDB (REG 1) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))))
+; (!*LINK PRIN1INT EXPR 1)
+; (HRRZI (REG LINKREG) 130)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1INT))
+; (!*MOVE (WCONST 58) (REG 1))
+; (HRRZI (REG 1) 58)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*FIELD (REG 1) (FRAME 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1INT EXPR 1)
+; (HRRZI (REG LINKREG) 130)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1INT))
+; (!*MOVE (QUOTE "> ") (REG 1))
+; (MOVE (REG 1) (QUOTE "> "))
+; (!*LINK PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2STRING))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) 0) 0 5))
+L0144: 1
+ byte(7)62,32,0
+L0145: 1
+ byte(7)32,60,0
+ 1
+; (!*ENTRY PRTITM EXPR 1)
+PRTITM: intern PRTITM
+ PUSH 15,1
+ MOVE 1,L0141
+ HRRZI 12,136
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+136
+ LDB 1,L0142
+ HRRZI 12,130
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+130
+ HRRZI 1,58
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ HRRZ 1,0(15)
+ HRRZI 12,130
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+130
+ MOVE 1,L0143
+ HRRZI 12,136
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+136
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L0142: point 5,0(15),4
+L0143: <4_31>+L0144
+L0141: <4_31>+L0145
+; (!*ENTRY CHANNELPRIN2 EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*LINKE 0 PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2))
+ 2
+; (!*ENTRY CHANNELPRIN2 EXPR 2)
+L0093: intern L0093
+ MOVE 1,2
+ HRRZI 12,138
+ HRRZI 13,1
+ JRST SYMFNC+138
+; (!*ENTRY ERRORHEADER EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "*** ERROR *** ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** ERROR *** "))
+; (!*LINKE 0 PRIN2STRING EXPR 1)
+; (HRRZI (REG LINKREG) 136)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PRIN2STRING))
+L0147: 13
+ byte(7)42,42,42,32,69,82,82,79,82,32,42,42,42,32,0
+ 0
+; (!*ENTRY ERRORHEADER EXPR 0)
+L0098: intern L0098
+ MOVE 1,L0146
+ HRRZI 12,136
+ HRRZI 13,1
+ JRST SYMFNC+136
+L0146: <4_31>+L0147
+; (!*ENTRY ERROR EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK ERRORHEADER EXPR 0)
+; (HRRZI (REG LINKREG) 155)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY ERRORHEADER))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 ERRORTRAILER EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 156)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY ERRORTRAILER))
+ 1
+; (!*ENTRY ERROR EXPR 1)
+ERROR: intern ERROR
+ PUSH 15,1
+ HRRZI 12,155
+ SETZM 13
+ PUSHJ 15,SYMFNC+155
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,156
+ HRRZI 13,1
+ JRST SYMFNC+156
+; (!*ENTRY ERRORTRAILER EXPR 1)
+; (!*ALLOC 0)
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY ERRORTRAILER EXPR 1)
+L0099: intern L0099
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY FATALERROR EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK ERRORHEADER EXPR 0)
+; (HRRZI (REG LINKREG) 155)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY ERRORHEADER))
+; (!*MOVE (QUOTE " FATAL ") (REG 1))
+; (MOVE (REG 1) (QUOTE " FATAL "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 ERRORTRAILER EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 156)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY ERRORTRAILER))
+L0149: 6
+ byte(7)32,70,65,84,65,76,32,0
+ 1
+; (!*ENTRY FATALERROR EXPR 1)
+L0102: intern L0102
+ PUSH 15,1
+ HRRZI 12,155
+ SETZM 13
+ PUSHJ 15,SYMFNC+155
+ MOVE 1,L0148
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,156
+ HRRZI 13,1
+ JRST SYMFNC+156
+L0148: <4_31>+L0149
+; (!*ENTRY STDERROR EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 ERROR EXPR 1)
+; (HRRZI (REG LINKREG) 149)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY ERROR))
+ 1
+; (!*ENTRY STDERROR EXPR 1)
+L0103: intern L0103
+ HRRZI 12,149
+ HRRZI 13,1
+ JRST SYMFNC+149
+; (!*ENTRY TYPEERROR EXPR 3)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*LINK ERRORHEADER EXPR 0)
+; (HRRZI (REG LINKREG) 155)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY ERRORHEADER))
+; (!*MOVE (QUOTE "An attempt was made to do") (REG 1))
+; (MOVE (REG 1) (QUOTE "An attempt was made to do"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " on `") (REG 1))
+; (MOVE (REG 1) (QUOTE " on `"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE ", which is not ") (REG 1))
+; (MOVE (REG 1) (QUOTE ", which is not "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN1T EXPR 1)
+; (HRRZI (REG LINKREG) 160)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+L0153: 14
+ byte(7)44,32,119,104,105,99,104,32,105,115,32,110,111,116,32,0
+L0154: 4
+ byte(7)32,111,110,32,96,0
+L0155: 24
+ byte(7)65,110,32,97,116,116,101,109,112,116,32,119,97,115,32,109,97,100,101,32,116,111,32,100,111,0
+ 3
+; (!*ENTRY TYPEERROR EXPR 3)
+L0156: intern L0156
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ HRRZI 12,155
+ SETZM 13
+ PUSHJ 15,SYMFNC+155
+ MOVE 1,L0150
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L0151
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L0152
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-2(15)
+ HRRZI 12,160
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+160
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L0152: <4_31>+L0153
+L0151: <4_31>+L0154
+L0150: <4_31>+L0155
+; (!*ENTRY USAGETYPEERROR EXPR 4)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 4) (FRAME 3))
+; (MOVEM (REG 4) (INDEXED (REG ST) -2))
+; (!*LINK ERRORHEADER EXPR 0)
+; (HRRZI (REG LINKREG) 155)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY ERRORHEADER))
+; (!*MOVE (QUOTE "An attempt was made to use") (REG 1))
+; (MOVE (REG 1) (QUOTE "An attempt was made to use"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " as ") (REG 1))
+; (MOVE (REG 1) (QUOTE " as "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " in `") (REG 1))
+; (MOVE (REG 1) (QUOTE " in `"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (QUOTE " is needed") (REG 1))
+; (MOVE (REG 1) (QUOTE " is needed"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+L0161: 9
+ byte(7)32,105,115,32,110,101,101,100,101,100,0
+L0162: 4
+ byte(7)32,105,110,32,96,0
+L0163: 3
+ byte(7)32,97,115,32,0
+L0164: 25
+ byte(7)65,110,32,97,116,116,101,109,112,116,32,119,97,115,32,109,97,100,101,32,116,111,32,117,115,101,0
+ 4
+; (!*ENTRY USAGETYPEERROR EXPR 4)
+L0165: intern L0165
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 4,-2(15)
+ HRRZI 12,155
+ SETZM 13
+ PUSHJ 15,SYMFNC+155
+ MOVE 1,L0157
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L0158
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-2(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L0159
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,0
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L0160
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L0160: <4_31>+L0161
+L0159: <4_31>+L0162
+L0158: <4_31>+L0163
+L0157: <4_31>+L0164
+; (!*ENTRY NONIDERROR EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "an identifier") (REG 3))
+; (MOVE (REG 3) (QUOTE "an identifier"))
+; (!*MOVE (!$FLUID FN) (REG 2))
+; (MOVE (REG 2) (!$FLUID FN))
+; (!*MOVE (!$FLUID OFFENDER) (REG 1))
+; (MOVE (REG 1) (!$FLUID OFFENDER))
+; (!*LINKE 0 TYPEERROR EXPR 3)
+; (HRRZI (REG LINKREG) 161)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY TYPEERROR))
+L0167: 12
+ byte(7)97,110,32,105,100,101,110,116,105,102,105,101,114,0
+ 2
+; (!*ENTRY NONIDERROR EXPR 2)
+L0106: intern L0106
+ MOVE 3,L0166
+ MOVE 2,SYMVAL+163
+ MOVE 1,SYMVAL+164
+ HRRZI 12,161
+ HRRZI 13,3
+ JRST SYMFNC+161
+L0166: <4_31>+L0167
+; (!*ENTRY NONNUMBERERROR EXPR 2)
+; (!*ALLOC 0)
+; (!*LAMBIND (REGISTERS (REG 2) (REG 1)) (NONLOCALVARS (!$FLUID FN) (!$FLUID OFFENDER)))
+; (MOVEM (REG 2) (INDIRECT (FLUID LAMBINDARGS!*)))
+; (MOVE (REG 2) (FLUID LAMBINDARGS!*))
+; (MOVEM (REG 1) (INDEXED (REG 2) 1))
+; (MOVE (REG 1) (QUOTE [FN OFFENDER]))
+; (PUSHJ (REG ST) (ENTRY LAMBIND))
+; (!*MOVE (QUOTE "a number") (REG 3))
+; (MOVE (REG 3) (QUOTE "a number"))
+; (!*MOVE (!$FLUID FN) (REG 2))
+; (MOVE (REG 2) (!$FLUID FN))
+; (!*MOVE (!$FLUID OFFENDER) (REG 1))
+; (MOVE (REG 1) (!$FLUID OFFENDER))
+; (!*LINK TYPEERROR EXPR 3)
+; (HRRZI (REG LINKREG) 161)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TYPEERROR))
+; (!*FREERSTR (NONLOCALVARS (!$FLUID FN) (!$FLUID OFFENDER)))
+; (HRRZI (REG 1) 2)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0170: 7
+ byte(7)97,32,110,117,109,98,101,114,0
+L0171: 1
+ <30_31>+163
+ <30_31>+164
+ 2
+; (!*ENTRY NONNUMBERERROR EXPR 2)
+L0172: intern L0172
+ MOVEM 2,@SYMVAL+166
+ MOVE 2,SYMVAL+166
+ MOVEM 1,1(2)
+ MOVE 1,L0168
+ PUSHJ 15,SYMFNC+167
+ MOVE 3,L0169
+ MOVE 2,SYMVAL+163
+ MOVE 1,SYMVAL+164
+ HRRZI 12,161
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+161
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+168
+ POPJ 15,0
+L0169: <4_31>+L0170
+L0168: <8_31>+L0171
+; (!*ENTRY NONINTEGERERROR EXPR 2)
+; (!*ALLOC 0)
+; (!*LAMBIND (REGISTERS (REG 2) (REG 1)) (NONLOCALVARS (!$FLUID FN) (!$FLUID OFFENDER)))
+; (MOVEM (REG 2) (INDIRECT (FLUID LAMBINDARGS!*)))
+; (MOVE (REG 2) (FLUID LAMBINDARGS!*))
+; (MOVEM (REG 1) (INDEXED (REG 2) 1))
+; (MOVE (REG 1) (QUOTE [FN OFFENDER]))
+; (PUSHJ (REG ST) (ENTRY LAMBIND))
+; (!*MOVE (QUOTE "an integer") (REG 3))
+; (MOVE (REG 3) (QUOTE "an integer"))
+; (!*MOVE (!$FLUID FN) (REG 2))
+; (MOVE (REG 2) (!$FLUID FN))
+; (!*MOVE (!$FLUID OFFENDER) (REG 1))
+; (MOVE (REG 1) (!$FLUID OFFENDER))
+; (!*LINK TYPEERROR EXPR 3)
+; (HRRZI (REG LINKREG) 161)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TYPEERROR))
+; (!*FREERSTR (NONLOCALVARS (!$FLUID FN) (!$FLUID OFFENDER)))
+; (HRRZI (REG 1) 2)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0175: 9
+ byte(7)97,110,32,105,110,116,101,103,101,114,0
+L0176: 1
+ <30_31>+163
+ <30_31>+164
+ 2
+; (!*ENTRY NONINTEGERERROR EXPR 2)
+L0177: intern L0177
+ MOVEM 2,@SYMVAL+166
+ MOVE 2,SYMVAL+166
+ MOVEM 1,1(2)
+ MOVE 1,L0173
+ PUSHJ 15,SYMFNC+167
+ MOVE 3,L0174
+ MOVE 2,SYMVAL+163
+ MOVE 1,SYMVAL+164
+ HRRZI 12,161
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+161
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+168
+ POPJ 15,0
+L0174: <4_31>+L0175
+L0173: <8_31>+L0176
+; (!*ENTRY NONPOSITIVEINTEGERERROR EXPR 2)
+; (!*ALLOC 0)
+; (!*LAMBIND (REGISTERS (REG 2) (REG 1)) (NONLOCALVARS (!$FLUID FN) (!$FLUID OFFENDER)))
+; (MOVEM (REG 2) (INDIRECT (FLUID LAMBINDARGS!*)))
+; (MOVE (REG 2) (FLUID LAMBINDARGS!*))
+; (MOVEM (REG 1) (INDEXED (REG 2) 1))
+; (MOVE (REG 1) (QUOTE [FN OFFENDER]))
+; (PUSHJ (REG ST) (ENTRY LAMBIND))
+; (!*MOVE (QUOTE "a non-negative integer") (REG 3))
+; (MOVE (REG 3) (QUOTE "a non-negative integer"))
+; (!*MOVE (!$FLUID FN) (REG 2))
+; (MOVE (REG 2) (!$FLUID FN))
+; (!*MOVE (!$FLUID OFFENDER) (REG 1))
+; (MOVE (REG 1) (!$FLUID OFFENDER))
+; (!*LINK TYPEERROR EXPR 3)
+; (HRRZI (REG LINKREG) 161)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TYPEERROR))
+; (!*FREERSTR (NONLOCALVARS (!$FLUID FN) (!$FLUID OFFENDER)))
+; (HRRZI (REG 1) 2)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0180: 21
+ byte(7)97,32,110,111,110,45,110,101,103,97,116,105,118,101,32,105,110,116,101,103,101,114,0
+L0181: 1
+ <30_31>+163
+ <30_31>+164
+ 2
+; (!*ENTRY NONPOSITIVEINTEGERERROR EXPR 2)
+L0182: intern L0182
+ MOVEM 2,@SYMVAL+166
+ MOVE 2,SYMVAL+166
+ MOVEM 1,1(2)
+ MOVE 1,L0178
+ PUSHJ 15,SYMFNC+167
+ MOVE 3,L0179
+ MOVE 2,SYMVAL+163
+ MOVE 1,SYMVAL+164
+ HRRZI 12,161
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+161
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+168
+ POPJ 15,0
+L0179: <4_31>+L0180
+L0178: <8_31>+L0181
+ end
ADDED psl-1983/20-tests/sub2.rel
Index: psl-1983/20-tests/sub2.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub2.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/sub20.mac
Index: psl-1983/20-tests/sub20.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub20.mac
@@ -0,0 +1,58 @@
+ search monsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ JRST INIT20
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SETZM 1
+ JRST GETC20
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ JRST TIMC20
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ JRST PUTC20
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ JRST QUIT20
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ JRST PUTI20
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 1)
+L0003: intern L0003
+ HRRZI 1,1
+ PUSHJ 15,ERR20
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ HRRZI 1,2
+ PUSHJ 15,ERR20
+; (!*ENTRY !*WTIMES32 EXPR 2)
+L0004: intern L0004
+ IMUL 1,2
+ POPJ 15,0
+ end
ADDED psl-1983/20-tests/sub3.init
Index: psl-1983/20-tests/sub3.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub3.init
ADDED psl-1983/20-tests/sub3.mac
Index: psl-1983/20-tests/sub3.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub3.mac
@@ -0,0 +1,785 @@
+ search monsym
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ extern L0183
+ extern L0184
+ extern L0185
+ extern L0186
+; (!*ENTRY GTHEAP EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 1) (REG 2))
+; (HRRZI (REG 2) 1)
+; (!*MOVE (WVAR HEAPUPPERBOUND) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPUPPERBOUND))
+; (!*WDIFFERENCE (REG 1) (WVAR HEAPLAST))
+; (SUB (REG 1) (WVAR HEAPLAST))
+; (!*LINKE 1 WQUOTIENT EXPR 2)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (WVAR HEAPLAST) (WVAR HEAPPREVIOUSLAST))
+; (MOVE (REG T1) (WVAR HEAPLAST))
+; (MOVEM (REG T1) (WVAR HEAPPREVIOUSLAST))
+; (!*WPLUS2 (WVAR HEAPLAST) (REG 1))
+; (ADDM (REG 1) (WVAR HEAPLAST))
+; (!*JUMPWGEQ (LABEL G0006) (WVAR HEAPUPPERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPUPPERBOUND))
+; (CAML (REG T1) (WVAR HEAPLAST))
+; (JRST (LABEL G0006))
+; (!*LINK !%RECLAIM EXPR 0)
+; (HRRZI (REG LINKREG) 172)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY !%RECLAIM))
+; (!*MOVE (WVAR HEAPLAST) (WVAR HEAPPREVIOUSLAST))
+; (MOVE (REG T1) (WVAR HEAPLAST))
+; (MOVEM (REG T1) (WVAR HEAPPREVIOUSLAST))
+; (!*WPLUS2 (WVAR HEAPLAST) (FRAME 1))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (ADDM (REG T2) (WVAR HEAPLAST))
+; (!*JUMPWGEQ (LABEL G0006) (WVAR HEAPUPPERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPUPPERBOUND))
+; (CAML (REG T1) (WVAR HEAPLAST))
+; (JRST (LABEL G0006))
+; (!*MOVE (QUOTE "Heap space exhausted") (REG 1))
+; (MOVE (REG 1) (QUOTE "Heap space exhausted"))
+; (!*LINK FATALERROR EXPR 1)
+; (HRRZI (REG LINKREG) 157)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FATALERROR))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (WVAR HEAPPREVIOUSLAST) (REG 1))
+; (MOVE (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+L0188: 19
+ byte(7)72,101,97,112,32,115,112,97,99,101,32,101,120,104,97,117,115,116,101,100,0
+ 1
+; (!*ENTRY GTHEAP EXPR 1)
+GTHEAP: intern GTHEAP
+ PUSH 15,1
+ CAME 1,0
+ JRST L0189
+ HRRZI 2,1
+ MOVE 1,L0184
+ SUB 1,L0185
+ ADJSP 15,-1
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+L0189: MOVE 6,L0185
+ MOVEM 6,L0186
+ ADDM 1,L0185
+ MOVE 6,L0184
+ CAML 6,L0185
+ JRST L0190
+ HRRZI 12,172
+ SETZM 13
+ PUSHJ 15,SYMFNC+172
+ MOVE 6,L0185
+ MOVEM 6,L0186
+ MOVE 7,0(15)
+ ADDM 7,L0185
+ MOVE 6,L0184
+ CAML 6,L0185
+ JRST L0190
+ MOVE 1,L0187
+ HRRZI 12,157
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+157
+L0190: MOVE 1,L0186
+ ADJSP 15,-1
+ POPJ 15,0
+L0187: <4_31>+L0188
+; (!*ENTRY GTSTR EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (WCONST 5) (REG 2))
+; (HRRZI (REG 2) 5)
+; (!*WPLUS2 (REG 1) (WCONST 6))
+; (ADDI (REG 1) 6)
+; (!*LINK WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 171)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK GTHEAP EXPR 1)
+; (HRRZI (REG LINKREG) 173)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GTHEAP))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*MKITEM (REG 1) (WCONST 23))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 23 13))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDIRECT (INDEXED (REG ST) -1)))
+; (!*MOVE (FRAME 3) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 3) (FRAME 2))
+; (ADD (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 0) (MEMORY (REG 3) (WCONST 0)))
+; (SETZM (INDEXED (REG 3) 0))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY GTSTR EXPR 1)
+GTSTR: intern GTSTR
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZI 2,5
+ ADDI 1,6
+ HRRZI 12,171
+ HRRZI 13,2
+ IDIV 1,2
+ MOVEM 1,-2(15)
+ AOS 1
+ HRRZI 12,173
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+173
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ TLZ 1,253952
+ TLO 1,188416
+ MOVEM 1,@-1(15)
+ MOVE 3,-2(15)
+ ADD 3,-1(15)
+ SETZM 0(3)
+ MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY GTVECT EXPR 1)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 1) (WCONST 2))
+; (ADDI (REG 1) 2)
+; (!*LINK GTHEAP EXPR 1)
+; (HRRZI (REG LINKREG) 173)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GTHEAP))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*MKITEM (REG 1) (WCONST 26))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 26 13))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDIRECT (INDEXED (REG ST) -1)))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY GTVECT EXPR 1)
+GTVECT: intern GTVECT
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ ADDI 1,2
+ HRRZI 12,173
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+173
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ TLZ 1,253952
+ TLO 1,212992
+ MOVEM 1,@-1(15)
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+; (!*ENTRY GTWARRAY EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 GTVECT EXPR 1)
+; (HRRZI (REG LINKREG) 175)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY GTVECT))
+ 1
+; (!*ENTRY GTWARRAY EXPR 1)
+L0191: intern L0191
+ HRRZI 12,175
+ HRRZI 13,1
+ JRST SYMFNC+175
+; (!*ENTRY GTID EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR NEXTSYMBOL) (REG 2))
+; (MOVE (REG 2) (WVAR NEXTSYMBOL))
+; (!*WPLUS2 (WVAR NEXTSYMBOL) (WCONST 1))
+; (AOS (WVAR NEXTSYMBOL))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY GTID EXPR 0)
+GTID: intern GTID
+ MOVE 2,L0003
+ AOS L0003
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY HARDCONS EXPR 2)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 2) (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINK GTHEAP EXPR 1)
+; (HRRZI (REG LINKREG) 173)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GTHEAP))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 1) (MEMORY (REG 1) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (MOVEM (REG T1) (INDEXED (REG 1) 0))
+; (!*MOVE (FRAME 2) (MEMORY (REG 1) (WCONST 1)))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (MOVEM (REG T1) (INDEXED (REG 1) 1))
+; (!*MKITEM (REG 1) (WCONST 9))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 9 13))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY HARDCONS EXPR 2)
+L0192: intern L0192
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ HRRZI 1,2
+ HRRZI 12,173
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+173
+ MOVEM 1,-2(15)
+ MOVE 6,0(15)
+ MOVEM 6,0(1)
+ MOVE 6,-1(15)
+ MOVEM 6,1(1)
+ TLZ 1,253952
+ TLO 1,73728
+ ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY CONS EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 HARDCONS EXPR 2)
+; (HRRZI (REG LINKREG) 178)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY HARDCONS))
+ 2
+; (!*ENTRY CONS EXPR 2)
+CONS: intern CONS
+ HRRZI 12,178
+ HRRZI 13,2
+ JRST SYMFNC+178
+; (!*ENTRY XCONS EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 3))
+; (MOVE (REG 3) (REG 2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*LINKE 0 HARDCONS EXPR 2)
+; (HRRZI (REG LINKREG) 178)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY HARDCONS))
+ 2
+; (!*ENTRY XCONS EXPR 2)
+XCONS: intern XCONS
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,3
+ HRRZI 12,178
+ HRRZI 13,2
+ JRST SYMFNC+178
+; (!*ENTRY NCONS EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*LINKE 0 HARDCONS EXPR 2)
+; (HRRZI (REG LINKREG) 178)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY HARDCONS))
+ 1
+; (!*ENTRY NCONS EXPR 1)
+NCONS: intern NCONS
+ MOVE 2,0
+ HRRZI 12,178
+ HRRZI 13,2
+ JRST SYMFNC+178
+; (!*ENTRY MKVECT EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPNOTINTYPE (LABEL G0004) (REG 1) POSINT)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 31)
+; (JRST "L0193")
+; (CAILE (REG T6) 0)
+; (JRST (LABEL G0004))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPWGEQ (LABEL G0006) (REG 1) (WCONST -1))
+; (CAML (REG 1) (LIT (FULLWORD -1)))
+; (JRST (LABEL G0006))
+; (!*MOVE (QUOTE "A vector with fewer than zero elements cannot be allocated") (REG 1))
+; (MOVE (REG 1) (QUOTE "A vector with fewer than zero elements cannot be allocated"))
+; (!*LINKE 3 STDERROR EXPR 1)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY STDERROR))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*LINK GTVECT EXPR 1)
+; (HRRZI (REG LINKREG) 175)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GTVECT))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (FRAME 3))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -2))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0011))
+; (!*JUMPWGREATERP (LABEL G0010) (FRAME 3) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -2))
+; (CAMLE (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0010))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 2) (FRAME 2))
+; (ADD (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 1)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 1))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0011))
+; (JRST (LABEL G0011))
+; (!*LBL (LABEL G0010))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*MKITEM (REG 1) (WCONST 8))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 8 13))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE MKVECT) (REG 2))
+; (MOVE (REG 2) (QUOTE MKVECT))
+; (!*LINKE 3 NONINTEGERERROR EXPR 2)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 169)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY NONINTEGERERROR))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+; (FULLWORD -1)
+L0198: 57
+ byte(7)65,32,118,101,99,116,111,114,32,119,105,116,104,32,102,101,119,101,114,32,116,104,97,110,32,122,101,114,111,32,101,108,101,109,101,110,116,115,32,99,97,110,110,111,116,32,98,101,32,97,108,108,111,99,97,116,101,100,0
+ 1
+; (!*ENTRY MKVECT EXPR 1)
+MKVECT: intern MKVECT
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ LDB 11,L0194
+ CAIN 11,31
+ JRST L0193
+ CAILE 11,0
+ JRST L0199
+L0193: MOVEM 1,0(15)
+ CAML 1,L0195
+ JRST L0200
+ MOVE 1,L0196
+ ADJSP 15,-3
+ HRRZI 12,158
+ HRRZI 13,1
+ JRST SYMFNC+158
+L0200: MOVEM 0,-1(15)
+ HRRZI 12,175
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+175
+ MOVEM 1,-1(15)
+ MOVEM 0,-2(15)
+ SETZM -2(15)
+L0201: MOVE 6,-2(15)
+ CAMLE 6,0(15)
+ JRST L0202
+ MOVE 2,-2(15)
+ ADD 2,-1(15)
+ MOVE 1,0
+ MOVEM 1,1(2)
+ AOS -2(15)
+ JRST L0201
+L0202: MOVE 1,-1(15)
+ TLZ 1,253952
+ TLO 1,65536
+ JRST L0203
+L0199: MOVE 2,L0197
+ ADJSP 15,-3
+ HRRZI 12,169
+ HRRZI 13,2
+ JRST SYMFNC+169
+L0203: ADJSP 15,-3
+ POPJ 15,0
+L0194: point 5,1,4
+L0195: -1
+L0197: <30_31>+182
+L0196: <4_31>+L0198
+; (!*ENTRY LIST2 EXPR 2)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*LINK NCONS EXPR 1)
+; (HRRZI (REG LINKREG) 181)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY NCONS))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINKE 1 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+ 2
+; (!*ENTRY LIST2 EXPR 2)
+LIST2: intern LIST2
+ PUSH 15,1
+ MOVE 1,2
+ HRRZI 12,181
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+181
+ MOVE 2,0(15)
+ ADJSP 15,-1
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+; (!*ENTRY LIST3 EXPR 3)
+; (!*PUSH (REG 2))
+; (PUSH (REG ST) (REG 2))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (REG 3) (REG 2))
+; (MOVE (REG 2) (REG 3))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK LIST2 EXPR 2)
+; (HRRZI (REG LINKREG) 183)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LIST2))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINKE 2 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+ 3
+; (!*ENTRY LIST3 EXPR 3)
+LIST3: intern LIST3
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 2,3
+ MOVE 1,-1(15)
+ HRRZI 12,183
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+183
+ MOVE 2,0(15)
+ ADJSP 15,-2
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+; (!*ENTRY LIST4 EXPR 4)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 4) (REG 3))
+; (MOVE (REG 3) (REG 4))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK LIST3 EXPR 3)
+; (HRRZI (REG LINKREG) 184)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY LIST3))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINKE 3 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+ 4
+; (!*ENTRY LIST4 EXPR 4)
+LIST4: intern LIST4
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 3,4
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ HRRZI 12,184
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+184
+ MOVE 2,0(15)
+ ADJSP 15,-3
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+; (!*ENTRY LIST5 EXPR 5)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 4) (FRAME 4))
+; (MOVEM (REG 4) (INDEXED (REG ST) -3))
+; (!*MOVE (REG 5) (REG 4))
+; (MOVE (REG 4) (REG 5))
+; (!*MOVE (FRAME 4) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK LIST4 EXPR 4)
+; (HRRZI (REG LINKREG) 185)
+; (HRRZI (REG NARGREG) 4)
+; (PUSHJ (REG ST) (ENTRY LIST4))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINKE 4 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 4))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+ 5
+; (!*ENTRY LIST5 EXPR 5)
+LIST5: intern LIST5
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVE 4,5
+ MOVE 3,-3(15)
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ HRRZI 12,185
+ HRRZI 13,4
+ PUSHJ 15,SYMFNC+185
+ MOVE 2,0(15)
+ ADJSP 15,-4
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+; (!*ENTRY MKSTRING EXPR 2)
+; (!*ALLOC 5)
+; (ADJSP (REG ST) 5)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (FRAME 3))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE NIL) (FRAME 4))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -3))
+; (!*JUMPNOTINTYPE (LABEL G0005) (REG 1) POSINT)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 31)
+; (JRST "L0204")
+; (CAILE (REG T6) 0)
+; (JRST (LABEL G0005))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (QUOTE MKSTRING) (REG 2))
+; (MOVE (REG 2) (QUOTE MKSTRING))
+; (!*LINKE 5 NONINTEGERERROR EXPR 2)
+; (ADJSP (REG ST) (MINUS 5))
+; (HRRZI (REG LINKREG) 169)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY NONINTEGERERROR))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWGEQ (LABEL G0008) (FRAME 3) (WCONST -1))
+; (MOVE (REG T1) (INDEXED (REG ST) -2))
+; (CAML (REG T1) (LIT (FULLWORD -1)))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE MKSTRING) (REG 2))
+; (MOVE (REG 2) (QUOTE MKSTRING))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 5 NONPOSITIVEINTEGERERROR EXPR 2)
+; (ADJSP (REG ST) (MINUS 5))
+; (HRRZI (REG LINKREG) 170)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY NONPOSITIVEINTEGERERROR))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK GTSTR EXPR 1)
+; (HRRZI (REG LINKREG) 174)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GTSTR))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (WCONST 0) (FRAME 5))
+; (SETZM (INDEXED (REG ST) -4))
+; (!*LBL (LABEL G0015))
+; (!*JUMPWGREATERP (LABEL G0014) (FRAME 5) (FRAME 3))
+; (MOVE (REG T1) (INDEXED (REG ST) -4))
+; (CAMLE (REG T1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0014))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 5) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*WPLUS2 (FRAME 5) (WCONST 1))
+; (AOS (INDEXED (REG ST) -4))
+; (!*JUMP (LABEL G0015))
+; (JRST (LABEL G0015))
+; (!*LBL (LABEL G0014))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*MKITEM (REG 1) (WCONST 4))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 4 13))
+; (!*EXIT 5)
+; (ADJSP (REG ST) (MINUS 5))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+; (FULLWORD -1)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 2
+; (!*ENTRY MKSTRING EXPR 2)
+L0209: intern L0209
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L0205
+ CAIN 11,31
+ JRST L0204
+ CAILE 11,0
+ JRST L0210
+L0204: MOVEM 1,-2(15)
+ JRST L0211
+L0210: MOVE 2,L0206
+ ADJSP 15,-5
+ HRRZI 12,169
+ HRRZI 13,2
+ JRST SYMFNC+169
+L0211: MOVE 6,-2(15)
+ CAML 6,L0207
+ JRST L0212
+ MOVE 2,L0206
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ HRRZI 12,170
+ HRRZI 13,2
+ JRST SYMFNC+170
+L0212: MOVE 1,-2(15)
+ HRRZI 12,174
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+174
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L0213: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L0214
+ MOVE 3,-1(15)
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ AOS 1
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L0208
+ DPB 3,2
+ AOS -4(15)
+ JRST L0213
+L0214: MOVE 1,-3(15)
+ TLZ 1,253952
+ TLO 1,32768
+ ADJSP 15,-5
+ POPJ 15,0
+L0205: point 5,1,4
+L0207: -1
+L0208: point 7,0(1),6
+L0206: <30_31>+188
+ end
ADDED psl-1983/20-tests/sub3.rel
Index: psl-1983/20-tests/sub3.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub3.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/sub4.init
Index: psl-1983/20-tests/sub4.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub4.init
ADDED psl-1983/20-tests/sub4.mac
Index: psl-1983/20-tests/sub4.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub4.mac
@@ -0,0 +1,1829 @@
+ search monsym
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY EQSTR EXPR 2)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*FIELD (REG 2) (REG 2) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 2) (REG 2))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*SIGNEDFIELD (REG 3) (MEMORY (REG 1) (WCONST 0)) (WCONST 18) (WCONST 18))
+; (HRRE (REG 3) (INDEXED (REG 1) 0))
+; (!*MOVE (REG 3) (FRAME 1))
+; (MOVEM (REG 3) (INDEXED (REG ST) 0))
+; (!*SIGNEDFIELD (REG 4) (MEMORY (REG 2) (WCONST 0)) (WCONST 18) (WCONST 18))
+; (HRRE (REG 4) (INDEXED (REG 2) 0))
+; (!*JUMPEQ (LABEL G0004) (REG 3) (REG 4))
+; (CAMN (REG 3) (REG 4))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWGEQ (LABEL G0008) (FRAME 1) (WCONST 0))
+; (SKIPL (INDEXED (REG ST) 0))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*MOVE (REG 1) (REG 5))
+; (MOVE (REG 5) (REG 1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*JUMPEQ (LABEL G0011) (REG 5) (REG 1))
+; (CAMN (REG 5) (REG 1))
+; (JRST (LABEL G0011))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0011))
+; (!*WPLUS2 (FRAME 1) (WCONST -1))
+; (SOS (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 2
+; (!*ENTRY EQSTR EXPR 2)
+EQSTR: intern EQSTR
+ ADJSP 15,3
+ HRRZ 1,1
+ MOVEM 1,-2(15)
+ HRRZ 2,2
+ MOVEM 2,-1(15)
+ HRRE 3,0(1)
+ MOVEM 3,0(15)
+ HRRE 4,0(2)
+ CAMN 3,4
+ JRST L0216
+ MOVE 1,0
+ JRST L0217
+L0216: SKIPL 0(15)
+ JRST L0218
+ MOVE 1,SYMVAL+84
+ JRST L0217
+L0218: MOVE 2,0(15)
+ MOVE 1,-2(15)
+ AOS 1
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L0215
+ LDB 1,2
+ MOVE 5,1
+ MOVE 2,0(15)
+ MOVE 1,-1(15)
+ AOS 1
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L0215
+ LDB 1,2
+ CAMN 5,1
+ JRST L0219
+ MOVE 1,0
+ JRST L0217
+L0219: SOS 0(15)
+ JRST L0216
+L0217: ADJSP 15,-3
+ POPJ 15,0
+L0215: point 7,0(1),6
+ extern BUFFER
+; (!*ENTRY INITREAD EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*MOVE (REG 1) (!$FLUID !*RAISE))
+; (MOVEM (REG 1) (!$FLUID !*RAISE))
+; (!*MOVE (WCONST 32) (REG 1))
+; (HRRZI (REG 1) 32)
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*MOVE (REG 1) (!$FLUID TOK!*))
+; (MOVEM (REG 1) (!$FLUID TOK!*))
+; (!*MOVE (WCONST 2) (!$FLUID TOKTYPE!*))
+; (HRRZI (REG T1) 2)
+; (MOVEM (REG T1) (!$FLUID TOKTYPE!*))
+; (!*JUMPEQ (LABEL G0004) (QUOTE NIL) (!$FLUID DEBUG))
+; (CAMN (REG NIL) (!$FLUID DEBUG))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE "NextSymbol =") (REG 1))
+; (MOVE (REG 1) (QUOTE "NextSymbol ="))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (WVAR NEXTSYMBOL) (REG 1))
+; (MOVE (REG 1) (WVAR NEXTSYMBOL))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0221: 11
+ byte(7)78,101,120,116,83,121,109,98,111,108,32,61,0
+ 0
+; (!*ENTRY INITREAD EXPR 0)
+L0222: intern L0222
+ MOVE 1,0
+ MOVEM 1,SYMVAL+191
+ HRRZI 1,32
+ MOVEM 1,SYMVAL+192
+ MOVE 1,0
+ MOVEM 1,SYMVAL+193
+ HRRZI 6,2
+ MOVEM 6,SYMVAL+194
+ CAMN 0,SYMVAL+195
+ JRST L0223
+ MOVE 1,L0220
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,L0003
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+L0223: MOVE 1,0
+ POPJ 15,0
+L0220: <4_31>+L0221
+; (!*ENTRY SETRAISE EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (!$FLUID !*RAISE))
+; (MOVEM (REG 1) (!$FLUID !*RAISE))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY SETRAISE EXPR 1)
+L0224: intern L0224
+ MOVEM 1,SYMVAL+191
+ POPJ 15,0
+; (!*ENTRY RATOM EXPR 0)
+; (!*ALLOC 1)
+; (ADJSP (REG ST) 1)
+; (!*LINK CLEARWHITE EXPR 0)
+; (HRRZI (REG LINKREG) 197)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY CLEARWHITE))
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 37) (!$FLUID CH!*))
+; (MOVE (REG T2) (!$FLUID CH!*))
+; (CAIE (REG T2) 37)
+; (JRST (LABEL G0004))
+; (!*LINK CLEARCOMMENT EXPR 0)
+; (HRRZI (REG LINKREG) 198)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY CLEARCOMMENT))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTEQ (LABEL G0007) (WCONST 34) (!$FLUID CH!*))
+; (MOVE (REG T2) (!$FLUID CH!*))
+; (CAIE (REG T2) 34)
+; (JRST (LABEL G0007))
+; (!*MOVE (WCONST 0) (!$FLUID TOKTYPE!*))
+; (SETZM (!$FLUID TOKTYPE!*))
+; (!*LINK READSTR EXPR 0)
+; (HRRZI (REG LINKREG) 199)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READSTR))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 1) (!$FLUID TOK!*))
+; (MOVEM (REG 1) (!$FLUID TOK!*))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0007))
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*LINK DIGITP EXPR 1)
+; (HRRZI (REG LINKREG) 200)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DIGITP))
+; (!*JUMPEQ (LABEL G0012) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0012))
+; (!*MOVE (WCONST 1) (!$FLUID TOKTYPE!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID TOKTYPE!*))
+; (!*LINK READINT EXPR 0)
+; (HRRZI (REG LINKREG) 201)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READINT))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 1) (!$FLUID TOK!*))
+; (MOVEM (REG 1) (!$FLUID TOK!*))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0012))
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*LINK ALPHAESCP EXPR 1)
+; (HRRZI (REG LINKREG) 202)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ALPHAESCP))
+; (!*JUMPEQ (LABEL G0018) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0018))
+; (!*MOVE (WCONST 2) (!$FLUID TOKTYPE!*))
+; (HRRZI (REG T1) 2)
+; (MOVEM (REG T1) (!$FLUID TOKTYPE!*))
+; (!*LINK READID EXPR 0)
+; (HRRZI (REG LINKREG) 203)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READID))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 1) (!$FLUID TOK!*))
+; (MOVEM (REG 1) (!$FLUID TOK!*))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0018))
+; (!*MOVE (WCONST 3) (!$FLUID TOKTYPE!*))
+; (HRRZI (REG T1) 3)
+; (MOVEM (REG T1) (!$FLUID TOKTYPE!*))
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*MOVE (REG 1) (!$FLUID TOK!*))
+; (MOVEM (REG 1) (!$FLUID TOK!*))
+; (!*MOVE (WCONST 32) (REG 1))
+; (HRRZI (REG 1) 32)
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*MOVE (!$FLUID TOK!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID TOK!*))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY RATOM EXPR 0)
+RATOM: intern RATOM
+ ADJSP 15,1
+ HRRZI 12,197
+ SETZM 13
+ PUSHJ 15,SYMFNC+197
+ MOVE 7,SYMVAL+192
+ CAIE 7,37
+ JRST L0225
+ HRRZI 12,198
+ SETZM 13
+ PUSHJ 15,SYMFNC+198
+L0225: MOVE 7,SYMVAL+192
+ CAIE 7,34
+ JRST L0226
+ SETZM SYMVAL+194
+ HRRZI 12,199
+ SETZM 13
+ PUSHJ 15,SYMFNC+199
+ MOVEM 1,0(15)
+ MOVEM 1,SYMVAL+193
+ JRST L0227
+L0226: MOVE 1,SYMVAL+192
+ HRRZI 12,200
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+200
+ CAMN 1,0
+ JRST L0228
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+194
+ HRRZI 12,201
+ SETZM 13
+ PUSHJ 15,SYMFNC+201
+ MOVEM 1,0(15)
+ MOVEM 1,SYMVAL+193
+ JRST L0227
+L0228: MOVE 1,SYMVAL+192
+ HRRZI 12,202
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+202
+ CAMN 1,0
+ JRST L0229
+ HRRZI 6,2
+ MOVEM 6,SYMVAL+194
+ HRRZI 12,203
+ SETZM 13
+ PUSHJ 15,SYMFNC+203
+ MOVEM 1,0(15)
+ MOVEM 1,SYMVAL+193
+ JRST L0227
+L0229: HRRZI 6,3
+ MOVEM 6,SYMVAL+194
+ MOVE 1,SYMVAL+192
+ TLZ 1,253952
+ TLO 1,245760
+ MOVEM 1,SYMVAL+193
+ HRRZI 1,32
+ MOVEM 1,SYMVAL+192
+ MOVE 1,SYMVAL+193
+L0227: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY CLEARWHITE EXPR 0)
+; (!*ALLOC 0)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*LINK WHITEP EXPR 1)
+; (HRRZI (REG LINKREG) 205)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY WHITEP))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0005))
+; (!*LINK GETC EXPR 0)
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GETC))
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+ 0
+; (!*ENTRY CLEARWHITE EXPR 0)
+L0230: intern L0230
+L0231: MOVE 1,SYMVAL+192
+ HRRZI 12,205
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+205
+ CAME 1,0
+ JRST L0232
+ MOVE 1,0
+ POPJ 15,0
+L0232: HRRZI 12,206
+ SETZM 13
+ PUSHJ 15,SYMFNC+206
+ MOVEM 1,SYMVAL+192
+ JRST L0231
+; (!*ENTRY CLEARCOMMENT EXPR 0)
+; (!*ALLOC 0)
+; (!*LBL (LABEL G0002))
+; (!*JUMPNOTEQ (LABEL G0005) (WCONST 10) (!$FLUID CH!*))
+; (MOVE (REG T2) (!$FLUID CH!*))
+; (CAIE (REG T2) 10)
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0003))
+; (JRST (LABEL G0003))
+; (!*LBL (LABEL G0005))
+; (!*LINK GETC EXPR 0)
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GETC))
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0003))
+; (!*LINKE 0 CLEARWHITE EXPR 0)
+; (HRRZI (REG LINKREG) 197)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY CLEARWHITE))
+ 0
+; (!*ENTRY CLEARCOMMENT EXPR 0)
+L0233: intern L0233
+L0234: MOVE 7,SYMVAL+192
+ CAIE 7,10
+ JRST L0235
+ MOVE 1,0
+ JRST L0236
+L0235: HRRZI 12,206
+ SETZM 13
+ PUSHJ 15,SYMFNC+206
+ MOVEM 1,SYMVAL+192
+ JRST L0234
+L0236: HRRZI 12,197
+ SETZM 13
+ JRST SYMFNC+197
+; (!*ENTRY READINT EXPR 0)
+; (!*ALLOC 1)
+; (ADJSP (REG ST) 1)
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*WPLUS2 (REG 1) (WCONST -48))
+; (SUBI (REG 1) (MINUS -48))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0005))
+; (!*LINK GETC EXPR 0)
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GETC))
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*LINK DIGITP EXPR 1)
+; (HRRZI (REG LINKREG) 200)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DIGITP))
+; (!*JUMPEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINK LONGTIMES EXPR 2)
+; (HRRZI (REG LINKREG) 207)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LONGTIMES))
+; (!*MOVE (!$FLUID CH!*) (REG 2))
+; (MOVE (REG 2) (!$FLUID CH!*))
+; (!*WPLUS2 (REG 2) (REG 1))
+; (ADDM (REG 1) (REG 2))
+; (!*WPLUS2 (REG 2) (WCONST -48))
+; (SUBI (REG 2) (MINUS -48))
+; (!*MOVE (REG 2) (FRAME 1))
+; (MOVEM (REG 2) (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*MKITEM (REG 1) (WCONST 0))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 0 13))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY READINT EXPR 0)
+L0237: intern L0237
+ ADJSP 15,1
+ MOVE 1,SYMVAL+192
+ SUBI 1,48
+ MOVEM 1,0(15)
+L0238: HRRZI 12,206
+ SETZM 13
+ PUSHJ 15,SYMFNC+206
+ MOVEM 1,SYMVAL+192
+ HRRZI 12,200
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+200
+ CAMN 1,0
+ JRST L0239
+ MOVE 2,0(15)
+ HRRZI 1,10
+ HRRZI 12,207
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+207
+ MOVE 2,SYMVAL+192
+ ADDM 1,2
+ SUBI 2,48
+ MOVEM 2,0(15)
+ JRST L0238
+L0239: MOVE 1,0(15)
+ TLZ 1,253952
+ TLO 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY BUFFERTOSTRING EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK GTSTR EXPR 1)
+; (HRRZI (REG LINKREG) 174)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GTSTR))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0006))
+; (!*JUMPWGREATERP (LABEL G0005) (FRAME 3) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -2))
+; (CAMLE (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (WCONST (PLUS2 1 (WCONST BUFFER))) (REG 1))
+; (HRRZI (REG 1) (IMMEDIATE (PLUS2 1 (WCONST BUFFER))))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0006))
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*MKITEM (REG 1) (WCONST 4))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 4 13))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 1
+; (!*ENTRY BUFFERTOSTRING EXPR 1)
+L0241: intern L0241
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZI 12,174
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+174
+ MOVEM 1,-1(15)
+ SETZM -2(15)
+L0242: MOVE 6,-2(15)
+ CAMLE 6,0(15)
+ JRST L0243
+ MOVE 2,-2(15)
+ HRRZI 1,1+BUFFER
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L0240
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ AOS 1
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L0240
+ DPB 3,2
+ AOS -2(15)
+ JRST L0242
+L0243: MOVE 1,-1(15)
+ TLZ 1,253952
+ TLO 1,32768
+ ADJSP 15,-3
+ POPJ 15,0
+L0240: point 7,0(1),6
+; (!*ENTRY READSTR EXPR 0)
+; (!*PUSH (WCONST -1))
+; (PUSH (REG ST) (LIT (FULLWORD -1)))
+; (!*LBL (LABEL G0005))
+; (!*LINK GETC EXPR 0)
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GETC))
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*JUMPEQ (LABEL G0004) (REG 1) (WCONST 34))
+; (CAIN (REG 1) 34)
+; (JRST (LABEL G0004))
+; (!*WPLUS2 (FRAME 1) (WCONST 1))
+; (AOS (INDEXED (REG ST) 0))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (WCONST (PLUS2 1 (WCONST BUFFER))) (REG 1))
+; (HRRZI (REG 1) (IMMEDIATE (PLUS2 1 (WCONST BUFFER))))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (WCONST 32) (REG 1))
+; (HRRZI (REG 1) 32)
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 BUFFERTOSTRING EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 208)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY BUFFERTOSTRING))
+; (FULLWORD -1)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 0
+; (!*ENTRY READSTR EXPR 0)
+L0246: intern L0246
+ PUSH 15,L0244
+L0247: HRRZI 12,206
+ SETZM 13
+ PUSHJ 15,SYMFNC+206
+ MOVEM 1,SYMVAL+192
+ CAIN 1,34
+ JRST L0248
+ AOS 0(15)
+ MOVE 3,1
+ MOVE 2,0(15)
+ HRRZI 1,1+BUFFER
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L0245
+ DPB 3,2
+ JRST L0247
+L0248: HRRZI 1,32
+ MOVEM 1,SYMVAL+192
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,208
+ HRRZI 13,1
+ JRST SYMFNC+208
+L0244: -1
+L0245: point 7,0(1),6
+; (!*ENTRY READID EXPR 0)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (QUOTE NIL) (FRAME 2))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE NIL) (FRAME 3))
+; (MOVEM (REG NIL) (INDEXED (REG ST) -2))
+; (!*MOVE (WCONST 0) (FRAME 1))
+; (SETZM (INDEXED (REG ST) 0))
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*LINK RAISECHAR EXPR 1)
+; (HRRZI (REG LINKREG) 209)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RAISECHAR))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (WCONST 0) (REG 2))
+; (SETZM (REG 2))
+; (!*MOVE (WCONST (PLUS2 1 (WCONST BUFFER))) (REG 1))
+; (HRRZI (REG 1) (IMMEDIATE (PLUS2 1 (WCONST BUFFER))))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*LBL (LABEL G0006))
+; (!*LINK GETC EXPR 0)
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GETC))
+; (!*MOVE (REG 1) (!$FLUID CH!*))
+; (MOVEM (REG 1) (!$FLUID CH!*))
+; (!*LINK ALPHANUMESCP EXPR 1)
+; (HRRZI (REG LINKREG) 210)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ALPHANUMESCP))
+; (!*JUMPEQ (LABEL G0005) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0005))
+; (!*WPLUS2 (FRAME 1) (WCONST 1))
+; (AOS (INDEXED (REG ST) 0))
+; (!*MOVE (!$FLUID CH!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID CH!*))
+; (!*LINK RAISECHAR EXPR 1)
+; (HRRZI (REG LINKREG) 209)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RAISECHAR))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (WCONST (PLUS2 1 (WCONST BUFFER))) (REG 1))
+; (HRRZI (REG 1) (IMMEDIATE (PLUS2 1 (WCONST BUFFER))))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*JUMP (LABEL G0006))
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK BUFFERTOSTRING EXPR 1)
+; (HRRZI (REG LINKREG) 208)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY BUFFERTOSTRING))
+; (!*LINKE 3 INTERN EXPR 1)
+; (ADJSP (REG ST) (MINUS 3))
+; (HRRZI (REG LINKREG) 211)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INTERN))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 0
+; (!*ENTRY READID EXPR 0)
+READID: intern READID
+ ADJSP 15,3
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ SETZM 0(15)
+ MOVE 1,SYMVAL+192
+ HRRZI 12,209
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+209
+ MOVE 3,1
+ SETZM 2
+ HRRZI 1,1+BUFFER
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L0249
+ DPB 3,2
+L0250: HRRZI 12,206
+ SETZM 13
+ PUSHJ 15,SYMFNC+206
+ MOVEM 1,SYMVAL+192
+ HRRZI 12,210
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+210
+ CAMN 1,0
+ JRST L0251
+ AOS 0(15)
+ MOVE 1,SYMVAL+192
+ HRRZI 12,209
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+209
+ MOVE 3,1
+ MOVE 2,0(15)
+ HRRZI 1,1+BUFFER
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L0249
+ DPB 3,2
+ JRST L0250
+L0251: MOVE 1,0(15)
+ HRRZI 12,208
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+208
+ ADJSP 15,-3
+ HRRZI 12,211
+ HRRZI 13,1
+ JRST SYMFNC+211
+L0249: point 7,0(1),6
+; (!*ENTRY RAISECHAR EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK ESCAPEP EXPR 1)
+; (HRRZI (REG LINKREG) 212)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ESCAPEP))
+; (!*JUMPEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*LINKE 1 GETC EXPR 0)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY GETC))
+; (!*LBL (LABEL G0004))
+; (!*JUMPEQ (LABEL G0009) (QUOTE NIL) (!$FLUID !*RAISE))
+; (CAMN (REG NIL) (!$FLUID !*RAISE))
+; (JRST (LABEL G0009))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK ALPHAP EXPR 1)
+; (HRRZI (REG LINKREG) 213)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ALPHAP))
+; (!*JUMPEQ (LABEL G0009) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0009))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LOWERCASEP EXPR 1)
+; (HRRZI (REG LINKREG) 214)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY LOWERCASEP))
+; (!*JUMPEQ (LABEL G0009) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0009))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 1) (WCONST -32))
+; (SUBI (REG 1) (MINUS -32))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0009))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY RAISECHAR EXPR 1)
+L0252: intern L0252
+ PUSH 15,1
+ HRRZI 12,212
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+212
+ CAMN 1,0
+ JRST L0253
+ ADJSP 15,-1
+ HRRZI 12,206
+ SETZM 13
+ JRST SYMFNC+206
+L0253: CAMN 0,SYMVAL+191
+ JRST L0254
+ MOVE 1,0(15)
+ HRRZI 12,213
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+213
+ CAMN 1,0
+ JRST L0254
+ MOVE 1,0(15)
+ HRRZI 12,214
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+214
+ CAMN 1,0
+ JRST L0254
+ MOVE 1,0(15)
+ SUBI 1,32
+ JRST L0255
+L0254: MOVE 1,0(15)
+L0255: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY INTERN EXPR 1)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPNOTTYPE (LABEL G0004) (REG 1) ID)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIE (REG T6) 30)
+; (JRST (LABEL G0004))
+; (!*FIELD (REG 2) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 2) (REG 1))
+; (!*MOVE (MEMORY (REG 2) (WCONST SYMNAM)) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG 2) (IMMEDIATE SYMNAM)))
+; (MOVEM (REG T1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LOOKUPID EXPR 1)
+; (HRRZI (REG LINKREG) 215)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY LOOKUPID))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*JUMPEQ (LABEL G0007) (REG 2) (QUOTE NIL))
+; (CAMN (REG 2) (REG NIL))
+; (JRST (LABEL G0007))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*MKITEM (REG 1) (WCONST 30))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 30 13))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0007))
+; (!*LINK GTID EXPR 0)
+; (HRRZI (REG LINKREG) 177)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GTID))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMPEQ (LABEL G0012) (QUOTE NIL) (!$FLUID DEBUG))
+; (CAMN (REG NIL) (!$FLUID DEBUG))
+; (JRST (LABEL G0012))
+; (!*MOVE (QUOTE "New ID# ") (REG 1))
+; (MOVE (REG 1) (QUOTE "New ID# "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*LBL (LABEL G0012))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINKE 2 INITNEWID EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 216)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INITNEWID))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+L0258: 7
+ byte(7)78,101,119,32,73,68,35,32,0
+ 1
+; (!*ENTRY INTERN EXPR 1)
+INTERN: intern INTERN
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ LDB 11,L0256
+ CAIE 11,30
+ JRST L0259
+ HRRZ 2,1
+ MOVE 6,SYMNAM(2)
+ MOVEM 6,0(15)
+L0259: MOVE 1,0(15)
+ HRRZI 12,215
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+215
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ CAMN 2,0
+ JRST L0260
+ MOVE 1,2
+ TLZ 1,253952
+ TLO 1,245760
+ JRST L0261
+L0260: HRRZI 12,177
+ SETZM 13
+ PUSHJ 15,SYMFNC+177
+ MOVEM 1,-1(15)
+ CAMN 0,SYMVAL+195
+ JRST L0262
+ MOVE 1,L0257
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+L0262: MOVE 2,0(15)
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ HRRZI 12,216
+ HRRZI 13,2
+ JRST SYMFNC+216
+L0261: ADJSP 15,-2
+ POPJ 15,0
+L0256: point 5,1,4
+L0257: <4_31>+L0258
+; (!*ENTRY INITNEWID EXPR 2)
+; (!*PUSH (REG 2))
+; (PUSH (REG ST) (REG 2))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (QUOTE NIL) (REG 3))
+; (MOVE (REG 3) (REG NIL))
+; (!*MOVE (REG 3) (MEMORY (REG 1) (WCONST SYMVAL)))
+; (MOVEM (REG 3) (INDEXED (REG 1) (IMMEDIATE SYMVAL)))
+; (!*MOVE (QUOTE NIL) (REG 4))
+; (MOVE (REG 4) (REG NIL))
+; (!*MOVE (REG 4) (MEMORY (REG 1) (WCONST SYMPRP)))
+; (MOVEM (REG 4) (INDEXED (REG 1) (IMMEDIATE SYMPRP)))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*MKITEM (REG 1) (WCONST 4))
+; (TLZ (REG 1) 253952)
+; (TLO (REG 1) (LSH 4 13))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST SYMNAM)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE SYMNAM)))
+; (!*MOVE (FRAME 1) (REG 5))
+; (MOVE (REG 5) (INDEXED (REG ST) 0))
+; (!*MKITEM (REG 5) (WCONST 30))
+; (TLZ (REG 5) 253952)
+; (TLO (REG 5) (LSH 30 13))
+; (!*MOVE (REG 5) (FRAME 1))
+; (MOVEM (REG 5) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 5) (REG 1))
+; (MOVE (REG 1) (REG 5))
+; (!*LINK MAKEFUNBOUND EXPR 1)
+; (HRRZI (REG LINKREG) 217)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY MAKEFUNBOUND))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY INITNEWID EXPR 2)
+L0263: intern L0263
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 3,0
+ MOVEM 3,SYMVAL(1)
+ MOVE 4,0
+ MOVEM 4,SYMPRP(1)
+ MOVE 1,2
+ TLZ 1,253952
+ TLO 1,32768
+ MOVE 7,0(15)
+ MOVEM 1,SYMNAM(7)
+ MOVE 5,0(15)
+ TLZ 5,253952
+ TLO 5,245760
+ MOVEM 5,0(15)
+ MOVE 1,5
+ HRRZI 12,217
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+217
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ POPJ 15,0
+; (!*ENTRY LOOKUPID EXPR 1)
+; (!*PUSH (WVAR NEXTSYMBOL))
+; (PUSH (REG ST) (WVAR NEXTSYMBOL))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPEQ (LABEL G0004) (QUOTE NIL) (!$FLUID DEBUG))
+; (CAMN (REG NIL) (!$FLUID DEBUG))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE "Lookup string=") (REG 1))
+; (MOVE (REG 1) (QUOTE "Lookup string="))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1STRING EXPR 1)
+; (HRRZI (REG LINKREG) 131)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1STRING))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWGREATERP (LABEL G0008) (FRAME 2) (WCONST 0))
+; (SKIPLE (INDEXED (REG ST) -1))
+; (JRST (LABEL G0008))
+; (!*JUMPEQ (LABEL G0010) (QUOTE NIL) (!$FLUID DEBUG))
+; (CAMN (REG NIL) (!$FLUID DEBUG))
+; (JRST (LABEL G0010))
+; (!*MOVE (QUOTE "Not Found in LookupId") (REG 1))
+; (MOVE (REG 1) (QUOTE "Not Found in LookupId"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LBL (LABEL G0010))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0008))
+; (!*WPLUS2 (FRAME 2) (WCONST -1))
+; (SOS (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (MEMORY (FRAME 2) (WCONST SYMNAM)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE SYMNAM)))
+; (!*LINK EQSTR EXPR 2)
+; (HRRZI (REG LINKREG) 189)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY EQSTR))
+; (!*JUMPEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*JUMPEQ (LABEL G0018) (QUOTE NIL) (!$FLUID DEBUG))
+; (CAMN (REG NIL) (!$FLUID DEBUG))
+; (JRST (LABEL G0018))
+; (!*MOVE (QUOTE "Found In LookUpId=") (REG 1))
+; (MOVE (REG 1) (QUOTE "Found In LookUpId="))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*LBL (LABEL G0018))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+L0267: 17
+ byte(7)70,111,117,110,100,32,73,110,32,76,111,111,107,85,112,73,100,61,0
+L0268: 20
+ byte(7)78,111,116,32,70,111,117,110,100,32,105,110,32,76,111,111,107,117,112,73,100,0
+L0269: 13
+ byte(7)76,111,111,107,117,112,32,115,116,114,105,110,103,61,0
+ 1
+; (!*ENTRY LOOKUPID EXPR 1)
+L0270: intern L0270
+ PUSH 15,L0003
+ PUSH 15,1
+ CAMN 0,SYMVAL+195
+ JRST L0271
+ MOVE 1,L0264
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,131
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+131
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+L0271: SKIPLE -1(15)
+ JRST L0272
+ CAMN 0,SYMVAL+195
+ JRST L0273
+ MOVE 1,L0265
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+L0273: MOVE 1,0
+ JRST L0274
+L0272: SOS -1(15)
+ MOVE 2,0(15)
+ MOVE 1,-1(15)
+ MOVE 1,SYMNAM(1)
+ HRRZI 12,189
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+189
+ CAMN 1,0
+ JRST L0271
+ CAMN 0,SYMVAL+195
+ JRST L0275
+ MOVE 1,L0266
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-1(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+L0275: MOVE 1,-1(15)
+L0274: ADJSP 15,-2
+ POPJ 15,0
+L0266: <4_31>+L0267
+L0265: <4_31>+L0268
+L0264: <4_31>+L0269
+; (!*ENTRY WHITEP EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPEQ (LABEL G0004) (REG 1) (WCONST 32))
+; (CAIN (REG 1) 32)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*LBL (LABEL G0005))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPEQ (LABEL G0006) (REG 2) (WCONST 10))
+; (CAIN (REG 2) 10)
+; (JRST (LABEL G0006))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0006))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPEQ (LABEL G0007) (REG 2) (WCONST 9))
+; (CAIN (REG 2) 9)
+; (JRST (LABEL G0007))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0007))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPEQ (LABEL G0008) (REG 2) (WCONST 10))
+; (CAIN (REG 2) 10)
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0008))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPEQ (LABEL G0009) (REG 2) (WCONST 12))
+; (CAIN (REG 2) 12)
+; (JRST (LABEL G0009))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0009))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPEQ (LABEL G0001) (REG 2) (WCONST 13))
+; (CAIN (REG 2) 13)
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY WHITEP EXPR 1)
+WHITEP: intern WHITEP
+ MOVE 2,1
+ CAIN 1,32
+ JRST L0276
+ MOVE 1,0
+ JRST L0277
+L0276: MOVE 1,SYMVAL+84
+L0277: CAME 1,0
+ JRST L0278
+ MOVE 1,SYMVAL+84
+ CAIN 2,10
+ JRST L0279
+ MOVE 1,0
+L0279: CAME 1,0
+ JRST L0278
+ MOVE 1,SYMVAL+84
+ CAIN 2,9
+ JRST L0280
+ MOVE 1,0
+L0280: CAME 1,0
+ JRST L0278
+ MOVE 1,SYMVAL+84
+ CAIN 2,10
+ JRST L0281
+ MOVE 1,0
+L0281: CAME 1,0
+ JRST L0278
+ MOVE 1,SYMVAL+84
+ CAIN 2,12
+ JRST L0282
+ MOVE 1,0
+L0282: CAME 1,0
+ JRST L0278
+ MOVE 1,SYMVAL+84
+ CAIN 2,13
+ JRST L0278
+ MOVE 1,0
+L0278: POPJ 15,0
+; (!*ENTRY DIGITP EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPWLEQ (LABEL G0004) (WCONST 48) (REG 1))
+; (CAIL (REG 1) 48)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*LBL (LABEL G0005))
+; (!*JUMPEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPWLEQ (LABEL G0001) (REG 2) (WCONST 57))
+; (CAIG (REG 2) 57)
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY DIGITP EXPR 1)
+DIGITP: intern DIGITP
+ MOVE 2,1
+ CAIL 1,48
+ JRST L0283
+ MOVE 1,0
+ JRST L0284
+L0283: MOVE 1,SYMVAL+84
+L0284: CAMN 1,0
+ JRST L0285
+ MOVE 1,SYMVAL+84
+ CAIG 2,57
+ JRST L0285
+ MOVE 1,0
+L0285: POPJ 15,0
+; (!*ENTRY ALPHAP EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK UPPERCASEP EXPR 1)
+; (HRRZI (REG LINKREG) 218)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY UPPERCASEP))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 LOWERCASEP EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 214)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY LOWERCASEP))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY ALPHAP EXPR 1)
+ALPHAP: intern ALPHAP
+ PUSH 15,1
+ HRRZI 12,218
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+218
+ CAME 1,0
+ JRST L0286
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,214
+ HRRZI 13,1
+ JRST SYMFNC+214
+L0286: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY UPPERCASEP EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPWLEQ (LABEL G0004) (WCONST 65) (REG 1))
+; (CAIL (REG 1) 65)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*LBL (LABEL G0005))
+; (!*JUMPEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPWLEQ (LABEL G0001) (REG 2) (WCONST 90))
+; (CAIG (REG 2) 90)
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY UPPERCASEP EXPR 1)
+L0287: intern L0287
+ MOVE 2,1
+ CAIL 1,65
+ JRST L0288
+ MOVE 1,0
+ JRST L0289
+L0288: MOVE 1,SYMVAL+84
+L0289: CAMN 1,0
+ JRST L0290
+ MOVE 1,SYMVAL+84
+ CAIG 2,90
+ JRST L0290
+ MOVE 1,0
+L0290: POPJ 15,0
+; (!*ENTRY LOWERCASEP EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*JUMPWLEQ (LABEL G0004) (WCONST 97) (REG 1))
+; (CAIL (REG 1) 97)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*LBL (LABEL G0005))
+; (!*JUMPEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*JUMPWLEQ (LABEL G0001) (REG 2) (WCONST 122))
+; (CAIG (REG 2) 122)
+; (JRST (LABEL G0001))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY LOWERCASEP EXPR 1)
+L0291: intern L0291
+ MOVE 2,1
+ CAIL 1,97
+ JRST L0292
+ MOVE 1,0
+ JRST L0293
+L0292: MOVE 1,SYMVAL+84
+L0293: CAMN 1,0
+ JRST L0294
+ MOVE 1,SYMVAL+84
+ CAIG 2,122
+ JRST L0294
+ MOVE 1,0
+L0294: POPJ 15,0
+; (!*ENTRY ESCAPEP EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPEQ (LABEL G0003) (REG 1) (WCONST 33))
+; (CAIN (REG 1) 33)
+; (JRST (LABEL G0003))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0003))
+; (!*MOVE (QUOTE T) (REG 1))
+; (MOVE (REG 1) (FLUID T))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY ESCAPEP EXPR 1)
+L0295: intern L0295
+ CAIN 1,33
+ JRST L0296
+ MOVE 1,0
+ POPJ 15,0
+L0296: MOVE 1,SYMVAL+84
+ POPJ 15,0
+; (!*ENTRY ALPHAESCP EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK ESCAPEP EXPR 1)
+; (HRRZI (REG LINKREG) 212)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ESCAPEP))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 ALPHAP EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 213)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY ALPHAP))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY ALPHAESCP EXPR 1)
+L0297: intern L0297
+ PUSH 15,1
+ HRRZI 12,212
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+212
+ CAME 1,0
+ JRST L0298
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,213
+ HRRZI 13,1
+ JRST SYMFNC+213
+L0298: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY ALPHANUMP EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK DIGITP EXPR 1)
+; (HRRZI (REG LINKREG) 200)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DIGITP))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 ALPHAP EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 213)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY ALPHAP))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY ALPHANUMP EXPR 1)
+L0299: intern L0299
+ PUSH 15,1
+ HRRZI 12,200
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+200
+ CAME 1,0
+ JRST L0300
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,213
+ HRRZI 13,1
+ JRST SYMFNC+213
+L0300: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY ALPHANUMESCP EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK ESCAPEP EXPR 1)
+; (HRRZI (REG LINKREG) 212)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ESCAPEP))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0001))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 ALPHANUMP EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 219)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY ALPHANUMP))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY ALPHANUMESCP EXPR 1)
+L0301: intern L0301
+ PUSH 15,1
+ HRRZI 12,212
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+212
+ CAME 1,0
+ JRST L0302
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,219
+ HRRZI 13,1
+ JRST SYMFNC+219
+L0302: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY READ EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK RATOM EXPR 0)
+; (HRRZI (REG LINKREG) 204)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY RATOM))
+; (!*LINKE 0 READ1 EXPR 1)
+; (HRRZI (REG LINKREG) 220)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY READ1))
+ 0
+; (!*ENTRY READ EXPR 0)
+READ: intern READ
+ HRRZI 12,204
+ SETZM 13
+ PUSHJ 15,SYMFNC+204
+ HRRZI 12,220
+ HRRZI 13,1
+ JRST SYMFNC+220
+; (!*ENTRY READ1 EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE !())
+; (CAME (REG 1) (QUOTE !())
+; (JRST (LABEL G0004))
+; (!*LINK RATOM EXPR 0)
+; (HRRZI (REG LINKREG) 204)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY RATOM))
+; (!*LINKE 0 READLIST EXPR 1)
+; (HRRZI (REG LINKREG) 222)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY READLIST))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTEQ (LABEL G0001) (REG 1) (QUOTE !'))
+; (CAME (REG 1) (QUOTE !'))
+; (JRST (LABEL G0001))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*LINK NCONS EXPR 1)
+; (HRRZI (REG LINKREG) 181)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY NCONS))
+; (!*MOVE (QUOTE QUOTE) (REG 2))
+; (MOVE (REG 2) (QUOTE QUOTE))
+; (!*LINKE 0 XCONS EXPR 2)
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY READ1 EXPR 1)
+READ1: intern READ1
+ CAME 1,L0303
+ JRST L0306
+ HRRZI 12,204
+ SETZM 13
+ PUSHJ 15,SYMFNC+204
+ HRRZI 12,222
+ HRRZI 13,1
+ JRST SYMFNC+222
+L0306: CAME 1,L0304
+ JRST L0307
+ HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ HRRZI 12,181
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+181
+ MOVE 2,L0305
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+L0307: POPJ 15,0
+L0305: <30_31>+223
+L0304: <30_31>+39
+L0303: <30_31>+40
+; (!*ENTRY READLIST EXPR 1)
+; (!*PUSH (QUOTE NIL))
+; (PUSH (REG ST) (REG NIL))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE !)))
+; (CAME (REG 1) (QUOTE !)))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*LINK READ1 EXPR 1)
+; (HRRZI (REG LINKREG) 220)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY READ1))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK RATOM EXPR 0)
+; (HRRZI (REG LINKREG) 204)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY RATOM))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*JUMPNOTEQ (LABEL G0009) (REG 1) (QUOTE !.))
+; (CAME (REG 1) (QUOTE !.))
+; (JRST (LABEL G0009))
+; (!*LINK RATOM EXPR 0)
+; (HRRZI (REG LINKREG) 204)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY RATOM))
+; (!*LINK READLIST EXPR 1)
+; (HRRZI (REG LINKREG) 222)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY READLIST))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (CAR (REG 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 1) 0))
+; (!*LINKE 2 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+; (!*LBL (LABEL G0009))
+; (!*LINK READLIST EXPR 1)
+; (HRRZI (REG LINKREG) 222)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY READLIST))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*LINKE 2 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY READLIST EXPR 1)
+L0310: intern L0310
+ PUSH 15,0
+ PUSH 15,1
+ CAME 1,L0308
+ JRST L0311
+ MOVE 1,0
+ JRST L0312
+L0311: HRRZI 12,220
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+220
+ MOVEM 1,-1(15)
+ HRRZI 12,204
+ SETZM 13
+ PUSHJ 15,SYMFNC+204
+ MOVEM 1,0(15)
+ CAME 1,L0309
+ JRST L0313
+ HRRZI 12,204
+ SETZM 13
+ PUSHJ 15,SYMFNC+204
+ HRRZI 12,222
+ HRRZI 13,1
+ PUSHJ 15,L0310
+ MOVE 2,-1(15)
+ MOVE 1,0(1)
+ ADJSP 15,-2
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+L0313: HRRZI 12,222
+ HRRZI 13,1
+ PUSHJ 15,L0310
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+L0312: ADJSP 15,-2
+ POPJ 15,0
+L0309: <30_31>+46
+L0308: <30_31>+41
+ end
ADDED psl-1983/20-tests/sub4.rel
Index: psl-1983/20-tests/sub4.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub4.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/sub5.init
Index: psl-1983/20-tests/sub5.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub5.init
@@ -0,0 +1,12 @@
+(PUT (QUOTE SYMFNCBASE) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (CODEPTR!* CODEFORM!* CODENARG!*)))
+(PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE COND) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE SETQ) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DF) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DN) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DM) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE LIST) (QUOTE TYPE) (QUOTE NEXPR))
+(PUT (QUOTE WHILE) (QUOTE TYPE) (QUOTE FEXPR))
ADDED psl-1983/20-tests/sub5.rel
Index: psl-1983/20-tests/sub5.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub5.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/sub6.init
Index: psl-1983/20-tests/sub6.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub6.init
ADDED psl-1983/20-tests/sub6.mac
Index: psl-1983/20-tests/sub6.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub6.mac
@@ -0,0 +1,1043 @@
+ search monsym
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ extern BNDSTK
+ extern L1005
+ extern L1006
+ extern L1007
+; (!*ENTRY BSTACKOVERFLOW EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "***** Binding stack overflow, restarting...") (REG 2))
+; (MOVE (REG 2) (QUOTE "***** Binding stack overflow, restarting..."))
+; (!*MOVE (!$FLUID ERROUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID ERROUT!*))
+; (!*LINK CHANNELPRIN2 EXPR 2)
+; (HRRZI (REG LINKREG) 150)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CHANNELPRIN2))
+; (!*MOVE (WCONST 10) (REG 2))
+; (HRRZI (REG 2) 10)
+; (!*MOVE (!$FLUID ERROUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID ERROUT!*))
+; (!*LINK CHANNELWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 151)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CHANNELWRITECHAR))
+; (!*LINKE 0 RESET EXPR 0)
+; (HRRZI (REG LINKREG) 338)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY RESET))
+L1009: 42
+ byte(7)42,42,42,42,42,32,66,105,110,100,105,110,103,32,115,116,97,99,107,32,111,118,101,114,102,108,111,119,44,32,114,101,115,116,97,114,116,105,110,103,46,46,46,0
+ 0
+; (!*ENTRY BSTACKOVERFLOW EXPR 0)
+L1010: intern L1010
+ MOVE 2,L1008
+ MOVE 1,SYMVAL+340
+ HRRZI 12,150
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+150
+ HRRZI 2,10
+ MOVE 1,SYMVAL+340
+ HRRZI 12,151
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+151
+ HRRZI 12,338
+ SETZM 13
+ JRST SYMFNC+338
+L1008: <4_31>+L1009
+; (!*ENTRY BSTACKUNDERFLOW EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "***** Binding stack underflow, restarting...") (REG 2))
+; (MOVE (REG 2) (QUOTE "***** Binding stack underflow, restarting..."))
+; (!*MOVE (!$FLUID ERROUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID ERROUT!*))
+; (!*LINK CHANNELPRIN2 EXPR 2)
+; (HRRZI (REG LINKREG) 150)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CHANNELPRIN2))
+; (!*MOVE (WCONST 10) (REG 2))
+; (HRRZI (REG 2) 10)
+; (!*MOVE (!$FLUID ERROUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID ERROUT!*))
+; (!*LINK CHANNELWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 151)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CHANNELWRITECHAR))
+; (!*LINKE 0 RESET EXPR 0)
+; (HRRZI (REG LINKREG) 338)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY RESET))
+L1012: 43
+ byte(7)42,42,42,42,42,32,66,105,110,100,105,110,103,32,115,116,97,99,107,32,117,110,100,101,114,102,108,111,119,44,32,114,101,115,116,97,114,116,105,110,103,46,46,46,0
+ 0
+; (!*ENTRY BSTACKUNDERFLOW EXPR 0)
+L1013: intern L1013
+ MOVE 2,L1011
+ MOVE 1,SYMVAL+340
+ HRRZI 12,150
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+150
+ HRRZI 2,10
+ MOVE 1,SYMVAL+340
+ HRRZI 12,151
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+151
+ HRRZI 12,338
+ SETZM 13
+ JRST SYMFNC+338
+L1011: <4_31>+L1012
+; (!*ENTRY CAPTUREENVIRONMENT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR BNDSTKPTR) (REG 1))
+; (MOVE (REG 1) (WVAR BNDSTKPTR))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY CAPTUREENVIRONMENT EXPR 0)
+L1014: intern L1014
+ MOVE 1,L1007
+ POPJ 15,0
+; (!*ENTRY RESTOREENVIRONMENT EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 5))
+; (MOVE (REG 5) (REG 1))
+; (!*JUMPWGEQ (LABEL G0004) (REG 1) (WVAR BNDSTKLOWERBOUND))
+; (CAML (REG 1) (WVAR BNDSTKLOWERBOUND))
+; (JRST (LABEL G0004))
+; (!*LINKE 0 BSTACKUNDERFLOW EXPR 0)
+; (HRRZI (REG LINKREG) 341)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY BSTACKUNDERFLOW))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLESSP (LABEL G0008) (REG 5) (WVAR BNDSTKPTR))
+; (CAMGE (REG 5) (WVAR BNDSTKPTR))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0008))
+; (!*MOVE (MEMORY (WVAR BNDSTKPTR) (WCONST 0)) (REG 1))
+; (MOVE (REG 1) (INDIRECT (WVAR BNDSTKPTR)))
+; (!*MOVE (REG 1) (REG 4))
+; (MOVE (REG 4) (REG 1))
+; (!*MOVE (WVAR BNDSTKPTR) (REG 2))
+; (MOVE (REG 2) (WVAR BNDSTKPTR))
+; (!*MOVE (MEMORY (REG 2) (WCONST -1)) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG 2) -1))
+; (!*MOVE (REG 1) (MEMORY (REG 3) (WCONST SYMVAL)))
+; (MOVEM (REG 1) (INDEXED (REG 3) (IMMEDIATE SYMVAL)))
+; (!*WPLUS2 (WVAR BNDSTKPTR) (WCONST -2))
+; (MOVNI (REG T2) (MINUS -2))
+; (ADDM (REG T2) (WVAR BNDSTKPTR))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+ 1
+; (!*ENTRY RESTOREENVIRONMENT EXPR 1)
+L1015: intern L1015
+ MOVE 5,1
+ CAML 1,L1005
+ JRST L1016
+ HRRZI 12,341
+ SETZM 13
+ JRST SYMFNC+341
+L1016: CAMGE 5,L1007
+ JRST L1017
+ MOVE 1,0
+ POPJ 15,0
+L1017: MOVE 1,@L1007
+ MOVE 4,1
+ MOVE 2,L1007
+ MOVE 3,-1(2)
+ MOVEM 1,SYMVAL(3)
+ MOVNI 7,2
+ ADDM 7,L1007
+ JRST L1016
+; (!*ENTRY CLEARBINDINGS EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR BNDSTKLOWERBOUND) (REG 1))
+; (MOVE (REG 1) (WVAR BNDSTKLOWERBOUND))
+; (!*LINK RESTOREENVIRONMENT EXPR 1)
+; (HRRZI (REG LINKREG) 343)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RESTOREENVIRONMENT))
+; (!*LINKE 0 !%CLEAR!-CATCH!-STACK EXPR 0)
+; (HRRZI (REG LINKREG) 344)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY !%CLEAR!-CATCH!-STACK))
+ 0
+; (!*ENTRY CLEARBINDINGS EXPR 0)
+L1018: intern L1018
+ MOVE 1,L1005
+ HRRZI 12,343
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+343
+ HRRZI 12,344
+ SETZM 13
+ JRST SYMFNC+344
+; (!*ENTRY UNBINDN EXPR 1)
+; (!*ALLOC 0)
+; (!*WMINUS (REG 1) (REG 1))
+; (MOVNS (REG 1))
+; (!*WSHIFT (REG 1) (WCONST 1))
+; (LSH (REG 1) 1)
+; (!*WPLUS2 (REG 1) (WVAR BNDSTKPTR))
+; (ADD (REG 1) (WVAR BNDSTKPTR))
+; (!*LINKE 0 RESTOREENVIRONMENT EXPR 1)
+; (HRRZI (REG LINKREG) 343)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY RESTOREENVIRONMENT))
+ 1
+; (!*ENTRY UNBINDN EXPR 1)
+L1019: intern L1019
+ MOVNS 1
+ LSH 1,1
+ ADD 1,L1007
+ HRRZI 12,343
+ HRRZI 13,1
+ JRST SYMFNC+343
+; (!*ENTRY LBIND1 EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 5))
+; (MOVE (REG 5) (REG 1))
+; (!*JUMPTYPE (LABEL G0004) (REG 1) ID)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 30)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE "binding") (REG 2))
+; (MOVE (REG 2) (QUOTE "binding"))
+; (!*LINKE 0 NONIDERROR EXPR 2)
+; (HRRZI (REG LINKREG) 159)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY NONIDERROR))
+; (!*LBL (LABEL G0004))
+; (!*JUMPEQ (LABEL G0006) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0006))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 1) (QUOTE T))
+; (CAME (REG 1) (FLUID T))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (QUOTE "T and NIL cannot be rebound") (REG 1))
+; (MOVE (REG 1) (QUOTE "T and NIL cannot be rebound"))
+; (!*LINKE 0 STDERROR EXPR 1)
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY STDERROR))
+; (!*LBL (LABEL G0005))
+; (!*WPLUS2 (WVAR BNDSTKPTR) (WCONST 2))
+; (HRRZI (REG T2) 2)
+; (ADDM (REG T2) (WVAR BNDSTKPTR))
+; (!*JUMPWGEQ (LABEL G0009) (WVAR BNDSTKUPPERBOUND) (WVAR BNDSTKPTR))
+; (MOVE (REG T1) (WVAR BNDSTKUPPERBOUND))
+; (CAML (REG T1) (WVAR BNDSTKPTR))
+; (JRST (LABEL G0009))
+; (!*LINKE 0 BSTACKOVERFLOW EXPR 0)
+; (HRRZI (REG LINKREG) 339)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY BSTACKOVERFLOW))
+; (!*LBL (LABEL G0009))
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*MOVE (REG 1) (REG 5))
+; (MOVE (REG 5) (REG 1))
+; (!*MOVE (WVAR BNDSTKPTR) (REG 4))
+; (MOVE (REG 4) (WVAR BNDSTKPTR))
+; (!*MOVE (REG 1) (MEMORY (REG 4) (WCONST -1)))
+; (MOVEM (REG 1) (INDEXED (REG 4) -1))
+; (!*MOVE (MEMORY (REG 1) (WCONST SYMVAL)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE SYMVAL)))
+; (!*MOVE (REG 1) (MEMORY (REG 4) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 4) 0))
+; (!*MOVE (REG 2) (MEMORY (REG 5) (WCONST SYMVAL)))
+; (MOVEM (REG 2) (INDEXED (REG 5) (IMMEDIATE SYMVAL)))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+L1023: 26
+ byte(7)84,32,97,110,100,32,78,73,76,32,99,97,110,110,111,116,32,98,101,32,114,101,98,111,117,110,100,0
+L1024: 6
+ byte(7)98,105,110,100,105,110,103,0
+ 2
+; (!*ENTRY LBIND1 EXPR 2)
+LBIND1: intern LBIND1
+ MOVE 5,1
+ LDB 11,L1020
+ CAIN 11,30
+ JRST L1025
+ MOVE 2,L1021
+ HRRZI 12,159
+ HRRZI 13,2
+ JRST SYMFNC+159
+L1025: CAMN 1,0
+ JRST L1026
+ CAME 1,SYMVAL+84
+ JRST L1027
+L1026: MOVE 1,L1022
+ HRRZI 12,158
+ HRRZI 13,1
+ JRST SYMFNC+158
+L1027: HRRZI 7,2
+ ADDM 7,L1007
+ MOVE 6,L1006
+ CAML 6,L1007
+ JRST L1028
+ HRRZI 12,339
+ SETZM 13
+ JRST SYMFNC+339
+L1028: HRRZ 1,1
+ MOVE 5,1
+ MOVE 4,L1007
+ MOVEM 1,-1(4)
+ MOVE 1,SYMVAL(1)
+ MOVEM 1,0(4)
+ MOVEM 2,SYMVAL(5)
+ MOVE 1,2
+ POPJ 15,0
+L1020: point 5,1,4
+L1022: <4_31>+L1023
+L1021: <4_31>+L1024
+; (!*ENTRY PBIND1 EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*LINKE 0 LBIND1 EXPR 2)
+; (HRRZI (REG LINKREG) 257)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY LBIND1))
+ 1
+; (!*ENTRY PBIND1 EXPR 1)
+PBIND1: intern PBIND1
+ MOVE 2,0
+ HRRZI 12,257
+ HRRZI 13,2
+ JRST SYMFNC+257
+; (!*ENTRY LAMBIND EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*SIGNEDFIELD (REG 2) (MEMORY (REG 1) (WCONST 0)) (WCONST 18) (WCONST 18))
+; (HRRE (REG 2) (INDEXED (REG 1) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0005))
+; (!*JUMPWGREATERP (LABEL G0004) (FRAME 3) (FRAME 2))
+; (MOVE (REG T1) (INDEXED (REG ST) -2))
+; (CAMLE (REG T1) (INDEXED (REG ST) -1))
+; (JRST (LABEL G0004))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 2) (!$FLUID LAMBINDARGS!*))
+; (ADD (REG 2) (!$FLUID LAMBINDARGS!*))
+; (!*MOVE (MEMORY (REG 2) (WCONST 0)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 2) 0))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (FRAME 1))
+; (ADD (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (MEMORY (REG 1) (WCONST 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*LINK LBIND1 EXPR 2)
+; (HRRZI (REG LINKREG) 257)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LBIND1))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY LAMBIND EXPR 1)
+L1029: intern L1029
+ ADJSP 15,3
+ HRRZ 1,1
+ MOVEM 1,0(15)
+ HRRE 2,0(1)
+ MOVEM 2,-1(15)
+ SETZM -2(15)
+L1030: MOVE 6,-2(15)
+ CAMLE 6,-1(15)
+ JRST L1031
+ MOVE 2,-2(15)
+ ADD 2,SYMVAL+166
+ MOVE 2,0(2)
+ MOVE 1,-2(15)
+ ADD 1,0(15)
+ MOVE 1,1(1)
+ HRRZI 12,257
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+257
+ AOS -2(15)
+ JRST L1030
+L1031: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY PROGBIND EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*FIELD (REG 1) (REG 1) (WCONST 18) (WCONST 18))
+; (HRRZ (REG 1) (REG 1))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*SIGNEDFIELD (REG 2) (MEMORY (REG 1) (WCONST 0)) (WCONST 18) (WCONST 18))
+; (HRRE (REG 2) (INDEXED (REG 1) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0005))
+; (!*JUMPWGREATERP (LABEL G0004) (FRAME 3) (FRAME 2))
+; (MOVE (REG T1) (INDEXED (REG ST) -2))
+; (CAMLE (REG T1) (INDEXED (REG ST) -1))
+; (JRST (LABEL G0004))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (FRAME 1))
+; (ADD (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (MEMORY (REG 1) (WCONST 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 1) 1))
+; (!*LINK PBIND1 EXPR 1)
+; (HRRZI (REG LINKREG) 346)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PBIND1))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PROGBIND EXPR 1)
+L1032: intern L1032
+ ADJSP 15,3
+ HRRZ 1,1
+ MOVEM 1,0(15)
+ HRRE 2,0(1)
+ MOVEM 2,-1(15)
+ SETZM -2(15)
+L1033: MOVE 6,-2(15)
+ CAMLE 6,-1(15)
+ JRST L1034
+ MOVE 1,-2(15)
+ ADD 1,0(15)
+ MOVE 1,1(1)
+ HRRZI 12,346
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+346
+ AOS -2(15)
+ JRST L1033
+L1034: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY GETD EXPR 1)
+; (!*PUSH (QUOTE NIL))
+; (PUSH (REG ST) (REG NIL))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPTYPE (LABEL G0004) (REG 1) ID)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 30)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE "*** Can only GETD off ID's: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Can only GETD off ID's: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*LINK FUNBOUNDP EXPR 1)
+; (HRRZI (REG LINKREG) 231)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FUNBOUNDP))
+; (!*JUMPEQ (LABEL G0008) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (QUOTE FTYPE) (REG 2))
+; (MOVE (REG 2) (QUOTE FTYPE))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK GET EXPR 2)
+; (HRRZI (REG LINKREG) 258)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY GET))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*JUMPNOTEQ (LABEL G0014) (REG 2) (QUOTE NIL))
+; (CAME (REG 2) (REG NIL))
+; (JRST (LABEL G0014))
+; (!*MOVE (QUOTE EXPR) (FRAME 2))
+; (MOVE (REG T1) (QUOTE EXPR))
+; (MOVEM (REG T1) (INDEXED (REG ST) -1))
+; (!*LBL (LABEL G0014))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK FCODEP EXPR 1)
+; (HRRZI (REG LINKREG) 237)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FCODEP))
+; (!*JUMPEQ (LABEL G0018) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0018))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK GETFCODEPOINTER EXPR 1)
+; (HRRZI (REG LINKREG) 239)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY GETFCODEPOINTER))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*LINKE 2 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+; (!*LBL (LABEL G0018))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK FLAMBDALINKP EXPR 1)
+; (HRRZI (REG LINKREG) 234)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FLAMBDALINKP))
+; (!*JUMPEQ (LABEL G0024) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0024))
+; (!*MOVE (QUOTE !*LAMBDALINK) (REG 2))
+; (MOVE (REG 2) (QUOTE !*LAMBDALINK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK GET EXPR 2)
+; (HRRZI (REG LINKREG) 258)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY GET))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*LINKE 2 XCONS EXPR 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (HRRZI (REG LINKREG) 180)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY XCONS))
+; (!*LBL (LABEL G0024))
+; (!*MOVE (QUOTE "*** GETD should find a LAMBDA or CODE") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** GETD should find a LAMBDA or CODE"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+L1041: 36
+ byte(7)42,42,42,32,71,69,84,68,32,115,104,111,117,108,100,32,102,105,110,100,32,97,32,76,65,77,66,68,65,32,111,114,32,67,79,68,69,0
+L1042: 27
+ byte(7)42,42,42,32,67,97,110,32,111,110,108,121,32,71,69,84,68,32,111,102,102,32,73,68,39,115,58,32,0
+ 1
+; (!*ENTRY GETD EXPR 1)
+GETD: intern GETD
+ PUSH 15,0
+ PUSH 15,1
+ LDB 11,L1035
+ CAIN 11,30
+ JRST L1043
+ MOVE 1,L1036
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ JRST L1044
+L1043: HRRZI 12,231
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+231
+ CAMN 1,0
+ JRST L1045
+ MOVE 1,0
+ JRST L1044
+L1045: MOVE 2,L1037
+ MOVE 1,0(15)
+ HRRZI 12,258
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+258
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ CAME 2,0
+ JRST L1046
+ MOVE 6,L1038
+ MOVEM 6,-1(15)
+L1046: MOVE 1,0(15)
+ HRRZI 12,237
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L1047
+ MOVE 1,0(15)
+ HRRZI 12,239
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+239
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+L1047: MOVE 1,0(15)
+ HRRZI 12,234
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+234
+ CAMN 1,0
+ JRST L1048
+ MOVE 2,L1039
+ MOVE 1,0(15)
+ HRRZI 12,258
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+258
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ HRRZI 12,180
+ HRRZI 13,2
+ JRST SYMFNC+180
+L1048: MOVE 1,L1040
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+L1044: ADJSP 15,-2
+ POPJ 15,0
+L1035: point 5,1,4
+L1040: <4_31>+L1041
+L1039: <30_31>+260
+L1038: <30_31>+293
+L1037: <30_31>+311
+L1036: <4_31>+L1042
+; (!*ENTRY PUTD EXPR 3)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*JUMPTYPE (LABEL G0004) (REG 1) ID)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (REG 1) 0 5))))
+; (CAIN (REG T6) 30)
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE "*** Can only define ID's as functions: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Can only define ID's as functions: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*LINK FCODEP EXPR 1)
+; (HRRZI (REG LINKREG) 237)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FCODEP))
+; (!*JUMPEQ (LABEL G0009) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0009))
+; (!*MOVE (QUOTE "*** Redefining a COMPILED function: ") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Redefining a COMPILED function: "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*JUMP (LABEL G0008))
+; (JRST (LABEL G0008))
+; (!*LBL (LABEL G0009))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK FUNBOUNDP EXPR 1)
+; (HRRZI (REG LINKREG) 231)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FUNBOUNDP))
+; (!*JUMPNOTEQ (LABEL G0008) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0008))
+; (!*MOVE (QUOTE " Redefining function ") (REG 1))
+; (MOVE (REG 1) (QUOTE " Redefining function "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (QUOTE !*LAMBDALINK) (REG 2))
+; (MOVE (REG 2) (QUOTE !*LAMBDALINK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK REMPROP EXPR 2)
+; (HRRZI (REG LINKREG) 334)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY REMPROP))
+; (!*MOVE (QUOTE FTYPE) (REG 2))
+; (MOVE (REG 2) (QUOTE FTYPE))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK REMPROP EXPR 2)
+; (HRRZI (REG LINKREG) 334)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY REMPROP))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK MAKEFUNBOUND EXPR 1)
+; (HRRZI (REG LINKREG) 217)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY MAKEFUNBOUND))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK LAMBDAP EXPR 1)
+; (HRRZI (REG LINKREG) 312)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY LAMBDAP))
+; (!*JUMPEQ (LABEL G0017) (REG 1) (QUOTE NIL))
+; (CAMN (REG 1) (REG NIL))
+; (JRST (LABEL G0017))
+; (!*MOVE (FRAME 3) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (QUOTE !*LAMBDALINK) (REG 2))
+; (MOVE (REG 2) (QUOTE !*LAMBDALINK))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PUT EXPR 3)
+; (HRRZI (REG LINKREG) 308)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY PUT))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK MAKEFLAMBDALINK EXPR 1)
+; (HRRZI (REG LINKREG) 236)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY MAKEFLAMBDALINK))
+; (!*JUMP (LABEL G0016))
+; (JRST (LABEL G0016))
+; (!*LBL (LABEL G0017))
+; (!*JUMPNOTTYPE (LABEL G0019) (FRAME 3) CODE)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG ST) -2) 0 5))))
+; (CAIE (REG T6) 15)
+; (JRST (LABEL G0019))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK MAKEFCODE EXPR 2)
+; (HRRZI (REG LINKREG) 238)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY MAKEFCODE))
+; (!*JUMP (LABEL G0016))
+; (JRST (LABEL G0016))
+; (!*LBL (LABEL G0019))
+; (!*MOVE (QUOTE "*** Body must be a LAMBDA or CODE") (REG 1))
+; (MOVE (REG 1) (QUOTE "*** Body must be a LAMBDA or CODE"))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN1 EXPR 1)
+; (HRRZI (REG LINKREG) 134)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN1))
+; (!*MOVE (QUOTE " ") (REG 1))
+; (MOVE (REG 1) (QUOTE " "))
+; (!*LINK PRIN2 EXPR 1)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0016))
+; (!*JUMPEQ (LABEL G0022) (FRAME 2) (QUOTE EXPR))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMN (REG T1) (QUOTE EXPR))
+; (JRST (LABEL G0022))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (QUOTE FTYPE) (REG 2))
+; (MOVE (REG 2) (QUOTE FTYPE))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PUT EXPR 3)
+; (HRRZI (REG LINKREG) 308)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY PUT))
+; (!*LBL (LABEL G0022))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (REG 1) 0 5))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG ST) -2) 0 5))
+L1059: 0
+ byte(7)32,0
+L1060: 32
+ byte(7)42,42,42,32,66,111,100,121,32,109,117,115,116,32,98,101,32,97,32,76,65,77,66,68,65,32,111,114,32,67,79,68,69,0
+L1061: 20
+ byte(7)32,82,101,100,101,102,105,110,105,110,103,32,102,117,110,99,116,105,111,110,32,0
+L1062: 35
+ byte(7)42,42,42,32,82,101,100,101,102,105,110,105,110,103,32,97,32,67,79,77,80,73,76,69,68,32,102,117,110,99,116,105,111,110,58,32,0
+L1063: 38
+ byte(7)42,42,42,32,67,97,110,32,111,110,108,121,32,100,101,102,105,110,101,32,73,68,39,115,32,97,115,32,102,117,110,99,116,105,111,110,115,58,32,0
+ 3
+; (!*ENTRY PUTD EXPR 3)
+PUTD: intern PUTD
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L1049
+ CAIN 11,30
+ JRST L1064
+ MOVE 1,L1050
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ JRST L1065
+L1064: HRRZI 12,237
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L1066
+ MOVE 1,L1051
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ JRST L1067
+L1066: MOVE 1,0(15)
+ HRRZI 12,231
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+231
+ CAME 1,0
+ JRST L1067
+ MOVE 1,L1052
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+L1067: MOVE 2,L1053
+ MOVE 1,0(15)
+ HRRZI 12,334
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+334
+ MOVE 2,L1054
+ MOVE 1,0(15)
+ HRRZI 12,334
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+334
+ MOVE 1,0(15)
+ HRRZI 12,217
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+217
+ MOVE 1,-2(15)
+ HRRZI 12,312
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+312
+ CAMN 1,0
+ JRST L1068
+ MOVE 3,-2(15)
+ MOVE 2,L1053
+ MOVE 1,0(15)
+ HRRZI 12,308
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+308
+ MOVE 1,0(15)
+ HRRZI 12,236
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+236
+ JRST L1069
+L1068: LDB 11,L1055
+ CAIE 11,15
+ JRST L1070
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ HRRZI 12,238
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+238
+ JRST L1069
+L1070: MOVE 1,L1056
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,0(15)
+ HRRZI 12,134
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+134
+ MOVE 1,L1057
+ HRRZI 12,138
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+138
+ MOVE 1,-2(15)
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ JRST L1065
+L1069: MOVE 6,-1(15)
+ CAMN 6,L1058
+ JRST L1071
+ MOVE 3,-1(15)
+ MOVE 2,L1054
+ MOVE 1,0(15)
+ HRRZI 12,308
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+308
+L1071: MOVE 1,0(15)
+L1065: ADJSP 15,-3
+ POPJ 15,0
+L1049: point 5,1,4
+L1055: point 5,-2(15),4
+L1058: <30_31>+293
+L1057: <4_31>+L1059
+L1056: <4_31>+L1060
+L1054: <30_31>+311
+L1053: <30_31>+260
+L1052: <4_31>+L1061
+L1051: <4_31>+L1062
+L1050: <4_31>+L1063
+; (!*ENTRY RESET EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Should RESET here, but will QUIT") (REG 1))
+; (MOVE (REG 1) (QUOTE "Should RESET here, but will QUIT"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 148)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1073: 31
+ byte(7)83,104,111,117,108,100,32,82,69,83,69,84,32,104,101,114,101,44,32,98,117,116,32,119,105,108,108,32,81,85,73,84,0
+ 0
+; (!*ENTRY RESET EXPR 0)
+RESET: intern RESET
+ MOVE 1,L1072
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ HRRZI 12,148
+ SETZM 13
+ PUSHJ 15,SYMFNC+148
+ MOVE 1,0
+ POPJ 15,0
+L1072: <4_31>+L1073
+ end
ADDED psl-1983/20-tests/sub6.rel
Index: psl-1983/20-tests/sub6.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub6.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/sub7.init
Index: psl-1983/20-tests/sub7.init
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub7.init
@@ -0,0 +1,5 @@
+(GLOBAL (QUOTE (!$EOL!$)))
+(FLUID (QUOTE (!*ECHO !*PVAL)))
+(FLUID (QUOTE (IN!* OUT!*)))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (STDIN!* STDOUT!* ERROUT!* PROMPTOUT!* !*ECHO)))
ADDED psl-1983/20-tests/sub7.mac
Index: psl-1983/20-tests/sub7.mac
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub7.mac
@@ -0,0 +1,1856 @@
+ search monsym
+ radix 10
+ extern L0001
+ extern L0002
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0003
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+; (!*ENTRY SYSCLEARIO EXPR 0)
+; (!*MOVE (WCONST 64) (REG 1))
+; (HRRZI (REG 1) 64)
+; (RFMOD)
+; (TRO 2 63552)
+; (SFMOD)
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY SYSCLEARIO EXPR 0)
+L1074: intern L1074
+ HRRZI 1,64
+ RFMOD
+ TRO 2,63552
+ SFMOD
+ POPJ 15,0
+; (!*ENTRY SYSOPENREAD EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*MOVE (WCONST 7516258304) (REG 3))
+; (MOVE (REG 3) 7516258304)
+; (!*MOVE (WCONST 8590196736) (REG 2))
+; (MOVE (REG 2) 8590196736)
+; (!*MOVE (REG 4) (REG 1))
+; (MOVE (REG 1) (REG 4))
+; (!*LINKE 0 DEC20OPEN EXPR 3)
+; (HRRZI (REG LINKREG) 349)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY DEC20OPEN))
+ 2
+; (!*ENTRY SYSOPENREAD EXPR 2)
+L1075: intern L1075
+ MOVE 4,2
+ MOVE 3,[7516258304]
+ MOVE 2,[8590196736]
+ MOVE 1,4
+ HRRZI 12,349
+ HRRZI 13,3
+ JRST SYMFNC+349
+; (!*ENTRY SYSOPENWRITE EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (REG 2) (REG 4))
+; (MOVE (REG 4) (REG 2))
+; (!*MOVE (WCONST 7516225536) (REG 3))
+; (MOVE (REG 3) 7516225536)
+; (!*MOVE (WCONST -17179607040) (REG 2))
+; (MOVE (REG 2) -17179607040)
+; (!*MOVE (REG 4) (REG 1))
+; (MOVE (REG 1) (REG 4))
+; (!*LINKE 0 DEC20OPEN EXPR 3)
+; (HRRZI (REG LINKREG) 349)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY DEC20OPEN))
+ 2
+; (!*ENTRY SYSOPENWRITE EXPR 2)
+L1076: intern L1076
+ MOVE 4,2
+ MOVE 3,[7516225536]
+ MOVE 2,[-17179607040]
+ MOVE 1,4
+ HRRZI 12,349
+ HRRZI 13,3
+ JRST SYMFNC+349
+; (!*ENTRY DEC20OPEN EXPR 3)
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (HRLI (REG 1) 147904)
+; (!*MOVE (REG 1) (REG 4))
+; (MOVE (REG 4) (REG 1))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*MOVE (REG 4) (REG 2))
+; (MOVE (REG 2) (REG 4))
+; (GTJFN)
+; (!*JUMP (LABEL CANTOPEN))
+; (JRST (LABEL CANTOPEN))
+; (!*MOVE (REG 3) (REG 2))
+; (MOVE (REG 2) (REG 3))
+; (OPENF)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 3
+; (!*ENTRY DEC20OPEN EXPR 3)
+L1077: intern L1077
+ AOS 1
+ HRLI 1,147904
+ MOVE 4,1
+ MOVE 1,2
+ MOVE 2,4
+ GTJFN
+ JRST L1078
+ MOVE 2,3
+ OPENF
+L1078: SETZM 1
+ POPJ 15,0
+; (!*ENTRY SYSREADREC EXPR 2)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (WCONST 0) (FRAME 3))
+; (SETZM (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK DEC20READCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 352)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DEC20READCHAR))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*JUMPEQ (LABEL G0008) (REG 3) (WCONST 10))
+; (CAIN (REG 3) 10)
+; (JRST (LABEL G0008))
+; (!*JUMPNOTEQ (LABEL G0006) (REG 3) (WCONST 26))
+; (CAIE (REG 3) 26)
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0008))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0006))
+; (!*WPLUS2 (FRAME 3) (WCONST 1))
+; (AOS (INDEXED (REG ST) -2))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 4)
+; (ADJSP (REG ST) (MINUS 4))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 2
+; (!*ENTRY SYSREADREC EXPR 2)
+L1080: intern L1080
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ SETZM -2(15)
+L1081: MOVE 1,0(15)
+ HRRZI 12,352
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+352
+ MOVEM 1,-3(15)
+ MOVE 3,1
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ AOS 1
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L1079
+ DPB 3,2
+ CAIN 3,10
+ JRST L1082
+ CAIE 3,26
+ JRST L1083
+L1082: MOVE 1,-2(15)
+ JRST L1084
+L1083: AOS -2(15)
+ JRST L1081
+L1084: ADJSP 15,-4
+ POPJ 15,0
+L1079: point 7,0(1),6
+; (!*ENTRY DEC20READCHAR EXPR 1)
+; (BIN)
+; (ERJMP CHECKEOF)
+; (!*JUMPEQ (LABEL LOOP) (REG 2) (WCONST 0))
+; (JUMPE (REG 2) (LABEL LOOP))
+; (!*JUMPEQ (LABEL LOOP) (REG 2) (WCONST 13))
+; (CAIN (REG 2) 13)
+; (JRST (LABEL LOOP))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (GTSTS)
+; (TLNN (REG 2) 512)
+; (!*JUMP (LABEL READERROR))
+; (JRST (LABEL READERROR))
+; (!*MOVE (WCONST 26) (REG 1))
+; (HRRZI (REG 1) 26)
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*MOVE (QUOTE "Attempt to read from file failed") (REG 1))
+; (MOVE (REG 1) (QUOTE "Attempt to read from file failed"))
+; (!*JCALL IOERROR)
+; (JRST (ENTRY IOERROR))
+L1086: 31
+ byte(7)65,116,116,101,109,112,116,32,116,111,32,114,101,97,100,32,102,114,111,109,32,102,105,108,101,32,102,97,105,108,101,100,0
+ 1
+; (!*ENTRY DEC20READCHAR EXPR 1)
+L1087: intern L1087
+L1088: BIN
+ ERJMP L1089
+ JUMPE 2,L1088
+ CAIN 2,13
+ JRST L1088
+ MOVE 1,2
+ POPJ 15,0
+L1089: GTSTS
+ TLNN 2,512
+ JRST L1090
+ HRRZI 1,26
+ POPJ 15,0
+L1090: MOVE 1,L1085
+ JRST SYMFNC+354
+L1085: <4_31>+L1086
+; (!*ENTRY SYSWRITEREC EXPR 3)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*MOVE (WCONST 0) (FRAME 4))
+; (SETZM (INDEXED (REG ST) -3))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 4) (FRAME 3))
+; (MOVE (REG T1) (INDEXED (REG ST) -3))
+; (CAMG (REG T1) (INDEXED (REG ST) -2))
+; (JRST (LABEL G0005))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 4) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK DEC20WRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 355)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY DEC20WRITECHAR))
+; (!*WPLUS2 (FRAME 4) (WCONST 1))
+; (AOS (INDEXED (REG ST) -3))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 4)
+; (ADJSP (REG ST) (MINUS 4))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 3
+; (!*ENTRY SYSWRITEREC EXPR 3)
+L1092: intern L1092
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ SETZM -3(15)
+L1093: MOVE 6,-3(15)
+ CAMG 6,-2(15)
+ JRST L1094
+ SETZM 1
+ JRST L1095
+L1094: MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ AOS 1
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L1091
+ LDB 1,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ HRRZI 12,355
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+355
+ AOS -3(15)
+ JRST L1093
+L1095: ADJSP 15,-4
+ POPJ 15,0
+L1091: point 7,0(1),6
+; (!*ENTRY DEC20WRITECHAR EXPR 2)
+; (!*JUMPEQ (LABEL CRLF) (REG 2) (WCONST 10))
+; (CAIN (REG 2) 10)
+; (JRST (LABEL CRLF))
+; (BOUT)
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*MOVE (WCONST 13) (REG 2))
+; (HRRZI (REG 2) 13)
+; (BOUT)
+; (!*MOVE (WCONST 10) (REG 2))
+; (HRRZI (REG 2) 10)
+; (BOUT)
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY DEC20WRITECHAR EXPR 2)
+L1096: intern L1096
+ CAIN 2,10
+ JRST L1097
+ BOUT
+ POPJ 15,0
+L1097: HRRZI 2,13
+ BOUT
+ HRRZI 2,10
+ BOUT
+ POPJ 15,0
+; (!*ENTRY SYSCLOSE EXPR 1)
+; (CLOSF)
+; (!*JUMP (LABEL CLOSEERROR))
+; (JRST (LABEL CLOSEERROR))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (!*MOVE (QUOTE "Channel could not be closed") (REG 1))
+; (MOVE (REG 1) (QUOTE "Channel could not be closed"))
+; (!*JCALL CHANNELERROR)
+; (JRST (ENTRY CHANNELERROR))
+L1099: 26
+ byte(7)67,104,97,110,110,101,108,32,99,111,117,108,100,32,110,111,116,32,98,101,32,99,108,111,115,101,100,0
+ 1
+; (!*ENTRY SYSCLOSE EXPR 1)
+L1100: intern L1100
+ CLOSF
+ JRST L1101
+ POPJ 15,0
+L1101: MOVE 1,L1098
+ JRST SYMFNC+358
+L1098: <4_31>+L1099
+; (!*ENTRY SYSMAXBUFFER EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 200) (REG 1))
+; (HRRZI (REG 1) 200)
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY SYSMAXBUFFER EXPR 1)
+L1102: intern L1102
+ HRRZI 1,200
+ POPJ 15,0
+ extern L1103
+ extern L1104
+ extern L1105
+ extern L1106
+ extern L1107
+ extern L1108
+ extern L1109
+ extern L1110
+ extern L1111
+ extern L1112
+ extern L1113
+ extern L1114
+; (!*ENTRY IOERROR EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 139)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK ERRORHEADER EXPR 0)
+; (HRRZI (REG LINKREG) 155)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY ERRORHEADER))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 141)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*MOVE (QUOTE 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK RDS EXPR 1)
+; (HRRZI (REG LINKREG) 370)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RDS))
+; (!*MOVE (QUOTE 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*LINK WRS EXPR 1)
+; (HRRZI (REG LINKREG) 371)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY WRS))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY IOERROR EXPR 1)
+L1115: intern L1115
+ PUSH 15,1
+ HRRZI 12,139
+ SETZM 13
+ PUSHJ 15,SYMFNC+139
+ HRRZI 12,155
+ SETZM 13
+ PUSHJ 15,SYMFNC+155
+ MOVE 1,0(15)
+ HRRZI 12,141
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+141
+ SETZM 1
+ HRRZI 12,370
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+370
+ HRRZI 1,1
+ HRRZI 12,371
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+371
+ MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY TYPEFILE EXPR 1)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE INPUT) (REG 2))
+; (MOVE (REG 2) (QUOTE INPUT))
+; (!*LINK OPEN EXPR 2)
+; (HRRZI (REG LINKREG) 372)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY OPEN))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK RDS EXPR 1)
+; (HRRZI (REG LINKREG) 370)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RDS))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0007))
+; (!*LINK GETC EXPR 0)
+; (HRRZI (REG LINKREG) 206)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY GETC))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMPEQ (LABEL G0006) (REG 1) (QUOTE 26))
+; (CAIN (REG 1) 26)
+; (JRST (LABEL G0006))
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*JUMP (LABEL G0007))
+; (JRST (LABEL G0007))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK RDS EXPR 1)
+; (HRRZI (REG LINKREG) 370)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RDS))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK CLOSE EXPR 1)
+; (HRRZI (REG LINKREG) 373)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY CLOSE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 4)
+; (ADJSP (REG ST) (MINUS 4))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY TYPEFILE EXPR 1)
+L1117: intern L1117
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVE 2,L1116
+ HRRZI 12,372
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+372
+ MOVEM 1,-1(15)
+ HRRZI 12,370
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+370
+ MOVEM 1,-2(15)
+L1118: HRRZI 12,206
+ SETZM 13
+ PUSHJ 15,SYMFNC+206
+ MOVEM 1,-3(15)
+ CAIN 1,26
+ JRST L1119
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ JRST L1118
+L1119: MOVE 1,-2(15)
+ HRRZI 12,370
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+370
+ MOVE 1,-1(15)
+ HRRZI 12,373
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+373
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L1116: <30_31>+375
+; (!*ENTRY DSKIN EXPR 1)
+; (!*ALLOC 4)
+; (ADJSP (REG ST) 4)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (QUOTE INPUT) (REG 2))
+; (MOVE (REG 2) (QUOTE INPUT))
+; (!*LINK OPEN EXPR 2)
+; (HRRZI (REG LINKREG) 372)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY OPEN))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK RDS EXPR 1)
+; (HRRZI (REG LINKREG) 370)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RDS))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*LBL (LABEL G0007))
+; (!*LINK READ EXPR 0)
+; (HRRZI (REG LINKREG) 221)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY READ))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMPEQ (LABEL G0006) (REG 1) (!$GLOBAL !$EOF!$))
+; (CAMN (REG 1) (!$GLOBAL !$EOF!$))
+; (JRST (LABEL G0006))
+; (!*LINK EVAL EXPR 1)
+; (HRRZI (REG LINKREG) 254)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY EVAL))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMPEQ (LABEL G0007) (QUOTE NIL) (!$FLUID !*PVAL))
+; (CAMN (REG NIL) (!$FLUID !*PVAL))
+; (JRST (LABEL G0007))
+; (!*LINK PRINT EXPR 1)
+; (HRRZI (REG LINKREG) 140)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRINT))
+; (!*JUMP (LABEL G0007))
+; (JRST (LABEL G0007))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*LINK RDS EXPR 1)
+; (HRRZI (REG LINKREG) 370)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY RDS))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK CLOSE EXPR 1)
+; (HRRZI (REG LINKREG) 373)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY CLOSE))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 4)
+; (ADJSP (REG ST) (MINUS 4))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY DSKIN EXPR 1)
+DSKIN: intern DSKIN
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVE 2,L1120
+ HRRZI 12,372
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+372
+ MOVEM 1,-1(15)
+ HRRZI 12,370
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+370
+ MOVEM 1,-2(15)
+L1121: HRRZI 12,221
+ SETZM 13
+ PUSHJ 15,SYMFNC+221
+ MOVEM 1,-3(15)
+ CAMN 1,SYMVAL+377
+ JRST L1122
+ HRRZI 12,254
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+254
+ MOVEM 1,-3(15)
+ CAMN 0,SYMVAL+378
+ JRST L1121
+ HRRZI 12,140
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+140
+ JRST L1121
+L1122: MOVE 1,-2(15)
+ HRRZI 12,370
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+370
+ MOVE 1,-1(15)
+ HRRZI 12,373
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+373
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L1120: <30_31>+375
+; (!*ENTRY LAPIN EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*PROGBIND (NONLOCALVARS (!$FLUID !*PVAL) (!$FLUID !*ECHO)))
+; (MOVE (REG 1) (QUOTE [!*PVAL !*ECHO]))
+; (PUSHJ (REG ST) (ENTRY PROGBIND))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK DSKIN EXPR 1)
+; (HRRZI (REG LINKREG) 376)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY DSKIN))
+; (!*FREERSTR (NONLOCALVARS (!$FLUID !*PVAL) (!$FLUID !*ECHO)))
+; (HRRZI (REG 1) 2)
+; (PUSHJ (REG ST) (ENTRY UNBINDN))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+L1124: 1
+ <30_31>+378
+ <30_31>+379
+ 1
+; (!*ENTRY LAPIN EXPR 1)
+LAPIN: intern LAPIN
+ PUSH 15,1
+ MOVE 1,L1123
+ PUSHJ 15,SYMFNC+347
+ MOVE 1,0(15)
+ HRRZI 12,376
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+376
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+168
+ ADJSP 15,-1
+ POPJ 15,0
+L1123: <8_31>+L1124
+; (!*ENTRY OPEN EXPR 2)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (REG 2) (QUOTE INPUT))
+; (CAME (REG 2) (QUOTE INPUT))
+; (JRST (LABEL G0004))
+; (!*LINKE 0 SYSTEMOPENFILEFORINPUT EXPR 1)
+; (HRRZI (REG LINKREG) 381)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY SYSTEMOPENFILEFORINPUT))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTEQ (LABEL G0005) (REG 2) (QUOTE OUTPUT))
+; (CAME (REG 2) (QUOTE OUTPUT))
+; (JRST (LABEL G0005))
+; (!*LINKE 0 SYSTEMOPENFILEFOROUTPUT EXPR 1)
+; (HRRZI (REG LINKREG) 382)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY SYSTEMOPENFILEFOROUTPUT))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (QUOTE "Cant Open") (REG 1))
+; (MOVE (REG 1) (QUOTE "Cant Open"))
+; (!*LINKE 0 IOERROR EXPR 1)
+; (HRRZI (REG LINKREG) 354)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY IOERROR))
+L1128: 8
+ byte(7)67,97,110,116,32,79,112,101,110,0
+ 2
+; (!*ENTRY OPEN EXPR 2)
+OPEN: intern OPEN
+ CAME 2,L1125
+ JRST L1129
+ HRRZI 12,381
+ HRRZI 13,1
+ JRST SYMFNC+381
+L1129: CAME 2,L1126
+ JRST L1130
+ HRRZI 12,382
+ HRRZI 13,1
+ JRST SYMFNC+382
+L1130: MOVE 1,L1127
+ HRRZI 12,354
+ HRRZI 13,1
+ JRST SYMFNC+354
+L1127: <4_31>+L1128
+L1126: <30_31>+383
+L1125: <30_31>+375
+; (!*ENTRY CLOSE EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 INDEPENDENTCLOSECHANNEL EXPR 1)
+; (HRRZI (REG LINKREG) 384)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTCLOSECHANNEL))
+ 1
+; (!*ENTRY CLOSE EXPR 1)
+CLOSE: intern CLOSE
+ HRRZI 12,384
+ HRRZI 13,1
+ JRST SYMFNC+384
+; (!*ENTRY RDS EXPR 1)
+; (!*ALLOC 0)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE 0) (REG 1))
+; (SETZM (REG 1))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*MOVE (!$GLOBAL IN!*) (REG 2))
+; (MOVE (REG 2) (!$GLOBAL IN!*))
+; (!*MOVE (REG 1) (!$GLOBAL IN!*))
+; (MOVEM (REG 1) (!$GLOBAL IN!*))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY RDS EXPR 1)
+RDS: intern RDS
+L1131: MOVE 3,1
+ CAME 1,0
+ JRST L1132
+ SETZM 1
+ JRST L1131
+L1132: MOVE 2,0
+ MOVE 2,SYMVAL+385
+ MOVEM 1,SYMVAL+385
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY WRS EXPR 1)
+; (!*ALLOC 0)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE NIL))
+; (CAME (REG 1) (REG NIL))
+; (JRST (LABEL G0004))
+; (!*MOVE (QUOTE 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*MOVE (!$GLOBAL OUT!*) (REG 2))
+; (MOVE (REG 2) (!$GLOBAL OUT!*))
+; (!*MOVE (REG 1) (!$GLOBAL OUT!*))
+; (MOVEM (REG 1) (!$GLOBAL OUT!*))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY WRS EXPR 1)
+WRS: intern WRS
+L1133: MOVE 3,1
+ CAME 1,0
+ JRST L1134
+ HRRZI 1,1
+ JRST L1133
+L1134: MOVE 2,0
+ MOVE 2,SYMVAL+154
+ MOVEM 1,SYMVAL+154
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY FINDFREECHANNEL EXPR 0)
+; (!*PUSH (WCONST 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*LBL (LABEL G0005))
+; (!*JUMPEQ (LABEL G0004) (WCONST 0) (MEMORY (FRAME 1) (WCONST CHANNELSTATUS)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (SKIPN (INDEXED (REG T2) (IMMEDIATE CHANNELSTATUS)))
+; (JRST (LABEL G0004))
+; (!*JUMPWLESSP (LABEL G0009) (FRAME 1) (WCONST 31))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (CAIGE (REG T1) 31)
+; (JRST (LABEL G0009))
+; (!*MOVE (QUOTE "No free channels left") (REG 1))
+; (MOVE (REG 1) (QUOTE "No free channels left"))
+; (!*LINK IOERROR EXPR 1)
+; (HRRZI (REG LINKREG) 354)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY IOERROR))
+; (!*LBL (LABEL G0009))
+; (!*WPLUS2 (FRAME 1) (WCONST 1))
+; (AOS (INDEXED (REG ST) 0))
+; (!*JUMP (LABEL G0005))
+; (JRST (LABEL G0005))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+L1137: 20
+ byte(7)78,111,32,102,114,101,101,32,99,104,97,110,110,101,108,115,32,108,101,102,116,0
+ 0
+; (!*ENTRY FINDFREECHANNEL EXPR 0)
+L1138: intern L1138
+ PUSH 15,L1135
+L1139: MOVE 7,0(15)
+ SKIPN L1110(7)
+ JRST L1140
+ MOVE 6,0(15)
+ CAIGE 6,31
+ JRST L1141
+ MOVE 1,L1136
+ HRRZI 12,354
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+354
+L1141: AOS 0(15)
+ JRST L1139
+L1140: MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L1135: 0
+L1136: <4_31>+L1137
+; (!*ENTRY SYSTEMOPENFILEFORINPUT EXPR 1)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK FINDFREECHANNEL EXPR 0)
+; (HRRZI (REG LINKREG) 389)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY FINDFREECHANNEL))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINK SYSOPENREAD EXPR 2)
+; (HRRZI (REG LINKREG) 350)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY SYSOPENREAD))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST CHANNELTABLE)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE CHANNELTABLE)))
+; (!*MOVE (WCONST 1) (MEMORY (FRAME 2) (WCONST CHANNELSTATUS)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (INDEXED (REG T2) (IMMEDIATE CHANNELSTATUS)))
+; (!*MOVE (MEMORY (FRAME 2) (WCONST CHANNELTABLE)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE CHANNELTABLE)))
+; (!*LINK SYSMAXBUFFER EXPR 1)
+; (HRRZI (REG LINKREG) 359)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY SYSMAXBUFFER))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST MAXBUFFER)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE MAXBUFFER)))
+; (!*MOVE (QUOTE INDEPENDENTREADCHAR) (REG 1))
+; (MOVE (REG 1) (QUOTE INDEPENDENTREADCHAR))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST READFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE READFUNCTION)))
+; (!*MOVE (QUOTE READONLYCHANNEL) (REG 1))
+; (MOVE (REG 1) (QUOTE READONLYCHANNEL))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST WRITEFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE WRITEFUNCTION)))
+; (!*MOVE (QUOTE INDEPENDENTCLOSECHANNEL) (REG 1))
+; (MOVE (REG 1) (QUOTE INDEPENDENTCLOSECHANNEL))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST CLOSEFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE CLOSEFUNCTION)))
+; (!*MOVE (WCONST 32) (REG 2))
+; (HRRZI (REG 2) 32)
+; (!*MOVE (MEMORY (FRAME 2) (WCONST MAXBUFFER)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE MAXBUFFER)))
+; (!*LINK MKSTRING EXPR 2)
+; (HRRZI (REG LINKREG) 188)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY MKSTRING))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 3) (!$FLUID IOBUFFER))
+; (ADD (REG 3) (!$FLUID IOBUFFER))
+; (!*MOVE (REG 1) (MEMORY (REG 3) (WCONST 1)))
+; (MOVEM (REG 1) (INDEXED (REG 3) 1))
+; (!*MOVE (WCONST 0) (MEMORY (FRAME 2) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (SETZM (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (WCONST -1) (MEMORY (FRAME 2) (WCONST BUFFERLENGTH)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (SETOM (INDEXED (REG T2) (IMMEDIATE BUFFERLENGTH)))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY SYSTEMOPENFILEFORINPUT EXPR 1)
+L1145: intern L1145
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ HRRZI 12,389
+ SETZM 13
+ PUSHJ 15,SYMFNC+389
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ HRRZI 12,350
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+350
+ MOVE 7,-1(15)
+ MOVEM 1,L1112(7)
+ MOVE 7,-1(15)
+ HRRZI 6,1
+ MOVEM 6,L1110(7)
+ MOVE 1,-1(15)
+ MOVE 1,L1112(1)
+ HRRZI 12,359
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+359
+ MOVE 7,-1(15)
+ MOVEM 1,L1111(7)
+ MOVE 1,L1142
+ MOVE 7,-1(15)
+ MOVEM 1,L1104(7)
+ MOVE 1,L1143
+ MOVE 7,-1(15)
+ MOVEM 1,L1105(7)
+ MOVE 1,L1144
+ MOVE 7,-1(15)
+ MOVEM 1,L1106(7)
+ HRRZI 2,32
+ MOVE 1,-1(15)
+ MOVE 1,L1111(1)
+ HRRZI 12,188
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+188
+ MOVE 3,-1(15)
+ ADD 3,SYMVAL+390
+ MOVEM 1,1(3)
+ MOVE 7,-1(15)
+ SETZM L1113(7)
+ MOVE 7,-1(15)
+ SETOM L1114(7)
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L1144: <30_31>+384
+L1143: <30_31>+364
+L1142: <30_31>+391
+; (!*ENTRY SYSTEMOPENFILEFOROUTPUT EXPR 1)
+; (!*ALLOC 2)
+; (ADJSP (REG ST) 2)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK FINDFREECHANNEL EXPR 0)
+; (HRRZI (REG LINKREG) 389)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY FINDFREECHANNEL))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*LINK SYSOPENWRITE EXPR 2)
+; (HRRZI (REG LINKREG) 351)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY SYSOPENWRITE))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST CHANNELTABLE)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE CHANNELTABLE)))
+; (!*MOVE (WCONST 2) (MEMORY (FRAME 2) (WCONST CHANNELSTATUS)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (HRRZI (REG T1) 2)
+; (MOVEM (REG T1) (INDEXED (REG T2) (IMMEDIATE CHANNELSTATUS)))
+; (!*MOVE (MEMORY (FRAME 2) (WCONST CHANNELTABLE)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE CHANNELTABLE)))
+; (!*LINK SYSMAXBUFFER EXPR 1)
+; (HRRZI (REG LINKREG) 359)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY SYSMAXBUFFER))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST MAXBUFFER)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE MAXBUFFER)))
+; (!*MOVE (QUOTE WRITEONLYCHANNEL) (REG 1))
+; (MOVE (REG 1) (QUOTE WRITEONLYCHANNEL))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST READFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE READFUNCTION)))
+; (!*MOVE (QUOTE INDEPENDENTWRITECHAR) (REG 1))
+; (MOVE (REG 1) (QUOTE INDEPENDENTWRITECHAR))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST WRITEFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE WRITEFUNCTION)))
+; (!*MOVE (QUOTE INDEPENDENTCLOSECHANNEL) (REG 1))
+; (MOVE (REG 1) (QUOTE INDEPENDENTCLOSECHANNEL))
+; (!*MOVE (REG 1) (MEMORY (FRAME 2) (WCONST CLOSEFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE CLOSEFUNCTION)))
+; (!*MOVE (WCONST 32) (REG 2))
+; (HRRZI (REG 2) 32)
+; (!*MOVE (MEMORY (FRAME 2) (WCONST MAXBUFFER)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE MAXBUFFER)))
+; (!*LINK MKSTRING EXPR 2)
+; (HRRZI (REG LINKREG) 188)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY MKSTRING))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 3) (!$FLUID IOBUFFER))
+; (ADD (REG 3) (!$FLUID IOBUFFER))
+; (!*MOVE (REG 1) (MEMORY (REG 3) (WCONST 1)))
+; (MOVEM (REG 1) (INDEXED (REG 3) 1))
+; (!*MOVE (WCONST -1) (MEMORY (FRAME 2) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (SETOM (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (WCONST -1) (MEMORY (FRAME 2) (WCONST BUFFERLENGTH)))
+; (MOVE (REG T2) (INDEXED (REG ST) -1))
+; (SETOM (INDEXED (REG T2) (IMMEDIATE BUFFERLENGTH)))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY SYSTEMOPENFILEFOROUTPUT EXPR 1)
+L1149: intern L1149
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ HRRZI 12,389
+ SETZM 13
+ PUSHJ 15,SYMFNC+389
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ HRRZI 12,351
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+351
+ MOVE 7,-1(15)
+ MOVEM 1,L1112(7)
+ MOVE 7,-1(15)
+ HRRZI 6,2
+ MOVEM 6,L1110(7)
+ MOVE 1,-1(15)
+ MOVE 1,L1112(1)
+ HRRZI 12,359
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+359
+ MOVE 7,-1(15)
+ MOVEM 1,L1111(7)
+ MOVE 1,L1146
+ MOVE 7,-1(15)
+ MOVEM 1,L1104(7)
+ MOVE 1,L1147
+ MOVE 7,-1(15)
+ MOVEM 1,L1105(7)
+ MOVE 1,L1148
+ MOVE 7,-1(15)
+ MOVEM 1,L1106(7)
+ HRRZI 2,32
+ MOVE 1,-1(15)
+ MOVE 1,L1111(1)
+ HRRZI 12,188
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+188
+ MOVE 3,-1(15)
+ ADD 3,SYMVAL+390
+ MOVEM 1,1(3)
+ MOVE 7,-1(15)
+ SETOM L1113(7)
+ MOVE 7,-1(15)
+ SETOM L1114(7)
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L1148: <30_31>+384
+L1147: <30_31>+152
+L1146: <30_31>+361
+; (!*ENTRY SYSTEMOPENFILESPECIAL EXPR 1)
+; (!*ALLOC 0)
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (QUOTE NIL) (REG 2))
+; (MOVE (REG 2) (REG NIL))
+; (!*MOVE (WCONST 3) (MEMORY (REG 2) (WCONST CHANNELSTATUS)))
+; (HRRZI (REG T1) 3)
+; (MOVEM (REG T1) (INDEXED (REG 2) (IMMEDIATE CHANNELSTATUS)))
+; (!*MOVE (REG 2) (REG 1))
+; (MOVE (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY SYSTEMOPENFILESPECIAL EXPR 1)
+L1150: intern L1150
+ MOVE 3,1
+ MOVE 2,0
+ HRRZI 6,3
+ MOVEM 6,L1110(2)
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY TESTLEGALCHANNEL EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTTYPE (LABEL G0005) (REG 1) POSINT)
+; (TLNE (REG 1) 253952)
+; (JRST (LABEL G0005))
+; (!*JUMPWLEQ (LABEL G0004) (REG 1) (WCONST 31))
+; (CAIG (REG 1) 31)
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (QUOTE " is not a legal channel ") (REG 2))
+; (MOVE (REG 2) (QUOTE " is not a legal channel "))
+; (!*LINK LIST2 EXPR 2)
+; (HRRZI (REG LINKREG) 183)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LIST2))
+; (!*LINKE 0 IOERROR EXPR 1)
+; (HRRZI (REG LINKREG) 354)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY IOERROR))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L1152: 23
+ byte(7)32,105,115,32,110,111,116,32,97,32,108,101,103,97,108,32,99,104,97,110,110,101,108,32,0
+ 1
+; (!*ENTRY TESTLEGALCHANNEL EXPR 1)
+L1153: intern L1153
+ TLNE 1,253952
+ JRST L1154
+ CAIG 1,31
+ JRST L1155
+L1154: MOVE 2,L1151
+ HRRZI 12,183
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+183
+ HRRZI 12,354
+ HRRZI 13,1
+ JRST SYMFNC+354
+L1155: MOVE 1,0
+ POPJ 15,0
+L1151: <4_31>+L1152
+; (!*ENTRY INDEPENDENTREADCHAR EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK TESTLEGALCHANNEL EXPR 1)
+; (HRRZI (REG LINKREG) 393)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY TESTLEGALCHANNEL))
+; (!*JUMPWGEQ (LABEL G0004) (MEMORY (FRAME 1) (WCONST BUFFERLENGTH)) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVE (REG T1) (INDEXED (REG T1) (IMMEDIATE BUFFERLENGTH)))
+; (CAML (REG T1) (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (JRST (LABEL G0004))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 2) (!$FLUID IOBUFFER))
+; (ADD (REG 2) (!$FLUID IOBUFFER))
+; (!*MOVE (MEMORY (REG 2) (WCONST 1)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST CHANNELTABLE)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE CHANNELTABLE)))
+; (!*LINK SYSREADREC EXPR 2)
+; (HRRZI (REG LINKREG) 353)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY SYSREADREC))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST BUFFERLENGTH)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE BUFFERLENGTH)))
+; (!*MOVE (WCONST 0) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (SETZM (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (MOVE (REG 2) (INDEXED (REG 2) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 3) (!$FLUID IOBUFFER))
+; (ADD (REG 3) (!$FLUID IOBUFFER))
+; (!*MOVE (MEMORY (REG 3) (WCONST 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 3) 1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE NEXTPOSITION)))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*JUMPEQ (LABEL G0009) (QUOTE NIL) (!$FLUID !*ECHO))
+; (CAMN (REG NIL) (!$FLUID !*ECHO))
+; (JRST (LABEL G0009))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK WRITECHAR EXPR 1)
+; (HRRZI (REG LINKREG) 153)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY WRITECHAR))
+; (!*LBL (LABEL G0009))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 1
+; (!*ENTRY INDEPENDENTREADCHAR EXPR 1)
+L1157: intern L1157
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZI 12,393
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+393
+ MOVE 6,0(15)
+ MOVE 7,0(15)
+ MOVE 6,L1114(6)
+ CAML 6,L1113(7)
+ JRST L1158
+ MOVE 2,0(15)
+ ADD 2,SYMVAL+390
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ MOVE 1,L1112(1)
+ HRRZI 12,353
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+353
+ MOVEM 1,-2(15)
+ MOVE 7,0(15)
+ MOVEM 1,L1114(7)
+ MOVE 7,0(15)
+ SETZM L1113(7)
+L1158: MOVE 2,0(15)
+ MOVE 2,L1113(2)
+ MOVE 3,0(15)
+ ADD 3,SYMVAL+390
+ MOVE 1,1(3)
+ AOS 1
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L1156
+ LDB 1,2
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,L1113(1)
+ AOS 1
+ MOVE 7,0(15)
+ MOVEM 1,L1113(7)
+ CAMN 0,SYMVAL+379
+ JRST L1159
+ MOVE 1,-1(15)
+ HRRZI 12,153
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+153
+L1159: MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L1156: point 7,0(1),6
+; (!*ENTRY INDEPENDENTWRITECHAR EXPR 2)
+; (!*PUSH (REG 2))
+; (PUSH (REG ST) (REG 2))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TESTLEGALCHANNEL EXPR 1)
+; (HRRZI (REG LINKREG) 393)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY TESTLEGALCHANNEL))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE NEXTPOSITION)))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (MOVE (REG 2) (INDEXED (REG 2) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (FRAME 1) (REG 4))
+; (MOVE (REG 4) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 4) (!$FLUID IOBUFFER))
+; (ADD (REG 4) (!$FLUID IOBUFFER))
+; (!*MOVE (MEMORY (REG 4) (WCONST 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 4) 1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK PUTBYTE EXPR 3)
+; (HRRZI (REG LINKREG) 187)
+; (HRRZI (REG NARGREG) 3)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (DPB (REG 3) (REG 2))
+; (!*JUMPEQ (LABEL G0006) (REG 3) (WCONST 10))
+; (CAIN (REG 3) 10)
+; (JRST (LABEL G0006))
+; (!*JUMPWGREATERP (LABEL G0004) (MEMORY (FRAME 1) (WCONST BUFFERLENGTH)) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVE (REG T1) (INDEXED (REG T1) (IMMEDIATE BUFFERLENGTH)))
+; (CAMLE (REG T1) (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (MOVE (REG 3) (INDEXED (REG 3) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 2) (!$FLUID IOBUFFER))
+; (ADD (REG 2) (!$FLUID IOBUFFER))
+; (!*MOVE (MEMORY (REG 2) (WCONST 1)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST CHANNELTABLE)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE CHANNELTABLE)))
+; (!*LINK SYSWRITEREC EXPR 3)
+; (HRRZI (REG LINKREG) 356)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY SYSWRITEREC))
+; (!*MOVE (WCONST -1) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (SETOM (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+ 2
+; (!*ENTRY INDEPENDENTWRITECHAR EXPR 2)
+L1161: intern L1161
+ PUSH 15,2
+ PUSH 15,1
+ HRRZI 12,393
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+393
+ MOVE 1,0(15)
+ MOVE 1,L1113(1)
+ AOS 1
+ MOVE 7,0(15)
+ MOVEM 1,L1113(7)
+ MOVE 3,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,L1113(2)
+ MOVE 4,0(15)
+ ADD 4,SYMVAL+390
+ MOVE 1,1(4)
+ AOS 1
+ HRRZI 12,187
+ HRRZI 13,3
+ ADJBP 2,L1160
+ DPB 3,2
+ CAIN 3,10
+ JRST L1162
+ MOVE 6,0(15)
+ MOVE 7,0(15)
+ MOVE 6,L1114(6)
+ CAMLE 6,L1113(7)
+ JRST L1163
+L1162: MOVE 3,0(15)
+ MOVE 3,L1113(3)
+ MOVE 2,0(15)
+ ADD 2,SYMVAL+390
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ MOVE 1,L1112(1)
+ HRRZI 12,356
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+356
+ MOVE 7,0(15)
+ SETOM L1113(7)
+L1163: MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L1160: point 7,0(1),6
+; (!*ENTRY SYSTEMMARKASCLOSEDCHANNEL EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TESTLEGALCHANNEL EXPR 1)
+; (HRRZI (REG LINKREG) 393)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY TESTLEGALCHANNEL))
+; (!*MOVE (WCONST 0) (MEMORY (FRAME 1) (WCONST CHANNELSTATUS)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (SETZM (INDEXED (REG T2) (IMMEDIATE CHANNELSTATUS)))
+; (!*MOVE (QUOTE CHANNELNOTOPEN) (REG 1))
+; (MOVE (REG 1) (QUOTE CHANNELNOTOPEN))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST CLOSEFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE CLOSEFUNCTION)))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST WRITEFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE WRITEFUNCTION)))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST READFUNCTION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE READFUNCTION)))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY SYSTEMMARKASCLOSEDCHANNEL EXPR 1)
+L1165: intern L1165
+ PUSH 15,1
+ HRRZI 12,393
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+393
+ MOVE 7,0(15)
+ SETZM L1110(7)
+ MOVE 1,L1164
+ MOVE 7,0(15)
+ MOVEM 1,L1106(7)
+ MOVE 7,0(15)
+ MOVEM 1,L1105(7)
+ MOVE 7,0(15)
+ MOVEM 1,L1104(7)
+ ADJSP 15,-1
+ POPJ 15,0
+L1164: <30_31>+363
+; (!*ENTRY INDEPENDENTCLOSECHANNEL EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LINK TESTLEGALCHANNEL EXPR 1)
+; (HRRZI (REG LINKREG) 393)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY TESTLEGALCHANNEL))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST CHANNELTABLE)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE CHANNELTABLE)))
+; (!*LINKE 1 SYSCLOSE EXPR 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 357)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY SYSCLOSE))
+ 1
+; (!*ENTRY INDEPENDENTCLOSECHANNEL EXPR 1)
+L1166: intern L1166
+ PUSH 15,1
+ HRRZI 12,393
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+393
+ MOVE 1,0(15)
+ MOVE 1,L1112(1)
+ ADJSP 15,-1
+ HRRZI 12,357
+ HRRZI 13,1
+ JRST SYMFNC+357
+; (!*ENTRY CLEARONECHANNEL EXPR 3)
+; (!*PUSH (REG 2))
+; (PUSH (REG ST) (REG 2))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*MOVE (REG 2) (MEMORY (REG 1) (WCONST MAXBUFFER)))
+; (MOVEM (REG 2) (INDEXED (REG 1) (IMMEDIATE MAXBUFFER)))
+; (!*MOVE (WCONST 0) (MEMORY (REG 1) (WCONST NEXTPOSITION)))
+; (SETZM (INDEXED (REG 1) (IMMEDIATE NEXTPOSITION)))
+; (!*JUMPNOTEQ (LABEL G0004) (REG 3) (QUOTE INPUT))
+; (CAME (REG 3) (QUOTE INPUT))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST -1) (MEMORY (REG 1) (WCONST BUFFERLENGTH)))
+; (SETOM (INDEXED (REG 1) (IMMEDIATE BUFFERLENGTH)))
+; (!*JUMP (LABEL G0003))
+; (JRST (LABEL G0003))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (WCONST 0) (MEMORY (REG 1) (WCONST BUFFERLENGTH)))
+; (SETZM (INDEXED (REG 1) (IMMEDIATE BUFFERLENGTH)))
+; (!*LBL (LABEL G0003))
+; (!*MOVE (WCONST 32) (REG 2))
+; (HRRZI (REG 2) 32)
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK MKSTRING EXPR 2)
+; (HRRZI (REG LINKREG) 188)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY MKSTRING))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 2) (!$FLUID IOBUFFER))
+; (ADD (REG 2) (!$FLUID IOBUFFER))
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 1)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 1))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+ 3
+; (!*ENTRY CLEARONECHANNEL EXPR 3)
+L1168: intern L1168
+ PUSH 15,2
+ PUSH 15,1
+ MOVEM 2,L1111(1)
+ SETZM L1113(1)
+ CAME 3,L1167
+ JRST L1169
+ SETOM L1114(1)
+ JRST L1170
+L1169: SETZM L1114(1)
+L1170: HRRZI 2,32
+ MOVE 1,-1(15)
+ HRRZI 12,188
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+188
+ MOVE 2,0(15)
+ ADD 2,SYMVAL+390
+ MOVEM 1,1(2)
+ ADJSP 15,-2
+ POPJ 15,0
+L1167: <30_31>+375
+; (!*ENTRY CLEARIO EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK SYSCLEARIO EXPR 0)
+; (HRRZI (REG LINKREG) 348)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY SYSCLEARIO))
+; (!*JUMPTYPE (LABEL G0003) (!$FLUID IOBUFFER) VECT)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (!$FLUID IOBUFFER) 0 5))))
+; (CAIN (REG T6) 8)
+; (JRST (LABEL G0003))
+; (!*MOVE (WCONST 31) (REG 1))
+; (HRRZI (REG 1) 31)
+; (!*LINK MKVECT EXPR 1)
+; (HRRZI (REG LINKREG) 182)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY MKVECT))
+; (!*MOVE (REG 1) (!$FLUID IOBUFFER))
+; (MOVEM (REG 1) (!$FLUID IOBUFFER))
+; (!*MOVE (QUOTE INPUT) (REG 3))
+; (MOVE (REG 3) (QUOTE INPUT))
+; (!*MOVE (WCONST 200) (REG 2))
+; (HRRZI (REG 2) 200)
+; (!*MOVE (!$FLUID STDIN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID STDIN!*))
+; (!*LINK CLEARONECHANNEL EXPR 3)
+; (HRRZI (REG LINKREG) 395)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY CLEARONECHANNEL))
+; (!*MOVE (QUOTE OUTPUT) (REG 3))
+; (MOVE (REG 3) (QUOTE OUTPUT))
+; (!*MOVE (WCONST 200) (REG 2))
+; (HRRZI (REG 2) 200)
+; (!*MOVE (!$FLUID STDOUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID STDOUT!*))
+; (!*LINK CLEARONECHANNEL EXPR 3)
+; (HRRZI (REG LINKREG) 395)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY CLEARONECHANNEL))
+; (!*MOVE (QUOTE OUTPUT) (REG 3))
+; (MOVE (REG 3) (QUOTE OUTPUT))
+; (!*MOVE (WCONST 200) (REG 2))
+; (HRRZI (REG 2) 200)
+; (!*MOVE (!$FLUID ERROUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID ERROUT!*))
+; (!*LINK CLEARONECHANNEL EXPR 3)
+; (HRRZI (REG LINKREG) 395)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY CLEARONECHANNEL))
+; (!*MOVE (QUOTE OUTPUT) (REG 3))
+; (MOVE (REG 3) (QUOTE OUTPUT))
+; (!*MOVE (WCONST 200) (REG 2))
+; (HRRZI (REG 2) 200)
+; (!*MOVE (!$FLUID PROMPTOUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID PROMPTOUT!*))
+; (!*LINK CLEARONECHANNEL EXPR 3)
+; (HRRZI (REG LINKREG) 395)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY CLEARONECHANNEL))
+; (!*LBL (LABEL G0003))
+; (!*MOVE (!$FLUID STDIN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID STDIN!*))
+; (!*MOVE (REG 1) (!$FLUID IN!*))
+; (MOVEM (REG 1) (!$FLUID IN!*))
+; (!*MOVE (!$FLUID STDOUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID STDOUT!*))
+; (!*MOVE (REG 1) (!$FLUID OUT!*))
+; (MOVEM (REG 1) (!$FLUID OUT!*))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (!$FLUID IOBUFFER) 0 5))
+ 0
+; (!*ENTRY CLEARIO EXPR 0)
+L1174: intern L1174
+ HRRZI 12,348
+ SETZM 13
+ PUSHJ 15,SYMFNC+348
+ LDB 11,L1171
+ CAIN 11,8
+ JRST L1175
+ HRRZI 1,31
+ HRRZI 12,182
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+182
+ MOVEM 1,SYMVAL+390
+ MOVE 3,L1172
+ HRRZI 2,200
+ MOVE 1,SYMVAL+386
+ HRRZI 12,395
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+395
+ MOVE 3,L1173
+ HRRZI 2,200
+ MOVE 1,SYMVAL+387
+ HRRZI 12,395
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+395
+ MOVE 3,L1173
+ HRRZI 2,200
+ MOVE 1,SYMVAL+340
+ HRRZI 12,395
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+395
+ MOVE 3,L1173
+ HRRZI 2,200
+ MOVE 1,SYMVAL+388
+ HRRZI 12,395
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+395
+L1175: MOVE 1,SYMVAL+386
+ MOVEM 1,SYMVAL+385
+ MOVE 1,SYMVAL+387
+ MOVEM 1,SYMVAL+154
+ POPJ 15,0
+L1171: point 5,<SYMVAL+390>,4
+L1173: <30_31>+383
+L1172: <30_31>+375
+; (!*ENTRY TERMINALINPUTHANDLER EXPR 1)
+; (!*ALLOC 3)
+; (ADJSP (REG ST) 3)
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK TESTLEGALCHANNEL EXPR 1)
+; (HRRZI (REG LINKREG) 393)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY TESTLEGALCHANNEL))
+; (!*JUMPWGEQ (LABEL G0004) (MEMORY (FRAME 1) (WCONST BUFFERLENGTH)) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVE (REG T1) (INDEXED (REG T1) (IMMEDIATE BUFFERLENGTH)))
+; (CAML (REG T1) (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (JRST (LABEL G0004))
+; (!*JUMPNOTTYPE (LABEL G0007) (!$FLUID PROMPTSTRING!*) STR)
+; (LDB (REG T6) (LIT (FULLWORD (FIELDPOINTER (!$FLUID PROMPTSTRING!*) 0 5))))
+; (CAIE (REG T6) 4)
+; (JRST (LABEL G0007))
+; (!*MOVE (!$FLUID PROMPTSTRING!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID PROMPTSTRING!*))
+; (!*JUMP (LABEL G0006))
+; (JRST (LABEL G0006))
+; (!*LBL (LABEL G0007))
+; (!*MOVE (QUOTE ">") (REG 1))
+; (MOVE (REG 1) (QUOTE ">"))
+; (!*LBL (LABEL G0006))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID PROMPTOUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID PROMPTOUT!*))
+; (!*LINK CHANNELWRITESTRING EXPR 2)
+; (HRRZI (REG LINKREG) 397)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY CHANNELWRITESTRING))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 2) (!$FLUID IOBUFFER))
+; (ADD (REG 2) (!$FLUID IOBUFFER))
+; (!*MOVE (MEMORY (REG 2) (WCONST 1)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG 2) 1))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST CHANNELTABLE)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE CHANNELTABLE)))
+; (!*LINK SYSREADREC EXPR 2)
+; (HRRZI (REG LINKREG) 353)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY SYSREADREC))
+; (!*MOVE (REG 1) (FRAME 3))
+; (MOVEM (REG 1) (INDEXED (REG ST) -2))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST BUFFERLENGTH)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE BUFFERLENGTH)))
+; (!*MOVE (WCONST 0) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (SETZM (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*LBL (LABEL G0004))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (MOVE (REG 2) (INDEXED (REG 2) (IMMEDIATE NEXTPOSITION)))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*WPLUS2 (REG 3) (!$FLUID IOBUFFER))
+; (ADD (REG 3) (!$FLUID IOBUFFER))
+; (!*MOVE (MEMORY (REG 3) (WCONST 1)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG 3) 1))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*LINK BYTE EXPR 2)
+; (HRRZI (REG LINKREG) 147)
+; (HRRZI (REG NARGREG) 2)
+; (ADJBP (REG 2) (LIT (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))))
+; (LDB (REG 1) (REG 2))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*MOVE (MEMORY (FRAME 1) (WCONST NEXTPOSITION)) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (MOVE (REG 1) (INDEXED (REG 1) (IMMEDIATE NEXTPOSITION)))
+; (!*WPLUS2 (REG 1) (WCONST 1))
+; (AOS (REG 1))
+; (!*MOVE (REG 1) (MEMORY (FRAME 1) (WCONST NEXTPOSITION)))
+; (MOVE (REG T2) (INDEXED (REG ST) 0))
+; (MOVEM (REG 1) (INDEXED (REG T2) (IMMEDIATE NEXTPOSITION)))
+; (!*JUMPEQ (LABEL G0014) (QUOTE NIL) (!$FLUID !*ECHO))
+; (CAMN (REG NIL) (!$FLUID !*ECHO))
+; (JRST (LABEL G0014))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK WRITECHAR EXPR 1)
+; (HRRZI (REG LINKREG) 153)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY WRITECHAR))
+; (!*LBL (LABEL G0014))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*EXIT 3)
+; (ADJSP (REG ST) (MINUS 3))
+; (POPJ (REG ST) 0)
+; (FULLWORD (FIELDPOINTER (!$FLUID PROMPTSTRING!*) 0 5))
+; (FULLWORD (FIELDPOINTER (INDEXED (REG 1) 0) 0 7))
+L1179: 0
+ byte(7)62,0
+ 1
+; (!*ENTRY TERMINALINPUTHANDLER EXPR 1)
+L1180: intern L1180
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZI 12,393
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+393
+ MOVE 6,0(15)
+ MOVE 7,0(15)
+ MOVE 6,L1114(6)
+ CAML 6,L1113(7)
+ JRST L1181
+ LDB 11,L1176
+ CAIE 11,4
+ JRST L1182
+ MOVE 1,SYMVAL+398
+ JRST L1183
+L1182: MOVE 1,L1177
+L1183: MOVE 2,1
+ MOVE 1,SYMVAL+388
+ HRRZI 12,397
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+397
+ MOVE 2,0(15)
+ ADD 2,SYMVAL+390
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ MOVE 1,L1112(1)
+ HRRZI 12,353
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+353
+ MOVEM 1,-2(15)
+ MOVE 7,0(15)
+ MOVEM 1,L1114(7)
+ MOVE 7,0(15)
+ SETZM L1113(7)
+L1181: MOVE 2,0(15)
+ MOVE 2,L1113(2)
+ MOVE 3,0(15)
+ ADD 3,SYMVAL+390
+ MOVE 1,1(3)
+ AOS 1
+ HRRZI 12,147
+ HRRZI 13,2
+ ADJBP 2,L1178
+ LDB 1,2
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,L1113(1)
+ AOS 1
+ MOVE 7,0(15)
+ MOVEM 1,L1113(7)
+ CAMN 0,SYMVAL+379
+ JRST L1184
+ MOVE 1,-1(15)
+ HRRZI 12,153
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+153
+L1184: MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L1176: point 5,<SYMVAL+398>,4
+L1178: point 7,0(1),6
+L1177: <4_31>+L1179
+ end
ADDED psl-1983/20-tests/sub7.rel
Index: psl-1983/20-tests/sub7.rel
==================================================================
--- /dev/null
+++ psl-1983/20-tests/sub7.rel
cannot compute difference between binary files
ADDED psl-1983/20-tests/test-dec20-cross.mic
Index: psl-1983/20-tests/test-dec20-cross.mic
==================================================================
--- /dev/null
+++ psl-1983/20-tests/test-dec20-cross.mic
@@ -0,0 +1,15 @@
+@delete s:test-dec20-cross.exe,
+ exp
+
+@get psl:rlisp
+@st
+*Options!*:=NIL; % Force reload of ALL
+*load(zboot, syslisp, if!-system, lap!-to!-asm);
+*load(dec20!-comp,dec20!-cmac,dec20!-asm);
+*remflag(''(extrareg),''terminaloperand);
+*off usermode;
+*in "P20T:DEC20-PATCHES.sl"$
+*Date!* := "PATCHED Dec 20 cross compiler";
+*Dumplisp "S:TEST-DEC20-CROSS.EXE";
+*Quit;
+@reset .
ADDED psl-1983/20-tests/test-guide.err
Index: psl-1983/20-tests/test-guide.err
==================================================================
--- /dev/null
+++ psl-1983/20-tests/test-guide.err
@@ -0,0 +1,5 @@
+@Comment{ErrLog of TEST-GUIDE.MSS.17 by Scribe 3C(1254) on 24 July 1982 at 13:19}
+
+Error in MAINN command found while processing the manuscript.
+TEST-GUIDE.MSS.17 line 287: @@EX @MAINn.CMD
+The name @MAINN is not defined in document type article.
ADDED psl-1983/20-tests/test-guide.otl
Index: psl-1983/20-tests/test-guide.otl
==================================================================
--- /dev/null
+++ psl-1983/20-tests/test-guide.otl
@@ -0,0 +1,10 @@
+@Comment{OUTLINE of TEST-GUIDE.MSS.17 by Scribe 3C(1254) on 24 July 1982 at 13:19}
+1. Introduction 1 TEST-GUIDE.MSS.17 line 51
+2. Basic I/O Support 1 TEST-GUIDE.MSS.17 line 64
+3. LAP and CMACRO Tests 4 TEST-GUIDE.MSS.17 line 181
+4. SysLisp Tests 4 TEST-GUIDE.MSS.17 line 189
+5. Mini PSL Tests 7 TEST-GUIDE.MSS.17 line 295
+6. Full PSL Tests 7 TEST-GUIDE.MSS.17 line 306
+7. References 8 TEST-GUIDE.MSS.17 line 322
+I. Sample DEC-20 Output 9 TEST-GUIDE.MSS.17 line 325
+ Table of Contents 1 <PSL.TESTS.20>-SCRIBE-SCRATCH-.15-3-1.100015 line 3
ADDED psl-1983/20-tests/time-psl.out
Index: psl-1983/20-tests/time-psl.out
==================================================================
--- /dev/null
+++ psl-1983/20-tests/time-psl.out
@@ -0,0 +1,25 @@
+PSL Spectral Tests, DEC-20 test system, No-Date-Yet
+---------------------------------------------------------------
+*** Dummy RECLAIM: 9815 Items used, 140185 Items left.
+EmptyTest 10000 18
+SlowEmptyTest 10000 187
+Cdr1Test 100 529
+Cdr2Test 100 374
+CddrTest 100 273
+ListOnlyCdrTest1 1776
+ListOnlyCddrTest1 3322
+ListOnlyCdrTest2 2759
+ListOnlyCddrTest2 4144
+ReverseTest 10 459
+*** Dummy RECLAIM: 46911 Items used, 103089 Items left.
+MyReverse1Test 10 466
+*** Dummy RECLAIM: 83575 Items used, 66425 Items left.
+MyReverse2Test 10 456
+*** Dummy RECLAIM: 120239 Items used, 29761 Items left.
+LengthTest 100 591
+ArithmeticTest 10000 649
+EvalTest 10000 2593
+tak 18 12 6 489
+gtak 18 12 6 1394
+gtsta g0 1139
+gtsta g1 1211
ADDED psl-1983/20-tests/utah-20-time-psl.out
Index: psl-1983/20-tests/utah-20-time-psl.out
==================================================================
--- /dev/null
+++ psl-1983/20-tests/utah-20-time-psl.out
@@ -0,0 +1,21 @@
+PSL Spectral Tests, DEC-20, standard 3.1 PSL, 4-Mar-83
+---------------------------------------------------------------
+EmptyTest 10000 19
+SlowEmptyTest 10000 294
+Cdr1Test 100 594
+Cdr2Test 100 380
+CddrTest 100 276
+ListOnlyCdrTest1 1902
+ListOnlyCddrTest1 3334
+ListOnlyCdrTest2 3119
+ListOnlyCddrTest2 4773
+ReverseTest 10 407
+MyReverse1Test 10 271
+MyReverse2Test 10 256
+LengthTest 100 603
+ArithmeticTest 10000 582
+EvalTest 10000 1969
+tak 18 12 6 456
+gtak 18 12 6 1920
+gtsta g0 743
+gtsta g1 822
ADDED psl-1983/20-tests/xxx-header.red
Index: psl-1983/20-tests/xxx-header.red
==================================================================
--- /dev/null
+++ psl-1983/20-tests/xxx-header.red
@@ -0,0 +1,156 @@
+% XXX-HEADER.RED for DEC20
+% Defines Data spaces, MAIN!. for 20 and I/O interface
+%
+% Revisions: MLG, 18 Feb 1983
+% Move HEAP declarations from PT:SUB3
+% and P20T:20-TEST-GLOBAL-DATA.RED
+% Add dummy DATE and VersionName routines
+on syslisp;
+% -----Allocate the stack area
+
+Internal WConst StackSize = 5000;
+Internal WArray Stack[StackSize];
+
+exported WVar StackLowerBound = &Stack[0],
+ StackUpperBound = &Stack[StackSize];
+
+external WVar ST;
+
+%--- Allocate HEAP and BPS areas
+
+Internal Wconst HeapSize = 150000; % Enough for PSL-TIMER
+Internal Warray HEAP[HeapSize]; % Could do a Dynamic alloc
+
+exported Wvar HeapLowerBound = &Heap[0], % bottom of heap
+ HeapUpperBound = &Heap[HeapSize],
+ HeapLast, % next free slot in heap
+ HeapPreviousLast; % save start of new block
+
+CommentOutcode << % If Copying GC
+Internal Warray OtherHeap[HeapSize];
+exported WVar OldHeapLast,
+ OldHeapLowerBound = &OtherHeap[0],
+ OldHeapUpperBound = &OtherHeap[HeapSize];
+>>;
+
+Internal Wconst BPSSize = 500;
+internal Warray BPS[BPSsize]; % Could do a Dynamic alloc
+
+exported WVar FirstBPS=&BPS[0], % Base of BPS, for info
+ NextBPS = &BPS[0], % allocate CODE up
+ LastBPS = &BPS[BPSSize], % allocate Warray down
+ FinalBPS= &BPS[BPSSize]; % For info purposes
+
+syslsp procedure InitHeap();
+% Set up Heap base etc.
+ <<HeapLast:=HeapLowerBound;
+ HeapPreviousLast := 0>>;
+
+
+% allocate for the "extra" arguments
+% 0..MaxArgBlock are arguments (MaxRealRegs + 1)..MaxArgs
+
+internal WConst MaxArgBlock = (MaxArgs - MaxRealRegs) - 1;
+exported WArray ArgumentBlock[MaxArgBlock];
+
+% For the ForeignFunction calling protocol
+exported Wvar Arg1,Arg2,Arg3,ARg4,Arg5,Arg6,Arg7,Arg8,
+ Arg9, Arg10,Arg11,Arg12,Arg13,Arg14,Arg15;
+
+%--- End of Data Definitions ----------
+
+%--- Now do 20 Specific MAIN!. and I/O Interface:
+
+lap '((!*entry Main!. expr 0)
+ (reset)
+ (move (reg st) (lit (halfword (minus (WConst StackSize))
+ (difference (WConst Stack) 1))))
+ (move (reg NIL) (fluid NIL))
+ (!*LINKE 0 FirstCall Expr 0) % Call the MAINn firstroutine
+);
+
+% Define "standard" LISP equivalents for the DEC20-MACRO foreign
+% functions defined in 20IO.MAC
+
+FLAG('(
+ Init20 % Initialize I/O, Timer, etc
+ PutC20 % Print Ascii Character, use 10=EOL to get end of line
+ GetC20 % Return Ascii Character
+ Timc20 % Return CPU time (can also print time check)
+ Quit20 % Terminate execution, finalize
+ Err20 % Print error message
+ PutI20 % print an Integer
+),'ForeignFunction);
+
+
+Global '(IN!* OUT!*);
+
+Procedure Init();
+ <<Init20 0;
+ LispVar IN!*:=0;
+ LispVar Out!*:=1;
+ >>; % Always need one dummy argument
+
+Procedure GetC();
+ If LispVar IN!* eq 0 then Getc20 0 % Always need one dummy argument
+ else IndependentReadChar LispVar IN!*;
+
+Procedure TimC();
+ TimC20 0; % Always need one dummy argument
+
+procedure PutC x;
+ If LispVar Out!* eq 1 then Putc20 x
+ else IndependentWriteChar(LispVar Out!*,x);
+
+procedure Quit;
+ Quit20 0; % always need 1 argument
+
+procedure Date;
+ '"No-Date-Yet";
+
+Procedure VersionName;
+ '"DEC-20 test system";
+
+procedure PutInt I;
+ PutI20 I;
+
+% SYMFNC storage routine:
+LAP '((!*entry !%Store!-Jcall Expr 2) % CodeAddress, Storage Address
+ (!*alloc 0)
+ (!*WOR (reg 1) 8#254000000000) % Load a JRST in higher-bits
+ (!*MOVE (reg 1) (memory (reg 2) (wconst 0)))
+ (!*EXIT 0));
+
+LAP '((!*entry !%copy!-function!-cell Expr 2) % from to
+ (!*alloc 0)
+ (!*move (memory (reg 1) (Wconst 0)) (memory (reg 2) (wconst 0)))
+ (!*exit 0));
+
+FLUID '(UndefnCode!* UndefnNarg!*);
+
+LAP '((!*ENTRY UndefinedFunction expr 0) % For missing Function
+ % No alloc 0 ? and no LINKE because dont want to change LinkReg
+ (!*MOVE (reg LinkReg) (Fluid UndefnCode!*))
+ (!*Move (reg NargReg) (Fluid UndefnNarg!*))
+ (!*JCALL UndefinedFunctionAux)
+);
+
+LAP '((!*ENTRY FLAG expr 2) % Dummy for INIT
+ (!*alloc 0)
+ (!*MOVE 2 (REG 1))
+ (!*LINKE 0 Err20 Expr 1)
+);
+
+procedure LongTimes(x,y);
+ x*y;
+
+procedure LongDiv(x,y);
+ x/y;
+
+procedure LongRemainder(x,y);
+ Remainder(x,y);
+
+off syslisp;
+
+end;
+
ADDED psl-1983/20-tests/xxx-system-io.red
Index: psl-1983/20-tests/xxx-system-io.red
==================================================================
--- /dev/null
+++ psl-1983/20-tests/xxx-system-io.red
@@ -0,0 +1,157 @@
+%==============================================================================
+%
+% PT20:XXX-SYSTEM-IO.RED - 20 specific IO routines for PSL
+%
+% Author: Modified by Robert R. Kessler and MLG
+% From System-io.red for the 20 by Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: Modified 16 August 1982
+% Original Date 16 September 1981
+%
+% Copyright (c) 1982 University of Utah
+%
+%==============================================================================
+
+ON Syslisp;
+
+% Each individual system must have the following routines defined.
+% SysClearIo, SysOpenRead, SysOpenWrite, SysReadRec, SysWriteRec, SysClose,
+% SysMaxBuffer
+%
+% The following definitions are used in the routines:
+% FileDescriptor - A machine dependent word that references a file once
+% opened.
+% FileName - A Lisp string of the file name.
+%
+% ---------- SysClearIo:
+% called by Cleario for system dep extras
+
+lap '((!*entry SysClearIO expr 0)
+%
+% ^C from RDTTY and restart causes trouble, but we don't want a full RESET
+% (don't want to close files or kill forks), so we'll just do the
+% part of RESET that we want, for terminal input
+%
+ (!*MOVE (WConst 8#100) (reg 1)) % .priin
+ (rfmod)
+ (tro 2 2#001111100001000000) % tt%wak + tt%eco + .ttasi, like RESET
+ (sfmod)
+ (!*EXIT 0)
+);
+
+
+syslsp procedure SysOpenRead(Channel,FileName);
+% % Open FileName for input and
+% % return a file descriptor used
+% % in later references to the
+% % file.
+ Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 7*of%bsz of%rd
+ 2#000111000000000000010000000000000000);
+%/ later... if JFN eq 0 then return ContOpenError(FileName, 'INPUT);
+
+syslsp procedure SysOpenWrite(Channel,FileName);
+ Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 7*of%bsz of%wr
+ 2#000111000000000000001000000000000000);
+ %/ if JFN eq 0 then return ContOpenError(FileName, 'OUTPUT);
+
+lap '((!*entry Dec20Open expr 3)
+%
+% Dec20Open(Filename string, GTJFN bits, OPENF bits)
+%
+ (!*WPLUS2 (reg 1) (WConst 1)) % increment r1 to point to characters
+ (hrli (reg 1) 8#440700) % turn r1 into a byte pointer
+ (!*MOVE (reg 1) (reg 4)) % save filename string in r4
+ (!*MOVE (reg 2) (reg 1)) % GTJFN flag bits in r1
+ (!*MOVE (reg 4) (reg 2)) % string in r2
+ (gtjfn)
+ (!*JUMP (Label CantOpen))
+ (!*MOVE (reg 3) (reg 2)) % OPENF bits in r2, JFN in r1
+ (openf)
+CantOpen
+ (!*MOVE (WConst 0) (reg 1)) % return 0 on error
+ (!*EXIT 0) % else return the JFN
+);
+
+
+syslsp procedure SysReadRec(FileDescriptor,StringBuffer);
+% % Read from the FileDescriptor, a
+% % record into the StringBuffer.
+% % Return the length of the
+% % string read.
+ Begin scalar N,Ch;
+ N:=0;
+ Loop: Ch:=Dec20ReadChar(FileDescriptor);
+ StrByt(StringBuffer,N):=Ch;
+ If Ch eq Char EOL or Ch eq Char EOF then return N;
+ N:=N+1;
+ % Check buffer size here
+ goto Loop;
+ End;
+
+lap '((!*entry Dec20ReadChar expr 1)
+Loop
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+%/ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+%/ (!*PUSH (reg 1)) % yes, save char
+%/ (!*CALL WriteChar) % and write it
+%/ (!*POP (reg 1)) % restore it
+%/ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+);
+
+
+syslsp procedure SysWriteRec (FileDescriptor, StringToWrite, StringLength);
+% % Write StringLength characters
+% % from StringToWrite from the
+% % first position.
+ for i:=0:StringLength do
+ Dec20WriteChar(FileDescriptor,strbyt(StringToWrite,i));
+
+lap '((!*entry Dec20WriteChar expr 2)
+ % Jfn,Chr
+ (!*JUMPEQ (Label CRLF) (reg 2) (WConst 8#12)) % if LF, echo CRLF
+ (bout) % no, just echo char
+ (!*EXIT 0) % return
+CRLF
+ (!*MOVE (WConst 8#15) (reg 2)) % write carriage-return
+ (bout)
+ (!*MOVE (WConst 8#12) (reg 2)) % write linefeed
+ (bout)
+ (!*EXIT 0) % return
+);
+
+% SysClose (FileDescriptor); % Close FileDescriptor, allowing
+% % it to be reused.
+lap '((!*entry SysClose expr 1)
+ (closf)
+ (!*JUMP (Label CloseError))
+ (!*EXIT 0)
+CloseError
+ (!*MOVE (QUOTE "Channel could not be closed") (reg 1))
+ (!*JCALL ChannelError)
+);
+
+syslsp procedure SysMaxBuffer(FileDesc);
+ 200;
+
+End;
ADDED psl-1983/20-util/20-interrupt.red
Index: psl-1983/20-util/20-interrupt.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/20-interrupt.red
@@ -0,0 +1,285 @@
+%
+% 20-INTERRUPT.RED -- Crude Interrupt Handler for DEC-20
+% Author: M. L. Griss and D. Morrison
+% Utah Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 May 1981
+% Copyright (c) University of Utah
+
+% It is assumed that the system dependent portion of an implementation will
+%supply the following 3 functions:
+%
+% InitializeInterrupts
+% EnableInterrupts
+% DisableInterrupts
+% DismissInterrupt
+%
+% While these are machine dependent, the interrupt handlers themselves are
+% are expected to generally be machine independent, simply calling
+% DismissInterrupt when done. The assignment of terminal-initiated interrupts
+% to keys is machine dependent.
+
+imports '(Addr2ID); % for code-address-to-symbol
+
+on Syslisp;
+
+%internal WARRAY InterruptLevelTable[2],
+% InterruptPCStorage[2],
+% InterruptChannelTable[35];
+
+FLUID '(InterruptLevelTable
+ LoadAverageStore
+ InterruptPCStorage
+ InterruptChannelTable
+);
+
+compiletime << WCONST !.FHSLF=8#400000;>>;
+
+if FUnBoundP 'XJsysError then <<
+syslsp procedure XJsysError(); % autoloading stub
+<< Load JSYS;
+ Apply(function XJsysError, '()) >>;
+>>;
+
+syslsp procedure InitializeInterrupts();
+% Initializes interrupt handlers for both machine- and terminal-initiated
+% interrupts. Most cases should dispatch to machine-independent handlers.
+% Leaves the interrupt system enabled.
+% In this Tops-20 (machine-code) version we currently handle:
+% just playing, for now
+begin
+ (LispVar InterruptLevelTable):=GtWarray 3;
+ (LispVar InterruptPCStorage):=GtWarray 3;
+ (LispVar InterruptChannelTable):=GtWarray 36;
+ (LispVar LoadAverageStore) := MkString(4, char BLANK);
+ ClearInterrupts();
+
+ % set up interrupt tables -- see Monitor Calls Manual for details
+ For i := 0:35 do %/ Some bug, wiped out next one when after
+ (LispVar InterruptChannelTable)[i]:=0;
+
+ for i := 0:2 do
+ (LispVar InterruptLevelTable)[i]:=(LispVar InterruptPCStorage) + i;
+
+ % Terminal Interupts (Procedure on channel/level)
+ % Note LEVEL is 1,2,3
+ PutInterrupt(0,1,'DoControlG);
+ PutInterrupt(1,1,'SaveAndCallControlT); % control T not working yet
+ PutInterrupt(2,1,'SaveAndBreak);
+ % special channels
+ PutInterrupt(6,1,'ArithOverflow);
+ PutInterrupt(7,1,'FloatArithOverflow);
+ PutInterrupt(9,1,'PushDownOverflow);
+
+ % Now Install tables
+ Xjsys0(!.FHSLF,
+ XWD((LispVar InterruptLevelTable),
+ (LispVar InterruptChannelTable)),0,0,const jsSIR);
+ EnableInterrupts();
+ ActivateChannel(0);
+ ActivateChannel(1);
+ ActivateChannel(2);
+ ActivateChannel(6);
+ ActivateChannel(7);
+ ActivateChannel(9);
+ PutTerminalInterrupt(7,0); % Char CNTRL-G on 0
+ PutTerminalInterrupt(4,0); % Char CNTRL-D on 2
+ PutTerminalInterrupt(20,1); % Char cntrl-t on 1, not working yet
+ PutTerminalInterrupt(0,2); % Char BREAK on 2
+ PutTerminalInterrupt(2,2); % Char cntrl-B on 2
+
+ ClearInterrupts();
+end;
+
+syslsp procedure SetContinueAddress(Level,Address);
+begin scalar x;
+ x:=(LispVar InterruptLevelTable)[Level-1];
+ x[0]:=address;
+ end;
+
+% FunctionCellLocation is used by LAP
+
+off Syslisp;
+
+fluid '(!*WritingFaslFile);
+
+lisp procedure SetContinueFunction(Level,FunctionName);
+begin scalar !*WritingFaslFile;
+ SetContinueAddress(Level, FunctionCellLocation FunctionName);
+end;
+
+lisp procedure PutInterrupt(Channel,Level,ActionId);
+begin scalar !*WritingFaslFile;
+ WPutV(InterruptChannelTable,
+ Channel,
+ XWD(Level, FunctionCellLocation ActionId));
+end;
+
+on Syslisp;
+
+syslsp procedure XWD(a,b);
+ Lor(Lsh(a,18),b);
+
+syslsp procedure PutTerminalInterrupt(CntrlChar,Channel);
+ Xjsys0(XWD(CntrlChar,Channel),0,0,0,const jsATI);
+
+syslsp procedure RemoveTerminalInterrupt(CntrlChar,Channel);
+ Xjsys0(XWD(CntrlChar,Channel),0,0,0,const jsDTI);
+
+syslsp procedure ReadTerminalWord;
+ Xjsys1(0,0,0,0,Const jsRTIW);
+
+syslsp procedure SetTerminalWordBit(n);
+ <<XJsys0(Lor(ReadTerminalLWord(),Dec20Bit n),0,0,const jsSTIW);
+ ReadTerminalWord()>>;
+
+syslsp procedure SetTerminalWord(MSK);
+ <<Xjsys0(Lor(ReadTerminalWord(),MSK),0,0,0,const jsSTIW);
+ ReadTerminalWord()>>;
+
+syslsp procedure ClearInterrupts;
+ Xjsys0(0,0,0,0,const jsCIS); % clear any pending interrupts
+
+syslsp procedure SignalChannel n; %. Test on channel n
+ Xjsys0(!.FHSLF,Dec20Bit n,0,0,const jsIIC);
+
+syslsp procedure EnableInterrupts;
+ Xjsys0(!.FHSLF,0,0,0,const jsEIR);
+
+syslsp procedure DisableInterrupts;
+ Xjsys0(!.FHSLF,0,0,0,const jsDIR);
+
+syslsp procedure ActivateChannel(n); %. Inform OS of channel
+ Xjsys0(!.FHSLF,Dec20Bit n,0,0,const jsAIC);
+
+syslsp procedure DeActivateChannel(n); %. Inform OS of channel
+ Xjsys0(!.FHSLF,Dec20Bit n,0,0,const jsDIC);
+
+syslsp procedure Dec20Bit n; %. Bits [0 to 35]
+ Dec20Fld(1,35-n);
+
+syslsp procedure Dec20Fld(x,y);
+ LSH(x,y);
+
+syslsp procedure DismissInterrupt;
+% Warning: an interrupt handler should not attempt to resume if may have
+% caused a garbage collection.
+Xjsys0(0,0,0,0,const jsDEBRK);
+
+
+% ----- Some default handlers ----------
+
+syslsp procedure DoControlG;
+<< ClearTerminalInputBuffer(); % CFIBF
+ ChannelWriteChar(LispVAR StdOUT!*, Char BELL);
+ ErrorPrintF "*** Restarting";
+ SetContinueFunction(1,'Reset);
+ DismissInterrupt()>>;
+
+syslsp procedure ClearTerminalInputBuffer();
+ Xjsys0(8#100,0,0,0,const jsCFIBF);
+
+syslsp procedure ArithOverflow;
+ <<SetContinueFunction(1,'ArithOverFlowError);
+ DismissInterrupt()>>;
+
+syslsp procedure ArithOverFlowError;
+ StdError('"Integer overflow");
+
+syslsp procedure FloatArithOverflow;
+ <<SetContinueFunction(1,'FloatArithOverFlowError);
+ DismissInterrupt()>>;
+
+syslsp procedure FloatArithOverFlowError;
+ StdError('"Floating point overflow");
+
+lap '((!*entry PushDownOverflow expr 0)
+ (sub (reg st) (lit (halfword 1000 1000))) % move the stack back
+ (!*MOVE (WConst 1) (REG 1))
+ (movei 2 ErrorAddress)
+ (!*CALL SetContinueAddress)
+ (!*JCALL DismissInterrupt)
+ErrorAddress
+ (!*MOVE '"Stack overflow" (reg 1))
+ (!*JCALL StdError) % normal error
+);
+
+lap '((!*entry FindLoadAverage expr 0)
+ (move 1 (lit (fullword 8#000014000014))) % 1 min avg, .systa
+ (getab)
+ (!*EXIT 0)
+ (hrrz 2 (fluid LoadAverageStore))
+ (hrli 2 8#10700) % make a byte pointer
+ (exch 1 2)
+ (move 3 (lit (fullword 8#024037020200)))
+ (flout)
+ (!*EXIT 0)
+ (!*EXIT 0)
+);
+
+syslsp procedure DoControlT();
+begin scalar RunningFunctionID, CameFrom;
+% ClearTerminalInputBuffer();
+ FindLoadAverage();
+ CameFrom := INF ((LispVar InterruptPCStorage)[0]);
+ RunningFunctionID := code!-address!-to!-symbol CameFrom or 'UNKNOWN;
+ ErrorPrintF("^T: in %p at %o, load %w",
+ RunningFunctionID, CameFrom, LispVar LoadAverageStore);
+end;
+>>;
+
+syslsp procedure DoBreak();
+begin scalar RunningFunctionID, CameFrom, CurrentChannel;
+ ClearTerminalInputBuffer();
+ CameFrom := INF( (LispVar InterruptPCStorage)[0]);
+ RunningFunctionID := code!-address!-to!-symbol CameFrom or 'UNKNOWN;
+ CurrentChannel := WRS NIL;
+ ErrorPrintF("*** Break in %p at %o", RunningFunctionID, CameFrom);
+ ErrorSet(quote Break(), NIL, NIL);
+ WRS CurrentChannel;
+end;
+
+
+lap '((!*Entry SaveAndCallControlT expr 0)
+%
+% Save all regs, call DoControlT and dismiss
+%
+ (adjsp (reg st) 14) % allocate 14 slots on the stack
+ (hrri (reg nil) (indexed (reg st) -13)) % set up BLT pointer
+ (hrli (reg nil) 1) % move regs 1..14 onto the stack
+ (blt (reg nil) (indexed (reg st) 0))
+ (move (reg nil) (fluid nil)) % fix reg nil
+ (!*CALL DoControlT) % call the function
+ (hrli (reg nil) (indexed (reg st) -13))
+ (hrri (reg nil) 1)
+ (blt (reg nil) 14) % move the registers back off the stack
+ (move (reg nil) (fluid nil)) % restore reg nil again
+ (adjsp (reg st) -14)
+ (debrk)
+);
+>>;
+
+lap '((!*Entry SaveAndBreak expr 0)
+%
+% Save all regs, call DoBreak and dismiss
+%
+ (adjsp (reg st) 14) % allocate 14 slots on the stack
+ (hrri (reg nil) (indexed (reg st) -13)) % set up BLT pointer
+ (hrli (reg nil) 1) % move regs 1..14 onto the stack
+ (blt (reg nil) (indexed (reg st) 0))
+ (move (reg nil) (fluid nil)) % fix reg nil
+ (!*CALL DoBreak) % call the function
+ (hrli (reg nil) (indexed (reg st) -13))
+ (hrri (reg nil) 1)
+ (blt (reg nil) 14) % move the registers back off the stack
+ (move (reg nil) (fluid nil)) % restore reg nil again
+ (adjsp (reg st) -14)
+ (debrk)
+);
+
+InitializeInterrupts();
+
+off syslisp;
+
+END;
ADDED psl-1983/20-util/bug.build
Index: psl-1983/20-util/bug.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/bug.build
@@ -0,0 +1,1 @@
+in "bug.red"$
ADDED psl-1983/20-util/bug.red
Index: psl-1983/20-util/bug.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/bug.red
@@ -0,0 +1,19 @@
+% BUG.RED - Send bug reports
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 December 1981
+% Copyright (c) 1981 University of Utah
+%
+
+IMPORTS '(EXEC);
+
+lisp procedure Bug();
+<< PrintF "*** PSL Bug reporter, ^N to abort%n";
+ PutRescan BldMsg "MAIL *PSL:USER-BUG-REPORTS.TXT,BENSON,GRISS%n";
+ MM();
+ TerPri() >>;
+
+END;
ADDED psl-1983/20-util/bug.sl
Index: psl-1983/20-util/bug.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/bug.sl
@@ -0,0 +1,26 @@
+% BUG.SL - Send bug reports
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 December 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PERDUE.PSL>BUG.SL.2, 7-Jan-83 16:52:07, Edit by PERDUE
+% Changed to LISP syntax, added bug-mail-to variable.
+% Each site may set bug-mail-to as desired.
+
+(imports '(exec))
+
+(fluid '(bug-mail-to))
+
+(cond ((null bug-mail-to) (setq bug-mail-to "")))
+
+(defun bug ()
+ (printf "*** PSL Bug reporter, ^N to abort%n")
+ (putrescan (bldmsg "mail %w%n" bug-mail-to))
+ (mm)
+ (terpri)
+ t)
ADDED psl-1983/20-util/dir-stuff.build
Index: psl-1983/20-util/dir-stuff.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/dir-stuff.build
@@ -0,0 +1,1 @@
+in "p20:dir-stuff.red"$
ADDED psl-1983/20-util/dir-stuff.red
Index: psl-1983/20-util/dir-stuff.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/dir-stuff.red
@@ -0,0 +1,166 @@
+
+% MLG, 6:01am Thursday, 10 June 1982
+% Utilities to read and process DIR files
+%
+
+IMPORTS '(EXEC);
+
+% -------- Basic File Reader -------------
+
+Fluid '(File);
+
+procedure ReadOneLine;
+% Read a single line, return as string
+ begin scalar c,l;
+ while ((c:=ReadCh()) NEQ !$EOL!$) do
+ If c EQ !$EOF!$ then Throw('Filer,'Done)
+ else l:=c . l;
+ Return list2string reverse l;
+end;
+
+procedure ReadDirFile F;
+% Read in a file as vector of strings
+ begin scalar oldF,x;
+ OldF:=Rds(F:=Open(F,'input));
+ File:=NIL;
+ Catch('Filer,'(ReadAllFile1));
+ Rds OldF;
+ Close F;
+ Return List2vector Reverse File;
+ end;
+
+procedure ReadAllFile1;
+% support for Read Dir File
+ begin scalar l;
+ While (l:=ReadOneLine()) do
+ if Size(l)>=0 then file:= segmentstring(l,char '! ) . file;
+ return List2Vector reverse file;
+ end;
+
+%---------------------------------------------------
+procedure ReadCleanDir F;
+% read in a Dir File without dates, and clean up
+ Begin scalar x;
+ x:=ReadDirFile F; % As a vector of strings
+%/ x:=ExpandNames x; % Handle .xxx case
+ x:=RemoveAllVersionNumbers x;
+%/ x:=RemoveDuplicates x; % Assume ordered
+ Return x;
+ End;
+
+%---- Now take apart the fields
+
+Procedure GetFileName(S); % Find part before dot
+ begin scalar N,I;
+ n:=Size S;
+ i:=0;
+ While i<=n and S[i] neq Char '!. do i:=i+1;
+ return Sub(S,0,i-1);
+ end;
+
+procedure GetExtension(S); % Find second part, after dot
+ begin scalar N,I;
+ n:=Size S;
+ i:=n;
+ While i>=0 and S[i] neq Char '!. do i:=i-1;
+ return Sub(S,i+1,n-i-1);
+ end;
+
+% Dont need to expand names anymore
+CommentOutCode <<
+
+procedure ExpandNames(Fvector); % replace .xxxx with yyy.xxx from previous
+ Begin scalar F;
+ for i:=1:Size(Fvector) do
+ <<F:=Fvector[I];
+ if F[0] EQ char '!.
+ then Fvector[I]:=concat(GetFileName Fvector[I-1],F)>>;
+ return Fvector;
+ end;
+>>;
+
+procedure RemoveVersionNumber F; % replace xxxx.yyyy.nnn with xxxx.yyyy
+ Begin scalar I;
+ i:=Size(F);
+ While i>=0 and F[i] NEQ char '!. do i:=i-1;
+ Return Sub(F,0,i-1);
+ end;
+
+procedure RemoveAllVersionNumbers(Fvector); % replace xxxx.yyy.nnn with xxx.yyy
+ Begin
+ For i:=0:Size(Fvector)
+ do Fvector[I]:=RemoveVersionNumber Car Fvector[I];
+ return Fvector;
+ end;
+
+procedure GetDirInFile(Dstring,FileName);
+ Docmds List("Dir ",Dstring,",",crlf,
+ "out ",Filename,crlf,
+ "no heading ",crlf,
+ "separate ",crlf,
+ "no summary ",crlf,
+ crlf,"pop");
+
+procedure GetCleanDir Dstring;
+ Begin Scalar x;
+ GetDirInFile(Dstring,"Junk.Dir");
+ x:=ReadCleanDir "junk.Dir";
+ DoCmds List("Del junk.dir,",crlf,
+ "exp ",crlf,crlf,"pop");
+ return x
+ End;
+
+procedure GetDatedDirInFile(Dstring,FileName);
+ Docmds List("Dir ",Dstring,",",crlf,
+ "out ",Filename,crlf,
+ "no heading ",crlf,
+ "separate ",crlf,
+ "no summary ",crlf,
+ "time write ",crlf,
+ crlf,"pop");
+
+procedure GetCleanDatedDir Dstring;
+ Begin Scalar x;
+ GetDatedDirInFile(Dstring,"Junk.Dir");
+ x:=ReadCleanDatedDir "junk.Dir";
+ DoCmds List("Del junk.dir,",crlf,
+ "exp ",crlf,crlf,"pop");
+ return x
+ End;
+
+procedure ReadCleanDatedDir F;
+ begin scalar x;
+ x:=ReadDirFile F;
+%/ x:=ExpandNames x; % Handle .xxx case
+ For i:=0:Size(x)
+ do Rplaca(x[i],RemoveVersionNumber Car x[I]);
+ return x
+ end;
+
+% Segment a string into fields:
+
+Procedure SegmentString(S,ch); % "parse" string in pieces at CH
+ Begin scalar s0,sN,sN1, Parts, sa,sb;
+ s0:=0;
+ sn:=Size(S);
+ sN1:=sN+1;
+ L1:If s0>sn then goto L2;
+ sa:=NextNonCh(Ch,S,s0,sN);
+ if sa>sN then goto L2;
+ sb:=NextCh(Ch,S,sa+1,sN);
+ if sb>SN1 then goto L2;
+ Parts:=SubSeq(S,sa,sb) . Parts;
+ s0:=sb;
+ goto L1;
+ L2:Return Reverse Parts;
+ End;
+
+Procedure NextCh(Ch,S,s1,s2);
+ <<While (S1<=S2) and not(S[S1] eq Ch) do s1:=s1+1;
+ S1>>;
+
+Procedure NextNonCh(Ch,S,s1,s2);
+ <<While (S1<=S2) and (S[S1] eq Ch) do s1:=s1+1;
+ S1>>;
+
+End;
ADDED psl-1983/20-util/directory.sl
Index: psl-1983/20-util/directory.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/directory.sl
@@ -0,0 +1,74 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Directory.SL - File Directory Primitives (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 13 July 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common jsys pathnames file-primitives))
+
+(de find-matching-files (filename include-deleted-files)
+
+ % Return a list describing all files that match the specified filename. The
+ % filename may specify a directory and/or may contain wildcard characters.
+ % Each element of the returned list corresponds to one matching file. The
+ % format of each list element is:
+
+ % (file-name full file name string
+ % deleted-flag T or NIL
+ % file-size integer count of pages in file
+ % write-date integer representing date/time of last write
+ % read-date integer representing date/time of last read
+ % )
+
+ (setf filename (fixup-directory-name filename))
+ (let (jfn-word jfn file-name deleted-flag file-size write-date read-date)
+ (cond
+ ((and (stringp filename)
+ (setf jfn-word (attempt-to-get-jfn
+ filename
+ (if include-deleted-files
+ #.(bits 2 8 11 13 17)
+ #.(bits 2 11 13 17)
+ )
+ )))
+ (for*
+ (while (>= jfn-word 0))
+ (do (setf jfn (lowhalfword jfn-word))
+ (setf file-name (MkString 100 (char space)))
+ (jsys1 file-name jfn
+ #.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
+ (setf file-name (recopystringtonull file-name))
+ (setf deleted-flag (jfn-deleted? jfn))
+ (setf file-size (jfn-page-count jfn))
+ (setf write-date (jfn-write-date jfn))
+ (setf read-date (jfn-read-date jfn))
+ )
+ (collect (list
+ file-name
+ deleted-flag
+ file-size
+ write-date
+ read-date
+ ))
+ (do (if (FixP (ErrorSet
+ (list 'jsys1 jfn-word 0 0 0 (const jsGNJFN))
+ NIL NIL)) (setf jfn-word -1)))
+ ))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Auxiliary Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de fixup-directory-name (pn)
+
+ % Replace all missing Name, Type, and Version components of the specified
+ % filename with "*".
+
+ (let ((wild-name (make-pathname 'name 'wild)))
+ (setf pn (pathname pn))
+ (namestring (merge-pathname-defaults pn wild-name 'wild 'wild))))
ADDED psl-1983/20-util/exec.build
Index: psl-1983/20-util/exec.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/exec.build
@@ -0,0 +1,2 @@
+CompileTime load(Syslisp, Jsys, Monsym);
+in "exec.red"$
ADDED psl-1983/20-util/exec.red
Index: psl-1983/20-util/exec.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/exec.red
@@ -0,0 +1,197 @@
+%
+% EXEC.RED - Simple TOPS20 Interfaces, "EXEC Fork", etc
+%
+% Author: Martin L. Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 8 March 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.UTIL>EXEC.RED.5, 24-May-82 13:01:50, Edit by BENSON
+% Changed <EDITORS> and <SUBSYS> to SYS: in filenames
+%/ Changed FILNAM->FileName, due to GLOBAL conflict
+%/ Changed JSYS calls, so LIST(..) rather than '(..) used
+%/ Changed for V3:JSYS
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Simple JSYS interfaces
+
+imports '(JSYS);
+
+GLOBAL '(ForkNAMES!* EXECFork EMacsFork MMFork);
+
+Lisp procedure GetOLDJfn FileName; %. test If file OLD and return Jfn
+ Begin scalar Jfn;
+ If NULL StringP FileName then return NIL;
+ Jfn := JSYS1(Bits(2,3,17),FileName,0,0,jsGTJfn);
+ % OLD!MSG!SHORT
+ If Jfn<0 then return NIL;
+ return Jfn
+ END;
+
+Lisp procedure GetNEWJfn FileName; %. test If file NEW and return Jfn
+ Begin scalar Jfn;
+ If NULL StringP FileName then return NIL;
+ Jfn := JSYS1(Bits(0,1,3,17),FileName,0,0,jsGTJfn);
+ % GEN!NEW!MSG!SHORT
+ If Jfn<0 then return NIL;
+ return Jfn
+ END;
+
+Lisp procedure RELJfn Jfn; %. return Jfn to system
+ JSYS0(Jfn,0,0,0,jsRLJfn);
+
+Lisp procedure OPENOLDJfn Jfn; %. OPEN to READ
+ JSYS0(Jfn,Bits( (7 . 5),19),0,0,jsOPENF);
+
+Lisp procedure OPENNEWJfn Jfn; %. Open to WRITE
+ JSYS0(Jfn,Bits( (7 . 5),20),0,0,jsOPENF);
+
+Lisp procedure GetFork Jfn; %. Create Fork, READ File on Jfn
+ Begin scalar FH;
+ FH := JSYS1(Bits(1),0,0,0,jsCFork);
+ JSYS0(Xword(FH ,Jfn),0,0,0,jsGet);
+ return FH
+ END;
+
+Lisp procedure STARTFork FH; %. Start (Restart) a Fork
+ JSYS0(FH, 0,0,0,jsSFRKV);
+
+Lisp procedure WAITFork FH; %. Wait for completion
+ JSYS0(FH,0,0,0,jsWFork);
+
+Lisp procedure RUNFork FH; %. Normal use, to run a Fork
+ <<STARTFork FH; WAITFork FH>>;
+
+Lisp procedure KILLFork FH; %. Kill a Fork
+ JSYS0(FH,0,0,0,jsKFork);
+
+Lisp procedure SETPRIMARYJfnS(FH,INJfn,OUTJfn);
+ JSYS0(FH,Xword(INJfn , OUTJfn),0,0,JSSPJfn); %. Change PRIMARY Jfns (BAD?)
+
+Lisp procedure OPENFork FileName; %. Get a File into a Fork
+ Begin scalar FH,Jfn;
+ If NULL FileP FileName then StdError CONCAT("Cant find File ",FileName);
+ Jfn := GetOLDJfn FileName;
+ FH := GetFork Jfn;
+ return FH
+ END;
+
+Lisp procedure RUN FileName; %. Run A File
+ Begin scalar FH; FH := OPENFork FileName; RUNFork FH; KILLFork FH END;
+
+Lisp Procedure ForkP FH; %. test if Valid Fork Handle
+ FixP FH and not Zerop FH; %/Kludge
+
+Lisp procedure EXEC;
+ <<If Not ForkP EXECFork then EXECFork := OPENFork "SYSTEM:EXEC.EXE";
+ RUNFork EXECFork>>;
+
+Lisp procedure EMACS;
+ <<If Not ForkP EMacsFork then EMACSFork := OPENFork "SYS:EMACS.EXE";
+ RUNFork EMACSFork>>;
+
+Lisp procedure MM;
+ <<If Not ForkP MMFork then MMFork := OPENFork "SYS:MM.EXE";
+ RUNFork MMFork>>;
+
+Lisp procedure GetUNAME; %. USER name
+ Begin Scalar S;
+ S:=Mkstring 80;
+ JSYS0(s,JSYS1(0,0,0,0,JSGJINF),0,0,JSDIRST);
+ Return RecopyStringToNULL S
+ End;
+
+Lisp procedure GetCDIR; %. Connected DIRECTORY
+ Begin scalar s;
+ S:=Mkstring 80;
+ JSYS0(S,JSYS2(0,0,0,0,jsGJINF),0,0,jsDIRST);
+ return RecopyStringToNULL S
+ end;
+
+Lisp procedure PSOUT S; %. Print String
+ JSYS0(S,0,0,0,jsPSOUT);
+
+Lisp procedure GTJfn L; %. Get a Jfn
+ JSYS1(L,0,0,0,jsGTJFN);
+
+Lisp procedure NAMEFROMJfn J; %. name of File on a Jfn
+ Begin scalar S;
+ s:=Mkstring 100;
+ JSYS0(S,J,0,0,JSJfnS);
+ return RecopyStringToNULL S;
+ end;
+
+Fexpr Procedure InFile(U); %. INPUT FILE, (prompt for name too?)
+ If StringP U then DskIn EVAL CAR U
+ else
+ Begin scalar Jfn,Fname;
+ PSOUT "Input file:";
+ Jfn:=Jsys1(BITS(2,3,4,16,17),Xword(8#100,8#101),0,0,jsGTJFN);
+ Fname:= NAMEFROMJFN JFN;
+ RELJFN JFN;
+ PRINTF("reading file %r %n", FNAME);
+ DSKIN Fname;
+ end;
+
+%-- Command string processor and take
+
+Lisp procedure PutRescan(S); %. Enter String
+ <<JSYS0(S,0,0,0,jsRSCAN);
+ JSYS0(0,0,0,0,jsRSCAN)>>;
+
+On SYSLISP;
+
+syslsp procedure GetRescan(); %. Return as String
+ Begin scalar N,S;
+ XJSYS1(0,0,0,0,jsRSCAN); % Announce to Get
+ N:=XJSYS1(1,0,0,0,jsRSCAN); % How Many
+ IF N=0 then return 'Nil;
+ S:=GtStr N-1; % To Drop Trailing EOL
+ For I:=0:N-2 do
+ StrByt(S,I):=XJsys1(0,0,0,0,JsPBIN);
+ Return MkSTR S; % Will include Program name
+ end;
+
+
+OFF SYSLISP;
+
+Global '(CRLF BL);
+
+CRLF :=STRING(8#15,8#12); %. CR-LF
+BL :=STRING(8#40); %. Blank
+
+Lisp procedure CONCATS (L); %. Combine list of strings
+ If PAIRP L then CONCAT(CAR L,CONCATS CDR L)
+ else CRLF;
+
+Lisp Fexpr Procedure CMDS (!%L); %. user COMMAND submit
+ DOCMDS EVLIS !%L;
+
+Lisp procedure DOCMDS (L); %. Submit via PutRescan
+ <<PutRescan CONCATS L; % Add CR, plant in RSCAN
+ EXEC()>>; % Run 'em
+
+%. -------- Sample Commands
+
+Lisp procedure VDIR (L);
+ DOCMDS LIST("VDIR ",L,CRLF,"POP");
+
+Lisp procedure HelpDir();
+ DOCMDS LIST("DIR PH:*.HLP",CRLF,"POP");
+
+Lisp procedure Take (FileName);
+ If FileP FileName then DOCMDS LIST("Take ",FileName,CRLF,"POP");
+
+Lisp procedure SYS (L);
+ DOCMDS LIST("SYS ", L, CRLF, "POP");
+
+Lisp procedure TALK (L);
+ DOCMDS LIST("TALK ",L,CRLF);
+
+Lisp procedure TYPE (L);
+ DOCMDS LIST("TYPE ",L,CRLF,"POP");
+
+END;
ADDED psl-1983/20-util/file-support.sl
Index: psl-1983/20-util/file-support.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/file-support.sl
@@ -0,0 +1,93 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% File-Support.SL - System-Dependent Support for File Primitives (TOPS-20)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 September 1982
+%
+% This file contains support functions used in the implementation of file
+% primitives for TOPS-20. The existence of the functions in this file should
+% be ignored when writing system-independent code.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load jsys common pathnames))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% JFN Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de jfn-truename (jfn)
+ (let ((file-name (make-string 200 #\space)))
+ (jsys1 file-name jfn #.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
+ (recopystringtonull file-name)
+ ))
+
+(de jfn-deleted? (jfn)
+ (if (integerp jfn)
+ (not (= (LAnd (Jsys4 jfn #.(xword 1 1) 4 0 (const jsGTFDB))
+ (bits 3)) 0))))
+
+(de jfn-write-date (jfn)
+ (if (integerp jfn)
+ (Jsys4 jfn #.(xword 1 8#14) 4 0 (const jsGTFDB))))
+
+(de jfn-read-date (jfn)
+ (if (integerp jfn)
+ (Jsys4 jfn #.(xword 1 8#15) 4 0 (const jsGTFDB))))
+
+(de jfn-byte-count (jfn)
+ (if (integerp jfn)
+ (Jsys4 jfn #.(xword 1 8#12) 4 0 (const jsGTFDB))))
+
+(de jfn-page-count (jfn)
+ (if (integerp jfn)
+ (lowhalfword (Jsys4 jfn #.(xword 1 8#11) 4 0 (const jsGTFDB)))))
+
+(de jfn-original-author (jfn)
+ (if (integerp jfn)
+ (let ((str (make-string 100 0)))
+ (Jsys0 (xword 0 jfn) str 0 0 (const jsGFUST))
+ (recopystringtonull str)
+ )))
+
+(de jfn-author (jfn)
+ (if (integerp jfn)
+ (let ((str (make-string 100 0)))
+ (Jsys0 (xword 1 jfn) str 0 0 (const jsGFUST))
+ (recopystringtonull str)
+ )))
+
+(de jfn-delete (jfn)
+ (if (integerp jfn)
+ (jsys0 jfn 0 0 0 (const jsDELF))
+ ))
+
+(de jfn-delete-and-expunge (jfn)
+ (if (integerp jfn)
+ (jsys0 (xword 2#010000000000000000 jfn) 0 0 0 (const jsDELF))
+ ))
+
+(de jfn-undelete (jfn)
+ (if (integerp jfn)
+ (jsys0 (xword 1 jfn) #.(bits 3) 0 0 (const jsCHFDB))
+ ))
+
+(de jfn-release (jfn)
+ (if (integerp jfn)
+ (jsys0 jfn 0 0 0 (const jsRLJFN))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% GTJFN Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de attempt-to-get-jfn (file-name the-bits)
+ (setf file-name (namestring file-name))
+ (let ((jfn (ErrorSet
+ (list 'jsys1 the-bits file-name 0 0 (const jsGTJFN)) nil nil)
+ ))
+ (cond
+ ((listp jfn) (car jfn))
+ )))
ADDED psl-1983/20-util/get-command-string.sl
Index: psl-1983/20-util/get-command-string.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/get-command-string.sl
@@ -0,0 +1,74 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Get-Command-String.SL (TOPS-20 Version) - Get Program Command String
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 August 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common jsys))
+(load strings)
+
+% The function GET-COMMAND-STRING returns the string argument given
+% to the program when it was invoked.
+
+(de char-blank? (ch)
+ (or (= ch (char space)) (= ch (char tab))))
+
+(fluid '(command-string*))
+
+(de get-command-string ()
+ (or command-string* (setq command-string* (dec20-get-command-string))))
+
+(de dec20-get-command-string ()
+
+ % Read the process command string. This function should only be invoked once
+ % in a given fork, and should be invoked as soon as possible. The process
+ % command string is massaged to remove the program name and any trailing
+ % CRLF.
+
+ (prog (s high i j)
+ (setq s (dec20-read-process-arg))
+ (setq high (size s))
+ (if (< high 0) (return ""))
+ (setq i 0)
+ (while (and (<= i high) (char-blank? (igets s i)))
+ (setq i (+ i 1)))
+ (setq j i)
+ (while (and (<= j high) (not (char-blank? (igets s j))))
+ (setq j (+ j 1)))
+ (if (string-equal (substring s i j) "run") (return ""))
+ (while (and (<= j high) (char-blank? (igets s j)))
+ (setq j (+ j 1)))
+ (while (and (> high j) (not (graphicp (igets s high))))
+ (setq high (- high 1)))
+ (return (substring s j (+ high 1)))
+ ))
+
+(CompileTime (put 'prarg 'OpenCode '((jsys 357) (move (reg 1) (reg 3)))))
+(CompileTime (put 'rscan 'OpenCode '((jsys 320) (move (reg 1) (reg 1)))))
+(CompileTime (put 'sin 'OpenCode '((jsys 42) (move (reg 1) (reg 3)))))
+
+(de dec20-read-process-arg ()
+
+ % On TOPS-20, the command argument can be passed to an inferior fork in two
+ % ways. The first (and better) way is to pass a string in the process
+ % argument block. The second (and more popular) way is to pass a string in
+ % the RESCAN buffer (what a crock!). We will use the process argument block,
+ % if it is nonempty, otherwise we will read from the RESCAN buffer.
+
+ (prog (arg-len str)
+ (setq arg-len (prarg #.(int2sys (xword 1 8#400000)) 4 0))
+ (cond ((> arg-len 0)
+ (setq str (MkString arg-len))
+ (prarg #.(int2sys (xword 1 8#400000)) (jconv str) arg-len)
+ (return (recopystringtonull str))
+ ))
+ (setq arg-len (rscan 0))
+ (if (= arg-len 0) (return "")) % no input string
+ (setq str (MkString arg-len))
+ (sin 8#777777 (jconv str) (- arg-len))
+ (return str)
+ ))
ADDED psl-1983/20-util/homedir.build
Index: psl-1983/20-util/homedir.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/homedir.build
@@ -0,0 +1,1 @@
+in "homedir.sl"$
ADDED psl-1983/20-util/homedir.sl
Index: psl-1983/20-util/homedir.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/homedir.sl
@@ -0,0 +1,55 @@
+%
+% HOMEDIR.SL - USER-HOMEDIR-STRING function for Tops-20
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 September 1982
+% Copyright (c) 1982 University of Utah
+%
+
+(compiletime (progn
+ (load monsym syslisp)
+ (put 'get-user-number 'opencode '((gjinf)))
+ (flag '(user-homedir-string-aux get-dir-string)
+ 'internalfunction)))
+
+% Returns a string which is the init file for program-name.
+% Optional HOST is not supported.
+(de init-file-string (program-name)
+ (concat (user-homedir-string) (concat program-name ".INIT")))
+
+% Returns a string which is the users home directory name.
+% Optional HOST is not supported.
+(lap '((*entry user-homedir-string expr 0)
+ (movei (reg 1) (indexed (reg st) 1)) % Pointer into the stack
+ (*alloc 20) % allocate space
+ (*call user-homedir-string-aux) % call the real function
+ (*exit 20))) % deallocate and return
+
+(de user-homedir-string-aux (p)
+ (concat "PS:<" (mkstr (get-dir-string p (get-user-number)))))
+
+(lap '((*entry get-dir-string expr 2)
+ (*move (reg 1) (reg 5)) % save original addr in ac5
+ (hrli (reg 1) 8#10700) % make a byte pointer
+ (*move (reg 1) (reg 3)) % save it in ac3
+ (dirst)
+ (erjmp cant-get-dir)
+ (movei (reg 4) 62) % put a closing > on it
+ (idpb (reg 4) (reg 1))
+ (setz (reg 4) 0) % put a null char on the end
+ (idpb (reg 4) (reg 1))
+ (seto (reg 4) 0) % initialize length to -1
+string-length-loop
+ (ildb (reg 2) (reg 3))
+ (jumpe (reg 2) done-computing-length)
+ (aoja (reg 4) string-length-loop)
+done-computing-length
+ (movem (reg 4) (indexed (reg 5) 0)) % put len in string header
+ (*move (reg 5) (reg 1)) % return original pointer
+ (*exit 0)
+cant-get-dir
+ (*move (reg 1) '"UNKNOWN>")
+ (*exit 0)))
ADDED psl-1983/20-util/input-stream.sl
Index: psl-1983/20-util/input-stream.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/input-stream.sl
@@ -0,0 +1,382 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Input-Stream.SL (TOPS-20 Version) - File Input Stream Objects
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 29 July 1982
+%
+% This package is 6.6 times faster than the standard unbuffered I/O.
+% (Using message passing, it is only 1.7 times faster.)
+%
+% Note: this code will only run COMPILED.
+%
+% See TESTING code at the end of this file for examples of use.
+% Be sure to include "(CompileTime (load objects))" at the beginning
+% of any file that uses this package.
+%
+% Summary of public functions:
+%
+% (setf s (open-input "file name")) % generates error on failure
+% (setf s (attempt-to-open-input "file name")) % returns NIL on failure
+% (setf ch (=> s getc)) % read character (map CRLF to LF)
+% (setf ch (=> s getc-image)) % read character (don't map CRLF to LF)
+% (setf ch (=> s peekc)) % peek at next character
+% (setf ch (=> s peekc-image)) % peek at next character (don't map CRLF to LF)
+% (setf str (=> s getl)) % Read a line; return string without terminating LF.
+% (=> s empty?) % Are there no more characters?
+% (=> s close) % Close the file.
+% (setf fn (=> s file-name)) % Return "true" name of file.
+% (setf date (=> s read-date)) % Return date that file was last read.
+% (setf date (=> s write-date)) % Return date that file was last written.
+% (=> s delete-file) % Delete the associated file.
+% (=> s undelete-file) % Undelete the associated file.
+% (=> s delete-and-expunge) % Delete and expunge the associated file.
+% (setf name (=> s author)) % Return the name of the file's author.
+% (setf name (=> s original-author)) % Return the original author's name.
+% (setf count (=> s file-length)) % Return the byte count of the file.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Changes:
+%
+% 9/29/82 Alan Snyder
+% Changed GETC to return stray CRs.
+% Now uses (=> self ...) form (produces same object code).
+% Added operations PEEKC-IMAGE, GETL, TELL-POSITION, SEEK-POSITION
+% (written by Nancy Kendzierski).
+%
+% 11/22/82 Alan Snyder
+% Changed SEEK-POSITION to work with large byte pointers (> 256K).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-strings))
+(BothTimes (load objects jsys))
+(load directory file-support)
+
+(de attempt-to-open-input (file-name)
+ (let ((p (ErrorSet (list 'open-input file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de open-input (file-name)
+ (let ((s (make-instance 'input-stream)))
+ (=> s open file-name)
+ s))
+
+(DefConst FILE-BUFFER-SIZE #.(* 5 512))
+
+(defflavor input-stream ((jfn NIL) % TOPS-20 file number
+ ptr % "pointer" to next char in buffer
+ count % number of valid chars in buffer
+ eof-flag % T => this bufferfull is the last
+ file-name % full name of actual file
+ buffer % input buffer
+ )
+ ()
+ (gettable-instance-variables file-name)
+ )
+
+% Note: The JSYS function can't be used for the 'SIN' JSYS because the JSYS
+% function handles errors. The 'SIN' JSYS will report an error on end-of-file
+% if errors are being handled. We don't want that to happen!
+
+(CompileTime (progn
+ (put 'SIN 'OpenCode '((jsys 8#52) (move (reg 1) (reg 3))))
+ (put 'BIN 'OpenCode '((jsys 8#50) (move (reg 1) (reg 2))))
+ (put 'CLOSF 'OpenCode '((jsys 8#22) (move (reg 1) (reg 1))))
+ (put 'RFPTR 'OpenCode '((jsys 8#43) (jfcl) (move (reg 1) (reg 2))))
+ (put 'SFPTR 'OpenCode '((jsys 8#27) (jfcl) (move (reg 1) (reg 1))))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (input-stream getc) ()
+
+ % Return the next character from the file. Line termination is represented
+ % by a single NEWLINE (LF) character. Returns NIL on end of file.
+
+ % Implementation note: It was determined by experiment that the PSL
+ % compiler produces much better code if there are no function calls other
+ % than tail-recursive ones. That's why this function is written the way
+ % it is.
+
+ (if (< ptr count)
+ (let ((ch (prog1
+ (string-fetch buffer ptr)
+ (setf ptr (+ ptr 1))
+ )))
+ % Ignore CR followed by LF
+ (if (= ch #\CR)
+ (=> self &getc-after-CR)
+ ch
+ ))
+ (=> self &fill-buffer-and-getc)
+ ))
+
+(defmethod (input-stream &getc-after-CR) () % Internal method.
+ % We have just read a CR from the buffer. If the next character
+ % is a LF, then we should ignore the CR and return the LF.
+ % Otherwise, we should return the CR.
+
+ (if (= (=> self peekc-image) #\LF)
+ (=> self getc-image)
+ #\CR
+ ))
+
+(defmethod (input-stream &fill-buffer-and-getc) () % Internal method.
+ (and (=> self &fill-buffer) (=> self getc)))
+
+(defmethod (input-stream getc-image) ()
+
+ % Return the next character from the file. Do not perform any translation.
+ % In particular, return all <CR>s. Returns NIL on end of file.
+
+ (if (< ptr count)
+ (prog1
+ (string-fetch buffer ptr)
+ (setf ptr (+ ptr 1))
+ )
+ (=> self &fill-buffer-and-getc-image)
+ ))
+
+(defmethod (input-stream &fill-buffer-and-getc-image) () % Internal method.
+ (and (=> self &fill-buffer) (=> self getc-image)))
+
+(defmethod (input-stream empty?) ()
+ (null (=> self peekc-image)))
+
+(defmethod (input-stream peekc) ()
+
+ % Return the next character from the file, but don't advance to the next
+ % character. Returns NIL on end of file. Maps CRLF to LF.
+
+ (if (< ptr count)
+ (let ((ch (string-fetch buffer ptr)))
+ % Ignore CR if followed by LF
+ (if (and (= ch #\CR)
+ (= (=> self &peek2) #\LF)
+ )
+ #\LF
+ ch
+ ))
+ (=> self &fill-buffer-and-peekc)
+ ))
+
+(defmethod (input-stream &fill-buffer-and-peekc) () % Internal method.
+ (and (=> self &fill-buffer) (=> self peekc)))
+
+(defmethod (input-stream peekc-image) ()
+
+ % Return the next character from the file, but don't advance to the next
+ % character. Returns NIL on end of file.
+
+ (if (< ptr count)
+ (string-fetch buffer ptr)
+ (=> self &fill-buffer-and-peekc-image)
+ ))
+
+(defmethod (input-stream &fill-buffer-and-peekc-image) () % Internal method.
+ (and (=> self &fill-buffer) (=> self peekc-image)))
+
+(defmethod (input-stream &peek2) () % Internal method.
+
+ % Return the character after the next character in the file, but don't
+ % advance. Does not map CRLF. Returns Ascii NUL on end of file. Requires
+ % that the buffer contain at least one character. This is a hack required
+ % to implement PEEKC.
+
+ (let ((next-ptr (+ ptr 1)))
+ (cond ((>= next-ptr count)
+ % The next character has not yet been read into the buffer.
+ (let* ((old-pos (RFPTR jfn))
+ (ch (BIN jfn))
+ )
+ (SFPTR jfn old-pos)
+ ch
+ ))
+ (t (string-fetch buffer next-ptr))
+ )))
+
+(defmethod (input-stream &fill-buffer) () % Internal method.
+ % Return NIL iff there are no more characters.
+ (if eof-flag
+ NIL
+ (let ((n (SIN jfn (jconv buffer) (- (const FILE-BUFFER-SIZE)))))
+ (if (~= n 0) (setf eof-flag T))
+ (setf count (+ (const FILE-BUFFER-SIZE) n))
+ (setf ptr 0)
+ (~= count 0))))
+
+(defmethod (input-stream getl) ()
+ % Read and return (the remainder of) the current input line.
+ % Read, but don't return the terminating EOL (if any).
+ % (EOL is interpreted as LF or CRLF)
+ % Return NIL if no characters and end-of-file detected.
+
+ (if (and (>= ptr count) (not (=> self &fill-buffer)))
+ NIL
+ % Else
+ (let ((start ptr) (save-buffer NIL) (eof? NIL))
+ (while (and (not eof?) (~= (string-fetch buffer ptr) #\LF))
+ (setf ptr (+ ptr 1))
+ (cond ((>= ptr count)
+ (setf save-buffer
+ (concat save-buffer (subseq buffer start ptr)))
+ (setf eof? (not (=> self &fill-buffer)))
+ (setf start ptr)
+ ))
+ )
+ (if eof?
+ save-buffer
+ % Else
+ (setf ptr (+ ptr 1))
+ (if (= ptr 1)
+ (if save-buffer
+ (if (= (string-fetch save-buffer (size save-buffer)) #\CR)
+ (subseq save-buffer 0 (size save-buffer))
+ (sub save-buffer 0 (size save-buffer)))
+ (subseq buffer start ptr))
+ (if (= (string-fetch buffer (- ptr 2)) #\CR)
+ (concat save-buffer (subseq buffer start (- ptr 2)))
+ (concat save-buffer (subseq buffer start (- ptr 1)))
+ )))
+ )))
+
+(defmethod (input-stream tell-position) ()
+ % Return an integer representing the current "position" of the stream. About
+ % all we can guarantee about this integer is (1) it will be 0 at the
+ % beginning of the file and (2) if you later SEEK-POSITION to this integer,
+ % the stream will be reset to its current position. The reason for this
+ % fuzziness is that the translation of CRLF into LF performed by the "normal"
+ % input operations makes it impossible to predict the relationship between
+ % the apparent file position and the actual file position.
+
+ (- (RFPTR jfn) (- count ptr))
+ )
+
+(defmethod (input-stream seek-position) (p)
+ (setf p (int2sys p))
+ (let* ((buffer-end (RFPTR jfn))
+ (buffer-start (- buffer-end count)))
+ (if (and (>= p buffer-start) (< p buffer-end))
+ (setf ptr (- p buffer-start))
+ % Else
+ (SFPTR jfn p)
+ (setf ptr 0)
+ (setf count 0)
+ (setf eof-flag NIL)
+ )
+ ))
+
+(defmethod (input-stream open) (name-of-file)
+
+ % Open the specified file for input via SELF. If the file cannot be opened,
+ % a Continuable Error is generated.
+
+ (if jfn (=> self close))
+ (setf buffer (MkString (const FILE-BUFFER-SIZE) #\space))
+ (setf ptr 0)
+ (setf count 0)
+ (setf eof-flag NIL)
+ (setf jfn (Dec20Open name-of-file
+ (int2sys 2#001000000000000001000000000000000000)
+ (int2sys 2#000111000000000000010000000000100000)
+ ))
+ (if (= jfn 0) (setf jfn NIL))
+ (if (null jfn)
+ (=> self open
+ (ContinuableError
+ 0
+ (BldMsg "Unable to Open '%w' for Input." name-of-file)
+ name-of-file))
+ % Else
+ (setf file-name (jfn-truename jfn))
+ ))
+
+(defmethod (input-stream close) ()
+ (when jfn
+ (CLOSF jfn)
+ (setf jfn NIL)
+ (setf buffer NIL)
+ (setf count 0)
+ (setf ptr 0)
+ (setf eof-flag T)
+ ))
+
+(defmethod (input-stream read-date) ()
+ (jfn-read-date jfn))
+
+(defmethod (input-stream write-date) ()
+ (jfn-write-date jfn))
+
+(defmethod (input-stream delete-file) ()
+ (jfn-delete jfn))
+
+(defmethod (input-stream undelete-file) ()
+ (jfn-undelete jfn))
+
+(defmethod (input-stream delete-and-expunge-file) ()
+ (jfn-delete-and-expunge jfn))
+
+(defmethod (input-stream author) ()
+ (jfn-author jfn))
+
+(defmethod (input-stream original-author) ()
+ (jfn-original-author jfn))
+
+(defmethod (input-stream file-length) ()
+ (jfn-byte-count jfn))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% TESTING CODE
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CommentOutCode (progn
+
+(de test-buffered-input (name-of-file)
+ (setf s (open-input name-of-file))
+ (while (setf ch (input-stream$getc s))
+ (WriteChar ch)
+ )
+ (=> s close)
+ (Prin2 "---EOF---")
+ NIL
+ )
+
+(de time-buffered-input (name-of-file)
+ (setf start-time (time))
+ (setf s (open-input name-of-file))
+ (while (setf ch (input-stream$getc s))
+ )
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-buffered-input-1 (name-of-file)
+ (setf start-time (time))
+ (setf s (open-input name-of-file))
+ (while (setf ch (=> s getc))
+ )
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-standard-input (name-of-file)
+ (setf start-time (time))
+ (setf chan (open name-of-file 'INPUT))
+ (while (not (= (setf ch (ChannelReadChar chan)) $EOF$))
+ )
+ (close chan)
+ (- (time) start-time)
+ )
+
+(de time-input (name-of-file)
+ (list
+ (time-buffered-input name-of-file)
+ (time-buffered-input-1 name-of-file)
+ (time-standard-input name-of-file)
+ ))
+
+)) % End CommentOutCode
ADDED psl-1983/20-util/interrupt.build
Index: psl-1983/20-util/interrupt.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/interrupt.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp, Monsym, Jsys;
+in "20-interrupt.red"$
ADDED psl-1983/20-util/jsys.build
Index: psl-1983/20-util/jsys.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/jsys.build
@@ -0,0 +1,2 @@
+CompileTime load Monsym;
+in "jsys.red"$
ADDED psl-1983/20-util/jsys.red
Index: psl-1983/20-util/jsys.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/jsys.red
@@ -0,0 +1,467 @@
+%
+% JSYS.RED - Simple XJSYS function
+%
+% Author: Martin L. Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 8 March 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.UTIL>JSYS.RED.9, 18-May-82 13:24:36, Edit by BENSON
+% Made XJSYSn OpenCode'ed
+%/ Changed FILNAM->FileName, due to GLOBAL conflict
+%/ Changed JSYS calls, so LIST(..) rather than '(..) used
+%/ Changed for V3:JSYS
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% <PSL.UTIL>JSYS.RED.2, 18-Mar-82 21:49:32, Edit by GRISS
+% Converted to V3
+%. M. Griss 3:32pm Saturday, 7 November 1981
+%. MLG: Fixed GetErrorString and BITS macro, 8:57am Friday, 25 December 1981
+on syslisp;
+
+% Modeled after the IDapply to avoid CONS, register reloads
+% could easily be done Opencoded
+% SYSLSP calls, expect W value, return appropriate register
+
+%. syslsp procedure XJsys0(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys1(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys2(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys3(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys4(Jr1,Jr2,Jr3,Jr4,Jnum)
+
+lap '((!*entry xjsys0 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (wconst 0) (reg 1))
+ (!*exit 0))$
+
+BothTimes put('xjsys0, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (setzm (reg 1))));
+
+lap '((!*entry xjsys1 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*exit 0))$
+
+BothTimes put('xjsys1, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))));
+
+lap '((!*entry xjsys2 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (reg 2) (reg 1))
+ (!*exit 0))$
+
+BothTimes put('xjsys2, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (move (reg 1) (reg 2))));
+
+lap '((!*entry xjsys3 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (reg 3) (reg 1))
+ (!*exit 0))$
+
+BothTimes put('xjsys3, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (move (reg 1) (reg 3))));
+
+lap '((!*entry xjsys4 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (reg 4) (reg 1))
+ (!*exit 0))$
+
+
+BothTimes put('xjsys4, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (move (reg 1) (reg 4))));
+
+lap '((!*entry geterrorstring expr 1)
+ (!*move (wconst -1) (reg 2)) % most recent error
+ (hrli (reg 2) 8#400000) % self process
+ (!*move (wconst 0) (reg 3)) % all string
+ (erstr) % get the error string to a1 buffer
+ (jfcl)
+ (jfcl)
+ (!*exit 0))$
+
+syslsp procedure xjsyserror$ %/ should load up errstr
+ begin scalar s;
+ s:=gtstr 200;
+ geterrorstring lor(lsh(8#10700,18), s)$
+ return stderror recopystringtonull s;
+ end;
+
+% --- conversions for lisp level calls
+
+syslsp procedure str2int s;
+ sys2int strinf s;
+
+syslsp procedure int2str i;
+ mkstr int2sys i;
+
+syslsp procedure jconv j; %. handle untagging
+ if fixp j then int2sys j
+ else if stringp j
+ then lor(lsh(8#10700,18),strinf(j)) % Bug in LONG const
+ else stderror list(j,'" not known in jconv");
+
+% lisp calls. untag args, then tag result as integer
+% user has to convert result from xword, stringbase, etc
+
+syslsp procedure jsys0(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys0(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys1(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys1(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys2(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys2(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys3(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys3(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys4(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys4(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure checknum(x,y);
+ if intp x then intinf x else nonintegererror(x,y);
+
+CommentOutCode<<
+syslsp procedure insertstringsize s;
+ begin scalar l,s1; % this must not be done to a string
+ l:=0; s1:=strinf(s); % in the heap!
+ while not (strbyt(s1,l)= char null) do l:=l+1;
+ @s1:=mkitem(hstr,l-1);
+ return s;
+ end;
+>>;
+
+syslsp procedure recopystringtonull s;
+ begin scalar l,s1,s2,ch;
+ l:=0; s1:=strinf(s);
+ while not (strbyt(s1,l)= char null) do l:=l+1;
+ s2:=gtstr(l-1);
+ l:=0;
+ while not ((ch:=strbyt(s1,l))= char null)
+ do <<strbyt(s2,l):= ch; l:=l+1>>;
+ return mkstr s2;
+ end;
+
+% ------------ useful bit, byte and word utilities
+
+syslsp procedure swap(x); %. swap half words
+ xword(lowhalfword x,highhalfword x);
+
+syslsp procedure lowhalfword n;
+ sys2int land(int2sys n,8#777777);
+
+compiletime <<
+syslsp smacro procedure rsh(x,y);
+ lsh(x,-y);
+>>;
+
+syslsp procedure highhalfword n;
+ sys2int land(rsh(int2sys n,18),8#777777);
+
+syslsp procedure xword(x,y); %. build word from half-words
+% sys2int lor(lsh(lowhalfword(int2sys x),18),
+% lowhalfword int2sys y); %/Compiler error
+begin scalar Tmp;
+ Tmp := lowhalfword int2sys x;
+ Tmp := lsh(Tmp, 18);
+ Tmp := lor(Tmp, lowhalfword int2sys y);
+ return sys2int Tmp;
+end;
+
+syslsp procedure jbits l; %. convert bit and byte fields
+% l is list of bitpos or (fieldvalue . rightbitpos)
+% msb is #0, lsb is #35 on dec-20
+ begin scalar wd,x,fldpos,fldval;
+ wd:=0;
+ lb: if not pairp l then return sys2int wd;
+ x:=car l; l := cdr l;
+ if pairp x then <<fldpos:=cdr x; fldval:=car x>>
+ else <<fldpos:=x; fldval:=1>>;
+ if not (fixp fldval and fixp fldpos) then goto lb;
+ if fldpos <0 or fldpos > 35 then goto lb;
+ wd := lor(wd,lsh(fldval,35-fldpos));
+ goto lb;
+ end;
+
+macro procedure bits l;
+ list('jbits, 'list . cdr l);
+
+
+%. load jSYS Names
+
+procedure MakeJsys(Name, Number);
+ EvDefConst(Name, Number);
+
+off syslisp;
+
+MakeJsys( 'jsJSYS , 8#0)$
+MakeJsys( 'jsLOGIN , 8#1)$
+MakeJsys( 'jsCRJOB , 8#2)$
+MakeJsys( 'jsLGOUT , 8#3)$
+MakeJsys( 'jsCACCT , 8#4)$
+MakeJsys( 'jsEFACT , 8#5)$
+MakeJsys( 'jsSMON , 8#6)$
+MakeJsys( 'jsTMON , 8#7)$
+MakeJsys( 'jsGETAB , 8#10)$
+MakeJsys( 'jsERSTR , 8#11)$
+MakeJsys( 'jsGETER , 8#12)$
+MakeJsys( 'jsGJINF , 8#13)$
+MakeJsys( 'jsTIME , 8#14)$
+MakeJsys( 'jsRUNTM , 8#15)$
+MakeJsys( 'jsSYSGT , 8#16)$
+MakeJsys( 'jsGNJFN , 8#17)$
+MakeJsys( 'jsGTJFN , 8#20)$
+MakeJsys( 'jsOPENF , 8#21)$
+MakeJsys( 'jsCLOSF , 8#22)$
+MakeJsys( 'jsRLJFN , 8#23)$
+MakeJsys( 'jsGTSTS , 8#24)$
+MakeJsys( 'jsSTSTS , 8#25)$
+MakeJsys( 'jsDELF , 8#26)$
+MakeJsys( 'jsSFPTR , 8#27)$
+MakeJsys( 'jsJFNS , 8#30)$
+MakeJsys( 'jsFFFFP , 8#31)$
+MakeJsys( 'jsRDDIR , 8#32)$
+MakeJsys( 'jsCPRTF , 8#33)$
+MakeJsys( 'jsCLZFF , 8#34)$
+MakeJsys( 'jsRNAMF , 8#35)$
+MakeJsys( 'jsSIZEF , 8#36)$
+MakeJsys( 'jsGACTF , 8#37)$
+MakeJsys( 'jsSTDIR , 8#40)$
+MakeJsys( 'jsDIRST , 8#41)$
+MakeJsys( 'jsBKJFN , 8#42)$
+MakeJsys( 'jsRFPTR , 8#43)$
+MakeJsys( 'jsCNDIR , 8#44)$
+MakeJsys( 'jsRFBSZ , 8#45)$
+MakeJsys( 'jsSFBSZ , 8#46)$
+MakeJsys( 'jsSWJFN , 8#47)$
+MakeJsys( 'jsBIN , 8#50)$
+MakeJsys( 'jsBOUT , 8#51)$
+MakeJsys( 'jsSIN , 8#52)$
+MakeJsys( 'jsSOUT , 8#53)$
+MakeJsys( 'jsRIN , 8#54)$
+MakeJsys( 'jsROUT , 8#55)$
+MakeJsys( 'jsPMAP , 8#56)$
+MakeJsys( 'jsRPACS , 8#57)$
+MakeJsys( 'jsSPACS , 8#60)$
+MakeJsys( 'jsRMAP , 8#61)$
+MakeJsys( 'jsSACTF , 8#62)$
+MakeJsys( 'jsGTFDB , 8#63)$
+MakeJsys( 'jsCHFDB , 8#64)$
+MakeJsys( 'jsDUMPI , 8#65)$
+MakeJsys( 'jsDUMPO , 8#66)$
+MakeJsys( 'jsDELDF , 8#67)$
+MakeJsys( 'jsASND , 8#70)$
+MakeJsys( 'jsRELD , 8#71)$
+MakeJsys( 'jsCSYNO , 8#72)$
+MakeJsys( 'jsPBIN , 8#73)$
+MakeJsys( 'jsPBOUT , 8#74)$
+MakeJsys( 'jsPSIN , 8#75)$
+MakeJsys( 'jsPSOUT , 8#76)$
+MakeJsys( 'jsMTOPR , 8#77)$
+MakeJsys( 'jsCFIBF , 8#100)$
+MakeJsys( 'jsCFOBF , 8#101)$
+MakeJsys( 'jsSIBE , 8#102)$
+MakeJsys( 'jsSOBE , 8#103)$
+MakeJsys( 'jsDOBE , 8#104)$
+MakeJsys( 'jsGTABS , 8#105)$
+MakeJsys( 'jsSTABS , 8#106)$
+MakeJsys( 'jsRFMOD , 8#107)$
+MakeJsys( 'jsSFMOD , 8#110)$
+MakeJsys( 'jsRFPOS , 8#111)$
+MakeJsys( 'jsRFCOC , 8#112)$
+MakeJsys( 'jsSFCOC , 8#113)$
+MakeJsys( 'jsSTI , 8#114)$
+MakeJsys( 'jsDTACH , 8#115)$
+MakeJsys( 'jsATACH , 8#116)$
+MakeJsys( 'jsDVCHR , 8#117)$
+MakeJsys( 'jsSTDEV , 8#120)$
+MakeJsys( 'jsDEVST , 8#121)$
+MakeJsys( 'jsMOUNT , 8#122)$
+MakeJsys( 'jsDSMNT , 8#123)$
+MakeJsys( 'jsINIDR , 8#124)$
+MakeJsys( 'jsSIR , 8#125)$
+MakeJsys( 'jsEIR , 8#126)$
+MakeJsys( 'jsSKPIR , 8#127)$
+MakeJsys( 'jsDIR , 8#130)$
+MakeJsys( 'jsAIC , 8#131)$
+MakeJsys( 'jsIIC , 8#132)$
+MakeJsys( 'jsDIC , 8#133)$
+MakeJsys( 'jsRCM , 8#134)$
+MakeJsys( 'jsRWM , 8#135)$
+MakeJsys( 'jsDEBRK , 8#136)$
+MakeJsys( 'jsATI , 8#137)$
+MakeJsys( 'jsDTI , 8#140)$
+MakeJsys( 'jsCIS , 8#141)$
+MakeJsys( 'jsSIRCM , 8#142)$
+MakeJsys( 'jsRIRCM , 8#143)$
+MakeJsys( 'jsRIR , 8#144)$
+MakeJsys( 'jsGDSTS , 8#145)$
+MakeJsys( 'jsSDSTS , 8#146)$
+MakeJsys( 'jsRESET , 8#147)$
+MakeJsys( 'jsRPCAP , 8#150)$
+MakeJsys( 'jsEPCAP , 8#151)$
+MakeJsys( 'jsCFORK , 8#152)$
+MakeJsys( 'jsKFORK , 8#153)$
+MakeJsys( 'jsFFORK , 8#154)$
+MakeJsys( 'jsRFORK , 8#155)$
+MakeJsys( 'jsRFSTS , 8#156)$
+MakeJsys( 'jsSFORK , 8#157)$
+MakeJsys( 'jsSFACS , 8#160)$
+MakeJsys( 'jsRFACS , 8#161)$
+MakeJsys( 'jsHFORK , 8#162)$
+MakeJsys( 'jsWFORK , 8#163)$
+MakeJsys( 'jsGFRKH , 8#164)$
+MakeJsys( 'jsRFRKH , 8#165)$
+MakeJsys( 'jsGFRKS , 8#166)$
+MakeJsys( 'jsDISMS , 8#167)$
+MakeJsys( 'jsHALTF , 8#170)$
+MakeJsys( 'jsGTRPW , 8#171)$
+MakeJsys( 'jsGTRPI , 8#172)$
+MakeJsys( 'jsRTIW , 8#173)$
+MakeJsys( 'jsSTIW , 8#174)$
+MakeJsys( 'jsSOBF , 8#175)$
+MakeJsys( 'jsRWSET , 8#176)$
+MakeJsys( 'jsGETNM , 8#177)$
+MakeJsys( 'jsGET , 8#200)$
+MakeJsys( 'jsSFRKV , 8#201)$
+MakeJsys( 'jsSAVE , 8#202)$
+MakeJsys( 'jsSSAVE , 8#203)$
+MakeJsys( 'jsSEVEC , 8#204)$
+MakeJsys( 'jsGEVEC , 8#205)$
+MakeJsys( 'jsGPJFN , 8#206)$
+MakeJsys( 'jsSPJFN , 8#207)$
+MakeJsys( 'jsSETNM , 8#210)$
+MakeJsys( 'jsFFUFP , 8#211)$
+MakeJsys( 'jsDIBE , 8#212)$
+MakeJsys( 'jsFDFRE , 8#213)$
+MakeJsys( 'jsGDSKC , 8#214)$
+MakeJsys( 'jsLITES , 8#215)$
+MakeJsys( 'jsTLINK , 8#216)$
+MakeJsys( 'jsSTPAR , 8#217)$
+MakeJsys( 'jsODTIM , 8#220)$
+MakeJsys( 'jsIDTIM , 8#221)$
+MakeJsys( 'jsODCNV , 8#222)$
+MakeJsys( 'jsIDCNV , 8#223)$
+MakeJsys( 'jsNOUT , 8#224)$
+MakeJsys( 'jsNIN , 8#225)$
+MakeJsys( 'jsSTAD , 8#226)$
+MakeJsys( 'jsGTAD , 8#227)$
+MakeJsys( 'jsODTNC , 8#230)$
+MakeJsys( 'jsIDTNC , 8#231)$
+MakeJsys( 'jsFLIN , 8#232)$
+MakeJsys( 'jsFLOUT , 8#233)$
+MakeJsys( 'jsDFIN , 8#234)$
+MakeJsys( 'jsDFOUT , 8#235)$
+MakeJsys( 'jsCRDIR , 8#240)$
+MakeJsys( 'jsGTDIR , 8#241)$
+MakeJsys( 'jsDSKOP , 8#242)$
+MakeJsys( 'jsSPRIW , 8#243)$
+MakeJsys( 'jsDSKAS , 8#244)$
+MakeJsys( 'jsSJPRI , 8#245)$
+MakeJsys( 'jsSTO , 8#246)$
+MakeJsys( 'jsBBNIIT , 8#247)$
+MakeJsys( 'jsARCF , 8#247)$
+MakeJsys( 'jsASNDP , 8#260)$
+MakeJsys( 'jsRELDP , 8#261)$
+MakeJsys( 'jsASNDC , 8#262)$
+MakeJsys( 'jsRELDC , 8#263)$
+MakeJsys( 'jsSTRDP , 8#264)$
+MakeJsys( 'jsSTPDP , 8#265)$
+MakeJsys( 'jsSTSDP , 8#266)$
+MakeJsys( 'jsRDSDP , 8#267)$
+MakeJsys( 'jsWATDP , 8#270)$
+MakeJsys( 'jsATNVT , 8#274)$
+MakeJsys( 'jsCVSKT , 8#275)$
+MakeJsys( 'jsCVHST , 8#276)$
+MakeJsys( 'jsFLHST , 8#277)$
+MakeJsys( 'jsGCVEC , 8#300)$
+MakeJsys( 'jsSCVEC , 8#301)$
+MakeJsys( 'jsSTTYP , 8#302)$
+MakeJsys( 'jsGTTYP , 8#303)$
+MakeJsys( 'jsBPT , 8#304)$
+MakeJsys( 'jsGTDAL , 8#305)$
+MakeJsys( 'jsWAIT , 8#306)$
+MakeJsys( 'jsHSYS , 8#307)$
+MakeJsys( 'jsUSRIO , 8#310)$
+MakeJsys( 'jsPEEK , 8#311)$
+MakeJsys( 'jsMSFRK , 8#312)$
+MakeJsys( 'jsESOUT , 8#313)$
+MakeJsys( 'jsSPLFK , 8#314)$
+MakeJsys( 'jsADVIS , 8#315)$
+MakeJsys( 'jsJOBTM , 8#316)$
+MakeJsys( 'jsDELNF , 8#317)$
+MakeJsys( 'jsSWTCH , 8#320)$
+MakeJsys( 'jsOPRFN , 8#326)$
+MakeJsys( 'jsCGRP , 8#327)$
+MakeJsys( 'jsVACCT , 8#330)$
+MakeJsys( 'jsGDACC , 8#331)$
+MakeJsys( 'jsATGRP , 8#332)$
+MakeJsys( 'jsGACTJ , 8#333)$
+MakeJsys( 'jsGPSGN , 8#334)$
+MakeJsys( 'jsRSCAN , 8#500)$
+MakeJsys( 'jsHPTIM , 8#501)$
+MakeJsys( 'jsCRLNM , 8#502)$
+MakeJsys( 'jsINLNM , 8#503)$
+MakeJsys( 'jsLNMST , 8#504)$
+MakeJsys( 'jsRDTXT , 8#505)$
+MakeJsys( 'jsSETSN , 8#506)$
+MakeJsys( 'jsGETJI , 8#507)$
+MakeJsys( 'jsMSEND , 8#510)$
+MakeJsys( 'jsMRECV , 8#511)$
+MakeJsys( 'jsMUTIL , 8#512)$
+MakeJsys( 'jsENQ , 8#513)$
+MakeJsys( 'jsDEQ , 8#514)$
+MakeJsys( 'jsENQC , 8#515)$
+MakeJsys( 'jsSNOOP , 8#516)$
+MakeJsys( 'jsSPOOL , 8#517)$
+MakeJsys( 'jsALLOC , 8#520)$
+MakeJsys( 'jsCHKAC , 8#521)$
+MakeJsys( 'jsTIMER , 8#522)$
+MakeJsys( 'jsRDTTY , 8#523)$
+MakeJsys( 'jsTEXTI , 8#524)$
+MakeJsys( 'jsUFPGS , 8#525)$
+MakeJsys( 'jsSFPOS , 8#526)$
+MakeJsys( 'jsSYERR , 8#527)$
+MakeJsys( 'jsDIAG , 8#530)$
+MakeJsys( 'jsSINR , 8#531)$
+MakeJsys( 'jsSOUTR , 8#532)$
+MakeJsys( 'jsRFTAD , 8#533)$
+MakeJsys( 'jsSFTAD , 8#534)$
+MakeJsys( 'jsTBDEL , 8#535)$
+MakeJsys( 'jsTBADD , 8#536)$
+MakeJsys( 'jsTBLUK , 8#537)$
+MakeJsys( 'jsSTCMP , 8#540)$
+MakeJsys( 'jsSETJB , 8#541)$
+MakeJsys( 'jsGDVEC , 8#542)$
+MakeJsys( 'jsSDVEC , 8#543)$
+MakeJsys( 'jsCOMND , 8#544)$
+MakeJsys( 'jsPRARG , 8#545)$
+MakeJsys( 'jsGACCT , 8#546)$
+MakeJsys( 'jsLPINI , 8#547)$
+MakeJsys( 'jsGFUST , 8#550)$
+MakeJsys( 'jsSFUST , 8#551)$
+MakeJsys( 'jsACCES , 8#552)$
+MakeJsys( 'jsRCDIR , 8#553)$
+MakeJsys( 'jsRCUSR , 8#554)$
+MakeJsys( 'jsSNDIM , 8#750)$
+MakeJsys( 'jsRCVIM , 8#751)$
+MakeJsys( 'jsASNSQ , 8#752)$
+MakeJsys( 'jsRELSQ , 8#753)$
+MakeJsys( 'jsTHIBR , 8#770)$
+MakeJsys( 'jsTWAKE , 8#771)$
+MakeJsys( 'jsMRPAC , 8#772)$
+MakeJsys( 'jsSETPV , 8#773)$
+MakeJsys( 'jsMTALN , 8#774)$
+MakeJsys( 'jsTTMSG , 8#775)$
+
+End$
ADDED psl-1983/20-util/monsym.build
Index: psl-1983/20-util/monsym.build
==================================================================
--- /dev/null
+++ psl-1983/20-util/monsym.build
@@ -0,0 +1,1 @@
+in "monsym.red"$
ADDED psl-1983/20-util/monsym.red
Index: psl-1983/20-util/monsym.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/monsym.red
@@ -0,0 +1,323 @@
+%
+% MONSYM.RED - Support for Dec-20 system LAP code
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+CompileTime <<
+
+macro procedure DefineJSYSRangeFrom X;
+begin scalar Start, L;
+ Start := Sub1 second X;
+ L := third X;
+ return ('progn
+ . for each Name in second L collect
+ list('progn, list('put, MkQuote Name,'(quote JSYSValue),
+ Start := Add1 Start),
+ list('put,MkQuote Name,
+ '(quote InstructionDepositFunction),
+ '(quote JSYSDeposit))));
+end;
+
+>>;
+
+lisp procedure JSYSDeposit X;
+<< if !*WritingFaslFile then UpdateBitTable(1, 0);
+ DepositAllFields(8#104, 0, get(car X, 'JSYSValue)) >>;
+
+flag('(ERJMP ERCAL), 'MC);
+
+lisp procedure ERJMP Address;
+ list list('jump, 8#16, Address);
+
+lisp procedure ERCAL Address;
+ list list('jump, 8#17, Address);
+
+DefineJSYSRangeFrom(1, '(
+ LOGIN
+ CRJOB
+ LGOUT
+ CACCT
+ EFACT
+ SMON
+ TMON
+ GETAB
+ ERSTR
+ GETER
+ GJINF
+ TIME
+ RUNTM
+ SYSGT
+ GNJFN
+ GTJFN
+ OPENF
+ CLOSF
+ RLJFN
+ GTSTS
+ STSTS
+ DELF
+ SFPTR
+ JFNS
+ FFFFP
+ RDDIR
+ CPRTF
+ CLZFF
+ RNAMF
+ SIZEF
+ GACTF
+ STDIR
+ DIRST
+ BKJFN
+ RFPTR
+ CNDIR
+ RFBSZ
+ SFBSZ
+ SWJFN
+ BIN
+ BOUT
+ SIN
+ SOUT
+ RIN
+ ROUT
+ PMAP
+ RPACS
+ SPACS
+ RMAP
+ SACTF
+ GTFDB
+ CHFDB
+ DUMPI
+ DUMPO
+ DELDF
+ ASND
+ RELD
+ CSYNO
+ PBIN
+ PBOUT
+ PSIN
+ PSOUT
+ MTOPR
+ CFIBF
+ CFOBF
+ SIBE
+ SOBE
+ DOBE
+ GTABS
+ STABS
+ RFMOD
+ SFMOD
+ RFPOS
+ RFCOC
+ SFCOC
+ STI
+ DTACH
+ ATACH
+ DVCHR
+ STDEV
+ DEVST
+ MOUNT
+ DSMNT
+ INIDR
+ SIR
+ EIR
+ SKPIR
+ DIR
+ AIC
+ IIC
+ DIC
+ RCM
+ RWM
+ DEBRK
+ ATI
+ DTI
+ CIS
+ SIRCM
+ RIRCM
+ RIR
+ GDSTS
+ SDSTS
+ RESET
+ RPCAP
+ EPCAP
+ CFORK
+ KFORK
+ FFORK
+ RFORK
+ RFSTS
+ SFORK
+ SFACS
+ RFACS
+ HFORK
+ WFORK
+ GFRKH
+ RFRKH
+ GFRKS
+ DISMS
+ HALTF
+ GTRPW
+ GTRPI
+ RTIW
+ STIW
+ SOBF
+ RWSET
+ GETNM
+ GET
+ SFRKV
+ SAVE
+ SSAVE
+ SEVEC
+ GEVEC
+ GPJFN
+ SPJFN
+ SETNM
+ FFUFP
+ DIBE
+ FDFRE
+ GDSKC
+ LITES
+ TLINK
+ STPAR
+ ODTIM
+ IDTIM
+ ODCNV
+ IDCNV
+ NOUT
+ NIN
+ STAD
+ GTAD
+ ODTNC
+ IDTNC
+ FLIN
+ FLOUT
+ DFIN
+ DFOUT
+));
+
+DefineJSYSRangeFrom(160, '(
+ CRDIR
+ GTDIR
+ DSKOP
+ SPRIW
+ DSKAS
+ SJPRI
+ STO
+ ARCF
+));
+
+%define(jsASNDP,8%260) # NOT IMPLEMENTED
+%define(jsRELDP,8%261) # NOT IMPLEMENTED
+%define(jsASNDC,8%262) # NOT IMPLEMENTED
+%define(jsRELDC,8%263) # NOT IMPLEMENTED
+%define(jsSTRDP,8%264) # NOT IMPLEMENTED
+%define(jsSTPDP,8%265) # NOT IMPLEMENTED
+%define(jsSTSDP,8%266) # NOT IMPLEMENTED
+%define(jsRDSDP,8%267) # NOT IMPLEMENTED
+%define(jsWATDP,8%270) # NOT IMPLEMENTED
+
+DefineJSYSRangeFrom(188, '(
+ ATNVT
+ CVSKT
+ CVHST
+ FLHST
+ GCVEC
+ SCVEC
+ STTYP
+ GTTYP
+ BPT
+ GTDAL
+ WAIT
+ HSYS
+ USRIO
+ PEEK
+ MSFRK
+ ESOUT
+ SPLFK
+ ADVIS
+ JOBTM
+ DELNF
+ SWTCH
+ TFORK
+ RTFRK
+ UTFRK
+));
+
+DefineJSYSRangeFrom(214, '(
+ OPRFN
+ CGRP
+ VACCT
+ GDACC
+ ATGRP
+ GACTJ
+ GPSGN
+));
+
+DefineJSYSRangeFrom(320, '(
+ RSCAN
+ HPTIM
+ CRLNM
+ INLNM
+ LNMST
+ RDTXT
+ SETSN
+ GETJI
+ MSEND
+ MRECV
+ MUTIL
+ ENQ
+ DEQ
+ ENQC
+ SNOOP
+ SPOOL
+ ALLOC
+ CHKAC
+ TIMER
+ RDTTY
+ TEXTI
+ UFPGS
+ SFPOS
+ SYERR
+ DIAG
+ SINR
+ SOUTR
+ RFTAD
+ SFTAD
+ TBDEL
+ TBADD
+ TBLUK
+ STCMP
+ SETJB
+ GDVEC
+ SDVEC
+ COMND
+ PRARG
+ GACCT
+ LPINI
+ GFUST
+ SFUST
+ ACCES
+ RCDIR
+ RCUSR
+));
+
+DefineJSYSRangeFrom(488, '(
+ SNDIM
+ RCVIM
+ ASNSQ
+ RELSQ
+));
+
+DefineJSYSRangeFrom(504, '(
+ THIBR
+ TWAKE
+ MRPAC
+ SETPV
+ MTALN
+ TTMSG
+));
+
+END;
ADDED psl-1983/20-util/output-stream.sl
Index: psl-1983/20-util/output-stream.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/output-stream.sl
@@ -0,0 +1,263 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Output-Stream.SL (TOPS-20 Version) - File Output Stream Objects
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 29 July 1982
+%
+% This package is 6.7 times faster than the standard unbuffered I/O.
+% (Using message passing, it is only 1.9 times faster.)
+%
+% Note: this code will only run COMPILED.
+%
+% See TESTING code at the end of this file for examples of use.
+% Be sure to include "(CompileTime (load objects))" at the beginning
+% of any file that uses this package.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-vectors fast-strings))
+(BothTimes (load objects jsys))
+
+(de attempt-to-open-output (file-name)
+ (let ((p (ErrorSet (list 'open-output file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de attempt-to-open-append (file-name)
+ (let ((p (ErrorSet (list 'open-append file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de open-output (file-name)
+ (let ((s (make-instance 'output-stream)))
+ (=> s open file-name)
+ s))
+
+(de open-append (file-name)
+ (let ((s (make-instance 'output-stream)))
+ (=> s open-append file-name)
+ s))
+
+(defconst FILE-BUFFER-SIZE #.(* 5 512))
+
+(defflavor output-stream ((jfn NIL) % TOPS-20 file number
+ ptr % "pointer" to next free slot in buffer
+ file-name % full name of actual file
+ buffer % output buffer
+ )
+ ()
+ (gettable-instance-variables file-name)
+ )
+
+(CompileTime (put 'SOUT 'OpenCode '((jsys 43) (move (reg 1) (reg 3)))))
+(CompileTime (put 'CLOSF 'OpenCode '((jsys 18) (move (reg 1) (reg 1)))))
+
+(defmethod (output-stream putc) (ch)
+
+ % Append the character CH to the file. Line termination is indicated by
+ % writing a single NEWLINE (LF) character.
+
+ % Implementation note: It was determined by experiment that the PSL
+ % compiler produces much better code if there are no function calls other
+ % than tail-recursive ones. That's why this function is written the way
+ % it is.
+
+ (if (= ch #\LF)
+ (=> self put-newline)
+ % Otherwise:
+ (string-store buffer ptr ch)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ ))
+
+(defmethod (output-stream put-newline) ()
+
+ % Output a line terminator.
+
+ (string-store buffer ptr #\CR)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ (string-store buffer ptr #\LF)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ )
+
+(defmethod (output-stream putc-image) (ch)
+
+ % Append the character CH to the file. No translation of LF character.
+
+ (string-store buffer ptr ch)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ )
+
+(defmethod (output-stream puts) (str)
+
+ % Write string to output stream (highly optimized!)
+
+ (let ((i 0)
+ (high (string-upper-bound str))
+ )
+ (while (<= i high)
+ (string-store buffer ptr (string-fetch str i))
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ (setf i (+ i 1))
+ )))
+
+(defmethod (output-stream putl) (str)
+
+ % Write string followed by line terminator to output stream.
+
+ (=> self puts str)
+ (=> self put-newline)
+ )
+
+(defmethod (output-stream open) (name-of-file)
+
+ % Open the specified file for output via SELF. If the file cannot
+ % be opened, a Continuable Error is generated.
+
+ (if jfn (=> self close))
+ (setf jfn (Dec20Open name-of-file
+ (int2sys 2#100000000000000001000000000000000000)
+ (int2sys 2#000111000000000000001000000000000000)
+ ))
+ (if (= jfn 0) (setf jfn NIL))
+ (if (null JFN)
+ (=> self open
+ (ContinuableError 0
+ (BldMsg "Unable to Open '%w' for Output" name-of-file)
+ name-of-file))
+ (=> self &fixup)
+ ))
+
+(defmethod (output-stream open-append) (name-of-file)
+
+ % Open the specified file for append output via SELF. If the file cannot
+ % be opened, a Continuable Error is generated.
+
+ (if jfn (=> self close))
+ (setf jfn (Dec20Open name-of-file
+ (int2sys 2#000000000000000001000000000000000000)
+ (int2sys 2#000111000000000000000010000000000000)
+ ))
+ (if (= jfn 0) (setf jfn NIL))
+ (if (null JFN)
+ (=> self open-append
+ (ContinuableError 0
+ (BldMsg "Unable to Open '%w' for Append" name-of-file)
+ name-of-file))
+ (=> self &fixup)
+ ))
+
+(defmethod (output-stream attach-to-jfn) (new-jfn)
+
+ % Attach the output-stream to the specified JFN.
+
+ (if jfn (=> self close))
+ (setf jfn new-jfn)
+ (=> self &fixup)
+ )
+
+(defmethod (output-stream &fixup) ()
+ % Internal method for initializing instance variables after setting JFN.
+
+ (setf buffer (make-string (const FILE-BUFFER-SIZE) #\space))
+ % It is necessary to clear out the low-order bit, lest some programs
+ % think we are writing "line numbers" (what a crock!).
+ (for (from i 0 (- (/ (const FILE-BUFFER-SIZE) 5) 1))
+ (do (vector-store buffer i 0)))
+ (setf ptr 0)
+ (setf file-name (jfn-truename jfn))
+ )
+
+(defmethod (output-stream close) ()
+ (when jfn
+ (=> self flush)
+ (CLOSF jfn)
+ (setf jfn NIL)
+ (setf buffer NIL)
+ ))
+
+(defmethod (output-stream flush) ()
+ (when (> ptr 0)
+ (SOUT jfn (jconv buffer) (- ptr))
+ (setf ptr 0)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% TESTING CODE
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (setf time-output-test-string "This is a line of text for testing."))
+
+(CommentOutCode (progn
+
+(de time-buffered-output (n-lines)
+ % This is the FAST way to do buffered output.
+
+ (setf start-time (time))
+ (setf s (open-output "test.output"))
+ (for (from i 1 n-lines 1)
+ (do (for (in ch '#.(String2List time-output-test-string))
+ (do (output-stream$putc s ch))
+ )
+ (output-stream$put-newline s)
+ ))
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-buffered-output-1 (n-lines)
+ % This is the SLOW (but GENERAL) way to do buffered output.
+
+ (setf start-time (time))
+ (setf s (open-output "test.output"))
+ (for (from i 1 n-lines 1)
+ (do (for (in ch '#.(String2List time-output-test-string))
+ (do (=> s putc ch))
+ )
+ (=> s put-newline)
+ ))
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-standard-output (n-lines)
+ (setf start-time (time))
+ (setf chan (open "test.output" 'OUTPUT))
+ (for (from i 1 n-lines 1)
+ (do (for (in ch '#.(String2List time-output-test-string))
+ (do (ChannelWriteChar chan ch))
+ )
+ (ChannelWriteChar chan #\LF)
+ ))
+ (close chan)
+ (- (time) start-time)
+ )
+
+(de time-output (n-lines)
+ (list
+ (time-buffered-output-string n-lines)
+ (time-buffered-output n-lines)
+ (time-buffered-output-1 n-lines)
+ (time-standard-output n-lines)
+ ))
+
+(de time-buffered-output-string (n-lines)
+ % This is the FAST way to do buffered output from strings.
+
+ (setf start-time (time))
+ (setf s (open-output "test.output"))
+ (for (from i 1 n-lines 1)
+ (do (output-stream$putl s #.time-output-test-string))
+ )
+ (=> s close)
+ (- (time) start-time)
+ )
+
+)) % End CommentOutCode
ADDED psl-1983/20-util/pathnames.sl
Index: psl-1983/20-util/pathnames.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/pathnames.sl
@@ -0,0 +1,352 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PathNames.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 14 September 1982
+% Revised: 9 February 1983
+%
+% DEC-20 implementation of some Common Lisp pathname functions.
+%
+% 9-Feb-83 Alan Snyder
+% Revise conversion to string to omit the dot if there is no type or version.
+% Revise conversion from string to interpret trailing dot as specifying
+% an empty type or version. Change home-directory to specify PS:
+% Fix bug in make-pathname. Convert to using fast-strings stuff.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-vector fast-strings))
+(BothTimes (load objects))
+
+(when (funboundp 'string2integer)
+ (de string2integer (s)
+ (makestringintolispinteger s 10 1)
+ ))
+
+% The following function is an NEXPR: be sure this module is loaded at
+% compile-time if you use this function in code to be compiled!
+
+(dn make-pathname (keyword-arg-list)
+ (let ((pn (make-instance 'pathname)))
+ (while (not (null keyword-arg-list))
+ (let ((keyword (car keyword-arg-list)))
+ (setf keyword-arg-list (cdr keyword-arg-list))
+ (cond (keyword-arg-list
+ (let ((value (car keyword-arg-list)))
+ (setf keyword-arg-list (cdr keyword-arg-list))
+ (selectq keyword
+ (host (=> pn set-host value))
+ (device (=> pn set-device value))
+ (directory (=> pn set-directory value))
+ (name (=> pn set-name value))
+ (type (=> pn set-type value))
+ (version (=> pn set-version value))
+ ))))))
+ pn
+ ))
+
+(de pathname-host (pn)
+ (=> (pathname pn) host))
+
+(de pathname-device (pn)
+ (=> (pathname pn) device))
+
+(de pathname-directory (pn)
+ (=> (pathname pn) directory))
+
+(de pathname-name (pn)
+ (=> (pathname pn) name))
+
+(de pathname-type (pn)
+ (=> (pathname pn) type))
+
+(de pathname-version (pn)
+ (=> (pathname pn) version))
+
+(de PathnameP (x)
+ (and (VectorP x) (eq (getv x 0) 'pathname)))
+
+(de StreamP (x)
+ (and (VectorP x) (object-get-handler-quietly x 'file-name)))
+
+(de truename (x) (pathname x))
+
+(de pathname (x)
+ (cond
+ ((PathnameP x) x)
+ ((StringP x) (string-to-pathname x))
+ ((IdP x) (string-to-pathname (id2string x)))
+ ((StreamP x) (string-to-pathname (=> x file-name)))
+ (t (TypeError x "PathName" "convertible to a pathname"))
+ ))
+
+(de namestring (x)
+ (setf x (pathname x))
+ (let ((dev (pathname-device x))
+ (dir (pathname-directory x))
+ (name (pathname-name x))
+ (type (pathname-type x))
+ (vers (pathname-version x))
+ )
+ (string-concat
+ (if dev (string-concat (pathname-field-to-string dev) ":") "")
+ (if dir (string-concat "<" (pathname-field-to-string dir) ">") "")
+ (if name (pathname-field-to-string name) "")
+ (if (or (not (pathname-empty-field? type))
+ (not (pathname-empty-field? vers)))
+ (string-concat "." (pathname-field-to-string type)) "")
+ (if (not (pathname-empty-field? vers))
+ (string-concat "." (pathname-field-to-string vers)) "")
+ )))
+
+(de file-namestring (x)
+ (setf x (pathname x))
+ (let ((name (pathname-name x))
+ (type (pathname-type x))
+ (vers (pathname-version x))
+ )
+ (string-concat
+ (if name (pathname-field-to-string name) "")
+ (if type (string-concat "." (pathname-field-to-string type)) "")
+ (if vers (string-concat "." (pathname-field-to-string vers)) "")
+ )))
+
+(de directory-namestring (x)
+ (setf x (pathname x))
+ (let ((dir (pathname-directory x))
+ )
+ (if dir (string-concat "<" (pathname-field-to-string dir) ">") "")
+ ))
+
+(de user-homedir-pathname ()
+ (let ((pn (make-instance 'pathname))
+ (user-number (Jsys1 0 0 0 0 (const jsGJINF)))
+ (dir-name (MkString 100 (char space)))
+ )
+ (Jsys1 dir-name user-number 0 0 (const jsDIRST))
+ (setf dir-name (recopystringtonull dir-name))
+ (=> pn set-device "PS")
+ (=> pn set-directory dir-name)
+ pn
+ ))
+
+(de init-file-pathname (program-name)
+ (let ((pn (user-homedir-pathname)))
+ (=> pn set-name program-name)
+ (=> pn set-type "INIT")
+ pn
+ ))
+
+(de merge-pathname-defaults (pn defaults-pn default-type default-version)
+ (setf pn (pathname pn))
+ (setf defaults-pn (pathname defaults-pn))
+ (setf pn (CopyVector pn))
+ (if (not (=> pn host))
+ (=> pn set-host (=> defaults-pn host)))
+ (cond ((not (=> pn device))
+ (=> pn set-device (=> defaults-pn device))
+ (if (not (=> pn directory))
+ (=> pn set-directory (=> defaults-pn directory)))
+ ))
+ (cond ((not (=> pn name))
+ (=> pn set-name (=> defaults-pn name))
+ (if (not (=> pn type)) (=> pn set-type (=> defaults-pn type)))
+ (if (not (=> pn version)) (=> pn set-version (=> defaults-pn version)))
+ ))
+ (if (not (=> pn type))
+ (=> pn set-type default-type))
+ (if (not (=> pn version))
+ (=> pn set-version default-version))
+ pn
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defflavor pathname
+ ((host "LOCAL")
+ (device NIL)
+ (directory NIL)
+ (name NIL)
+ (type NIL)
+ (version NIL)
+ )
+ ()
+ gettable-instance-variables
+ )
+
+(defmethod (pathname set-host) (new-host)
+ (cond ((StringP new-host) (setf host (string-upcase new-host)))
+ ((and (ListP new-host)
+ (not (null new-host))
+ (StringP (car new-host)))
+ (setf host (string-upcase (car new-host))))
+ (t (StdError "Invalid host specified for pathname."))
+ ))
+
+(defmethod (pathname set-device) (new-device)
+ (cond ((StringP new-device) (setf device (string-upcase new-device)))
+ ((null new-device) (setf device NIL))
+ ((and (ListP new-device)
+ (StringP (car new-device)))
+ (setf device (string-upcase (car new-device))))
+ ((and (IdP new-device)
+ (or (eq new-device 'unspecific)
+ (eq new-device 'wild)))
+ (setf device new-device))
+ (t (StdError "Invalid device specified for pathname."))
+ ))
+
+(defmethod (pathname set-directory) (new-directory)
+ (cond ((StringP new-directory) (setf directory (string-upcase new-directory)))
+ ((null new-directory) (setf directory NIL))
+ ((and (ListP new-directory)
+ (StringP (car new-directory)))
+ (setf directory (string-upcase (car new-directory))))
+ ((and (IdP new-directory)
+ (or (eq new-directory 'unspecific)
+ (eq new-directory 'wild)))
+ (setf directory new-directory))
+ (t (StdError "Invalid directory specified for pathname."))
+ ))
+
+(defmethod (pathname set-name) (new-name)
+ (cond ((StringP new-name) (setf name (string-upcase new-name)))
+ ((null new-name) (setf name NIL))
+ ((and (ListP new-name)
+ (StringP (car new-name)))
+ (setf name (string-upcase (car new-name))))
+ ((and (IdP new-name)
+ (or (eq new-name 'unspecific)
+ (eq new-name 'wild)))
+ (setf name new-name))
+ (t (StdError "Invalid name specified for pathname."))
+ ))
+
+(defmethod (pathname set-type) (new-type)
+ (cond ((StringP new-type) (setf type (string-upcase new-type)))
+ ((null new-type) (setf type NIL))
+ ((and (IdP new-type)
+ (or (eq new-type 'unspecific)
+ (eq new-type 'wild)))
+ (setf type new-type))
+ (t (StdError "Invalid type specified for pathname."))
+ ))
+
+(defmethod (pathname set-version) (new-version)
+ (cond ((and (FixP new-version) (>= new-version 0))
+ (setf version new-version))
+ ((null new-version) (setf version NIL))
+ ((and (IdP new-version)
+ (or (eq new-version 'unspecific)
+ (eq new-version 'wild)
+ (eq new-version 'newest)
+ (eq new-version 'oldest)
+ ))
+ (setf version new-version))
+ (t (StdError "Invalid version specified for pathname."))
+ ))
+
+(de string-to-pathname (s)
+ (let ((pn (make-instance 'pathname))
+ (i 0)
+ j
+ ch
+ (len (string-length s))
+ (name-count 0)
+ field
+ )
+ (while (< i len)
+ (setf j (pathname-bite s i))
+ (selectq
+ (string-fetch s (- j 1))
+ (#\: (=> pn set-device (pathname-field-from-string
+ (substring s i (- j 1)))))
+ (#\> (=> pn set-directory (pathname-field-from-string
+ (substring s (+ i 1) (- j 1)))))
+ (#\. (setf name-count (+ name-count 1))
+ (setf field (substring s i (- j 1)))
+ (selectq
+ name-count
+ (1 (=> pn set-name (pathname-field-from-string field))
+ (if (>= j len) (=> pn set-type 'UNSPECIFIC))
+ )
+ (2 (=> pn set-type (pathname-field-from-string field))
+ (if (>= j len) (=> pn set-version 'UNSPECIFIC))
+ )
+ (3 (=> pn set-version (pathname-version-from-string field)))
+ ))
+ (t (setf name-count (+ name-count 1))
+ (setf field (substring s i j))
+ (selectq
+ name-count
+ (1 (=> pn set-name (pathname-field-from-string field)))
+ (2 (=> pn set-type (pathname-field-from-string field)))
+ (3 (=> pn set-version (pathname-version-from-string field)))
+ )))
+ (setf i j)
+ )
+ pn
+ ))
+
+(de pathname-bite (pn i)
+ (let* ((len (string-length pn))
+ (ch (string-fetch pn i))
+ )
+ (cond ((= ch #\<)
+ (setf i (+ i 1))
+ (while (< i len)
+ (setf ch (string-fetch pn i))
+ (setf i (+ i 1))
+ (if (= ch #\>) (exit))
+ )
+ )
+ (t
+ (while (< i len)
+ (setf ch (string-fetch pn i))
+ (setf i (+ i 1))
+ (if (= ch #\:) (exit))
+ (if (= ch #\.) (exit))
+ )))
+ i
+ ))
+
+(de pathname-field-from-string (s)
+ (cond ((StringP s)
+ (cond ((string-empty? s) 'UNSPECIFIC)
+ ((string= s "*") 'WILD)
+ (t s)
+ ))
+ (t s)))
+
+(de pathname-version-from-string (s)
+ (cond ((StringP s)
+ (cond ((string-empty? s) NIL)
+ ((string= s "-2") 'OLDEST)
+ ((string= s "0") 'NEWEST)
+ ((string= s "*") 'WILD)
+ ((string-is-integer s) (string2integer s))
+ (t s)
+ ))
+ (t s)))
+
+(de pathname-empty-field? (x)
+ (string-empty? (pathname-field-to-string x))
+ )
+
+(de pathname-field-to-string (x)
+ (cond ((StringP x) x)
+ ((eq x 'OLDEST) "-2")
+ ((eq x 'NEWEST) "0")
+ ((eq x 'UNSPECIFIC) "")
+ ((eq x 'WILD) "*")
+ ((null x) "")
+ (t (BldMsg "%w" x))))
+
+(de string-is-integer (s)
+ (for (from i 0 (string-upper-bound s))
+ (always (DigitP (string-fetch s i)))
+ ))
ADDED psl-1983/20-util/processor-time.sl
Index: psl-1983/20-util/processor-time.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/processor-time.sl
@@ -0,0 +1,16 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Processor-Time.SL (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 22 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (put 'hptim 'OpenCode '((jsys 8#501) (jfcl))))
+
+(de processor-time ()
+ % Return accumulated processor time for the current process in microseconds.
+ (WTimes2 (hptim 1) 10)
+ )
ADDED psl-1983/20-util/wait.sl
Index: psl-1983/20-util/wait.sl
==================================================================
--- /dev/null
+++ psl-1983/20-util/wait.sl
@@ -0,0 +1,28 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Wait.SL - Wait Primitive (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int))
+(BothTimes (load jsys))
+
+(de wait-timeout (f n-60ths)
+
+ % Return when either of two conditions are met: (1) The function F (of no
+ % arguments) returns non-NIL; (2) The specified elapsed time (in units of
+ % 1/60th second) has elapsed. Don't waste CPU cycles! Return the last
+ % value returned by F (which is always invoked at least once).
+
+ (let (result)
+ (while (and (not (setf result (apply f nil)))
+ (> n-60ths 0))
+ (Jsys0 250 0 0 0 (const jsDISMS))
+ (setf n-60ths (- n-60ths 15))
+ )
+ result
+ ))
ADDED psl-1983/20-util/whereis.red
Index: psl-1983/20-util/whereis.red
==================================================================
--- /dev/null
+++ psl-1983/20-util/whereis.red
@@ -0,0 +1,33 @@
+% Scan the *.ins files
+% for a special Token
+Loadtime Load DIR!-STUFF$
+
+InsList!*:=Vector2List GetCleanDir "<psl.util.ins>*.ins"$
+
+Procedure ShowAllIns();
+Begin scalar R,C,OldC;
+ For each F in InsList!* do
+ <<C:=OPEN(F,'input);
+ OldC:=RDS C; R:=READ(); RDS OldC;
+ Close C;
+ Print F;
+ Print R>>;
+End;
+
+Procedure LoadAllIns();
+Begin scalar R,C,OldC;
+ For each F in InsList!* do
+ <<C:=OPEN(F,'input);
+ OldC:=RDS C; R:=READ(); RDS OldC;
+ Close C;
+ For Each x in R do Put(x,'DefinedIn,F);
+ PrintF(" %r loaded %n",F)>>
+End;
+
+Procedure WhereIs X;
+ Begin scalar y;
+ if(y:=get(x,'DefinedIn)) then Return y;
+ if getd x then return "In The Kernel ";
+ return NIL;
+ end;
+
ADDED psl-1983/3-1/clsc-20/common.sl
Index: psl-1983/3-1/clsc-20/common.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/common.sl
@@ -0,0 +1,460 @@
+%
+% COMMON.SL - Compile- and read-time support for Common Lisp compatibility.
+% In a few cases, actually LISP Machine Lisp compatibility?
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 31 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Edit by Cris Perdue, 7 Mar 1983 1335-PST
+% Left-expand is now available outside this module. (No longer flagged
+% as internalfunction.)
+% Edit by Cris Perdue, 4 Feb 1983 1047-PST
+% Removed ERRSET (redundant and not COMMON Lisp) and MOD (incorrect).
+% <PSL.UTIL.NEWVERSIONS>COMMON.SL.2, 13-Dec-82 21:30:58, Edit by GALWAY
+% Fixed bugs in copylist and copyalist that copied the first element
+% twice. Also fixed bug in copyalist where it failed to copy first pair
+% in the list.
+% Also started commenting the functions defined here.
+
+% These are only the Common Lisp definitions that do not conflict with
+% Standard Lisp or other PSL functions. Currently growing on a daily basis
+
+(imports '(useful fast-vector))
+
+(compiletime
+(defmacro cl-alias (sl-name cl-name)
+ `(defmacro ,cl-name form
+ `(,',sl-name . ,form)))
+
+(flag '(expand-funcall* butlast-aux nbutlast-aux
+ left-expand-aux) 'internalfunction)
+
+)
+
+(cl-alias de defun)
+
+(defmacro defvar (name . other)
+ (if *defn (fluid (list name)))
+ (if (atom other)
+ `(fluid `(,',name))
+ `(progn (fluid `(,',name))
+ (setq ,name ,(car other)))))
+
+(cl-alias idp symbolp)
+
+(cl-alias pairp consp)
+
+(defun listp (x) (or (null x) (consp x)))
+
+(put 'listp 'cmacro '(lambda (x) ((lambda (y) (or (null y) (consp y))) x)))
+
+(cl-alias fixp integerp)
+
+(cl-alias fixp characterp)
+
+(put 'characterp 'cmacro '(lambda (x) (posintp x)))
+
+(cl-alias vectorp arrayp)
+
+(cl-alias codep subrp)
+
+(defun functionp (x)
+ (or (symbolp x) (codep x) (and (consp x) (eq (car x) 'lambda))))
+
+(cl-alias eqn eql)
+
+(cl-alias equal equalp)
+
+(cl-alias valuecell symeval)
+
+(defmacro fsymeval (symbol)
+ `((lambda (***fsymeval***)
+ (or (cdr (getd ***fsymeval***))
+ (stderror (bldmsg "%r has no function definition"
+ ***fsymeval***))))
+ ,symbol))
+
+(defmacro boundp (name)
+ `(not (unboundp ,name)))
+
+(defmacro fboundp (name)
+ `(not (funboundp ,name)))
+
+(defmacro macro-p (x)
+ `(let ((y (getd ,x)))
+ (if (and (consp y) (equal (car y) 'macro)) (cdr y) nil)))
+
+(defmacro special-form-p (x)
+ `(let ((y (getd ,x)))
+ (if (and (consp y) (equal (car y) 'fexpr)) (cdr y) nil)))
+
+(defmacro fset (symbol value)
+ `(putd ,symbol 'expr ,value))
+
+(defmacro makunbound (x)
+ `(let ((y ,x) (makunbound y) y)))
+
+(defmacro fmakunbound (x)
+ `(let ((y ,x) (remd y) y)))
+
+(defmacro funcall* (fn . args)
+ `(apply ,fn ,(expand-funcall* args)))
+
+(defun expand-funcall* (args)
+ (if (null (cdr args))
+ (car args)
+ `(cons ,(car args) ,(expand-funcall* (cdr args)))))
+
+(cl-alias funcall* lexpr-funcall)
+
+% only works when calls are compiled right now
+% need to make a separate special form and compiler macro prop.
+(defmacro progv (symbols values . body)
+ `(let ((***bindmark*** (captureenvironment)))
+ (do ((symbols ,symbols (cdr symbols))
+ (values ,values (cdr values)))
+ ((null symbols) nil)
+ (lbind1 (car symbols) (car values)))
+ (prog1 (progn ,@body)
+ (restoreenvironment ***bindmark***))))
+
+(defmacro dolist (bindspec . progbody)
+ `(prog (***do-list*** ,(first bindspec))
+ (setq ***do-list*** ,(second bindspec))
+$loop$
+ (if (null ***do-list***)
+ (return ,(if (not (null (cddr bindspec)))
+ (third bindspec)
+ ())))
+ (setq ,(first bindspec) (car ***do-list***))
+ ,@progbody
+ (setq ***do-list*** (cdr ***do-list***))
+ (go $loop$)))
+
+(defmacro dotimes (bindspec . progbody)
+ `(prog (***do-times*** ,(first bindspec))
+ (setq ,(first bindspec) 0)
+ (setq ***do-times*** ,(second bindspec))
+$loop$
+ (if (= ,(first bindspec) ***do-times***)
+ (return ,(if (not (null (cddr bindspec)))
+ (third bindspec)
+ ())))
+ (setq ,(first bindspec) (+ ,(first bindspec) 1))
+ ,@progbody
+ (go $loop$)))
+
+(cl-alias map mapl)
+
+% neither PROG or PROG* supports initialization yet
+(cl-alias prog prog*)
+
+(cl-alias dm macro)
+
+% DECLARE, LOCALLY ignored now
+(defmacro declare forms
+ ())
+
+(defmacro locally forms
+ `(let () ,forms))
+
+% version of THE which does nothing
+(defmacro the (type form)
+ form)
+
+(cl-alias get getpr)
+
+(cl-alias put putpr)
+
+(cl-alias remprop rempr)
+
+(cl-alias prop plist)
+
+(cl-alias id2string get-pname)
+
+(defun samepnamep (x y)
+ (equal (get-pname x) (get-pname y)))
+
+(cl-alias newid make-symbol)
+
+(cl-alias internp internedp)
+
+(defun plusp (x)
+ (and (not (minusp x)) (not (zerop x))))
+
+(defun oddp (x)
+ (and (integerp x) (equal (remainder x 2) 1)))
+
+(defun evenp (x)
+ (and (integerp x) (equal (remainder x 2) 0)))
+
+(cl-alias eqn =)
+
+(cl-alias lessp <)
+
+(cl-alias greaterp >)
+
+(cl-alias leq <=)
+
+(cl-alias geq >=)
+
+(cl-alias neq /=)
+
+(cl-alias plus +)
+
+(defmacro - args
+ (cond ((null (cdr args))
+ `(minus ,@args))
+ ((null (cddr args))
+ `(difference ,@args))
+ (t (left-expand args 'difference))))
+
+(cl-alias times *)
+
+(defmacro / args
+ (cond ((null (cdr args))
+ `(recip ,(car args)))
+ ((null (cddr args))
+ `(quotient ,@args))
+ (t (left-expand args 'quotient))))
+
+(defun left-expand (arglist op)
+ (left-expand-aux `(,op ,(first arglist) ,(second arglist))
+ (rest (rest arglist))
+ op))
+
+(defun left-expand-aux (newform arglist op)
+ (if (null arglist) newform
+ (left-expand-aux `(,op ,newform ,(first arglist))
+ (rest arglist)
+ op)))
+
+(cl-alias add1 !1+)
+
+(cl-alias sub1 !1-)
+
+(cl-alias incr incf)
+
+(cl-alias decr decf)
+
+(defmacro logior args
+ (robustexpand args 'lor 0))
+
+(defmacro logxor args
+ (robustexpand args 'lxor 0))
+
+(defmacro logand args
+ (robustexpand args 'land -1))
+
+(cl-alias lnot lognot)
+
+(cl-alias lshift ash)
+
+(put 'ldb 'assign-op 'dpb) % Not defined, but used in NSTRUCT
+
+(put 'rplachar 'cmacro '(lambda (s i x) (iputs s i x)))
+
+(put 'char-int 'cmacro '(lambda (x) x))
+
+(put 'int-char 'cmacro '(lambda (x) x))
+
+(put 'char= 'cmacro '(lambda (x y) (eq x y)))
+
+(put 'char< 'cmacro '(lambda (x y) (ilessp x y)))
+
+(put 'char> 'cmacro '(lambda (x y) (igreaterp x y)))
+
+(cl-alias indx elt)
+
+(cl-alias setindx setelt)
+
+(defun copyseq (seq)
+ (subseq seq 0 (+ (size seq) 1)))
+
+(defun endp (x)
+ (cond ((consp x) ())
+ ((null x) t)
+ (t (stderror (bldmsg "%r is not null at end of list" x)))))
+
+(cl-alias length list-length)
+
+(cl-alias reversip nreverse)
+
+(cl-alias getv vref)
+
+(cl-alias putv vset)
+
+(put 'string= 'cmacro '(lambda (x y) (eqstr x y)))
+
+(put 'string-length 'cmacro '(lambda (x) (iadd1 (isizes x))))
+
+(put 'string-to-list 'cmacro '(lambda (x) (string2list x)))
+
+(put 'list-to-string 'cmacro '(lambda (x) (list2string x)))
+
+(put 'string-to-vector 'cmacro '(lambda (x) (string2vector x)))
+
+(put 'vector-to-string 'cmacro '(lambda (x) (vector2string x)))
+
+(put 'substring
+ 'cmacro
+ '(lambda (s low high) (sub s low (idifference high (iadd1 low)))))
+
+(defun nthcdr (n l)
+ (do ((n n (isub1 n))
+ (l l (cdr l)))
+ ((izerop n) l)))
+
+(cl-alias copy copytree)
+
+(cl-alias pair pairlis)
+
+(put 'make-string 'cmacro '(lambda (i c) (mkstring (isub1 i) c)))
+
+(defmacro putprop (symbol value indicator)
+ `(put ,symbol ,indicator ,value))
+
+(defmacro defprop (symbol value indicator)
+ `(putprop `,',symbol `,',value `,',indicator))
+
+(defmacro eval-when (time . forms)
+ (if *defn
+ (progn (when (memq 'compile time) (evprogn forms))
+ (when (memq 'load time) `(progn ,@forms)))
+ (when (memq 'eval time) `(progn ,@forms))))
+
+% This name is already used by PSL /csp
+% (defmacro case tail
+% (cons 'selectq tail)
+
+% Selectq is actually a LISP Machine LISP name /csp
+(defmacro selectq (on . s-forms)
+ (if (atom on)
+ `(cond ,@(expand-select s-forms on))
+ `((lambda (***selectq-arg***)
+ (cond ,@(expand-select s-forms '***selectq-arg***)))
+ ,on)))
+
+(defun expand-select (s-forms formal)
+ (cond ((null s-forms) ())
+ (t `((,(let ((selector (first (first s-forms))))
+ (cond ((consp selector)
+ `(memq ,formal `,',selector))
+ ((memq selector '(otherwise t))
+ t)
+ (t `(eq ,formal `,',selector))))
+ ,@(rest (first s-forms)))
+ ,@(expand-select (rest s-forms) formal)))))
+
+(defmacro comment form
+ ())
+
+(defmacro special args
+ `(fluid `,',args))
+
+(defmacro unspecial args
+ `(unfluid `,',args))
+
+(cl-alias atsoc assq)
+
+(cl-alias lastpair last)
+
+(cl-alias flatsize2 flatc)
+
+(cl-alias explode2 explodec)
+
+% swapf, exchf ...?
+
+
+(defun nthcdr (n l)
+ (do ((n n (isub1 n))
+ (l l (cdr l)))
+ ((izerop n) l)))
+
+
+(defun tree-equal (x y)
+ (if (atom x)
+ (eql x y)
+ (and (tree-equal (car x) (car y))
+ (tree-equal (cdr x) (cdr y)))))
+
+% Return a "top level copy" of a list.
+(defun copylist (x)
+ (if (atom x)
+ x
+ (let* ((x1 (cons (car x) ()))
+ (x (cdr x)))
+ (do ((x2 x1 (cdr x2)))
+ ((atom x) (rplacd x2 x) x1)
+ (rplacd x2 (cons (car x) ()))
+ (setq x (cdr x))))))
+
+% Return a copy of an a-list (copy down to the pairs but no deeper).
+(defun copyalist (x)
+ (if (atom x)
+ x
+ (let* ((x1 (cons (cons (caar x) (cdar x)) ()))
+ (x (cdr x)))
+ (do ((x2 x1 (cdr x2)))
+ ((atom x) (rplacd x2 x) x1)
+ (rplacd x2 (cons (cons (caar x) (cdar x)) ()))
+ (setq x (cdr x))))))
+
+(defun revappend (x y)
+ (if (atom x) y
+ (revappend (cdr x) (cons (car x) y))))
+
+(defun nreconc (x y)
+ (if (atom x) y
+ (let ((z (cdr x)))
+ (rplacd x y)
+ (nreconc z x))))
+
+(defun butlast (x)
+ (if (or (atom x) (atom (cdr x))) x
+ (butlast-aux x ())))
+
+(defun butlast-aux (x y)
+ (let ((z (cons (car x) y)))
+ (if (atom (cddr x)) z
+ (butlast-aux (cdr x) z))))
+
+(defun nbutlast (x)
+ (if (or (atom x) (atom (cdr x)))
+ x
+ (do ((y x (cdr y)))
+ ((atom (cddr y)) (rplacd y ())))
+ x))
+
+(defun buttail (list sublist)
+ (if (atom list)
+ list
+ (let ((list1 (cons (car list) ())))
+ (setq list (cdr list))
+ (do ((list2 list1 (cdr list2)))
+ ((or (atom list) (eq list sublist)) list1)
+ (rplacd list2 (cons (car list) ()))
+ (setq list (cdr list))))))
+
+(cl-alias substip nsubst)
+
+(defmacro ouch (char . maybe-channel)
+ (if maybe-channel
+ `(channelwritechar ,(car maybe-channel) ,char)
+ `(writechar ,char)))
+
+(defmacro inch maybe-channel
+ (if maybe-channel
+ `(channelreadchar ,(car maybe-channel))
+ `(readchar)))
+
+(defmacro uninch (char . maybe-channel)
+ (if maybe-channel
+ `(channelunreadchar ,(car maybe-channel) ,char)
+ `(unreadchar ,char)))
+
ADDED psl-1983/3-1/clsc-20/extended-input.b
Index: psl-1983/3-1/clsc-20/extended-input.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/extended-input.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/extended-input.sl
Index: psl-1983/3-1/clsc-20/extended-input.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/extended-input.sl
@@ -0,0 +1,104 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Extended-Input.SL - 9-bit terminal input (for 7 or 8 bit terminals)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 31 August 1982
+% Revised: 11 April 1983
+%
+% 11-Apr-83 Alan Snyder
+% Change "obsolete" #\BS to #\BackSpace.
+% 17-Feb-83 Alan Snyder
+% Added PUSH-BACK-INPUT-CHARACTER function. Revise mapping so that
+% bit prefix characters are recognized after mapping.
+% 22-Dec-82 Jeffrey Soreff
+% Added PUSH-BACK-EXTENDED-CHARACTER function.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load extended-char fast-int fast-vectors))
+
+% Global variables:
+
+(fluid '(nmode-meta-bit-prefix-character
+ nmode-control-bit-prefix-character
+ nmode-control-meta-bit-prefix-character))
+
+(setf nmode-meta-bit-prefix-character (x-char C-!\))
+(setf nmode-control-bit-prefix-character (x-char C-^))
+(setf nmode-control-meta-bit-prefix-character (x-char C-Z))
+
+% Internal static variables:
+
+(fluid '(nmode-terminal-map nmode-lookahead-extended-char nmode-lookahead-char))
+(setf nmode-lookahead-extended-char nil)
+(setf nmode-lookahead-char nil)
+
+(de nmode-initialize-extended-input ()
+ (setf nmode-terminal-map (MkVect 255))
+
+ % Most input characters map to themselves.
+ (for (from i 0 255)
+ (do (vector-store nmode-terminal-map i i)))
+
+ % Some ASCII control character map to Extended Control characters.
+ % Exceptions: BACKSPACE, TAB, RETURN, LINEFEED, ESCAPE
+ (for (from i 0 31)
+ (unless (member i '#.(list #\BackSpace #\Tab #\CR #\LF #\ESC)))
+ (do (let ((mch (X-Set-Control (+ i 64))))
+ (vector-store nmode-terminal-map i mch)
+ (vector-store nmode-terminal-map (+ i 128) (+ mch 128))
+ )))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de input-extended-character ()
+ (if nmode-lookahead-extended-char
+ (prog1 nmode-lookahead-extended-char
+ (setf nmode-lookahead-extended-char nil))
+ (input-direct-extended-character)))
+
+(de push-back-extended-character (ch)
+ (setf nmode-lookahead-extended-char ch))
+
+(de input-direct-extended-character ()
+ % Read an extended character from the terminal.
+ % Recognize and interpret bit-prefix characters.
+
+ (let* ((ch (input-terminal-character)))
+ (cond
+ ((= ch nmode-meta-bit-prefix-character)
+ (nmode-append-separated-prompt "M-")
+ (setf ch (input-terminal-character))
+ (nmode-complete-prompt (x-char-name (x-unmeta ch)))
+ (x-set-meta ch)
+ )
+ ((= ch nmode-control-bit-prefix-character)
+ (nmode-append-separated-prompt "C-")
+ (setf ch (input-terminal-character))
+ (nmode-complete-prompt (x-char-name (x-uncontrol ch)))
+ (x-set-control ch)
+ )
+ ((= ch nmode-control-meta-bit-prefix-character)
+ (nmode-append-separated-prompt "C-M-")
+ (setf ch (input-terminal-character))
+ (nmode-complete-prompt (x-char-name (x-base ch)))
+ (x-set-meta (x-set-control ch))
+ )
+ (t ch)
+ )))
+
+(de push-back-input-character (ch)
+ (setf nmode-lookahead-char ch)
+ )
+
+(de input-terminal-character ()
+ % Read an extended character from the terminal. Perform mapping from 8-bit
+ % to 9-bit characters. Do not interpret bit prefix characters.
+
+ (if nmode-lookahead-char
+ (prog1 nmode-lookahead-char (setf nmode-lookahead-char nil))
+ (vector-fetch nmode-terminal-map (input-direct-terminal-character))
+ ))
ADDED psl-1983/3-1/clsc-20/hazeltine-1500.b
Index: psl-1983/3-1/clsc-20/hazeltine-1500.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/hazeltine-1500.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/hazeltine-1500.sl
Index: psl-1983/3-1/clsc-20/hazeltine-1500.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/hazeltine-1500.sl
@@ -0,0 +1,304 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% HAZELTINE-1500.SL - Terminal Interface
+%
+% Author: Lon Willett
+% Date: 6-Jul-83
+%
+% Based on TELERAY.SL by:
+% Author: G.Q. Maguire Jr., U of Utah
+% Date: 3 Nov 1982
+% based on VT52X.SL by Alan Snyder
+% Hewlett-Packard/CRC
+% 6 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+(BothTimes (load jsys))
+(compiletime
+ (progn
+ (defconst !.MORLW 8#30 % read page width
+ !.MORLL 8#32 % read page length
+ !.PRIOU 8#101) % primary output jfn, it had better be a TTY
+ (ds get-system-page-height ()
+ (jsys3 (const !.priou) (const !.morll) 0 0 (const jsMTOPR)) )
+ (ds get-system-line-length ()
+ (jsys3 (const !.priou) (const !.morlw) 0 0 (const jsMTOPR)) )
+ ))
+
+(BothTimes (Put 'TILDE 'CHARCONST 126))
+
+% This hack redefines !\= as a macro to be replaced by
+% (INTERN (STRING #\TILDE #\=)). This file shouldn't contain any TILDE's
+(CompileTime (DM !\= (u) `(#.(INTERN (STRING #\TILDE #/=)) . ,(CDR u)) ))
+
+(defflavor hazeltine-1500 (
+
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (auto-wrap 'MAYBE) % does a CRLF when output to last column: YES NO MAYBE
+ (auto-scroll 'YES) % scrolls when output (MAXROW,MAXCOL): YES NO MAYBE
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width auto-wrap auto-scroll
+ maxrow maxcol raw-mode)
+ (initable-instance-variables height width auto-wrap auto-scroll)
+ )
+
+(defmethod (hazeltine-1500 init) (initlis)
+ % Pick up the page length & width from the monitor if it is not
+ % specified by an initialization argument. Use default if we don't like
+ % what the monitor claims.
+ % HEIGHT & MAXROW:
+ (unless (memq 'HEIGHT initlis) (setf height (get-system-page-height)))
+ (when (or (< height 10) (> height 96)) (setf height 24))
+ (setf maxrow (- height 1))
+ % WIDTH & MAXCOL:
+ (unless (memq 'WIDTH initlis) (setf width (get-system-line-length)))
+ (when (or (< width 10) (> width 96)) (setf width 80))
+ (setf maxcol (- width 1))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (deflambda out-move (xxxrow xxxcol)
+ (out-chars TILDE (CONTROL Q))
+ (PBOUT (IF (>= xxxcol 31) xxxcol (+ xxxcol 8#140)))
+ (PBOUT (+ xxxrow 32)) ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (hazeltine-1500 get-character) ()
+ (& (PBIN) 8#177)
+ )
+
+(defmethod (hazeltine-1500 ring-bell) ()
+ (out-char BELL)
+)
+
+(defmethod (hazeltine-1500 move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (let ((relative-move-number-of-chars
+ (+ %calculate the number of chars for a horizontal move
+ (cond ((= column cursor-column) 0) % no horizontal move required
+ ((= column 0) 1) % using a CR
+ ((< column cursor-column)
+ (- cursor-column column)) % move left takes 1 char
+ (T (- column cursor-column)) ) % move right takes 1 char
+ % and add in the number of chars for a vertical move
+ (cond ((= row cursor-row) 0) % no vertical move required
+ ((< row cursor-row)
+ (* 2 (- cursor-row row))) % move up takes 2 chars
+ (T (- row cursor-row)) )))) % move down takes 1 char
+ (cond ((= relative-move-number-of-chars 0) ) % no move required
+ ((and (= row 0) (= column 0)
+ (<= 2 relative-move-number-of-chars))
+ (out-chars TILDE (CONTROL R)) ) % cursor home
+ ((<= 4 relative-move-number-of-chars)
+ (out-move row column)) % move absolute
+ (T %Move relative to the current point
+ (cond
+ ((= column cursor-column) ) % no horizontal move needed
+ ((= column 0) (out-char CR)) % move to leftmost column
+ ((< column cursor-column)
+ (FOR (FROM junk cursor-column (+ column 1) -1)
+ (DO (out-char BACKSPACE)) )) % move left
+ (T
+ (FOR (FROM junk cursor-column (- column 1) 1)
+ (DO (out-char (CONTROL P))) ))) % move right
+ (cond ((< row cursor-row)
+ (FOR (FROM junk cursor-row (+ row 1) -1)
+ (DO (out-chars TILDE FF)) )) % move up
+ ((> row cursor-row)
+ (FOR (FROM junk cursor-row (- row 1) 1)
+ (DO (out-char LF)) ))) % move down
+ )) )
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (hazeltine-1500 enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (hazeltine-1500 leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (hazeltine-1500 erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars TILDE (CONTROL R) TILDE (CONTROL X))
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (hazeltine-1500 clear-line) ()
+ (out-chars TILDE (CONTROL O))
+ )
+
+(defmethod (hazeltine-1500 convert-character) (ch)
+ (setf ch (& ch (display-character-cons
+ % no enhancements
+ (dc-make-enhancement-mask
+ % INVERSE-VIDEO BLINK UNDERLINE INTENSIFY
+ )
+ % only font number 0
+ (dc-make-font-mask 0)
+ % only 7 bits in a character
+ 16#7F)))
+ (let ((code (dc-character-code ch)))
+ % replace non-printable chars with a space
+ (when (or (< code 8#40) (>= code 8#176)) (setf ch terminal-blank)) )
+ ch)
+
+(defmethod (hazeltine-1500 normal-enhancement) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (hazeltine-1500 highlighted-enhancement) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (hazeltine-1500 supported-enhancements) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (hazeltine-1500 update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % this check prevents unchecked index of -1, and also keeps
+ % us from moving the cursor when the line doesn't need to be updated
+ (when (<= first-col last-col)
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank ) )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (!\= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (when (!\= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement) )
+ (=> self move-cursor row col)
+ (=> self &print-char new-code)
+ (vector-store old-line col new)
+ )) )))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self move-cursor row (+ last-nonblank-column 1))
+ (=> self clear-line)
+ )
+ )))
+
+
+% The following methods are provided for INTERNAL use only!
+
+% This method outputs a printable character
+% (should we check that the character is printable?)
+(defmethod (hazeltine-1500 &print-char) (ch)
+ (cond ((< cursor-column maxcol) % normal case
+ (PBOUT ch)
+ (setf cursor-column (+ cursor-column 1)))
+
+ ((< cursor-row maxrow) % last character on a line, but not last line
+ % This horrendous hack assures that we have auto-wrap
+ (PBOUT ch)
+ (setf cursor-row (+ cursor-row 1))
+ (setf cursor-column 0)
+ (cond ((eq auto-wrap 'NO) (out-chars CR LF))
+ ((eq auto-wrap 'MAYBE) (out-move cursor-row 0))
+% ((eq auto-wrap 'YES) )
+ ))
+ (T % Bottom right corner
+ % Prevent scrolling (put blank there if we can't print). Move to (0,0).
+ (IF (or (eq auto-scroll 'YES) (eq auto-scroll 'MAYBE))
+ % THEN
+ (=> self clear-line)
+ % ELSE (eq auto-scroll 'NO) so
+ (PBOUT ch))
+ (=> self move-cursor 0 0) )
+ ))
+
+(defmethod (hazeltine-1500 &set-terminal-enhancement) (enh)
+% no enhancements supported
+ (setf terminal-enhancement 0)
+)
ADDED psl-1983/3-1/clsc-20/make-nmode.ctl
Index: psl-1983/3-1/clsc-20/make-nmode.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/make-nmode.ctl
@@ -0,0 +1,15 @@
+; This file creates a new S:EX-NMODE.EXE, replacing the old one.
+; NOTE: the compiler is also loaded, as most users will need it.
+@delete s:nmode.exe,
+@exp
+@
+@s:bare-psl random-argument-to-get-a-new-fork
+*(load nmode)
+*(load compiler)
+*(nmode-initialize)
+*(setf nmode-auto-start T)
+*(setf prinlevel 2)
+*(savesystem "Extended 20-PSL 3.1 NMODE" "S:NMODE.EXE" ())
+*(quit)
+@reset .
+
ADDED psl-1983/3-1/clsc-20/make-nmode.mic
Index: psl-1983/3-1/clsc-20/make-nmode.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/make-nmode.mic
@@ -0,0 +1,15 @@
+! 29-Jun-83 Lon Willett
+! Modified MAKE-NMODE.CTL to get this file. Just commented out
+! the PRINLEVEL change.
+!
+! This file creates a new S:NMODE.EXE, replacing the old one.
+! NOTE: the compiler is also loaded, as most users will need it.
+@s:bare-psl random-argument-to-get-a-new-fork
+*(load nmode)
+*(load compiler)
+*(nmode-initialize)
+*(setf nmode-auto-start T)
+!(setf prinlevel 2)
+*(savesystem "Extended 20-PSL 3.1 NMODE" "S:NMODE.EXE" ())
+*(quit)
+@reset .
ADDED psl-1983/3-1/clsc-20/mode-defs.b
Index: psl-1983/3-1/clsc-20/mode-defs.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/mode-defs.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/mode-defs.sl
Index: psl-1983/3-1/clsc-20/mode-defs.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/mode-defs.sl
@@ -0,0 +1,515 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% MODE-DEFS.SL - NMODE Command Table and Mode Definitions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 14 September 1982
+% Revised: 15 March 1983
+%
+% 15-Mar-83 Alan Snyder
+% Add M-X List Browsers, M-X Print Buffer, C-X C-P. Define modes at load
+% time. Rename write-screen-photo-command to write-screen-command; change to
+% M-X Write Screen (instead of C-X P).
+% 18-Feb-83 Alan Snyder
+% Rename down-list and insert-parens. Add M-) command.
+% 9-Feb-83 Alan Snyder
+% Add Esc-_ (Help), temporarily attached to M-X Apropos.
+% Move some M-X commands into text-command-list.
+% 2-Feb-83 Alan Snyder
+% Add Lisp-D.
+% 26-Jan-83 Alan Snyder
+% Add Esc-/.
+% 25-Jan-83 Alan Snyder
+% Created Window-Command-List to allow scrolling in Recurse mode.
+% Removed modifying text commands from Recurse mode.
+% 24-Jan-83 Jeffrey Soreff
+% Added definition of Recurse-Mode
+% Defined M-X commands: Delete Matching Lines, Flush Lines,
+% Delete Non-Matching Lines, Keep Lines, How Many, Count Occurrences,
+% Set Key, Set Visited Filename, Rename Buffer, Kill Some Buffers,
+% Insert Date, Revert File
+% 5-Jan-83 Alan Snyder
+% Revised definition of input mode, C-S, and C-R.
+% 3-Dec-82 Alan Snyder
+% New definitions for ) and ] in Lisp mode.
+% New definitions for C-M-(, C-M-), C-M-U, C-M-N, and C-M-P.
+% New definitions for C-M-A, C-M-[, and C-M-R.
+% Define C-M-\ (Indent Region) in Lisp mode and Text mode.
+% Define C-? same as M-?, C-( same as C-M-(, C-) same as C-M-).
+% Lisp Mode establishes Lisp Parser.
+% Define C-M-C.
+% Define the text commands: C-=, C-X =, M-A, M-E, M-K, C-X Rubout, M-Z, M-Q,
+% M-G, M-H, M-], M-[, M-S.
+% Fix definitions of digits and hyphen: inserting definition goes on
+% text-command-list (where insertion commands go).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% (CompileTime (load objects))
+(CompileTime (load extended-char))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-default-mode
+ nmode-current-buffer
+ nmode-input-special-command-list
+ ))
+
+% Mode definitions:
+
+(fluid '(Lisp-Interface-Mode
+ Text-Mode
+ Basic-Mode
+ Read-Only-Text-Mode
+ Input-Mode
+ Recurse-Mode
+ ))
+
+% Command lists:
+
+(fluid '(Input-Command-List
+ Read-Only-Text-Command-List
+ Text-Command-List
+ Rlisp-Command-List
+ Lisp-Command-List
+ Read-Only-Terminal-Command-List
+ Modifying-Terminal-Command-List
+ Window-Command-List
+ Basic-Command-List
+ Essential-Command-List
+ Recurse-Command-List
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Mode Definitions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(setf Basic-Mode
+ (nmode-define-mode
+ "Basic"
+ '((nmode-define-commands Basic-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Window-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ )))
+
+(setf Read-Only-Text-Mode
+ (nmode-define-mode
+ "Read-Only-Text"
+ '((nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-establish-mode Basic-Mode)
+ )))
+
+(setf Text-Mode
+ (nmode-define-mode
+ "Text"
+ '((nmode-define-commands Text-Command-List)
+ (nmode-define-commands Modifying-Terminal-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ (nmode-define-normal-self-inserts)
+ )))
+
+(setf Lisp-Interface-Mode
+ (nmode-define-mode
+ "Lisp"
+ '((nmode-define-commands Rlisp-Command-List)
+ (establish-lisp-parser)
+ (nmode-define-commands Lisp-Command-List)
+ (nmode-establish-mode Text-Mode)
+ )))
+
+(setf Input-Mode
+ (nmode-define-mode
+ "Input"
+ '((nmode-define-commands nmode-input-special-command-list)
+ (nmode-define-command (x-char CR) 'nmode-terminate-input)
+ (nmode-define-command (x-char LF) 'nmode-terminate-input)
+ (nmode-define-commands Input-Command-List)
+ (nmode-define-commands Text-Command-List)
+ (nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ (nmode-define-normal-self-inserts)
+ )))
+
+(setf Recurse-Mode
+ (nmode-define-mode
+ "Recurse"
+ '((nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Window-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ (nmode-define-commands Recurse-Command-List)
+ )))
+
+(setf nmode-default-mode Text-Mode)
+
+(de nmode-initialize-modes ()
+ % Define initial set of file modes.
+ (nmode-declare-file-mode "txt" Text-Mode)
+ (nmode-declare-file-mode "red" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "sl" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "lsp" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "lap" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "build" Lisp-Interface-Mode)
+ )
+
+(de lisp-mode-command ()
+ (buffer-set-mode nmode-current-buffer Lisp-Interface-Mode)
+ )
+
+(de text-mode-command ()
+ (buffer-set-mode nmode-current-buffer Text-Mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Command Lists:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Rlisp-Command-List - commands related to the LISP interface
+
+(setf Rlisp-Command-List
+ (list
+ (cons (x-char C-!]) 'Lisp-prefix)
+ (cons (x-chars C-!] !?) 'lisp-help-command)
+ (cons (x-chars C-!] A) 'lisp-abort-command)
+ (cons (x-chars C-!] B) 'lisp-backtrace-command)
+ (cons (x-chars C-!] C) 'lisp-continue-command)
+ (cons (x-chars C-!] D) 'execute-defun-command)
+ (cons (x-chars C-!] E) 'execute-form-command)
+ (cons (x-chars C-!] L) 'exit-nmode)
+ (cons (x-chars C-!] Q) 'lisp-quit-command)
+ (cons (x-chars C-!] R) 'lisp-retry-command)
+ (cons (x-chars C-!] Y) 'yank-last-output-command)
+ ))
+
+% Lisp-Command-List - commands related to editing LISP text
+
+(setf Lisp-Command-List
+ (list
+ (cons (x-char !)) 'insert-closing-bracket)
+ (cons (x-char !]) 'insert-closing-bracket)
+ (cons (x-char C-!() 'backward-up-list-command)
+ (cons (x-char C-!)) 'forward-up-list-command)
+ (cons (x-char C-M-!() 'backward-up-list-command)
+ (cons (x-char C-M-!)) 'forward-up-list-command)
+ (cons (x-char C-M-![) 'move-backward-defun-command)
+ (cons (x-char C-M-!]) 'end-of-defun-command)
+ (cons (x-char C-M-!\) 'lisp-indent-region-command)
+ (cons (x-char C-M-@) 'mark-form-command)
+ (cons (x-char C-M-A) 'move-backward-defun-command)
+ (cons (x-char C-M-B) 'move-backward-form-command)
+ (cons (x-char C-M-BACKSPACE) 'mark-defun-command)
+ (cons (x-char C-M-D) 'down-list-command)
+ (cons (x-char C-M-E) 'end-of-defun-command)
+ (cons (x-char C-M-F) 'move-forward-form-command)
+ (cons (x-char C-M-H) 'mark-defun-command)
+ (cons (x-char C-M-I) 'lisp-tab-command)
+ (cons (x-char C-M-K) 'kill-forward-form-command)
+ (cons (x-char C-M-N) 'move-forward-list-command)
+ (cons (x-char C-M-P) 'move-backward-list-command)
+ (cons (x-char C-M-Q) 'lisp-indent-sexpr)
+ (cons (x-char C-M-R) 'reposition-window-command)
+ (cons (x-char C-M-RUBOUT) 'kill-backward-form-command)
+ (cons (x-char C-M-T) 'transpose-forms)
+ (cons (x-char C-M-TAB) 'lisp-tab-command)
+ (cons (x-char C-M-U) 'backward-up-list-command)
+ (cons (x-char M-!;) 'insert-comment-command)
+ (cons (x-char M-BACKSPACE) 'mark-defun-command)
+ (cons (x-char M-!() 'make-parens-command)
+ (cons (x-char M-!)) 'move-over-paren-command)
+ (cons (x-char RUBOUT) 'delete-backward-hacking-tabs-command)
+ (cons (x-char TAB) 'lisp-tab-command)
+ ))
+
+% Essential-Command-List: the most essential commands
+
+(setf Essential-Command-List
+ (list
+ (cons (x-char C-X) 'c-x-prefix)
+ (cons (x-char ESC) 'Esc-prefix)
+ (cons (x-char M-X) 'm-x-prefix)
+ (cons (x-char C-M-X) 'm-x-prefix)
+ (cons (x-char C-G) 'nmode-abort-command)
+ (cons (x-char C-L) 'nmode-refresh-command)
+ (cons (x-char C-U) 'universal-argument)
+ (cons (x-char 0) 'argument-digit)
+ (cons (x-char 1) 'argument-digit)
+ (cons (x-char 2) 'argument-digit)
+ (cons (x-char 3) 'argument-digit)
+ (cons (x-char 4) 'argument-digit)
+ (cons (x-char 5) 'argument-digit)
+ (cons (x-char 6) 'argument-digit)
+ (cons (x-char 7) 'argument-digit)
+ (cons (x-char 8) 'argument-digit)
+ (cons (x-char 9) 'argument-digit)
+ (cons (x-char -) 'negative-argument)
+ (cons (x-char C-0) 'argument-digit)
+ (cons (x-char C-1) 'argument-digit)
+ (cons (x-char C-2) 'argument-digit)
+ (cons (x-char C-3) 'argument-digit)
+ (cons (x-char C-4) 'argument-digit)
+ (cons (x-char C-5) 'argument-digit)
+ (cons (x-char C-6) 'argument-digit)
+ (cons (x-char C-7) 'argument-digit)
+ (cons (x-char C-8) 'argument-digit)
+ (cons (x-char C-9) 'argument-digit)
+ (cons (x-char C--) 'negative-argument)
+ (cons (x-char M-0) 'argument-digit)
+ (cons (x-char M-1) 'argument-digit)
+ (cons (x-char M-2) 'argument-digit)
+ (cons (x-char M-3) 'argument-digit)
+ (cons (x-char M-4) 'argument-digit)
+ (cons (x-char M-5) 'argument-digit)
+ (cons (x-char M-6) 'argument-digit)
+ (cons (x-char M-7) 'argument-digit)
+ (cons (x-char M-8) 'argument-digit)
+ (cons (x-char M-9) 'argument-digit)
+ (cons (x-char M--) 'negative-argument)
+ (cons (x-char C-M-0) 'argument-digit)
+ (cons (x-char C-M-1) 'argument-digit)
+ (cons (x-char C-M-2) 'argument-digit)
+ (cons (x-char C-M-3) 'argument-digit)
+ (cons (x-char C-M-4) 'argument-digit)
+ (cons (x-char C-M-5) 'argument-digit)
+ (cons (x-char C-M-6) 'argument-digit)
+ (cons (x-char C-M-7) 'argument-digit)
+ (cons (x-char C-M-8) 'argument-digit)
+ (cons (x-char C-M-9) 'argument-digit)
+ (cons (x-char C-M--) 'negative-argument)
+ (cons (x-chars C-X C-Z) 'nmode-exit-to-superior)
+ (cons (x-chars C-X V) 'nmode-invert-video)
+ (cons (x-chars Esc !/) 'execute-softkey-command)
+ ))
+
+% Window-Command-List: commands for scrolling, etc.
+% These commands do not allow selecting a new window, buffer, mode, etc.
+
+(setf Window-Command-List
+ (list
+ (cons (x-char C-M-V) 'scroll-other-window-command)
+ (cons (x-char C-V) 'next-screen-command)
+ (cons (x-char M-R) 'move-to-screen-edge-command)
+ (cons (x-char M-V) 'previous-screen-command)
+ (cons (x-chars C-X <) 'scroll-window-left-command)
+ (cons (x-chars C-X >) 'scroll-window-right-command)
+ (cons (x-chars C-X ^) 'grow-window-command)
+ (cons (m-x "Write Screen") 'write-screen-command)
+ ))
+
+% Basic-Command-List: contains commands desirable in almost any mode.
+
+(setf Basic-Command-List
+ (list
+ (cons (x-char C-!?) 'help-dispatch)
+ (cons (x-char C-M-L) 'select-previous-buffer-command)
+ (cons (x-char M-!/) 'help-dispatch)
+ (cons (x-char M-!?) 'help-dispatch)
+ (cons (x-char M-!~) 'buffer-not-modified-command)
+ (cons (x-chars C-X !.) 'set-fill-prefix-command)
+ (cons (x-chars C-X 1) 'one-window-command)
+ (cons (x-chars C-X 2) 'two-windows-command)
+ (cons (x-chars C-X 3) 'view-two-windows-command)
+ (cons (x-chars C-X 4) 'visit-in-other-window-command)
+ (cons (x-chars C-X B) 'select-buffer-command)
+ (cons (x-chars C-X C-B) 'buffer-browser-command)
+ (cons (x-chars C-X C-F) 'find-file-command)
+ (cons (x-chars C-X C-P) 'print-buffer-command)
+ (cons (x-chars C-X C-S) 'save-file-command)
+ (cons (x-chars C-X C-W) 'write-file-command) % here???
+ (cons (x-chars C-X D) 'dired-command)
+ (cons (x-chars C-X E) 'exchange-windows-command)
+ (cons (x-chars C-X F) 'set-fill-column-command)
+ (cons (x-chars C-X K) 'kill-buffer-command)
+ (cons (x-chars C-X O) 'other-window-command)
+ (cons (x-chars Esc _) 'apropos-command)
+ (cons (m-x "Append to File") 'append-to-file-command)
+ (cons (m-x "Apropos") 'apropos-command)
+ (cons (m-x "Auto Fill Mode") 'auto-fill-mode-command)
+ (cons (m-x "Count Occurrences") 'Count-Occurrences-command)
+ (cons (m-x "Delete and Expunge File") 'delete-and-expunge-file-command)
+ (cons (m-x "Delete File") 'delete-file-command)
+ (cons (m-x "DIRED") 'edit-directory-command)
+ (cons (m-x "Edit Directory") 'edit-directory-command)
+ (cons (m-x "Execute Buffer") 'execute-buffer-command)
+ (cons (m-x "Execute File") 'execute-file-command)
+ (cons (m-x "Find File") 'find-file-command)
+ (cons (m-x "How Many") 'Count-Occurrences-command)
+ (cons (m-x "Kill Buffer") 'kill-buffer-command)
+ (cons (m-x "Kill File") 'delete-file-command)
+ (cons (m-x "Kill Some Buffers") 'kill-some-buffers-command)
+ (cons (m-x "List Browsers") 'browser-browser-command)
+ (cons (m-x "List Buffers") 'buffer-browser-command)
+ (cons (m-x "Make Space") 'nmode-gc)
+ (cons (m-x "Prepend to File") 'prepend-to-file-command)
+ (cons (m-x "Print Buffer") 'print-buffer-command)
+ (cons (m-x "Rename Buffer") 'rename-buffer-command)
+ (cons (m-x "Save All Files") 'save-all-files-command)
+ (cons (m-x "Select Buffer") 'select-buffer-command)
+ (cons (m-x "Set Key") 'set-key-command)
+ (cons (m-x "Set Visited Filename") 'set-visited-filename-command)
+ (cons (m-x "Start Scripting") 'start-scripting-command)
+ (cons (m-x "Start Timing NMODE") 'start-timing-command)
+ (cons (m-x "Stop Scripting") 'stop-scripting-command)
+ (cons (m-x "Stop Timing NMODE") 'stop-timing-command)
+ (cons (m-x "Undelete File") 'undelete-file-command)
+ (cons (m-x "Write File") 'write-file-command) % here???
+ (cons (m-x "Write Region") 'write-region-command)
+ ))
+
+% Read-Only-Text-Command-List: Commands for editing text buffers that
+% do not modify the buffer.
+
+(setf Read-Only-Text-Command-List
+ (list
+ % These commands are read-only commands for text mode.
+ (cons (x-char BACKSPACE) 'move-backward-character-command)
+ (cons (x-char C-<) 'mark-beginning-command)
+ (cons (x-char C->) 'mark-end-command)
+ (cons (x-char C-=) 'what-cursor-position-command)
+ (cons (x-char C-@) 'set-mark-command)
+ (cons (x-char C-A) 'move-to-start-of-line-command)
+ (cons (x-char C-B) 'move-backward-character-command)
+ (cons (x-char C-E) 'move-to-end-of-line-command)
+ (cons (x-char C-F) 'move-forward-character-command)
+ (cons (x-char C-M-M) 'back-to-indentation-command)
+ (cons (x-char C-M-RETURN) 'back-to-indentation-command)
+ (cons (x-char C-M-W) 'append-next-kill-command)
+ (cons (x-char C-N) 'move-down-command)
+ (cons (x-char C-P) 'move-up-command)
+ (cons (x-char C-R) 'reverse-search-command)
+ (cons (x-char C-S) 'incremental-search-command)
+ (cons (x-char C-SPACE) 'set-mark-command)
+ (cons (x-char M-<) 'move-to-buffer-start-command)
+ (cons (x-char M->) 'move-to-buffer-end-command)
+ (cons (x-char M-![) 'backward-paragraph-command)
+ (cons (x-char M-!]) 'forward-paragraph-command)
+ (cons (x-char M-@) 'mark-word-command)
+ (cons (x-char M-A) 'backward-sentence-command)
+ (cons (x-char M-B) 'move-backward-word-command)
+ (cons (x-char M-E) 'forward-sentence-command)
+ (cons (x-char M-F) 'move-forward-word-command)
+ (cons (x-char M-H) 'mark-paragraph-command)
+ (cons (x-char M-M) 'back-to-indentation-command)
+ (cons (x-char M-RETURN) 'back-to-indentation-command)
+ (cons (x-char M-W) 'copy-region)
+ (cons (x-chars C-X A) 'append-to-buffer-command)
+ (cons (x-chars C-X C-N) 'set-goal-column-command)
+ (cons (x-chars C-X C-X) 'exchange-point-and-mark)
+ (cons (x-chars C-X H) 'mark-whole-buffer-command)
+ (cons (x-chars C-X =) 'what-cursor-position-command)
+ ))
+
+% Text-Command-List: Commands for editing text buffers that might modify
+% the buffer. Note: put read-only commands on
+% Read-Only-Text-Command-List (above).
+
+(setf Text-Command-List
+ (list
+ (cons (x-char 0) 'argument-or-insert-command)
+ (cons (x-char 1) 'argument-or-insert-command)
+ (cons (x-char 2) 'argument-or-insert-command)
+ (cons (x-char 3) 'argument-or-insert-command)
+ (cons (x-char 4) 'argument-or-insert-command)
+ (cons (x-char 5) 'argument-or-insert-command)
+ (cons (x-char 6) 'argument-or-insert-command)
+ (cons (x-char 7) 'argument-or-insert-command)
+ (cons (x-char 8) 'argument-or-insert-command)
+ (cons (x-char 9) 'argument-or-insert-command)
+ (cons (x-char -) 'argument-or-insert-command)
+ (cons (x-char C-!%) 'replace-string-command)
+ (cons (x-char C-D) 'delete-forward-character-command)
+ (cons (x-char C-K) 'kill-line)
+ (cons (x-char C-M-C) 'insert-self-command)
+ (cons (x-char C-M-O) 'split-line-command)
+ (cons (x-char C-M-!\) 'indent-region-command)
+ (cons (x-char C-N) 'move-down-extending-command)
+ (cons (x-char C-O) 'open-line-command)
+ (cons (x-char C-Q) 'insert-next-character-command)
+ (cons (x-char C-RUBOUT) 'delete-backward-hacking-tabs-command)
+ (cons (x-char C-T) 'transpose-characters-command)
+ (cons (x-char C-W) 'kill-region)
+ (cons (x-char C-Y) 'insert-kill-buffer)
+ (cons (x-char LF) 'indent-new-line-command)
+ (cons (x-char M-!') 'upcase-digit-command)
+ (cons (x-char M-!%) 'query-replace-command)
+ (cons (x-char M-!\) 'delete-horizontal-space-command)
+ (cons (x-char M-C) 'uppercase-initial-command)
+ (cons (x-char M-D) 'kill-forward-word-command)
+ (cons (x-char M-G) 'fill-region-command)
+ (cons (x-char M-I) 'tab-to-tab-stop-command)
+ (cons (x-char M-K) 'kill-sentence-command)
+ (cons (x-char M-L) 'lowercase-word-command)
+ (cons (x-char M-Q) 'fill-paragraph-command)
+ (cons (x-char M-RUBOUT) 'kill-backward-word-command)
+ (cons (x-char M-S) 'center-line-command)
+ (cons (x-char M-T) 'transpose-words)
+ (cons (x-char M-TAB) 'tab-to-tab-stop-command)
+ (cons (x-char M-U) 'uppercase-word-command)
+ (cons (x-char M-Y) 'unkill-previous)
+ (cons (x-char M-Z) 'fill-comment-command)
+ (cons (x-char M-^) 'delete-indentation-command)
+ (cons (x-char RETURN) 'return-command)
+ (cons (x-char RUBOUT) 'delete-backward-character-command)
+ (cons (x-char TAB) 'tab-to-tab-stop-command)
+ (cons (x-chars C-X C-L) 'lowercase-region-command)
+ (cons (x-chars C-X C-O) 'delete-blank-lines-command)
+ (cons (x-chars C-X C-T) 'transpose-lines)
+ (cons (x-chars C-X C-U) 'uppercase-region-command)
+ (cons (x-chars C-X C-V) 'visit-file-command)
+ (cons (x-chars C-X G) 'get-register-command)
+ (cons (x-chars C-X Rubout) 'backward-kill-sentence-command)
+ (cons (x-chars C-X T) 'transpose-regions)
+ (cons (x-chars C-X X) 'put-register-command)
+ (cons (m-x "Delete Matching Lines") 'delete-matching-lines-command)
+ (cons (m-x "Delete Non-Matching Lines") 'delete-non-matching-lines-command)
+ (cons (m-x "Flush Lines") 'delete-matching-lines-command)
+ (cons (m-x "Insert Buffer") 'insert-buffer-command)
+ (cons (m-x "Insert Date") 'insert-date-command)
+ (cons (m-x "Insert File") 'insert-file-command)
+ (cons (m-x "Keep Lines") 'delete-non-matching-lines-command)
+ (cons (m-x "Lisp Mode") 'lisp-mode-command)
+ (cons (m-x "Replace String") 'replace-string-command)
+ (cons (m-x "Query Replace") 'query-replace-command)
+ (cons (m-x "Revert File") 'revert-file-command)
+ (cons (m-x "Text Mode") 'text-mode-command)
+ (cons (m-x "Visit File") 'visit-file-command)
+ ))
+
+(setf Read-Only-Terminal-Command-List
+ (list
+ (cons (x-chars ESC !h) 'move-to-buffer-start-command)
+ (cons (x-chars ESC 4) 'move-backward-word-command)
+ (cons (x-chars ESC 5) 'move-forward-word-command)
+ (cons (x-chars ESC A) 'move-up-command)
+ (cons (x-chars ESC B) 'move-down-command)
+ (cons (x-chars ESC C) 'move-forward-character-command)
+ (cons (x-chars ESC D) 'move-backward-character-command)
+ (cons (x-chars ESC F) 'move-to-buffer-end-command)
+ (cons (x-chars ESC J) 'nmode-full-refresh)
+ (cons (x-chars ESC S) 'scroll-window-up-line-command)
+ (cons (x-chars ESC T) 'scroll-window-down-line-command)
+ (cons (x-chars ESC U) 'scroll-window-up-page-command)
+ (cons (x-chars ESC V) 'scroll-window-down-page-command)
+ ))
+
+(setf Modifying-Terminal-Command-List
+ (list
+ (cons (x-chars ESC L) 'open-line-command)
+ (cons (x-chars ESC M) 'kill-line)
+ (cons (x-chars ESC P) 'delete-forward-character-command)
+ ))
+
+(setf Input-Command-List
+ (list
+ (cons (x-char C-R) 'nmode-yank-default-input)
+ ))
+
+(setf Recurse-Command-List
+ (list
+ (cons (x-char y) 'affirmative-exit)
+ (cons (x-char n) 'negative-exit)
+ ))
ADDED psl-1983/3-1/clsc-20/nmode-20.b
Index: psl-1983/3-1/clsc-20/nmode-20.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/nmode-20.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/nmode-ex-20.sl
Index: psl-1983/3-1/clsc-20/nmode-ex-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/nmode-ex-20.sl
@@ -0,0 +1,238 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-20.SL - DEC-20 NMODE Stuff (intended for DEC-20 Version Only)
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 24 January 1983
+% Revised: 5 April 1983
+%
+% 15-Jun-83 Robert Kessler
+% Add ambassador, teleray and VT100 terminal support.
+% 5-Apr-83 Alan Snyder
+% Add load-nmode and set-terminal stuff to make it more like other systems.
+% 15-Mar-83 Alan Snyder
+% Add nmode-print-device.
+% 25-Jan-83 Alan Snyder
+% Add version of actualize-file-name that ensures that transiently-created
+% file has delete access.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime
+ (load useful common fast-strings))
+
+% External variables used here:
+
+(fluid '(nmode-file-list
+ nmode-source-prefix
+ nmode-binary-prefix
+ *usermode
+ *redefmsg
+ doc-text-file
+ reference-text-file
+ nmode-print-device
+ nmode-terminal
+ ))
+
+% Global variables defined here:
+
+(fluid '(terminal-type))
+
+
+(if (or (unboundp 'nmode-source-prefix) (null nmode-source-prefix))
+ (setf nmode-source-prefix "pn:"))
+
+(if (or (unboundp 'nmode-binary-prefix) (null nmode-binary-prefix))
+ (setf nmode-binary-prefix "pnb:"))
+
+(de load-nmode ()
+ % Load NMODE.
+ % Any system-dependent customization is done here so that it can
+ % be overridden by the user before NMODE is initialized.
+
+ (nmode-load-required-modules)
+ (nmode-load-all)
+ (setf nmode-print-device "LPT:")
+ % Set up "pointers" to online documentation.
+ (setf doc-text-file "PS:<PSL.DOC.NMODE>FRAMES.LPT")
+ (setf reference-text-file "PS:<PSL.DOC.NMODE>COSTLY.SL")
+ % Get our version of the prompt line with date/time
+ (load exec)
+ (faslin "pnb:window-label-rewrite.b")
+ (let ((*usermode nil) (*redefmsg nil))
+ (copyd 'actualize-file-name 'dec20-actualize-file-name)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Terminal Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-set-terminal ()
+ (setf terminal-type (jsys2 65 0 0 0 (const jsgttyp)))
+ (selectq terminal-type
+ (6 % HP264X
+ (ensure-terminal-type 'hp2648a)
+ )
+ (7 % Teleray
+ (ensure-terminal-type 'teleray)
+ )
+ (15 % VT52
+ (ensure-terminal-type 'vt52x)
+ )
+ (16 % VT100
+ (ensure-terminal-type 'vt100)
+ )
+ (19 % ambassador
+ (ensure-terminal-type 'ambassador)
+ )
+ (21 % HP2621
+ (ensure-terminal-type 'hp2648a)
+ )
+ (t
+ (or nmode-terminal (ensure-terminal-type 'hp2648a))
+ )
+ ))
+
+
+% These functions defined for compatibility:
+
+(de ambassador () (ensure-terminal-type 'ambassador))
+(de hp2648a () (ensure-terminal-type 'hp2648a))
+(de vt52x () (ensure-terminal-type 'vt52x))
+(de teleray () (ensure-terminal-type 'teleray))
+(de vt100 () (ensure-terminal-type 'vt100))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% System-Dependent Stuff:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-date-time () % Stolen directly from Nancy Kendzierski
+ % Date/time in appropriate format for the network mail header
+ (let ((date-time (MkString 80)))
+ (jsys1 date-time -1 #.(bits 5 7 10 12 13) 0 (const jsODTIM))
+ (recopystringtonull date-time)))
+
+(de dec20-actualize-file-name (file-name)
+ % If the specified file exists, return its "true" (and complete) name.
+ % Otherwise, return the "true" name of the file that would be created if one
+ % were to do so. (Unfortunately, we have no way to do this except by actually
+ % creating the file and then deleting it!) Return NIL if the file cannot be
+ % read or created.
+
+ (let ((s (attempt-to-open-input file-name)))
+ (cond ((not s)
+ (setf s (attempt-to-open-output
+ (string-concat file-name ";P777777") % so we can delete it!
+ ))
+ (when s
+ (setf file-name (=> s file-name))
+ (=> s close)
+ (file-delete-and-expunge file-name)
+ file-name
+ )
+ )
+ (t
+ (setf file-name (=> s file-name))
+ (=> s close)
+ file-name
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building NMODE:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-load-required-modules ()
+ (load objects)
+ (load common)
+ (load useful)
+ (load strings)
+ (load pathnames)
+ (load pathnamex)
+ (load ring-buffer)
+ (load extended-char)
+ (load directory)
+ (load input-stream)
+ (load output-stream)
+ (load processor-time)
+ (load wait)
+ (load vector-fix)
+ (load nmode-parsing)
+ (load rawio)
+ (load windows)
+ )
+
+(de nmode-fixup-name (s) s)
+
+(de nmode-load-all ()
+ (for (in s nmode-file-list)
+ (do (nmode-load s))
+ ))
+
+(de nmode-load (s)
+ (nmode-faslin nmode-binary-prefix s)
+ )
+
+(de nmode-faslin (directory-name module-name)
+ (setf module-name (nmode-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf nmode-file-list
+ (list
+ "browser"
+ "browser-support"
+ "buffer"
+ "buffer-io"
+ "buffer-position"
+ "buffer-window"
+ "buffers"
+ "case-commands"
+ "command-input"
+ "commands"
+ "defun-commands"
+ "dispatch"
+ "extended-input"
+ "fileio"
+ "incr"
+ "indent-commands"
+ "kill-commands"
+ "lisp-commands"
+ "lisp-indenting"
+ "lisp-interface"
+ "lisp-parser"
+ "m-x"
+ "m-xcmd"
+ "modes"
+ "mode-defs"
+ "move-commands"
+ "nmode-break"
+ "nmode-init"
+ "prompting"
+ "query-replace"
+ "reader"
+ "rec"
+ "screen-layout"
+ "search"
+ "softkeys"
+ "structure-functions"
+ "terminal-input"
+ "text-buffer"
+ "text-commands"
+ "window"
+ "window-label"
+
+ % These must be last:
+
+ "autofill"
+ "browser-browser"
+ "buffer-browser"
+ "dired"
+ "doc"
+ ))
ADDED psl-1983/3-1/clsc-20/notes.txt
Index: psl-1983/3-1/clsc-20/notes.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/notes.txt
@@ -0,0 +1,36 @@
+1. Changed references to "PS:<PSL.DOC.NMODE>" to "PNDOC:", in files
+ PN:NMODE-EX-20 => PNB:NMODE-20.B
+
+2. Redo the terminal type selection, in
+ PN:NMODE-EX-20 => PNB:NMODE-20.B
+
+3. Changed TELERAY terminal definitions to do 7 bit input (not 8), in
+ PW:TELERAY.SL => PWB:TELERAY.B
+
+4. Where is the source code for VT100 terminals (and AMBASSADOR)?
+
+5. Changed PRINLEVEL init from 2 to NIL (in PDIST:MAKE-NMODE.CTL)
+
+6. Use ESC as the M-Prefix key, in files
+ PN:EXTENDED-INPUT.SL => PNB:EXTENDED-INPUT.B
+
+7. Define M-ESC (accessed by the sequence ESC ESC) to be the ESC-Prefix, in
+ PN:MODE-DEFS.SL => PNB:MODE-DEFS.B
+
+8. When further terminal types are supported, load the packages from
+ PW:WINDOWS-EX-20.SL => PW:WINDOWS-20.B
+
+9. Note that PSL, not BARE-PSL is used to remake NMODE, so be sure you
+ don't have a PSL.INIT file. Also a few extra packages (HOMEDIR and
+ INIT-FILE) are pre-loaded in the new NMODE.
+
+10. Note that the loading sequence finds the NMODE.LAP in "PL:", not
+ the version in "PN:".
+
+11. Fixed bug in METHOD TELERAY MOVE-CURSOR that used vector index of -1, in
+ PW:TELERAY.SL => PWB:TELERAY.B
+
+12. Why, in 2 window mode, is the top line of the bottom window printed
+ as appended to the mode line of the top window, and therefore not
+ visible? Is the bug something on our 20 or a problem in NMODE in
+ general?
ADDED psl-1983/3-1/clsc-20/remake-nmode.mic
Index: psl-1983/3-1/clsc-20/remake-nmode.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/remake-nmode.mic
@@ -0,0 +1,28 @@
+@connect scrtch:<psl.3-1.clsc-20>
+@define s: scrtch:<scratch>
+@psl:pslcomp
+*(FASLOUT "VT52NX") (DSKIN "VT52NX.SL") (FASLEND)
+*(FASLOUT "HAZELTINE-1500") (DSKIN "HAZELTINE-1500.SL") (FASLEND)
+*(FASLOUT "TELEVIDEO") (DSKIN "TELEVIDEO.SL") (FASLEND)
+*(FASLOUT "WINDOWS-20") (DSKIN "WINDOWS-EX-20.SL") (FASLEND)
+*(FASLOUT "EXTENDED-INPUT") (DSKIN "EXTENDED-INPUT.SL") (FASLEND)
+*(FASLOUT "MODE-DEFS") (DSKIN "MODE-DEFS.SL") (FASLEND)
+*(FASLOUT "NMODE-20") (DSKIN "NMODE-EX-20.SL") (FASLEND)
+*(QUIT)
+@reset .
+@set file generation-retention-count pwb:windows-20.b.* 0
+@set file generation-retention-count pnb:extended-input.b.* 0
+@set file generation-retention-count pnb:mode-defs.b.* 0
+@set file generation-retention-count pnb:nmode-20.b.* 0
+@copy vt52nx.b.0 pwb:vt52nx.b.-1
+@copy hazeltine-1500.b.0 pwb:hazeltine-1500.b.-1
+@copy televideo.b.0 pwb:televideo.b.-1
+@copy windows-20.b.0 pwb:windows-20.b.-1
+@copy extended-input.b.0 pnb:extended-input.b.-1
+@copy mode-defs.b.0 pnb:mode-defs.b.-1
+@copy nmode-20.b.0 pnb:nmode-20.b.-1
+@copy psl:psl.exe s:bare-psl.exe
+@do make-nmode.mic
+@set file generation-retention-count psl:nmode.exe.* 0
+@rename s:nmode.exe.0 psl:nmode.exe.-1
+@kmic
ADDED psl-1983/3-1/clsc-20/teleray.sl
Index: psl-1983/3-1/clsc-20/teleray.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/teleray.sl
@@ -0,0 +1,256 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% TELERAY.SL - Terminal Interface
+%
+% Author: G.Q. Maguire Jr., U of Utah
+% Date: 3 Nov 1982
+% based on VT52X.SL by Alan Snyder
+% Hewlett-Packard/CRC
+% 6 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+
+(defflavor teleray (
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-n (n)
+ `(progn
+ (if (> ,n 9)
+ (PBOUT (+ (char 0) (/ ,n 10))))
+ (PBOUT (+ (char 0) (// ,n 10))))))
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move (row col)
+ `(progn
+ (out-chars ESC Y)
+ (PBOUT (+ ,row 32))
+ (PBOUT (+ ,col 32)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (teleray get-character) ()
+ (& (PBIN) 8#377)
+ )
+
+(defmethod (teleray ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (teleray move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (cond ((and (= row cursor-row) (= column cursor-column))) % no action needed
+ ((and (= row 0) (= column 0))
+ (out-chars ESC H)) % cursor HOME
+ ((= row cursor-row) % movement on current row
+ (cond ((= column 0)
+ (out-char CR)) % move to left margin
+ ((= column (- cursor-column 1))
+ (out-chars ESC D)) % move LEFT
+ ((= column (+ cursor-column 1))
+ (out-chars ESC C)) % move RIGHT
+ (t (out-move row column))))
+ ((= column cursor-column) % movement on same column
+ (cond ((= row (- cursor-row 1))
+ (out-chars ESC A)) % move UP
+ ((= row (+ cursor-row 1))
+ (out-char LF)) % move DOWN
+ (t (out-move row column))))
+ (t % arbitrary movement
+ (out-move row column)))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (teleray enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (teleray leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (teleray erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars ESC H ESC J)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (teleray clear-line) ()
+ (out-chars ESC K)
+ )
+
+(defmethod (teleray convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ BLINK
+ UNDERLINE
+ INTENSIFY)
+ (dc-make-font-mask 0)
+ 16#FF)))
+ (let ((code (dc-character-code ch)))
+ (if (or (< code #\space) (= code (char rubout)))
+ (setq ch #\space)))
+ ch)
+
+(defmethod (teleray normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (teleray highlighted-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (teleray supported-enhancements) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (teleray update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether we want to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (if (not (and (= cursor-row row) (<= cursor-column first-col)))
+ (=> self move-cursor row first-col))
+
+ % The VT52X will scroll if we write to the bottom right position.
+ % This (hopefully temporary) hack will avoid writing there.
+ (if (and (= row maxrow) (= last-col maxcol))
+ (setf last-col (- maxcol 1))
+ )
+
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (~= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (if (~= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement)
+ )
+ (=> self &move-cursor-forward col old-line)
+ (if (> new-code 127)
+ (progn (PBOUT 27) (PBOUT 82) (PBOUT (+ 64 (- new-code 128))))
+ (PBOUT new-code))
+ (setf cursor-column (+ cursor-column 1))
+ (when (> cursor-column maxcol)
+ (setf cursor-column 0)
+ (setf cursor-row (+ cursor-row 1))
+ (if (> cursor-row maxrow)
+ (=> self move-cursor 0 0)
+ ))
+ (vector-store old-line col new)
+ )))))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self &move-cursor-forward (+ last-nonblank-column 1) old-line)
+ (=> self clear-line)
+ )
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (teleray init) ()
+ )
+
+(defmethod (teleray &move-cursor-forward) (column line)
+ (cond ((> (- column cursor-column) 4)
+ (out-move cursor-row column)
+ (setf cursor-column column))
+ (t (while (< cursor-column column)
+ (PBOUT (dc-character-code (vector-fetch line cursor-column)))
+ (setf cursor-column (+ cursor-column 1))
+ ))))
+
+(defmethod (teleray &set-terminal-enhancement) (enh)
+)
ADDED psl-1983/3-1/clsc-20/televideo.b
Index: psl-1983/3-1/clsc-20/televideo.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/televideo.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/televideo.sl
Index: psl-1983/3-1/clsc-20/televideo.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/televideo.sl
@@ -0,0 +1,298 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% TELEVIDEO -- Terminal Interface
+% Lon Willett, 6-Jul-83
+% Based on file:
+%
+% TELERAY.SL
+% Author: G.Q. Maguire Jr., U of Utah
+% Date: 3 Nov 1982
+% based on VT52X.SL by Alan Snyder
+% Hewlett-Packard/CRC
+% 6 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+(BothTimes (load JSYS))
+(compiletime
+ (progn
+ (defconst !.MORLW 8#30 % read page width
+ !.MORLL 8#32 % read page length
+ !.PRIOU 8#101) % primary output jfn, it had better be a TTY
+% NOTE: since I/O is done with PBIN/PBOUT, using the primary JFN should
+% be ok. This really ought to be written to use an arbitrary JFN.
+ (ds get-system-page-height ()
+ (jsys3 (const !.priou) (const !.morll) 0 0 (const jsMTOPR)) )
+ (ds get-system-line-length ()
+ (jsys3 (const !.priou) (const !.morlw) 0 0 (const jsMTOPR)) )
+ ))
+
+(defflavor televideo (
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (auto-wrap 'MAYBE) % does a CRLF when output to last column: YES NO MAYBE
+ (auto-scroll 'YES) % scrolls when output to (MAXROW,MAXCOL): YES NO MAYBE
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width auto-wrap auto-scroll
+ maxrow maxcol raw-mode)
+ (initable-instance-variables height width auto-wrap auto-scroll)
+ )
+
+(defmethod (televideo init) (initlis)
+ % Pick up the page length & width from the monitor if it is not
+ % specified by an initialization argument. Use default if we don't like
+ % what the monitor claims.
+ % HEIGHT & MAXROW:
+ (unless (memq 'HEIGHT initlis) (setf height (get-system-page-height)))
+ (when (or (< height 10) (> height 96)) (setf height 24))
+ (setf maxrow (- height 1))
+ % WIDTH & MAXCOL:
+ (unless (memq 'WIDTH initlis) (setf width (get-system-line-length)))
+ (when (or (< width 10) (> width 96)) (setf width 80))
+ (setf maxcol (- width 1))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move (row col)
+ `(progn
+ (out-chars ESC !=)
+ (PBOUT (+ ,row 32))
+ (PBOUT (+ ,col 32)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (televideo get-character) ()
+ (& (PBIN) 8#177)
+ )
+
+(defmethod (televideo ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (televideo move-cursor) (row column)
+ % (ROW COLUMN) is the point we want to move to
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (let ((relative-move-number-of-chars
+ (+ % vertical move:
+ (cond ((< cursor-row row) (- row cursor-row)) % 1 char to move down
+ ((> cursor-row row) (- cursor-row row)) % 1 to move up
+ (T 0)) % else no vertical move necessary
+ % horizontal move:
+ (cond ((= cursor-column column) 0) % no horizontal move necessary
+ ((= column 0) 1) % move to left column
+ ((> cursor-column column)
+ (- cursor-column column)) % 1 char to move left
+ (T (- column cursor-column)) ) % 1 char to move right
+ )))
+ (cond ((= relative-move-number-of-chars 0) ) % no move needed
+ ((and (= row 0) (= column 0))
+ (out-char (CONTROL !^))) % cursor HOME
+ ((>= relative-move-number-of-chars 4)
+ (out-move row column)) % move absolute
+ (T % move relative
+ (cond ((= cursor-column column) ) % no horizontal move needed
+ ((= column 0) (out-char CR)) % move to left-most column
+ ((> cursor-column column)
+ (for (from curcol cursor-column (+ column 1) -1)
+ (do (out-char BACKSPACE)) )) % move left
+ (T
+ (for (from curcol cursor-column (- column 1) 1)
+ (do (out-char FF)) )) ) % move right
+ % now take care of the vertical move
+ (cond ((= cursor-row row) ) % no move needed
+ ((< cursor-row row)
+ (for (from currow cursor-row (- row 1) 1)
+ (do (out-char LF)) )) % move down
+ (T (for (from currow cursor-row (+ row 1) -1)
+ (do (out-char (CONTROL K))) )) ) % move up
+ )))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (televideo enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (televideo leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (televideo erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars (CONTROL !^) ESC !*)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (televideo clear-line) ()
+ (out-chars ESC (LOWER T))
+ )
+
+(defmethod (televideo convert-character) (ch)
+ (setf ch (& ch (display-character-cons
+ % no enhancements supporeted
+ (dc-make-enhancement-mask
+ % INVERSE-VIDEO BLINK UNDERLINE INTENSIFY
+ )
+ % only font number 0 supported
+ (dc-make-font-mask 0)
+ % only 7 bit chars
+ 16#7F)))
+ (let ((code (dc-character-code ch)))
+ % replace non-printable chars with a space
+ (when (or (< code 8#40) (= code (char rubout))) (setf ch terminal-blank)))
+ ch)
+
+(defmethod (televideo normal-enhancement) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (televideo highlighted-enhancement) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (televideo supported-enhancements) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (televideo update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % this check prevents index of -1, and also avoids cursor movement
+ % when the line doesn't need to be changed
+ (when (<= first-col last-col)
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (~= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (when (~= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement)
+ )
+ (=> self move-cursor row col)
+ (=> self &print-char new-code)
+ (vector-store old-line col new)
+ )))))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self move-cursor row (+ last-nonblank-column 1))
+ (=> self clear-line)
+ )
+ )))
+
+% The following methods are provided for INTERNAL use only!
+
+% This method outputs a printable character
+% (should we check that the character is printable?)
+(defmethod (televideo &print-char) (ch)
+ (cond ((< cursor-column maxcol) % normal case
+ (PBOUT ch)
+ (setf cursor-column (+ cursor-column 1)))
+
+ ((< cursor-row maxrow) % last character on a line, but not last line
+ % This horrendous hack assures that we have auto-wrap
+ (PBOUT ch)
+ (setf cursor-row (+ cursor-row 1))
+ (setf cursor-column 0)
+ (cond ((eq auto-wrap 'NO) (out-chars CR LF))
+ ((eq auto-wrap 'MAYBE) (out-move cursor-row 0))
+% ((eq auto-wrap 'YES) )
+ ))
+ (T % Bottom right corner
+ % Prevent scrolling (put blank there if we can't print). Move to (0,0).
+ (IF (or (eq auto-scroll 'YES) (eq auto-scroll 'MAYBE))
+ % THEN
+ (=> self clear-line)
+ % ELSE (eq auto-scroll 'NO) so
+ (PBOUT ch))
+ (=> self move-cursor 0 0) )
+ ))
+
+(defmethod (televideo &set-terminal-enhancement) (enh)
+ (setf terminal-enhancement 0) )
ADDED psl-1983/3-1/clsc-20/vt52nx.b
Index: psl-1983/3-1/clsc-20/vt52nx.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/vt52nx.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/vt52nx.sl
Index: psl-1983/3-1/clsc-20/vt52nx.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/vt52nx.sl
@@ -0,0 +1,324 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% VT52NX -- Non extended VT52 interface
+% Lon Willett, 6-Jul-83
+% Based on file:
+%
+% TELERAY.SL
+% Author: G.Q. Maguire Jr., U of Utah
+% Date: 3 Nov 1982
+% based on VT52X.SL by Alan Snyder
+% Hewlett-Packard/CRC
+% 6 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+(BothTimes (load JSYS))
+(compiletime
+ (progn
+ (defconst !.MORLW 8#30 % read page width
+ !.MORLL 8#32 % read page length
+ !.PRIOU 8#101) % primary output jfn, it had better be a TTY
+% NOTE: since I/O is done with PBIN/PBOUT, using the primary JFN should
+% be ok. This really ought to be written to use an arbitrary JFN.
+ (ds get-system-page-height ()
+ (jsys3 (const !.priou) (const !.morll) 0 0 (const jsMTOPR)) )
+ (ds get-system-line-length ()
+ (jsys3 (const !.priou) (const !.morlw) 0 0 (const jsMTOPR)) )
+ ))
+
+(defflavor vt52nx (
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (auto-wrap 'MAYBE) % does a CRLF when output to last column: YES NO MAYBE
+ (auto-scroll 'YES) % scrolls when output to (MAXROW,MAXCOL): YES NO MAYBE
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width auto-wrap auto-scroll
+ maxrow maxcol raw-mode)
+ (initable-instance-variables height width auto-wrap auto-scroll)
+ )
+
+(defmethod (vt52nx init) (initlis)
+ % Pick up the page length & width from the monitor if it is not
+ % specified by an initialization argument. Use default if we don't like
+ % what the monitor claims.
+ % HEIGHT & MAXROW:
+ (unless (memq 'HEIGHT initlis) (setf height (get-system-page-height)))
+ (when (or (< height 10) (> height 96)) (setf height 24))
+ (setf maxrow (- height 1))
+ % WIDTH & MAXCOL:
+ (unless (memq 'WIDTH initlis) (setf width (get-system-line-length)))
+ (when (or (< width 10) (> width 96)) (setf width 80))
+ (setf maxcol (- width 1))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move (row col)
+ `(progn
+ (out-chars ESC Y)
+ (PBOUT (+ ,row 32))
+ (PBOUT (+ ,col 32)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (vt52nx get-character) ()
+ (& (PBIN) 8#177)
+ )
+
+(defmethod (vt52nx ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (vt52nx move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (=> self &move-cursor row column nil nil)
+ )
+
+(defmethod (vt52nx enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (vt52nx leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (vt52nx erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars ESC H ESC J)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (vt52nx clear-line) ()
+ (out-chars ESC K)
+ )
+
+(defmethod (vt52nx convert-character) (ch)
+ (setf ch (& ch (display-character-cons
+ % no enhancements supporeted
+ (dc-make-enhancement-mask
+ % INVERSE-VIDEO BLINK UNDERLINE INTENSIFY
+ )
+ % only font number 0 supported
+ (dc-make-font-mask 0)
+ % only 7 bit chars
+ 16#7F)))
+ (let ((code (dc-character-code ch)))
+ % replace non-printable chars with a space
+ (when (or (< code 8#40) (= code (char rubout))) (setf ch terminal-blank)))
+ ch)
+
+(defmethod (vt52nx normal-enhancement) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (vt52nx highlighted-enhancement) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (vt52nx supported-enhancements) ()
+ (dc-make-enhancement-mask) )
+
+(defmethod (vt52nx update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % this check prevents unchecked index of -1, and also keeps
+ % us from moving the cursor when the line doesn't need to be updated
+ (when (<= first-col last-col)
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (~= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (when (~= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement)
+ )
+ (=> self &move-cursor row col row old-line)
+ (=> self &print-char new-code)
+ (vector-store old-line col new)
+ )))))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self &move-cursor row (+ last-nonblank-column 1) row old-line)
+ (=> self clear-line)
+ )
+ )))
+
+% The following methods are provided for INTERNAL use only!
+
+% This method outputs a printable character
+% (should we check that the character is printable?)
+(defmethod (vt52nx &print-char) (ch)
+ (cond ((< cursor-column maxcol) % normal case
+ (PBOUT ch)
+ (setf cursor-column (+ cursor-column 1)))
+
+ ((< cursor-row maxrow) % last character on a line, but not last line
+ % This horrendous hack assures that we have auto-wrap
+ (PBOUT ch)
+ (setf cursor-row (+ cursor-row 1))
+ (setf cursor-column 0)
+ (cond ((eq auto-wrap 'NO) (out-chars CR LF))
+ ((eq auto-wrap 'MAYBE) (out-move cursor-row 0))
+% ((eq auto-wrap 'YES) )
+ ))
+ (T % Bottom right corner
+ % Prevent scrolling (put blank there if we can't print). Move to (0,0).
+ (IF (or (eq auto-scroll 'YES) (eq auto-scroll 'MAYBE))
+ % THEN
+ (=> self clear-line)
+ % ELSE (eq auto-scroll 'NO) so
+ (PBOUT ch))
+ (=> self move-cursor 0 0) )
+ ))
+
+(defmethod (vt52nx &move-cursor) (row column known-row-number known-row)
+ % (ROW COLUMN) is the point we want to move to
+ % KNOWN-ROW-NUMBER is the number of a row whose characters are known, or
+ % NIL if we don't have a row.
+ % KNOWN-ROW is a the vector of chars in KNOWN-ROW-NUMBER
+ (let* ((need-to-use-known-line-flag NIL)
+ (relative-move-number-of-chars
+ (+ % vertical move
+ (cond ((< cursor-row row) (- row cursor-row)) % 1 char to move down
+ ((> cursor-row row) (* 2 (- cursor-row row))) % 2 to move up
+ (T 0)) % else no vertical move necessary
+ % horizontal move
+ (cond ((= cursor-column column) 0) % no horizontal move necessary
+ ((= column 0) 1) % move to left column
+ ((> cursor-column column)
+ (- cursor-column column)) % 1 char / move left
+ ((and known-row-number
+ (let (minumumrow maximumrow)
+ (if (< row cursor-row)
+ (setf minumumrow row maximumrow cursor-row)
+ (setf minumumrow cursor-row maximumrow row))
+ (and (<= known-row-number maximumrow)
+ (>= known-row-number minumumrow)) ))
+ (setf need-to-use-known-line-flag T)
+ (- column cursor-column)) % can reprint chars, 1/move right
+ (T (* 2 (- column cursor-column))) ) % 2 chars/move right
+ )))
+ (cond ((= relative-move-number-of-chars 0) ) % no move needed
+ ((and (= row 0) (= column 0) (>= relative-move-number-of-chars 2))
+ (out-chars ESC H)) % cursor HOME
+ ((>= relative-move-number-of-chars 4)
+ (out-move row column)) % move absolute
+ (T % move relative
+ (cond ((= cursor-column column) ) % no horizontal move needed
+ ((= column 0) (out-char CR)) % move to left-most column
+ ((> cursor-column column)
+ (for (from junk cursor-column (+ column 1) -1)
+ (do (out-char BACKSPACE)) )) % move left
+ ((not need-to-use-known-line-flag)
+ (for (from junk cursor-column (- column 1) 1)
+ (do (out-chars ESC C)) )) % move right
+ (T (while (> cursor-row known-row-number)
+ (out-chars ESC A) % move up
+ (setf cursor-row (- cursor-row 1)) )
+ (while (< cursor-row known-row-number)
+ (out-char LF) % move down
+ (setf cursor-row (+ cursor-row 1)) )
+ (for (from col cursor-column (- column 1))
+ (do (PBOUT (vector-fetch known-row col))) ))
+ )
+ % now take care of the vertical move
+ (cond ((= cursor-row row) ) % no move needed
+ ((< cursor-row row)
+ (for (from junk cursor-row (- row 1) 1)
+ (do (out-char LF)) )) % move down
+ (T (for (from junk cursor-row (+ row 1) -1)
+ (do (out-chars ESC A)) )) ) % move up
+ )))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (vt52nx &set-terminal-enhancement) (enh)
+ (setf terminal-enhancement 0) )
ADDED psl-1983/3-1/clsc-20/windows-20.b
Index: psl-1983/3-1/clsc-20/windows-20.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/windows-20.b
cannot compute difference between binary files
ADDED psl-1983/3-1/clsc-20/windows-ex-20.sl
Index: psl-1983/3-1/clsc-20/windows-ex-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/clsc-20/windows-ex-20.sl
@@ -0,0 +1,61 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% WINDOWS-20.SL - Dec-20 Windows Stuff (intended only for Dec-20 version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 April 1983
+%
+% 15-Jun-83 - Robert Kessler
+% Added faslin of the 3 new device drivers: VT100, Ambassador and Teleray
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings fast-int))
+(bothtimes (load strings common))
+
+(fluid '(window-file-list window-source-prefix window-binary-prefix))
+
+(if (or (unboundp 'window-source-prefix) (null window-source-prefix))
+ (setf window-source-prefix "pw:"))
+
+(if (or (unboundp 'window-binary-prefix) (null window-binary-prefix))
+ (setf window-binary-prefix "pwb:"))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building WINDOWS:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-fixup-name (s) s)
+
+(de window-load-all ()
+ (for (in s window-file-list)
+ (do (window-load s))
+ ))
+
+(de window-load (s)
+ (window-faslin window-binary-prefix s)
+ )
+
+(de window-faslin (directory-name module-name)
+ (setf module-name (window-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf window-file-list
+ (list
+ "ambassador"
+ "hp2648a"
+ "physical-screen"
+ "shared-physical-screen"
+ "teleray"
+ "virtual-screen"
+ "vt100"
+ "vt52x"
+ ))
ADDED psl-1983/3-1/comp/20/data-machine.red
Index: psl-1983/3-1/comp/20/data-machine.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/data-machine.red
@@ -0,0 +1,502 @@
+%
+% DATA-MACHINE.RED - Macros for fast access to data structures
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 22-May-83 Mark R. Swanson
+% Added Mid-range tags (for extended addressing-20.
+% <PSL.COMP>DATA-MACHINE.RED.13, 30-Mar-83 11:03:57, Edit by KENDZIERSKI
+% Included the text from data-machine.build at the beginning of this file.
+% The file names w/extensions were getting too large for the VAX to deal with.
+% <PERDUE.PSL>DATA-MACHINE.RED.3, 28-Feb-83 12:28:57, Edit by PERDUE
+% Added nasty comments and proposed changes
+% <PSL.COMP>DATA-MACHINE.RED.10, 10-Jan-83 16:31:31, Edit by PERDUE
+% Added PutEvecLen for EVectors; this had been omitted
+% Edit by GRISS, 3Nov: Added missing EVEC operations
+
+% Primitives handled by the compiler are BYTE, PUTBYTE, GETMEM, PUTMEM,
+% MKITEM, FIELD, SIGNEDFIELD, PUTFIELD, HALFWORD, PUYTHALFWORD
+
+CompileTime << load if!-system, syslisp; % Assume still there, else load source
+ off UserMode; >>;
+in "wdeclare.red"$
+CompileTime if_system(PDP10, << in "P20C:DEC20-DATA-MACHINE.RED"$ >>)$
+CompileTime if_system(Dec20, << in "P20C:DEC20-DATA-MACHINE.RED"$ >>)$
+CompileTime if_system(ExtDec20, << in "P20eC:DEC20-DATA-MACHINE.RED"$ >>)$
+CompileTime if_system(VAX, << in "vax/vax-data-machine.red"$ >>)$
+CompileTime if_system(HP9836, << in "phpc:hp-data-machine.red"$ >>)$
+
+on Syslisp;
+
+off R2I;
+
+% These definitions are for interpretive testing of Syslisp code.
+% They may be dangerous in some cases.
+
+CommentOutCode <<
+syslsp procedure Byte(WAddr, ByteOffset);
+ Byte(WAddr, ByteOffset);
+
+syslsp procedure PutByte(WAddr, ByteOffset, Val);
+ PutByte(WAddr, ByteOffset, Val);
+
+syslsp procedure Halfword(WAddr, HalfwordOffset);
+ Halfword(WAddr, HalfwordOffset);
+
+syslsp procedure PutHalfword(WAddr, HalfwordOffset, Val);
+ PutHalfword(WAddr, HalfwordOffset, Val);
+
+syslsp procedure GetMem Addr;
+ GetMem Addr;
+
+syslsp procedure PutMem(Addr, Val);
+ PutMem(Addr, Val);
+
+syslsp procedure MkItem(TagPart, InfPart);
+ MkItem(TagPart, InfPart);
+
+CommentOutCode << % can't do FIELD w/ non constants
+syslsp procedure Field(Cell, StartingBit, BitLength);
+ Field(Cell, StartingBit, BitLength);
+
+syslsp procedure SignedField(Cell, StartingBit, BitLength);
+ SignedField(Cell, StartingBit, BitLength);
+
+syslsp procedure PutField(Cell, StartingBit, BitLength, Val);
+ PutField(Cell, StartingBit, BitLength, Val);
+>>;
+
+syslsp procedure WPlus2(R1, R2);
+ WPlus2(R1, R2);
+
+syslsp procedure WDifference(R1, R2);
+ WDifference(R1, R2);
+
+syslsp procedure WTimes2(R1, R2);
+ WTimes2(R1, R2);
+
+syslsp procedure WQuotient(R1, R2);
+ WQuotient(R1, R2);
+
+syslsp procedure WRemainder(R1, R2);
+ WRemainder(R1, R2);
+
+syslsp procedure WMinus R1;
+ WMinus R1;
+
+syslsp procedure WShift(R1, R2);
+ WShift(R1, R2);
+
+syslsp procedure WAnd(R1, R2);
+ WAnd(R1, R2);
+
+syslsp procedure WOr(R1, R2);
+ WOr(R1, R2);
+
+syslsp procedure WXor(R1, R2);
+ WXor(R1, R2);
+
+syslsp procedure WNot R1;
+ WNot R1;
+
+syslsp procedure WLessP(R1, R2);
+ WLessP(R1, R2);
+
+syslsp procedure WGreaterP(R1, R2);
+ WGreaterP(R1, R2);
+
+syslsp procedure WLEQ(R1, R2);
+ WLEQ(R1, R2);
+
+syslsp procedure WGEQ(R1, R2);
+ WGEQ(R1, R2);
+>>;
+
+on R2I;
+
+off Syslisp;
+
+% SysLisp array accessing primitives
+
+syslsp macro procedure WGetV U;
+ list('GetMem, list('WPlus2, cadr U, list('WTimes2, caddr U,
+ '(WConst AddressingUnitsPerItem))));
+
+syslsp macro procedure WPutV U;
+ list('PutMem, list('WPlus2, cadr U, list('WTimes2, caddr U,
+ '(WConst AddressingUnitsPerItem))),
+ cadddr U);
+
+% tags
+
+CompileTime <<
+lisp procedure DeclareTagRange(NameList, StartingValue, Increment);
+begin scalar Result;
+ Result := list 'progn;
+ while NameList do
+ << Result := list('put, MkQuote car NameList,
+ '(quote WConst),
+ StartingValue)
+ . Result;
+ StartingValue := StartingValue + Increment;
+ NameList := cdr NameList >>;
+ return ReversIP Result;
+end;
+
+macro procedure LowTags U;
+ DeclareTagRange(cdr U, 0, 1);
+
+macro procedure MidTags U;
+ DeclareTagRange(cdr U, LSH(1, get('TagBitLength, 'WConst) - 1) -2, -1);
+
+macro procedure HighTags U;
+ DeclareTagRange(cdr U, LSH(1, get('TagBitLength, 'WConst)) - 1, -1);
+>>;
+
+% JumpInType and friends depend on the ordering and contiguity of
+% the numeric type tags. Fast arithmetic depends on PosInt = 0,
+% NegInt = -1. Garbage collectors depend on pointer tags being
+% between PosInt and Code, non-inclusive. /csp
+
+LowTags(PosInt, FixN, BigN, FltN, Str, Bytes, HalfWords, Wrds, Vect, Pair,
+ Evect);
+
+put('Code, 'WConst, 15);
+
+% Extended addressing treats negative word (one with aits high-order bit
+% on) as a local address--hence pointer types must have (positive) MidTags
+
+MidTags( ID, Unbound, BtrTag, Forward,
+ HVect, HWrds, HHalfWords, HBytes);
+
+HighTags(NegInt);
+
+% Item constructor macros
+
+lisp procedure MakeItemConstructor(TagPart, InfPart);
+ list('MkItem, TagPart, InfPart);
+
+syslsp macro procedure MkBTR U;
+ MakeItemConstructor('(wconst BtrTag), cadr U);
+
+syslsp macro procedure MkID U;
+ MakeItemConstructor('(wconst ID), cadr U);
+
+syslsp macro procedure MkFIXN U;
+ MakeItemConstructor('(wconst FIXN), cadr U);
+
+syslsp macro procedure MkFLTN U;
+ MakeItemConstructor('(wconst FLTN), cadr U);
+
+syslsp macro procedure MkBIGN U;
+ MakeItemConstructor('(wconst BIGN), cadr U);
+
+syslsp macro procedure MkPAIR U;
+ MakeItemConstructor('(wconst PAIR), cadr U);
+
+syslsp macro procedure MkVEC U;
+ MakeItemConstructor('(wconst VECT), cadr U);
+
+syslsp macro procedure MkEVECT U;
+ MakeItemConstructor('(wconst EVECT), cadr U);
+
+syslsp macro procedure MkWRDS U;
+ MakeItemConstructor('(wconst WRDS), cadr U);
+
+syslsp macro procedure MkSTR U;
+ MakeItemConstructor('(wconst STR), cadr U);
+
+syslsp macro procedure MkBYTES U;
+ MakeItemConstructor('(wconst BYTES), cadr U);
+
+syslsp macro procedure MkHalfWords U;
+ MakeItemConstructor('(wconst HalfWords), cadr U);
+
+syslsp macro procedure MkCODE U;
+ MakeItemConstructor('(wconst CODE), cadr U);
+
+% Access to tag (type indicator) of Lisp item in ordinary code
+
+syslsp macro procedure Tag U;
+ list('Field, cadr U, '(wconst TagStartingBit), '(wconst TagBitLength));
+
+
+% Access to info field of item (pointer or immediate operand)
+
+syslsp macro procedure Inf U;
+ list('Field, cadr U, '(wconst InfStartingBit), '(wconst InfBitLength));
+
+syslsp macro procedure PutInf U;
+ list('PutField, cadr U, '(wconst InfStartingBit),
+ '(wconst InfBitLength), caddr U);
+
+for each X in '(IDInf StrInf VecInf EvecInf PairInf WrdInf HalfWordInf CodeInf
+ FixInf FltInf BigInf) do
+ PutD(X, 'Macro, cdr getd 'Inf);
+
+for each X in '(PutIDInf PutStrInf PutVecInf PutPairInf PutWrdInf
+ PutHalfWordInf PutEvecInf
+ PutFixInf PutFltInf PutBigInf) do
+ PutD(X, 'Macro, cdr getd 'PutInf);
+
+% IntInf is no longer needed, will be a macro no-op
+% for the time being
+
+RemProp('IntInf, 'OpenFn);
+
+macro procedure IntInf U;
+ cadr U;
+
+% Similarly for MkINT
+
+macro procedure MkINT U;
+ cadr U;
+
+% # of words in a pair
+
+syslsp macro procedure PairPack U;
+ 2;
+
+% length (in characters, words, etc.) of a string, vector, or whatever,
+% stored in the first word pointed to
+
+syslsp macro procedure GetLen U;
+ list('SignedField, list('GetMem, cadr U), '(WConst InfStartingBit),
+ '(WConst InfBitLength));
+
+syslsp macro procedure StrBase U; % point to chars of string
+ list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem));
+
+% chars string length --> words string length
+
+% Don't add 1 in this! (Put change in at some reasonable time.)
+% Actually need space for extra null, but magic constant to add
+% to determine number of words needed is CharsPerWord-1, so all
+% cancels out. /csp 2-28-83
+syslsp macro procedure StrPack U;
+ list('WQuotient, list('WPlus2, cadr U,
+ list('WPlus2, '(WConst CharactersPerWord),
+ 1)),
+ '(WConst CharactersPerWord));
+
+% access to bytes of string; skip first word
+
+syslsp macro procedure StrByt U;
+ list('Byte, list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem)),
+ caddr U);
+
+syslsp macro procedure PutStrByt U;
+ list('PutByte, list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem)),
+ caddr U,
+ cadddr U);
+
+% access to halfword entries; skip first word
+
+syslsp macro procedure HalfWordItm U;
+ list('HalfWord, list('WPlus2, cadr U,
+ '(WConst AddressingUnitsPerItem)),
+ caddr U);
+
+syslsp macro procedure PutHalfWordItm U;
+ list('PutHalfWord, list('WPlus2, cadr U,
+ '(WConst AddressingUnitsPerItem)),
+ caddr U,
+ cadddr U);
+
+% halfword length --> words length
+
+% Should add 1 before shift! /csp 2-28-83
+syslsp macro procedure HalfWordPack U;
+ list('WPlus2, list('WShift, cadr U, -1), 1);
+
+
+% length (in Item size quantities) of Lisp vectors
+
+% size of Lisp vector in words
+
+% Adding 1 not needed for GtVect! /csp 2-28-83
+syslsp macro procedure VectPack U;
+ list('WPlus2, cadr U, 1);
+
+% size of Lisp Evector in words
+% See comment above! /csp
+syslsp macro procedure EVectPack U;
+ list('WPlus2, cadr U, 1);
+
+% access to elements of Lisp vector
+
+syslsp macro procedure VecItm U;
+ list('WGetV, cadr U,
+ list('WPlus2, caddr U, 1));
+
+syslsp macro procedure PutVecItm U;
+ list('WPutV, cadr U,
+ list('WPlus2, caddr U, 1),
+ cadddr U);
+
+% access to elements of Lisp Evector
+
+syslsp macro procedure EVecItm U;
+ list('WGetV, cadr U,
+ list('WPlus2, caddr U, 1));
+
+syslsp macro procedure PutEVecItm U;
+ list('WPutV, cadr U,
+ list('WPlus2, caddr U, 1),
+ cadddr U);
+
+
+% Wrd is like Vect, but not traced by the garbage collector
+
+% See comment for VectPack, above! /csp 2-28-83
+syslsp macro procedure WrdPack U;
+ list('WPlus2, cadr U, 1);
+
+for each X in '(StrLen ByteLen VecLen EVecLen WrdLen HalfWordLen) do
+ PutD(X, 'Macro, cdr getd 'GetLen);
+
+PutD('WrdItm, 'Macro, cdr GetD 'VecItm);
+
+PutD('PutWrdItm, 'Macro, cdr GetD 'PutVecItm);
+
+% So what about FixPack and FloatPack, turkeys? /csp 2-28-83
+
+syslsp macro procedure FixVal U;
+ list('WGetV, cadr U, 1);
+
+syslsp macro procedure PutFixVal U;
+ list('WPutV, cadr U, 1, caddr U);
+
+
+syslsp macro procedure FloatBase U;
+ list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem));
+
+syslsp macro procedure FloatHighOrder U;
+ list('WGetV, cadr U, 1);
+
+syslsp macro procedure FloatLowOrder U;
+ list('WGetV, cadr U, 2);
+
+
+% New addition: A code pointer can have the number of arguments it expects
+% stored in the word just before the entry
+syslsp macro procedure !%code!-number!-of!-arguments U;
+ list('WGetV, cadr U, -1);
+
+% The four basic cells for each symbol: Val, Nam, Fnc, Prp, corresponding to
+% variable value, symbol name (as string), function cell (jump to compiled
+% code or lambda linker) and property list (pairs for PUT, GET, atoms for FLAG,
+% FLAGP). These are currently 4 separate arrays, but this representation may
+% be changed to a contiguous 4 element record for each symbol or something else
+% and therefore should not be accessed as arrays.
+
+syslsp macro procedure SymVal U;
+ list('WGetV, '(WConst SymVal), cadr U);
+
+syslsp macro procedure PutSymVal U;
+ list('WPutV, '(WConst SymVal), cadr U, caddr U);
+
+syslsp macro procedure LispVar U; % Access value cell by name
+ list('(WConst SymVal), list('IDLoc, cadr U));
+
+syslsp macro procedure PutLispVar U;
+ list('PutSymVal, list('IDLoc, cadr U), caddr U);
+
+syslsp macro procedure SymNam U;
+ list('WGetV, '(WConst SymNam), cadr U);
+
+syslsp macro procedure PutSymNam U;
+ list('WPutV, '(WConst SymNam), cadr U, caddr U);
+
+% Retrieve the address stored in the function cell
+
+% SymFnc and PutSymFnc are not defined portably
+
+syslsp macro procedure SymPrp U;
+ list('WGetV, '(WConst SymPrp), cadr U);
+
+syslsp macro procedure PutSymPrp U;
+ list('WPutV, '(WConst SymPrp), cadr U, caddr U);
+
+
+
+% Binding stack primitives
+
+syslsp macro procedure BndStkID U;
+ list('WGetV, cadr U, -1);
+
+syslsp macro procedure PutBndStkID U;
+ list('WPutV, cadr U, -1, caddr U);
+
+syslsp macro procedure BndStkVal U;
+ list('GetMem, cadr U);
+
+syslsp macro procedure PutBndStkVal U;
+ list('PutMem, cadr U, caddr U);
+
+syslsp macro procedure AdjustBndStkPtr U;
+ list('WPlus2, cadr U,
+ list('WTimes2, caddr U,
+ list('WTimes2,
+ '(WConst AddressingUnitsPerItem),
+ 2)));
+
+% ObArray is a linearly allocated hash table containing ID numbers of entries
+% maintained as a circular buffer. It is referenced only via these macros
+% because we may decide to change to some other representation.
+
+syslsp smacro procedure ObArray I;
+ HalfWord(HashTable, I);
+
+syslsp smacro procedure PutObArray(I, X);
+ HalfWord(HashTable, I) := X;
+
+put('ObArray, 'Assign!-Op, 'PutObArray);
+
+syslsp smacro procedure OccupiedSlot U;
+ ObArray U > 0;
+
+DefList('((GetMem PutMem)
+ (Field PutField)
+ (Byte PutByte)
+ (HalfWord PutHalfWord)
+ (Tag PutTag)
+ (Inf PutInf)
+ (IDInf PutIDInf)
+ (StrInf PutStrInf)
+ (VecInf PutVecInf)
+ (EVecInf PutEVecInf)
+ (WrdInf PutWrdInf)
+ (PairInf PutPairInf)
+ (FixInf PutFixInf)
+ (FixVal PutFixVal)
+ (FltInf PutFltInf)
+ (BigInf PutBigInf)
+ (StrLen PutStrLen)
+ (StrByt PutStrByt)
+ (VecLen PutVecLen)
+ (EVecLen PutEvecLen)
+ (VecItm PutVecItm)
+ (EVecItm PutEVecItm)
+ (WrdLen PutWrdLen)
+ (WrdItm PutWrdItm)
+ (SymVal PutSymVal)
+ (LispVar PutLispVar)
+ (SymNam PutSymNam)
+ (SymFnc PutSymFnc)
+ (SymPrp PutSymPrp)
+ (BndStkID PutBndStkID)
+ (BndStkVal PutBndStkVal)), 'Assign!-Op);
+
+% This is redefined for the HP 9836 to cure the high-order FF problem
+
+macro procedure !%chipmunk!-kludge x;
+ cadr x;
+
+END;
ADDED psl-1983/3-1/comp/20/dec20-asm.build
Index: psl-1983/3-1/comp/20/dec20-asm.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-asm.build
@@ -0,0 +1,6 @@
+CompileTime <<
+load If!-System;
+load SysLisp;
+off UserMode;
+>>;
+in "DEC20-ASM.RED"$
ADDED psl-1983/3-1/comp/20/dec20-asm.ctl
Index: psl-1983/3-1/comp/20/dec20-asm.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-asm.ctl
@@ -0,0 +1,11 @@
+; Rebuild the ASM module
+@def dsk: dsk:,p20ec:,p20c:,pc:
+@def pl: ple:
+@term page 0
+@get psl:ex-rlisp
+@st
+*load build;
+*build "DEC20-ASM";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/3-1/comp/20/dec20-asm.red
Index: psl-1983/3-1/comp/20/dec20-asm.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-asm.red
@@ -0,0 +1,243 @@
+
+% 20-ASM.RED - Dec-20 specific information for LAP-TO-ASM
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 21-May-83 Mark R. Swanson
+% Added changes to support extended addressing.
+% <PSL.20-COMP>20-ASM.RED.1, 25-Feb-82 16:46:44, Edit by BENSON
+% Converted from VAX version
+
+fluid '(CodeFileNameFormat!*
+ DataFileNameFormat!*
+ InputSymFile!*
+ OutputSymFile!*
+ CommentFormat!*
+ LabelFormat!*
+ ExternalDeclarationFormat!*
+ ExportedDeclarationFormat!*
+ FullWordFormat!*
+ DoubleFloatFormat!*
+ ReserveZeroBlockFormat!*
+ ReserveDataBlockFormat!*
+ DefinedFunctionCellFormat!*
+ UndefinedFunctionCellInstructions!*
+ MainEntryPointName!*
+ !*MainFound
+ CodeOut!*
+ DataOut!*
+ !*Lower
+ ASMOpenParen!*
+ ASMCloseParen!*
+ NumericRegisterNames!*);
+
+CodeFileNameFormat!* := "%w.mac";
+DataFileNameFormat!* := "d%w.mac";
+InputSymFile!* := "20.sym";
+OutputSymFile!* := "20.sym";
+GlobalDataFileName!* := "global-data.red"$
+MainEntryPointName!* := 'MAIN!.;
+NumericRegisterNames!* := '[0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15];
+CommentFormat!* := "; %p%n";
+LabelFormat!* := "%w:";
+ExternalDeclarationFormat!* := " extern %w%n";
+ExportedDeclarationFormat!* := " intern %w%n";
+FullWordFormat!* := " %e%n"; % FullWord expects %e for parameter
+IndWordFormat!*:= " IFIW %e%n"; % For extended addressing.
+DoubleFloatFormat!* := " %w%n 0%n";
+ReserveZeroBlockFormat!* := "%w: block %e%n";
+ReserveDataBlockFormat!* := " block %e%n";
+DefinedFunctionCellFormat!* := " jrst %w##%n";
+UndefinedFunctionCellInstructions!* :=
+ '((jsp (reg t5) (Entry UndefinedFunction)));
+ASMOpenParen!* := '!<;
+ASMCloseParen!* := '!>;
+
+DefList('((LAnd !&)
+ (LOr !!)
+ (LXor !^!!)
+ (LSH !_)), 'BinaryASMOp);
+
+put('LNot, 'UnaryASMOp, '!^!-);
+
+DefList('((t1 6)
+ (t2 7)
+ (t3 8)
+ (t4 9)
+ (t5 10)
+ (t6 11)
+ (nil 0)
+ (st 15)), 'RegisterName);
+
+put('MkItem2, 'ASMExpressionFormat, "<%e_30>+<%e_18>+%e");
+put('MkItem1, 'ASMExpressionFormat, "<%e_30>+%e");
+put('MkItem, 'ASMExpressionFunction, 'ASMPseudoMkItem);
+
+lisp procedure ASMPseudoMkItem U;
+%
+% (MkItem Tag Inf)
+%
+ if (second U) > 0 and (second U) < 15 % PointerTagP
+ then % use a format that generates a global address
+ PrintExpression List('MkItem2, second U, 1, third U) % force section
+ % # to 1
+ else
+ PrintExpression List('MkItem1, second U, third U);
+
+lisp procedure CodeFileHeader();
+ CodePrintF " search monsym,macsym%n radix 10%n";
+
+lisp procedure DataFileHeader();
+ DataPrintF " radix 10%n";
+
+lisp procedure CodeFileTrailer();
+ CodePrintF(if !*MainFound then " end MAIN.%n" else " end%n");
+
+lisp procedure DataFileTrailer();
+ DataPrintF " end%n";
+
+lisp procedure CodeBlockHeader();
+ NIL;
+
+lisp procedure CodeBlockTrailer();
+ NIL;
+
+lisp procedure DataAlignFullWord();
+ NIL;
+
+lisp procedure PrintString S;
+begin scalar N;
+ N := Size S;
+ PrintF " byte(7)";
+ for I := 0 step 1 until N do
+ << PrintExpression Indx(S, I);
+ Prin2 '!, >>;
+ PrintExpression 0;
+ TerPri();
+end;
+
+lisp procedure PrintByteList L;
+ if null L then NIL else
+ << PrintF " byte(7)";
+ while cdr L do
+ << PrintExpression car L;
+ Prin2 '!,;
+ L := cdr L >>;
+ PrintExpression car L;
+ TerPri() >>;
+
+lisp procedure PrintByte X;
+<< PrintF " byte(7)";
+ PrintExpression X;
+ TerPri() >>;
+
+lisp procedure PrintHalfWordList L;
+ if null L then NIL else
+ << PrintF " byte(18)";
+ while cdr L do
+ << PrintExpression car L;
+ Prin2 '!,;
+ L := cdr L >>;
+ PrintExpression car L;
+ TerPri() >>;
+
+lisp procedure PrintOpcode X;
+ Prin2 X;
+
+lisp procedure SpecialActionForMainEntryPoint();
+%
+% "Hardwire" HEAPs into sections 2 & 4; code modifies self to avoid
+% recreating sections on re-entry.
+
+ <<DataPrintF(" intern HEAP%n HEAP=2,,0%n");
+ DataPrintF(" intern HEAP2%n HEAP2=4,,0%n");
+ CodePrintF " intern MAIN.%nMAIN.:";
+ CodePrintF " reset%% %n";
+ CodePrintF " setzm 1%n"; % initially create sections 2,3,4
+ CodePrintF " move 2,[.fhslf,,2]%n";
+ CodePrintF " move 3,[140000,,3]%n";
+ CodePrintF "smap.: smap%%%n";
+ CodePrintF " move 1,[jfcl]%n"; % make sure it only happens once
+ CodePrintF " movem 1,smap.%n";>>; % by stuffing a NOOP instruction
+
+lisp procedure ASMSymbolP X;
+ Radix50SymbolP(if IDP X then ID2String X else X);
+
+lisp procedure Radix50SymbolP X;
+begin scalar N, C, I;
+ N := Size X;
+ if N > 5 then return NIL;
+ C := Indx(X, 0);
+ if not (C >= char A and C <= char Z
+ or C = char !% or C = char !. or C = char !$) then return NIL;
+ I := 1;
+Loop:
+ if I > N then return T;
+ C := Indx(X, I);
+ if not (C >= char A and C <= char Z
+ or C >= char !0 and C <= char !9
+ or C = char !% or C = char !. or C = char !$) then return NIL;
+ I := I + 1;
+ goto Loop;
+end;
+
+lisp procedure PrintNumericOperand X;
+ if ImmediateP X then Prin2 X else PrintF("[%w]", X);
+
+lisp procedure OperandPrintIndirect X;
+<< Prin2 '!@;
+ PrintOperand cadr X >>;
+
+put('Indirect, 'OperandPrintFunction, 'OperandPrintIndirect);
+
+lisp procedure OperandPrintIndexed X;
+<< X := cdr X;
+ PrintExpression cadr X;
+ Prin2 '!(;
+ PrintOperand car X;
+ Prin2 '!) >>;
+
+put('Indexed, 'OperandPrintFunction, 'OperandPrintIndexed);
+
+macro procedure Immediate X; % immediate does nothing on the 20
+ cadr X;
+
+lisp procedure ASMPseudoFieldPointer U;
+%
+% (FieldPointer Operand StartingBit Length)
+%
+<< U := cdr U;
+ Prin2 "point ";
+ PrintExpression third U;
+ Prin2 '!, ;
+ PrintOperand first U;
+ Prin2 '!, ;
+ PrintExpression list('difference, list('plus2, second U, third U), 1) >>;
+
+put('FieldPointer, 'ASMExpressionFunction, 'ASMPseudoFieldPointer);
+
+procedure MCPrint(x); % Echo of MC's
+ CodePrintF("; %p%n",x);
+
+procedure InstructionPrint(x);
+ CodePrintF( "; %p%n",x);
+
+procedure !*cerror x;
+ begin scalar i;
+ i:=wrs Nil;
+ printf( "%n *** CERROR: %r %n ",x);
+ wrs i;
+ return list list('cerror,x);
+ end;
+
+put('cerror,'asmpseudoop,'printcomment);
+
+DefCmacro !*cerror;
+
+END;
ADDED psl-1983/3-1/comp/20/dec20-cmac.build
Index: psl-1983/3-1/comp/20/dec20-cmac.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-cmac.build
@@ -0,0 +1,9 @@
+CompileTime <<
+on EolInStringOK;
+macro procedure !* U;
+ NIL;
+flag('(TagNumber InumP), 'lose);
+>>;
+imports '(dec20-comp);
+in "p20ec:tags.red"$
+in "dec20-cmac.sl"$
ADDED psl-1983/3-1/comp/20/dec20-cmac.ctl
Index: psl-1983/3-1/comp/20/dec20-cmac.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-cmac.ctl
@@ -0,0 +1,11 @@
+; Rebuild the CMAC module
+@term page 0
+@def dsk: dsk:,p20ec:,p20c:
+@def pl: ple:
+@get psl:ex-rlisp
+@st
+*load build;
+*build "DEC20-CMAC";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/3-1/comp/20/dec20-cmac.sl
Index: psl-1983/3-1/comp/20/dec20-cmac.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-cmac.sl
@@ -0,0 +1,818 @@
+%
+% 20-CMAC.SL - Patterns and predicates for Dec-20 PSL cmacro expansion
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 14 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 21-May-83 Mark R. Swanson
+% Adapted for Extended addressing on -20. Added IdTagP test to *MkItem to
+% optimize ID cases.
+% <PSL.20-COMP>20-CMAC.SL.1, 21 October 1982, Griss
+% Fixed foreign function for CROSS compiler
+
+% <PSL.20-COMP>20-CMAC.SL.1, 24-Feb-82 12:08:45, Edit by BENSON
+% Adapted VAX version for Dec-20
+
+
+(fluid '(AddressingUnitsPerItem
+ CharactersPerWord
+ StackDirection
+ !*ImmediateQuote
+ AddressingUnitsPerFunctionCell))
+
+(setq AddressingUnitsPerItem 1)
+
+(setq CharactersPerWord 5)
+
+(setq AddressingUnitsPerFunctionCell 1)
+
+(setq StackDirection 1)
+
+(setq !*ImmediateQuote NIL)
+
+(ds BitMask (Start End)
+ (land (lsh -1 (minus Start)) (lsh -1 (difference 35 End))))
+
+(dm Bit (U)
+ (progn (setq U (cdr U))
+ (cond ((null U) 0)
+ (t (ExpandBit U)))))
+
+(de ExpandBit (U)
+ (cond ((null (cdr U)) (list 'lsh 1 (list 'difference 35 (car U))))
+ (t (list 'lor
+ (list 'lsh 1 (list 'difference 35 (car U)))
+ (ExpandBit (cdr U))))))
+
+% "InumP tells what numbers can be immediate operands on the target machine."
+
+(de InumP (Expression)
+ (and (FixP Expression)
+ (leq Expression 8#777777)
+ (geq Expression (minus 8#1000000))))
+
+
+(de TagNumber (X)
+ (cond ((IDP X) (get 'ID 'WConst))
+ ((PairP X) (get 'PAIR 'WConst))
+ ((StringP X) (get 'STR 'WConst))
+ ((InumP X) (cond ((MinusP X) 63) (t 0)))
+ ((CodeP X) (get 'CODE 'WConst))
+ ((FloatP X) (get 'FltN 'WConst))
+ ((VectorP X) (get 'VECT 'WConst))
+ ((FixP X) (get 'FixN 'WConst))))
+
+(de IdTagP (X)
+ (and (ImmediateP X)
+ (eq X (get 'ID 'WConst))))
+
+(de ImmediateP (X)
+ (or (EqCar X 'Immediate)
+ (and (FixP X) (leq X 8#777777) (geq X (minus 8#777777)))))
+
+(de AddrExpressionP (X)
+ (and (EqCar x 'Immediate)
+ (Null (FixP (cadr x)))))
+
+(de MemoryP (X)
+ (not (ImmediateP X)))
+
+(de NegativeImmediateP (X)
+ (and (FixP X)
+ (MinusP X)
+ (geq X (minus 8#777777))))
+
+(de SixP (X)
+ (equal X 6))
+
+(de SevenP (X)
+ (equal X 7))
+
+(de TwelveP (X)
+ (equal X 12))
+
+(de EighteenP (X)
+ (equal X 18))
+
+(de TwentyFourP (X)
+ (equal X 24))
+
+(de ThirtyP (X)
+ (equal X 30))
+
+(de NonIndirectP (Expression)
+ (not (EqCar Expression 'Indirect)))
+
+(de FakeRegisterNumberP (Expression)
+ (and (IntP Expression) (GreaterP Expression 5)))
+
+
+% "Leave Indexed and Indirect alone in recursive c-macro"
+
+(flag '(Indexed Indirect UnImmediate) 'TerminalOperand)
+
+(DefAnyreg CAR
+ AnyregCAR
+ ((RegisterP) (Indexed SOURCE 0))
+ ((move REGISTER SOURCE) (Indexed REGISTER 0)))
+
+(DefAnyreg CDR
+ AnyregCDR
+ ((RegisterP) (Indexed SOURCE 1))
+ ((move REGISTER SOURCE) (Indexed REGISTER 1)))
+
+(DefAnyreg QUOTE
+ AnyregQUOTE
+ ((Null) (REG NIL))
+ ((EqTP) (FLUID T))
+ ((InumP) SOURCE)
+ ((QUOTE SOURCE)))
+
+(DefAnyreg WVAR
+ AnyregWVAR
+ ((RegisterNameP) (REG SOURCE))
+ ((WVAR SOURCE)))
+
+(DefAnyreg MEMORY
+ AnyregMEMORY
+ ((RegisterP AnyP) (Indexed SOURCE ARGTWO))
+ ((AddressConstantP ZeroP) (UnImmediate SOURCE))
+ ((!*MOVE SOURCE REGISTER)
+ (Indexed REGISTER ARGTWO)))
+
+(DefAnyreg FRAME
+ AnyregFRAME
+ ((Indexed (REG st) SOURCE)))
+
+(DefAnyreg REG
+ AnyregREG
+ ((FakeRegisterNumberP) (ExtraReg SOURCE))
+ ((REG SOURCE)))
+
+(DefCMacro !*Call
+ ((InternallyCallableP) (pushj (reg st) (InternalEntry ARGONE)))
+ ((pushj (reg st) (Entry ARGONE))))
+
+(DefCMacro !*JCall
+ ((InternallyCallableP) (jrst (InternalEntry ARGONE)))
+ ((jrst (Entry ARGONE))))
+
+(DefCMacro !*Move
+ (Equal)
+ ((ZeroP AnyP) (setzm ARGTWO))
+ ((MinusOneP AnyP) (setom ARGTWO))
+ ((NegativeImmediateP RegisterP)
+ (movni ARGTWO (minus ARGONE)))
+ ((AddrExpressionP RegisterP) (xmovei ARGTWO ARGONE))
+ ((ImmediateP RegisterP) (hrrzi ARGTWO ARGONE))
+ ((AnyP RegisterP) (move ARGTWO ARGONE))
+ ((RegisterP AnyP) (movem ARGONE ARGTWO))
+ ((!*MOVE ARGONE (reg t1)) (movem (reg t1) ARGTWO)))
+
+(DefCMacro !*Alloc
+ ((ZeroP))
+ ((adjsp (REG st) ARGONE)))
+
+(DefCMacro !*DeAlloc
+ ((ZeroP))
+ ((adjsp (REG st) (minus ARGONE))))
+
+(DefCMacro !*Exit
+ ((!*DeAlloc ARGONE)
+ (popj (reg st) 0)))
+
+(DefCMacro !*Jump
+ ((jrst ARGONE)))
+
+(DefCMacro !*Lbl
+ (ARGONE))
+
+(DefCMacro !*WPlus2
+ ((AnyP OneP) (aos ARGONE))
+ ((AnyP MinusOneP) (sos ARGONE))
+ ((AnyP RegisterP) (addm ARGTWO ARGONE))
+ ((RegisterP NegativeImmediateP) (subi ARGONE (minus ARGTWO)))
+ ((RegisterP ImmediateP) (addi ARGONE ARGTWO))
+ ((RegisterP AnyP) (add ARGONE ARGTWO))
+ ((!*MOVE ARGTWO (reg t2)) (addm (reg t2) ARGONE)))
+
+(DefCMacro !*WDifference
+ ((AnyP OneP) (sos ARGONE))
+ ((AnyP MinusOneP) (aos ARGONE))
+ ((RegisterP NegativeImmediateP) (addi ARGONE (minus ARGTWO)))
+ ((RegisterP ImmediateP) (subi ARGONE ARGTWO))
+ ((RegisterP AnyP) (sub ARGONE ARGTWO))
+ ((!*WMINUS (reg t2) ARGTWO) (addm (reg t2) ARGONE)))
+
+(DefCMacro !*WTimes2
+ ((AnyP MinusOneP) (!*WMINUS ARGONE ARGONE))
+ ((RegisterP NegativeImmediateP)
+ (imul ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (imuli ARGONE ARGTWO))
+ ((RegisterP AnyP) (imul ARGONE ARGTWO))
+ ((AnyP RegisterP) (imulm ARGTWO ARGONE))
+ ((!*MOVE ARGTWO (reg t2)) (imulm (reg t2) ARGONE)))
+
+(DefCMacro !*WAnd
+ ((RegisterP NegativeImmediateP)
+ (and ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (andi ARGONE ARGTWO))
+ ((RegisterP AnyP) (and ARGONE ARGTWO))
+ ((AnyP RegisterP) (andm ARGTWO ARGONE))
+ ((!*MOVE (reg t2) ARGTWO) (andm (reg t2) ARGONE)))
+
+(DefCMacro !*WOr
+ ((RegisterP NegativeImmediateP)
+ (ior ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (iori ARGONE ARGTWO))
+ ((RegisterP AnyP) (ior ARGONE ARGTWO))
+ ((AnyP RegisterP) (iorm ARGTWO ARGONE))
+ ((!*MOVE (reg t2) ARGTWO) (iorm (reg t2) ARGONE)))
+
+(DefCMacro !*WXOr
+ ((RegisterP NegativeImmediateP)
+ (xor ARGONE (lit (fullword ARGTWO))))
+ ((RegisterP ImmediateP) (xori ARGONE ARGTWO))
+ ((RegisterP AnyP) (xor ARGONE ARGTWO))
+ ((AnyP RegisterP) (xorm ARGTWO ARGONE))
+ ((!*MOVE (reg t2) ARGTWO) (xorm (reg t2) ARGONE)))
+
+(DefCMacro !*AShift
+ ((RegisterP ImmediateP) (ash ARGONE ARGTWO))
+ ((RegisterP RegisterP) (ash ARGONE (Indexed ARGTWO 0)))
+ ((RegisterP AnyP)
+ (move (reg t2) ARGTWO)
+ (ash ARGONE (Indexed (reg t2) 0)))
+ ((AnyP ImmediateP)
+ (move (reg t3) ARGONE)
+ (ash (reg t3) ARGTWO)
+ (movem (reg t3) ARGONE))
+ ((AnyP RegisterP)
+ (move (reg t3) ARGONE)
+ (ash (reg t3) (Indexed ARGTWO 0))
+ (movem (reg t3) ARGONE))
+ ((move (reg t2) ARGTWO)
+ (move (reg t3) ARGONE)
+ (ash (reg t3) (Indexed (reg t2) 0))
+ (movem (reg t3) ARGONE)))
+
+(DefCMacro !*WShift
+ ((RegisterP ImmediateP) (lsh ARGONE ARGTWO))
+ ((RegisterP RegisterP) (lsh ARGONE (Indexed ARGTWO 0)))
+ ((RegisterP AnyP)
+ (move (reg t2) ARGTWO)
+ (lsh ARGONE (Indexed (reg t2) 0)))
+ ((AnyP ImmediateP)
+ (move (reg t3) ARGONE)
+ (lsh (reg t3) ARGTWO)
+ (movem (reg t3) ARGONE))
+ ((AnyP RegisterP)
+ (move (reg t3) ARGONE)
+ (lsh (reg t3) (Indexed ARGTWO 0))
+ (movem (reg t3) ARGONE))
+ ((move (reg t2) ARGTWO)
+ (move (reg t3) ARGONE)
+ (lsh (reg t3) (Indexed (reg t2) 0))
+ (movem (reg t3) ARGONE)))
+
+(DefCMacro !*WNot
+ (Equal (setcmm ARGONE))
+ ((RegisterP AnyP) (setcm ARGONE ARGTWO))
+ ((AnyP RegisterP) (setcam ARGTWO ARGONE))
+ ((move (reg t1) ARGTWO) (setcam (reg t1) ARGONE)))
+
+(DefCMacro !*WMinus
+ (Equal (movns ARGONE))
+ ((RegisterP AnyP) (movn ARGONE ARGTWO))
+ ((AnyP RegisterP) (movnm ARGTWO ARGONE))
+ ((move (reg t1) ARGTWO) (movnm (reg t1) ARGONE)))
+
+
+(DefCMacro !*MkItem
+ ((RegisterP IdTagP) % assume ID numbers never slop into left half
+ (hrli ARGONE (lsh ARGTWO 12)))
+ ((RegisterP ImmediateP)
+ (tlz ARGONE 8#770000)
+ (tlo ARGONE (lsh ARGTWO 12)))
+ ((RegisterP RegisterP)
+ (dpb ARGTWO (lit (fullword (FieldPointer ARGONE 0 6)))))
+ ((Registerp Anyp)
+ (!*MOVE ARGTWO (reg t1))
+ (dpb (reg t1) (lit (fullword (FieldPointer ARGONE 0 6)))))
+ ((AnyP RegisterP)
+ (!*MOVE ARGONE (reg t2))
+ (dpb ARGTWO (lit (fullword (FieldPointer (reg t2) 0 6))))
+ (!*MOVE (reg t2) ARGONE))
+ ((!*MOVE ARGONE (reg t2))
+ (!*MOVE ARGTWO (reg t1))
+ (dpb (reg t1) (lit (fullword (FieldPointer (reg t2) 0 6))))
+ (!*MOVE (reg t2) ARGONE)))
+
+
+(DefCMacro !*JumpType
+ ((RegisterP ZeroP)
+ (tlnn ARGONE 8#770000)
+ (jrst ARGTHREE))
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 6))))
+ (!*JUMPEQ ARGTHREE (reg t6) ARGTWO)))
+
+(DefCMacro !*JumpNotType
+ ((RegisterP ZeroP)
+ (tlne ARGONE 8#770000)
+ (jrst ARGTHREE))
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 6))))
+ (!*JUMPNOTEQ ARGTHREE (reg t6) ARGTWO)))
+
+(DefCMacro !*JumpInType
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 6))))
+ (caig (reg t6) ARGTWO)
+ (jrst ARGTHREE)
+ (cain (reg t6) 63)
+ (jrst ARGTHREE))) % (WConst NegInt)
+
+(DefCMacro !*JumpNotInType
+ ((ldb (reg t6) (lit (fullword (FieldPointer ARGONE 0 6))))
+ (cain (reg t6) 63) % (WConst NegInt)
+ (jrst TEMPLABEL)
+ (caile (reg t6) ARGTWO)
+ (jrst ARGTHREE)
+ TEMPLABEL))
+
+(DefCMacro !*JumpEQ
+ ((RegisterP ZeroP) (jumpe ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpe ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipn ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipn ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camn ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camn ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (cain ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (cain ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camn ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camn ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpNotEQ
+ ((RegisterP ZeroP) (jumpn ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpn ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipe ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipe ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (came ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (came ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caie ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caie ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (came ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (came ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPNOTEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPNOTEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWLessP
+ ((RegisterP ZeroP) (jumpl ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpg ARGTWO ARGTHREE))
+ ((RegisterP OneP) (jumple ARGONE ARGTHREE))
+ ((MinusOneP RegisterP) (jumpge ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipge ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skiple ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP OneP)
+ (skipg ARGONE)
+ (jrst ARGTHREE))
+ ((MinusOneP AnyP)
+ (skipl ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camge ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camle ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caige ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caile ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camge ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camle ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWLESSP ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWLESSP ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWGreaterP
+ ((RegisterP ZeroP) (jumpg ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpl ARGTWO ARGTHREE))
+ ((RegisterP MinusOneP) (jumpge ARGONE ARGTHREE))
+ ((OneP RegisterP) (jumple ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skiple ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipge ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP MinusOneP)
+ (skipl ARGONE)
+ (jrst ARGTHREE))
+ ((OneP AnyP)
+ (skipg ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camle ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camge ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caile ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caige ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camle ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camge ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWGreaterP ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWGreaterP ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWLEQ
+ ((RegisterP ZeroP) (jumple ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumpge ARGTWO ARGTHREE))
+ ((RegisterP MinusOneP) (jumpl ARGONE ARGTHREE))
+ ((OneP RegisterP) (jumpg ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipg ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipl ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP MinusOneP)
+ (skipge ARGONE)
+ (jrst ARGTHREE))
+ ((OneP AnyP)
+ (skiple ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (camg ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (caml ARGTWO (lit ARGTHREE))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (caig ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (cail ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (camg ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (caml ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWLEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWLEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*JumpWGEQ
+ ((RegisterP ZeroP) (jumpge ARGONE ARGTHREE))
+ ((ZeroP RegisterP) (jumple ARGTWO ARGTHREE))
+ ((RegisterP OneP) (jumpg ARGONE ARGTHREE))
+ ((MinusOneP RegisterP) (jumpl ARGTWO ARGTHREE))
+ ((AnyP ZeroP)
+ (skipl ARGONE)
+ (jrst ARGTHREE))
+ ((ZeroP AnyP)
+ (skipg ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP OneP)
+ (skiple ARGONE)
+ (jrst ARGTHREE))
+ ((MinusOneP AnyP)
+ (skipge ARGTWO)
+ (jrst ARGTHREE))
+ ((RegisterP NegativeImmediateP)
+ (caml ARGONE (lit (fullword ARGTWO)))
+ (jrst ARGTHREE))
+ ((NegativeImmediateP RegisterP)
+ (camg ARGTWO (lit (fullword ARGONE)))
+ (jrst ARGTHREE))
+ ((RegisterP ImmediateP)
+ (cail ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((ImmediateP RegisterP)
+ (caig ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((RegisterP AnyP)
+ (caml ARGONE ARGTWO)
+ (jrst ARGTHREE))
+ ((AnyP RegisterP)
+ (camg ARGTWO ARGONE)
+ (jrst ARGTHREE))
+ ((MemoryP AnyP)
+ (move (reg t1) ARGONE)
+ (!*JUMPWGEQ ARGTHREE (reg t1) ARGTWO))
+ ((move (reg t2) ARGTWO)
+ (!*JUMPWGEQ ARGTHREE ARGONE (reg t2))))
+
+(DefCMacro !*Push
+ ((ImmediateP) (push (reg st) (lit (fullword ARGONE))))
+ ((push (reg st) ARGONE)))
+
+(DefCMacro !*Pop
+ ((ImmediateP) (pop (reg st) (lit (fullword ARGONE))))
+ ((pop (reg st) ARGONE)))
+
+(DefCMacro !*Freerstr
+ ((jsp (reg t5) (Entry FastUnbind)) (fullword ARGONE)))
+
+(DefCMacro !*Loc
+ ((RegisterP AnyP) (xmovei ARGONE ARGTWO))
+ ((xmovei (reg t2) ARGTWO) (movem (reg t2) ARGONE)))
+
+(DefCMacro !*Field
+% ARGONE is Destination, ARGTWO is Source, ARGTHREE is Starting bit
+% ARGFOUR is Length
+ ((RegisterP AnyP ZeroP EighteenP) (hlrz ARGONE ARGTWO))
+ ((RegisterP AnyP EighteenP EighteenP) (hrrz ARGONE ARGTWO))
+ ((AnyP RegisterP ZeroP EighteenP) (hlrzm ARGTWO ARGONE))
+ ((AnyP RegisterP EighteenP EighteenP) (hrrzm ARGTWO ARGONE))
+ ((RegisterP AnyP TwelveP TwentyFourP)
+ (!*Move ARGTWO ARGONE)
+ (tlz ARGONE 8#777700))
+ ((RegisterP AnyP SixP ThirtyP)
+ (!*Move ARGTWO ARGONE)
+ (tlz ARGONE 8#770000))
+ ((RegisterP) % this might choke with extended addressing?
+ (ldb ARGONE
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR)))))
+ ((ldb (reg t2)
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR))))
+ (movem (reg t2) ARGONE)))
+
+(DefCMacro !*SignedField
+ ((RegisterP AnyP ZeroP EighteenP) (hlre ARGONE ARGTWO))
+ ((RegisterP AnyP EighteenP EighteenP) (hrre ARGONE ARGTWO))
+ ((AnyP RegisterP ZeroP EighteenP) (hlrem ARGTWO ARGONE))
+ ((AnyP RegisterP EighteenP EighteenP) (hrrem ARGTWO ARGONE))
+ ((RegisterP MemoryP)
+ % could optimize to use tlne tlo trne tro
+ (!*MOVE ARGTWO (reg t1))
+ (ldb ARGONE
+ (lit (fullword (FieldPointer
+ (reg t1) ARGTHREE
+ ARGFOUR))))
+ (tdne ARGONE (lit (fullword (bit ARGTHREE))))
+ (tdo ARGONE (lit (fullword (bitmask 0 ARGTHREE)))))
+ ((RegisterP)
+ % could optimize to use tlne tlo trne tro
+ (ldb ARGONE
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR))))
+ (tdne ARGONE (lit (fullword (bit ARGTHREE))))
+ (tdo ARGONE (lit (fullword (bitmask 0 ARGTHREE)))))
+ ((!*MOVE ARGTWO (reg t1))
+ (ldb (reg t2)
+ (lit (fullword (FieldPointer
+ (reg t1) ARGTHREE
+ ARGFOUR))))
+ (tdne (reg t2) (lit (fullword (bit ARGTHREE))))
+ (tdo (reg t2) (lit (fullword (bitmask 0 ARGTHREE))))
+ (!*MOVE (reg t2) ARGONE)))
+
+(DefCMacro !*PutField
+ ((RegisterP RegisterP)
+ (dpb ARGONE
+ (lit (fullword (FieldPointer
+ ARGTWO ARGTHREE
+ ARGFOUR)))))
+ ((Registerp Anyp ZeroP SixP) % a TAG field in memory
+ (!*LOC (reg t1) ARGTWO)
+ (tlo (reg t1) 8#460000)
+ (dpb ARGONE (reg t1)))
+ ((AnyP Anyp ZeroP SixP) % a TAG field in memory
+ (!*LOC (reg t1) ARGTWO)
+ (tlo (reg t1) 8#460000)
+ (!*MOVE ARGONE (reg t2))
+ (dpb (reg t2) (reg t1)))
+
+ ((!*MOVE ARGTWO (reg t2))
+ (!*MOVE ARGONE (reg t1))
+ (dpb (reg t1)
+ (lit (fullword (FieldPointer
+ (reg t2) ARGTHREE
+ ARGFOUR))))
+ (!*MOVE (reg t2) ARGTWO)))
+
+(DefCMacro !*ADJSP
+ ((RegisterP ImmediateP) (adjsp ARGONE ARGTWO))
+ ((RegisterP RegisterP) (adjsp ARGONE (Indexed ARGTWO 0)))
+ ((RegisterP)
+ (move (reg t2) ARGTWO)
+ (adjsp ARGONE (Indexed (reg t2) 0)))
+ ((move (reg t1) ARGONE)
+ (!*ADJSP (reg t1) ARGTWO)
+ (movem (reg t1) ARGONE)))
+
+(DefList '((WQuotient ((idiv (reg 1) (reg 2))))
+ (WRemainder ((idiv (reg 1) (reg 2)) (move (reg 1) (reg 2)))))
+ 'OpenCode)
+
+(!&Tworeg '(WQuotient WRemainder))
+
+(loadtime
+(DefList '((Byte ((tlo (reg 1) 8#620000)
+ (adjbp (reg 2) (reg 1))
+ (ldb (reg 1) (reg 2))))
+ (PutByte ((tlo (reg 1) 8#620000)
+ (adjbp (reg 2) (reg 1))
+ (dpb (reg 3) (reg 2))))
+ (HalfWord ((tlo (reg 1) 8#740000)
+ (adjbp (reg 2) (reg 1))
+ (ldb (reg 1) (reg 2))))
+ (PutHalfWord ((tlo (reg 1) 8#740000)
+ (adjbp (reg 2) (reg 1))
+ (dpb (reg 3) (reg 2))))
+ (BitTable ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 2))))
+ (ldb (reg 1) (reg 2))))
+ (PutBitTable ((adjbp (reg 2)
+ (lit (fullword (FieldPointer
+ (Indexed (reg 1) 0) 0 2))))
+ (dpb (reg 3) (reg 2)))))
+ 'OpenCode))
+
+(loadtime
+(!&TwoReg '(Byte PutByte HalfWord PutHalfWord BitTable PutBitTable)))
+
+(DefList '((IDApply0 ((tlz (reg 1) 8#770000) % essentially: clear LH to make
+ (pushj (reg st) % certain address is local
+ (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 ((tlz (reg 2) 8#770000)
+ (pushj (reg st)
+ (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 ((tlz (reg 3) 8#770000)
+ (pushj (reg st)
+ (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 ((tlz (reg 4) 8#770000)
+ (pushj (reg st)
+ (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 ((tlz (reg 5) 8#770000)
+ (pushj (reg st)
+ (Indexed (reg 5) (WArray SymFnc))))))
+ 'OpenCode)
+
+(DefList '((IDApply0 ((tlz (reg 1) 8#770000)
+ (jrst (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 ((tlz (reg 2) 8#770000)
+ (jrst (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 ((tlz (reg 3) 8#770000)
+ (jrst (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 ((tlz (reg 4) 8#770000)
+ (jrst (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 ((tlz (reg 5) 8#770000)
+ (jrst (Indexed (reg 5) (WArray SymFnc))))))
+ 'ExitOpenCode)
+
+(DefList '((CodeApply0 ((pushj (reg st) (Indexed (reg 1) 0))))
+ (CodeApply1 ((pushj (reg st) (Indexed (reg 2) 0))))
+ (CodeApply2 ((pushj (reg st) (Indexed (reg 3) 0))))
+ (CodeApply3 ((pushj (reg st) (Indexed (reg 4) 0))))
+ (CodeApply4 ((pushj (reg st) (Indexed (reg 5) 0)))))
+ 'OpenCode)
+
+(DefList '((CodeApply0 ((jrst (Indexed (reg 1) 0))))
+ (CodeApply1 ((jrst (Indexed (reg 2) 0))))
+ (CodeApply2 ((jrst (Indexed (reg 3) 0))))
+ (CodeApply3 ((jrst (Indexed (reg 4) 0))))
+ (CodeApply4 ((jrst (Indexed (reg 5) 0)))))
+ 'ExitOpenCode)
+
+(DefList '((AddressApply0 ((pushj (reg st) (Indexed (reg 1) 0))))
+ (AddressApply1 ((pushj (reg st) (Indexed (reg 2) 0))))
+ (AddressApply2 ((pushj (reg st) (Indexed (reg 3) 0))))
+ (AddressApply3 ((pushj (reg st) (Indexed (reg 4) 0))))
+ (AddressApply4 ((pushj (reg st) (Indexed (reg 5) 0)))))
+ 'OpenCode)
+
+(DefList '((AddressApply0 ((jrst (Indexed (reg 1) 0))))
+ (AddressApply1 ((jrst (Indexed (reg 2) 0))))
+ (AddressApply2 ((jrst (Indexed (reg 3) 0))))
+ (AddressApply3 ((jrst (Indexed (reg 4) 0))))
+ (AddressApply4 ((jrst (Indexed (reg 5) 0)))))
+ 'ExitOpenCode)
+
+% "*FEQ, *FGreaterP and !*FLessP can only occur once in a function."
+
+(DefList '((!*WFix ((fix (reg 1) (indexed (reg 1) 0))))
+ (!*WFloat ((fltr (reg 2) (reg 2))
+ (movem (reg 2) (indexed (reg 1) 0))
+ (setzm (indexed (reg 1) 1))))
+ (!*FAssign ((dmove (reg 2) (indexed (reg 2) 0))
+ (dmovem (reg 2) (indexed (reg 1) 0))))
+ (!*FEQ ((dmove (reg 3) (indexed (reg 2) 0))
+ (came (reg 3) (indexed (reg 1) 0))
+ (jrst !*NotEQ!*)
+ (camn (reg 4) (indexed (reg 1) 1))
+ !*NotEQ!*
+ (move (reg 1) (reg nil))))
+ (!*FGreaterP ((dmove (reg 3) (indexed (reg 2) 0))
+ (camge (reg 3) (indexed (reg 1) 0))
+ (jrst !*IsGreaterP!*)
+ (camn (reg 3) (indexed (reg 1) 0))
+ (caml (reg 4) (indexed (reg 1) 1))
+ (move (reg 1) (reg nil))
+ !*IsGreaterP!*))
+ (!*FLessP ((dmove (reg 3) (indexed (reg 2) 0))
+ (camle (reg 3) (indexed (reg 1) 0))
+ (jrst !*IsLessP!*)
+ (camn (reg 3) (indexed (reg 1) 0))
+ (camg (reg 4) (indexed (reg 1) 1))
+ (move (reg 1) (reg nil))
+ !*IsLessP!*))
+ (!*FPlus2 ((dmove (reg 3) (indexed (reg 3) 0))
+ (dfad (reg 3) (indexed (reg 2) 0))
+ (dmovem (reg 3) (indexed (reg 1) 0))))
+ (!*FDifference ((dmove (reg 4) (indexed (reg 2) 0))
+ (dfsb (reg 4) (indexed (reg 3) 0))
+ (dmovem (reg 4) (indexed (reg 1) 0))))
+ (!*FTimes2 ((dmove (reg 3) (indexed (reg 3) 0))
+ (dfmp (reg 3) (indexed (reg 2) 0))
+ (dmovem (reg 3) (indexed (reg 1) 0))))
+ (!*FQuotient ((dmove (reg 4) (indexed (reg 2) 0))
+ (dfdv (reg 4) (indexed (reg 3) 0))
+ (dmovem (reg 4) (indexed (reg 1) 0)))))
+ 'OpenCode)
+
+% Later, do as FORTRAN call?
+(DE !*ForeignLink (FunctionName FunctionType NumberOfArguments)
+ (prog NIL
+ (CodeDeclareExternal FunctionName) % To emit Extern
+ (return (LIST (LIST 'Pushj '(REG st) (LIST 'InternalEntry FunctionName))))
+))
+
+(DefCMacro !*ForeignLink)
ADDED psl-1983/3-1/comp/20/dec20-comp.ctl
Index: psl-1983/3-1/comp/20/dec20-comp.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-comp.ctl
@@ -0,0 +1,11 @@
+; Rebuild the COMP module
+@term page 0
+@def dsk: dsk:,p20ec:,p20c:
+@def pl: ple:
+@get psl:ex-rlisp
+@st
+*load build;
+*build "DEC20-COMP";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/3-1/comp/20/dec20-comp.red
Index: psl-1983/3-1/comp/20/dec20-comp.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-comp.red
@@ -0,0 +1,171 @@
+%
+% 20-COMP.RED - Compiler patterns for Dec-20 PSL, plus a few cmacro expanders
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 21-May-83 Mark R. Swanson
+% Changed *JumpOn to generate Instruction Format Indirect Words for
+% "case" addresses.
+% <PSL.COMP-20>DEC20-COMP.RED.4, 2-Mar-83 18:07:16, Edit by PERDUE
+% Added a USESDEST case to the pattern for SUBPAT
+% <PSL.20-COMP>20-COMP.RED.1, 25-Feb-82 16:34:42, Edit by BENSON
+% Converted from VAX version
+
+
+PUT('TVPAT,'PATTERN,'(
+ !®MEM ('!*DESTROY DEST)
+ ((DEST ANY) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((ANY DEST) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((USESDEST ANY) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((ANY USESDEST) (MAC L1 A1 A2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ (ANY ('!*LOAD DEST '(QUOTE T)) (MAC L1 A1 A2)
+ ('!*LOAD DEST '(QUOTE NIL)) ('!*LBL L1))));
+
+
+PUT('TVPAT1,'PATTERN,'(
+ !®MEM ('!*DESTROY DEST)
+ ((DEST) (MAC L1 A1 P2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ ((USESDEST) (MAC L1 A1 P2) ('!*LOAD DEST '(QUOTE NIL))
+ ('!*JUMP L2) ('!*LBL L1) ('!*LOAD DEST '(QUOTE T)) ('!*LBL L2))
+ (ANY ('!*LOAD DEST '(QUOTE T)) (MAC L1 A1 P2)
+ ('!*LOAD DEST '(QUOTE NIL)) ('!*LBL L1))));
+
+
+PUT('TSTPAT,'PATTERN,'(
+ NIL
+ !&FIXREGTEST
+ ((REGN ANY) (MAC DEST A1 A2))
+ (ANY (MAC DEST A2 A1))));
+
+PUT('TSTPATC,'PATTERN,'(
+ NIL
+ !&SETREGS1
+ ((REGN ANY) (MAC DEST A1 A2))
+ (ANY (P2 DEST A2 A1))));
+
+PUT('TSTPAT2, 'PATTERN, '(
+ NIL !&SETREGS1
+ (ANY (MAC DEST A1 P2))));
+
+PUT('SETQPAT,'PATTERN,'(
+ NIL NIL
+ ((NOVAL ANY NOTANYREG) ('!*STORE A2 A1))
+ ((NOVAL DEST ANY) ('!*STORE A2 DEST))
+ ((NOVAL USESDEST ANY) ('!*LOAD T1 A2) ('!*STORE T1 A1))
+ ((NOVAL ANY ANY) ('!*LOAD DEST A2) ('!*STORE DEST A1))
+ ((ANY DEST) ('!*STORE DEST A1))
+ ((DEST ANY) ('!*STORE A2 DEST))
+ ((USESDEST ANY) ('!*STORE A2 A1) ('!*STORE A2 DEST))
+ (ANY ('!*LOAD DEST A2) ('!*STORE DEST A1))));
+
+PUT('RPLACPAT,'PATTERN,'(
+ NIL NIL
+ ((NOVAL ANY ANY) ('!*STORE A2 (MAC A1)))
+ ((DEST ANY) ('!*STORE A2 (MAC A1)))
+ ((USESDEST ANY) ('!*STORE A2 (MAC A1)) ('!*LOAD DEST A1))
+ ((ANY DEST) ('!*STORE A2 (MAC A1)) ('!*LOAD DEST A1))
+ ((ANY USESDEST) ('!*STORE A2 (MAC A1)) ('!*LOAD DEST A1))
+ (ANY ('!*LOAD DEST A1) ('!*STORE A2 (MAC DEST)))));
+
+PUT('ASSOCPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2))
+ ((DEST ANY) (MAC A1 A2))
+ ((ANY DEST) (MAC A2 A1))
+ ((USESDEST USESDEST) ('!*LOAD T1 A1) ('!*LOAD DEST A2) (MAC DEST T1))
+ ((ANY USESDEST) ('!*LOAD DEST A2) (MAC DEST A1))
+ (ANY ('!*LOAD DEST A1) (MAC DEST A2))));
+
+PUT('SUBPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2))
+ ((DEST ANY) (MAC A1 A2))
+ ((ANY DEST) ('!*WMINUS DEST DEST) ('!*WPLUS2 A2 A1))
+ ((ANY USESDEST) ('!*LOAD T1 A2) ('!*LOAD DEST A1) (MAC DEST T1))
+ (ANY ('!*LOAD DEST A1) (MAC DEST A2))));
+
+PUT('NONASSOCPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2))
+ ((DEST ANY) (MAC A1 A2))
+ ((ANY USESDEST) ('!*LOAD T1 A2) ('!*LOAD DEST A1) (MAC DEST T1))
+ (ANY ('!*LOAD DEST A1) (MAC DEST A2))));
+
+PUT('FIELDPAT,'PATTERN,'(
+ NIL ('!*SET DEST (FN A1 A2 A3))
+ (ANY (MAC DEST A1 A2 A3))));
+
+PUT('PUTFIELDPAT,'PATTERN,'(
+ NIL NIL
+ ((NOVAL ANY ANY ANY ANY) (MAC A1 A2 A3 A4))
+ (ANY (MAC A1 A2 A3 A4) ('!*STORE A1 DEST))));
+
+PUT('UNARYPAT,'PATTERN,'(
+ !&NOANYREG ('!*SET DEST (FN A1))
+ (ANY (MAC DEST A1))));
+
+PUT('MODMEMPAT,'PATTERN,'(
+ NIL NIL
+ (ANY (MAC A1 A2))));
+
+PUT('MODMEMPAT1,'PATTERN,'(
+ NIL NIL
+ (ANY (MAC A1 A1))));
+
+% Potential trouble spot!!!!!!! (for extend addressing)
+
+lisp procedure !*LamBind(Regs, FLst);
+begin scalar X, Y;
+ FLst := reverse cdr FLst;
+ Regs := reverse cdr Regs;
+ while FLst do
+ << if null Regs then
+ X := 0
+ else
+ << X := cadr car Regs;
+ Regs := cdr Regs >>;
+ Y := list('halfword, X, list('IDLoc, cadar FLst)) . Y;
+ FLst := cdr FLst >>;
+ return '(jsp (reg t5) (Entry FastBind)) . Y;
+end;
+
+DefCMacro !*Lambind;
+
+lisp procedure !*JumpOn(Register, LowerBound, UpperBound, LabelList);
+begin scalar ExitLbl, BaseLbl, Result;
+ ExitLbl := GenSym();
+ BaseLbl := GenSym();
+ Result := NIL . NIL;
+ TConc(Result,if LowerBound < 0 then
+ list('caml, Register, list('lit, LowerBound))
+ else
+ list('cail, Register, LowerBound));
+ TConc(Result,if UpperBound < 0 then
+ list('camle, Register, list('lit, UpperBound))
+ else
+ list('caile, Register, UpperBound));
+ TConc(Result,list('jrst, ExitLbl));
+ TConc(Result,
+ list('jrst,
+ list('Indirect,
+ list('Indexed,
+ Register,
+ list('difference, BaseLbl, LowerBound)))));
+ TConc(Result, BaseLbl);
+ for each X in LabelList do
+ TConc(Result, list('indword, cadr X));
+ TConc(Result, ExitLbl);
+ return car Result;
+end;
+
+DefCMacro !*JumpOn;
+
+END;
ADDED psl-1983/3-1/comp/20/dec20-cross.mic
Index: psl-1983/3-1/comp/20/dec20-cross.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-cross.mic
@@ -0,0 +1,21 @@
+@delete s:ex-dec20-cross.exe,
+ exp
+
+
+@get psl:ex-rlisp
+@st
+*Options!*:=NIL; % Force reload of ALL
+*load(zboot, syslisp, if!-system, lap!-to!-asm);
+*load(dec20!-comp,dec20!-asm);
+*load(dec20!-cmac);
+*remflag(''(extrareg),''terminaloperand);
+*off usermode;
+*% This patch is until init files can be read
+*%CopyD(''SaveUncompiledExpression, ''SaveForCompilation);
+*%in "DEC20-PATCHES.sl"$
+*in "pt:new-sym.red"$
+*cross!-compiler!-name := "S:EX-DEC20-CROSS.EXE";
+*Date!* := "Extended Dec 20 cross compiler";
+*writesavefile();
+*Quit;
+@reset .
ADDED psl-1983/3-1/comp/20/dec20-data-machine.red
Index: psl-1983/3-1/comp/20/dec20-data-machine.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-data-machine.red
@@ -0,0 +1,80 @@
+%
+% 20-DATA-MACHINE.RED - Lisp item constructors & selectors for Dec-20 Syslisp
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 July 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.20-COMP>20-DATA-MACHINE.RED.1, 25-Feb-82 17:24:56, Edit by BENSON
+% Converted from VAX version (which was previously converted from 20 version!)
+
+% Primitives handled by the compiler are BYTE, PUTBYTE, GETMEM, PUTMEM,
+% MKITEM, FIELD, SIGNEDFIELD, PUTFIELD
+
+fluid '(system_list!*);
+
+system_list!* := '(ExtDec20 Tops20);
+
+BothTimes <<
+exported WConst TagStartingBit = 0,
+ TagBitLength = 6,
+ InfStartingBit = 6,
+ InfBitLength = 30,
+ GCStartingBit = 0,
+ GCBitLength = 0,
+ AddressingUnitsPerItem = 1,
+ CharactersPerWord = 5,
+ BitsPerWord = 36,
+ AddressingUnitsPerFunctionCell = 1,
+ StackDirection = 1;
+
+>>;
+
+syslsp macro procedure GCField U;
+ list('Field, cadr U, '(WConst GCStartingBit), '(WConst GCBitLength));
+
+syslsp macro procedure PutGCField U;
+ list('PutField, cadr U, '(WConst GCStartingBit), '(WConst GCBitLength),
+ caddr U);
+
+% Retrieve the address stored in the function cell and strip off 'JRST' part
+
+syslsp macro procedure SymFnc U;
+% list ('Wshift,
+ % list ('WShift, list('WGetV, '(WConst SymFnc), cadr U), 9),
+ % -9);
+ list('Field, list('WGetV, '(WConst SymFnc), cadr U), 12, 24);
+
+syslsp macro procedure PutSymFnc U;
+% put JRST instr. part in table.
+% list('WPutV, '(WConst SymFnc), cadr U, '(Wor 8#254000000000, caddr U);
+ list('WPutV, '(WConst SymFnc), cadr U, MkCode caddr U);
+% list('PutField, caddr U,'(Plus2 '(WConst SymFnc), cadr u), 9, 27);
+
+% Macros for building stack pointers
+
+syslsp macro procedure MakeStackPointerFromAddress U;
+% when code resides in more than one section, the following will need to be
+% changed to put the section number rather than a count in the left half
+ list('WOr, list('WShift, list('WDifference, 0, caddr U), 18),
+ list('WDifference, cadr U, 1));
+
+syslsp macro procedure MakeAddressFromStackPointer U;
+%the next line will be the definition needed when code resides in more than
+% one section.
+% list('Field, cadr U, InfStartingBit, InfBitLength);
+% list('Field, cadr U, 18, 18);
+ list('Wor, list('Field, cadr U, 18, 18), 8#1000000);
+
+put('AdjustStackPointer,'OpenFn,'(NonAssocPat !*ADJSP));
+
+lisp procedure !*ADJSP(Arg1, Arg2);
+ Expand2OperandCMacro(Arg1, Arg2, '!*ADJSP);
+
+put('EOF, 'CharConst, char cntrl Z);
+
+END;
ADDED psl-1983/3-1/comp/20/dec20-lap.build
Index: psl-1983/3-1/comp/20/dec20-lap.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-lap.build
@@ -0,0 +1,25 @@
+CompileTime <<
+load Syslisp;
+put('negint,'wconst,63);
+>>;
+
+Compiletime <<
+exported WConst TagStartingBit = 0,
+ TagBitLength = 6,
+ InfStartingBit = 6,
+ InfBitLength = 30,
+ GCStartingBit = 0,
+ GCBitLength = 0,
+ AddressingUnitsPerItem = 1,
+ CharactersPerWord = 5,
+ BitsPerWord = 36,
+ AddressingUnitsPerFunctionCell = 1,
+ StackDirection = 1;
+
+>>;
+
+in "p20e:system-faslout.red"$
+in "dec20-lap.red"$
+in "instrs.sl"$
+
+end;
ADDED psl-1983/3-1/comp/20/dec20-lap.red
Index: psl-1983/3-1/comp/20/dec20-lap.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/dec20-lap.red
@@ -0,0 +1,460 @@
+%
+% 20-LAP.RED - Dec-20 PSL assembler
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 1 February 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 27-May-1983 Mark R. Swanson
+% Added IndWord support for Extended adressing on -20
+
+fluid '(LabelOffsets!* CurrentOffset!* CodeSize!* CodeBase!* Entries!*
+ ForwardInternalReferences!*
+ NewBitTableEntry!* LapReturnValue!*
+ !*WritingFaslFile InitOffset!* !*PGWD !*PWrds);
+
+CompileTime <<
+
+flag('(SaveEntry DefineEntries DepositInstruction
+ OpcodeValue OperandValue DepositWord DepositWordExpression
+ DepositHalfWords LabelValue DepositItem DepositHalfWordIDNumber
+ FindLabels OneLapLength MakeRelocInf MakeRelocWord),
+ 'InternalFunction);
+
+smacro procedure LabelP X;
+ atom X;
+
+>>;
+
+LoadTime <<
+
+!*PWrds := T;
+
+>>;
+
+lisp procedure Lap U;
+begin scalar LapReturnValue!*, LabelOffsets!*, Entries!*;
+ if not !*WritingFaslFile then
+ CurrentOffset!* := 0;
+ U := Pass1Lap U;
+ FindLabels U;
+ if !*PGWD then for each X in U do
+ if atom X then Prin2 X else PrintF(" %p%n", X);
+ if not !*WritingFaslFile then
+ CodeBase!* := GTBPS CodeSize!*;
+ for each X in U do
+ if not LabelP X then
+ if first X = '!*entry then SaveEntry X
+ else DepositInstruction X;
+ DefineEntries();
+ if not !*WritingFaslFile and !*PWrds then
+ ErrorPrintF("*** %p: base %o, length %d words",
+ for each X in Entries!* collect first car X,
+ CodeBase!*, CodeSize!*);
+ return MkCODE LapReturnValue!*;
+end;
+
+lisp procedure SaveEntry X;
+ if second X = '!*!*!*Code!*!*Pointer!*!*!* then
+ LapReturnValue!* := % Magic token that tells LAP to return
+ (if !*WritingFaslFile then CurrentOffset!* % a code pointer
+ else IPlus2(CodeBase!*, CurrentOffset!*))
+ else if not !*WritingFaslFile then
+ << Entries!* := (rest X . CurrentOffset!*) . Entries!*;
+ if not LapReturnValue!* then LapReturnValue!* :=
+ IPlus2(CodeBase!*, CurrentOffset!*) >>
+ else if second X = '!*!*Fasl!*!*InitCode!*!* then
+ InitOffset!* := CurrentOffset!*
+ else if FlagP(second X, 'InternalFunction) then
+ put(second X, 'InternalEntryOffset, CurrentOffset!*)
+ else
+ << FindIDNumber second X;
+ DFPrintFasl list('PutEntry, MkQuote second X,
+ MkQuote third X,
+ CurrentOffset!*) >>;
+
+lisp procedure DefineEntries();
+ for each X in Entries!* do
+ PutD(first car X, second car X, MkCODE IPlus2(CodeBase!*, cdr X));
+
+lisp procedure DepositInstruction X;
+%
+% Legal forms are:
+% (special_form . any)
+% (opcode)
+% (opcode address)
+% (opcode ac address)
+%
+begin scalar Op, Y, A, E;
+ return if (Y := get(first X, 'InstructionDepositFunction)) then
+ Apply(Y, list X)
+ else
+ << NewBitTableEntry!* := 0;
+ Op := OpcodeValue first X;
+ if null(Y := rest X) then
+ A := E := 0
+ else
+ << E := OperandValue first Y;
+ if null(Y := rest Y) then
+ A := 0
+ else
+ << A := E;
+ E := OperandValue first Y >> >>;
+ UpdateBitTable(1, NewBitTableEntry!*);
+ DepositAllFields(Op, A, E) >>;
+end;
+
+lisp procedure DepositAllFields(Op, A, E);
+<< @IPlus2(CodeBase!*, CurrentOffset!*) :=
+ ILOR(ILSH(Op, 27), ILOR(ILSH(A, 23), E));
+ CurrentOffset!* := IAdd1 CurrentOffset!* >>;
+
+lisp procedure OpcodeValue U;
+ if PosIntP U then U
+ else get(U, 'OpcodeValue) or StdError BldMsg("Unknown opcode %r", U);
+
+lisp procedure OperandValue U;
+%
+% Legal forms are:
+% number
+% other atom (label)
+% (special . any) fluid, global, etc.
+% (indexed register address)
+% (indirect other_op)
+%
+begin scalar X;
+ return if PosIntP U then U
+ else if NegIntP U then ILAND(U, 8#777777)
+ else if LabelP U then ILAND(LabelValue U, 8#777777)
+ else if (X := get(first U, 'OperandValueFunction)) then
+ Apply(X, list U)
+ else if (X := WConstEvaluable U) then OperandValue X
+ else StdError BldMsg("Unknown operand %r", U);
+end;
+
+lisp procedure BinaryOperand U;
+%
+% (op x x) can occur in expressions
+%
+begin scalar X;
+ return if (X := WConstEvaluable U) then X
+ else
+ << X := if GetD first U then first U else get(first U, 'DOFN);
+ U := rest U;
+ if NumberP first U then
+ Apply(X, list(first U, LabelValue second U))
+ else if NumberP second U then
+ Apply(X, list(LabelValue first U, second U))
+ else StdError BldMsg("Expression too complicated in LAP %r", U) >>;
+end;
+
+% Add others to this list if they arise
+
+put('difference, 'OperandValueFunction, 'BinaryOperand);
+put('WPlus2, 'OperandValueFunction, 'BinaryOperand);
+
+lisp procedure RegisterOperand U;
+begin scalar V;
+ U := second U;
+ return if PosIntP U then U
+ else if (V := get(U, 'RegisterNumber)) then V
+ else StdError BldMsg("Unknown register %r", U);
+end;
+
+put('REG, 'OperandValueFunction, 'RegisterOperand);
+
+DefList('((nil 0)
+ (t1 6)
+ (t2 7)
+ (t3 8)
+ (t4 9)
+ (t5 10)
+ (t6 11)
+ (st 8#17)), 'RegisterNumber);
+
+lisp procedure ImmediateOperand U;
+ OperandValue second U; % immediate does nothing on the PDP10
+
+put('immediate, 'OperandValueFunction, 'ImmediateOperand);
+
+lisp procedure IndexedOperand U;
+begin scalar V;
+ V := OperandValue second U;
+ U := OperandValue third U;
+ return ILOR(ILSH(V, 18), U);
+end;
+
+put('indexed, 'OperandValueFunction, 'IndexedOperand);
+
+lisp procedure LapValueCell U;
+ ValueCellLocation second U;
+
+DefList('((fluid LapValueCell)
+ (!$fluid LapValueCell)
+ (global LapValueCell)
+ (!$global LapValueCell)), 'OperandValueFunction);
+
+lisp procedure LapEntry U;
+ FunctionCellLocation second U;
+
+put('entry, 'OperandValueFunction, 'LapEntry);
+
+lisp procedure LapInternalEntry U;
+begin scalar X;
+ U := second U;
+ NewBitTableEntry!* := const RELOC_HALFWORD;
+ return if (X := Atsoc(U, LabelOffsets!*)) then
+ << X := cdr X;
+ if !*WritingFaslFile then X else IPlus2(CodeBase!*, X) >>
+ else
+ << if not !*WritingFaslFile then FunctionCellLocation U
+ else if (X := get(U, 'InternalEntryOffset)) then X
+ else
+ << ForwardInternalReferences!* :=
+ (CurrentOffset!* . U) . ForwardInternalReferences!*;
+ 0 >> >>; % will be modified later
+end;
+
+put('InternalEntry, 'OperandValueFunction, 'LapInternalEntry);
+
+lisp procedure DepositWordBlock X;
+ for each Y in cdr X do DepositWordExpression Y;
+
+put('fullword, 'InstructionDepositFunction, 'DepositWordBlock);
+put('indword, 'InstructionDepositFunction, 'DepositIndWord);
+
+lisp procedure DepositIndWord X;
+begin scalar Infpart;
+ InfPart := cadr X;
+ if not !*WritingFaslFile then
+ DepositWord MkItem(8#40,ILAND(8#777777, LabelValue InfPart))
+
+ else
+ << if LabelP InfPart then
+ @IPlus2(CodeBase!*, CurrentOffset!*) := % RELOC_CODE_OFFSET = 0
+ MkItem(8#40, LabelValue InfPart);
+ CurrentOffset!* := IAdd1 CurrentOffset!*;
+ UpdateBitTable(1, const RELOC_HALFWORD) >>;
+end;
+
+lisp procedure DepositHalfWordBlock X;
+begin scalar L, R;
+ X := rest X;
+ while not null X do
+ << L := first X;
+ X := rest X;
+ if null X then
+ R := 0
+ else
+ << R := first X;
+ X := rest X >>;
+ DepositHalfWords(L, R) >>;
+end;
+
+put('halfword, 'InstructionDepositFunction, 'DepositHalfWordBlock);
+
+CommentOutCode <<
+lisp procedure DepositByteBlock X;
+ case length X of
+ 0: DepositWord 0;
+ 1: DepositBytes(first X, 0, 0, 0, 0);
+ 2: DepositBytes(first X, second X, 0, 0, 0);
+ 3: DepositBytes(first X, second X, third X, 0, 0);
+ 4: DepositBytes(first X, second X, third X, fourth X, 0);
+ default:
+ << DepositBytes(first X, second X, third X, fourth X, fourth rest X);
+ DepositByteBlock rest rest rest rest rest X >>;
+ end;
+
+put('byte, 'InstructionDepositFunction, 'DepositByteBlock);
+>>;
+
+lisp procedure DepositString X;
+begin scalar Y;
+ X := StrInf second X;
+ Y := StrPack StrLen X;
+ for I := 1 step 1 until Y do DepositWord @IPlus2(X, I);
+end;
+
+put('string, 'InstructionDepositFunction, 'DepositString);
+
+lisp procedure DepositFloat X; % this will not work in cross-assembly
+<< X := second X; % don't need to strip tag on PDP10
+ DepositWord FloatHighOrder X;
+ DepositWord FloatLowOrder X >>;
+
+put('float, 'InstructionDepositFunction, 'DepositFloat);
+
+lisp procedure DepositWord X;
+<< @IPlus2(CodeBase!*, CurrentOffset!*) := X;
+ UpdateBitTable(1, 0);
+ CurrentOffset!* := IAdd1 CurrentOffset!* >>;
+
+lisp procedure DepositWordExpression X; % Only limited expressions now handled
+begin scalar Y;
+ return if FixP X then DepositWord Int2Sys X
+ else if LabelP X then
+ << @IPlus2(CodeBase!*, CurrentOffset!*) := LabelValue X;
+ UpdateBitTable(1, const RELOC_HALFWORD);
+ CurrentOffset!* := IAdd1 CurrentOffset!* >>
+ else if first X = 'MkItem then DepositItem(second X, third X)
+ else if first X = 'FieldPointer then
+ DepositFieldPointer(second X, third X, fourth X)
+ else if (Y := WConstEvaluable X) then DepositWord Int2Sys Y
+ else StdError BldMsg("Expression too complicated %r", X);
+end;
+
+lisp procedure DepositHalfWords(L, R);
+begin scalar Y;
+ if not (FixP L or (L := WConstEvaluable L))
+ then StdError "Left half too complex";
+ if PairP R and first R = 'IDLoc then
+ DepositHalfWordIDNumber(L, second R)
+ else if (Y := WConstEvaluable R) then DepositWord ILOR(ILSH(L, 18), Y)
+ else StdError BldMsg("Halfword expression too complicated %r", R);
+end;
+
+lisp procedure LabelValue U;
+begin scalar V;
+ return if CodeP U then Inf U
+ else if (V := Atsoc(U, LabelOffsets!*)) then
+ << V := cdr V;
+ if !*WritingFaslFile then
+ << NewBitTableEntry!* := const RELOC_HALFWORD;
+ V >>
+ else IPlus2(CodeBase!*, V) >>
+ else StdError BldMsg("Unknown label %r in LAP", U);
+end;
+
+lisp procedure DepositItem(TagPart, InfPart);
+ if not !*WritingFaslFile then
+ DepositWord MkItem(TagPart, if LabelP InfPart then
+ LabelValue InfPart
+ else if first InfPart = 'IDLoc then
+ IDInf second InfPart
+ else
+ StdError BldMsg("Unknown inf in MkItem %r",
+ InfPart))
+ else
+ << if LabelP InfPart then
+ @IPlus2(CodeBase!*, CurrentOffset!*) := % RELOC_CODE_OFFSET = 0
+ MkItem(TagPart, LabelValue InfPart)
+ else if first InfPart = 'IDLoc then
+ @IPlus2(CodeBase!*, CurrentOffset!*) :=
+ MkItem(TagPart,
+ MakeRelocInf(const RELOC_ID_NUMBER,
+ FindIDNumber second InfPart))
+ else StdError BldMsg("Unknown inf in MkItem %r", InfPart);
+ CurrentOffset!* := IAdd1 CurrentOffset!*;
+ UpdateBitTable(1, const RELOC_INF) >>;
+
+lisp procedure DepositHalfWordIDNumber(LHS, X);
+ if not !*WritingFaslFile or ILEQ(IDInf X, 128) then
+ DepositWord ILOR(ILSH(LHS, 18), IDInf X)
+ else
+ << @IPlus2(CodeBase!*, CurrentOffset!*) := ILOR(ILSH(LHS, 18),
+ MakeRelocHalfWord(const RELOC_ID_NUMBER, FindIDNumber X));
+ CurrentOffset!* := IAdd1 CurrentOffset!*;
+ UpdateBitTable(1, const RELOC_HALFWORD) >>;
+
+lisp procedure SystemFaslFixup();
+<< while not null ForwardInternalReferences!* do
+ << Field(@IPlus2(CodeBase!*,
+ car first ForwardInternalReferences!*),
+ 18, 18) :=
+ get(cdr first ForwardInternalReferences!*, 'InternalEntryOffset)
+ or << ErrorPrintF(
+"***** %r not defined in this module; normal function call being used",
+ cdr first ForwardInternalReferences!*);
+ MakeRelocHalfWord(const RELOC_FUNCTION_CELL,
+ FindIDNumber cdr first
+ ForwardInternalReferences!*) >>;
+ ForwardInternalReferences!* := cdr ForwardInternalReferences!* >>;
+ MapObl function lambda(X);
+ RemProp(X, 'InternalEntryOffset) >>;
+
+
+fluid '(LapCodeList!*);
+
+lisp procedure FindLabels LapCodeList!*;
+<< CodeSize!* := 0;
+ for each X in LapCodeList!* do
+ CodeSize!* := IPlus2(CodeSize!*, OneLapLength X) >>;
+
+lisp procedure OneLapLength U;
+begin scalar X;
+ return if atom U then
+ << LabelOffsets!* := (U . IPlus2(CurrentOffset!*, CodeSize!*))
+ . LabelOffsets!*;
+ 0 >>
+ else if (X := get(car U, 'LapLength)) then
+ if PosIntP X then X
+ else Apply(X, list U)
+ else % minor klugde for long constants
+ << if length U = 3 and FixP(X := third U) and not ImmediateP X then
+ begin scalar Y;
+ RPlaca(rest rest U, Y := StringGensym());
+ NConc(LapCodeList!*, list(Y, list('fullword, X)));
+ end;
+ 1 >>;
+end;
+
+DefList('((!*entry LapEntryLength)
+ (float 2)
+ (string LapStringLength)
+ (fullword LapWordLength)
+ (halfword LapHalfwordLength)
+ (byte LapByteLength)), 'LapLength);
+
+lisp procedure LapEntryLength U;
+<< LabelOffsets!* := (second U . IPlus2(CurrentOffset!*, CodeSize!*))
+ . LabelOffsets!*;
+ 0 >>;
+
+lisp procedure LapStringLength U;
+ StrPack StrLen StrInf second U;
+
+lisp procedure LapWordLength U;
+ length rest U;
+
+lisp procedure LapHalfwordLength U;
+ ILSH(IAdd1 length rest U, -1);
+
+lisp procedure LapByteLength U;
+ StrPack length rest U;
+
+on SysLisp;
+
+syslsp procedure DepositFieldPointer(Opr, Start, Len);
+<< LispVar NewBitTableEntry!* := 0;
+ Opr := OperandValue Opr;
+ @IPlus2(LispVar CodeBase!*, LispVar CurrentOffset!*) :=
+ ILOR(ILSH(36 - (Start + Len), 30), ILOR(ILSH(Len, 24), Opr));
+ UpdateBitTable(1, LispVar NewBitTableEntry!*);
+ LispVar CurrentOffset!* := IAdd1 LispVar CurrentOffset!* >>;
+
+syslsp procedure IndirectOperand U;
+ ILOR(ILSH(1, 22), OperandValue second U);
+
+put('Indirect, 'OperandValueFunction, 'IndirectOperand);
+
+% ExtraRegLocation is in 20-FASL
+
+put('ExtraReg, 'OperandValueFunction, 'ExtraRegLocation);
+
+syslsp procedure MakeRelocWord(RelocTag, RelocInf);
+ LSH(RelocTag, 34) + Field(RelocInf, 2, 34);
+
+syslsp procedure MakeRelocInf(RelocTag, RelocInf);
+ LSH(RelocTag, 16) + Field(RelocInf, 20, 16);
+
+syslsp procedure MakeRelocHalfWord(RelocTag, RelocInf);
+ LSH(RelocTag, 16) + Field(RelocInf, 20, 16);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/comp/20/instrs.sl
Index: psl-1983/3-1/comp/20/instrs.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/instrs.sl
@@ -0,0 +1,48 @@
+(compiletime
+(dm DEFINEOPCODERANGEFROM (U)
+ (prog (start args)
+ (setq start (sub1 (second U)))
+ (setq args (second (third U)))
+ (return (cons 'progn
+ (foreach X in args collect (list 'put
+ (mkquote X)
+ ''opcodevalue
+ (setq start (add1 start))))))))
+)
+(DEFINEOPCODERANGEFROM 68 (QUOTE (JSYS ADJSP)))
+(DEFINEOPCODERANGEFROM 91 (QUOTE (ADJBP)))
+(DEFINEOPCODERANGEFROM 72 (QUOTE (DFAD DFSB DFMP DFDV)))
+(DEFINEOPCODERANGEFROM 80 (QUOTE (DMOVE DMOVN FIX)))
+(DEFINEOPCODERANGEFROM 84 (QUOTE (DMOVEM DMOVNM FIXR FLTR UFA DFN FSC IBP
+ILDB LDB IDPB DPB FAD FADL FADM FADB FADR FADRI FADRM FADRB FSB FSBL FSBM
+FSBB FSBR FSBRI FSBRM FSBRB FMP FMPL FMPM FMPB FMPR FMPRI FMPRM FMPRB FDV
+FDVL FDVM FDVB FDVR FDVRI FDVRM FDVRB MOVE MOVEI MOVEM MOVES MOVS MOVSI
+MOVSM MOVSS MOVN MOVNI MOVNM MOVNS MOVM MOVMI MOVMM MOVMS IMUL IMULI IMULM
+IMULB MUL MULI MULM MULB IDIV IDIVI IDIVM IDIVB DIV DIVI DIVM DIVB ASH ROT
+LSH JFFO ASHC ROTC LSHC)))
+(DEFINEOPCODERANGEFROM 168 (QUOTE (EXCH BLT AOBJP AOBJN JRST JFCL XCT MAP
+PUSHJ PUSH POP POPJ JSR JSP JSA JRA ADD ADDI ADDM ADDB SUB SUBI SUBM SUBB
+CAI CAIL CAIE CAILE CAIA CAIGE CAIN CAIG CAM CAML CAME CAMLE CAMA CAMGE CAMN
+CAMG)))
+(DEFINEOPCODERANGEFROM 208 (QUOTE (JUMP JUMPL JUMPE JUMPLE JUMPA JUMPGE
+JUMPN JUMPG SKIP SKIPL SKIPE SKIPLE SKIPA SKIPGE SKIPN SKIPG AOJ AOJL AOJE
+AOJLE AOJA AOJGE AOJN AOJG AOS AOSL AOSE AOSLE AOSA AOSGE AOSN AOSG SOJ SOJL
+SOJE SOJLE SOJA SOJGE SOJN SOJG SOS SOSL SOSE SOSLE SOSA SOSGE SOSN SOSG)))
+(DEFINEOPCODERANGEFROM 256 (QUOTE (SETZ SETZI SETZM SETZB AND ANDI ANDM ANDB
+ANDCA ANDCAI ANDCAM ANDCAB SETM SETMI SETMM SETMB ANDCM ANDCMI ANDCMM ANDCMB)))
+(DEFINEOPCODERANGEFROM 276 (QUOTE (SETA SETAI SETAM SETAB XOR XORI XORM XORB
+IOR IORI IORM IORB ANDCB ANDCBI ANDCBM ANDCBB EQV EQVI EQVM EQVB SETCA
+SETCAI SETCAM SETCAB ORCA ORCAI ORCAM ORCAB SETCM SETCMI SETCMM SETCMB ORCM
+ORCMI ORCMM ORCMB ORCB ORCBI ORCBM ORCBB SETO SETOI SETOM SETOB)))
+(DEFINEOPCODERANGEFROM 320 (QUOTE (HLL HLLI HLLM HLLS HRL HRLI HRLM HRLS
+HLLZ HLLZI HLLZM HLLZS HRLZ HRLZI HRLZM HRLZS HLLO HLLOI HLLOM HLLOS HRLO
+HRLOI HRLOM HRLOS HLLE HLLEI HLLEM HLLES HRLE HRLEI HRLEM HRLES HRR HRRI
+HRRM HRRS HLR HLRI HLRM HLRS HRRZ HRRZI HRRZM HRRZS HLRZ HLRZI HLRZM HLRZS
+HRRO HRROI HRROM HRROS HLRO HLROI HLROM HLROS HRRE HRREI HRREM HRRES HLRE
+HLREI HLREM HLRES)))
+(DEFINEOPCODERANGEFROM 384 (QUOTE (TRN TLN TRNE TLNE TRNA TLNA TRNN TLNN TDN
+TSN TDNE TSNE TDNA TSNA TDNN TSNN TRZ TLZ TRZE TLZE TRZA TLZA TRZN TLZN TDZ
+TSZ TDZE TSZE TDZA TSZA TDZN TSZN TRC TLC TRCE TLCE TRCA TLCA TRCN TLCN TDC
+TSC TDCE TSCE TDCA TSCA TDCN TSCN TRO TLO TROE TLOE TROA TLOA TRON TLON TDO
+TSO TDOE TSOE TDOA TSOA TDON TSON)))
+(DEFINEOPCODERANGEFROM 269 (QUOTE (XMOVEI)))
ADDED psl-1983/3-1/comp/20/lap-to-asm.ctl
Index: psl-1983/3-1/comp/20/lap-to-asm.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/lap-to-asm.ctl
@@ -0,0 +1,11 @@
+; Rebuild the LAP-TO-ASM module
+@def dsk: dsk:,p20ec:,pc:
+@def pl: mple:,ple:
+@term page 0
+@get psl:ex-rlisp
+@st
+*load build;
+*build "LAP-TO-ASM";
+*quit;
+@reset .
+@term page 24
ADDED psl-1983/3-1/comp/20/lap-to-asm.red
Index: psl-1983/3-1/comp/20/lap-to-asm.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/lap-to-asm.red
@@ -0,0 +1,1175 @@
+%
+% LAP-TO-ASM.RED - LAP to assembler translator
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 13 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 21-May-83 Mark R. Swanson
+% Added IndWord functions to support extended-20
+% 01-Mar-83 Nancy Kendzierski
+% Changed EVIN to PathIn in ASMOUT to enable search paths to be
+% used when doing system builds connected to a directory other
+% than pxx:, where xx=machine (hp, 20, vax, etc.)
+% Only set InputSymFile!*, OutputSymFile!*, GlobalDataFileName!*,
+% and InitFileNameFormat!* if they aren't already initialized.
+% Changed SEMIC!* declaration from global to fluid.
+% <PSL.COMP>LAP-TO-ASM.RED.5, 30-Apr-82 14:47:52, Edit by BENSON
+% Removed EVAL and IGNORE processing
+
+Imports '(PathIn);
+
+fluid '(Semic!*
+ !*Comp
+ !*PLap
+ DfPrint!*
+ CharactersPerWord
+ AddressingUnitsPerItem
+ AddressingUnitsPerFunctionCell
+ InputSymFile!*
+ OutputSymFile!*
+ CodeOut!*
+ DataOut!*
+ InitOut!*;
+ CodeFileNameFormat!*
+ DataFileNameFormat!*
+ InitFileNameFormat!*
+ ModuleName!*
+ UncompiledExpressions!*
+ NextIDNumber!*
+ OrderedIDList!*
+ NilNumber!*
+ !*MainFound
+ !*MAIN
+ !*DeclareBeforeUse
+ MainEntryPointName!*
+ EntryPoints!*
+ LocalLabels!*
+ CodeExternals!*
+ CodeExporteds!*
+ DataExternals!*
+ DataExporteds!*
+ ExternalDeclarationFormat!*
+ ExportedDeclarationFormat!*
+ LabelFormat!*
+ FullWordFormat!*
+ DoubleFloatFormat!*
+ ReserveDataBlockFormat!*
+ ReserveZeroBlockFormat!*
+ UndefinedFunctionCellInstructions!*
+ DefinedFunctionCellFormat!*
+ PrintExpressionForm!*
+ PrintExpressionFormPointer!*
+ CommentFormat!*
+ NumericRegisterNames!*
+ ExpressionCount!*
+ ASMOpenParen!*
+ ASMCloseParen!*
+ ToBeCompiledExpressions!*
+ GlobalDataFileName!*
+);
+
+
+% Default values; set up if not already initialized.
+if null InputSymFile!* then InputSymFile!* := "psl.sym";
+if null OutputSymFile!* then OutputSymFile!* := "psl.sym";
+if null GlobalDataFileName!* then GlobalDataFileName!* := "global-data.red";
+if null InitFileNameFormat!* then InitFileNameFormat!* := "%w.init";
+
+lisp procedure DfPrintASM U; %. Called by TOP-loop, DFPRINT!*
+begin scalar Nam, Ty, Fn;
+ if atom U then return NIL;
+ Fn := car U;
+ IF FN = 'PUTD THEN GOTO DB2;
+ IF NOT (FN MEMQ '(DE DF DM DN)) THEN GOTO DB1;
+ NAM:=CADR U;
+ U:='LAMBDA . CDDR U;
+ TY:=CDR ASSOC(FN, '((DE . EXPR)
+ (DF . FEXPR)
+ (DM . MACRO)
+ (DN . NEXPR)));
+DB3: if Ty = 'MACRO then begin scalar !*Comp;
+ PutD(Nam, Ty, U); % Macros get defined now
+ end;
+ if FlagP(Nam, 'Lose) then <<
+ ErrorPrintF("*** %r has not been defined, because it is flagged LOSE",
+ Nam);
+ return NIL >>;
+ IF FLAGP(TY,'COMPILE) THEN
+ << PUT(NAM,'CFNTYPE,LIST TY);
+ U := LIST('!*ENTRY,NAM,TY,LENGTH CADR U)
+ . !&COMPROC(U, NAM);
+ if !*PLAP then for each X in U do Print X;
+ if TY neq 'EXPR then
+ DfPrintASM list('put, MkQuote Nam, '(quote TYPE), MkQuote TY);
+ ASMOUTLAP U >>
+ ELSE % should never happen
+ SaveUncompiledExpression LIST('PUTD, MKQUOTE NAM,
+ MKQUOTE TY,
+ MKQUOTE U);
+ RETURN NIL;
+DB1: % Simple S-EXPRESSION, maybe EVAL it;
+ IF NOT PAIRP U THEN RETURN NIL;
+ if (Fn := get(car U, 'ASMPreEval)) then return Apply(Fn, list U)
+ else if (Fn := GetD car U) and car Fn = 'MACRO then
+ return DFPRINTASM Apply(cdr Fn, list U);
+ SaveUncompiledExpression U;
+ RETURN NIL;
+DB2: NAM:=CADR U;
+ TY:=CADDR U;
+ FN:=CADDDR U;
+ IF EQCAR(NAM,'QUOTE) THEN << NAM:=CADR NAM;
+ IF EQCAR(TY,'QUOTE) THEN << TY:=CADR TY;
+ IF PAIRP FN AND CAR FN MEMBER '(FUNCTION QUOTE) THEN << FN:=CADR FN;
+ IF TY MEMQ '(EXPR FEXPR MACRO NEXPR) THEN
+ << U:=FN; GOTO DB3 >> >> >> >>;
+ GOTO DB1;
+ END;
+
+lisp procedure ASMPreEvalLoadTime U;
+ DFPrintASM cadr U; % remove LOADTIME
+
+put('LoadTime, 'ASMPreEval, 'ASMPreEvalLoadTime);
+
+lisp procedure ASMPreEvalStartupTime U;
+ SaveForCompilation cadr U;
+
+put('StartupTime, 'ASMPreEval, 'ASMPreEvalStartupTime);
+
+lisp procedure ASMPreEvalProgN U;
+ for each X in cdr U do
+ DFPrintASM X;
+
+put('ProgN, 'ASMPreEval, 'ASMPreEvalProgN);
+
+put('WDeclare, 'ASMPreEval, 'Eval); % do it now
+
+lisp procedure ASMPreEvalSetQ U;
+begin scalar X, Val;
+ X := cadr U;
+ Val := caddr U;
+ return if ConstantP Val or Val = T then
+ << FindIDNumber X;
+ put(X, 'InitialValue, Val);
+ NIL >>
+ else if null Val then
+ << FindIDNumber X;
+ RemProp(X, 'InitialValue);
+ Flag(list X, 'NilInitialValue);
+ NIL >>
+ else if EqCar(Val, 'QUOTE) then
+ << FindIDNumber X;
+ Val := cadr Val;
+ if null Val then
+ << RemProp(X, 'InitialValue);
+ Flag(list X, 'NilInitialValue) >>
+ else
+ put(X, 'InitialValue, Val);
+ NIL >>
+ else if IDP Val and get(Val, 'InitialValue)
+ or FlagP(Val, 'NilInitialValue) then
+ << if (Val := get(Val, 'InitialValue)) then
+ put(X, 'InitialValue, Val)
+ else Flag(list X, 'NilInitialValue) >>
+ else SaveUncompiledExpression U; % just check simple cases, else return
+end;
+
+put('SetQ, 'ASMPreEval, 'ASMPreEvalSetQ);
+
+lisp procedure ASMPreEvalPutD U;
+ SaveUncompiledExpression CheckForEasySharedEntryPoints U;
+
+lisp procedure CheckForEasySharedEntryPoints U;
+%
+% looking for (PUTD (QUOTE name1) xxxx (CDR (GETD (QUOTE name2))))
+%
+begin scalar NU, Nam, Exp;
+ NU := cdr U;
+ Nam := car NU;
+ if car Nam = 'QUOTE then Nam := cadr Nam else return U;
+ NU := cdr NU;
+ Exp := cadr NU;
+ if not (car Exp = 'CDR) then return U;
+ Exp := cadr Exp;
+ if not (car Exp = 'GETD) then return U;
+ Exp := cadr Exp;
+ if not (car Exp = 'QUOTE) then return U;
+ Exp := cadr Exp;
+ FindIDNumber Nam;
+ put(Nam, 'EntryPoint, FindEntryPoint Exp);
+ if not (car NU = '(QUOTE EXPR)) then return list('Put, '(Quote Type),
+ car NU);
+ return NIL;
+end;
+
+put('PutD, 'ASMPreEval, 'ASMPreEvalPutD);
+
+lisp procedure ASMPreEvalFluidAndGlobal U;
+<< if EqCar(cadr U, 'QUOTE) then Flag(cadr cadr U, 'NilInitialValue);
+ SaveUncompiledExpression U >>;
+
+put('Fluid, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+put('Global, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+
+CommentOutCode <<
+fluid '(NewFluids!* NewGlobals!*);
+
+lisp procedure ASMPreEvalFluidAndGlobal U;
+begin scalar L;
+ L := cadr U;
+ return if car L = 'QUOTE then
+ << L := cadr L;
+ if car U = 'FLUID then
+ NewFluids!* := UnionQ(NewFluids!*, L) % take union
+ else NewGlobals!* := UnionQ(NewGlobals!*, L);
+ Flag(L, 'NilInitialValue);
+ NIL >>
+ else SaveUncompiledExpression U;
+end;
+
+put('Fluid, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+put('Global, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+>>;
+
+lisp procedure ASMPreEvalLAP U;
+ if EqCar(cadr U, 'QUOTE) then ASMOutLap cadr cadr U
+ else SaveUncompiledExpression U;
+
+put('LAP, 'ASMPreEval, 'ASMPreEvalLAP);
+
+CommentOutCode <<
+lisp procedure InitialPut(Nam, Ind, Val);
+begin scalar L, P;
+ FindIDNumber Nam;
+ if (P := Atsoc(Ind, L := get(Nam, 'InitialPropertyList))) then
+ Rplacd(P, Val)
+ else put(Nam, 'InitialPropertyList, (Ind . Val) . L);
+end;
+
+lisp procedure InitialRemprop(Nam, Ind);
+begin scalar L;
+ if (L := get(Nam, 'InitialPropertyList)) then
+ put(Nam, 'InitialPropertyList, DelAtQIP(Ind, L));
+end;
+
+lisp procedure InitialFlag1(Nam, Ind);
+begin scalar L, P;
+ FindIDNumber Nam;
+ if not Ind memq (L := get(Nam, 'InitialPropertyList)) then
+ put(Nam, 'InitialPropertyList, Ind . L);
+end;
+
+lisp procedure InitialRemFlag1(Nam, Ind);
+begin scalar L;
+ if (L := get(Nam, 'InitialPropertyList)) then
+ put(Nam, 'InitialPropertyList, DelQIP(Ind, L));
+end;
+
+lisp procedure ASMPreEvalPut U;
+begin scalar Nam, Ind, Val;
+ Nam := second U;
+ Ind := third U;
+ Val := fourth U;
+ if EqCar(Nam, 'QUOTE) and EqCar(Ind, 'QUOTE) and
+ (ConstantP Val or Val = T or EqCar(Val, 'QUOTE)) then
+ InitialPut(second Nam, second Ind, if EqCar(Val, 'QUOTE) then
+ second Val else Val)
+ else SaveUncompiledExpression U;
+end;
+
+put('put, 'ASMPreEval, 'ASMPreEvalPut);
+
+lisp procedure ASMPreEvalRemProp U;
+begin scalar Nam, Ind;
+ Nam := second U;
+ Ind := third U;
+ if EqCar(Nam, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ InitialRemProp(second Nam, second Ind)
+ else SaveUncompiledExpression U;
+end;
+
+put('RemProp, 'ASMPreEval, 'ASMPreEvalRemProp);
+
+lisp procedure ASMPreEvalDefList U;
+begin scalar DList, Ind;
+ DList := second U;
+ Ind := third U;
+ if EqCar(DList, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ << DList := second DList;
+ Ind := second Ind;
+ for each X in Dlist do InitialPut(first X, Ind, second X) >>
+ else SaveUncompiledExpression U;
+end;
+
+put('DefList, 'ASMPreEval, 'ASMPreEvalDefList);
+
+lisp procedure ASMPreEvalFlag U;
+begin scalar NameList, Ind;
+ NameList := second U;
+ Ind := third U;
+ if EqCar(NameList, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ << Ind := second Ind;
+ for each X in second NameList do
+ InitialFlag1(X, Ind) >>
+ else SaveUncompiledExpression U;
+end;
+
+put('flag, 'ASMPreEval, 'ASMPreEvalFlag);
+
+lisp procedure ASMPreEvalRemFlag U;
+begin scalar NameList, Ind;
+ NameList := second U;
+ Ind := third U;
+ if EqCar(NameList, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ << Ind := second Ind;
+ for each X in second NameList do
+ InitialRemFlag1(X, Ind) >>
+ else SaveUncompiledExpression U;
+end;
+
+put('RemFlag, 'ASMPreEval, 'ASMPreEvalRemFlag);
+
+lisp procedure ASMPreEvalGlobal U;
+begin scalar NameList;
+ NameList := second U;
+ if EqCar(NameList, 'QUOTE) then
+ for each X in second NameList do
+ InitialPut(X, 'TYPE, 'Global)
+ else SaveUncompiledExpression U;
+end;
+
+put('Global, 'ASMPreEval, 'ASMPreEvalGlobal);
+
+lisp procedure ASMPreEvalFluid U;
+begin scalar NameList;
+ NameList := second U;
+ if EqCar(NameList, 'QUOTE) then
+ for each X in second NameList do
+ InitialPut(X, 'TYPE, 'FLUID)
+ else SaveUncompiledExpression U;
+end;
+
+put('Fluid, 'ASMPreEval, 'ASMPreEvalFluid);
+
+lisp procedure ASMPreEvalUnFluid U;
+begin scalar NameList;
+ NameList := second U;
+ if EqCar(NameList, 'QUOTE) then
+ for each X in second NameList do
+ InitialRemProp(X, 'TYPE)
+ else SaveUncompiledExpression U;
+end;
+
+put('UnFluid, 'ASMPreEval, 'ASMPreEvalUnFluid);
+>>;
+
+lisp procedure SaveUncompiledExpression U;
+ if PairP U then
+ begin scalar OldOut;
+ OldOut := WRS InitOut!*;
+ Print U;
+ WRS OldOut;
+ end;
+
+ToBeCompiledExpressions!* := NIL . NIL;
+
+lisp procedure SaveForCompilation U;
+ if atom U or U member car ToBeCompiledExpressions!* then NIL
+ else if car U = 'progn then
+ for each X in cdr U do SaveForCompilation X
+ else TConc(ToBeCompiledExpressions!*, U);
+
+SYMBOLIC PROCEDURE ASMOUT FIL;
+begin scalar OldOut;
+ ModuleName!* := FIL;
+ Prin2T "ASMOUT: IN files; or type in expressions";
+ Prin2T "When all done execute ASMEND;";
+ CodeOut!* := Open(BldMsg(CodeFileNameFormat!*, ModuleName!*), 'OUTPUT);
+ OldOut := WRS CodeOut!*;
+ LineLength 1000;
+ WRS OldOut;
+ CodeFileHeader();
+ DataOut!* := Open(BldMsg(DataFileNameFormat!*, ModuleName!*), 'OUTPUT);
+ OldOut := WRS DataOut!*;
+ LineLength 1000;
+ WRS OldOut;
+ DataFileHeader();
+ InitOut!* := Open(BldMsg(InitFileNameFormat!*, ModuleName!*), 'OUTPUT);
+ ReadSYMFile();
+ DFPRINT!* := 'DFPRINTASM;
+ RemD 'OldLap;
+ PutD('OldLap, 'EXPR, cdr RemD 'Lap);
+ PutD('Lap, 'EXPR, cdr GetD 'ASMOutLap);
+ !*DEFN := T;
+ SEMIC!* := '!$ ; % to turn echo off for IN
+ if not ((ModuleName!* = "main")
+ or !*Main) then PathIn GlobalDataFileName!*
+ else !*Main := T;
+end;
+
+lisp procedure ASMEnd;
+<< off SysLisp;
+ if !*MainFound then
+ << CompileUncompiledExpressions();
+% WriteInitFile();
+ InitializeSymbolTable() >>
+ else WriteSymFile();
+ CodeFileTrailer();
+ Close CodeOut!*;
+ DataFileTrailer();
+ Close DataOut!*;
+ Close InitOut!*;
+ RemD 'Lap;
+ PutD('Lap, 'EXPR, cdr GetD 'OldLap);
+ DFPRINT!* := NIL;
+ !*DEFN := NIL >>;
+
+FLAG('(ASMEND), 'IGNORE);
+DEFINEROP('ASMEND,NIL,ESTAT('ASMEND));
+
+lisp procedure CompileUncompiledExpressions();
+<< CommentOutCode << AddFluidAndGlobalDecls(); >>;
+ DFPRINTASM list('DE, 'INITCODE, '(),
+ 'PROGN . car ToBeCompiledExpressions!*) >>;
+
+CommentOutCode <<
+lisp procedure AddFluidAndGlobalDecls();
+<< SaveUncompiledExpression list('GLOBAL, MkQuote NewGlobals!*);
+ SaveUncompiledExpression list('FLUID, MkQuote NewFluids!*) >>;
+>>;
+
+lisp procedure ReadSymFile();
+ LapIN InputSymFile!*;
+
+lisp procedure WriteSymFile();
+begin scalar NewOut, OldOut;
+ OldOut := WRS(NewOut := Open(OutputSymFile!*, 'OUTPUT));
+ print list('SaveForCompilation,
+ MkQuote('progn . car ToBeCompiledExpressions!*));
+ SaveIDList();
+ SetqPrint 'NextIDNumber!*;
+ SetqPrint 'StringGenSym!*;
+ MapObl function PutPrintEntryAndSym;
+ WRS OldOut;
+ Close NewOut;
+end;
+
+
+CommentOutCode <<
+lisp procedure WriteInitFile();
+begin scalar OldOut, NewOut;
+ NewOut := Open(InitFileName!*, 'OUTPUT);
+ OldOut := WRS NewOut;
+ for each X in car UncompiledExpressions!* do PrintInit X;
+ Close NewOut;
+ WRS OldOut;
+end;
+
+lisp procedure PrintInit X;
+ if EqCar(X, 'progn) then
+ for each Y in cdr X do PrintInit Y
+ else Print X;
+>>;
+
+lisp procedure SaveIDList();
+<< Print list('setq, 'OrderedIDList!*, MkQuote car OrderedIDList!*);
+ Print quote(OrderedIDList!* :=
+ OrderedIDList!* . LastPair OrderedIDList!*) >>;
+
+lisp procedure SetqPrint U;
+ print list('SETQ, U, MkQuote Eval U);
+
+lisp procedure PutPrint(X, Y, Z);
+ print list('PUT, MkQuote X, MkQuote Y, MkQuote Z);
+
+lisp procedure PutPrintEntryAndSym X;
+begin scalar Y;
+ if (Y := get(X, 'EntryPoint)) then PutPrint(X, 'EntryPoint, Y);
+ if (Y := get(X, 'IDNumber)) then
+ PutPrint(X, 'IDNumber, Y);
+CommentOutCode <<
+ if (Y := get(X, 'InitialPropertyList)) then
+ PutPrint(X, 'InitialPropertyList, Y);
+>>;
+ if (Y := get(X, 'InitialValue)) then
+ PutPrint(X, 'InitialValue, Y)
+ else if FlagP(X, 'NilInitialValue) then
+ print list('flag, MkQuote list X, '(quote NilInitialValue));
+ if get(X, 'SCOPE) = 'EXTERNAL then
+ << PutPrint(X, 'SCOPE, 'EXTERNAL);
+ PutPrint(X, 'ASMSymbol, get(X, 'ASMSymbol));
+ if get(X, 'WVar) then PutPrint(X, 'WVar, X)
+ else if get(X, 'WArray) then PutPrint(X, 'WArray, X)
+ else if get(X, 'WString) then PutPrint(X, 'WString, X)
+ else if (Y := get(X, 'WConst)) then PutPrint(X, 'WConst, Y) >>;
+end;
+
+lisp procedure FindIDNumber U;
+begin scalar I;
+ return if (I := ID2Int U) <= 128 then I
+ else if (I := get(U, 'IDNumber)) then I
+ else
+ << put(U, 'IDNumber, I := NextIDNumber!*);
+ OrderedIDList!* := TConc(OrderedIDList!*, U);
+ NextIDNumber!* := NextIDNumber!* + 1;
+ I >>;
+end;
+
+OrderedIDList!* := NIL . NIL;
+NextIDNumber!* := 129;
+
+lisp procedure InitializeSymbolTable();
+begin scalar MaxSymbol;
+ MaxSymbol := get('MaxSymbols, 'WConst);
+ if MaxSymbol < NextIDNumber!* then
+ << ErrorPrintF("*** MaxSymbols %r is too small; at least %r is needed",
+ MaxSymbol, NextIDNumber!*);
+ MaxSymbol := NextIDNumber!* + 100 >>;
+ Flag('(NIL), 'NilInitialValue);
+ put('T, 'InitialValue, 'T);
+ put('!$EOF!$, 'InitialValue, Int2ID get('EOF, 'CharConst));
+ put('!$EOL!$, 'InitialValue, '!
+);
+ NilNumber!* := CompileConstant NIL;
+ DataAlignFullWord();
+%/ This is a BUG? M.L. G.
+%/ for I := NextIDNumber!* step 1 until MaxSymbol do
+%/ DataPrintFullWord NilNumber!*;
+ InitializeSymVal();
+ DataReserveBlock((MaxSymbol - NextIDNumber!*) + 1);
+ InitializeSymPrp();
+ DataReserveBlock((MaxSymbol - NextIDNumber!*) + 1);
+%/ This is a BUG? M.L. G.
+%/ for I := NextIDNumber!* step 1 until MaxSymbol do
+%/ DataPrintFullWord NilNumber!*;
+ InitializeSymNam MaxSymbol;
+ InitializeSymFnc();
+ DataReserveFunctionCellBlock((MaxSymbol - NextIDNumber!*) + 1);
+ DataAlignFullWord();
+ DataPrintGlobalLabel FindGlobalLabel 'NextSymbol;
+ DataPrintFullWord NextIDNumber!*;
+end;
+
+lisp procedure InitializeSymPrp();
+<< CommentOutCode << InitializeHeap(); >>; % init prop lists
+ DataPrintGlobalLabel FindGlobalLabel 'SymPrp;
+ for I := 0 step 1 until 128 do
+ InitSymPrp1 Int2ID I;
+ for each X in car OrderedIDList!* do
+ InitSymPrp1 X >>;
+
+lisp procedure InitSymPrp1 X;
+<<
+CommentOutCode <<
+ DataPrintFullWord(if (X := get(X, 'InitialPropertyList)) then
+ X
+ else NilNumber!*);
+>>;
+ DataPrintFullWord NilNumber!* >>;
+
+CommentOutCode <<
+lisp procedure InitializeHeap();
+begin scalar L;
+ DataPrintGlobalLabel FindGlobalLabel 'Heap;
+ for I := 0 step 1 until 128 do
+ PrintPropertyList Int2ID I;
+ for each X in car OrderedIDList!* do
+ PrintPropertyList X;
+ L := get('HeapSize, 'WConst);
+end;
+>>;
+
+lisp procedure InitializeSymNam MaxSymbol;
+<< DataPrintGlobalLabel FindGlobalLabel 'SymNam;
+ for I := 0 step 1 until 128 do
+ DataPrintFullWord CompileConstant ID2String Int2ID I;
+ for each IDName in car OrderedIDList!* do
+ DataPrintFullWord CompileConstant ID2String IDName;
+ MaxSymbol := MaxSymbol - 1;
+ for I := NextIDNumber!* step 1 until MaxSymbol do
+ DataPrintFullWord(I + 1);
+ DataPrintFullWord 0 >>;
+
+lisp procedure InitializeSymVal();
+<< DataPrintGlobalLabel FindGlobalLabel 'SymVal;
+ for I := 0 step 1 until 128 do InitSymVal1 Int2ID I;
+ for each X in car OrderedIDList!* do InitSymVal1 X >>;
+
+lisp procedure InitSymVal1 X;
+begin scalar Val;
+ return DataPrintFullWord(if (Val := get(X, 'InitialValue)) then
+ CompileConstant Val
+ else if FlagP(X, 'NilInitialValue) then
+ NilNumber!*
+ else list('MkItem, get('Unbound, 'WConst),
+ FindIDNumber X));
+end;
+
+lisp procedure InitializeSymFnc();
+<< DataPrintGlobalLabel FindGlobalLabel 'SymFnc;
+ for I := 0 step 1 until 128 do InitSymFnc1 Int2ID I;
+ for each X in car OrderedIDList!* do InitSymFnc1 X >>;
+
+lisp procedure InitSymFnc1 X;
+begin scalar EP;
+ EP := get(X, 'EntryPoint);
+ if null EP then DataPrintUndefinedFunctionCell()
+ else DataPrintDefinedFunctionCell EP;
+end;
+
+lisp procedure ASMOutLap U;
+begin scalar LocalLabels!*, OldOut;
+ U := Pass1Lap U; % Expand cmacros, quoted expressions
+ CodeBlockHeader();
+ OldOut := WRS CodeOut!*;
+ for each X in U do ASMOutLap1 X;
+ WRS OldOut;
+ CodeBlockTrailer();
+end;
+
+lisp procedure ASMOutLap1 X;
+begin scalar Fn;
+ return if StringP X then PrintLabel X
+ else if atom X then PrintLabel FindLocalLabel X
+ else if (Fn := get(car X, 'ASMPseudoOp)) then Apply(Fn, list X)
+ else
+ % instruction output form is:
+ % "space" <opcode> [ "space" <operand> { "comma" <operand> } ] "newline"
+ << Prin2 '! ; % Space
+ PrintOpcode car X;
+ X := cdr X;
+ if not null X then
+ << Prin2 '! ; % SPACE
+ PrintOperand car X;
+ for each U in cdr X do
+ << Prin2 '!,; % COMMA
+ PrintOperand U >> >>;
+ Prin2 !$EOL!$ >>; % NEWLINE
+end;
+
+put('!*Entry, 'ASMPseudoOp, 'ASMPrintEntry);
+
+lisp procedure ASMPrintEntry X;
+begin scalar Y;
+ PrintComment X;
+ X := cadr X;
+ Y := FindEntryPoint X;
+ if not FlagP(X, 'InternalFunction) then FindIDNumber X;
+ if X eq MainEntryPointName!* then
+ << !*MainFound := T;
+ SpecialActionForMainEntryPoint() >>
+ else CodeDeclareExportedUse Y;
+ end;
+
+Procedure CodeDeclareExportedUse Y;
+ if !*DeclareBeforeUse then
+ << CodeDeclareExported Y;
+ PrintLabel Y >>
+ else
+ << PrintLabel Y;
+ CodeDeclareExported Y >>;
+
+lisp procedure FindEntryPoint X;
+begin scalar E;
+ return if (E := get(X, 'EntryPoint)) then E
+ else if ASMSymbolP X and not get(X, 'ASMSymbol) then
+ << put(X, 'EntryPoint, X);
+ X >>
+ else
+ << E := StringGenSym();
+ put(X, 'EntryPoint, E);
+ E >>;
+end;
+
+lisp procedure ASMPseudoPrintFloat X;
+ PrintF(DoubleFloatFormat!*, cadr X);
+
+put('Float, 'ASMPseudoOp, 'ASMPseudoPrintFloat);
+
+lisp procedure ASMPseudoPrintFullWord X;
+ for each Y in cdr X do PrintFullWord Y;
+
+put('FullWord, 'ASMPseudoOp, 'ASMPseudoPrintFullWord);
+
+lisp procedure ASMPseudoPrintIndWord X;
+ for each Y in cdr X do PrintIndWord Y;
+
+put('IndWord, 'ASMPseudoOp, 'ASMPseudoPrintIndWord);
+
+lisp procedure ASMPseudoPrintByte X;
+ PrintByteList cdr X;
+
+put('Byte, 'ASMPseudoOp, 'ASMPseudoPrintByte);
+
+lisp procedure ASMPseudoPrintHalfWord X;
+ PrintHalfWordList cdr X;
+
+put('HalfWord, 'ASMPseudoOp, 'ASMPseudoPrintHalfWord);
+
+lisp procedure ASMPseudoPrintString X;
+ PrintString cadr X;
+
+put('String, 'ASMPseudoOp, 'ASMPseudoPrintString);
+
+lisp procedure PrintOperand X;
+ if StringP X then Prin2 X
+ else if NumberP X then PrintNumericOperand X
+ else if IDP X then Prin2 FindLabel X
+ else begin scalar Hd, Fn;
+ Hd := car X;
+ if (Fn := get(Hd, 'OperandPrintFunction)) then
+ Apply(Fn, list X)
+ else if (Fn := GetD Hd) and car Fn = 'MACRO then
+ PrintOperand Apply(cdr Fn, list X)
+ else if (Fn := WConstEvaluable X) then PrintOperand Fn
+ else PrintExpression X;
+ end;
+
+put('REG, 'OperandPrintFunction, 'PrintRegister);
+
+lisp procedure PrintRegister X;
+begin scalar Nam;
+ X := cadr X;
+ if StringP X then Prin2 X
+ else if NumberP X then Prin2 GetV(NumericRegisterNames!*, X)
+ else if Nam := RegisterNameP X then Prin2 Nam
+ else
+ << ErrorPrintF("***** Unknown register %r", X);
+ Prin2 X >>;
+end;
+
+lisp procedure RegisterNameP X;
+ get(X, 'RegisterName);
+
+lisp procedure ASMEntry X;
+ PrintExpression
+ list('plus2, 'SymFnc,
+ list('times2, AddressingUnitsPerFunctionCell,
+ list('IDLoc, cadr X)));
+
+put('Entry, 'OperandPrintFunction, 'ASMEntry);
+
+lisp procedure ASMInternalEntry X;
+ Prin2 FindEntryPoint cadr X;
+
+put('InternalEntry, 'OperandPrintFunction, 'ASMInternalEntry);
+put('InternalEntry, 'ASMExpressionFunction, 'ASMInternalEntry);
+
+macro procedure ExtraReg U;
+ list('plus2, '(WArray ArgumentBlock), (cadr U - (LastActualReg!& + 1))
+ * AddressingUnitsPerItem);
+
+lisp procedure ASMSyslispVarsPrint X;
+ Prin2 FindGlobalLabel cadr X;
+
+DefList('((WVar ASMSyslispVarsPrint)
+ (WArray ASMSyslispVarsPrint)
+ (WString ASMSyslispVarsPrint)), 'OperandPrintFunction);
+
+DefList('((WVar ASMSyslispVarsPrint)
+ (WArray ASMSyslispVarsPrint)
+ (WString ASMSyslispVarsPrint)), 'ASMExpressionFunction);
+
+lisp procedure ASMPrintValueCell X;
+ PrintExpression list('plus2, 'SymVal,
+ list('times, AddressingUnitsPerItem,
+ list('IDLoc, cadr X)));
+
+DefList('((fluid ASMPrintValueCell)
+ (!$fluid ASMPrintValueCell)
+ (global ASMPrintValueCell)
+ (!$global ASMPrintValueCell)), 'OperandPrintFunction);
+
+% Redefinition of WDeclare for output to assembler file
+
+% if either UpperBound or Initializer are NIL, they are considered to be
+% unspecified.
+
+fexpr procedure WDeclare U;
+ for each X in cddr U do WDeclare1(car X, car U, cadr U, cadr X, caddr X);
+
+flag('(WDeclare), 'IGNORE);
+
+lisp procedure WDeclare1(Name, Scope, Typ, UpperBound, Initializer);
+ if Typ = 'WCONST then
+ if Scope = 'EXTERNAL and not get(Name, 'WCONST) then
+ ErrorPrintF("*** A value has not been defined for WConst %r",
+ Name)
+ else
+ << put(Name, 'SCOPE, if Scope = 'EXPORTED then 'EXTERNAL else Scope);
+ put(Name, 'WCONST, WConstReform Initializer) >>
+ else
+ << put(Name, Typ, Name);
+ if Scope = 'EXTERNAL then
+ << put(Name, 'SCOPE, 'EXTERNAL);
+ if not RegisterNameP Name then % kludge to avoid declaring
+ << Name := LookupOrAddASMSymbol Name;
+ DataDeclareExternal Name; % registers as variables
+ CodeDeclareExternal Name >> >>
+ else
+ << put(Name, 'SCOPE, if Scope = 'EXPORTED then 'EXTERNAL else Scope);
+ Name := LookupOrAddASMSymbol Name;
+ if !*DeclareBeforeUse then DataDeclareExported Name;
+ DataInit(Name,
+ Typ,
+ UpperBound,
+ Initializer);
+ if not !*DeclareBeforeUse then DataDeclareExported Name;
+ CodeDeclareExternal Name >> >>;
+
+lisp procedure DataInit(ASMSymbol, Typ, UpperBound, Initializer);
+<< DataAlignFullWord();
+ if Typ = 'WVAR then
+ << if UpperBound then
+ ErrorPrintF "*** An UpperBound may not be specified for a WVar";
+ Initializer := if Initializer then WConstReform Initializer else 0;
+ DataPrintVar(ASMSymbol, Initializer) >>
+ else
+ << if UpperBound and Initializer then
+ ErrorPrintF "*** Can't have both UpperBound and initializer"
+ else if not (UpperBound or Initializer) then
+ ErrorPrintF "*** Must have either UpperBound or initializer"
+ else if UpperBound then
+ DataPrintBlock(ASMSymbol, WConstReform UpperBound, Typ)
+ else
+ << Initializer := if StringP Initializer then Initializer
+ else WConstReformLis Initializer;
+ DataPrintList(ASMSymbol, Initializer, Typ) >> >> >>;
+
+lisp procedure WConstReform U;
+begin scalar X;
+ return if FixP U or StringP U then U
+ else if IDP U then
+ if get(U, 'WARRAY) or get(U, 'WSTRING) then U
+ else if get(U,'WVAR) then list('GETMEM,U)
+ else if (X := get(U, 'WCONST)) then X
+ else ErrorPrintF("*** Unknown symbol %r in WConstReform", U)
+ else if PairP U then
+ if (X := get(car U, 'WConstReformPseudo)) then Apply(X, list U)
+ else if (X := get(car U, 'DOFN)) then X . WConstReformLis cdr U
+ else if MacroP car U then WConstReform Apply(cdr GetD car U, list U)
+ else car U . WConstReformLis cdr U
+ else ErrorPrintF("*** Illegal expression %r in WConstReform", U);
+end;
+
+lisp procedure WConstReformIdent U;
+ U;
+
+put('InternalEntry, 'WConstReformPseudo, 'WConstReformIdent);
+
+lisp procedure WConstReformQuote U;
+ CompileConstant cadr U;
+
+put('QUOTE, 'WConstReformPseudo, 'WConstReformQuote);
+
+lisp procedure WConstReformLis U;
+ for each X in U collect WConstReform X;
+
+lisp procedure WConstReformLoc U; %. To handle &Foo[23]
+<< U := WConstReform cadr U;
+ if car U neq 'GETMEM then
+ ErrorPrintF("*** Illegal constant addressing expression %r",
+ list('LOC, U))
+ else cadr U >>;
+
+put('LOC, 'WConstReformPseudo, 'WConstReformLoc);
+
+lisp procedure WConstReformIDLoc U;
+ FindIDNumber cadr U;
+
+put('IDLoc, 'WConstReformPseudo, 'WConstReformIDLoc);
+
+lisp procedure LookupOrAddASMSymbol U;
+begin scalar X;
+ if not (X := get(U, 'ASMSymbol)) then X := AddASMSymbol U;
+ return X;
+end;
+
+lisp procedure AddASMSymbol U;
+begin scalar X;
+ X := if ASMSymbolP U and not get(U, 'EntryPoint) then U
+ else StringGensym();
+ put(U, 'ASMSymbol, X);
+ return X;
+end;
+
+lisp procedure DataPrintVar(Name, Init);
+begin scalar OldOut;
+ DataPrintLabel Name;
+ OldOut := WRS DataOut!*;
+ PrintFullWord Init;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintBlock(Name, Siz, Typ);
+<< if Typ = 'WSTRING
+ then Siz := list('quotient, list('plus2, Siz, CharactersPerWord + 1),
+ CharactersPerWord)
+ else Siz := list('plus2, Siz, 1);
+ DataReserveZeroBlock(Name, Siz) >>;
+
+lisp procedure DataPrintList(Nam, Init, Typ);
+begin scalar OldOut;
+ DataPrintLabel Nam;
+ OldOut := WRS DataOut!*;
+ if Typ = 'WSTRING then
+ if StringP Init then
+ << PrintFullWord Size Init;
+ PrintString Init >>
+ else
+ << PrintFullWord(Length Init - 1);
+ PrintByteList Append(Init, '(0)) >>
+ else
+ if StringP Init then begin scalar S;
+ S := Size Init;
+ for I := 0 step 1 until S do
+ PrintFullWord Indx(Init, I);
+ end else for each X in Init do
+ PrintFullWord X;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintGlobalLabel X;
+<< if !*DeclareBeforeUse then DataDeclareExported X;
+ DataPrintLabel X;
+ if not !*DeclareBeforeUse then DataDeclareExported X;
+ CodeDeclareExternal X >>;
+
+
+lisp procedure DataDeclareExternal X;
+ if not (X member DataExternals!* or X member DataExporteds!*) then
+ << DataExternals!* := X . DataExternals!*;
+ DataPrintF(ExternalDeclarationFormat!*, X, X) >>;
+
+lisp procedure CodeDeclareExternal X;
+ if not (X member CodeExternals!* or X member CodeExporteds!*) then
+ << CodeExternals!* := X . CodeExternals!*;
+ CodePrintF(ExternalDeclarationFormat!*, X, X) >>;
+
+lisp procedure DataDeclareExported X;
+<< if X member DataExternals!* or X member DataExporteds!* then
+ ErrorPrintF("***** %r multiply defined", X);
+ DataExporteds!* := X . DataExporteds!*;
+ DataPrintF(ExportedDeclarationFormat!*, X, X) >>;
+
+lisp procedure CodeDeclareExported X;
+<< if X member CodeExternals!* or X member CodeExporteds!* then
+ ErrorPrintF("***** %r multiply defined", X);
+ CodeExporteds!* := X . CodeExporteds!*;
+ CodePrintF(ExportedDeclarationFormat!*, X, X) >>;
+
+lisp procedure PrintLabel X;
+ PrintF(LabelFormat!*, X,X);
+
+lisp procedure DataPrintLabel X;
+ DataPrintF(LabelFormat!*, X,X);
+
+lisp procedure CodePrintLabel X;
+ CodePrintF(LabelFormat!*, X,X);
+
+lisp procedure PrintComment X;
+ PrintF(CommentFormat!*, X);
+
+PrintExpressionForm!* := list('PrintExpression, MkQuote NIL);
+PrintExpressionFormPointer!* := cdadr PrintExpressionForm!*;
+
+% Save some consing
+% instead of list('PrintExpression, MkQuote X), reuse the same list structure
+
+lisp procedure PrintFullWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ PrintF(FullWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure PrintIndWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ PrintF(IndWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataPrintFullWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ DataPrintF(FullWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure CodePrintFullWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ CodePrintF(FullWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataReserveZeroBlock(Nam, X);
+<< RplacA(PrintExpressionFormPointer!*,
+ list('Times2, AddressingUnitsPerItem, X));
+ DataPrintF(ReserveZeroBlockFormat!*, Nam, PrintExpressionForm!*) >>;
+
+lisp procedure DataReserveBlock X;
+<< RplacA(PrintExpressionFormPointer!*,
+ list('Times2, AddressingUnitsPerItem, X));
+ DataPrintF(ReserveDataBlockFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataReserveFunctionCellBlock X;
+<< RplacA(PrintExpressionFormPointer!*,
+ list('Times2, AddressingUnitsPerFunctionCell, X));
+ DataPrintF(ReserveDataBlockFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataPrintUndefinedFunctionCell();
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ for each X in UndefinedFunctionCellInstructions!* do
+ ASMOutLap1 X;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintDefinedFunctionCell X;
+ <<DataDeclareExternal X;
+ DataPrintF(DefinedFunctionCellFormat!*, X, X)>>;
+ % in case it's needed twice
+
+
+lisp procedure DataPrintByteList X;
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintByteList X;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintExpression X;
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintExpression X;
+ WRS OldOut;
+end;
+
+lisp procedure CodePrintExpression X;
+begin scalar OldOut;
+ OldOut := WRS CodeOut!*;
+ PrintExpression X;
+ WRS OldOut;
+end;
+
+ExpressionCount!* := -1;
+
+lisp procedure PrintExpression X;
+(lambda(ExpressionCount!*);
+begin scalar Hd, Tl, Fn;
+ X := ResolveWConstExpression X;
+ if NumberP X or StringP X then Prin2 X
+ else if IDP X then Prin2 FindLabel X
+ else if atom X then
+ << ErrorPrintF("***** Oddity in expression %r", X);
+ Prin2 X >>
+ else
+ << Hd := car X;
+ Tl := cdr X;
+ if (Fn := get(Hd, 'BinaryASMOp)) then
+ << if ExpressionCount!* > 0 then Prin2 ASMOpenParen!*;
+ PrintExpression car Tl;
+ Prin2 Fn;
+ PrintExpression cadr Tl;
+ if ExpressionCount!* > 0 then Prin2 ASMCloseParen!* >>
+ else if (Fn := get(Hd, 'UnaryASMOp)) then
+ << Prin2 Fn;
+ PrintExpression car Tl >>
+ else if (Fn := get(Hd, 'ASMExpressionFormat)) then
+ Apply('PrintF, Fn . for each Y in Tl collect
+ list('PrintExpression, MkQuote Y))
+ else if (Fn := GetD Hd) and car Fn = 'MACRO then
+ PrintExpression Apply(cdr Fn, list X)
+ else if (Fn := get(Hd, 'ASMExpressionFunction)) then
+ Apply(Fn, list X)
+ else
+ << ErrorPrintF("***** Unknown expression %r", X);
+ PrintF("*** Expression error %r ***", X) >> >>;
+end)(ExpressionCount!* + 1);
+
+lisp procedure ASMPrintWConst U;
+ PrintExpression cadr U;
+
+put('WConst, 'ASMExpressionFunction, 'ASMPrintWConst);
+
+DefList('((Plus2 !+)
+ (WPlus2 !+)
+ (Difference !-)
+ (WDifference !-)
+ (Times2 !*)
+ (WTimes2 !*)
+ (Quotient !/)
+ (WQuotient !/)), 'BinaryASMOp);
+
+DefList('((Minus !-)
+ (WMinus !-)), 'UnaryASMOp);
+
+lisp procedure CompileConstant X;
+<< X := BuildConstant X;
+ if null cdr X then car X
+ else
+ << If !*DeclareBeforeUse then CodeDeclareExported cadr X;
+ ASMOutLap cdr X;
+ DataDeclareExternal cadr X;
+ If Not !*DeclareBeforeUse then CodeDeclareExported cadr X;
+ car X >> >>;
+
+CommentOutCode <<
+lisp procedure CompileHeapData X;
+begin scalar Y;
+ X := BuildConstant X;
+ return if null cdr X then car X
+ else
+ << Y := WRS DataOut!*;
+ for each Z in cdr X do ASMOutLap1 Z;
+ DataDeclareExported cadr X;
+ WRS Y;
+ car X >>;
+end;
+>>;
+
+lisp procedure DataPrintString X;
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintString X;
+ WRS OldOut;
+end;
+
+lisp procedure FindLabel X;
+begin scalar Y;
+ return if (Y := Atsoc(X, LocalLabels!*)) then cdr Y
+ else if (Y := get(X, 'ASMSymbol)) then Y
+ else if (Y := get(X, 'WConst)) then Y
+ else FindLocalLabel X;
+end;
+
+lisp procedure FindLocalLabel X;
+begin scalar Y;
+ return if (Y := Atsoc(X, LocalLabels!*)) then cdr Y
+ else
+ << LocalLabels!* := (X . (Y := StringGensym())) . LocalLabels!*;
+ Y >>;
+end;
+
+lisp procedure FindGlobalLabel X;
+ get(X, 'ASMSymbol) or ErrorPrintF("***** Undefined symbol %r", X);
+
+lisp procedure CodePrintF(Fmt, A1, A2, A3, A4);
+begin scalar OldOut;
+ OldOut := WRS CodeOut!*;
+ PrintF(Fmt, A1, A2, A3, A4);
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintF(Fmt, A1, A2, A3, A4);
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintF(Fmt, A1, A2, A3, A4);
+ WRS OldOut;
+end;
+
+% Kludge of the year, just to avoid having IDLOC defined during compilation
+
+CompileTime fluid '(MACRO);
+
+MACRO := 'MACRO;
+
+PutD('IDLoc, MACRO,
+function lambda X;
+ FindIDNumber cadr X);
+
+END;
ADDED psl-1983/3-1/comp/20/tags.red
Index: psl-1983/3-1/comp/20/tags.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/20/tags.red
@@ -0,0 +1,66 @@
+% <PSL.COMP.20.EXT>TAGS.RED.7, 1-Jun-83 08:10:26, Edit by KESSLER
+% Change BothTimes Declarations of wconsts to compiletime.
+on syslisp;
+
+% tags
+
+CompileTime <<
+exported WConst TagStartingBit = 0,
+ TagBitLength = 6,
+ InfStartingBit = 6,
+ InfBitLength = 30,
+ GCStartingBit = 0,
+ GCBitLength = 0,
+ AddressingUnitsPerItem = 1,
+ CharactersPerWord = 5,
+ BitsPerWord = 36,
+ AddressingUnitsPerFunctionCell = 1,
+ StackDirection = 1;
+
+>>;
+
+off syslisp;
+
+CompileTime <<
+lisp procedure DeclareTagRange(NameList, StartingValue, Increment);
+begin scalar Result;
+ Result := list 'progn;
+ while NameList do
+ << Result := list('put, MkQuote car NameList,
+ '(quote WConst),
+ StartingValue)
+ . Result;
+ StartingValue := StartingValue + Increment;
+ NameList := cdr NameList >>;
+ return ReversIP Result;
+end;
+
+macro procedure LowTags U;
+ DeclareTagRange(cdr U, 0, 1);
+
+macro procedure MidTags U;
+ DeclareTagRange(cdr U, LSH(1, get('TagBitLength, 'WConst) - 1) - 2, -1);
+
+macro procedure HighTags U;
+ DeclareTagRange(cdr U, LSH(1, get('TagBitLength, 'WConst)) - 1, -1);
+>>;
+
+% JumpInType and friends depend on the ordering and contiguity of
+% the numeric type tags. Fast arithmetic depends on PosInt = 0,
+% NegInt = -1. Garbage collectors depend on pointer tags being
+% between PosInt and Code, non-inclusive. /csp
+
+LowTags(PosInt, FixN, BigN, FltN, Str, Bytes, HalfWords, Wrds, Vect, Pair,
+ Evect);
+
+put('Code, 'WConst, 15);
+
+% Extended addressing treats negative word (one with aits high-order bit
+% on) as a local address--hence pointer types must have (positive) MidTags
+
+MidTags( ID, Unbound, BtrTag, Forward,
+ HVect, HWrds, HHalfWords, HBytes);
+
+HighTags(NegInt);
+
+
ADDED psl-1983/3-1/comp/anyreg-cmacro.sl
Index: psl-1983/3-1/comp/anyreg-cmacro.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/anyreg-cmacro.sl
@@ -0,0 +1,263 @@
+(*
+"% ANYREG-CMACRO.SL - Table-driven Anyreg and C-macro expander
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 December 1981
+% Copyright (c) 1981 University of Utah
+%")
+
+(fluid '(ResultingCode!* TempLabel!* TempLabel2!*))
+
+(* "Generated code is collected in reverse order in ResultingCode*")
+
+(CompileTime (flag '(SafePair PatternSublA WConstEvaluabLis
+ AnyregPatternMatch1 MatchAll AnyregSubstitute1
+ TempLabelGen
+ CMacroSubstitute1)
+ 'InternalFunction))
+
+(dm DefAnyreg (Form)
+ (prog (AnyregName FunctionName Pattern)
+ (setq Form (cdr Form))
+ (setq AnyregName (car Form))
+ (setq Form (cdr Form))
+ (setq FunctionName (car Form))
+ (setq Pattern (cdr Form))
+ (return (list 'progn
+ (list 'put
+ (MkQuote AnyregName)
+ '(quote AnyregResolutionFunction)
+ (MkQuote FunctionName))
+ (list 'put
+ (MkQuote AnyregName)
+ '(quote AnyregPatternTable)
+ (MkQuote Pattern))))))
+
+(dm DefCMacro (Form)
+ (prog (CMacroName Pattern)
+ (setq Form (cdr Form))
+ (setq CMacroName (car Form))
+ (setq Pattern (cdr Form))
+ (return (list 'progn
+ (list 'flag
+ (MkQuote (list CMacroName))
+ '(quote MC))
+ (list 'put
+ (MkQuote CMacroName)
+ '(quote CMacroPatternTable)
+ (MkQuote Pattern))))))
+
+(de ResolveOperand (Register Source)
+ (prog (ResolveAnyregFunction)
+ (return (cond ((IDP Source) (ResolveWConst Source))
+ ((atom Source) Source)
+ ((FlagP (car Source) 'TerminalOperand) Source)
+ ((setq ResolveAnyregFunction
+ (get (car Source) 'AnyregResolutionFunction))
+ (Apply ResolveAnyregFunction
+ (cons Register (cdr Source))))
+ (t (ResolveWConst Source))))))
+
+(de ResolveWConst (Expression)
+ (prog (ResolvedExpression)
+ (setq ResolvedExpression (ResolveWConstExpression Expression))
+ (return (cond ((NumberP ResolvedExpression) ResolvedExpression)
+ (t (list 'Immediate Expression))))))
+
+(de ResolveWConstExpression (Expression)
+ (cond ((EqCar Expression 'WConst)
+ (ResolveWConstExpression (cadr Expression)))
+ (t (prog (ResultExpression)
+ (return
+ (cond
+ ((or (NumberP Expression) (StringP Expression)) Expression)
+ ((IDP Expression)
+ (cond ((setq ResultExpression (get Expression 'WConst))
+ ResultExpression)
+ (t Expression)))
+ (t (progn
+ (cond
+ ((MacroP (car Expression))
+ (return
+ (ResolveWConstExpression (Apply (car Expression)
+ (list Expression))))))
+ (setq Expression
+ (cons (car Expression)
+ (MapCar (cdr Expression)
+ (Function ResolveWConstExpression))))
+ (cond ((setq ResultExpression
+ (WConstEvaluable Expression))
+ ResultExpression)
+ (t Expression))))))))))
+
+(de WConstEvaluable (Expression)
+ (prog (WC WCLis DoFn)
+ (return
+ (cond ((NumberP Expression) Expression)
+ ((and (IDP Expression) (setq WC (get Expression 'WConst)))
+ WC)
+ ((and (PairP Expression) (IDP (setq WC (car Expression))))
+ (cond ((MacroP WC)
+ (WConstEvaluable (apply (car Expression)
+ (list Expression))))
+ ((and (or (and (setq DoFn (get WC 'DoFn))
+ (setq WC DoFn))
+ (not (FUnBoundP WC)))
+ (not (eq (setq WCLis
+ (WConstEvaluabLis (cdr
+ Expression)))
+ 'not)))
+ (Eval (cons WC WCLis)))
+ (T NIL)))
+ (T NIL)))))
+
+(de WConstEvaluabLis (ExpressionTail)
+ (prog (WC WCLis)
+ (return
+ (cond ((null ExpressionTail) NIL)
+ ((not (setq WC (WConstEvaluable (car ExpressionTail)))) 'not)
+ ((eq (setq WCLis (WConstEvaluabLis (cdr ExpressionTail)))
+ 'not)
+ 'not)
+ (T (cons WC WCLis))))))
+
+(de OneOperandAnyreg (Register Source AnyregName)
+ (ExpandOneArgumentAnyreg Register
+ (ResolveOperand Register Source)
+ AnyregName))
+
+(* "SecondArg must not require a register for evaluation.
+It is currently used only for (MEMORY reg const).")
+
+(de TwoOperandAnyreg (Register Source SecondArg AnyregName)
+ (ExpandTwoArgumentAnyreg Register
+ (ResolveOperand Register Source)
+ (ResolveOperand '(REG Error) SecondArg)
+ AnyregName))
+
+(de ExpandOneArgumentAnyreg (Register Source AnyregName)
+ (AnyregPatternExpand (list Register Source)
+ (get AnyregName 'AnyregPatternTable)))
+
+(de ExpandTwoArgumentAnyreg (Register Source SecondArg AnyregName)
+ (AnyregPatternExpand (list Register Source SecondArg)
+ (get AnyregName 'AnyregPatternTable)))
+
+(de ExpandThreeArgumentAnyreg (Register Source SecondArg ThirdArg AnyregName)
+ (AnyregPatternExpand (list Register Source SecondArg ThirdArg)
+ (get AnyregName 'AnyregPatternTable)))
+
+(de AnyregPatternExpand (ArgumentList PatternTable)
+ (AnyregSubstitute ArgumentList
+ (AnyregPatternMatch (cdr ArgumentList) PatternTable)))
+
+(* "The label operand must not require a register to resolve.")
+
+(de Expand2OperandAndLabelCMacro (Arg1 Arg2 Label CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1)
+ (ResolveOperand '(REG t2) Arg2)
+ (ResolveOperand '(REG Error) Label))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de Expand4OperandCMacro (Arg1 Arg2 Arg3 Arg4 CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1)
+ (ResolveOperand '(REG t2) Arg2)
+ (ResolveOperand '(REG Error) Arg3)
+ (ResolveOperand '(REG Error) Arg4))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de Expand2OperandCMacro (Arg1 Arg2 CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1)
+ (ResolveOperand '(REG t2) Arg2))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de Expand1OperandCMacro (Arg1 CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de CMacroPatternExpand (ArgumentList PatternTable)
+ (CMacroSubstitute ArgumentList
+ (AnyregPatternMatch ArgumentList PatternTable)))
+
+(de AnyregPatternMatch (ArgumentList PatternTable)
+ (cond ((null (cdr PatternTable)) (car PatternTable))
+ ((AnyregPatternMatch1 ArgumentList (caar PatternTable))
+ (cdar PatternTable))
+ (t (AnyregPatternMatch ArgumentList (cdr PatternTable)))))
+
+(de AnyregPatternMatch1 (ArgumentList PredicateOrPredicateList)
+ (cond ((atom PredicateOrPredicateList)
+ (Apply PredicateOrPredicateList ArgumentList))
+ (t (MatchAll ArgumentList PredicateOrPredicateList))))
+
+(de MatchAll (ArgumentList PredicateList)
+ (or (atom ArgumentList)
+ (atom PredicateList)
+ (and (Apply (car PredicateList) (list (car ArgumentList)))
+ (MatchAll (cdr ArgumentList) (cdr PredicateList)))))
+
+(de AnyregSubstitute (ArgumentList CodeAndAddressExpressionList)
+ (AnyregSubstitute1 (SafePair '(Register Source ArgTwo ArgThree)
+ ArgumentList)
+ CodeAndAddressExpressionList))
+
+(de AnyregSubstitute1 (NameExpressionAList CodeAndAddressExpressionList)
+ (cond ((null (cdr CodeAndAddressExpressionList))
+ (SublA NameExpressionAList (car CodeAndAddressExpressionList)))
+ (t (progn (setq ResultingCode!*
+ (cons (SublA NameExpressionAList
+ (car CodeAndAddressExpressionList))
+ ResultingCode!*))
+ (AnyregSubstitute1 NameExpressionAList
+ (cdr CodeAndAddressExpressionList))))))
+
+(de CMacroSubstitute (ArgumentList CodeTemplateList)
+ (prog (TempLabel!* TempLabel2!*)
+ (return (CMacroSubstitute1 (SafePair '(ArgOne ArgTwo
+ ArgThree
+ ArgFour
+ ArgFive)
+ ArgumentList)
+ CodeTemplateList))))
+
+(de CMacroSubstitute1 (NameExpressionAList CodeTemplateList)
+ (cond ((null CodeTemplateList) (ReversIP ResultingCode!*))
+ (t (progn (setq ResultingCode!*
+ (cons (PatternSublA NameExpressionAList
+ (car CodeTemplateList))
+ ResultingCode!*))
+ (CMacroSubstitute1 NameExpressionAList
+ (cdr CodeTemplateList))))))
+
+(de SafePair (CarList CdrList)
+ (cond ((and (PairP CarList) (PairP CdrList))
+ (cons (cons (car CarList) (car CdrList))
+ (SafePair (cdr CarList) (cdr CdrList))))
+ (t NIL)))
+
+(de PatternSublA (AList Expression)
+ (prog (X)
+ (return (cond ((null Expression) Expression)
+ ((atom Expression)
+ (cond ((eq Expression 'TempLabel)
+ (TempLabelGen 'TempLabel!*))
+ ((eq Expression 'TempLabel2)
+ (TempLabelGen 'TempLabel2!*))
+ ((setq X (atsoc Expression AList))
+ (cdr X))
+ (t Expression)))
+ (t (cons (PatternSublA AList (car Expression))
+ (PatternSublA AList (cdr Expression))))))))
+
+(de TempLabelGen (X)
+ ((lambda (Y)
+ (cond ((StringP Y) Y)
+ (T (set X (StringGensym)))))
+ (Eval X)))
ADDED psl-1983/3-1/comp/bare-psl.sym
Index: psl-1983/3-1/comp/bare-psl.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/bare-psl.sym
@@ -0,0 +1,4 @@
+(setq OrderedIDList!* (NCons NIL))
+(setq UncompiledExpressions!* (NCons NIL))
+(setq ToBeCompiledExpressions!* (NCons NIL))
+(setq NextIDNumber!* 129)
ADDED psl-1983/3-1/comp/big-faslend.build
Index: psl-1983/3-1/comp/big-faslend.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/big-faslend.build
@@ -0,0 +1,1 @@
+in "big-faslend.red"$
ADDED psl-1983/3-1/comp/big-faslend.red
Index: psl-1983/3-1/comp/big-faslend.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/big-faslend.red
@@ -0,0 +1,39 @@
+% BIG-FASLEND.RED - Patch to FASLEND for huge files
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 7 May 1982
+% Copyright (c) 1982 University of Utah
+% <PSL.COMP>BIG-FASLEND.RED.4, 10-Jun-82 10:39:32, Edit by GRISS
+% Added InitCodeMax!* for testing
+%
+
+lisp procedure CompileUncompiledExpressions();
+ <<ErrorPrintF("%n*** Init code length is %w%n",
+ length car UncompiledExpressions!*);
+ CompileInitCode('!*!*Fasl!*!*InitCode!*!*,
+ car UncompiledExpressions!*)>>;
+
+FLUID '(InitCodeMax!*);
+
+LoadTime <<InitCodeMax!*:=350>>;
+
+lisp procedure CompileInitCode(Name, InitCodeList);
+begin scalar X, Len, LastHalf;
+ return if ILessP(Len := length InitCodeList, InitCodeMax!*) then
+ DfPrintFasl list('de, Name, '(), 'progn . InitCodeList)
+ else
+ << ErrorPrintF(
+"*** Initcode length %w too large, splitting into smaller pieces", Len);
+ ErrorPrintF("*** Please use smaller files in FASL");
+ X := PNTH(InitCodeList, IQuotient(Len, 2));
+ LastHalf := cdr X;
+ Rplacd(X, NIL); % tricky, split the code in 2
+ X := Intern Concat(ID2String Name, StringGensym());
+ Flag1(X, 'InternalFunction); % has to be internal to get called!
+ CompileInitCode(X,
+ InitCodeList);
+ CompileInitCode(Name, list X . LastHalf) >>; % call previous
+end;
ADDED psl-1983/3-1/comp/common-cmacros.sl
Index: psl-1983/3-1/comp/common-cmacros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/common-cmacros.sl
@@ -0,0 +1,286 @@
+(*
+"% COMMON-CMACROS.SL - C-macros and Anyregs common to all implementations
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 December 1981
+% Copyright (c) 1981 University of Utah
+%")
+
+(fluid '(NAlloc!* AddressingUnitsPerItem StackDirection ResultingCode!*))
+
+(de !*Link (FunctionName FunctionType NumberOfArguments)
+ (list (cond ((FlagP FunctionName 'ForeignFunction)
+ (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments))
+ (t (list '!*Call FunctionName)))))
+
+(DefCMacro !*Link)
+
+(de !*Call (FunctionName)
+ (prog (ResultingCode!* OpenCodeSequence)
+ (return (cond ((setq OpenCodeSequence
+ (get FunctionName 'OpenCode))
+ OpenCodeSequence)
+ (t (CMacroPatternExpand (list FunctionName)
+ (get '!*Call
+ 'CMacroPatternTable)))))))
+
+(de !*LinkE (DeAllocCount FunctionName FunctionType NumberOfArguments)
+ (cons (list '!*DeAlloc DeAllocCount)
+ (cond ((FlagP FunctionName 'ForeignFunction)
+ (list (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments)
+ '(!*Exit 0)))
+ (t (list (list '!*JCall FunctionName))))))
+
+(DefCMacro !*LinkE)
+
+(de !*JCall (FunctionName)
+ (prog (ResultingCode!* OpenCodeSequence)
+ (return (cond ((setq OpenCodeSequence
+ (get FunctionName 'ExitOpenCode))
+ OpenCodeSequence)
+ ((setq OpenCodeSequence
+ (get FunctionName 'OpenCode))
+ (Append OpenCodeSequence (list '(!*Exit 0))))
+ (t (CMacroPatternExpand (list FunctionName)
+ (get '!*JCall
+ 'CMacroPatternTable)))))))
+
+
+(de !*DeAlloc (DeAllocCount)
+ (Expand1OperandCMacro (times DeAllocCount AddressingUnitsPerItem)
+ '!*DeAlloc))
+
+(de !*Alloc (N)
+ (progn (setq NAlloc!* N)
+ (Expand1OperandCMacro (times N AddressingUnitsPerItem) '!*Alloc)))
+
+(de !*Exit (N)
+ (Expand1OperandCMacro (times N AddressingUnitsPerItem) '!*Exit))
+
+(de !*JumpWithin (Label LowerBound UpperBound)
+ (prog (ExitLabel)
+ (setq ExitLabel (list 'Label (GenSym)))
+ (return (list (list '!*JumpWLessP ExitLabel '(Reg 1) LowerBound)
+ (list '!*JumpWLeq Label '(Reg 1) UpperBound)
+ (list '!*Lbl ExitLabel)))))
+
+(DefCMacro !*JumpWithin)
+
+(de !*ProgBind (FluidsList)
+ (!*LamBind '(Registers) FluidsList))
+
+(DefCMacro !*ProgBind)
+
+(de !*FreeRstr (FluidsList)
+ (Expand1OperandCMacro (length (cdr FluidsList)) '!*FreeRstr))
+
+(de !*Jump (Arg1)
+ (Expand1OperandCMacro Arg1 '!*Jump))
+
+(de !*Lbl (Arg1)
+ (cdr Arg1))
+
+(de !*Push (Arg1)
+ (Expand1OperandCMacro Arg1 '!*Push))
+
+(de !*Pop (Arg1)
+ (Expand1OperandCMacro Arg1 '!*Pop))
+
+(de !*Move (Source Destination)
+ (prog (ResultingCode!* ResolvedDestination)
+ (setq ResolvedDestination (ResolveOperand '(REG t2) Destination))
+ (return
+ (CMacroPatternExpand
+ (list (ResolveOperand (cond ((RegisterP ResolvedDestination)
+ ResolvedDestination)
+ (t '(REG t1)))
+ Source)
+ ResolvedDestination)
+ (get '!*Move 'CMacroPatternTable)))))
+
+(de !*JumpEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpEQ))
+
+(de !*JumpNotEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpNotEQ))
+
+(de !*JumpWLessP (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWLessP))
+
+(de !*JumpWGreaterP (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWGreaterP))
+
+(de !*JumpWLEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWLEQ))
+
+(de !*JumpWGEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWGEQ))
+
+(de !*JumpType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpType))
+
+(de !*JumpNotType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpNotType))
+
+(de !*JumpInType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpInType))
+
+(de !*JumpNotInType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpNotInType))
+
+(de !*MkItem (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*MkItem))
+
+(de !*WPlus2 (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WPlus2))
+
+(de !*WDifference (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WDifference))
+
+(de !*WTimes2 (Arg1 Arg2)
+ (prog (P)
+ (return (cond ((and (or (EqCar Arg2 'Quote)
+ (EqCar Arg2 'WConst))
+ (setq P (PowerOf2P (cadr Arg2))))
+ (!*AShift Arg1 (list (car Arg2) P)))
+ (t (Expand2OperandCMacro Arg1 Arg2 '!*WTimes2))))))
+
+(* "PowerOf2P(X:integer):{integer,NIL}
+If X is a positive power of 2, log base 2 of X is returned. Otherwise
+NIL is returned.")
+
+(de PowerOf2P (X)
+ (prog (N)
+ (return (cond ((or (not (FixP X)) (MinusP X) (equal X 0)) NIL)
+ (t (progn (setq N 0)
+ (while (not (equal (lor x 1) x))
+ (progn (setq N (add1 N))
+ (setq X (lsh X -1))))
+ (cond ((equal X 1) N) (T NIL))))))))
+
+(de !*AShift (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*AShift))
+
+(de !*WShift (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WShift))
+
+(de !*WAnd (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WAnd))
+
+(de !*WOr (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WOr))
+
+(de !*WXOr (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WXOr))
+
+(de !*WMinus (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WMinus))
+
+(de !*WNot (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WNot))
+
+(de !*Loc (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*Loc))
+
+(de !*Field (Arg1 Arg2 Arg3 Arg4)
+ (Expand4OperandCMacro Arg1 Arg2 Arg3 Arg4 '!*Field))
+
+(de !*SignedField (Arg1 Arg2 Arg3 Arg4)
+ (Expand4OperandCMacro Arg1 Arg2 Arg3 Arg4 '!*SignedField))
+
+(de !*PutField (Arg1 Arg2 Arg3 Arg4)
+ (Expand4OperandCMacro Arg1 Arg2 Arg3 Arg4 '!*PutField))
+
+(de AnyregCAR (Register Source)
+ (OneOperandAnyreg Register Source 'car))
+
+(de AnyregCDR (Register Source)
+ (OneOperandAnyreg Register Source 'cdr))
+
+(de AnyregQUOTE (Register Source)
+ (ExpandOneArgumentAnyreg Register Source 'quote))
+
+(de AnyregWVAR (Register Source)
+ (ExpandOneArgumentAnyreg Register Source 'WVar))
+
+(de AnyregREG (Register Source)
+ (ExpandOneArgumentAnyreg Register Source 'REG))
+
+(de AnyregWCONST (Register Source)
+ (OneOperandAnyreg Register Source 'WConst))
+
+(DefAnyreg WCONST
+ AnyregWCONST
+ (SOURCE))
+
+(de AnyregFRAME (Register Source)
+ (ExpandOneArgumentAnyreg Register
+ (times StackDirection
+ AddressingUnitsPerItem
+ (difference 1 Source))
+ 'Frame))
+
+(de AnyregFRAMESIZE (Register)
+ (times NAlloc!* AddressingUnitsPerItem))
+
+(DefAnyreg FrameSize
+ AnyregFRAMESIZE)
+
+(de AnyregMEMORY (Register Source ArgTwo)
+ (TwoOperandAnyreg Register Source ArgTwo 'MEMORY))
+
+(flag '(FLUID !$FLUID GLOBAL !$GLOBAL ExtraReg Label) 'TerminalOperand)
+
+
+(fluid '(labelgen*)) % a-list of tags and labels
+
+% (labelgen tag) and (labelref tag) can be used as either ANYREG or CMACRO.
+% (labelgen tag) creates and returns a unique label, (labelref tag) returns
+% the same one. Useful for 'OpenCode lists.
+
+(de anyreglabelgen (reg name)
+ ((lambda (lb al)
+ (cond ((null al)
+ (setq labelgen* (cons (cons name lb) labelgen*)))
+ (t (rplacd al lb)))
+ lb)
+ (gensym)
+ (assoc name labelgen*)))
+
+(defanyreg labelgen anyreglabelgen)
+
+(de labelgen (name)
+ (list (anyreglabelgen nil name)))
+
+(defcmacro labelgen)
+
+
+(de anyreglabelref (reg name) (cdr (assoc name labelgen*)))
+
+(defanyreg labelref anyreglabelref)
+
+(de labelref (name)
+ (list (anyreglabelref nil name)))
+
+(defcmacro labelref)
ADDED psl-1983/3-1/comp/common-predicates.sl
Index: psl-1983/3-1/comp/common-predicates.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/common-predicates.sl
@@ -0,0 +1,40 @@
+(*
+"% COMMON-PREDICATES.SL - Predicates used for Anyreg and C-macro expansion
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 December 1981
+% Copyright (c) 1981 University of Utah
+%")
+
+(fluid '(EntryPoints!*
+ !*FastLinks))
+
+(global '(!*R2I))
+
+(de RegisterP (Expression)
+ (EqCar Expression 'REG))
+
+(de AnyP (Expression)
+ T)
+
+(de TaggedLabel (X)
+ (EqCar X 'Label))
+
+(de EqTP (Expression)
+ (equal Expression T))
+
+(de MinusOneP (Expression)
+ (equal Expression -1))
+
+(de InternallyCallableP (X) % only when writing a file
+ (and (or !*WritingFaslFile (not (FUnBoundP 'AsmOut)))
+ (or !*FastLinks
+ (and !*R2I (memq X EntryPoints!*))
+ (FlagP X 'InternalFunction)
+ (FlagP X 'FastLink))))
+
+(de AddressConstantP (Expression)
+ (or (atom Expression) (equal (car Expression) 'Immediate)))
ADDED psl-1983/3-1/comp/comp-decls.build
Index: psl-1983/3-1/comp/comp-decls.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/comp-decls.build
@@ -0,0 +1,1 @@
+in "comp-decls.red"$
ADDED psl-1983/3-1/comp/comp-decls.red
Index: psl-1983/3-1/comp/comp-decls.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/comp-decls.red
@@ -0,0 +1,403 @@
+%
+% COMP-DECLS.RED - Machine-independent declaractions used by the compiler
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 16 October 1981
+% Copyright (c) 1981 University of Utah
+%
+% <PSL.COMP>COMP-DECLS.RED.16, 3-Sep-82 09:46:43, Edit by BENSON
+% Added PA1REFORMFN for WNOT
+% <PSL.COMP>COMP-DECLS.RED.5, 3-Dec-82 18:20:08, Edit by PERDUE
+% Removed PA1REFORMFN for NE
+% <PSL.COMP>COMP-DECLS.RED.6, 24-Jan-83 16:04:00, Edit by MLGriss
+% Changed W to !%!%!%W in the EQCAR to avoid subst W into EQCAR form
+
+% Pass 1 functions
+
+put('Apply, 'PA1FN, '!&PaApply);
+PUT('ASSOC, 'PA1FN, '!&PAASSOC);
+PUT('EQUAL, 'PA1FN, '!&PAEQUAL);
+PUT('MEMBER, 'PA1FN, '!&PAMEMBER);
+put('Catch, 'Pa1Fn, '!&PaCatch);
+PUT('COND, 'PA1FN, '!&PACOND);
+PUT('DIFFERENCE,'PA1FN, '!&PADIFF);
+PUT('FUNCTION, 'PA1FN, '!&PAFUNCTION);
+PUT('GETMEM, 'PA1FN, '!&PAGETMEM);
+PUT('GO, 'PA1FN, '!&PAIDENT);
+PUT('CASE, 'PA1FN, '!&PACASE);
+PUT('INTERN, 'PA1FN, '!&PAINTERN);
+PUT('LAMBDA, 'PA1FN, '!&PALAMBDA);
+PUT('LESSP, 'PA1FN, '!&PALESSP);
+PUT('LIST, 'PA1FN, '!&PALIST);
+PUT('LOC, 'PA1REFORMFN, '!&REFORMLOC);
+PUT('MAP, 'PA1FN, '!&PAMAP);
+PUT('MAPC, 'PA1FN, '!&PAMAPC);
+PUT('MAPCAN, 'PA1FN, '!&PAMAPCAN);
+PUT('MAPCAR, 'PA1FN, '!&PAMAPCAR);
+PUT('MAPCON, 'PA1FN, '!&PAMAPCON);
+PUT('MAPLIST, 'PA1FN, '!&PAMAPLIST);
+PUT('MINUS, 'PA1FN, '!&PAMINUS);
+PUT('NULL, 'PA1REFORMFN, '!&REFORMNULL);
+% PUT('NE, 'PA1REFORMFN, '!&REFORMNE); % Perdue 12/3/82
+put('Nth, 'Pa1Fn, '!&PaNth);
+put('PNth, 'Pa1Fn, '!&PaPNth);
+PUT('PLUS2, 'PA1FN, '!&PAPLUS2);
+PUT('PROG, 'PA1FN, '!&PAPROG);
+PUT('PUTMEM, 'PA1FN, '!&PAPUTMEM);
+PUT('PUTLISPVAR,'PA1FN, '!&PAPUTLISPVAR);
+PUT('LISPVAR, 'PA1FN, '!&PALISPVAR);
+PUT('QUOTE, 'PA1FN, '!&PAIDENT);
+PUT('WCONST, 'PA1FN, '!&PAWCONST);
+PUT('SETQ, 'PA1FN, '!&PASETQ);
+PUT('WPLUS2, 'PA1FN, '!&GROUP);
+PUT('WDIFFERENCE,'PA1FN, '!&GROUP);
+PUT('WMINUS, 'PA1FN, '!&GROUP);
+PUT('WTIMES2, 'PA1FN, '!&ASSOCOP);
+PUT('WAND, 'PA1FN, '!&ASSOCOP);
+PUT('WOR, 'PA1FN, '!&ASSOCOP);
+PUT('WXOR, 'PA1FN, '!&ASSOCOP);
+PUT('WPLUS2, 'PA1ALGFN, '!&GROUPV);
+PUT('WDIFFERENCE,'PA1ALGFN, '!&GROUPV);
+PUT('WMINUS, 'PA1ALGFN, '!&GROUPV);
+PUT('WTIMES2, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WAND, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WOR, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WXOR, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WSHIFT, 'PA1REFORMFN, '!&DOOP);
+PUT('WNOT, 'PA1REFORMFN, '!&DOOP);
+put('WTimes2, 'PA1Reformfn, function !&PaReformWTimes2);
+
+% Simplification
+PUT('WPLUS2, 'DOFN, 'PLUS2);
+PUT('WDIFFERENCE,'DOFN, 'DIFFERENCE);
+PUT('WMINUS, 'DOFN, 'MINUS);
+PUT('WTIMES2, 'DOFN, 'TIMES2);
+PUT('WQUOTIENT, 'DOFN, 'QUOTIENT);
+PUT('WREMAINDER,'DOFN, 'REMAINDER);
+PUT('WAND, 'DOFN, 'LAND);
+PUT('WOR, 'DOFN, 'LOR);
+PUT('WXOR, 'DOFN, 'LXOR);
+PUT('WNOT, 'DOFN, 'LNOT);
+PUT('WSHIFT, 'DOFN, 'LSHIFT);
+
+PUT('WTIMES2, 'ONE, 1);
+PUT('WTIMES2, 'ZERO, 0);
+PUT('WPLUS2, 'ONE, 0);
+PUT('WPLUS2, 'GROUPOPS, '(WPLUS2 WDIFFERENCE WMINUS));
+PUT('WMINUS, 'GROUPOPS, '(WPLUS2 WDIFFERENCE WMINUS));
+PUT('WDIFFERENCE,'GROUPOPS, '(WPLUS2 WDIFFERENCE WMINUS));
+PUT('WAND, 'ZERO, 0);
+PUT('WOR, 'ONE, 0);
+PUT('WXOR, 'ONE, 0);
+
+% Compile functions
+
+PUT('AND, 'COMPFN, '!&COMANDOR);
+PUT('APPLY, 'COMPFN, '!&COMAPPLY);
+PUT('COND, 'COMPFN, '!&COMCOND);
+PUT('CONS, 'COMPFN, '!&COMCONS);
+PUT('GO, 'COMPFN, '!&COMGO);
+PUT('CASE, 'COMPFN, '!&COMCASE);
+PUT('OR, 'COMPFN, '!&COMANDOR);
+PUT('PROG, 'COMPFN, '!&COMPROG);
+PUT('PROG2, 'COMPFN, '!&COMPROGN);
+PUT('PROGN, 'COMPFN, '!&COMPROGN);
+PUT('RETURN, 'COMPFN, '!&COMRETURN);
+
+% Patterns for the tests and SETQ
+
+PUT('EQ, 'OPENTST, '(TSTPAT !*JUMPEQ));
+PUT('EQ, 'OPENFN, '(TVPAT !*JUMPEQ));
+PUT('NE, 'OPENTST, '(TSTPAT !*JUMPNOTEQ));
+PUT('NE, 'OPENFN, '(TVPAT !*JUMPNOTEQ));
+PUT('AND, 'OPENTST, '!&TSTANDOR);
+PUT('OR, 'OPENTST, '!&TSTANDOR);
+PUT('PAIRP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE PAIR));
+PUT('ATOM, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE PAIR));
+PUT('STRINGP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE STR));
+PUT('NOTSTRINGP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE STR));
+PUT('VECTORP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE VECT));
+PUT('NOTVECTORP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE VECT));
+PUT('CODEP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE CODE));
+PUT('NOTCODEP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE CODE));
+PUT('FLOATP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE FLTN));
+PUT('NOTFLOATP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE FLTN));
+PUT('INTP, 'OPENTST, '(TSTPAT2 !*JUMPINTYPE POSINT));
+PUT('NOTINTP, 'OPENTST, '(TSTPAT2 !*JUMPNOTINTYPE POSINT));
+PUT('FIXP, 'OPENTST, '(TSTPAT2 !*JUMPINTYPE BIGN));
+PUT('NOTFIXP, 'OPENTST, '(TSTPAT2 !*JUMPNOTINTYPE BIGN));
+PUT('NUMBERP, 'OPENTST, '(TSTPAT2 !*JUMPINTYPE FLTN));
+PUT('NOTNUMBERP,'OPENTST, '(TSTPAT2 !*JUMPNOTINTYPE FLTN));
+PUT('FIXNP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE FIXN));
+PUT('NOTFIXNP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE FIXN));
+PUT('BIGP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE BIGN));
+PUT('NOTBIGP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE BIGN));
+PUT('POSINTP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE POSINT));
+PUT('NOTPOSINTP,'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE POSINT));
+PUT('NEGINTP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE NEGINT));
+PUT('NOTNEGINTP,'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE NEGINT));
+PUT('IDP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE ID));
+PUT('NOTIDP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE ID));
+PUT('BYTESP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE BYTES));
+PUT('NOTBYTESP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE BYTES));
+PUT('WRDSP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE WRDS));
+PUT('NOTWRDSP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE WRDS));
+PUT('HALFWORDSP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE HALFWORDS));
+PUT('NOTHALFWORDSP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE HALFWORDS));
+PUT('PAIRP, 'OPENFN, '(TVPAT1 !*JUMPTYPE PAIR));
+PUT('ATOM, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE PAIR));
+PUT('STRINGP, 'OPENFN, '(TVPAT1 !*JUMPTYPE STR));
+PUT('NOTSTRINGP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE STR));
+PUT('VECTORP, 'OPENFN, '(TVPAT1 !*JUMPTYPE VECT));
+PUT('NOTVECTORP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE VECT));
+PUT('CODEP, 'OPENFN, '(TVPAT1 !*JUMPTYPE CODE));
+PUT('NOTCODEP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE CODE));
+PUT('FLOATP, 'OPENFN, '(TVPAT1 !*JUMPTYPE FLTN));
+PUT('NOTFLOATP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE FLTN));
+PUT('INTP, 'OPENFN, '(TVPAT1 !*JUMPINTYPE POSINT));
+PUT('NOTINTP, 'OPENFN, '(TVPAT1 !*JUMPNOTINTYPE POSINT));
+PUT('FIXP, 'OPENFN, '(TVPAT1 !*JUMPINTYPE BIGN));
+PUT('NOTFIXP, 'OPENFN, '(TVPAT1 !*JUMPNOTINTYPE BIGN));
+PUT('NUMBERP, 'OPENFN, '(TVPAT1 !*JUMPINTYPE FLTN));
+PUT('NOTNUMBERP,'OPENFN, '(TVPAT1 !*JUMPNOTINTYPE FLTN));
+PUT('FIXNP, 'OPENFN, '(TVPAT1 !*JUMPTYPE FIXN));
+PUT('NOTFIXNP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE FIXN));
+PUT('BIGP, 'OPENFN, '(TVPAT1 !*JUMPTYPE BIGN));
+PUT('NOTBIGP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE BIGN));
+PUT('POSINTP, 'OPENFN, '(TVPAT1 !*JUMPTYPE POSINT));
+PUT('NOTPOSINTP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE POSINT));
+PUT('NEGINTP, 'OPENFN, '(TVPAT1 !*JUMPTYPE NEGINT));
+PUT('NOTNEGINTP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE NEGINT));
+PUT('IDP, 'OPENFN, '(TVPAT1 !*JUMPTYPE ID));
+PUT('NOTIDP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE ID));
+PUT('BYTESP, 'OPENFN, '(TVPAT1 !*JUMPTYPE BYTES));
+PUT('NOTBYTESP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE BYTES));
+PUT('WRDSP, 'OPENFN, '(TVPAT1 !*JUMPTYPE WRDS));
+PUT('NOTWRDSP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE WRDS));
+PUT('HALFWORDSP, 'OPENFN, '(TVPAT1 !*JUMPTYPE HALFWORDS));
+PUT('NOTHALFWORDSP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE HALFWORDS));
+PUT('SETQ, 'OPENFN, '(SETQPAT NIL));
+PUT('RPLACA, 'OPENFN, '(RPLACPAT CAR));
+PUT('RPLACD, 'OPENFN, '(RPLACPAT CDR));
+PUT('WPLUS2, 'OPENFN, '(ASSOCPAT !*WPLUS2));
+PUT('WDIFFERENCE,'OPENFN, '(SUBPAT !*WDIFFERENCE));
+PUT('WTIMES2, 'OPENFN, '(ASSOCPAT !*WTIMES2));
+PUT('WMINUS, 'OPENFN, '(UNARYPAT !*WMINUS));
+PUT('WAND, 'OPENFN, '(ASSOCPAT !*WAND));
+PUT('WOR, 'OPENFN, '(ASSOCPAT !*WOR));
+PUT('WXOR, 'OPENFN, '(ASSOCPAT !*WXOR));
+PUT('WNOT, 'OPENFN, '(UNARYPAT !*WNOT));
+PUT('WSHIFT, 'OPENFN, '(NONASSOCPAT !*WSHIFT));
+PUT('MKITEMREV, 'OPENFN, '(NONASSOCPAT !*MKITEM));
+PUT('LOC, 'OPENFN, '(UNARYPAT !*LOC));
+PUT('!*ADDMEM, 'OPENFN, '(MODMEMPAT !*ADDMEM));
+PUT('!*MPYMEM, 'OPENFN, '(MODMEMPAT !*MPYMEM));
+PUT('FIELD, 'OPENFN, '(FIELDPAT !*FIELD));
+PUT('SIGNEDFIELD,'OPENFN, '(FIELDPAT !*SIGNEDFIELD));
+PUT('PUTFIELDREV,'OPENFN, '(PUTFIELDPAT !*PUTFIELD));
+PUT('WGREATERP,'OPENTST, '(TSTPATC !*JUMPWGREATERP !*JUMPWLESSP));
+PUT('WLEQ, 'OPENTST, '(TSTPATC !*JUMPWLEQ !*JUMPWGEQ));
+PUT('WGEQ, 'OPENTST, '(TSTPATC !*JUMPWGEQ !*JUMPWLEQ));
+PUT('WLESSP, 'OPENTST, '(TSTPATC !*JUMPWLESSP !*JUMPWGREATERP));
+PUT('WGREATERP, 'OPENFN, '(TVPAT !*JUMPWGREATERP));
+PUT('WLEQ, 'OPENFN, '(TVPAT !*JUMPWLEQ));
+PUT('WGEQ, 'OPENFN, '(TVPAT !*JUMPWGEQ));
+PUT('WLESSP, 'OPENFN, '(TVPAT !*JUMPWLESSP));
+
+PUT('EQ,'FLIPTST,'NE);
+PUT('NE,'FLIPTST,'EQ);
+PUT('ATOM,'FLIPTST,'PAIRP);
+PUT('PAIRP,'FLIPTST,'ATOM);
+PUT('STRINGP,'FLIPTST,'NOTSTRINGP);
+PUT('NOTSTRINGP,'FLIPTST,'STRINGP);
+PUT('BytesP,'FLIPTST,'NOTBytesP);
+PUT('NOTBytesP,'FLIPTST,'BytesP);
+PUT('WrdsP,'FLIPTST,'NOTWrdsP);
+PUT('NOTWrdsP,'FLIPTST,'WrdsP);
+PUT('HalfwordsP,'FLIPTST,'NOTHalfwordsP);
+PUT('NOTHalfwordsP,'FLIPTST,'HalfwordsP);
+PUT('CODEP,'FLIPTST,'NOTCODEP);
+PUT('NOTCODEP, 'FLIPTST,'CODEP);
+PUT('IDP,'FLIPTST,'NOTIDP);
+PUT('NOTIDP,'FLIPTST,'IDP);
+PUT('INTP,'FLIPTST,'NOTINTP);
+PUT('NOTINTP,'FLIPTST,'INTP);
+PUT('POSINTP,'FLIPTST,'NOTPOSINTP);
+PUT('NOTPOSINTP,'FLIPTST,'POSINTP);
+PUT('NEGINTP,'FLIPTST,'NOTNEGINTP);
+PUT('NOTNEGINTP,'FLIPTST,'NEGINTP);
+PUT('FIXP,'FLIPTST,'NOTFIXP);
+PUT('NOTFIXP,'FLIPTST,'FIXP);
+PUT('NUMBERP,'FLIPTST,'NOTNUMBERP);
+PUT('NOTNUMBERP,'FLIPTST,'NUMBERP);
+PUT('FIXNP,'FLIPTST,'NOTFIXNP);
+PUT('NOTFIXNP,'FLIPTST,'FIXNP);
+PUT('FLOATP,'FLIPTST,'NOTFLOATP);
+PUT('NOTFLOATP,'FLIPTST,'FLOATP);
+PUT('BIGP,'FLIPTST,'NOTBIGP);
+PUT('NOTBIGP,'FLIPTST,'BIGP);
+PUT('VECTORP,'FLIPTST,'NOTVECTORP);
+PUT('NOTVECTORP,'FLIPTST,'VECTORP);
+PUT('WLESSP,'FLIPTST,'WGEQ);
+PUT('WGEQ,'FLIPTST,'WLESSP);
+PUT('WLEQ,'FLIPTST,'WGREATERP);
+PUT('WGREATERP,'FLIPTST,'WLEQ);
+
+% Match functions
+
+PUT('ANY,'MATCHFN,'!&ANY);
+PUT('VAR,'MATCHFN,'!&VAR);
+PUT('REG,'MATCHFN,'!®FP);
+PUT('DEST,'MATCHFN,'!&DEST);
+PUT('USESDEST,'MATCHFN,'!&USESDEST);
+PUT('REGN,'MATCHFN,'!®N);
+PUT('NOTDEST,'MATCHFN,'!&NOTDEST);
+PUT('NOTANYREG,'MATCHFN,'!&NOTANYREG);
+PUT('MEM,'MATCHFN,'!&MEM);
+PUT('ANYREGFN,'MATCHFN,'!&ANYREGFNP);
+
+% Tag properties
+
+FLAG('(!$LOCAL !$GLOBAL !$FLUID QUOTE WCONST IDLOC WVAR
+ REG LABEL FRAME !*FRAMESIZE IREG),
+ 'TERMINAL);
+FLAG('(!$LOCAL !$GLOBAL !$FLUID WVAR),'VAR);
+FLAG('(QUOTE WCONST IDLOC FRAMESIZE),'CONST);
+FLAG('(REG),'REG);
+FLAG('(!$FLUID !$GLOBAL),'EXTVAR);
+FLAG('(CAR CDR !$NAME MEMORY FRAMESIZE), 'ANYREG);
+
+FLAG('(!*ADDMEM !*MPYMEM),'MEMMOD);
+
+% Optimizing functions
+
+PUT('!*LBL, 'OPTFN, '!&LBLOPT);
+PUT('!*MOVE, 'OPTFN, '!&STOPT);
+PUT('!*JUMP, 'OPTFN, '!&JUMPOPT);
+
+% Things which can be compiled
+
+FLAG('(EXPR FEXPR MACRO NEXPR),'COMPILE);
+
+% Some compiler macros
+
+DEFLIST('((CAAR (LAMBDA (U) (CAR (CAR U))))
+ (CADR (LAMBDA (U) (CAR (CDR U))))
+ (CDAR (LAMBDA (U) (CDR (CAR U))))
+ (CDDR (LAMBDA (U) (CDR (CDR U))))
+ (CAAAR (LAMBDA (U) (CAR (CAR (CAR U)))))
+ (CAADR (LAMBDA (U) (CAR (CAR (CDR U)))))
+ (CADAR (LAMBDA (U) (CAR (CDR (CAR U)))))
+ (CADDR (LAMBDA (U) (CAR (CDR (CDR U)))))
+ (CDAAR (LAMBDA (U) (CDR (CAR (CAR U)))))
+ (CDADR (LAMBDA (U) (CDR (CAR (CDR U)))))
+ (CDDAR (LAMBDA (U) (CDR (CDR (CAR U)))))
+ (CDDDR (LAMBDA (U) (CDR (CDR (CDR U)))))
+ (EQCAR (LAMBDA (U V)
+ ((LAMBDA (!%!%!%W) (AND (PAIRP !%!%!%W)
+ (EQ (CAR !%!%!%W) V))) U)))
+ (CONSTANTP (LAMBDA (U)
+ ((LAMBDA (V) (NOT (OR (PAIRP V) (IDP V))))
+ U)))
+ (WEQ (LAMBDA (U V) (EQ U V)))
+ (WNEQ (LAMBDA (U V) (NE U V)))
+ (IPLUS2 (LAMBDA (U V) (WPLUS2 U V)))
+ (IADD1 (LAMBDA (U) (WPLUS2 U 1)))
+ (IDIFFERENCE (LAMBDA (U V) (WDIFFERENCE U V)))
+ (ISUB1 (LAMBDA (U) (WDIFFERENCE U 1)))
+ (ITIMES2 (LAMBDA (U V) (WTIMES2 U V)))
+ (IQUOTIENT (LAMBDA (U V) (WQUOTIENT U V)))
+ (IREMAINDER (LAMBDA (U V) (WREMAINDER U V)))
+ (IGREATERP (LAMBDA (U V) (WGREATERP U V)))
+ (ILESSP (LAMBDA (U V) (WLESSP U V)))
+ (ILEQ (LAMBDA (U V) (WLEQ U V)))
+ (IGEQ (LAMBDA (U V) (WGEQ U V)))
+ (ILOR (LAMBDA (U V) (WOR U V)))
+ (ILSH (LAMBDA (U V) (WSHIFT U V)))
+ (ILAND (LAMBDA (U V) (WAND U V)))
+ (ILXOR (LAMBDA (U V) (WXOR U V)))
+ (IZEROP (LAMBDA (U) (EQ U 0)))
+ (IONEP (LAMBDA (U) (EQ U 1)))
+ (IMINUSP (LAMBDA (U) (WLESSP U 0)))
+ (IMINUS (LAMBDA (U) (WMINUS U)))
+ (PUTFIELD (LAMBDA (U V W X) (PUTFIELDREV X U V W)))
+ (MKITEM (LAMBDA (U V) (MKITEMREV V U)))
+ (NEQ (LAMBDA (U V) (NOT (EQUAL U V))))
+ (GEQ (LAMBDA (U V) (NOT (LESSP U V))))
+ (LEQ (LAMBDA (U V) (NOT (GREATERP U V))))
+ (NOT (LAMBDA (U) (NULL U)))),'CMACRO);
+
+% Macro functions
+
+PUT('A1,'SUBSTFN,'!&ARG1);
+PUT('A2,'SUBSTFN,'!&ARG2);
+PUT('A3,'SUBSTFN,'!&ARG3);
+PUT('A4,'SUBSTFN,'!&ARG4);
+PUT('FN,'SUBSTFN,'!&PARAM1);
+PUT('MAC,'SUBSTFN,'!&PARAM2);
+PUT('P2,'SUBSTFN,'!&PARAM3);
+PUT('P3,'SUBSTFN,'!&PARAM4);
+PUT('T1,'SUBSTFN,'!&GETTEMP);
+PUT('T2,'SUBSTFN,'!&GETTEMP);
+PUT('T3,'SUBSTFN,'!&GETTEMP);
+PUT('T4,'SUBSTFN,'!&GETTEMP);
+PUT('L1,'SUBSTFN,'!&GETTEMPLBL);
+PUT('L2,'SUBSTFN,'!&GETTEMPLBL);
+PUT('L3,'SUBSTFN,'!&GETTEMPLBL);
+PUT('L4,'SUBSTFN,'!&GETTEMPLBL);
+
+% Emit functions
+
+PUT('!*LOAD,'EMITFN,'!&EMITLOAD);
+PUT('!*STORE,'EMITFN,'!&EMITSTORE);
+PUT('!*JUMP,'EMITFN,'!&EMITJUMP);
+PUT('!*LBL,'EMITFN,'!&EMITLBL);
+PUT('!*ADDMEM,'EMITFN,'!&EMITMEMMOD);
+PUT('!*MPYMEM,'EMITFN,'!&EMITMEMMOD);
+PUT('!*ADDMEM, 'UNMEMMOD, '!*WPLUS2);
+PUT('!*MPYMEM, 'UNMEMMOD, '!*WTIMES2);
+
+% In memory operations
+
+PUT('WPLUS2,'MEMMODFN,'!*ADDMEM);
+PUT('WTIMES2,'MEMMODFN,'!*MPYMEM);
+
+% Flip jump for conditional jump macros
+
+PUT('!*JUMPEQ,'NEGJMP,'!*JUMPNOTEQ);
+PUT('!*JUMPNOTEQ,'NEGJMP,'!*JUMPEQ);
+PUT('!*JUMPTYPE,'NEGJMP,'!*JUMPNOTTYPE);
+PUT('!*JUMPNOTTYPE,'NEGJMP,'!*JUMPTYPE);
+PUT('!*JUMPINTYPE,'NEGJMP,'!*JUMPNOTINTYPE);
+PUT('!*JUMPNOTINTYPE,'NEGJMP,'!*JUMPINTYPE);
+PUT('!*JUMPWEQ,'NEGJMP,'!*JUMPWNEQ);
+PUT('!*JUMPWNEQ,'NEGJMP,'!*JUMPWEQ);
+PUT('!*JUMPWLESSP,'NEGJMP,'!*JUMPWGEQ);
+PUT('!*JUMPWGEQ,'NEGJMP,'!*JUMPWLESSP);
+PUT('!*JUMPWLEQ,'NEGJMP,'!*JUMPWGREATERP);
+PUT('!*JUMPWGREATERP,'NEGJMP,'!*JUMPWLEQ);
+
+% Assorted other flags
+
+FLAG('(!*JUMP !*LINKE !*EXIT),'TRANSFER);
+FLAG('(!*LINK !*LINKE),'UNKNOWNUSE);
+PUT('!*LINK, 'EXITING, '!*LINKE);
+
+% Initialize variables
+!*MSG := T; % Do print messages
+!*INSTALLDESTROY := NIL;
+!*USINGDESTROY := T;
+!*SHOWDEST := NIL;
+!*NOFRAMEFLUID := T;
+!*USEREGFLUID := NIL;
+!*NOLINKE := NIL; %. Permit LINKE
+!*ORD := NIL; %. Dont force ORDER
+!*R2I := T; %. Do convert Rec to Iter
+GLOBALGENSYM!&:=LIST GENSYM(); % initialize symbol list
+MAXNARGS!&:=15;
+LASTACTUALREG!& := 5;
+
+END;
ADDED psl-1983/3-1/comp/compiler.build
Index: psl-1983/3-1/comp/compiler.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/compiler.build
@@ -0,0 +1,15 @@
+CompileTime <<
+load If!-System;
+>>;
+if_system(PDP10, <<
+imports '(comp!-decls pass!-1!-lap
+ dec20!-lap dec20!-cmac faslout);
+if_system(KL10, NIL, imports '(non!-kl!-comp));
+>>);
+if_system(VAX,
+imports '(comp!-decls pass!-1!-lap
+ vax!-lap vax!-cmac faslout));
+if_system(HP9836,
+imports '(comp!-decls pass!-1!-lap
+ hp!-lap hp!-cmac hp!-comp faslout));
+in "compiler.red"$
ADDED psl-1983/3-1/comp/compiler.ctl
Index: psl-1983/3-1/comp/compiler.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/compiler.ctl
@@ -0,0 +1,5 @@
+psl:rlisp
+loaddirectories!*:='("pl:");
+load build;
+build 'compiler;
+quit;
ADDED psl-1983/3-1/comp/compiler.log
Index: psl-1983/3-1/comp/compiler.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/compiler.log
cannot compute difference between binary files
ADDED psl-1983/3-1/comp/compiler.red
Index: psl-1983/3-1/comp/compiler.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/compiler.red
@@ -0,0 +1,2706 @@
+% MLG: 15 Dec
+% added additional arguments to
+% Compiler BUG message in &LOCATE to get more info
+% <PSL.COMP>COMPILER.RED.19, 3-Dec-82 18:21:21, Edit by PERDUE
+% Removed REFORMNE, which was over-optimizing sometimes
+% <PSL.COMP>COMPILER.RED.18, 1-Dec-82 15:59:45, Edit by BENSON
+% Fixed car of atom bug in &PaApply
+% New extended compiler for PSL
+% John Peterson 4-5-81
+
+% <PSL.COMP>COMPILER.RED.4, 20-Sep-82 11:40:31, Edit by BENSON
+% Slight improvement to "FOO not compiled" messages
+% <PSL.COMP>COMPILER.RED.2, 20-Sep-82 10:32:51, Edit by BENSON
+% (DE FOO (LIST) (LIST LIST)) does the right thing
+% <PSL.COMP>COMPILER.RED.10, 10-Sep-82 12:43:27, Edit by BENSON
+% NONLOCALSYS calls NONLOCALLISP if not WVAR or WARRAY
+% <PSL.COMP>COMPILER.RED.9, 10-Sep-82 09:53:08, Edit by BENSON
+% Changed error and warning messages
+
+CompileTime flag(
+'(!&COMPERROR !&COMPWARN !&IREG
+!&ADDRVALS !&ALLARGS1 !&ALLCONST !&ANYREG !&ANYREGL !&ANYREGP
+!&ARGLOC !&ASSOCOP1 !&ASSOCOP2 !&ATTACH !&ATTJMP !&ATTLBL !&CALL
+!&CALL1 !&CALLOPEN !&CFNTYPE !&CLASSMEMBER !&CLRSTR !&COMLIS !&COMLIS1
+!&COMOPENTST !&COMPLY !&COMTST !&COMVAL !&COMVAL1 !&CONSTTAG
+!&DEFEQLBL !&DEFEQLBL1 !&DELARG !&DELCLASS !&DELETEMAC !&DELMAC
+!&EMITMAC !&EQP !&EQPL !&EQVP !&EXTERNALVARP !&FIXCHAINS !&FIXFRM
+!&FIXLABS !&FIXLINKS !&FIXREGTEST1
+!&FRAME !&FREERSTR !&GENLBL !&GENSYM !&GETFRAMES
+!&GETFRAMES1 !&GETFRAMES2 !&GETFRM !&GETFVAR !&GETGROUPARGS !&GETGROUPARGS1
+!&GETGROUPARGS2 !&GETLBL !&GETNUM !&HIGHEST !&HIGHEST1 !&HIGHEST2
+!&INALL !&INSERTMAC !&INSOP !&INSOP1 !&INSTALLDESTROY !&INSTBL !&JUMPNIL
+!&JUMPT !&LABCLASS !&LBLEQ !&LOADARGS !&LOADOPENEXP !&LOADTEMP1 !&LOADTEMP2
+!&LOADTEMPREG !&LOCATE !&LOCATEL !&LREG !&LREG1 !&MACROSUBST !&MACROSUBST1
+!&MACROSUBST2 !&MAKEADDRESS !&MAKEXP !&MATCHES !&MEMADDRESS !&MKFRAME
+!&MKFUNC !&MKNAM !&MKPROGN !&MKREG !&MOVEJUMP &NOANYREG1
+!&NOSIDEEFFECTP !&NOSIDEEFFECTPL !&OPENFNP !&OPENP !&OPENPL
+!&PA1V !&PALISV
+!&PA1X !&PAASSOC1 !&PAEQUAL1 !&PALIS !&PAMAPCOLLECT !&PAMAPCONC !&PAMAPDO
+!&PAMEMBER1 !&PANONLOCAL !&PAPROGBOD !&PASS1 !&PASS2 !&PASS3 !&PEEPHOLEOPT
+!&PROTECT !&RASSOC !&REFERENCES !&REFERENCESL !&REFEXTERNAL !&REFEXTERNALL
+!&REFMEMORY !&REFMEMORYL !&REFORMMACROS !®P !®VAL !&REMCODE
+!&REMMREFS !&REMMREFS1 !&REMOPEN !&REMREFS !&REMREFS1 !&REMREGS !&REMREGSL
+!&REMTAGS !&REMTAGS1 !&REMTAGS2 !&REMTAGS3 !&REMTAGS4 !&REMUNUSEDMAC
+!&REMVARL !&REMVREFS !&REMVREFS1 !&REPASC !&RMERGE !&RSTVAR !&RSTVARL !&RVAL
+!&SAVER1 !&STORELOCAL !&STOREVAR !&SUBARG !&SUBARGS !&TEMPREG !&TRANSFERP
+!&UNPROTECT !&UNUSEDLBLS !&USESDESTL !&VARBIND !&VARP !&WCONSTP
+!&CONSTP ISAWCONST MKNONLOCAL MKWCONST NONLOCAL NONLOCALLISP
+NONLOCALSYS PA1ERR WARRAYP WCONSTP WVARP),
+'InternalFunction);
+
+GLOBAL '(ERFG!*
+ !*NOLINKE !*ORD !*R2I !*UNSAFEBINDER
+ MAXNARGS!&
+ !*NOFRAMEFLUID !*USEREGFLUID
+ !*INSTALLDESTROY
+ !*USINGDESTROY
+ !*SHOWDEST
+ GLOBALGENSYM!&); % list of symbols to be re-used by the compiler
+
+FLUID '(ALSTS!& FLAGG!& NAME!& GOLIST!& CODELIST!& CONDTAIL!&
+ LLNGTH!& NARG!& REGS!& EXITT!& LBLIST!& JMPLIST!& SLST!& STOMAP!&
+ LASTACTUALREG!& DFPRINT!* !*PLAP
+ !*SYSLISP
+ SWITCH!&
+ TOPLAB!&
+ FREEBOUND!&
+ STATUS!&
+ REGS1!&
+ PREGS!& DESTREG!&
+ EXITREGS!&
+ DEST!& ENVIRONMENT!&
+ HOLEMAP!&
+ LOCALGENSYM!&); % traveling pointer into GLOBALGENSYM!&
+
+%COMMENT **************************************************************
+%**********************************************************************
+% THE STANDARD LISP COMPILER
+%**********************************************************************
+% Augmented for SYSLISP
+%*********************************************************************;
+%
+%COMMENT machine dependent parts are in a separate file;
+%
+%COMMENT these include the macros described below and, in addition,
+% an auxiliary function !&MKFUNC which is required to pass
+% functional arguments (input as FUNCTION <func>) to the
+% loader. In most cases, !&MKFUNC may be defined as MKQUOTE;
+%
+%COMMENT Registers used:
+%1-MAXNARGS!& used for args of link. result returned in reg 1;
+%
+%COMMENT Macros used in this compiler;
+%
+%COMMENT The following macros must NOT change REGS!& 1-MAXNARGS!&:
+%!*ALLOC nw allocate new stack frame of nw words
+%!*DEALLOC nw deallocate above frame
+%!*ENTRY name type noargs entry point to function name of type type
+% with noargs args
+%!*EXIT EXIT to previously saved return address
+%!*JUMP adr unconditional jump
+%!*LBL adr define label
+%!*LAMBIND regs alst bind free lambda vars in alst currently in regs
+%!*PROGBIND alst bind free prog vars in alst
+%!*FREERSTR alst unbind free variables in alst
+%!*STORE reg floc store contents of reg (or NIL) in floc
+%
+%COMMENT the following macro must only change specific register being
+% loaded:
+%
+%!*LOAD reg exp load exp into reg;
+%
+%COMMENT the following macros do not protect regs 1-MAXNARGS!&:
+%
+%!*LINK fn type nargs link to fn of type type with nargs args
+%!*LINKE fn type nargs nw link to fn of type type with nargs args
+% and EXITT!& removing frame of nw words;
+%
+%
+%COMMENT variable types are:
+%
+% LOCAL allocated on stack and known only locally
+% GLOBAL accessed via cell (GLOBAL name) known to
+% loader at load time
+% WGLOBAL accessed via cell (WGLOBAL name) known to
+% loader at load time, SYSLISP
+% FLUID accessed via cell (FLUID name)
+% known to loader. This cell is rebound by LAMBIND/
+% PROGBIND if variable used in lambda/prog list
+% and restored by FREERSTR;
+%
+%COMMENT global flags used in this compiler:
+%!*UNSAFEBINDER for Don's BAKER problem...GC may be called in
+% Binder, so regs cant be preserved
+%!*MODULE indicates block compilation (a future extension of
+% this compiler)
+%!*NOLINKE if ON inhibits use of !*LINKE macro
+%!*ORD if ON forces left-to-right argument evaluation
+%!*PLAP if ON causes LAP output to be printed
+%!*R2I if ON causes recursion removal where possible;
+%
+%
+%COMMENT global variables used:
+%
+%DFPRINT!* name of special definition process (or NIL)
+%ERFG!* used by REDUCE to control error recovery
+%MAXNARGS!& maximum number of arguments permitted in implementation;
+%
+%
+%
+%%Standard LISP limit;
+%
+%COMMENT fluid variables used:
+%
+%ALSTS alist of fluid parameters
+%FLAGG used in COMTST, and in FIXREST
+%FREEBOUND indicates that some variables were FLUID
+%GOLIST storage map for jump labels
+%PREGS A list of protected registers
+%CODELIST code being built
+%CONDTAIL simulated stack of position in the tail of a COND
+%LLNGTH cell whose CAR is length of frame
+%NAME NAME!& of function being currently compiled
+%FNAME!& name of function being currently compiled, set by COMPILE
+%NARG number of arguments in function
+%REGS known current contents of registers as an alist with elements
+% of form (<reg> . <contents>)
+%EXITT label for *EXIT jump
+%EXITREGS List or register statuses at return point
+%LBLIST list of label words
+%JMPLIST list of locations in CODELIST!& of transfers
+%SLST association list for stores which have not yet been used
+%STOMAP storage map for variables
+%SWITCH boolean expression value flag - keeps track of NULLs;
+%
+
+SYMBOLIC PROCEDURE !&MKFUNC FN; MKQUOTE FN;
+
+SYMBOLIC PROCEDURE WARRAYP X;
+ GET(X,'WARRAY) OR GET(X, 'WSTRING);
+
+SYMBOLIC PROCEDURE WVARP X;
+ GET(X,'WVAR);
+
+SYMBOLIC PROCEDURE WCONSTP X;
+ NUMBERP X OR (IDP X AND GET(X,'WCONST));
+
+SYMBOLIC PROCEDURE !&ANYREGP X;
+ FLAGP(X, 'ANYREG);
+
+macro procedure LocalF U; % declare functions internal, ala Franz
+ list('flag, Mkquote cdr U, ''InternalFunction);
+
+%************************************************************
+% The compiler
+%************************************************************
+
+% Top level compile entry - X is list of functions to compile
+
+SYMBOLIC PROCEDURE COMPILE X;
+ BEGIN SCALAR EXP;
+ FOR EACH FNAME!& IN X DO
+ <<EXP := GETD FNAME!&;
+ IF NULL EXP THEN !&COMPWARN LIST("No definition for", FNAME!&)
+ ELSE IF CODEP CDR EXP THEN
+ !&COMPWARN LIST(FNAME!&, "already compiled")
+ ELSE COMPD(FNAME!&,CAR EXP,CDR EXP)>>
+ END;
+
+% COMPD - Single function compiler
+% Makes sure function type is compilable; sends original definition to
+% DFPRINT!*, then compiles the function. Shows LAP code when PLAP is on.
+% Runs LAP and adds COMPFN property if LAP indeed redefines the function.
+
+SYMBOLIC PROCEDURE COMPD(NAME!&,TY,EXP);
+ BEGIN
+ IF NOT FLAGP(TY,'COMPILE)
+ THEN <<!&COMPERROR LIST("Uncompilable function type", TY);
+ RETURN NIL>>;
+ IF NOT EQCAR(EXP, 'LAMBDA)
+ THEN
+ << !&COMPERROR LIST("Attempt to compile non-lambda expression", EXP);
+ RETURN NIL >>
+%/ ELSE IF !*MODULE THEN MODCMP(NAME!&,TY,EXP)
+% ELSE IF DFPRINT!*
+% THEN APPLY(DFPRINT!*,LIST IF TY EQ 'EXPR
+% THEN 'DE . (NAME!& . CDR EXP)
+% ELSE IF TY EQ 'FEXPR
+% THEN 'DF . (NAME!& . CDR EXP)
+% ELSE IF TY EQ 'MACRO
+%% THEN 'DM . (NAME!& . CDR EXP)
+% ELSE IF TY EQ 'NEXPR
+% THEN 'DN . (NAME!& . CDR EXP)
+% ELSE LIST('PUTD,MKQUOTE NAME!&,
+% MKQUOTE TY,
+% MKQUOTE EXP))
+ ELSE BEGIN SCALAR X;
+ IF TY MEMQ '(EXPR FEXPR)
+ THEN PUT(NAME!&,'CFNTYPE,LIST TY);
+ X :=
+ LIST('!*ENTRY,NAME!&,TY,LENGTH CADR EXP)
+ . !&COMPROC(EXP,
+ IF TY MEMQ '(EXPR FEXPR)
+ THEN NAME!&);
+ IF !*PLAP THEN FOR EACH Y IN X DO PRINT Y;
+ % ***Code**Pointer** is a magic token that tells
+ % COMPD to return a code pointer instead of an ID
+ IF NAME!& = '!*!*!*Code!*!*Pointer!*!*!* then
+ NAME!& := LAP X
+ ELSE
+ << LAP X;
+ %this is the hook to the assembler. LAP must
+ %remove old function definition if it exists;
+ IF (X := GET(NAME!&,'CFNTYPE))
+ AND EQCAR(GETD NAME!&,CAR X)
+ THEN REMPROP(NAME!&,'CFNTYPE) >>
+ END;
+ RETURN NAME!&
+ END;
+
+%************************************************************
+% Pass 1 routines
+%************************************************************
+
+
+SYMBOLIC PROCEDURE !&PASS1 EXP; %. Pass1- reform body of expression for
+ !&PA1(EXP,NIL); % Compilation
+
+SYMBOLIC PROCEDURE PA1ERR(X); %. Error messages from PASS1
+ STDERROR LIST("-- PA1 --", X);
+
+lisp procedure !&Pa1(U, Vbls);
+ !&Pa1V(U, Vbls, NIL);
+
+% Do the real pass1 and an extra reform
+
+SYMBOLIC PROCEDURE !&PA1V(U,VBLS, VAR);
+ BEGIN
+ SCALAR Z,FN; % Z is the pass1 result. Reform if necessary
+ Z:=!&PA1X(U,VBLS, VAR);
+ IF IDP CAR Z AND (FN:=GET(CAR Z,'PA1REFORMFN)) THEN
+ Z := APPLY(FN,LIST Z);
+ RETURN Z;
+ END;
+
+SYMBOLIC PROCEDURE !&PA1X(U,VBLS,VAR); %. VBLS are current local vars
+ BEGIN SCALAR X;
+ RETURN IF ATOM U % tag variables and constants
+ THEN IF ISAWCONST U THEN MKWCONST U
+ ELSE IF CONSTANTP U OR U MEMQ '(NIL T) THEN MKQUOTE U
+ ELSE IF NONLOCAL U THEN !&PANONLOCAL(U, VBLS)
+ ELSE IF U MEMQ VBLS THEN LIST('!$LOCAL,U)
+ ELSE <<MKNONLOCAL U; !&PANONLOCAL(U, VBLS) >>
+ ELSE IF NOT IDP CAR U
+ THEN IF EQCAR(CAR U,'LAMBDA) THEN
+ !&PA1V(CAR U,VBLS,VAR) . !&PALISV(CDR U,VBLS,VAR)
+ ELSE % Change to APPLY
+ << !&COMPERROR
+ list("Ill-formed function expression", U);
+ '(QUOTE NIL) >>
+% Changed semantics of EVAL to conform to Common Lisp.
+% CAR of a form is NEVER evaluated.
+% ELSE IF CAR U MEMQ VBLS OR FLUIDP CAR U
+% OR (GLOBALP CAR U
+% AND NOT GETD CAR U) THEN % Change to APPLY
+% << !&COMPWARN list("Functional form converted to APPLY", U);
+% !&PA1(LIST('APPLY, CAR U, 'LIST . CDR U), VBLS) >>
+ ELSE IF X := GET(CAR U,'PA1ALGFN) % Do const folding, etc.
+ THEN APPLY(X,LIST(U,VBLS,VAR))
+ ELSE IF X := GET(CAR U,'PA1FN) % Do PA1FN's
+ THEN APPLY(X,LIST(U,VBLS))
+ ELSE IF X := GET(CAR U,'CMACRO) % CMACRO substitution
+ THEN !&PA1V(SUBLIS(PAIR(CADR X,CDR U),CADDR X),VBLS,VAR)
+ ELSE IF (X := GETD CAR U) % Expand macros
+ AND CAR X EQ 'MACRO
+ AND NOT (GET(CAR U,'COMPFN) OR GET(CAR U,'OPENFN))
+ THEN !&PA1V(APPLY(CDR X,LIST U),VBLS,VAR)
+ ELSE IF !&CFNTYPE CAR U EQ 'FEXPR % Transform FEXPR calls to
+ AND NOT (GET(CAR U,'COMPFN) OR GET(CAR U,'OPENFN))
+ THEN LIST(CAR U,MKQUOTE CDR U) % EXPR calls
+ ELSE IF !&CFNTYPE CAR U EQ 'NEXPR % Transform NEXPR calls to
+ AND NOT (GET(CAR U,'COMPFN) OR GET(CAR U,'OPENFN))
+ THEN LIST(CAR U,!&PA1V('LIST . CDR U,VBLS,VAR)) % EXPR calls
+ ELSE CAR U . !&PALISV(CDR U,VBLS,VAR);
+ END;
+
+SYMBOLIC PROCEDURE !&PALIS(U,VBLS);
+ !&PALISV(U,VBLS,NIL);
+
+SYMBOLIC PROCEDURE !&PALISV(U,VBLS, VAR);
+ FOR EACH X IN U COLLECT !&PA1V(X,VBLS,VAR);
+
+SYMBOLIC PROCEDURE ISAWCONST X; %. Check to see if WCONST,
+ %. in SYSLISP only
+ !*SYSLISP AND WCONSTP X;
+
+SYMBOLIC PROCEDURE !&CONSTTAG();
+ IF !*SYSLISP THEN 'WCONST ELSE 'QUOTE;
+
+SYMBOLIC PROCEDURE MKWCONST X; %. Made into WCONST
+BEGIN SCALAR Y;
+ RETURN LIST('WCONST, IF (Y := GET(X, 'WCONST)) AND NOT GET(X, 'WARRAY)
+ AND NOT GET(X, 'WSTRING) THEN
+ Y
+ ELSE X);
+END;
+
+SYMBOLIC PROCEDURE !&PAWCONST(U, VBLS);
+ MKWCONST CADR U;
+
+SYMBOLIC PROCEDURE NONLOCAL X; %. Default NON-LOCAL types
+ IF !*SYSLISP THEN NONLOCALSYS X
+ ELSE NONLOCALLISP X;
+
+SYMBOLIC PROCEDURE NONLOCALLISP X;
+ IF FLUIDP X THEN '!$FLUID
+ ELSE IF GLOBALP X THEN '!$GLOBAL
+ ELSE IF WVARP X OR WARRAYP X THEN
+ <<!&COMPWARN LIST(X,"already SYSLISP non-local");NIL>>
+ ELSE NIL;
+
+SYMBOLIC PROCEDURE NONLOCALSYS X;
+ IF WARRAYP X THEN 'WARRAY
+ ELSE IF WVARP X THEN 'WVAR
+ ELSE NONLOCALLISP X;
+
+SYMBOLIC PROCEDURE !&PANONLOCAL(X, VBLS); %. Reform Non-locals
+ % X will be a declared NONLOCAL
+ BEGIN SCALAR Z;
+ RETURN
+ IF NOT IDP X OR NOT NONLOCAL X THEN PA1ERR LIST("non-local error",X)
+ ELSE IF FLUIDP X THEN LIST('!$FLUID,X)
+ ELSE IF GLOBALP X THEN LIST('!$GLOBAL,X)
+ ELSE IF GET(X,'WVAR) THEN
+ IF X MEMBER VBLS THEN <<!&COMPWARN(LIST('WVAR,X,"used as local"));
+ LIST('!$LOCAL,X)>>
+ ELSE LIST('WVAR,X)
+ ELSE IF WARRAYP X THEN
+ LIST('WCONST, X)
+ ELSE PA1ERR LIST("Unknown in PANONLOCAL",X);
+ END;
+
+% Make unknown symbols into FLUID for LISP, WVAR for SYSLISP, with warning
+% Changed to just declare it fluid, EB, 9:36am Friday, 10 September 1982
+SYMBOLIC PROCEDURE MKNONLOCAL U;
+% IF !*SYSLISP THEN
+% << !&COMPERROR LIST("Undefined symbol", U,
+% "in Syslisp, treated as WVAR");
+% WDECLARE1(U, 'INTERNAL, 'WVAR, NIL, 0);
+% LIST('WVAR, U) >>
+% ELSE
+ <<!&COMPWARN LIST(U,"declared fluid"); FLUID LIST U; LIST('!$FLUID,U)>>;
+
+
+% Utility stuff for the PA1 functions
+
+SYMBOLIC PROCEDURE !&MKNAM U;
+ %generates unique name for auxiliary function in U;
+ IMPLODE NCONC(EXPLODE U,EXPLODE !&GENSYM());
+
+% For making implied PROGN's into explicit ones (as in COND)
+SYMBOLIC PROCEDURE !&MKPROGN U;
+ IF NULL U OR CDR U THEN 'PROGN . U ELSE CAR U;
+
+
+SYMBOLIC PROCEDURE !&EQP U;
+ %!&EQP is true if U is an object for which EQ can replace EQUAL;
+ INUMP U OR IDP U;
+
+SYMBOLIC PROCEDURE !&EQVP U;
+ %!&EQVP is true if EVAL U is an object for which EQ can
+ %replace EQUAL;
+ INUMP U OR NULL U OR U EQ 'T OR EQCAR(U,'QUOTE) AND !&EQP CADR U;
+
+% !&EQPL U is true if !&EQP of all elements of U
+SYMBOLIC PROCEDURE !&EQPL U;
+NULL U OR !&EQP(CAR U) AND !&EQPL(CDR U);
+
+SYMBOLIC PROCEDURE !&MAKEADDRESS U;
+% convert an expression into an addressing expression, (MEMORY var const),
+% where var is the variable part & const is the constant part (tagged, of
+% course). It is assumed that U has been through pass 1, which does constant
+% folding & puts any constant term at the top level.
+ IF EQCAR(U,'LOC) THEN CADR U ELSE % GETMEM LOC x == x
+'MEMORY .
+ (IF EQCAR(U,'WPLUS2) AND !&CONSTP CADDR U THEN CDR U
+ ELSE IF EQCAR(U,'WDIFFERENCE) AND !&CONSTP CADR U THEN
+ LIST(LIST('WMINUS,CADDR U),CADR U)
+ ELSE LIST(U,'(WCONST 0)));
+
+SYMBOLIC PROCEDURE !&DOOP U;
+% simplification for random operators - op is doable only when all operands
+% are constant
+ IF !&ALLCONST CDR U THEN
+ LIST(CAR CADR U,
+ APPLY(GET(CAR U,'DOFN) or car U, FOR EACH X IN CDR U COLLECT CADR X))
+ ELSE U;
+
+SYMBOLIC PROCEDURE !&ALLCONST L;
+ NULL L OR (car L = 'QUOTE or !&WCONSTP CAR L AND NUMBERP CADR CAR L)
+ AND !&ALLCONST CDR L;
+
+lisp procedure !&PaReformWTimes2 U;
+begin scalar X;
+ U := !&Doop U;
+ return if first U = 'WTimes2 then
+ if !&WConstP second U and (X := PowerOf2P second second U) then
+ list('WShift, third U, list(!&ConstTag(), X))
+ else if !&WConstP third U and (X := PowerOf2P second third U) then
+ list('WShift, second U, list(!&ConstTag(), X))
+ else U
+ else U;
+end;
+
+SYMBOLIC PROCEDURE !&ASSOCOP(U,VBLS); % For abelian semi-groups & monoids
+% given an associative, communitive operation (TIMES2, AND, ...) collect all
+% arguments, seperate constant args, evaluate true constants, check for zero's
+% and ones (0*X = 0, 1*X = X)
+!&ASSOCOPV(U,VBLS,NIL);
+
+SYMBOLIC PROCEDURE !&ASSOCOPV(U,VBLS,VAR);
+ BEGIN SCALAR ARGS,NUM,CONSTS,VARS;
+ ARGS := !&ASSOCOP1(CAR U,!&PALIS(CDR U,VBLS));
+ CONSTS := VARS := NUM := NIL;
+ FOR EACH ARG IN ARGS DO
+ IF !&WCONSTP ARG THEN
+ IF NUMBERP CADR ARG THEN
+ IF NUM THEN NUM := APPLY(GET(CAR U,'DOFN),LIST(NUM,CADR ARG))
+ ELSE NUM := CADR ARG
+ ELSE CONSTS := NCONC(CONSTS,LIST ARG)
+ ELSE VARS := NCONC(VARS,LIST ARG);
+ IF NUM THEN
+ <<IF NUM = GET(CAR U,'ZERO) THEN RETURN LIST(!&CONSTTAG(),NUM);
+ IF NUM NEQ GET(CAR U,'ONE) THEN CONSTS := NUM . CONSTS
+ ELSE IF NULL VARS AND NULL CONSTS THEN RETURN
+ LIST(!&CONSTTAG(), NUM) >>;
+ IF CONSTS THEN
+ VARS := NCONC(VARS,LIST LIST('WCONST,!&INSOP(CAR U,CONSTS)));
+ IF VAR MEMBER VARS THEN
+ <<VARS := DELETIP(VAR,VARS);
+ RETURN !&INSOP(CAR U,REVERSIP(VAR . REVERSIP VARS))>>;
+ RETURN !&INSOP(CAR U,VARS);
+ END;
+
+SYMBOLIC PROCEDURE !&ASSOCOP1(OP,ARGS);
+ IF NULL ARGS THEN NIL
+ ELSE NCONC(!&ASSOCOP2(OP,CAR ARGS),!&ASSOCOP1(OP,CDR ARGS));
+
+SYMBOLIC PROCEDURE !&ASSOCOP2(OP,ARG);
+ IF EQCAR(ARG,OP) THEN !&ASSOCOP1(OP,CDR ARG)
+ ELSE LIST ARG;
+
+SYMBOLIC PROCEDURE !&INSOP(OP,L);
+% Insert OP into a list of operands as follows: INSOP(~,'(A B C D)) =
+% (~ (~ (~ A B) C) D)
+ IF NULL L THEN NIL ELSE if null cdr L then car L else
+ !&INSOP1(list(OP, first L, second L), rest rest L, OP);
+
+SYMBOLIC PROCEDURE !&INSOP1(NEW, RL, OP);
+ if null RL then NEW else !&INSOP1(list(OP, NEW, first RL), rest RL, OP);
+
+SYMBOLIC PROCEDURE !&GROUP(U,VBLS);
+% Like ASSOP, except inverses exist. All operands are partitioned into two
+% lists, non-inverted and inverted. Cancellation is done between these two
+% lists. The group is defined by three operations, the group operation (+),
+% inversion (unary -), and subtraction (dyadic -). The GROUPOPS property on
+% all three of there operators must contain the names of these operators in
+% the order (add subtract minus)
+!&GROUPV(U,VBLS,NIL);
+
+SYMBOLIC PROCEDURE !&GROUPV(U,VBLS,VAR);
+ BEGIN SCALAR X,ARGS,INVARGS,FNS,CONSTS,INVCONSTS,CON,RES,VFLG,INVFLG,ONE;
+ FNS := GET(CAR U,'GROUPOPS);
+ ONE := LIST(!&CONSTTAG(),GET(CAR FNS,'ONE));
+ X := !&GETGROUPARGS(FNS,CAR U . !&PALIS(CDR U, VBLS),NIL,'(NIL NIL));
+ ARGS := CAR X;
+ INVARGS := CADR X;
+ FOR EACH ARG IN ARGS DO
+ IF ARG MEMBER INVARGS THEN
+ <<ARGS := !&DELARG(ARG,ARGS);
+ INVARGS := !&DELARG(ARG,INVARGS)>>;
+ CONSTS := INVCONSTS := CON := NIL;
+ FOR EACH ARG IN ARGS DO
+ IF !&WCONSTP ARG THEN
+ <<ARGS := !&DELARG(ARG,ARGS);
+ IF NUMBERP CADR ARG THEN
+ IF CON THEN CON := APPLY(GET(CAR FNS,'DOFN),LIST(CON,CADR ARG))
+ ELSE CON := CADR ARG
+ ELSE CONSTS := NCONC(CONSTS,LIST ARG)>>;
+ FOR EACH ARG IN INVARGS DO
+ IF !&WCONSTP ARG THEN
+ <<INVARGS := !&DELARG(ARG,INVARGS);
+ IF NUMBERP CADR ARG THEN
+ IF CON THEN CON := APPLY(GET(CADR FNS,'DOFN),LIST(CON,CADR ARG))
+ ELSE CON := APPLY(GET(CADDR FNS,'DOFN),LIST CADR ARG)
+ ELSE INVCONSTS := NCONC(INVCONSTS,LIST ARG)>>;
+ IF CON AND CON = GET(CAR FNS,'ZERO) THEN RETURN LIST(!&CONSTTAG(),CON);
+ IF CON AND CON = CADR ONE THEN CON := NIL;
+ IF CON THEN CONSTS := CON . CONSTS;
+ CONSTS := !&MAKEXP(CONSTS,INVCONSTS,FNS);
+ IF CONSTS AND NOT !&WCONSTP CONSTS THEN CONSTS := LIST('WCONST,CONSTS);
+ IF VAR MEMBER ARGS THEN
+ <<ARGS := DELETE(VAR,ARGS);
+ VFLG := T;
+ INVFLG := NIL>>;
+ IF VAR MEMBER INVARGS THEN
+ <<INVARGS := DELETE(VAR,INVARGS);
+ VFLG := T;
+ INVFLG := T>>;
+ ARGS := !&MAKEXP(ARGS,INVARGS,FNS);
+ RES := IF NULL ARGS THEN
+ IF NULL CONSTS THEN
+ ONE
+ ELSE CONSTS
+ ELSE
+ IF NULL CONSTS THEN ARGS
+ ELSE IF EQCAR(ARGS,CADDR FNS) THEN
+ LIST(CADR FNS,CONSTS,CADR ARGS)
+ ELSE
+ LIST(CAR FNS,ARGS,CONSTS);
+ IF VFLG THEN
+ IF RES = ONE THEN
+ IF INVFLG THEN RES := LIST(CADDR FNS,VAR)
+ ELSE RES := VAR
+ ELSE
+ RES := LIST(IF INVFLG THEN CADR FNS ELSE CAR FNS,RES,VAR);
+ RETURN RES;
+ END;
+
+SYMBOLIC PROCEDURE !&MAKEXP(ARGS,INVARGS,FNS);
+ IF NULL ARGS THEN
+ IF NULL INVARGS THEN NIL
+ ELSE LIST(CADDR FNS,!&INSOP(CAR FNS,INVARGS))
+ ELSE
+ IF NULL INVARGS THEN !&INSOP(CAR FNS,ARGS)
+ ELSE !&INSOP(CADR FNS,!&INSOP(CAR FNS,ARGS) . INVARGS);
+
+SYMBOLIC PROCEDURE !&GETGROUPARGS(FNS,EXP,INVFLG,RES);
+ IF ATOM EXP OR NOT(CAR EXP MEMBER FNS) THEN
+ !&GETGROUPARGS1(EXP,INVFLG,RES)
+ ELSE IF CAR EXP EQ CAR FNS THEN !&GETGROUPARGS2(FNS,CDR EXP,INVFLG,RES)
+ ELSE IF CAR EXP EQ CADR FNS THEN
+ !&GETGROUPARGS(FNS,CADR EXP,INVFLG,
+ !&GETGROUPARGS(FNS,CADDR EXP,NOT INVFLG,RES))
+ ELSE IF CAR EXP EQ CADDR FNS THEN
+ !&GETGROUPARGS(FNS,CADR EXP,NOT INVFLG,RES)
+ ELSE !&COMPERROR(LIST("Compiler bug in constant folding",FNS,EXP));
+
+SYMBOLIC PROCEDURE !&GETGROUPARGS1(THING,INVFLG,RES);
+ IF INVFLG THEN LIST(CAR RES,THING . CADR RES)
+ ELSE (THING . CAR RES) . CDR RES;
+
+SYMBOLIC PROCEDURE !&GETGROUPARGS2(FNS,ARGS,INVFLG,RES);
+ IF NULL ARGS THEN RES
+ ELSE !&GETGROUPARGS2(FNS,CDR ARGS,INVFLG,
+ !&GETGROUPARGS(FNS,CAR ARGS,INVFLG,RES));
+
+SYMBOLIC PROCEDURE !&DELARG(ARG,ARGS);
+ IF ARG = CAR ARGS THEN CDR ARGS ELSE CAR ARGS . !&DELARG(ARG,CDR ARGS);
+
+%************************************************************
+% Pass 1 functions
+%************************************************************
+
+lisp procedure !&PaApply(U, Vars);
+ if EqCar(third U, 'LIST) then % set up for !&COMAPPLY
+ if EqCar(second U, 'function)
+ and !&CfnType second second U = 'EXPR then
+ !&Pa1(second second U . rest third U, Vars)
+ else list('APPLY,
+ !&Pa1(second U, Vars),
+ 'LIST . !&PaLis(rest third U, Vars))
+ else 'APPLY . !&PaLis(rest U, Vars);
+
+% Try to turn ASSOC into ATSOC
+SYMBOLIC PROCEDURE !&PAASSOC(U,VARS);
+ !&PAASSOC1(CADR U,CADDR U) . !&PALIS(CDR U,VARS);
+
+SYMBOLIC PROCEDURE !&PAASSOC1(ASSOCVAR,ASSOCLIST);
+ IF !&EQVP ASSOCVAR
+ OR EQCAR(ASSOCLIST,'QUOTE) AND
+ !&EQPL(FOR EACH U IN CADR ASSOCLIST COLLECT CAR U)
+ THEN 'ATSOC ELSE 'ASSOC;
+
+SYMBOLIC PROCEDURE !&PACOND(U,VBLS);
+begin scalar RevU, Result, Temp;
+ if null cdr U then return '(QUOTE NIL); % (COND) == NIL
+ RevU := reverse cdr U;
+ if first first RevU neq T then RevU := '(T NIL) . RevU;
+ for each CondForm in RevU do
+ if null rest CondForm then
+ << if not Temp then
+ << Temp := !&Gensym();
+ VBLS := Temp . VBLS >>;
+ Result := list(!&PA1(list('SETQ, Temp, first CondForm), VBLS),
+ !&PA1(Temp, VBLS)) . Result >>
+ else
+ Result := list(!&PA1(first CondForm, VBLS),
+ !&PA1(!&MkProgN rest CondForm, VBLS)) . Result;
+ return if Temp then list(list('LAMBDA,
+ list !&PA1(Temp, VBLS),
+ 'COND . Result),
+ '(QUOTE NIL))
+ else 'COND . Result;
+end;
+
+lisp procedure !&PaCatch(U, Vbls);
+(lambda(Tag, Forms);
+<< if null cdr Forms and
+ (atom car Forms
+ or car car Forms = 'QUOTE
+ or car car Forms = 'LIST) then
+ !&CompWarn list("Probable obsolete use of CATCH:", U);
+ !&Pa1(list(list('lambda, '(!&!&HiddenVar!&!&),
+ list('cond, list('(null ThrowSignal!*),
+ list('(lambda (xxx)
+ (!%UnCatch !&!&HiddenVar!&!&)
+ xxx),
+ 'progn . Forms)),
+ '(t !&!&HiddenVar!&!&))),
+ list('CatchSetup, Tag)),
+ Vbls)>>)(cadr U, cddr U);
+
+% X-1 -> SUB1 X
+SYMBOLIC PROCEDURE !&PADIFF(U,VARS);
+ IF CADDR U=1 THEN LIST('SUB1,!&PA1(CADR U,VARS))
+ ELSE 'DIFFERENCE . !&PALIS(CDR U,VARS);
+
+
+SYMBOLIC PROCEDURE !&PAEQUAL(U,VARS);
+ !&PAEQUAL1(CADR U,CADDR U) . !&PALIS(CDR U,VARS);
+
+SYMBOLIC PROCEDURE !&PAEQUAL1(LEFT,RIGHT);
+ IF !&EQVP LEFT OR !&EQVP RIGHT THEN 'EQ
+ ELSE IF NUMBERP LEFT OR NUMBERP RIGHT THEN 'EQN
+ ELSE 'EQUAL;
+
+% FUNCTION will compile a non-atomic arg into a GENSYMed name.
+% Currently, MKFUNC = MKQUOTE
+
+SYMBOLIC PROCEDURE !&PAFUNCTION(U,VBLS);
+ IF ATOM CADR U THEN !&MKFUNC CADR U % COMPD returns a code pointer here
+ ELSE !&MKFUNC COMPD('!*!*!*Code!*!*Pointer!*!*!*,
+ 'EXPR,CADR U);
+
+SYMBOLIC PROCEDURE !&PAGETMEM(U,VBLS);
+ !&MAKEADDRESS !&PA1(CADR U,VBLS);
+
+SYMBOLIC PROCEDURE !&PAIDENT(U,VBLS); %. return form
+ U;
+
+% LAMBDA - pick up new vars, check implicit PROGN
+
+SYMBOLIC PROCEDURE !&PACASE(U,VBLS);
+ 'CASE . !&PA1(CADR U,VBLS) . FOR EACH EXP IN CDDR U COLLECT
+ LIST(!&PALIS(CAR EXP,VBLS),!&PA1(CADR EXP,VBLS));
+
+SYMBOLIC PROCEDURE !&PALAMBDA(U,VBLS);
+ <<VBLS := APPEND(CADR U,VBLS);
+ 'LAMBDA . LIST(!&PALIS(CADR U,VBLS),!&PA1(!&MKPROGN CDDR U,VBLS)) >>;
+
+% X<0 -> MINUSP(X)
+
+SYMBOLIC PROCEDURE !&PALESSP(U,VARS);
+ IF CADDR U=0 THEN LIST('MINUSP,!&PA1(CADR U,VARS))
+ ELSE 'LESSP . !&PALIS(CDR U,VARS);
+
+SYMBOLIC PROCEDURE !&PALIST(U, VBLS);
+ BEGIN SCALAR L,FN;
+ L := LENGTH CDR U;
+ RETURN
+ IF L = 0 THEN '(QUOTE NIL)
+ ELSE IF FN := ASSOC(L,'((1 . NCONS)
+ (2 . LIST2)
+ (3 . LIST3)
+ (4 . LIST4)
+ (5 . LIST5)))
+ THEN !&PA1(CDR FN . CDR U, VBLS)
+ ELSE !&PA1(LIST('CONS,CADR U, 'LIST . CDDR U), VBLS);
+ END;
+
+lisp procedure !&PaNth(U, Vbls);
+ !&PaNths(U, Vbls, '((1 . CAR) (2 . CADR) (3 . CADDR) (4 . CADDDR)));
+
+lisp procedure !&PaPNth(U, Vbls);
+ !&PaNths(U, Vbls, '((1 . CR)
+ (2 . CDR)
+ (3 . CDDR)
+ (4 . CDDDR)
+ (5 . CDDDDR)));
+
+lisp procedure !&PaNths(U, Vbls, FnTable);
+begin scalar N, X, Fn;
+ N := !&Pa1(third U, Vbls);
+ X := second U;
+ return if first N memq '(QUOTE WCONST) and FixP second N
+ and (Fn := Assoc(second N, FnTable)) then
+ if cdr Fn = 'CR then
+ !&Pa1(X, Vbls)
+ else !&Pa1(list(cdr Fn, X), Vbls)
+ else list(car U, !&Pa1(X, Vbls), N);
+end;
+
+SYMBOLIC PROCEDURE !&PAMAP(U, VBLS);
+ !&PAMAPDO(U, VBLS, NIL);
+
+SYMBOLIC PROCEDURE !&PAMAPC(U, VBLS);
+ !&PAMAPDO(U, VBLS, T);
+
+SYMBOLIC PROCEDURE !&PAMAPDO(U, VBLS, CARFLAG);
+ IF NOT EQCAR(CADDR U,'FUNCTION) THEN CAR U . !&PALIS(CDR U,VBLS)
+ ELSE BEGIN SCALAR TMP;
+ TMP := !&GENSYM();
+ RETURN !&PA1(SUBLA(LIST('TMP . TMP,
+ 'STARTINGLIST . CADR U,
+ 'FNCALL . LIST(CADR CADDR U,
+ IF CARFLAG THEN
+ LIST('CAR, TMP)
+ ELSE TMP)),
+ '(PROG (TMP)
+ (SETQ TMP STARTINGLIST)
+ LOOPLABEL
+ (COND ((ATOM TMP) (RETURN NIL)))
+ FNCALL
+ (SETQ TMP (CDR TMP))
+ (GO LOOPLABEL))), VBLS);
+ END;
+
+SYMBOLIC PROCEDURE !&PAMAPLIST(U, VBLS);
+ !&PAMAPCOLLECT(U, VBLS, NIL);
+
+SYMBOLIC PROCEDURE !&PAMAPCAR(U, VBLS);
+ !&PAMAPCOLLECT(U, VBLS, T);
+
+SYMBOLIC PROCEDURE !&PAMAPCOLLECT(U, VBLS, CARFLAG);
+ IF NOT EQCAR(CADDR U,'FUNCTION) THEN CAR U . !&PALIS(CDR U,VBLS)
+ ELSE BEGIN SCALAR TMP, RESULT, ENDPTR;
+ TMP := !&GENSYM();
+ RESULT := !&GENSYM();
+ ENDPTR := !&GENSYM();
+ RETURN !&PA1(SUBLA(LIST('TMP . TMP,
+ 'RESULT . RESULT,
+ 'ENDPTR . ENDPTR,
+ 'STARTINGLIST . CADR U,
+ 'FNCALL . LIST(CADR CADDR U,
+ IF CARFLAG THEN
+ LIST('CAR, TMP)
+ ELSE TMP)),
+ '(PROG (TMP RESULT ENDPTR)
+ (SETQ TMP STARTINGLIST)
+ (COND ((ATOM TMP) (RETURN NIL)))
+ (SETQ RESULT (SETQ ENDPTR (NCONS FNCALL)))
+ LOOPLABEL
+ (SETQ TMP (CDR TMP))
+ (COND ((ATOM TMP) (RETURN RESULT)))
+ (RPLACD ENDPTR (NCONS FNCALL))
+ (SETQ ENDPTR (CDR ENDPTR))
+ (GO LOOPLABEL))), VBLS);
+ END;
+
+SYMBOLIC PROCEDURE !&PAMAPCON(U, VBLS);
+ !&PAMAPCONC(U, VBLS, NIL);
+
+SYMBOLIC PROCEDURE !&PAMAPCAN(U, VBLS);
+ !&PAMAPCONC(U, VBLS, T);
+
+SYMBOLIC PROCEDURE !&PAMAPCONC(U, VBLS, CARFLAG);
+ IF NOT EQCAR(CADDR U,'FUNCTION) THEN CAR U . !&PALIS(CDR U,VBLS)
+ ELSE BEGIN SCALAR TMP, RESULT, ENDPTR;
+ TMP := !&GENSYM();
+ RESULT := !&GENSYM();
+ ENDPTR := !&GENSYM();
+ RETURN !&PA1(SUBLA(LIST('TMP . TMP,
+ 'RESULT . RESULT,
+ 'ENDPTR . ENDPTR,
+ 'STARTINGLIST . CADR U,
+ 'FNCALL . LIST(CADR CADDR U,
+ IF CARFLAG THEN
+ LIST('CAR, TMP)
+ ELSE TMP)),
+ '(PROG (TMP RESULT ENDPTR)
+ (SETQ TMP STARTINGLIST)
+ STARTOVER
+ (COND ((ATOM TMP) (RETURN NIL)))
+ (SETQ RESULT FNCALL)
+ (SETQ ENDPTR (LASTPAIR RESULT))
+ (SETQ TMP (CDR TMP))
+ (COND ((ATOM ENDPTR) (GO STARTOVER)))
+ LOOPLABEL
+ (COND ((ATOM TMP) (RETURN RESULT)))
+ (RPLACD ENDPTR FNCALL)
+ (SETQ ENDPTR (LASTPAIR ENDPTR))
+ (SETQ TMP (CDR TMP))
+ (GO LOOPLABEL))), VBLS);
+ END;
+
+% Attempt to change MEMBER to MEMQ
+
+SYMBOLIC PROCEDURE !&PAMEMBER(U,VARS);
+ !&PAMEMBER1(CADR U,CADDR U) . !&PALIS(CDR U,VARS);
+
+SYMBOLIC PROCEDURE !&PAMEMBER1(THING,LST);
+ IF !&EQVP THING OR EQCAR(LST,'QUOTE) AND !&EQPL CADR LST
+ THEN 'MEMQ ELSE 'MEMBER;
+
+% (Intern (Compress X)) == (Implode X)
+% (Intern (Gensym)) == (InternGensym)
+
+SYMBOLIC PROCEDURE !&PAINTERN(U, VBLS);
+<< U := !&PA1(CADR U, VBLS);
+ IF EQCAR(U, 'COMPRESS) THEN 'IMPLODE . CDR U
+ ELSE IF EQCAR(U, 'GENSYM) THEN 'INTERNGENSYM . CDR U
+ ELSE LIST('INTERN, U) >>;
+
+% Do MINUS on constants.
+
+SYMBOLIC PROCEDURE !&PAMINUS(U,VBLS);
+ IF EQCAR(U := !&PA1(CADR U,VBLS),'QUOTE) AND NUMBERP CADR U
+ THEN MKQUOTE ( - CADR U)
+ ELSE IF EQCAR(U ,'WCONST) AND NUMBERP CADR U
+ THEN MKWCONST ( - CADR U)
+ ELSE LIST('MINUS,U);
+
+SYMBOLIC PROCEDURE !&REFORMLOC U;
+ IF EQCAR(CADR U, 'MEMORY) THEN
+ LIST('WPLUS2, CADDR CADR U, CADR CADR U)
+ ELSE U;
+
+SYMBOLIC PROCEDURE !&REFORMNULL U;
+ BEGIN SCALAR FLIP;
+ RETURN
+ IF PAIRP CADR U AND (FLIP := GET(CAADR U,'FLIPTST)) THEN
+ FLIP . CDADR U
+ ELSE LIST('EQ, CADR U, '(QUOTE NIL));
+ END;
+
+% Perdue 12/3/82
+% This optimization causes compiled code to behave differently
+% from interpreted code. The FLIPTST property on NE and PASS2
+% handling of negation in tests (&COMTST) are enough to cause good code
+% to be generated when NE is used as a test.
+
+% SYMBOLIC PROCEDURE !&REFORMNE U;
+% IF CADR U = '(QUOTE NIL) THEN CADDR U
+% ELSE IF CADDR U = '(QUOTE NIL) THEN CADR U
+% ELSE U;
+
+% PLUS2(X,1) -> ADD1(X)
+
+SYMBOLIC PROCEDURE !&PAPLUS2(U,VARS);
+ IF CADDR U=1 THEN !&PA1(LIST('ADD1, CADR U),VARS)
+ ELSE IF CADR U=1 THEN !&PA1('ADD1 . CDDR U,VARS)
+ ELSE 'PLUS2 . !&PALIS(CDR U,VARS);
+
+% Pick up PROG vars, ignore labels.
+
+SYMBOLIC PROCEDURE !&PAPROG(U,VBLS);
+ <<VBLS := APPEND(CADR U,VBLS);
+ 'PROG . (!&PALIS(CADR U,VBLS) . !&PAPROGBOD(CDDR U,VBLS)) >>;
+
+SYMBOLIC PROCEDURE !&PAPROGBOD(U,VBLS);
+ FOR EACH X IN U COLLECT IF ATOM X THEN X ELSE !&PA1(X,VBLS);
+
+SYMBOLIC PROCEDURE !&PAPUTMEM(U,VBLS);
+ !&PA1('SETQ . LIST('GETMEM, CADR U) . CDDR U, VBLS);
+
+SYMBOLIC PROCEDURE !&PAPUTLISPVAR(U, VBLS);
+ !&PA1('SETQ . LIST('LISPVAR, CADR U) . CDDR U, VBLS);
+
+SYMBOLIC PROCEDURE !&PALISPVAR(U, VBLS);
+ LIST('!$FLUID, CADR U);
+
+SYMBOLIC PROCEDURE !&PASETQ(U,VBLS);
+ BEGIN SCALAR VAR,FN,EXP, LN;
+ LN := LENGTH CDR U;
+ IF LN NEQ 2 THEN RETURN
+ << LN := DIVIDE(LN, 2);
+ IF CDR LN NEQ 0 THEN
+ << !&COMPERROR LIST("Odd number of arguments to SETQ", U);
+ U := APPEND(U, LIST NIL);
+ LN := CAR LN + 1 >>
+ ELSE LN := CAR LN;
+ U := CDR U;
+ FOR I := 1 STEP 1 UNTIL LN DO
+ << EXP := LIST('SETQ, CAR U, CADR U) . EXP;
+ U := CDDR U >>;
+ !&PA1('PROGN . REVERSIP EXP, VBLS) >>;
+ VAR := !&PA1(CADR U,VBLS);
+ EXP := !&PA1V(CADDR U, VBLS, VAR);
+ U := IF FLAGP(CAR VAR,'VAR) THEN LIST('!$NAME,VAR) ELSE VAR;
+ IF (NOT (FN := GET(CAR EXP,'MEMMODFN))) OR not (LastCar EXP = VAR) THEN
+ RETURN LIST('SETQ,U,EXP)
+ ELSE RETURN FN . U . REVERSIP CDR REVERSIP CDR EXP;
+END;
+
+SYMBOLIC PROCEDURE !&INSTALLDESTROY(NAME!&);
+% determine which (if any) registers are unaltered by the function.
+% Print this information out if !*SHOWDEST, install it on the
+% property list of the function if !*INSTALLDESTOY
+ BEGIN SCALAR DESTL,R,HRU;
+ HRU := !&HIGHEST(CODELIST!&,NIL,NARG!&,T);
+% Find the highest register used in the code. Registers above this are
+% unchanged. Incoming registers have a distinguished value, IREG n, placed
+% in register n. If this value remains, it has not been destroyed.
+ IF HRU = 'ALL THEN RETURN NIL;
+ DESTL := NIL;
+ FOR I := 1:NARG!& DO
+ <<R := !&MKREG I;
+ IF NOT (!&IREG I MEMBER !®VAL R) THEN DESTL := R . DESTL>>;
+ FOR I := NARG!&+1 : HRU DO
+ DESTL := !&MKREG I . DESTL;
+ IF NULL DESTL THEN DESTL := '((REG 1));
+ IF !*INSTALLDESTROY THEN PUT(NAME!&,'DESTROYS,DESTL);
+ IF !*SHOWDEST THEN <<PRIN2 NAME!&;PRIN2 " DESTROYS ";PRIN2T DESTL>>;
+ END;
+
+
+% COMPROC does the dirty work - initializes variables and gets the
+% three passes going.
+SYMBOLIC PROCEDURE !&COMPROC(EXP,NAME!&);
+ %compiles a function body, returning the generated LAP;
+ BEGIN SCALAR CODELIST!&,FLAGG!&,JMPLIST!&,LBLIST!&,
+ LOCALGENSYM!&,
+ LLNGTH!&,REGS!&,REGS1!&,ALSTS!&,
+ EXITT!&,TOPLAB!&,SLST!&,STOMAP!&,
+ CONDTAIL!&,FREEBOUND!&,HOLEMAP!&,PREGS!&,
+ SWITCH!&,EXITREGS!&,RN; INTEGER NARG!&;
+ LOCALGENSYM!& := GLOBALGENSYM!&;
+ PREGS!& := NIL;
+ REGS!& := NIL;
+ LLNGTH!& := 0;
+ IF NOT EQCAR(EXP, 'LAMBDA) THEN
+ << !&COMPERROR LIST("Attempt to compile a non-lambda expression", EXP);
+ RETURN NIL >>;
+ NARG!& := LENGTH CADR EXP;
+ EXITREGS!& := NIL;
+ EXITT!& := !&GENLBL();
+ TOPLAB!& := !&GENLBL();
+ STOMAP!& := NIL;
+ CODELIST!& := LIST '(!*ALLOC (!*FRAMESIZE));
+ !&ATTLBL TOPLAB!&;
+ EXP := !&PASS1 EXP;
+ IF NARG!& > MAXNARGS!&
+ THEN !&COMPERROR LIST("Too many arguments",NARG!&);
+ ALSTS!& := !&VARBIND(CADR EXP,T); % Generate LAMBIND
+ RN := 1;
+ FOR I := 1:LENGTH CADR EXP DO
+ REGS!& := !&ADDRVALS(!&MKREG I,REGS!&,LIST( !&IREG I));
+ !&PASS2 CADDR EXP;
+ !&FREERSTR(ALSTS!&,0); %Restores old fluid bindings
+ !&PASS3();
+ IF !*INSTALLDESTROY OR !*SHOWDEST THEN !&INSTALLDESTROY(NAME!&);
+ !&REFORMMACROS(); % Plugs compile time constants into macros. FIXFRM?
+ !&REMTAGS(); % Kludge
+ RETURN CODELIST!&
+ END;
+
+lisp procedure !&IReg N;
+ if N > 0 and N <= 15 then
+ GetV('[() (IREG 1) (IREG 2) (IREG 3) (IREG 4) (IREG 5)
+ (IREG 6) (IREG 7) (IREG 8) (IREG 9) (IREG 10)
+ (IREG 11) (IREG 12) (IREG 13) (IREG 14) (IREG 15)], n)
+ else list('IREG, N);
+
+SYMBOLIC PROCEDURE !&WCONSTP X;
+ PairP X and (first X = 'WConst or first X = 'Quote and FixP second X);
+
+%************************************************************
+% Pass 2 *
+%************************************************************
+
+% Initialize STATUS!&=0 (Top level)
+
+SYMBOLIC PROCEDURE !&PASS2 EXP; !&COMVAL(EXP,0);
+
+SYMBOLIC PROCEDURE !&COMVAL(EXP,STATUS!&);
+% Compile EXP. Special cases: if STATUS!&>1 (compiling for side effects),
+% anyreg functions are ignored since they have no side effects.
+% Otherwise, top level ANYREG stuff is factored out and done via a LOAD
+% instead of a LINK.
+ IF !&ANYREG(EXP)
+ THEN IF STATUS!&>1 THEN
+ <<IF NOT (CAR EXP MEMBER '(QUOTE !$LOCAL !$FLUID)) THEN
+ !&COMPWARN(LIST("Value of",
+ EXP,
+ "not used, therefore not compiled"));
+ NIL >>
+ ELSE !&LREG1(EXP) % Just a LOAD
+ ELSE % When not all ANYREG
+ IF !&ANYREGFNP EXP % Is the top level an ANYREG fn?
+ THEN IF STATUS!&>1 THEN
+ <<!&COMVAL(CADR EXP,STATUS!&);
+ !&COMPWARN LIST("Top level", CAR EXP,
+ "in", EXP, "not used, therefore not compiled");
+ NIL>>
+ ELSE
+ !&LREG1(CAR EXP . !&COMLIS CDR EXP) % Preserve the anyreg fn
+ ELSE !&COMVAL1(EXP,STOMAP!&,STATUS!&); % no anyregs in sight
+
+% Generate code which loads the value of EXP into register 1
+
+% Patch to COMVAL1 for better register allocation
+
+SYMBOLIC PROCEDURE !&COMVAL1(EXP,STOMAP!&,STATUS!&);
+ BEGIN SCALAR X;
+ IF !&ANYREG EXP OR !&OPENFNP EXP OR !&ANYREGFNP EXP THEN
+ IF STATUS!&<2 AND !&NOSIDEEFFECTP EXP
+ THEN !&COMPWARN(LIST(EXP," not compiled"))
+ ELSE <<!&LOADOPENEXP(IF STATUS!& > 1 THEN !&AllocTemp(Exp)
+ ELSE '(REG 1),
+ CAR EXP . !&COMLIS CDR EXP,STATUS!&,PREGS!&)>>
+ ELSE IF NOT ATOM CAR EXP % Non atomic function?
+ THEN IF CAAR EXP EQ 'LAMBDA
+ THEN !&COMPLY(CAR EXP,CDR EXP,STATUS!&) % LAMBDA compilation
+ ELSE !&COMPERROR LIST(CAR EXP, "Invalid as function")
+ % Should be noticed in pass 1
+ ELSE IF X := GET(CAR EXP,'COMPFN) THEN APPLY(X,LIST(EXP,STATUS!&))
+ % Dispatch built in compiler functions
+ ELSE IF CAR EXP EQ 'LAMBDA
+ THEN !&COMPERROR LIST("Invalid use of LAMBDA in COMVAL1",EXP)
+ ELSE !&CALL(CAR EXP,CDR EXP,STATUS!&); % Call a function
+ RETURN NIL
+ END;
+
+% Procedure to allocate temps for OPEN exprs. Used only when STATUS!&<1 to
+% set up destination. Only special case is SETQ. SETQ tries to put the
+% value of X:=... into a register containing X (keeps variables in the same
+% register if possible.
+
+Symbolic Procedure !&Alloctemp(Exp);
+ if car Exp = 'Setq then
+ if car caddr exp = 'Setq then % Nested setq - move to actual RHS
+ !&Alloctemp(caddr Exp)
+ else
+ begin
+ Scalar Reg;
+ If (Reg := !&RAssoc(Cadr Cadr Exp,Regs!&)) % LHS variable already in reg?
+ and not (Car Reg member PRegs!&) then % and reg must be available
+ Return Car Reg % Return the reg previously used for the var
+ else
+ Return !&Tempreg() % Just get a temp
+ end
+ else !&TempReg(); % not SETQ - any old temp will do
+
+
+SYMBOLIC PROCEDURE !&CALL(FN,ARGS,STATUS!&);
+ !&CALL1(FN,!&COMLIS1 ARGS,STATUS!&);
+
+%Args have been compiled
+
+SYMBOLIC PROCEDURE !&CALL1(FN,ARGS,STATUS!&);
+ %ARGS is reversed list of compiled arguments of FN;
+ BEGIN INTEGER ARGNO;
+ SCALAR DEST!&;
+ ARGNO := LENGTH ARGS;
+ IF !&ANYREGP FN THEN !&LREG1(FN . ARGS)
+ ELSE <<!&LOADARGS(ARGS,1,PREGS!&); %Emits loads to registers
+ !&ATTACH LIST('!*LINK,FN,!&CFNTYPE FN,ARGNO);
+ !&REMMREFS();
+ !&REMVREFS();
+% Default - all registers destroyed
+ IF !*USINGDESTROY THEN DEST!& := GET(FN,'DESTROYS);
+ IF NULL DEST!& THEN REGS!& := NIL
+ ELSE
+ BEGIN SCALAR TEMP;
+ TEMP := NIL;
+ FOR EACH R IN REGS!& DO
+ IF NOT(CAR R MEMBER DEST!&) THEN TEMP := R . TEMP;
+ REGS!& := TEMP
+ END >>
+ END;
+
+% Comlis altered to return unreversed list
+
+SYMBOLIC PROCEDURE !&COMLIS EXP; REVERSIP !&COMLIS1 EXP;
+
+% COMLIS1 returns reversed list of compiled arguments;
+
+SYMBOLIC PROCEDURE !&COMLIS1 EXP;
+ BEGIN SCALAR ACUSED,Y; % Y gathers a set of ANYREG expressions denoting
+% the params. Code for non ANYREG stuff is emitted by ATTACH. ACUSED is
+% name of psuedo variable holding results of non anyreg stuff.
+ Y := NIL;
+ WHILE EXP DO
+ <<IF !&CONSTP CAR EXP OR
+ !&OPENP CAR EXP
+ AND (NOT !*ORD OR !&NOSIDEEFFECTPL CDR EXP)
+ THEN Y := CAR EXP . Y
+% Anyreg stuff is handled later. Anyreg args are not loaded until after
+% all others.
+% If !*ORD is true, order is still switched unless no side effects
+ ELSE <<
+ %/ Special coding for top level ANYREG
+ IF ACUSED THEN !&SAVER1();
+ IF (!&ANYREGFNP CAR EXP OR !&OPENFNP CAR EXP)
+ AND (NOT !*ORD OR !&NOSIDEEFFECTPL CDR EXP) THEN
+ <<Y := (CAAR EXP . !&COMLIS CDAR EXP) . Y;
+ ACUSED := T>>
+% Emit code to place arg in R1, generate a name for the result to put in R1
+ ELSE <<!&COMVAL1(CAR EXP,STOMAP!&,1);
+ ACUSED := LIST('!$LOCAL,!&GENSYM());
+ REGS!& := !&ADDRVALS('(REG 1),REGS!&,LIST ACUSED);
+% REGS!& the new variable name goes on the code list (rest already emitted)
+ Y := ACUSED . Y>>>>;
+% place arg in memory while doing others
+ EXP := CDR EXP>>;
+ RETURN Y
+ END;
+
+% SAVE R1 IF NECESSARY
+
+SYMBOLIC PROCEDURE !&SAVER1; %MARKS CONTENTS OF REGISTER 1 FOR STORAGE;
+ BEGIN SCALAR X;
+ X := !®VAL '(REG 1); % Contents of R1
+ IF NULL X OR NOT !&VARP CAR X
+ THEN RETURN NIL % Dont save constants
+ ELSE IF NOT ASSOC(CAR X,STOMAP!&) THEN !&FRAME CAR X; % For temporaries
+ % as generated in COMLIS
+ !&STORELOCAL(CAR X,'(REG 1)) % Emit a store
+ END;
+
+% Compiler for LAMBDA
+
+SYMBOLIC PROCEDURE !&COMPLY(FN,ARGS,STATUS!&);
+ BEGIN SCALAR ALSTS!&,VARS, N, I;
+ %SCALAR OLDSTOMAP,OLDCODE;
+% OLDSTOMAP := STOMAP!&;
+% OLDCODE := CODELIST!&;
+ VARS := CADR FN;
+% Compile args to the lambda
+ ARGS := !&COMLIS1 ARGS;
+ N := LENGTH ARGS;
+ IF N>MAXNARGS!& THEN
+ !&COMPERROR LIST("Too many arguments in LAMBDA form",FN);
+% Put the args into registers
+ !&LOADARGS(ARGS,1,PREGS!&);
+% Enter new ENVIRONMENT!&
+ ARGS := !&REMVARL VARS; % The stores that were protected;
+ I := 1;
+% Put this junk on the frame
+ ALSTS!& := !&VARBIND(VARS,T); %Old fluid values saved;
+% compile the body
+ !&COMVAL(CADDR FN,STATUS!&);
+% Restore old fluids
+ !&FREERSTR(ALSTS!&,STATUS!&);
+% Go back to the old ENVIRONMENT!&
+ !&RSTVARL(VARS,ARGS);
+%/ !&FIXFRM(OLDSTOMAP,OLDCODE,0)
+ END;
+
+% Load a sequence of expressions into the registers
+
+SYMBOLIC PROCEDURE !&LOADARGS(ARGS,STATUS!&,PREGS!&);
+ BEGIN INTEGER N; SCALAR FN,DESTREG!&;
+ N := LENGTH ARGS;
+ IF N>MAXNARGS!& THEN
+ !&COMPERROR LIST("Too many arguments",ARGS);
+ WHILE ARGS DO
+% Generate a load for each arg
+ <<DESTREG!& := !&MKREG N;
+ !&LOADOPENEXP(DESTREG!&,CAR ARGS,STATUS!&,PREGS!&);
+ PREGS!& := DESTREG!& . PREGS!&;
+ N := N - 1;
+ ARGS := CDR ARGS>>
+ END;
+
+SYMBOLIC PROCEDURE !&LOADOPENEXP(DESTREG!&,ARG,STATUS!&,PREGS!&);
+ BEGIN SCALAR R;
+ IF !&ANYREG ARG OR !&RASSOC(ARG,REGS!&) THEN !&LREG(DESTREG!&,!&LOCATE ARG)
+ ELSE IF !&ANYREGFNP ARG THEN
+ <<!&LOADOPENEXP(DESTREG!&,CADR ARG,1,PREGS!&);
+ !&LREG(DESTREG!&,!&LOCATE (CAR ARG . DESTREG!& . CDDR ARG)) >>
+ ELSE % Must be an open function
+ IF FLAGP(CAR ARG,'MEMMOD) AND STATUS!& < 2 THEN
+ <<!&LOADOPENEXP(DESTREG!&,ARG,2,PREGS!&);
+ !&LREG(DESTREG!&,IF EQCAR(CADR ARG,'!$NAME) THEN
+ !&LOCATE CADR CADR ARG
+ ELSE !&LOCATE CADR ARG)>>
+ ELSE
+ BEGIN
+ SCALAR OPFN,ADJFN,ANYREGARGS;
+ ANYREGARGS := !&REMOPEN(DESTREG!&,CDR ARG);
+ OPFN := GET(CAR ARG,'OPENFN);
+ IF IDP OPFN THEN
+ APPLY(OPFN,LIST(DESTREG!&,ANYREGARGS,ARG))
+ ELSE
+ !&CALLOPEN(OPFN,DESTREG!&,ANYREGARGS,CAR ARG)
+ END;
+ END;
+
+SYMBOLIC PROCEDURE !&REMOPEN(DESTREG!&,ARGS);
+ FOR EACH ARG IN ARGS COLLECT !&ARGLOC ARG;
+
+SYMBOLIC PROCEDURE !&ARGLOC ARG;
+ BEGIN SCALAR LOC;
+ IF EQCAR(ARG,'!$NAME) THEN RETURN ARG;
+ IF !&CONSTP ARG THEN RETURN ARG;
+ IF EQCAR(ARG,'MEMORY) THEN RETURN !&MEMADDRESS ARG;
+ IF LOC := !&RASSOC(ARG,REGS!&) THEN
+ <<PREGS!& := CAR LOC . PREGS!&; RETURN CAR LOC>>;
+ IF !&ANYREG ARG THEN RETURN ARG;
+ IF !&ANYREGFNP ARG THEN RETURN (CAR ARG . !&ARGLOC CADR ARG . CDDR ARG);
+ IF NULL DESTREG!& OR DESTREG!& MEMBER PREGS!& THEN DESTREG!& := !&TEMPREG();
+ IF FLAGP(CAR ARG,'MEMMOD) THEN
+ <<!&LOADOPENEXP(DESTREG!&,ARG,2,PREGS!&);
+ RETURN CADR CADR ARG>>
+ ELSE !&LOADOPENEXP(DESTREG!&,ARG,1,PREGS!&);
+ PREGS!& := DESTREG!& . PREGS!&;
+ RETURN DESTREG!&
+ END;
+
+SYMBOLIC PROCEDURE !&MEMADDRESS ARG;
+ BEGIN SCALAR TEMPDEST;
+ PREGS!& := DESTREG!& . PREGS!&;
+ TEMPDEST := !&TEMPREG();
+ PREGS!& := CDR PREGS!&;
+ ARG := CAR ARG . !&REMOPEN(TEMPDEST,CDR ARG);
+ IF NOT(CADDR ARG = '(WCONST 0) AND NOT !&ANYREGFNP CADR ARG
+ OR !®FP CADR ARG) THEN
+ <<!&LREG(TEMPDEST,!&LOCATE CADR ARG);
+ ARG := CAR ARG . TEMPDEST . CDDR ARG>>;
+ IF CADR ARG = TEMPDEST THEN PREGS!& := TEMPDEST . PREGS!&;
+ RETURN ARG;
+ END;
+
+SYMBOLIC PROCEDURE !&CALLOPEN(OPFN,DEST!&,ARGS,OP);
+ BEGIN
+ SCALAR PATS,PARAMS,ADJFN,REGFN,ENVIRONMENT!&;
+ PATS := CAR OPFN;
+ IF IDP PATS THEN PATS := GET(PATS,'PATTERN);
+ PARAMS := OP . CDR OPFN;
+ ADJFN := CAR PATS;
+ REGFN := CADR PATS;
+ IF ADJFN THEN ARGS := APPLY(ADJFN,LIST ARGS);
+ PATS := CDDR PATS;
+ WHILE NOT NULL PATS AND NOT !&MATCHES(CAAR PATS,ARGS) DO
+ PATS := CDR PATS;
+ IF NULL PATS THEN
+ <<!&COMPERROR(LIST("Compiler bug - no pattern for",OP . ARGS));
+ RETURN NIL>>;
+ FOR EACH MAC IN CDAR PATS DO
+ !&EMITMAC(!&SUBARGS(MAC,ARGS,PARAMS));
+ IF REGFN THEN IF IDP REGFN THEN APPLY(REGFN,LIST(OP, ARGS))
+ ELSE !&EMITMAC(!&SUBARGS(REGFN,ARGS,PARAMS));
+ RETURN NIL;
+ END;
+
+SYMBOLIC PROCEDURE !&MATCHES(PAT,SUBJ);
+ IF EQCAR(PAT,'QUOTE) THEN CADR PAT = SUBJ
+ ELSE IF NULL PAT THEN NULL SUBJ
+ ELSE IF EQCAR(PAT,'NOVAL) THEN STATUS!& > 1 AND !&MATCHES(CDR PAT,SUBJ)
+ ELSE IF ATOM PAT THEN APPLY(GET(PAT,'MATCHFN),LIST SUBJ)
+ ELSE PAIRP SUBJ AND !&MATCHES(CAR PAT,CAR SUBJ)
+ AND !&MATCHES(CDR PAT,CDR SUBJ);
+
+SYMBOLIC PROCEDURE !&ANY U;T;
+
+SYMBOLIC PROCEDURE !&DEST U;U = DEST!&;
+
+% An anyreg which uses DEST!& at any level
+SYMBOLIC PROCEDURE !&USESDEST U;
+ !&DEST U OR PAIRP U AND !&USESDESTL CDR U;
+
+SYMBOLIC PROCEDURE !&USESDESTL U;
+ PAIRP U AND (!&DEST CAR U OR !&USESDEST CAR U OR !&USESDESTL CDR U);
+
+SYMBOLIC PROCEDURE !®FP U;!®P U OR EQCAR(U,'!$LOCAL);
+
+SYMBOLIC PROCEDURE !®N U; !®P U OR EQCAR(U,'!$LOCAL) OR U = '(QUOTE NIL);
+
+SYMBOLIC PROCEDURE !&MEM U;
+ NOT(U = '(QUOTE NIL) OR EQCAR(U,'!$LOCAL))
+ AND (!&CONSTP U OR !&VARP U OR CAR U = 'MEMORY);
+
+SYMBOLIC PROCEDURE !&NOTANYREG U;!&MEM U OR !®FP U;
+
+
+
+SYMBOLIC PROCEDURE !&SUBARGS(MAC,ARGS,PARAMS);
+ FOR EACH ARG IN MAC COLLECT !&SUBARG(ARG,ARGS,PARAMS);
+
+SYMBOLIC PROCEDURE !&SUBARG(ARG,ARGS,PARAMS);
+ BEGIN SCALAR ARGFN;
+ RETURN
+ IF EQCAR(ARG,'QUOTE) THEN CADR ARG
+ ELSE IF PAIRP ARG THEN !&SUBARGS(ARG,ARGS,PARAMS)
+ ELSE IF ARG = 'DEST THEN DEST!&
+ ELSE IF ARGFN := GET(ARG,'SUBSTFN) THEN
+ APPLY(ARGFN,LIST(ARG,ARGS,PARAMS))
+ ELSE !&COMPERROR(LIST("Compiler bug", ARG,"invalid in macro"))
+ END;
+
+SYMBOLIC PROCEDURE !&ARG1(ARG,ARGS,PARAMS);
+ !&LOCATE CAR ARGS;
+
+SYMBOLIC PROCEDURE !&ARG2(ARG,ARGS,PARAMS);
+ !&LOCATE CADR ARGS;
+
+SYMBOLIC PROCEDURE !&ARG3(ARG,ARGS,PARAMS);
+ !&LOCATE CADDR ARGS;
+
+SYMBOLIC PROCEDURE !&ARG4(ARG,ARGS,PARAMS);
+ !&LOCATE CADDDR ARGS;
+
+SYMBOLIC PROCEDURE !&PARAM1(ARG,ARGS,PARAMS);
+ CAR PARAMS;
+
+SYMBOLIC PROCEDURE !&PARAM2(ARG,ARGS,PARAMS);
+ CADR PARAMS;
+
+SYMBOLIC PROCEDURE !&PARAM3(ARG,ARGS,PARAMS);
+ CADDR PARAMS;
+
+SYMBOLIC PROCEDURE !&PARAM4(ARG,ARGS,PARAMS);
+ CADDDR PARAMS;
+
+SYMBOLIC PROCEDURE !&GETTEMP(TNAME,ARGS,PARAMS);
+ BEGIN SCALAR TN;
+ RETURN IF TN := ASSOC(TNAME,ENVIRONMENT!&) THEN CDR TN
+ ELSE <<TN := !&TEMPREG();
+ ENVIRONMENT!& := (TNAME . TN) . ENVIRONMENT!&;
+ PREGS!& := TN . PREGS!&;
+ TN>>;
+ END;
+
+SYMBOLIC PROCEDURE !&GETTEMPLBL(LNAME,ARGS,PARAMS);
+ BEGIN SCALAR LAB;
+ RETURN IF LAB := ASSOC(LNAME,ENVIRONMENT!&) THEN CDR LAB
+ ELSE <<LAB := !&GENLBL();
+ ENVIRONMENT!& := (LNAME . LAB) . ENVIRONMENT!&;
+ LAB>>
+ END;
+
+SYMBOLIC PROCEDURE !&GENSYM(); % gensym local to compiler, reuses symbols
+BEGIN SCALAR SYMB;
+ IF NULL CDR LOCALGENSYM!& THEN
+ RPLACD(LOCALGENSYM!&, LIST GENSYM());
+ SYMB := CAR LOCALGENSYM!&;
+ LOCALGENSYM!& := CDR LOCALGENSYM!&;
+ RETURN SYMB;
+END;
+
+SYMBOLIC PROCEDURE !&COMPERROR U;
+<< ERRORPRINTF("***** in %P: %L", NAME!&, U);
+ ERFG!* := T >>;
+
+SYMBOLIC PROCEDURE !&COMPWARN U;
+ !*MSG AND ERRORPRINTF("*** in %P: %L", NAME!&, U);
+
+SYMBOLIC PROCEDURE !&EMITMAC MAC;
+ BEGIN SCALAR EMITFN;
+ IF CAR MAC = '!*DO THEN APPLY(CADR MAC,CDDR MAC)
+ ELSE IF CAR MAC = '!*DESTROY THEN
+ FOR EACH REG IN CDR MAC DO REGS!& := DELASC(REG,REGS!&)
+ ELSE IF CAR MAC = '!*SET THEN
+ REGS!& := !&REPASC(CADR MAC,!&REMREGSL CADDR MAC,REGS!&)
+ ELSE
+ IF EMITFN := GET(CAR MAC,'EMITFN) THEN
+ APPLY(EMITFN,LIST MAC)
+ ELSE !&ATTACH MAC
+ END;
+
+SYMBOLIC PROCEDURE !&EMITLOAD M;
+ !&LREG(CADR M,CADDR M);
+
+SYMBOLIC PROCEDURE !&EMITSTORE M;
+ !&STOREVAR(CADDR M,CADR M);
+
+SYMBOLIC PROCEDURE !&EMITJUMP M;
+ !&ATTJMP CADR M;
+
+SYMBOLIC PROCEDURE !&EMITLBL M;
+ !&ATTLBL CADR M;
+
+SYMBOLIC PROCEDURE !&EMITMEMMOD M;
+ BEGIN SCALAR Y, X;
+ X := CADR M;
+ !&REMREFS X;
+ IF EQCAR(X,'!$LOCAL) THEN
+ WHILE Y := ASSOC(X,SLST!&) DO SLST!& := DELETIP(Y,SLST!&);
+ IF EQCAR(X,'!$LOCAL) THEN M := CAR M . !&GETFRM X . CDDR M;
+ !&ATTACH(GET(CAR M, 'UNMEMMOD) . CDR M);
+ END;
+
+% Support to patterns - register adjustment functions
+
+SYMBOLIC PROCEDURE !&NOANYREG ARGS;
+% remove all ANYREG stuff except top level MEMORY
+IF NULL ARGS THEN NIL
+ELSE
+ !&NOANYREG1 CAR ARGS . !&NOANYREG CDR ARGS;
+
+SYMBOLIC PROCEDURE !&NOANYREG1 ARG;
+ IF !&ANYREGFNP ARG AND NOT EQCAR(ARG,'MEMORY) THEN
+ !&LOADTEMPREG ARG ELSE ARG;
+
+SYMBOLIC PROCEDURE !&INREG ARGS;
+ IF NOT !®FP CAR ARGS THEN LIST !&LOADTEMPREG CAR ARGS ELSE ARGS;
+
+SYMBOLIC PROCEDURE !®MEM ARGS;
+ <<ARGS := !&NOANYREG ARGS;
+ IF !&MEM CAR ARGS AND !&MEM CADR ARGS THEN
+ !&LOADTEMPREG CAR ARGS . CDR ARGS
+ ELSE ARGS>>;
+
+SYMBOLIC PROCEDURE !&DESTMEM ARGS;
+% A1 in DEST!&, A2 in MEM, rest (if any) not anyreg
+<<ARGS := CAR ARGS . !&NOANYREG CDR ARGS;
+ IF STATUS!& > 1 THEN
+ IF !®FP CAR ARGS THEN ARGS
+ ELSE !&LOADTEMPREG CAR ARGS . CDR ARGS
+ ELSE IF !&DEST CADR ARGS OR !&USESDEST CADR ARGS THEN
+ !&DESTMEM(CAR ARGS . !&LOADTEMPREG CADR ARGS . CDDR ARGS)
+ ELSE IF CAR ARGS NEQ DEST!& THEN
+ <<!&LREG(DEST!&,!&LOCATE CAR ARGS);
+ DEST!& . CDR ARGS>>
+ ELSE ARGS>>;
+
+SYMBOLIC PROCEDURE !&DESTMEMA ARGS;
+% put either a1or A2 into DEST!&, the other to MEM.
+IF CAR ARGS = DEST!& THEN % A1 = DEST!&, make A1 mem or reg
+ IF !&NOTANYREG CADR ARGS AND NOT !&USESDEST CADR ARGS THEN ARGS
+ ELSE !&LOADTEMP2 ARGS
+ELSE IF CADR ARGS = DEST!& THEN % A2 = DEST!&, make A2 mem or reg
+ IF !&NOTANYREG CAR ARGS AND NOT !&USESDEST CAR ARGS THEN ARGS
+ ELSE !&LOADTEMP1 ARGS
+ELSE IF !&NOTANYREG CADR ARGS OR NOT !&NOTANYREG CAR ARGS
+THEN % A2 is MEM or A1 is anyreg: make A1 the destination
+ <<IF NOT !&NOTANYREG CADR ARGS OR !&USESDEST CADR ARGS THEN
+ ARGS := !&LOADTEMP2 ARGS;
+ !&LREG(DEST!&,!&LOCATE CAR ARGS);
+ DEST!& . CDR ARGS>>
+ELSE % Make A2 the DEST!& - only when A2 is anyreg and a1 is mem
+ <<IF NOT !&NOTANYREG CAR ARGS OR !&USESDEST CAR ARGS THEN
+ ARGS := !&LOADTEMP1 ARGS;
+ !&LREG(DEST!&,!&LOCATE CADR ARGS);
+ LIST(CAR ARGS,DEST!&)>>;
+
+SYMBOLIC PROCEDURE !&LOADTEMP1 U;
+% Bring first arg into a temp
+!&LOADTEMPREG CAR U . CDR U;
+
+SYMBOLIC PROCEDURE !&LOADTEMP2 U;
+% put second arg in a temp
+CAR U . !&LOADTEMPREG CADR U . CDDR U;
+
+SYMBOLIC PROCEDURE !&CONSARGS ARGS;
+ IF
+ NOT !&ANYREGFNP CADR ARGS AND CADR ARGS NEQ DEST!&
+ OR
+ NOT !&ANYREGFNP CAR ARGS AND CAR ARGS NEQ DEST!&
+ THEN ARGS
+ ELSE LIST(CAR ARGS,!&LOADTEMPREG CADR ARGS);
+
+SYMBOLIC PROCEDURE !&LOADTEMPREG ARG;
+% Load ARG into a temporary register. Return the register.
+ BEGIN
+ SCALAR TEMP;
+ TEMP := !&TEMPREG();
+ PREGS!& := TEMP . PREGS!&;
+ !&LREG(TEMP,!&LOCATE ARG);
+ RETURN TEMP
+ END;
+
+SYMBOLIC PROCEDURE !&FIXREGTEST(OP,ARGS);
+ !&FIXREGTEST1(OP, first ARGS, second ARGS);
+
+SYMBOLIC PROCEDURE !&FIXREGTEST1(OP, A1, A2);
+% Fixes up the registers after a conditional jump has been emitted.
+% For JUMPEQ and JUMPNE, equalities can be assumed in REGS!& or REGS1!&
+% For other jumps, REGS!& copied onto REGS1!&.
+ <<REGS1!& := REGS!&;
+ IF OP = 'EQ OR OP = 'NE THEN
+ IF NOT !®P A1 THEN
+ << IF !®P A2 THEN !&FIXREGTEST1(OP,A2,A1) >>
+ ELSE
+ <<IF OP = 'EQ THEN REGS1!& := !&ADDRVALS(A1,REGS1!&,!&REMREGS A2)
+ ELSE REGS!& := !&ADDRVALS(A1,REGS!& ,!&REMREGS A2)>>>>;
+
+
+SYMBOLIC PROCEDURE !&SETREGS1(OP, ARGS); REGS1!& := REGS!&;
+
+
+% Find the location of a variable
+
+
+SYMBOLIC PROCEDURE !&LOCATE X;
+ BEGIN SCALAR Y,VTYPE;
+% Constants are their own location
+ IF ATOM X OR EQCAR(X,'LABEL) OR !&CONSTP X THEN RETURN X;
+ IF EQCAR(X,'!$NAME) THEN RETURN CADR X;
+ IF CAR X = 'MEMORY THEN
+ RETURN(CAR X . !&LOCATE CADR X . CDDR X);
+ IF Y := !&RASSOC(X,REGS!&) THEN RETURN CAR Y;
+% If in a register, return the register number
+% Registers are their own location
+% For ANYREG stuff, locate each constant
+ IF !&ANYREGFNP X THEN
+ RETURN CAR X . !&LOCATEL CDR X;
+ IF NOT EQCAR(X,'!$LOCAL) THEN RETURN X;
+% Since the value of the variable has been referenced, a previous store was
+% justified, so it can be removed from SLST!&
+% Must be in the frame, otherwise make nonlocal (really ought to be an error)
+% Frame location (<=0) is returned
+ WHILE Y := ASSOC(X,SLST!&) DO SLST!& := DELETIP(Y,SLST!&);
+ IF Y := ASSOC(X,STOMAP!&) THEN RETURN CADR Y;
+% Nasty compiler bug. Until we fix it, tell the user to simplify expressions
+ !&COMPERROR LIST
+ ("Compiler bug: expression too complicated, please simplify",X);
+ RETURN '(QUOTE 0); % just so it doesn't blow up
+ END;
+
+SYMBOLIC PROCEDURE !&LOCATEL U;
+ FOR EACH X IN U COLLECT !&LOCATE X;
+
+% Load register REG with value U. V (always NIL except when called from
+% LOADARGS) is a list of other loads to be done
+
+SYMBOLIC PROCEDURE !&LREG(REG,VAL);
+ BEGIN SCALAR ACTUALVAL;
+ ACTUALVAL := !&REMREGS VAL;
+ IF REG = VAL OR ACTUALVAL MEMBER !®VAL REG THEN RETURN NIL;
+ !&ATTACH LIST('!*MOVE,VAL,REG);
+ REGS!& := !&REPASC(REG,ACTUALVAL,REGS!&);
+ END;
+
+% Load register 1 with X
+
+SYMBOLIC PROCEDURE !&LREG1(X); !&LOADOPENEXP('(REG 1),X,1,PREGS!&);
+
+SYMBOLIC PROCEDURE !&JUMPT LAB;
+!&ATTACH LIST('!*JUMPNOTEQ,LAB,'(REG 1),'(QUOTE NIL));
+
+SYMBOLIC PROCEDURE !&JUMPNIL LAB;
+!&ATTACH LIST('!*JUMPEQ,LAB,'(REG 1),'(QUOTE NIL));
+
+
+COMMENT Functions for Handling Non-local Variables;
+
+SYMBOLIC PROCEDURE !&VARBIND(VARS,LAMBP);
+ %bind FLUID variables in lambda or prog lists;
+ %LAMBP is true for LAMBDA, false for PROG;
+ BEGIN SCALAR VLOCS,VNAMES,FREGS,Y,REG,TAIL; INTEGER I;
+ I := 1;
+ FOR EACH X IN VARS DO
+ <<
+ REG := !&MKREG I;
+ IF EQCAR(X,'!$GLOBAL) THEN % whoops
+ << !&COMPWARN LIST("Illegal to bind global",
+ CADR X, "but binding anyway");
+ RPLACA(X,'!$FLUID) >>; % cheat a little
+ IF EQCAR(X,'!$FLUID)
+ THEN <<FREEBOUND!& := T;
+ VNAMES := X . VNAMES;
+ IF NOT !*NOFRAMEFLUID THEN VLOCS := !&FRAME X . VLOCS;
+ FREGS := REG . FREGS>>
+ ELSE IF EQCAR(X,'!$LOCAL)
+ THEN <<!&FRAME X;
+ !&STORELOCAL(X,IF LAMBP THEN REG ELSE NIL)>>
+ ELSE !&COMPERROR LIST("Cannot bind non-local variable",X);
+ IF LAMBP THEN
+ IF EQCAR(X,'!$LOCAL) THEN
+ REGS!& := !&REPASC(REG,LIST X,REGS!&)
+ ELSE REGS!& := !&REPASC(REG,NIL,REGS!&);
+ I := I + 1>>;
+ IF NULL VNAMES THEN RETURN NIL;
+ VNAMES := 'NONLOCALVARS . VNAMES;
+ FREGS := 'REGISTERS . FREGS;
+ VLOCS := 'FRAMES . VLOCS;
+ TAIL := IF !*NOFRAMEFLUID THEN LIST VNAMES
+ ELSE LIST(VNAMES,VLOCS);
+ IF LAMBP THEN !&ATTACH('!*LAMBIND . FREGS . TAIL)
+ ELSE !&ATTACH('!*PROGBIND . TAIL);
+ IF !*UNSAFEBINDER THEN REGS!& := NIL;
+ RETURN TAIL;
+ END;
+
+SYMBOLIC PROCEDURE !&FREERSTR(ALSTS!&,STATUS!&); %restores FLUID variables;
+ IF ALSTS!& THEN
+ << !&ATTACH('!*FREERSTR . ALSTS!&);
+ IF !*UNSAFEBINDER THEN REGS!& := NIL >>;
+
+% ATTACH is used to emit code
+
+SYMBOLIC PROCEDURE !&ATTACH U; CODELIST!& := U . CODELIST!&;
+
+SYMBOLIC PROCEDURE !&STORELOCAL(U,REG);
+ %marks expression U in register REG for storage;
+ BEGIN SCALAR X;
+ IF NULL REG THEN REG := '(QUOTE NIL);
+ X := LIST('!*MOVE,REG,!&GETFRM U);
+% Update list of stores done so far
+ !&ATTACH X;
+% Zap out earlier stores if there were never picked up
+% ie, if you store to X, then a ref to X will remove this store from
+% SLST!&. Otherwise, the previous store will be removed by CLRSTR
+% SLST!& is for variables only (anything else?)
+ !&CLRSTR U;
+ SLST!& := (U . CODELIST!&) . SLST!&;
+ END;
+
+SYMBOLIC PROCEDURE !&CLRSTR VAR; %removes unneeded stores;
+ BEGIN SCALAR X;
+% Inside conditionals, you cant tell if store was on the same path
+ IF CONDTAIL!& THEN RETURN NIL;
+ X := ASSOC(VAR,SLST!&);
+ IF NULL X THEN RETURN NIL;
+ SLST!& := DelQIP(X,SLST!&);
+ !&DELMAC CDR X;
+ END;
+
+COMMENT Functions for general tests;
+
+SYMBOLIC PROCEDURE !&COMTST(EXP,LABL);
+ %compiles boolean expression EXP.
+ %If EXP has the same value as SWITCH!& then branch to LABL,
+ %otherwise fall through;
+ %REGS are active registers for fall through,
+ %REGS1 for branch;
+ BEGIN SCALAR X,FN,REG;
+% First factor out NOT's to set up the SWITCH!&
+ WHILE EQCAR(EXP,'EQ) AND CADDR EXP = '(QUOTE NIL) DO
+ <<SWITCH!& := NOT SWITCH!&; EXP := CADR EXP>>;
+% Dispatch a built in compiling function
+ IF NOT SWITCH!& AND (FN := GET(CAR EXP,'FLIPTST)) THEN
+ EXP := FN . CDR EXP; % SWITCH!& is assumed to be true by fn's with
+ % a flip test
+ IF FN := GET(CAR EXP,'OPENTST)
+ THEN <<IF ATOM FN THEN APPLY(FN,LIST(EXP,LABL))
+ ELSE !&COMOPENTST(FN,EXP,LABL,PREGS!&)>>
+% Trivial case of condition is T. FLAGG!& indicates jump cannot take place
+ ELSE <<IF EQCAR(EXP,'QUOTE) THEN
+ IF SWITCH!& AND CADR EXP
+ OR (NOT SWITCH!&) AND (NOT CADR EXP) THEN
+ <<REGS1!& := REGS!&;
+ !&ATTJMP LABL>>
+ ELSE FLAGG!& := T
+ ELSE <<!&COMTST(LIST('NE,EXP,'(QUOTE NIL)),LABL)>>>>
+
+ END;
+
+SYMBOLIC PROCEDURE !&COMOPENTST(PAT,EXP,DESTLAB,PREGS!&);
+ BEGIN
+ SCALAR ANYREGARGS,ADJFN;
+ ANYREGARGS := !&REMOPEN(!&TEMPREG(),!&COMLIS CDR EXP);
+ !&CALLOPEN(PAT,DESTLAB,ANYREGARGS,CAR EXP)
+ END;
+
+
+% Remove variables to avoid name conflicts: Hide variable names which match
+% new names when entering an inner function. Other names will be available
+% as global info. VARS is the list of new variable names, the result is a
+% list of protected stores.
+
+SYMBOLIC PROCEDURE !&REMVARL VARS;
+ FOR EACH X IN VARS COLLECT !&PROTECT X;
+
+
+% Delete all references to U from SLST!&
+% return the protected store
+SYMBOLIC PROCEDURE !&PROTECT U;
+ BEGIN SCALAR X;
+ IF X := ASSOC(U,SLST!&) THEN SLST!& := DelQIP(X,SLST!&);
+ RETURN X
+ END;
+
+% Restore a previous ENVIRONMENT!&. VARS is the list of variables taken out
+% of the ENVIRONMENT!&; LST is the list of protected stores. One or zero
+% stores for each variable.
+
+SYMBOLIC PROCEDURE !&RSTVARL(VARS,LST);
+ WHILE VARS DO
+ <<!&RSTVAR(CAR VARS,CAR LST); VARS := CDR VARS; LST := CDR LST>>;
+
+% Restore a particular variable and STORE
+
+SYMBOLIC PROCEDURE !&RSTVAR(VAR,VAL);
+ BEGIN
+ !&REMREFS VAR;
+ !&CLRSTR VAR;
+% Put back on store list if not NIL
+ !&UNPROTECT VAL
+ END;
+
+SYMBOLIC PROCEDURE !&UNPROTECT VAL; %restores VAL to SLST!&;
+ IF VAL THEN SLST!& := VAL . SLST!&;
+
+
+SYMBOLIC PROCEDURE !&STOREVAR(U,V);
+% The store generated by a SETQ
+ BEGIN SCALAR VTYPE,X;
+ !&REMREFS U;
+ IF CAR U = '!$LOCAL THEN
+ !&STORELOCAL(U,V)
+ ELSE
+ !&ATTACH LIST('!*MOVE,V,U);
+ IF !®P V THEN
+ REGS!& := !&ADDRVALS(V,REGS!&,LIST U)
+ END;
+
+
+COMMENT Support Functions;
+
+SYMBOLIC PROCEDURE !&REFERENCES(EXP,VAR);
+% True if expression EXP (probably ANYREG) references VAR.
+EXP = VAR OR
+ IF ATOM EXP OR FLAGP(CAR EXP,'TERMINAL) THEN NIL
+ ELSE !&REFERENCESL(CDR EXP,VAR);
+
+SYMBOLIC PROCEDURE !&REFERENCESL(EXP,VAR);
+IF NULL EXP THEN NIL ELSE !&REFERENCES(CAR EXP,VAR)
+ OR !&REFERENCESL(CDR EXP,VAR);
+
+SYMBOLIC PROCEDURE !&CFNTYPE FN;
+ BEGIN SCALAR X;
+ RETURN IF X := GET(FN,'CFNTYPE) THEN CAR X
+ ELSE IF X := GETD FN THEN CAR X
+ ELSE 'EXPR
+ END;
+
+SYMBOLIC PROCEDURE !&GENLBL;
+ BEGIN SCALAR L;
+ L := LIST('LABEL,!&GENSYM());
+ LBLIST!& := LIST L . LBLIST!&;
+ RETURN L
+ END;
+
+SYMBOLIC PROCEDURE !&GETLBL LABL;
+ BEGIN SCALAR X;
+ X := ASSOC(LABL,GOLIST!&);
+ IF NULL X THEN !&COMPERROR LIST("Compiler bug: missing label", LABL);
+ RETURN CDR X
+ END;
+
+
+SYMBOLIC PROCEDURE !&ATTLBL LBL;
+ IF CAAR CODELIST!& EQ '!*LBL THEN !&DEFEQLBL(LBL,CADR CAR CODELIST!&)
+ ELSE !&ATTACH LIST('!*LBL,LBL);
+
+SYMBOLIC PROCEDURE !&ATTJMP LBL;
+ BEGIN
+ IF CAAR CODELIST!& EQ '!*LBL
+ THEN <<!&DEFEQLBL(LBL,CADR CAR CODELIST!&);
+ !&DELMAC CODELIST!&>>;
+ IF !&TRANSFERP CODELIST!& THEN RETURN NIL;
+ !&ATTACH LIST('!*JUMP,LBL);
+ END;
+
+SYMBOLIC PROCEDURE !&TRANSFERP X;
+ IF CAAR X = '!*NOOP THEN !&TRANSFERP CDR X ELSE
+ FLAGP(IF CAAR X EQ '!*LINK THEN CADAR X ELSE CAAR X,'TRANSFER);
+
+SYMBOLIC PROCEDURE !&DEFEQLBL(LAB1,LAB2);
+ LBLIST!& := !&DEFEQLBL1(LBLIST!&,LAB1,LAB2);
+
+SYMBOLIC PROCEDURE !&DEFEQLBL1(LABS,LAB1,LAB2);
+ IF LAB1 MEMBER CAR LABS THEN
+ IF LAB2 MEMBER CAR LABS THEN LABS
+ ELSE APPEND(!&LABCLASS LAB2,CAR LABS) . !&DELCLASS(LAB2,CDR LABS)
+ ELSE IF LAB2 MEMBER CAR LABS THEN
+ APPEND(!&LABCLASS LAB1,CAR LABS) . !&DELCLASS(LAB1,CDR LABS)
+ ELSE CAR LABS . !&DEFEQLBL1(CDR LABS,LAB1,LAB2);
+
+SYMBOLIC PROCEDURE !&LABCLASS(LAB);
+ BEGIN SCALAR TEMP;
+ TEMP := LBLIST!&;
+ WHILE TEMP AND NOT (LAB MEMBER CAR TEMP) DO TEMP := CDR TEMP;
+ RETURN IF TEMP THEN CAR TEMP ELSE NIL;
+ END;
+
+SYMBOLIC PROCEDURE !&DELCLASS(LAB,LABS);
+ IF LAB MEMBER CAR LABS THEN CDR LABS ELSE CAR LABS . !&DELCLASS(LAB,CDR LABS);
+
+SYMBOLIC PROCEDURE !&LBLEQ(LAB1,LAB2);
+ LAB1 MEMBER !&LABCLASS LAB2;
+
+SYMBOLIC PROCEDURE !&FRAME U; %allocates space for U in frame;
+ BEGIN SCALAR Z,RES;
+ Z := IF NULL STOMAP!& THEN 1 ELSE 1 + CADR CADAR STOMAP!&;
+ RES := !&MKFRAME Z;
+ STOMAP!& := LIST(U,RES) . STOMAP!&;
+ LLNGTH!& := MAX(Z,LLNGTH!&);
+ RETURN RES
+ END;
+
+% GETFRM returns the frame location on a variable
+SYMBOLIC PROCEDURE !&GETFRM U;
+ BEGIN SCALAR X;
+ IF X:=ASSOC(U,STOMAP!&) THEN RETURN CADR X;
+ !&COMPERROR LIST("Compiler bug: lost variable",U)
+ END;
+
+%*************************************************************************
+% The following functions determine classes or properties of expressions *
+%*************************************************************************
+
+
+SYMBOLIC PROCEDURE !&ANYREG U;
+% !&ANYREG determines if U is an ANYREG expression
+%
+% ANYREG expressions are those expressions which may be loaded into any
+% register without the use of (visable) temporary registers. It is assumed
+% that ANYREG expressions have no side effects.
+%
+% ANYREG expressions are defined as constants, variables, and ANYREG functions
+% whose arguments are ANYREG expressions. Note that ANYREG functions are
+% not necessarily a part of ANYREG expressions; their arguments may not be
+% ANYREG expressions.
+!&CONSTP U OR !&VARP U OR !&ANYREGFNP U AND !&ANYREGL CDR U;
+
+SYMBOLIC PROCEDURE !&ANYREGL U;
+ NULL U OR !&ANYREG(CAR U) AND !&ANYREGL CDR U;
+
+SYMBOLIC PROCEDURE !&ANYREGFNP U;
+% !&ANYREGFNP is true when U is an ANYREG function. The arguments are not
+% checked
+ !&ANYREGP CAR U;
+
+SYMBOLIC PROCEDURE !&OPENP U;
+!&CONSTP U OR !&VARP U OR (!&ANYREGFNP U OR !&OPENFNP U) AND !&OPENPL CDR U;
+
+SYMBOLIC PROCEDURE !&OPENPL U;
+NULL U OR !&OPENP CAR U AND !&OPENPL CDR U;
+
+SYMBOLIC PROCEDURE !&OPENFNP U;
+ GET(CAR U,'OPENFN);
+
+SYMBOLIC PROCEDURE !&CONSTP U;
+% True if U is a constant expression
+ IDP CAR U AND FLAGP(CAR U,'CONST);
+
+SYMBOLIC PROCEDURE !&VARP U;
+% True if U is a variable: (LOCAL x),(FLUID x), ...
+ PAIRP U AND FLAGP(CAR U,'VAR);
+
+SYMBOLIC PROCEDURE !®P U;
+ PAIRP U AND FLAGP(CAR U,'REG);
+
+SYMBOLIC PROCEDURE !&NOSIDEEFFECTP U;
+% True if the expression U has no side effects. ANYREG expressions and
+% functions are assumed to have no side effects; other functions must be
+% flagged NOSIDEEFFECT. All arguments to a function must also be NOSIDEEFFECT.
+!&ANYREG U OR
+ (!&ANYREGFNP U OR FLAGP(CAR U,'NOSIDEEFFECT)) AND !&NOSIDEEFFECTPL CDR U;
+
+
+SYMBOLIC PROCEDURE !&NOSIDEEFFECTPL U;
+NULL U OR !&NOSIDEEFFECTP CAR U AND !&NOSIDEEFFECTPL CDR U;
+
+%**********************************************************************
+% Basic register manipulation utilities
+%**********************************************************************
+
+
+SYMBOLIC PROCEDURE !&RVAL(R,RGS);
+% Return the set of values in register R as determined by register list RGS
+ IF NULL RGS THEN NIL
+ ELSE IF CAAR RGS = R THEN CDAR RGS
+ ELSE !&RVAL(R,CDR RGS);
+
+SYMBOLIC PROCEDURE !®VAL R;
+% Normally, register contents are found in register list REGS!&.
+ !&RVAL(R,REGS!&);
+
+
+SYMBOLIC PROCEDURE !&ADDRVALS(REG,RGS,VALS);
+% Add the values VALS to the contents of REG in register list RGS
+ IF NULL RGS THEN LIST (REG . VALS)
+ ELSE IF CAAR RGS = REG THEN (CAAR RGS . APPEND(VALS,CDAR RGS)) . CDR RGS
+ ELSE CAR RGS . !&ADDRVALS(REG,CDR RGS,VALS);
+
+SYMBOLIC PROCEDURE !&MKREG NUM;
+% Used to generate a tagged register from a register number
+BEGIN SCALAR AENTRY;
+ RETURN
+ IF AENTRY := ASSOC(NUM, '((1 . (REG 1)) (2 . (REG 2)) (3 . (REG 3))
+ (4 . (REG 4)) (5 . (REG 5)) (6 . (REG 6))
+ (7 . (REG 7)) (8 . (REG 8)) (9 . (REG 9)))) THEN
+ CDR AENTRY
+ ELSE LIST('REG,NUM);
+END;
+
+SYMBOLIC PROCEDURE !&MKFRAME NUM;
+% Used to generate a tagged register from a register number
+BEGIN SCALAR AENTRY;
+ RETURN
+ IF AENTRY := ASSOC(NUM, '((1 . (FRAME 1)) (2 . (FRAME 2)) (3 . (FRAME 3))
+ (4 . (FRAME 4)) (5 . (FRAME 5)) (6 . (FRAME 6))
+ (7 . (FRAME 7)) (8 . (FRAME 8)) (9 . (FRAME 9))))
+ THEN CDR AENTRY
+ ELSE LIST('FRAME,NUM);
+END;
+
+SYMBOLIC PROCEDURE !&RASSOC(VAL,RGS);
+% Find a register in register list RGS which contains VAL. NIL is returned if
+% VAL is not present in RGS
+ IF NULL RGS THEN NIL
+ ELSE IF VAL MEMBER CDAR RGS THEN CAR RGS
+ ELSE !&RASSOC(VAL,CDR RGS);
+
+SYMBOLIC PROCEDURE !&REPASC(REG,VAL,REGL);
+% Replace the contants of REG in list REGL by the value VAL
+ IF NULL REGL THEN LIST (REG . VAL)
+ ELSE IF REG=CAAR REGL THEN (REG . VAL) . CDR REGL
+ ELSE CAR REGL . !&REPASC(REG,VAL,CDR REGL);
+
+SYMBOLIC PROCEDURE !&RMERGE U;
+% RMERGE takes a list of register contents representing the information
+% present in the registers from a number of different ways to reach the same
+% place. RMERGE returns whatever information is known to be in the registers
+% regardless of which path was taken.
+
+IF NULL U THEN NIL ELSE
+ BEGIN
+ SCALAR RES,CONTENTS;
+ RES := NIL;
+ FOR EACH RG IN CAR U DO
+ <<CONTENTS := NIL;
+ FOR EACH THING IN CDR RG DO
+ IF !&INALL(THING,CAR RG,CDR U) THEN
+ CONTENTS := THING . CONTENTS;
+ IF CONTENTS THEN RES := (CAR RG . CONTENTS) . RES>>;
+ RETURN RES;
+ END;
+
+SYMBOLIC PROCEDURE !&INALL(THING,RG,LST);
+NULL LST OR (THING MEMBER !&RVAL(RG,CAR LST)) AND !&INALL(THING,RG,CDR LST);
+
+
+SYMBOLIC PROCEDURE !&TEMPREG();
+ BEGIN SCALAR I,R,EMPTY,UNPROT;
+ EMPTY := UNPROT := NIL;
+ I := 1;
+ WHILE I <= MAXNARGS!& AND NOT EMPTY DO
+ <<R := !&MKREG I;
+ IF NOT(R MEMBER PREGS!&) THEN
+ IF I <= LASTACTUALREG!& AND NULL !®VAL R THEN EMPTY := R
+ ELSE IF NOT UNPROT THEN UNPROT := R;
+ I := I + 1
+ >>;
+ IF EMPTY THEN RETURN EMPTY;
+ IF UNPROT THEN RETURN UNPROT;
+ !&COMPERROR("Compiler bug: Not enough registers");
+ RETURN '(REG ERROR);
+ END;
+
+SYMBOLIC PROCEDURE !&REMREGS U;
+ IF !®P U THEN !®VAL U
+ ELSE IF EQCAR(U,'FRAME) THEN LIST !&GETFVAR (U,STOMAP!&)
+ ELSE IF !&CONSTP U OR !&VARP U THEN LIST U
+ ELSE !&REMREGSL U;
+
+SYMBOLIC PROCEDURE !&GETFVAR (V,SMAP);
+ IF NULL SMAP THEN !&COMPERROR(LIST("Compiler bug:", V,"evaporated?"))
+ ELSE IF CADAR SMAP = V THEN CAAR SMAP
+ ELSE !&GETFVAR (V,CDR SMAP);
+
+SYMBOLIC PROCEDURE !&REMREGSL U;
+FOR EACH ARG IN !&ALLARGS CDR U COLLECT (CAR U . ARG);
+
+SYMBOLIC PROCEDURE !&ALLARGS ARGLST;
+ if null Arglst then NIL
+ else IF NULL CDR ARGLST THEN
+ FOR EACH VAL IN !&REMREGS CAR ARGLST COLLECT LIST VAL
+ ELSE !&ALLARGS1(!&REMREGS CAR ARGLST,!&ALLARGS CDR ARGLST);
+
+SYMBOLIC PROCEDURE !&ALLARGS1(FIRSTARGS,RESTARGS);
+ BEGIN SCALAR RES;
+ RES := NIL;
+ FOR EACH A1 IN FIRSTARGS DO
+ FOR EACH A2 IN RESTARGS DO
+ RES := (A1 . A2) . RES;
+ RETURN RES;
+ END;
+
+SYMBOLIC PROCEDURE !&REMMREFS();
+REGS!& := FOR EACH R IN REGS!& COLLECT (CAR R . !&REMMREFS1 CDR R);
+
+SYMBOLIC PROCEDURE !&REMMREFS1 L;
+IF NULL L THEN L ELSE
+ IF !&REFMEMORY CAR L THEN !&REMMREFS1 CDR L
+ ELSE CAR L . !&REMMREFS1 CDR L;
+
+SYMBOLIC PROCEDURE !&REFMEMORY EXP;
+ IF ATOM EXP OR FLAGP(CAR EXP,'TERMINAL) THEN NIL
+ ELSE CAR EXP MEMBER '(MEMORY CAR CDR) OR !&REFMEMORYL CDR EXP;
+
+SYMBOLIC PROCEDURE !&REFMEMORYL L;
+ IF NULL L THEN NIL ELSE !&REFMEMORY CAR L OR !&REFMEMORYL CDR L;
+
+SYMBOLIC PROCEDURE !&REMVREFS;
+BEGIN SCALAR S;
+ REGS!& := FOR EACH R IN REGS!& COLLECT (CAR R . !&REMVREFS1 CDR R);
+% Slow version:
+% SLST!& := FOR EACH S IN SLST!& CONC
+% IF !&EXTERNALVARP CAR S THEN NIL ELSE LIST S;
+% Faster version:
+ while not null Slst!& and !&ExternalVarP car car Slst!& do
+ Slst!& := cdr Slst!&;
+ S := Slst!&;
+ while not null S and not null cdr S do
+ << if !&ExternalVarP car car cdr S then Rplacd(S, cddr S);
+ S := cdr S >>;
+END;
+
+SYMBOLIC PROCEDURE !&REMVREFS1 L;
+ FOR EACH THING IN L CONC
+ IF !&REFEXTERNAL THING THEN NIL ELSE LIST THING;
+
+SYMBOLIC PROCEDURE !&REFEXTERNAL EXP;
+ IF ATOM EXP THEN NIL
+ ELSE IF !&EXTERNALVARP EXP THEN T
+ ELSE IF FLAGP(CAR EXP,'TERMINAL) THEN NIL
+ ELSE !&REFEXTERNALL CDR EXP;
+
+SYMBOLIC PROCEDURE !&REFEXTERNALL EXPS;
+ IF NULL EXPS THEN NIL
+ ELSE !&EXTERNALVARP CAR EXPS OR !&REFEXTERNALL CDR EXPS;
+
+SYMBOLIC PROCEDURE !&EXTERNALVARP U;
+ PAIRP U AND FLAGP(CAR U,'EXTVAR);
+
+SYMBOLIC PROCEDURE !&REMREFS V;
+% Remove all references to V from REGS!&
+ IF CAR V MEMBER '(MEMORY CAR CDR) THEN
+ !&REMMREFS()
+ ELSE
+ REGS!& := FOR EACH R IN REGS!& COLLECT
+ CAR R . !&REMREFS1(V,CDR R);
+
+
+SYMBOLIC PROCEDURE !&REMREFS1(X,LST);
+% Remove all expressions from LST which reference X
+IF NULL LST THEN NIL
+ ELSE IF !&REFERENCES(CAR LST,X) THEN !&REMREFS1(X,CDR LST)
+ ELSE CAR LST . !&REMREFS1(X,CDR LST);
+
+
+%************************************************************
+% Test functions
+%************************************************************
+
+SYMBOLIC PROCEDURE !&TSTANDOR(EXP,LABL);
+ BEGIN SCALAR FLG,FLG1,FN,LAB2,REGSL,REGS1L,
+ TAILP;
+ %FLG is initial SWITCH!& condition;
+ %FN is appropriate AND/OR case;
+ %FLG1 determines appropriate switching state;
+ FLG := SWITCH!&;
+ SWITCH!& := NIL;
+ FN := CAR EXP EQ 'AND;
+ FLG1 := FLG EQ FN;
+ EXP := CDR EXP;
+ LAB2 := !&GENLBL();
+ WHILE EXP DO
+ <<SWITCH!& := NIL;
+ IF NULL CDR EXP AND FLG1
+ THEN <<IF FN THEN SWITCH!& := T;
+ !&COMTST(CAR EXP,LABL);
+ REGSL := REGS!& . REGSL;
+ REGS1L := REGS1!& . REGS1L>>
+ ELSE <<IF NOT FN THEN SWITCH!& := T;
+ IF FLG1
+ THEN <<!&COMTST(CAR EXP,LAB2);
+ REGSL := REGS1!& . REGSL;
+ REGS1L := REGS!& . REGS1L>>
+ ELSE <<!&COMTST(CAR EXP,LABL);
+ REGSL := REGS!& . REGSL;
+ REGS1L := REGS1!& . REGS1L>>>>;
+ IF NULL TAILP
+ THEN <<CONDTAIL!& := NIL . CONDTAIL!&; TAILP := T>>;
+ EXP := CDR EXP>>;
+ !&ATTLBL LAB2;
+ REGS!& := IF NOT FLG1 THEN CAR REGSL ELSE !&RMERGE REGSL;
+ REGS1!& := IF FLG1 THEN CAR REGS1L ELSE !&RMERGE REGS1L;
+ IF TAILP THEN CONDTAIL!& := CDR CONDTAIL!&;
+ SWITCH!& := FLG
+ END;
+
+
+
+%************************************************************
+% Pass2 compile functions
+%************************************************************
+
+SYMBOLIC PROCEDURE !&COMANDOR(EXP,STATUS!&);
+ BEGIN SCALAR FN,LABL,REGSL;
+ FN := CAR EXP EQ 'AND;
+ LABL := !&GENLBL();
+ EXP := CDR EXP;
+ WHILE EXP DO
+ <<!&COMVAL(CAR EXP,IF CDR EXP THEN 1 ELSE STATUS!&);
+ %to allow for recursion on last entry;
+ REGSL := REGS!& . REGSL;
+ IF CDR EXP THEN IF FN THEN !&JUMPNIL LABL ELSE !&JUMPT LABL;
+ EXP := CDR EXP>>;
+ REGS!& := !&RMERGE REGSL;
+ !&ATTLBL LABL
+ END;
+
+SYMBOLIC PROCEDURE !&COMAPPLY(EXP,STATUS); % Look for LIST;
+ BEGIN SCALAR FN,ARGS, N,NN;
+ EXP := CDR EXP;
+ FN := CAR EXP;
+ ARGS := CDR EXP;
+ IF NULL ARGS
+ OR CDR ARGS
+ OR NOT (PAIRP CAR ARGS
+ AND CAAR ARGS MEMBER
+ '(LIST QUOTE NCONS LIST1 LIST2 LIST3 LIST4 LIST5))
+ OR LENGTH CDAR ARGS>MAXNARGS!&
+ THEN RETURN !&CALL('APPLY,EXP,STATUS);
+ ARGS := IF EQCAR(CAR ARGS,'QUOTE) THEN
+ FOR EACH THING IN CADAR ARGS COLLECT LIST('QUOTE,THING)
+ ELSE CDAR ARGS;
+ NN := LENGTH ARGS;
+ ARGS := REVERSIP (FN . REVERSE ARGS);
+ !&LOADARGS(REVERSIP !&COMLIS ARGS,1,PREGS!&);
+ !&ATTACH LIST('!*MOVE, !&MKREG(NN + 1), '(REG T1));
+ !&ATTACH LIST('!*LINK,'FASTAPPLY,'EXPR, NN);
+ REGS!& := NIL;
+ !&REMVREFS();
+ END;
+
+%Bug fix to COMCOND - tail has (QUOTE T) not T. Test for tail screwed up anyway
+
+SYMBOLIC PROCEDURE !&COMCOND(EXP,STATUS!&);
+ %compiles conditional expressions;
+ %registers REGS!& are set for dropping through,
+ %REGS1 are set for a branch;
+ BEGIN SCALAR REGS1!&,FLAGG!&,SWITCH!&,LAB1,LAB2,REGSL,
+ TAILP;
+ EXP := CDR EXP;
+ LAB1 := !&GENLBL();
+ FOR EACH X ON EXP DO % Changed IN -> ON
+ <<LAB2 := !&GENLBL();
+ SWITCH!& := NIL;
+ IF CDR X THEN !&COMTST(CAAR X,LAB2) % CAR -> CAAR
+ %update CONDTAIL!&;
+ ELSE IF CAAR X = '(QUOTE T) THEN % CAR -> CAAR, T->(QUOTE T)
+ FLAGG!& := T
+ ELSE <<!&COMVAL(CAAR X,1); % CAR -> CAAR
+ !&JUMPNIL LAB2;
+ REGS1!& := !&ADDRVALS('(REG 1),
+ REGS!&,
+ list '(QUOTE NIL)) >>;
+ IF NULL TAILP
+ THEN <<CONDTAIL!& := NIL . CONDTAIL!&;
+ TAILP := T>>;
+ !&COMVAL(CADR CAR X,STATUS!&); %X -> CAR X
+ % Branch code;
+ %test if need jump to LAB1;
+ IF NOT FLAGG!& THEN % New line
+ <<IF NOT !&TRANSFERP CODELIST!&
+ THEN <<!&ATTJMP LAB1;
+ REGSL := REGS!& . REGSL>>;
+ REGS!& := REGS1!&;>>;
+ %restore register status for next iteration;
+ %we do not need to set REGS1!& to NIL since all COMTSTs
+ %are required to set it;
+ !&ATTLBL LAB2>>;
+ IF NULL FLAGG!& AND STATUS!&<2
+ THEN <<!&LREG1('(QUOTE NIL));
+ REGS!& := !&RMERGE(REGS!& . REGSL)>>
+ ELSE IF REGSL
+ THEN REGS!& := !&RMERGE(REGS!& . REGSL);
+ !&ATTLBL LAB1;
+ IF TAILP THEN CONDTAIL!& := CDR CONDTAIL!&
+ END;
+
+SYMBOLIC PROCEDURE !&COMCONS(EXP,STATUS!&);
+ IF NULL (EXP := CDR EXP) OR NULL CDR EXP OR CDDR EXP
+ THEN !&COMPERROR LIST("Wrong number of arguments to CONS",EXP)
+ ELSE IF CADR EXP='(QUOTE NIL)
+ THEN !&CALL('NCONS,LIST CAR EXP,STATUS!&)
+ ELSE IF CADR EXP MEMBER !®VAL '(REG 1)
+ AND !&OPENP CAR EXP
+ THEN !&CALL1('XCONS,!&COMLIS EXP,STATUS!&)
+ ELSE IF !&OPENP CADR EXP THEN !&CALL('CONS,EXP,STATUS!&)
+ ELSE !&CALL1('XCONS,!&COMLIS EXP,STATUS!&);
+
+SYMBOLIC PROCEDURE !&COMGO(EXP,STATUS!&);
+ << IF STATUS!&>1 THEN <<!&ATTJMP !&GETLBL CADR EXP; SLST!& := NIL>>
+ ELSE !&COMPERROR LIST(EXP,"invalid go")>>;
+
+SYMBOLIC PROCEDURE !&COMCASE(EXP,STATUS!&);
+ BEGIN SCALAR BOTTOMLAB,REGS1!&,JUMPS,EXPS,ELSELAB,HIGH,LOW,SAVEREGS,
+ JMPS,JLIST,RANGES,TABLE,TAILP;
+ BOTTOMLAB := !&GENLBL();
+ REGS1!& := NIL;
+ !&COMVAL(CADR EXP,1);
+ JUMPS := EXPS := NIL;
+ CONDTAIL!& := NIL . CONDTAIL!&;
+ TAILP := T;
+ FOR EACH THING ON CDDR EXP DO
+ BEGIN SCALAR LAB;
+ LAB := !&GENLBL();
+ JUMPS := NCONC(JUMPS,LIST LIST(CAAR THING,LAB));
+ EXPS := NCONC(EXPS,LIST LIST(LAB,CADAR THING));
+ IF NULL CDR THING THEN
+ IF NOT NULL CAAR THING THEN
+ IF STATUS!& > 1 THEN <<REGS1!& := REGS!& . REGS1!&;
+ ELSELAB := BOTTOMLAB>>
+ ELSE EXPS := NCONC(EXPS,LIST LIST(ELSELAB := !&GENLBL(),
+ '(QUOTE NIL)))
+ ELSE ELSELAB := LAB;
+ END;
+ RANGES := NIL;
+ TABLE := NIL;
+ FOR EACH JMP IN JUMPS DO
+ FOR EACH NUM IN CAR JMP DO
+ IF EQCAR(NUM,'RANGE) THEN
+ BEGIN
+ SCALAR HIGH,LOW;
+ LOW := !&GETNUM CADR NUM;
+ HIGH := !&GETNUM CADDR NUM;
+ IF HIGH >= LOW THEN
+ IF HIGH - LOW < 6 THEN
+ FOR I := LOW:HIGH DO
+ TABLE := !&INSTBL(TABLE,I,CADR JMP)
+ ELSE RANGES := NCONC(RANGES,LIST LIST(LOW,HIGH,CADR JMP));
+ END
+ ELSE TABLE := !&INSTBL(TABLE,!&GETNUM NUM,CADR JMP);
+ FOR EACH R IN RANGES DO
+ !&ATTACH LIST('!*JUMPWITHIN,CADDR R,CAR R,CADR R);
+ WHILE TABLE DO
+ <<JMPS := LIST CAR TABLE;
+ LOW := HIGH := CAAR TABLE;
+ JLIST := LIST CADAR TABLE;
+ WHILE CDR TABLE AND CAR CADR TABLE < HIGH + 5 DO
+ <<TABLE := CDR TABLE;
+ WHILE HIGH < (CAAR TABLE) - 1 DO
+ <<HIGH := HIGH + 1;
+ JLIST := NCONC(JLIST,LIST ELSELAB)>>;
+ HIGH := HIGH + 1;
+ JLIST := NCONC(JLIST,LIST CADAR TABLE);
+ JMPS := NCONC(JMPS,LIST CAR TABLE)>>;
+ IF LENGTH JMPS < 4 THEN
+ FOR EACH J IN JMPS DO
+ !&ATTACH LIST('!*JUMPEQ,CADR J,'(REG 1),LIST('WCONST,CAR J))
+ ELSE
+ !&ATTACH('!*JUMPON . '(REG 1) . LOW . HIGH . JLIST);
+ TABLE := CDR TABLE>>;
+ !&ATTJMP ELSELAB;
+ SAVEREGS := REGS!&;
+ FOR EACH THING IN EXPS DO
+ <<!&ATTLBL CAR THING;
+ REGS!& := SAVEREGS;
+ IF CADR THING THEN !&COMVAL(CADR THING,STATUS!&);
+ IF NOT !&TRANSFERP CODELIST!& THEN
+ <<!&ATTJMP BOTTOMLAB;
+ REGS1!& := REGS!& . REGS1!&>> >>;
+ !&ATTLBL BOTTOMLAB;
+ REGS!& := !&RMERGE REGS1!&;
+ CONDTAIL!& := CDR CONDTAIL!&
+ END;
+
+SYMBOLIC PROCEDURE !&INSTBL(TBL,I,L);
+ IF NULL TBL THEN LIST LIST(I,L)
+ ELSE IF I < CAAR TBL THEN LIST(I,L) . TBL
+ ELSE IF I = CAAR TBL THEN
+ !&COMPERROR LIST("Ambiguous case",TBL)
+ ELSE CAR TBL . !&INSTBL(CDR TBL,I,L);
+
+SYMBOLIC PROCEDURE !&GETNUM X;
+ IF !&WCONSTP X AND NUMBERP CADR X THEN CADR X
+ ELSE !&COMPERROR(LIST("Number expected for CASE label",X));
+
+SYMBOLIC PROCEDURE !&COMPROG(EXP,STATUS!&); %compiles program blocks;
+ BEGIN SCALAR ALSTS!&,GOLIST!&,PG,PROGLIS,EXITT!&,EXITREGS!&;
+ INTEGER I;
+ %SCALAR OLDSTOMAP,OLDCODE;
+% OLDCODE := CODELIST!&;
+% OLDSTOMAP := STOMAP!&;
+ EXITREGS!& := NIL;
+ PROGLIS := CADR EXP;
+ EXP := CDDR EXP;
+ EXITT!& := !&GENLBL();
+ PG := !&REMVARL PROGLIS; %protect prog variables;
+ ALSTS!& := !&VARBIND(PROGLIS,NIL);
+ FOR EACH X IN EXP DO IF ATOM X
+ THEN GOLIST!& := (X . !&GENLBL()) . GOLIST!&;
+ WHILE EXP DO
+ <<IF ATOM CAR EXP
+ THEN <<!&ATTLBL !&GETLBL CAR EXP;
+ REGS!& := NIL>>
+ ELSE !&COMVAL(CAR EXP,IF STATUS!&>2 THEN 4 ELSE 3);
+ EXP := CDR EXP>>;
+ IF NOT !&TRANSFERP CODELIST!& AND STATUS!& < 2 THEN
+ !&LREG1('(QUOTE NIL));
+ !&ATTLBL EXITT!&;
+ REGS!& := !&RMERGE (REGS!& . EXITREGS!&);
+ !&FREERSTR(ALSTS!&,STATUS!&);
+ !&RSTVARL(PROGLIS,PG);
+%/ !&FIXFRM(OLDSTOMAP,OLDCODE,0);
+ END;
+
+SYMBOLIC PROCEDURE !&COMPROGN(EXP,STATUS!&);
+ BEGIN
+ EXP := CDR EXP;
+ IF NULL EXP THEN RETURN !&COMVAL('(QUOTE NIL), STATUS!&);
+ WHILE CDR EXP DO
+ <<!&COMVAL(CAR EXP,IF STATUS!&<2 THEN 2 ELSE STATUS!&);
+ EXP := CDR EXP>>;
+ !&COMVAL(CAR EXP,STATUS!&)
+ END;
+
+SYMBOLIC PROCEDURE !&COMRETURN(EXP,STATUS!&);
+<< EXP := CDR EXP;
+ IF NULL EXP OR NOT NULL CDR EXP THEN
+ << !&COMPERROR LIST("RETURN must have exactly one argument",EXP);
+ EXP := '((QUOTE NIL)) >>;
+ IF STATUS!&<4 OR NOT !&NOSIDEEFFECTP(CAR EXP)
+ THEN !&LREG1(CAR !&COMLIS1 EXP);
+ SLST!& := NIL;
+ EXITREGS!& := REGS!& . EXITREGS!&;
+ !&ATTJMP EXITT!& >>;
+
+
+SYMBOLIC PROCEDURE !&DELMAC X;
+% Delete macro CAR X from CODELIST!&
+ RPLACA(X,'(!*NOOP));
+
+%*************************************************************
+% Pass 3
+%*************************************************************
+
+
+COMMENT Post Code Generation Fixups;
+
+SYMBOLIC PROCEDURE !&PASS3;
+% Pass 3 - optimization.
+% The optimizations currently performed are:
+% 1. Deletion of stores not yet picked up from SLST!&.
+% 2. Removal of unreachable macros.
+% 3. A peep hole optimizer, currently only optmizing LBL macros.
+% 4. Removal of common code chains
+% 5. Changing LINK to LINKE where possible
+% 6. Squeezing out unused frame locations and mapping the stack onto
+% the registers.
+% Other functions of PASS3 are to tack exit code on the end and reverse
+% the code list.
+
+ <<
+ FOR EACH J IN SLST!& DO !&DELMAC CDR J;
+ !&ATTLBL EXITT!&;
+ !&ATTACH '(!*EXIT (!*FRAMESIZE));
+ !&REMCODE(T);
+ !&FIXLABS();
+ !&FIXCHAINS();
+ !&FIXLINKS();
+ !&REMCODE(NIL);
+ !&FIXFRM(NIL,NIL,NARG!&);
+ !&PEEPHOLEOPT();
+ !&REMCODE(NIL);
+ CODELIST!& := REVERSIP CODELIST!&;
+ >>;
+
+SYMBOLIC PROCEDURE !&INSERTMAC(PLACE,MAC);
+ RPLACW(PLACE,MAC . (CAR PLACE . CDR PLACE));
+
+SYMBOLIC PROCEDURE !&DELETEMAC(PLACE);
+ RPLACW(PLACE,CDR PLACE);
+
+SYMBOLIC PROCEDURE !&REMCODE(KEEPTOP);
+ BEGIN SCALAR UNUSEDLBLS;
+ UNUSEDLBLS := !&UNUSEDLBLS(KEEPTOP);
+ !&REMUNUSEDMAC(UNUSEDLBLS);
+ WHILE (UNUSEDLBLS := !&UNUSEDLBLS(KEEPTOP)) DO !&REMUNUSEDMAC(UNUSEDLBLS);
+ END;
+
+SYMBOLIC PROCEDURE !&UNUSEDLBLS(KEEPTOP);
+ BEGIN SCALAR USED,UNUSED;
+ USED := NIL;
+ UNUSED := LBLIST!&;
+ IF KEEPTOP THEN
+ <<USED := !&LABCLASS(TOPLAB!&) . USED;
+ UNUSED := !&DELCLASS(TOPLAB!&,UNUSED)>>;
+ FOR EACH MAC IN CODELIST!& DO
+ IF CAR MAC NEQ '!*LBL THEN
+ FOR EACH FLD IN CDR MAC DO
+ IF EQCAR(FLD,'LABEL) AND !&CLASSMEMBER(FLD,UNUSED) THEN
+ <<USED := !&LABCLASS(FLD) . USED;
+ UNUSED := !&DELCLASS(FLD,UNUSED)>>;
+ LBLIST!& := USED;
+ RETURN UNUSED;
+ END;
+
+SYMBOLIC PROCEDURE !&CLASSMEMBER(LAB,CLASSES);
+ IF NULL CLASSES THEN NIL
+ ELSE LAB MEMBER CAR CLASSES OR !&CLASSMEMBER(LAB,CDR CLASSES);
+
+
+SYMBOLIC PROCEDURE !&REMUNUSEDMAC(UNUSEDLABS);
+ BEGIN SCALAR P,Q,R;
+ CODELIST!& := P := REVERSIP CODELIST!&;
+ WHILE CDR P DO
+ <<Q := CDR P;
+ IF CAAR Q = '!*NOOP OR
+ !&TRANSFERP P AND CAAR Q NEQ '!*LBL
+ OR CAAR Q = '!*LBL AND !&CLASSMEMBER(CADAR Q,UNUSEDLABS) THEN
+ RPLACD(P,CDR Q)
+ ELSE P := CDR P >>;
+ CODELIST!& := REVERSIP CODELIST!&;
+ END;
+
+lisp procedure !&FixLinks();
+%
+% replace LINK by LINKE where appropriate
+%
+if not !*NoLinkE and not FreeBound!& then
+begin scalar Switched;
+ for each Inst on CodeList!& do
+ begin scalar SaveRest;
+ if ExitT!& and first first Inst = '!*JUMP
+ and second first Inst = ExitT!&
+ or first first Inst = '!*EXIT then
+ << if first second Inst = '!*LBL then
+ << if first third Inst = '!*LINK then
+ << Inst := cdr Inst;
+ SaveRest := T >> >>;
+ if first second Inst = '!*LINK then
+ << if second second Inst eq NAME!& and !*R2I then
+ Rplaca(rest Inst, list('!*JUMP, TopLab!&))
+ else
+ Rplaca(rest Inst, '!*LINKE . '(!*FRAMESIZE)
+ . rest second Inst);
+ if not SaveRest then !&DeleteMac Inst >> >>;
+ end;
+end;
+
+SYMBOLIC PROCEDURE !&PEEPHOLEOPT;
+ %'peep-hole' optimization for various cases;
+ BEGIN SCALAR X,Z;
+ Z := CODELIST!&;
+ WHILE Z DO
+ IF CAAR Z = '!*NOOP THEN !&DELETEMAC Z
+ ELSE IF NOT (X := GET(CAAR Z,'OPTFN)) OR NOT APPLY(X,LIST Z)
+ THEN Z := CDR Z
+ END;
+
+COMMENT Peep-hole optimization tables;
+SYMBOLIC PROCEDURE !&STOPT U;
+ IF CAADR U = '!*ALLOC AND LLNGTH!& = 1
+ AND CDDAR U = '((FRAME 1)) THEN
+ <<RPLACW(U,LIST('!*PUSH,CADAR U) . CDDR U)>>
+ ELSE IF CAADR U = '!*MOVE AND CAADDR U = '!*ALLOC AND LLNGTH!& = 2
+ AND CDDAR U = '((FRAME 2)) AND CDDADR U = '((FRAME 1)) THEN
+ <<RPLACW(U,LIST('!*PUSH,CADADR U) . LIST('!*PUSH,CADAR U) . CDDDR U)>>;
+
+SYMBOLIC PROCEDURE !&LBLOPT U;
+ BEGIN SCALAR Z;
+ IF CADR U = '!*LBL THEN
+ <<!&DEFEQLBL(CADR U,CADR CDR U);
+ RPLACD(U,CDDR U);
+ RETURN T>>;
+ IF CDADR U AND EQCAR(CADADR U,'LABEL) AND !&LBLEQ(CADAR U,CADADR U)
+ THEN RETURN RPLACW(CDR U,CDDR U)
+ ELSE IF CAADR U = '!*JUMP
+ AND (Z := GET(CAADDR U,'NEGJMP))
+ AND !&LBLEQ(CADAR U,CADR CADDR U)
+ THEN RETURN <<Z := Z . (CADADR U . CDDR CADDR U);
+ RPLACD(U,(Z . CDDDR U));
+ T>>
+ ELSE RETURN NIL
+ END;
+
+SYMBOLIC PROCEDURE !&JUMPOPT U;
+ IF CADAR U = EXITT!& AND LLNGTH!& = 0 THEN
+ RPLACA(U,'(!*EXIT (!*FRAMESIZE)));
+
+SYMBOLIC PROCEDURE !&FIXCHAINS();
+ BEGIN SCALAR LAB;
+ FOR EACH LABCODE ON CODELIST!& DO
+ IF CAAR LABCODE = '!*LBL % OR CAAR LABCODE = '!*JUMP % croaks on this one
+ THEN
+ <<LAB := CADAR LABCODE;
+ FOR EACH JUMPCODE ON CDR LABCODE DO
+ IF CAAR JUMPCODE = '!*JUMP AND CADAR JUMPCODE = LAB THEN
+ !&MOVEJUMP(LABCODE,JUMPCODE)>>
+ END;
+
+SYMBOLIC PROCEDURE !&MOVEJUMP(LABCODE,JUMPCODE);
+ IF CADR LABCODE = CADR JUMPCODE THEN
+ BEGIN SCALAR LAB;
+ REPEAT
+ <<IF CADR LABCODE = CADR JUMPCODE THEN
+ <<JUMPCODE := CDR JUMPCODE;
+ LABCODE := CDR LABCODE>>;
+ WHILE CAADR LABCODE = '!*LBL DO LABCODE := CDR LABCODE;
+ WHILE CAADR JUMPCODE = '!*LBL DO JUMPCODE := CDR JUMPCODE;>>
+ UNTIL NOT(CADR JUMPCODE = CADR LABCODE);
+ IF CAAR LABCODE = '!*LBL THEN
+ RPLACD(JUMPCODE,LIST('!*JUMP,CADR CAR LABCODE) . CDR JUMPCODE)
+ ELSE
+ <<LAB := !&GENLBL();
+ RPLACD(JUMPCODE,LIST('!*JUMP,LAB) . CDR JUMPCODE);
+ RPLACD(LABCODE,LIST('!*LBL,LAB) . CDR LABCODE)>>;
+ END;
+
+
+SYMBOLIC PROCEDURE !&FIXFRM(OLDSTOMAP,OLDCODE,HIGHREG);
+% Should change FIXFRM to do sliding squeeze, not reorder;
+ BEGIN SCALAR LST,GAZINTA,N,NF,TOP,FRAMESUSED,R,USED,FR,P,HMAP;
+ HOLEMAP!& := NIL;
+% No stores were generated - frame size = 0
+ N := 1;
+ GAZINTA := 1;
+% Now, loop through every allocated slot in the frame
+ FRAMESUSED := !&GETFRAMES(CODELIST!&,OLDCODE,NIL);
+ WHILE N <= LLNGTH!& DO
+ <<USED := NIL;
+ FR := !&MKFRAME N;
+ FOR EACH VAR IN OLDSTOMAP DO IF CADR VAR = FR THEN USED := T;
+ IF FR MEMBER FRAMESUSED THEN USED := T;
+% Find out if a frame location was used. N and GAZINTA used for squeeze
+% HOLEMAP!& is an association list between old and new frame locations.
+ IF USED THEN <<HOLEMAP!& := LIST(FR,!&MKFRAME GAZINTA) . HOLEMAP!&;
+ GAZINTA := GAZINTA + 1 >>;
+ N := N + 1>>;
+ LLNGTH!& := GAZINTA - 1;
+ %now see if we can map stack to registers;
+ TOP := !&HIGHEST(CODELIST!&,OLDCODE,HIGHREG,NIL);
+ IF NOT(TOP = 'ALL OR
+ FREEBOUND!& AND NOT !*USEREGFLUID) THEN
+ <<HMAP := NIL;
+ NF := 0;
+ FOR EACH HOLE IN HOLEMAP!& DO
+ IF TOP < LASTACTUALREG!& THEN
+ << TOP := TOP + 1;
+ LLNGTH!& := LLNGTH!& - 1;
+ R := !&MKREG TOP;
+ REGS!& := DELASC(R,REGS!&);
+ HMAP := LIST(CAR HOLE,R) . HMAP>>
+ ELSE
+ << NF := NF + 1;
+ HMAP := LIST(CAR HOLE, !&MKFRAME NF) . HMAP >>;
+ IF NF NEQ 0 THEN LLNGTH!& := NF;
+ HOLEMAP!& := HMAP;
+ >>
+ ELSE IF N = GAZINTA THEN RETURN NIL;
+ P := CODELIST!&;
+ WHILE NOT (P EQ OLDCODE) DO
+ <<RPLACA(P,!&MACROSUBST(CAR P,HOLEMAP!&));
+ P := CDR P>>;
+END;
+
+SYMBOLIC PROCEDURE !&GETFRAMES(CODE,OLDCODE,RES);
+IF CODE EQ OLDCODE THEN RES
+ ELSE !&GETFRAMES(CDR CODE,OLDCODE,!&GETFRAMES1(CDAR CODE,RES));
+
+SYMBOLIC PROCEDURE !&GETFRAMES1(MACARGS,RES);
+IF NULL MACARGS THEN RES ELSE !&GETFRAMES1(CDR MACARGS,
+ !&GETFRAMES2(CAR MACARGS,RES));
+
+SYMBOLIC PROCEDURE !&GETFRAMES2(MACARG,RES);
+IF ATOM MACARG OR !&VARP MACARG OR !&CONSTP MACARG OR !®P MACARG THEN RES
+ ELSE IF EQCAR(MACARG,'FRAME) THEN
+ IF MACARG MEMBER RES THEN RES ELSE MACARG . RES
+ ELSE !&GETFRAMES1(CDR MACARG,RES);
+
+
+
+SYMBOLIC PROCEDURE !&HIGHEST(START,STOP,HIGHREG,EXITFLAG);
+% Find the highest register used. 'ALL is returned if all are used.
+ IF START EQ STOP THEN HIGHREG ELSE
+ BEGIN SCALAR FN,MAC;
+ MAC := CAR START;
+ RETURN
+ IF CAR MAC = '!*LINK OR CAR MAC = '!*LINKE AND EXITFLAG THEN
+ <<FN := CADR MAC;
+ IF FN = NAME!& THEN
+ IF EXITFLAG THEN
+ !&HIGHEST(CDR START,STOP,HIGHREG,EXITFLAG)
+ ELSE 'ALL
+ ELSE IF (DEST!& := GET(FN,'DESTROYS)) AND !*USINGDESTROY THEN
+ <<FOR EACH R IN DEST!& DO HIGHREG := MAX(HIGHREG,CADR R);
+ !&HIGHEST(CDR START,STOP,HIGHREG,EXITFLAG)>>
+ ELSE 'ALL>>
+ ELSE IF CAR MAC = '!*LINKF OR CAR MAC = '!*LINKEF AND EXITFLAG THEN
+ 'ALL
+ ELSE
+ !&HIGHEST(CDR START,STOP,!&HIGHEST1(HIGHREG,CDR MAC),EXITFLAG);
+END;
+
+SYMBOLIC PROCEDURE !&HIGHEST1(H,ARGS);
+ BEGIN
+ FOR EACH A IN ARGS DO
+ H := MAX(H,!&HIGHEST2(H,A));
+ RETURN H;
+ END;
+
+SYMBOLIC PROCEDURE !&HIGHEST2(H,ARG);
+ IF ATOM ARG THEN H
+ ELSE IF NOT ATOM CAR ARG THEN !&HIGHEST1(H,ARG)
+ ELSE IF !&CONSTP ARG THEN H
+ ELSE IF CAR ARG = 'REG AND NUMBERP CADR ARG THEN MAX(H,CADR ARG)
+ ELSE !&HIGHEST1(H,CDR ARG);
+
+SYMBOLIC PROCEDURE !&REFORMMACROS;
+ BEGIN SCALAR FINALTRANSFORM;
+ FINALTRANSFORM := LIST(LIST('(!*FRAMESIZE),LLNGTH!&));
+ FOR EACH MAC ON CODELIST!& DO
+ RPLACA(MAC,!&MACROSUBST(CAR MAC,FINALTRANSFORM));
+ END;
+
+SYMBOLIC PROCEDURE !&FIXLABS();
+ BEGIN SCALAR TRANSFORM,U;
+ TRANSFORM := NIL;
+ FOR EACH LAB IN LBLIST!& DO
+ FOR EACH EQLAB IN CDR LAB DO
+ TRANSFORM := LIST(EQLAB,CAR LAB) . TRANSFORM;
+ FOR EACH MAC ON CODELIST!& DO
+ RPLACA(MAC,!&MACROSUBST(CAR MAC,TRANSFORM));
+ IF U := ASSOC(EXITT!&,TRANSFORM) THEN EXITT!& := CADR U;
+ IF U := ASSOC(TOPLAB!&,TRANSFORM) THEN TOPLAB!& := CADR U;
+ LBLIST!& := FOR EACH LAB IN LBLIST!& COLLECT LIST CAR LAB;
+ END;
+
+SYMBOLIC PROCEDURE !&MACROSUBST(MAC,ALIST);
+ CAR MAC . !&MACROSUBST1(CDR MAC,ALIST);
+
+SYMBOLIC PROCEDURE !&MACROSUBST1(ARGS,ALIST);
+ FOR EACH ARG IN ARGS COLLECT !&MACROSUBST2(ARG,ALIST);
+
+SYMBOLIC PROCEDURE !&MACROSUBST2(ARG,ALIST);
+ BEGIN SCALAR U;
+ U:=ASSOC(ARG,ALIST);
+ RETURN IF U THEN CADR U
+ ELSE IF ATOM ARG OR FLAGP(CAR ARG,'TERMINAL) THEN ARG
+ ELSE (CAR ARG . !&MACROSUBST1(CDR ARG,ALIST));
+ END;
+
+SYMBOLIC PROCEDURE !&REMTAGS();
+ FOR EACH MAC IN CODELIST!& DO !&REMTAGS1 MAC;
+
+SYMBOLIC PROCEDURE !&REMTAGS1 MAC;
+<< IF CAR MAC = '!*JUMPON THEN RPLACD(CDDDR MAC, LIST CDDDDR MAC);
+ FOR EACH MACFIELD IN CDR MAC DO !&REMTAGS2 MACFIELD >>;
+
+SYMBOLIC PROCEDURE !&REMTAGS2 U;
+ IF EQCAR(U, 'WCONST) THEN !&REMTAGS3 CADR U;
+
+SYMBOLIC PROCEDURE !&REMTAGS3 U;
+BEGIN SCALAR DOFN;
+ IF ATOM U THEN RETURN NIL;
+ IF DOFN := GET(CAR U, 'DOFN) THEN
+ RPLACA(U, DOFN);
+ !&REMTAGS4 CDR U;
+END;
+
+SYMBOLIC PROCEDURE !&REMTAGS4 U;
+ FOR EACH X IN U DO !&REMTAGS3 X;
+
+% Entry points used in setting up the system
+
+SYMBOLIC PROCEDURE !&ONEREG U;
+ FOR EACH X IN U DO PUT(X,'DESTROYS,'((REG 1)));
+
+SYMBOLIC PROCEDURE !&TWOREG U;
+ FOR EACH X IN U DO PUT(X,'DESTROYS,'((REG 1) (REG 2)));
+
+SYMBOLIC PROCEDURE !&THREEREG U;
+ FOR EACH X IN U DO PUT(X,'DESTROYS,'((REG 1) (REG 2) (REG 3)));
+
+END;
ADDED psl-1983/3-1/comp/data-machine.red
Index: psl-1983/3-1/comp/data-machine.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/data-machine.red
@@ -0,0 +1,490 @@
+%
+% DATA-MACHINE.RED - Macros for fast access to data structures
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.COMP>DATA-MACHINE.RED.13, 30-Mar-83 11:03:57, Edit by KENDZIERSKI
+% Included the text from data-machine.build at the beginning of this file.
+% The file names w/extensions were getting too large for the VAX to deal with.
+% <PERDUE.PSL>DATA-MACHINE.RED.3, 28-Feb-83 12:28:57, Edit by PERDUE
+% Added nasty comments and proposed changes
+% <PSL.COMP>DATA-MACHINE.RED.10, 10-Jan-83 16:31:31, Edit by PERDUE
+% Added PutEvecLen for EVectors; this had been omitted
+% Edit by GRISS, 3Nov: Added missing EVEC operations
+
+% Primitives handled by the compiler are BYTE, PUTBYTE, GETMEM, PUTMEM,
+% MKITEM, FIELD, SIGNEDFIELD, PUTFIELD, HALFWORD, PUYTHALFWORD
+
+CompileTime << load if!-system, syslisp; % Assume still there, else load source
+ off UserMode; >>;
+in "wdeclare.red"$
+CompileTime if_system(PDP10, << in "P20C:DEC20-DATA-MACHINE.RED"$ >>)$
+CompileTime if_system(VAX, << in "vax/vax-data-machine.red"$ >>)$
+CompileTime if_system(HP9836, << in "phpc:hp-data-machine.red"$ >>)$
+
+on Syslisp;
+
+off R2I;
+
+% These definitions are for interpretive testing of Syslisp code.
+% They may be dangerous in some cases.
+
+CommentOutCode <<
+syslsp procedure Byte(WAddr, ByteOffset);
+ Byte(WAddr, ByteOffset);
+
+syslsp procedure PutByte(WAddr, ByteOffset, Val);
+ PutByte(WAddr, ByteOffset, Val);
+
+syslsp procedure Halfword(WAddr, HalfwordOffset);
+ Halfword(WAddr, HalfwordOffset);
+
+syslsp procedure PutHalfword(WAddr, HalfwordOffset, Val);
+ PutHalfword(WAddr, HalfwordOffset, Val);
+
+syslsp procedure GetMem Addr;
+ GetMem Addr;
+
+syslsp procedure PutMem(Addr, Val);
+ PutMem(Addr, Val);
+
+syslsp procedure MkItem(TagPart, InfPart);
+ MkItem(TagPart, InfPart);
+
+CommentOutCode << % can't do FIELD w/ non constants
+syslsp procedure Field(Cell, StartingBit, BitLength);
+ Field(Cell, StartingBit, BitLength);
+
+syslsp procedure SignedField(Cell, StartingBit, BitLength);
+ SignedField(Cell, StartingBit, BitLength);
+
+syslsp procedure PutField(Cell, StartingBit, BitLength, Val);
+ PutField(Cell, StartingBit, BitLength, Val);
+>>;
+
+syslsp procedure WPlus2(R1, R2);
+ WPlus2(R1, R2);
+
+syslsp procedure WDifference(R1, R2);
+ WDifference(R1, R2);
+
+syslsp procedure WTimes2(R1, R2);
+ WTimes2(R1, R2);
+
+syslsp procedure WQuotient(R1, R2);
+ WQuotient(R1, R2);
+
+syslsp procedure WRemainder(R1, R2);
+ WRemainder(R1, R2);
+
+syslsp procedure WMinus R1;
+ WMinus R1;
+
+syslsp procedure WShift(R1, R2);
+ WShift(R1, R2);
+
+syslsp procedure WAnd(R1, R2);
+ WAnd(R1, R2);
+
+syslsp procedure WOr(R1, R2);
+ WOr(R1, R2);
+
+syslsp procedure WXor(R1, R2);
+ WXor(R1, R2);
+
+syslsp procedure WNot R1;
+ WNot R1;
+
+syslsp procedure WLessP(R1, R2);
+ WLessP(R1, R2);
+
+syslsp procedure WGreaterP(R1, R2);
+ WGreaterP(R1, R2);
+
+syslsp procedure WLEQ(R1, R2);
+ WLEQ(R1, R2);
+
+syslsp procedure WGEQ(R1, R2);
+ WGEQ(R1, R2);
+>>;
+
+on R2I;
+
+off Syslisp;
+
+% SysLisp array accessing primitives
+
+syslsp macro procedure WGetV U;
+ list('GetMem, list('WPlus2, cadr U, list('WTimes2, caddr U,
+ '(WConst AddressingUnitsPerItem))));
+
+syslsp macro procedure WPutV U;
+ list('PutMem, list('WPlus2, cadr U, list('WTimes2, caddr U,
+ '(WConst AddressingUnitsPerItem))),
+ cadddr U);
+
+% tags
+
+CompileTime <<
+lisp procedure DeclareTagRange(NameList, StartingValue, Increment);
+begin scalar Result;
+ Result := list 'progn;
+ while NameList do
+ << Result := list('put, MkQuote car NameList,
+ '(quote WConst),
+ StartingValue)
+ . Result;
+ StartingValue := StartingValue + Increment;
+ NameList := cdr NameList >>;
+ return ReversIP Result;
+end;
+
+macro procedure LowTags U;
+ DeclareTagRange(cdr U, 0, 1);
+
+macro procedure HighTags U;
+ DeclareTagRange(cdr U, LSH(1, get('TagBitLength, 'WConst)) - 1, -1);
+>>;
+
+% JumpInType and friends depend on the ordering and contiguity of
+% the numeric type tags. Fast arithmetic depends on PosInt = 0,
+% NegInt = -1. Garbage collectors depend on pointer tags being
+% between PosInt and Code, non-inclusive. /csp
+
+LowTags(PosInt, FixN, BigN, FltN, Str, Bytes, HalfWords, Wrds, Vect, Pair,
+ Evect);
+
+put('Code, 'WConst, 15);
+
+HighTags(NegInt, ID, Unbound, BtrTag, Forward,
+ HVect, HWrds, HHalfWords, HBytes);
+
+% Item constructor macros
+
+lisp procedure MakeItemConstructor(TagPart, InfPart);
+ list('MkItem, TagPart, InfPart);
+
+syslsp macro procedure MkBTR U;
+ MakeItemConstructor('(wconst BtrTag), cadr U);
+
+syslsp macro procedure MkID U;
+ MakeItemConstructor('(wconst ID), cadr U);
+
+syslsp macro procedure MkFIXN U;
+ MakeItemConstructor('(wconst FIXN), cadr U);
+
+syslsp macro procedure MkFLTN U;
+ MakeItemConstructor('(wconst FLTN), cadr U);
+
+syslsp macro procedure MkBIGN U;
+ MakeItemConstructor('(wconst BIGN), cadr U);
+
+syslsp macro procedure MkPAIR U;
+ MakeItemConstructor('(wconst PAIR), cadr U);
+
+syslsp macro procedure MkVEC U;
+ MakeItemConstructor('(wconst VECT), cadr U);
+
+syslsp macro procedure MkEVECT U;
+ MakeItemConstructor('(wconst EVECT), cadr U);
+
+syslsp macro procedure MkWRDS U;
+ MakeItemConstructor('(wconst WRDS), cadr U);
+
+syslsp macro procedure MkSTR U;
+ MakeItemConstructor('(wconst STR), cadr U);
+
+syslsp macro procedure MkBYTES U;
+ MakeItemConstructor('(wconst BYTES), cadr U);
+
+syslsp macro procedure MkHalfWords U;
+ MakeItemConstructor('(wconst HalfWords), cadr U);
+
+syslsp macro procedure MkCODE U;
+ MakeItemConstructor('(wconst CODE), cadr U);
+
+% Access to tag (type indicator) of Lisp item in ordinary code
+
+syslsp macro procedure Tag U;
+ list('Field, cadr U, '(wconst TagStartingBit), '(wconst TagBitLength));
+
+
+% Access to info field of item (pointer or immediate operand)
+
+syslsp macro procedure Inf U;
+ list('Field, cadr U, '(wconst InfStartingBit), '(wconst InfBitLength));
+
+syslsp macro procedure PutInf U;
+ list('PutField, cadr U, '(wconst InfStartingBit),
+ '(wconst InfBitLength), caddr U);
+
+for each X in '(IDInf StrInf VecInf EvecInf PairInf WrdInf HalfWordInf CodeInf
+ FixInf FltInf BigInf) do
+ PutD(X, 'Macro, cdr getd 'Inf);
+
+for each X in '(PutIDInf PutStrInf PutVecInf PutPairInf PutWrdInf
+ PutHalfWordInf PutEvecInf
+ PutFixInf PutFltInf PutBigInf) do
+ PutD(X, 'Macro, cdr getd 'PutInf);
+
+% IntInf is no longer needed, will be a macro no-op
+% for the time being
+
+RemProp('IntInf, 'OpenFn);
+
+macro procedure IntInf U;
+ cadr U;
+
+% Similarly for MkINT
+
+macro procedure MkINT U;
+ cadr U;
+
+% # of words in a pair
+
+syslsp macro procedure PairPack U;
+ 2;
+
+% length (in characters, words, etc.) of a string, vector, or whatever,
+% stored in the first word pointed to
+
+syslsp macro procedure GetLen U;
+ list('SignedField, list('GetMem, cadr U), '(WConst InfStartingBit),
+ '(WConst InfBitLength));
+
+syslsp macro procedure StrBase U; % point to chars of string
+ list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem));
+
+% chars string length --> words string length
+
+% Don't add 1 in this! (Put change in at some reasonable time.)
+% Actually need space for extra null, but magic constant to add
+% to determine number of words needed is CharsPerWord-1, so all
+% cancels out. /csp 2-28-83
+syslsp macro procedure StrPack U;
+ list('WQuotient, list('WPlus2, cadr U,
+ list('WPlus2, '(WConst CharactersPerWord),
+ 1)),
+ '(WConst CharactersPerWord));
+
+% access to bytes of string; skip first word
+
+syslsp macro procedure StrByt U;
+ list('Byte, list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem)),
+ caddr U);
+
+syslsp macro procedure PutStrByt U;
+ list('PutByte, list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem)),
+ caddr U,
+ cadddr U);
+
+% access to halfword entries; skip first word
+
+syslsp macro procedure HalfWordItm U;
+ list('HalfWord, list('WPlus2, cadr U,
+ '(WConst AddressingUnitsPerItem)),
+ caddr U);
+
+syslsp macro procedure PutHalfWordItm U;
+ list('PutHalfWord, list('WPlus2, cadr U,
+ '(WConst AddressingUnitsPerItem)),
+ caddr U,
+ cadddr U);
+
+% halfword length --> words length
+
+% Should add 1 before shift! /csp 2-28-83
+syslsp macro procedure HalfWordPack U;
+ list('WPlus2, list('WShift, cadr U, -1), 1);
+
+
+% length (in Item size quantities) of Lisp vectors
+
+% size of Lisp vector in words
+
+% Adding 1 not needed for GtVect! /csp 2-28-83
+syslsp macro procedure VectPack U;
+ list('WPlus2, cadr U, 1);
+
+% size of Lisp Evector in words
+% See comment above! /csp
+syslsp macro procedure EVectPack U;
+ list('WPlus2, cadr U, 1);
+
+% access to elements of Lisp vector
+
+syslsp macro procedure VecItm U;
+ list('WGetV, cadr U,
+ list('WPlus2, caddr U, 1));
+
+syslsp macro procedure PutVecItm U;
+ list('WPutV, cadr U,
+ list('WPlus2, caddr U, 1),
+ cadddr U);
+
+% access to elements of Lisp Evector
+
+syslsp macro procedure EVecItm U;
+ list('WGetV, cadr U,
+ list('WPlus2, caddr U, 1));
+
+syslsp macro procedure PutEVecItm U;
+ list('WPutV, cadr U,
+ list('WPlus2, caddr U, 1),
+ cadddr U);
+
+
+% Wrd is like Vect, but not traced by the garbage collector
+
+% See comment for VectPack, above! /csp 2-28-83
+syslsp macro procedure WrdPack U;
+ list('WPlus2, cadr U, 1);
+
+for each X in '(StrLen ByteLen VecLen EVecLen WrdLen HalfWordLen) do
+ PutD(X, 'Macro, cdr getd 'GetLen);
+
+PutD('WrdItm, 'Macro, cdr GetD 'VecItm);
+
+PutD('PutWrdItm, 'Macro, cdr GetD 'PutVecItm);
+
+% So what about FixPack and FloatPack, turkeys? /csp 2-28-83
+
+syslsp macro procedure FixVal U;
+ list('WGetV, cadr U, 1);
+
+syslsp macro procedure PutFixVal U;
+ list('WPutV, cadr U, 1, caddr U);
+
+
+syslsp macro procedure FloatBase U;
+ list('WPlus2, cadr U, '(WConst AddressingUnitsPerItem));
+
+syslsp macro procedure FloatHighOrder U;
+ list('WGetV, cadr U, 1);
+
+syslsp macro procedure FloatLowOrder U;
+ list('WGetV, cadr U, 2);
+
+
+% New addition: A code pointer can have the number of arguments it expects
+% stored in the word just before the entry
+syslsp macro procedure !%code!-number!-of!-arguments U;
+ list('WGetV, cadr U, -1);
+
+% The four basic cells for each symbol: Val, Nam, Fnc, Prp, corresponding to
+% variable value, symbol name (as string), function cell (jump to compiled
+% code or lambda linker) and property list (pairs for PUT, GET, atoms for FLAG,
+% FLAGP). These are currently 4 separate arrays, but this representation may
+% be changed to a contiguous 4 element record for each symbol or something else
+% and therefore should not be accessed as arrays.
+
+syslsp macro procedure SymVal U;
+ list('WGetV, '(WConst SymVal), cadr U);
+
+syslsp macro procedure PutSymVal U;
+ list('WPutV, '(WConst SymVal), cadr U, caddr U);
+
+syslsp macro procedure LispVar U; % Access value cell by name
+ list('(WConst SymVal), list('IDLoc, cadr U));
+
+syslsp macro procedure PutLispVar U;
+ list('PutSymVal, list('IDLoc, cadr U), caddr U);
+
+syslsp macro procedure SymNam U;
+ list('WGetV, '(WConst SymNam), cadr U);
+
+syslsp macro procedure PutSymNam U;
+ list('WPutV, '(WConst SymNam), cadr U, caddr U);
+
+% Retrieve the address stored in the function cell
+
+% SymFnc and PutSymFnc are not defined portably
+
+syslsp macro procedure SymPrp U;
+ list('WGetV, '(WConst SymPrp), cadr U);
+
+syslsp macro procedure PutSymPrp U;
+ list('WPutV, '(WConst SymPrp), cadr U, caddr U);
+
+
+
+% Binding stack primitives
+
+syslsp macro procedure BndStkID U;
+ list('WGetV, cadr U, -1);
+
+syslsp macro procedure PutBndStkID U;
+ list('WPutV, cadr U, -1, caddr U);
+
+syslsp macro procedure BndStkVal U;
+ list('GetMem, cadr U);
+
+syslsp macro procedure PutBndStkVal U;
+ list('PutMem, cadr U, caddr U);
+
+syslsp macro procedure AdjustBndStkPtr U;
+ list('WPlus2, cadr U,
+ list('WTimes2, caddr U,
+ list('WTimes2,
+ '(WConst AddressingUnitsPerItem),
+ 2)));
+
+% ObArray is a linearly allocated hash table containing ID numbers of entries
+% maintained as a circular buffer. It is referenced only via these macros
+% because we may decide to change to some other representation.
+
+syslsp smacro procedure ObArray I;
+ HalfWord(HashTable, I);
+
+syslsp smacro procedure PutObArray(I, X);
+ HalfWord(HashTable, I) := X;
+
+put('ObArray, 'Assign!-Op, 'PutObArray);
+
+syslsp smacro procedure OccupiedSlot U;
+ ObArray U > 0;
+
+DefList('((GetMem PutMem)
+ (Field PutField)
+ (Byte PutByte)
+ (HalfWord PutHalfWord)
+ (Tag PutTag)
+ (Inf PutInf)
+ (IDInf PutIDInf)
+ (StrInf PutStrInf)
+ (VecInf PutVecInf)
+ (EVecInf PutEVecInf)
+ (WrdInf PutWrdInf)
+ (PairInf PutPairInf)
+ (FixInf PutFixInf)
+ (FixVal PutFixVal)
+ (FltInf PutFltInf)
+ (BigInf PutBigInf)
+ (StrLen PutStrLen)
+ (StrByt PutStrByt)
+ (VecLen PutVecLen)
+ (EVecLen PutEvecLen)
+ (VecItm PutVecItm)
+ (EVecItm PutEVecItm)
+ (WrdLen PutWrdLen)
+ (WrdItm PutWrdItm)
+ (SymVal PutSymVal)
+ (LispVar PutLispVar)
+ (SymNam PutSymNam)
+ (SymFnc PutSymFnc)
+ (SymPrp PutSymPrp)
+ (BndStkID PutBndStkID)
+ (BndStkVal PutBndStkVal)), 'Assign!-Op);
+
+% This is redefined for the HP 9836 to cure the high-order FF problem
+
+macro procedure !%chipmunk!-kludge x;
+ cadr x;
+
+END;
ADDED psl-1983/3-1/comp/faslout.build
Index: psl-1983/3-1/comp/faslout.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/faslout.build
@@ -0,0 +1,12 @@
+CompileTime load If!-system, Syslisp;
+CompileTime if_system(PDP10, <<
+load Monsym;
+in "p20:system-faslout.red"$
+>>)$
+CompileTime if_system(Unix, <<
+in "../kernel/vax/system-faslout.red"$
+>>)$
+CompileTime if_system(HP9836, <<
+in "php:system-faslout.red"$
+>>)$
+in "faslout.red"$
ADDED psl-1983/3-1/comp/faslout.red
Index: psl-1983/3-1/comp/faslout.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/faslout.red
@@ -0,0 +1,320 @@
+%
+% FASLOUT.RED - Top level of fasl file writer
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 16 February 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.COMP>FASLOUT.RED.8, 19-Apr-83 07:54:22, Edit by KESSLER
+% Flat Faslabort as Ignore, so you need not type compiletime faslabort.
+% <PSL.COMP>FASLOUT.RED.7, 28-Mar-83 07:49:53, Edit by KESSLER
+% Added FaslAbort Command to Terminate Faslout Gracefully.
+% <PSL.COMP>FASLOUT.RED.6, 16-Dec-82 12:49:59, Edit by KESSLER
+% Take out Semic!* as a fluid. Not used by anyone that I can see
+% and is already a global in RLISP.
+% <PSL.COMP>FASLOUT.RED.35, 10-Jun-82 10:41:18, Edit by GRISS
+% Made CompileUncompiledExpressions regular func
+% <PSL.COMP>FASLOUT.RED.12, 30-Apr-82 14:45:59, Edit by BENSON
+% Removed EVAL and IGNORE processing
+% <PSL.COMP>FASLOUT.RED.8, 29-Apr-82 06:23:18, Edit by GRISS
+% moved DEFINEROP call to RLISP-PARSER
+
+
+CompileTime <<
+ flag('(CodeFileHeader CodeFileTrailer AllocateFaslSpaces),
+ 'InternalFunction);
+ load Fast!-Vector;
+>>;
+
+fluid '(!*WritingFaslFile
+ !*Lower
+ !*quiet_faslout
+ DfPrint!*
+ UncompiledExpressions!*
+ ModuleName!*
+ CodeOut!*
+ InitOffset!*
+ CurrentOffset!*
+ FaslBlockEnd!*
+ MaxFaslOffset!*
+ BitTableOffset!*
+ FaslFilenameFormat!*);
+
+FaslFilenameFormat!* := "%w.b";
+
+lisp procedure DfPrintFasl U; %. Called by TOP-loop, DFPRINT!*
+begin scalar Nam, Ty, Fn, !*WritingFaslFile;
+ !*WritingFaslFile := T;
+ if atom U then return NIL;
+ Fn := car U;
+ IF FN = 'PUTD THEN GOTO DB2;
+ IF NOT (FN MEMQ '(DE DF DM DN)) THEN GOTO DB1;
+ NAM:=CADR U;
+ U:='LAMBDA . CDDR U;
+ TY:=CDR ASSOC(FN, '((DE . EXPR)
+ (DF . FEXPR)
+ (DM . MACRO)
+ (DN . NEXPR)));
+DB3: if Ty = 'MACRO then begin scalar !*Comp;
+ PutD(Nam, Ty, U); % Macros get defined now
+ end;
+ if FlagP(Nam, 'Lose) then <<
+ ErrorPrintF("*** %r has not been defined, because it is flagged LOSE",
+ Nam);
+ return NIL >>;
+ IF FLAGP(TY,'COMPILE) THEN
+ << PUT(NAM,'CFNTYPE,LIST TY);
+ U := LIST('!*ENTRY,NAM,TY,LENGTH CADR U)
+ . !&COMPROC(U, NAM);
+ LAP U >>
+ ELSE % should never happen
+ SaveUncompiledExpression LIST('PUTD, MKQUOTE NAM,
+ MKQUOTE TY,
+ MKQUOTE U);
+ if IGreaterP(Posn(), 0) then WriteChar char BLANK;
+ Prin1 NAM;
+ RETURN NIL;
+DB1: % Simple S-EXPRESSION, maybe EVAL it;
+ IF NOT PAIRP U THEN RETURN NIL;
+ if (Fn := get(car U, 'FaslPreEval)) then return Apply(Fn, list U)
+ else if (Fn := GetD car U) and car Fn = 'MACRO then
+ return DFPRINTFasl Apply(cdr Fn, list U);
+ SaveUncompiledExpression U;
+ RETURN NIL;
+DB2: NAM:=CADR U;
+ TY:=CADDR U;
+ FN:=CADDDR U;
+ IF EQCAR(NAM,'QUOTE) THEN << NAM:=CADR NAM;
+ IF EQCAR(TY,'QUOTE) THEN << TY:=CADR TY;
+ IF PAIRP FN AND CAR FN MEMBER '(FUNCTION QUOTE) THEN << FN:=CADR FN;
+ IF TY MEMQ '(EXPR FEXPR MACRO NEXPR) THEN
+ << U:=FN; GOTO DB3 >> >> >> >>;
+ GOTO DB1;
+ END;
+
+FLAG ('(DEFLIST FLAG FLUID GLOBAL REMFLAG REMPROP UNFLUID),'EVAL);
+
+lisp procedure FaslPreEvalLoadTime U;
+ DFPrintFasl cadr U; % remove LOADTIME
+
+put('LoadTime, 'FaslPreEval, 'FaslPreEvalLoadTime);
+put('BothTimes, 'FaslPreEval, 'FaslPreEvalLoadTime);
+put('StartupTime, 'FaslPreEval, 'FaslPreEvalLoadTime); % used in kernel
+
+% A few things to save space when loading
+
+put('Flag,
+ 'FaslPreEval,
+ function lambda U;
+ if EqCar(second U, 'QUOTE) then
+ DFPrintFasl('progn . for each X in second second U collect
+ list('Flag1, MkQuote X, third U))
+ else SaveUncompiledExpression U);
+
+put('fluid,
+ 'FaslPreEval,
+ function lambda U;
+ if EqCar(second U, 'QUOTE) then
+ DFPrintFasl('progn . for each X in second second U collect
+ list('Fluid1, MkQuote X))
+ else SaveUncompiledExpression U);
+
+put('global,
+ 'FaslPreEval,
+ function lambda U;
+ if EqCar(second U, 'QUOTE) then
+ DFPrintFasl('progn . for each X in second second U collect
+ list('Global1, MkQuote X))
+ else SaveUncompiledExpression U);
+
+put('DefList,
+ 'FaslPreEval,
+ function lambda U;
+ if EqCar(second U, 'QUOTE) then
+ DFPrintFasl('progn . for each X in second second U collect
+ list('put, MkQuote first X,
+ third U,
+ MkQuote second X))
+ else SaveUncompiledExpression U);
+
+put('ProgN,
+ 'FaslPreEval,
+ function lambda U;
+ for each X in cdr U do
+ DFPrintFasl X);
+
+put('LAP,
+ 'FaslPreEval,
+ function lambda U;
+ if EqCar(cadr U, 'QUOTE) then Lap cadr cadr U
+ else SaveUncompiledExpression U);
+
+UncompiledExpressions!* := NIL . NIL;
+
+lisp procedure SaveUncompiledExpression U;
+<< if atom U then NIL
+ else TConc(UncompiledExpressions!*, U);
+ NIL >>;
+
+lisp procedure FaslOut FIL;
+<< ModuleName!* := FIL;
+ if not !*quiet_faslout then
+ << if not FUnBoundP 'Begin1 then
+ << Prin2T "FASLOUT: IN files; or type in expressions";
+ Prin2T "When all done execute FASLEND;" >>
+ else
+ << Prin2T "FASLOUT: (DSKIN files) or type in expressions";
+ Prin2T "When all done execute (FASLEND)" >> >>;
+ CodeOut!* := BinaryOpenWrite BldMsg(FaslFilenameFormat!*, ModuleName!*);
+ CodeFileHeader();
+ DFPRINT!* := 'DFPRINTFasl;
+ !*WritingFaslFile := T;
+ !*DEFN := T >>;
+
+lisp procedure FaslEnd;
+ if not !*WritingFaslFile then
+ StdError "FASLEND not within FASLOUT"
+ else
+ << CompileUncompiledExpressions();
+ UncompiledExpressions!* := NIL . NIL;
+ CodeFileTrailer();
+ BinaryClose CodeOut!*;
+ DFPRINT!* := NIL;
+ !*WritingFaslFile := NIL;
+ !*DEFN := NIL >>;
+
+FLAG('(FaslEND), 'IGNORE);
+
+% FaslAbort. Abort the Fasl process cleanly. The code file will be closed
+% and the various flags will be reset.
+lisp procedure FaslAbort;
+ if not !*WritingFaslFile then
+ StdError "FASLAbort not within FASLOUT"
+ else
+ << UncompiledExpressions!* := NIL . NIL;
+ BinaryClose CodeOut!*;
+ DFPRINT!* := NIL;
+ !*WritingFaslFile := NIL;
+ !*DEFN := NIL >>;
+
+Flag('(FaslAbort), 'Ignore);
+
+lisp procedure ComFile Filename;
+begin scalar !*Defn, !*WritingFaslFile, TestFile, FileBase, FileExt,
+ I, N, DotFound, TestExts, !*quiet_faslout;
+ if IDP Filename then
+ (lambda (!*Lower); Filename := BldMsg("%w", Filename))(T);
+ if not StringP Filename then return
+ NonStringError(Filename, 'ComFile);
+ N := ISizeS Filename;
+ I := 0;
+ while not DotFound and ILEQ(I, N) do
+ << if IGetS(Filename, I) = char '!. then DotFound := T;
+ I := IAdd1 I >>;
+ if DotFound then
+ << if not FileP Filename then return ContError(99, "Couldn't find file",
+ ComFile Filename)
+ else
+ << FileBase := SubSeq(Filename, 0, I);
+ FileExt := SubSeq(Filename, ISub1 I, IAdd1 N) >> >>
+ else
+ << TestExts := '(".build" ".sl" ".red");
+ while not null TestExts
+ and not FileP(TestFile := Concat(Filename, first TestExts)) do
+ TestExts := rest TestExts;
+ if null TestExts then return ContError(99,
+ "Couldn't find file",
+ ComFile Filename)
+ else
+ << FileExt := first TestExts;
+ FileBase := Filename;
+ Filename := TestFile >> >>;
+ ErrorPrintF("*** Compiling %w", Filename);
+ !*quiet_faslout := T;
+ Faslout FileBase;
+ if FileExt member '(".build" ".red") then
+ EvIn list Filename
+ else DskIn Filename;
+ Faslend;
+ return T;
+end;
+
+lisp procedure CompileUncompiledExpressions();
+<< ErrorPrintF("*** Init code length is %w",
+ length car UncompiledExpressions!*);
+ DFPRINTFasl list('DE, '!*!*Fasl!*!*InitCode!*!*, '(),
+ 'PROGN . car UncompiledExpressions!*) >>;
+
+lisp procedure CodeFileHeader();
+<< BinaryWrite(CodeOut!*, const FASL_MAGIC_NUMBER);
+ AllocateFaslSpaces() >>;
+
+fluid '(CodeBase!* BitTableBase!* OrderedIDList!* NextIDNumber!*);
+
+lisp procedure FindIDNumber U;
+begin scalar I;
+ return if ILEQ(I := IDInf U, 128) then I
+ else if (I := get(U, 'IDNumber)) then I
+ else
+ << put(U, 'IDNumber, I := NextIDNumber!*);
+ OrderedIDList!* := TConc(OrderedIDList!*, U);
+ NextIDNumber!* := IAdd1 NextIDNumber!*;
+ I >>;
+end;
+
+lisp procedure CodeFileTrailer();
+begin scalar S;
+ SystemFaslFixup();
+ BinaryWrite(CodeOut!*, IDifference(ISub1 NextIDNumber!*, 2048));
+ % Number of local IDs
+ for each X in car OrderedIDList!* do
+ << RemProp(X, 'IDNumber);
+ X := StrInf ID2String X;
+ S := StrLen X;
+ BinaryWriteBlock(CodeOut!*, X, IAdd1 StrPack S) >>;
+ BinaryWrite(CodeOut!*, % S is size in words
+ S := IQuotient(IPlus2(CurrentOffset!*,
+ ISub1 const AddressingUnitsPerItem),
+ const AddressingUnitsPerItem));
+ BinaryWrite(CodeOut!*, InitOffset!*);
+ BinaryWriteBlock(CodeOut!*, CodeBase!*, S);
+ BinaryWrite(CodeOut!*, S := IQuotient(IPlus2(BitTableOffset!*,
+ ISub1 const BitTableEntriesPerWord),
+ const BitTableEntriesPerWord));
+ BinaryWriteBlock(CodeOut!*, BitTableBase!*, S);
+ DelWArray(BitTableBase!*, FaslBlockEnd!*);
+end;
+
+lisp procedure UpdateBitTable(NumberOfEntries, FirstEntry);
+if !*WritingFaslFile then
+<< PutBitTable(BitTableBase!*, BitTableOffset!*, FirstEntry);
+ BitTableOffset!* := IAdd1 BitTableOffset!*;
+ for I := 2 step 1 until NumberOfEntries do
+ << PutBitTable(BitTableBase!*, BitTableOffset!*, 0);
+ BitTableOffset!* := IAdd1 BitTableOffset!* >>;
+ if IGreaterP(BitTableOffset!*, MaxFaslOffset!*) then
+ FatalError "BPS exhausted during FaslOut; output file too large" >>;
+
+lisp procedure AllocateFaslSpaces();
+begin scalar B;
+ B := GTWarray NIL; % how much is left?
+ B := IDifference(B, IQuotient(B, 3));
+ FaslBlockEnd!* := GTWArray 0; % pointer to top of space
+ BitTableBase!* := GTWarray B; % take 2/3 of whatever's left
+ CurrentOffset!* := 0;
+ BitTableOffset!* := 0;
+ CodeBase!*
+ := Loc WGetV(BitTableBase!*, % split the space between
+ IQuotient(B, % bit table and code
+ IQuotient(const BitTableEntriesPerWord,
+ const AddressingUnitsPerItem)));
+ MaxFaslOffset!* := IDifference(FaslBlockEnd!*, CodeBase!*);
+ OrderedIDList!* := NIL . NIL;
+ NextIDNumber!* := 2048; % local IDs start at 2048
+end;
+
+END;
ADDED psl-1983/3-1/comp/lap-to-asm.build
Index: psl-1983/3-1/comp/lap-to-asm.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/lap-to-asm.build
@@ -0,0 +1,1 @@
+in "lap-to-asm.red"$
ADDED psl-1983/3-1/comp/lap-to-asm.red
Index: psl-1983/3-1/comp/lap-to-asm.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/lap-to-asm.red
@@ -0,0 +1,1163 @@
+%
+% LAP-TO-ASM.RED - LAP to assembler translator
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 13 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 01-Mar-83 Nancy Kendzierski
+% Changed EVIN to PathIn in ASMOUT to enable search paths to be
+% used when doing system builds connected to a directory other
+% than pxx:, where xx=machine (hp, 20, vax, etc.)
+% Only set InputSymFile!*, OutputSymFile!*, GlobalDataFileName!*,
+% and InitFileNameFormat!* if they aren't already initialized.
+% Changed SEMIC!* declaration from global to fluid.
+% <PSL.COMP>LAP-TO-ASM.RED.5, 30-Apr-82 14:47:52, Edit by BENSON
+% Removed EVAL and IGNORE processing
+
+Imports '(PathIn);
+
+fluid '(Semic!*
+ !*Comp
+ !*PLap
+ DfPrint!*
+ CharactersPerWord
+ AddressingUnitsPerItem
+ AddressingUnitsPerFunctionCell
+ InputSymFile!*
+ OutputSymFile!*
+ CodeOut!*
+ DataOut!*
+ InitOut!*;
+ CodeFileNameFormat!*
+ DataFileNameFormat!*
+ InitFileNameFormat!*
+ ModuleName!*
+ UncompiledExpressions!*
+ NextIDNumber!*
+ OrderedIDList!*
+ NilNumber!*
+ !*MainFound
+ !*MAIN
+ !*DeclareBeforeUse
+ MainEntryPointName!*
+ EntryPoints!*
+ LocalLabels!*
+ CodeExternals!*
+ CodeExporteds!*
+ DataExternals!*
+ DataExporteds!*
+ ExternalDeclarationFormat!*
+ ExportedDeclarationFormat!*
+ LabelFormat!*
+ FullWordFormat!*
+ DoubleFloatFormat!*
+ ReserveDataBlockFormat!*
+ ReserveZeroBlockFormat!*
+ UndefinedFunctionCellInstructions!*
+ DefinedFunctionCellFormat!*
+ PrintExpressionForm!*
+ PrintExpressionFormPointer!*
+ CommentFormat!*
+ NumericRegisterNames!*
+ ExpressionCount!*
+ ASMOpenParen!*
+ ASMCloseParen!*
+ ToBeCompiledExpressions!*
+ GlobalDataFileName!*
+);
+
+% Default values; set up if not already initialized.
+if null InputSymFile!* then InputSymFile!* := "psl.sym";
+if null OutputSymFile!* then OutputSymFile!* := "psl.sym";
+if null GlobalDataFileName!* then GlobalDataFileName!* := "global-data.red";
+if null InitFileNameFormat!* then InitFileNameFormat!* := "%w.init";
+
+lisp procedure DfPrintASM U; %. Called by TOP-loop, DFPRINT!*
+begin scalar Nam, Ty, Fn;
+ if atom U then return NIL;
+ Fn := car U;
+ IF FN = 'PUTD THEN GOTO DB2;
+ IF NOT (FN MEMQ '(DE DF DM DN)) THEN GOTO DB1;
+ NAM:=CADR U;
+ U:='LAMBDA . CDDR U;
+ TY:=CDR ASSOC(FN, '((DE . EXPR)
+ (DF . FEXPR)
+ (DM . MACRO)
+ (DN . NEXPR)));
+DB3: if Ty = 'MACRO then begin scalar !*Comp;
+ PutD(Nam, Ty, U); % Macros get defined now
+ end;
+ if FlagP(Nam, 'Lose) then <<
+ ErrorPrintF("*** %r has not been defined, because it is flagged LOSE",
+ Nam);
+ return NIL >>;
+ IF FLAGP(TY,'COMPILE) THEN
+ << PUT(NAM,'CFNTYPE,LIST TY);
+ U := LIST('!*ENTRY,NAM,TY,LENGTH CADR U)
+ . !&COMPROC(U, NAM);
+ if !*PLAP then for each X in U do Print X;
+ if TY neq 'EXPR then
+ DfPrintASM list('put, MkQuote Nam, '(quote TYPE), MkQuote TY);
+ ASMOUTLAP U >>
+ ELSE % should never happen
+ SaveUncompiledExpression LIST('PUTD, MKQUOTE NAM,
+ MKQUOTE TY,
+ MKQUOTE U);
+ RETURN NIL;
+DB1: % Simple S-EXPRESSION, maybe EVAL it;
+ IF NOT PAIRP U THEN RETURN NIL;
+ if (Fn := get(car U, 'ASMPreEval)) then return Apply(Fn, list U)
+ else if (Fn := GetD car U) and car Fn = 'MACRO then
+ return DFPRINTASM Apply(cdr Fn, list U);
+ SaveUncompiledExpression U;
+ RETURN NIL;
+DB2: NAM:=CADR U;
+ TY:=CADDR U;
+ FN:=CADDDR U;
+ IF EQCAR(NAM,'QUOTE) THEN << NAM:=CADR NAM;
+ IF EQCAR(TY,'QUOTE) THEN << TY:=CADR TY;
+ IF PAIRP FN AND CAR FN MEMBER '(FUNCTION QUOTE) THEN << FN:=CADR FN;
+ IF TY MEMQ '(EXPR FEXPR MACRO NEXPR) THEN
+ << U:=FN; GOTO DB3 >> >> >> >>;
+ GOTO DB1;
+ END;
+
+lisp procedure ASMPreEvalLoadTime U;
+ DFPrintASM cadr U; % remove LOADTIME
+
+put('LoadTime, 'ASMPreEval, 'ASMPreEvalLoadTime);
+
+lisp procedure ASMPreEvalStartupTime U;
+ SaveForCompilation cadr U;
+
+put('StartupTime, 'ASMPreEval, 'ASMPreEvalStartupTime);
+
+lisp procedure ASMPreEvalProgN U;
+ for each X in cdr U do
+ DFPrintASM X;
+
+put('ProgN, 'ASMPreEval, 'ASMPreEvalProgN);
+
+put('WDeclare, 'ASMPreEval, 'Eval); % do it now
+
+lisp procedure ASMPreEvalSetQ U;
+begin scalar X, Val;
+ X := cadr U;
+ Val := caddr U;
+ return if ConstantP Val or Val = T then
+ << FindIDNumber X;
+ put(X, 'InitialValue, Val);
+ NIL >>
+ else if null Val then
+ << FindIDNumber X;
+ RemProp(X, 'InitialValue);
+ Flag(list X, 'NilInitialValue);
+ NIL >>
+ else if EqCar(Val, 'QUOTE) then
+ << FindIDNumber X;
+ Val := cadr Val;
+ if null Val then
+ << RemProp(X, 'InitialValue);
+ Flag(list X, 'NilInitialValue) >>
+ else
+ put(X, 'InitialValue, Val);
+ NIL >>
+ else if IDP Val and get(Val, 'InitialValue)
+ or FlagP(Val, 'NilInitialValue) then
+ << if (Val := get(Val, 'InitialValue)) then
+ put(X, 'InitialValue, Val)
+ else Flag(list X, 'NilInitialValue) >>
+ else SaveUncompiledExpression U; % just check simple cases, else return
+end;
+
+put('SetQ, 'ASMPreEval, 'ASMPreEvalSetQ);
+
+lisp procedure ASMPreEvalPutD U;
+ SaveUncompiledExpression CheckForEasySharedEntryPoints U;
+
+lisp procedure CheckForEasySharedEntryPoints U;
+%
+% looking for (PUTD (QUOTE name1) xxxx (CDR (GETD (QUOTE name2))))
+%
+begin scalar NU, Nam, Exp;
+ NU := cdr U;
+ Nam := car NU;
+ if car Nam = 'QUOTE then Nam := cadr Nam else return U;
+ NU := cdr NU;
+ Exp := cadr NU;
+ if not (car Exp = 'CDR) then return U;
+ Exp := cadr Exp;
+ if not (car Exp = 'GETD) then return U;
+ Exp := cadr Exp;
+ if not (car Exp = 'QUOTE) then return U;
+ Exp := cadr Exp;
+ FindIDNumber Nam;
+ put(Nam, 'EntryPoint, FindEntryPoint Exp);
+ if not (car NU = '(QUOTE EXPR)) then return list('Put, '(Quote Type),
+ car NU);
+ return NIL;
+end;
+
+put('PutD, 'ASMPreEval, 'ASMPreEvalPutD);
+
+lisp procedure ASMPreEvalFluidAndGlobal U;
+<< if EqCar(cadr U, 'QUOTE) then Flag(cadr cadr U, 'NilInitialValue);
+ SaveUncompiledExpression U >>;
+
+put('Fluid, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+put('Global, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+
+CommentOutCode <<
+fluid '(NewFluids!* NewGlobals!*);
+
+lisp procedure ASMPreEvalFluidAndGlobal U;
+begin scalar L;
+ L := cadr U;
+ return if car L = 'QUOTE then
+ << L := cadr L;
+ if car U = 'FLUID then
+ NewFluids!* := UnionQ(NewFluids!*, L) % take union
+ else NewGlobals!* := UnionQ(NewGlobals!*, L);
+ Flag(L, 'NilInitialValue);
+ NIL >>
+ else SaveUncompiledExpression U;
+end;
+
+put('Fluid, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+put('Global, 'ASMPreEval, 'ASMPreEvalFluidAndGlobal);
+>>;
+
+lisp procedure ASMPreEvalLAP U;
+ if EqCar(cadr U, 'QUOTE) then ASMOutLap cadr cadr U
+ else SaveUncompiledExpression U;
+
+put('LAP, 'ASMPreEval, 'ASMPreEvalLAP);
+
+CommentOutCode <<
+lisp procedure InitialPut(Nam, Ind, Val);
+begin scalar L, P;
+ FindIDNumber Nam;
+ if (P := Atsoc(Ind, L := get(Nam, 'InitialPropertyList))) then
+ Rplacd(P, Val)
+ else put(Nam, 'InitialPropertyList, (Ind . Val) . L);
+end;
+
+lisp procedure InitialRemprop(Nam, Ind);
+begin scalar L;
+ if (L := get(Nam, 'InitialPropertyList)) then
+ put(Nam, 'InitialPropertyList, DelAtQIP(Ind, L));
+end;
+
+lisp procedure InitialFlag1(Nam, Ind);
+begin scalar L, P;
+ FindIDNumber Nam;
+ if not Ind memq (L := get(Nam, 'InitialPropertyList)) then
+ put(Nam, 'InitialPropertyList, Ind . L);
+end;
+
+lisp procedure InitialRemFlag1(Nam, Ind);
+begin scalar L;
+ if (L := get(Nam, 'InitialPropertyList)) then
+ put(Nam, 'InitialPropertyList, DelQIP(Ind, L));
+end;
+
+lisp procedure ASMPreEvalPut U;
+begin scalar Nam, Ind, Val;
+ Nam := second U;
+ Ind := third U;
+ Val := fourth U;
+ if EqCar(Nam, 'QUOTE) and EqCar(Ind, 'QUOTE) and
+ (ConstantP Val or Val = T or EqCar(Val, 'QUOTE)) then
+ InitialPut(second Nam, second Ind, if EqCar(Val, 'QUOTE) then
+ second Val else Val)
+ else SaveUncompiledExpression U;
+end;
+
+put('put, 'ASMPreEval, 'ASMPreEvalPut);
+
+lisp procedure ASMPreEvalRemProp U;
+begin scalar Nam, Ind;
+ Nam := second U;
+ Ind := third U;
+ if EqCar(Nam, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ InitialRemProp(second Nam, second Ind)
+ else SaveUncompiledExpression U;
+end;
+
+put('RemProp, 'ASMPreEval, 'ASMPreEvalRemProp);
+
+lisp procedure ASMPreEvalDefList U;
+begin scalar DList, Ind;
+ DList := second U;
+ Ind := third U;
+ if EqCar(DList, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ << DList := second DList;
+ Ind := second Ind;
+ for each X in Dlist do InitialPut(first X, Ind, second X) >>
+ else SaveUncompiledExpression U;
+end;
+
+put('DefList, 'ASMPreEval, 'ASMPreEvalDefList);
+
+lisp procedure ASMPreEvalFlag U;
+begin scalar NameList, Ind;
+ NameList := second U;
+ Ind := third U;
+ if EqCar(NameList, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ << Ind := second Ind;
+ for each X in second NameList do
+ InitialFlag1(X, Ind) >>
+ else SaveUncompiledExpression U;
+end;
+
+put('flag, 'ASMPreEval, 'ASMPreEvalFlag);
+
+lisp procedure ASMPreEvalRemFlag U;
+begin scalar NameList, Ind;
+ NameList := second U;
+ Ind := third U;
+ if EqCar(NameList, 'QUOTE) and EqCar(Ind, 'QUOTE) then
+ << Ind := second Ind;
+ for each X in second NameList do
+ InitialRemFlag1(X, Ind) >>
+ else SaveUncompiledExpression U;
+end;
+
+put('RemFlag, 'ASMPreEval, 'ASMPreEvalRemFlag);
+
+lisp procedure ASMPreEvalGlobal U;
+begin scalar NameList;
+ NameList := second U;
+ if EqCar(NameList, 'QUOTE) then
+ for each X in second NameList do
+ InitialPut(X, 'TYPE, 'Global)
+ else SaveUncompiledExpression U;
+end;
+
+put('Global, 'ASMPreEval, 'ASMPreEvalGlobal);
+
+lisp procedure ASMPreEvalFluid U;
+begin scalar NameList;
+ NameList := second U;
+ if EqCar(NameList, 'QUOTE) then
+ for each X in second NameList do
+ InitialPut(X, 'TYPE, 'FLUID)
+ else SaveUncompiledExpression U;
+end;
+
+put('Fluid, 'ASMPreEval, 'ASMPreEvalFluid);
+
+lisp procedure ASMPreEvalUnFluid U;
+begin scalar NameList;
+ NameList := second U;
+ if EqCar(NameList, 'QUOTE) then
+ for each X in second NameList do
+ InitialRemProp(X, 'TYPE)
+ else SaveUncompiledExpression U;
+end;
+
+put('UnFluid, 'ASMPreEval, 'ASMPreEvalUnFluid);
+>>;
+
+lisp procedure SaveUncompiledExpression U;
+ if PairP U then
+ begin scalar OldOut;
+ OldOut := WRS InitOut!*;
+ Print U;
+ WRS OldOut;
+ end;
+
+ToBeCompiledExpressions!* := NIL . NIL;
+
+lisp procedure SaveForCompilation U;
+ if atom U or U member car ToBeCompiledExpressions!* then NIL
+ else if car U = 'progn then
+ for each X in cdr U do SaveForCompilation X
+ else TConc(ToBeCompiledExpressions!*, U);
+
+SYMBOLIC PROCEDURE ASMOUT FIL;
+begin scalar OldOut;
+ ModuleName!* := FIL;
+ Prin2T "ASMOUT: IN files; or type in expressions";
+ Prin2T "When all done execute ASMEND;";
+ CodeOut!* := Open(BldMsg(CodeFileNameFormat!*, ModuleName!*), 'OUTPUT);
+ OldOut := WRS CodeOut!*;
+ LineLength 1000;
+ WRS OldOut;
+ CodeFileHeader();
+ DataOut!* := Open(BldMsg(DataFileNameFormat!*, ModuleName!*), 'OUTPUT);
+ OldOut := WRS DataOut!*;
+ LineLength 1000;
+ WRS OldOut;
+ DataFileHeader();
+ InitOut!* := Open(BldMsg(InitFileNameFormat!*, ModuleName!*), 'OUTPUT);
+ ReadSYMFile();
+ DFPRINT!* := 'DFPRINTASM;
+ RemD 'OldLap;
+ PutD('OldLap, 'EXPR, cdr RemD 'Lap);
+ PutD('Lap, 'EXPR, cdr GetD 'ASMOutLap);
+ !*DEFN := T;
+ SEMIC!* := '!$ ; % to turn echo off for IN
+ if not ((ModuleName!* = "main")
+ or !*Main) then PathIn GlobalDataFileName!*
+ else !*Main := T;
+end;
+
+lisp procedure ASMEnd;
+<< off SysLisp;
+ if !*MainFound then
+ << CompileUncompiledExpressions();
+% WriteInitFile();
+ InitializeSymbolTable() >>
+ else WriteSymFile();
+ CodeFileTrailer();
+ Close CodeOut!*;
+ DataFileTrailer();
+ Close DataOut!*;
+ Close InitOut!*;
+ RemD 'Lap;
+ PutD('Lap, 'EXPR, cdr GetD 'OldLap);
+ DFPRINT!* := NIL;
+ !*DEFN := NIL >>;
+
+FLAG('(ASMEND), 'IGNORE);
+DEFINEROP('ASMEND,NIL,ESTAT('ASMEND));
+
+lisp procedure CompileUncompiledExpressions();
+<< CommentOutCode << AddFluidAndGlobalDecls(); >>;
+ DFPRINTASM list('DE, 'INITCODE, '(),
+ 'PROGN . car ToBeCompiledExpressions!*) >>;
+
+CommentOutCode <<
+lisp procedure AddFluidAndGlobalDecls();
+<< SaveUncompiledExpression list('GLOBAL, MkQuote NewGlobals!*);
+ SaveUncompiledExpression list('FLUID, MkQuote NewFluids!*) >>;
+>>;
+
+lisp procedure ReadSymFile();
+ LapIN InputSymFile!*;
+
+lisp procedure WriteSymFile();
+begin scalar NewOut, OldOut;
+ OldOut := WRS(NewOut := Open(OutputSymFile!*, 'OUTPUT));
+ print list('SaveForCompilation,
+ MkQuote('progn . car ToBeCompiledExpressions!*));
+ SaveIDList();
+ SetqPrint 'NextIDNumber!*;
+ SetqPrint 'StringGenSym!*;
+ MapObl function PutPrintEntryAndSym;
+ WRS OldOut;
+ Close NewOut;
+end;
+
+
+CommentOutCode <<
+lisp procedure WriteInitFile();
+begin scalar OldOut, NewOut;
+ NewOut := Open(InitFileName!*, 'OUTPUT);
+ OldOut := WRS NewOut;
+ for each X in car UncompiledExpressions!* do PrintInit X;
+ Close NewOut;
+ WRS OldOut;
+end;
+
+lisp procedure PrintInit X;
+ if EqCar(X, 'progn) then
+ for each Y in cdr X do PrintInit Y
+ else Print X;
+>>;
+
+lisp procedure SaveIDList();
+<< Print list('setq, 'OrderedIDList!*, MkQuote car OrderedIDList!*);
+ Print quote(OrderedIDList!* :=
+ OrderedIDList!* . LastPair OrderedIDList!*) >>;
+
+lisp procedure SetqPrint U;
+ print list('SETQ, U, MkQuote Eval U);
+
+lisp procedure PutPrint(X, Y, Z);
+ print list('PUT, MkQuote X, MkQuote Y, MkQuote Z);
+
+lisp procedure PutPrintEntryAndSym X;
+begin scalar Y;
+ if (Y := get(X, 'EntryPoint)) then PutPrint(X, 'EntryPoint, Y);
+ if (Y := get(X, 'IDNumber)) then
+ PutPrint(X, 'IDNumber, Y);
+CommentOutCode <<
+ if (Y := get(X, 'InitialPropertyList)) then
+ PutPrint(X, 'InitialPropertyList, Y);
+>>;
+ if (Y := get(X, 'InitialValue)) then
+ PutPrint(X, 'InitialValue, Y)
+ else if FlagP(X, 'NilInitialValue) then
+ print list('flag, MkQuote list X, '(quote NilInitialValue));
+ if get(X, 'SCOPE) = 'EXTERNAL then
+ << PutPrint(X, 'SCOPE, 'EXTERNAL);
+ PutPrint(X, 'ASMSymbol, get(X, 'ASMSymbol));
+ if get(X, 'WVar) then PutPrint(X, 'WVar, X)
+ else if get(X, 'WArray) then PutPrint(X, 'WArray, X)
+ else if get(X, 'WString) then PutPrint(X, 'WString, X)
+ else if (Y := get(X, 'WConst)) then PutPrint(X, 'WConst, Y) >>;
+end;
+
+lisp procedure FindIDNumber U;
+begin scalar I;
+ return if (I := ID2Int U) <= 128 then I
+ else if (I := get(U, 'IDNumber)) then I
+ else
+ << put(U, 'IDNumber, I := NextIDNumber!*);
+ OrderedIDList!* := TConc(OrderedIDList!*, U);
+ NextIDNumber!* := NextIDNumber!* + 1;
+ I >>;
+end;
+
+OrderedIDList!* := NIL . NIL;
+NextIDNumber!* := 129;
+
+lisp procedure InitializeSymbolTable();
+begin scalar MaxSymbol;
+ MaxSymbol := get('MaxSymbols, 'WConst);
+ if MaxSymbol < NextIDNumber!* then
+ << ErrorPrintF("*** MaxSymbols %r is too small; at least %r is needed",
+ MaxSymbol, NextIDNumber!*);
+ MaxSymbol := NextIDNumber!* + 100 >>;
+ Flag('(NIL), 'NilInitialValue);
+ put('T, 'InitialValue, 'T);
+ put('!$EOF!$, 'InitialValue, Int2ID get('EOF, 'CharConst));
+ put('!$EOL!$, 'InitialValue, '!
+);
+ NilNumber!* := CompileConstant NIL;
+ DataAlignFullWord();
+%/ This is a BUG? M.L. G.
+%/ for I := NextIDNumber!* step 1 until MaxSymbol do
+%/ DataPrintFullWord NilNumber!*;
+ InitializeSymVal();
+ DataReserveBlock((MaxSymbol - NextIDNumber!*) + 1);
+ InitializeSymPrp();
+ DataReserveBlock((MaxSymbol - NextIDNumber!*) + 1);
+%/ This is a BUG? M.L. G.
+%/ for I := NextIDNumber!* step 1 until MaxSymbol do
+%/ DataPrintFullWord NilNumber!*;
+ InitializeSymNam MaxSymbol;
+ InitializeSymFnc();
+ DataReserveFunctionCellBlock((MaxSymbol - NextIDNumber!*) + 1);
+ DataAlignFullWord();
+ DataPrintGlobalLabel FindGlobalLabel 'NextSymbol;
+ DataPrintFullWord NextIDNumber!*;
+end;
+
+lisp procedure InitializeSymPrp();
+<< CommentOutCode << InitializeHeap(); >>; % init prop lists
+ DataPrintGlobalLabel FindGlobalLabel 'SymPrp;
+ for I := 0 step 1 until 128 do
+ InitSymPrp1 Int2ID I;
+ for each X in car OrderedIDList!* do
+ InitSymPrp1 X >>;
+
+lisp procedure InitSymPrp1 X;
+<<
+CommentOutCode <<
+ DataPrintFullWord(if (X := get(X, 'InitialPropertyList)) then
+ X
+ else NilNumber!*);
+>>;
+ DataPrintFullWord NilNumber!* >>;
+
+CommentOutCode <<
+lisp procedure InitializeHeap();
+begin scalar L;
+ DataPrintGlobalLabel FindGlobalLabel 'Heap;
+ for I := 0 step 1 until 128 do
+ PrintPropertyList Int2ID I;
+ for each X in car OrderedIDList!* do
+ PrintPropertyList X;
+ L := get('HeapSize, 'WConst);
+end;
+>>;
+
+lisp procedure InitializeSymNam MaxSymbol;
+<< DataPrintGlobalLabel FindGlobalLabel 'SymNam;
+ for I := 0 step 1 until 128 do
+ DataPrintFullWord CompileConstant ID2String Int2ID I;
+ for each IDName in car OrderedIDList!* do
+ DataPrintFullWord CompileConstant ID2String IDName;
+ MaxSymbol := MaxSymbol - 1;
+ for I := NextIDNumber!* step 1 until MaxSymbol do
+ DataPrintFullWord(I + 1);
+ DataPrintFullWord 0 >>;
+
+lisp procedure InitializeSymVal();
+<< DataPrintGlobalLabel FindGlobalLabel 'SymVal;
+ for I := 0 step 1 until 128 do InitSymVal1 Int2ID I;
+ for each X in car OrderedIDList!* do InitSymVal1 X >>;
+
+lisp procedure InitSymVal1 X;
+begin scalar Val;
+ return DataPrintFullWord(if (Val := get(X, 'InitialValue)) then
+ CompileConstant Val
+ else if FlagP(X, 'NilInitialValue) then
+ NilNumber!*
+ else list('MkItem, get('Unbound, 'WConst),
+ FindIDNumber X));
+end;
+
+lisp procedure InitializeSymFnc();
+<< DataPrintGlobalLabel FindGlobalLabel 'SymFnc;
+ for I := 0 step 1 until 128 do InitSymFnc1 Int2ID I;
+ for each X in car OrderedIDList!* do InitSymFnc1 X >>;
+
+lisp procedure InitSymFnc1 X;
+begin scalar EP;
+ EP := get(X, 'EntryPoint);
+ if null EP then DataPrintUndefinedFunctionCell()
+ else DataPrintDefinedFunctionCell EP;
+end;
+
+lisp procedure ASMOutLap U;
+begin scalar LocalLabels!*, OldOut;
+ U := Pass1Lap U; % Expand cmacros, quoted expressions
+ CodeBlockHeader();
+ OldOut := WRS CodeOut!*;
+ for each X in U do ASMOutLap1 X;
+ WRS OldOut;
+ CodeBlockTrailer();
+end;
+
+lisp procedure ASMOutLap1 X;
+begin scalar Fn;
+ return if StringP X then PrintLabel X
+ else if atom X then PrintLabel FindLocalLabel X
+ else if (Fn := get(car X, 'ASMPseudoOp)) then Apply(Fn, list X)
+ else
+ % instruction output form is:
+ % "space" <opcode> [ "space" <operand> { "comma" <operand> } ] "newline"
+ << Prin2 '! ; % Space
+ PrintOpcode car X;
+ X := cdr X;
+ if not null X then
+ << Prin2 '! ; % SPACE
+ PrintOperand car X;
+ for each U in cdr X do
+ << Prin2 '!,; % COMMA
+ PrintOperand U >> >>;
+ Prin2 !$EOL!$ >>; % NEWLINE
+end;
+
+put('!*Entry, 'ASMPseudoOp, 'ASMPrintEntry);
+
+lisp procedure ASMPrintEntry X;
+begin scalar Y;
+ PrintComment X;
+ X := cadr X;
+ Y := FindEntryPoint X;
+ if not FlagP(X, 'InternalFunction) then FindIDNumber X;
+ if X eq MainEntryPointName!* then
+ << !*MainFound := T;
+ SpecialActionForMainEntryPoint() >>
+ else CodeDeclareExportedUse Y;
+ end;
+
+Procedure CodeDeclareExportedUse Y;
+ if !*DeclareBeforeUse then
+ << CodeDeclareExported Y;
+ PrintLabel Y >>
+ else
+ << PrintLabel Y;
+ CodeDeclareExported Y >>;
+
+lisp procedure FindEntryPoint X;
+begin scalar E;
+ return if (E := get(X, 'EntryPoint)) then E
+ else if ASMSymbolP X and not get(X, 'ASMSymbol) then
+ << put(X, 'EntryPoint, X);
+ X >>
+ else
+ << E := StringGenSym();
+ put(X, 'EntryPoint, E);
+ E >>;
+end;
+
+lisp procedure ASMPseudoPrintFloat X;
+ PrintF(DoubleFloatFormat!*, cadr X);
+
+put('Float, 'ASMPseudoOp, 'ASMPseudoPrintFloat);
+
+lisp procedure ASMPseudoPrintFullWord X;
+ for each Y in cdr X do PrintFullWord Y;
+
+put('FullWord, 'ASMPseudoOp, 'ASMPseudoPrintFullWord);
+
+lisp procedure ASMPseudoPrintByte X;
+ PrintByteList cdr X;
+
+put('Byte, 'ASMPseudoOp, 'ASMPseudoPrintByte);
+
+lisp procedure ASMPseudoPrintHalfWord X;
+ PrintHalfWordList cdr X;
+
+put('HalfWord, 'ASMPseudoOp, 'ASMPseudoPrintHalfWord);
+
+lisp procedure ASMPseudoPrintString X;
+ PrintString cadr X;
+
+put('String, 'ASMPseudoOp, 'ASMPseudoPrintString);
+
+lisp procedure PrintOperand X;
+ if StringP X then Prin2 X
+ else if NumberP X then PrintNumericOperand X
+ else if IDP X then Prin2 FindLabel X
+ else begin scalar Hd, Fn;
+ Hd := car X;
+ if (Fn := get(Hd, 'OperandPrintFunction)) then
+ Apply(Fn, list X)
+ else if (Fn := GetD Hd) and car Fn = 'MACRO then
+ PrintOperand Apply(cdr Fn, list X)
+ else if (Fn := WConstEvaluable X) then PrintOperand Fn
+ else PrintExpression X;
+ end;
+
+put('REG, 'OperandPrintFunction, 'PrintRegister);
+
+lisp procedure PrintRegister X;
+begin scalar Nam;
+ X := cadr X;
+ if StringP X then Prin2 X
+ else if NumberP X then Prin2 GetV(NumericRegisterNames!*, X)
+ else if Nam := RegisterNameP X then Prin2 Nam
+ else
+ << ErrorPrintF("***** Unknown register %r", X);
+ Prin2 X >>;
+end;
+
+lisp procedure RegisterNameP X;
+ get(X, 'RegisterName);
+
+lisp procedure ASMEntry X;
+ PrintExpression
+ list('plus2, 'SymFnc,
+ list('times2, AddressingUnitsPerFunctionCell,
+ list('IDLoc, cadr X)));
+
+put('Entry, 'OperandPrintFunction, 'ASMEntry);
+
+lisp procedure ASMInternalEntry X;
+ Prin2 FindEntryPoint cadr X;
+
+put('InternalEntry, 'OperandPrintFunction, 'ASMInternalEntry);
+put('InternalEntry, 'ASMExpressionFunction, 'ASMInternalEntry);
+
+macro procedure ExtraReg U;
+ list('plus2, '(WArray ArgumentBlock), (cadr U - (LastActualReg!& + 1))
+ * AddressingUnitsPerItem);
+
+lisp procedure ASMSyslispVarsPrint X;
+ Prin2 FindGlobalLabel cadr X;
+
+DefList('((WVar ASMSyslispVarsPrint)
+ (WArray ASMSyslispVarsPrint)
+ (WString ASMSyslispVarsPrint)), 'OperandPrintFunction);
+
+DefList('((WVar ASMSyslispVarsPrint)
+ (WArray ASMSyslispVarsPrint)
+ (WString ASMSyslispVarsPrint)), 'ASMExpressionFunction);
+
+lisp procedure ASMPrintValueCell X;
+ PrintExpression list('plus2, 'SymVal,
+ list('times, AddressingUnitsPerItem,
+ list('IDLoc, cadr X)));
+
+DefList('((fluid ASMPrintValueCell)
+ (!$fluid ASMPrintValueCell)
+ (global ASMPrintValueCell)
+ (!$global ASMPrintValueCell)), 'OperandPrintFunction);
+
+% Redefinition of WDeclare for output to assembler file
+
+% if either UpperBound or Initializer are NIL, they are considered to be
+% unspecified.
+
+fexpr procedure WDeclare U;
+ for each X in cddr U do WDeclare1(car X, car U, cadr U, cadr X, caddr X);
+
+flag('(WDeclare), 'IGNORE);
+
+lisp procedure WDeclare1(Name, Scope, Typ, UpperBound, Initializer);
+ if Typ = 'WCONST then
+ if Scope = 'EXTERNAL and not get(Name, 'WCONST) then
+ ErrorPrintF("*** A value has not been defined for WConst %r",
+ Name)
+ else
+ << put(Name, 'SCOPE, if Scope = 'EXPORTED then 'EXTERNAL else Scope);
+ put(Name, 'WCONST, WConstReform Initializer) >>
+ else
+ << put(Name, Typ, Name);
+ if Scope = 'EXTERNAL then
+ << put(Name, 'SCOPE, 'EXTERNAL);
+ if not RegisterNameP Name then % kludge to avoid declaring
+ << Name := LookupOrAddASMSymbol Name;
+ DataDeclareExternal Name; % registers as variables
+ CodeDeclareExternal Name >> >>
+ else
+ << put(Name, 'SCOPE, if Scope = 'EXPORTED then 'EXTERNAL else Scope);
+ Name := LookupOrAddASMSymbol Name;
+ if !*DeclareBeforeUse then DataDeclareExported Name;
+ DataInit(Name,
+ Typ,
+ UpperBound,
+ Initializer);
+ if not !*DeclareBeforeUse then DataDeclareExported Name;
+ CodeDeclareExternal Name >> >>;
+
+lisp procedure DataInit(ASMSymbol, Typ, UpperBound, Initializer);
+<< DataAlignFullWord();
+ if Typ = 'WVAR then
+ << if UpperBound then
+ ErrorPrintF "*** An UpperBound may not be specified for a WVar";
+ Initializer := if Initializer then WConstReform Initializer else 0;
+ DataPrintVar(ASMSymbol, Initializer) >>
+ else
+ << if UpperBound and Initializer then
+ ErrorPrintF "*** Can't have both UpperBound and initializer"
+ else if not (UpperBound or Initializer) then
+ ErrorPrintF "*** Must have either UpperBound or initializer"
+ else if UpperBound then
+ DataPrintBlock(ASMSymbol, WConstReform UpperBound, Typ)
+ else
+ << Initializer := if StringP Initializer then Initializer
+ else WConstReformLis Initializer;
+ DataPrintList(ASMSymbol, Initializer, Typ) >> >> >>;
+
+lisp procedure WConstReform U;
+begin scalar X;
+ return if FixP U or StringP U then U
+ else if IDP U then
+ if get(U, 'WARRAY) or get(U, 'WSTRING) then U
+ else if get(U,'WVAR) then list('GETMEM,U)
+ else if (X := get(U, 'WCONST)) then X
+ else ErrorPrintF("*** Unknown symbol %r in WConstReform", U)
+ else if PairP U then
+ if (X := get(car U, 'WConstReformPseudo)) then Apply(X, list U)
+ else if (X := get(car U, 'DOFN)) then X . WConstReformLis cdr U
+ else if MacroP car U then WConstReform Apply(cdr GetD car U, list U)
+ else car U . WConstReformLis cdr U
+ else ErrorPrintF("*** Illegal expression %r in WConstReform", U);
+end;
+
+lisp procedure WConstReformIdent U;
+ U;
+
+put('InternalEntry, 'WConstReformPseudo, 'WConstReformIdent);
+
+lisp procedure WConstReformQuote U;
+ CompileConstant cadr U;
+
+put('QUOTE, 'WConstReformPseudo, 'WConstReformQuote);
+
+lisp procedure WConstReformLis U;
+ for each X in U collect WConstReform X;
+
+lisp procedure WConstReformLoc U; %. To handle &Foo[23]
+<< U := WConstReform cadr U;
+ if car U neq 'GETMEM then
+ ErrorPrintF("*** Illegal constant addressing expression %r",
+ list('LOC, U))
+ else cadr U >>;
+
+put('LOC, 'WConstReformPseudo, 'WConstReformLoc);
+
+lisp procedure WConstReformIDLoc U;
+ FindIDNumber cadr U;
+
+put('IDLoc, 'WConstReformPseudo, 'WConstReformIDLoc);
+
+lisp procedure LookupOrAddASMSymbol U;
+begin scalar X;
+ if not (X := get(U, 'ASMSymbol)) then X := AddASMSymbol U;
+ return X;
+end;
+
+lisp procedure AddASMSymbol U;
+begin scalar X;
+ X := if ASMSymbolP U and not get(U, 'EntryPoint) then U
+ else StringGensym();
+ put(U, 'ASMSymbol, X);
+ return X;
+end;
+
+lisp procedure DataPrintVar(Name, Init);
+begin scalar OldOut;
+ DataPrintLabel Name;
+ OldOut := WRS DataOut!*;
+ PrintFullWord Init;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintBlock(Name, Siz, Typ);
+<< if Typ = 'WSTRING
+ then Siz := list('quotient, list('plus2, Siz, CharactersPerWord + 1),
+ CharactersPerWord)
+ else Siz := list('plus2, Siz, 1);
+ DataReserveZeroBlock(Name, Siz) >>;
+
+lisp procedure DataPrintList(Nam, Init, Typ);
+begin scalar OldOut;
+ DataPrintLabel Nam;
+ OldOut := WRS DataOut!*;
+ if Typ = 'WSTRING then
+ if StringP Init then
+ << PrintFullWord Size Init;
+ PrintString Init >>
+ else
+ << PrintFullWord(Length Init - 1);
+ PrintByteList Append(Init, '(0)) >>
+ else
+ if StringP Init then begin scalar S;
+ S := Size Init;
+ for I := 0 step 1 until S do
+ PrintFullWord Indx(Init, I);
+ end else for each X in Init do
+ PrintFullWord X;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintGlobalLabel X;
+<< if !*DeclareBeforeUse then DataDeclareExported X;
+ DataPrintLabel X;
+ if not !*DeclareBeforeUse then DataDeclareExported X;
+ CodeDeclareExternal X >>;
+
+
+lisp procedure DataDeclareExternal X;
+ if not (X member DataExternals!* or X member DataExporteds!*) then
+ << DataExternals!* := X . DataExternals!*;
+ DataPrintF(ExternalDeclarationFormat!*, X, X) >>;
+
+lisp procedure CodeDeclareExternal X;
+ if not (X member CodeExternals!* or X member CodeExporteds!*) then
+ << CodeExternals!* := X . CodeExternals!*;
+ CodePrintF(ExternalDeclarationFormat!*, X, X) >>;
+
+lisp procedure DataDeclareExported X;
+<< if X member DataExternals!* or X member DataExporteds!* then
+ ErrorPrintF("***** %r multiply defined", X);
+ DataExporteds!* := X . DataExporteds!*;
+ DataPrintF(ExportedDeclarationFormat!*, X, X) >>;
+
+lisp procedure CodeDeclareExported X;
+<< if X member CodeExternals!* or X member CodeExporteds!* then
+ ErrorPrintF("***** %r multiply defined", X);
+ CodeExporteds!* := X . CodeExporteds!*;
+ CodePrintF(ExportedDeclarationFormat!*, X, X) >>;
+
+lisp procedure PrintLabel X;
+ PrintF(LabelFormat!*, X,X);
+
+lisp procedure DataPrintLabel X;
+ DataPrintF(LabelFormat!*, X,X);
+
+lisp procedure CodePrintLabel X;
+ CodePrintF(LabelFormat!*, X,X);
+
+lisp procedure PrintComment X;
+ PrintF(CommentFormat!*, X);
+
+PrintExpressionForm!* := list('PrintExpression, MkQuote NIL);
+PrintExpressionFormPointer!* := cdadr PrintExpressionForm!*;
+
+% Save some consing
+% instead of list('PrintExpression, MkQuote X), reuse the same list structure
+
+lisp procedure PrintFullWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ PrintF(FullWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataPrintFullWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ DataPrintF(FullWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure CodePrintFullWord X;
+<< RplacA(PrintExpressionFormPointer!*, X);
+ CodePrintF(FullWordFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataReserveZeroBlock(Nam, X);
+<< RplacA(PrintExpressionFormPointer!*,
+ list('Times2, AddressingUnitsPerItem, X));
+ DataPrintF(ReserveZeroBlockFormat!*, Nam, PrintExpressionForm!*) >>;
+
+lisp procedure DataReserveBlock X;
+<< RplacA(PrintExpressionFormPointer!*,
+ list('Times2, AddressingUnitsPerItem, X));
+ DataPrintF(ReserveDataBlockFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataReserveFunctionCellBlock X;
+<< RplacA(PrintExpressionFormPointer!*,
+ list('Times2, AddressingUnitsPerFunctionCell, X));
+ DataPrintF(ReserveDataBlockFormat!*, PrintExpressionForm!*) >>;
+
+lisp procedure DataPrintUndefinedFunctionCell();
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ for each X in UndefinedFunctionCellInstructions!* do
+ ASMOutLap1 X;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintDefinedFunctionCell X;
+ <<DataDeclareExternal X;
+ DataPrintF(DefinedFunctionCellFormat!*, X, X)>>;
+ % in case it's needed twice
+
+
+lisp procedure DataPrintByteList X;
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintByteList X;
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintExpression X;
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintExpression X;
+ WRS OldOut;
+end;
+
+lisp procedure CodePrintExpression X;
+begin scalar OldOut;
+ OldOut := WRS CodeOut!*;
+ PrintExpression X;
+ WRS OldOut;
+end;
+
+ExpressionCount!* := -1;
+
+lisp procedure PrintExpression X;
+(lambda(ExpressionCount!*);
+begin scalar Hd, Tl, Fn;
+ X := ResolveWConstExpression X;
+ if NumberP X or StringP X then Prin2 X
+ else if IDP X then Prin2 FindLabel X
+ else if atom X then
+ << ErrorPrintF("***** Oddity in expression %r", X);
+ Prin2 X >>
+ else
+ << Hd := car X;
+ Tl := cdr X;
+ if (Fn := get(Hd, 'BinaryASMOp)) then
+ << if ExpressionCount!* > 0 then Prin2 ASMOpenParen!*;
+ PrintExpression car Tl;
+ Prin2 Fn;
+ PrintExpression cadr Tl;
+ if ExpressionCount!* > 0 then Prin2 ASMCloseParen!* >>
+ else if (Fn := get(Hd, 'UnaryASMOp)) then
+ << Prin2 Fn;
+ PrintExpression car Tl >>
+ else if (Fn := get(Hd, 'ASMExpressionFormat)) then
+ Apply('PrintF, Fn . for each Y in Tl collect
+ list('PrintExpression, MkQuote Y))
+ else if (Fn := GetD Hd) and car Fn = 'MACRO then
+ PrintExpression Apply(cdr Fn, list X)
+ else if (Fn := get(Hd, 'ASMExpressionFunction)) then
+ Apply(Fn, list X)
+ else
+ << ErrorPrintF("***** Unknown expression %r", X);
+ PrintF("*** Expression error %r ***", X) >> >>;
+end)(ExpressionCount!* + 1);
+
+lisp procedure ASMPrintWConst U;
+ PrintExpression cadr U;
+
+put('WConst, 'ASMExpressionFunction, 'ASMPrintWConst);
+
+DefList('((Plus2 !+)
+ (WPlus2 !+)
+ (Difference !-)
+ (WDifference !-)
+ (Times2 !*)
+ (WTimes2 !*)
+ (Quotient !/)
+ (WQuotient !/)), 'BinaryASMOp);
+
+DefList('((Minus !-)
+ (WMinus !-)), 'UnaryASMOp);
+
+lisp procedure CompileConstant X;
+<< X := BuildConstant X;
+ if null cdr X then car X
+ else
+ << If !*DeclareBeforeUse then CodeDeclareExported cadr X;
+ ASMOutLap cdr X;
+ DataDeclareExternal cadr X;
+ If Not !*DeclareBeforeUse then CodeDeclareExported cadr X;
+ car X >> >>;
+
+CommentOutCode <<
+lisp procedure CompileHeapData X;
+begin scalar Y;
+ X := BuildConstant X;
+ return if null cdr X then car X
+ else
+ << Y := WRS DataOut!*;
+ for each Z in cdr X do ASMOutLap1 Z;
+ DataDeclareExported cadr X;
+ WRS Y;
+ car X >>;
+end;
+>>;
+
+lisp procedure DataPrintString X;
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintString X;
+ WRS OldOut;
+end;
+
+lisp procedure FindLabel X;
+begin scalar Y;
+ return if (Y := Atsoc(X, LocalLabels!*)) then cdr Y
+ else if (Y := get(X, 'ASMSymbol)) then Y
+ else if (Y := get(X, 'WConst)) then Y
+ else FindLocalLabel X;
+end;
+
+lisp procedure FindLocalLabel X;
+begin scalar Y;
+ return if (Y := Atsoc(X, LocalLabels!*)) then cdr Y
+ else
+ << LocalLabels!* := (X . (Y := StringGensym())) . LocalLabels!*;
+ Y >>;
+end;
+
+lisp procedure FindGlobalLabel X;
+ get(X, 'ASMSymbol) or ErrorPrintF("***** Undefined symbol %r", X);
+
+lisp procedure CodePrintF(Fmt, A1, A2, A3, A4);
+begin scalar OldOut;
+ OldOut := WRS CodeOut!*;
+ PrintF(Fmt, A1, A2, A3, A4);
+ WRS OldOut;
+end;
+
+lisp procedure DataPrintF(Fmt, A1, A2, A3, A4);
+begin scalar OldOut;
+ OldOut := WRS DataOut!*;
+ PrintF(Fmt, A1, A2, A3, A4);
+ WRS OldOut;
+end;
+
+% Kludge of the year, just to avoid having IDLOC defined during compilation
+
+CompileTime fluid '(MACRO);
+
+MACRO := 'MACRO;
+
+PutD('IDLoc, MACRO,
+function lambda X;
+ FindIDNumber cadr X);
+
+END;
ADDED psl-1983/3-1/comp/opencodedfunctions.lst
Index: psl-1983/3-1/comp/opencodedfunctions.lst
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/opencodedfunctions.lst
@@ -0,0 +1,47 @@
+These functions where tagged as open coded in the Dec20 PSL.
+
+ADDRESSAPPLY0
+ADDRESSAPPLY1
+ADDRESSAPPLY2
+ADDRESSAPPLY3
+ADDRESSAPPLY4
+
+CODEAPPLY0
+CODEAPPLY1
+CODEAPPLY2
+CODEAPPLY3
+CODEAPPLY4
+
+IDAPPLY0
+IDAPPLY1
+IDAPPLY2
+IDAPPLY3
+IDAPPLY4
+
+% These represent the interface tothe users float capability.
+
+!*FEQ
+!*FGREATERP
+!*WFIX
+!*WFLOAT
+!*FDIFFERENCE
+!*FASSIGN
+!*FLESSP
+!*FPLUS2
+!*FQUOTIENT
+!*FTIMES2
+
+%These are for standard division.
+
+WREMAINDER
+WQUOTIENT
+
+% These arethe primitives for dealing with the machine words of various sizes.
+
+BYTE
+HALFWORD
+BITTABLE
+PUTBYTE
+PUTHALFWORD
+PUTBITTABLE
+
ADDED psl-1983/3-1/comp/p-lambind.sl
Index: psl-1983/3-1/comp/p-lambind.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/p-lambind.sl
@@ -0,0 +1,59 @@
+%
+% P-LAMBIND.SL - Portable cmacro definitions *LAMBIND, *PROGBIND and *FREERSTR
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 6 August 1982
+% Copyright (c) 1982 University of Utah
+%
+
+(compiletime (load useful))
+
+(imports '(syslisp)) % requires SYSLISP for AddrUnitsPerItem
+
+(de *lambind (regs fluids)
+ (prog (n firstreg)
+ (setq n 0)
+ (setq regs (rest regs)) % remove REGISTERS at the front
+ (setq fluids (rest fluids)) % remove NONLOCALVARS at the front
+ (setq fluids % convert fluids list into vector
+ (list2vector (foreach x in fluids collect (second x))))
+ (setq firstreg (first regs))
+ (setq regs (rest regs))
+ (return (if (null regs) % only one to bind
+ `((*move ,firstreg (reg 2))
+ (*move `,',(getv fluids 0) (reg 1))
+ (*call lbind1))
+ `((*move ,firstreg (memory (fluid LambindArgs*) (wconst 0)))
+ (*move (fluid LambindArgs*) ,firstreg)
+ ,@(foreach x in regs collect
+ (progn (setq n (add1 n))
+ `(*move ,x
+ (memory ,firstreg
+ (wconst (wtimes2 (wconst AddressingUnitsPerItem)
+ (wconst ,n)))))))
+ (*move `,',fluids (reg 1))
+ (*call lambind))))))
+
+(defcmacro *lambind)
+
+(de *progbind (fluids)
+ (if (null (rest (rest fluids)))
+ `((*move `,',(second (first (rest fluids))) (reg 1))
+ (*call pbind1))
+ `((*move `,',(list2vector (foreach x in (rest fluids) collect
+ (second x)))
+ (reg 1))
+ (*call progbind))))
+
+(defcmacro *progbind)
+
+(de *freerstr (fluids)
+ `((*move `,',(length (rest fluids)) (reg 1))
+ (*call UnBindN)))
+
+(defcmacro *freerstr)
+
+(setq *unsafebinder t) % has to save registers across calls
ADDED psl-1983/3-1/comp/pass-1-lap.build
Index: psl-1983/3-1/comp/pass-1-lap.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/pass-1-lap.build
@@ -0,0 +1,10 @@
+CompileTime <<
+on EolInStringOK;
+macro procedure !* U;
+ NIL;
+load Syslisp;
+>>;
+in "anyreg-cmacro.sl"$
+in "pass-1-lap.sl"$
+in "common-cmacros.sl"$
+in "common-predicates.sl"$
ADDED psl-1983/3-1/comp/pass-1-lap.sl
Index: psl-1983/3-1/comp/pass-1-lap.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/pass-1-lap.sl
@@ -0,0 +1,338 @@
+(*
+"% PASS-1-LAP.SL - Expand c-macros and allocate quoted expressions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 14 December 1981
+% Copyright (c) 1981 University of Utah
+%
+% Added MCprint and InstructionPrint - MLG
+
+% <PSL.COMP>PASS-1-LAP.SL.17, 4-Aug-82 00:35:54, Edit by BENSON
+% Added bignum constants; won't work for cross-compilation, though
+
+%")
+
+(*
+"Pass1Lap takes a list of c-macros and instructions, and attempts to simplify
+them whenever possible. C-macros are expanded by APPLY(CAR X, CDR X), which
+will return another instruction list to be processed recursively by Pass1Lap.
+Quoted expressions are allocated at the end of the code, in the following way:
+
+In an instruction or c-macro
+(.... (QUOTE (A B C)) ...)
+
+the following is tacked onto the end of the constructed code list:
+
+L2
+(MKITEM ID A)
+(MKITEM PAIR L3)
+L3
+(MKITEM ID B)
+(MKITEM PAIR L4)
+L4
+(MKITEM ID C)
+(MKITEM ID NIL)
+
+If *ImmediateQuote is NIL, the quoted reference becomes:
+
+(... L1 ...)
+...
+L1
+(fullword (MKITEM PAIR L2))
+
+Otherwise, it becomes:
+
+(... (immediate (MKITEM PAIR L2)) ...)")
+
+(fluid '(!*ImmediateQuote
+ !*PCMAC
+ !*PrintedOneCMacro
+ Pass1CodeList
+ Pass1ConstantList
+ Pass1ConstantContentsList
+ Pass1AddedCode
+ EntryPoints!*
+ AddressingUnitsPerItem
+ LastActualReg!&))
+
+(CompileTime (flag '(Pass1Code OneLapPass1 AddInstruction
+ ExpandPseudoOps ExpandOnePseudoOp
+ GenerateLabel GenerateCodeLabel AddCodeLabel AddCode
+ ExpandQuote1 ExpandImmediateQuote ExpandItem
+ ExpandNonImmediateQuote SaveConstant SaveContents
+ AppendConstants AppendOneConstant AppendItem
+ AddFullWord AppendContents MakeMkItem)
+ 'InternalFunction))
+
+(CompileTime (load fast-vector))
+
+(de Pass1Lap (InstructionList)
+ (prog (Pass1CodeList
+ Pass1ConstantList
+ Pass1ConstantContentsList
+ EntryPoints!*
+ Pass1AddedCode)
+ (setq Pass1CodeList (cons NIL NIL)) (* "Init a TCONC pointer")
+ (setq Pass1ConstantContentsList (cons NIL NIL))
+ (Pass1Code InstructionList) (* "Expand macros")
+ (Pass1Code Pass1AddedCode)
+ (AppendConstants) (* "Tack the constants on the end")
+ (return (car Pass1CodeList))))
+
+(* "BuildConstant takes an S-expression and returns the LAP version of it.")
+
+(* "The car is the expanded item, cdr is the contents")
+
+(de BuildConstant (Expression)
+ (prog (Pass1CodeList
+ Pass1ConstantList
+ Pass1ConstantContentsList
+ ExpandedExpression)
+ (setq Pass1CodeList (cons NIL NIL)) (* "Init a TCONC pointer")
+ (setq Pass1ConstantContentsList (cons NIL NIL))
+ (setq ExpandedExpression (ExpandItem Expression)) (* "Expand the item")
+ (AppendConstants) (* "Tack the contents on the end")
+ (return (cons ExpandedExpression (car Pass1CodeList)))))
+
+(de Pass1Code (InstructionList)
+ (ForEach Instruction in InstructionList do (OneLapPass1 Instruction)))
+
+(de OneLapPass1 (Instruction)
+ (cond ((atom Instruction) (AddCodeLabel Instruction))
+ ((eq (car Instruction) '!*ENTRY)
+ (progn (* "ENTRY directives are passed unchanged")
+ (cond ((and (not (or (FlagP (second Instruction)
+ 'InternalFunction)
+ (equal (second Instruction)
+ '**fasl**initcode**)))
+ (null (car Pass1CodeList)))
+ (* "Header word says how many arguments to expect")
+ (AddCode (list 'FULLWORD (fourth Instruction)))))
+ (setq EntryPoints!*
+ (cons (second Instruction) EntryPoints!*))
+ (cond (!*PCMAC (MCPrint Instruction)))
+ (AddCode Instruction)))
+ ((FlagP (car Instruction) 'MC)
+ (progn (cond ((and !*PCMAC (not !*PrintedOneCMacro))
+ (MCPrint Instruction)))
+ ((lambda (!*PrintedOneCMacro)
+ (Pass1Code (Apply (car Instruction)
+ (cdr Instruction))))
+ T)))
+ (t (progn (cond (!*PCMAC (InstructionPrint Instruction)))
+ (AddInstruction Instruction)))))
+
+(de MCPrint(x) (print x))
+(de InstructionPrint(x) (PrintF " %p%n" x))
+
+(de AddInstruction (Instruction)
+ (AddCode (ExpandPseudoOps Instruction)))
+
+(de ExpandPseudoOps (X)
+ (cond ((atom X) X)
+ (t (cons (ExpandOnePseudoOp (car X))
+ (ExpandPseudoOps (cdr X))))))
+
+(de ExpandOnePseudoOp (X)
+ (prog (PseudoOpFunction)
+ (return (cond ((atom X) X)
+ ((setq PseudoOpFunction
+ (get (car X) 'Pass1PseudoOp))
+ (ExpandOnePseudoOp (Apply PseudoOpFunction
+ (list X))))
+ ((setq PseudoOpFunction (WConstEvaluable X))
+ PseudoOpFunction)
+ (t (cons (car X) (ExpandPseudoOps (cdr X))))))))
+
+
+(de PassOneUnImmediate (X)
+ (progn (setq X (cadr X))
+ (cond ((EqCar X 'Immediate) (cadr X))
+ (t X))))
+
+(put 'UnImmediate 'Pass1PseudoOp 'PassOneUnImmediate)
+
+(de PassOneLabel (U)
+ (cadr U))
+
+(put 'Label 'Pass1PseudoOp 'PassOneLabel)
+
+(de PassOneUnDeferred (X)
+ (progn (setq X (cadr X))
+ (cond ((EqCar X 'Deferred) (cadr X))
+ (t X))))
+
+(put 'UnDeferred 'Pass1PseudoOp 'PassOneUnDeferred)
+
+(* "Removed because ExtraReg has to be processed differently by resident LAP"
+(de PassOneExtraReg (X)
+ (progn (setq X (cadr X))
+ (list 'plus2
+ '(WArray ArgumentBlock)
+ (times (difference (Add1 LastActualReg!&) X)
+ AddressingUnitsPerItem))))
+
+(put 'ExtraReg 'Pass1PseudoOp 'PassOneExtraReg)
+)
+
+(de GenerateCodeLabel ()
+ (prog (NewLabel)
+ (setq NewLabel (GenerateLabel))
+ (AddCodeLabel NewLabel)
+ (return NewLabel)))
+
+(de GenerateLabel ()
+ (StringGenSym))
+
+(de AddCodeLabel (Label)
+ (AddCode Label))
+
+(de AddCode (C)
+ (TConc Pass1CodeList C))
+
+(de ExpandLit (U)
+ (prog (L)
+ (cond ((setq L (FindPreviousLit (cdr U))) (return L)))
+ (setq L (GenerateLabel))
+ (setq Pass1AddedCode (NConc Pass1AddedCode
+ (cons L (ForEach X in (cdr U) collect X))))
+ (return L)))
+
+(de FindPreviousLit (U)
+ (cond ((not (null (rest U))) NIL)
+ (t (prog (L)
+ (setq L Pass1AddedCode)
+ (cond ((null L) (return NIL)))
+ (setq U (first U))
+ loop
+ (cond ((null (rest L)) (return NIL)))
+ (cond ((equal U (second L))
+ (return (cond ((atom (first L)) (first L))
+ (t (prog (B)
+ (setq L (rest L))
+ (rplacd L (cons (first L) (rest L)))
+ (rplaca L (setq B (GenerateLabel)))
+ (return B)))))))
+ (setq L (rest L))
+ (go loop)))))
+
+(put 'lit 'Pass1PseudoOp 'ExpandLit)
+(flag '(lit) 'TerminalOperand)
+
+(de ExpandQuote (QuotedExpression)
+ (ExpandQuote1 (cadr QuotedExpression)))
+
+(put 'Quote 'Pass1PseudoOp 'ExpandQuote)
+
+(de ExpandQuote1 (Expression)
+ (cond (!*ImmediateQuote (ExpandImmediateQuote Expression))
+ (t (ExpandNonImmediateQuote Expression))))
+
+(de ExpandImmediateQuote (Expression)
+ (list 'IMMEDIATE (ExpandItem Expression)))
+
+(de ExpandItem (Expression)
+ (prog (LabelOfContents)
+ (return (cond ((InumP Expression) Expression)
+ ((IDP Expression)
+ (MakeMkItem (TagNumber Expression)
+ (list 'IDLoc Expression)))
+ ((CodeP Expression)
+ (MakeMkItem (TagNumber Expression)
+ Expression))
+ (t (progn (setq LabelOfContents
+ (SaveContents Expression))
+ (MakeMkItem (TagNumber Expression)
+ LabelOfContents)))))))
+
+(de ExpandNonImmediateQuote (Expression)
+ (SaveConstant Expression))
+
+(de SaveConstant (Expression)
+ (prog (TableEntry)
+ (return (cond ((setq TableEntry
+ (Assoc Expression Pass1ConstantList))
+ (cdr TableEntry))
+ (t (progn (setq TableEntry (GenerateLabel))
+ (setq Pass1ConstantList
+ (cons (cons Expression
+ TableEntry)
+ Pass1ConstantList))
+ TableEntry))))))
+
+
+(de SaveContents (Expression)
+ (prog (TableEntry)
+ (return (cond ((setq TableEntry
+ (Assoc Expression
+ (car Pass1ConstantContentsList)))
+ (cdr TableEntry))
+ (t (progn (setq TableEntry (GenerateLabel))
+ (TConc Pass1ConstantContentsList
+ (cons Expression TableEntry))
+ TableEntry))))))
+
+
+(de AppendConstants ()
+ (prog (TempCodeList)
+ (cond ((not !*ImmediateQuote)
+ (ForEach TableEntry in Pass1ConstantList do
+ (AppendOneConstant TableEntry))))
+ (setq TempCodeList Pass1CodeList)
+ (setq Pass1CodeList (cons NIL NIL))
+ (ForEach TableEntry in (car Pass1ConstantContentsList) do
+ (AppendContents TableEntry))
+ (* "The contents go on the begininning of the list")
+ (LConc Pass1CodeList (car TempCodeList))))
+
+(de AppendOneConstant (ExpressionLabelPair)
+ (progn (AddCodeLabel (cdr ExpressionLabelPair))
+ (AppendItem (car ExpressionLabelPair))))
+
+(de AppendItem (Expression)
+ (AddFullWord (ExpandItem Expression)))
+
+(de AddFullWord (Expression)
+ (AddCode (list 'FULLWORD Expression)))
+
+(de AppendContents (ExpressionLabelPair)
+ (prog (Expression UpperBound I)
+ (AddCodeLabel (cdr ExpressionLabelPair))
+ (setq Expression (car ExpressionLabelPair))
+ (cond ((PairP Expression)
+ (progn (AppendItem (car Expression))
+ (AppendItem (cdr Expression))))
+ ((StringP Expression)
+ (progn (AddFullWord (Size Expression))
+ (AddCode (list 'STRING Expression))))
+ ((VectorP Expression)
+ (progn (setq UpperBound (ISizeV Expression))
+ (AddFullWord UpperBound)
+ (setq I 0)
+ (while (ILEQ I UpperBound)
+ (progn (AppendItem (IGetV Expression I))
+ (setq I (IAdd1 I))))))
+ ((BigP Expression)
+ (progn (setq UpperBound (ISizeV Expression))
+ (AddFullWord UpperBound)
+ (setq I 0)
+ (while (ILEQ I UpperBound)
+ (progn (AppendItem (IGetV Expression I))
+ (setq I (IAdd1 I))))))
+ ((FixP Expression)
+ (progn (AddFullWord 0) (* "Header of full word fixnum")
+ (AddFullWord Expression)))
+ ((FloatP Expression)
+ (progn (AddFullWord 1) (* "Header of float")
+ (AddCode (list 'FLOAT Expression)))))))
+
+(de MakeMkItem (TagPart InfPart)
+ (list 'MKITEM TagPart InfPart))
+
+(de InumP (N) (IntP N)) (* "Must be changed for cross-compilation")
+
+(de TagNumber (Expression)
+ (MkINT (Tag Expression))) (* "Must be redefined for cross-compilation")
ADDED psl-1983/3-1/comp/syslisp-syntax.red
Index: psl-1983/3-1/comp/syslisp-syntax.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/syslisp-syntax.red
@@ -0,0 +1,222 @@
+%
+% SYSLISP-SYNTAX.RED - SMacros and redefinition of arithmetic operators
+% and other syslisp syntax
+%
+% Author: Eric Benson and M. L. griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 July 1981
+% Copyright (c) 1981 University of Utah
+%
+% <PSL.COMP>SYSLISP-SYNTAX.RED.2, 30-Mar-83 11:05:36, Edit by KENDZIERSKI
+% Included the text from syslisp-syntax.build at the beginning of this file.
+% The file names w/extensions were too large for the VAX to deal with.
+% <PSL.COMP>SYSLISP-SYNTAX.RED.3, 5-May-82 11:33:48, Edit by BENSON
+% Wrapped if GetD 'BEGIN1 around parser calls
+
+CompileTime << off UserMode; >>;
+
+fluid '(!*SYSLISP);
+
+% New WDECLARE constructs
+
+% Modify ***** [] vector syntax for PREFIX and INFIX forms
+% At lower prec
+
+SYMBOLIC PROCEDURE ParseLVEC(VNAME,VEXPR);
+ IF OP EQ '!*RVEC!* THEN <<OP :=SCAN(); LIST('INDX,VNAME,VEXPR)>>
+ ELSE PARERR("Missing ] in index expression ");
+
+% Use normal parsing, then CLEAN
+
+SYMBOLIC PROCEDURE ParseWDEC0(FN,DMODES,DLIST);
+ BEGIN SCALAR PLIST;
+ IF EQCAR(DLIST,'!*COMMA!*) THEN DLIST:=REVERSE CDR DLIST
+ ELSE DLIST:=LIST DLIST;
+ PLIST:=FOR EACH DEC IN DLIST COLLECT ParseWDEC1(FN,DEC);
+ RETURN ('WDECLARE . DMODES . FN . REVERSE PLIST);
+ END;
+
+SYMBOLIC PROCEDURE ParseWDEC1(FN,DEC);
+% Process each WDEC to check legal modes
+ if EqCar(DEC,'EQUAL) THEN
+ AConc(ParseWDEC2(FN,CADR DEC), ParseWDEC3(FN,CADDR DEC))
+ ELSE AConc(ParseWDEC2(FN,DEC), NIL);
+
+SYMBOLIC PROCEDURE ParseWDEC2(FN,X);
+% Remove INDXs from LHS of =
+ IF IDP X THEN list(X, NIL)
+ ELSE IF EQCAR(X,'INDX) THEN LIST(CADR X,CADDR X)
+ ELSE PARERR "Only [] allowed on LHS of WDECLARATION";
+
+SYMBOLIC PROCEDURE ParseWDEC3(FN,X);
+% Remove INDX's from RHS of =
+ IF IDP X THEN X
+ ELSE IF EQCAR(X,'INDX)
+ THEN (IF CADR X EQ '!*PREFIXVECT!*
+ THEN REMCOM(CADDR X)
+ ELSE PARERR("Only [...] is legal INIT in WDECLARE"))
+ ELSE X;
+
+if not FUnBoundP 'BEGIN1 then << % kludge #+Rlisp
+DEFINEBOP('!*LVEC!*,121,5,ParseLVEC);
+DEFINEROP('!*LVEC!*,5,ParseLVEC('!*PREFIXVECT!*,X));
+
+DEFINEBOP('!*RVEC!*,4,5);
+
+DEFINEROP('WCONST,1,ParseWDEC0('WCONST,'DEFAULT,X));
+DEFINEROP('WVAR,1,ParseWDEC0('WVAR,'DEFAULT,X));
+DEFINEROP('WARRAY,1,ParseWDEC0('WARRAY,'DEFAULT,X));
+DEFINEROP('WSTRING,1,ParseWDEC0('WSTRING,'DEFAULT,X));
+
+DEFINEBOP('WCONST,1,1,ParseWDEC0('WCONST,X,Y));
+DEFINEBOP('WVAR,1,1,ParseWDEC0('WVAR,X,Y));
+DEFINEBOP('WARRAY,1,1,ParseWDEC0('WARRAY,X,Y));
+DEFINEBOP('WSTRING,1,1,ParseWDEC0('WSTRING,X,Y));
+
+% Operators @ for GetMem, & for Loc
+
+put('!@, 'NewNam, 'GetMem);
+put('!&, 'NewNam, 'Loc);
+
+>>;
+
+% SysName hooks for REFORM
+
+REMFLAG('(REFORM),'LOSE);
+
+SYMBOLIC PROCEDURE REFORM U;
+ IF ATOM U OR CAR U MEMQ '(QUOTE WCONST)
+ THEN U
+ ELSE IF CAR U EQ 'COND THEN 'COND . REFORM CDR U
+ ELSE IF CAR U EQ 'PROG
+ THEN PROGN(RPLCDX(CDR U,REFORMLIS CDDR U),U)
+ ELSE IF CAR U EQ 'LAMBDA
+ THEN PROGN(RPLACA(CDDR U,REFORM CADDR U),U)
+ ELSE IF CAR U EQ 'FUNCTION AND ATOM CADR U
+ THEN BEGIN SCALAR X;
+ IF NULL !*CREF AND (X:= GET(CADR U,'SMACRO))
+ THEN RETURN LIST('FUNCTION,X)
+ ELSE IF GET(CADR U,'NMACRO) OR MACROP CADR U
+ THEN REDERR "MACRO USED AS FUNCTION"
+ ELSE RETURN U END
+% ELSE IF CAR U EQ 'MAT THEN RPLCDX(U,MAPC2(CDR U,FUNCTION REFORM))
+ ELSE IF ATOM CAR U
+ THEN BEGIN SCALAR X,Y,FN;
+ FN := CAR U;
+ IF (Y := GETD FN) AND CAR Y EQ 'MACRO
+ AND EXPANDQ FN
+ THEN RETURN REFORM APPLY(CDR Y,LIST U);
+ X := REFORMLIS CDR U;
+ IF NULL IDP FN THEN RETURN(FN . X);
+ IF !*SYSLISP AND (Y:=GET(FN,'SYSNAME)) THEN <<FN:=Y;U:=FN.CDR U>>;
+ IF (NULL !*CREF OR EXPANDQ FN)
+ AND (Y:= GET(FN,'NMACRO))
+ THEN RETURN
+ APPLY(Y,IF FLAGP(FN,'NOSPREAD) THEN LIST X ELSE X)
+ ELSE IF (NULL !*CREF OR EXPANDQ FN)
+ AND (Y:= GET(FN,'SMACRO))
+ THEN RETURN SUBLIS(PAIR(CADR Y,X),CADDR Y)
+ %we could use an atom SUBLIS here (eg, SUBLA);
+ ELSE RETURN PROGN(RPLCDX(U,X),U)
+ END
+ ELSE REFORM CAR U . REFORMLIS CDR U;
+
+RemFlag('(Plus Times), 'NARY)$
+
+DefList('((Plus WPlus2)
+ (Plus2 WPlus2)
+ (Minus WMinus)
+ (Difference WDifference)
+ (Times WTimes2)
+ (Times2 WTimes2)
+ (Quotient WQuotient)
+ (Remainder WRemainder)
+ (Mod WRemainder)
+ (Land WAnd)
+ (Lor WOr)
+ (Lxor WXor)
+ (Lnot WNot)
+ (LShift WShift)
+ (LSH WShift)), 'SysName);
+
+DefList('((Neq WNeq)
+ (Equal WEq)
+ (Eqn WEq)
+ (Eq WEq)
+ (Greaterp WGreaterp)
+ (Lessp WLessp)
+ (Geq WGeq)
+ (Leq WLeq)
+ (Getv WGetv)
+ (Indx WGetv)
+ (Putv WPutv)
+ (SetIndx WPutv)), 'SysName);
+
+
+% modification to arithmetic FOR loop for SysLisp
+
+LISP PROCEDURE MKSYSFOR U;
+ BEGIN SCALAR ACTION,BODY,EXP,INCR,LAB1,LAB2,RESULT,TAIL,VAR,X;
+ VAR := second second U;
+ INCR := cddr second U;
+ if FixP third Incr or WConstEvaluable third Incr then return
+ ConstantIncrementFor U;
+ ACTION := first third U;
+ BODY := second third U;
+ RESULT := LIST LIST('SETQ,VAR,CAR INCR);
+ INCR := CDR INCR;
+ X := LIST('WDIFFERENCE,first INCR,VAR);
+ IF second INCR NEQ 1 THEN X := LIST('WTIMES2,second INCR,X);
+ IF NOT ACTION EQ 'DO THEN
+ REDERR "Only do expected in SysLisp FOR";
+ LAB1 := GENSYM();
+ LAB2 := GENSYM();
+ RESULT := NCONC(RESULT,
+ LAB1 .
+ LIST('COND,LIST(LIST('WLESSP,X,0),LIST('GO,LAB2))) .
+ BODY .
+ LIST('SETQ,VAR,LIST('WPLUS2,VAR,second INCR)) .
+ LIST('GO,LAB1) .
+ LAB2 .
+ TAIL);
+ RETURN MKPROG(VAR . EXP,RESULT)
+ END;
+
+LISP PROCEDURE ConstantIncrementFor U;
+ BEGIN SCALAR ACTION,BODY,EXP,INCR,LAB1,RESULT,VAR,X,
+ StepValue, Limit;
+ VAR := second second U;
+ INCR := cddr second U;
+ ACTION := first third U;
+ BODY := second third U;
+ RESULT := LIST LIST('SETQ,VAR,CAR INCR);
+ INCR := CDR INCR;
+ StepValue := if FixP second Incr then second Incr
+ else WConstEvaluable second Incr;
+ Limit := first Incr;
+ IF NOT ACTION EQ 'DO THEN
+ REDERR "Only do expected in SysLisp FOR";
+ LAB1 := GENSYM();
+ RESULT := NCONC(RESULT,
+ LAB1 .
+ LIST('COND,LIST(LIST(if MinusP StepValue then 'WLessP
+ else 'WGreaterP,
+ Var,
+ Limit),'(return 0))) .
+ BODY .
+ LIST('SETQ,VAR,LIST('WPLUS2,VAR,StepValue)) .
+ LIST('GO,LAB1) .
+ NIL);
+ RETURN MKPROG(VAR . EXP,RESULT)
+ END;
+
+LISP PROCEDURE MKFOR1 U;
+ IF !*SYSLISP THEN MKSYSFOR U ELSE MKLISPFOR U;
+
+PUTD('MKLISPFOR,'EXPR,CDR GETD 'FOR); % grab old FOR definition
+
+macro procedure For U; MkFor1 U; % redefine FOR
+
+END;
ADDED psl-1983/3-1/comp/tags.red
Index: psl-1983/3-1/comp/tags.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/tags.red
@@ -0,0 +1,29 @@
+CompileTime <<
+lisp procedure DeclareTagRange(NameList, StartingValue, Increment);
+begin scalar Result;
+ Result := list 'progn;
+ while NameList do
+ << Result := list('put, MkQuote car NameList,
+ '(quote WConst),
+ StartingValue)
+ . Result;
+ StartingValue := StartingValue + Increment;
+ NameList := cdr NameList >>;
+ return ReversIP Result;
+end;
+
+macro procedure LowTags U;
+ DeclareTagRange(cdr U, 0, 1);
+
+macro procedure HighTags U;
+ DeclareTagRange(cdr U, if_system(MC68000, 16#FF, 31), -1);
+>>;
+
+LowTags(PosInt, FixN, BigN, FltN, Str, Bytes, HalfWords, Wrds, Vect, Pair);
+
+put('Code, 'WConst, 15);
+
+HighTags(NegInt, ID, Unbound, BtrTag, Forward,
+ HVect, HWrds, HHalfWords, HBytes);
+
+
ADDED psl-1983/3-1/comp/wdeclare.red
Index: psl-1983/3-1/comp/wdeclare.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/comp/wdeclare.red
@@ -0,0 +1,28 @@
+%
+% WDECLARE.RED - Skeleton WDeclare for WConsts
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 9 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.COMP>WDECLARE.RED.2, 17-Nov-82 17:09:39, Edit by PERDUE
+% Flagged WDeclare IGNORE rather than EVAL, so it takes effect
+% at compile time rather than load time!
+
+fexpr procedure WDeclare U;
+ for each X in cddr U do WDeclare1(car X, car U, cadr U, cadr X, caddr X);
+
+flag('(WDeclare), 'IGNORE);
+
+lisp procedure WDeclare1(Name, Scope, Typ, UpperBound, Initializer);
+ if Typ = 'WCONST then
+ if Scope = 'EXTERNAL and not get(Name, 'WCONST) then
+ ErrorPrintF("*** A value has not been defined for WConst %r",
+ Name)
+ else% EvDefConst(Name, Initializer)
+ put(Name, 'WConst, Initializer)
+ else StdError BldMsg("%r is not currently supported", Typ);
ADDED psl-1983/3-1/create-directories.ctl
Index: psl-1983/3-1/create-directories.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/create-directories.ctl
@@ -0,0 +1,187 @@
+; Please edit this, and replace all <psl with <yourpslname
+@build <psl>
+@@perm 6400 ! choose appropriate size
+@@work 6400 ! nnnn+extra
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 30
+@@
+; 5230 pages for following. PSL: needs about 1100.
+; Single directory, partial restore needs about 1300 below and 1100 above.
+@build <psl.comp>
+@@perm 180 ! choose appropriate size
+@@work 180 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.comp.20>
+@@perm 55 ! choose appropriate size
+@@work 55 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.dist>
+@@perm 25 ! choose appropriate size
+@@work 25 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.doc>
+@@perm 725 ! choose appropriate size
+@@work 725 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 2
+@@
+@build <psl.doc.20>
+@@perm 25 ! choose appropriate size
+@@work 25 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.doc.nmode>
+@@perm 590 ! choose appropriate size
+@@work 590 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.glisp>
+@@perm 330 ! choose appropriate size
+@@work 330 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.help>
+@@perm 100 ! choose appropriate size
+@@work 100 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.kernel>
+@@perm 785 ! choose appropriate size
+@@work 785 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.kernel.20>
+@@perm 560 ! choose appropriate size
+@@work 560 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.lap>
+@@perm 500 ! choose appropriate size
+@@work 500 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.lpt>
+@@perm 430 ! choose appropriate size
+@@work 430 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.nmode>
+@@perm 510 ! choose appropriate size
+@@work 510 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.nmode.binary>
+@@perm 230 ! choose appropriate size
+@@work 230 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.nonkernel>
+@@perm 5 ! choose appropriate size
+@@work 5 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.tests>
+@@perm 715 ! choose appropriate size
+@@work 715 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.tests.20>
+@@perm 500 ! choose appropriate size
+@@work 500 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.util>
+@@perm 635 ! choose appropriate size
+@@work 635 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.util.20>
+@@perm 60 ! choose appropriate size
+@@work 60 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.windows>
+@@perm 105 ! choose appropriate size
+@@work 105 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.windows.binary>
+@@perm 30 ! choose appropriate size
+@@work 30 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
ADDED psl-1983/3-1/dist/20-copy.ctl
Index: psl-1983/3-1/dist/20-copy.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/20-copy.ctl
@@ -0,0 +1,15 @@
+! Master PSL Tape Copy
+! 12:31 pm Friday, 22 April 1983
+@enable ! so operators can read the files
+@set account small
+@assign mta0:
+@assign mta1:
+@MTU
+Tape mta0:
+Copy mta1:
+rew
+tape mta1:
+unload
+exit
+@deas mta0:
+@deas mta1:
ADDED psl-1983/3-1/dist/bboard.msg
Index: psl-1983/3-1/dist/bboard.msg
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/bboard.msg
@@ -0,0 +1,30 @@
+ Version 3.1 PSL Available
+
+We have just installed the latest version of Utah's PSL (Portable
+Standard LISP) system. This system is written almost entirely in
+itself, and is compiled with an efficient optimizing LISP compiler,
+with machine oriented extensions (called "SYSLISP"). The LISP itself
+is based on Utah Standard LISP, with modernizations and extensions
+derived from FranzLISP, Common-LISP, etc. PSL currently runs on
+DEC-20 under TOPS-20, VAX under UNIX, and a number of Motorola MC68000
+systems. Future implementations for VAX-VMS, CRAY-1, IBM-370 and extended
+addressing TOPS-20 are envisioned or already underway.
+
+In order to run PSL, you must use a set of logical names, defined
+in <name>MINIMAL-LOGICAL-NAMES.CMD. You should insert a @TAKE of this
+file in your LOGIN.CMD file.
+
+A printed copy of the preliminary PSL manual can be obtained from
+[........]; there is also a complete online version of this manual,
+organized as a set of files, one per chapter. These are stored as
+PLPT:nnnn-chaptername.LPT. PLEASE DO NOT print your own copy.
+
+There are a set of short HELP files, on directory PH:. To get started,
+read PH:PSL-INTRO.HLP.
+
+
+The licence agrrement under which we have recieved this version of PSL
+restricts it to our internal use. Please do not distribute the code (source
+or listings), or documentation outside of our group.
+
+If there are any problems, please MAIL to [.....].
ADDED psl-1983/3-1/dist/create-directories.ctl
Index: psl-1983/3-1/dist/create-directories.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/create-directories.ctl
@@ -0,0 +1,187 @@
+; Please edit this, and replace all <psl with <yourpslname
+@build <psl>
+@@perm 6400 ! choose appropriate size
+@@work 6400 ! nnnn+extra
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 30
+@@
+; 5230 pages for following. PSL: needs about 1100.
+; Single directory, partial restore needs about 1300 below and 1100 above.
+@build <psl.comp>
+@@perm 180 ! choose appropriate size
+@@work 180 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.comp.20>
+@@perm 55 ! choose appropriate size
+@@work 55 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.dist>
+@@perm 25 ! choose appropriate size
+@@work 25 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.doc>
+@@perm 725 ! choose appropriate size
+@@work 725 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 2
+@@
+@build <psl.doc.20>
+@@perm 25 ! choose appropriate size
+@@work 25 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.doc.nmode>
+@@perm 590 ! choose appropriate size
+@@work 590 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.glisp>
+@@perm 330 ! choose appropriate size
+@@work 330 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.help>
+@@perm 100 ! choose appropriate size
+@@work 100 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.kernel>
+@@perm 785 ! choose appropriate size
+@@work 785 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.kernel.20>
+@@perm 560 ! choose appropriate size
+@@work 560 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.lap>
+@@perm 500 ! choose appropriate size
+@@work 500 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.lpt>
+@@perm 430 ! choose appropriate size
+@@work 430 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.nmode>
+@@perm 510 ! choose appropriate size
+@@work 510 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.nmode.binary>
+@@perm 230 ! choose appropriate size
+@@work 230 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.nonkernel>
+@@perm 5 ! choose appropriate size
+@@work 5 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.tests>
+@@perm 715 ! choose appropriate size
+@@work 715 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.tests.20>
+@@perm 500 ! choose appropriate size
+@@work 500 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.util>
+@@perm 635 ! choose appropriate size
+@@work 635 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.util.20>
+@@perm 60 ! choose appropriate size
+@@work 60 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
+@build <psl.windows>
+@@perm 105 ! choose appropriate size
+@@work 105 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@max 1
+@@
+@build <psl.windows.binary>
+@@perm 30 ! choose appropriate size
+@@work 30 ! increase this as needed
+@@files-only ! Cant login
+@@gen 2 ! Retain 1 previous version
+@@protection 777700 ! Give group access
+@@default 777700 ! Give group access
+@@
ADDED psl-1983/3-1/dist/full-logical-names.cmd
Index: psl-1983/3-1/dist/full-logical-names.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/full-logical-names.cmd
@@ -0,0 +1,27 @@
+; Officially recognized logical names for FULL set of
+; PSL subdirectories on UTAH-20 for V3 PSL distribution
+; EDIT <PSL to your <name
+define psl: <psl> ! Executable files and miscellaneous
+define pc: <psl.comp> ! Compiler sources
+define p20c: <psl.comp.20> ! 20 Specific Compiler sources
+define pdist: <psl.dist> ! Distribution files
+define pd: <psl.doc> ! Documentation files
+define p20d: <psl.doc.20> ! 20 Specific Documentation
+define pndoc: <psl.doc.nmode> ! NMODE Documentation files
+; not distributed anymore define pe: <psl.emode> ! EMODE support and drivers
+define pg: <psl.glisp> ! Glisp sources
+define ph: <psl.help> ! Help files
+define pk: <psl.kernel> ! Kernel Source files
+define p20k: <psl.kernel.20> ! 20 Specific Kernel Sources
+define pl: <psl.lap> ! LAP files
+define plpt: <psl.lpt> ! Printer version of Documentation
+define pn: <psl.nmode> ! NMODE editor files
+define pnb: <psl.nmode.binary> ! NMODE editor binaries
+define pnk: <psl.nonkernel> ! PSL Non Kernel source files
+define pt: <psl.tests> ! Test files
+define p20t: <psl.tests.20> ! 20 Specific Test files
+define pu: <psl.util> ! Utility program sources
+define p20u: <psl.util.20> ! 20 Specific Utility files
+define pw: <psl.windows> ! NMODE Window files
+define pwb: <psl.windows.binary>! NMODE Window binaries
+take
ADDED psl-1983/3-1/dist/full-restore.ctl
Index: psl-1983/3-1/dist/full-restore.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/full-restore.ctl
@@ -0,0 +1,37 @@
+; Used to retrieve ALL ssnames for FULL PSL system
+; First edit FULL-LOGICAL-NAMES.CMD to reflect <name>
+; then TAKE to install names
+; then BUILD sub-directories
+; then mount TAPE, def X:
+@TERM PAGE 0
+@DUMPER
+*tape X:
+*density 1600
+*files
+*account system-default
+
+*; --- Skip over the logical names etc to do the restore.
+*skip 1
+*restore dsk*:<*>*.*.* PSL:*.*.*
+*restore dsk*:<*>*.*.* PC:*.*.*
+*restore dsk*:<*>*.*.* P20C:*.*.*
+*restore dsk*:<*>*.*.* PDIST:*.*.*
+*restore dsk*:<*>*.*.* PD:*.*.*
+*restore dsk*:<*>*.*.* P20D:*.*.*
+*restore dsk*:<*>*.*.* PNDOC:*.*.*
+; not distributed anymore *restore dsk*:<*>*.*.* PE:*.*.*
+*restore dsk*:<*>*.*.* PG:*.*.*
+*restore dsk*:<*>*.*.* ph:*.*.*
+*restore dsk*:<*>*.*.* pk:*.*.*
+*restore dsk*:<*>*.*.* p20:*.*.*
+*restore dsk*:<*>*.*.* pl:*.*.*
+*restore dsk*:<*>*.*.* plpt:*.*.*
+*restore dsk*:<*>*.*.* pn:*.*.*
+*restore dsk*:<*>*.*.* pnb:*.*.*
+*restore dsk*:<*>*.*.* pnk:*.*.*
+*restore dsk*:<*>*.*.* pT:*.*.*
+*restore dsk*:<*>*.*.* p20T:*.*.*
+*restore dsk*:<*>*.*.* pu:*.*.*
+*restore dsk*:<*>*.*.* p20u:*.*.*
+*restore dsk*:<*>*.*.* pw:*.*.*
+*restore dsk*:<*>*.*.* pwb:*.*.*
ADDED psl-1983/3-1/dist/make-bare-psl.ctl
Index: psl-1983/3-1/dist/make-bare-psl.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-bare-psl.ctl
@@ -0,0 +1,14 @@
+@define dsk: dsk:,p20:
+@S:BPSL.EXE
+*(lapin "psl.init")
+*(setq loaddirectories* '("" "pl:"))
+*(load char-macro))
+*(de gc-trap () nil)
+*(setq heap-warning-level 1000)
+*(setq options* nil)
+*(setq bug-mail-to "PSL")
+*(de versionname() "Extended-20 Bare PSL 3.1")
+*(savesystem (versionname) "s:bare-psl.exe" ())
+*(quit)
+;@rename S:BARE-PSL.EXE PSL:BARE-PSL.EXE
+;@set file autokeep PSL:BARE-PSL.EXE
ADDED psl-1983/3-1/dist/make-hp-psl.ctl
Index: psl-1983/3-1/dist/make-hp-psl.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-hp-psl.ctl
@@ -0,0 +1,22 @@
+@; This file constructs a new PSL containing many useful things, including:
+@;
+@; The NMODE (EMACS-like) editor and Lisp interface.
+@; The Lisp Machine Defstruct Facility.
+@; A set of "useful" things described in the manual.
+@;
+@; It creates a new executable file S:PSL.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@; PSL:PSL.EXE.
+@;
+@delete s:psl.exe
+@expunge s:
+@s:bare-psl random-argument-to-get-a-new-fork
+*(load useful nstruct debug find nmode init-file)
+*(nmode-initialize)
+*(nmode-switch-windows) % Switch to "OUTPUT" window
+*(set-message
+*"C-] E executes Lisp form on current line; C-] L gets normal PSL interface")
+*(savesystem "Extended-20 PSL 3.1" "s:psl.exe" '((read-init-file "psl")))
+*(quit)
+@reset .
+@set file autokeep s:psl.exe
ADDED psl-1983/3-1/dist/make-nmode.ctl
Index: psl-1983/3-1/dist/make-nmode.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-nmode.ctl
@@ -0,0 +1,15 @@
+; This file creates a new S:EX-NMODE.EXE, replacing the old one.
+; NOTE: the compiler is also loaded, as most users will need it.
+@delete s:nmode.exe,
+@exp
+@
+@s:bare-psl random-argument-to-get-a-new-fork
+*(load nmode)
+*(load compiler)
+*(nmode-initialize)
+*(setf nmode-auto-start T)
+*(setf prinlevel 2)
+*(savesystem "Extended 20-PSL 3.1 NMODE" "S:NMODE.EXE" ())
+*(quit)
+@reset .
+
ADDED psl-1983/3-1/dist/make-psl.ctl
Index: psl-1983/3-1/dist/make-psl.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-psl.ctl
@@ -0,0 +1,9 @@
+@; This file constructs a new PSL containing many useful things, including:
+@; It creates a new executable file S:EX-PSL.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@;
+@s:bare-psl random-argument-to-get-a-new-fork
+*(load init-file homedir)
+*(savesystem "Extended 20-PSL 3.1" "s:psl.exe" '((read-init-file "psl")))
+*(quit)
+@reset .
ADDED psl-1983/3-1/dist/make-pslcomp.ctl
Index: psl-1983/3-1/dist/make-pslcomp.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-pslcomp.ctl
@@ -0,0 +1,19 @@
+@; This file constructs a new PSLCOMP.
+@;
+@; It creates a new executable file S:PSLCOMP.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@; PSL:PSLCOMP.EXE.
+@;
+@delete s:pslcomp.exe,
+@expunge
+@
+@s:bare-psl random-argument-to-get-a-new-fork
+* (load pslcomp-main init-file)
+* % The following things are loaded because their definitions are useful
+* % when users compile things:
+* (load objects common strings pathnames fast-vector nstruct)
+* (savesystem "Extended 20-PSL Compiler 3.1"
+* "s:pslcomp.exe"
+* '((read-init-file "pslcomp")))
+* (quit)
+@reset .
ADDED psl-1983/3-1/dist/make-rlisp.ctl
Index: psl-1983/3-1/dist/make-rlisp.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-rlisp.ctl
@@ -0,0 +1,7 @@
+@S:BARE-PSL.EXE random-argument-to-get-a-new-fork
+*((lambda (loaddirectories!*)
+ (load compiler rlisp init-file))
+ '("" "pl:"))
+*(SaveSystem "Extended 20-PSL 3.1 RLisp" "S:RLISP.EXE" '((read-init-file "rlisp")))
+*(quit)
+@reset .
ADDED psl-1983/3-1/dist/make-rlispcomp.ctl
Index: psl-1983/3-1/dist/make-rlispcomp.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-rlispcomp.ctl
@@ -0,0 +1,18 @@
+@; This file constructs a new RLISPCOMP.
+@;
+@; It creates a new executable file S:RLISPCOMP.EXE, first deleting any previous
+@; versions and expunging. When approved, this file should be renamed to
+@; PSL:RLISPCOMP.EXE.
+@;
+@delete s:rlispcomp.exe
+@expunge s:
+@s:bare-psl random-argument-to-get-a-new-fork
+* (load rlisp rlispcomp init-file if-system monsym)
+* % The following things are loaded because their definitions are useful
+* % when users compile things:
+* (load objects common strings pathnames fast-vector nstruct)
+* (savesystem "Extended-20 RLISP Compiler 3.1"
+* "s:rlispcomp.exe"
+* '((read-init-file "rlispcomp")(rlispcomp)))
+* (quit)
+@reset .
ADDED psl-1983/3-1/dist/make-vdir.ctl
Index: psl-1983/3-1/dist/make-vdir.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/make-vdir.ctl
@@ -0,0 +1,8 @@
+; Command file to produce a directory listing for comparison.
+@vd psl:,pc:,p20c:,phpc:,pvc:,pdist:,p20dist:,phpdist:,pvdist:,pd:,p20d:,phpd:,pndoc:,pvd:,pe:,pg:,ph:,pk:,p20:,php:,pv:,plap:,plpt:,pm:,pnew:,pn:,pnk:,psup:,p20sup:,phpsup:,pvsup:,pt:,p20t:,phpt:pvt:,pu:,p20u:,phpu:,pvu:,pw:,
+@out s:vdirectory.dir
+@no times
+@no user
+@no protection
+@date
+@
ADDED psl-1983/3-1/dist/minimal-logical-names.cmd
Index: psl-1983/3-1/dist/minimal-logical-names.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/minimal-logical-names.cmd
@@ -0,0 +1,27 @@
+; Officially recognized logical names for MINIMAL
+; PSL system, in single directory
+; EDIT <psl> into <name> as appropriate
+define psl: <psl> ! Executable files and miscellaneous
+;define pc: <psl> ! Compiler sources
+;define p20c: <psl> ! 20 Specific Compiler sources
+;define pdist: <psl> ! Distribution files
+;define pd: <psl> ! Documentation files
+;define p20d: <psl> ! 20 Specific Documentation files
+;define pndoc: <psl> ! NMODE Documentation files
+; not distributed define pe: <psl> ! EMODE support and drivers
+;define pg: <psl> ! GLISP source
+define ph: <psl> ! Help files
+;define pk: <psl> ! Kernel Source files
+;define p20k: <psl> ! 20 Specific Kernel Sources
+define pl: <psl> ! LAP files
+;define plpt: <psl> ! Printer version of Documentation
+;define pn: <psl> ! NMODE editor files
+define pnb: <psl> ! NMODE editor binaries
+;define pnk: <psl> ! PSL Non Kernel source files
+;define pt: <psl> ! PSL Test files
+;define p20t: <psl> ! PSL 20 Specific Test files
+;define pu: <psl> ! Utility program sources
+;define p20u: <psl> ! 20 specific Utility files
+;define pw: <psl> ! NMODE Window files
+define pwb: <psl> ! NMODE Window binaries
+take
ADDED psl-1983/3-1/dist/minimal-restore.ctl
Index: psl-1983/3-1/dist/minimal-restore.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/minimal-restore.ctl
@@ -0,0 +1,54 @@
+; Used to retrieve subset of ssnames for MINIMAL PSL system
+; First edit MINIMAL-LOGICAL-NAMES.CMD to reflect <name>
+; then TAKE to install names
+; then BUILD sub-directories or single directory
+; then mount TAPE, def X:
+@DUMPER
+*tape X:
+*density 1600
+*files
+*account system-default
+
+*; --- Skip over the logical names etc to do the restore.
+*skip 1
+*restore dsk*:<*>*.*.* PSL:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* PC:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* P20C:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* PDIST:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* PD:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* P20D:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* PNDOC:*.*.*
+*skip 1
+; --- not distributed anymore --- *restore dsk*:<*>*.*.* pe:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* pg:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* ph:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* pk:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* p20:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* pl:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* plpt:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pn:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* pnb:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* pnk:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pT:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* p20T:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pu:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* p20u:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pw:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* pwb:*.*.*
+
ADDED psl-1983/3-1/dist/rlisp-save.ctl
Index: psl-1983/3-1/dist/rlisp-save.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/rlisp-save.ctl
@@ -0,0 +1,6 @@
+cd S:
+PSL:PSL.EXE
+(LOAD RLISP COMPILER)
+(SaveSystem "PSL 3.0 Rlisp")
+(quit)
+rename PSL-SAVE.EXE PSL:RLISP.EXE
ADDED psl-1983/3-1/dist/thor-xfer.ctl
Index: psl-1983/3-1/dist/thor-xfer.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/dist/thor-xfer.ctl
@@ -0,0 +1,66 @@
+;;; File of commands to transfer PSL support from HULK to THOR
+;;; Cris Perdue 3-2-83
+
+;;; The user this job runs under must have a CFTP.CMD file that
+;;; logs in as guest and gives the guest password when connected to THOR.
+
+cftp thor
+take p20sup:cftp-thor.cmd
+
+; The blank line after each wildcard send tells CFTP that its
+; default destination is OK.
+
+; Using "delete" makes this file liable to fail because if the
+; deletion can't be done, a "?" message is put out, stopping the
+; batch job. There is enough extra space to make it unnecessary
+; right now.
+
+; Delete the .EXE files so there is room in the directory.
+; delete psl.exe
+; delete bare-psl.exe
+
+send p20sup:thor-names.cmd
+logical-names.cmd
+expunge
+
+send plap:*.b
+
+expunge
+
+send plap:*.lap
+
+expunge
+
+send ph:help.tbl
+help.tbl
+send ph:*.hlp
+
+expunge
+
+send pnb:*.b
+
+expunge
+
+send pwb:*.b
+
+expunge
+
+send psl:psl.exe
+psl.exe
+expunge
+
+send psl:bare-psl.exe
+bare-psl.exe
+expunge
+
+exit
+
+reset .
+
+submit p20sup:thor-xfer.ctl /after:+168:00 /restartable:yes
+mail perdue, kendzierski
+THOR file transfer
+The weekly PSL file transfer to Thor has completed and next
+week's job has been submitted.
+
+
ADDED psl-1983/3-1/doc/20/20-dist.err
Index: psl-1983/3-1/doc/20/20-dist.err
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/20/20-dist.err
@@ -0,0 +1,13 @@
+@Comment{ErrLog of 20-DIST.MSS.9 by Scribe 3C(1265) on 26 April 1983 at 14:37}
+
+Error in text found while processing the manuscript.
+20-DIST.MSS.9 line 349:
+Widow line.
+
+Error in text.
+20-DIST.MSS.9 line 428:
+Widow line.
+
+Error in text.
+20-DIST.MSS.9 line 539:
+Widow line.
ADDED psl-1983/3-1/doc/20/20-dist.lpt
Index: psl-1983/3-1/doc/20/20-dist.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/20/20-dist.lpt
@@ -0,0 +1,710 @@
+Utah Symbolic Computation Group June 1983
+Operating Note No. xx
+
+
+
+
+
+
+
+
+
+
+
+
+ Release Notes
+
+ Extended DEC-20 V3.1 PSL System
Extended DEC-20 V3.1 PSL System
Extended DEC-20 V3.1 PSL System
+
+
+ M. L. Griss and R. R. Kessler
+
+ Utah Symbolic Computation Group
+ Computer Science Department
+ University of Utah
+ Salt Lake City, Utah 84112
+ (801)-581-5017
+
+ 20 June 1983
+
+
+
+
+ ABSTRACT
ABSTRACT
ABSTRACT
+
+
+This note describes how to install the extended DEC-20 version of
+PSL.
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Work supported in part by the National Science Foundation under
+Grants MCS80-07034 and MCS81-21750, and by development grants
+from Boeing, Patil Systems, Lucas Film, Wicat and Hewlett
+Packard.
DEC-20 PSL Release Page 2
+
+
+1. INTRODUCTION
1. INTRODUCTION
1. INTRODUCTION
+
+ The attached DUMPER format tape contains most of the files
+needed to use and maintain the DEC-20 PSL system. At UTAH we have
+a <PSL> main directory, with a number of sub-directories, each
+containing a separate class of file, such as common interpreter
+and compiler sources, DEC-20 sources, VAX sources, 68000 sources,
+help files, etc. This multi-directory structure enables us to
+manage the sources for all machines in a reasonable way. Most
+people running PSL on the DEC-20 will not be interested in all of
+the files, and certainly will not want to have them all on line.
+
+
+ We have therefore created the tape to enable either a
+multi-directory or single directory model; a set of logical
+device definitions will be TAKEn by the user (usually inserted in
+the LOGIN.CMD file). Each separate distribution directory is a
+separate SAVESET on the attached dumper format tape, and so may
+be individually restored into a common (<PSL> at Utah) directory,
+or into appropriate sub-directories (<PSL.*> at Utah).
+
+
+
+2. DISCLAIMER
2. DISCLAIMER
2. DISCLAIMER
+
+ Please be aware that this is a PRELIMINARY release, and some of
+the files and documentation are not quite complete; we may also
+have forgotten some files, or sent incorrect versions. We are
+releasing this preliminary version to you at this time to enhance
+our collaborative research, and we expect the files to continue
+to change quite rapidly as the system and distribution is tested.
+
+
+ For these reasons please:
+
+
+ a. Make a note of ANY problems, concerns, suggestions you
+ have, and send this information to us to aid in
+ improving the system and this distribution mechanism.
+
+ b. Please do not REDISTRIBUTE any of these files,
+ listings or machine readable form to anyone, and try
+ to restrict access to a small group of users.
+
+
+
+3. CONTENTS OF THE TAPE
3. CONTENTS OF THE TAPE
3. CONTENTS OF THE TAPE
+
+ Attached to this note is a copy of the DUMPER run that created
+the tape, indicating the savesets, the file names, and sizes
+needed to restore each saveset.
DEC-20 PSL Release Page 3
+
+
+ The following lists each of the savesets, their logical names,
+sizes and whether or not it is included in the saveset:
+
+
+SSname Pages Min <Utah File Name> Logical Name
+
+RESTORE-PSL 10 NO ---- ----
+ Files necessary to restore the PSL system.
+
+PSL 1100 YES <psl> psl:
+ The executable files (PSL.EXE and RLISP.EXE),
+ this 20-DIST.DOC file, .CMD files to define
+ appropriate logical names and a sample message to
+ announce PSL availability. Also, included are a
+ number of news files announcing new features and
+ changes, some files associated with the NMODE
+ editor and a version of psl (PSLCOMP.EXE) that
+ will compile the argument on the execution line.
+
+COMP 125 NO <psl.comp> pc:
+ Common compiler, LAP, FASL sources.
+
+20COMP 55 NO <psl.comp.20> p20c:
+ DEC-20 specific compiler, LAP and FASL sources.
+
+DIST 25 NO <psl.dist> pdist:
+ Files as an aid to the installer.
+
+DOC 110 NO <psl.doc> pdoc:
+ Miscellaneous documentation files, including
+ random notes on new features.
+
+20DOC 25 NO <psl.doc.20> p20d:
+ Documentation files that are 20 specific.
+
+DOCNMODE 590 NO <psl.doc.nmode> pndoc:
+ NMODE documentation files.
+
+GLISP 330 NO <psl.glisp> pg:
+ An object oriented LISP.
+
+HELP 100 YES <psl.help> ph:
+ A set of *.HLP files, describing major modules.
+
+KERNEL 225 NO <psl.kernel> pk:
+ Machine Independent kernel sources.
+
+P20 560 NO <psl.kernel.20> p20:
+ DecSystem 20 dependent kernel sources.
+
+LAP 500 YES <psl.lap> pl:
+ Mostly binary FASL (*.B) files, with some LISP
DEC-20 PSL Release Page 4
+
+
+ files (*.LAP) for loading multiple .B files of
+ loadable (optional) modules.
+
+LPT 430 NO <psl.lpt> plpt:
+ The PSL manual in printable form (has
+ overprinting and underlining), as SCRIBE .LPT
+ files.
+
+NMODE 270 NO <psl.nmode> pn:
+ The NMODE text editor sources, which is a newer
+ version of EMODE developed at HP Research
+ Laboratories.
+
+NMODEBIN 230 YES <psl.nmode.binary> pnb:
+ The binary files associated with NMODE.
+
+NONKERNEL 5 NO <psl.nonkernel> pnk:
+ The sources that are not in the kernel, but are
+ kernel related.
+
+PT 215 NO <psl.tests> pt:
+ A set of timing and test files.
+
+P20T 500 NO <psl.tests.20> p20t:
+ DecSystem 20 specific test files.
+
+UTIL 575 NO <psl.util> pu:
+ Sources for most utilities, useful as examples of
+ PSL and RLISP code, and for customization.
+
+P20U 60 NO <psl.util.20> p20u:
+ DecSystem 20 specific utilities.
+
+WINDOWS 75 NO <psl.windows> pw:
+ The window support functions used by NMODE.
+
+WINBIN 30 YES <psl.windows.binary> pwb:
+ The binaries associated with the window support.
+
+
+
+4. INSTALLING PSL
4. INSTALLING PSL
4. INSTALLING PSL
+
+ When installing the PSL system, you have two options for the
+directory structure. You may utilize a single directory for all
+of the file, or you may create a directory tree using
+subdirectories. The Utah group utilizes a directory tree
+structure and recommends its use when installing a "full" system
+(that includes all of the sources and the capability of
+rebuilding any part of the system). However, if only a minimal
+system is desired, it can be accomplished using a single
+directory.
DEC-20 PSL Release Page 5
+
+
+4.1. Retrieve Control Files
4.1. Retrieve Control Files
4.1. Retrieve Control Files
+
+ Whether building a single directory system or multiple
+directory system, logical name definition files and file restore
+control files must be first retrieved. Therefore, first mount
+the dumper tape, at 1600 BPI (verify that there is no write ring
+in the tape). Then, define X: as the appropriate tape device,
+MTAn:, or use MOUNT if running a labeled tape system:
+
+
+@DEFINE X: MTAn: or @MOUNT TAPE X:
+@ASSIGN X:
+
+
+ Restore from the first saveset (PSL) the .cmd and .ctl files
+
+
+ @DUMPER
+ *tape X:
+ *density 1600
+ *files
+ *account system-default
+ *restore <*>*.*.* *.*.*
+
+
+These files will be restored to your connected directory, and
+should be copied to your main PSL directory after their creation.
+
+
+4.2. Create a single subdirectory
4.2. Create a single subdirectory
4.2. Create a single subdirectory
+
+ Create a directory, call it <name> and define a logical device
+PSL: (a size of about 2400 should be sufficient).
+
+
+ Any <name> will do, since the logical device name PSL: will be
+used.
+
+
+ @DEF PSL: <name>
+
+
+ Copy the minimal-* restored files to PSL
+
+
+ @COPY minimal-*.* PSL:*.*
+
+
+ Now edit the file PSL:minimal-logical-names.cmd to reflect the
+your choice of <name>.
DEC-20 PSL Release Page 6
+
+
+ Also put @TAKE <name>minimal-logical-names.cmd in your
+LOGIN.CMD.
+
+
+ Finally, restore the minimal system by DOing the minimal-
+restore.ctl file:
+
+
+ @DO MINIMAL-RESTORE
+ @DEASSIGN X: or @DISMOUNT X:
+
+
+4.3. A MULTIPLE SUB-DIRECTORY SYSTEM
4.3. A MULTIPLE SUB-DIRECTORY SYSTEM
4.3. A MULTIPLE SUB-DIRECTORY SYSTEM
+
+ If you plan to do much source modification, or a significant
+number of rebuilds, or maintain a compatible multiple-machine
+version of PSL, or attempt retargeting of PSL, a multiple-
+directory structure such as that at UTAH should be built.
+
+
+ The file FULL-LOGICAL-NAMES.CMD, retrieved above should be used
+as a guide to building the sub-directories. We currently use 18
+sub-directories for the Common Sources and DEC-20 specific
+sources, and have at least an extra three for each new machine.
+Consult the 20-DIST.LOG file supplied with the PSL tape as a
+guide for the amount of space required for each sub-directory.
+The current set of directories for DEC-20 PSL, the logical names
+that we use, and rough space estimate follows. Build the
+sub-directories with a somewhat larger working space allocation.
+
+
+ Now edit the file PSL:full-logical-names.cmd to reflect the
+your choice of <name> along with the create-directories.ctl file.
+
+
+ Also put @TAKE <name>full-logical-names.cmd in your LOGIN.CMD.
+
+
+4.4. Build Sub-Directories
4.4. Build Sub-Directories
4.4. Build Sub-Directories
+
+ Then use the system command, BUILD, to build each sub-directory
+with the name Pxxx:, as follows. Assistance from the system
+manager may be required to permit the creation of
+sub-directories, and the appropriate choice of sub-directory
+parameters:
DEC-20 PSL Release Page 7
+
+
+ @BUILD Pxxx:
+ @@PERM nnnn ! choose appropriate size
+ @@WORK wwww ! nnnn+extra
+ @@FILES-ONLY ! Can't login
+ @@GEN 2 ! Retain 1 previous version
+ @@PROTECTION 777700 ! Give group access
+ @@DEFAULT 777700
+ @ ! that are permitted access
+
+
+ To make this process easier, we have created a control file:
+CREATE-DIRECTORIES.CTL that will build all of the subdirectories
+with sizes such that restoration of the files will succeed.
+Therefore, after editing the full-logical-names.cmd file above to
+reflect the correct logical names, simply DO the CTL file (some
+systems use MIC instead of DO, so that may be substituted in the
+following examples) :
+
+
+ @DO CREATE-DIRECTORIES.CTL
+
+
+ This will create all of the necessary directories.
+
+
+ Finally, restore the full system by DOing the full-restore.ctl
+file:
+
+
+ @DO FULL-RESTORE
+ @DEASSIGN X: or @DISMOUNT X:
+
+
+4.5. Announce the System
4.5. Announce the System
4.5. Announce the System
+
+ Send out a Message to all those interested in using PSL. The
+file BBOARD.MSG is a suggested start.
+
+
+ Edit as you see fit, but please REMIND people not to
+re-distribute the PSL system and sources.
+
+
+ You may also want to set the directory protection to 775200 and
+limit access only to those that you feel should have access at
+this time.
DEC-20 PSL Release Page 8
+
+
+4.6. Summary of Restoration Process
4.6. Summary of Restoration Process
4.6. Summary of Restoration Process
+
+ In summary, first retrieve the cmd and ctl files from the first
+saveset on the DUMPER tape. Then choose a single or multiple
+directory system and edit the appropriate logical name file to
+reflect the directory name(s). If creating a multiple directory
+system use the create-directories.ctl control file to build each
+directory. Then run the appropriate file retrieval control file.
+Finally, announce the system to any interested users.
+
+
+
+5. REBUILDING LOADABLE MODULES
5. REBUILDING LOADABLE MODULES
5. REBUILDING LOADABLE MODULES
+
+ Most of the utilities, and many of the more experimental parts
+of the system are kept as binary FASL files (with extensions .b)
+on the PL: directory. NMODE is currently the only major
+sub-system that has its own set of sub-directories. In some cases
+(usually large sub-systems, or sub-systems that share modules)
+there are a number of .B files, and a .LAP file that loads each
+.B file in turn. The PSL LOAD function will look first for a .B
+file, then a .LAP file first on the user directory, then on PL:
+(both this "search" path and the order of extensions can be
+changed).
+
+
+ In order to ease the task of rebuilding and modifying the .B
+files, we have a small utility, BUILD. To use BUILD for a module
+you call xxxx, prepare a file called xxxx.BUILD, which has RLISP
+syntax commands for loading the appropriate source files. The
+file can also have various CompileTime options, including the
+loading of various .B files to set up the correct compilation
+environment.
+
+
+ Then run PSL:RLISP, LOAD BUILD; and finally enter BUILD 'xxxx;
+this will do a FASLOUT to "PL:xxxx", input the xxxx.BUILD file,
+and finally close the FASL file.
+
+
+ The target file "PL:xxxx" is constructed using the variable
+"BuildFileFormat!*", initialized in the file PU:Build.Red .
+
+
+ For example, consider the contents of PU:Gsort.Build:
+
+
+ CompileTime load Syslisp;
+ in "gsort.red"$
+
+
+ Note that the SYSLISP module is required, since some of the
DEC-20 PSL Release Page 9
+
+
+fast sorting functions in GSORT are written in SYSLISP mode.
+
+
+ GSORT is then rebuilt by the sequence:
+
+
+ PSL:RLISP
+ LOAD BUILD;
+ BUILD 'GSORT;
+ QUIT;
+
+
+ This is such a common sequence that a MIC file (MIC is a
+parameterized DO facility) PU:BUILD.MIC is provided, and is used
+by passing the module name to MIC, after connecting to PU:
+
+
+ @mic BUILD GSORT
+
+
+ is all that is required.
+
+
+
+6. REBUILDING THE INTERPRETER
6. REBUILDING THE INTERPRETER
6. REBUILDING THE INTERPRETER
+
+ A running `rlisp' is required to rebuild the basic interpreter,
+since the entire system is written in itself. The kernel
+modules, rather than being compiled to FASL files, are compiled
+ _____ ____
to assembly code (MACRO) and linked using the system loader LINK.
+ ____ _____ _____ ___
The command file P20C:DEC20-cross.CTL is executed to produce the
+ _ _____ _____
cross compiler, S:DEC20-cross (S: should be set to an appropriate
+scratch directory). The modules in the kernel are represented by
+ ___ _____ __ ______ __ __
the files P20:*.build. There is a program PU:kernel.sl or
+__ ______ _
PL:kernel.b which generates command files for building the kernel
+ ___ __ ______ ___ __
when parameterized for Tops-20 by P20:20-kernel-gen.sl. The
+specific modules which are in the kernel are only listed in this
+ ______
file, in the call to the function kernel. This generates a file
+____ ___ ____ _____
xxxx.CTL for each xxxx.build.
+
+
+6.1. Complete Kernel Rebuild
6.1. Complete Kernel Rebuild
6.1. Complete Kernel Rebuild
+
+ A complete rebuild is accomplished by the following steps. At
+Utah we use a <scratch> directory for some intermediate files.
+Define S: to be this directory or some other appropriate
+location that can be deleted when done. Below we use @SUBMIT
+xxxx.CTL to run batch jobs; on some systems, @DO xxxx.CTL can be
+used instead, or on others, @MIC xxxx.CTL may be used.
+
+
+ Begin by defining S: as <scratch> or other scratch directory:
DEC-20 PSL Release Page 10
+
+
+ @DEFINE S: <scratch>
+
+
+ Now connect to <psl.20-comp> and rebuild DEC20-CROSS.EXE:
+
+
+ @CONN P20C:
+
+
+ @SUBMIT DEC20-CROSS.CTL
+
+
+ Copy the <psl.comp>BARE-PSL.SYM to 20.SYM, and regenerate the
+appropriate .CTL files. This saves the old 20.SYM as
+PREVIOUS-20.SYM:
+
+
+ @CONN P20:
+
+
+ @SUBMIT P20:FRESH-KERNEL.CTL
+
+
+ Rebuild each module (xxxx) in turn, using its xxxx.CTL. This
+creates xxxx.MAC and Dxxxx.MAC files, and assembles each to make
+xxxx.REL and Dxxxx.REL. The entire set is submitted with the
+file ALL-KERNEL.CTL, which submits each file in turn. (Note that
+these must be done sequentially, not simultaneously. If you have
+more than one batch stream, make sure that these are run one at a
+time):
+
+
+ @SUBMIT ALL-KERNEL.CTL
+
+
+ Build the main module, which converts the accumulated 20.SYM
+into heap and symbol-table initialization:
+
+
+ @SUBMIT P20:MAIN.CTL
+
+
+ Finally LINK the xxxx.REL and Dxxxx.REL files to produce
+S:BARE-PSL.EXE:
+
+
+ @SUBMIT P20:PSL-LINK.CTL
+
+
+ Execute and save as PSL.EXE, reading appropriate xxxx.INIT
+files (note, each site usually customizes the PSL environment to
+suit their needs, therefore we recommend that you create your own
DEC-20 PSL Release Page 11
+
+
+version of Make-psl.ctl to perform this task).
+
+
+ @SUBMIT PDIST:MAKE-PSL.CTL
+
+
+ Finally, run MAKE-RLISP.CTL as needed:
+
+
+ @SUBMIT PDIST:MAKE-RLISP.CTL
+
+
+ Rlisp.exe and Psl.exe will be saved on the <PSL> directory.
+You now may want to delete any xxx.log files that where created.
+
+
+ You may also remake, RLISPCOMP, PSLCOMP and NMODE, in a similar
+manner.
+
+
+ @DEL P20:*.LOG
+ @DEL P20C:*.LOG
+
+
+6.2. Partial or Incremental Kernel Rebuild
6.2. Partial or Incremental Kernel Rebuild
6.2. Partial or Incremental Kernel Rebuild
+
+ Often, only a single kernel file needs to be changed, and a
+complete rebuild is not needed. The PSL kernel building process
+permits a (semi-)independent rebuilding of modules, by
+maintaining the 20.SYM file to record Identifier Numbers, etc.
+The 20.SYM file from the recent full-rebuild, and xxxx.INIT files
+are required, as are the "xxxx.REL" and "Dxxxx.REL". The partial
+rebuild will replace the "mmmm.REL", "Dmmmm.REL" and "mmmm.INIT"
+files, modify "20.SYM", and then rebuild the MAIN module.
+Assuming that a recent full rebuild has been done, a partial
+rebuild of module "mmmm", is accomplished by the following steps.
+
+
+ As above, S: is required for "Scratch" space.
+
+
+ Define S: as <scratch> or other scratch directory:
+
+
+ @DEFINE S: <scratch>
+
+
+ Rebuild DEC20-CROSS.EXE, if needed:
+
+
+ @SUBMIT P20C:DEC20-CROSS.CTL
DEC-20 PSL Release Page 12
+
+
+ Rebuild the module (mmmm), using its mmmm.CTL. This creates
+mmmm.MAC and Dmmmm.MAC files, and assembled each to make mmmm.REL
+and Dmmmm.REL. See the file ALL-KERNEL.CTL for current modules.
+
+
+ @SUBMIT P20:mmmm.CTL
+ Other modules can be done after this
+
+
+ Rebuild the main module, which converts the accumulated 20.SYM
+into heap and symbol-table initialization: (This step can be
+omitted if 20.SYM has not been changed by the incremental
+recompilation.)
+
+
+ @SUBMIT P20:MAIN.CTL
+
+
+ Finally LINK the xxxx.REL and Dxxxx.REL files to produce
+S:BARE-PSL.EXE:
+
+
+ @SUBMIT P20:PSL-LINK.CTL
+
+
+ Execute and save as PSL.EXE, reading appropriate xxxx.INIT
+files:
+
+
+ @SUBMIT PDIST:MAKE-PSL.CTL
+
+
+ Finally, run MAKE-RLISP as needed:
+
+
+ @SUBMIT PDIST:MAKE-RLISP.CTL
+
+
+ You may also remake, RLISPCOMP, PSLCOMP and NMODE, in a similar
+manner.
+
+
+ Note that 20.SYM may be changed slightly to reflect any new
+symbols encountered, and certain generated symbols. Occasionally,
+repeated building of certain modules can cause 20.SYM to grow,
+and then a full rebuild may be required.
DEC-20 PSL Release Page 13
+
+
+6.3. Rebuilding RLISP.EXE from PSL.EXE
6.3. Rebuilding RLISP.EXE from PSL.EXE
6.3. Rebuilding RLISP.EXE from PSL.EXE
+
+ The PSL executable file, PSL.EXE, is a fairly bare system, and
+is usually extended by loading appropriate utilities, and then
+saving this as a new executable. We have provided RLISP.EXE,
+which includes the compiler, and the RLISP parser. RLISP.EXE is
+built from PSL.EXE by the following commands:
+
+
+ @TAKE PSL:minimal-logical-names.cmd
+ @PSL:PSL.EXE
+ (LOAD COMPILER RLISP INIT-FILE)
+ % Also LOAD any other modules that
+ % should be in your "standard" system
+ (SAVESYSTEM "PSL 3.1 Rlisp" "PSL:rlisp.exe" '((Read-init-file
+ "rlisp")))
+ % The string is the Welcome Message, the save file
+ % name and the startup expression to read rlisp.init.
+ (QUIT)
+
+
+ We have provided a command file, PDIST:MAKE-RLISP.CTL for this
+purpose. Edit it to reflect any modules that local usage desires
+in the basic system (PRLISP, USEFUL, etc. are common choices).
+
+
+ In a similar fashion, a customized PSL.EXE could be maintained
+instead of the "bare" version we provide. In order to avoid
+destroying PSL entirely, we suggest that you maintain a copy of
+the supplied PSL.EXE as BARE-PSL.EXE, and customize your PSL.EXE
+from it.
+
+
+
+7. RELATIONSHIP TO PSL 3.0
7. RELATIONSHIP TO PSL 3.0
7. RELATIONSHIP TO PSL 3.0
+
+ Even though this is the first version of PSL for the
+DecSystem-20 that utilizes extended addressing, it is identical
+to the PSL V3.1 for the non-extended 20. As a new PSL version
+3.1, it is a complete release, and totally replaces the previous
+PSL 3.0 that underwent limited distribution. The files
+__ ___ ___ ___ __ ____ ___
pd:bug-fix.log and pd:bugs.txt record many of the changes and bug
+fixes that occurred since version 3.0.
+
+
+
+8. FUTURE UPDATES
8. FUTURE UPDATES
8. FUTURE UPDATES
+
+ It is currently envisioned that future updates will still be
+complete releases. It is therefore suggested that you
DEC-20 PSL Release Page 14
+
+
+ a. Retain this distribution tape in case you may have to
+ compare files.
+
+ b. Do not make any changes on these distributed
+ directories. If you must make your own bug fixes, it
+ is suggested that you put the changed files on some
+ ____
other directories, such as pnew:. They can then be
+ compared with any new files sent out in subsequent
+ releases.
DEC-20 PSL Release Page i
+
+
+ Table of Contents
Table of Contents
Table of Contents
+
+1. INTRODUCTION 2
+2. DISCLAIMER 2
+3. CONTENTS OF THE TAPE 2
+4. INSTALLING PSL 4
+ 4.1. Retrieve Control Files 5
+ 4.2. Create a single subdirectory 5
+ 4.3. A MULTIPLE SUB-DIRECTORY SYSTEM 6
+ 4.4. Build Sub-Directories 6
+ 4.5. Announce the System 7
+ 4.6. Summary of Restoration Process 8
+5. REBUILDING LOADABLE MODULES 8
+6. REBUILDING THE INTERPRETER 9
+ 6.1. Complete Kernel Rebuild 9
+ 6.2. Partial or Incremental Kernel Rebuild 11
+ 6.3. Rebuilding RLISP.EXE from PSL.EXE 13
+7. RELATIONSHIP TO PSL 3.0 13
+8. FUTURE UPDATES 13
ADDED psl-1983/3-1/doc/20/20-dist.mss
Index: psl-1983/3-1/doc/20/20-dist.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/20/20-dist.mss
@@ -0,0 +1,539 @@
+@make(article)
+@Case(Draft, 1 <@device(Omnitech)>,
+ else <@device(LPT)>
+ )
+@Style(WidowAction=warn)
+@Style(Hyphenation Off) @comment(on)
+@Style(DoubleSided no) @comment(yes)
+@style(Spacing 1)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(itemize,spread 1)
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "June 1983",
+ Line "Operating Note No. xx"
+ )
+@set(page=1)
+@newpage()
+@Begin(TitlePAge)
+@begin(TitleBox)
+@center[Release Notes
+
+@b(Extended DEC-20 V3.1 PSL System)
+
+
+M. L. Griss and R. R. Kessler
+
+Utah Symbolic Computation Group
+Computer Science Department
+University of Utah
+Salt Lake City, Utah 84112
+(801)-581-5017
+
+@value(date)]
+@end(TitleBox)
+@begin(abstract)
+This note describes how to install the extended DEC-20 version of PSL.
+@end(abstract)
+@begin(ResearchCredit)
+Work supported in part by the National Science Foundation
+under Grants MCS80-07034 and MCS81-21750, and by development
+grants from Boeing, Patil Systems,
+Lucas Film, Wicat and Hewlett Packard.
+@end(ResearchCredit)
+@end(TitlePage)
+@pageheading(Left "DEC-20 PSL Release",
+ Right "Page @Value(Page)"
+ )
+@newpage()
+@section(INTRODUCTION)
+
+ The attached DUMPER format tape contains most of the files needed to
+use and maintain the DEC-20 PSL system. At UTAH we have a <PSL> main
+directory, with a number of sub-directories, each containing a separate
+class of file, such as common interpreter and compiler sources, DEC-20
+sources, VAX sources, 68000 sources, help files, etc. This multi-directory
+structure enables us to manage the sources for all machines in a reasonable
+way. Most people running PSL on the DEC-20 will not be interested in all of
+the files, and certainly will not want to have them all on line.
+
+ We have therefore created the tape to enable either a multi-directory
+or single directory model; a set of logical device definitions will be
+TAKEn by the user (usually inserted in the LOGIN.CMD file). Each separate
+distribution directory is a separate SAVESET on the attached dumper format
+tape, and so may be individually restored into a common (<PSL> at Utah)
+directory, or into appropriate sub-directories (<PSL.*> at Utah).
+
+@section(DISCLAIMER)
+
+ Please be aware that this is a PRELIMINARY release, and some of the
+files and documentation are not quite complete; we may also have forgotten
+some files, or sent incorrect versions. We are releasing this preliminary
+version to you at this time to enhance our collaborative research, and we
+expect the files to continue to change quite rapidly as the system and
+distribution is tested.
+
+ For these reasons please:
+@begin(enumerate)
+Make a note of ANY problems, concerns, suggestions you have, and
+send this information to us to aid in improving the system and this
+distribution mechanism.
+
+Please do not REDISTRIBUTE any of these files, listings or machine
+readable form to anyone, and try to restrict access to a small group
+of users.
+@end(enumerate)
+@section(CONTENTS OF THE TAPE)
+ Attached to this note is a copy of the DUMPER run that created the
+tape, indicating the savesets, the file names, and sizes needed to restore
+each saveset.
+
+The following lists each of the savesets, their logical names, sizes and
+whether or not it is included in the saveset:
+@begin(Description, spread 1)
+SSname@ @ Pages@ Min@ <Utah@ File@ Name>@ Logical@ Name
+
+RESTORE-PSL@ 10@ NO@ @ @ ----@ @ @ @ @ @ @ @ @ @ @ @ ----
+@\Files necessary to restore the PSL system.
+
+PSL@ @ @ @ @ 1100@ @ YES@ @ <psl>@ @ @ @ @ @ @ @ @ @ @ @ psl:
+@\The executable files (PSL.EXE and RLISP.EXE),
+this 20-DIST.DOC file,
+.CMD files to define appropriate logical names and a
+sample message to announce PSL availability. Also, included are a number
+of news files announcing new features and changes, some files associated
+with the NMODE editor and a version of psl (PSLCOMP.EXE) that will compile
+the argument on the execution line.
+
+COMP@ @ @ @ @ 125@ @ NO@ @ @ <psl.comp>@ @ @ @ @ @ @ pc:
+@\Common compiler, LAP, FASL sources.
+
+20COMP@ @ @ @ 55@ @ NO@ @ @ <psl.comp.20>@ @ @ @ p20c:
+@\DEC-20 specific compiler, LAP and FASL sources.
+
+DIST@ @ @ @ @ @ 25@ @ NO@ @ @ <psl.dist>@ @ @ @ @ @ @ pdist:
+@\Files as an aid to the installer.
+
+DOC@ @ @ @ @ @ 110@ @ NO@ @ @ <psl.doc>@ @ @ @ @ @ @ @ pdoc:
+@\Miscellaneous documentation files, including random notes on new
+features.
+
+20DOC@ @ @ @ @ 25@ @ NO@ @ @ <psl.doc.20>@ @ @ @ @ p20d:
+@\Documentation files that are 20 specific.
+
+DOCNMODE@ 590@ @ NO@ @ @ <psl.doc.nmode>@ @ pndoc:
+@\NMODE documentation files.
+
+GLISP@ @ @ @ 330@ @ NO@ @ @ <psl.glisp>@ @ @ @ @ @ pg:
+@\An object oriented LISP.
+
+HELP@ @ @ @ @ 100@ @ YES@ @ <psl.help>@ @ @ @ @ @ @ ph:
+@\A set of *.HLP files, describing major modules.
+
+KERNEL@ @ @ 225@ @ NO@ @ @ <psl.kernel>@ @ @ @ @ pk:
+@\Machine Independent kernel sources.
+
+P20@ @ @ @ @ @ 560@ @ NO@ @ @ <psl.kernel.20>@ @ p20:
+@\DecSystem 20 dependent kernel sources.
+
+LAP@ @ @ @ @ @ 500@ @ YES@ @ <psl.lap>@ @ @ @ @ @ @ @ pl:
+@\Mostly binary FASL (*.B) files, with some
+LISP files (*.LAP) for
+loading multiple .B files of loadable (optional) modules.
+
+LPT@ @ @ @ @ @ 430@ @ NO@ @ @ <psl.lpt>@ @ @ @ @ @ @ @ plpt:
+@\The PSL manual in printable form (has overprinting and underlining),
+as SCRIBE .LPT files.
+
+NMODE@ @ @ @ 270@ @ NO@ @ @ <psl.nmode>@ @ @ @ @ @ pn:
+@\The NMODE text editor sources, which is
+a newer version of EMODE developed at HP Research Laboratories.
+
+NMODEBIN@ 230@ @ YES@ @ <psl.nmode.binary>@ pnb:
+@\The binary files associated with NMODE.
+
+NONKERNEL@ @ 5@ @ NO@ @ @ <psl.nonkernel>@ @ pnk:
+@\The sources that are not in the kernel,
+but are kernel related.
+
+PT@ @ @ @ @ @ @ 215@ @ NO@ @ @ <psl.tests>@ @ @ @ @ @ pt:
+@\A set of timing and test files.
+
+P20T@ @ @ @ @ 500@ @ NO@ @ @ <psl.tests.20>@ @ @ p20t:
+@\DecSystem 20 specific test files.
+
+UTIL@ @ @ @ @ 575@ @ NO@ @ @ <psl.util>@ @ @ @ @ @ @ pu:
+@\Sources for most utilities, useful as examples of
+PSL and RLISP code, and for customization.
+
+P20U@ @ @ @ @ @ 60@ @ NO@ @ @ <psl.util.20>@ @ @ @ p20u:
+@\DecSystem 20 specific utilities.
+
+WINDOWS@ @ @ 75@ @ NO@ @ @ <psl.windows>@ @ @ @ pw:
+@\The window support functions used by NMODE.
+
+WINBIN@ @ @ @ 30@ @ YES@ @ <psl.windows.binary>@ pwb:
+@\The binaries associated with the window support.
+@end(description)
+@section(INSTALLING PSL)
+
+When installing the PSL system, you have two options for the directory
+structure. You may utilize a single directory for all of the file, or you
+may create a directory tree using subdirectories. The Utah group utilizes a
+directory tree structure and recommends its use when installing a "full" system
+(that includes all of the sources and the capability of rebuilding any part
+of the system). However, if only a minimal system is desired, it can be
+accomplished using a single directory.
+
+@subsection(Retrieve Control Files)
+
+Whether building a single directory system or multiple directory system,
+logical name definition files and file restore control files must be first
+retrieved. Therefore, first mount the dumper tape, at 1600 BPI (verify
+that there is no write ring in the tape). Then, define X: as the
+appropriate tape device, MTAn:, or use MOUNT if running a labeled tape
+system:
+@verbatim[
+@@DEFINE X: MTAn: or @@MOUNT TAPE X:
+@@ASSIGN X:
+]
+
+Restore from the first saveset (PSL) the .cmd and .ctl files
+@begin(verbatim)
+ @@DUMPER
+ *tape X:
+ *density 1600
+ *files
+ *account system-default
+ *restore <*>*.*.* *.*.*
+@end(verbatim)
+These files will be restored to your connected directory, and should be
+copied to your main PSL directory after their creation.
+
+@subsection(Create a single subdirectory)
+Create a directory, call it <name> and define a logical device PSL:
+(a size of about 2400 should be sufficient).
+
+Any <name> will do, since the logical device name PSL: will be used.
+@begin(verbatim)
+ @@DEF PSL: <name>
+@end(verbatim)
+
+Copy the minimal-* restored files to PSL
+@begin(verbatim)
+ @@COPY minimal-*.* PSL:*.*
+@end(verbatim)
+
+Now edit the file PSL:minimal-logical-names.cmd to reflect the your choice
+of <name>.
+
+Also put @@TAKE <name>minimal-logical-names.cmd in your LOGIN.CMD.
+
+Finally, restore the minimal system by DOing the minimal-restore.ctl file:
+@begin(verbatim)
+ @@DO MINIMAL-RESTORE
+ @@DEASSIGN X: or @@DISMOUNT X:
+@end(verbatim)
+
+@subsection(A MULTIPLE SUB-DIRECTORY SYSTEM)
+If you plan to do much source modification, or a significant number of
+rebuilds, or maintain a compatible multiple-machine version of PSL, or
+attempt retargeting of PSL, a multiple-directory structure such as that at
+UTAH should be built.
+
+The file FULL-LOGICAL-NAMES.CMD, retrieved above should be used as a guide
+to building the sub-directories. We currently use 18 sub-directories for the
+Common Sources and DEC-20 specific sources, and have at least an extra three
+for each new machine. Consult the 20-DIST.LOG file supplied with the PSL
+tape as a guide for the amount of space required for each sub-directory.
+The current set of directories for DEC-20 PSL, the logical names that we
+use, and rough space estimate follows. Build the sub-directories with a
+somewhat larger working space allocation.
+
+Now edit the file PSL:full-logical-names.cmd to reflect the your choice of
+<name> along with the create-directories.ctl file.
+
+Also put @@TAKE <name>full-logical-names.cmd in your LOGIN.CMD.
+
+@subsection(Build Sub-Directories)
+Then use the system command, BUILD, to build each sub-directory with the name
+Pxxx:, as follows. Assistance from the system manager may be required to permit
+the creation of sub-directories, and the appropriate choice of sub-directory
+parameters:
+@begin(ProgramExample)
+@@BUILD Pxxx:
+@@@@PERM nnnn ! choose appropriate size
+@@@@WORK wwww ! nnnn+extra
+@@@@FILES-ONLY ! Can't login
+@@@@GEN 2 ! Retain 1 previous version
+@@@@PROTECTION 777700 ! Give group access
+@@@@DEFAULT 777700
+@@ ! that are permitted access
+@end(ProgramExample)
+
+To make this process easier, we have created a control file:
+CREATE-DIRECTORIES.CTL that will build all of the subdirectories with sizes
+such that restoration of the files will succeed. Therefore, after editing
+the full-logical-names.cmd file above to reflect the correct logical names,
+simply DO the CTL file (some systems use MIC instead of DO, so that may be
+substituted in the following examples) :
+@begin(verbatim)
+ @@DO CREATE-DIRECTORIES.CTL
+@end(verbatim)
+
+This will create all of the necessary directories.
+
+Finally, restore the full system by DOing the full-restore.ctl file:
+@begin(verbatim)
+ @@DO FULL-RESTORE
+ @@DEASSIGN X: or @@DISMOUNT X:
+@end(verbatim)
+
+@subsection(Announce the System)
+Send out a Message to all those interested in using PSL.
+The file BBOARD.MSG is a suggested start.
+
+Edit as you see fit, but please REMIND people not to re-distribute
+the PSL system and sources.
+
+You may also want to set the directory protection to 775200
+and limit access only to those that you feel should have access at
+this time.
+
+@subsection(Summary of Restoration Process)
+In summary, first retrieve the cmd and ctl files from the first saveset on
+the DUMPER tape. Then choose a single or multiple directory system and
+edit the appropriate logical name file to reflect the directory name(s).
+If creating a multiple directory system use the create-directories.ctl
+control file to build each directory. Then run the appropriate file
+retrieval control file. Finally, announce the system to any interested users.
+
+@section(REBUILDING LOADABLE MODULES)
+Most of the utilities, and many of the more experimental parts of the
+system are kept as binary FASL files (with extensions .b) on the PL:
+directory. NMODE is currently the only major sub-system that
+has its own set of sub-directories. In some cases (usually large
+sub-systems, or sub-systems that share modules) there are a number of .B
+files, and a .LAP file that loads each .B file in turn. The PSL LOAD
+function will look first for a .B file, then a .LAP file first on the user
+directory, then on PL: (both this "search" path and the order of extensions
+can be changed).
+
+In order to ease the task of rebuilding and modifying the .B files, we have
+a small utility, BUILD. To use BUILD for a module you call xxxx, prepare a
+file called xxxx.BUILD, which has RLISP syntax commands for loading the
+appropriate source files. The file can also have various CompileTime
+options, including the loading of various .B files to set up the correct
+compilation environment.
+
+Then run PSL:RLISP, LOAD BUILD; and finally enter BUILD 'xxxx; this will
+do a FASLOUT to "PL:xxxx", input the xxxx.BUILD file, and finally close the
+FASL file.
+
+The target file "PL:xxxx" is constructed using the variable
+"BuildFileFormat!*", initialized in the file PU:Build.Red .
+
+For example, consider the contents of PU:Gsort.Build:
+
+@ProgramExample[
+CompileTime load Syslisp;
+in "gsort.red"$]
+
+Note that the SYSLISP module is required, since some of the fast sorting
+functions in GSORT are written in SYSLISP mode.
+
+GSORT is then rebuilt by the sequence:
+
+@ProgramExample[
+PSL:RLISP
+LOAD BUILD;
+BUILD 'GSORT;
+QUIT;]
+
+This is such a common sequence that a MIC file (MIC is a parameterized DO
+facility) PU:BUILD.MIC is provided, and is used by passing the
+module name to MIC, after connecting to PU:
+@ProgramExample[
+@@mic BUILD GSORT
+]
+
+is all that is required.
+
+@Section(REBUILDING THE INTERPRETER)
+A running `rlisp' is required to rebuild the basic interpreter, since the
+entire system is written in itself. The kernel modules, rather than being
+compiled to FASL files, are compiled to assembly code (@i(MACRO)) and
+linked using the system loader @i(LINK). The command file
+@i{P20C:DEC20-cross.CTL} is executed to produce the cross compiler,
+@i{S:DEC20-cross} (S: should be set to an appropriate scratch directory).
+The modules in the kernel are represented by the files
+@I{P20:*.build}. There is a program @I{PU:kernel.sl or PL:kernel.b} which
+generates command files for building the kernel when parameterized for
+Tops-20 by @I{P20:20-kernel-gen.sl}. The specific modules which are in the
+kernel are only listed in this file, in the call to the function
+@I{kernel}. This generates a file @I{xxxx.CTL} for each @I{xxxx.build}.
+
+@subsection(Complete Kernel Rebuild)
+A complete rebuild is accomplished by the following steps. At Utah we
+use a <scratch> directory for some intermediate files. Define S:
+to be this directory or some other appropriate location that can be
+deleted when done. Below we use @@SUBMIT xxxx.CTL to run batch jobs;
+on some systems, @@DO xxxx.CTL can be used instead, or on others, @@MIC
+xxxx.CTL may be used.
+
+Begin by defining S: as <scratch> or other scratch directory:
+
+@verbatim[ @@DEFINE S: <scratch>]
+
+Now connect to <psl.20-comp> and rebuild DEC20-CROSS.EXE:
+
+@verbatim[ @@CONN P20C:]
+@verbatim[ @@SUBMIT DEC20-CROSS.CTL]
+
+Copy the <psl.comp>BARE-PSL.SYM to 20.SYM, and regenerate the
+appropriate .CTL files. This saves the old 20.SYM as
+PREVIOUS-20.SYM:
+
+@verbatim[ @@CONN P20:]
+@verbatim[ @@SUBMIT P20:FRESH-KERNEL.CTL]
+
+Rebuild each module (xxxx) in turn, using its xxxx.CTL. This creates xxxx.MAC
+and Dxxxx.MAC files, and assembles each to make xxxx.REL and Dxxxx.REL.
+The entire set is submitted with the file ALL-KERNEL.CTL, which submits
+each file in turn. (Note that these must be done sequentially, not
+simultaneously. If you have more than one batch stream, make sure that
+these are run one at a time):
+
+@verbatim[ @@SUBMIT ALL-KERNEL.CTL]
+
+Build the main module, which converts the accumulated
+20.SYM into heap and symbol-table initialization:
+
+@verbatim[ @@SUBMIT P20:MAIN.CTL]
+
+Finally LINK the xxxx.REL and Dxxxx.REL files to produce S:BARE-PSL.EXE:
+
+@verbatim[ @@SUBMIT P20:PSL-LINK.CTL]
+
+Execute and save as PSL.EXE, reading appropriate xxxx.INIT files (note,
+each site usually customizes the PSL environment to suit their needs,
+therefore we recommend that you create your own version of Make-psl.ctl to
+perform this task).
+
+@verbatim[ @@SUBMIT PDIST:MAKE-PSL.CTL]
+
+Finally, run MAKE-RLISP.CTL as needed:
+
+@verbatim[ @@SUBMIT PDIST:MAKE-RLISP.CTL]
+
+Rlisp.exe and Psl.exe will be saved on the <PSL> directory.
+You now may want to delete any xxx.log files that where created.
+
+You may also remake, RLISPCOMP, PSLCOMP and NMODE, in a similar manner.
+
+@Verbatim[
+ @@DEL P20:*.LOG
+ @@DEL P20C:*.LOG]
+
+
+@subsection(Partial or Incremental Kernel Rebuild)
+Often, only a single kernel file needs to be changed, and a complete
+rebuild is not needed. The PSL kernel building process permits a
+(semi-)independent rebuilding of modules, by maintaining the 20.SYM file to
+record Identifier Numbers, etc. The 20.SYM file from the recent
+full-rebuild, and xxxx.INIT files are required, as are the "xxxx.REL" and
+"Dxxxx.REL". The partial rebuild will replace the "mmmm.REL", "Dmmmm.REL"
+and "mmmm.INIT" files, modify "20.SYM", and then rebuild the MAIN module.
+Assuming that a recent full rebuild has been done, a partial rebuild of
+module "mmmm", is accomplished by the following steps.
+
+As above, S: is required for "Scratch" space.
+
+Define S: as <scratch> or other scratch directory:
+
+@verbatim[ @@DEFINE S: <scratch> ]
+
+Rebuild DEC20-CROSS.EXE, if needed:
+
+@verbatim[ @@SUBMIT P20C:DEC20-CROSS.CTL]
+
+Rebuild the module (mmmm), using its mmmm.CTL. This creates mmmm.MAC
+and Dmmmm.MAC files, and assembled each to make mmmm.REL and Dmmmm.REL.
+See the file ALL-KERNEL.CTL for current modules.
+
+@verbatim[ @@SUBMIT P20:mmmm.CTL
+ Other modules can be done after this]
+
+Rebuild the main module, which converts the accumulated
+20.SYM into heap and symbol-table initialization: (This step can be omitted
+if 20.SYM has not been changed by the incremental recompilation.)
+
+@verbatim[ @@SUBMIT P20:MAIN.CTL]
+
+Finally LINK the xxxx.REL and Dxxxx.REL files to produce S:BARE-PSL.EXE:
+
+@verbatim[ @@SUBMIT P20:PSL-LINK.CTL]
+
+Execute and save as PSL.EXE, reading appropriate xxxx.INIT files:
+
+@verbatim[ @@SUBMIT PDIST:MAKE-PSL.CTL]
+
+Finally, run MAKE-RLISP as needed:
+
+@verbatim[ @@SUBMIT PDIST:MAKE-RLISP.CTL]
+
+You may also remake, RLISPCOMP, PSLCOMP and NMODE, in a similar manner.
+
+Note that 20.SYM may be changed slightly to reflect any new symbols
+encountered, and certain generated symbols. Occasionally, repeated building
+of certain modules can cause 20.SYM to grow, and then a full rebuild may be
+required.
+
+@subsection(Rebuilding RLISP.EXE from PSL.EXE)
+The PSL executable file, PSL.EXE, is a fairly bare system, and is usually
+extended by loading appropriate utilities, and then saving this as a new
+executable. We have provided RLISP.EXE, which includes the compiler, and
+the RLISP parser. RLISP.EXE is built from PSL.EXE by the following
+commands:
+@begin(verbatim)
+ @@TAKE PSL:minimal-logical-names.cmd
+ @@PSL:PSL.EXE
+ (LOAD COMPILER RLISP INIT-FILE)
+ % Also LOAD any other modules that
+ % should be in your "standard" system
+ (SAVESYSTEM "PSL 3.1 Rlisp" "PSL:rlisp.exe" '((Read-init-file
+ "rlisp")))
+ % The string is the Welcome Message, the save file
+ % name and the startup expression to read rlisp.init.
+ (QUIT)
+@end(verbatim)
+
+We have provided a command file, PDIST:MAKE-RLISP.CTL for this purpose.
+Edit it to reflect any modules that local usage desires in the
+basic system (PRLISP, USEFUL, etc. are common choices).
+
+In a similar fashion, a customized PSL.EXE could be maintained instead of
+the "bare" version we provide. In order to avoid destroying PSL entirely,
+we suggest that you maintain a copy of the supplied PSL.EXE as
+BARE-PSL.EXE, and customize your PSL.EXE from it.
+
+@section(RELATIONSHIP TO PSL 3.0)
+Even though this is the first version of PSL for the DecSystem-20 that
+utilizes extended addressing, it is identical to the PSL V3.1 for the
+non-extended 20. As a new PSL version 3.1, it is a complete release, and
+totally replaces the previous PSL 3.0 that underwent limited distribution.
+The files @i(pd:bug-fix.log) and @i(pd:bugs.txt) record many of the changes
+and bug fixes that occurred since version 3.0.
+
+@section(FUTURE UPDATES)
+It is currently envisioned that future updates will still be complete
+releases. It is therefore suggested that you
+
+@begin(enumerate)
+Retain this distribution tape in case you may have to compare files.
+
+Do not make any changes on these distributed directories. If you must make
+your own bug fixes, it is suggested that you put the changed files on some
+other directories, such as @i(pnew:). They can then be compared with any
+new files sent out in subsequent releases.
+@end
ADDED psl-1983/3-1/doc/20/20-dist.otl
Index: psl-1983/3-1/doc/20/20-dist.otl
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/20/20-dist.otl
@@ -0,0 +1,19 @@
+@Comment{OUTLINE of 20-DIST.MSS.10 by Scribe 3C(1312) on 20 June 1983 at 13:39}
+1. INTRODUCTION 2 20-DIST.MSS.10 line 49
+2. DISCLAIMER 2 20-DIST.MSS.10 line 67
+3. CONTENTS OF THE TAPE 2 20-DIST.MSS.10 line 86
+4. INSTALLING PSL 4 20-DIST.MSS.10 line 178
+ 4.1. Retrieve Control Files 5 20-DIST.MSS.10 line 188
+ 4.2. Create a single subdirectory 5 20-DIST.MSS.10 line 213
+ 4.3. A MULTIPLE SUB-DIRECTORY SYSTEM 6 20-DIST.MSS.10 line 238
+ 4.4. Build Sub-Directories 6 20-DIST.MSS.10 line 258
+ 4.5. Announce the System 7 20-DIST.MSS.10 line 292
+ 4.6. Summary of Restoration Process 8 20-DIST.MSS.10 line 303
+5. REBUILDING LOADABLE MODULES 8 20-DIST.MSS.10 line 311
+6. REBUILDING THE INTERPRETER 9 20-DIST.MSS.10 line 363
+ 6.1. Complete Kernel Rebuild 9 20-DIST.MSS.10 line 377
+ 6.2. Partial or Incremental Kernel Rebuild 11 20-DIST.MSS.10 line 441
+ 6.3. Rebuilding RLISP.EXE from PSL.EXE 13 20-DIST.MSS.10 line 494
+7. RELATIONSHIP TO PSL 3.0 13 20-DIST.MSS.10 line 522
+8. FUTURE UPDATES 13 20-DIST.MSS.10 line 530
+ Table of Contents 1 -SCRIBE-SCRATCH-.28-33-1.100028 line 3
ADDED psl-1983/3-1/doc/examples-for-imp-guide.mss
Index: psl-1983/3-1/doc/examples-for-imp-guide.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/examples-for-imp-guide.mss
@@ -0,0 +1,424 @@
+@section(Examples of various kinds)
+
+Recall that when compiling code, variables which are used extended in
+one procedure, and bound as LAMBDA or PROG variables in another, must
+be declared fluids.
+
+Example:
+@begin(verbatim)
+(de foo(X) (PLUS2 X 1)), compiles to:
+
+ (!*entry foo expr 1)
+ (!*alloc 0)
+ (!*move (quote 1) (reg 2))
+ (!*linke 0 plus2 expr 2)
+
+(de fee(X Y) (Fum (foo X) (foo Y)), compiles to:
+
+ (!*entry fee expr 2)
+ (!*alloc 2)
+ (!*move (reg 2) (frame 2))
+ (!*link foo expr 1)
+ (!*move (reg 1) (frame 1))
+ (!*move (frame 2) (reg 1))
+ (!*link foo expr 1)
+ (!*move (reg 1) (reg 2))
+ (!*move (frame 1) (reg 1))
+ (!*linke 2 fum expr 2)
+
+Finally, (de fac (N) (cond ((Lessp N 1) 1)
+ (T (Times2 N (fac SUB 1 N))
+compiles to:
+
+ (!*entry fac expr 1)
+ (!*alloc 1)
+ (!*move (reg 1) (frame 1))
+ (!*move (quote 1) (reg 2))
+ (!*link LessP expr 1)
+ (!*jumpeq (label L) (quote nil) (reg 1))
+ (!*move (quote 1) (reg 1))
+ (!*exit 1)
+ (!*lbl (label L))
+ (!*move (frame 1) (reg 1))
+ (!*link sub1 expr 1)
+ (!*link fac expr 1)
+ (!*move (reg 1) (reg 2))
+ (!*move (frame 1) (reg 1))
+ (!*linke 1 times2 expr 2)
+@end(verbatim)
+
+@section(BUILDING the CROSS Compiler)
+
+The executable @dq[xxxx-CROSS.EXE] is built as follows:
+@begin(verbatim)
+
+@@psl:rlisp ! an RLISP
+*mapobl function lambda X;
+*<< RemProp(X, 'OpenCode);
+* RemProp(X, 'ExitOpenCode) >>; % Remove old compiler opts
+* % Load common modules
+*load(zboot, pass!-one!-lap, if!-system, syslisp, lap!-to!-asm);
+* % Load XXXX specific modules
+*load(XXXX!-comp, XXXX!-cmac, XXXX!-asm);
+*off UserMode;
+*DumpFileName!* := "filename.exe"; % Establish the executable name
+*Date!*:=Concat("XXXX Cross Assmbler ", Date()); % Establish greeting
+*DumpLisp(); % Does a Reclaim and save
+*Quit;
+@end(verbatim)
+
+
+@subsection(An example of the process)
+The following is a complete example, from @syslisp to @CMACRO@xs:
+@begin(verbatim,leftmargin 0)
+@@PSL:RLISP
+PSL 3.0 Rlisp, 9-May-82
+
+syslsp procedure Test1(); % Input RLISP syntax code
+ begin scalar x;
+ x := 5;
+ x := x+7;
+ L := '(A B C D);
+ L1 := (CAR L) . CAR(CDR L);
+ print L1;
+end;
+@End(verbatim)
+
+@begin(verbatim,leftmargin 0)
+% This is the output from the Compiler/LAP system.
+% The lines beginning with "(!* ... " are the Abstract
+% machine CMACRO's output from the compiler.
+
+% The indented lines following them are the VAX @sq[LAP]
+% assembly code the CMACRO patterns
+% (in the *-CMAC.SL files) produced by the expansion process.
+
+(!*PUSH '5)
+ (@op{PUSHL} 5)
+(!*WPLUS2 (FRAME 1) (WCONST 7)) % WPLUS2 is actually a
+ % CMACRO (OpenFunct)
+ (@op{ADDL2} 7 (DEFERRED (REG ST))) % Note how the FRAME AnyReg
+ % is converted directly to
+ % a machine specific
+ % addressing mode.
+(!*MOVE '(A B C D) (!$FLUID L))
+ (@op{MOVL} '(A B C D) (!$FLUID L))
+(!*MOVE (CAR (CDR (!$FLUID L))) (REG 2))
+ % The AnyReg patterns
+ (@op{EXTZV} 0 27 (!$FLUID L) (REG 2)) % for CAR and CDR are used
+ (@op{EXTZV} 0 27 (DISPLACEMENT (REG 2) 4) (REG 2))
+ (@op{MOVL} (DEFERRED (REG 2)) (REG 2))
+(!*MOVE (CAR (!$FLUID L)) (REG 1))
+ (@op{EXTZV} 0 27 (!$FLUID L) (REG 1))
+ (@op{MOVL} (DEFERRED (REG 1)) (REG 1))
+(!*LINK CONS EXPR 2) % Standard Function Cell
+ % call.
+ (@op{JSB} (ENTRY CONS))
+(!*MOVE (REG 1) (!$FLUID L1))
+ (@op{MOVL} (REG 1) (!$FLUID L1))
+(!*LINK PRINT EXPR 1)
+ (@op{JSB} (ENTRY PRINT))
+(!*MOVE 'NIL (REG 1))
+ (@op{MOVL} (REG NIL) (REG 1)) % Reg NIL evaluates to an
+(!*EXIT 1) % immediate constant.
+ (@op{ADDL2} 4 (REG ST))
+ (@op{RSB})
+TEST1
+@end(verbatim)
+
+@subsection(Prologues and Epilogues)
+ An example of Prologues and Epilogues for (@APOLLO version of) the
+@68000 is given below:
+
+@begin(ProgramExample,leftmargin 0)
+lisp procedure CodeFileHeader(); % Pure Code Segment
+If !*MAIN then
+<<CodePrintF(" program %w,m0001%n",ModName!*);
+ CodePrintF " data%n";
+ DataProcState!*:='data;
+ CodePrintF "* Start of execution of the program%n";
+
+ CodeDeclareExternal 'SYMVAL; %/ Issue EXTERN.D early
+ CodeDeclareExternal 'SYMFNC; %/ Issue EXTERN.D early
+
+ CodePrintF "m0001 EQ *%n";
+ CodePrintF " move.l db,-(sp) Save caller db%n";
+ CodePrintF " clr.l -(sp) Push reserved word%n";
+ CodePrintF " move.l a0,-(sp) Push address of ECB%n";
+ CodePrintF " move.l SYMVAL+512,d0 Init NIL Reg%n";
+ CodePrintF " link sb,#0 Balance unlink%n";
+ CodePrintF " movea.l #0,a6 Setup zeroareg%n";
+ CodePrintF " lea m0001,db Setup db reg%n";
+ CodePrintF(" jsr %w Call Main routine%n",
+ MainEntryPointNAme!*);
+
+ CodePrintF "* now return to OS%n";
+ CodePrintF " movea.l A_PGM_$EXIT,a6%n";
+ CodePrintF " jsr (a6)%n";
+ CodePrintF " unlk sb Reload callers SB%n";
+ CodePrintF " addq.w #8,sp Pop linkage%n";
+ CodePrintF " movea.l (sp)+,db Reload callers db%n";
+ CodePrintF " rts Return%n";
+ ForeignExternList!*:=NIL;
+ CheckForeignExtern 'PGM!_!$EXIT;
+ >>
+else
+<<CodePrintF (" module %w,m0000%n",ModName!*);
+ %/ Kludge, since ModuleName set in ASMOUT
+ CodePrintF " data%n";
+ DataProcState!*:='data;
+ CodeDeclareExternal 'SYMVAL; %/ Issue EXTERN.D early
+ CodeDeclareExternal 'SYMFNC; %/ Issue EXTERN.D early
+ CodePrintF "* this is an Independent Module %n";
+ ForeignExternList!*:=NIL;
+ >>;
+
+lisp procedure DataFileHeader();
+ Begin
+ DataPrintF(" module %w_D%n",ModName!*);
+ DataPrintF " data%n";
+ End;
+
+lisp procedure DataFileTrailer();
+ DataPrintF "end%n";
+
+lisp procedure CodeFileTrailer();
+ <<Foreach Fn in Reverse ForeignExternList!* do
+ <<CodePrintF(" extern.p %w%n",Fn);
+ CodePrintF("A_%w ac %w%n",Fn,Fn)>>;
+ CodePrintF " end%n">>;
+
+@end(ProgramExample)
+
+ The general use of the headers given above is to declare the module
+name, tell the assembler that this is a data section@Foot[On the @Apollo
+all of the code and data were put in a data section since the operating
+system and assembler had a problem with mixed code and data due to
+expecting a pure code segment with all data references relative to the data
+base register.], and in the
+case of the main routine performing the proper operating system dependent
+linkage for program entry and exit.
+
+ Note that CodePrintF and DataPrintF are used to direct output to
+either the @ei[code] segment or @ei[data] segment. This is to allow
+seperate segements for those machines that allow for pure code segments (on
+the @Apollo a pure code segment is directly maped into the address space
+rather than copied, which results in a large difference in start up speed).
+This could probably be extended to PureCode, PureData, and ImpureData.
+
+
+procedure WW(X);
+ <<print LIST('WW,x); x+1>>;
+
+
+Now a plain resolve function.
+That does not argument processing
+best for register conversion:
+
+procedure MYREGFN(R,S);
+ <<Print LIST('MYREG, R,S);
+ List('REG,S+10)>>;
+
+PUT('MYREG,'ANYREGRESOLUTIONFUNCTION,'MYREGFN);
+
+procedure MYANYFN(R,S);
+ <<Print LIST('MYANY, R,S);
+ S:= ResolveOperand('(REG t3),S);
+ List('Weird,S)>>;
+
+FLAG('(WEIRD),'TERMINALOPERAND);
+PUT('MYANY,'ANYREGRESOLUTIONFUNCTION,'MYANYFN);
+
+(!*MOVE (WW 1) (WW 2))); ARgs must be WCONSTEVALUABEL
+(!*MOVE (WW (WW 1)) (WW 2)));
+(!*MOVE (WW A) (WW 2))); % First WW shouldnt convert
+
+(!*MOVE (MYREG 1) (MYREG 2))); % OK
+
+(!*MOVE (MYREG (WW 1)) (WW (MYREG 2)))); % Fails since args not processed
+(!*MOVE (MYREG (MYREG 1)) (MYREG 2)));
+
+(!*MOVE (MYANY 1) (MYANY 2))); % OK
+
+(!*MOVE (MYANY (WW 1)) (MYANY (MYREG 2)))); % Args processed
+(!*MOVE (MYANY (MYANY 1)) (MYANY 2)));
+
+@section(Sample ANYREGs and CMACROs from various machines)
+
+The following choice pieces from the @VAX750, @DEC20 and @68000
+illustrate a range of addressing modes, predicates and style.
+
+@subsection(VAX)
+@begin(verbatim,leftmargin 0)
+(DefCMacro !*Move % ARGONE -> ARGTWO
+ (Equal) % Don't do anything
+ ((ZeroP AnyP) (@op{clrl} ARGTWO)) % 0 -> ARGTWO
+ ((NegativeImmediateP AnyP) % -n -> ARGTWO
+ (@op{mnegl} (immediate (minus ARGONE)) ARGTWO))
+ ((@op{movl} ARGONE ARGTWO))) % General case
+
+(DefCMacro !*WPlus2 % ARGONE+ARGTWO->ARGONE
+ ((AnyP OneP) (@op{incl} ARGONE)) % add 1
+ ((AnyP MinusOneP) (@op{decl} ARGONE)) % Subtract 1
+ ((AnyP MinusP) (@op{subl2} (immediate (minus ARGTWO)) ARGONE))
+ ((@op{addl2} ARGTWO ARGONE)))
+
+The Predicates used:
+
+@begin(description,spread 0)
+Equal@\As an atom, rather than in (...), it check both arguments same.
+
+Zerop@\Check if argument is 0
+
+AnyP@\Just returns T
+
+NegativeImmediateP@\Check that a negative, 32 bit constant.
+
+@end(Description)
+@end(verbatim)
+
+@subsection(DEC-20)
+@begin(verbatim,leftmargin 0)
+(DefCMacro !*Move % Move ArgOne -> ArgTwo
+ (Equal)
+ ((ZeroP AnyP) (@op{setzm} ARGTWO))
+ ((MinusOneP AnyP) (@op{setom} ARGTWO))
+ ((RegisterP AnyP) (@op{movem} ARGONE ARGTWO))
+ ((NegativeImmediateP RegisterP)
+ (@op{movni} ARGTWO (immediate (minus ARGONE))))
+ ((ImmediateP RegisterP) (@op{hrrzi} ARGTWO ARGONE))
+ ((AnyP RegisterP) (@op{move} ARGTWO ARGONE))
+ ((!*MOVE ARGONE (reg t1)) (@op{movem} (reg t1) ARGTWO)))
+
+(DefCMacro !*WPlus2
+ ((AnyP OneP) (@op{aos} ARGONE))
+ ((AnyP MinusOneP) (@op{sos} ARGONE))
+ ((AnyP RegisterP) (@op{addm} ARGTWO ARGONE))
+ ((RegisterP NegativeImmediateP)
+ (@op{subi} ARGTWO (minus ARGONE)))
+ ((RegisterP ImmediateP) (@op{addi} ARGTWO ARGONE))
+ ((RegisterP AnyP) (@op{add} ARGONE ARGTWO))
+ ((!*MOVE ARGTWO (reg t2)) (@op{addm} (reg t2) ARGONE)))
+
+The Predicates used:
+
+@begin(description,spread 0)
+Equal@\As an atom, rather than in (...), it check both arguments same.
+
+Zerop@\Check if argument is 0
+
+AnyP@\Just returns T
+
+MinusOneP@\Check that argument is -1.
+
+ImmediateP@\Check that an address or 18 bit constant. Will
+change for extended addressing.
+
+NegativeImmediateP@\Check that a negative 18 bit constant.
+
+RegisterP@\Check that is (REG r), a register.
+@end(Description)
+@end(verbatim)
+
+@subsection(APOLLO)
+@begin(verbatim,leftmargin 0)
+(DefCMacro !*Move % (!*Move Source Destination)
+ (Equal) % if source @Value(Eq) dest then do nothing
+ ((ZeroP AregP)(@op{suba!.l} ARGTWO ARGTWO))
+ ((ZeroP AnyP) (@op{clr!.l} ARGTWO)) % if source @Value(Eq) 0 then dest := 0
+ ((InumP AregP) (@op{movea!.l} (Iconst ARGONE) ARGTWO))
+ ((AddressP AregP) (@op{lea} ARGONE ARGTWO))
+ ((InumP AnyP) (@op{move!.l} (Iconst ARGONE) ARGTWO))
+ ((AddressP AnyP)
+(lea ARGONE (reg a0)) (@op{move!.l} (reg a0) ARGTWO))
+ ((AnyP AregP) (@op{movea!.l} ARGONE ARGTWO))
+ ((@op{move!.l} ARGONE ARGTWO)))
+
+(DefCMacro !*WPlus2 % (!*WPlus2 dest source)
+ ((AnyP QuickIconstP) (@op{addq!.l} (Iconst ARGTWO) ARGONE))
+ ((AnyP NegativeQuickIconstP)
+ (@op{subq!.l} (Iconst (minus ARGTWO)) ARGONE))
+ ((AregP MinusP) (@op{suba!.l} (Iconst (Minus ARGTWO)) ARGONE))
+ ((AnyP MinusP) (@op{subi!.l} (Minus ARGTWO) ARGONE))
+ ((AregP InumP) (@op{adda!.l} (Iconst ARGTWO) ARGONE))
+ ((AnyP InumP) (@op{addi!.l} (Iconst ARGTWO) ARGONE))
+ ((AregP AddressP) (@op{lea} ARGTWO (reg a0))
+ (@op{adda!.l} (reg a0) ARGONE))
+ ((AnyP AddressP) (@op{lea} ARGTWO (reg a0))
+ (@op{add!.l} (reg a0) ARGONE))
+ ((AregP AnyP)(@op{adda!.l} ARGTWO ARGONE))
+ ((@op{add!.l} ARGTWO ARGONE))) % really need one a DREG
+
+
+The Predicates used:
+
+@begin(description,spread 0)
+Equal@\As an atom, rather than in (...), it check both arguments same.
+
+Zerop@\Check if argument is 0
+
+AregP@\Check that is one of the A registers (which can not be used for
+arithmetic), and require modified mnemonics.
+
+DregP@\Check that is one of the D registers, used for most
+arithmetic.
+
+InumP@\Check that a small integer.
+
+AddressP@\Check that an address, not a constant, since we need to use
+different instruction for Address's, e.g@. @op{lea} vs @op{movi}.
+
+AnyP@\Just returns T.
+
+NegativeImmediateP@\Check that a negative, 32 bit constant.
+
+QuickIconstP@\Small integer in range 1 ..@. 8 for the xxxxQ instructions on
+68000.
+
+NegativeQuickIconstP@\Small integer in range -8 ..@. -1 for the xxxxQ
+instructions on 68000.
+@end(Description)
+@end(verbatim)
+
+
+@begin(verbatim,leftmargin 0)
+For example, on the @VAX750:
+@begin(Group)
+(DefAnyreg CAR % First ITEM of pair
+ AnyregCAR % Associated function
+ ((@op{extzv} 0 27 SOURCE REGISTER)
+ % Code to extract 27 bit
+ % address, masking TAG
+ (Deferred REGISTER))) % Finally indexed mode used
+@hinge
+(DefAnyreg CDR % Second item
+ AnyregCDR
+ ((@op{extzv} 0 27 SOURCE REGISTER)
+ (Displacement REGISTER 4)))
+ % Displace 4 bytes off Register
+
+% Both CAR and CDR use a single instruction, so do not use a
+% predicate to test SOURCE.
+@hinge
+(DefAnyreg QUOTE % Note a set of different choices
+ AnyregQUOTE
+ ((Null) (REG NIL))
+ ((EqTP) (FLUID T))
+ ((InumP) SOURCE)
+ ((QUOTE SOURCE)))
+@hinge
+
+(DefCMACRO !*Move % !*MOVE Usually has the most cases
+ (Equal)
+ ((ZeroP AnyP) (@op{clrl} ARGTWO))
+ ((NegativeImmediateP AnyP)
+ (@op{mnegl} (immediate (minus ARGONE)) ARGTWO))
+ ((@op{movl} ARGONE ARGTWO)))
+@hinge
+
+(DefCMACRO !*Alloc
+ ((ZeroP)) % No BODY - nothing to allocate
+ ((@op{subl2} ARGONE (REG st))))
+@end(group)
+@end(verbatim)
+
ADDED psl-1983/3-1/doc/fasl.mss
Index: psl-1983/3-1/doc/fasl.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/fasl.mss
@@ -0,0 +1,100 @@
+@make(article)
+@section(How in the hell does faslout work???)
+This section is a guide to the internal workings of faslout and then
+faslin.
+
+The user begins the faslout procedure by calling the procedure faslout with
+a string that does not have the extension (because it will add the
+appropriate binary extension for you). However, when fasling in, the file
+name requires the binary extension [Change this inconsistency].
+
+Inside the procedure faslout, the file name is assigned to the fluid
+variable ModuleName!*. Depending upon the setting of the flag
+!*Quiet_Faslout, the system will either print out a greeting message or
+not. Next, an output binary file is opened using the argument file name.
+It will return the channel number to a fluid variable CodeOut!*.
+CodeFileHeader is called to put in a header in the output file.
+
+CodeFileHeader writes out a word consisting of the Fasl Magic Number
+(currently set to 99). This magic word is used to check consistency
+between old and current fasl format files (an error is given upon fasling
+in the file if there is not a 99 as the first word). Therefore, the system
+must consistently modify that number when a new fasl format is produced.
+To continue, we need to understand the allocation that takes place within
+the Binary Program Space (BPS). The BPS is a large, non-collected space
+that contains compiled code, warrays, the string assocaited with interned
+ID's, constant data in fasl files, etc. Space is allocated from both
+ends of the space. Compiled code is allocated from the bottom (using
+NextBPS as a pointer) and warrays are allocated from the top (using LastBPS
+as the pointer). When an allocation is attempted, the desired size is
+checked to see if it will cause LastBPS and NextBPS to cross; if it will,
+an error message will be printed. The next step is to allocate 2/3 or the
+remaining BPS from the top.
+@begin(verbatim)
+
+ .------------------------------------.
+ | |
+ | WArrays |
+ | |
+ | |
+Last_BPS>|------------------------------------| <-FaslBlockEnd!* ---.
+ | Code | |
+ | | |
+ | | |
+ | | 2/3
+ |====================================| <-CodeBase!* |
+ | Bit Table | |
+ |====================================| <-BitTableBase!* ---'
+ | |
+ | |
+Next_BPS>|------------------------------------|
+ | |
+ | |
+ | |
+ `------------------------------------'
+
+ Binary Program Space
+
+@end(verbatim)
+The procedure AllocateFaslSpaces will setup the following fluid variables.
+FaslBlockEnd!* will be the address to the top of the available space for
+this particular allocation.
+
+BitTableBase!* points to the beginning of the BitTable.
+
+CurrentOffset!* keeps a pointer into the codespace of this allocation to
+the next available point to add more code.
+
+BitTableOffset!* is a running pointer to the current location in the
+BitTable where the next entry will go.
+
+CodeBase!* is the base pointer to the beginning of the code segment for
+this allocation.
+
+MaxFaslOffset!* is the max size of the codespace allowed for this
+implementation.
+
+OrderedIDList!* keeps record of the ID's as they are added.
+
+NextIDNumber!* is a base number used just in fasl files to indicate which
+IDs are local and which are global. It is assumed that there will never be
+more than 2048 pre-allocated ID's, currently there are 129. The first 128
+preallocated IDs are ASCII codes(0-127) and the last one is NIL(128).
+
+Everything is now setup to begin fasling PSL code out to the file.
+The remainder of the faslout procedure sets up three more fluid variables.
+
+!*DEFN is set to T which indicates that you are not going to do normal
+evaluation from the top loop and from files such as using the functions IN
+and DSKIN.
+
+DFPRINT!* signals that DFPRINT!* is now used as the printing function.
+The procedure used will be DFPRINTFasl!*.
+
+!*WritingFaslFile is set to T to let the system know that fasling out is
+goping on as opposed to compiling code directly into memory inside the PSL
+system.
+
+
+@section(What happens to code being fasled out to a file)
+
ADDED psl-1983/3-1/doc/history-of-psl.mss
Index: psl-1983/3-1/doc/history-of-psl.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/history-of-psl.mss
@@ -0,0 +1,87 @@
+@section[A Brief History of @PSL]
+@begin[Comment]
+ This section NEEDS MORE WORK!! (WFG)
+
+ Major ideas I think we should cover are:
+
+ -Influence of REDUCE on the system (e.g. Rlisp syntax).
+ -Work on "Standard Lisp".
+ -Work on portable compiler.
+
+ The major focus of this chapter should be clarifying why PSL is what it
+ is, and explaining other alternatives that were explored. [But BRIEFLY!]
+ e.g.
+ - Why Rlisp syntax (an outgrowth of REDUCE)
+ - Why syslisp instead of (e.g.) C, (or BIL, or whatever).
+ - Why "DE" instead of "Defun" (perhaps this is getting into too much
+ detail).
+
+ (Also, perhaps, give more credit to various folks?)
+
+@end[Comment]
+
+@topic[History of PSL]
+@Comment{TALK a bit more about REDUCE and Rlisp, mention some of the
+systems they ran on (e.g. Lisp 1.6 (or 1.5?), IBM dialect (namely?), ...}
+@Comment{Is my impression correct that REDUCE was once written in LISP
+syntax, later converted to Rlisp?}
+
+@Comment{Then go into this paragraph, but don't need to explain what REDUCE is.}
+In 1966, a model for a standard @Lisp subset was proposed@cite(Hearn66) as
+part of a general effort to make @Reduce@cite(Hearn73), a large
+@Lisp-based algebraic manipulation system, as portable as possible.
+The goal of this proposal was to define a uniform subset of @lng[Lisp 1.5]
+and its variants so that programs written in this subset could run on any
+of those @Lisp systems.
+
+@Comment{"intervening"? Between what and what?}
+In the intervening years, two deficiencies in the original proposal
+emerged. First, in order to be as general as possible, the specific
+semantics of several key functions were left undefined. Consequently,
+programs built on this subset could not be written with any assumptions
+made about the form of the values of such functions. The second deficiency
+was in the proposed method of implementation of @lng[Standard Lisp]. The
+model considered two versions of @Lisp on any given machine, namely
+@lng[Standard Lisp] and the @Lisp of the host machine, which we shall refer to
+as @lng[Target Lisp].
+@Comment{I CAN'T MAKE SENSE OF THE FOLLOWING (WFG).}
+This meant that if any definition were stored as
+interpretive Target @Lisp, it would vary from implementation to
+implementation; consequently, one could not write programs in Standard
+@LISP which needed to assume any knowledge about the structure of such
+forms. This deficiency became apparent during recent work on the
+development of a portable compiler for
+@Lisp@cite[Griss81b]. It is clearly easier to write a compiler if we
+deal with a single dialect (Standard @Lisp) than if we must
+change it to conform with the various Target @Lisp@xs.
+
+As a result of this study, we produced a more aggressive definition of
+Standard @LISP in the Standard @LISP Report@cite(Marti79).
+That paper can serve as a standard for a reasonably large subset of
+@Lisp with as precise as possible a statement about the semantics
+of each function.
+
+Recent work has concentrated on producing a @i(complete) specification and
+portable implementation of a @lisp based on @lng[Standard LISP].
+Experience with a Portable @Lisp Compiler@cite(Griss81b) and with an
+earlier experimental portable @Lisp implementation@cite(Griss79)) has led
+to the current @PSL implementation strategy: write most of the system in
+@Lisp, compiled with the portable compiler. A small non-@Lisp kernel is
+written in a portable,
+@Lisp-like systems language, @Syslisp.
+
+The previous systems had the problem that the special implementation
+language (called @lng<BIL>), although oriented to @Lisp implementations,
+was a distinct language from @Lisp, so that communication between "system"
+code and "@Lisp" code was difficult. The pattern-driven @lng(BIL) compiler
+was not very efficient. Consequently, the @lng(BIL) work resulted in a
+number of experimental @Lisp@xs on a number of machines. These
+implementations were quite flexible, portable, and useful for @Lisp and
+@Reduce on machines that did not already have any @Lisp, but somewhat
+inefficient. We therefore developed the much more powerful, @Lisp-like
+systems language, @SYSLisp, in which to recode all useful modules. @SYSLisp
+has been targeted to high-level languages (such as @Fortran, @Pascal,
+@lng(C) or @Ada), and also to assembly code. We believe this approach will
+advance our goal of producing a portability strategy which could lead to a
+system efficient enough for realistic experiments with computer algebra and
+ultimately to portable, production quality systems.
ADDED psl-1983/3-1/doc/hp-psl.lpt
Index: psl-1983/3-1/doc/hp-psl.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/hp-psl.lpt
@@ -0,0 +1,276 @@
+
+
+
+
+
+
+ Notes on PSL at HP
+ Cris Perdue
+ Alan Snyder
+ 28 September 1982
+
+1. Introduction
+
+ This memo describes PSL as it exists at HP, as opposed to the standard
+PSL distribution described in the PSL Users Manual. PSL at HP differs from
+standard PSL in a number of significant ways. This memo should be read
+carefully before trying to run PSL at HP.
+
+ This memo describes the version of PSL installed on Hulk on September 28,
+1982. This version does not yet exist on the Vaxen.
+
+2. Before Running PSL on HULK or THOR
+
+ In order to run PSL on HULK or THOR, you must first perform the EXEC
+command:
+
+ @take PSL:LOGICAL-NAMES.CMD
+
+This command defines a set of logical device names that are necessary for the
+proper execution of PSL. If you intend to use PSL more than once, you should
+include the above command in your LOGIN.CMD file. These logical names are
+also referred to below and in other PSL documentation; the above command must
+be performed before you can use any of these logical names.
+
+3. PSL Documentation
+
+ A printed copy of the preliminary PSL manual can be obtained from Ira
+Goldstein's secretary. There is also a complete online version of this manual
+on HULK, organized as a set of files, one per chapter. These are stored in
+files "PLPT:nnnn-chaptername.LPT". Please do not print your own copies of
+these files. The manual is currently available on HEWEY in the directory
+~psl/dist/lpt.
+
+ If you have never used PSL at HP before, the memo "DEC-20 PSL New Users'
+Guide" may be helpful. Copies are available from Ira Goldstein's secretary.
+
+ On HULK there is a set of short HELP files, on directory "PH:". These
+help files are generally not very helpful.
+
+ There is a log of PSL bugs, comments, and inquiries. See the section on
+"PSL Bugs" below. There is also a file of more substantial PSL news items,
+(HULK:) PSL:NEWS.TXT. Be sure to read that file as a companion to this
+document. In addition, there is a file listing most changes made to PSL,
+(HULK:) PSL:BUG-FIX.LOG. This file is updated whenever a change is made to a
+PSL system source file; the changes may not actually be installed until some
+later time.
+
+4. PSL Bugs
+
+ Send bug reports, inquiries, and comments via computer mail to "PSL".
+This procedure should work on any DEC-20 or VAX in CRC.
+
+ The file (HULK:) PSL:BUGS.TXT contains a log of inquiries, comments, and
+bug reports concerning PSL and its documentation. The file is kept up to date
+and is edited somewhat. Entries are in chronological order, most recent
+first, so it is easy to find the latest and most wonderful bugs. The file
+(HULK:) PSL:BUG-MAIL.TXT contains the unedited accumulation of mail to PSL.
+
+5. Local PSL -- What's in it
+
+ PSL at HP has some modules preloaded on top of the "bare PSL", which is
+the minimum set of features now available in a PSL. Some of these modules are
+described in the PSL manual and are part of the standard PSL distribution;
+these are preloaded as a convenience for users. Others are local
+contributions; these are described in greater detail below.
+
+ The following modules described in the PSL manual are loaded as part of
+"PSL" at HP. We have chosen these modules as being most useful for most
+people.
+
+ useful This module provides a variety of useful features, many
+ or all of them documented in the PSL manual, including
+ the "extended" FOR loop. These functions generally have
+ an obscure annotation in the manual saying that they are
+ available in the USEFUL library.
+
+ strings This module defines all of the string and character
+ functions defined in section 8.7 of the manual, except
+ for Char and String, whose definitions there conflict
+ with definitions specified elsewhere in PSL.
+
+ nstruct This module provides a "defstruct" facility said to be
+ the same as the one available on the LISP machines. This
+ is a fancy package that allows the user to define and
+ make use of record or structure-like objects in LISP.
+ See the LISP machine documentation for details, but note
+ that in PSL, colons should not be used to prefix
+ keywords.
+
+ debug This module provides various debugging features as
+ described in the PSL manual. Most of them are not very
+ high-powered.
+
+ gsort This module defines some functions for sorting lists and
+ some predicates useful in sorting.
+
+ common This module defines some functions of "Common LISP".
+ This module is incomplete in many ways: many Common LISP
+ functions are either not provided or are provided in a
+ limited form. This module is intended as a compatibility
+ package rather than an extension to PSL. Common LISP is
+ a relative of MacLISP, and is described in the "Common
+ LISP Reference Manual", copies of which are floating
+ around the Application Technology Department.
+
+ Many other modules, although mentioned in the PSL manual, are not loaded
+in "PSL" at HP. Most notable of these are RLISP, the Pascal-like syntax for
+Standard Lisp, COMPILER, the PSL compiler, and EMODE, a screen editor. See
+below for information on compiling PSL programs. EMODE has been replaced by
+NMODE, a locally written editor that is described below.
+
+ The following are locally-contributed modules that are preloaded in "PSL"
+at HP. These modules are not described in the PSL Users Manual.
+Unfortunately, as a result, there is no easy way to prevent your programs from
+clashing with symbols defined in these modules. Only the most important such
+modules are listed here.
+
+ nmode NMODE is an EMACS-like screen editor. It provides a
+ different LISP interface than that described in the PSL
+ manual. See below for more information.
+
+ objects OBJECTS is a primitive package for supporting
+ object-oriented programming. It is used extensively in
+ NMODE and other HP contributions. It supports a very
+ limited subset of the Lisp Machine flavors package.
+ Notably missing is any support for inheritance. See the
+ file <AS.PSL>OBJECTS.SL on Hulk for further information.
+
+ input-stream INPUT-STREAM is a class of objects implemented using the
+ OBJECTS package that provide for buffered file input. It
+ is used primarily by NMODE. See the file
+ <AS.PSL>INPUT-STREAM.SL on Hulk for details.
+
+ output-stream OUTPUT-STREAM is a class of objects implemented using the
+ OBJECTS package that provide for buffered file output.
+ It is used primarily by NMODE. See the file
+ <AS.PSL>OUTPUT-STREAM.SL on Hulk for details.
+
+ pathnames PATHNAMES is a compatible subset of the Common Lisp
+ pathname package. It provides a system-independent
+ interface for manipulating file names. See the file
+ P20SUP:PATHNAMES.SL for information on the DEC-20
+ version, and the "Common Lisp Reference Manual".
+
+
+6. NMODE
+
+ NMODE is an EMACS-like screen editor. It currently supports only HP
+terminals, and does not support HP262X terminals well. It supports a useful
+subset of the EMACS command interface, although many significant features are
+missing. A list of the NMODE commands is attached as an appendix to this
+document. Available documentation on NMODE includes the following memos: (1)
+"NMODE for EMODE Users" - a brief description of NMODE written primarily for
+those users already familiar with EMODE. (2) "Customizing NMODE" - a
+description of how to customize NMODE by defining new commands or redefining
+existing commands. These memos are available on the directory PSL: on Hulk.
+
+ NMODE provides a display-oriented Lisp interface that is significantly
+different than the "standard" PSL interface described in the PSL Users Manual.
+At HP, PSL starts up in NMODE. However, it is possible to get to the
+"standard" PSL interface simply by executing the command C-] L. (For those
+not familiar with EMACS, this means to type two characters: "CONTROL-]",
+followed by "L".) From the PSL interface, you can return to NMODE by invoking
+the function NMODE (with no arguments), or by RESETing (invoking the function
+RESET or aborting from a break loop), or reSTARTing (returning to EXEC via ^C
+and using the "START" command).
+
+ The proper way to leave NMODE and return to EXEC is to use the command
+C-X C-Z. While ^C will get you back to EXEC, it may leave your terminal in a
+funny state. Using C-X C-Z allows NMODE to restore your terminal to the
+proper state before returning control to the EXEC.
+
+ NMODE's display-oriented Lisp interface is based on the idea of reading
+from and writing to NMODE text buffers. The NMODE command "Lisp-E" (which is
+typed as C-] E) causes PSL to read and evaluate the form starting on the
+current line of the current buffer. The output resulting from that evaluation
+is appended to the buffer named "OUTPUT" (which is the current buffer when PSL
+starts up).
+
+ If the evaluation of a Lisp form causes an error, a Break Handler will be
+entered. Terminal input will continue to be directed to NMODE, and NMODE can
+still be used as an editor while the Break Handler is active. NMODE provides
+a number of special commands for interacting with an active Break handler: The
+command "Lisp-Q" (typed as C-] Q) quits out of the innermost break handler.
+The command "Lisp-A" (typed as C-] A) aborts all the way back to the top level
+and restarts NMODE. The command "Lisp-R" attempts to retry the failing action
+that caused the error (which must be a "continuable" error). The command
+"Lisp-C" is similar, except that rather than reevaluating the "errorform", it
+uses the result of the last expression evaluated using "Lisp-E". The command
+"Lisp-B" prints a backtrace. The "Lisp-" commands are available only in LISP
+mode. To enter Lisp mode, use the command "M-X Lisp Mode".
+
+7. Compiling PSL
+
+ As mentioned above, the PSL compiler is not normally loaded in PSL. The
+recommended way to compile PSL programs is to use the program PSLCOMP.
+PSLCOMP compiles a PSL source file (e.g. "foo.sl") and produces a binary
+object file (e.g. "foo.b"). PSLCOMP is invoked by the EXEC command
+
+ @PSLCOMP foo
+or @PSLCOMP foo.sl
+
+PSLCOMP may be given multiple source file names (separated by spaces) and will
+produce a separate binary file for each source file; however, this practice is
+dangerous because the "compilation context" created for one source file will
+remain and may affect the compilation of a later source file.
+
+ The object file "foo.b" created by PSLCOMP may be loaded into PSL using
+either LOAD or FASLIN, as follows:
+
+ (LOAD FOO)
+ (FASLIN "FOO.B")
+
+The difference between LOAD and FASLIN is that LOAD will not reload a file
+that has already been loaded.
+
+ If you use any non-standard macros, fexprs, or nexprs that are defined in
+other files, you must cause definitions of those functions to be loaded into
+PSLCOMP when it compiles your source file. The way to do this is to include a
+statement of the form
+
+ (CompileTime (load Module1 Module2 ... ))
+
+at the beginning of your source file, where Module1, Module2, ... are
+LOADable modules that define the macros, etc. that you use. PSLCOMP is
+preloaded with the following modules: COMMON, USEFUL, STRINGS, OBJECTS,
+PATHNAMES, NSTRUCT.
+
+8. PSL Directories and Subdirectories -- HULK
+
+ HULK has a complete set of source files, command files, object files,
+etc. THOR currently does not, and has only a single directory for PSL.
+Status of PSL directories and subdirectories on HEWEY is subject to change at
+any time, so it isn't discussed here.
+
+ Sources on Hulk reside in SS:<PSL> and its subdirectories. The
+subdirectories of SS:<PSL> are organized in a logical fashion. The file
+"PSL:-THIS-.DIRECTORY" contains short descriptions of the files in SS:<PSL>
+and the subdirectories of SS:<PSL>. To see the complete set of subdirectories
+of SS:<PSL>, type "DSKUSE SS:<PSL*>" to EXEC. Note that the source code is
+kept separate from the object code, which is all on PL:.
+
+8.1 TAGS -- Finding the Definitions of PSL System Functions
+
+ The EMACS editor has a feature that is of great help in finding source
+code, the TAGS package. To use this package, first load a "tag table", which
+is a database that records what source file definitions appear in. One tag
+table can hold definitions that appear in many different source files. We
+have a very large tag table for all of PSL, which is in the file (HULK:)
+PSL:PSL.TAGS.
+
+ To load a tag table file, do "M-X Visit Tag Table" in EMACS and give the
+file name as an argument. Once a file is loaded, search for a definition
+using "M-.". You may wish to set the EMACS variable Tags Find File to 1
+before searching for definitions. Note also that tag table files may become
+somewhat out of date. Do not expect perfection.
+
+ The program TAGS is used to create tag table files. The version that
+handles PSL (and RLISP) syntax, as well as understanding the file types .SL
+and .RED is PSL:TAGS.EXE. The system version of TAGS may eventually
+understand these things.
+
+ Full information on the EMACS TAGS package is only available in the EMACS
+manual and through the INFO facility. Do not bother the PSL group with
+questions and complaints about TAGS until you have read the full
+documentation. We will not improve the TAGS package itself in any case.
ADDED psl-1983/3-1/doc/implementation-guide.mss
Index: psl-1983/3-1/doc/implementation-guide.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/implementation-guide.mss
@@ -0,0 +1,3164 @@
+@make(article)
+@Case(Draft, 1 <@device(Omnitech)>,
+ else <@device(LPT)>
+ )
+@Comment{ For use with the final versions }
+@Style(WidowAction=warn)
+@Style(Hyphenation Off) @comment(on)
+@Style(DoubleSided no) @comment(yes)
+@style(Spacing 1, LeftMargin 1.2 Inch)
+@comment[See G:MSS-junk.MSS]
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@comment{ Font related stuff }
+@Define(OP,FaceCode Y,TabExport)@comment{ used for indicating opcodes in
+ C-macros }
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+@LibraryFile(PSLMacrosNames)
+@LibraryFile(SpecialCharacters)
+@comment{ The logos and other fancy macros }
+@PageHeading(Left "Utah Symbolic Computation Group",
+ Right "May 1982",
+ Line "Operating Note No. xx"
+ )
+@set(page=1)
+@newpage()
+@Begin(TitlePage)
+@begin(TitleBox)
+@MajorHeading(@PSL Implementation Guide)
+@Heading(M. L. Griss, E. Benson, R. Kessler, S. Lowder,
+G. Q. Maguire, Jr. and J. W. Peterson)
+Utah Symbolic Computation Group
+Computer Science Department
+University of Utah
+Salt Lake City, Utah 84112
+(801)-581-5017
+
+Last Update: @value(date)
+@end(TitleBox)
+@begin(abstract)
+This note describes the steps involved in bringing PSL up on a new
+machine. It combines information from the previous BOOTSTRAP, LAP,
+CMACRO and TEST guides.
+@end(abstract)
+@center[
+File: @Value(SourceFile)
+Printed: @value(date)]
+@copyrightnotice(Griss, Benson, Lowder, Maguire and Peterson)
+@begin(ResearchCredit)
+Work supported in part by the National Science Foundation under Grant
+No. MCS80-07034, and by Livermore Lawrence Laboratories under
+Subcontract No. 7752601, IBM and HP.
+@end(ResearchCredit)
+@end(TitlePage)
+
+@pageheading(Left "Implementation Guide", Center "@value(date)",
+ Right "Page @Value(Page)"
+ ) @comment{@pageheading(Even,Left "Page @Value(Page)",
+ Right "Operating Note No. xx"
+ )} @set(page=1) @newpage()
+
+@section(Introduction)
+
+This document describes the techniques used to implement PSL on a new
+machine. This note assumes that the reader has some familiarity with
+the basic strategy of @PSL implementation (see the 1982 LISP Conference
+Paper on PSL, UCP-83), and has also read the papers on the @PSL Portable
+@xlisp compiler (Griss and Hearn, "Software Practice and Experience",
+and Griss, Hearn and Benson, 1982 Compiler Conference). Also see the
+compiler chapter (19) of the @PSL manual@cite[Griss81]. Finally, a
+basic understanding of how to use PSL and LISP is required@cite[Griss81].
+
+In order to explain a new PSL implementation, we will first describe the
+PSL compilation model, hopefully providing some insight into the various
+steps involved in the transformation of PSL sources into code executable
+on the target machine. @comment{May want to add a description of each
+section to follow}
+
+The initial level of transformation takes the RLISP format and
+translates it into LISP for those source files that are written in RLISP
+format; those files already in LISP may be directly input into the
+system (see the figure below). The LISP code is then compiled into
+instructions for an Abstract Lisp Machine (ALM). The ALM is a
+general-purpose register machine designed for its ease as a target for
+compilation@cite(Griss81b) in which temporary variables are allocated in
+a block of locations on a @ei[stack]. The ALM instructions are
+expressed in LAP format (LISP Assembly Program) which
+consists of a list whose first element is the ALM opecode
+followed by zero or more ALM operands which are ALM addressing
+modes. The ALM format is (ALMopcode ALMoperand ... ALMoperand).
+ The ALMopcode is a macro referred to as a CMACRO and the
+addressing modes of the ALMoperands are referred to as ANYRegs.
+
+The ALM instructions are macro expanded into instructions for the Target Lisp
+Machine (TLM). TLM instructions have the same LAP format, except the
+operators are now TLM operators and the operands are TLM addressing modes.
+
+From here, a number of alternate routes are possible for the final code
+generation. So far the LISP or RLISP has transformed into
+into a set of TLM instructions that can take one of three paths.
+
+@begin(enumerate)
+Fist, the TLM instructions can be printed out as Target Machine Assembly
+code (ASM) for assembly on the
+target machine. This route is followed in the initial phases of the PSL
+implementation process to produce code for the target machine.
+
+Secondly, a file of the target machine code can be produced in a
+format that can be loaded directly into a running PSL system. This
+process is called FASLing, producing a FASt Load format file.
+
+Finally, the TLM code can be assembled and deposited directly into memopry
+of the running PSL system.
+This is basically analogous to the process used to load in a FASL file
+produced above except the code is not written to or read from a FASL file.
+@end(enumerate)
+
+This process is illustrated below:
+
+@begin(verbatim,leftmargin 0,group)
+ .-----------------. Rlisp: Procedure SelectOne x;
+ | RLISP input code| x := car x;
+ `-----------------'
+ v
+ .------.
+ | LISP | Lisp: (de selectone (x)
+ `------' (setq x (car x)))
+ v
+ .----------.
+ | Compiler |
+ `----------'
+ v
+.------------------------. ALM: (!*entry selectone expr 1)
+|ALM instructions in LAP | (!*alloc 0)
+| format | (!*move (car (reg 1))
+`------------------------' (reg 1))
+ v (!*exit 0)
+ .----------.
+ | Pass1Lap |
+ `----------'
+ |
+ v
+.---------------------. TLM: [68000 code]
+| TLM instructions in | (Fullword 1) Count of Args
+| LAP format. | (!*Entry selectone expr 1)
+`---------------------' (movea!.l (indirect
+ | | (reg 1)) (reg 1))
+ | v (rts)
+ | .------------.
+ | | TLM to ASM |
+ | | converter |
+ | `------------'
+ | v
+ | .-------------------. ASM: dc.l 1
+ | | | movea.l (a1),a1
+ | | Asm code suitable | rts
+ | | for TM assembler |
+ | `-------------------'
+ v
+.--------------. .-----------------.
+| LAP resident |----->| Resident binary |
+| assembler | | `-----------------'
++--------------+ | .------------.
+ `-->| FASL files |
+ `------------'
+@end(verbatim)
+
+In summary, here is an overview of the steps necessary to implement
+PSLon your target machine. More details will be given in the
+following sections.
+@begin(enumerate)
+Prelimaries:
+@begin(enumerate)
+Believe in yourself.
+
+Choose the host machine.
+
+Test file transfer.
+@end(enumerate)
+
+Decide how to map the ALM architecture to the TLM.
+
+Implement the TLM to ASM.
+
+Implement the ALM to TLM.
+
+Build the Cross Compiler and test.
+
+Run Cmacro Tests.
+
+Build Bare PSL.
+
+Implement a resident TLM assembler.
+
+Implement FASL.
+
+Bootstrap the compiler.
+@end(enumerate)
+
+
+@section(Overview of the Abstract LISP Machine)
+The abstract machine is really a class of related machines rather than a
+single fixed machine (such as PASCAL P-code, or some true @xlisp machines).
+The exact set of @CMACRO@XS, the number of registers, etc@. are under the
+control of parameters, flags and compiler code-generator patterns defined
+for the specific machine. This flexibility permits the match between the
+compilation model and the target machine to be better set, producing better
+code. Therefore, the exact set and meaning of @CMACRO@XS are not
+fixed by this definition; rather, they form an adjustable @dq[convention]
+between the compilation and @CMACRO/Assembly phase. The compiler itself is
+defined in PC:COMPILER.RED@Foot[dir: represents a logical directory name,
+in this PC: stands for <PSL.Comp> under Tops-20 or /psl/comp under UNIX.]
+and is augmented by machine-specific files, described later.
+
+The ABSTRACT LISP MACHINE (ALM) used by our compiler has the following
+characteristics.
+
+
+
+@begin(enumerate)
+There are 15 general purpose registers, 1 ..@. 15;
+and a stack for call/return addresses.
+
+Locals and temporaries variables are allocated on the stack by
+allocating a frame of temporaries large enough to hold them all, not
+by the use of push and pop instructions.
+
+The function calling mechanism loads N args into 1 ..@. N, and
+then transfers to the function entry point, pushing the return
+address onto the stack if necessary.
+The functions result is returned in register 1.
+
+Each procedure is responsible to save any values it needs on stack;
+small procedures often do not use the stack at all.
+
+The following is a brief lisp of all the ALM opcodes (CMACROS).
+
+@begin(verbatim)
+(!*ALLOC nframe:integer)
+(!*ASHIFT dest:any-alterable source:any)
+(!*CALL name:id)
+(!*DEALLOC nframe:integer)
+(!*EXIT nframe:integer)
+(!*FIELD operand:any-alterable starting-bit:integer
+ bit-length:integer)
+(!*FOREIGNLINK name:id type:id
+ number-of-arguments:integer)
+(!*FREERSTR l:nonlocalvars-list)
+(!*JCALL name:id)
+(!*JUMP label:any)
+(!*JUMPEQ label:any source1:any source2:any)
+(!*JUMPINTYPE label:any source1:any type-name:id)
+(!*JUMPNOTEQ label:any source1:any source2:any)
+(!*JUMPNOTINTYPE label:any source1:any type-name:id)
+(!*JUMPNOTTYPE label:any source1:any type-name:id)
+(!*JUMPON source:any lower-bound:integer
+ upper-bound:integer l:label-list)
+(!*JUMPTYPE label:any source1:any type-name:id)
+(!*JUMPWGEQ label:any source1:any source2:any)
+(!*JUMPWGREATERP label:any source1:any source2:any)
+(!*JUMPWITHIN label:any lower-bound:integer
+ upper-bound:integer)
+(!*JUMPWLEQ label:any source1:any source2:any)
+(!*JUMPWLESSP label:any source1:any source2:any)
+(!*LAMBIND r:registers-list l:nonlocalvars-list)
+(!*LBL label:tagged-label)
+(!*LINK name:id type:id number-of-arguments:integer)
+(!*LINKE nframe:integer name:id type:id
+ number-of-arguments:integer)
+(!*LOC dest:any-alterable source:any)
+(!*MKITEM inf:any-alterable tag:any)
+(!*MOVE source:any dest:any-alterable)
+(!*POP dest:any-alterable)
+(!*PROGBIND l:nonlocalvars-list)
+(!*PUSH source:any)
+(!*PUTFIELD source:any dest:any-alterable
+ starting-bit:integer bit-length:integer)
+(!*SIGNEDFIELD operand:any-alterable
+ starting-bit:integer
+ bit-length:integer)
+(!*WAND dest:any-alterable source:any)
+(!*WDIFFERENCE dest:any-alterable source:any)
+(!*WMINUS dest:any-alterable source:any)
+(!*WNOT dest:any-alterable source:any)
+(!*WOR dest:any-alterable source:any)
+(!*WPLUS2 dest:any-alterable source:any)
+(!*WSHIFT dest:any-alterable source:any)
+(!*WTIMES2 dest:any-alterable source:any)
+(!*WXOR dest:any-alterable source:any)
+
+(LABELGEN tag:id)
+(LABELREF tag:id)
+(!*CERROR message:any)
+
+(FULLWORD [exp:wconst-expression])
+(HALFWORD [exp:wconst-expression])
+(BYTE [exp:wconst-expression])
+(STRING s:string)
+(FLOAT f:float)
+
+@end(verbatim)
+
+ALM operand forms ("addressing" modes)
+
+@begin(verbatim)
+(FLUID name:id)
+(!$FLUID name:id)
+(GLOBAL name:id)
+(!$GLOBAL name:id)
+(WVAR name:id)
+
+(WARRAY name:id)
+(WSTRING name:id)
+(WCONST expr:wconst-expression)
+(IMMEDIATE wconst-expression:any)
+(QUOTE s-exp:s-expression)
+(LABEL l:id)
+
+(MEMORY base:any offset:wconst-expression)
+(CAR base:any)
+(CDR base:any)
+
+(FRAME n:integer)
+(REG reg-descriptor:{integer,id})
+
+(LIT [any-instruction-or-label:{list,id}])
+(LABELGEN tag:id)
+(LABELREF tag:id)
+
+(IDLOC symbol:id)
+@end(verbatim)
+@end(enumerate)
+
+@Section(System Overview for Bootstrapping)
+Currently PSL is half bootstrapped from a complete PSL system on a
+host machine. At the moment only the Decsystem 20 and the VAX 750
+can be used as hosts; shortly we expect the Apollo and HP9836 to
+be also usuable.
+If you have a choice for your host machine, one important consideration
+will be the ease in shipping code between the host and target. It is worth
+taking the time initially to be sure this pathway is as smooth and troublefree
+as possible. The need for easy file transfers is derived from the half
+bootstrap method and the iterative nature of developing and debugging the
+tables used in the ALM to TLM transformation. The size of the transferred
+files will be in the range of 1 to 70 KBytes.
+Having a fast network or a tape transfer from host to target is worth
+considering in the beginning of a PSL implementation.
+
+The first major step in the implementation will be to modify the host PSL
+to become a cross compiler, turning lisp or rlisp into the target machines
+assembly language.
+
+@SubSection(Overview of the Cross Compiler)
+Three modules are created, compiled and loaded into a host PSL to transform
+it into a cross compiler.
+
+@begin(enumerate)
+The first module will be xxx-comp.red (we will use XXX to represent
+the name of the target machine, like DEC20, VAX, etc.); a file
+containing patterns used by the compiler to control which ALM
+instructions are emitted for certain instructions. Basically it is
+used in LISP to ALM transformations and initially will only require
+you to copy the same file used on your host machine.
+
+The second module will be xxx-cmac.sl. This file contains the
+tables(CMacroPatternTables) used to convert ALM opcodes to TLM opcodes,
+the tables used to convert ALM addressingmodes into TLM addressingmodes
+(ANYREGS), and some miscellaneous required opencoded functions.
+
+The last module, xxx-asm, consists of two files, xxx-asm.red and
+xxx-data-machine.red. The first file, xxx-asm.red, specifies the necessary
+formats, costants, and procedures for converting TLM instructions into the
+host's actual assembly language. The file, xxx-data-machine.red, provides
+constants for describing to the compiler some of the specific choices for
+what registers to use and how the lisp item will be used in the machine
+words.
+@end(enumerate)
+All of these modules are compiled and loaded into a host PSL to turn
+it into the cross compiler. The next few sections will try to
+describe to the reader how these three modules are actually designed
+and built from the bottom up. It will be worth getting a listing of
+these modules for your host machine and also for a machine most similar
+to your target machine, if available.
+
+@Section(Designing the TLM instruction format).
+
+The implementor must decide first the specifics of the TLM instruction
+format patterned around the form (TLMopcode TLMoperand ... TLMoperand).
+The TLM to ASM translation occurs in a parallel manner.
+
+(TLMopcode TLMoperand TLMoperand) TLM format.
+ | | |
+ ASMopcode ASMoperand ASMoperand Some ASM format.
+
+
+The closer the ASM format approaches the TLM format the better. However in
+some cases this will not be possible and the reader must devise a scheme.
+Take a look at the case studies for some ideas of ways to handle some of
+these issues.
+
+TLM opcodes are usually passed through unchanged to the ASM code.
+However the TLM operands will require extensive changes. [Mention
+terminal operands!!!]. The TLM operands are of the form
+(addressingmode value-expression). The addressingmode is a tag which
+will direct what procedures will be used to convert and print the ASM
+operands. The reader should pick these addressingmode names to closely
+match the addressingmodes of the target machine. Some examples of
+these would be (immediate ...), (indirect ...), (displacement ...), or
+(indexed ...). Here again the case studies will give you some
+information for proceeding. [Mention CRAY mismatch of TLM].
+
+@Section(Implementing the TLM to ASM conversion)
+
+You can begin by creating the xxx-data-machine.red file and begin to add
+some definitions. First pick a name for your system, anything
+representative will do like the name of its operating system or its
+manufacturers identifier. Some examples are dec20, vax, apollo, or m68000.
+
+@begin[verbatim]
+fluid '(system_list!*);
+system_list!* := '(MC68000 Chipmunk HP9836);
+@end[verbatim]
+
+
+The next step is quite important. You must decide how you are going to
+implement the LISP item on the target machine.
+The LISP item consists of 2 or three fields; each field
+having a position and size in the machines item picked by the
+implementor. All LISP items must have a tag field and an INFormation
+field and some implementations have a garbage collector field. The
+tag field must be at least 5 bits long@Foot[Nineteen (19) different tags are
+presently used.] and the inf field should be large
+enough to hold a target machine address. Some implementations, such
+as the Vax, will choose an inf smaller than the largest address
+possible on the machine and will have to mask tag bits out when using
+the inf field as an address. This does cause problems and should be
+avoided if possible. If space allows it the INF
+field may be larger to allow larger numeric operands to be stored in
+registers.
+
+Currently PSL provides two different garbage collection methods, one
+of which should be chosen (or a new one developed if needed). One is
+a two-space copying collector, which requires no extra garbage
+collection bits, but is very wasteful of space and is best for a
+virtual memory machine (in fact, there are two copies of the heap).
+The other is a one space compacting collector, and requires at least
+one bit for marking, and ideally additional bits for relocation
+(sometimes, these extra bits can be stored in a separate bit table).
+Naturally these fields may be larger to make their accessing easier,
+like aligning on a byte boundary.
+
+Once you have decided upon how the LISP item will be implemented on the
+machine you can begin filling in the constant definitions for the
+xxx-data-machine.red file. When numbering bits in a machine word, we have
+settled upon the convention that the most significant bit is zero and
+counts up to the max-1 bit.
+The current constants are
+@begin(verbatim)
+TagStartingBit
+TagBitLength
+InfStartingBit
+InfBitLength
+AddressingUnitsPerItem
+CharactersPerWord
+BitsPerWord
+AddressingUnitsPerFunctionCell
+StackDirection
+
+and optionally
+
+GCStartingBit
+GCBitLength
+@end(verbatim)
+The following figure illustrates the positions of these constants:
+@begin(verbatim)
+
+ .-----------------------------------------.
+ | TAG | [gc] | INF |
+ `-----------------------------------------'
+ FILL IN LATER
+
+@end(verbatim)
+Some other decisions that must be made include:
+@begin(enumerate)
+Which and how many registers to dedicate as the compiler-allocated
+@ei[Registers];
+
+How large an integer will be supported in the @xlisp item;
+
+How many tags are to be supported
+
+How to implement the recursion stack and check for stack overflow
+(either using an explicit test, or some machine-interrupt);
+
+How to pack and unpack strings;
+
+@Comment{PSL must have explicitly tagged items, and the current allocator
+is a simple linear model, so this is not relevant.
+
+Whether to have a heterogeneous heap, multiple heaps, a @ei[page] per type,
+or whatever;}
+
+@Comment{This is also not relevant. Pairs are the same on all machines.
+How pairs are referenced, i.e. does the pointer to a pair point to the
+first element, to the second element, are the pairs allocated
+separately in parallel areas, or is there some type of CDR coding being
+done.}
+@end(enumerate)
+
+The next step is to implement the tables that accept the ALM
+form and emits assembly code for the target machine.
+Most of the program is machine-independent (using
+PC:LAP-TO-ASM.RED), and an @dq[xxxx-ASM.RED] file is to be
+written. We have the following already written as a guide: @DEC20
+@dq[MACRO], @VAX750 @UNIX @dq[as], @68000 for @apollo and WICAT, and CRAY
+CTSS CIVIC. The main problem is to emit the correct format, such as:
+placement of tabs, commas, spaces, parentheses; renaming symbols (certain
+legal @xlisp IDs are not legal in some assemblers); and determining how and
+where to place EXTERNAL, ENTRY and GLOBAL declarations, how to declare and
+reserve blocks of storage, and how to overcome certain problems involved
+with large files and restrictions on addressing modes and relocation.
+
+Finally, the ALM to ASM needs to be tested. This is usually
+accomplished by Hand-coding some small test routines, and
+then convert from ALM to machine X assembly code, assemble, and run. This
+checks the final details of required Prologues and
+Epilogues@Foot[Prologues and Epilogues contain operating system-specific
+standard module headers and trailers.], understanding of the instruction
+set, and so on. Suggested LAP tests are described @ei[generically], but
+will have to be translated by the implementor into machine-dependent LAP
+for machine X, and depending on the flavor of assembler and LAP, other
+tests will have to be devised by the implementor. This is a good time to
+investigate how Assembly coded routine can call (and be called) by the
+most common language used on machine X (such as FORTRAN, PASCAL, C, etc.).
+This "Foreign" language can be used for initial operating system support.
+
+@section(Implementing the ALM instructions)
+
+The ALM instructions consists of a set of operations and their
+addressing mode operands. These ALM instructions are commonly
+referred to as CMACRO's and the addressing modes are ANYREG's. The
+purpose of this part of the PSL implementation is to implement the
+functionality of each ALM instruction in terms of other ALM
+instructions and TLM instructions. The ability to recursively define
+the ALM instructions in terms of other ALM instructions is a benefit
+because it greatly decreases the amount of code required to implement
+a particular instruction. For example, a good technique in designing
+the ALM instructions is to carefully implement the !*MOVE instruction
+(to distinguish ALM instructions, they generally have a !* in the front
+of their name) to
+efficiently handle transfer between any possible locations (memory to
+register, stack frame to memory, etc.). Then when implementing
+another instruction, the code for moving the actual operands to
+locations necessary for the TLM instruction can be accomplished using
+a recursive call to the !*MOVE ALM instruction.
+
+The important tasks of the implementor are to
+@begin(enumerate)
+Carefully examine the instruction set and architecture of the TLM to
+see which instruction (instructions) correspond to each ALM CMACRO;
+
+Decide how to map the ALM registers and addressing modes onto the
+TLM registers and addressing modes (some will map one-to-one, others
+will take some thought, and a sequence of actions);
+
+Decide on a set of classifications of the TLM modes that distinguish
+which of a related set of TLM opcodes should be used to implement
+a particular ALM opcode, and write predicates that examine ALM and TLM
+modes to decide which class they are in;
+
+Write tables to map ALM modes into TLM modes, using these predicates,
+and then ALM opcodes into a (sequence of) TLM opcodes with the correct
+TLM modes.
+@end(enumerate)
+
+@subsection(Mechanics of ALM Instruction Definition)
+Before we get into the description of the ALM instructions, we must first
+define the table-driven pattern matching approach used to implement
+them. This approach allows definition of
+an ALM instruction in terms of a pattern predicate which is used to match
+the operands of the ALM instruction and a body that may consist of a
+mixture of ALM instructions (for recursive decomposition) and TLM
+instructions (for direct code generation). This is exactly analogous to
+the COND construct in LISP. Just like COND, any number of predicate/body
+pairs may be included in the expansion of an ALM instruction. Also, the
+order of the pairs is quite important (since they are compared in order
+from first to last). Typically, the most specific predicates are described
+first followed by gradually more and more general ones. The table
+definition for a specific ALM instruction is compiled into a single
+procedure. The instruction name must then be flagged with 'MC to
+indicate that it is a legal ALM instruction. The pattern table itself
+must then be stored under the indicator 'CMACROPATTERNTABLE on the ALM
+instruction property list. To simplify this process, the DefCmacro
+Macro has been defined:
+@begin(verbatim)
+
+ (DefCMacro ALMInstructionName
+ (pred1 body1)
+ (pred2 body2)
+ ...
+ lastbody)
+
+@end(verbatim)
+
+Each ALM instruction is defined with a set number of arguments and the
+predicates are used to compare the types and/or values of the arguments. A
+predicate need not test all arguments, with non-tested arguments defaulting
+to T for a value. For example, one could define the following patterns:
+@begin(verbatim)
+
+ Predicate Body
+ (DefCMacro ALMInst
+ ((FOOP) (Body1))
+ ((FEEP BARP) (Body2))
+ ((ANYP) (Body3))
+ (Body4))
+
+@end(verbatim)
+Note that this looks almost exactly like the LISP operation COND. The
+one difference lies with the Body4 in the above example, which has no
+predicate and will always be evaluated if all others fail (Similar to
+the final 'T case in a Cond without the T). This last predicate/body
+pair may NOT have a predicate. If it doesn't, it will be evaluted just
+like the body. [!!Future change - CERROR on the default case, and make
+the defined use ANYP for his default case]
+The predicate
+functions are automatically passed one argument which is the ALM operand in
+the position of the test. So, in the above example, FOOP is passed the
+first operand and BARP is passed the second, after failure in the FOOP
+test.
+
+The body can be thought of as an implicit PROGN that contains a set of ALM
+and TLM instructions. These instructions then reference the various
+operands as ARGONE, ARGTWO, ARGTHREE, etc. using lexical ordering in the
+instruction. For example, if an ALM instruction mapped directly to a TLM
+one, it may be defined as:
+@begin(verbatim)
+
+ ((FOOP BARP) (TLMOperator ARGONE ARGTWO))
+
+@end(verbatim)
+Or, it may map into a number of ALM and TLM instructions:
+@begin(verbatim)
+
+ ((FEEP) (ALMOperator ARGONE Something)
+ (TLMOperator Something ARGTWO)
+ (ALMOperator Something ARGONE))
+
+@end(verbatim)
+Notice that even though the predicates only test the first operand ARGONE,
+the other operands may be referenced in the body. Also, "Something" can be
+thought of as a kind of constant operand (like a particular register, an
+integer constant, a memory location or whatever).
+
+In order to facilitate more complicated instructions within the body, we
+must now introduce a number of other features. First, suppose that you
+wish to include code generation time constants within the body. This can
+be accomplished by placing on the property of a variable name, 'WCONST with
+its value being the desired constant. Then when the variable is
+encountered in the instruction expansion, it will be replaced by the value
+on its property list under the 'WCONST indicator. A useful function to
+perform this operation would be:
+@begin(verbatim)
+
+ (DE MakeReferencedConst (ConstName ConstValue)
+ (Put ConstName 'WCONST ConstValue))
+
+@end(verbatim)
+Therefore, if you perform a (MakeReferencedConst 'TAGPOSITION 10) then the
+body may reference TAGPOSITION directly:
+@begin(verbatim)
+
+ ((FOOP) (ALMOperator ARGONE TAGPOSITION))
+
+@end(verbatim)
+Now, that we have constants, it is sometimes desirable to have constant
+expressions. As long as all of the operands are either direct or
+referenced constants, the expression can be evaluated in an ALM or TLM
+instruction (the function may also be called if it doesn't have any
+operands). For example, the following could be imbedded within an
+instruction body:
+@begin(verbatim)
+
+ (Plus2 (Foo 35 TagPosition) WordWidth)
+
+@end(verbatim)
+The system also provides for an alias mechanism, so you can map one name
+into another. This is accomplished by placing on the property of the
+alias, the name of the acutal function under the property DOFN. Thus, if
+you wanted to map FEE into PLUS2, you would simply: (Put 'FEE 'DOFN
+'PLUS2). Therefore, another useful function would be:
+@begin(verbatim)
+ (DE Alias (AliasFunction ActualFunction)
+ (Put AliasFunction 'DOFN ActualFunction))
+@end(verbatim)
+
+Sometimes in the process of generating the TLM instructions, it is
+necessary to make use of a temporary label (i.e. to generate a forward
+branch). This can be accomplished by referencing TEMPLABEL (just like a
+reference to ARGONE), which will create a label name consistent with a
+particular body. For example:
+@begin(verbatim)
+
+ ((FOOP) (Test ARGONE)
+ (GO (Label TEMPLABEL))
+ (Operate ARGONE ARGTWO)
+ (Label TEMPLABEL))
+
+@end(verbatim)
+Notice that even if the label references are separated by recursive ALM
+instructions, it will still create a unique reference to the label in both
+places. There is another mechanism to accomplish the same task in a more
+general fashion, that allows referencing of multiple labels. This
+mechanism is used with two functions:
+@begin(description)
+LabelGen@\This function takes one argument and returns a generated label.
+The argument and label are stored on an A-List for later reference. The
+argument may be any atom.
+
+LabelRef@\Look up the argument on the label's A-List and return the
+associated label.
+@end(description)
+An example of the use of these two functions is:
+@begin(verbatim)
+
+ ((FOOP) (Label (LabelGen 'L1))
+ (Test ARGONE)
+ (Go (LabelGen 'L2))
+ (Operator ARGTWO))
+ (Go (LabelRef 'L1))
+ (Label (LabelRef 'L2)))
+
+@end(verbatim)
+
+Finally, if the need arises to be able to call a function within an ALM
+instruction expansion. This can be accomplished by using the ANYREG
+mechanism. It is important to know that this technique will not work for a
+function call within a TLM instruction, only in the recursive expansion of
+an ALM instruction (there is no method for calling a function within
+a TLM instruction). (Note: ANYREG's will be explained in detail later, but
+the mechanism can be used to call a function). The technique is to first
+define the function that you wish to call, with one extra argument (the
+first one) that will be ignored. Then define an anyreg function that calls
+your function. For example, suppose you want a function that returns an
+associated register based upon a register argument (with the association
+stored in an A-List). The code would be implemented as follows:
+@begin(verbatim)
+ (De GetOtherRegFunction (DummyArgument RegName)
+ (Assoc RegName '((A1 S3) (A2 S2) (A3 S1))))
+ (DefAnyReg GetOtherReg GetOtherRegFunction)
+@end(verbatim)
+Then the pattern that may use the function would be:
+@begin(verbatim)
+
+ ((FOOP) (ALMOperator (GetOtherReg ARGONE)
+ (GetOtherReg ARGTWO)))
+
+@end(Verbatim)
+[Future Change - Implement a technique so if it is necessary for a
+random function to be called, all one has to do is define it and flag it
+as something appropriate - like 'ALMRandomFunction]
+
+@subsection(@ANYREG and @CMACRO patterns)
+
+Certain of the ALM operands are @ei[tagged] with a very
+special class of functions thought of as extended addressing modes; these
+@ANYREG@xs are essentially Pseudo instructions, indicating computations
+often done by the addressing hardware (such as field extract, indexing,
+multiple indexing, offset from certain locations, etc.). For example, the
+@xlisp operations CAR and CDR often are compiled in one instruction,
+accessing a field of a word or item. Using @ANYREG in this case, CAR and
+CDR are done as part of some other operations. In most cases, the @ANYREG
+feature is reserved for operations/addressing modes usable with most
+instructions. In some cases, the @ANYREG is too complicated to be done in
+one instruction, so its expansion emits some code to @ei[simplify] the
+requested addressing operation and returns a simpler addressing mode. The
+main thing is all desired computations are done using 1 or zero registers,
+hence the name @dq[@ANYREG].
+
+The @ANYREG@xs have an associated function and possible table, with the
+name of the function under the property 'ANYREGRESOLUTIONFUNCTION and
+the pattern under 'ANYREGPATTERNTABLE. Just like the DefCMacro macro
+has been defined to aid ALM instruction description, the macro DefAnyReg
+has been provided to help set up these associations:
+
+@begin(verbatim)
+
+(DEFANYREG anyregname anyregfunction
+ (pred1 body1)
+ (pred2 body2)
+ ...
+ lastbody)
+
+@end(verbatim)
+As you can see, the structure of a DefAnyReg is exactly the same as
+DefCMacro, except an additional operand AnyRegFunction must be supplied.
+When an AnyReg is found in the instruction expansion, the function is
+called with two or more arguments:
+@begin(enumerate)
+Temp Register - Since the anyreg must perform its operation using zero
+or one register, this is the register that it may use to perform its
+task. (CAVEAT: The current implementation provides either (Reg T1) or
+(Reg T2) as the temporary register in all cases except one. That is
+when the anyreg is the source of a move and the destination is a
+register. In that case, the destination register is passed as the
+temporary. This can cause a problem if any part of the anyreg requires
+the destination to first be a source. [Future change - Eliminate this
+problem used in move and always pass in T1 or T2]).
+
+Source - This is the actual body of the anyreg. It may be referenced
+within the AnyRegPatternTable as SOURCE.
+
+ArgTwo - Only one anyreg (Memory) currently has more than two arguments.
+If they are desired, this third argument may be referenced by ARTTWO.
+@end(enumerate)
+A defect in the current system is that the pattern predicates following
+the anyreg function may not test the Temporary Register. This is quite
+inconsistent, since the function definition must consider the operand,
+while the pattern table must ignore it. [Future change - Fix This
+problem]
+
+@subsection(ALM Instruction Expansion)
+Now that we understand the mechanics of defining ALM instructions and
+anyreg tables we need to explore the order of expansion of the
+instructions. The compiler emits ALM instructions, with the operands
+being legal ALM "addressing" modes. These instructions are collected in
+a list and passed to the Pass1Lap function. Pass1Lap looks at each
+instruction and attempts to simplify it. It looks on the property of
+the opcode and checks to see if it has been flagged with 'MC. If so, it
+calls the function of the same name with the operands unchanged.
+
+Most ALM expansion functions first apply the function
+@begin(verbatim)
+
+ ResolveOperand(Reg, Source)
+
+@end(verbatim)
+to each operand, passing a temporary register as the first argument,
+REG. This resolution process converts ALM operand forms into TLM
+operand forms i.e, legal addressing modes of the TLM.
+After each operand has been "resolved", the CMACRO pattern table
+is used, and the resulting LIST of CMACROS processed recursively.
+
+This is what is accomplished in the three functions:
+@begin(verbatim)
+
+ EXPAND1OPERANDCMACRO(Arg1,Name)
+ EXPAND2OPERANDCMACRO(Arg1,ARg2,Name)
+ EXPAND4OPERANDCMACRO(Arg1,ARg2,Arg3,Arg4,Name)
+
+@end(verbatim)
+which first resolves the arguments using the available registers and
+then calls the routine (CMACROPATTERNEXPAND) which finds the pattern
+table of the Name argument (ALM instruction) stored on the property list
+under the indicator 'CMACROPATTERNTABLE.
+
+For example,
+ (de !*WPlus2 (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WPlus2))
+
+Only the (!*MOVE s d) ALM opcode tries to be smarter about temporary regs:
+ d:=RESOLVEOPERAND('(Reg t2),d)
+ If d is a register, then RESOLVEOPERAND(d,S)
+ else RESOLVEOPERAND('(REG t1),s);
+
+[Future change - This should be changed in the future]
+
+Recall also that Processing an arugment with RESOLVEOPERAND may
+require other CMACRO's to be emitted first, to "simplify" the complex
+addressing mode; each Operand is free to destroy/modify its given
+register. For example, note how register t1 is reused below to
+resolve multiple CAR's and CDR's into MOVE's and simpler CAR's and
+CDR's:
+
+ (!*MOVE (CAR (CAR x)) d) => (!*MOVE (CAR x) (REG t1))
+ (!*MOVE (CAR (REG t1)) d)
+ (!*MOVE (CAR (CAR(reg 1))) (CDR (CDR (reg 2))))
+ => (!*MOVE (CDR (reg 2)) (REG t2))
+ (!*MOVE (CAR (REG 1)) (REG t1))
+ (!*MOVE (CAR (reg t1)) (CDR (reg t2)))
+
+Therefore, typically the operands are first processed before the ALM
+instruction table is used.
+
+AnyReg processing works the same way as with the ALM instructions. The
+operands are first resolved by calling the ResolveOperand function and
+then ExpandOneArgumentAnyReg (or TwoArgument) is called to process the
+pattern table. This has also been combined into a single function:
+OneOperandAnyReg and TwoOperandAnyReg.
+[[WARNING - There is an inconsistency in the naming here. For CMacro
+expansion the combined functions are called EXPANDxOPERANDCMACRO where
+for anyregs it is ONEOPERANDANYREG. BE CAREFUL!!!!!!! Another
+inconsistency is that CMacros are flagged with 'MC, which AnyRegs are
+not flagged]]
+
+@paragraph(ResolveOperand)
+The ResolveOperand function takes two arguments, a temporary register
+and the source to resolve. It performs the following resolution, in the
+order given:
+@begin(Description)
+an ID@\cals ResolveWConst on the ID;
+
+number or string@\returned unchanged;
+
+(OP s)@\If OP is flagged 'TerminalOperand, it is returned as is.
+
+(OP s)@\If OP is an @anyreg (has an 'AnyregResolutionFunction), it is
+applied to (Register s).
+
+(OP s)@\Otherwise, it is examined to see if it is a WCONST expression.
+@end(description)
+
+The function ResolveWConst tests its operand to see if it is a constant
+or constant expression, and returns its value. It performs the
+following resolution:
+@begin(description)
+(WCONST number)@\returns the number
+
+ID@\If WCONST indicator is on the ID's property, the associated number
+is returned otherwise the ID is returned.
+
+Expression@\Each operand is tested to determine if it can be resolved as
+a WCONST and if so, the function is applied to all of the operands (ANY
+FUNCTION CAN BE CALLED)
+@end(description)
+
+?????Insert some SUMMARY USING THE FOLLOWING????????
+Most ANYREGS use OneOperandAnyReg, ie recursively process arguments
+inside out (CAR anyreg), (CDR anyreg), etc
+% (de AnyRegCAR(R S) (OneOperandAnyReg R S 'CAR))
+% (defAnyReg CAR AnyRegCar ....)
+
+Those that do not permit anyregs as args, use ExpandOneOperandAnyReg
+eg, (QUOTE s), (WCONST w), (WVAR v), (REG r)
+or flag name as TERMINALOPERAND to pass direct to ASM
+
+so here is a simple WCONST expression.
+As long as args are WCONSTEVALUABEL themselves, any
+function can be applied:
+
+@section(Predicates)
+ Provided in the common machine independent files are a number of
+useful predicates. Those include:
+
+[[[[List the predicates provided in common-predicates]]]]
+
+Each of the following predicates expects one argument; call it X:
+@begin(Description)
+RegisterP@\(EqCAR X 'REG) tests for any register
+
+AnyP@\ Always T, used as filler
+
+EqTP@\ (equal X T)
+
+MinusOneP@\(equal X -1)
+
+InternallyCallableP@\Check if legal to make a fast internal call.
+Essentially checks the following:
+@begin(format)
+[(or !*FastLinks
+ % all calls Fastlinks?
+ (and !*R2I (memq X EntryPoints!*))
+ % or specially declared
+ (FlagP X 'InternalFunction)
+ (FlagP X 'FastLink)))]
+@end(format)
+
+AddressConstantP@\(or (NumberP X) (EqCar X 'Immediate)))
+@end(Description)
+
+@section(Standard ANYREGS)
+
+The following are the basic @ANYREG functions, which in many cases
+look for an AnyregTable:
+@begin(Description)
+@B[ID]@\@B[Flagged]
+
+CAR@\OneOperandAnyreg, 'CAR table@comment{ need to explain all of these
+ tables - particularly the WVar
+ table }
+
+CDR@\OneOperandAnyreg, 'CDR table
+
+QUOTE@\ExpandOneArgumentAnyreg, 'QUOTE table
+
+WVAR@\ExpandOneArgumentAnyreg, 'WVar table
+
+REG@\ExpandOneArgumentAnyreg, 'REG table
+
+WCONST@\OneOperandAnyreg, 'WConst table, default normally just SOURCE.
+
+FRAME@\ExpandOneArgumentAnyreg, computes offset from stack pointer,
+ and passes this (in bytes) to 'FRAME table
+
+FRAMESIZE (Register)@\Computes (NAlloc!* @Value(Times)
+AddressingUnitsPerItem) to give size of frame to any special code needing it.
+
+MEMORY (Register Source ArgTwo)@\Used to
+compute indexed memory access: TwoOperandAnyreg, Look for 'MEMORY table.
+
+LABEL@\Flags a label, does no processing.
+@end(Description)
+
+The implementor of @PSL for any particular machine is free to add additional
+@ANYREG@xs (addressing modes), that are emitted as part of @CMACRO@XS by
+machine specific compiler patterns or COMPFNs.
+
+
+IMMEDIATE is a tag used to @ei[suggest] address or immediate constant.
+
+@subsection(Some AUXILLIARY Operand Modes for the TLM)
+Each of the following functions expects one argument; call it X:
+@begin(Description)
+UnImmediate@\If X @Value(Eq)(Immediate Y), removes tag to get Y.
+
+ExtraReg@\Converts argument X into Access to ArgumentBlock[X-LastActualReg]
+
+QUOTE@\Compiles X into a constant. If !*ImmediateQuote is T, returns an
+ITEM for object, else emits ITEM into a memory location, returns its address.
+@end(Description)
+
+Note @CMACRO@XS (flagged 'MC) are first expanded, then the PASS1PSEUDO@xs.
+This means the @CMACRO@XS are able to insert and manage TAGS that are
+removed or modified by final PASS1PSEUDO.
+
+
+@section(more junk)
+@i[Implement the Compiler Patterns and Tables]. This requires selecting
+certain alternative routes and parameterizations allowed by the compiler,
+trying to improve the match between the Abstract @PSL machine used by the
+compiler and the target architecture X. Mostly this phase is reserved for
+optimization, but the basic tables have to be installed to map @xlisp
+function names to corresponding @cmacro names and select the Compiler
+functions (COMPFNs and OPENFNs) to be used for each construct. This file,
+@dq[xxxx-COMP.RED], is usually copied from one of the existing machines and
+modified as needed. Most of the modifications relate to the legality of
+certain addressing combinations. These tables are briefly described in the
+Compiler chapter of the manual, but currently this task is still somewhat
+"arcane".@comment{ There needs to be some mention of what the usual
+modifications are! }
+
+@i[Build and Test the CROSS Compiler]. Now compile a series of LAP (mostly
+@CMACRO tests), @xlisp and
+@syslisp files to X assembly code, link and run. As the tests proceed,
+certain small I/O and function calling procedures are written in LAP. A
+common way to do I/O is to implement a @ei[Foreign Function]-calling
+protocol, used from @xlisp to call functions according to
+FORTRAN, PASCAL, C or other useful conventions. Calls in compiled
+@xlisp/@syslisp code to function names flagged with the 'FOREIGN-FUNCTION
+flag are called with a non-@xlisp protocol. This permits a
+standard I/O library to be called and allows simple routines to be
+written in another language. The purpose of this separate
+function-calling mechanism is to allow the @xlisp system to use the
+most efficient calling method possible, compatible with the needs of
+@syslisp and @xlisp. This method is not necessarily the most flexible,
+general, or safe method and need not be used by other languages.
+However, to allow the @xlisp/@syslisp system to call upon existing
+routines, particularly system-provided services, this additional
+function-calling mechanism should be provided. Some care needs to be taken
+to preserve and restore registers appropriately.
+
+@chapter(Test Series)
+In order to accomplish the PSL bootstrap with a
+minimum of fuss, a carefully graded set of tests is being developed,
+to help pinpoint each error as rapidly as possible. This section
+describes the current status of the test files. The first phase
+requires the coding of an initial machine dependent I/O package and
+its testing using a familar system language. Then the code-generator
+macros can be succesively tested, making calls on this I/O package as
+needed. Following this is a series of graded SYSLISP files, each
+relying on the correct working of a large set of SYSLISP constructs.
+At the end of this sequence, a fairly complete "mini-LISP" is
+obtained. At last the complete PSL interpreter is bootstrapped, and a
+variety of PSL functional and timing tests are run.
+
+@section(Basic I/O Support)
+The test suite requires a package of I/O routines to read and print
+characters, and print integers. These support routines are usually written
+in a "foreign" language (call it "F"), such as PASCAL, C or FORTRAN; they
+could also be coded in LAP, using CMACROs to call operating system
+commands, if simple enough. (E.g., JSYS's on DEC-20, Traps on 68000, etc.).
+These routines typically are limited to using the user's terminal/console
+for input and output. Later steps in the bootstraping sequence introduce a
+more complete stream based I/O module, with file-IO.
+
+On some systems, it is appropriate to have a main routine written in "F"
+which initializes various things, and then calls the "LISP" entry point; on
+others, it is better to have "LISP" as the main routine, and have it call
+the initialization routines itself. In any event, it is best to first write
+a MAIN routine in "F", have it call a subroutine (called, say TEST), which
+then calls the basic I/O routines to test them. The documentation for the
+operating system should be consulted to determine the subroutine calling
+conventions. Often, the "F" compiler has an "ASSEMBLY Listing switch",
+which can be turned on to see how the standard "F" to "F" calling sequence
+is constructed, and to give some useful guidance to writing correct
+assembly code. This can also be misleading, if the assembler switch only
+shows part of the assembly code, thus the user is cautioned to examine
+both the code and the documentation.
+
+On directory PT: (which stands for /psl/tests or <PSL.TESTS>), or its
+subdirectories, we have a number of sample I/O packages, written in various
+languages: PASCAL, FORTRAN, C and DEC20 assembly code. Each has been used
+successfully with some PSL bootstrap. The primitives provided in these
+files are often named XXX-yyyy, where XXX is the machine name, and yyyy is
+the primitive, provided that these are legal symbols. Of course, the name
+XXX-yyyy may have to be changed to conform to "F" and the associated linker
+symbol conventions. Each name XXX-yyyy will be flagged as a
+"ForeignFunction", and called by a non-LISP convention.
+
+The following is a brief description of each primitive, and its use. For
+uniformity we assume each "foreign" primitive gets a single integer
+argument, which it may use, ignore, or change (VAR c:integer in PASCAL).
+@Comment{Is this assumed to be a WORD size quantity, i.e. on the 68000 a 32
+bit quantity or can it be a small integer???}
+The following routines ("yyyy") in LISP, will be associated with the
+corresponding "foreign" routine "XXX-yyyy" in an appropriate way:
+@begin(description)
+init()@\Called once to set up I/O channels, open devices, print welcome
+message, initialize timer.
+
+Quit()@\Called to terminate execution; may close all open files.
+
+PutC(C)@\C is the ASCII equivalent of a character, and is printed out
+without line termination (I/O buffering may be needed). C=EOL=10 (ASCII LF)
+@Comment{does this mean that the character should appear right away, or can
+it wait till the EOL is sent???}
+will be used to signal end-of-line, C=EOF=26 (ASCII SUB) will be used to
+signal end of file.
+
+GetC()@\Returns the ASCII equivalent of the next input character;
+C=EOL=10 for end of line, and C=EOF=26 for end of file. Note it is
+assumed that GetC does not echo the character.
+
+TimC()@\Returns the runtime since the start of this program, in
+milli-seconds, unless micro-seconds is more appropriate. For testing
+purposes this routine could also print out the time since last called.
+
+PutINT(C)@\Print C as an integer, until a SYSLISP based Integer printer that
+calls XXX-PutC works. This function is used to print integers in the
+initial tests before the full I/O implementation is ready.
+
+@comment{Err(C)@\Called in test code if an error occurs, and prints C as an
+error number. It should then call Quit() .}
+@end(description)
+The following functions will probably need to be defined in LAP, using
+either the ALM (cmacro level ) or machine specific (TLM) level:
+@begin(description)
+!%Store!-Jcall(Code-Address,Storage-Address)@\The Storage-Address is
+the address of the slot in the SYMFNC table where a jump instruction
+to the Code-Address must be stored. This implements a compiled call
+to a compiled function. You may have to insert padding or legal code
+to make the code match the call to the compiled code. The LAP for the
+Dec20 is:
+@begin(verbatim)
+
+LAP
+ '((!*entry !%Store!-Jcall Expr 2)
+ % CodeAddress, Storage Address
+ (!*alloc 0)
+ (!*WOR (reg 1) 8#254000000000)
+ % Load a JRST in higher-bits
+ (!*MOVE (reg 1) (memory (reg 2)
+ (wconst 0)))
+ (!*EXIT 0));
+
+@end(verbatim)
+
+!%Copy!-Function!-Cell(From-Address,To-Address)@\Copies the SYMFNC
+cell located at the From-Address to the SYMFNC cell located at the
+To-Address. If your machine has the SYMFNC cell the same width as
+that of MEMORY, the following code used on the Dec-20 will work:
+@begin(verbatim)
+
+LAP
+ '((!*entry !%copy!-function!-cell
+ Expr 2) % from to
+ (!*alloc 0)
+ (!*move (memory (reg 1)
+ (Wconst 0))
+ (memory (reg 2)
+ (wconst 0)))
+ (!*exit 0));
+
+@end(verbatim)
+
+UndefinedFunction()@\In general, we think of the storage of the number
+of arguments in a register (Reg NargReg) and the index of the called
+function in a register (Reg LinkReg). This function must store the
+linkage register in the fluid UndefnCode!* and the Narg register in
+the fluid UndefnNarg!*. Finally, it must !*JCALL to the
+UndefinedFunctionAux. The following code implements this function in
+a manner that is portable across all machines that use the LinkReg and
+NargReg as real register:
+@begin(verbatim)
+
+FLUID '(UndefnCode!* UndefnNarg!*);
+
+LAP
+ '((!*ENTRY UndefinedFunction expr 0)
+ % No alloc 0 ? and no LINKE
+ % because we don't want to
+ % change LinkReg.
+ (!*Move (reg LinkReg)
+ (Fluid UndefnCode!*))
+ (!*Move (reg NargReg)
+ (Fluid UndefnNarg!*))
+ (!*JCALL UndefinedFunctionAux)
+);
+
+@end(verbatim)
+
+Flag(Dummy1,Dummy2)@\A call to this function is automatically
+generated by the compiler, but is never used. So, you must implement
+this function to call your error routine if it is actually called
+(This function will be redefined in a later test). The code for the
+Dec-20 is portable except the linkage to the Machine Dependent Error
+routine Err20:
+@begin(verbatim)
+
+LAP '((!*ENTRY FLAG expr 2)
+ (!*alloc 0)
+ (!*MOVE 2 (REG 1))
+ (!*LINKE 0 Err20 Expr 1)
+);
+
+@end(verbatim)
+@end(description)
+Finally, the following three functions must be implemented to allow
+arithmetic operations of sufficient length.
+@begin(description)
+LongTimes(Arg1,Arg2)@\Compute the product of Arg1 and Arg2 and return:
+@begin(verbatim)
+
+procedure LongTimes(x,y);
+ x*y;
+
+@end(verbatim)
+
+LongDiv(Arg1,Arg2)@\Compute the quotient of Arg1 and Arg2 and return
+the value:
+@begin(verbatim)
+
+procedure LongDiv(x,y);
+ x/y;
+
+@end(verbatim)
+
+LongRemainder(Arg1,Arg2)@\Compute the Remainder of Arg1 with respect
+to Arg2:
+@begin(verbatim)
+
+procedure LongRemainder(x,y);
+ Remainder(x,y);
+
+@end(verbatim)
+@end(description)
+
+As a simple test of these routines implement in "F" the following.
+Based on the "MainEntryPointName!*" set in XXX-ASM.RED, and the
+decision as to whether the Main routine is in "F" or in "LISP",
+XXX-MAIN() is the main routine or first subroutine called:
+@begin(verbatim)
+% MAIN-ROUTINE:
+ CALL XXX-INIT(0);
+ CALL XXX-MAIN(0);
+ CALL XXX-QUIT(0);
+
+% XXX-MAIN(DUMMY):
+ INTEGER DUMMY,C;
+
+ CALL XXX-PUTI(1); % Print a 1 for first test
+ CALL XXX-PUTC(10); % EOL to flush line
+
+ CALL XXX-PUTI(2); % Second test
+ CALL XXX-PUTC(65); % A capital "A"
+ CALL XXX-PUTC(66); % A capital "B"
+ CALL XXX-PUTC(97); % A lowercase "a"
+ CALL XXX-PUTC(98); % A lowercase "b"
+ CALL XXX-PUTC(10); % EOL to flush line
+
+ CALL XXX-PUTI(3); % Third test, type "AB<cr>"
+ CALL XXX-GETC(C);
+ CALL XXX-PUTC(C); % Should print A65
+ CALL XXX-PUTI(C);
+ CALL XXX-GETC(C);
+ CALL XXX-PUTC(C); % Should print B66
+ CALL XXX-PUTI(C);
+ CALL XXX-GETC(C);
+ CALL XXX-PUTI(C); % should print 10 and EOL
+ CALL XXX-PUTC(C);
+
+ CALL XXX-PUTI(4); % Last Test
+ CALL XXX-ERR(100);
+
+ CALL XXX-PUTC(26); % EOF to flush buffer
+ CALL XXX-QUIT(0);
+% END
+
+@end(verbatim)
+
+For examples, see PT20:20IO.MAC for DEC-20 version, PHP:HP.TEXT for HP9836
+PASCAL version, PCR:shell for CRAY fortran version.
+
+@section(LAP-TO-ASM and CMACRO Tests)
+After the basic XXX-ASM.RED file has been written and the XXX-CROSS.EXE has
+been built, and seems to be working, an exhastive set of CMACRO tests
+should be run. The emitted code should be carefully examined, and the
+XXX-CMAC.SL adjusted as seems necessary. Part of the CMACRO tests are to
+ensure that !*MOVEs in and out of the registers, and the ForeignFunction
+calling mechanism work.
+
+The goal of this test, and the following few sections is to guide you
+in getting the first piece of ALM code to translate to TLM form,
+correctly assemble, and finally execute on the target machine. There
+are a large number of details to worry about, and one will have to
+come back and refine decisions a number of times. Some of the
+decisions you will have to make are based on incomplete information,
+and are based on an interaction of the ALM model, LISP usage
+statistics and unknown oddities of the target machine. In many cases,
+you will have to make the decision just to proceed to get the skeleton
+together, and then immediately come back to fix the code.
+
+The first major milestone will be to set up enough of the basic
+cross-compiler to be able to translate and assemble the following
+file, called PT:MAIN0.RED:
+@begin(verbatim)
+% MAIN0.RED - A "trivial" file of ALM level LAP to test
+% basic set of tools: LAP-TO-ASM mostly,
+% and CMACROs
+
+LAP '((!*ENTRY DummyFunctionDefinition Expr 1)
+ (!*ALLOC 0)
+ (!*MOVE (REG 1) (REG 2))
+ (!*EXIT 0));
+
+END;
+@end(verbatim)
+
+
+It consists of a single procedure, written in LAP using only 4
+CMACROs, each quite simple. Notice the procedure defined has a "long"
+name, which may have to be mapped to a simpler symbol (for your
+assembler) by a routine in your xxx-ASM.RED file. The !*ENTRY cmacro
+is actually handled by LAP itself, so there are 3 CMACROs to be
+written:
+@Begin(description)
+
+(!*ALLOC n)@\Issues instructions to
+allocate a frame of n items on the stack. May also have to issue
+instructions to check stack overflow if the system hardware does not.
+For some machines, with n=0, no code is emitted, while for others,
+!*ALLOC is a good place to establish certain registers for the code
+body. (On the CRAY, the call instruction puts the return address in
+a register, which get saved on the stack in the !*ALLOC).
+
+(!*MOVE source dest)@\Issue code to move the contents of source to
+the destination. In the MAIN0 example, a register to register move is
+desired. ALM (REG 1) and (REG 2) are almost always allocated to real
+TLM registers. An "anyreg" for the REG mapping will have to be
+written.
+
+(!*EXIT n)@\Issues code to clean up the stack, by removing the frame
+that was allocated by a corresponding (!*ALLOC n), and then returns
+to the caller, whose address was saved on the stack (usually) by
+an appropriate TLM instruction. (On CRAY, the return address
+is restored to the special register).
+@end(description)
+
+Here is an example of the processing of this file on the
+DEC-20. On the DEC20 we produce 2 files, the CODE-FILE and the DATA-FILE:
+
+@begin(verbatim)
+CODE-FILE, MAIN0.MAC
+
+DATA-FILE, DMAIN0.MAC
+@end(verbatim)
+In summary, here are the initial steps you will have to follow, with some
+indication of the decisions you will have to make:
+
+@begin(description)
+Decide on PSL Item layout@\How many bits for the tag; should there be
+a GC field; will the tag have to be masked out when the INF field is
+used as an address; should the fields be aligned to byte, word or
+other boundaries to make TAG and INF access faster;
+
+
+Decide on TLM register use@\Some registers will be used for the ALM
+registers (rest simulated by memory locations), some used for CMACRO
+temporaries, some for Target OS interface or addressibility, some for
+Linkage registers and some for the stack.
+
+Stack Implementation@\Should the LISP stack be same as system stack; can we
+use stack hardware; how about stack overflow; which way should stack
+grow; ALM needs to access elements inside the stack relative to the
+stack pointer; the stack pointer needs to be accessible so that the GC
+and other things can access and examine elements.
+
+@end(description)
+
+@section(More details on Arcitecture mapping)
+Need to explain why currently 1 tags used, expect more or less in future.
+Perhaps explain which tests are MOST important so at least those can be done
+efficiently, even if others encoded in a funny wya.
+
+Mention idea that in future may want to put (say) 3 bits of tag in lower
+word, force double or quadword alignment, and put rest of tag in object.
+Mention how some data-types are immediate, others point into memory,
+and some already have headers. Mention possibel user-defind extension types.
+
+
+Need to clarify how ALM registers are used so can be mapped to
+TLM or memory.
+
+Need to explain Stack registers, CMACRO temporary registers, link
+registers.
+
+Need to explain relative importance of certain CMACROs and order in
+which they should be written and debugged. Make a CMACRO test file to
+be examined by hand, to be assembled, and maybe even run.
+
+Need to give more detailed steps on how to get MAIN1 running; seems
+like a BIG step. Perhaps break down into smaller MAIN0, just to get
+off the ground. (Ie, might not execute, but should assemble). Give a
+check list of steps. Explain that at first, just get all pieces
+together, then can fill in details once the skeleton is correct, and
+flesh out stubs.
+
+Explain data-file versus code-file model.
+
+@section(SysLisp Tests)
+This set of tests involve the compilation to target assmbly code, the
+linking and execution of a series of increasingly more complex tests. The
+tests are organized as a set of modules, called by a main driver. Two of
+these files are machine dependent, associating convenient LISP names and
+calling conventions with the "Foreign" XXX-yyyy function, define
+basic data-spaces, define external definitions of them for inclusion, and
+also provide the appropriate MAIN routine, if needed. These files
+should probably be put on a separte subdirectory of PT: (e.g., PT20:,
+PT68:, etc.)
+
+The machine dependent files are:
+@begin(description)
+
+XXX-HEADER.RED@\Is a machine dependent "main" include file, read into each
+MAINn.RED file, to define the data-spaces needed, and perhaps define a main
+routine in LAP, and have the appropriate XXX-MAIN call the "FirstCall"
+function, used to start the body of the test. Also included are the
+interface routines to the "F" coded I/O package. providing a set of LISP
+entry-points to the XXX-yyy functions. This should be copied and edited
+for the new target machine as needed. Notice that in most cases, it simply
+defines "procedure yyyy(x); XXX-yyyy(x);", relying on "ForeignFunction"
+declaration of XXX-yyyy.
+
+XXX-TEST-GLOBAL-DATA.RED@\This contains a series of external declarations
+to correspond to the Global Data definitions in the above header file
+file. It is automatically included in all but the MAINn module via the
+"GlobalDataFileName!*" option of XXX-ASM.RED.
+@end(description)
+The machine independent test files and drivers are:
+@begin(description)
+MAIN1.RED@\Is a very simple driver, that calls Getc and Putc, does a few
+tests. It does an 'IN "XXX-HEADER.RED";'. The "FirstCall" procedure
+then calls "init", uses "putc" to print AB on one
+line. It should then print factorial 10, and some timings for 1000 calls
+on Factorial 9 and Tak(18,12,6). Build by itself, and run with IO.
+@Comment{This seems to hide the assumption that 10! can be done in the
+integer size of the test implementation.??? }
+
+SUB2.RED@\Defines a simple print function, to print ID's, Integer's,
+Strings and Dotted pairs in terms of repeated calls on PutC. Defines
+PRIN1, PRIN2, PRINT, PRIN2T, TERPRI and a few other auxilliary print functions
+used in other tests. Tries to print "nice" list notation.
+
+MAIN2.RED@\Tests printing and access to strings. It peforms most of the
+useful string operations, printing messages to verify that they
+function properly.
+Uses Prin2String to print a greeting, solicit a sequence of
+characters to be input, terminated by "#". Watch how end-of-line is handled.
+Then Print is called, to check that TAG's are correctly recognized,
+by printing a LISP integer, an ID and 2 dotted pairs. Requires SUB2
+and IO modules. Finally, it tests the undefined function calling
+mechanism to verify that it does print out an error message.
+Therefore, the UndefinedFunction routine must be defined in xxx-header
+by this test 2.
+
+SUB3.RED@\Defines a mini-allocator, with the functions GtHEAP, GtSTR,
+GtVECT, GtCONS, Cons, XCons, NCons, MkVect and MkString. Requires
+primitives in SUB2 module.
+
+MAIN3.RED@\First Executes a Casetest, trying a variety of Branches and
+Defaults in the case staement. There are a number of calls on Ctest with an
+integer from -1 to 12; Ctest tries to classify its argument using a case
+statement. ConsTest simply calls the mini-allocator version of CONS to build
+up a list and then prints it. Requires SUB2, SUB3 and IO modules.
+
+SUB4.RED@\Defines a mini-reader, with InitRead, RATOM and READ. It
+has the facilities to convert case input, using the !*RAISE switch
+(and the SetRaise function). This mini-READ does not yet read vectors.
+Requires SUB3, SUB2, and IO modules.
+
+MAIN4.RED@\First, this test checks to see that EQSTR works. Then it
+tests FindId to see if it can find Identifiers known to exist. After
+that, it tests to see if new Id's can be found and then found in the
+same place. Then a test loop is created that calls RATOM, printing
+the internal representation of each token. Type in a series of id's,
+integer's, string's etc. Watch that the same ID goes to same place.
+When the user types a Q, it should go into a READ-PRINT loop. You
+should type in a variety of S-Expressions, checking that they are
+correctly printed. Once again, you should finally type a Q to exit.
+Requires SUB3, SUB2 and IO modules.
+
+SUB5.RED@\Defines a mini-EVAL. Does not permit user defined functions.
+Can eval ID's, numbers, and simple forms. No LAMBDA expressions can be
+applied. FEXPR Functions known are: QUOTE, SETQ, COND, PROGN and
+WHILE. The Nexpr LIST is also known. Can call any compiled EXPR, with
+the standard 15 arguments. Requires SUB4, SUB3, SUB2 and I/O.
+
+MAIN5.RED@\Starts a mini-READ-EVAL-PRINT loop, to which random simple
+forms may be input and evaluated. When ready, input (TESTSERIES) to
+test PUT, GET and REMPROP. Then an undefined function is called to
+test the UNDEFINED function mechanism. Requires SUB5, SUB4, SUB3,
+SUB2 and IO modules. Note that input ID's are case raised (!*RAISE
+has been set to T by default) so input can be in in lowercase for
+built-in functions. Terminates on Q input.
+
+SUB6.RED@\Defines a more extensive set of primitives to support the
+EVAL, including LAMBDA expressions, and user defined EXPR, FEXPR,
+NEXPR and MACRO functions. This is a complete model of PSL, but has a
+restriced set of the PSL functions present. Can call any compiled or
+interpreted function. Requires SUB5, SUB4, SUB3, SUB2 and I/O.
+
+MAIN6.RED@\Tests the full PSL BINDING modules (PI:BINDING.RED and
+PT:P-FAST-BINDER.RED). Call the (TESTSERIES) routine to do a test of
+Binding, the Interpretive LAMBDA expression evaluator, and binding in
+compiled functions. Requires SUB6,SUB5, SUB4,
+SUB3, SUB2 and IO modules. !*RAISE is once again on. Terminates on Q
+input.
+
+SUB7.RED@\A set of routines to define a minimal file-io package, loading
+the machine independent files: PT:SYSTEM-IO.RED and PT:IO-DATA.RED, and a
+machine dependent file XXX-SYSTEM-IO.RED. The latter file defines
+primitives to OPEN and CLOSE files, and read and write RECORDS of some
+size. The following definitions are used in the routines:
+@begin(verbatim)
+FileDescriptor: A machine dependent
+ word to references an open file.
+FileName: A Lisp string
+@end(verbatim)
+@begin(description)
+SYSCLEARIO()@\Called by Cleario to do any machine specific initialization
+needed, such as clearing buffers, initialization tables, setting interrupt
+characters, etc.
+
+SysOpenRead(Channel,FileName)@\Open FileName for input and return a file
+descriptor used in later references to the file. Channel may be used to
+index a table of "unit" numbers in FORTRAN-like systems.
+
+SysOpenWrite(Channel,FileName)@\Open FileName for Output and return a file
+descriptor used in later references to the file. Channel may be used to
+index a table of "unit" numbers in FORTRAN-like systems.
+
+SysReadRec(FileDescriptor,StringBuffer)@\Read from the FileDescriptor, a
+record into the StringBuffer. Return the length of the string read.
+
+SysWriteRec (FileDescriptor, StringToWrite, StringLength)@\ StringLength
+characters from StringToWrite from the first position.
+
+SysClose (FileDescriptor)@\Close FileDescriptor, allowing
+it to be reused.
+
+SysMaxBuffer(FileDesc)@\Return a number to allocate the file-buffer
+as a string; this should be maximum for this descriptor.
+@end(description)
+RDS, WRS, OPEN, CLOSE, DSKIN and TYPEFILE are defined.
+
+MAIN7.RED@\Starts the LISP READ-EVAL-PRINT loop tested before, and now
+permits the user to test io. Call (IOTEST). Other functions to try are
+(OPEN "foo" 'OUTPUT), (WRS n), (RDS n) etc. [Now the GETC and PUTC IO
+routines in XXX-HEADER will finally call the file-oriented
+IndependentReadChar and IndependentWriteChar]. Also includes the
+standard PSL-TIMER.RED (described below), which can be invoked by
+doing (DSKIN "PT:TIME-PSL.SL"). Since the garbage collector not yet
+present, may run out of space.
+
+FIELD.RED@\A a set of extensive tests of the Field and Shift functions.
+Needs a WCONST BitsPerWord defined in XXX-HEADER.RED. Build by itself,
+and execute with the IO support.
+@end(description)
+
+Test set "n" is run by using a set of command files to set up
+a multi-module program. These files are stored on the
+approriate subdirectory (PT20: for the DEC20). Note that each module
+usually produces 2-3 files ("code", "data" and "init")
+@begin(Enumerate)
+First Connect to the Test subdirectory for XXX:
+@verbatim[
+@@CONN PTxxx:]
+
+Then initialize a fresh symbol table for program MAINn, MAINn.SYM:
+@verbatim[
+
+@@MIC FRESH MAINn]
+
+Now successively compile each module, SUB2..SUBn
+@verbatim[
+@@MIC MODULE SUB2,MAINn
+@@MIC MODULE SUB3,MAINn
+
+@@MIC MODULE SUBn,MAINn]
+
+Now compile the MAIN program itself
+@verbatim[
+@@MIC PROGRAM MAINn]
+
+As appropriate, compile or assemble the output "F" language modules
+(after shipping to the remote machine, removing tabs, etc..). Then
+"link" the modules, with the XXX-IO support, and execute. On the
+DEC-20, the
+@verbatim[
+@@EX @@MAINn.CMD]
+
+command files are provided as a guide]
+
+Rather than including output from some older test runs, we insist that
+you run the tests yourself on the HOST machine to be absolutley sure
+of what output they produce, and what input is expected. Also, if
+errors occur during testing, the examination of the HOST tests will
+help. This will also help as additonal tests are added by new
+implementors.
+@end(enumerate)
+@section(Mini PSL Tests)
+
+The next step is to start incorporating portions of the PSL kernel into the
+test series (the "full" Printer, the "full" reader, the "full" Allocator,
+the "full" Eval, etc.), driving each with more comprehensive tests. Most of
+these should just "immediately" run. There some peices of Machine specific
+code that have to be written (in LAP or SYSLISP), to do channel I/O,
+replacing the simple XXX-IO; to do fast APPLY; Fluid Binding and
+Arithmetic. This set of tests will help check these peices out before
+getting involved with large files.
+
+@section(Full PSL Tests)
+Now that PSL seems to be running, a spectrum of functional tests and timing
+tests should be run to catch any oversights, missing modules or bugs, and as a
+guide to optimization. The following tests exist:
+@Description[
+PSLTEST.SL@\A fairly comprehensive test of the Standard LISP subset of PSL.
+Do (DSKIN "pt:psltest.sl"). There are a few tests of the error mechanism that
+have to be "pushed" through for a full test.
+
+MATHLIB.TST@\A series of tests of MATHLIB. First LAOD MATHLIB; into RLISP,
+then do IN "MATHLIB.TST"; .
+
+PSL-TIMER.SL, TIME-PSL.SL@\A standard timimg test covering PSL basics.
+Compile PSL-TIMER.SL into kernel, or with resident compiler, then
+(LAPIN "PT:TIME-PSL.TEST").
+]
+
+@section(Stabilize Basic PSL)
+Finally, compile the kernel modules of @PSL, link with the
+additional machine-dependent modules, and @PSL (hopefully) comes right
+up@Foot[Presently an unlikely possibility, as the system may still change
+arbitrarily from under the implementor!]. Additional work is underway to
+develop a much more comprehensive test set, that will not change while the
+implementor is proceeding with the bootstrap; unfortunately, @PSL is still
+undergoing continuous development at Utah, resulting in some "out-of-phase"
+communication problems.
+
+After the basic interpreter is working, additional modules can also be
+compiled from @xlisp to X and linked with the kernel. The most common of these
+might be the @RLISP parser and even the @REDUCE@cite[Hearn73] computer
+algebra system@Comment{???or should this be symbolic algebra system??? }. As
+more files are compiled to machine X and linked, the task
+becomes more tedious. At this point, we need to consider the bootstrap of
+the @ei[Resident] Compiler, LAP and fast-loader (FASL). The most common way
+to build and maintain large @PSL programs is to build the kernel @PSL with a
+resident FASLIN for loading fast-load files, and then compile required
+modules to FASL (xxxx.b) files. A @PSL-based system is built by loading the
+appropriate FASL files, and then saving the @dq[core] image as an
+executable file. On some machines this is easy; on others it is quite
+hard; see the discussions below.
+
+These additional steps are:
+
+@begin(enumerate)
+@i[Implement Resident LAP]. Using an existing LAP.RED as a guide, write a
+table-driven program that does the actual assembly of code written in
+LAP form for machine X, to the appropriate bit-patterns; the details of
+this process are discussed at length in @dq[Reading, Writing and Testing
+LAP]@cite[Griss82h]. @PSL provides many tools to make this task quite
+easy, but the process is still very machine dependent. Future work may
+lead to the use of an architectural description language.
+
+@i[Test LAP]. The depositing of bit-patterns into
+BPS@Foot[BPS is Binary Program Space. The name BPS is a remnant of
+@xlisp 1.6. The desire to have a separate code space is based on the desire
+to @ei<not> relocate compiled code.] needs to be checked. Check also that
+procedures can be constructed with LAP, compile LAP into the kernel,
+and assemble some small files.
+
+@i[Implement FASLIN]. FASLIN requires some binary I/O and other small
+support procedures described in a separate section below.
+
+
+@i[Implement FASLOUT]. Once LAP works, the FASLOUT process seems quite
+simple, requiring only the Binary I/O etc@. used by FASLIN. It should be
+possible to get xxxx-FASLOUT working on an existing @PSL, and cross-FASL
+for machine X. This has not yet been tested. When it works, FASLIN could be
+made part of the @PSL kernel very early on.
+
+@i[Test FASL files]. Check that FASL files can be easily written and read.
+@Comment{What kind of tests should be done??? This "easily written and
+read" sounds like apple pie, but it would seem that a piece of SYSLISP
+could be written that would give the FASL mechanism a good work out,
+perhaps two pieces with cross references to one another. }
+
+@i[Implement and test Core saving]. Determine how to save the image of an
+executing program, so that it can be restarted. We only require that it be
+restarted at the beginning, not where it was when it was saved. We usually
+change the MAIN entry function to call an appropriate TopLoop.
+See the more extensive discussion below.
+@foot[Actually, the only part which
+must be saved is the impure data part; the pure data section, the pure code
+section and the control stack need not be preserved - however, if only the
+impure data part is saved, the restart mechanism must map the pure data and
+code back in. For an example of programs which do selective dumping see
+EMACS MKDUMP and @interlisp SYSOUT. @Comment{We probably need to think
+about some way of loading the libraries similar to EMACS, such that it is
+easy to reload the libraries (particularly if they remain pure).}]
+@end(enumerate)
+
+@chapter(DETAILED REFERENCE MATERIAL)
+
+@section(Details on the ALM Operand forms)
+
+The following are references to a variety of memory locations: In the
+current implementation the following 4 reference the same location,
+the SYMVAL cell of the associated ID. This is the contents of the
+location SYMVAL+AddressingUnitsPerItem*IDLOC(id):
+@begin(verbatim)
+(FLUID name:id)
+(!$FLUID name:id)
+(GLOBAL name:id)
+(!$GLOBAL name:id)
+@end(verbatim)
+
+@begin(description)
+(WVAR name:id)@\This references the contents of the static location
+named by the ID.
+@end(description)
+
+The following are all constants, either absolute bit-patterns, or
+address expressions.
+
+@begin(description)
+(WARRAY name:id)@\Address of the base of a static array
+
+(WSTRING name:id)@\Address of the base of a static string
+
+(WCONST expr:wconst-expression)@\Any constant expression, either
+numeric, a declared constant, addresses of thinsg that could also be
+passed as WARRAY or WSTRING, or other expressions that can be handled
+by the TLM assembler.
+
+(IMMEDIATE wconst-expression:any)@\Really only introduced as a "tag"
+to make later processing easier; a constant is either an explict
+constant or (IMMEDIATE expression). This is default TLM mode wrapped
+when RESOLVEOPERAND is "unsure". We are confused about the
+differences between WConsts and Immediates in some cases.
+
+(QUOTE s-exp:s-expression)@\Is the constant bit-pattern representing a
+tagged PSL item.
+
+(LABEL l:id)@\Reference to a local location (symbol) in the current
+set of ALM instructions, processed in a single call to LAP, usually a
+single function.
+
+(MEMORY base:any offset:wconst-expression)@\This is the basic ALM "indexing"
+operation, and represents the contents of the location (base)+offset.
+
+(CAR base:any)@\Reference the contents of the ITEM pointed at by
+INF(base). It is assumed that base is actually a PAIR (not checked).
+In principle this is sort of like (MEMORY (INF base) (WCONST 0)).
+
+(CDR base:any)@\Refernce the contents of the ITEM pointed at by
+INF(base). It is assumed that base is actually a PAIR (not checked).
+In principle this is sort of like (MEMORY (INF base) (WCONST
+AddressingUnitsPerItem)).
+
+
+(FRAME n:integer)@\Contents of the n'th location in the current stack
+frame. In most versions of the ALM, there is an explicit register,
+(REG ST), which points at the base of the frame. The stack grows in
+some direction determined by features on the TLM, so that this could
+in principle be expressed as (MEMORY (reg ST)
+ (WCONST (times StackDirection -1 AddressingUnitsPerItem (SUB1 n))))
+
+(REG reg-descriptor:{integer,id})@\Reference to an ALM register.
+
+(LIT [any-instruction-or-label:{list,id}])@\Plants the instruction sequence
+elswhere, and leaves a reference to its start. Essetially equivalent to
+ (label g), with g starting a block of the instructions, in "literal"
+ space.
+
+(LABELGEN tag:id)@\A mechnism (with LABELREF) to generate and
+reference a label local to a particular CMACRO pattern. Meant mostly
+for implementing conditional jumps of various kinds.
+
+(LABELREF tag:id)@\Reference a label that was assigned to the Tag.
+@end(description)
+
+
+The following set of ALM instruction forms are used to define constant data
+which is intermixed with instructions.
+
+@begin(description)
+(FULLWORD [exp:wconst-expression])@\The expressions are deposited in
+successive "words" (item-sized units).
+
+(HALFWORD [exp:wconst-expression])@)\The expressions are deposited in
+succesive halfwords (two per item-sized unit).
+
+(BYTE [exp:wconst-expression])@\The expressions are deposited in successive
+"bytes" (character-sized units).
+
+(STRING s:string)@\The ASCII values of the characters of the string are
+deposited in successive bytes, terminated by a zero byte.
+
+(FLOAT f:float)@\The 2 word bit pattern for the floating point number is
+deposited.
+@end(description)
+
+These must be processed by the TLM to ASM translator (and later by the resident
+assmbler).
+
+
+@subsection(Standard @CMACRO@xs)
+
+The following are the basic @CMACRO@XS; additional @CMACRO@XS are of course
+frequently added either to aid in writing the @CMACRO@XS (a @CMACRO
+@ei[subroutine]), or to aid some aspect of the machine-specific details.
+Recall that each @CMACRO returns a list of LAP instructions (which are simpler
+to generate code for, although it may be a more complex list of operations)
+representing the appropriate expansion of this @CMACRO (these may also call
+other @CMACRO@XS). These instructions are then recursively processed by the
+@CMACRO expander (i.e@. LAP). The !*MOVE @CMACRO is very commonly used for
+this purpose, to get a @ei[general] operand into a register, so the
+particular @CMACRO can operate on it.
+
+The following @CMACRO@XS deal with function ENTRY, EXIT and function call:
+
+
+@begin(Description)
+!*Entry((FunctionName FunctionType NumberOfArguments)@\Normally the user
+does not code this @CMACRO, since it is processed completely by LAP
+itself. It is used to indicate the start of a function (or entry point
+within a function). Normally just plants a label corresponding to
+FunctionName.
+
+!*Exit (N)@\Exits (@dq[returns]) from procedure, deallocating N items, as
+needed. N corresponds to the N items allocated by !*Alloc, see below.
+
+!*Link (FunctionName FunctionType NumberOfArguments)@\If FunctionName
+is flagged 'FOREIGNFUNCTION, emit a call (!*ForeignLink FunctionName
+FunctionType NumberOfArguments), else emit a (!*Call FunctionName).
+This is the basic function call macro. It assumes the appropriate
+number of arguments are in the registers (previously loaded) in the
+registers, @w[(REG 1) ... (REG n)]. We currently do not check either
+NumberOfArguments or FunctionType, so a simpler @CMACRO, !*CALL is
+provided for basic function call.
+
+!*Call (FunctionName)@\Basic or @dq[Standard] function call. Checks
+to see if FunctionName has an 'OPENCODE property, and returns the
+stored instruction list if any. Otherwise it looks for an
+appropriate pattern table stored by DEFCMACRO under
+'CMACROPATTERNTABLE, as described above.
+
+!*LinkE (DeAllocCount FunctionName FunctionType NumberOfArguments)@\An
+@dq[exit] call. Emitted when the caller does not need to examine the
+result, but returns it directly. The !*LinkE @CMACRO does not save
+the return address, so a return from the called function is not to
+this caller, but to the previous !*LINK. Essentially deallocates the
+frame (if any), does either an ordinary !*ForeignCall and then
+!*Exit(0), or does a !*JCALL which does no return address saving.
+
+!*JCall (FunctionName)@\First checks for an EXITOPENCODE table, then
+for an OPENCODE table (followed by a normal return, !*EXIT(0)) or
+looks for the general '!*JCALL table. The generated code is supposed
+to call the function without saving a return address, essentially a
+JUMP.
+
+!*ForeignLink (FunctionName FunctionType NumberOfArguments)@\
+This is the basic linkage to a foreign function. It assumes the appropriate
+number of arguments are in the registers (previously loaded) in the
+registers, @w[(REG 1) ... (REG n)]. It then pushes the arguments on a
+stack, or moves them to a global location, as appropriate and
+transfers to the ForeignFunction in an appropriate manner (REWRITE).
+Some care must be taken in interfacing to the LISP world, with cleanup
+on return.
+@end(description)
+
+The following @CMACRO@XS handle the allocation and deallocation of a Frame of
+temporary items on the stack, used for argument saving, PROG local
+variables, etc.
+
+
+@Begin(description)
+!*Alloc (N)@\Allocates a frame of N @Value(Times)
+AddressingUnitsPerItem units by adjusting the stack (generally
+increasing it) by using a stack operation that invokes an overflow
+signal, if any. Otherwise the stack register should be compared
+against an appropriate UpperBound. It passes N @Value(Times)
+AddressingUnitsPerItem to the pattern, to be used for indexing or
+displacement. Note some stacks grow in the @ei[negative] direction,
+and this is a major source of @CMACRO errors. Currently, there is a
+major problem, that this MACRO may not be called recursively. FIX in
+the future.
+
+!*DeAlloc (N)@\Decrement stack by N @Value(Times) AddressingUnitsPerItem units,
+deallocating the temporary FRAME. Passes N*AddressingUnitsPerItem to the
+pattern.
+@end(Description)
+
+The following @CMACRO@XS deal with the binding and unbinding of FLUID
+variables used as Lambda or Prog parameters. They are usually quite
+complex to code. The basic idea is to follow the call on a Lambind or
+Progbind procedure by a compact table of Fluid addresses or offsets. The
+call may have to be special, and @ei[internal], so that the support code
+(usually hand-coded in LAP) can pick up and process each entry in the
+compact table.
+
+
+@begin(Description)
+!*LamBind(Registers FluidsList)@\Registers is of the form
+@w[(REGISTERS (REG a) (REG b) ... (REG c))], and FluidsList is of the form
+@w[(NONLOCALVARS (FLUID f) ...)]. The intent of this @CMACRO is to save the
+current value of each
+Fluid in the list on the Binding Stack, paired with the Fluid name. Then
+the value in the corresponding register is stored into the Value cell.
+Later unbinding by !*FreeRstr or the Catch and Throw mechanism, restores
+the saved value.
+
+!*ProgBind (FluidsList)@\Emitted for Fluid variables in Prog parameter
+lists. Idea is as above, but stores a NIL in the value cell after saving
+the old contents. Usually implemented as
+@w[(!*LamBind '(REGISTERS) FluidsList))], but may be able to use a more compact
+table.
+
+!*FreeRstr (FluidsList)@\Restores the old values of the fluids. Since we use
+a special binding stack with Fluid names stored on it, we really only need the
+number to unbind. [Perhaps we should use !*UnBind(N) to make this decision
+explicit.]
+@end(Description)
+
+Data-moving @CMACRO@XS. Most of the work is done by !*MOVE, with some PUSH/POP
+optimizations if the !*MOVE is close to an !*ALLOC or !*DEALLOC. Other data
+moving may be done in conjuction some of the operations, such as !*WAND,
+!*WOR, !*WPLUS2, !*WMINUS, etc.
+
+
+@begin(Description)
+!*Move (Source Destination)@\The major work horse. Generates code to move
+SOURCE to DESTINATION. Uses (REG t1) and (REG t2) as temporary
+registers if needed. First simplifies destination (@ei[Anyreg resolution]),
+using (REG t1) as a temporary if needed. It then simplifies the SOURCE,
+using the as temporary either the destination (if a register), or (REG
+t2). Finally, the !*MOVE table is used.
+
+!*Push (Arg1)@\Emitted during peep hole optimization to
+replace a pair !*ALLOC(1) and !*MOVE(arg1,(FRAME 1)). This is a very common
+optimization.
+
+!*Pop (Arg1)@\Emitted during the peep hole phase
+to replace the common pair !*MOVE((FRAME 1),Arg1), followed by
+!*DEALLOC(1). This modifies the argument ARG1.
+
+@end(Description)
+
+The JUMP @CMACRO@XS are given the label as the first operand, but
+they pass the label as the third (and last) argument to the pattern
+(usually as ARGTHREE) after resolving the other arguments. The label
+is tagged (LABEL Label).
+
+
+@begin(Description)
+
+@begin(group)
+!*Lbl (Label)@\This @CMACRO is emitted when a label is inserted in the
+generated code. Its body is usually trivial, but can be more complex
+if some form of short and long jump optimization is attempted.
+@hinge
+
+!*Jump (Label)@\Emit code to jump to Label. Label often involves memory.
+@hinge
+
+!*JumpEQ (Label Arg1 Arg2)@\Generate code to JUMP if Arg1 EQ Arg2.
+Used for @xlisp EQ and @syslisp WEQ.
+@hinge
+
+!*JumpNotEQ (Label Arg1 Arg2)@\Generate code to JUMP if not(Arg1 EQ Arg2).
+Used for @xlisp EQ and @syslisp WEQ.
+@hinge
+
+!*JumpWLessP (Label Arg1 Arg2)@\Generate code to JUMP if Arg1 @Value(LT) Arg2.
+Used for @syslisp WLESSP.
+@hinge
+
+!*JumpWGreaterP (Label Arg1 Arg2)@\Generate code to JUMP if Arg1 @Value(GT) Arg2.
+Used for @syslisp WGREATERP.
+@hinge
+
+!*JumpWLEQ (Label Arg1 Arg2)@\Generate code to JUMP if Arg1 @Value(LTE) Arg2.
+Used for @syslisp WLEQ.
+
+!*JumpWGEQ (Label Arg1 Arg2)@\Generate code to JUMP if Arg1 @Value(GTE) Arg2.
+Used for @syslisp WGEQ.
+
+!*JumpType (Label Arg TypeTag)@\Generate code to JUMP if TAG(Arg)
+@Value(Eq) TypeTag. The TypeTags are small integers, defined in the
+xxxx-Data-Machine file. This @CMACRO is emitted for opencoded Type
+checking, such as IDP(x), etc. It should be implemented very efficiently.
+Instead of extracting the TAG and comparing with the small integer, it may
+be easier just to mask the INF portion of Arg, and compare with a shifted
+version of TypeTag (previously saved, of course).
+@hinge
+
+!*JumpNotType (Label Arg TypeTag)@\Generate code to JUMP if not(TAG(Arg)
+@Value(Eq) TypeTag). See comments above.
+@hinge
+
+!*JumpInType (Label Arg TypeTag)@\Generate code to JUMP if Tag(Arg) is in the
+range @w([0 ... TypeTag,NegInt]). This is used to support the numeric
+Types, which are encoded as 0,...M, and -1 for negative Inums. Thus NumberP,
+FixP, etc@. have to test a range. Note that NegInt is tested specially.
+@hinge
+
+!*JumpNotInType (Label Arg TypeTag)@\Generate code to JUMP if Tag(Arg) is
+not in the range @w([0 ... TypeTag, NegInt]). See above comment.
+@hinge
+
+
+!*JumpOn (Register LowerBound UpperBound LabelList)@\Used to support the
+CASE statement. This is usually written by hand and no pattern is used.
+It tests if Register is in range LowerBound @value[Lte] Register
+@value[Lte] UpperBound; if so, it jumps to the appropriate label in
+labellist, using (Register @value[MinusSign] LowerBound) as the index. If
+not in range, it Jumps to a label planted at the end of the label table. In
+some implementations, the label table has to be a jump table.
+@hinge
+
+!*JumpWithin (Label LowerBound UpperBound)@\This is also used to support
+the CASE statement, in the situation where the overall label range is
+large, and there are many sub-ranges. This generates code to JUMP to Label
+if LowerBound @value(LTE) (REG 1) @value(LTE) UpperBound. A default version
+uses !*JumpWLessP and !*JumpWLeq tests. [Perhaps should be modified to use
+ANY reg].
+@end(group)
+@end(Description)
+
+ The following @CMACRO@XS perform simple computations on their arguments.
+Binary operations take two arguments, (Dest Source), and leave the result
+in DEST.
+
+
+@begin(description)
+!*MkItem (Arg1 Arg2)@\Computes Arg1 @Value(Eq) Item(Arg1,Arg2); construct an
+Item into Arg1 from the tag in Arg1 and Information part in ARg2. May have
+to shift and mask both Arg1 and Arg2. Equivalent to
+!*WOR(!*Wshift(Arg1,24),!*Wand(Arg2,16#FFFFFF)) on the 68000 [This may
+actually use a stored preshifted version of the tag].
+[[[[[Check the ORDER!!!! and use parameters rather than 24 and fffff]]]]]]
+
+!*WPlus2 (Arg1 Arg2)@\Compute Arg1 @Value(Eq) Arg1 + Arg2. Look for special
+cases of 1, -1, 0, etc. Note on the 68000 it checks for a small integer, i.e.
+-8..8 since these are done with a @dq[QUICK] instruction. [Ignore overflow?]
+
+!*WDifference (Arg1 Arg2)@\Compute Arg1 @Value(Eq) Arg1-Arg2. Look for special
+cases of 1, -1, 0, etc.
+
+!*WTimes2 (Arg1 Arg2)@\Compute Arg1 @Value(Eq) Arg1*Arg2. It first looks to
+see if Arg2 is constant and a power of 2. If so, it emits a corresponding
+!*Ashift(Arg1,PowerOfTwo Arg2). This check for special cases is in the
+pattern.
+
+!*AShift (Arg1 Arg2)@\Shift Arg1 by Arg2, using Arithmetic shift. Used to
+support !*WTIMES2. Should do appropriate Sign Extend.
+
+!*WShift (Arg1 Arg2)@\Shift Arg1 by Arg2, logically, doing 0 fill.
+
+!*WAnd (Arg1 Arg2)@\Arg1 @Value(Eq) Arg1 AND Arg2. BitWise AND, each bit of
+Arg1 is 1 only if BOTH corresponding bits of Arg1 and Arg2 are 1.
+
+!*WOr (Arg1 Arg2)@\Arg1 @Value(Eq) Arg1 OR Arg2. BitWise OR.
+
+!*WXOr (Arg1 Arg2)@\Arg1 @Value(Eq) Arg1 Xor Arg2.
+
+!*WMinus (Arg1 Arg2)@\Arg1 @Value(Eq) @Value(MinusSign) Arg2.
+
+!*WNot (Arg1 Arg2)@\Arg1 @Value(Eq) Logical NOT Arg2.
+
+!*Loc (Arg1 Arg2)@\Arg1 @Value(Eq) Address (Arg2).
+
+@end(description)
+
+The following are important optimizations, that may be initially
+implemented as procedures:
+@begin(description)
+!*Field (Arg1 Arg2 Arg3 Arg4)@\Arg1 @Value(Eq) Extract Field of Arg2
+starting at Bit Arg3, of Length Arg4. Bits are numbered
+0...Size(Word)@Value(MinusSign)1. The most significant bit is numbered 0 in
+our model. There is an assumption that Arg3 Arg4 are constants.
+
+!*SignedField (Arg1 Arg2 Arg3 Arg4)@\Arg1 @Value(Eq) Extract Field of Arg2
+starting at Bit Arg3, or Length Arg4. Bits are numbered
+0...Size(Word)@Value(MinusSign)1. The field is to be sign extended into
+Arg1.
+
+!*PutField (Arg1 Arg2 Arg3 Arg4)@\Deposit into Arg1 a field of Arg2
+starting at Bit Arg3, or Length Arg4. Bits are numbered
+0...Size(Word)@Value(MinusSign)1. @end(Description)
+
+
+
+
+@section(Organization of the Compiler and Assembler Source Files)
+
+
+The code is organized as a set of common files kept on the PC:
+directory, augmented by machine-specific files kept on other
+directories@Foot[These generally have logical names of the form
+PxxxC: where xxx is the root name of the directories for a given machine/OS
+implementation.]. The @dq[skeletal] common files and machine-specific
+files (mostly kept as compiled FASL files) make up the CROSS compiler
+and assembler. The machine-specific files customize the compiler for
+the specific target machine and assembler (currently we compile for
+@DEC20, @VAX750, @Apollo, @WICAT, and Cray-1).
+
+@subsection(Common Files)
+
+The machine-independent part of compiler is kept as
+PL:COMPILER.B@Foot[PL: is <PSL.LAP> or ~psl/lap.],
+built by PC:COMPILER.CTL. It consists of the files:
+
+@begin(description)
+PC:COMPILER.RED@\The basic compiler
+
+PC:COMP-DECLS.RED@\Common declarations configuring the compiler:
+installing the compiler specific functions, such as PA1FNs, COMPFNs,
+OPENFNS etc. These are described in the compiler chapter.
+
+PC:PASS-1-LAP.SL@\Basic PASS1 of @CMACRO/LAP process.
+
+PC:ANYREG-CMACRO.SL@\The @CMACRO and @anyreg pattern matcher and support
+functions.
+
+PC:COMMON-CMACROS.SL@\Standard or default @CMACRO@xs and @anyreg@xs used by
+most implementations.
+
+PC:COMMON-PREDICATES.SL@\Useful predicates to aid in writing the @CMACRO@xs.
+@end(Description)
+
+In addition, the following file is needed:
+
+@Begin(Description)
+PC:LAP-TO-ASM.RED@\Standard functions to convert LAP into machine-dependent
+assembly code.
+@end(Description)
+
+@subsection(Machine-Specific Files)
+For machine xxxx, the files:
+
+@begin(description)
+xxxx-COMP.RED@\Machine-Specific Compiler Patterns and Function installations.
+This file may have some special @CMACRO support in it@Foot{This is the case
+of extending the abstract machine for a particular implementation.}.
+
+xxxx-CMAC.SL@\Machine-Specific @CMACRO@xs and @anyreg@xs.
+
+xxxx-ASM.RED@\Definition of FORMATS, and special addressing mode conversion
+functions, declaration Pseudos, etc.
+
+xxxx-DATA-MACHINE.RED@\Smacros and constants to define @syslisp macros
+needed for the implementation. This file associates @syslisp functions with
+@CMACRO@xs for special cases.
+@end(description)
+Finally, during the compilation of XXXX- user files, the following two files:
+
+@begin(description)
+xxxx:GLOBAL-DATA.Red@\Describes GLOBAL symbols used everywhere.
+@end(description)
+
+@subsection(Building the CROSS Compiler)
+[For the moment, see the distribution guide for the Host machine].
+
+
+@section(Design of LAP Format)
+
+The argument to the function LAP is a list of lists and atoms. The
+lists are instructions, pseudo-ops and @cmacro@xs, and the atoms are labels
+which are used to refer to positions in the code. Note these need not
+be IDs, but can also be strings, saving on ID space. Instructions
+should be of the form @w[(@i(opcode) . @i(operands))], where @i(opcode) is a
+mnemonic for an opcode, and @i(operands) is a list of operands. Each
+operand should be either an integer, which represents an immediate integer
+operand, a label, or a list of the form @w[(@i(mode) . @i(suboperands))]. A
+@i(mode) is an addressing mode, such as INDEXED or INDIRECT on the PDP-10,
+and DISPLACEMENT, DEFERRED, AUTOINCREMENT, etc@. for the VAX-11. REG must
+exist on all machines; others will be chosen as appropriate for the system.
+Remember that these are mainly used for @cmacro expansions rather than
+for writing code, so choose names for mnemonic value rather than brevity.
+@i(Suboperands) may also be operands, or they may be specific to the mode,
+e.g@. register names.@comment(more on @xlisp specific ones, QUOTE and FLUID)
+
+See also the READING/WRITING/TESTING of LAP operating note@cite[Griss82h].
+@comment[We have a LOT to write here!]
+
+@subsection(Addressing Modes)
+@subsection(Register Designators)
+@subsection(Labels)
+@subsection(Storage Pseudos)
+
+
+@section(Implement LAP-TO-ASM)
+@SubSection(Needed Values)
+ Values must be given for:
+
+@begin(description)
+MainEntryPointName!*@\An ID which is the main procedure name.
+
+NumericRegisterNames!*@\A vector of the symbolic names for the compiler
+registers.
+
+@end(description)
+ In addition, each of the registers (as IDs) must be declared, using
+DefList to provide the string name of the register and flagging the
+property list of the ID with 'RegisterName.
+
+@subsection(Tables)
+ The list ForeignExternList!* is used to remember each of the
+foreign functions that has been called in the course of a module so that
+the proper externs can be emitted.
+
+@SubSection(Printing routines)
+ A number of routines which are used to print the
+strings, constants, etc@. are listed as follows:
+
+@begin(format)
+PrintString(S)
+PrintByte!,(X)
+TruncateString(S,n)
+PrintByteList(L)
+PrintByte(X)
+PrintHalfWordList(L)
+PrintHalfWord(X)
+PrintHalfWords(X)
+PrintOpcode(X)
+SpecialActionForMainEntryPoint()
+PrintNumericOperand(X)
+@end(format)
+
+@subsection(Symbol Mapping)
+ The function ASMSymbolP(X) must be written to check whether a @Xlisp
+ID is also a legal symbol for the target assembler.
+
+@Subsection(Formats)
+ The following formats must be declared to tell the LAP-TO-ASM
+routines how to print objects and the format of file names to use:
+CodeFileNameFormat!*, DataFileNameFormat!*, LabelFormat!*, CommentFormat!*,
+ExportedDeclarationFormat!*, ExternalDeclarationFormat!*, FullWordFormat!*,
+HalfWordFormat!*, ReserveDataBlockFormat!*, ReserveZeroBlockFormat!*,
+DefinedFunctionCellFormat!*, UndefinedFunctionCellInstructions!*, and the
+description for how to construct an item (for MkItem).
+
+
+@section(Independent Compilation)
+
+ In order to maintain the PSL kernel as a set of reasonable sized
+modules (about 15) a method to permit (semi-)independent translation
+from LISP (or RLISP) to TLM assembly format was devised. This method
+records information about symbols and structures defined in one module
+and needed in another in a file called the SYM file.
+
+When a set of modules is to be assembled into a program, a fresh SYM
+file is allocated (usually called XXX-PSL.SYM or "Program-name.SYM").
+Then as each module, MMM.RED is translated, the SYM file is first read
+in to initialize various SYMBOL counters. After the translation is
+complete an updated SYM file is written for the next step. When all
+modules are tranlated, a last (MAIN) module is translated, and some of
+the data information gathered in the SYM file is converted into global
+data declarations in the assembly file.
+
+Each module, MMM.RED (perhaps described by a MMM.BUILD file), is
+converted
+into 3 files, and updates to the SYM file:
+@begin(description)
+Code-File@\Contains the actual instructions for the procedues in the
+MMM file. May also contain "read-only" data, such as some strings or
+s-expressions. Typically called something like MMM.asm
+
+Data-file@\Contains data-objects that may get changed, typically
+WVAR and WARRAYs. This file typically called DMMM.asm or MMMd.asm.
+
+Init-file@\Contains S-expressions that were not compilable procedures
+found in the MMM.red file. Typically FLUID declarations, SETQ's and
+PUT's dominate this sort of code. This file will be read-in by the
+executing PSL after basic INITCODE is executed. Typically called
+MMM.INIT.
+@end(description)
+
+The .SYM file data structures are updated. These structures are:
+@begin(description)
+Startup-Sexpressions@\Certain s-expressions must be evaluated
+during INITCODE, before the .INIT files can be read. These are
+collected into a single procedure, and compiled as INITCODE in the
+MAIN module. This is the (SAVEFORCOMPILATION (QUOTE ...))
+expression in the SYM file.
+
+ID list@\New IDs encountered in this file are added to a list
+of IDs in ID# order. IDs are referred to by ID#; list is called
+ORDEREDIDLIST!*.
+
+NEXTIDNUMBER!*@\The next ID# that will be allocated to the next new
+ID.
+
+STRINGGENSYM!*@\A string representing the last generated symbol-name.
+Used for internal labels, and external names that are too complex.
+
+Individual ID descriptors@\Each ID is now "installed" with a set of
+PUT's, indicating its ID#, the assembly symbol that is its entry
+point, if it is a WCONST, WVAR ,WARRAY etc. for example:
+@begin(Verbatim)
+(PUT 'INFBITLENGTH 'SCOPE 'EXTERNAL)
+ % An exported WCONST
+(PUT 'INFBITLENGTH 'ASMSYMBOL 'NIL)
+ % no symbol allocated
+(PUT 'INFBITLENGTH 'WCONST '18)
+ % Its compile time value
+
+(PUT 'STACKUPPERBOUND 'SCOPE 'EXTERNAL)
+ % An exported WVAR
+(PUT 'STACKUPPERBOUND 'ASMSYMBOL '"L2041")
+ % The Assembly SYMBOL
+(PUT 'STACKUPPERBOUND 'WVAR 'STACKUPPERBOUND)
+ % Type of VAR
+
+(PUT 'TWOARGDISPATCH 'ENTRYPOINT '"L1319")
+ % An internal FUNCTION and its Assembly
+ % SYMBOL
+
+(PUT 'RELOAD 'ENTRYPOINT 'RELOAD)
+ % A simple entry point, not renamed
+(PUT 'RELOAD 'IDNUMBER '552)
+ % Its ID number. SYMFNC(552)->
+ % JUMP RELOAD
+
+(PUT 'CADR 'ENTRYPOINT 'CADR)
+ % Another simple entry point
+(PUT 'CADR 'IDNUMBER '229)
+
+
+(PUT 'LIST2STRING 'ENTRYPOINT '"L0059")
+ % Entry point, renamed because too long
+ % SYMFNC(147)->JUMP L0059
+(PUT 'LIST2STRING 'IDNUMBER '147)
+
+(PUT 'SPECIALRDSACTION!* 'IDNUMBER '598)
+ % A Global variable, INITIALLY NIL
+(FLAG '(SPECIALRDSACTION!*) 'NILINITIALVALUE)
+
+(PUT 'GLOBALLOOKUP 'ENTRYPOINT '"L3389")
+(PUT 'GLOBALLOOKUP 'IDNUMBER '772)
+
+(PUT 'CLEARCOMPRESSCHANNEL 'ENTRYPOINT
+ '"L2793")
+(PUT 'CLEARCOMPRESSCHANNEL 'IDNUMBER '678)
+
+@end(Verbatim)
+@end(description)
+
+The contents of SYMFNC are filled in during the translation of the
+MAIN module, and JUMPs to the entrypoints of symbols that have them
+are filled in. Other symbols get a JUMP to the UndefinedFunction Entry
+point.
+
+In general, individual modules can be retranslated, since the
+information they generate is initially taken from the SYM file
+(ensuring that ID's and SYMBOLS get the same IDNUMBER and ENTRYPOINT
+as before). The procedure is to translate the desired model (modules)
+again, replacing the CODE-FILE, DATE-FILE and INIT-FILE previously
+produced, and also to retranslate the MAIN module, since additonal
+symbols S-expressions etc may have been produced, and therefor need to
+be converted into INIOTCODE or HEAP or SYMBOL data.
+
+
+@subsection(Data Pseudos)
+The following are pseudo operations (from the @68000 version) which
+must have a procedure to implement them in xxxx-ASM.RED:
+HalfWord, Deferred, Displacement, Indexed, Immediate, Iconst,
+AutoIncrement, AutoDecrement, Absolute, and ForeignEntry.
+
+
+
+@section(Configure the Compiler)
+This is still somewhat arcane. Basically, the compiler tables that select the
+COMPFN's and OPENFN's and patterns need to be installed. The most
+common method of doing this is to start from the xxxx-COMP.RED file most
+like the target machine X@Foot[It is still the case that you need a
+compiler wizard to help you with this as the details are still changing and
+often undocumented, with a lot of "You have to do this, to do that, but ..."].
+
+[Effort is required to describe this more clearly]
+
+
+@Section(Write the Additional LAP Modules)
+A variety of small LAP routines are required for I/O, system interface,
+core-saving, efficient function-linkage, variable binding, etc. Some of these
+are described in the following System Dependent Section. Others are:
+
+@subsection(Apply-LAP)
+These procedures are rather important, and unfortunately tricky to write.
+They are used to enable compiled-code to call interpreted code and
+vice versa. When they are used, the registers R1...Rn have the arguments
+loaded in them, so SYSLISP can't be used.
+
+The routines are CodeApply(codePtr,Arglst), CodeEvalApply(CodePtr,Arglst),
+BindEval(Formals,Args), CompileCallingInterpreted(IdOfFunction), FastApply(),
+and UndefinedFunction(). These are partially described in SYSLISP, and
+written in LAP with mostly @CMACRO@XS@Foot[See P20:APPLY-LAP.RED and
+PV:APPLY-LAP.RED.].
+
+Need to discuss tricks in more detail, devise a set of tests.
+
+@subsection(Fast-Bind)
+This consists of efficient routines written in LAP (using mostly
+@CMACRO@xs) to BIND and UNBIND fluid variables. The specifics depend
+on how the !*LAMBIND, !*PROGBIND and !*FREERESTR @CMACRO@xs are
+implemented. In general, a machine specific "fast-call" is used, rather
+than the more general recursive LISP call, and a list of ID numbers and
+values ( NIL or register numbers) are passed in a block. The FASTBIND
+routine uses the ID number to find the current value of the ID, and saves
+the ID number and this value on the binding stack. Then NIL (for PROGBIND),
+or the register value (for LAMBIND) is installed in SYMVAL(ID#). Note that
+the compiler registers R1...Rn should not be changed, so either they have
+to be saved, or other "hidden" registers have to be used. Since some hidden
+registers may be used in the implementation of certain @CMACRO@xs, care has
+to be exercized.
+
+FASTUNBIND is usually simpler, since all it needs is a number of
+@W[(ID# . Old-value)] pairs to pop off the Binding stack, and restore
+@Foot[See P20:FAST-BINDER.RED or PV:FAST-BINDER.RED for some ideas.].
+
+
+@SECTION(System Dependent Primitives)
+The following set of functions are needed to complete the
+system-dependent part of @PSL:
+
+@subsection(System-dependent input and output)
+
+@PSL uses a one-character-at-a-time stream model for I/O. I/O channels are
+just small integers in a range from 0 to 32 (32 was chosen for no
+particular reason and could easily be increased if desired). They are used
+as indices to the WArrays ReadFunction, WriteFunction and CloseFunction,
+which contain the names (as @xlisp items) of the functions to be called.
+Thus a stream is an object with a set of operations, buffer(s), and static
+vaiables associated with it. The current implementation of streams uses
+parallel vectors for each of the operations that can be associated with a
+stream. The Channel Number is used as an index into these vectors.
+For example, the standard input channel is 0@Foot[This corresponds to the
+@UNIX STDIO channel "stdin".] thus ReadFunction[0] contains
+'TerminalInputHandler, which is a function used to get a character from the
+terminal. The system-dependent file input and output functions are
+responsible for associating these channels with @ei[file pointers] or
+@ei[JFNs] or whatever is appropriate to your system. These functions must
+also perform any buffering required. We have been lucky so far because the
+@UNIX and Tops-20 systems have single character primitives@Foot[Thus the
+operating system hides the buffering.].
+
+The reading function is responsible for echoing characters if the flag
+!*ECHO is T. It may not be appropriate for a read function to echo
+characters. For example, the "disk" reading function does echoing, while
+the reader used to implement the @b[Compress] function does not. The read
+function should return the ASCII code for a line feed (EOL) character to
+indicate an end of line (or "newline"). This may require that the ASCII
+code for carriage return be ignored when read, not returned.
+
+
+The VAX UNIX version of SYSTEM-IO.RED (stored on PV:@Foot[PV: is
+<PSL.VAX-Interp> or ~benson/psl/vax-interp.]) is the simplest,
+since the UNIX STDIO library is so close to this model. This is a good
+starting point for a new version. It also uses the file PSLIO.C, which
+contains the array @w[@Value(UnderScore)FILEPOINTEROFCHANNEL], used for
+channel allocation.
+
+The function @b(ClearIO) is called at system-startup time and when the
+function RESET is called. It should do all dynamic initialization of the
+system, but should not close any open files. Static initialization of
+slots in the function arrays is done in the system-dependent file
+IO-DATA.RED, and the array used for channel allocation should also have
+initialized slots for the channels used for terminal input (STDIN!* = 0),
+terminal output (STDOUT!* = 1) and channels 2 thru 4, used by BLDMSG,
+COMPRESS/EXPLODE and FLATSIZE. The variable ERROUT!* should have a
+terminal output channel associated with it. This may be shared with
+STDOUT!* as in the @Dec20, or be associated with a separate error
+diagnostic stream, as on the VAX.
+
+Channel allocation is handled by the system-dependent part of I/O, so when
+the @Xlisp function Open calls the function @b(SystemOpenFileSpecial) for a
+non-file-oriented I/O stream, it should just mark a free channel as being
+in use and return it. @b(SystemMarkAsClosedChannel) does the opposite,
+returning a channel to the pool of available ones.
+
+@b(SystemOpenFileForInput) and @b(SystemOpenFileForOutput) each takes a
+string as an argument and should return a channel and set appropriate
+functions in the corresponding slots in ReadFunction, WriteFunction and
+CloseFunction. If a file cannot be opened, a continuable error should be
+generated whose error form is (OPEN @dq[file name] 'TYPE), where TYPE is either
+INPUT or OUTPUT.
+
+Terminal output should be unbuffered if possible. If it must be buffered,
+it should be flushed when terminal input is done and when EOLs are written.
+Terminal input should be line buffered, using line editing facilities
+provided by the operating system if possible. The terminal input routine
+is responsible for the display of the variable PromptString!*, using a @PSL
+channel for output if desired, as the VAX version does. The @Dec20
+terminal input routine uses a line editing facility that redisplays the
+prompt and previously typed characters when a Control-R is typed.
+
+End of file on input is indicated by returning a character which is CHAR
+EOF, Control-Z (ASCII 26) on the @Dec20 and Control-D (ASCII 4) on UNIX.
+This can be changed to any control character. The file SCAN-TABLE.RED will
+contain the CharConst definition for EOF, and a copy of LispScanTable!*
+with an 11 (delimiter) in that position.
+
+
+@subsection(Terminate Execution)
+The function QUIT(); terminates execution. It should probably close open
+files, perhaps restore system state to "standard" if special I/O
+capabilities were enabled. On some systems, execution can continue after
+the QUIT() at the next instruction, using a system command such as
+START or CONTINUE; on others, the core-image cannot be
+continued or restarted (see DUMPLISP(), below). On the DEC-20, the HALTF
+jsys is used, and execution can be continued. On the VAX under UNIX, a Stop
+signal (18) is sent via the "kill(0,18)" call. This also can be continued
+under Berkeley 4.1 UNIX.
+
+See the file SYSTEM-EXTRAS.RED on PV: and P20:
+
+@subsection(Date and Time)
+The function TIMC(); is supposed to return the run-time in milliseconds.
+This time should be from the start of this core-image, rather than JOB or
+SYSTEM time. It is used to time execution of functions. Return it as a
+full-word, untagged integer in register 1. On the DEC-20, we use the RUNTM
+jsys, on the VAX the C call on "times" is used, and multipled by 17,
+to get 1/1020'ths of a second. While not yet required, a TIMR() to get REAL,
+or WALL, time may be useful@Foot[See TIMC.RED on P20: and PV:.].
+
+The DATE(); function is supposed to return a Tagged @XLISP string
+containing the current date. No particular format is currently assumed,
+and the string is used to create welcome messages, etc. Later developments
+may require a standard for TIMESTAMPS on files, and may also require a
+CLOCK-time function. The Allocator function GtSTR(nbytes) may be useful to
+get a fresh string to copy the string returned by a system call into. The
+string should be 0-terminated. The DEC-20 uses ODTIM, and "writes" to the
+string in "6-jun-82" format. On the VAX, the "ctime" call is used, and the
+result "shuffled" into the same format as the DEC-20@Foot[See
+SYSTEM-EXTRAS.RED on PV: and P20:].
+
+@subsection(ReturnAddressP)
+The function RETURNADDRESSP(x); supports the backtrace mechanism, and is
+supposed to check that the instruction before the supposed address X, is in
+fact a legal CALL instruction. It is used to scan the stack, looking for
+return addresses@Foot[Very TRICKY, see SYSTEM-EXTRAS.RED on PV: and P20:].
+
+
+@subsection(Interrupt Handler)
+Also very crude at present; on the DEC-20, written as a loadable module,
+P20:20-INTERRUPT.RED, using the JSYS package. This enables CTRL-G, CTRL-T,
+some stack and arithmetic overflows, binding them to some sort of Throw
+or Error routine.
+
+ On the VAX, the file PV:TRAP.RED defines some signal setup, and
+InitializeInterrupts routine, and is included in the kernel.
+It associates each trap with a STDERROR call with a given message.
+
+Not yet standardized.
+
+We really should "bind" all trappable interupts to an
+appropriate THROW('!$SIGNAL!$,n), and indicate whether
+to treat as a Fatal Error, a Continuable Error, or not an
+Error at all.
+
+@subsection(Core Image Saving)
+A way in which @PSL (and most @XLISP@xs) get used involves the ability to
+load @XLISP and FASL code into an executing @PSL, saving this
+augmented "core-image" in a named file for subsequent restart later. Some
+Operating Systems permit a running program to be saved into an executable
+file, and then restarted from the beginning; others permit the saved
+program to be continued at the instruction following the call to the SAVE
+routine. Some operating systems do not normally permit or encourage the
+saving of a running program into an executable file, and there is a lot of
+work to be done.
+
+The model currently used in @PSL is that a call on DUMPLISP(); does the
+following (this is based on VAX and DEC-20 experience, and could
+change as Apollo and CRAY are completed):
+
+
+@begin(enumerate)
+calls RECLAIM(); to compact the heap, or move the upper heap into
+the lower heap. @Comment{How is it told that this is a cleanup reclaim that
+is to put the results in the "lower" heap???}
+
+makes some system calls to free unused space, decreasing the executable
+image; space is returned from HEAP, BPS and STACK.
+
+the core-image is saved in a file, whose name is the string in the
+global variable, DumpFileName!* (this string may have to be passed
+to the system routine, similar to I/O, using a small peice of LAP
+as interface, or using the Foreign function protocol);
+
+execution continues without leaving the running program; to terminate,
+the QUIT(); function must be called explicitly [this may not be possible
+on some systems, and may require a change in the model, or a
+machine specific restriction].
+
+the saved executable file will restart "from-the-top", i.e. by calling the
+machine specific "startup" function defined in MAIN-START.RED, which calls
+initialization functions CLEARBINDINGS(), CLEARIO(),
+INITIALIZEINTERRUPTS(), etc. Then the Startup function calls MAIN();,
+which can be redefined by the user before calling DUMPLISP();. MAIN()
+typically calls StandardLISP() or RLISP(), or some other TopLoop. This
+startup function also has a @XLISP accesible name, RESET.
+@end(Enumerate)
+
+On some machines, the core-image will automatically start "from-the-top",
+unless effort is expended to change the "restart-vector" (e.g@. the TOPS-20
+SSAVE jsys on the DEC-20);
+on others, an explicit LINKE CALL (a JUMP) to RESET should be included
+after the core-save call, to ensure execution of RESET (e.g@. the CTSS
+DROPFILE call on the CRAY-1).
+
+On the VAX under UNIX, a new function UNEXEC
+was written in C, to convert an executing program back into "a.out" format.
+
+See the files MAIN-START.RED and DUMPLISP.RED on P20: and PV:, and the
+preliminary documentation on the @apollo MAP_CODE.TXT, on PD:.
+
+
+@section(How LAP/TLM assembler works)
+
+@Section(How the LAP works)
+This discription of how the resident assembler (LAP) works is taken
+from the 68000 implementations. Refer to the diagram below to aid the
+understanding of this description. ALM instructions are passed into the
+procedure called LAP. The first thing LAP does is to pass them through the
+procedure PASS1LAP to transform ALM into TLM. The TLM is handed to
+OptimizeBranches to check to see if long branches are needed.
+OptimizeBranches is responsible for computing the offset of each label from
+the beginning of the function. A list called BranchAndLabelAlist is created
+which stores the labels and their offsets from the start of the code for
+this function.
+
+Upon the exit from OptimizeBranches the user may turn on the flag "PGWD"
+and will be able to see the current state of the code. If the code is to
+be compiled into memory and not fasled to a file then BPS space is
+allocated.
+
+Now the code make take one of three parallel paths.
+If the code is a label then it is ignored.
+If the instruction is an instance of !*Entry then the instruction
+is passed to the procedure SaveEntry to establish the address of the
+entry point of the code.
+On all other cases the instruction is passed to the procedure
+deposit instruction. This is often a good procedure to trace when
+debugging lap so that one can see what is actually heading off to be
+depsoited.
+
+Once the code has passed through one of the above three paths,
+the function defineEntries is called which loads the new code pointer into
+the function cell in the SYMFNC table. Following this the code pointer is
+tagged as code and returned as the result value of the function LAP.
+
+The following details are provideed as a guide to writing your own
+assembler.
+Consderation should be give to
+@begin(enumerate)
+Regular vs Irregular Machines
+
+Templates to Assemble Portions of Instruction
+
+Variable Length Instructions
+
+Alignment Problems
+
+Data Psuedos
+
+@xlisp Specific Pseudos
+@end(enumerate)
+
+@section(How do opcodes get defined for the LAP assembly process)
+
+There are three procedures used to define the opcodes.
+
+The first is DefineOpcode which defines, sets the necessary properties on
+the opcode's property list, for 680000 opcodes that have no ,byte,word, or
+long variants.
+
+The second function is DefineOpcodes (notice it is simply the plural of the
+first function) which defines an opcode with variants for byte,word, and
+long mode.
+
+And third is the function DefineCCOpcodes which sets up the properties for
+all the condition codes.
+
+@Section(Description of DefineOpcode)
+The function DefineOpcode an have three, four, or five arguments.
+They are defined to be:
+@begin(enumerate)
+The opcode name or id.
+
+The base 2 value of the opcode, only the constant bits in the opcodes
+binary value are given initially, the varible fields of an opcode are
+ORed into the word later. These are all two bytes long. This is tagged
+on a functions property list as its OpcodeValue.
+
+The function to be used to assemble this opcode, referred to on the
+property list by a functions InstructionDepositFunction.
+
+The forth field if present represents the mode to be used with this
+instruction: either byte, word, or long mode. The default is always word
+mode. This value is stored on the property list under the tag of Size.
+
+The fifth field is the number of bytes that the instruction will take up
+in the resulting binary code. Generally, only instructions that take no
+arguments will have this field filled in. This value is stored on the
+property list under the tag of InstructionLength.
+
+@end(enumerate)
+DefOpcode finally calls the function EvDefopcode which puts all the
+properties on the property list.
+
+@Section(How the Function DefOpcodes works)
+This function works just like the previous function DefOpcode except that
+it takes one less field, the size field which tells how the opcode will be
+used: byte, word, or long. This procedure will define an opcode for each
+case.
+For example if an opcode name is move then an id with associated property
+list will be created for move.b, move.w, and move.l.
+
+@Section(How the procedure DefCCOpcodes Works)
+This function was written just to save typing in all the cases of opcodes
+that use the condition codes. It does that same thing as DefOpcode above
+but for each condition code variant of an opcode.
+
+@section(Ok so what happens in a functions instruction depositfunction??)
+The opcode and oprands are selected out of the list and if the operands are
+not normal then they are passed throught the function effective address
+which classifies then as to the 68000 convention of register and mode.
+
+ Purpose: convert an operand from symbolic to numeric form.
+ Returns: Addressing mode in the range 0..7
+ --------------------------------------------------
+ M68K addressing modes (from appendix B of the M68K User's Manual)
+ Addressing Mode Mode Reg Valid Modes* Assembler
+ Data MEM Cont Alter Syntax
+ Data Register Direct 000 reg no. X - - X Dn
+ Address Register Direct 001 reg no. - - - X An
+ Addr Reg Indirect 010 reg no. X X X X (An)
+ with PostIncrement 011 reg no. X X - X (An)+
+ with PreDecrement 100 reg no. X X - X -(An)
+ with Displacement 101 reg no. X X X X d(An)
+ with Index 110 reg no. X X X X d(An,Ri)
+ Absolute Short 111 000 X X X X xxxx
+ Absolute Long 111 001 X X X X xxxxxxxx
+ PC with Displacement 111 010 X X X - d(PC)
+ PC with Index 111 011 X X X - d(PC,Ri)
+ Immediate 111 100 X X - - #xxxxxxxx
+
+ * = Valid Addressing modes for each type of Addressing Category
+ Data - used to refer to data operands
+ Mem = Memory - used to refer to memory operands
+ Cont = Control - used to refer to memory operands without an associated
+ size
+ Alter = Alterable - used to refer to alterable (writeable) operands
+ --------------------------------------------------
+ Operand is of the form:
+
+ case 1: numeric immediate data
+ or (immediate x)
+ case 2: non-numeric atom a local label, which uses PC with
+ displacement
+ case 3: (reg x) x is a number or symbolic register name
+ case 4: (deferred (reg x)) address register indirect in Motorola jargon
+ case 5: (autoincrement (reg x)) address register indirect with postincrement
+ case 6: (autodecrement (reg x)) address register indirect with predecrement
+ case 7: (displacement (reg x) n) if (reg x) is an A reg
+ then if n is 0
+ then (deferred (reg x))
+ else address register indirect
+ with displacement
+ else if (reg x) is a D reg
+ then address register indirect
+ with index, using A6 (zero)
+ case 8: (indexed (reg x) (displacement (reg y) n))
+ address register indirect with index
+
+ case 9+: various Lisp addressing modes, all of which are absolute long
+ addresses
+
+ The value returned by this function is the mode field of the instruction
+ for the operand.
+ In addition, the fluid variables OperandRegisterNumber!*
+ and OperandExtension!*
+ will be set.
+ If there are no words to follow, OperandExtension!* will be set to NIL.
+ Otherwise, possible values of OperandExtension!* are:
+
+ number or (immediate exp) immediate data
+ (number) 16-bit signed displacement
+ non-numeric atom pc relative label
+ (displacement reg disp) index extension word
+ other absolute long, i.e. LISP addressing mode
+
+
+LAP is a complete assembly form and can
+be used by @xlisp programmers to write any legal assembly
+code@Foot{There is no real guarantee that the entire set of machine
+opcodes is supported by the LAP. An implementor may have chosen to
+implement only those constructs used by the compiler-produced code or
+explicitly used in hand written LAP. The reason for this partial
+implementation is that many modern processors have included operations
+to facilitate @ei[high level language compilation], which often seem
+to be less than useful.}
+
+@section(Binary FAST Loader,FASL)
+[Explain FASL in general]
+
+[Explain essential problem, relocation of machine addresses and LISP
+ids]
+
+[Give big-picture of FASL]
+
+[Find MAGUIREs pictures of FASL blocks or regenerate
+]
+This section is a guide to the internal workings of faslout and then
+faslin.
+
+The user begins the faslout procedure by calling the procedure faslout with
+a string that does not have the extension (because it will add the
+appropriate binary extension for you). However, when fasling in, the file
+name requires the binary extension [Change this inconsistency].
+
+Inside the procedure faslout, the file name is assigned to the fluid
+variable ModuleName!*. Depending upon the setting of the flag
+!*Quiet_Faslout, the system will either print out a greeting message or
+not. Next, an output binary file is opened using the argument file name.
+It will return the channel number to a fluid variable CodeOut!*.
+CodeFileHeader is called to put in a header in the output file.
+
+CodeFileHeader writes out a word consisting of the Fasl Magic Number
+(currently set to 99). This magic word is used to check consistency
+between old and current fasl format files (an error is given upon fasling
+in the file if there is not a 99 as the first word). Therefore, the system
+must consistently modify that number when a new fasl format is produced.
+To continue, we need to understand the allocation that takes place within
+the Binary Program Space (BPS). The BPS is a large, non-collected space
+that contains compiled code, warrays, the string assocaited with interned
+ID's, constant data in fasl files, etc. Space is allocated from both
+ends of the space. Compiled code is allocated from the bottom (using
+NextBPS as a pointer) and warrays are allocated from the top (using LastBPS
+as the pointer). When an allocation is attempted, the desired size is
+checked to see if it will cause LastBPS and NextBPS to cross; if it will,
+an error message will be printed. The next step is to allocate 2/3 or the
+remaining BPS from the top.
+@begin(verbatim,leftmargin 0)
+
+ .----------------------------.
+ | |
+ | WArrays |
+ | |
+ | |
+Last_BPS>|----------------------------| <-FaslBlockEnd!* ---.
+ | Code | |
+ | | |
+ | | |
+ | | 2/3
+ |============================| <-CodeBase!* |
+ | Bit Table | |
+ |============================| <-BitTableBase!* ---'
+ | |
+ | |
+Next_BPS>|----------------------------|
+ | |
+ | |
+ | |
+ `----------------------------'
+
+ Binary Program Space
+
+@end(verbatim)
+The procedure AllocateFaslSpaces will setup the following fluid variables.
+FaslBlockEnd!* will be the address to the top of the available space for
+this particular allocation.
+
+BitTableBase!* points to the beginning of the BitTable.
+
+CurrentOffset!* keeps a pointer into the codespace of this allocation to
+the next available point to add more code.
+
+BitTableOffset!* is a running pointer to the current location in the
+BitTable where the next entry will go.
+
+CodeBase!* is the base pointer to the beginning of the code segment for
+this allocation.
+
+MaxFaslOffset!* is the max size of the codespace allowed for this
+implementation.
+
+OrderedIDList!* keeps record of the ID's as they are added.
+
+NextIDNumber!* is a base number used just in fasl files to indicate which
+IDs are local and which are global. It is assumed that there will never be
+more than 2048 pre-allocated ID's, currently there are 129. The first 128
+preallocated IDs are ASCII codes(0-127) and the last one is NIL(128).
+
+Everything is now setup to begin fasling PSL code out to the file.
+The remainder of the faslout procedure sets up three more fluid variables.
+
+!*DEFN is set to T which indicates that you are not going to do normal
+evaluation from the top loop and from files such as using the functions IN
+and DSKIN.
+
+DFPRINT!* signals that DFPRINT!* is now used as the printing function.
+The procedure used will be DFPRINTFasl!*.
+
+!*WritingFaslFile is set to T to let the system know that fasling out is
+goping on as opposed to compiling code directly into memory inside the PSL
+system.
+
+
+@subsection(Binary I/O and File Format)
+@u[Current FASL file format:]
+
+Check accuracy, this was PC:fasl-file.Specs
+
+@begin(description)
+Word@\Magic number (currently 99).@comment{ Why the magic number 99??? }
+
+Word@\Number of local IDs.
+
+Block@\Local ID names, in order, in regular @xlisp format
+(string size followed by block of chars).@comment{ need to specify that the
+ string size is given as a
+ word, and the character
+ counts is interms of bytes}
+
+Word@\Size of code segment in words.
+
+Word@\Offset in addressing units of initialization procedure.
+
+Block@\Code segment.
+
+Word@\Size of bit table in words (redundant, could be eliminated).
+
+Block@\Bit table.
+@end(description)
+
+@subsection(Relocation/Bit Table)
+Describes how to adjust addresses and ID numbers in previous Code Segment.
+[Should add GENSYM generator option.] This is a block of 2 bit items, one
+for each \addressing unit/ in the code block.@comment{ Are we committed to
+two bits forever? }
+
+@begin(description)
+0@\Don't relocate at this offset.
+
+1@\Relocate the word at this offset in the code segment.
+
+2@\Relocate the (halfword on VAX, right half on 20) at this offset.
+@comment[Can this be generalized some more????]
+
+3@\Relocate the info field of the @xlisp item at this offset.
+@end(description)
+
+The data referred to by relocation entries in the bit table are split into
+tag and info fields. The tag field specifies the type of relocation to be
+done:@comment{ Where is this data stored??? }
+
+@begin(description)
+0@\Add the code base to the info part.
+
+1@\Replace the local ID number in the info part by its global ID number.
+
+2@\Replace the local ID number in the info part by the location of its
+value cell.
+
+3@\Replace the local ID number in the info part by the location of its
+function cell.
+@end(description)
+
+Local ID numbers begin at 2048@comment{why this magic number???}, to allow
+for statically allocated ID numbers (those which will be the same at
+compile time and load time).
+
+@subsection(Internal Functions)
+[IS there any special handling of these, or restrictions]
+
+@subsection(Foreign Functions, Externs, etc)
+[Explain why cant do in FASL now. Need to do run-time look up of
+LOADER symbols, and use in LAP/FASL part of things. Will need to
+add extra RELOC types to FASL].
+
+@subsection(Init Code)
+[Explain how executable -sexpressions that are not procedure
+definitions
+are gathered into a single LISP procedure, compiled, and given
+name, sort of !*!*FASL-INIRTCODE!*!*, or some such.
+
+Is called as last action of LOAD.
+
+Explain current restriction on FASL initcode size, suggest soluitions]
+@subsection(Annotated FASL file example)
+@begin(verbatim)
+*Annotated version of a dump*
+
+procedure adder(x);
+begin scalar y;
+ y:=x;
+ return y+1;
+end;
+
+Dump of "trythis.b"
+
+000000: 0020 0001 E7DF FEDF 0000 0080 0000 00A0
+000010: 1800 0000 0000 0000 0000 0000 0000 0000
+000020: 0000 0080
+ 0000 0063 16#63 is the magic number which
+ indicates that is a FASL file
+ 0000 0003 Number of local IDs
+ 0000 0004 The first ID, in the form Length
+ of String, String name
+000030: 4144 4445 ADDER
+ 5200 0000
+ 0000 0003 Second ID, 3 (+1) characters "ADD1"
+ 4144 4431 ADD1
+000040: 0000 0000
+ 0000 0007 Third ID, 7 (+1) characters of
+ "PUTENTRY"
+ 5055 5445 PUTENTRY
+ 4E54 5259
+000050: 0000 0000
+ 0000 0003 Fourth ID, 3 (+1) characters "EXPR"
+ 4558 5052 EXPR
+ 0000 0000
+000060: 0000 000A CodeSize = 10 words
+ 0000 000A Offset of INIT function
+ -------------------- Code Block
+ 2649 MOVEA.L A1,A3
+ 2449 MOVEA.L A1,A2
+ 4EF9 C000 JMP C000 0801
+ ^ Relocate
+ Function cell
+ (ID.1 call on "ADD1")
+000070: 0801
+---------- The init code
+ 267C 0000 0000 MOVEA.L #0,A3
+ 247A 0010 MOVEA.L 10(pc),A2
+ 227A 0008 MOVEA.L 8(pc),A1
+000080: 4EF9 C000 0802 JMP C000 0802
+ ^ Relocate
+ Function cell
+ (ID.2 = "PUTENTRY")
+ FE40 0800 (ID.0 the procedure
+ ^ Relocate ID number name "ADDER")
+ FE40 0803 (ID.3 the procedure
+ ^ Relocate ID number type "EXPR")
+ 0000
+ -------------------- Bit Table Section
+000090: 0000 0003 Length of Bit table in words
+ -------------------- Bit Table
+ 0004 0000 : 0000 0000 0000 0100 0000 0000 0000 0000
+ ^ = Relocate Word
+ 0000 040C : 0000 0000 0000 0000 0000 0100 0000 1100
+ Relocate Word ^ ^
+ Relocate Inf------------'
+ 0C00 0000 : 0000 1100 0000 0000 0000 0000 0000 0000
+ ^ Relocate Inf
+@end(verbatim)
+
+[Explain how to use a BDUMP routine to examine this]
+
+
+@subsection(Binary I/O)
+
+The following functions are needed for FASLIN and FASLOUT:
+
+@i(BinaryOpenRead(Filename:string):system-channel)
+
+This should take a filename and open it so that binary input can be done.
+The value returned is used only by the other functions in this group, and
+so can be whatever is appropriate on your system.
+
+@i(BinaryOpenWrite(Filename:string):system-channel)
+
+Similar to BinaryOpenRead, open a file for binary output.
+
+@i(BinaryClose(SChn:system-channel):none returned)
+
+SChn is the value returned by BinaryOpenRead or BinaryOpenWrite. The file
+is closed.
+
+@i(BinaryRead(SChn:system-channel):word)
+
+One word (i.e. Lisp item sized quantity) is read from the binary file. On
+the Dec-20 this is done using the @i(BIN) jsys with the file opened in
+36-bit mode using a 36-bit byte pointer. The VAX Unix implementation uses
+@i(getw) from the stdio library.
+
+@i(BinaryReadBlock(SChn:system-channel, A:word-address, S:integer):none
+returned)
+
+S words are read from the binary file and deposited starting at the word
+address A. The Dec-20 version uses the @i(SIN) jsys and VAX Unix uses the
+@i(fread) function.
+
+@i(BinaryWrite(SChn:system-channel, W:word):none returned)
+
+One word is written to the binary file. On the Dec-20 this is done using
+the @i(BOUT) jsys with the file opened in 36-bit mode using a 36-bit byte
+pointer. The VAX Unix implementation uses @i(putw) from the stdio library.
+
+@i(BinaryWriteBlock(SChn:system-channel, A:word-address, S:integer):none
+returned)
+
+S words starting at the word address A are written to the binary file. The
+Dec-20 version uses the @i(SOUT) jsys and VAX Unix uses the @i(fwrite)
+function.
+
+@i(BitTable(A:word-address, B:bit-table-offset):integer)
+
+This is similar to @i(Byte) and @i(HalfWord), except that a 2-bit unit is
+being extracted. A is a word address, the base of a table of 2-bit
+entries. The one B entries from the beginning is returned.
+
+@i(PutBitTable(A:word-address, B:bit-table-offset, I:integer):)
+
+Analagous to @i(PutByte) and @i(PutHalfWord), except that a 2-bit unit is
+being deposited. A is a word address, the base of a table of 2-bit
+entries. The low-order 2 bits of the integer I are stored at offset B.
+
+[Explain how to test Binary I/O, in test N]
+
+@subsection(Miscellaneous)
+To use EMODE/NMODE and PRLISP on some systems, a "raw" I/O mode may be
+required. See the PBIN, PBOUT, CHARSININPUTBUFFER, ECHOON and ECHOOFF
+functions in EMOD2:RAWIO.RED and SYSTEM-EXTRAS.RED.
+
+Some sort of system-call, fork or similar primitives are useful,
+clearly system dependent. See the JSYS and EXEC package on P20:, the
+SYSTEM call in PV:SYSTEM-EXTRAS.RED (written in C as a Foreign
+Function), or the SYSCALL on the APOLLO.
+
+This set is not yet standardized.
+
ADDED psl-1983/3-1/doc/nmode/chart.ibm
Index: psl-1983/3-1/doc/nmode/chart.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/chart.ibm
@@ -0,0 +1,261 @@
+,MOD
+- R 44X (11 February 1983) <PSL.NMODE-DOC>CHART.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+
+
+
+
+
+ 202/9836 NMODE Command Summary
+
+ 201/11 February 1983
+
+
+
+ 202/Information
+
+ 201/What Cursor Position C-X =
+ Show Function on Key M-?
+ List Matching Commands <help>
+
+ 202/Files
+
+ 201/Find File C-X C-F
+ Write File C-X C-W
+ Save File C-X C-S
+ Save All Files M-X Save All Files
+ Write Region to File M-X Write Region
+ Append Region to File M-X Append to File
+ Prepend Region to File M-X Prepend to File
+ Insert File M-X Insert File
+ Revert File M-X Revert File
+ Set Visited Filename M-X Set Visited Filename
+
+ 202/Buffers
+
+ 201/Find File C-X C-F
+ Select Buffer C-X B
+ Select Previous Buffer C-M-L
+ List Buffers C-X C-B
+ Go to Buffer Start M-< (or) <clr-end>
+ Go to Buffer End M-> (or) Shift-<clr-end>
+ Kill Buffer C-X K
+ Kill Some Buffers M-X Kill Some Buffers
+ Append Region to Buffer C-X A
+ Rename Buffer M-X Rename Buffer
+ Insert Buffer M-X Insert Buffer
+ Set Buffer Not-Modified M-~
+
+ 202/Regions
+
+ 201/Kill Region C-W
+ Copy Region M-W
+ Fill Region M-G
+ Upcase Region C-X C-U
+ Downcase Region C-X C-L
+ Append Region to File M-X Append to File
+ Prepend Region to File M-X Prepend to File
+ Append Region to Buffer C-X A
+
+ 202/The Mark
+
+ 201/Set/Pop Mark C-@
+ Exchange Point and Mark C-X C-X
+ Set Mark at Beginning C-<
+ Set Mark at End C->
+ Mark Word M-@
+ Mark Paragraph M-H
+ Mark Form C-M-@
+ Mark Defun M-Backspace
+ Mark Whole Buffer C-X H
+
+
+
+
+
+ 202/Characters
+
+ 201/Move Forward Character C-F (or) <right-arrow>
+ Move Backward Character C-B (or) <left-arrow>
+ Forward Delete Character C-D (or) <del-chr>
+ Backward Delete Character Rubout
+ Transpose Characters C-T
+ Quote Character C-Q
+
+ 202/Lines
+
+ 201/Move to Next Line C-N (or) <down-arrow>
+ Move to Previous Line C-P (or) <up-arrow>
+ Goto Start of Line C-A
+ Goto End of Line C-E
+ Kill Line C-K (or) <del-ln>
+ Transpose Lines C-X C-T
+ Center Line M-S
+ Join To Previous Line M-^
+ Insert Blank Line C-O (or) <ins-ln>
+ Split Line C-M-O
+ Delete Blank Lines C-X C-O
+ Delete Matching Lines M-X Delete Matching Lines
+ Delete Non-Matching Lines M-X Delete Non-Matching Lines
+
+ 202/Words
+
+ 201/Move Forward Word M-F (or) Control-<right-arrow>
+ Move Backward Word M-B (or) Control-<left-arrow>
+ Forward Kill Word M-D
+ Backward Kill Word M-Rubout
+ Mark Word M-@
+ Transpose Words M-T
+ Upcase Word M-U
+ Downcase Word M-L
+ Capitalize Word M-C
+
+ 202/Sentences
+
+ 201/Move Forward Sentence M-E
+ Move Backward Sentence M-A
+ Forward Kill Sentence M-K
+ Backward Kill Sentence C-X Rubout
+
+ 202/Paragraphs
+
+ 201/Move Forward Paragraph M-]
+ Move Backward Paragraph M-[
+ Mark Paragraph M-H
+ Fill Paragraph M-Q
+
+ 202/Killing and Unkilling Text
+
+ 201/Kill Line C-K (or) <del-ln>
+ Forward Kill Word M-D
+ Backward Kill Word M-Rubout
+ Forward Kill Sentence M-K
+ Backward Kill Sentence C-X Rubout
+ Forward Kill Form C-M-K
+ Backward Kill Form C-M-Rubout
+ Kill Region C-W
+ Copy Region M-W
+ Yank Killed Text C-Y
+ Yank Previous Kill M-Y
+ Append Next Kill C-M-W
+
+
+
+
+
+ 202/Deleting Text
+
+ 201/Forward Delete Character C-D (or) <del-chr>
+ Backward Delete Character Rubout
+ Delete Horizontal Spaces M-\
+ Delete Blank Lines C-X C-O
+ Delete Matching Lines M-X Delete Matching Lines
+ Delete Non-Matching Lines M-X Delete Non-Matching Lines
+
+ 202/String Search
+
+ 201/Foward Search C-S
+ Reverse Search C-R
+ Count Occurrences M-X Count Occurrences
+
+ 202/String Replacement
+
+ 201/Query Replace M-%
+ Replace String C-%
+
+ 202/Indentation
+
+ 201/Back to Indentation on Line M-M
+ Indent Line Tab
+ Indent New Line Newline
+ Indent Form C-M-Q
+ Indent Region C-M-\
+
+ 202/Text Filling and Justification
+
+ 201/Set Fill Prefix C-X .
+ Set Right Margin C-X F
+ Fill Region M-G
+ Fill Paragraph M-Q
+ Fill Comment M-Z
+ Auto Fill Mode (toggle) M-X Auto Fill Mode
+
+ 202/Case Conversion
+
+ 201/Upcase Word M-U
+ Downcase Word M-L
+ Capitalize Word M-C
+ Upcase Region C-X C-U
+ Downcase Region C-X C-L
+
+ 202/Modes
+
+ 201/Enter Lisp Mode M-X Lisp Mode
+ Enter Text Mode M-X Text Mode
+
+ 202/Lisp Forms
+
+ 201/Move Forward Form C-M-F
+ Move Backward Form C-M-B
+ Forward Kill Form C-M-K
+ Backward Kill Form C-M-Rubout
+ Transpose Forms C-M-T
+ Mark Form C-M-@
+ Indent Form C-M-Q
+
+ 202/Lisp Lists
+
+ 201/Move Backward Up List C-(
+ Move Forward Up List C-)
+ Move Forward Into List C-M-D
+ Insert Parens M-(
+
+
+
+
+
+ 202/Lisp Defuns
+
+ 201/Mark Defun C-M-H
+ Beginning of Defun C-M-A
+ End of Defun C-M-E
+ Execute Defun C-] D
+
+ 202/Lisp Execution
+
+ 201/Execute Form C-] E
+ Execute Defun C-] D
+ Quit from Break Loop C-] Q
+ Abort from Break Loop C-] A
+ Backtrace from Break Loop C-] B
+ Continue from Break Loop C-] C
+ Retry from Break Loop C-] R
+
+ 202/Screen Management
+
+ 201/Redisplay Screen C-L
+ Reposition Window C-M-R
+ Scroll to Next Screenful C-V (or) <recall>
+ Scroll to Previous Screenful M-V (or) Shift-<recall>
+ Scroll Buffer Up One Line Control-<recall>
+ Scroll Buffer Down One Line Shift-Control-<recall>
+ Invert Video C-X V
+
+ 202/Windows
+
+ 201/Two Windows C-X 2
+ One Window C-X 1
+ Go to Other Window C-X O
+ Exchange Windows C-X E
+ Scroll Other Window C-M-V
+ Grow Window C-X ^
ADDED psl-1983/3-1/doc/nmode/commands.r
Index: psl-1983/3-1/doc/nmode/commands.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/commands.r
@@ -0,0 +1,2095 @@
+@fnc(append-next-kill-command)
+@cmd(Append Next Kill)
+@key(C-M-W)
+@seeglobal(Kill Ring)
+@acttype(Move Data)
+@cmddoc
+Make following kill commands append to last batch. Thus, C-K C-K,
+cursor motion, this command, and C-K C-K, generate one block of killed
+stuff, containing two lines.
+@end
+
+@fnc(append-to-buffer-command)
+@cmd(Append To Buffer)
+@key(C-X A)
+@topic(Buffers)
+@seedef(Region)
+@acttype(Move Data)
+@cmddoc
+Append region to specified buffer. The buffer's name is read from
+the keyboard; the buffer is created if nonexistent.
+A numeric argument causes us
+to "prepend" instead. We always insert the text at that buffer's
+pointer, but when "prepending" we leave the pointer before the
+inserted text.
+@end
+
+@fnc(append-to-file-command)
+@cmd(Append To File)
+@key(M-X Append To File)
+@topic(Files)
+@seedef(Region)
+@acttype(Move Data)
+@cmddoc
+Append region to end of specified file.
+@end
+
+@fnc(apropos-command)
+@cmd(Apropos)
+@key(M-X Apropos)
+@key(Esc-_)
+@acttype(Inform)
+@cmddoc
+M-X Apropos lists functions with names containing a string for which the
+user is prompted. The functions are displayed using a documentation
+browser, which allows the user to view additional information on each
+function or further filter the list of displayed functions by matching
+on addtional strings.
+@end
+
+@fnc(argument-digit)
+@cmd(Argument Digit)
+@key(C-0)
+@key(C-1)
+@key(C-2)
+@key(C-3)
+@key(C-4)
+@key(C-5)
+@key(C-6)
+@key(C-7)
+@key(C-8)
+@key(C-9)
+@key(C-M-0)
+@key(C-M-1)
+@key(C-M-2)
+@key(C-M-3)
+@key(C-M-4)
+@key(C-M-5)
+@key(C-M-6)
+@key(C-M-7)
+@key(C-M-8)
+@key(C-M-9)
+@key(M-0)
+@key(M-1)
+@key(M-2)
+@key(M-3)
+@key(M-4)
+@key(M-5)
+@key(M-6)
+@key(M-7)
+@key(M-8)
+@key(M-9)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+Specify numeric argument for next command. Several such digits typed
+in a row all accumulate.
+@end
+
+@fnc(auto-fill-mode-command)
+@cmd(Auto Fill Mode)
+@key(M-X Auto Fill Mode)
+@acttype(Change Mode)
+@seecmd(Set Fill Column)
+@cmddoc
+Break lines between words at the right margin. A positive argument
+turns Auto Fill mode on; zero or negative, turns it off. With no
+argument, the mode is toggled. When Auto Fill mode is on, lines are
+broken at spaces to fit the right margin (position controlled by Fill
+Column).
+You can set the Fill Column with the Set Fill Column command.
+@end
+
+@fnc(back-to-indentation-command)
+@cmd(Back To Indentation)
+@key(C-M-M)
+@key(C-M-RETURN)
+@key(M-M)
+@key(M-RETURN)
+@acttype(Move Point)
+@cmddoc
+Move to end of this line's indentation.
+@end
+
+@fnc(backward-kill-sentence-command)
+@cmd(Backward Kill Sentence)
+@key(C-X RUBOUT)
+@seeglobal(Kill Ring)
+@seedef(Sentence)
+@acttype(Remove)
+@cmddoc
+Kill back to beginning of sentence.
+With a command argument n kills backward (n>0) or
+forward (n>0) by |n| sentences.
+@end
+
+@fnc(backward-paragraph-command)
+@cmd(Backward Paragraph)
+@key(M-[)
+@seedef(Paragraph)
+@acttype(Move Point)
+@cmddoc
+Move backward to start of paragraph.
+When given argument moves backward (n>0) or forward (n<0) by |n| paragraphs
+where n is the command argument.
+@end
+
+@fnc(backward-sentence-command)
+@cmd(Backward Sentence)
+@key(M-A)
+@seedef(Sentence)
+@acttype(Move Point)
+@cmddoc
+Move to beginning of sentence.
+When given argument moves backward (n>0) or forward (n<0) by |n| sentences
+where n is the command argument.
+@end
+
+@fnc(backward-up-list-command)
+@cmd(Backward Up List)
+@key[C-(]
+@key[C-M-(]
+@mode(Lisp)
+@key(C-M-U)
+@acttype(Move Point)
+@topic(Lisp)
+@cmddoc
+Move up one level of list structure, backward.
+Given a command argument n move up |n| levels backward (n>0) or forward (n<0).
+@end
+
+@fnc(buffer-browser-command)
+@cmd(Buffer Browser)
+@key(C-X C-B)
+@key(M-X List Buffers)
+@topic(Buffers)
+@acttype(Inform)
+@cmddoc
+Put up a buffer browser subsystem. If an argument is given,
+then include
+buffers whose names begin with "+".
+@end
+
+@fnc(buffer-not-modified-command)
+@cmd(Buffer Not Modified)
+@key(M-~)
+@topic(Buffers)
+@acttype(Set Global Variable)
+@cmddoc
+Pretend that this buffer hasn't been altered.
+@end
+
+@fnc(c-x-prefix)
+@cmd(C-X Prefix)
+@key(C-X)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+The command Control-X is an escape-prefix for more commands.
+It reads a character (subcommand) and dispatches on it.
+@end
+
+@fnc(center-line-command)
+@cmd(Center Line)
+@key(M-S)
+@topic(Text)
+@seeglobal(Fill Column)
+@acttype(Alter Existing Text)
+@cmddoc
+Center this line's text within the line.
+With argument, centers that many lines and moves past.
+Centers current and preceding lines with negative argument.
+The width is Fill Column.
+@end
+
+@fnc(copy-region)
+@cmd(Copy Region)
+@key(M-W)
+@acttype(Preserve)
+@seeglobal(Kill Ring)
+@seedef(Region)
+@cmddoc
+Stick region into kill-ring without killing it.
+Like killing and getting back, but doesn't mark buffer modified.
+@end
+
+@fnc(count-occurrences-command)
+@cmd(Count Occurrences)
+@key(M-X Count Occurrences)
+@key(M-X How Many)
+@acttype(Inform)
+@cmddoc
+Counts occurrences of a string, after point.
+The user is prompted for the string.
+Case is ignored in the count.
+@end
+
+@fnc(delete-and-expunge-file-command)
+@cmd(Delete And Expunge File)
+@key(M-X Delete And Expunge File)
+@acttype(Remove)
+@topic(Files)
+@cmddoc
+This command prompts the user for the name of the file. NMODE will fill in
+defaults in a partly specified filename (eg filetype can be defaulted).
+If possible, the file will then be deleted and expunged, and a message
+to that effect will be displayed. If the operation fails, the bell will sound.
+@end
+
+@fnc(delete-backward-character-command)
+@cmd(Delete Backward Character)
+@key(BACKSPACE)
+@key(RUBOUT)
+@mode(Text)
+@acttype(Remove)
+@cmddoc
+Delete character before point.
+With positive arguments this operation is performed multiple times on the
+text before point.
+With negative arguments this operation is performed multiple times on
+the text after point.
+@end
+
+@fnc(delete-backward-hacking-tabs-command)
+@cmd(Delete Backward Hacking Tabs)
+@key(BACKSPACE)
+@key(C-RUBOUT)
+@mode(Lisp)
+@key(RUBOUT)
+@acttype(Remove)
+@cmddoc
+Delete character before point, turning tabs into spaces.
+Rather than deleting a whole tab, the tab is converted into the appropriate
+number of spaces and then one space is deleted.
+With positive arguments this operation is performed multiple times on the
+text before point.
+With negative arguments this operation is performed multiple times on
+the text after point.
+@end
+
+@fnc(delete-blank-lines-command)
+@cmd(Delete Blank Lines)
+@key(C-X C-O)
+@acttype(Remove)
+@cmddoc
+Delete all blank lines around this line's end.
+If done on a non-blank line, deletes all spaces and tabs
+at the end of it, and all following blank lines
+(Lines are blank if they contain only spaces and tabs).
+If done on a blank line, deletes all preceding blank lines as well.
+@end
+
+@fnc(delete-file-command)
+@cmd(Delete File)
+@key(M-X Delete File)
+@key(M-X Kill File)
+@acttype(Remove)
+@topic(Files)
+@cmddoc
+Delete a file. Prompts for filename.
+@end
+
+@fnc(delete-forward-character-command)
+@cmd(Delete Forward Character)
+@key(C-D)
+@key(ESC-P)
+@acttype(Remove)
+@seeglobal(Kill Ring)
+@cmddoc
+Delete character after point.
+With argument, kill that many characters (saving them).
+Negative args kill characters backward.
+@end
+
+@fnc(delete-horizontal-space-command)
+@cmd(Delete Horizontal Space)
+@key(M-\)
+@acttype(Remove)
+@cmddoc
+Delete all spaces and tabs around point.
+@end
+
+@fnc(delete-indentation-command)
+@cmd(Delete Indentation)
+@key(M-^)
+@acttype(Remove)
+@cmddoc
+Delete CRLF and indentation at front of line.
+Leaves one space in place of them. With argument,
+moves down one line first (deleting CRLF after current line).
+@end
+
+@fnc(delete-matching-lines-command)
+@cmd(Delete Matching Lines)
+@key(M-X Delete Matching Lines)
+@key(M-X Flush Lines)
+@acttype(Select)
+@acttype(Remove)
+@cmddoc
+Delete Matching Lines:
+Prompts user for string.
+Deletes all lines containing specified string.
+@end
+
+@fnc(delete-non-matching-lines-command)
+@cmd(Delete Non-Matching Lines)
+@key(M-X Delete Non-Matching Lines)
+@key(M-X Keep Lines)
+@acttype(Select)
+@acttype(Remove)
+@cmddoc
+Delete Non-Matching Lines:
+Prompts user for string.
+Deletes all lines not containing specified string.
+@end
+
+@fnc(dired-command)
+@cmd(Dired)
+@key(C-X D)
+@cmddoc
+Run Dired on the directory of the current buffer file.
+With no argument, edits that directory.
+With an argument of 1, shows only the versions of the file in the buffer.
+With an argument of 4, asks for input, only versions of that file are shown.
+@end
+
+@fnc(down-list-command)
+@cmd(Down List)
+@key(C-M-D)
+@acttype(Move Point)
+@mode(Lisp)
+@topic(Lisp)
+@cmddoc
+Move down one level of list structure, forward.
+In other words, move forward past the next open bracket, unless there
+is in an intervening close bracket.
+With a positive command argument, move forward down that many levels.
+With a negative command argument, move backward down that many levels.
+@end
+
+@fnc(edit-directory-command)
+@cmd(Edit Directory)
+@key(M-X Dired)
+@key(M-X Edit Directory)
+@cmddoc
+DIRED:
+Edit a directory.
+The string argument may contain the filespec (with wildcards of course)
+ D deletes the file which is on the current line. (also K,^D,^K)
+ U undeletes the current line file.
+ Rubout undeletes the previous line file.
+ Space is like ^N - moves down a line.
+ E edit the file.
+ S sorts files according to size, read or write date.
+ R does a reverse sort.
+ ? types a list of commands.
+ Q lists files to be deleted and asks for confirmation:
+ Typing YES deletes them; X aborts; N resumes DIRED.
+@end
+
+@fnc(end-of-defun-command)
+@cmd(End Of Defun)
+@key(C-M-E)
+@key(C-M-])
+@acttype(Move Point)
+@mode(Lisp)
+@topic(Lisp)
+@seedef(Defun)
+@cmddoc
+Move to end of this or next defun.
+With argument of 2, finds end of following defun.
+With argument of -1, finds end of previous defun, etc.
+@end
+
+@fnc(esc-prefix)
+@cmd(Esc Prefix)
+@key(ESCAPE)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+The command esc-prefix is an escape-prefix for more commands.
+It reads a character (subcommand) and dispatches on it.
+Used for escape sequences sent by function keys on the keyboard.
+@end
+
+@fnc(exchange-point-and-mark)
+@cmd(Exchange Point And Mark)
+@key(C-X C-X)
+@acttype(Mark)
+@acttype(Move Point)
+@cmddoc
+Exchange positions of point and mark.
+@end
+
+@fnc(exchange-windows-command)
+@cmd(Exchange Windows)
+@key(C-X E)
+@acttype(Alter Display Format)
+@cmddoc
+Exchanges the current window with the other window, which becomes current.
+In two window mode, the windows swap physical positions.
+@end
+
+@fnc(execute-buffer-command)
+@cmd(Execute Buffer)
+@key(M-X Execute Buffer)
+@topic(Buffers)
+@cmddoc
+This command makes NMODE take input from the specified buffer
+as if it were typed in.
+This command supercedes any such previous request.
+Newline characters are ignored when reading from a buffer.
+If a command argument is given then
+only the last refresh of the screen triggered by the commands
+actually occurs, otherwise all of the updating of the screen is visible.
+@end
+
+@fnc(execute-defun-command)
+@cmd(Execute Defun)
+@key(Lisp-D)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Mark)
+@seedef(Defun)
+@cmddoc
+Causes the Lisp reader to read and evaluate the current defun.
+If there is no current defin, the Lisp reader will read
+a form starting at the current location.
+We arrange for output to go to the end of the output buffer.
+The mark is set at
+the current location in the input buffer, in case user wants to
+go back.
+@end
+
+@fnc(execute-file-command)
+@cmd(Execute File)
+@key(M-X Execute File)
+@topic(Files)
+@cmddoc
+This command
+makes NMODE take input from the specified file as if it were typed in.
+This command supercedes any such previous request.
+Newline characters are ignored when reading from a buffer.
+If a command argument is given then
+only the last refresh of the screen triggered by the commands
+actually occurs, otherwise all of the updating of the screen is visible.
+@end
+
+@fnc(execute-form-command)
+@cmd(Execute Form)
+@key(Lisp-E)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Mark)
+@cmddoc
+Causes the Lisp reader to read and evaluate a form starting at the
+beginning of the current line.
+We arrange for output to go to the end of the output buffer.
+The mark is set at
+the current location in the input buffer, in case user wants to
+go back.
+@end
+
+@fnc(exit-nmode)
+@cmd(Exit Nmode)
+@key(Lisp-L)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Escape)
+@cmddoc
+Leave NMODE, return to normal listen loop.
+@end
+
+@fnc(fill-comment-command)
+@cmd(Fill Comment)
+@key(M-Z)
+@seeglobal(Fill Prefix)
+@seeglobal(Fill Column)
+@seedef(Paragraph)
+@acttype(Alter Existing Text)
+@cmddoc
+This command creates a temporary fill prefix from the start of
+the current line. It replaces the surrounding paragraph
+(determined using fill-prefix) with a filled version.
+It leaves point at the a position bearing the same relation to the
+filled text that the old point did to the old text.
+@end
+
+@fnc(fill-paragraph-command)
+@cmd(Fill Paragraph)
+@key(M-Q)
+@seeglobal(Fill Prefix)
+@seeglobal(Fill Column)
+@seedef(Paragraph)
+@topic(Text)
+@acttype(Alter Existing Text)
+@cmddoc
+This fills (or justifies) this (or next) paragraph.
+It leaves point at the a position bearing the same relation to the
+filled text that the old point did to the old text.
+A numeric argument triggers justification rather than filling.
+@end
+
+@fnc(fill-region-command)
+@cmd(Fill Region)
+@key(M-G)
+@acttype(Alter Existing Text)
+@seeglobal(Fill Prefix)
+@seeglobal(Fill Column)
+@seedef(Paragraph)
+@seedef(Sentence)
+@seecmd(Set Fill Column)
+@seecmd(Set Fill Prefix)
+@topic(Text)
+@cmddoc
+Fill text from point to mark.
+Fill Column specifies the desired text width.
+Fill Prefix if present is a string that goes
+at the front of each line and is not included in the filling.
+See Set Fill Column and Set Fill Prefix.
+An explicit argument causes justification instead of filling.
+Each sentence which ends within a line is followed by two spaces.
+@end
+
+@fnc(find-file-command)
+@cmd(Find File)
+@key(C-X C-F)
+@key(M-X Find File)
+@acttype(Move Data)
+@acttype(Move Point)
+@topic(Files)
+@topic(Buffers)
+@cmddoc
+Visit a file in its own buffer.
+If the file is already in some buffer, select that buffer.
+Otherwise, visit the file in a buffer named after the file.
+@end
+
+@fnc(forward-paragraph-command)
+@cmd(Forward Paragraph)
+@key(M-])
+@acttype(Move Point)
+@seedef(Paragraph)
+@topic(Text)
+@cmddoc
+Move forward to end of this or the next paragraph.
+When given argument moves forward (n>0) or backward (n<0) by |n| paragraphs
+where n is the command argument.
+@end
+
+@fnc(forward-sentence-command)
+@cmd(Forward Sentence)
+@key(M-E)
+@topic(Text)
+@acttype(Move Point)
+@seedef(Sentence)
+@cmddoc
+Move forward to end of this or the next sentence.
+When given argument moves forward (n>0) or backward (n<0) by |n| sentences.
+where n is the command argument.
+@end
+
+@fnc(forward-up-list-command)
+@cmd(Forward Up List)
+@key[C-)]
+@key[C-M-)]
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move up one level of list structure, forward.
+Given a command argument n move up |n| levels forward (n>0) or backward (n<0).
+@end
+
+@fnc(get-register-command)
+@cmd(Get Register)
+@key(C-X G)
+@acttype(Move Data)
+@acttype(Mark)
+@cmddoc
+Get contents of register (reads name from keyboard).
+The name is a single letter or digit.
+Usually leaves the pointer before, and the mark after, the text.
+With argument, puts point after and mark before.
+@end
+
+@fnc(grow-window-command)
+@cmd(Grow Window)
+@key(C-X ^)
+@acttype(Alter Display Format)
+@cmddoc
+Make this window use more lines.
+Argument is number of extra lines (can be negative).
+@end
+
+@fnc(help-dispatch)
+@cmd(Help Dispatch)
+@key(C-?)
+@key(M-/)
+@key(M-?)
+@acttype(Inform)
+@cmddoc
+Prints the documentation of a command (not a function).
+The command character is read from the terminal.
+@end
+
+@fnc(incremental-search-command)
+@cmd(Incremental Search)
+@key(C-S)
+@acttype(Move Point)
+@acttype(Select)
+@cmddoc
+Search for character string as you type it.
+C-Q quotes special characters. Rubout cancels last character.
+C-S repeats the search, forward, and C-R repeats it backward.
+C-R or C-S with search string empty changes the direction of search
+or brings back search string from previous search.
+Altmode exits the search.
+Other Control and Meta chars exit the search and then are executed.
+If not all the input string can be found, the rest is not discarded.
+You can rub it out, discard it all with C-G, exit,
+or use C-R or C-S to search the other way.
+Quitting a successful search aborts the search and moves point back;
+quitting a failing search just discards whatever input wasn't found.
+@end
+
+@fnc(indent-new-line-command)
+@cmd(Indent New line)
+@key(NEWLINE)
+@acttype(Insert Constant)
+@cmddoc
+This function performs the following actions:
+Executes whatever function, if any, is associated with <CR>.
+Executes whatever function, if any, is associated with TAB,
+as if no command argument was given.
+@end
+
+@fnc(indent-region-command)
+@cmd(Indent Region)
+@key(C-M-\)
+@mode(Text)
+@cmddoc
+Indent all lines between point and mark.
+With argument, indents each line to exactly that column.
+A line is processed if its first character is in the region.
+It tries to preserve the textual context of point and mark.
+@end
+
+@fnc(insert-buffer-command)
+@cmd(Insert Buffer)
+@key(M-X Insert Buffer)
+@acttype(Move Data)
+@topic(Buffers)
+@cmddoc
+Insert contents of another buffer into existing text.
+The user is prompted for the buffer name.
+Point is left just before the inserted material,
+and mark is left just after it.
+@end
+
+@fnc(insert-closing-bracket)
+@cmd(Insert Closing bracket)
+@key[)]
+@key(])
+@acttype(Insert Constant)
+@mode(Lisp)
+@topic(Lisp)
+@cmddoc
+Insert the character typed, which should be a closing bracket,
+then display the matching opening bracket.
+@end
+
+@fnc(insert-comment-command)
+@cmd(Insert Comment)
+@key(M-;)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Insert Constant)
+@cmddoc
+Move to the end of the current line, then add a "%" and a space at its end.
+Leave point after the space.
+@end
+
+@fnc(insert-date-command)
+@cmd(Insert Date)
+@key(M-X Insert Date)
+@acttype(Move Data)
+@cmddoc
+Insert the current time and date after point.
+The mark is put after the inserted text.
+@end
+
+@fnc(insert-file-command)
+@cmd(Insert File)
+@key(M-X Insert File)
+@topic(Files)
+@acttype(Move Data)
+@cmddoc
+Insert contents of file into existing text.
+File name is string argument.
+The pointer is left at the beginning, and the mark at the end.
+@end
+
+@fnc(insert-kill-buffer)
+@cmd(Insert Kill Buffer)
+@key(C-Y)
+@seeglobal(Kill Ring)
+@acttype(Move Data)
+@acttype(Mark)
+@cmddoc
+Re-insert the last stuff killed.
+Puts point after it and the mark before it.
+An argument n says un-kill the n'th most recent
+string of killed stuff (1 = most recent). A null
+argument (just C-U) means leave point before, mark after.
+@end
+
+@fnc(insert-next-character-command)
+@cmd(Insert Next Character)
+@key(C-Q)
+@acttype(Move Data)
+@cmddoc
+Reads a character and inserts it.
+@end
+
+@fnc(kill-backward-form-command)
+@cmd(Kill Backward Form)
+@key(C-M-RUBOUT)
+@mode(Lisp)
+@topic(Lisp)
+@seeglobal(Kill Ring)
+@acttype(Remove)
+@cmddoc
+Kill the last form.
+With a command argument kill the last (n>0) or next (n<0) |n| forms,
+where n is the command argument.
+@end
+
+@fnc(kill-backward-word-command)
+@cmd(Kill Backward Word)
+@key(M-RUBOUT)
+@acttype(Remove)
+@topic(Text)
+@seeglobal(Kill Ring)
+@cmddoc
+Kill last word.
+With a command argument kill the last (n>0) or next (n<0) |n| words,
+where n is the command argument.
+@end
+
+@fnc(kill-buffer-command)
+@cmd(Kill Buffer)
+@key(C-X K)
+@key(M-X Kill Buffer)
+@topic(Buffers)
+@acttype(Remove)
+@cmddoc
+Kill the buffer with specified name.
+The buffer name is taken from the keyboard.
+Name completion is performed by SPACE and RETURN.
+If the buffer has changes in it, the user is asked for confirmation.
+@end
+
+@fnc(kill-forward-form-command)
+@cmd(Kill Forward Form)
+@key(C-M-K)
+@mode(Lisp)
+@topic(Lisp)
+@seeglobal(Kill Ring)
+@acttype(Remove)
+@cmddoc
+Kill the next form.
+With a command argument kill the next (n>0) or last (n<0) |n| forms,
+where n is the command argument.
+@end
+
+@fnc(kill-forward-word-command)
+@cmd(Kill Forward Word)
+@key(M-D)
+@seeglobal(Kill Ring)
+@topic(Text)
+@acttype(Remove)
+@cmddoc
+Kill the next word.
+With a command argument kill the next (n>0) or last (n<0) |n| words,
+where n is the command argument.
+@end
+
+@fnc(kill-line)
+@cmd(Kill Line)
+@key(C-K)
+@key(ESC-M)
+@seeglobal(Kill Ring)
+@acttype(Remove)
+@cmddoc
+Kill to end of line, or kill an end of line.
+At the end of a line (only blanks following) kill through the CRLF.
+Otherwise, kill the rest of the line but not the CRLF.
+With argument (positive or negative), kill specified number of lines
+forward or backward respectively.
+An argument of zero means kill to the beginning of the
+ine, nothing if at the beginning.
+Killed text is pushed onto the kill ring for retrieval.
+@end
+
+@fnc(kill-region)
+@cmd(Kill Region)
+@key(C-W)
+@seeglobal(Kill Ring)
+@seedef(Region)
+@acttype(Remove)
+@cmddoc
+Kill from point to mark.
+Use Control-Y and Meta-Y to get it back.
+@end
+
+@fnc(kill-sentence-command)
+@cmd(Kill Sentence)
+@key(M-K)
+@seedef(Sentence)
+@seeglobal(Kill Ring)
+@topic(Text)
+@acttype(Remove)
+@cmddoc
+Kill forward to end of sentence.
+With minus one as an argument it kills back to the beginning of the sentence.
+Positive or negative arguments mean to kill that many sentences forward or
+backward respectively.
+@end
+
+@fnc(kill-some-buffers-command)
+@cmd(Kill Some Buffers)
+@key(M-X Kill Some Buffers)
+@acttype(Remove)
+@topic(Buffers)
+@cmddoc
+Kill Some Buffers:
+Offer to kill each buffer, one by one.
+If the buffer contains a modified file and you say to kill it,
+you are asked for confirmation.
+@end
+
+@fnc(lisp-abort-command)
+@cmd(Lisp Abort)
+@key(Lisp-A)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Escape)
+@cmddoc
+This command will pop out of an arbitrarily deep break loop.
+@end
+
+@fnc(lisp-backtrace-command)
+@cmd(Lisp Backtrace)
+@key(Lisp-B)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Inform)
+@cmddoc
+This lists all the function calls on the stack. It is a good way to
+see how the offending expression got generated.
+@end
+
+@fnc(lisp-continue-command)
+@cmd(Lisp Continue)
+@key(Lisp-C)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Escape)
+@cmddoc
+This causes the expression last printed to be returned as the value of the
+offending expression. This allows a user to recover from a low level error
+in an involved calculation if they know what should have been returned by the
+offending expression. This is also often useful as an automatic stub:
+If an expression containing an undefined function is evaluated, a Break loop is
+entered, and this may be used to return the value of the function call.
+@end
+
+@fnc(lisp-help-command)
+@cmd(Lisp Help)
+@key(Lisp-?)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Inform)
+@cmddoc
+If in break print:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+else print:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp Listener"
+@end
+
+@fnc(lisp-indent-region-command)
+@cmd(Lisp Indent Region)
+@key(C-M-\)
+@mode(Lisp)
+@topic(Lisp)
+@cmddoc
+Indent all lines between point and mark.
+With argument, indents each line to exactly that column.
+Otherwise, lisp indents each line.
+A line is processed if its first character is in the region.
+It tries to preserve the textual context of point and mark.
+@end
+
+@fnc(lisp-indent-sexpr)
+@cmd(Lisp Indent sexpr)
+@mode(Lisp)
+@topic(Lisp)
+@key(C-M-Q)
+@cmddoc
+Lisp Indent each line contained in the next form.
+This command does NOT respond to command arguments.
+@end
+
+@fnc(lisp-mode-command)
+@cmd(Lisp Mode)
+@key(M-X Lisp Mode)
+@acttype(Change Mode)
+@topic(Lisp)
+@cmddoc
+Set things up for editing Lisp code.
+Tab indents for Lisp.
+Rubout hacks tabs.
+Lisp execution commands availible.
+Paragraphs are delimited only by blank lines.
+@end
+
+@fnc(lisp-prefix)
+@cmd(Lisp Prefix)
+@key(C-])
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+The command lisp-prefix is an escape-prefix for more commands.
+It reads a character (subcommand) and dispatches on it.
+@end
+
+@fnc(lisp-quit-command)
+@cmd(Lisp Quit)
+@key(Lisp-Q)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Escape)
+@cmddoc
+This exits the current break loop. It only pops up one level, unlike abort.
+@end
+
+@fnc(lisp-retry-command)
+@cmd(Lisp Retry)
+@key(Lisp-R)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Escape)
+@cmddoc
+This tries to evaluate the offending expression again, and to continue the
+computation. This is often useful after defining a missing function,
+or assigning a value to a variable.
+@end
+
+@fnc(lisp-tab-command)
+@cmd(Lisp Tab)
+@key(C-M-I)
+@key(C-M-TAB)
+@mode(Lisp)
+@topic(Lisp)
+@key(TAB)
+@seecmd(Tab To Tab Stop)
+@acttype(Alter Existing Text)
+@cmddoc
+ Indent this line for a Lisp-like language.
+With arg, moves over and indents that many lines.
+With negative argument, indents preceding lines.
+ Note that the binding of TAB to this function holds only in Lisp mode.
+In text mode TAB is bound to the Tab To Tab Stop command and the other keys
+bound to this function are undefined.
+@end
+
+@fnc(lowercase-region-command)
+@cmd(Lowercase Region)
+@key(C-X C-L)
+@seedef(Region)
+@acttype(Alter Existing Text)
+@cmddoc
+Convert region to lower case.
+@end
+
+@fnc(lowercase-word-command)
+@cmd(Lowercase Word)
+@topic(Text)
+@key(M-L)
+@acttype(Alter Existing Text)
+@cmddoc
+Convert one word to lower case, moving past it.
+With arg, applies to that many words backward or forward.
+If backward, the cursor does not move.
+@end
+
+@fnc(m-x-prefix)
+@cmd(M-X Prefix)
+@key(C-M-X)
+@key(M-X)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+Read an extended command from the terminal with completion.
+Completion is performed by SPACE and RETURN.
+This command reads the name of an extended command, with completion,
+then executes that command.
+The command may itself prompt for input.
+@end
+
+@fnc(make-parens-command)
+@cmd(Make Parens)
+@key[M-(]
+@acttype(Insert Constant)
+@mode(Lisp)
+@topic(Lisp)
+@cmddoc
+Insert () putting point after the (.
+Also make a space before the (, if appropriate.
+With argument, put the ) after the specified number
+of already existing forms. Thus, with argument 1,
+puts extra parens around the following form.
+@end
+
+@fnc(mark-beginning-command)
+@cmd(Mark Beginning)
+@key(C-<)
+@acttype(Mark)
+@cmddoc
+Set mark at beginning of buffer.
+@end
+
+@fnc(mark-defun-command)
+@cmd(Mark Defun)
+@key(C-M-BACKSPACE)
+@key(C-M-H)
+@key(M-BACKSPACE)
+@acttype(Mark)
+@seedef(Defun)
+@mode(Lisp)
+@topic(Lisp)
+@cmddoc
+Put point and mark around this defun (or next).
+@end
+
+@fnc(mark-end-command)
+@cmd(Mark End)
+@key(C->)
+@acttype(Mark)
+@cmddoc
+Set mark at end of buffer.
+@end
+
+@fnc(mark-form-command)
+@cmd(Mark Form)
+@mode(Lisp)
+@topic(Lisp)
+@key(C-M-@)
+@acttype(Mark)
+@cmddoc
+Set mark after (n>0) or before (n<0) |n| forms from point
+where n is the command argument.
+@end
+
+@fnc(mark-paragraph-command)
+@cmd(Mark Paragraph)
+@key(M-H)
+@acttype(Mark)
+@topic(Text)
+@seedef(Paragraph)
+@acttype(Move Point)
+@cmddoc
+Put point and mark around this paragraph.
+In between paragraphs, puts it around the next one.
+@end
+
+@fnc(mark-whole-buffer-command)
+@cmd(Mark Whole Buffer)
+@key(C-X H)
+@acttype(Mark)
+@acttype(Move Point)
+@cmddoc
+Set point at beginning and mark at end of buffer.
+Pushes the old point on the mark first, so two pops restore it.
+@end
+
+@fnc(mark-word-command)
+@cmd(Mark Word)
+@key(M-@)
+@acttype(Mark)
+@topic(Text)
+@cmddoc
+Set mark after (n>0) or before (n<0) |n| words from point
+where n is the command argument.
+@end
+
+@fnc(move-backward-character-command)
+@cmd(Move Backward Character)
+@key(C-B)
+@key(ESC-D)
+@acttype(Move Point)
+@cmddoc
+Move back one character.
+With argument, move that many characters backward.
+Negative arguments move forward.
+@end
+
+@fnc(move-backward-defun-command)
+@cmd(Move Backward Defun)
+@key(C-M-A)
+@key(C-M-[)
+@seedef(Defun)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move to beginning of this or previous defun.
+With a negative argument, moves forward to the beginning of a defun.
+@end
+
+@fnc(move-backward-form-command)
+@cmd(Move Backward Form)
+@key(C-M-B)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move back one form.
+With argument, move that many forms backward.
+Negative arguments move forward.
+@end
+
+@fnc(move-backward-list-command)
+@cmd(Move Backward List)
+@key(C-M-P)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move back one list.
+With argument, move that many lists backward.
+Negative arguments move forward.
+@end
+
+@fnc(move-backward-word-command)
+@cmd(Move Backward Word)
+@key(ESC-4)
+@key(M-B)
+@topic(Text)
+@acttype(Move Point)
+@cmddoc
+Move back one word.
+With argument, move that many words backward.
+Negative arguments move forward.
+@end
+
+@fnc(move-down-command)
+@cmd(Move Down)
+@key(ESC-B)
+@acttype(Move Point)
+@seeglobal(Goal Column)
+@cmddoc
+Move point down a line.
+If a command argument n is given, move point down (n>0) or up (n<0)
+by |n| lines.
+@end
+
+@fnc(move-down-extending-command)
+@cmd(Move Down Extending)
+@key(C-N)
+@acttype(Move Point)
+@seeglobal(Goal Column)
+@cmddoc
+Move down vertically to next line.
+If given an argument moves down (n>0) or up (n<0) |n| lines where
+n is the command argument.
+If given without an argument after the
+last LF in the buffer, makes a new one at the end.
+@end
+
+@fnc(move-forward-character-command)
+@cmd(Move Forward Character)
+@key(C-F)
+@key(ESC-C)
+@acttype(Move Point)
+@cmddoc
+Move forward one character.
+With argument, move that many characters forward.
+Negative args move backward.
+@end
+
+@fnc(move-forward-form-command)
+@cmd(Move Forward Form)
+@key(C-M-F)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move forward one form.
+With argument, move that many forms forward.
+Negative args move backward.
+@end
+
+@fnc(move-forward-list-command)
+@cmd(Move Forward List)
+@key(C-M-N)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move forward one list.
+With argument, move that many lists forward.
+Negative args move backward.
+@end
+
+@fnc(move-forward-word-command)
+@cmd(Move Forward Word)
+@key(ESC-5)
+@key(M-F)
+@topic(Text)
+@acttype(Move Point)
+@cmddoc
+Move forward one word.
+With argument, move that many words forward.
+Negative args move backward.
+@end
+
+@fnc(move-over-paren-command)
+@cmd(Move Over Paren)
+@key[M-)]
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Point)
+@cmddoc
+Move forward past the next closing bracket. If a positive command
+argument is given, move forward past that many closing brackets.
+Delete all indentation before the first closing bracket passed.
+After the last closing bracket passed, insert an end-of-line and
+then indent the new line according to Lisp.
+@end
+
+@fnc(move-to-buffer-end-command)
+@cmd(Move To Buffer End)
+@key(ESC-F)
+@key(M->)
+@acttype(Move Point)
+@cmddoc
+Go to end of buffer (leaving mark behind).
+@end
+
+@fnc(move-to-buffer-start-command)
+@cmd(Move To Buffer Start)
+@key(ESC-H)
+@key(M-<)
+@acttype(Move Point)
+@cmddoc
+Go to beginning of buffer (leaving mark behind).
+@end
+
+@fnc(move-to-end-of-line-command)
+@cmd(Move To End Of Line)
+@key(C-E)
+@acttype(Move Point)
+@cmddoc
+Move point to end of line.
+With positive argument n goes down n-1 lines, then to the end of line.
+With zero argument goes up a line, then to line end.
+With negative argument n goes up |n|+1 lines, then to the end of line.
+@end
+
+@fnc(move-to-screen-edge-command)
+@cmd(Move To Screen Edge)
+@key(M-R)
+@acttype(Move Point)
+@cmddoc
+Jump to top or bottom of screen.
+Like Control-L except that point is changed instead of the window.
+With no argument, jumps to the center.
+An argument specifies the number of lines from the top,
+(negative args count from the bottom).
+@end
+
+@fnc(move-to-start-of-line-command)
+@cmd(Move To Start Of Line)
+@key(C-A)
+@acttype(Move Point)
+@cmddoc
+Move point to beginning of line.
+With positive argument n goes down n-1 lines, then to the beginning of line.
+With zero argument goes up a line, then to line beginning.
+With negative argument n goes up |n|+1 lines, then to the beginning of line.
+@end
+
+@fnc(move-up-command)
+@cmd(Move Up)
+@key(C-P)
+@key(ESC-A)
+@seeglobal(Goal Column)
+@acttype(Move Point)
+@cmddoc
+Move up vertically to next line.
+If given an argument moves up (n>0) or down (n<0) |n| lines where
+n is the command argument.
+@end
+
+@fnc(negative-argument)
+@cmd(Negative Argument)
+@key(C--)
+@key(C-M--)
+@key(M--)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+Make argument to next command negative.
+@end
+
+@fnc(next-screen-command)
+@cmd(Next Screen)
+@key(C-V)
+@acttype(Move Point)
+@cmddoc
+Move down to display next screenful of text.
+With argument, moves window down <arg> lines (negative moves up).
+Just minus as an argument moves up a full screen.
+@end
+
+@fnc(nmode-abort-command)
+@cmd(Nmode Abort)
+@key(C-G)
+@acttype(Escape)
+@cmddoc
+This command provides a way of aborting input requests.
+@end
+
+@fnc(nmode-exit-to-superior)
+@cmd(Nmode Exit To Superior)
+@key(C-X C-Z)
+@acttype(Escape)
+@cmddoc
+Go back to EMACS's superior job.
+@end
+
+@fnc(nmode-full-refresh)
+@cmd(Nmode Full Refresh)
+@key(ESC-J)
+@acttype(Alter Display Format)
+@cmddoc
+This function refreshes the screen after first clearing the
+display. It it used when the state of the display is in doubt.
+@end
+
+@fnc(nmode-gc)
+@cmd(Nmode Gc)
+@key(M-X Make Space)
+@cmddoc
+Reclaims any internal wasted space.
+@end
+
+@fnc(nmode-invert-video)
+@cmd(Nmode Invert Video)
+@key(C-X V)
+@acttype(Alter Display Format)
+@cmddoc
+Toggle between normal and inverse video.
+@end
+
+@fnc(nmode-refresh-command)
+@cmd(Nmode Refresh)
+@key(C-L)
+@acttype(Alter Display Format)
+@cmddoc
+Choose new window putting point at center, top or bottom.
+With no argument, chooses a window to put point at the center.
+An argument gives the line to put
+point on; negative args count from the bottom.
+@end
+
+@fnc(one-window-command)
+@cmd(One Window)
+@key(C-X 1)
+@acttype(Alter Display Format)
+@cmddoc
+Display only one window.
+Normally, we display what used to be in the top window,
+but a numeric argument says to display what was in the bottom one.
+@end
+
+@fnc(open-line-command)
+@cmd(Open Line)
+@key(C-O)
+@key(ESC-L)
+@acttype(Insert Constant)
+@cmddoc
+Insert a CRLF after point.
+Differs from ordinary insertion in that point remains
+before the inserted characters.
+With positive argument, inserts several CRLFs.
+With negative argument does nothing.
+@end
+
+@fnc(other-window-command)
+@cmd(Other Window)
+@key(C-X O)
+@acttype(Alter Display Format)
+@acttype(Move Point)
+@cmddoc
+Switch to the other window.
+In two-window mode, moves cursor to other window.
+In one-window mode, exchanges contents of visible window
+with remembered contents of (invisible) window two.
+An argument means switch windows but select the same
+buffer in the other window.
+@end
+
+@fnc(prepend-to-file-command)
+@cmd(Prepend To File)
+@topic(Files)
+@key(M-X Prepend To File)
+@seedef(Region)
+@acttype(Move Data)
+@cmddoc
+Append region to start of specified file.
+@end
+
+@fnc(previous-screen-command)
+@cmd(Previous Screen)
+@key(M-V)
+@acttype(Move Point)
+@cmddoc
+Move up to display previous screenful of text.
+When an argument is present, move the window back (n>0)
+or forward (n<0) |n| lines, where n is the command argument.
+@end
+
+@fnc(put-register-command)
+@cmd(Put Register)
+@key(C-X X)
+@acttype(Preserve)
+@cmddoc
+Put point to mark into register (reads name from keyboard).
+With an argument, the text is also deleted.
+@end
+
+@fnc(query-replace-command)
+@cmd(Query Replace)
+@key(M-%)
+@key(M-X Query Replace)
+@acttype(Alter Existing Text)
+@acttype(Select)
+@cmddoc
+Replace occurrences of a string from point to the
+end of the buffer, asking about each occurrence.
+Query Replace prompts for the string to be replaced and for its
+potential replacement.
+Query Replace displays each occurrence of the string to be replaced,
+you then type a character to say what to do.
+Space => replace it with the potential replacement and show the next copy.
+Rubout or Backspace => don't replace, but show next copy.
+Comma => replace this copy and show result, waiting for next command.
+^ => return to site of previous copy.
+C-L => redisplay screen.
+Exclamation mark => replace all remaining copys without asking.
+Period => replace this copy and exit.
+Escape => just exit.
+Anything else exits and is reread.
+@end
+
+@fnc(rename-buffer-command)
+@cmd(Rename Buffer)
+@key(M-X Rename Buffer)
+@topic(Buffers)
+@acttype(Set Global Variable)
+@cmddoc
+Change the name of the current buffer.
+The new name is read from the keyboard.
+If the user provides an empty string, the buffer name will be set to
+a truncated version of the filename associated with the buffer.
+The buffer name is automatically converted to upper case.
+An error is reported if the user provides the name of another existing
+buffer. The buffers MAIN and OUTPUT may not be renamed.
+@end
+
+@fnc(replace-string-command)
+@cmd(Replace String)
+@key(C-%)
+@key(M-X Replace String)
+@acttype(Alter Existing Text)
+@acttype(Select)
+@cmddoc
+Replace string with another from point to buffer end.
+@end
+
+@fnc(reposition-window-command)
+@cmd(Reposition Window)
+@key(C-M-R)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Alter Display Format)
+@cmddoc
+Reposition screen window appropriately.
+Tries to get all of current defun on screen.
+Never moves the pointer.
+@end
+
+@fnc(return-command)
+@cmd(Return)
+@key(RETURN)
+@acttype(Insert Constant)
+@cmddoc
+Insert CRLF, or move onto empty line.
+Repeated by positive argument.
+No action with negative argument.
+@end
+
+@fnc(reverse-search-command)
+@cmd(Reverse Search)
+@key(C-R)
+@acttype(Move Point)
+@acttype(Select)
+@seecmd(Incremental Search)
+@cmddoc
+Incremental Search Backwards.
+Like Control-S but in reverse.
+@end
+
+@fnc(revert-file-command)
+@cmd(Revert File)
+@topic(Files)
+@key(M-X Revert File)
+@acttype(Remove)
+@cmddoc
+Undo changes to a file.
+Reads back the file being edited from disk
+@end
+
+@fnc(save-all-files-command)
+@cmd(Save All Files)
+@key(M-X Save All Files)
+@topic(Buffers)
+@topic(Files)
+@acttype(Preserve)
+@cmddoc
+Offer to write back each buffer which may need it.
+For each buffer which is visiting a file and which
+has been modified, you are asked whether to save it.
+A numeric arg means don't ask; save everything.
+@end
+
+@fnc(save-file-command)
+@cmd(Save File)
+@key(C-X C-S)
+@topic(Files)
+@acttype(Preserve)
+@cmddoc
+Save visited file on disk if modified.
+@end
+
+@fnc(scroll-other-window-command)
+@cmd(Scroll Other Window)
+@key(C-M-V)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll other window up several lines.
+Specify the number as a numeric argument, negative for down.
+The default is a whole screenful up. Just Meta-Minus as argument
+means scroll a whole screenful down.
+@end
+
+@fnc(scroll-window-down-line-command)
+@cmd(Scroll Window Down Line)
+@key(ESC-T)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll the contents of the window down (n > 0) or up (n < 0) by |n| lines
+where n is the command argument.
+The "window position" may be adjusted to keep it within the window. Ding if
+the window contents does not move.
+@end
+
+@fnc(scroll-window-down-page-command)
+@cmd(Scroll Window Down Page)
+@key(ESC-V)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll the contents of the window down (n > 0) or up (n < 0) by |n| screenfuls
+where n is the command argument.
+The "window position" may be adjusted to keep it within the
+window. Ding if the window contents does not move.
+@end
+
+@fnc(scroll-window-left-command)
+@cmd(Scroll Window Left)
+@key(C-X <)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll the contents of the specified window right (n > 0) or left (n < 0)
+by |n| columns where n is the command argument.
+@end
+
+@fnc(scroll-window-right-command)
+@cmd(Scroll Window Right)
+@key(C-X >)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll the contents of the specified window left (n > 0) or right (n < 0)
+by |n| columns where n is the command argument.
+@end
+
+@fnc(scroll-window-up-line-command)
+@cmd(Scroll Window Up Line)
+@key(ESC-S)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines
+where n is the command argument.
+The "window position" may be adjusted to keep it within the window. Ding if
+the window contents does not move.
+@end
+
+@fnc(scroll-window-up-page-command)
+@cmd(Scroll Window Up Page)
+@key(ESC-U)
+@acttype(Alter Display Format)
+@cmddoc
+Scroll the contents of the window up (n > 0) or down (n < 0) by |n| screenfuls
+where n is the command argument.
+The "window position" may be adjusted to keep it within the
+window. Ding if the window contents does not move.
+@end
+
+@fnc(select-buffer-command)
+@cmd(Select Buffer)
+@key(C-X B)
+@key(M-X Select Buffer)
+@acttype(Move Point)
+@topic(Buffers)
+@cmddoc
+Select or create buffer with specified name.
+Buffer name is read from keyboard.
+Name completion is performed by SPACE and RETURN.
+@end
+
+@fnc(select-previous-buffer-command)
+@cmd(Select Previous Buffer)
+@key(C-M-L)
+@topic(Buffers)
+@acttype(Move Point)
+@cmddoc
+Select the previous buffer of the current buffer, if it exists and
+is selectable.
+Otherwise, select the MAIN buffer.
+@end
+
+@fnc(set-fill-column-command)
+@cmd(Set Fill Column)
+@seeglobal(Fill Column)
+@key(C-X F)
+@acttype(Set Global Variable)
+@cmddoc
+Set fill column to numeric arg or current column.
+If there is an argument, that is used.
+Otherwise, the current position of the cursor is used.
+The Fill Column variable controls where Auto Fill mode
+and the fill commands put the right margin.
+@end
+
+@fnc(set-fill-prefix-command)
+@cmd(Set Fill Prefix)
+@seeglobal(Fill Prefix)
+@key(C-X .)
+@acttype(Set Global Variable)
+@cmddoc
+Defines Fill Prefix from current line.
+All of the current line up to point becomes the value
+of Fill Prefix. Auto Fill Mode inserts the
+prefix on each line; the Fill Paragraph command assumes that each
+non-blank line starts with the prefix (which is ignored
+for filling purposes).
+To stop using a Fill Prefix, do Control-X .
+at the front of a line.
+@end
+
+@fnc(set-goal-column-command)
+@cmd(Set Goal Column)
+@key(C-X C-N)
+@acttype(Set Global Variable)
+@cmddoc
+Set (or flush) a permanent goal for vertical motion.
+With no argument, makes the current column the goal for vertical
+motion commands. They will always try to go to that column.
+With argument, clears out any previously set goal. Only
+Control-P and Control-N are affected.
+@end
+
+@fnc(set-key-command)
+@cmd(Set Key)
+@key(M-X Set Key)
+@acttype(Set Global Variable)
+@cmddoc
+Put a function on a key.
+The function name is a string argument.
+The key is always read from the terminal (not a string argument).
+It may contain metizers and other prefix characters.
+@end
+
+@fnc(set-mark-command)
+@cmd(Set Mark)
+@key(C-@)
+@key(C-SPACE)
+@acttype(Mark)
+@cmddoc
+Sets or pops the mark.
+With no ^U's, pushes point as the mark.
+With one ^U, pops the mark into point.
+With two ^U's, pops the mark and throws it away.
+@end
+
+@fnc(set-visited-filename-command)
+@cmd(Set Visited Filename)
+@key(M-X Set Visited Filename)
+@topic(Files)
+@acttype(Set Global Variable)
+@cmddoc
+Change visited filename, without writing or reading any file.
+The user is prompted for a filename.
+What NMODE believes to be the name
+of the visited file associated with the current buffer
+is set from the user's input.
+No file's name is actually changed.
+If possible, the new name will be adjusted to reflect an actual
+file name, as if the specified file were visited.
+@end
+
+@fnc(split-line-command)
+@cmd(Split Line)
+@key(C-M-O)
+@acttype(Insert Constant)
+@cmddoc
+Move rest of this line vertically down.
+Inserts a CRLF, and then enough tabs/spaces so that
+what had been the rest of the current line is indented as much as
+it had been. Point does not move, except to skip over indentation
+that originally followed it.
+With positive argument, makes extra blank lines in between.
+No action with negative argument.
+@end
+
+@fnc(start-scripting-command)
+@cmd(Start Scripting)
+@key(M-X Start Scripting)
+@acttype(Change Mode)
+@cmddoc
+This function prompts the user for a buffer name, into which it will copy
+all the user's commands (as well as executing them) until the
+stop-scripting-command is invoked.
+This command supercedes any such previous request.
+Note that to keep the lines of reasonable length,
+free Newlines will be inserted from time to time. Because of this, and
+because many file systems cannot represent stray Newlines, the Newline
+character is itself scripted as a CR followed by a TAB, since this is its
+normal definition. Someday, perhaps, this hack will be replaced by a better
+one.
+@end
+
+@fnc(start-timing-command)
+@cmd(Start Timing)
+@key(M-X Start Timing Nmode)
+@acttype(Change Mode)
+@cmddoc
+This cleans up a number of global variables associated with timing,
+prompts for a file in which to put the timing data (or defaults to a
+file named "timing", of type "txt"), and starts the timing. Information
+is collected on the total time, refresh time, read time, command execution
+time, total number of cons cells built, and total number of garbage collections
+performed.
+@end
+
+@fnc(stop-scripting-command)
+@cmd(Stop Scripting)
+@key(M-X Stop Scripting)
+@acttype(Change Mode)
+@cmddoc
+This command stops the echoing of user commands into a script buffer.
+This command is itself echoed before the creation of the script stops.
+@end
+
+@fnc(stop-timing-command)
+@cmd(Stop Timing)
+@key(M-X Stop Timing Nmode)
+@acttype(Change Mode)
+@cmddoc
+This stops the timing, formats the output data, and closes the file into
+which the timing information is going. Information is collected on the
+total time, refresh time, read time, command execution time, total number
+of cons cells built, and total number of garbage collections performed.
+In addition to these numbers, some ratios are printed.
+@end
+
+@fnc(tab-to-tab-stop-command)
+@cmd(Tab To Tab Stop)
+@key(M-I)
+@key(M-TAB)
+@key(TAB)
+@seecmd(Lisp Tab)
+@acttype(Insert Constant)
+@cmddoc
+Insert a tab character.
+Note that the binding of TAB to this command only holds in text mode,
+not in lisp mode, where it is bound to the Lisp Tab command.
+In lisp mode, the other keys continue to be bound to this command.
+@end
+
+@fnc(text-mode-command)
+@cmd(Text Mode)
+@key(M-X Text Mode)
+@topic(Text)
+@acttype(Change Mode)
+@cmddoc
+Set things up for editing English text.
+Tab inserts tab characters.
+There are no comments.
+Auto Fill does not indent new lines.
+@end
+
+@fnc(transpose-characters-command)
+@cmd(Transpose Characters)
+@key(C-T)
+@acttype(Alter Existing Text)
+@seecmd(Transpose Words)
+@cmddoc
+Transpose the characters before and after the cursor.
+For more details, see Meta-T, reading "character" for "word".
+However: at the end of a line, with no argument, the preceding
+two characters are transposed.
+@end
+
+@fnc(transpose-forms)
+@cmd(Transpose Forms)
+@key(C-M-T)
+@mode(Lisp)
+@topic(Lisp)
+@seecmd(Transpose Words)
+@acttype(Alter Existing Text)
+@cmddoc
+Transpose the forms before and after the cursor.
+For more details, see Meta-T, reading "Form" for "Word".
+@end
+
+@fnc(transpose-lines)
+@cmd(Transpose Lines)
+@key(C-X C-T)
+@seecmd(Transpose Words)
+@acttype(Alter Existing Text)
+@cmddoc
+Transpose the lines before and after the cursor.
+For more details, see Meta-T, reading "Line" for "Word".
+@end
+
+@fnc(transpose-regions)
+@cmd(Transpose Regions)
+@key(C-X T)
+@seedef(Region)
+@acttype(Alter Existing Text)
+@cmddoc
+Transpose regions defined by cursor and last 3 marks.
+To transpose two non-overlapping regions, set the mark successively at three
+of the four boundaries, put point at the fourth, and call this function.
+@end
+
+@fnc(transpose-words)
+@cmd(Transpose Words)
+@key(M-T)
+@topic(Text)
+@acttype(Alter Existing Text)
+@cmddoc
+Transpose the words before and after the cursor.
+With a positive argument it transposes the words before and
+after the cursor, moves right, and repeats the specified number of
+times, dragging the word to the left of the cursor right. With a
+negative argument, it transposes the two words to the left of
+the cursor, moves between them, and repeats the specified number of
+times, exactly undoing the positive argument form. With a zero
+argument, it transposes the words at point and mark.
+@end
+
+@fnc(two-windows-command)
+@cmd(Two Windows)
+@key(C-X 2)
+@acttype(Alter Display Format)
+@cmddoc
+Show two windows and select window two.
+An argument > 1 means give window 2 the same buffer as in Window 1.
+@end
+
+@fnc(undelete-file-command)
+@cmd(Undelete File)
+@key(M-X Undelete File)
+@acttype(Move Data)
+@acttype(Preserve)
+@topic(Files)
+@cmddoc
+This command prompts the user for the name of the file. NMODE will fill in
+a partly specified filename (eg filetype can be defaulted).
+If possible, the file will then be undeleted, and a message
+to that effect will be displayed. If the operation fails, the bell will sound.
+@end
+
+@fnc(universal-argument)
+@cmd(Universal Argument)
+@key(C-U)
+@acttype(Subsequent Command Modifier)
+@cmddoc
+Sets argument or multiplies it by four.
+Followed by digits, uses them to specify the
+argument for the command after the digits.
+If not followed by digits, multiplies the argument by four.
+@end
+
+@fnc(unkill-previous)
+@cmd(Unkill Previous)
+@seedef(Region)
+@seeglobal(Kill Ring)
+@key(M-Y)
+@acttype(Alter Existing Text)
+@cmddoc
+Delete (without saving away) the current region, and then unkill (yank) the
+specified entry in the kill ring. "Ding" if the current region does not
+contain the same text as the current entry in the kill ring.
+If one has just retrieved the top entry from the kill ring this has the
+effect of displaying the item just beneath it, then the item beneath that
+and so on until the original top entry rotates back into view.
+@end
+
+@fnc(upcase-digit-command)
+@cmd(Upcase Digit)
+@key(M-')
+@acttype(Alter Existing Text)
+@cmddoc
+Convert last digit to shifted character.
+Looks on current line back from point, and previous line.
+The first time you use this command, it asks you to type
+the row of digits from 1 to 9 and then 0, holding down Shift,
+to determine how your keyboard is set up.
+@end
+
+@fnc(uppercase-initial-command)
+@cmd(Uppercase Initial)
+@key(M-C)
+@topic(Text)
+@acttype(Alter Existing Text)
+@cmddoc
+Put next word in lower case, but capitalize initial.
+With arg, applies to that many words backward or forward.
+If backward, the cursor does not move.
+@end
+
+@fnc(uppercase-region-command)
+@cmd(Uppercase Region)
+@key(C-X C-U)
+@seedef(Region)
+@acttype(Alter Existing Text)
+@cmddoc
+Convert region to upper case.
+@end
+
+@fnc(uppercase-word-command)
+@cmd(Uppercase Word)
+@key(M-U)
+@topic(Text)
+@acttype(Alter Existing Text)
+@cmddoc
+Convert one word to upper case, moving past it.
+With arg, applies to that many words backward or forward.
+If backward, the cursor does not move.
+@end
+
+@fnc(view-two-windows-command)
+@cmd(View Two Windows)
+@key(C-X 3)
+@acttype(Alter Display Format)
+@cmddoc
+Show two windows but stay in first.
+@end
+
+@fnc(visit-file-command)
+@cmd(Visit File)
+@key(C-X C-V)
+@topic(Files)
+@key(M-X Visit File)
+@acttype(Move Data)
+@acttype(Move Point)
+@cmddoc
+Visit new file in current buffer.
+The user is prompted for the filename.
+If the current buffer is modified, the user is asked whether to write it out.
+@end
+
+@fnc(visit-in-other-window-command)
+@cmd(Visit In Other Window)
+@key(C-X 4)
+@acttype(Move Point)
+@acttype(Alter Display Format)
+@topic(Files)
+@topic(Buffers)
+@cmddoc
+Find buffer or file in other window.
+Follow this command by B and a buffer name, or by
+F and a file name.
+We find the buffer or file in the other window,
+creating the other window if necessary.
+@end
+
+@fnc(what-cursor-position-command)
+@cmd(What Cursor Position)
+@key(C-=)
+@key(C-X =)
+@acttype(Inform)
+@cmddoc
+Print various things about where cursor is.
+Print the X position, the Y position,
+the octal code for the following character,
+point absolutely and as a percentage of the total file size,
+and the virtual boundaries, if any.
+If a positive argument is given point will jump to the line number
+specified by the argument.
+A negative argument triggers a jump to the first line in the buffer.
+@end
+
+@fnc(write-file-command)
+@cmd(Write File)
+@key(C-X C-W)
+@key(M-X Write File)
+@topic(Files)
+@acttype(Preserve)
+@cmddoc
+Prompts for file name.
+Stores the current buffer in specified file.
+This file becomes the one being visited.
+@end
+
+@fnc(write-region-command)
+@cmd(Write Region)
+@key(M-X Write Region)
+@seedef(Region)
+@topic(Files)
+@acttype(Preserve)
+@cmddoc
+Write region to file.
+Prompts for file name.
+@end
+
+@fnc(write-screen-command)
+@cmd(Write Screen)
+@key(C-X P)
+@topic(Files)
+@acttype(Preserve)
+@cmddoc
+Ask for filename, write out the screen to the file.
+@end
+
+@fnc(yank-last-output-command)
+@cmd(Yank Last Output)
+@key(Lisp-Y)
+@mode(Lisp)
+@topic(Lisp)
+@acttype(Move Data)
+@cmddoc
+Insert "last output" typed in the OUTPUT buffer.
+@end
ADDED psl-1983/3-1/doc/nmode/costly.sl
Index: psl-1983/3-1/doc/nmode/costly.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/costly.sl
@@ -0,0 +1,648 @@
+(SETQ DOC-OBJ-LIST (LIST (SETQ DOC1 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Alter Display Format") (QUOTE TYPE) (QUOTE ACTION) (
+QUOTE INDEX) (QUOTE 1) (QUOTE START-LINE) (QUOTE 1) (QUOTE END-LINE) (QUOTE
+6) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC2 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Alter Existing Text") (QUOTE TYPE) (
+QUOTE ACTION) (QUOTE INDEX) (QUOTE 2) (QUOTE START-LINE) (QUOTE 7) (QUOTE
+END-LINE) (QUOTE 12) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC3 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Change Mode") (
+QUOTE TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 3) (QUOTE START-LINE) (QUOTE
+13) (QUOTE END-LINE) (QUOTE 18) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC4 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Escape") (QUOTE
+TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 4) (QUOTE START-LINE) (QUOTE
+19) (QUOTE END-LINE) (QUOTE 23) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC5 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Inform") (QUOTE
+TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 5) (QUOTE START-LINE) (QUOTE
+24) (QUOTE END-LINE) (QUOTE 30) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC6 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Insert Constant") (
+QUOTE TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 6) (QUOTE START-LINE) (QUOTE
+31) (QUOTE END-LINE) (QUOTE 36) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC7 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Mark") (QUOTE TYPE) (
+QUOTE ACTION) (QUOTE INDEX) (QUOTE 7) (QUOTE START-LINE) (QUOTE 37) (QUOTE
+END-LINE) (QUOTE 41) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC8 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Data") (QUOTE
+TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 8) (QUOTE START-LINE) (QUOTE
+42) (QUOTE END-LINE) (QUOTE 47) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC9 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Point") (
+QUOTE TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 9) (QUOTE START-LINE) (QUOTE
+48) (QUOTE END-LINE) (QUOTE 53) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC10 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Preserve") (QUOTE
+TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 10) (QUOTE START-LINE) (QUOTE
+54) (QUOTE END-LINE) (QUOTE 58) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC11 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Remove") (QUOTE
+TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 11) (QUOTE START-LINE) (QUOTE
+59) (QUOTE END-LINE) (QUOTE 64) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC12 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Select") (QUOTE
+TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 12) (QUOTE START-LINE) (QUOTE
+65) (QUOTE END-LINE) (QUOTE 70) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC13 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Set Global Variable")
+(QUOTE TYPE) (QUOTE ACTION) (QUOTE INDEX) (QUOTE 13) (QUOTE START-LINE) (
+QUOTE 71) (QUOTE END-LINE) (QUOTE 76) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ
+DOC14 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Subsequent Command Modifier") (QUOTE TYPE) (QUOTE ACTION) (QUOTE INDEX) (
+QUOTE 14) (QUOTE START-LINE) (QUOTE 77) (QUOTE END-LINE) (QUOTE 82) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC15 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Defun") (QUOTE TYPE) (QUOTE DEFINITION) (QUOTE INDEX) (
+QUOTE 15) (QUOTE START-LINE) (QUOTE 83) (QUOTE END-LINE) (QUOTE 88) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC16 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Paragraph") (QUOTE TYPE) (QUOTE DEFINITION) (QUOTE INDEX) (
+QUOTE 16) (QUOTE START-LINE) (QUOTE 89) (QUOTE END-LINE) (QUOTE 98) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC17 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Region") (QUOTE TYPE) (QUOTE DEFINITION) (QUOTE INDEX) (
+QUOTE 17) (QUOTE START-LINE) (QUOTE 99) (QUOTE END-LINE) (QUOTE 104) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC18 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Sentence") (QUOTE TYPE) (QUOTE DEFINITION) (QUOTE INDEX) (
+QUOTE 18) (QUOTE START-LINE) (QUOTE 105) (QUOTE END-LINE) (QUOTE 112) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC19 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Fill Column") (QUOTE TYPE) (QUOTE GLOBAL) (QUOTE INDEX) (
+QUOTE 19) (QUOTE START-LINE) (QUOTE 113) (QUOTE END-LINE) (QUOTE 119) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC20 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Fill Prefix") (QUOTE TYPE) (QUOTE GLOBAL) (QUOTE INDEX) (
+QUOTE 20) (QUOTE START-LINE) (QUOTE 120) (QUOTE END-LINE) (QUOTE 128) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC21 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Goal Column") (QUOTE TYPE) (QUOTE GLOBAL) (QUOTE INDEX) (
+QUOTE 21) (QUOTE START-LINE) (QUOTE 129) (QUOTE END-LINE) (QUOTE 133) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC22 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Kill Ring") (QUOTE TYPE) (QUOTE GLOBAL) (QUOTE INDEX) (
+QUOTE 22) (QUOTE START-LINE) (QUOTE 134) (QUOTE END-LINE) (QUOTE 152) (QUOTE
+REF-LIST) (QUOTE NIL))) (SETQ DOC23 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Append Next Kill") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 23) (QUOTE START-LINE) (QUOTE 153) (QUOTE END-LINE) (QUOTE
+164) (QUOTE REF-LIST) (QUOTE (DOC8 DOC22)))) (SETQ DOC24 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Append To Buffer") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 24) (QUOTE START-LINE) (QUOTE 165) (
+QUOTE END-LINE) (QUOTE 178) (QUOTE REF-LIST) (QUOTE (DOC8 DOC17 DOC197)))) (
+SETQ DOC25 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Append To File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 25) (
+QUOTE START-LINE) (QUOTE 179) (QUOTE END-LINE) (QUOTE 189) (QUOTE REF-LIST) (
+QUOTE (DOC8 DOC17 DOC196)))) (SETQ DOC26 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Apropos") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 26) (QUOTE START-LINE) (QUOTE 190) (QUOTE END-LINE) (
+QUOTE 199) (QUOTE REF-LIST) (QUOTE (DOC5)))) (SETQ DOC27 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Argument Digit") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 27) (QUOTE START-LINE) (QUOTE 200) (
+QUOTE END-LINE) (QUOTE 238) (QUOTE REF-LIST) (QUOTE (DOC14)))) (SETQ DOC28 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Auto Fill Mode") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 28) (QUOTE START-LINE) (
+QUOTE 239) (QUOTE END-LINE) (QUOTE 252) (QUOTE REF-LIST) (QUOTE (DOC3 DOC159))))
+(SETQ DOC29 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Back To Indentation") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+29) (QUOTE START-LINE) (QUOTE 253) (QUOTE END-LINE) (QUOTE 264) (QUOTE
+REF-LIST) (QUOTE (DOC9)))) (SETQ DOC30 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Backward Kill Sentence") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 30) (QUOTE START-LINE) (QUOTE 265) (QUOTE END-LINE) (
+QUOTE 276) (QUOTE REF-LIST) (QUOTE (DOC11 DOC18 DOC22)))) (SETQ DOC31 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Backward Paragraph") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 31) (QUOTE START-LINE) (
+QUOTE 277) (QUOTE END-LINE) (QUOTE 287) (QUOTE REF-LIST) (QUOTE (DOC9 DOC16))))
+(SETQ DOC32 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Backward Sentence") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+32) (QUOTE START-LINE) (QUOTE 288) (QUOTE END-LINE) (QUOTE 298) (QUOTE
+REF-LIST) (QUOTE (DOC9 DOC18)))) (SETQ DOC33 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Backward Up List") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 33) (QUOTE START-LINE) (QUOTE 299) (QUOTE
+END-LINE) (QUOTE 312) (QUOTE REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (SETQ
+DOC34 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Buffer Browser") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 34) (
+QUOTE START-LINE) (QUOTE 313) (QUOTE END-LINE) (QUOTE 324) (QUOTE REF-LIST) (
+QUOTE (DOC5 DOC197)))) (SETQ DOC35 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Buffer Not Modified") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 35) (QUOTE START-LINE) (QUOTE 325) (QUOTE END-LINE) (
+QUOTE 334) (QUOTE REF-LIST) (QUOTE (DOC13 DOC197)))) (SETQ DOC36 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "C-X Prefix") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 36) (QUOTE START-LINE) (
+QUOTE 335) (QUOTE END-LINE) (QUOTE 344) (QUOTE REF-LIST) (QUOTE (DOC14)))) (
+SETQ DOC37 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Center Line") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 37) (QUOTE
+START-LINE) (QUOTE 345) (QUOTE END-LINE) (QUOTE 357) (QUOTE REF-LIST) (QUOTE (
+DOC2 DOC19 DOC193)))) (SETQ DOC38 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Copy Region") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 38) (QUOTE START-LINE) (QUOTE 358) (QUOTE END-LINE) (QUOTE 369) (QUOTE
+REF-LIST) (QUOTE (DOC10 DOC17 DOC22)))) (SETQ DOC39 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Count Occurrences") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 39) (QUOTE START-LINE) (QUOTE 370) (QUOTE
+END-LINE) (QUOTE 380) (QUOTE REF-LIST) (QUOTE (DOC5)))) (SETQ DOC40 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Delete And Expunge File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+40) (QUOTE START-LINE) (QUOTE 381) (QUOTE END-LINE) (QUOTE 393) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC196)))) (SETQ DOC41 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Delete Backward Hacking Tabs") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 41) (QUOTE START-LINE) (QUOTE
+394) (QUOTE END-LINE) (QUOTE 409) (QUOTE REF-LIST) (QUOTE (DOC11 DOC195)))) (
+SETQ DOC42 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Delete Blank Lines") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+42) (QUOTE START-LINE) (QUOTE 410) (QUOTE END-LINE) (QUOTE 421) (QUOTE
+REF-LIST) (QUOTE (DOC11)))) (SETQ DOC43 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Delete File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 43) (QUOTE START-LINE) (QUOTE 422) (QUOTE END-LINE) (QUOTE 432) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC196)))) (SETQ DOC44 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Delete Forward Character") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 44) (QUOTE START-LINE) (QUOTE 433) (
+QUOTE END-LINE) (QUOTE 444) (QUOTE REF-LIST) (QUOTE (DOC11 DOC22)))) (SETQ
+DOC45 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Delete Horizontal Space") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+45) (QUOTE START-LINE) (QUOTE 445) (QUOTE END-LINE) (QUOTE 453) (QUOTE
+REF-LIST) (QUOTE (DOC11)))) (SETQ DOC46 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Delete Indentation") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 46) (QUOTE START-LINE) (QUOTE 454) (QUOTE END-LINE) (QUOTE
+464) (QUOTE REF-LIST) (QUOTE (DOC11)))) (SETQ DOC47 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Delete Matching Lines") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 47) (QUOTE START-LINE) (QUOTE 465) (
+QUOTE END-LINE) (QUOTE 476) (QUOTE REF-LIST) (QUOTE (DOC11 DOC12)))) (SETQ
+DOC48 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Delete Non-Matching Lines") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 48) (QUOTE START-LINE) (QUOTE 477) (QUOTE END-LINE) (QUOTE 488) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC12)))) (SETQ DOC49 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Dired") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 49) (QUOTE START-LINE) (QUOTE 489) (QUOTE END-LINE) (
+QUOTE 499) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ DOC50 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Down List") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 50) (QUOTE START-LINE) (QUOTE 500) (QUOTE END-LINE) (
+QUOTE 511) (QUOTE REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (SETQ DOC51 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Edit Directory") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 51) (QUOTE START-LINE) (
+QUOTE 512) (QUOTE END-LINE) (QUOTE 531) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ
+DOC52 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "End Of Defun")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 52) (QUOTE START-LINE) (
+QUOTE 532) (QUOTE END-LINE) (QUOTE 545) (QUOTE REF-LIST) (QUOTE (DOC9 DOC15
+DOC194 DOC195)))) (SETQ DOC53 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Esc Prefix") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+53) (QUOTE START-LINE) (QUOTE 546) (QUOTE END-LINE) (QUOTE 556) (QUOTE
+REF-LIST) (QUOTE (DOC14)))) (SETQ DOC54 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Exchange Point And Mark") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 54) (QUOTE START-LINE) (QUOTE 557) (QUOTE END-LINE) (
+QUOTE 566) (QUOTE REF-LIST) (QUOTE (DOC9 DOC7)))) (SETQ DOC55 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Exchange Windows") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 55) (QUOTE START-LINE) (QUOTE 567) (
+QUOTE END-LINE) (QUOTE 576) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC56 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Execute Buffer") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 56) (QUOTE START-LINE) (
+QUOTE 577) (QUOTE END-LINE) (QUOTE 589) (QUOTE REF-LIST) (QUOTE (DOC197)))) (
+SETQ DOC57 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Execute File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 57) (QUOTE
+START-LINE) (QUOTE 590) (QUOTE END-LINE) (QUOTE 602) (QUOTE REF-LIST) (QUOTE (
+DOC196)))) (SETQ DOC58 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Execute Form") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+58) (QUOTE START-LINE) (QUOTE 603) (QUOTE END-LINE) (QUOTE 616) (QUOTE
+REF-LIST) (QUOTE (DOC7 DOC194 DOC195)))) (SETQ DOC59 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Exit Nmode") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 59) (QUOTE START-LINE) (QUOTE 617) (QUOTE
+END-LINE) (QUOTE 627) (QUOTE REF-LIST) (QUOTE (DOC4 DOC194 DOC195)))) (SETQ
+DOC60 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Fill Comment")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 60) (QUOTE START-LINE) (
+QUOTE 628) (QUOTE END-LINE) (QUOTE 642) (QUOTE REF-LIST) (QUOTE (DOC2 DOC16
+DOC19 DOC20)))) (SETQ DOC61 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Fill Paragraph") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 61) (QUOTE START-LINE) (QUOTE 643) (QUOTE END-LINE) (QUOTE 657) (QUOTE
+REF-LIST) (QUOTE (DOC2 DOC16 DOC19 DOC20 DOC193)))) (SETQ DOC62 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Fill Region") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 62) (QUOTE START-LINE) (
+QUOTE 658) (QUOTE END-LINE) (QUOTE 677) (QUOTE REF-LIST) (QUOTE (DOC2 DOC18
+DOC16 DOC19 DOC20 DOC160 DOC159 DOC193)))) (SETQ DOC63 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Find File") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 63) (QUOTE START-LINE) (QUOTE 678) (QUOTE END-LINE) (
+QUOTE 691) (QUOTE REF-LIST) (QUOTE (DOC9 DOC8 DOC197 DOC196)))) (SETQ DOC64 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Forward Paragraph") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 64) (QUOTE START-LINE) (
+QUOTE 692) (QUOTE END-LINE) (QUOTE 704) (QUOTE REF-LIST) (QUOTE (DOC9 DOC16
+DOC193)))) (SETQ DOC65 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Forward Sentence") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+65) (QUOTE START-LINE) (QUOTE 705) (QUOTE END-LINE) (QUOTE 717) (QUOTE
+REF-LIST) (QUOTE (DOC9 DOC18 DOC193)))) (SETQ DOC66 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Forward Up List") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 66) (QUOTE START-LINE) (QUOTE 718) (QUOTE
+END-LINE) (QUOTE 730) (QUOTE REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (SETQ
+DOC67 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Get Register")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 67) (QUOTE START-LINE) (
+QUOTE 731) (QUOTE END-LINE) (QUOTE 742) (QUOTE REF-LIST) (QUOTE (DOC7 DOC8)))) (
+SETQ DOC68 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Grow Window") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 68) (QUOTE
+START-LINE) (QUOTE 743) (QUOTE END-LINE) (QUOTE 752) (QUOTE REF-LIST) (QUOTE (
+DOC1)))) (SETQ DOC69 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Help Dispatch") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+69) (QUOTE START-LINE) (QUOTE 753) (QUOTE END-LINE) (QUOTE 764) (QUOTE
+REF-LIST) (QUOTE (DOC5)))) (SETQ DOC70 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Incremental Search") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 70) (QUOTE START-LINE) (QUOTE 765) (QUOTE END-LINE) (QUOTE
+782) (QUOTE REF-LIST) (QUOTE (DOC12 DOC9)))) (SETQ DOC71 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Indent New line") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 71) (QUOTE START-LINE) (QUOTE 783) (
+QUOTE END-LINE) (QUOTE 793) (QUOTE REF-LIST) (QUOTE (DOC6)))) (SETQ DOC72 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Insert Buffer") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 72) (QUOTE START-LINE) (
+QUOTE 794) (QUOTE END-LINE) (QUOTE 805) (QUOTE REF-LIST) (QUOTE (DOC8 DOC197))))
+(SETQ DOC73 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Insert Closing bracket") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+73) (QUOTE START-LINE) (QUOTE 806) (QUOTE END-LINE) (QUOTE 818) (QUOTE
+REF-LIST) (QUOTE (DOC6 DOC194 DOC195)))) (SETQ DOC74 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Insert Comment") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 74) (QUOTE START-LINE) (QUOTE 819) (QUOTE
+END-LINE) (QUOTE 830) (QUOTE REF-LIST) (QUOTE (DOC6 DOC194 DOC195)))) (SETQ
+DOC75 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Insert Date") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 75) (QUOTE START-LINE) (
+QUOTE 831) (QUOTE END-LINE) (QUOTE 840) (QUOTE REF-LIST) (QUOTE (DOC8)))) (
+SETQ DOC76 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Insert File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 76) (QUOTE
+START-LINE) (QUOTE 841) (QUOTE END-LINE) (QUOTE 851) (QUOTE REF-LIST) (QUOTE (
+DOC8 DOC196)))) (SETQ DOC77 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Insert Kill Buffer") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 77) (QUOTE START-LINE) (QUOTE 852) (QUOTE END-LINE) (QUOTE 864) (QUOTE
+REF-LIST) (QUOTE (DOC7 DOC8 DOC22)))) (SETQ DOC78 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Insert Next Character") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 78) (QUOTE START-LINE) (QUOTE 865) (
+QUOTE END-LINE) (QUOTE 873) (QUOTE REF-LIST) (QUOTE (DOC8)))) (SETQ DOC79 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Insert Parens") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 79) (QUOTE START-LINE) (
+QUOTE 874) (QUOTE END-LINE) (QUOTE 887) (QUOTE REF-LIST) (QUOTE (DOC6 DOC194
+DOC195)))) (SETQ DOC80 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Kill Backward Form") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 80) (QUOTE START-LINE) (QUOTE 888) (QUOTE END-LINE) (QUOTE 900) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC22 DOC194 DOC195)))) (SETQ DOC81 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Kill Backward Word") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 81) (QUOTE START-LINE) (QUOTE 901) (
+QUOTE END-LINE) (QUOTE 912) (QUOTE REF-LIST) (QUOTE (DOC11 DOC22 DOC193)))) (
+SETQ DOC82 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Kill Buffer") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 82) (QUOTE
+START-LINE) (QUOTE 913) (QUOTE END-LINE) (QUOTE 925) (QUOTE REF-LIST) (QUOTE (
+DOC11 DOC197)))) (SETQ DOC83 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Kill Forward Form") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 83) (QUOTE START-LINE) (QUOTE 926) (QUOTE END-LINE) (QUOTE 938) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC22 DOC194 DOC195)))) (SETQ DOC84 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Kill Forward Word") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 84) (QUOTE START-LINE) (QUOTE 939) (
+QUOTE END-LINE) (QUOTE 950) (QUOTE REF-LIST) (QUOTE (DOC11 DOC22 DOC193)))) (
+SETQ DOC85 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Kill Line") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 85) (QUOTE
+START-LINE) (QUOTE 951) (QUOTE END-LINE) (QUOTE 966) (QUOTE REF-LIST) (QUOTE (
+DOC11 DOC22)))) (SETQ DOC86 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Kill Region") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 86) (QUOTE START-LINE) (QUOTE 967) (QUOTE END-LINE) (QUOTE 977) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC17 DOC22)))) (SETQ DOC87 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Kill Sentence") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 87) (QUOTE START-LINE) (QUOTE 978) (QUOTE
+END-LINE) (QUOTE 991) (QUOTE REF-LIST) (QUOTE (DOC11 DOC18 DOC22 DOC193)))) (
+SETQ DOC88 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Kill Some Buffers") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+88) (QUOTE START-LINE) (QUOTE 992) (QUOTE END-LINE) (QUOTE 1002) (QUOTE
+REF-LIST) (QUOTE (DOC11 DOC197)))) (SETQ DOC89 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Abort") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 89) (QUOTE START-LINE) (QUOTE 1003) (QUOTE
+END-LINE) (QUOTE 1013) (QUOTE REF-LIST) (QUOTE (DOC4 DOC194 DOC195)))) (SETQ
+DOC90 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Lisp Backtrace") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 90) (
+QUOTE START-LINE) (QUOTE 1014) (QUOTE END-LINE) (QUOTE 1025) (QUOTE REF-LIST) (
+QUOTE (DOC5 DOC194 DOC195)))) (SETQ DOC91 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Continue") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 91) (QUOTE START-LINE) (QUOTE 1026) (QUOTE
+END-LINE) (QUOTE 1041) (QUOTE REF-LIST) (QUOTE (DOC4 DOC194 DOC195)))) (SETQ
+DOC92 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Help") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 92) (QUOTE START-LINE) (
+QUOTE 1042) (QUOTE END-LINE) (QUOTE 1055) (QUOTE REF-LIST) (QUOTE (DOC5
+DOC194 DOC195)))) (SETQ DOC93 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Lisp Indent Region") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 93) (QUOTE START-LINE) (QUOTE 1056) (QUOTE END-LINE) (QUOTE 1068) (
+QUOTE REF-LIST) (QUOTE (DOC194 DOC195)))) (SETQ DOC94 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Indent sexpr") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 94) (QUOTE START-LINE) (QUOTE 1069) (QUOTE
+END-LINE) (QUOTE 1079) (QUOTE REF-LIST) (QUOTE (DOC194 DOC195)))) (SETQ
+DOC95 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Mode") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 95) (QUOTE START-LINE) (
+QUOTE 1080) (QUOTE END-LINE) (QUOTE 1091) (QUOTE REF-LIST) (QUOTE (DOC3
+DOC194)))) (SETQ DOC96 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Lisp Prefix") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+96) (QUOTE START-LINE) (QUOTE 1092) (QUOTE END-LINE) (QUOTE 1103) (QUOTE
+REF-LIST) (QUOTE (DOC14 DOC194 DOC195)))) (SETQ DOC97 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Quit") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 97) (QUOTE START-LINE) (QUOTE 1104) (QUOTE END-LINE) (
+QUOTE 1114) (QUOTE REF-LIST) (QUOTE (DOC4 DOC194 DOC195)))) (SETQ DOC98 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lisp Retry") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 98) (QUOTE START-LINE) (
+QUOTE 1115) (QUOTE END-LINE) (QUOTE 1127) (QUOTE REF-LIST) (QUOTE (DOC4
+DOC194 DOC195)))) (SETQ DOC99 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Lisp Tab") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+99) (QUOTE START-LINE) (QUOTE 1128) (QUOTE END-LINE) (QUOTE 1145) (QUOTE
+REF-LIST) (QUOTE (DOC2 DOC170 DOC194 DOC195)))) (SETQ DOC100 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Lowercase Region") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 100) (QUOTE START-LINE) (QUOTE 1146) (
+QUOTE END-LINE) (QUOTE 1155) (QUOTE REF-LIST) (QUOTE (DOC2 DOC17)))) (SETQ
+DOC101 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Lowercase Word") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 101) (
+QUOTE START-LINE) (QUOTE 1156) (QUOTE END-LINE) (QUOTE 1166) (QUOTE REF-LIST) (
+QUOTE (DOC2 DOC193)))) (SETQ DOC102 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "M-X Prefix") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 102) (QUOTE START-LINE) (QUOTE 1167) (QUOTE END-LINE) (QUOTE 1179) (
+QUOTE REF-LIST) (QUOTE (DOC14)))) (SETQ DOC103 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Mark Beginning") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 103) (QUOTE START-LINE) (QUOTE 1180) (QUOTE
+END-LINE) (QUOTE 1188) (QUOTE REF-LIST) (QUOTE (DOC7)))) (SETQ DOC104 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Mark Defun") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 104) (QUOTE START-LINE) (
+QUOTE 1189) (QUOTE END-LINE) (QUOTE 1202) (QUOTE REF-LIST) (QUOTE (DOC7
+DOC15 DOC194 DOC195)))) (SETQ DOC105 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Mark End") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 105) (QUOTE START-LINE) (QUOTE 1203) (QUOTE END-LINE) (QUOTE 1211) (
+QUOTE REF-LIST) (QUOTE (DOC7)))) (SETQ DOC106 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Mark Form") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 106) (QUOTE START-LINE) (QUOTE 1212) (QUOTE END-LINE) (
+QUOTE 1223) (QUOTE REF-LIST) (QUOTE (DOC7 DOC194 DOC195)))) (SETQ DOC107 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Mark Paragraph") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 107) (QUOTE START-LINE) (
+QUOTE 1224) (QUOTE END-LINE) (QUOTE 1236) (QUOTE REF-LIST) (QUOTE (DOC9 DOC7
+DOC16 DOC193)))) (SETQ DOC108 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Mark Whole Buffer") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 108) (QUOTE START-LINE) (QUOTE 1237) (QUOTE END-LINE) (QUOTE 1247) (
+QUOTE REF-LIST) (QUOTE (DOC9 DOC7)))) (SETQ DOC109 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Mark Word") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 109) (QUOTE START-LINE) (QUOTE 1248) (QUOTE END-LINE) (
+QUOTE 1258) (QUOTE REF-LIST) (QUOTE (DOC7 DOC193)))) (SETQ DOC110 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Move Backward Character") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+110) (QUOTE START-LINE) (QUOTE 1259) (QUOTE END-LINE) (QUOTE 1269) (QUOTE
+REF-LIST) (QUOTE (DOC9)))) (SETQ DOC111 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Move Backward Defun") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 111) (QUOTE START-LINE) (QUOTE 1270) (QUOTE END-LINE) (
+QUOTE 1283) (QUOTE REF-LIST) (QUOTE (DOC9 DOC15 DOC194 DOC195)))) (SETQ
+DOC112 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Move Backward Form") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+112) (QUOTE START-LINE) (QUOTE 1284) (QUOTE END-LINE) (QUOTE 1295) (QUOTE
+REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (SETQ DOC113 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Backward List") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 113) (QUOTE START-LINE) (QUOTE 1296) (
+QUOTE END-LINE) (QUOTE 1307) (QUOTE REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (
+SETQ DOC114 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Move Backward Word") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+114) (QUOTE START-LINE) (QUOTE 1308) (QUOTE END-LINE) (QUOTE 1319) (QUOTE
+REF-LIST) (QUOTE (DOC9 DOC193)))) (SETQ DOC115 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Down") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 115) (QUOTE START-LINE) (QUOTE 1320) (QUOTE END-LINE) (
+QUOTE 1330) (QUOTE REF-LIST) (QUOTE (DOC9 DOC21)))) (SETQ DOC116 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Down Extending")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 116) (QUOTE START-LINE) (
+QUOTE 1331) (QUOTE END-LINE) (QUOTE 1342) (QUOTE REF-LIST) (QUOTE (DOC9
+DOC21)))) (SETQ DOC117 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Move Forward Character") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 117) (QUOTE START-LINE) (QUOTE 1343) (QUOTE END-LINE) (QUOTE 1353) (
+QUOTE REF-LIST) (QUOTE (DOC9)))) (SETQ DOC118 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Forward Form") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 118) (QUOTE START-LINE) (QUOTE 1354) (QUOTE
+END-LINE) (QUOTE 1365) (QUOTE REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (SETQ
+DOC119 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Move Forward List") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+119) (QUOTE START-LINE) (QUOTE 1366) (QUOTE END-LINE) (QUOTE 1377) (QUOTE
+REF-LIST) (QUOTE (DOC9 DOC194 DOC195)))) (SETQ DOC120 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move Forward Word") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 120) (QUOTE START-LINE) (QUOTE 1378) (QUOTE
+END-LINE) (QUOTE 1389) (QUOTE REF-LIST) (QUOTE (DOC9 DOC193)))) (SETQ DOC121 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move To Buffer End") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 121) (QUOTE START-LINE) (
+QUOTE 1390) (QUOTE END-LINE) (QUOTE 1399) (QUOTE REF-LIST) (QUOTE (DOC9)))) (
+SETQ DOC122 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Move To Buffer Start") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+122) (QUOTE START-LINE) (QUOTE 1400) (QUOTE END-LINE) (QUOTE 1409) (QUOTE
+REF-LIST) (QUOTE (DOC9)))) (SETQ DOC123 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Move To End Of Line") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 123) (QUOTE START-LINE) (QUOTE 1410) (QUOTE END-LINE) (
+QUOTE 1420) (QUOTE REF-LIST) (QUOTE (DOC9)))) (SETQ DOC124 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Move To Screen Edge") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 124) (QUOTE START-LINE) (QUOTE 1421) (
+QUOTE END-LINE) (QUOTE 1432) (QUOTE REF-LIST) (QUOTE (DOC9)))) (SETQ DOC125 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Move To Start Of Line") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+125) (QUOTE START-LINE) (QUOTE 1433) (QUOTE END-LINE) (QUOTE 1444) (QUOTE
+REF-LIST) (QUOTE (DOC9)))) (SETQ DOC126 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Move Up") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 126) (QUOTE START-LINE) (QUOTE 1445) (QUOTE END-LINE) (QUOTE 1456) (
+QUOTE REF-LIST) (QUOTE (DOC9 DOC21)))) (SETQ DOC127 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Negative Argument") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 127) (QUOTE START-LINE) (QUOTE 1457) (QUOTE
+END-LINE) (QUOTE 1467) (QUOTE REF-LIST) (QUOTE (DOC14)))) (SETQ DOC128 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Next Screen") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 128) (QUOTE START-LINE) (
+QUOTE 1468) (QUOTE END-LINE) (QUOTE 1478) (QUOTE REF-LIST) (QUOTE (DOC9)))) (
+SETQ DOC129 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Nmode Abort") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 129) (QUOTE
+START-LINE) (QUOTE 1479) (QUOTE END-LINE) (QUOTE 1487) (QUOTE REF-LIST) (
+QUOTE (DOC4)))) (SETQ DOC130 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Nmode Exit To Superior") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 130) (QUOTE START-LINE) (QUOTE 1488) (QUOTE END-LINE) (QUOTE
+1496) (QUOTE REF-LIST) (QUOTE (DOC4)))) (SETQ DOC131 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Nmode Full Refresh") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 131) (QUOTE START-LINE) (QUOTE 1497) (
+QUOTE END-LINE) (QUOTE 1506) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC132 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Nmode Gc") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 132) (QUOTE START-LINE) (QUOTE
+1507) (QUOTE END-LINE) (QUOTE 1514) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ
+DOC133 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Nmode Invert Video") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+133) (QUOTE START-LINE) (QUOTE 1515) (QUOTE END-LINE) (QUOTE 1523) (QUOTE
+REF-LIST) (QUOTE (DOC1)))) (SETQ DOC134 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Nmode Refresh") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 134) (QUOTE START-LINE) (QUOTE 1524) (QUOTE END-LINE) (QUOTE
+1534) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC135 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "One Window") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 135) (QUOTE START-LINE) (QUOTE 1535) (QUOTE
+END-LINE) (QUOTE 1544) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC136 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Open Line") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 136) (QUOTE START-LINE) (QUOTE
+1545) (QUOTE END-LINE) (QUOTE 1556) (QUOTE REF-LIST) (QUOTE (DOC6)))) (SETQ
+DOC137 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Other Window")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 137) (QUOTE START-LINE) (
+QUOTE 1557) (QUOTE END-LINE) (QUOTE 1569) (QUOTE REF-LIST) (QUOTE (DOC9 DOC1))))
+(SETQ DOC138 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Prepend To File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 138) (
+QUOTE START-LINE) (QUOTE 1570) (QUOTE END-LINE) (QUOTE 1580) (QUOTE REF-LIST) (
+QUOTE (DOC8 DOC17 DOC196)))) (SETQ DOC139 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Previous Screen") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 139) (QUOTE START-LINE) (QUOTE 1581) (QUOTE
+END-LINE) (QUOTE 1591) (QUOTE REF-LIST) (QUOTE (DOC9)))) (SETQ DOC140 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Put Register") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 140) (QUOTE START-LINE) (
+QUOTE 1592) (QUOTE END-LINE) (QUOTE 1601) (QUOTE REF-LIST) (QUOTE (DOC10)))) (
+SETQ DOC141 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Query Replace") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 141) (
+QUOTE START-LINE) (QUOTE 1602) (QUOTE END-LINE) (QUOTE 1620) (QUOTE REF-LIST) (
+QUOTE (DOC12 DOC2)))) (SETQ DOC142 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Rename Buffer") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 142) (QUOTE START-LINE) (QUOTE 1621) (QUOTE END-LINE) (QUOTE
+1632) (QUOTE REF-LIST) (QUOTE (DOC13 DOC197)))) (SETQ DOC143 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Replace String") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 143) (QUOTE START-LINE) (QUOTE 1633) (
+QUOTE END-LINE) (QUOTE 1643) (QUOTE REF-LIST) (QUOTE (DOC12 DOC2)))) (SETQ
+DOC144 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Reposition Window") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+144) (QUOTE START-LINE) (QUOTE 1644) (QUOTE END-LINE) (QUOTE 1655) (QUOTE
+REF-LIST) (QUOTE (DOC1 DOC194 DOC195)))) (SETQ DOC145 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Return") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 145) (QUOTE START-LINE) (QUOTE 1656) (QUOTE END-LINE) (
+QUOTE 1665) (QUOTE REF-LIST) (QUOTE (DOC6)))) (SETQ DOC146 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Reverse Search") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 146) (QUOTE START-LINE) (QUOTE 1666) (
+QUOTE END-LINE) (QUOTE 1676) (QUOTE REF-LIST) (QUOTE (DOC12 DOC9 DOC70)))) (
+SETQ DOC147 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Revert File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 147) (QUOTE
+START-LINE) (QUOTE 1677) (QUOTE END-LINE) (QUOTE 1686) (QUOTE REF-LIST) (
+QUOTE (DOC11 DOC196)))) (SETQ DOC148 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Save All Files") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 148) (QUOTE START-LINE) (QUOTE 1687) (QUOTE END-LINE) (QUOTE
+1699) (QUOTE REF-LIST) (QUOTE (DOC10 DOC196 DOC197)))) (SETQ DOC149 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Save File") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 149) (QUOTE START-LINE) (QUOTE
+1700) (QUOTE END-LINE) (QUOTE 1709) (QUOTE REF-LIST) (QUOTE (DOC10 DOC196)))) (
+SETQ DOC150 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Scroll Other Window") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+150) (QUOTE START-LINE) (QUOTE 1710) (QUOTE END-LINE) (QUOTE 1720) (QUOTE
+REF-LIST) (QUOTE (DOC1)))) (SETQ DOC151 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Scroll Window Down Line") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 151) (QUOTE START-LINE) (QUOTE 1721) (QUOTE END-LINE) (
+QUOTE 1731) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC152 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Scroll Window Down Page") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 152) (QUOTE START-LINE) (QUOTE
+1732) (QUOTE END-LINE) (QUOTE 1742) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ
+DOC153 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Scroll Window Left") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+153) (QUOTE START-LINE) (QUOTE 1743) (QUOTE END-LINE) (QUOTE 1752) (QUOTE
+REF-LIST) (QUOTE (DOC1)))) (SETQ DOC154 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Scroll Window Right") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 154) (QUOTE START-LINE) (QUOTE 1753) (QUOTE END-LINE) (
+QUOTE 1762) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC155 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Scroll Window Up Line") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 155) (QUOTE START-LINE) (QUOTE
+1763) (QUOTE END-LINE) (QUOTE 1773) (QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ
+DOC156 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Scroll Window Up Page") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+156) (QUOTE START-LINE) (QUOTE 1774) (QUOTE END-LINE) (QUOTE 1784) (QUOTE
+REF-LIST) (QUOTE (DOC1)))) (SETQ DOC157 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Select Buffer") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 157) (QUOTE START-LINE) (QUOTE 1785) (QUOTE END-LINE) (QUOTE
+1796) (QUOTE REF-LIST) (QUOTE (DOC9 DOC197)))) (SETQ DOC158 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Select Previous Buffer") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 158) (QUOTE START-LINE) (QUOTE
+1797) (QUOTE END-LINE) (QUOTE 1807) (QUOTE REF-LIST) (QUOTE (DOC9 DOC197)))) (
+SETQ DOC159 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Set Fill Column") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 159) (
+QUOTE START-LINE) (QUOTE 1808) (QUOTE END-LINE) (QUOTE 1820) (QUOTE REF-LIST) (
+QUOTE (DOC13 DOC19)))) (SETQ DOC160 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Set Fill Prefix") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 160) (QUOTE START-LINE) (QUOTE 1821) (QUOTE END-LINE) (QUOTE
+1834) (QUOTE REF-LIST) (QUOTE (DOC13 DOC20)))) (SETQ DOC161 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Set Goal Column") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 161) (QUOTE START-LINE) (QUOTE 1835) (
+QUOTE END-LINE) (QUOTE 1846) (QUOTE REF-LIST) (QUOTE (DOC13)))) (SETQ DOC162 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Set Key") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 162) (QUOTE START-LINE) (QUOTE
+1847) (QUOTE END-LINE) (QUOTE 1857) (QUOTE REF-LIST) (QUOTE (DOC13)))) (SETQ
+DOC163 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Set Mark") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 163) (QUOTE START-LINE) (
+QUOTE 1858) (QUOTE END-LINE) (QUOTE 1868) (QUOTE REF-LIST) (QUOTE (DOC7)))) (
+SETQ DOC164 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Set Visited Filename") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+164) (QUOTE START-LINE) (QUOTE 1869) (QUOTE END-LINE) (QUOTE 1881) (QUOTE
+REF-LIST) (QUOTE (DOC13 DOC196)))) (SETQ DOC165 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Split Line") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 165) (QUOTE START-LINE) (QUOTE 1882) (QUOTE
+END-LINE) (QUOTE 1894) (QUOTE REF-LIST) (QUOTE (DOC6)))) (SETQ DOC166 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Start Scripting") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 166) (QUOTE START-LINE) (
+QUOTE 1895) (QUOTE END-LINE) (QUOTE 1910) (QUOTE REF-LIST) (QUOTE (DOC3)))) (
+SETQ DOC167 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Start Timing") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 167) (
+QUOTE START-LINE) (QUOTE 1911) (QUOTE END-LINE) (QUOTE 1923) (QUOTE REF-LIST) (
+QUOTE (DOC3)))) (SETQ DOC168 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Stop Scripting") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 168) (QUOTE START-LINE) (QUOTE 1924) (QUOTE END-LINE) (QUOTE 1933) (
+QUOTE REF-LIST) (QUOTE (DOC3)))) (SETQ DOC169 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Stop Timing") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 169) (QUOTE START-LINE) (QUOTE 1934) (QUOTE
+END-LINE) (QUOTE 1946) (QUOTE REF-LIST) (QUOTE (DOC3)))) (SETQ DOC170 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Tab To Tab Stop") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 170) (QUOTE START-LINE) (
+QUOTE 1947) (QUOTE END-LINE) (QUOTE 1960) (QUOTE REF-LIST) (QUOTE (DOC6
+DOC99)))) (SETQ DOC171 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "Text Mode") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 171) (
+QUOTE START-LINE) (QUOTE 1961) (QUOTE END-LINE) (QUOTE 1971) (QUOTE REF-LIST) (
+QUOTE (DOC3 DOC193)))) (SETQ DOC172 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Transpose Characters") (QUOTE TYPE) (QUOTE COMMAND) (
+QUOTE INDEX) (QUOTE 172) (QUOTE START-LINE) (QUOTE 1972) (QUOTE END-LINE) (
+QUOTE 1983) (QUOTE REF-LIST) (QUOTE (DOC2 DOC176)))) (SETQ DOC173 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Transpose Forms") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 173) (QUOTE START-LINE) (
+QUOTE 1984) (QUOTE END-LINE) (QUOTE 1996) (QUOTE REF-LIST) (QUOTE (DOC2
+DOC176 DOC194 DOC195)))) (SETQ DOC174 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Transpose Lines") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 174) (QUOTE START-LINE) (QUOTE 1997) (QUOTE END-LINE) (QUOTE
+2007) (QUOTE REF-LIST) (QUOTE (DOC2 DOC176)))) (SETQ DOC175 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Transpose Regions") (QUOTE TYPE) (
+QUOTE COMMAND) (QUOTE INDEX) (QUOTE 175) (QUOTE START-LINE) (QUOTE 2008) (
+QUOTE END-LINE) (QUOTE 2019) (QUOTE REF-LIST) (QUOTE (DOC2 DOC17)))) (SETQ
+DOC176 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Transpose Words") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 176) (
+QUOTE START-LINE) (QUOTE 2020) (QUOTE END-LINE) (QUOTE 2035) (QUOTE REF-LIST) (
+QUOTE (DOC2 DOC193)))) (SETQ DOC177 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Two Windows") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 177) (QUOTE START-LINE) (QUOTE 2036) (QUOTE END-LINE) (QUOTE 2045) (
+QUOTE REF-LIST) (QUOTE (DOC1)))) (SETQ DOC178 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Undelete File") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 178) (QUOTE START-LINE) (QUOTE 2046) (QUOTE
+END-LINE) (QUOTE 2059) (QUOTE REF-LIST) (QUOTE (DOC10 DOC8 DOC196)))) (SETQ
+DOC179 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Universal Argument") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+179) (QUOTE START-LINE) (QUOTE 2060) (QUOTE END-LINE) (QUOTE 2070) (QUOTE
+REF-LIST) (QUOTE (DOC14)))) (SETQ DOC180 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Unkill Previous") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 180) (QUOTE START-LINE) (QUOTE 2071) (QUOTE
+END-LINE) (QUOTE 2086) (QUOTE REF-LIST) (QUOTE (DOC2 DOC17 DOC22)))) (SETQ
+DOC181 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Upcase Digit")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 181) (QUOTE START-LINE) (
+QUOTE 2087) (QUOTE END-LINE) (QUOTE 2098) (QUOTE REF-LIST) (QUOTE (DOC2)))) (
+SETQ DOC182 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE
+"Uppercase Initial") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+182) (QUOTE START-LINE) (QUOTE 2099) (QUOTE END-LINE) (QUOTE 2109) (QUOTE
+REF-LIST) (QUOTE (DOC2 DOC193)))) (SETQ DOC183 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Uppercase Region") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 183) (QUOTE START-LINE) (QUOTE 2110) (QUOTE
+END-LINE) (QUOTE 2119) (QUOTE REF-LIST) (QUOTE (DOC2 DOC17)))) (SETQ DOC184 (
+MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Uppercase Word") (
+QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 184) (QUOTE START-LINE) (
+QUOTE 2120) (QUOTE END-LINE) (QUOTE 2130) (QUOTE REF-LIST) (QUOTE (DOC2
+DOC193)))) (SETQ DOC185 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (
+QUOTE "View Two Windows") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE
+185) (QUOTE START-LINE) (QUOTE 2131) (QUOTE END-LINE) (QUOTE 2139) (QUOTE
+REF-LIST) (QUOTE (DOC1)))) (SETQ DOC186 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (
+QUOTE NAME) (QUOTE "Visit File") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 186) (QUOTE START-LINE) (QUOTE 2140) (QUOTE END-LINE) (QUOTE 2152) (
+QUOTE REF-LIST) (QUOTE (DOC9 DOC8 DOC196)))) (SETQ DOC187 (MAKE-INSTANCE (
+QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Visit In Other Window") (QUOTE
+TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 187) (QUOTE START-LINE) (QUOTE
+2153) (QUOTE END-LINE) (QUOTE 2166) (QUOTE REF-LIST) (QUOTE (DOC1 DOC9
+DOC197 DOC196)))) (SETQ DOC188 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "What Cursor Position") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE
+INDEX) (QUOTE 188) (QUOTE START-LINE) (QUOTE 2167) (QUOTE END-LINE) (QUOTE
+2180) (QUOTE REF-LIST) (QUOTE (DOC5)))) (SETQ DOC189 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Write File") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 189) (QUOTE START-LINE) (QUOTE 2181) (QUOTE
+END-LINE) (QUOTE 2192) (QUOTE REF-LIST) (QUOTE (DOC10 DOC196)))) (SETQ
+DOC190 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Write Region")
+(QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (QUOTE 190) (QUOTE START-LINE) (
+QUOTE 2193) (QUOTE END-LINE) (QUOTE 2203) (QUOTE REF-LIST) (QUOTE (DOC10
+DOC17 DOC196)))) (SETQ DOC191 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE
+NAME) (QUOTE "Write Screen Photo") (QUOTE TYPE) (QUOTE COMMAND) (QUOTE INDEX) (
+QUOTE 191) (QUOTE START-LINE) (QUOTE 2204) (QUOTE END-LINE) (QUOTE 2213) (
+QUOTE REF-LIST) (QUOTE (DOC10 DOC196)))) (SETQ DOC192 (MAKE-INSTANCE (QUOTE
+DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "Yank Last Output") (QUOTE TYPE) (QUOTE
+COMMAND) (QUOTE INDEX) (QUOTE 192) (QUOTE START-LINE) (QUOTE 2214) (QUOTE
+END-LINE) (QUOTE 2223) (QUOTE REF-LIST) (QUOTE (DOC8 DOC194 DOC195)))) (SETQ
+DOC193 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "TEXT") (
+QUOTE TYPE) (QUOTE TOPIC) (QUOTE INDEX) (QUOTE 193) (QUOTE START-LINE) (
+QUOTE *UNBOUND*) (QUOTE END-LINE) (QUOTE NIL) (QUOTE REF-LIST) (QUOTE NIL))) (
+SETQ DOC194 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "LISP") (
+QUOTE TYPE) (QUOTE TOPIC) (QUOTE INDEX) (QUOTE 194) (QUOTE START-LINE) (
+QUOTE *UNBOUND*) (QUOTE END-LINE) (QUOTE NIL) (QUOTE REF-LIST) (QUOTE NIL))) (
+SETQ DOC195 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "LISP") (
+QUOTE TYPE) (QUOTE MODE) (QUOTE INDEX) (QUOTE 195) (QUOTE START-LINE) (QUOTE
+*UNBOUND*) (QUOTE END-LINE) (QUOTE NIL) (QUOTE REF-LIST) (QUOTE NIL))) (SETQ
+DOC196 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "FILES") (
+QUOTE TYPE) (QUOTE TOPIC) (QUOTE INDEX) (QUOTE 196) (QUOTE START-LINE) (
+QUOTE *UNBOUND*) (QUOTE END-LINE) (QUOTE NIL) (QUOTE REF-LIST) (QUOTE NIL))) (
+SETQ DOC197 (MAKE-INSTANCE (QUOTE DOC-BROWSE-OBJ) (QUOTE NAME) (QUOTE "BUFFERS")
+(QUOTE TYPE) (QUOTE TOPIC) (QUOTE INDEX) (QUOTE 197) (QUOTE START-LINE) (
+QUOTE *UNBOUND*) (QUOTE END-LINE) (QUOTE NIL) (QUOTE REF-LIST) (QUOTE NIL)))))
ADDED psl-1983/3-1/doc/nmode/frames.lpt
Index: psl-1983/3-1/doc/nmode/frames.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/frames.lpt
@@ -0,0 +1,2223 @@
+###0
+Action Type Explanation: Alter Display Format
+
+This type of command alters how text is displayed without altering the contents
+of existing buffers.
+
+###1
+Action Type Explanation: Alter Existing Text
+
+This type of command alters some part of the existing text, generally
+transforming and/or moving text rather than just inserting or deleting it.
+
+###2
+Action Type Explanation: Change Mode
+
+This type of command turns some feature(s) of the editor on or off. This may
+include major modes, minor modes, timing, or scripting.
+
+###3
+Action Type Explanation: Escape
+
+Escape from the current level.
+
+###4
+Action Type Explanation: Inform
+
+This type of command informs the user of some property of the text being worked
+with, or of the state of the editor (including where point is, what the existing
+buffer(s) is(are), what is in the documentation, etc.).
+
+###5
+Action Type Explanation: Insert Constant
+
+This type of command inserts a character constant like tab or space or a
+multiple thereof.
+
+###6
+Action Type Explanation: Mark
+
+This type of command sets mark.
+
+###7
+Action Type Explanation: Move Data
+
+This command copies some data (which is not a constant wired into the program)
+from one place to another.
+
+###8
+Action Type Explanation: Move Point
+
+This type of command moves point. It may move it within a buffer or from buffer
+to buffer.
+
+###9
+Action Type Explanation: Preserve
+
+Make a copy of something current and put it somewhere else (usually disc).
+
+###10
+Action Type Explanation: Remove
+
+This type of command allows a user to get rid of data, either killing or
+deleting text or removing files or directory entries.
+
+###11
+Action Type Explanation: Select
+
+This type of command finds particular strings in text, and may perform some
+action upon them, such as counting, replacement, or deletion.
+
+###12
+Action Type Explanation: Set Global Variable
+
+This type of command sets some global variable which tends to remain stable for
+some time, such as prefix variables and key bindings.
+
+###13
+Action Type Explanation: Subsequent Command Modifier
+
+This type of command modifies the meaning of the keys that immediately follow
+it, as the prefix commands and the argument commands do.
+
+###14
+Definition: Defun
+
+A defun is a list whose ( falls in column 0. Its end is after the CRLF
+following its ).
+
+###15
+Definition: Paragraph
+
+Paragraphs are delimited by blank lines and psuedo-blank lines, which are lines
+which don't match the existing fill prefix (when there is one), and, when in
+text mode, also by indentation and by text justifier command lines, which are
+currently defined as lines starting with a period and which are treated as
+another type of psuedo-blank line. Paragraphs contain the final CRLF after
+their last test, and contain any immediately preceding empty line.
+
+###16
+Definition: Region
+
+The region is that portion of text between point, the current buffer position,
+and mark.
+
+###17
+Definition: Sentence
+
+A sentence is ended by a ., ? or ! followed by two spaces or a CRLF (with
+optional space), with any number of "closing characters" ", ', ) and ] between.
+A sentence also starts at the start of a paragraph. A sentence also ends at the
+end of a paragraph.
+
+###18
+Global Explanation: Fill Column
+
+The fill column is the column beyond which all the fill commands: auto fill,
+fill paragraph, fill region, and fill comment, will try to break up lines. The
+fill column can be set by the Set Fill Column command.
+
+###19
+Global Explanation: Fill Prefix
+
+The fill prefix, if present, is a string that the fill paragraph and fill region
+commands expect to see on the areas that they are filling. It is useful, for
+instance, in filling indented text. Only the indented area will be filled, and
+any new lines created by the filling will be properly indented. Autofill will
+also insert it on each new line it starts.
+
+###20
+Global Explanation: Goal Column
+
+This is not yet correctly implemented
+
+###21
+Global Explanation: Kill Ring
+
+ The kill ring is a stack of the 16 most recently killed pieces of text. The
+Insert Kill Buffer command reads text on the top of the kill ring and inserts it
+back into the buffer. It can accept an argument, specifying an argument other
+than the top one. If one knows that the text one wants is on the kill ring, but
+is not certain how deeply it is buried, one can retrieve the top item with the
+Insert Kill Buffer command, then look through the other items one by one with
+the Unkill Previous command. This rotates the items on the kill ring,
+displaying them one by one in a cycle.
+ Most kill commands push their text onto the top of the kill ring. If two kill
+commands are performed right after each other, the text they kill is
+concatenated. Commands the kill forward add onto the end of the previously
+killed text. Commands that kill backward add onto the beginning. That way, the
+text is assembled in its original order. If intervening commands have taken
+place one can issue an Append Next Kill command before the next kill in order to
+assemble the next killed text together with the text on top of the kill ring.
+
+###22
+Command: Append Next Kill
+
+Function: append-next-kill-command
+Key: C-M-W
+See Global: Kill Ring
+Action Type: Move Data
+
+Make following kill commands append to last batch. Thus, C-K C-K, cursor
+motion, this command, and C-K C-K, generate one block of killed stuff,
+containing two lines.
+
+###23
+Command: Append To Buffer
+
+Function: append-to-buffer-command
+Key: C-X A
+Topic: Buffers
+See Definition: Region
+Action Type: Move Data
+
+Append region to specified buffer. The buffer's name is read from the keyboard;
+the buffer is created if nonexistent. A numeric argument causes us to "prepend"
+instead. We always insert the text at that buffer's pointer, but when
+"prepending" we leave the pointer before the inserted text.
+
+###24
+Command: Append To File
+
+Function: append-to-file-command
+Key: M-X Append To File
+Topic: Files
+See Definition: Region
+Action Type: Move Data
+
+Append region to end of specified file.
+
+###25
+Command: Apropos
+
+Function: apropos-command
+Key: M-X Apropos
+Action Type: Inform
+
+M-X Apropos lists functions with names containing a string for which the user is
+prompted.
+
+###26
+Command: Argument Digit
+
+Function: argument-digit
+Key: C-0
+Key: C-1
+Key: C-2
+Key: C-3
+Key: C-4
+Key: C-5
+Key: C-6
+Key: C-7
+Key: C-8
+Key: C-9
+Key: C-M-0
+Key: C-M-1
+Key: C-M-2
+Key: C-M-3
+Key: C-M-4
+Key: C-M-5
+Key: C-M-6
+Key: C-M-7
+Key: C-M-8
+Key: C-M-9
+Key: M-0
+Key: M-1
+Key: M-2
+Key: M-3
+Key: M-4
+Key: M-5
+Key: M-6
+Key: M-7
+Key: M-8
+Key: M-9
+Action Type: Subsequent Command Modifier
+
+Specify numeric argument for next command. Several such digits typed in a row
+all accumulate.
+
+###27
+Command: Auto Fill Mode
+
+Function: auto-fill-mode-command
+Key: M-X Auto Fill Mode
+See Command: Set Fill Column
+Action Type: Change Mode
+
+Break lines between words at the right margin. A positive argument turns Auto
+Fill mode on; zero or negative, turns it off. With no argument, the mode is
+toggled. When Auto Fill mode is on, lines are broken at spaces to fit the right
+margin (position controlled by Fill Column). You can set the Fill Column with
+the Set Fill Column command.
+
+###28
+Command: Back To Indentation
+
+Function: back-to-indentation-command
+Key: C-M-M
+Key: C-M-RETURN
+Key: M-M
+Key: M-RETURN
+Action Type: Move Point
+
+Move to end of this line's indentation.
+
+###29
+Command: Backward Kill Sentence
+
+Function: backward-kill-sentence-command
+Key: C-X RUBOUT
+See Global: Kill Ring
+See Definition: Sentence
+Action Type: Remove
+
+Kill back to beginning of sentence. With a command argument n kills backward
+(n>0) or forward (n>0) by |n| sentences.
+
+###30
+Command: Backward Paragraph
+
+Function: backward-paragraph-command
+Key: M-[
+See Definition: Paragraph
+Action Type: Move Point
+
+Move backward to start of paragraph. When given argument moves backward (n>0)
+or forward (n<0) by |n| paragraphs where n is the command argument.
+
+###31
+Command: Backward Sentence
+
+Function: backward-sentence-command
+Key: M-A
+See Definition: Sentence
+Action Type: Move Point
+
+Move to beginning of sentence. When given argument moves backward (n>0) or
+forward (n<0) by |n| sentences where n is the command argument.
+
+###32
+Command: Backward Up List
+
+Function: backward-up-list-command
+Key: C-(
+Key: C-M-(
+Key: C-M-U
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move up one level of list structure, backward. Given a command argument n move
+up |n| levels backward (n>0) or forward (n<0).
+
+###33
+Command: Buffer Browser
+
+Function: buffer-browser-command
+Key: C-X C-B
+Key: M-X List Buffers
+Topic: Buffers
+Action Type: Inform
+
+Put up a buffer browser subsystem. If an argument is given, then include buffers
+whose names begin with "+".
+
+###34
+Command: Buffer Not Modified
+
+Function: buffer-not-modified-command
+Key: M-~
+Topic: Buffers
+Action Type: Set Global Variable
+
+Pretend that this buffer hasn't been altered.
+
+###35
+Command: C-X Prefix
+
+Function: c-x-prefix
+Key: C-X
+Action Type: Subsequent Command Modifier
+
+The command Control-X is an escape-prefix for more commands. It reads a
+character (subcommand) and dispatches on it.
+
+###36
+Command: Center Line
+
+Function: center-line-command
+Key: M-S
+Topic: Text
+See Global: Fill Column
+Action Type: Alter Existing Text
+
+Center this line's text within the line. With argument, centers that many lines
+and moves past. Centers current and preceding lines with negative argument.
+The width is Fill Column.
+
+###37
+Command: Copy Region
+
+Function: copy-region
+Key: M-W
+See Global: Kill Ring
+See Definition: Region
+Action Type: Preserve
+
+Stick region into kill-ring without killing it. Like killing and getting back,
+but doesn't mark buffer modified.
+
+###38
+Command: Count Occurrences
+
+Function: count-occurrences-command
+Key: M-X Count Occurrences
+Key: M-X How Many
+Action Type: Inform
+
+Counts occurrences of a string, after point. The user is prompted for the
+string. Case is ignored in the count.
+
+###39
+Command: Delete And Expunge File
+
+Function: delete-and-expunge-file-command
+Key: M-X Delete And Expunge File
+Topic: Files
+Action Type: Remove
+
+This command prompts the user for the name of the file. NMODE will fill in
+defaults in a partly specified filename (eg filetype can be defaulted). If
+possible, the file will then be deleted and expunged, and a message to that
+effect will be displayed. If the operation fails, the bell will sound.
+
+###40
+Command: Delete Backward Hacking Tabs
+
+Function: delete-backward-hacking-tabs-command
+Key: BACKSPACE
+Key: C-RUBOUT
+Key: RUBOUT
+Mode: Lisp
+Action Type: Remove
+
+Delete character before point, turning tabs into spaces. Rather than deleting a
+whole tab, the tab is converted into the appropriate number of spaces and then
+one space is deleted. With positive arguments this operation is performed
+multiple times on the text before point. With negative arguments this operation
+is performed multiple times on the text after point.
+
+###41
+Command: Delete Blank Lines
+
+Function: delete-blank-lines-command
+Key: C-X C-O
+Action Type: Remove
+
+Delete all blank lines around this line's end. If done on a non-blank line,
+deletes all spaces and tabs at the end of it, and all following blank lines
+(Lines are blank if they contain only spaces and tabs). If done on a blank
+line, deletes all preceding blank lines as well.
+
+###42
+Command: Delete File
+
+Function: delete-file-command
+Key: M-X Delete File
+Key: M-X Kill File
+Topic: Files
+Action Type: Remove
+
+Delete a file. Prompts for filename.
+
+###43
+Command: Delete Forward Character
+
+Function: delete-forward-character-command
+Key: C-D
+Key: ESC-P
+See Global: Kill Ring
+Action Type: Remove
+
+Delete character after point. With argument, kill that many characters (saving
+them). Negative args kill characters backward.
+
+###44
+Command: Delete Horizontal Space
+
+Function: delete-horizontal-space-command
+Key: M-\
+Action Type: Remove
+
+Delete all spaces and tabs around point.
+
+###45
+Command: Delete Indentation
+
+Function: delete-indentation-command
+Key: M-^
+Action Type: Remove
+
+Delete CRLF and indentation at front of line. Leaves one space in place of
+them. With argument, moves down one line first (deleting CRLF after current
+line).
+
+###46
+Command: Delete Matching Lines
+
+Function: delete-matching-lines-command
+Key: M-X Delete Matching Lines
+Key: M-X Flush Lines
+Action Type: Select
+Action Type: Remove
+
+Delete Matching Lines: Prompts user for string. Deletes all lines containing
+specified string.
+
+###47
+Command: Delete Non-Matching Lines
+
+Function: delete-non-matching-lines-command
+Key: M-X Delete Non-Matching Lines
+Key: M-X Keep Lines
+Action Type: Select
+Action Type: Remove
+
+Delete Non-Matching Lines: Prompts user for string. Deletes all lines not
+containing specified string.
+
+###48
+Command: Dired
+
+Function: dired-command
+Key: C-X D
+
+Run Dired on the directory of the current buffer file. With no argument, edits
+that directory. With an argument of 1, shows only the versions of the file in
+the buffer. With an argument of 4, asks for input, only versions of that file
+are shown.
+
+###49
+Command: Down List
+
+Function: down-list
+Key: C-M-D
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move down one level of list structure, forward. Command argument sensitivity
+not yet implemented.
+
+###50
+Command: Edit Directory
+
+Function: edit-directory-command
+Key: M-X Dired
+Key: M-X Edit Directory
+
+DIRED: Edit a directory. The string argument may contain the filespec (with
+wildcards of course)
+ D deletes the file which is on the current line. (also K,^D,^K)
+ U undeletes the current line file.
+ Rubout undeletes the previous line file.
+ Space is like ^N - moves down a line.
+ E edit the file.
+ S sorts files according to size, read or write date.
+ R does a reverse sort.
+ ? types a list of commands.
+ Q lists files to be deleted and asks for confirmation:
+ Typing YES deletes them; X aborts; N resumes DIRED.
+
+###51
+Command: End Of Defun
+
+Function: end-of-defun-command
+Key: C-M-E
+Key: C-M-]
+Mode: Lisp
+Topic: Lisp
+See Definition: Defun
+Action Type: Move Point
+
+Move to end of this or next defun. With argument of 2, finds end of following
+defun. With argument of -1, finds end of previous defun, etc.
+
+###52
+Command: Esc Prefix
+
+Function: esc-prefix
+Key: ESCAPE
+Action Type: Subsequent Command Modifier
+
+The command esc-prefix is an escape-prefix for more commands. It reads a
+character (subcommand) and dispatches on it. Used for escape sequences sent by
+function keys on the keyboard.
+
+###53
+Command: Exchange Point And Mark
+
+Function: exchange-point-and-mark
+Key: C-X C-X
+Action Type: Mark
+Action Type: Move Point
+
+Exchange positions of point and mark.
+
+###54
+Command: Exchange Windows
+
+Function: exchange-windows-command
+Key: C-X E
+Action Type: Alter Display Format
+
+Exchanges the current window with the other window, which becomes current. In
+two window mode, the windows swap physical positions.
+
+###55
+Command: Execute Buffer
+
+Function: execute-buffer-command
+Key: M-X Execute Buffer
+Topic: Buffers
+
+This command makes NMODE take input from the specified buffer as if it were
+typed in. This command supercedes any such previous request. Newline
+characters are ignored when reading from a buffer. If a command argument is
+given then only the last refresh of the screen triggered by the commands
+actually occurs, otherwise all of the updating of the screen is visible.
+
+###56
+Command: Execute File
+
+Function: execute-file-command
+Key: M-X Execute File
+Topic: Files
+
+This command makes NMODE take input from the specified file as if it were typed
+in. This command supercedes any such previous request. Newline characters are
+ignored when reading from a buffer. If a command argument is given then only
+the last refresh of the screen triggered by the commands actually occurs,
+otherwise all of the updating of the screen is visible.
+
+###57
+Command: Execute Form
+
+Function: execute-form-command
+Key: Lisp-E
+Mode: Lisp
+Topic: Lisp
+Action Type: Mark
+
+Causes the Lisp reader to read and evaluate a form starting at the beginning of
+the current line. We arrange for output to go to the end of the output buffer.
+The mark is set at the current location in the input buffer, in case user wants
+to go back.
+
+###58
+Command: Exit Nmode
+
+Function: exit-nmode
+Key: Lisp-L
+Mode: Lisp
+Topic: Lisp
+Action Type: Escape
+
+Leave NMODE, return to normal listen loop.
+
+###59
+Command: Fill Comment
+
+Function: fill-comment-command
+Key: M-Z
+See Global: Fill Prefix
+See Global: Fill Column
+See Definition: Paragraph
+Action Type: Alter Existing Text
+
+This command creates a temporary fill prefix from the start of the current line.
+It replaces the surrounding paragraph (determined using fill-prefix) with a
+filled version. It leaves point at the a position bearing the same relation to
+the filled text that the old point did to the old text.
+
+###60
+Command: Fill Paragraph
+
+Function: fill-paragraph-command
+Key: M-Q
+Topic: Text
+See Global: Fill Prefix
+See Global: Fill Column
+See Definition: Paragraph
+Action Type: Alter Existing Text
+
+This fills (or justifies) this (or next) paragraph. It leaves point at the a
+position bearing the same relation to the filled text that the old point did to
+the old text. A numeric argument triggers justification rather than filling.
+
+###61
+Command: Fill Region
+
+Function: fill-region-command
+Key: M-G
+Topic: Text
+See Command: Set Fill Column
+See Command: Set Fill Prefix
+See Global: Fill Prefix
+See Global: Fill Column
+See Definition: Paragraph
+See Definition: Sentence
+Action Type: Alter Existing Text
+
+Fill text from point to mark. Fill Column specifies the desired text width.
+Fill Prefix if present is a string that goes at the front of each line and is
+not included in the filling. See Set Fill Column and Set Fill Prefix. An
+explicit argument causes justification instead of filling. Each sentence which
+ends within a line is followed by two spaces.
+
+###62
+Command: Find File
+
+Function: find-file-command
+Key: C-X C-F
+Key: M-X Find File
+Topic: Files
+Topic: Buffers
+Action Type: Move Data
+Action Type: Move Point
+
+Visit a file in its own buffer. If the file is already in some buffer, select
+that buffer. Otherwise, visit the file in a buffer named after the file.
+
+###63
+Command: Forward Paragraph
+
+Function: forward-paragraph-command
+Key: M-]
+Topic: Text
+See Definition: Paragraph
+Action Type: Move Point
+
+Move forward to end of this or the next paragraph. When given argument moves
+forward (n>0) or backward (n<0) by |n| paragraphs where n is the command
+argument.
+
+###64
+Command: Forward Sentence
+
+Function: forward-sentence-command
+Key: M-E
+Topic: Text
+See Definition: Sentence
+Action Type: Move Point
+
+Move forward to end of this or the next sentence. When given argument moves
+forward (n>0) or backward (n<0) by |n| sentences. where n is the command
+argument.
+
+###65
+Command: Forward Up List
+
+Function: forward-up-list-command
+Key: C-)
+Key: C-M-)
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move up one level of list structure, forward. Given a command argument n move
+up |n| levels forward (n>0) or backward (n<0).
+
+###66
+Command: Get Register
+
+Function: get-register-command
+Key: C-X G
+Action Type: Move Data
+Action Type: Mark
+
+Get contents of register (reads name from keyboard). The name is a single
+letter or digit. Usually leaves the pointer before, and the mark after, the
+text. With argument, puts point after and mark before.
+
+###67
+Command: Grow Window
+
+Function: grow-window-command
+Key: C-X ^
+Action Type: Alter Display Format
+
+Make this window use more lines. Argument is number of extra lines (can be
+negative).
+
+###68
+Command: Help Dispatch
+
+Function: help-dispatch
+Key: C-?
+Key: M-/
+Key: M-?
+Action Type: Inform
+
+Prints the documentation of a command (not a function). The command character
+is read from the terminal.
+
+###69
+Command: Incremental Search
+
+Function: incremental-search-command
+Key: C-S
+Action Type: Move Point
+Action Type: Select
+
+Search for character string as you type it. C-Q quotes special characters.
+Rubout cancels last character. C-S repeats the search, forward, and C-R repeats
+it backward. C-R or C-S with search string empty changes the direction of
+search or brings back search string from previous search. Altmode exits the
+search. Other Control and Meta chars exit the search and then are executed. If
+not all the input string can be found, the rest is not discarded. You can rub
+it out, discard it all with C-G, exit, or use C-R or C-S to search the other
+way. Quitting a successful search aborts the search and moves point back;
+quitting a failing search just discards whatever input wasn't found.
+
+###70
+Command: Indent New line
+
+Function: indent-new-line-command
+Key: NEWLINE
+Action Type: Insert Constant
+
+This function performs the following actions: Executes whatever function, if
+any, is associated with <CR>. Executes whatever function, if any, is associated
+with TAB, as if no command argument was given.
+
+###71
+Command: Insert Buffer
+
+Function: insert-buffer-command
+Key: M-X Insert Buffer
+Topic: Buffers
+Action Type: Move Data
+
+Insert contents of another buffer into existing text. The user is prompted for
+the buffer name. Point is left just before the inserted material, and mark is
+left just after it.
+
+###72
+Command: Insert Closing bracket
+
+Function: insert-closing-bracket
+Key: )
+Key: ]
+Mode: Lisp
+Topic: Lisp
+Action Type: Insert Constant
+
+Insert the character typed, which should be a closing bracket, then display the
+matching opening bracket.
+
+###73
+Command: Insert Comment
+
+Function: insert-comment-command
+Key: M-;
+Mode: Lisp
+Topic: Lisp
+Action Type: Insert Constant
+
+Move to the end of the current line, then add a "%" and a space at its end.
+Leave point after the space.
+
+###74
+Command: Insert Date
+
+Function: insert-date-command
+Key: M-X Insert Date
+Action Type: Move Data
+
+Insert the current time and date after point. The mark is put after the
+inserted text.
+
+###75
+Command: Insert File
+
+Function: insert-file-command
+Key: M-X Insert File
+Topic: Files
+Action Type: Move Data
+
+Insert contents of file into existing text. File name is string argument. The
+pointer is left at the beginning, and the mark at the end.
+
+###76
+Command: Insert Kill Buffer
+
+Function: insert-kill-buffer
+Key: C-Y
+See Global: Kill Ring
+Action Type: Move Data
+Action Type: Mark
+
+Re-insert the last stuff killed. Puts point after it and the mark before it.
+An argument n says un-kill the n'th most recent string of killed stuff (1 = most
+recent). A null argument (just C-U) means leave point before, mark after.
+
+###77
+Command: Insert Next Character
+
+Function: insert-next-character-command
+Key: C-Q
+Action Type: Move Data
+
+Reads a character and inserts it.
+
+###78
+Command: Insert Parens
+
+Function: insert-parens
+Key: M-(
+Mode: Lisp
+Topic: Lisp
+Action Type: Insert Constant
+
+Insert () putting point between them. Also make a space before them if
+appropriate. With argument, put the ) after the specified number of already
+existing s-expressions. Thus, with argument 1, puts extra parens around the
+following s-expression.
+
+###79
+Command: Kill Backward Form
+
+Function: kill-backward-form-command
+Key: C-M-RUBOUT
+Mode: Lisp
+Topic: Lisp
+See Global: Kill Ring
+Action Type: Remove
+
+Kill the last form. With a command argument kill the last (n>0) or next (n<0)
+|n| forms, where n is the command argument.
+
+###80
+Command: Kill Backward Word
+
+Function: kill-backward-word-command
+Key: M-RUBOUT
+Topic: Text
+See Global: Kill Ring
+Action Type: Remove
+
+Kill last word. With a command argument kill the last (n>0) or next (n<0) |n|
+words, where n is the command argument.
+
+###81
+Command: Kill Buffer
+
+Function: kill-buffer-command
+Key: C-X K
+Key: M-X Kill Buffer
+Topic: Buffers
+Action Type: Remove
+
+Kill the buffer with specified name. The buffer name is taken from the
+keyboard. Name completion is performed by SPACE and RETURN. If the buffer has
+changes in it, the user is asked for confirmation.
+
+###82
+Command: Kill Forward Form
+
+Function: kill-forward-form-command
+Key: C-M-K
+Mode: Lisp
+Topic: Lisp
+See Global: Kill Ring
+Action Type: Remove
+
+Kill the next form. With a command argument kill the next (n>0) or last (n<0)
+|n| forms, where n is the command argument.
+
+###83
+Command: Kill Forward Word
+
+Function: kill-forward-word-command
+Key: M-D
+Topic: Text
+See Global: Kill Ring
+Action Type: Remove
+
+Kill the next word. With a command argument kill the next (n>0) or last (n<0)
+|n| words, where n is the command argument.
+
+###84
+Command: Kill Line
+
+Function: kill-line
+Key: C-K
+Key: ESC-M
+See Global: Kill Ring
+Action Type: Remove
+
+Kill to end of line, or kill an end of line. At the end of a line (only blanks
+following) kill through the CRLF. Otherwise, kill the rest of the line but not
+the CRLF. With argument (positive or negative), kill specified number of lines
+forward or backward respectively. An argument of zero means kill to the
+beginning of the ine, nothing if at the beginning. Killed text is pushed onto
+the kill ring for retrieval.
+
+###85
+Command: Kill Region
+
+Function: kill-region
+Key: C-W
+See Global: Kill Ring
+See Definition: Region
+Action Type: Remove
+
+Kill from point to mark. Use Control-Y and Meta-Y to get it back.
+
+###86
+Command: Kill Sentence
+
+Function: kill-sentence-command
+Key: M-K
+Topic: Text
+See Global: Kill Ring
+See Definition: Sentence
+Action Type: Remove
+
+Kill forward to end of sentence. With minus one as an argument it kills back to
+the beginning of the sentence. Positive or negative arguments mean to kill that
+many sentences forward or backward respectively.
+
+###87
+Command: Kill Some Buffers
+
+Function: kill-some-buffers-command
+Key: M-X Kill Some Buffers
+Topic: Buffers
+Action Type: Remove
+
+Kill Some Buffers: Offer to kill each buffer, one by one. If the buffer
+contains a modified file and you say to kill it, you are asked for confirmation.
+
+###88
+Command: Lisp Abort
+
+Function: lisp-abort-command
+Key: Lisp-A
+Mode: Lisp
+Topic: Lisp
+Action Type: Escape
+
+This command will pop out of an arbitrarily deep break loop.
+
+###89
+Command: Lisp Backtrace
+
+Function: lisp-backtrace-command
+Key: Lisp-B
+Mode: Lisp
+Topic: Lisp
+Action Type: Inform
+
+This lists all the function calls on the stack. It is a good way to see how the
+offending expression got generated.
+
+###90
+Command: Lisp Continue
+
+Function: lisp-continue-command
+Key: Lisp-C
+Mode: Lisp
+Topic: Lisp
+Action Type: Escape
+
+This causes the expression last printed to be returned as the value of the
+offending expression. This allows a user to recover from a low level error in
+an involved calculation if they know what should have been returned by the
+offending expression. This is also often useful as an automatic stub: If an
+expression containing an undefined function is evaluated, a Break loop is
+entered, and this may be used to return the value of the function call.
+
+###91
+Command: Lisp Help
+
+Function: lisp-help-command
+Key: Lisp-?
+Mode: Lisp
+Topic: Lisp
+Action Type: Inform
+
+If in break print:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace" else
+print:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp Listener"
+
+###92
+Command: Lisp Indent Region
+
+Function: lisp-indent-region-command
+Key: C-M-\
+Mode: Lisp
+Topic: Lisp
+
+Indent all lines between point and mark. With argument, indents each line to
+exactly that column. Otherwise, lisp indents each line. A line is processed if
+its first character is in the region. It tries to preserve the textual context
+of point and mark.
+
+###93
+Command: Lisp Indent sexpr
+
+Function: lisp-indent-sexpr
+Key: C-M-Q
+Mode: Lisp
+Topic: Lisp
+
+Lisp Indent each line contained in the next form. This command does NOT respond
+to command arguments.
+
+###94
+Command: Lisp Mode
+
+Function: lisp-mode-command
+Key: M-X Lisp Mode
+Topic: Lisp
+Action Type: Change Mode
+
+Set things up for editing Lisp code. Tab indents for Lisp. Rubout hacks tabs.
+Lisp execution commands availible. Paragraphs are delimited only by blank
+lines.
+
+###95
+Command: Lisp Prefix
+
+Function: lisp-prefix
+Key: C-]
+Mode: Lisp
+Topic: Lisp
+Action Type: Subsequent Command Modifier
+
+The command lisp-prefix is an escape-prefix for more commands. It reads a
+character (subcommand) and dispatches on it.
+
+###96
+Command: Lisp Quit
+
+Function: lisp-quit-command
+Key: Lisp-Q
+Mode: Lisp
+Topic: Lisp
+Action Type: Escape
+
+This exits the current break loop. It only pops up one level, unlike abort.
+
+###97
+Command: Lisp Retry
+
+Function: lisp-retry-command
+Key: Lisp-R
+Mode: Lisp
+Topic: Lisp
+Action Type: Escape
+
+This tries to evaluate the offending expression again, and to continue the
+computation. This is often useful after defining a missing function, or
+assigning a value to a variable.
+
+###98
+Command: Lisp Tab
+
+Function: lisp-tab-command
+Key: C-M-I
+Key: C-M-TAB
+Key: TAB
+Mode: Lisp
+Topic: Lisp
+See Command: Tab To Tab Stop
+Action Type: Alter Existing Text
+
+ Indent this line for a Lisp-like language. With arg, moves over and indents
+that many lines. With negative argument, indents preceding lines.
+ Note that the binding of TAB to this function holds only in Lisp mode. In text
+mode TAB is bound to the Tab To Tab Stop command and the other keys bound to
+this function are undefined.
+
+###99
+Command: Lowercase Region
+
+Function: lowercase-region-command
+Key: C-X C-L
+See Definition: Region
+Action Type: Alter Existing Text
+
+Convert region to lower case.
+
+###100
+Command: Lowercase Word
+
+Function: lowercase-word-command
+Key: M-L
+Topic: Text
+Action Type: Alter Existing Text
+
+Convert one word to lower case, moving past it. With arg, applies to that many
+words backward or forward. If backward, the cursor does not move.
+
+###101
+Command: M-X Prefix
+
+Function: m-x-prefix
+Key: C-M-X
+Key: M-X
+Action Type: Subsequent Command Modifier
+
+Read an extended command from the terminal with completion. Completion is
+performed by SPACE and RETURN. This command reads the name of an extended
+command, with completion, then executes that command. The command may itself
+prompt for input.
+
+###102
+Command: Mark Beginning
+
+Function: mark-beginning-command
+Key: C-<
+Action Type: Mark
+
+Set mark at beginning of buffer.
+
+###103
+Command: Mark Defun
+
+Function: mark-defun-command
+Key: C-M-BACKSPACE
+Key: C-M-H
+Key: M-BACKSPACE
+Mode: Lisp
+Topic: Lisp
+See Definition: Defun
+Action Type: Mark
+
+Put point and mark around this defun (or next).
+
+###104
+Command: Mark End
+
+Function: mark-end-command
+Key: C->
+Action Type: Mark
+
+Set mark at end of buffer.
+
+###105
+Command: Mark Form
+
+Function: mark-form-command
+Key: C-M-@
+Mode: Lisp
+Topic: Lisp
+Action Type: Mark
+
+Set mark after (n>0) or before (n<0) |n| forms from point where n is the command
+argument.
+
+###106
+Command: Mark Paragraph
+
+Function: mark-paragraph-command
+Key: M-H
+Topic: Text
+See Definition: Paragraph
+Action Type: Mark
+Action Type: Move Point
+
+Put point and mark around this paragraph. In between paragraphs, puts it around
+the next one.
+
+###107
+Command: Mark Whole Buffer
+
+Function: mark-whole-buffer-command
+Key: C-X H
+Action Type: Mark
+Action Type: Move Point
+
+Set point at beginning and mark at end of buffer. Pushes the old point on the
+mark first, so two pops restore it.
+
+###108
+Command: Mark Word
+
+Function: mark-word-command
+Key: M-@
+Topic: Text
+Action Type: Mark
+
+Set mark after (n>0) or before (n<0) |n| words from point where n is the command
+argument.
+
+###109
+Command: Move Backward Character
+
+Function: move-backward-character-command
+Key: C-B
+Key: ESC-D
+Action Type: Move Point
+
+Move back one character. With argument, move that many characters backward.
+Negative arguments move forward.
+
+###110
+Command: Move Backward Defun
+
+Function: move-backward-defun-command
+Key: C-M-A
+Key: C-M-[
+Mode: Lisp
+Topic: Lisp
+See Definition: Defun
+Action Type: Move Point
+
+Move to beginning of this or previous defun. With a negative argument, moves
+forward to the beginning of a defun.
+
+###111
+Command: Move Backward Form
+
+Function: move-backward-form-command
+Key: C-M-B
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move back one form. With argument, move that many forms backward. Negative
+arguments move forward.
+
+###112
+Command: Move Backward List
+
+Function: move-backward-list-command
+Key: C-M-P
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move back one list. With argument, move that many lists backward. Negative
+arguments move forward.
+
+###113
+Command: Move Backward Word
+
+Function: move-backward-word-command
+Key: ESC-4
+Key: M-B
+Topic: Text
+Action Type: Move Point
+
+Move back one word. With argument, move that many words backward. Negative
+arguments move forward.
+
+###114
+Command: Move Down
+
+Function: move-down-command
+Key: ESC-B
+See Global: Goal Column
+Action Type: Move Point
+
+Move point down a line. If a command argument n is given, move point down (n>0)
+or up (n<0) by |n| lines.
+
+###115
+Command: Move Down Extending
+
+Function: move-down-extending-command
+Key: C-N
+See Global: Goal Column
+Action Type: Move Point
+
+Move down vertically to next line. If given an argument moves down (n>0) or up
+(n<0) |n| lines where n is the command argument. If given without an argument
+after the last LF in the buffer, makes a new one at the end.
+
+###116
+Command: Move Forward Character
+
+Function: move-forward-character-command
+Key: C-F
+Key: ESC-C
+Action Type: Move Point
+
+Move forward one character. With argument, move that many characters forward.
+Negative args move backward.
+
+###117
+Command: Move Forward Form
+
+Function: move-forward-form-command
+Key: C-M-F
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move forward one form. With argument, move that many forms forward. Negative
+args move backward.
+
+###118
+Command: Move Forward List
+
+Function: move-forward-list-command
+Key: C-M-N
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Point
+
+Move forward one list. With argument, move that many lists forward. Negative
+args move backward.
+
+###119
+Command: Move Forward Word
+
+Function: move-forward-word-command
+Key: ESC-5
+Key: M-F
+Topic: Text
+Action Type: Move Point
+
+Move forward one word. With argument, move that many words forward. Negative
+args move backward.
+
+###120
+Command: Move To Buffer End
+
+Function: move-to-buffer-end-command
+Key: ESC-F
+Key: M->
+Action Type: Move Point
+
+Go to end of buffer (leaving mark behind).
+
+###121
+Command: Move To Buffer Start
+
+Function: move-to-buffer-start-command
+Key: ESC-H
+Key: M-<
+Action Type: Move Point
+
+Go to beginning of buffer (leaving mark behind).
+
+###122
+Command: Move To End Of Line
+
+Function: move-to-end-of-line-command
+Key: C-E
+Action Type: Move Point
+
+Move point to end of line. With positive argument n goes down n-1 lines, then
+to the end of line. With zero argument goes up a line, then to line end. With
+negative argument n goes up |n|+1 lines, then to the end of line.
+
+###123
+Command: Move To Screen Edge
+
+Function: move-to-screen-edge-command
+Key: M-R
+Action Type: Move Point
+
+Jump to top or bottom of screen. Like Control-L except that point is changed
+instead of the window. With no argument, jumps to the center. An argument
+specifies the number of lines from the top, (negative args count from the
+bottom).
+
+###124
+Command: Move To Start Of Line
+
+Function: move-to-start-of-line-command
+Key: C-A
+Action Type: Move Point
+
+Move point to beginning of line. With positive argument n goes down n-1 lines,
+then to the beginning of line. With zero argument goes up a line, then to line
+beginning. With negative argument n goes up |n|+1 lines, then to the beginning
+of line.
+
+###125
+Command: Move Up
+
+Function: move-up-command
+Key: C-P
+Key: ESC-A
+See Global: Goal Column
+Action Type: Move Point
+
+Move up vertically to next line. If given an argument moves up (n>0) or down
+(n<0) |n| lines where n is the command argument.
+
+###126
+Command: Negative Argument
+
+Function: negative-argument
+Key: C--
+Key: C-M--
+Key: M--
+Action Type: Subsequent Command Modifier
+
+Make argument to next command negative.
+
+###127
+Command: Next Screen
+
+Function: next-screen-command
+Key: C-V
+Action Type: Move Point
+
+Move down to display next screenful of text. With argument, moves window down
+<arg> lines (negative moves up). Just minus as an argument moves up a full
+screen.
+
+###128
+Command: Nmode Abort
+
+Function: nmode-abort-command
+Key: C-G
+Action Type: Escape
+
+This command provides a way of aborting input requests.
+
+###129
+Command: Nmode Exit To Superior
+
+Function: nmode-exit-to-superior
+Key: C-X C-Z
+Action Type: Escape
+
+Go back to EMACS's superior job.
+
+###130
+Command: Nmode Full Refresh
+
+Function: nmode-full-refresh
+Key: ESC-J
+Action Type: Alter Display Format
+
+This function refreshes the screen after first clearing the display. It it used
+when the state of the display is in doubt.
+
+###131
+Command: Nmode Gc
+
+Function: nmode-gc
+Key: M-X Make Space
+
+Reclaims any internal wasted space.
+
+###132
+Command: Nmode Invert Video
+
+Function: nmode-invert-video
+Key: C-X V
+Action Type: Alter Display Format
+
+Toggle between normal and inverse video.
+
+###133
+Command: Nmode Refresh
+
+Function: nmode-refresh-command
+Key: C-L
+Action Type: Alter Display Format
+
+Choose new window putting point at center, top or bottom. With no argument,
+chooses a window to put point at the center. An argument gives the line to put
+point on; negative args count from the bottom.
+
+###134
+Command: One Window
+
+Function: one-window-command
+Key: C-X 1
+Action Type: Alter Display Format
+
+Display only one window. Normally, we display what used to be in the top
+window, but a numeric argument says to display what was in the bottom one.
+
+###135
+Command: Open Line
+
+Function: open-line-command
+Key: C-O
+Key: ESC-L
+Action Type: Insert Constant
+
+Insert a CRLF after point. Differs from ordinary insertion in that point
+remains before the inserted characters. With positive argument, inserts several
+CRLFs. With negative argument does nothing.
+
+###136
+Command: Other Window
+
+Function: other-window-command
+Key: C-X O
+Action Type: Alter Display Format
+Action Type: Move Point
+
+Switch to the other window. In two-window mode, moves cursor to other window.
+In one-window mode, exchanges contents of visible window with remembered
+contents of (invisible) window two. An argument means switch windows but select
+the same buffer in the other window.
+
+###137
+Command: Prepend To File
+
+Function: prepend-to-file-command
+Key: M-X Prepend To File
+Topic: Files
+See Definition: Region
+Action Type: Move Data
+
+Append region to start of specified file.
+
+###138
+Command: Previous Screen
+
+Function: previous-screen-command
+Key: M-V
+Action Type: Move Point
+
+Move up to display previous screenful of text. When an argument is present,
+move the window back (n>0) or forward (n<0) |n| lines, where n is the command
+argument.
+
+###139
+Command: Put Register
+
+Function: put-register-command
+Key: C-X X
+Action Type: Preserve
+
+Put point to mark into register (reads name from keyboard). With an argument,
+the text is also deleted.
+
+###140
+Command: Query Replace
+
+Function: query-replace-command
+Key: M-%
+Key: M-X Query Replace
+Action Type: Alter Existing Text
+Action Type: Select
+
+Replace occurrences of a string from point to the end of the buffer, asking
+about each occurrence. Query Replace prompts for the string to be replaced and
+for its potential replacement. Query Replace displays each occurrence of the
+string to be replaced, you then type a character to say what to do. Space =>
+replace it with the potential replacement and show the next copy. Rubout =>
+don't replace, but show next copy. Comma => replace this copy and show result,
+waiting for next command. ^ => return to site of previous copy. ^L =>
+redisplay screen. Exclamation mark => replace all remaining copys without
+asking. Period => replace this copy and exit. Escape => just exit.
+
+###141
+Command: Rename Buffer
+
+Function: rename-buffer-command
+Key: M-X Rename Buffer
+Topic: Buffers
+Action Type: Set Global Variable
+
+Change the name of the current buffer. The new name is read from the keyboard.
+If the user provides an empty string, the buffer name will be set to a truncated
+version of the filename associated with the buffer.
+
+###142
+Command: Replace String
+
+Function: replace-string-command
+Key: C-%
+Key: M-X Replace String
+Action Type: Alter Existing Text
+Action Type: Select
+
+Replace string with another from point to buffer end.
+
+###143
+Command: Reposition Window
+
+Function: reposition-window-command
+Key: C-M-R
+Mode: Lisp
+Topic: Lisp
+Action Type: Alter Display Format
+
+Reposition screen window appropriately. Tries to get all of current defun on
+screen. Never moves the pointer.
+
+###144
+Command: Return
+
+Function: return-command
+Key: RETURN
+Action Type: Insert Constant
+
+Insert CRLF, or move onto empty line. Repeated by positive argument. No action
+with negative argument.
+
+###145
+Command: Reverse Search
+
+Function: reverse-search-command
+Key: C-R
+See Command: Incremental Search
+Action Type: Move Point
+Action Type: Select
+
+Incremental Search Backwards. Like Control-S but in reverse.
+
+###146
+Command: Revert File
+
+Function: revert-file-command
+Key: M-X Revert File
+Topic: Files
+Action Type: Remove
+
+Undo changes to a file. Reads back the file being edited from disk
+
+###147
+Command: Save All Files
+
+Function: save-all-files-command
+Key: M-X Save All Files
+Topic: Buffers
+Topic: Files
+Action Type: Preserve
+
+Offer to write back each buffer which may need it. For each buffer which is
+visiting a file and which has been modified, you are asked whether to save it.
+A numeric arg means don't ask; save everything.
+
+###148
+Command: Save File
+
+Function: save-file-command
+Key: C-X C-S
+Topic: Files
+Action Type: Preserve
+
+Save visited file on disk if modified.
+
+###149
+Command: Scroll Other Window
+
+Function: scroll-other-window-command
+Key: C-M-V
+Action Type: Alter Display Format
+
+Scroll other window up several lines. Specify the number as a numeric argument,
+negative for down. The default is a whole screenful up. Just Meta-Minus as
+argument means scroll a whole screenful down.
+
+###150
+Command: Scroll Window Down Line
+
+Function: scroll-window-down-line-command
+Key: ESC-T
+Action Type: Alter Display Format
+
+Scroll the contents of the window down (n > 0) or up (n < 0) by |n| lines where
+n is the command argument. The "window position" may be adjusted to keep it
+within the window. Ding if the window contents does not move.
+
+###151
+Command: Scroll Window Down Page
+
+Function: scroll-window-down-page-command
+Key: ESC-V
+Action Type: Alter Display Format
+
+Scroll the contents of the window down (n > 0) or up (n < 0) by |n| screenfuls
+where n is the command argument. The "window position" may be adjusted to keep
+it within the window. Ding if the window contents does not move.
+
+###152
+Command: Scroll Window Left
+
+Function: scroll-window-left-command
+Key: C-X <
+Action Type: Alter Display Format
+
+Scroll the contents of the specified window right (n > 0) or left (n < 0) by |n|
+columns where n is the command argument.
+
+###153
+Command: Scroll Window Right
+
+Function: scroll-window-right-command
+Key: C-X >
+Action Type: Alter Display Format
+
+Scroll the contents of the specified window left (n > 0) or right (n < 0) by |n|
+columns where n is the command argument.
+
+###154
+Command: Scroll Window Up Line
+
+Function: scroll-window-up-line-command
+Key: ESC-S
+Action Type: Alter Display Format
+
+Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines where
+n is the command argument. The "window position" may be adjusted to keep it
+within the window. Ding if the window contents does not move.
+
+###155
+Command: Scroll Window Up Page
+
+Function: scroll-window-up-page-command
+Key: ESC-U
+Action Type: Alter Display Format
+
+Scroll the contents of the window up (n > 0) or down (n < 0) by |n| screenfuls
+where n is the command argument. The "window position" may be adjusted to keep
+it within the window. Ding if the window contents does not move.
+
+###156
+Command: Select Buffer
+
+Function: select-buffer-command
+Key: C-X B
+Key: M-X Select Buffer
+Topic: Buffers
+Action Type: Move Point
+
+Select or create buffer with specified name. Buffer name is read from keyboard.
+Name completion is performed by SPACE and RETURN.
+
+###157
+Command: Select Previous Buffer
+
+Function: select-previous-buffer-command
+Key: C-M-L
+Topic: Buffers
+Action Type: Move Point
+
+Select the previous buffer of the current buffer, if it exists and is
+selectable. Otherwise, select the MAIN buffer.
+
+###158
+Command: Set Fill Column
+
+Function: set-fill-column-command
+Key: C-X F
+See Global: Fill Column
+Action Type: Set Global Variable
+
+Set fill column to numeric arg or current column. If there is an argument, that
+is used. Otherwise, the current position of the cursor is used. The Fill
+Column variable controls where Auto Fill mode and the fill commands put the
+right margin.
+
+###159
+Command: Set Fill Prefix
+
+Function: set-fill-prefix-command
+Key: C-X .
+See Global: Fill Prefix
+Action Type: Set Global Variable
+
+Defines Fill Prefix from current line. All of the current line up to point
+becomes the value of Fill Prefix. Auto Fill Mode inserts the prefix on each
+line; the Fill Paragraph command assumes that each non-blank line starts with
+the prefix (which is ignored for filling purposes). To stop using a Fill
+Prefix, do Control-X . at the front of a line.
+
+###160
+Command: Set Goal Column
+
+Function: set-goal-column-command
+Key: C-X C-N
+Action Type: Set Global Variable
+
+Set (or flush) a permanent goal for vertical motion. With no argument, makes
+the current column the goal for vertical motion commands. They will always try
+to go to that column. With argument, clears out any previously set goal. Only
+Control-P and Control-N are affected.
+
+###161
+Command: Set Key
+
+Function: set-key-command
+Key: M-X Set Key
+Action Type: Set Global Variable
+
+Put a function on a key. The function name is a string argument. The key is
+always read from the terminal (not a string argument). It may contain metizers
+and other prefix characters.
+
+###162
+Command: Set Mark
+
+Function: set-mark-command
+Key: C-@
+Key: C-SPACE
+Action Type: Mark
+
+Sets or pops the mark. With no ^U's, pushes point as the mark. With one ^U,
+pops the mark into point. With two ^U's, pops the mark and throws it away.
+
+###163
+Command: Set Visited Filename
+
+Function: set-visited-filename-command
+Key: M-X Set Visited Filename
+Topic: Files
+Action Type: Set Global Variable
+
+Change visited filename, without writing file. The user is prompted for a
+filename. What NMODE believes to be the name of the visited file associated
+with the current buffer is set from the user's input. No file's name is
+actually changed.
+
+###164
+Command: Split Line
+
+Function: split-line-command
+Key: C-M-O
+Action Type: Insert Constant
+
+Move rest of this line vertically down. Inserts a CRLF, and then enough
+tabs/spaces so that what had been the rest of the current line is indented as
+much as it had been. Point does not move, except to skip over indentation that
+originally followed it. With positive argument, makes extra blank lines in
+between. No action with negative argument.
+
+###165
+Command: Start Scripting
+
+Function: start-scripting-command
+Key: M-X Start Scripting
+Action Type: Change Mode
+
+This function prompts the user for a buffer name, into which it will copy all
+the user's commands (as well as executing them) until the stop-scripting-command
+is invoked. This command supercedes any such previous request. Note that to
+keep the lines of reasonable length, free Newlines will be inserted from time to
+time. Because of this, and because many file systems cannot represent stray
+Newlines, the Newline character is itself scripted as a CR followed by a TAB,
+since this is its normal definition. Someday, perhaps, this hack will be
+replaced by a better one.
+
+###166
+Command: Start Timing
+
+Function: start-timing-command
+Key: M-X Start Timing Nmode
+Action Type: Change Mode
+
+This cleans up a number of global variables associated with timing, prompts for
+a file in which to put the timing data (or defaults to a file named "timing", of
+type "txt"), and starts the timing. Information is collected on the total time,
+refresh time, read time, command execution time, total number of cons cells
+built, and total number of garbage collections performed.
+
+###167
+Command: Stop Scripting
+
+Function: stop-scripting-command
+Key: M-X Stop Scripting
+Action Type: Change Mode
+
+This command stops the echoing of user commands into a script buffer. This
+command is itself echoed before the creation of the script stops.
+
+###168
+Command: Stop Timing
+
+Function: stop-timing-command
+Key: M-X Stop Timing Nmode
+Action Type: Change Mode
+
+This stops the timing, formats the output data, and closes the file into which
+the timing information is going. Information is collected on the total time,
+refresh time, read time, command execution time, total number of cons cells
+built, and total number of garbage collections performed. In addition to these
+numbers, some ratios are printed.
+
+###169
+Command: Tab To Tab Stop
+
+Function: tab-to-tab-stop-command
+Key: M-I
+Key: M-TAB
+Key: TAB
+See Command: Lisp Tab
+Action Type: Insert Constant
+
+Insert a tab character. Note that the binding of TAB to this command only holds
+in text mode, not in lisp mode, where it is bound to the Lisp Tab command. In
+lisp mode, the other keys continue to be bound to this command.
+
+###170
+Command: Text Mode
+
+Function: text-mode-command
+Key: M-X Text Mode
+Topic: Text
+Action Type: Change Mode
+
+Set things up for editing English text. Tab inserts tab characters. There are
+no comments. Auto Fill does not indent new lines.
+
+###171
+Command: Transpose Characters
+
+Function: transpose-characters-command
+Key: C-T
+See Command: Transpose Words
+Action Type: Alter Existing Text
+
+Transpose the characters before and after the cursor. For more details, see
+Meta-T, reading "character" for "word". However: at the end of a line, with no
+argument, the preceding two characters are transposed.
+
+###172
+Command: Transpose Forms
+
+Function: transpose-forms
+Key: C-M-T
+Mode: Lisp
+Topic: Lisp
+See Command: Transpose Words
+Action Type: Alter Existing Text
+
+Transpose the forms before and after the cursor. For more details, see Meta-T,
+reading "Form" for "Word".
+
+###173
+Command: Transpose Lines
+
+Function: transpose-lines
+Key: C-X C-T
+See Command: Transpose Words
+Action Type: Alter Existing Text
+
+Transpose the lines before and after the cursor. For more details, see Meta-T,
+reading "Line" for "Word".
+
+###174
+Command: Transpose Regions
+
+Function: transpose-regions
+Key: C-X T
+See Definition: Region
+Action Type: Alter Existing Text
+
+Transpose regions defined by cursor and last 3 marks. To transpose two
+non-overlapping regions, set the mark successively at three of the four
+boundaries, put point at the fourth, and call this function.
+
+###175
+Command: Transpose Words
+
+Function: transpose-words
+Key: M-T
+Topic: Text
+Action Type: Alter Existing Text
+
+Transpose the words before and after the cursor. With a positive argument it
+transposes the words before and after the cursor, moves right, and repeats the
+specified number of times, dragging the word to the left of the cursor right.
+With a negative argument, it transposes the two words to the left of the cursor,
+moves between them, and repeats the specified number of times, exactly undoing
+the positive argument form. With a zero argument, it transposes the words at
+point and mark.
+
+###176
+Command: Two Windows
+
+Function: two-windows-command
+Key: C-X 2
+Action Type: Alter Display Format
+
+Show two windows and select window two. An argument > 1 means give window 2 the
+same buffer as in Window 1.
+
+###177
+Command: Undelete File
+
+Function: undelete-file-command
+Key: M-X Undelete File
+Topic: Files
+Action Type: Move Data
+Action Type: Preserve
+
+This command prompts the user for the name of the file. NMODE will fill in a
+partly specified filename (eg filetype can be defaulted). If possible, the file
+will then be undeleted, and a message to that effect will be displayed. If the
+operation fails, the bell will sound.
+
+###178
+Command: Universal Argument
+
+Function: universal-argument
+Key: C-U
+Action Type: Subsequent Command Modifier
+
+Sets argument or multiplies it by four. Followed by digits, uses them to
+specify the argument for the command after the digits. If not followed by
+digits, multiplies the argument by four.
+
+###179
+Command: Unkill Previous
+
+Function: unkill-previous
+Key: M-Y
+See Global: Kill Ring
+See Definition: Region
+Action Type: Alter Existing Text
+
+Delete (without saving away) the current region, and then unkill (yank) the
+specified entry in the kill ring. "Ding" if the current region does not contain
+the same text as the current entry in the kill ring. If one has just retrieved
+the top entry from the kill ring this has the effect of displaying the item just
+beneath it, then the item beneath that and so on until the original top entry
+rotates back into view.
+
+###180
+Command: Upcase Digit
+
+Function: upcase-digit-command
+Key: M-'
+Action Type: Alter Existing Text
+
+Convert last digit to shifted character. Looks on current line back from point,
+and previous line. The first time you use this command, it asks you to type the
+row of digits from 1 to 9 and then 0, holding down Shift, to determine how your
+keyboard is set up.
+
+###181
+Command: Uppercase Initial
+
+Function: uppercase-initial-command
+Key: M-C
+Topic: Text
+Action Type: Alter Existing Text
+
+Put next word in lower case, but capitalize initial. With arg, applies to that
+many words backward or forward. If backward, the cursor does not move.
+
+###182
+Command: Uppercase Region
+
+Function: uppercase-region-command
+Key: C-X C-U
+See Definition: Region
+Action Type: Alter Existing Text
+
+Convert region to upper case.
+
+###183
+Command: Uppercase Word
+
+Function: uppercase-word-command
+Key: M-U
+Topic: Text
+Action Type: Alter Existing Text
+
+Convert one word to upper case, moving past it. With arg, applies to that many
+words backward or forward. If backward, the cursor does not move.
+
+###184
+Command: View Two Windows
+
+Function: view-two-windows-command
+Key: C-X 3
+Action Type: Alter Display Format
+
+Show two windows but stay in first.
+
+###185
+Command: Visit File
+
+Function: visit-file-command
+Key: C-X C-V
+Key: M-X Visit File
+Topic: Files
+Action Type: Move Data
+Action Type: Move Point
+
+Visit new file in current buffer. The user is prompted for the filename. If
+the current buffer is modified, the user is asked whether to write it out.
+
+###186
+Command: Visit In Other Window
+
+Function: visit-in-other-window-command
+Key: C-X 4
+Topic: Files
+Topic: Buffers
+Action Type: Move Point
+Action Type: Alter Display Format
+
+Find buffer or file in other window. Follow this command by B and a buffer
+name, or by F and a file name. We find the buffer or file in the other window,
+creating the other window if necessary.
+
+###187
+Command: What Cursor Position
+
+Function: what-cursor-position-command
+Key: C-=
+Key: C-X =
+Action Type: Inform
+
+Print various things about where cursor is. Print the X position, the Y
+position, the octal code for the following character, point absolutely and as a
+percentage of the total file size, and the virtual boundaries, if any. If a
+positive argument is given point will jump to the line number specified by the
+argument. A negative argument triggers a jump to the first line in the buffer.
+
+###188
+Command: Write File
+
+Function: write-file-command
+Key: C-X C-W
+Key: M-X Write File
+Topic: Files
+Action Type: Preserve
+
+Prompts for file name. Stores the current buffer in specified file. This file
+becomes the one being visited.
+
+###189
+Command: Write Region
+
+Function: write-region-command
+Key: M-X Write Region
+Topic: Files
+See Definition: Region
+Action Type: Preserve
+
+Write region to file. Prompts for file name.
+
+###190
+Command: Write Screen Photo
+
+Function: write-screen-photo-command
+Key: C-X P
+Topic: Files
+Action Type: Preserve
+
+Ask for filename, write out the screen to the file.
+
+###191
+Command: Yank Last Output
+
+Function: yank-last-output-command
+Key: Lisp-Y
+Mode: Lisp
+Topic: Lisp
+Action Type: Move Data
+
+Insert "last output" typed in the OUTPUT buffer.
ADDED psl-1983/3-1/doc/nmode/manual.ibm
Index: psl-1983/3-1/doc/nmode/manual.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/manual.ibm
@@ -0,0 +1,3127 @@
+,MOD
+- R 44X (11 February 1983) <PSL.NMODE-DOC>MANUAL.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 201/NMODE Reference Manual
+
+
+ Preliminary Edition
+
+
+
+
+ 11 February 1983 11:07:16
+
+
+
+
+
+
+
+
+
+
+ This document is a preliminary edition of the NMODE Reference
+ Manual. Do not distribute this document!
+
+ 201/- 2 - NMODE Manual
+ 201/NMODE Manual - 5 - Introduction
+
+
+ 202/1. Introduction
+
+ 201/This document describes the NMODE text editor. NMODE is an interactive,
+ multiple-window, screen-oriented editor written in PSL (Portable Standard
+ Lisp). NMODE provides a compatible subset of the EMACS text editor,
+ developed at M.I.T. It also contains a number of extensions, most notably an
+ interface to the underlying Lisp system for Lisp programmers.
+
+ NMODE was developed at the Hewlett-Packard Laboratories Computer Research
+ Center by Alan Snyder. A number of significant extensions have been
+ contributed by Jeff Soreff.
+
+ NMODE is based on an earlier editor, EMODE, written in PSL by William F.
+ Galway at the University of Utah. Many of the basic ideas and the
+ underlying structure of the NMODE editor come directly from EMODE.
+
+ This document is only partially complete, but is being reprinted at this time
+ for the benefit of new users that are not familiar with EMACS. The bulk of
+ this document has been borrowed from EMACS documentation and modified
+ appropriately in areas where NMODE and EMACS differ.
+ 201/Introduction - 6 - NMODE Manual
+ 201/NMODE Manual - 7 - Action Types
+
+
+ 202/2. Action Types
+
+ 201/This section defines a number of 203/action types201/, which are used in the
+ descriptions of NMODE commands.
+
+
+
+
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Alter Display Format
+
+ 201/This type of command alters how text is displayed without altering the
+ contents of existing buffers.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Alter Existing Text
+
+ 201/This type of command alters some part of the existing text, generally
+ transforming and/or moving text rather than just inserting or deleting it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Change Mode
+
+ 201/This type of command turns some feature(s) of the editor on or off. This
+ may include major modes, minor modes, timing, or scripting.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Escape
+
+ 201/Escape from the current level.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Inform
+
+ 201/This type of command informs the user of some property of the text being
+ worked with, or of the state of the editor (including where point is, what the
+ existing buffer(s) is(are), what is in the documentation, etc.).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Insert Constant
+
+ 201/This type of command inserts a character constant like tab or space or a
+ multiple thereof.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Mark
+
+ 201/This type of command sets mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Action Types - 8 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Move Data
+
+ 201/This command copies some data (which is not a constant wired into the
+ program) from one place to another.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Move Point
+
+ 201/This type of command moves point. It may move it within a buffer or from
+ buffer to buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Preserve
+
+ 201/Make a copy of something current and put it somewhere else (usually disc).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Remove
+
+ 201/This type of command allows a user to get rid of data, either killing or
+ deleting text or removing files or directory entries.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Select
+
+ 201/This type of command finds particular strings in text, and may perform some
+ action upon them, such as counting, replacement, or deletion.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Set Global Variable
+
+ 201/This type of command sets some global variable which tends to remain stable
+ for some time, such as prefix variables and key bindings.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Subsequent Command Modifier
+
+ 201/This type of command modifies the meaning of the keys that immediately follow
+ it, as the prefix commands and the argument commands do.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 9 - Definitions
+
+
+ 202/3. Definitions
+
+ 201/This section defines a number of terms used in the descriptions of NMODE
+ commands.
+
+
+
+
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Defun
+
+ 201/A defun is a list whose ( falls in column 0. Its end is after the CRLF
+ following its ).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Paragraph
+
+ 201/Paragraphs are delimited by blank lines and psuedo-blank lines, which are
+ lines which don't match the existing fill prefix (when there is one), and,
+ when in text mode, also by indentation and by text justifier command lines,
+ which are currently defined as lines starting with a period and which are
+ treated as another type of psuedo-blank line. Paragraphs contain the final
+ CRLF after their last test, and contain any immediately preceding empty line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Region
+
+ 201/The region is that portion of text between point, the current buffer position,
+ and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Sentence
+
+ 201/A sentence is ended by a ., ? or ! followed by two spaces or a CRLF (with
+ optional space), with any number of "closing characters" ", ', ) and ]
+ between. A sentence also starts at the start of a paragraph. A sentence
+ also ends at the end of a paragraph.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Definitions - 10 - NMODE Manual
+ 201/NMODE Manual - 11 - Globals
+
+
+ 202/4. Globals
+
+ 201/This section defines a number of conceptual 203/global variables201/, which are
+ referred to in the descriptions of NMODE commands. These 203/globals 201/represent
+ state information that can affect the behavior of various NMODE commands.
+ The value of NMODE globals are set as the result of various NMODE
+ commands.
+
+
+
+
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Fill Column
+
+ 201/The fill column is the column beyond which all the fill commands: auto fill, fill
+ paragraph, fill region, and fill comment, will try to break up lines. The fill
+ column can be set by the Set Fill Column command.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Fill Prefix
+
+ 201/The fill prefix, if present, is a string that the fill paragraph and fill region
+ commands expect to see on the areas that they are filling. It is useful, for
+ instance, in filling indented text. Only the indented area will be filled, and
+ any new lines created by the filling will be properly indented. Autofill will
+ also insert it on each new line it starts.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Goal Column
+
+ 201/This is not yet correctly implemented
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Kill Ring
+
+ 201/The kill ring is a stack of the 16 most recently killed pieces of text. The
+ Insert Kill Buffer command reads text on the top of the kill ring and inserts
+ it back into the buffer. It can accept an argument, specifying an argument
+ other than the top one. If one knows that the text one wants is on the kill
+ ring, but is not certain how deeply it is buried, one can retrieve the top
+ item with the Insert Kill Buffer command, then look through the other items
+ one by one with the Unkill Previous command. This rotates the items on the
+ kill ring, displaying them one by one in a cycle.
+ Most kill commands push their text onto the top of the kill ring. If two kill
+ commands are performed right after each other, the text they kill is
+ concatenated. Commands the kill forward add onto the end of the previously
+ killed text. Commands that kill backward add onto the beginning. That way,
+ the text is assembled in its original order. If intervening commands have
+ taken place one can issue an Append Next Kill command before the next kill
+ in order to assemble the next killed text together with the text on top of the
+ kill ring.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Globals - 12 - NMODE Manual
+ 201/NMODE Manual - 13 - Command Descriptions
+
+
+ 202/5. Command Descriptions
+
+ 201/This section defines the basic NMODE commands. Each command description
+ includes the following information:
+
+ 203/command 201/A descriptive name of the command.
+
+ 203/function 201/The name of the Lisp function that implements the command.
+
+ 203/key 201/The logical keys on the keyboard that normally have this command
+ attached to them. A 203/logical key 201/includes ordinary keys such as
+ Tab or Rubout, 203/shifted 201/keys using the 202/Control 201/and/or 202/Meta
+ 201/modifiers (e.g., C-F, M-F, and C-M-F), 203/prefixed commands 201/using
+ C-X, C-], or Escape (e.g., C-X C-F, C-] E, and Esc-L), and
+ 203/extended commands 201/using 202/Meta-X 201/(e.g., M-X Delete Matching
+ Lines).
+
+ 203/action type 201/One of a number of descriptive terms that categorize the behavior
+ of commands. Action types are defined in Chapter 2.
+
+ 203/mode 201/Some commands are defined only in certain modes. If present,
+ this attribute specifies the mode or modes in which the command
+ is normally defined.
+
+ 203/topic 201/A keyword that describes the command. Topics are listed in the
+ Topic Index, Chapter 9.
+ 201/Command Descriptions - 14 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Append Next Kill
+
+ 201/Function: append-next-kill-command
+ Key: C-M-W
+ See Global: Kill Ring
+ Action Type: Move Data
+
+ Make following kill commands append to last batch. Thus, C-K C-K, cursor
+ motion, this command, and C-K C-K, generate one block of killed stuff,
+ containing two lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Append To Buffer
+
+ 201/Function: append-to-buffer-command
+ Key: C-X A
+ Topic: Buffers
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to specified buffer. The buffer's name is read from the
+ keyboard; the buffer is created if nonexistent. A numeric argument causes
+ us to "prepend" instead. We always insert the text at that buffer's pointer,
+ but when "prepending" we leave the pointer before the inserted text.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Append To File
+
+ 201/Function: append-to-file-command
+ Key: M-X Append To File
+ Topic: Files
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to end of specified file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Apropos
+
+ 201/Function: apropos-command
+ Key: M-X Apropos
+ Action Type: Inform
+
+ M-X Apropos lists functions with names containing a string for which the user
+ is prompted.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 15 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Argument Digit
+
+ 201/Function: argument-digit
+ Key: C-0
+ Key: C-1
+ Key: C-2
+ Key: C-3
+ Key: C-4
+ Key: C-5
+ Key: C-6
+ Key: C-7
+ Key: C-8
+ Key: C-9
+ Key: C-M-0
+ Key: C-M-1
+ Key: C-M-2
+ Key: C-M-3
+ Key: C-M-4
+ Key: C-M-5
+ Key: C-M-6
+ Key: C-M-7
+ Key: C-M-8
+ Key: C-M-9
+ Key: M-0
+ Key: M-1
+ Key: M-2
+ Key: M-3
+ Key: M-4
+ Key: M-5
+ Key: M-6
+ Key: M-7
+ Key: M-8
+ Key: M-9
+ Action Type: Subsequent Command Modifier
+
+ Specify numeric argument for next command. Several such digits typed in a
+ row all accumulate.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Auto Fill Mode
+
+ 201/Function: auto-fill-mode-command
+ Key: M-X Auto Fill Mode
+ See Command: Set Fill Column
+ Action Type: Change Mode
+
+ Break lines between words at the right margin. A positive argument turns
+ Auto Fill mode on; zero or negative, turns it off. With no argument, the
+ mode is toggled. When Auto Fill mode is on, lines are broken at spaces to fit
+ the right margin (position controlled by Fill Column). You can set the Fill
+ Column with the Set Fill Column command.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 16 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Back To Indentation
+
+ 201/Function: back-to-indentation-command
+ Key: C-M-M
+ Key: C-M-RETURN
+ Key: M-M
+ Key: M-RETURN
+ Action Type: Move Point
+
+ Move to end of this line's indentation.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Kill Sentence
+
+ 201/Function: backward-kill-sentence-command
+ Key: C-X RUBOUT
+ See Global: Kill Ring
+ See Definition: Sentence
+ Action Type: Remove
+
+ Kill back to beginning of sentence. With a command argument n kills
+ backward (n>0) or forward (n>0) by |n| sentences.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Paragraph
+
+ 201/Function: backward-paragraph-command
+ Key: M-[
+ See Definition: Paragraph
+ Action Type: Move Point
+
+ Move backward to start of paragraph. When given argument moves backward
+ (n>0) or forward (n<0) by |n| paragraphs where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Sentence
+
+ 201/Function: backward-sentence-command
+ Key: M-A
+ See Definition: Sentence
+ Action Type: Move Point
+
+ Move to beginning of sentence. When given argument moves backward (n>0)
+ or forward (n<0) by |n| sentences where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 17 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Up List
+
+ 201/Function: backward-up-list-command
+ Key: C-(
+ Key: C-M-(
+ Key: C-M-U
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move up one level of list structure, backward. Given a command argument n
+ move up |n| levels backward (n>0) or forward (n<0).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Buffer Browser
+
+ 201/Function: buffer-browser-command
+ Key: C-X C-B
+ Key: M-X List Buffers
+ Topic: Buffers
+ Action Type: Inform
+
+ Put up a buffer browser subsystem. If an argument is given, then include
+ buffers whose names begin with "+".
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Buffer Not Modified
+
+ 201/Function: buffer-not-modified-command
+ Key: M-~
+ Topic: Buffers
+ Action Type: Set Global Variable
+
+ Pretend that this buffer hasn't been altered.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: C-X Prefix
+
+ 201/Function: c-x-prefix
+ Key: C-X
+ Action Type: Subsequent Command Modifier
+
+ The command Control-X is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 18 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Center Line
+
+ 201/Function: center-line-command
+ Key: M-S
+ Topic: Text
+ See Global: Fill Column
+ Action Type: Alter Existing Text
+
+ Center this line's text within the line. With argument, centers that many
+ lines and moves past. Centers current and preceding lines with negative
+ argument. The width is Fill Column.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Copy Region
+
+ 201/Function: copy-region
+ Key: M-W
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Preserve
+
+ Stick region into kill-ring without killing it. Like killing and getting back,
+ but doesn't mark buffer modified.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Count Occurrences
+
+ 201/Function: count-occurrences-command
+ Key: M-X Count Occurrences
+ Key: M-X How Many
+ Action Type: Inform
+
+ Counts occurrences of a string, after point. The user is prompted for the
+ string. Case is ignored in the count.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete And Expunge File
+
+ 201/Function: delete-and-expunge-file-command
+ Key: M-X Delete And Expunge File
+ Topic: Files
+ Action Type: Remove
+
+ This command prompts the user for the name of the file. NMODE will fill in
+ defaults in a partly specified filename (eg filetype can be defaulted). If
+ possible, the file will then be deleted and expunged, and a message to that
+ effect will be displayed. If the operation fails, the bell will sound.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 19 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Backward Hacking Tabs
+
+ 201/Function: delete-backward-hacking-tabs-command
+ Key: BACKSPACE
+ Key: C-RUBOUT
+ Key: RUBOUT
+ Mode: Lisp
+ Action Type: Remove
+
+ Delete character before point, turning tabs into spaces. Rather than deleting
+ a whole tab, the tab is converted into the appropriate number of spaces and
+ then one space is deleted. With positive arguments this operation is
+ performed multiple times on the text before point. With negative arguments
+ this operation is performed multiple times on the text after point.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Blank Lines
+
+ 201/Function: delete-blank-lines-command
+ Key: C-X C-O
+ Action Type: Remove
+
+ Delete all blank lines around this line's end. If done on a non-blank line,
+ deletes all spaces and tabs at the end of it, and all following blank lines
+ (Lines are blank if they contain only spaces and tabs). If done on a blank
+ line, deletes all preceding blank lines as well.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete File
+
+ 201/Function: delete-file-command
+ Key: M-X Delete File
+ Key: M-X Kill File
+ Topic: Files
+ Action Type: Remove
+
+ Delete a file. Prompts for filename.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Forward Character
+
+ 201/Function: delete-forward-character-command
+ Key: C-D
+ Key: ESC-P
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Delete character after point. With argument, kill that many characters
+ (saving them). Negative args kill characters backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 20 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Horizontal Space
+
+ 201/Function: delete-horizontal-space-command
+ Key: M-\
+ Action Type: Remove
+
+ Delete all spaces and tabs around point.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Indentation
+
+ 201/Function: delete-indentation-command
+ Key: M-^
+ Action Type: Remove
+
+ Delete CRLF and indentation at front of line. Leaves one space in place of
+ them. With argument, moves down one line first (deleting CRLF after current
+ line).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Matching Lines
+
+ 201/Function: delete-matching-lines-command
+ Key: M-X Delete Matching Lines
+ Key: M-X Flush Lines
+ Action Type: Select
+ Action Type: Remove
+
+ Delete Matching Lines: Prompts user for string. Deletes all lines containing
+ specified string.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Non-Matching Lines
+
+ 201/Function: delete-non-matching-lines-command
+ Key: M-X Delete Non-Matching Lines
+ Key: M-X Keep Lines
+ Action Type: Select
+ Action Type: Remove
+
+ Delete Non-Matching Lines: Prompts user for string. Deletes all lines not
+ containing specified string.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Dired
+
+ 201/Function: dired-command
+ Key: C-X D
+
+ Run Dired on the directory of the current buffer file. With no argument,
+ edits that directory. With an argument of 1, shows only the versions of the
+ file in the buffer. With an argument of 4, asks for input, only versions of
+ that file are shown.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 21 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Down List
+
+ 201/Function: down-list
+ Key: C-M-D
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move down one level of list structure, forward. Command argument
+ sensitivity not yet implemented.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Edit Directory
+
+ 201/Function: edit-directory-command
+ Key: M-X Dired
+ Key: M-X Edit Directory
+
+ DIRED: Edit a directory. The string argument may contain the filespec (with
+ wildcards of course)
+ D deletes the file which is on the current line. (also K,^D,^K)
+ U undeletes the current line file.
+ Rubout undeletes the previous line file.
+ Space is like ^N - moves down a line.
+ E edit the file.
+ S sorts files according to size, read or write date.
+ R does a reverse sort.
+ ? types a list of commands.
+ Q lists files to be deleted and asks for confirmation:
+ Typing YES deletes them; X aborts; N resumes DIRED.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: End Of Defun
+
+ 201/Function: end-of-defun-command
+ Key: C-M-E
+ Key: C-M-]
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Move Point
+
+ Move to end of this or next defun. With argument of 2, finds end of
+ following defun. With argument of -1, finds end of previous defun, etc.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 22 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Esc Prefix
+
+ 201/Function: esc-prefix
+ Key: ESCAPE
+ Action Type: Subsequent Command Modifier
+
+ The command esc-prefix is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it. Used for escape sequences
+ sent by function keys on the keyboard.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Exchange Point And Mark
+
+ 201/Function: exchange-point-and-mark
+ Key: C-X C-X
+ Action Type: Mark
+ Action Type: Move Point
+
+ Exchange positions of point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Exchange Windows
+
+ 201/Function: exchange-windows-command
+ Key: C-X E
+ Action Type: Alter Display Format
+
+ Exchanges the current window with the other window, which becomes current.
+ In two window mode, the windows swap physical positions.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute Buffer
+
+ 201/Function: execute-buffer-command
+ Key: M-X Execute Buffer
+ Topic: Buffers
+
+ This command makes NMODE take input from the specified buffer as if it were
+ typed in. This command supercedes any such previous request. Newline
+ characters are ignored when reading from a buffer. If a command argument
+ is given then only the last refresh of the screen triggered by the commands
+ actually occurs, otherwise all of the updating of the screen is visible.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute File
+
+ 201/Function: execute-file-command
+ Key: M-X Execute File
+ Topic: Files
+
+ This command makes NMODE take input from the specified file as if it were
+ typed in. This command supercedes any such previous request. Newline
+ characters are ignored when reading from a buffer. If a command argument
+ is given then only the last refresh of the screen triggered by the commands
+ actually occurs, otherwise all of the updating of the screen is visible.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 23 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute Form
+
+ 201/Function: execute-form-command
+ Key: Lisp-E
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Mark
+
+ Causes the Lisp reader to read and evaluate a form starting at the beginning
+ of the current line. We arrange for output to go to the end of the output
+ buffer. The mark is set at the current location in the input buffer, in case
+ user wants to go back.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Exit Nmode
+
+ 201/Function: exit-nmode
+ Key: Lisp-L
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ Leave NMODE, return to normal listen loop.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Fill Comment
+
+ 201/Function: fill-comment-command
+ Key: M-Z
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ Action Type: Alter Existing Text
+
+ This command creates a temporary fill prefix from the start of the current
+ line. It replaces the surrounding paragraph (determined using fill-prefix)
+ with a filled version. It leaves point at the a position bearing the same
+ relation to the filled text that the old point did to the old text.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Fill Paragraph
+
+ 201/Function: fill-paragraph-command
+ Key: M-Q
+ Topic: Text
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ Action Type: Alter Existing Text
+
+ This fills (or justifies) this (or next) paragraph. It leaves point at the a
+ position bearing the same relation to the filled text that the old point did to
+ the old text. A numeric argument triggers justification rather than filling.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 24 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Fill Region
+
+ 201/Function: fill-region-command
+ Key: M-G
+ Topic: Text
+ See Command: Set Fill Column
+ See Command: Set Fill Prefix
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ See Definition: Sentence
+ Action Type: Alter Existing Text
+
+ Fill text from point to mark. Fill Column specifies the desired text width.
+ Fill Prefix if present is a string that goes at the front of each line and is not
+ included in the filling. See Set Fill Column and Set Fill Prefix. An explicit
+ argument causes justification instead of filling. Each sentence which ends
+ within a line is followed by two spaces.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Find File
+
+ 201/Function: find-file-command
+ Key: C-X C-F
+ Key: M-X Find File
+ Topic: Files
+ Topic: Buffers
+ Action Type: Move Data
+ Action Type: Move Point
+
+ Visit a file in its own buffer. If the file is already in some buffer, select
+ that buffer. Otherwise, visit the file in a buffer named after the file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Forward Paragraph
+
+ 201/Function: forward-paragraph-command
+ Key: M-]
+ Topic: Text
+ See Definition: Paragraph
+ Action Type: Move Point
+
+ Move forward to end of this or the next paragraph. When given argument
+ moves forward (n>0) or backward (n<0) by |n| paragraphs where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 25 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Forward Sentence
+
+ 201/Function: forward-sentence-command
+ Key: M-E
+ Topic: Text
+ See Definition: Sentence
+ Action Type: Move Point
+
+ Move forward to end of this or the next sentence. When given argument
+ moves forward (n>0) or backward (n<0) by |n| sentences. where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Forward Up List
+
+ 201/Function: forward-up-list-command
+ Key: C-)
+ Key: C-M-)
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move up one level of list structure, forward. Given a command argument n
+ move up |n| levels forward (n>0) or backward (n<0).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Get Register
+
+ 201/Function: get-register-command
+ Key: C-X G
+ Action Type: Move Data
+ Action Type: Mark
+
+ Get contents of register (reads name from keyboard). The name is a single
+ letter or digit. Usually leaves the pointer before, and the mark after, the
+ text. With argument, puts point after and mark before.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Grow Window
+
+ 201/Function: grow-window-command
+ Key: C-X ^
+ Action Type: Alter Display Format
+
+ Make this window use more lines. Argument is number of extra lines (can be
+ negative).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 26 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Help Dispatch
+
+ 201/Function: help-dispatch
+ Key: C-?
+ Key: M-/
+ Key: M-?
+ Action Type: Inform
+
+ Prints the documentation of a command (not a function). The command
+ character is read from the terminal.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Incremental Search
+
+ 201/Function: incremental-search-command
+ Key: C-S
+ Action Type: Move Point
+ Action Type: Select
+
+ Search for character string as you type it. C-Q quotes special characters.
+ Rubout cancels last character. C-S repeats the search, forward, and C-R
+ repeats it backward. C-R or C-S with search string empty changes the
+ direction of search or brings back search string from previous search.
+ Altmode exits the search. Other Control and Meta chars exit the search and
+ then are executed. If not all the input string can be found, the rest is not
+ discarded. You can rub it out, discard it all with C-G, exit, or use C-R or
+ C-S to search the other way. Quitting a successful search aborts the search
+ and moves point back; quitting a failing search just discards whatever input
+ wasn't found.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Indent New line
+
+ 201/Function: indent-new-line-command
+ Key: NEWLINE
+ Action Type: Insert Constant
+
+ This function performs the following actions: Executes whatever function, if
+ any, is associated with <CR>. Executes whatever function, if any, is
+ associated with TAB, as if no command argument was given.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Buffer
+
+ 201/Function: insert-buffer-command
+ Key: M-X Insert Buffer
+ Topic: Buffers
+ Action Type: Move Data
+
+ Insert contents of another buffer into existing text. The user is prompted
+ for the buffer name. Point is left just before the inserted material, and mark
+ is left just after it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 27 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Closing bracket
+
+ 201/Function: insert-closing-bracket
+ Key: )
+ Key: ]
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Insert the character typed, which should be a closing bracket, then display
+ the matching opening bracket.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Comment
+
+ 201/Function: insert-comment-command
+ Key: M-;
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Move to the end of the current line, then add a "%" and a space at its end.
+ Leave point after the space.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Date
+
+ 201/Function: insert-date-command
+ Key: M-X Insert Date
+ Action Type: Move Data
+
+ Insert the current time and date after point. The mark is put after the
+ inserted text.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert File
+
+ 201/Function: insert-file-command
+ Key: M-X Insert File
+ Topic: Files
+ Action Type: Move Data
+
+ Insert contents of file into existing text. File name is string argument. The
+ pointer is left at the beginning, and the mark at the end.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 28 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Kill Buffer
+
+ 201/Function: insert-kill-buffer
+ Key: C-Y
+ See Global: Kill Ring
+ Action Type: Move Data
+ Action Type: Mark
+
+ Re-insert the last stuff killed. Puts point after it and the mark before it.
+ An argument n says un-kill the n'th most recent string of killed stuff (1 =
+ most recent). A null argument (just C-U) means leave point before, mark
+ after.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Next Character
+
+ 201/Function: insert-next-character-command
+ Key: C-Q
+ Action Type: Move Data
+
+ Reads a character and inserts it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Parens
+
+ 201/Function: insert-parens
+ Key: M-(
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Insert () putting point between them. Also make a space before them if
+ appropriate. With argument, put the ) after the specified number of already
+ existing s-expressions. Thus, with argument 1, puts extra parens around
+ the following s-expression.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Backward Form
+
+ 201/Function: kill-backward-form-command
+ Key: C-M-RUBOUT
+ Mode: Lisp
+ Topic: Lisp
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the last form. With a command argument kill the last (n>0) or next (n<0)
+ |n| forms, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 29 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Backward Word
+
+ 201/Function: kill-backward-word-command
+ Key: M-RUBOUT
+ Topic: Text
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill last word. With a command argument kill the last (n>0) or next (n<0)
+ |n| words, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Buffer
+
+ 201/Function: kill-buffer-command
+ Key: C-X K
+ Key: M-X Kill Buffer
+ Topic: Buffers
+ Action Type: Remove
+
+ Kill the buffer with specified name. The buffer name is taken from the
+ keyboard. Name completion is performed by SPACE and RETURN. If the
+ buffer has changes in it, the user is asked for confirmation.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Forward Form
+
+ 201/Function: kill-forward-form-command
+ Key: C-M-K
+ Mode: Lisp
+ Topic: Lisp
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the next form. With a command argument kill the next (n>0) or last
+ (n<0) |n| forms, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Forward Word
+
+ 201/Function: kill-forward-word-command
+ Key: M-D
+ Topic: Text
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the next word. With a command argument kill the next (n>0) or last
+ (n<0) |n| words, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 30 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Line
+
+ 201/Function: kill-line
+ Key: C-K
+ Key: ESC-M
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill to end of line, or kill an end of line. At the end of a line (only blanks
+ following) kill through the CRLF. Otherwise, kill the rest of the line but not
+ the CRLF. With argument (positive or negative), kill specified number of
+ lines forward or backward respectively. An argument of zero means kill to
+ the beginning of the ine, nothing if at the beginning. Killed text is pushed
+ onto the kill ring for retrieval.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Region
+
+ 201/Function: kill-region
+ Key: C-W
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Remove
+
+ Kill from point to mark. Use Control-Y and Meta-Y to get it back.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Sentence
+
+ 201/Function: kill-sentence-command
+ Key: M-K
+ Topic: Text
+ See Global: Kill Ring
+ See Definition: Sentence
+ Action Type: Remove
+
+ Kill forward to end of sentence. With minus one as an argument it kills back
+ to the beginning of the sentence. Positive or negative arguments mean to kill
+ that many sentences forward or backward respectively.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Some Buffers
+
+ 201/Function: kill-some-buffers-command
+ Key: M-X Kill Some Buffers
+ Topic: Buffers
+ Action Type: Remove
+
+ Kill Some Buffers: Offer to kill each buffer, one by one. If the buffer
+ contains a modified file and you say to kill it, you are asked for confirmation.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 31 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Abort
+
+ 201/Function: lisp-abort-command
+ Key: Lisp-A
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This command will pop out of an arbitrarily deep break loop.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Backtrace
+
+ 201/Function: lisp-backtrace-command
+ Key: Lisp-B
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Inform
+
+ This lists all the function calls on the stack. It is a good way to see how the
+ offending expression got generated.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Continue
+
+ 201/Function: lisp-continue-command
+ Key: Lisp-C
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This causes the expression last printed to be returned as the value of the
+ offending expression. This allows a user to recover from a low level error in
+ an involved calculation if they know what should have been returned by the
+ offending expression. This is also often useful as an automatic stub: If an
+ expression containing an undefined function is evaluated, a Break loop is
+ entered, and this may be used to return the value of the function call.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Help
+
+ 201/Function: lisp-help-command
+ Key: Lisp-?
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Inform
+
+ If in break print:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+ else print:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp
+ Listener"
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 32 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Indent Region
+
+ 201/Function: lisp-indent-region-command
+ Key: C-M-\
+ Mode: Lisp
+ Topic: Lisp
+
+ Indent all lines between point and mark. With argument, indents each line to
+ exactly that column. Otherwise, lisp indents each line. A line is processed
+ if its first character is in the region. It tries to preserve the textual
+ context of point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Indent sexpr
+
+ 201/Function: lisp-indent-sexpr
+ Key: C-M-Q
+ Mode: Lisp
+ Topic: Lisp
+
+ Lisp Indent each line contained in the next form. This command does NOT
+ respond to command arguments.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Mode
+
+ 201/Function: lisp-mode-command
+ Key: M-X Lisp Mode
+ Topic: Lisp
+ Action Type: Change Mode
+
+ Set things up for editing Lisp code. Tab indents for Lisp. Rubout hacks
+ tabs. Lisp execution commands availible. Paragraphs are delimited only by
+ blank lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Prefix
+
+ 201/Function: lisp-prefix
+ Key: C-]
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Subsequent Command Modifier
+
+ The command lisp-prefix is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 33 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Quit
+
+ 201/Function: lisp-quit-command
+ Key: Lisp-Q
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This exits the current break loop. It only pops up one level, unlike abort.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Retry
+
+ 201/Function: lisp-retry-command
+ Key: Lisp-R
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This tries to evaluate the offending expression again, and to continue the
+ computation. This is often useful after defining a missing function, or
+ assigning a value to a variable.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Tab
+
+ 201/Function: lisp-tab-command
+ Key: C-M-I
+ Key: C-M-TAB
+ Key: TAB
+ Mode: Lisp
+ Topic: Lisp
+ See Command: Tab To Tab Stop
+ Action Type: Alter Existing Text
+
+ Indent this line for a Lisp-like language. With arg, moves over and indents
+ that many lines. With negative argument, indents preceding lines.
+ Note that the binding of TAB to this function holds only in Lisp mode. In
+ text mode TAB is bound to the Tab To Tab Stop command and the other keys
+ bound to this function are undefined.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lowercase Region
+
+ 201/Function: lowercase-region-command
+ Key: C-X C-L
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Convert region to lower case.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 34 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lowercase Word
+
+ 201/Function: lowercase-word-command
+ Key: M-L
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Convert one word to lower case, moving past it. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: M-X Prefix
+
+ 201/Function: m-x-prefix
+ Key: C-M-X
+ Key: M-X
+ Action Type: Subsequent Command Modifier
+
+ Read an extended command from the terminal with completion. Completion is
+ performed by SPACE and RETURN. This command reads the name of an
+ extended command, with completion, then executes that command. The
+ command may itself prompt for input.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Beginning
+
+ 201/Function: mark-beginning-command
+ Key: C-<
+ Action Type: Mark
+
+ Set mark at beginning of buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Defun
+
+ 201/Function: mark-defun-command
+ Key: C-M-BACKSPACE
+ Key: C-M-H
+ Key: M-BACKSPACE
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Mark
+
+ Put point and mark around this defun (or next).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 35 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark End
+
+ 201/Function: mark-end-command
+ Key: C->
+ Action Type: Mark
+
+ Set mark at end of buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Form
+
+ 201/Function: mark-form-command
+ Key: C-M-@
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Mark
+
+ Set mark after (n>0) or before (n<0) |n| forms from point where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Paragraph
+
+ 201/Function: mark-paragraph-command
+ Key: M-H
+ Topic: Text
+ See Definition: Paragraph
+ Action Type: Mark
+ Action Type: Move Point
+
+ Put point and mark around this paragraph. In between paragraphs, puts it
+ around the next one.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Whole Buffer
+
+ 201/Function: mark-whole-buffer-command
+ Key: C-X H
+ Action Type: Mark
+ Action Type: Move Point
+
+ Set point at beginning and mark at end of buffer. Pushes the old point on
+ the mark first, so two pops restore it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Word
+
+ 201/Function: mark-word-command
+ Key: M-@
+ Topic: Text
+ Action Type: Mark
+
+ Set mark after (n>0) or before (n<0) |n| words from point where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 36 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Character
+
+ 201/Function: move-backward-character-command
+ Key: C-B
+ Key: ESC-D
+ Action Type: Move Point
+
+ Move back one character. With argument, move that many characters
+ backward. Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Defun
+
+ 201/Function: move-backward-defun-command
+ Key: C-M-A
+ Key: C-M-[
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Move Point
+
+ Move to beginning of this or previous defun. With a negative argument,
+ moves forward to the beginning of a defun.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Form
+
+ 201/Function: move-backward-form-command
+ Key: C-M-B
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move back one form. With argument, move that many forms backward.
+ Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward List
+
+ 201/Function: move-backward-list-command
+ Key: C-M-P
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move back one list. With argument, move that many lists backward.
+ Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 37 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Word
+
+ 201/Function: move-backward-word-command
+ Key: ESC-4
+ Key: M-B
+ Topic: Text
+ Action Type: Move Point
+
+ Move back one word. With argument, move that many words backward.
+ Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Down
+
+ 201/Function: move-down-command
+ Key: ESC-B
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move point down a line. If a command argument n is given, move point down
+ (n>0) or up (n<0) by |n| lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Down Extending
+
+ 201/Function: move-down-extending-command
+ Key: C-N
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move down vertically to next line. If given an argument moves down (n>0)
+ or up (n<0) |n| lines where n is the command argument. If given without an
+ argument after the last LF in the buffer, makes a new one at the end.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward Character
+
+ 201/Function: move-forward-character-command
+ Key: C-F
+ Key: ESC-C
+ Action Type: Move Point
+
+ Move forward one character. With argument, move that many characters
+ forward. Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 38 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward Form
+
+ 201/Function: move-forward-form-command
+ Key: C-M-F
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward one form. With argument, move that many forms forward.
+ Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward List
+
+ 201/Function: move-forward-list-command
+ Key: C-M-N
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward one list. With argument, move that many lists forward.
+ Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward Word
+
+ 201/Function: move-forward-word-command
+ Key: ESC-5
+ Key: M-F
+ Topic: Text
+ Action Type: Move Point
+
+ Move forward one word. With argument, move that many words forward.
+ Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Buffer End
+
+ 201/Function: move-to-buffer-end-command
+ Key: ESC-F
+ Key: M->
+ Action Type: Move Point
+
+ Go to end of buffer (leaving mark behind).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 39 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Buffer Start
+
+ 201/Function: move-to-buffer-start-command
+ Key: ESC-H
+ Key: M-<
+ Action Type: Move Point
+
+ Go to beginning of buffer (leaving mark behind).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To End Of Line
+
+ 201/Function: move-to-end-of-line-command
+ Key: C-E
+ Action Type: Move Point
+
+ Move point to end of line. With positive argument n goes down n-1 lines,
+ then to the end of line. With zero argument goes up a line, then to line
+ end. With negative argument n goes up |n|+1 lines, then to the end of line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Screen Edge
+
+ 201/Function: move-to-screen-edge-command
+ Key: M-R
+ Action Type: Move Point
+
+ Jump to top or bottom of screen. Like Control-L except that point is
+ changed instead of the window. With no argument, jumps to the center. An
+ argument specifies the number of lines from the top, (negative args count
+ from the bottom).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Start Of Line
+
+ 201/Function: move-to-start-of-line-command
+ Key: C-A
+ Action Type: Move Point
+
+ Move point to beginning of line. With positive argument n goes down n-1
+ lines, then to the beginning of line. With zero argument goes up a line, then
+ to line beginning. With negative argument n goes up |n|+1 lines, then to the
+ beginning of line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Up
+
+ 201/Function: move-up-command
+ Key: C-P
+ Key: ESC-A
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move up vertically to next line. If given an argument moves up (n>0) or
+ down (n<0) |n| lines where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 40 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Negative Argument
+
+ 201/Function: negative-argument
+ Key: C--
+ Key: C-M--
+ Key: M--
+ Action Type: Subsequent Command Modifier
+
+ Make argument to next command negative.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Next Screen
+
+ 201/Function: next-screen-command
+ Key: C-V
+ Action Type: Move Point
+
+ Move down to display next screenful of text. With argument, moves window
+ down <arg> lines (negative moves up). Just minus as an argument moves up
+ a full screen.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Abort
+
+ 201/Function: nmode-abort-command
+ Key: C-G
+ Action Type: Escape
+
+ This command provides a way of aborting input requests.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Exit To Superior
+
+ 201/Function: nmode-exit-to-superior
+ Key: C-X C-Z
+ Action Type: Escape
+
+ Go back to EMACS's superior job.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Full Refresh
+
+ 201/Function: nmode-full-refresh
+ Key: ESC-J
+ Action Type: Alter Display Format
+
+ This function refreshes the screen after first clearing the display. It it used
+ when the state of the display is in doubt.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 41 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Gc
+
+ 201/Function: nmode-gc
+ Key: M-X Make Space
+
+ Reclaims any internal wasted space.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Invert Video
+
+ 201/Function: nmode-invert-video
+ Key: C-X V
+ Action Type: Alter Display Format
+
+ Toggle between normal and inverse video.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Refresh
+
+ 201/Function: nmode-refresh-command
+ Key: C-L
+ Action Type: Alter Display Format
+
+ Choose new window putting point at center, top or bottom. With no
+ argument, chooses a window to put point at the center. An argument gives
+ the line to put point on; negative args count from the bottom.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: One Window
+
+ 201/Function: one-window-command
+ Key: C-X 1
+ Action Type: Alter Display Format
+
+ Display only one window. Normally, we display what used to be in the top
+ window, but a numeric argument says to display what was in the bottom one.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Open Line
+
+ 201/Function: open-line-command
+ Key: C-O
+ Key: ESC-L
+ Action Type: Insert Constant
+
+ Insert a CRLF after point. Differs from ordinary insertion in that point
+ remains before the inserted characters. With positive argument, inserts
+ several CRLFs. With negative argument does nothing.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 42 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Other Window
+
+ 201/Function: other-window-command
+ Key: C-X O
+ Action Type: Alter Display Format
+ Action Type: Move Point
+
+ Switch to the other window. In two-window mode, moves cursor to other
+ window. In one-window mode, exchanges contents of visible window with
+ remembered contents of (invisible) window two. An argument means switch
+ windows but select the same buffer in the other window.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Prepend To File
+
+ 201/Function: prepend-to-file-command
+ Key: M-X Prepend To File
+ Topic: Files
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to start of specified file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Previous Screen
+
+ 201/Function: previous-screen-command
+ Key: M-V
+ Action Type: Move Point
+
+ Move up to display previous screenful of text. When an argument is present,
+ move the window back (n>0) or forward (n<0) |n| lines, where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Put Register
+
+ 201/Function: put-register-command
+ Key: C-X X
+ Action Type: Preserve
+
+ Put point to mark into register (reads name from keyboard). With an
+ argument, the text is also deleted.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Query Replace
+
+ 201/Function: query-replace-command
+ Key: M-%
+ Key: M-X Query Replace
+ Action Type: Alter Existing Text
+ Action Type: Select
+
+ Replace occurrences of a string from point to the end of the buffer, asking
+ about each occurrence. Query Replace prompts for the string to be replaced
+ and for its potential replacement. Query Replace displays each occurrence of
+ 201/NMODE Manual - 43 - Command Descriptions
+
+
+ the string to be replaced, you then type a character to say what to do.
+ Space => replace it with the potential replacement and show the next copy.
+ Rubout => don't replace, but show next copy. Comma => replace this copy
+ and show result, waiting for next command. ^ => return to site of previous
+ copy. ^L => redisplay screen. Exclamation mark => replace all remaining
+ copys without asking. Period => replace this copy and exit. Escape => just
+ exit.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Rename Buffer
+
+ 201/Function: rename-buffer-command
+ Key: M-X Rename Buffer
+ Topic: Buffers
+ Action Type: Set Global Variable
+
+ Change the name of the current buffer. The new name is read from the
+ keyboard. If the user provides an empty string, the buffer name will be set
+ to a truncated version of the filename associated with the buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Replace String
+
+ 201/Function: replace-string-command
+ Key: C-%
+ Key: M-X Replace String
+ Action Type: Alter Existing Text
+ Action Type: Select
+
+ Replace string with another from point to buffer end.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Reposition Window
+
+ 201/Function: reposition-window-command
+ Key: C-M-R
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Alter Display Format
+
+ Reposition screen window appropriately. Tries to get all of current defun on
+ screen. Never moves the pointer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Return
+
+ 201/Function: return-command
+ Key: RETURN
+ Action Type: Insert Constant
+
+ Insert CRLF, or move onto empty line. Repeated by positive argument. No
+ action with negative argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 44 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Reverse Search
+
+ 201/Function: reverse-search-command
+ Key: C-R
+ See Command: Incremental Search
+ Action Type: Move Point
+ Action Type: Select
+
+ Incremental Search Backwards. Like Control-S but in reverse.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Revert File
+
+ 201/Function: revert-file-command
+ Key: M-X Revert File
+ Topic: Files
+ Action Type: Remove
+
+ Undo changes to a file. Reads back the file being edited from disk
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Save All Files
+
+ 201/Function: save-all-files-command
+ Key: M-X Save All Files
+ Topic: Buffers
+ Topic: Files
+ Action Type: Preserve
+
+ Offer to write back each buffer which may need it. For each buffer which is
+ visiting a file and which has been modified, you are asked whether to save
+ it. A numeric arg means don't ask; save everything.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Save File
+
+ 201/Function: save-file-command
+ Key: C-X C-S
+ Topic: Files
+ Action Type: Preserve
+
+ Save visited file on disk if modified.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Other Window
+
+ 201/Function: scroll-other-window-command
+ Key: C-M-V
+ Action Type: Alter Display Format
+
+ Scroll other window up several lines. Specify the number as a numeric
+ argument, negative for down. The default is a whole screenful up. Just
+ Meta-Minus as argument means scroll a whole screenful down.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 45 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Down Line
+
+ 201/Function: scroll-window-down-line-command
+ Key: ESC-T
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window down (n > 0) or up (n < 0) by |n| lines
+ where n is the command argument. The "window position" may be adjusted to
+ keep it within the window. Ding if the window contents does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Down Page
+
+ 201/Function: scroll-window-down-page-command
+ Key: ESC-V
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window down (n > 0) or up (n < 0) by |n|
+ screenfuls where n is the command argument. The "window position" may be
+ adjusted to keep it within the window. Ding if the window contents does not
+ move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Left
+
+ 201/Function: scroll-window-left-command
+ Key: C-X <
+ Action Type: Alter Display Format
+
+ Scroll the contents of the specified window right (n > 0) or left (n < 0) by
+ |n| columns where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Right
+
+ 201/Function: scroll-window-right-command
+ Key: C-X >
+ Action Type: Alter Display Format
+
+ Scroll the contents of the specified window left (n > 0) or right (n < 0) by
+ |n| columns where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Up Line
+
+ 201/Function: scroll-window-up-line-command
+ Key: ESC-S
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines
+ where n is the command argument. The "window position" may be adjusted to
+ keep it within the window. Ding if the window contents does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 46 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Up Page
+
+ 201/Function: scroll-window-up-page-command
+ Key: ESC-U
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window up (n > 0) or down (n < 0) by |n|
+ screenfuls where n is the command argument. The "window position" may be
+ adjusted to keep it within the window. Ding if the window contents does not
+ move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Select Buffer
+
+ 201/Function: select-buffer-command
+ Key: C-X B
+ Key: M-X Select Buffer
+ Topic: Buffers
+ Action Type: Move Point
+
+ Select or create buffer with specified name. Buffer name is read from
+ keyboard. Name completion is performed by SPACE and RETURN.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Select Previous Buffer
+
+ 201/Function: select-previous-buffer-command
+ Key: C-M-L
+ Topic: Buffers
+ Action Type: Move Point
+
+ Select the previous buffer of the current buffer, if it exists and is
+ selectable. Otherwise, select the MAIN buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Fill Column
+
+ 201/Function: set-fill-column-command
+ Key: C-X F
+ See Global: Fill Column
+ Action Type: Set Global Variable
+
+ Set fill column to numeric arg or current column. If there is an argument,
+ that is used. Otherwise, the current position of the cursor is used. The
+ Fill Column variable controls where Auto Fill mode and the fill commands put
+ the right margin.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 47 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Fill Prefix
+
+ 201/Function: set-fill-prefix-command
+ Key: C-X .
+ See Global: Fill Prefix
+ Action Type: Set Global Variable
+
+ Defines Fill Prefix from current line. All of the current line up to point
+ becomes the value of Fill Prefix. Auto Fill Mode inserts the prefix on each
+ line; the Fill Paragraph command assumes that each non-blank line starts
+ with the prefix (which is ignored for filling purposes). To stop using a Fill
+ Prefix, do Control-X . at the front of a line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Goal Column
+
+ 201/Function: set-goal-column-command
+ Key: C-X C-N
+ Action Type: Set Global Variable
+
+ Set (or flush) a permanent goal for vertical motion. With no argument, makes
+ the current column the goal for vertical motion commands. They will always
+ try to go to that column. With argument, clears out any previously set goal.
+ Only Control-P and Control-N are affected.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Key
+
+ 201/Function: set-key-command
+ Key: M-X Set Key
+ Action Type: Set Global Variable
+
+ Put a function on a key. The function name is a string argument. The key
+ is always read from the terminal (not a string argument). It may contain
+ metizers and other prefix characters.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Mark
+
+ 201/Function: set-mark-command
+ Key: C-@
+ Key: C-SPACE
+ Action Type: Mark
+
+ Sets or pops the mark. With no ^U's, pushes point as the mark. With one
+ ^U, pops the mark into point. With two ^U's, pops the mark and throws it
+ away.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 48 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Visited Filename
+
+ 201/Function: set-visited-filename-command
+ Key: M-X Set Visited Filename
+ Topic: Files
+ Action Type: Set Global Variable
+
+ Change visited filename, without writing file. The user is prompted for a
+ filename. What NMODE believes to be the name of the visited file associated
+ with the current buffer is set from the user's input. No file's name is
+ actually changed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Split Line
+
+ 201/Function: split-line-command
+ Key: C-M-O
+ Action Type: Insert Constant
+
+ Move rest of this line vertically down. Inserts a CRLF, and then enough
+ tabs/spaces so that what had been the rest of the current line is indented as
+ much as it had been. Point does not move, except to skip over indentation
+ that originally followed it. With positive argument, makes extra blank lines in
+ between. No action with negative argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Start Scripting
+
+ 201/Function: start-scripting-command
+ Key: M-X Start Scripting
+ Action Type: Change Mode
+
+ This function prompts the user for a buffer name, into which it will copy all
+ the user's commands (as well as executing them) until the
+ stop-scripting-command is invoked. This command supercedes any such
+ previous request. Note that to keep the lines of reasonable length, free
+ Newlines will be inserted from time to time. Because of this, and because
+ many file systems cannot represent stray Newlines, the Newline character is
+ itself scripted as a CR followed by a TAB, since this is its normal definition.
+ Someday, perhaps, this hack will be replaced by a better one.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Start Timing
+
+ 201/Function: start-timing-command
+ Key: M-X Start Timing Nmode
+ Action Type: Change Mode
+
+ This cleans up a number of global variables associated with timing, prompts
+ for a file in which to put the timing data (or defaults to a file named
+ "timing", of type "txt"), and starts the timing. Information is collected on
+ the total time, refresh time, read time, command execution time, total number
+ of cons cells built, and total number of garbage collections performed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 49 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Stop Scripting
+
+ 201/Function: stop-scripting-command
+ Key: M-X Stop Scripting
+ Action Type: Change Mode
+
+ This command stops the echoing of user commands into a script buffer. This
+ command is itself echoed before the creation of the script stops.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Stop Timing
+
+ 201/Function: stop-timing-command
+ Key: M-X Stop Timing Nmode
+ Action Type: Change Mode
+
+ This stops the timing, formats the output data, and closes the file into which
+ the timing information is going. Information is collected on the total time,
+ refresh time, read time, command execution time, total number of cons cells
+ built, and total number of garbage collections performed. In addition to
+ these numbers, some ratios are printed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Tab To Tab Stop
+
+ 201/Function: tab-to-tab-stop-command
+ Key: M-I
+ Key: M-TAB
+ Key: TAB
+ See Command: Lisp Tab
+ Action Type: Insert Constant
+
+ Insert a tab character. Note that the binding of TAB to this command only
+ holds in text mode, not in lisp mode, where it is bound to the Lisp Tab
+ command. In lisp mode, the other keys continue to be bound to this command.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Text Mode
+
+ 201/Function: text-mode-command
+ Key: M-X Text Mode
+ Topic: Text
+ Action Type: Change Mode
+
+ Set things up for editing English text. Tab inserts tab characters. There
+ are no comments. Auto Fill does not indent new lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 50 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Characters
+
+ 201/Function: transpose-characters-command
+ Key: C-T
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the characters before and after the cursor. For more details, see
+ Meta-T, reading "character" for "word". However: at the end of a line, with
+ no argument, the preceding two characters are transposed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Forms
+
+ 201/Function: transpose-forms
+ Key: C-M-T
+ Mode: Lisp
+ Topic: Lisp
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the forms before and after the cursor. For more details, see
+ Meta-T, reading "Form" for "Word".
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Lines
+
+ 201/Function: transpose-lines
+ Key: C-X C-T
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the lines before and after the cursor. For more details, see
+ Meta-T, reading "Line" for "Word".
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Regions
+
+ 201/Function: transpose-regions
+ Key: C-X T
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Transpose regions defined by cursor and last 3 marks. To transpose two
+ non-overlapping regions, set the mark successively at three of the four
+ boundaries, put point at the fourth, and call this function.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 51 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Words
+
+ 201/Function: transpose-words
+ Key: M-T
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Transpose the words before and after the cursor. With a positive argument
+ it transposes the words before and after the cursor, moves right, and
+ repeats the specified number of times, dragging the word to the left of the
+ cursor right. With a negative argument, it transposes the two words to the
+ left of the cursor, moves between them, and repeats the specified number of
+ times, exactly undoing the positive argument form. With a zero argument, it
+ transposes the words at point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Two Windows
+
+ 201/Function: two-windows-command
+ Key: C-X 2
+ Action Type: Alter Display Format
+
+ Show two windows and select window two. An argument > 1 means give
+ window 2 the same buffer as in Window 1.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Undelete File
+
+ 201/Function: undelete-file-command
+ Key: M-X Undelete File
+ Topic: Files
+ Action Type: Move Data
+ Action Type: Preserve
+
+ This command prompts the user for the name of the file. NMODE will fill in a
+ partly specified filename (eg filetype can be defaulted). If possible, the file
+ will then be undeleted, and a message to that effect will be displayed. If the
+ operation fails, the bell will sound.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Universal Argument
+
+ 201/Function: universal-argument
+ Key: C-U
+ Action Type: Subsequent Command Modifier
+
+ Sets argument or multiplies it by four. Followed by digits, uses them to
+ specify the argument for the command after the digits. If not followed by
+ digits, multiplies the argument by four.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 52 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Unkill Previous
+
+ 201/Function: unkill-previous
+ Key: M-Y
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Delete (without saving away) the current region, and then unkill (yank) the
+ specified entry in the kill ring. "Ding" if the current region does not
+ contain the same text as the current entry in the kill ring. If one has just
+ retrieved the top entry from the kill ring this has the effect of displaying the
+ item just beneath it, then the item beneath that and so on until the original
+ top entry rotates back into view.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Upcase Digit
+
+ 201/Function: upcase-digit-command
+ Key: M-'
+ Action Type: Alter Existing Text
+
+ Convert last digit to shifted character. Looks on current line back from
+ point, and previous line. The first time you use this command, it asks you
+ to type the row of digits from 1 to 9 and then 0, holding down Shift, to
+ determine how your keyboard is set up.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Uppercase Initial
+
+ 201/Function: uppercase-initial-command
+ Key: M-C
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Put next word in lower case, but capitalize initial. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Uppercase Region
+
+ 201/Function: uppercase-region-command
+ Key: C-X C-U
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Convert region to upper case.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 53 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Uppercase Word
+
+ 201/Function: uppercase-word-command
+ Key: M-U
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Convert one word to upper case, moving past it. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: View Two Windows
+
+ 201/Function: view-two-windows-command
+ Key: C-X 3
+ Action Type: Alter Display Format
+
+ Show two windows but stay in first.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Visit File
+
+ 201/Function: visit-file-command
+ Key: C-X C-V
+ Key: M-X Visit File
+ Topic: Files
+ Action Type: Move Data
+ Action Type: Move Point
+
+ Visit new file in current buffer. The user is prompted for the filename. If
+ the current buffer is modified, the user is asked whether to write it out.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Visit In Other Window
+
+ 201/Function: visit-in-other-window-command
+ Key: C-X 4
+ Topic: Files
+ Topic: Buffers
+ Action Type: Move Point
+ Action Type: Alter Display Format
+
+ Find buffer or file in other window. Follow this command by B and a buffer
+ name, or by F and a file name. We find the buffer or file in the other
+ window, creating the other window if necessary.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 54 - NMODE Manual
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: What Cursor Position
+
+ 201/Function: what-cursor-position-command
+ Key: C-=
+ Key: C-X =
+ Action Type: Inform
+
+ Print various things about where cursor is. Print the X position, the Y
+ position, the octal code for the following character, point absolutely and as a
+ percentage of the total file size, and the virtual boundaries, if any. If a
+ positive argument is given point will jump to the line number specified by the
+ argument. A negative argument triggers a jump to the first line in the
+ buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Write File
+
+ 201/Function: write-file-command
+ Key: C-X C-W
+ Key: M-X Write File
+ Topic: Files
+ Action Type: Preserve
+
+ Prompts for file name. Stores the current buffer in specified file. This file
+ becomes the one being visited.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Write Region
+
+ 201/Function: write-region-command
+ Key: M-X Write Region
+ Topic: Files
+ See Definition: Region
+ Action Type: Preserve
+
+ Write region to file. Prompts for file name.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Write Screen Photo
+
+ 201/Function: write-screen-photo-command
+ Key: C-X P
+ Topic: Files
+ Action Type: Preserve
+
+ Ask for filename, write out the screen to the file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual - 55 - Command Descriptions
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Yank Last Output
+
+ 201/Function: yank-last-output-command
+ Key: Lisp-Y
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Data
+
+ Insert "last output" typed in the OUTPUT buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Command Descriptions - 56 - NMODE Manual
+ 201/NMODE Manual - 57 - Command Index
+
+
+ 202/6. Command Index
+
+ 201/Append Next Kill . . . . . . . . . . . . . . . . . . . . 14
+ Append To Buffer . . . . . . . . . . . . . . . . . . . . 14
+ Append To File . . . . . . . . . . . . . . . . . . . . . 14
+ Apropos . . . . . . . . . . . . . . . . . . . . . . . . . 14
+ Argument Digit . . . . . . . . . . . . . . . . . . . . . 15
+ Auto Fill Mode . . . . . . . . . . . . . . . . . . . . . . 15
+
+ Back To Indentation . . . . . . . . . . . . . . . . . . . 16
+ Backward Kill Sentence . . . . . . . . . . . . . . . . . 16
+ Backward Paragraph . . . . . . . . . . . . . . . . . . . 16
+ Backward Sentence . . . . . . . . . . . . . . . . . . . . 16
+ Backward Up List . . . . . . . . . . . . . . . . . . . . 17
+ Buffer Browser . . . . . . . . . . . . . . . . . . . . . 17
+ Buffer Not Modified . . . . . . . . . . . . . . . . . . . 17
+
+ C-X Prefix . . . . . . . . . . . . . . . . . . . . . . . . 17
+ Center Line . . . . . . . . . . . . . . . . . . . . . . . 18
+ Copy Region . . . . . . . . . . . . . . . . . . . . . . . 18
+ Count Occurrences . . . . . . . . . . . . . . . . . . . . 18
+
+ Delete And Expunge File . . . . . . . . . . . . . . . . . 18
+ Delete Backward Hacking Tabs . . . . . . . . . . . . . . 19
+ Delete Blank Lines . . . . . . . . . . . . . . . . . . . . 19
+ Delete File . . . . . . . . . . . . . . . . . . . . . . . . 19
+ Delete Forward Character . . . . . . . . . . . . . . . . 19
+ Delete Horizontal Space . . . . . . . . . . . . . . . . . 20
+ Delete Indentation . . . . . . . . . . . . . . . . . . . . 20
+ Delete Matching Lines . . . . . . . . . . . . . . . . . . 20
+ Delete Non-Matching Lines . . . . . . . . . . . . . . . . 20
+ Dired . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ Down List . . . . . . . . . . . . . . . . . . . . . . . . 21
+
+ Edit Directory . . . . . . . . . . . . . . . . . . . . . . 21
+ End Of Defun . . . . . . . . . . . . . . . . . . . . . . 21
+ Esc Prefix . . . . . . . . . . . . . . . . . . . . . . . . 22
+ Exchange Point And Mark . . . . . . . . . . . . . . . . 22
+ Exchange Windows . . . . . . . . . . . . . . . . . . . . 22
+ Execute Buffer . . . . . . . . . . . . . . . . . . . . . . 22
+ Execute File . . . . . . . . . . . . . . . . . . . . . . . 22
+ Execute Form . . . . . . . . . . . . . . . . . . . . . . 23
+ Exit Nmode . . . . . . . . . . . . . . . . . . . . . . . 23
+
+ Fill Comment . . . . . . . . . . . . . . . . . . . . . . . 23
+ Fill Paragraph . . . . . . . . . . . . . . . . . . . . . . 23
+ Fill Region . . . . . . . . . . . . . . . . . . . . . . . . 24
+ Find File . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ Forward Paragraph . . . . . . . . . . . . . . . . . . . . 24
+ Forward Sentence . . . . . . . . . . . . . . . . . . . . 25
+ Forward Up List . . . . . . . . . . . . . . . . . . . . . 25
+ 201/Command Index - 58 - NMODE Manual
+
+
+ Get Register . . . . . . . . . . . . . . . . . . . . . . . 25
+ Grow Window . . . . . . . . . . . . . . . . . . . . . . . 25
+
+ Help Dispatch . . . . . . . . . . . . . . . . . . . . . . 26
+
+ Incremental Search . . . . . . . . . . . . . . . . . . . . 26
+ Indent New line . . . . . . . . . . . . . . . . . . . . . 26
+ Insert Buffer . . . . . . . . . . . . . . . . . . . . . . 26
+ Insert Closing bracket . . . . . . . . . . . . . . . . . . 27
+ Insert Comment . . . . . . . . . . . . . . . . . . . . . 27
+ Insert Date . . . . . . . . . . . . . . . . . . . . . . . 27
+ Insert File . . . . . . . . . . . . . . . . . . . . . . . . 27
+ Insert Kill Buffer . . . . . . . . . . . . . . . . . . . . 28
+ Insert Next Character . . . . . . . . . . . . . . . . . . 28
+ Insert Parens . . . . . . . . . . . . . . . . . . . . . . 28
+
+ Kill Backward Form . . . . . . . . . . . . . . . . . . . 28
+ Kill Backward Word . . . . . . . . . . . . . . . . . . . 29
+ Kill Buffer . . . . . . . . . . . . . . . . . . . . . . . . 29
+ Kill Forward Form . . . . . . . . . . . . . . . . . . . . 29
+ Kill Forward Word . . . . . . . . . . . . . . . . . . . . 29
+ Kill Line . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ Kill Region . . . . . . . . . . . . . . . . . . . . . . . . 30
+ Kill Sentence . . . . . . . . . . . . . . . . . . . . . . . 30
+ Kill Some Buffers . . . . . . . . . . . . . . . . . . . . 30
+
+ Lisp Abort . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Backtrace . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Continue . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Help . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Indent Region . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Indent sexpr . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Mode . . . . . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Prefix . . . . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Quit . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp Retry . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp Tab . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lowercase Region . . . . . . . . . . . . . . . . . . . . 33
+ Lowercase Word . . . . . . . . . . . . . . . . . . . . . 34
+
+ M-X Prefix . . . . . . . . . . . . . . . . . . . . . . . . 34
+ Mark Beginning . . . . . . . . . . . . . . . . . . . . . 34
+ Mark Defun . . . . . . . . . . . . . . . . . . . . . . . 34
+ Mark End . . . . . . . . . . . . . . . . . . . . . . . . 35
+ Mark Form . . . . . . . . . . . . . . . . . . . . . . . . 35
+ Mark Paragraph . . . . . . . . . . . . . . . . . . . . . 35
+ Mark Whole Buffer . . . . . . . . . . . . . . . . . . . . 35
+ Mark Word . . . . . . . . . . . . . . . . . . . . . . . . 35
+ Move Backward Character . . . . . . . . . . . . . . . . 36
+ Move Backward Defun . . . . . . . . . . . . . . . . . . 36
+ Move Backward Form . . . . . . . . . . . . . . . . . . . 36
+ Move Backward List . . . . . . . . . . . . . . . . . . . 36
+ Move Backward Word . . . . . . . . . . . . . . . . . . . 37
+ 201/NMODE Manual - 59 - Command Index
+
+
+ Move Down . . . . . . . . . . . . . . . . . . . . . . . . 37
+ Move Down Extending . . . . . . . . . . . . . . . . . . 37
+ Move Forward Character . . . . . . . . . . . . . . . . . 37
+ Move Forward Form . . . . . . . . . . . . . . . . . . . 38
+ Move Forward List . . . . . . . . . . . . . . . . . . . . 38
+ Move Forward Word . . . . . . . . . . . . . . . . . . . 38
+ Move To Buffer End . . . . . . . . . . . . . . . . . . . 38
+ Move To Buffer Start . . . . . . . . . . . . . . . . . . 39
+ Move To End Of Line . . . . . . . . . . . . . . . . . . 39
+ Move To Screen Edge . . . . . . . . . . . . . . . . . . 39
+ Move To Start Of Line . . . . . . . . . . . . . . . . . . 39
+ Move Up . . . . . . . . . . . . . . . . . . . . . . . . . 39
+
+ Negative Argument . . . . . . . . . . . . . . . . . . . . 40
+ Next Screen . . . . . . . . . . . . . . . . . . . . . . . 40
+ Nmode Abort . . . . . . . . . . . . . . . . . . . . . . . 40
+ Nmode Exit To Superior . . . . . . . . . . . . . . . . . 40
+ Nmode Full Refresh . . . . . . . . . . . . . . . . . . . 40
+ Nmode Gc . . . . . . . . . . . . . . . . . . . . . . . . 41
+ Nmode Invert Video . . . . . . . . . . . . . . . . . . . 41
+ Nmode Refresh . . . . . . . . . . . . . . . . . . . . . . 41
+
+ One Window . . . . . . . . . . . . . . . . . . . . . . . 41
+ Open Line . . . . . . . . . . . . . . . . . . . . . . . . 41
+ Other Window . . . . . . . . . . . . . . . . . . . . . . 42
+
+ Prepend To File . . . . . . . . . . . . . . . . . . . . . 42
+ Previous Screen . . . . . . . . . . . . . . . . . . . . . 42
+ Put Register . . . . . . . . . . . . . . . . . . . . . . . 42
+
+ Query Replace . . . . . . . . . . . . . . . . . . . . . . 42
+
+ Rename Buffer . . . . . . . . . . . . . . . . . . . . . . 43
+ Replace String . . . . . . . . . . . . . . . . . . . . . . 43
+ Reposition Window . . . . . . . . . . . . . . . . . . . . 43
+ Return . . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ Reverse Search . . . . . . . . . . . . . . . . . . . . . 44
+ Revert File . . . . . . . . . . . . . . . . . . . . . . . 44
+
+ Save All Files . . . . . . . . . . . . . . . . . . . . . . 44
+ Save File . . . . . . . . . . . . . . . . . . . . . . . . 44
+ Scroll Other Window . . . . . . . . . . . . . . . . . . . 44
+ Scroll Window Down Line . . . . . . . . . . . . . . . . . 45
+ Scroll Window Down Page . . . . . . . . . . . . . . . . . 45
+ Scroll Window Left . . . . . . . . . . . . . . . . . . . . 45
+ Scroll Window Right . . . . . . . . . . . . . . . . . . . 45
+ Scroll Window Up Line . . . . . . . . . . . . . . . . . . 45
+ Scroll Window Up Page . . . . . . . . . . . . . . . . . . 46
+ Select Buffer . . . . . . . . . . . . . . . . . . . . . . 46
+ Select Previous Buffer . . . . . . . . . . . . . . . . . . 46
+ Set Fill Column . . . . . . . . . . . . . . . . . . . . . 46
+ Set Fill Prefix . . . . . . . . . . . . . . . . . . . . . . 47
+ Set Goal Column . . . . . . . . . . . . . . . . . . . . . 47
+ 201/Command Index - 60 - NMODE Manual
+
+
+ Set Key . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ Set Mark . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ Set Visited Filename . . . . . . . . . . . . . . . . . . . 48
+ Split Line . . . . . . . . . . . . . . . . . . . . . . . . 48
+ Start Scripting . . . . . . . . . . . . . . . . . . . . . . 48
+ Start Timing . . . . . . . . . . . . . . . . . . . . . . . 48
+ Stop Scripting . . . . . . . . . . . . . . . . . . . . . . 49
+ Stop Timing . . . . . . . . . . . . . . . . . . . . . . . 49
+
+ Tab To Tab Stop . . . . . . . . . . . . . . . . . . . . 49
+ Text Mode . . . . . . . . . . . . . . . . . . . . . . . . 49
+ Transpose Characters . . . . . . . . . . . . . . . . . . 50
+ Transpose Forms . . . . . . . . . . . . . . . . . . . . . 50
+ Transpose Lines . . . . . . . . . . . . . . . . . . . . . 50
+ Transpose Regions . . . . . . . . . . . . . . . . . . . . 50
+ Transpose Words . . . . . . . . . . . . . . . . . . . . . 51
+ Two Windows . . . . . . . . . . . . . . . . . . . . . . . 51
+
+ Undelete File . . . . . . . . . . . . . . . . . . . . . . . 51
+ Universal Argument . . . . . . . . . . . . . . . . . . . 51
+ Unkill Previous . . . . . . . . . . . . . . . . . . . . . 52
+ Upcase Digit . . . . . . . . . . . . . . . . . . . . . . . 52
+ Uppercase Initial . . . . . . . . . . . . . . . . . . . . . 52
+ Uppercase Region . . . . . . . . . . . . . . . . . . . . 52
+ Uppercase Word . . . . . . . . . . . . . . . . . . . . . 53
+
+ View Two Windows . . . . . . . . . . . . . . . . . . . . 53
+ Visit File . . . . . . . . . . . . . . . . . . . . . . . . 53
+ Visit In Other Window . . . . . . . . . . . . . . . . . . 53
+
+ What Cursor Position . . . . . . . . . . . . . . . . . . . 54
+ Write File . . . . . . . . . . . . . . . . . . . . . . . . 54
+ Write Region . . . . . . . . . . . . . . . . . . . . . . . 54
+ Write Screen Photo . . . . . . . . . . . . . . . . . . . . 54
+
+ Yank Last Output . . . . . . . . . . . . . . . . . . . . 55
+ 201/NMODE Manual - 61 - Function Index
+
+
+ 202/7. Function Index
+
+ 201/append-next-kill-command . . . . . . . . . . . . . . . . 14
+ append-to-buffer-command . . . . . . . . . . . . . . . . 14
+ append-to-file-command . . . . . . . . . . . . . . . . . 14
+ apropos-command . . . . . . . . . . . . . . . . . . . . . 14
+ argument-digit . . . . . . . . . . . . . . . . . . . . . . 15
+ auto-fill-mode-command . . . . . . . . . . . . . . . . . . 15
+
+ back-to-indentation-command . . . . . . . . . . . . . . . 16
+ backward-kill-sentence-command . . . . . . . . . . . . . 16
+ backward-paragraph-command . . . . . . . . . . . . . . 16
+ backward-sentence-command . . . . . . . . . . . . . . . 16
+ backward-up-list-command . . . . . . . . . . . . . . . . 17
+ buffer-browser-command . . . . . . . . . . . . . . . . . 17
+ buffer-not-modified-command . . . . . . . . . . . . . . . 17
+
+ c-x-prefix . . . . . . . . . . . . . . . . . . . . . . . . 17
+ center-line-command . . . . . . . . . . . . . . . . . . . 18
+ copy-region . . . . . . . . . . . . . . . . . . . . . . . 18
+ count-occurrences-command . . . . . . . . . . . . . . . 18
+
+ delete-and-expunge-file-command . . . . . . . . . . . . . 18
+ delete-backward-hacking-tabs-command . . . . . . . . . . 19
+ delete-blank-lines-command . . . . . . . . . . . . . . . . 19
+ delete-file-command . . . . . . . . . . . . . . . . . . . 19
+ delete-forward-character-command . . . . . . . . . . . . 19
+ delete-horizontal-space-command . . . . . . . . . . . . . 20
+ delete-indentation-command . . . . . . . . . . . . . . . . 20
+ delete-matching-lines-command . . . . . . . . . . . . . . 20
+ delete-non-matching-lines-command . . . . . . . . . . . . 20
+ dired-command . . . . . . . . . . . . . . . . . . . . . . 20
+ down-list . . . . . . . . . . . . . . . . . . . . . . . . 21
+
+ edit-directory-command . . . . . . . . . . . . . . . . . . 21
+ end-of-defun-command . . . . . . . . . . . . . . . . . . 21
+ esc-prefix . . . . . . . . . . . . . . . . . . . . . . . . 22
+ exchange-point-and-mark . . . . . . . . . . . . . . . . . 22
+ exchange-windows-command . . . . . . . . . . . . . . . 22
+ execute-buffer-command . . . . . . . . . . . . . . . . . 22
+ execute-file-command . . . . . . . . . . . . . . . . . . . 22
+ execute-form-command . . . . . . . . . . . . . . . . . . 23
+ exit-nmode . . . . . . . . . . . . . . . . . . . . . . . . 23
+
+ fill-comment-command . . . . . . . . . . . . . . . . . . . 23
+ fill-paragraph-command . . . . . . . . . . . . . . . . . . 23
+ fill-region-command . . . . . . . . . . . . . . . . . . . 24
+ find-file-command . . . . . . . . . . . . . . . . . . . . 24
+ forward-paragraph-command . . . . . . . . . . . . . . . 24
+ forward-sentence-command . . . . . . . . . . . . . . . . 25
+ forward-up-list-command . . . . . . . . . . . . . . . . . 25
+ 201/Function Index - 62 - NMODE Manual
+
+
+ get-register-command . . . . . . . . . . . . . . . . . . 25
+ grow-window-command . . . . . . . . . . . . . . . . . . 25
+
+ help-dispatch . . . . . . . . . . . . . . . . . . . . . . 26
+
+ incremental-search-command . . . . . . . . . . . . . . . 26
+ indent-new-line-command . . . . . . . . . . . . . . . . . 26
+ insert-buffer-command . . . . . . . . . . . . . . . . . . 26
+ insert-closing-bracket . . . . . . . . . . . . . . . . . . 27
+ insert-comment-command . . . . . . . . . . . . . . . . . 27
+ insert-date-command . . . . . . . . . . . . . . . . . . . 27
+ insert-file-command . . . . . . . . . . . . . . . . . . . 27
+ insert-kill-buffer . . . . . . . . . . . . . . . . . . . . . 28
+ insert-next-character-command . . . . . . . . . . . . . . 28
+ insert-parens . . . . . . . . . . . . . . . . . . . . . . 28
+
+ kill-backward-form-command . . . . . . . . . . . . . . . 28
+ kill-backward-word-command . . . . . . . . . . . . . . . 29
+ kill-buffer-command . . . . . . . . . . . . . . . . . . . 29
+ kill-forward-form-command . . . . . . . . . . . . . . . . 29
+ kill-forward-word-command . . . . . . . . . . . . . . . . 29
+ kill-line . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ kill-region . . . . . . . . . . . . . . . . . . . . . . . . 30
+ kill-sentence-command . . . . . . . . . . . . . . . . . . 30
+ kill-some-buffers-command . . . . . . . . . . . . . . . . 30
+
+ lisp-abort-command . . . . . . . . . . . . . . . . . . . . 31
+ lisp-backtrace-command . . . . . . . . . . . . . . . . . 31
+ lisp-continue-command . . . . . . . . . . . . . . . . . . 31
+ lisp-help-command . . . . . . . . . . . . . . . . . . . . 31
+ lisp-indent-region-command . . . . . . . . . . . . . . . . 32
+ lisp-indent-sexpr . . . . . . . . . . . . . . . . . . . . 32
+ lisp-mode-command . . . . . . . . . . . . . . . . . . . . 32
+ lisp-prefix . . . . . . . . . . . . . . . . . . . . . . . . 32
+ lisp-quit-command . . . . . . . . . . . . . . . . . . . . 33
+ lisp-retry-command . . . . . . . . . . . . . . . . . . . . 33
+ lisp-tab-command . . . . . . . . . . . . . . . . . . . . . 33
+ lowercase-region-command . . . . . . . . . . . . . . . . 33
+ lowercase-word-command . . . . . . . . . . . . . . . . . 34
+
+ m-x-prefix . . . . . . . . . . . . . . . . . . . . . . . . 34
+ mark-beginning-command . . . . . . . . . . . . . . . . . 34
+ mark-defun-command . . . . . . . . . . . . . . . . . . . 34
+ mark-end-command . . . . . . . . . . . . . . . . . . . . 35
+ mark-form-command . . . . . . . . . . . . . . . . . . . 35
+ mark-paragraph-command . . . . . . . . . . . . . . . . . 35
+ mark-whole-buffer-command . . . . . . . . . . . . . . . 35
+ mark-word-command . . . . . . . . . . . . . . . . . . . 35
+ move-backward-character-command . . . . . . . . . . . . 36
+ move-backward-defun-command . . . . . . . . . . . . . . 36
+ move-backward-form-command . . . . . . . . . . . . . . 36
+ move-backward-list-command . . . . . . . . . . . . . . . 36
+ move-backward-word-command . . . . . . . . . . . . . . 37
+ 201/NMODE Manual - 63 - Function Index
+
+
+ move-down-command . . . . . . . . . . . . . . . . . . . 37
+ move-down-extending-command . . . . . . . . . . . . . . 37
+ move-forward-character-command . . . . . . . . . . . . . 37
+ move-forward-form-command . . . . . . . . . . . . . . . 38
+ move-forward-list-command . . . . . . . . . . . . . . . . 38
+ move-forward-word-command . . . . . . . . . . . . . . . 38
+ move-to-buffer-end-command . . . . . . . . . . . . . . . 38
+ move-to-buffer-start-command . . . . . . . . . . . . . . 39
+ move-to-end-of-line-command . . . . . . . . . . . . . . . 39
+ move-to-screen-edge-command . . . . . . . . . . . . . . 39
+ move-to-start-of-line-command . . . . . . . . . . . . . . 39
+ move-up-command . . . . . . . . . . . . . . . . . . . . 39
+
+ negative-argument . . . . . . . . . . . . . . . . . . . . 40
+ next-screen-command . . . . . . . . . . . . . . . . . . . 40
+ nmode-abort-command . . . . . . . . . . . . . . . . . . 40
+ nmode-exit-to-superior . . . . . . . . . . . . . . . . . . 40
+ nmode-full-refresh . . . . . . . . . . . . . . . . . . . . 40
+ nmode-gc . . . . . . . . . . . . . . . . . . . . . . . . 41
+ nmode-invert-video . . . . . . . . . . . . . . . . . . . . 41
+ nmode-refresh-command . . . . . . . . . . . . . . . . . 41
+
+ one-window-command . . . . . . . . . . . . . . . . . . . 41
+ open-line-command . . . . . . . . . . . . . . . . . . . . 41
+ other-window-command . . . . . . . . . . . . . . . . . . 42
+
+ prepend-to-file-command . . . . . . . . . . . . . . . . . 42
+ previous-screen-command . . . . . . . . . . . . . . . . . 42
+ put-register-command . . . . . . . . . . . . . . . . . . 42
+
+ query-replace-command . . . . . . . . . . . . . . . . . . 42
+
+ rename-buffer-command . . . . . . . . . . . . . . . . . 43
+ replace-string-command . . . . . . . . . . . . . . . . . 43
+ reposition-window-command . . . . . . . . . . . . . . . . 43
+ return-command . . . . . . . . . . . . . . . . . . . . . 43
+ reverse-search-command . . . . . . . . . . . . . . . . . 44
+ revert-file-command . . . . . . . . . . . . . . . . . . . 44
+
+ save-all-files-command . . . . . . . . . . . . . . . . . . 44
+ save-file-command . . . . . . . . . . . . . . . . . . . . 44
+ scroll-other-window-command . . . . . . . . . . . . . . . 44
+ scroll-window-down-line-command . . . . . . . . . . . . . 45
+ scroll-window-down-page-command . . . . . . . . . . . . 45
+ scroll-window-left-command . . . . . . . . . . . . . . . . 45
+ scroll-window-right-command . . . . . . . . . . . . . . . 45
+ scroll-window-up-line-command . . . . . . . . . . . . . . 45
+ scroll-window-up-page-command . . . . . . . . . . . . . 46
+ select-buffer-command . . . . . . . . . . . . . . . . . . 46
+ select-previous-buffer-command . . . . . . . . . . . . . 46
+ set-fill-column-command . . . . . . . . . . . . . . . . . 46
+ set-fill-prefix-command . . . . . . . . . . . . . . . . . . 47
+ set-goal-column-command . . . . . . . . . . . . . . . . . 47
+ 201/Function Index - 64 - NMODE Manual
+
+
+ set-key-command . . . . . . . . . . . . . . . . . . . . . 47
+ set-mark-command . . . . . . . . . . . . . . . . . . . . 47
+ set-visited-filename-command . . . . . . . . . . . . . . . 48
+ split-line-command . . . . . . . . . . . . . . . . . . . . 48
+ start-scripting-command . . . . . . . . . . . . . . . . . 48
+ start-timing-command . . . . . . . . . . . . . . . . . . . 48
+ stop-scripting-command . . . . . . . . . . . . . . . . . 49
+ stop-timing-command . . . . . . . . . . . . . . . . . . . 49
+
+ tab-to-tab-stop-command . . . . . . . . . . . . . . . . . 49
+ text-mode-command . . . . . . . . . . . . . . . . . . . . 49
+ transpose-characters-command . . . . . . . . . . . . . . 50
+ transpose-forms . . . . . . . . . . . . . . . . . . . . . 50
+ transpose-lines . . . . . . . . . . . . . . . . . . . . . . 50
+ transpose-regions . . . . . . . . . . . . . . . . . . . . 50
+ transpose-words . . . . . . . . . . . . . . . . . . . . . 51
+ two-windows-command . . . . . . . . . . . . . . . . . . 51
+
+ undelete-file-command . . . . . . . . . . . . . . . . . . 51
+ universal-argument . . . . . . . . . . . . . . . . . . . . 51
+ unkill-previous . . . . . . . . . . . . . . . . . . . . . . 52
+ upcase-digit-command . . . . . . . . . . . . . . . . . . 52
+ uppercase-initial-command . . . . . . . . . . . . . . . . 52
+ uppercase-region-command . . . . . . . . . . . . . . . . 52
+ uppercase-word-command . . . . . . . . . . . . . . . . . 53
+
+ view-two-windows-command . . . . . . . . . . . . . . . . 53
+ visit-file-command . . . . . . . . . . . . . . . . . . . . 53
+ visit-in-other-window-command . . . . . . . . . . . . . . 53
+
+ what-cursor-position-command . . . . . . . . . . . . . . 54
+ write-file-command . . . . . . . . . . . . . . . . . . . . 54
+ write-region-command . . . . . . . . . . . . . . . . . . 54
+ write-screen-photo-command . . . . . . . . . . . . . . . 54
+
+ yank-last-output-command . . . . . . . . . . . . . . . . 55
+ 201/NMODE Manual - 65 - Key Index
+
+
+ 202/8. Key Index
+
+ 201/) . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27
+
+ BACKSPACE . . . . . . . . . . . . . . . . . . . . . . . 19
+
+ C-% . . . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ C-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-) . . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-- . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-0 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-1 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-2 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-3 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-4 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-5 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-6 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-7 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-8 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-9 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-< . . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ C-= . . . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-> . . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ C-? . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ C-@ . . . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-A . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ C-B . . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-D . . . . . . . . . . . . . . . . . . . . . . . . . . . 19
+ C-E . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ C-F . . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ C-G . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-K . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ C-L . . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-M-\ . . . . . . . . . . . . . . . . . . . . . . . . . . 32
+ C-M-( . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-M-) . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-M-- . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-M-0 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-1 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-2 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-3 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-4 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-5 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-6 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-7 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-8 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-9 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-@ . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ C-M-A . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-B . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-BACKSPACE . . . . . . . . . . . . . . . . . . . . 34
+ C-M-D . . . . . . . . . . . . . . . . . . . . . . . . . . 21
+ C-M-E . . . . . . . . . . . . . . . . . . . . . . . . . . 21
+ 201/Key Index - 66 - NMODE Manual
+
+
+ C-M-F . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ C-M-H . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ C-M-I . . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ C-M-K . . . . . . . . . . . . . . . . . . . . . . . . . . 29
+ C-M-L . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ C-M-M . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ C-M-N . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ C-M-O . . . . . . . . . . . . . . . . . . . . . . . . . . 48
+ C-M-P . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 32
+ C-M-R . . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ C-M-RETURN . . . . . . . . . . . . . . . . . . . . . . 16
+ C-M-RUBOUT . . . . . . . . . . . . . . . . . . . . . . 28
+ C-M-T . . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-M-TAB . . . . . . . . . . . . . . . . . . . . . . . . 33
+ C-M-U . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-M-V . . . . . . . . . . . . . . . . . . . . . . . . . . 44
+ C-M-W . . . . . . . . . . . . . . . . . . . . . . . . . . 14
+ C-M-X . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ C-M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-] . . . . . . . . . . . . . . . . . . . . . . . . . . 21
+ C-N . . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ C-O . . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-P . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ C-Q . . . . . . . . . . . . . . . . . . . . . . . . . . . 28
+ C-R . . . . . . . . . . . . . . . . . . . . . . . . . . . 44
+ C-RUBOUT . . . . . . . . . . . . . . . . . . . . . . . 19
+ C-S . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ C-SPACE . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-T . . . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-U . . . . . . . . . . . . . . . . . . . . . . . . . . . 51
+ C-V . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-W . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ C-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-X < . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ C-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-X 1 . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-X 2 . . . . . . . . . . . . . . . . . . . . . . . . . . 51
+ C-X 3 . . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ C-X 4 . . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ C-X = . . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-X > . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ C-X A . . . . . . . . . . . . . . . . . . . . . . . . . . 14
+ C-X B . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ C-X C-B . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-X C-F . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ C-X C-L . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ C-X C-N . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-X C-O . . . . . . . . . . . . . . . . . . . . . . . . . 19
+ C-X C-S . . . . . . . . . . . . . . . . . . . . . . . . . 44
+ C-X C-T . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-X C-U . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ C-X C-V . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ 201/NMODE Manual - 67 - Key Index
+
+
+ C-X C-W . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-X C-X . . . . . . . . . . . . . . . . . . . . . . . . . 22
+ C-X C-Z . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-X D . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ C-X E . . . . . . . . . . . . . . . . . . . . . . . . . . 22
+ C-X F . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ C-X G . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-X H . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ C-X K . . . . . . . . . . . . . . . . . . . . . . . . . . 29
+ C-X O . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ C-X P . . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-X RUBOUT . . . . . . . . . . . . . . . . . . . . . . 16
+ C-X T . . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-X V . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-X X . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ C-X ^ . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-Y . . . . . . . . . . . . . . . . . . . . . . . . . . . 28
+ C-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 32
+
+ ESC-4 . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ ESC-5 . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ ESC-A . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ ESC-B . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ ESC-C . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ ESC-D . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ ESC-F . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ ESC-H . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ ESC-J . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ ESC-L . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ ESC-M . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ ESC-P . . . . . . . . . . . . . . . . . . . . . . . . . . 19
+ ESC-S . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ ESC-T . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ ESC-U . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ ESC-V . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ ESCAPE . . . . . . . . . . . . . . . . . . . . . . . . . 22
+
+ Lisp-? . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-A . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-B . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-C . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-E . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ Lisp-L . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ Lisp-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp-R . . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp-Y . . . . . . . . . . . . . . . . . . . . . . . . . . 55
+
+ M-\ . . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ M-% . . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ M-' . . . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ M-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 28
+ M-- . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ M-/ . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ 201/Key Index - 68 - NMODE Manual
+
+
+ M-0 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-1 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-2 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-3 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-4 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-5 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-6 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-7 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-8 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-9 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-; . . . . . . . . . . . . . . . . . . . . . . . . . . . 27
+ M-< . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ M-> . . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ M-? . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ M-@ . . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ M-A . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-B . . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ M-BACKSPACE . . . . . . . . . . . . . . . . . . . . . . 34
+ M-C . . . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ M-D . . . . . . . . . . . . . . . . . . . . . . . . . . . 29
+ M-E . . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ M-F . . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ M-G . . . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ M-H . . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ M-I . . . . . . . . . . . . . . . . . . . . . . . . . . . 49
+ M-K . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ M-L . . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ M-M . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-Q . . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ M-R . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ M-RETURN . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-RUBOUT . . . . . . . . . . . . . . . . . . . . . . . 29
+ M-S . . . . . . . . . . . . . . . . . . . . . . . . . . . 18
+ M-T . . . . . . . . . . . . . . . . . . . . . . . . . . . 51
+ M-TAB . . . . . . . . . . . . . . . . . . . . . . . . . . 49
+ M-U . . . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ M-V . . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ M-W . . . . . . . . . . . . . . . . . . . . . . . . . . . 18
+ M-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ M-X Append To File . . . . . . . . . . . . . . . . . . . 14
+ M-X Apropos . . . . . . . . . . . . . . . . . . . . . . . 14
+ M-X Auto Fill Mode . . . . . . . . . . . . . . . . . . . 15
+ M-X Count Occurrences . . . . . . . . . . . . . . . . . 18
+ M-X Delete And Expunge File . . . . . . . . . . . . . . 18
+ M-X Delete File . . . . . . . . . . . . . . . . . . . . . 19
+ M-X Delete Matching Lines . . . . . . . . . . . . . . . . 20
+ M-X Delete Non-Matching Lines . . . . . . . . . . . . . . 20
+ M-X Dired . . . . . . . . . . . . . . . . . . . . . . . . 21
+ M-X Edit Directory . . . . . . . . . . . . . . . . . . . . 21
+ M-X Execute Buffer . . . . . . . . . . . . . . . . . . . 22
+ M-X Execute File . . . . . . . . . . . . . . . . . . . . . 22
+ M-X Find File . . . . . . . . . . . . . . . . . . . . . . 24
+ M-X Flush Lines . . . . . . . . . . . . . . . . . . . . . 20
+ 201/NMODE Manual - 69 - Key Index
+
+
+ M-X How Many . . . . . . . . . . . . . . . . . . . . . . 18
+ M-X Insert Buffer . . . . . . . . . . . . . . . . . . . . 26
+ M-X Insert Date . . . . . . . . . . . . . . . . . . . . . 27
+ M-X Insert File . . . . . . . . . . . . . . . . . . . . . 27
+ M-X Keep Lines . . . . . . . . . . . . . . . . . . . . . 20
+ M-X Kill Buffer . . . . . . . . . . . . . . . . . . . . . 29
+ M-X Kill File . . . . . . . . . . . . . . . . . . . . . . . 19
+ M-X Kill Some Buffers . . . . . . . . . . . . . . . . . . 30
+ M-X Lisp Mode . . . . . . . . . . . . . . . . . . . . . . 32
+ M-X List Buffers . . . . . . . . . . . . . . . . . . . . . 17
+ M-X Make Space . . . . . . . . . . . . . . . . . . . . . 41
+ M-X Prepend To File . . . . . . . . . . . . . . . . . . . 42
+ M-X Query Replace . . . . . . . . . . . . . . . . . . . 42
+ M-X Rename Buffer . . . . . . . . . . . . . . . . . . . 43
+ M-X Replace String . . . . . . . . . . . . . . . . . . . 43
+ M-X Revert File . . . . . . . . . . . . . . . . . . . . . 44
+ M-X Save All Files . . . . . . . . . . . . . . . . . . . . 44
+ M-X Select Buffer . . . . . . . . . . . . . . . . . . . . 46
+ M-X Set Key . . . . . . . . . . . . . . . . . . . . . . . 47
+ M-X Set Visited Filename . . . . . . . . . . . . . . . . . 48
+ M-X Start Scripting . . . . . . . . . . . . . . . . . . . 48
+ M-X Start Timing Nmode . . . . . . . . . . . . . . . . . 48
+ M-X Stop Scripting . . . . . . . . . . . . . . . . . . . 49
+ M-X Stop Timing Nmode . . . . . . . . . . . . . . . . . 49
+ M-X Text Mode . . . . . . . . . . . . . . . . . . . . . 49
+ M-X Undelete File . . . . . . . . . . . . . . . . . . . . 51
+ M-X Visit File . . . . . . . . . . . . . . . . . . . . . . 53
+ M-X Write File . . . . . . . . . . . . . . . . . . . . . . 54
+ M-X Write Region . . . . . . . . . . . . . . . . . . . . 54
+ M-Y . . . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ M-Z . . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ M-^ . . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ M-~ . . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+
+ NEWLINE . . . . . . . . . . . . . . . . . . . . . . . . . 26
+
+ RETURN . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ RUBOUT . . . . . . . . . . . . . . . . . . . . . . . . . 19
+
+ TAB . . . . . . . . . . . . . . . . . . . . . . . . . . . 33, 49
+
+ ] . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27
+ 201/Key Index - 70 - NMODE Manual
+ 201/NMODE Manual - 71 - Topic Index
+
+
+ 202/9. Topic Index
+
+ 201/Alter Display Format . . . . . . . 7, 22, 25, 40, 41, 42, 43, 44, 45, 46,
+ 51, 53
+ Alter Existing Text . . . . . . . 7, 18, 23, 24, 33, 34, 42, 43, 50, 51,
+ 52, 53
+
+ Buffers . . . . . . . . . . . . . 14, 17, 22, 24, 26, 29, 30, 43, 44, 46, 53
+
+ Change Mode . . . . . . . . . . . 7, 15, 32, 48, 49
+
+ Defun . . . . . . . . . . . . . . 9, 21, 34, 36
+
+ Escape . . . . . . . . . . . . . . 7, 23, 31, 33, 40
+
+ Files . . . . . . . . . . . . . . . 14, 18, 19, 22, 24, 27, 42, 44, 48, 51,
+ 53, 54
+ Fill Column . . . . . . . . . . . 11, 18, 23, 24, 46
+ Fill Prefix . . . . . . . . . . . . 11, 23, 24, 47
+
+ Goal Column . . . . . . . . . . . 11, 37, 39
+
+ Inform . . . . . . . . . . . . . . 7, 14, 17, 18, 26, 31, 54
+ Insert Constant . . . . . . . . . 7, 26, 27, 28, 41, 43, 48, 49
+
+ Kill Ring . . . . . . . . . . . . . 11, 14, 16, 18, 19, 28, 29, 30, 52
+
+ Lisp . . . . . . . . . . . . . . . 17, 21, 23, 25, 27, 28, 29, 31, 32, 33,
+ 34, 35, 36, 38, 43, 50, 55
+
+ Mark . . . . . . . . . . . . . . . 7, 22, 23, 25, 28, 34, 35, 47
+ Move Data . . . . . . . . . . . . 8, 14, 24, 25, 26, 27, 28, 42, 51, 53, 55
+ Move Point . . . . . . . . . . . . 8, 16, 17, 21, 22, 24, 25, 26, 35, 36,
+ 37, 38, 39, 40, 42, 44, 46, 53
+
+ Paragraph . . . . . . . . . . . . 9, 16, 23, 24, 35
+ Preserve . . . . . . . . . . . . . 8, 18, 42, 44, 51, 54
+
+ Region . . . . . . . . . . . . . . 9, 14, 18, 30, 33, 42, 50, 52, 54
+ Remove . . . . . . . . . . . . . 8, 16, 18, 19, 20, 28, 29, 30, 44
+
+ Select . . . . . . . . . . . . . . 8, 20, 26, 42, 43, 44
+ Sentence . . . . . . . . . . . . . 9, 16, 24, 25, 30
+ Set Global Variable . . . . . . . . 8, 17, 43, 46, 47, 48
+ Subsequent Command Modifier . . 8, 15, 17, 22, 32, 34, 40, 51
+
+ Text . . . . . . . . . . . . . . . 18, 23, 24, 25, 29, 30, 34, 35, 37, 38,
+ 49, 51, 52, 53
+ 201/Topic Index - 72 - NMODE Manual
+ 201/NMODE Manual - 3 - Table of Contents
+
+
+
+
+
+ 202/CONTENTS
+
+
+
+ 1. Introduction ..................................................... 5
+
+ 2. Action Types .................................................... 7
+
+ 3. Definitions ....................................................... 9
+
+ 4. Globals ......................................................... 11
+
+ 5. Command Descriptions ........................................... 13
+
+ 6. Command Index ................................................. 57
+
+ 7. Function Index .................................................. 61
+
+ 8. Key Index ...................................................... 65
+
+ 9. Topic Index ..................................................... 71
ADDED psl-1983/3-1/doc/nmode/manual.labels
Index: psl-1983/3-1/doc/nmode/manual.labels
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/manual.labels
@@ -0,0 +1,124 @@
+.sr label_Introduction 1
+.nr label_Introduction 1
+.sr label_intro 1
+.nr label_intro 1
+.sr label_screen 2
+.nr label_screen 1
+.sr label_modeline 2.1
+.nr label_modeline 1
+.sr label_characters 3
+.nr label_characters 1
+.sr label_prefix 3.2
+.nr label_prefix 2
+.sr label_editing 4
+.nr label_editing 1
+.sr label_basic 4
+.nr label_basic 1
+.sr label_arguments 5
+.nr label_arguments 1
+.sr label_m_x 6
+.nr label_m_x 1
+.sr label_mmarcana 6.2
+.nr label_mmarcana 2
+.sr label_subsystems 7.1
+.nr label_subsystems 1
+.sr label_recursive 7.2
+.nr label_recursive 1
+.sr label_browsers 8
+.nr label_browsers 1
+.sr label_help 9
+.nr label_help 1
+.sr label_mark 10
+.nr label_mark 1
+.sr label_killing 11
+.nr label_killing 1
+.sr label_un_killing 11.2
+.nr label_un_killing 2
+.sr label_copying 11.3
+.nr label_copying 4
+.sr label_NMODEregisters 11.3.2
+.nr label_NMODEregisters 5
+.sr label_NMODE_registers 11.3.2
+.nr label_NMODE_registers 5
+.sr label_search 12
+.nr label_search 1
+.sr label_text 13
+.nr label_text 1
+.sr label_words 13.1
+.nr label_words 1
+.sr label_sentences 13.2
+.nr label_sentences 2
+.sr label_textindent 13.3
+.nr label_textindent 3
+.sr label_filling 13.4
+.nr label_filling 4
+.sr label_case 13.5
+.nr label_case 5
+.sr label_fixit 14
+.nr label_fixit 1
+.sr label_files 15
+.nr label_files 1
+.sr label_visiting 15.1
+.nr label_visiting 1
+.sr label_revert 15.2
+.nr label_revert 2
+.sr label_listdir 15.3
+.nr label_listdir 2
+.sr label_dired 15.4
+.nr label_dired 2
+.sr label_filadv 15.5
+.nr label_filadv 3
+.sr label_buffers 16
+.nr label_buffers 1
+.sr label_display 17
+.nr label_display 1
+.sr label_windows 18
+.nr label_windows 1
+.sr label_replace 19
+.nr label_replace 1
+.sr label_programs 20
+.nr label_programs 1
+.sr label_majormodes 20.1
+.nr label_majormodes 1
+.sr label_indenting 20.2
+.nr label_indenting 1
+.sr label_matching 20.3
+.nr label_matching 2
+.sr label_comments 20.4
+.nr label_comments 3
+.sr label_lisp 20.5
+.nr label_lisp 3
+.sr label_lists 20.5.1
+.nr label_lists 3
+.sr label_defuns 20.5.2
+.nr label_defuns 5
+.sr label_grinding 20.6
+.nr label_grinding 6
+.sr label_NMODECustomization 22
+.nr label_NMODECustomization 1
+.sr label_customization 22
+.nr label_customization 1
+.sr label_init 22.1
+.nr label_init 1
+.sr label_variables 22.2
+.nr label_variables 4
+.sr label_minormodes 22.3
+.nr label_minormodes 4
+.sr label_quitting 23.1
+.nr label_quitting 1
+.sr label_bugs 23.2
+.nr label_bugs 1
+.sr label_Action_Types 24
+.nr label_Action_Types 1
+.sr label_Definitions 25
+.nr label_Definitions 1
+.sr label_Globals 26
+.nr label_Globals 1
+.sr label_Command 27
+.nr label_Command 1
+.sr label_Function_Index 28
+.nr label_Function_Index 1
+.sr label_Key_Index 29
+.nr label_Key_Index 1
+.sr label_Topic_Index 30
+.nr label_Topic_Index 1
ADDED psl-1983/3-1/doc/nmode/manual.lpt
Index: psl-1983/3-1/doc/nmode/manual.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/manual.lpt
@@ -0,0 +1,3115 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ NMODE Reference Manual
+
+
+ Preliminary Edition
+
+
+
+
+ 11 February 1983 11:07:16
+
+
+
+
+
+
+
+
+
+
+ This document is a preliminary edition of the NMODE Reference
+ Manual. Do not distribute this document!
+
+ - 2 - NMODE Manual
+ NMODE Manual - 5 - Introduction
+
+
+ 1. Introduction
+
+ This document describes the NMODE text editor. NMODE is an interactive,
+ multiple-window, screen-oriented editor written in PSL (Portable Standard
+ Lisp). NMODE provides a compatible subset of the EMACS text editor,
+ developed at M.I.T. It also contains a number of extensions, most notably an
+ interface to the underlying Lisp system for Lisp programmers.
+
+ NMODE was developed at the Hewlett-Packard Laboratories Computer Research
+ Center by Alan Snyder. A number of significant extensions have been
+ contributed by Jeff Soreff.
+
+ NMODE is based on an earlier editor, EMODE, written in PSL by William F.
+ Galway at the University of Utah. Many of the basic ideas and the
+ underlying structure of the NMODE editor come directly from EMODE.
+
+ This document is only partially complete, but is being reprinted at this time
+ for the benefit of new users that are not familiar with EMACS. The bulk of
+ this document has been borrowed from EMACS documentation and modified
+ appropriately in areas where NMODE and EMACS differ.
+ Introduction - 6 - NMODE Manual
+ NMODE Manual - 7 - Action Types
+
+
+ 2. Action Types
+
+ This section defines a number of action types, which are used in the
+ descriptions of NMODE commands.
+
+
+
+
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Alter Display Format
+
+ This type of command alters how text is displayed without altering the
+ contents of existing buffers.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Alter Existing Text
+
+ This type of command alters some part of the existing text, generally
+ transforming and/or moving text rather than just inserting or deleting it.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Change Mode
+
+ This type of command turns some feature(s) of the editor on or off. This
+ may include major modes, minor modes, timing, or scripting.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Escape
+
+ Escape from the current level.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Inform
+
+ This type of command informs the user of some property of the text being
+ worked with, or of the state of the editor (including where point is, what the
+ existing buffer(s) is(are), what is in the documentation, etc.).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Insert Constant
+
+ This type of command inserts a character constant like tab or space or a
+ multiple thereof.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Mark
+
+ This type of command sets mark.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Types - 8 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Move Data
+
+ This command copies some data (which is not a constant wired into the
+ program) from one place to another.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Move Point
+
+ This type of command moves point. It may move it within a buffer or from
+ buffer to buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Preserve
+
+ Make a copy of something current and put it somewhere else (usually disc).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Remove
+
+ This type of command allows a user to get rid of data, either killing or
+ deleting text or removing files or directory entries.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Select
+
+ This type of command finds particular strings in text, and may perform some
+ action upon them, such as counting, replacement, or deletion.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Set Global Variable
+
+ This type of command sets some global variable which tends to remain stable
+ for some time, such as prefix variables and key bindings.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Action Type Explanation: Subsequent Command Modifier
+
+ This type of command modifies the meaning of the keys that immediately follow
+ it, as the prefix commands and the argument commands do.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 9 - Definitions
+
+
+ 3. Definitions
+
+ This section defines a number of terms used in the descriptions of NMODE
+ commands.
+
+
+
+
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Definition: Defun
+
+ A defun is a list whose ( falls in column 0. Its end is after the CRLF
+ following its ).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Definition: Paragraph
+
+ Paragraphs are delimited by blank lines and psuedo-blank lines, which are
+ lines which don't match the existing fill prefix (when there is one), and,
+ when in text mode, also by indentation and by text justifier command lines,
+ which are currently defined as lines starting with a period and which are
+ treated as another type of psuedo-blank line. Paragraphs contain the final
+ CRLF after their last test, and contain any immediately preceding empty line.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Definition: Region
+
+ The region is that portion of text between point, the current buffer position,
+ and mark.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Definition: Sentence
+
+ A sentence is ended by a ., ? or ! followed by two spaces or a CRLF (with
+ optional space), with any number of "closing characters" ", ', ) and ]
+ between. A sentence also starts at the start of a paragraph. A sentence
+ also ends at the end of a paragraph.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Definitions - 10 - NMODE Manual
+ NMODE Manual - 11 - Globals
+
+
+ 4. Globals
+
+ This section defines a number of conceptual global variables, which are
+ referred to in the descriptions of NMODE commands. These globals represent
+ state information that can affect the behavior of various NMODE commands.
+ The value of NMODE globals are set as the result of various NMODE
+ commands.
+
+
+
+
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Global Explanation: Fill Column
+
+ The fill column is the column beyond which all the fill commands: auto fill, fill
+ paragraph, fill region, and fill comment, will try to break up lines. The fill
+ column can be set by the Set Fill Column command.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Global Explanation: Fill Prefix
+
+ The fill prefix, if present, is a string that the fill paragraph and fill region
+ commands expect to see on the areas that they are filling. It is useful, for
+ instance, in filling indented text. Only the indented area will be filled, and
+ any new lines created by the filling will be properly indented. Autofill will
+ also insert it on each new line it starts.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Global Explanation: Goal Column
+
+ This is not yet correctly implemented
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Global Explanation: Kill Ring
+
+ The kill ring is a stack of the 16 most recently killed pieces of text. The
+ Insert Kill Buffer command reads text on the top of the kill ring and inserts
+ it back into the buffer. It can accept an argument, specifying an argument
+ other than the top one. If one knows that the text one wants is on the kill
+ ring, but is not certain how deeply it is buried, one can retrieve the top
+ item with the Insert Kill Buffer command, then look through the other items
+ one by one with the Unkill Previous command. This rotates the items on the
+ kill ring, displaying them one by one in a cycle.
+ Most kill commands push their text onto the top of the kill ring. If two kill
+ commands are performed right after each other, the text they kill is
+ concatenated. Commands the kill forward add onto the end of the previously
+ killed text. Commands that kill backward add onto the beginning. That way,
+ the text is assembled in its original order. If intervening commands have
+ taken place one can issue an Append Next Kill command before the next kill
+ in order to assemble the next killed text together with the text on top of the
+ kill ring.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Globals - 12 - NMODE Manual
+ NMODE Manual - 13 - Command Descriptions
+
+
+ 5. Command Descriptions
+
+ This section defines the basic NMODE commands. Each command description
+ includes the following information:
+
+ command A descriptive name of the command.
+
+ function The name of the Lisp function that implements the command.
+
+ key The logical keys on the keyboard that normally have this command
+ attached to them. A logical key includes ordinary keys such as
+ Tab or Rubout, shifted keys using the Control and/or Meta
+ modifiers (e.g., C-F, M-F, and C-M-F), prefixed commands using
+ C-X, C-], or Escape (e.g., C-X C-F, C-] E, and Esc-L), and
+ extended commands using Meta-X (e.g., M-X Delete Matching
+ Lines).
+
+ action type One of a number of descriptive terms that categorize the behavior
+ of commands. Action types are defined in Chapter 2.
+
+ mode Some commands are defined only in certain modes. If present,
+ this attribute specifies the mode or modes in which the command
+ is normally defined.
+
+ topic A keyword that describes the command. Topics are listed in the
+ Topic Index, Chapter 9.
+ Command Descriptions - 14 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Append Next Kill
+
+ Function: append-next-kill-command
+ Key: C-M-W
+ See Global: Kill Ring
+ Action Type: Move Data
+
+ Make following kill commands append to last batch. Thus, C-K C-K, cursor
+ motion, this command, and C-K C-K, generate one block of killed stuff,
+ containing two lines.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Append To Buffer
+
+ Function: append-to-buffer-command
+ Key: C-X A
+ Topic: Buffers
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to specified buffer. The buffer's name is read from the
+ keyboard; the buffer is created if nonexistent. A numeric argument causes
+ us to "prepend" instead. We always insert the text at that buffer's pointer,
+ but when "prepending" we leave the pointer before the inserted text.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Append To File
+
+ Function: append-to-file-command
+ Key: M-X Append To File
+ Topic: Files
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to end of specified file.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Apropos
+
+ Function: apropos-command
+ Key: M-X Apropos
+ Action Type: Inform
+
+ M-X Apropos lists functions with names containing a string for which the user
+ is prompted.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 15 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Argument Digit
+
+ Function: argument-digit
+ Key: C-0
+ Key: C-1
+ Key: C-2
+ Key: C-3
+ Key: C-4
+ Key: C-5
+ Key: C-6
+ Key: C-7
+ Key: C-8
+ Key: C-9
+ Key: C-M-0
+ Key: C-M-1
+ Key: C-M-2
+ Key: C-M-3
+ Key: C-M-4
+ Key: C-M-5
+ Key: C-M-6
+ Key: C-M-7
+ Key: C-M-8
+ Key: C-M-9
+ Key: M-0
+ Key: M-1
+ Key: M-2
+ Key: M-3
+ Key: M-4
+ Key: M-5
+ Key: M-6
+ Key: M-7
+ Key: M-8
+ Key: M-9
+ Action Type: Subsequent Command Modifier
+
+ Specify numeric argument for next command. Several such digits typed in a
+ row all accumulate.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Auto Fill Mode
+
+ Function: auto-fill-mode-command
+ Key: M-X Auto Fill Mode
+ See Command: Set Fill Column
+ Action Type: Change Mode
+
+ Break lines between words at the right margin. A positive argument turns
+ Auto Fill mode on; zero or negative, turns it off. With no argument, the
+ mode is toggled. When Auto Fill mode is on, lines are broken at spaces to fit
+ the right margin (position controlled by Fill Column). You can set the Fill
+ Column with the Set Fill Column command.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 16 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Back To Indentation
+
+ Function: back-to-indentation-command
+ Key: C-M-M
+ Key: C-M-RETURN
+ Key: M-M
+ Key: M-RETURN
+ Action Type: Move Point
+
+ Move to end of this line's indentation.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Backward Kill Sentence
+
+ Function: backward-kill-sentence-command
+ Key: C-X RUBOUT
+ See Global: Kill Ring
+ See Definition: Sentence
+ Action Type: Remove
+
+ Kill back to beginning of sentence. With a command argument n kills
+ backward (n>0) or forward (n>0) by |n| sentences.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Backward Paragraph
+
+ Function: backward-paragraph-command
+ Key: M-[
+ See Definition: Paragraph
+ Action Type: Move Point
+
+ Move backward to start of paragraph. When given argument moves backward
+ (n>0) or forward (n<0) by |n| paragraphs where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Backward Sentence
+
+ Function: backward-sentence-command
+ Key: M-A
+ See Definition: Sentence
+ Action Type: Move Point
+
+ Move to beginning of sentence. When given argument moves backward (n>0)
+ or forward (n<0) by |n| sentences where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 17 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Backward Up List
+
+ Function: backward-up-list-command
+ Key: C-(
+ Key: C-M-(
+ Key: C-M-U
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move up one level of list structure, backward. Given a command argument n
+ move up |n| levels backward (n>0) or forward (n<0).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Buffer Browser
+
+ Function: buffer-browser-command
+ Key: C-X C-B
+ Key: M-X List Buffers
+ Topic: Buffers
+ Action Type: Inform
+
+ Put up a buffer browser subsystem. If an argument is given, then include
+ buffers whose names begin with "+".
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Buffer Not Modified
+
+ Function: buffer-not-modified-command
+ Key: M-~
+ Topic: Buffers
+ Action Type: Set Global Variable
+
+ Pretend that this buffer hasn't been altered.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: C-X Prefix
+
+ Function: c-x-prefix
+ Key: C-X
+ Action Type: Subsequent Command Modifier
+
+ The command Control-X is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 18 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Center Line
+
+ Function: center-line-command
+ Key: M-S
+ Topic: Text
+ See Global: Fill Column
+ Action Type: Alter Existing Text
+
+ Center this line's text within the line. With argument, centers that many
+ lines and moves past. Centers current and preceding lines with negative
+ argument. The width is Fill Column.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Copy Region
+
+ Function: copy-region
+ Key: M-W
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Preserve
+
+ Stick region into kill-ring without killing it. Like killing and getting back,
+ but doesn't mark buffer modified.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Count Occurrences
+
+ Function: count-occurrences-command
+ Key: M-X Count Occurrences
+ Key: M-X How Many
+ Action Type: Inform
+
+ Counts occurrences of a string, after point. The user is prompted for the
+ string. Case is ignored in the count.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete And Expunge File
+
+ Function: delete-and-expunge-file-command
+ Key: M-X Delete And Expunge File
+ Topic: Files
+ Action Type: Remove
+
+ This command prompts the user for the name of the file. NMODE will fill in
+ defaults in a partly specified filename (eg filetype can be defaulted). If
+ possible, the file will then be deleted and expunged, and a message to that
+ effect will be displayed. If the operation fails, the bell will sound.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 19 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Backward Hacking Tabs
+
+ Function: delete-backward-hacking-tabs-command
+ Key: BACKSPACE
+ Key: C-RUBOUT
+ Key: RUBOUT
+ Mode: Lisp
+ Action Type: Remove
+
+ Delete character before point, turning tabs into spaces. Rather than deleting
+ a whole tab, the tab is converted into the appropriate number of spaces and
+ then one space is deleted. With positive arguments this operation is
+ performed multiple times on the text before point. With negative arguments
+ this operation is performed multiple times on the text after point.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Blank Lines
+
+ Function: delete-blank-lines-command
+ Key: C-X C-O
+ Action Type: Remove
+
+ Delete all blank lines around this line's end. If done on a non-blank line,
+ deletes all spaces and tabs at the end of it, and all following blank lines
+ (Lines are blank if they contain only spaces and tabs). If done on a blank
+ line, deletes all preceding blank lines as well.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete File
+
+ Function: delete-file-command
+ Key: M-X Delete File
+ Key: M-X Kill File
+ Topic: Files
+ Action Type: Remove
+
+ Delete a file. Prompts for filename.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Forward Character
+
+ Function: delete-forward-character-command
+ Key: C-D
+ Key: ESC-P
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Delete character after point. With argument, kill that many characters
+ (saving them). Negative args kill characters backward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 20 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Horizontal Space
+
+ Function: delete-horizontal-space-command
+ Key: M-\
+ Action Type: Remove
+
+ Delete all spaces and tabs around point.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Indentation
+
+ Function: delete-indentation-command
+ Key: M-^
+ Action Type: Remove
+
+ Delete CRLF and indentation at front of line. Leaves one space in place of
+ them. With argument, moves down one line first (deleting CRLF after current
+ line).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Matching Lines
+
+ Function: delete-matching-lines-command
+ Key: M-X Delete Matching Lines
+ Key: M-X Flush Lines
+ Action Type: Select
+ Action Type: Remove
+
+ Delete Matching Lines: Prompts user for string. Deletes all lines containing
+ specified string.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Delete Non-Matching Lines
+
+ Function: delete-non-matching-lines-command
+ Key: M-X Delete Non-Matching Lines
+ Key: M-X Keep Lines
+ Action Type: Select
+ Action Type: Remove
+
+ Delete Non-Matching Lines: Prompts user for string. Deletes all lines not
+ containing specified string.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Dired
+
+ Function: dired-command
+ Key: C-X D
+
+ Run Dired on the directory of the current buffer file. With no argument,
+ edits that directory. With an argument of 1, shows only the versions of the
+ file in the buffer. With an argument of 4, asks for input, only versions of
+ that file are shown.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 21 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Down List
+
+ Function: down-list
+ Key: C-M-D
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move down one level of list structure, forward. Command argument
+ sensitivity not yet implemented.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Edit Directory
+
+ Function: edit-directory-command
+ Key: M-X Dired
+ Key: M-X Edit Directory
+
+ DIRED: Edit a directory. The string argument may contain the filespec (with
+ wildcards of course)
+ D deletes the file which is on the current line. (also K,^D,^K)
+ U undeletes the current line file.
+ Rubout undeletes the previous line file.
+ Space is like ^N - moves down a line.
+ E edit the file.
+ S sorts files according to size, read or write date.
+ R does a reverse sort.
+ ? types a list of commands.
+ Q lists files to be deleted and asks for confirmation:
+ Typing YES deletes them; X aborts; N resumes DIRED.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: End Of Defun
+
+ Function: end-of-defun-command
+ Key: C-M-E
+ Key: C-M-]
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Move Point
+
+ Move to end of this or next defun. With argument of 2, finds end of
+ following defun. With argument of -1, finds end of previous defun, etc.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 22 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Esc Prefix
+
+ Function: esc-prefix
+ Key: ESCAPE
+ Action Type: Subsequent Command Modifier
+
+ The command esc-prefix is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it. Used for escape sequences
+ sent by function keys on the keyboard.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Exchange Point And Mark
+
+ Function: exchange-point-and-mark
+ Key: C-X C-X
+ Action Type: Mark
+ Action Type: Move Point
+
+ Exchange positions of point and mark.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Exchange Windows
+
+ Function: exchange-windows-command
+ Key: C-X E
+ Action Type: Alter Display Format
+
+ Exchanges the current window with the other window, which becomes current.
+ In two window mode, the windows swap physical positions.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Execute Buffer
+
+ Function: execute-buffer-command
+ Key: M-X Execute Buffer
+ Topic: Buffers
+
+ This command makes NMODE take input from the specified buffer as if it were
+ typed in. This command supercedes any such previous request. Newline
+ characters are ignored when reading from a buffer. If a command argument
+ is given then only the last refresh of the screen triggered by the commands
+ actually occurs, otherwise all of the updating of the screen is visible.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Execute File
+
+ Function: execute-file-command
+ Key: M-X Execute File
+ Topic: Files
+
+ This command makes NMODE take input from the specified file as if it were
+ typed in. This command supercedes any such previous request. Newline
+ characters are ignored when reading from a buffer. If a command argument
+ is given then only the last refresh of the screen triggered by the commands
+ actually occurs, otherwise all of the updating of the screen is visible.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 23 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Execute Form
+
+ Function: execute-form-command
+ Key: Lisp-E
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Mark
+
+ Causes the Lisp reader to read and evaluate a form starting at the beginning
+ of the current line. We arrange for output to go to the end of the output
+ buffer. The mark is set at the current location in the input buffer, in case
+ user wants to go back.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Exit Nmode
+
+ Function: exit-nmode
+ Key: Lisp-L
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ Leave NMODE, return to normal listen loop.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Fill Comment
+
+ Function: fill-comment-command
+ Key: M-Z
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ Action Type: Alter Existing Text
+
+ This command creates a temporary fill prefix from the start of the current
+ line. It replaces the surrounding paragraph (determined using fill-prefix)
+ with a filled version. It leaves point at the a position bearing the same
+ relation to the filled text that the old point did to the old text.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Fill Paragraph
+
+ Function: fill-paragraph-command
+ Key: M-Q
+ Topic: Text
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ Action Type: Alter Existing Text
+
+ This fills (or justifies) this (or next) paragraph. It leaves point at the a
+ position bearing the same relation to the filled text that the old point did to
+ the old text. A numeric argument triggers justification rather than filling.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 24 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Fill Region
+
+ Function: fill-region-command
+ Key: M-G
+ Topic: Text
+ See Command: Set Fill Column
+ See Command: Set Fill Prefix
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ See Definition: Sentence
+ Action Type: Alter Existing Text
+
+ Fill text from point to mark. Fill Column specifies the desired text width.
+ Fill Prefix if present is a string that goes at the front of each line and is not
+ included in the filling. See Set Fill Column and Set Fill Prefix. An explicit
+ argument causes justification instead of filling. Each sentence which ends
+ within a line is followed by two spaces.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Find File
+
+ Function: find-file-command
+ Key: C-X C-F
+ Key: M-X Find File
+ Topic: Files
+ Topic: Buffers
+ Action Type: Move Data
+ Action Type: Move Point
+
+ Visit a file in its own buffer. If the file is already in some buffer, select
+ that buffer. Otherwise, visit the file in a buffer named after the file.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Forward Paragraph
+
+ Function: forward-paragraph-command
+ Key: M-]
+ Topic: Text
+ See Definition: Paragraph
+ Action Type: Move Point
+
+ Move forward to end of this or the next paragraph. When given argument
+ moves forward (n>0) or backward (n<0) by |n| paragraphs where n is the
+ command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 25 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Forward Sentence
+
+ Function: forward-sentence-command
+ Key: M-E
+ Topic: Text
+ See Definition: Sentence
+ Action Type: Move Point
+
+ Move forward to end of this or the next sentence. When given argument
+ moves forward (n>0) or backward (n<0) by |n| sentences. where n is the
+ command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Forward Up List
+
+ Function: forward-up-list-command
+ Key: C-)
+ Key: C-M-)
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move up one level of list structure, forward. Given a command argument n
+ move up |n| levels forward (n>0) or backward (n<0).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Get Register
+
+ Function: get-register-command
+ Key: C-X G
+ Action Type: Move Data
+ Action Type: Mark
+
+ Get contents of register (reads name from keyboard). The name is a single
+ letter or digit. Usually leaves the pointer before, and the mark after, the
+ text. With argument, puts point after and mark before.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Grow Window
+
+ Function: grow-window-command
+ Key: C-X ^
+ Action Type: Alter Display Format
+
+ Make this window use more lines. Argument is number of extra lines (can be
+ negative).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 26 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Help Dispatch
+
+ Function: help-dispatch
+ Key: C-?
+ Key: M-/
+ Key: M-?
+ Action Type: Inform
+
+ Prints the documentation of a command (not a function). The command
+ character is read from the terminal.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Incremental Search
+
+ Function: incremental-search-command
+ Key: C-S
+ Action Type: Move Point
+ Action Type: Select
+
+ Search for character string as you type it. C-Q quotes special characters.
+ Rubout cancels last character. C-S repeats the search, forward, and C-R
+ repeats it backward. C-R or C-S with search string empty changes the
+ direction of search or brings back search string from previous search.
+ Altmode exits the search. Other Control and Meta chars exit the search and
+ then are executed. If not all the input string can be found, the rest is not
+ discarded. You can rub it out, discard it all with C-G, exit, or use C-R or
+ C-S to search the other way. Quitting a successful search aborts the search
+ and moves point back; quitting a failing search just discards whatever input
+ wasn't found.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Indent New line
+
+ Function: indent-new-line-command
+ Key: NEWLINE
+ Action Type: Insert Constant
+
+ This function performs the following actions: Executes whatever function, if
+ any, is associated with <CR>. Executes whatever function, if any, is
+ associated with TAB, as if no command argument was given.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Buffer
+
+ Function: insert-buffer-command
+ Key: M-X Insert Buffer
+ Topic: Buffers
+ Action Type: Move Data
+
+ Insert contents of another buffer into existing text. The user is prompted
+ for the buffer name. Point is left just before the inserted material, and mark
+ is left just after it.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 27 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Closing bracket
+
+ Function: insert-closing-bracket
+ Key: )
+ Key: ]
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Insert the character typed, which should be a closing bracket, then display
+ the matching opening bracket.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Comment
+
+ Function: insert-comment-command
+ Key: M-;
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Move to the end of the current line, then add a "%" and a space at its end.
+ Leave point after the space.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Date
+
+ Function: insert-date-command
+ Key: M-X Insert Date
+ Action Type: Move Data
+
+ Insert the current time and date after point. The mark is put after the
+ inserted text.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert File
+
+ Function: insert-file-command
+ Key: M-X Insert File
+ Topic: Files
+ Action Type: Move Data
+
+ Insert contents of file into existing text. File name is string argument. The
+ pointer is left at the beginning, and the mark at the end.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 28 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Kill Buffer
+
+ Function: insert-kill-buffer
+ Key: C-Y
+ See Global: Kill Ring
+ Action Type: Move Data
+ Action Type: Mark
+
+ Re-insert the last stuff killed. Puts point after it and the mark before it.
+ An argument n says un-kill the n'th most recent string of killed stuff (1 =
+ most recent). A null argument (just C-U) means leave point before, mark
+ after.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Next Character
+
+ Function: insert-next-character-command
+ Key: C-Q
+ Action Type: Move Data
+
+ Reads a character and inserts it.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Insert Parens
+
+ Function: insert-parens
+ Key: M-(
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Insert () putting point between them. Also make a space before them if
+ appropriate. With argument, put the ) after the specified number of already
+ existing s-expressions. Thus, with argument 1, puts extra parens around
+ the following s-expression.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Backward Form
+
+ Function: kill-backward-form-command
+ Key: C-M-RUBOUT
+ Mode: Lisp
+ Topic: Lisp
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the last form. With a command argument kill the last (n>0) or next (n<0)
+ |n| forms, where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 29 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Backward Word
+
+ Function: kill-backward-word-command
+ Key: M-RUBOUT
+ Topic: Text
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill last word. With a command argument kill the last (n>0) or next (n<0)
+ |n| words, where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Buffer
+
+ Function: kill-buffer-command
+ Key: C-X K
+ Key: M-X Kill Buffer
+ Topic: Buffers
+ Action Type: Remove
+
+ Kill the buffer with specified name. The buffer name is taken from the
+ keyboard. Name completion is performed by SPACE and RETURN. If the
+ buffer has changes in it, the user is asked for confirmation.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Forward Form
+
+ Function: kill-forward-form-command
+ Key: C-M-K
+ Mode: Lisp
+ Topic: Lisp
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the next form. With a command argument kill the next (n>0) or last
+ (n<0) |n| forms, where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Forward Word
+
+ Function: kill-forward-word-command
+ Key: M-D
+ Topic: Text
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the next word. With a command argument kill the next (n>0) or last
+ (n<0) |n| words, where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 30 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Line
+
+ Function: kill-line
+ Key: C-K
+ Key: ESC-M
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill to end of line, or kill an end of line. At the end of a line (only blanks
+ following) kill through the CRLF. Otherwise, kill the rest of the line but not
+ the CRLF. With argument (positive or negative), kill specified number of
+ lines forward or backward respectively. An argument of zero means kill to
+ the beginning of the ine, nothing if at the beginning. Killed text is pushed
+ onto the kill ring for retrieval.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Region
+
+ Function: kill-region
+ Key: C-W
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Remove
+
+ Kill from point to mark. Use Control-Y and Meta-Y to get it back.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Sentence
+
+ Function: kill-sentence-command
+ Key: M-K
+ Topic: Text
+ See Global: Kill Ring
+ See Definition: Sentence
+ Action Type: Remove
+
+ Kill forward to end of sentence. With minus one as an argument it kills back
+ to the beginning of the sentence. Positive or negative arguments mean to kill
+ that many sentences forward or backward respectively.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Kill Some Buffers
+
+ Function: kill-some-buffers-command
+ Key: M-X Kill Some Buffers
+ Topic: Buffers
+ Action Type: Remove
+
+ Kill Some Buffers: Offer to kill each buffer, one by one. If the buffer
+ contains a modified file and you say to kill it, you are asked for confirmation.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 31 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Abort
+
+ Function: lisp-abort-command
+ Key: Lisp-A
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This command will pop out of an arbitrarily deep break loop.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Backtrace
+
+ Function: lisp-backtrace-command
+ Key: Lisp-B
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Inform
+
+ This lists all the function calls on the stack. It is a good way to see how the
+ offending expression got generated.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Continue
+
+ Function: lisp-continue-command
+ Key: Lisp-C
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This causes the expression last printed to be returned as the value of the
+ offending expression. This allows a user to recover from a low level error in
+ an involved calculation if they know what should have been returned by the
+ offending expression. This is also often useful as an automatic stub: If an
+ expression containing an undefined function is evaluated, a Break loop is
+ entered, and this may be used to return the value of the function call.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Help
+
+ Function: lisp-help-command
+ Key: Lisp-?
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Inform
+
+ If in break print:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+ else print:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp
+ Listener"
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 32 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Indent Region
+
+ Function: lisp-indent-region-command
+ Key: C-M-\
+ Mode: Lisp
+ Topic: Lisp
+
+ Indent all lines between point and mark. With argument, indents each line to
+ exactly that column. Otherwise, lisp indents each line. A line is processed
+ if its first character is in the region. It tries to preserve the textual
+ context of point and mark.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Indent sexpr
+
+ Function: lisp-indent-sexpr
+ Key: C-M-Q
+ Mode: Lisp
+ Topic: Lisp
+
+ Lisp Indent each line contained in the next form. This command does NOT
+ respond to command arguments.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Mode
+
+ Function: lisp-mode-command
+ Key: M-X Lisp Mode
+ Topic: Lisp
+ Action Type: Change Mode
+
+ Set things up for editing Lisp code. Tab indents for Lisp. Rubout hacks
+ tabs. Lisp execution commands availible. Paragraphs are delimited only by
+ blank lines.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Prefix
+
+ Function: lisp-prefix
+ Key: C-]
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Subsequent Command Modifier
+
+ The command lisp-prefix is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 33 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Quit
+
+ Function: lisp-quit-command
+ Key: Lisp-Q
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This exits the current break loop. It only pops up one level, unlike abort.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Retry
+
+ Function: lisp-retry-command
+ Key: Lisp-R
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This tries to evaluate the offending expression again, and to continue the
+ computation. This is often useful after defining a missing function, or
+ assigning a value to a variable.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lisp Tab
+
+ Function: lisp-tab-command
+ Key: C-M-I
+ Key: C-M-TAB
+ Key: TAB
+ Mode: Lisp
+ Topic: Lisp
+ See Command: Tab To Tab Stop
+ Action Type: Alter Existing Text
+
+ Indent this line for a Lisp-like language. With arg, moves over and indents
+ that many lines. With negative argument, indents preceding lines.
+ Note that the binding of TAB to this function holds only in Lisp mode. In
+ text mode TAB is bound to the Tab To Tab Stop command and the other keys
+ bound to this function are undefined.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lowercase Region
+
+ Function: lowercase-region-command
+ Key: C-X C-L
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Convert region to lower case.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 34 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Lowercase Word
+
+ Function: lowercase-word-command
+ Key: M-L
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Convert one word to lower case, moving past it. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: M-X Prefix
+
+ Function: m-x-prefix
+ Key: C-M-X
+ Key: M-X
+ Action Type: Subsequent Command Modifier
+
+ Read an extended command from the terminal with completion. Completion is
+ performed by SPACE and RETURN. This command reads the name of an
+ extended command, with completion, then executes that command. The
+ command may itself prompt for input.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark Beginning
+
+ Function: mark-beginning-command
+ Key: C-<
+ Action Type: Mark
+
+ Set mark at beginning of buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark Defun
+
+ Function: mark-defun-command
+ Key: C-M-BACKSPACE
+ Key: C-M-H
+ Key: M-BACKSPACE
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Mark
+
+ Put point and mark around this defun (or next).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 35 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark End
+
+ Function: mark-end-command
+ Key: C->
+ Action Type: Mark
+
+ Set mark at end of buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark Form
+
+ Function: mark-form-command
+ Key: C-M-@
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Mark
+
+ Set mark after (n>0) or before (n<0) |n| forms from point where n is the
+ command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark Paragraph
+
+ Function: mark-paragraph-command
+ Key: M-H
+ Topic: Text
+ See Definition: Paragraph
+ Action Type: Mark
+ Action Type: Move Point
+
+ Put point and mark around this paragraph. In between paragraphs, puts it
+ around the next one.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark Whole Buffer
+
+ Function: mark-whole-buffer-command
+ Key: C-X H
+ Action Type: Mark
+ Action Type: Move Point
+
+ Set point at beginning and mark at end of buffer. Pushes the old point on
+ the mark first, so two pops restore it.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Mark Word
+
+ Function: mark-word-command
+ Key: M-@
+ Topic: Text
+ Action Type: Mark
+
+ Set mark after (n>0) or before (n<0) |n| words from point where n is the
+ command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 36 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Backward Character
+
+ Function: move-backward-character-command
+ Key: C-B
+ Key: ESC-D
+ Action Type: Move Point
+
+ Move back one character. With argument, move that many characters
+ backward. Negative arguments move forward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Backward Defun
+
+ Function: move-backward-defun-command
+ Key: C-M-A
+ Key: C-M-[
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Move Point
+
+ Move to beginning of this or previous defun. With a negative argument,
+ moves forward to the beginning of a defun.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Backward Form
+
+ Function: move-backward-form-command
+ Key: C-M-B
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move back one form. With argument, move that many forms backward.
+ Negative arguments move forward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Backward List
+
+ Function: move-backward-list-command
+ Key: C-M-P
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move back one list. With argument, move that many lists backward.
+ Negative arguments move forward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 37 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Backward Word
+
+ Function: move-backward-word-command
+ Key: ESC-4
+ Key: M-B
+ Topic: Text
+ Action Type: Move Point
+
+ Move back one word. With argument, move that many words backward.
+ Negative arguments move forward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Down
+
+ Function: move-down-command
+ Key: ESC-B
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move point down a line. If a command argument n is given, move point down
+ (n>0) or up (n<0) by |n| lines.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Down Extending
+
+ Function: move-down-extending-command
+ Key: C-N
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move down vertically to next line. If given an argument moves down (n>0)
+ or up (n<0) |n| lines where n is the command argument. If given without an
+ argument after the last LF in the buffer, makes a new one at the end.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Forward Character
+
+ Function: move-forward-character-command
+ Key: C-F
+ Key: ESC-C
+ Action Type: Move Point
+
+ Move forward one character. With argument, move that many characters
+ forward. Negative args move backward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 38 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Forward Form
+
+ Function: move-forward-form-command
+ Key: C-M-F
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward one form. With argument, move that many forms forward.
+ Negative args move backward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Forward List
+
+ Function: move-forward-list-command
+ Key: C-M-N
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward one list. With argument, move that many lists forward.
+ Negative args move backward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Forward Word
+
+ Function: move-forward-word-command
+ Key: ESC-5
+ Key: M-F
+ Topic: Text
+ Action Type: Move Point
+
+ Move forward one word. With argument, move that many words forward.
+ Negative args move backward.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move To Buffer End
+
+ Function: move-to-buffer-end-command
+ Key: ESC-F
+ Key: M->
+ Action Type: Move Point
+
+ Go to end of buffer (leaving mark behind).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 39 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move To Buffer Start
+
+ Function: move-to-buffer-start-command
+ Key: ESC-H
+ Key: M-<
+ Action Type: Move Point
+
+ Go to beginning of buffer (leaving mark behind).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move To End Of Line
+
+ Function: move-to-end-of-line-command
+ Key: C-E
+ Action Type: Move Point
+
+ Move point to end of line. With positive argument n goes down n-1 lines,
+ then to the end of line. With zero argument goes up a line, then to line
+ end. With negative argument n goes up |n|+1 lines, then to the end of line.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move To Screen Edge
+
+ Function: move-to-screen-edge-command
+ Key: M-R
+ Action Type: Move Point
+
+ Jump to top or bottom of screen. Like Control-L except that point is
+ changed instead of the window. With no argument, jumps to the center. An
+ argument specifies the number of lines from the top, (negative args count
+ from the bottom).
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move To Start Of Line
+
+ Function: move-to-start-of-line-command
+ Key: C-A
+ Action Type: Move Point
+
+ Move point to beginning of line. With positive argument n goes down n-1
+ lines, then to the beginning of line. With zero argument goes up a line, then
+ to line beginning. With negative argument n goes up |n|+1 lines, then to the
+ beginning of line.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Move Up
+
+ Function: move-up-command
+ Key: C-P
+ Key: ESC-A
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move up vertically to next line. If given an argument moves up (n>0) or
+ down (n<0) |n| lines where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 40 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Negative Argument
+
+ Function: negative-argument
+ Key: C--
+ Key: C-M--
+ Key: M--
+ Action Type: Subsequent Command Modifier
+
+ Make argument to next command negative.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Next Screen
+
+ Function: next-screen-command
+ Key: C-V
+ Action Type: Move Point
+
+ Move down to display next screenful of text. With argument, moves window
+ down <arg> lines (negative moves up). Just minus as an argument moves up
+ a full screen.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Nmode Abort
+
+ Function: nmode-abort-command
+ Key: C-G
+ Action Type: Escape
+
+ This command provides a way of aborting input requests.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Nmode Exit To Superior
+
+ Function: nmode-exit-to-superior
+ Key: C-X C-Z
+ Action Type: Escape
+
+ Go back to EMACS's superior job.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Nmode Full Refresh
+
+ Function: nmode-full-refresh
+ Key: ESC-J
+ Action Type: Alter Display Format
+
+ This function refreshes the screen after first clearing the display. It it used
+ when the state of the display is in doubt.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 41 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Nmode Gc
+
+ Function: nmode-gc
+ Key: M-X Make Space
+
+ Reclaims any internal wasted space.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Nmode Invert Video
+
+ Function: nmode-invert-video
+ Key: C-X V
+ Action Type: Alter Display Format
+
+ Toggle between normal and inverse video.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Nmode Refresh
+
+ Function: nmode-refresh-command
+ Key: C-L
+ Action Type: Alter Display Format
+
+ Choose new window putting point at center, top or bottom. With no
+ argument, chooses a window to put point at the center. An argument gives
+ the line to put point on; negative args count from the bottom.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: One Window
+
+ Function: one-window-command
+ Key: C-X 1
+ Action Type: Alter Display Format
+
+ Display only one window. Normally, we display what used to be in the top
+ window, but a numeric argument says to display what was in the bottom one.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Open Line
+
+ Function: open-line-command
+ Key: C-O
+ Key: ESC-L
+ Action Type: Insert Constant
+
+ Insert a CRLF after point. Differs from ordinary insertion in that point
+ remains before the inserted characters. With positive argument, inserts
+ several CRLFs. With negative argument does nothing.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 42 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Other Window
+
+ Function: other-window-command
+ Key: C-X O
+ Action Type: Alter Display Format
+ Action Type: Move Point
+
+ Switch to the other window. In two-window mode, moves cursor to other
+ window. In one-window mode, exchanges contents of visible window with
+ remembered contents of (invisible) window two. An argument means switch
+ windows but select the same buffer in the other window.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Prepend To File
+
+ Function: prepend-to-file-command
+ Key: M-X Prepend To File
+ Topic: Files
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to start of specified file.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Previous Screen
+
+ Function: previous-screen-command
+ Key: M-V
+ Action Type: Move Point
+
+ Move up to display previous screenful of text. When an argument is present,
+ move the window back (n>0) or forward (n<0) |n| lines, where n is the
+ command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Put Register
+
+ Function: put-register-command
+ Key: C-X X
+ Action Type: Preserve
+
+ Put point to mark into register (reads name from keyboard). With an
+ argument, the text is also deleted.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Query Replace
+
+ Function: query-replace-command
+ Key: M-%
+ Key: M-X Query Replace
+ Action Type: Alter Existing Text
+ Action Type: Select
+
+ Replace occurrences of a string from point to the end of the buffer, asking
+ about each occurrence. Query Replace prompts for the string to be replaced
+ and for its potential replacement. Query Replace displays each occurrence of
+ NMODE Manual - 43 - Command Descriptions
+
+
+ the string to be replaced, you then type a character to say what to do.
+ Space => replace it with the potential replacement and show the next copy.
+ Rubout => don't replace, but show next copy. Comma => replace this copy
+ and show result, waiting for next command. ^ => return to site of previous
+ copy. ^L => redisplay screen. Exclamation mark => replace all remaining
+ copys without asking. Period => replace this copy and exit. Escape => just
+ exit.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Rename Buffer
+
+ Function: rename-buffer-command
+ Key: M-X Rename Buffer
+ Topic: Buffers
+ Action Type: Set Global Variable
+
+ Change the name of the current buffer. The new name is read from the
+ keyboard. If the user provides an empty string, the buffer name will be set
+ to a truncated version of the filename associated with the buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Replace String
+
+ Function: replace-string-command
+ Key: C-%
+ Key: M-X Replace String
+ Action Type: Alter Existing Text
+ Action Type: Select
+
+ Replace string with another from point to buffer end.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Reposition Window
+
+ Function: reposition-window-command
+ Key: C-M-R
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Alter Display Format
+
+ Reposition screen window appropriately. Tries to get all of current defun on
+ screen. Never moves the pointer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Return
+
+ Function: return-command
+ Key: RETURN
+ Action Type: Insert Constant
+
+ Insert CRLF, or move onto empty line. Repeated by positive argument. No
+ action with negative argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 44 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Reverse Search
+
+ Function: reverse-search-command
+ Key: C-R
+ See Command: Incremental Search
+ Action Type: Move Point
+ Action Type: Select
+
+ Incremental Search Backwards. Like Control-S but in reverse.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Revert File
+
+ Function: revert-file-command
+ Key: M-X Revert File
+ Topic: Files
+ Action Type: Remove
+
+ Undo changes to a file. Reads back the file being edited from disk
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Save All Files
+
+ Function: save-all-files-command
+ Key: M-X Save All Files
+ Topic: Buffers
+ Topic: Files
+ Action Type: Preserve
+
+ Offer to write back each buffer which may need it. For each buffer which is
+ visiting a file and which has been modified, you are asked whether to save
+ it. A numeric arg means don't ask; save everything.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Save File
+
+ Function: save-file-command
+ Key: C-X C-S
+ Topic: Files
+ Action Type: Preserve
+
+ Save visited file on disk if modified.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Other Window
+
+ Function: scroll-other-window-command
+ Key: C-M-V
+ Action Type: Alter Display Format
+
+ Scroll other window up several lines. Specify the number as a numeric
+ argument, negative for down. The default is a whole screenful up. Just
+ Meta-Minus as argument means scroll a whole screenful down.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 45 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Window Down Line
+
+ Function: scroll-window-down-line-command
+ Key: ESC-T
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window down (n > 0) or up (n < 0) by |n| lines
+ where n is the command argument. The "window position" may be adjusted to
+ keep it within the window. Ding if the window contents does not move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Window Down Page
+
+ Function: scroll-window-down-page-command
+ Key: ESC-V
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window down (n > 0) or up (n < 0) by |n|
+ screenfuls where n is the command argument. The "window position" may be
+ adjusted to keep it within the window. Ding if the window contents does not
+ move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Window Left
+
+ Function: scroll-window-left-command
+ Key: C-X <
+ Action Type: Alter Display Format
+
+ Scroll the contents of the specified window right (n > 0) or left (n < 0) by
+ |n| columns where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Window Right
+
+ Function: scroll-window-right-command
+ Key: C-X >
+ Action Type: Alter Display Format
+
+ Scroll the contents of the specified window left (n > 0) or right (n < 0) by
+ |n| columns where n is the command argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Window Up Line
+
+ Function: scroll-window-up-line-command
+ Key: ESC-S
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines
+ where n is the command argument. The "window position" may be adjusted to
+ keep it within the window. Ding if the window contents does not move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 46 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Scroll Window Up Page
+
+ Function: scroll-window-up-page-command
+ Key: ESC-U
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window up (n > 0) or down (n < 0) by |n|
+ screenfuls where n is the command argument. The "window position" may be
+ adjusted to keep it within the window. Ding if the window contents does not
+ move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Select Buffer
+
+ Function: select-buffer-command
+ Key: C-X B
+ Key: M-X Select Buffer
+ Topic: Buffers
+ Action Type: Move Point
+
+ Select or create buffer with specified name. Buffer name is read from
+ keyboard. Name completion is performed by SPACE and RETURN.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Select Previous Buffer
+
+ Function: select-previous-buffer-command
+ Key: C-M-L
+ Topic: Buffers
+ Action Type: Move Point
+
+ Select the previous buffer of the current buffer, if it exists and is
+ selectable. Otherwise, select the MAIN buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Set Fill Column
+
+ Function: set-fill-column-command
+ Key: C-X F
+ See Global: Fill Column
+ Action Type: Set Global Variable
+
+ Set fill column to numeric arg or current column. If there is an argument,
+ that is used. Otherwise, the current position of the cursor is used. The
+ Fill Column variable controls where Auto Fill mode and the fill commands put
+ the right margin.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 47 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Set Fill Prefix
+
+ Function: set-fill-prefix-command
+ Key: C-X .
+ See Global: Fill Prefix
+ Action Type: Set Global Variable
+
+ Defines Fill Prefix from current line. All of the current line up to point
+ becomes the value of Fill Prefix. Auto Fill Mode inserts the prefix on each
+ line; the Fill Paragraph command assumes that each non-blank line starts
+ with the prefix (which is ignored for filling purposes). To stop using a Fill
+ Prefix, do Control-X . at the front of a line.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Set Goal Column
+
+ Function: set-goal-column-command
+ Key: C-X C-N
+ Action Type: Set Global Variable
+
+ Set (or flush) a permanent goal for vertical motion. With no argument, makes
+ the current column the goal for vertical motion commands. They will always
+ try to go to that column. With argument, clears out any previously set goal.
+ Only Control-P and Control-N are affected.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Set Key
+
+ Function: set-key-command
+ Key: M-X Set Key
+ Action Type: Set Global Variable
+
+ Put a function on a key. The function name is a string argument. The key
+ is always read from the terminal (not a string argument). It may contain
+ metizers and other prefix characters.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Set Mark
+
+ Function: set-mark-command
+ Key: C-@
+ Key: C-SPACE
+ Action Type: Mark
+
+ Sets or pops the mark. With no ^U's, pushes point as the mark. With one
+ ^U, pops the mark into point. With two ^U's, pops the mark and throws it
+ away.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 48 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Set Visited Filename
+
+ Function: set-visited-filename-command
+ Key: M-X Set Visited Filename
+ Topic: Files
+ Action Type: Set Global Variable
+
+ Change visited filename, without writing file. The user is prompted for a
+ filename. What NMODE believes to be the name of the visited file associated
+ with the current buffer is set from the user's input. No file's name is
+ actually changed.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Split Line
+
+ Function: split-line-command
+ Key: C-M-O
+ Action Type: Insert Constant
+
+ Move rest of this line vertically down. Inserts a CRLF, and then enough
+ tabs/spaces so that what had been the rest of the current line is indented as
+ much as it had been. Point does not move, except to skip over indentation
+ that originally followed it. With positive argument, makes extra blank lines in
+ between. No action with negative argument.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Start Scripting
+
+ Function: start-scripting-command
+ Key: M-X Start Scripting
+ Action Type: Change Mode
+
+ This function prompts the user for a buffer name, into which it will copy all
+ the user's commands (as well as executing them) until the
+ stop-scripting-command is invoked. This command supercedes any such
+ previous request. Note that to keep the lines of reasonable length, free
+ Newlines will be inserted from time to time. Because of this, and because
+ many file systems cannot represent stray Newlines, the Newline character is
+ itself scripted as a CR followed by a TAB, since this is its normal definition.
+ Someday, perhaps, this hack will be replaced by a better one.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Start Timing
+
+ Function: start-timing-command
+ Key: M-X Start Timing Nmode
+ Action Type: Change Mode
+
+ This cleans up a number of global variables associated with timing, prompts
+ for a file in which to put the timing data (or defaults to a file named
+ "timing", of type "txt"), and starts the timing. Information is collected on
+ the total time, refresh time, read time, command execution time, total number
+ of cons cells built, and total number of garbage collections performed.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 49 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Stop Scripting
+
+ Function: stop-scripting-command
+ Key: M-X Stop Scripting
+ Action Type: Change Mode
+
+ This command stops the echoing of user commands into a script buffer. This
+ command is itself echoed before the creation of the script stops.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Stop Timing
+
+ Function: stop-timing-command
+ Key: M-X Stop Timing Nmode
+ Action Type: Change Mode
+
+ This stops the timing, formats the output data, and closes the file into which
+ the timing information is going. Information is collected on the total time,
+ refresh time, read time, command execution time, total number of cons cells
+ built, and total number of garbage collections performed. In addition to
+ these numbers, some ratios are printed.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Tab To Tab Stop
+
+ Function: tab-to-tab-stop-command
+ Key: M-I
+ Key: M-TAB
+ Key: TAB
+ See Command: Lisp Tab
+ Action Type: Insert Constant
+
+ Insert a tab character. Note that the binding of TAB to this command only
+ holds in text mode, not in lisp mode, where it is bound to the Lisp Tab
+ command. In lisp mode, the other keys continue to be bound to this command.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Text Mode
+
+ Function: text-mode-command
+ Key: M-X Text Mode
+ Topic: Text
+ Action Type: Change Mode
+
+ Set things up for editing English text. Tab inserts tab characters. There
+ are no comments. Auto Fill does not indent new lines.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 50 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Transpose Characters
+
+ Function: transpose-characters-command
+ Key: C-T
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the characters before and after the cursor. For more details, see
+ Meta-T, reading "character" for "word". However: at the end of a line, with
+ no argument, the preceding two characters are transposed.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Transpose Forms
+
+ Function: transpose-forms
+ Key: C-M-T
+ Mode: Lisp
+ Topic: Lisp
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the forms before and after the cursor. For more details, see
+ Meta-T, reading "Form" for "Word".
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Transpose Lines
+
+ Function: transpose-lines
+ Key: C-X C-T
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the lines before and after the cursor. For more details, see
+ Meta-T, reading "Line" for "Word".
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Transpose Regions
+
+ Function: transpose-regions
+ Key: C-X T
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Transpose regions defined by cursor and last 3 marks. To transpose two
+ non-overlapping regions, set the mark successively at three of the four
+ boundaries, put point at the fourth, and call this function.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 51 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Transpose Words
+
+ Function: transpose-words
+ Key: M-T
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Transpose the words before and after the cursor. With a positive argument
+ it transposes the words before and after the cursor, moves right, and
+ repeats the specified number of times, dragging the word to the left of the
+ cursor right. With a negative argument, it transposes the two words to the
+ left of the cursor, moves between them, and repeats the specified number of
+ times, exactly undoing the positive argument form. With a zero argument, it
+ transposes the words at point and mark.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Two Windows
+
+ Function: two-windows-command
+ Key: C-X 2
+ Action Type: Alter Display Format
+
+ Show two windows and select window two. An argument > 1 means give
+ window 2 the same buffer as in Window 1.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Undelete File
+
+ Function: undelete-file-command
+ Key: M-X Undelete File
+ Topic: Files
+ Action Type: Move Data
+ Action Type: Preserve
+
+ This command prompts the user for the name of the file. NMODE will fill in a
+ partly specified filename (eg filetype can be defaulted). If possible, the file
+ will then be undeleted, and a message to that effect will be displayed. If the
+ operation fails, the bell will sound.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Universal Argument
+
+ Function: universal-argument
+ Key: C-U
+ Action Type: Subsequent Command Modifier
+
+ Sets argument or multiplies it by four. Followed by digits, uses them to
+ specify the argument for the command after the digits. If not followed by
+ digits, multiplies the argument by four.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 52 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Unkill Previous
+
+ Function: unkill-previous
+ Key: M-Y
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Delete (without saving away) the current region, and then unkill (yank) the
+ specified entry in the kill ring. "Ding" if the current region does not
+ contain the same text as the current entry in the kill ring. If one has just
+ retrieved the top entry from the kill ring this has the effect of displaying the
+ item just beneath it, then the item beneath that and so on until the original
+ top entry rotates back into view.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Upcase Digit
+
+ Function: upcase-digit-command
+ Key: M-'
+ Action Type: Alter Existing Text
+
+ Convert last digit to shifted character. Looks on current line back from
+ point, and previous line. The first time you use this command, it asks you
+ to type the row of digits from 1 to 9 and then 0, holding down Shift, to
+ determine how your keyboard is set up.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Uppercase Initial
+
+ Function: uppercase-initial-command
+ Key: M-C
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Put next word in lower case, but capitalize initial. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Uppercase Region
+
+ Function: uppercase-region-command
+ Key: C-X C-U
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Convert region to upper case.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 53 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Uppercase Word
+
+ Function: uppercase-word-command
+ Key: M-U
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Convert one word to upper case, moving past it. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: View Two Windows
+
+ Function: view-two-windows-command
+ Key: C-X 3
+ Action Type: Alter Display Format
+
+ Show two windows but stay in first.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Visit File
+
+ Function: visit-file-command
+ Key: C-X C-V
+ Key: M-X Visit File
+ Topic: Files
+ Action Type: Move Data
+ Action Type: Move Point
+
+ Visit new file in current buffer. The user is prompted for the filename. If
+ the current buffer is modified, the user is asked whether to write it out.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Visit In Other Window
+
+ Function: visit-in-other-window-command
+ Key: C-X 4
+ Topic: Files
+ Topic: Buffers
+ Action Type: Move Point
+ Action Type: Alter Display Format
+
+ Find buffer or file in other window. Follow this command by B and a buffer
+ name, or by F and a file name. We find the buffer or file in the other
+ window, creating the other window if necessary.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 54 - NMODE Manual
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: What Cursor Position
+
+ Function: what-cursor-position-command
+ Key: C-=
+ Key: C-X =
+ Action Type: Inform
+
+ Print various things about where cursor is. Print the X position, the Y
+ position, the octal code for the following character, point absolutely and as a
+ percentage of the total file size, and the virtual boundaries, if any. If a
+ positive argument is given point will jump to the line number specified by the
+ argument. A negative argument triggers a jump to the first line in the
+ buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Write File
+
+ Function: write-file-command
+ Key: C-X C-W
+ Key: M-X Write File
+ Topic: Files
+ Action Type: Preserve
+
+ Prompts for file name. Stores the current buffer in specified file. This file
+ becomes the one being visited.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Write Region
+
+ Function: write-region-command
+ Key: M-X Write Region
+ Topic: Files
+ See Definition: Region
+ Action Type: Preserve
+
+ Write region to file. Prompts for file name.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Write Screen Photo
+
+ Function: write-screen-photo-command
+ Key: C-X P
+ Topic: Files
+ Action Type: Preserve
+
+ Ask for filename, write out the screen to the file.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ NMODE Manual - 55 - Command Descriptions
+
+
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command: Yank Last Output
+
+ Function: yank-last-output-command
+ Key: Lisp-Y
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Data
+
+ Insert "last output" typed in the OUTPUT buffer.
+ $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ Command Descriptions - 56 - NMODE Manual
+ NMODE Manual - 57 - Command Index
+
+
+ 6. Command Index
+
+ Append Next Kill . . . . . . . . . . . . . . . . . . . . 14
+ Append To Buffer . . . . . . . . . . . . . . . . . . . . 14
+ Append To File . . . . . . . . . . . . . . . . . . . . . 14
+ Apropos . . . . . . . . . . . . . . . . . . . . . . . . . 14
+ Argument Digit . . . . . . . . . . . . . . . . . . . . . 15
+ Auto Fill Mode . . . . . . . . . . . . . . . . . . . . . . 15
+
+ Back To Indentation . . . . . . . . . . . . . . . . . . . 16
+ Backward Kill Sentence . . . . . . . . . . . . . . . . . 16
+ Backward Paragraph . . . . . . . . . . . . . . . . . . . 16
+ Backward Sentence . . . . . . . . . . . . . . . . . . . . 16
+ Backward Up List . . . . . . . . . . . . . . . . . . . . 17
+ Buffer Browser . . . . . . . . . . . . . . . . . . . . . 17
+ Buffer Not Modified . . . . . . . . . . . . . . . . . . . 17
+
+ C-X Prefix . . . . . . . . . . . . . . . . . . . . . . . . 17
+ Center Line . . . . . . . . . . . . . . . . . . . . . . . 18
+ Copy Region . . . . . . . . . . . . . . . . . . . . . . . 18
+ Count Occurrences . . . . . . . . . . . . . . . . . . . . 18
+
+ Delete And Expunge File . . . . . . . . . . . . . . . . . 18
+ Delete Backward Hacking Tabs . . . . . . . . . . . . . . 19
+ Delete Blank Lines . . . . . . . . . . . . . . . . . . . . 19
+ Delete File . . . . . . . . . . . . . . . . . . . . . . . . 19
+ Delete Forward Character . . . . . . . . . . . . . . . . 19
+ Delete Horizontal Space . . . . . . . . . . . . . . . . . 20
+ Delete Indentation . . . . . . . . . . . . . . . . . . . . 20
+ Delete Matching Lines . . . . . . . . . . . . . . . . . . 20
+ Delete Non-Matching Lines . . . . . . . . . . . . . . . . 20
+ Dired . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ Down List . . . . . . . . . . . . . . . . . . . . . . . . 21
+
+ Edit Directory . . . . . . . . . . . . . . . . . . . . . . 21
+ End Of Defun . . . . . . . . . . . . . . . . . . . . . . 21
+ Esc Prefix . . . . . . . . . . . . . . . . . . . . . . . . 22
+ Exchange Point And Mark . . . . . . . . . . . . . . . . 22
+ Exchange Windows . . . . . . . . . . . . . . . . . . . . 22
+ Execute Buffer . . . . . . . . . . . . . . . . . . . . . . 22
+ Execute File . . . . . . . . . . . . . . . . . . . . . . . 22
+ Execute Form . . . . . . . . . . . . . . . . . . . . . . 23
+ Exit Nmode . . . . . . . . . . . . . . . . . . . . . . . 23
+
+ Fill Comment . . . . . . . . . . . . . . . . . . . . . . . 23
+ Fill Paragraph . . . . . . . . . . . . . . . . . . . . . . 23
+ Fill Region . . . . . . . . . . . . . . . . . . . . . . . . 24
+ Find File . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ Forward Paragraph . . . . . . . . . . . . . . . . . . . . 24
+ Forward Sentence . . . . . . . . . . . . . . . . . . . . 25
+ Forward Up List . . . . . . . . . . . . . . . . . . . . . 25
+ Command Index - 58 - NMODE Manual
+
+
+ Get Register . . . . . . . . . . . . . . . . . . . . . . . 25
+ Grow Window . . . . . . . . . . . . . . . . . . . . . . . 25
+
+ Help Dispatch . . . . . . . . . . . . . . . . . . . . . . 26
+
+ Incremental Search . . . . . . . . . . . . . . . . . . . . 26
+ Indent New line . . . . . . . . . . . . . . . . . . . . . 26
+ Insert Buffer . . . . . . . . . . . . . . . . . . . . . . 26
+ Insert Closing bracket . . . . . . . . . . . . . . . . . . 27
+ Insert Comment . . . . . . . . . . . . . . . . . . . . . 27
+ Insert Date . . . . . . . . . . . . . . . . . . . . . . . 27
+ Insert File . . . . . . . . . . . . . . . . . . . . . . . . 27
+ Insert Kill Buffer . . . . . . . . . . . . . . . . . . . . 28
+ Insert Next Character . . . . . . . . . . . . . . . . . . 28
+ Insert Parens . . . . . . . . . . . . . . . . . . . . . . 28
+
+ Kill Backward Form . . . . . . . . . . . . . . . . . . . 28
+ Kill Backward Word . . . . . . . . . . . . . . . . . . . 29
+ Kill Buffer . . . . . . . . . . . . . . . . . . . . . . . . 29
+ Kill Forward Form . . . . . . . . . . . . . . . . . . . . 29
+ Kill Forward Word . . . . . . . . . . . . . . . . . . . . 29
+ Kill Line . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ Kill Region . . . . . . . . . . . . . . . . . . . . . . . . 30
+ Kill Sentence . . . . . . . . . . . . . . . . . . . . . . . 30
+ Kill Some Buffers . . . . . . . . . . . . . . . . . . . . 30
+
+ Lisp Abort . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Backtrace . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Continue . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Help . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp Indent Region . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Indent sexpr . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Mode . . . . . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Prefix . . . . . . . . . . . . . . . . . . . . . . . 32
+ Lisp Quit . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp Retry . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp Tab . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lowercase Region . . . . . . . . . . . . . . . . . . . . 33
+ Lowercase Word . . . . . . . . . . . . . . . . . . . . . 34
+
+ M-X Prefix . . . . . . . . . . . . . . . . . . . . . . . . 34
+ Mark Beginning . . . . . . . . . . . . . . . . . . . . . 34
+ Mark Defun . . . . . . . . . . . . . . . . . . . . . . . 34
+ Mark End . . . . . . . . . . . . . . . . . . . . . . . . 35
+ Mark Form . . . . . . . . . . . . . . . . . . . . . . . . 35
+ Mark Paragraph . . . . . . . . . . . . . . . . . . . . . 35
+ Mark Whole Buffer . . . . . . . . . . . . . . . . . . . . 35
+ Mark Word . . . . . . . . . . . . . . . . . . . . . . . . 35
+ Move Backward Character . . . . . . . . . . . . . . . . 36
+ Move Backward Defun . . . . . . . . . . . . . . . . . . 36
+ Move Backward Form . . . . . . . . . . . . . . . . . . . 36
+ Move Backward List . . . . . . . . . . . . . . . . . . . 36
+ Move Backward Word . . . . . . . . . . . . . . . . . . . 37
+ NMODE Manual - 59 - Command Index
+
+
+ Move Down . . . . . . . . . . . . . . . . . . . . . . . . 37
+ Move Down Extending . . . . . . . . . . . . . . . . . . 37
+ Move Forward Character . . . . . . . . . . . . . . . . . 37
+ Move Forward Form . . . . . . . . . . . . . . . . . . . 38
+ Move Forward List . . . . . . . . . . . . . . . . . . . . 38
+ Move Forward Word . . . . . . . . . . . . . . . . . . . 38
+ Move To Buffer End . . . . . . . . . . . . . . . . . . . 38
+ Move To Buffer Start . . . . . . . . . . . . . . . . . . 39
+ Move To End Of Line . . . . . . . . . . . . . . . . . . 39
+ Move To Screen Edge . . . . . . . . . . . . . . . . . . 39
+ Move To Start Of Line . . . . . . . . . . . . . . . . . . 39
+ Move Up . . . . . . . . . . . . . . . . . . . . . . . . . 39
+
+ Negative Argument . . . . . . . . . . . . . . . . . . . . 40
+ Next Screen . . . . . . . . . . . . . . . . . . . . . . . 40
+ Nmode Abort . . . . . . . . . . . . . . . . . . . . . . . 40
+ Nmode Exit To Superior . . . . . . . . . . . . . . . . . 40
+ Nmode Full Refresh . . . . . . . . . . . . . . . . . . . 40
+ Nmode Gc . . . . . . . . . . . . . . . . . . . . . . . . 41
+ Nmode Invert Video . . . . . . . . . . . . . . . . . . . 41
+ Nmode Refresh . . . . . . . . . . . . . . . . . . . . . . 41
+
+ One Window . . . . . . . . . . . . . . . . . . . . . . . 41
+ Open Line . . . . . . . . . . . . . . . . . . . . . . . . 41
+ Other Window . . . . . . . . . . . . . . . . . . . . . . 42
+
+ Prepend To File . . . . . . . . . . . . . . . . . . . . . 42
+ Previous Screen . . . . . . . . . . . . . . . . . . . . . 42
+ Put Register . . . . . . . . . . . . . . . . . . . . . . . 42
+
+ Query Replace . . . . . . . . . . . . . . . . . . . . . . 42
+
+ Rename Buffer . . . . . . . . . . . . . . . . . . . . . . 43
+ Replace String . . . . . . . . . . . . . . . . . . . . . . 43
+ Reposition Window . . . . . . . . . . . . . . . . . . . . 43
+ Return . . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ Reverse Search . . . . . . . . . . . . . . . . . . . . . 44
+ Revert File . . . . . . . . . . . . . . . . . . . . . . . 44
+
+ Save All Files . . . . . . . . . . . . . . . . . . . . . . 44
+ Save File . . . . . . . . . . . . . . . . . . . . . . . . 44
+ Scroll Other Window . . . . . . . . . . . . . . . . . . . 44
+ Scroll Window Down Line . . . . . . . . . . . . . . . . . 45
+ Scroll Window Down Page . . . . . . . . . . . . . . . . . 45
+ Scroll Window Left . . . . . . . . . . . . . . . . . . . . 45
+ Scroll Window Right . . . . . . . . . . . . . . . . . . . 45
+ Scroll Window Up Line . . . . . . . . . . . . . . . . . . 45
+ Scroll Window Up Page . . . . . . . . . . . . . . . . . . 46
+ Select Buffer . . . . . . . . . . . . . . . . . . . . . . 46
+ Select Previous Buffer . . . . . . . . . . . . . . . . . . 46
+ Set Fill Column . . . . . . . . . . . . . . . . . . . . . 46
+ Set Fill Prefix . . . . . . . . . . . . . . . . . . . . . . 47
+ Set Goal Column . . . . . . . . . . . . . . . . . . . . . 47
+ Command Index - 60 - NMODE Manual
+
+
+ Set Key . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ Set Mark . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ Set Visited Filename . . . . . . . . . . . . . . . . . . . 48
+ Split Line . . . . . . . . . . . . . . . . . . . . . . . . 48
+ Start Scripting . . . . . . . . . . . . . . . . . . . . . . 48
+ Start Timing . . . . . . . . . . . . . . . . . . . . . . . 48
+ Stop Scripting . . . . . . . . . . . . . . . . . . . . . . 49
+ Stop Timing . . . . . . . . . . . . . . . . . . . . . . . 49
+
+ Tab To Tab Stop . . . . . . . . . . . . . . . . . . . . 49
+ Text Mode . . . . . . . . . . . . . . . . . . . . . . . . 49
+ Transpose Characters . . . . . . . . . . . . . . . . . . 50
+ Transpose Forms . . . . . . . . . . . . . . . . . . . . . 50
+ Transpose Lines . . . . . . . . . . . . . . . . . . . . . 50
+ Transpose Regions . . . . . . . . . . . . . . . . . . . . 50
+ Transpose Words . . . . . . . . . . . . . . . . . . . . . 51
+ Two Windows . . . . . . . . . . . . . . . . . . . . . . . 51
+
+ Undelete File . . . . . . . . . . . . . . . . . . . . . . . 51
+ Universal Argument . . . . . . . . . . . . . . . . . . . 51
+ Unkill Previous . . . . . . . . . . . . . . . . . . . . . 52
+ Upcase Digit . . . . . . . . . . . . . . . . . . . . . . . 52
+ Uppercase Initial . . . . . . . . . . . . . . . . . . . . . 52
+ Uppercase Region . . . . . . . . . . . . . . . . . . . . 52
+ Uppercase Word . . . . . . . . . . . . . . . . . . . . . 53
+
+ View Two Windows . . . . . . . . . . . . . . . . . . . . 53
+ Visit File . . . . . . . . . . . . . . . . . . . . . . . . 53
+ Visit In Other Window . . . . . . . . . . . . . . . . . . 53
+
+ What Cursor Position . . . . . . . . . . . . . . . . . . . 54
+ Write File . . . . . . . . . . . . . . . . . . . . . . . . 54
+ Write Region . . . . . . . . . . . . . . . . . . . . . . . 54
+ Write Screen Photo . . . . . . . . . . . . . . . . . . . . 54
+
+ Yank Last Output . . . . . . . . . . . . . . . . . . . . 55
+ NMODE Manual - 61 - Function Index
+
+
+ 7. Function Index
+
+ append-next-kill-command . . . . . . . . . . . . . . . . 14
+ append-to-buffer-command . . . . . . . . . . . . . . . . 14
+ append-to-file-command . . . . . . . . . . . . . . . . . 14
+ apropos-command . . . . . . . . . . . . . . . . . . . . . 14
+ argument-digit . . . . . . . . . . . . . . . . . . . . . . 15
+ auto-fill-mode-command . . . . . . . . . . . . . . . . . . 15
+
+ back-to-indentation-command . . . . . . . . . . . . . . . 16
+ backward-kill-sentence-command . . . . . . . . . . . . . 16
+ backward-paragraph-command . . . . . . . . . . . . . . 16
+ backward-sentence-command . . . . . . . . . . . . . . . 16
+ backward-up-list-command . . . . . . . . . . . . . . . . 17
+ buffer-browser-command . . . . . . . . . . . . . . . . . 17
+ buffer-not-modified-command . . . . . . . . . . . . . . . 17
+
+ c-x-prefix . . . . . . . . . . . . . . . . . . . . . . . . 17
+ center-line-command . . . . . . . . . . . . . . . . . . . 18
+ copy-region . . . . . . . . . . . . . . . . . . . . . . . 18
+ count-occurrences-command . . . . . . . . . . . . . . . 18
+
+ delete-and-expunge-file-command . . . . . . . . . . . . . 18
+ delete-backward-hacking-tabs-command . . . . . . . . . . 19
+ delete-blank-lines-command . . . . . . . . . . . . . . . . 19
+ delete-file-command . . . . . . . . . . . . . . . . . . . 19
+ delete-forward-character-command . . . . . . . . . . . . 19
+ delete-horizontal-space-command . . . . . . . . . . . . . 20
+ delete-indentation-command . . . . . . . . . . . . . . . . 20
+ delete-matching-lines-command . . . . . . . . . . . . . . 20
+ delete-non-matching-lines-command . . . . . . . . . . . . 20
+ dired-command . . . . . . . . . . . . . . . . . . . . . . 20
+ down-list . . . . . . . . . . . . . . . . . . . . . . . . 21
+
+ edit-directory-command . . . . . . . . . . . . . . . . . . 21
+ end-of-defun-command . . . . . . . . . . . . . . . . . . 21
+ esc-prefix . . . . . . . . . . . . . . . . . . . . . . . . 22
+ exchange-point-and-mark . . . . . . . . . . . . . . . . . 22
+ exchange-windows-command . . . . . . . . . . . . . . . 22
+ execute-buffer-command . . . . . . . . . . . . . . . . . 22
+ execute-file-command . . . . . . . . . . . . . . . . . . . 22
+ execute-form-command . . . . . . . . . . . . . . . . . . 23
+ exit-nmode . . . . . . . . . . . . . . . . . . . . . . . . 23
+
+ fill-comment-command . . . . . . . . . . . . . . . . . . . 23
+ fill-paragraph-command . . . . . . . . . . . . . . . . . . 23
+ fill-region-command . . . . . . . . . . . . . . . . . . . 24
+ find-file-command . . . . . . . . . . . . . . . . . . . . 24
+ forward-paragraph-command . . . . . . . . . . . . . . . 24
+ forward-sentence-command . . . . . . . . . . . . . . . . 25
+ forward-up-list-command . . . . . . . . . . . . . . . . . 25
+ Function Index - 62 - NMODE Manual
+
+
+ get-register-command . . . . . . . . . . . . . . . . . . 25
+ grow-window-command . . . . . . . . . . . . . . . . . . 25
+
+ help-dispatch . . . . . . . . . . . . . . . . . . . . . . 26
+
+ incremental-search-command . . . . . . . . . . . . . . . 26
+ indent-new-line-command . . . . . . . . . . . . . . . . . 26
+ insert-buffer-command . . . . . . . . . . . . . . . . . . 26
+ insert-closing-bracket . . . . . . . . . . . . . . . . . . 27
+ insert-comment-command . . . . . . . . . . . . . . . . . 27
+ insert-date-command . . . . . . . . . . . . . . . . . . . 27
+ insert-file-command . . . . . . . . . . . . . . . . . . . 27
+ insert-kill-buffer . . . . . . . . . . . . . . . . . . . . . 28
+ insert-next-character-command . . . . . . . . . . . . . . 28
+ insert-parens . . . . . . . . . . . . . . . . . . . . . . 28
+
+ kill-backward-form-command . . . . . . . . . . . . . . . 28
+ kill-backward-word-command . . . . . . . . . . . . . . . 29
+ kill-buffer-command . . . . . . . . . . . . . . . . . . . 29
+ kill-forward-form-command . . . . . . . . . . . . . . . . 29
+ kill-forward-word-command . . . . . . . . . . . . . . . . 29
+ kill-line . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ kill-region . . . . . . . . . . . . . . . . . . . . . . . . 30
+ kill-sentence-command . . . . . . . . . . . . . . . . . . 30
+ kill-some-buffers-command . . . . . . . . . . . . . . . . 30
+
+ lisp-abort-command . . . . . . . . . . . . . . . . . . . . 31
+ lisp-backtrace-command . . . . . . . . . . . . . . . . . 31
+ lisp-continue-command . . . . . . . . . . . . . . . . . . 31
+ lisp-help-command . . . . . . . . . . . . . . . . . . . . 31
+ lisp-indent-region-command . . . . . . . . . . . . . . . . 32
+ lisp-indent-sexpr . . . . . . . . . . . . . . . . . . . . 32
+ lisp-mode-command . . . . . . . . . . . . . . . . . . . . 32
+ lisp-prefix . . . . . . . . . . . . . . . . . . . . . . . . 32
+ lisp-quit-command . . . . . . . . . . . . . . . . . . . . 33
+ lisp-retry-command . . . . . . . . . . . . . . . . . . . . 33
+ lisp-tab-command . . . . . . . . . . . . . . . . . . . . . 33
+ lowercase-region-command . . . . . . . . . . . . . . . . 33
+ lowercase-word-command . . . . . . . . . . . . . . . . . 34
+
+ m-x-prefix . . . . . . . . . . . . . . . . . . . . . . . . 34
+ mark-beginning-command . . . . . . . . . . . . . . . . . 34
+ mark-defun-command . . . . . . . . . . . . . . . . . . . 34
+ mark-end-command . . . . . . . . . . . . . . . . . . . . 35
+ mark-form-command . . . . . . . . . . . . . . . . . . . 35
+ mark-paragraph-command . . . . . . . . . . . . . . . . . 35
+ mark-whole-buffer-command . . . . . . . . . . . . . . . 35
+ mark-word-command . . . . . . . . . . . . . . . . . . . 35
+ move-backward-character-command . . . . . . . . . . . . 36
+ move-backward-defun-command . . . . . . . . . . . . . . 36
+ move-backward-form-command . . . . . . . . . . . . . . 36
+ move-backward-list-command . . . . . . . . . . . . . . . 36
+ move-backward-word-command . . . . . . . . . . . . . . 37
+ NMODE Manual - 63 - Function Index
+
+
+ move-down-command . . . . . . . . . . . . . . . . . . . 37
+ move-down-extending-command . . . . . . . . . . . . . . 37
+ move-forward-character-command . . . . . . . . . . . . . 37
+ move-forward-form-command . . . . . . . . . . . . . . . 38
+ move-forward-list-command . . . . . . . . . . . . . . . . 38
+ move-forward-word-command . . . . . . . . . . . . . . . 38
+ move-to-buffer-end-command . . . . . . . . . . . . . . . 38
+ move-to-buffer-start-command . . . . . . . . . . . . . . 39
+ move-to-end-of-line-command . . . . . . . . . . . . . . . 39
+ move-to-screen-edge-command . . . . . . . . . . . . . . 39
+ move-to-start-of-line-command . . . . . . . . . . . . . . 39
+ move-up-command . . . . . . . . . . . . . . . . . . . . 39
+
+ negative-argument . . . . . . . . . . . . . . . . . . . . 40
+ next-screen-command . . . . . . . . . . . . . . . . . . . 40
+ nmode-abort-command . . . . . . . . . . . . . . . . . . 40
+ nmode-exit-to-superior . . . . . . . . . . . . . . . . . . 40
+ nmode-full-refresh . . . . . . . . . . . . . . . . . . . . 40
+ nmode-gc . . . . . . . . . . . . . . . . . . . . . . . . 41
+ nmode-invert-video . . . . . . . . . . . . . . . . . . . . 41
+ nmode-refresh-command . . . . . . . . . . . . . . . . . 41
+
+ one-window-command . . . . . . . . . . . . . . . . . . . 41
+ open-line-command . . . . . . . . . . . . . . . . . . . . 41
+ other-window-command . . . . . . . . . . . . . . . . . . 42
+
+ prepend-to-file-command . . . . . . . . . . . . . . . . . 42
+ previous-screen-command . . . . . . . . . . . . . . . . . 42
+ put-register-command . . . . . . . . . . . . . . . . . . 42
+
+ query-replace-command . . . . . . . . . . . . . . . . . . 42
+
+ rename-buffer-command . . . . . . . . . . . . . . . . . 43
+ replace-string-command . . . . . . . . . . . . . . . . . 43
+ reposition-window-command . . . . . . . . . . . . . . . . 43
+ return-command . . . . . . . . . . . . . . . . . . . . . 43
+ reverse-search-command . . . . . . . . . . . . . . . . . 44
+ revert-file-command . . . . . . . . . . . . . . . . . . . 44
+
+ save-all-files-command . . . . . . . . . . . . . . . . . . 44
+ save-file-command . . . . . . . . . . . . . . . . . . . . 44
+ scroll-other-window-command . . . . . . . . . . . . . . . 44
+ scroll-window-down-line-command . . . . . . . . . . . . . 45
+ scroll-window-down-page-command . . . . . . . . . . . . 45
+ scroll-window-left-command . . . . . . . . . . . . . . . . 45
+ scroll-window-right-command . . . . . . . . . . . . . . . 45
+ scroll-window-up-line-command . . . . . . . . . . . . . . 45
+ scroll-window-up-page-command . . . . . . . . . . . . . 46
+ select-buffer-command . . . . . . . . . . . . . . . . . . 46
+ select-previous-buffer-command . . . . . . . . . . . . . 46
+ set-fill-column-command . . . . . . . . . . . . . . . . . 46
+ set-fill-prefix-command . . . . . . . . . . . . . . . . . . 47
+ set-goal-column-command . . . . . . . . . . . . . . . . . 47
+ Function Index - 64 - NMODE Manual
+
+
+ set-key-command . . . . . . . . . . . . . . . . . . . . . 47
+ set-mark-command . . . . . . . . . . . . . . . . . . . . 47
+ set-visited-filename-command . . . . . . . . . . . . . . . 48
+ split-line-command . . . . . . . . . . . . . . . . . . . . 48
+ start-scripting-command . . . . . . . . . . . . . . . . . 48
+ start-timing-command . . . . . . . . . . . . . . . . . . . 48
+ stop-scripting-command . . . . . . . . . . . . . . . . . 49
+ stop-timing-command . . . . . . . . . . . . . . . . . . . 49
+
+ tab-to-tab-stop-command . . . . . . . . . . . . . . . . . 49
+ text-mode-command . . . . . . . . . . . . . . . . . . . . 49
+ transpose-characters-command . . . . . . . . . . . . . . 50
+ transpose-forms . . . . . . . . . . . . . . . . . . . . . 50
+ transpose-lines . . . . . . . . . . . . . . . . . . . . . . 50
+ transpose-regions . . . . . . . . . . . . . . . . . . . . 50
+ transpose-words . . . . . . . . . . . . . . . . . . . . . 51
+ two-windows-command . . . . . . . . . . . . . . . . . . 51
+
+ undelete-file-command . . . . . . . . . . . . . . . . . . 51
+ universal-argument . . . . . . . . . . . . . . . . . . . . 51
+ unkill-previous . . . . . . . . . . . . . . . . . . . . . . 52
+ upcase-digit-command . . . . . . . . . . . . . . . . . . 52
+ uppercase-initial-command . . . . . . . . . . . . . . . . 52
+ uppercase-region-command . . . . . . . . . . . . . . . . 52
+ uppercase-word-command . . . . . . . . . . . . . . . . . 53
+
+ view-two-windows-command . . . . . . . . . . . . . . . . 53
+ visit-file-command . . . . . . . . . . . . . . . . . . . . 53
+ visit-in-other-window-command . . . . . . . . . . . . . . 53
+
+ what-cursor-position-command . . . . . . . . . . . . . . 54
+ write-file-command . . . . . . . . . . . . . . . . . . . . 54
+ write-region-command . . . . . . . . . . . . . . . . . . 54
+ write-screen-photo-command . . . . . . . . . . . . . . . 54
+
+ yank-last-output-command . . . . . . . . . . . . . . . . 55
+ NMODE Manual - 65 - Key Index
+
+
+ 8. Key Index
+
+ ) . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27
+
+ BACKSPACE . . . . . . . . . . . . . . . . . . . . . . . 19
+
+ C-% . . . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ C-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-) . . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-- . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-0 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-1 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-2 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-3 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-4 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-5 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-6 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-7 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-8 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-9 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-< . . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ C-= . . . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-> . . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ C-? . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ C-@ . . . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-A . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ C-B . . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-D . . . . . . . . . . . . . . . . . . . . . . . . . . . 19
+ C-E . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ C-F . . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ C-G . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-K . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ C-L . . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-M-\ . . . . . . . . . . . . . . . . . . . . . . . . . . 32
+ C-M-( . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-M-) . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-M-- . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-M-0 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-1 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-2 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-3 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-4 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-5 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-6 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-7 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-8 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-9 . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ C-M-@ . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ C-M-A . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-B . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-BACKSPACE . . . . . . . . . . . . . . . . . . . . 34
+ C-M-D . . . . . . . . . . . . . . . . . . . . . . . . . . 21
+ C-M-E . . . . . . . . . . . . . . . . . . . . . . . . . . 21
+ Key Index - 66 - NMODE Manual
+
+
+ C-M-F . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ C-M-H . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ C-M-I . . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ C-M-K . . . . . . . . . . . . . . . . . . . . . . . . . . 29
+ C-M-L . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ C-M-M . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ C-M-N . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ C-M-O . . . . . . . . . . . . . . . . . . . . . . . . . . 48
+ C-M-P . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 32
+ C-M-R . . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ C-M-RETURN . . . . . . . . . . . . . . . . . . . . . . 16
+ C-M-RUBOUT . . . . . . . . . . . . . . . . . . . . . . 28
+ C-M-T . . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-M-TAB . . . . . . . . . . . . . . . . . . . . . . . . 33
+ C-M-U . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-M-V . . . . . . . . . . . . . . . . . . . . . . . . . . 44
+ C-M-W . . . . . . . . . . . . . . . . . . . . . . . . . . 14
+ C-M-X . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ C-M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ C-M-] . . . . . . . . . . . . . . . . . . . . . . . . . . 21
+ C-N . . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ C-O . . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-P . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ C-Q . . . . . . . . . . . . . . . . . . . . . . . . . . . 28
+ C-R . . . . . . . . . . . . . . . . . . . . . . . . . . . 44
+ C-RUBOUT . . . . . . . . . . . . . . . . . . . . . . . 19
+ C-S . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ C-SPACE . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-T . . . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-U . . . . . . . . . . . . . . . . . . . . . . . . . . . 51
+ C-V . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-W . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ C-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-X < . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ C-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-X 1 . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-X 2 . . . . . . . . . . . . . . . . . . . . . . . . . . 51
+ C-X 3 . . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ C-X 4 . . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ C-X = . . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-X > . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ C-X A . . . . . . . . . . . . . . . . . . . . . . . . . . 14
+ C-X B . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ C-X C-B . . . . . . . . . . . . . . . . . . . . . . . . . 17
+ C-X C-F . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ C-X C-L . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ C-X C-N . . . . . . . . . . . . . . . . . . . . . . . . . 47
+ C-X C-O . . . . . . . . . . . . . . . . . . . . . . . . . 19
+ C-X C-S . . . . . . . . . . . . . . . . . . . . . . . . . 44
+ C-X C-T . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-X C-U . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ C-X C-V . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ NMODE Manual - 67 - Key Index
+
+
+ C-X C-W . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-X C-X . . . . . . . . . . . . . . . . . . . . . . . . . 22
+ C-X C-Z . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ C-X D . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ C-X E . . . . . . . . . . . . . . . . . . . . . . . . . . 22
+ C-X F . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ C-X G . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-X H . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ C-X K . . . . . . . . . . . . . . . . . . . . . . . . . . 29
+ C-X O . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ C-X P . . . . . . . . . . . . . . . . . . . . . . . . . . 54
+ C-X RUBOUT . . . . . . . . . . . . . . . . . . . . . . 16
+ C-X T . . . . . . . . . . . . . . . . . . . . . . . . . . 50
+ C-X V . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ C-X X . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ C-X ^ . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ C-Y . . . . . . . . . . . . . . . . . . . . . . . . . . . 28
+ C-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 32
+
+ ESC-4 . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ ESC-5 . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ ESC-A . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ ESC-B . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ ESC-C . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ ESC-D . . . . . . . . . . . . . . . . . . . . . . . . . . 36
+ ESC-F . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ ESC-H . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ ESC-J . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ ESC-L . . . . . . . . . . . . . . . . . . . . . . . . . . 41
+ ESC-M . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ ESC-P . . . . . . . . . . . . . . . . . . . . . . . . . . 19
+ ESC-S . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ ESC-T . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ ESC-U . . . . . . . . . . . . . . . . . . . . . . . . . . 46
+ ESC-V . . . . . . . . . . . . . . . . . . . . . . . . . . 45
+ ESCAPE . . . . . . . . . . . . . . . . . . . . . . . . . 22
+
+ Lisp-? . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-A . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-B . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-C . . . . . . . . . . . . . . . . . . . . . . . . . . 31
+ Lisp-E . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ Lisp-L . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ Lisp-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp-R . . . . . . . . . . . . . . . . . . . . . . . . . . 33
+ Lisp-Y . . . . . . . . . . . . . . . . . . . . . . . . . . 55
+
+ M-\ . . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ M-% . . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ M-' . . . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ M-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 28
+ M-- . . . . . . . . . . . . . . . . . . . . . . . . . . . 40
+ M-/ . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ Key Index - 68 - NMODE Manual
+
+
+ M-0 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-1 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-2 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-3 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-4 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-5 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-6 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-7 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-8 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-9 . . . . . . . . . . . . . . . . . . . . . . . . . . . 15
+ M-; . . . . . . . . . . . . . . . . . . . . . . . . . . . 27
+ M-< . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ M-> . . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ M-? . . . . . . . . . . . . . . . . . . . . . . . . . . . 26
+ M-@ . . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ M-A . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-B . . . . . . . . . . . . . . . . . . . . . . . . . . . 37
+ M-BACKSPACE . . . . . . . . . . . . . . . . . . . . . . 34
+ M-C . . . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ M-D . . . . . . . . . . . . . . . . . . . . . . . . . . . 29
+ M-E . . . . . . . . . . . . . . . . . . . . . . . . . . . 25
+ M-F . . . . . . . . . . . . . . . . . . . . . . . . . . . 38
+ M-G . . . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ M-H . . . . . . . . . . . . . . . . . . . . . . . . . . . 35
+ M-I . . . . . . . . . . . . . . . . . . . . . . . . . . . 49
+ M-K . . . . . . . . . . . . . . . . . . . . . . . . . . . 30
+ M-L . . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ M-M . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-Q . . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ M-R . . . . . . . . . . . . . . . . . . . . . . . . . . . 39
+ M-RETURN . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-RUBOUT . . . . . . . . . . . . . . . . . . . . . . . 29
+ M-S . . . . . . . . . . . . . . . . . . . . . . . . . . . 18
+ M-T . . . . . . . . . . . . . . . . . . . . . . . . . . . 51
+ M-TAB . . . . . . . . . . . . . . . . . . . . . . . . . . 49
+ M-U . . . . . . . . . . . . . . . . . . . . . . . . . . . 53
+ M-V . . . . . . . . . . . . . . . . . . . . . . . . . . . 42
+ M-W . . . . . . . . . . . . . . . . . . . . . . . . . . . 18
+ M-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 34
+ M-X Append To File . . . . . . . . . . . . . . . . . . . 14
+ M-X Apropos . . . . . . . . . . . . . . . . . . . . . . . 14
+ M-X Auto Fill Mode . . . . . . . . . . . . . . . . . . . 15
+ M-X Count Occurrences . . . . . . . . . . . . . . . . . 18
+ M-X Delete And Expunge File . . . . . . . . . . . . . . 18
+ M-X Delete File . . . . . . . . . . . . . . . . . . . . . 19
+ M-X Delete Matching Lines . . . . . . . . . . . . . . . . 20
+ M-X Delete Non-Matching Lines . . . . . . . . . . . . . . 20
+ M-X Dired . . . . . . . . . . . . . . . . . . . . . . . . 21
+ M-X Edit Directory . . . . . . . . . . . . . . . . . . . . 21
+ M-X Execute Buffer . . . . . . . . . . . . . . . . . . . 22
+ M-X Execute File . . . . . . . . . . . . . . . . . . . . . 22
+ M-X Find File . . . . . . . . . . . . . . . . . . . . . . 24
+ M-X Flush Lines . . . . . . . . . . . . . . . . . . . . . 20
+ NMODE Manual - 69 - Key Index
+
+
+ M-X How Many . . . . . . . . . . . . . . . . . . . . . . 18
+ M-X Insert Buffer . . . . . . . . . . . . . . . . . . . . 26
+ M-X Insert Date . . . . . . . . . . . . . . . . . . . . . 27
+ M-X Insert File . . . . . . . . . . . . . . . . . . . . . 27
+ M-X Keep Lines . . . . . . . . . . . . . . . . . . . . . 20
+ M-X Kill Buffer . . . . . . . . . . . . . . . . . . . . . 29
+ M-X Kill File . . . . . . . . . . . . . . . . . . . . . . . 19
+ M-X Kill Some Buffers . . . . . . . . . . . . . . . . . . 30
+ M-X Lisp Mode . . . . . . . . . . . . . . . . . . . . . . 32
+ M-X List Buffers . . . . . . . . . . . . . . . . . . . . . 17
+ M-X Make Space . . . . . . . . . . . . . . . . . . . . . 41
+ M-X Prepend To File . . . . . . . . . . . . . . . . . . . 42
+ M-X Query Replace . . . . . . . . . . . . . . . . . . . 42
+ M-X Rename Buffer . . . . . . . . . . . . . . . . . . . 43
+ M-X Replace String . . . . . . . . . . . . . . . . . . . 43
+ M-X Revert File . . . . . . . . . . . . . . . . . . . . . 44
+ M-X Save All Files . . . . . . . . . . . . . . . . . . . . 44
+ M-X Select Buffer . . . . . . . . . . . . . . . . . . . . 46
+ M-X Set Key . . . . . . . . . . . . . . . . . . . . . . . 47
+ M-X Set Visited Filename . . . . . . . . . . . . . . . . . 48
+ M-X Start Scripting . . . . . . . . . . . . . . . . . . . 48
+ M-X Start Timing Nmode . . . . . . . . . . . . . . . . . 48
+ M-X Stop Scripting . . . . . . . . . . . . . . . . . . . 49
+ M-X Stop Timing Nmode . . . . . . . . . . . . . . . . . 49
+ M-X Text Mode . . . . . . . . . . . . . . . . . . . . . 49
+ M-X Undelete File . . . . . . . . . . . . . . . . . . . . 51
+ M-X Visit File . . . . . . . . . . . . . . . . . . . . . . 53
+ M-X Write File . . . . . . . . . . . . . . . . . . . . . . 54
+ M-X Write Region . . . . . . . . . . . . . . . . . . . . 54
+ M-Y . . . . . . . . . . . . . . . . . . . . . . . . . . . 52
+ M-Z . . . . . . . . . . . . . . . . . . . . . . . . . . . 23
+ M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . . 16
+ M-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 24
+ M-^ . . . . . . . . . . . . . . . . . . . . . . . . . . . 20
+ M-~ . . . . . . . . . . . . . . . . . . . . . . . . . . . 17
+
+ NEWLINE . . . . . . . . . . . . . . . . . . . . . . . . . 26
+
+ RETURN . . . . . . . . . . . . . . . . . . . . . . . . . 43
+ RUBOUT . . . . . . . . . . . . . . . . . . . . . . . . . 19
+
+ TAB . . . . . . . . . . . . . . . . . . . . . . . . . . . 33, 49
+
+ ] . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27
+ Key Index - 70 - NMODE Manual
+ NMODE Manual - 71 - Topic Index
+
+
+ 9. Topic Index
+
+ Alter Display Format . . . . . . . 7, 22, 25, 40, 41, 42, 43, 44, 45, 46,
+ 51, 53
+ Alter Existing Text . . . . . . . 7, 18, 23, 24, 33, 34, 42, 43, 50, 51,
+ 52, 53
+
+ Buffers . . . . . . . . . . . . . 14, 17, 22, 24, 26, 29, 30, 43, 44, 46, 53
+
+ Change Mode . . . . . . . . . . . 7, 15, 32, 48, 49
+
+ Defun . . . . . . . . . . . . . . 9, 21, 34, 36
+
+ Escape . . . . . . . . . . . . . . 7, 23, 31, 33, 40
+
+ Files . . . . . . . . . . . . . . . 14, 18, 19, 22, 24, 27, 42, 44, 48, 51,
+ 53, 54
+ Fill Column . . . . . . . . . . . 11, 18, 23, 24, 46
+ Fill Prefix . . . . . . . . . . . . 11, 23, 24, 47
+
+ Goal Column . . . . . . . . . . . 11, 37, 39
+
+ Inform . . . . . . . . . . . . . . 7, 14, 17, 18, 26, 31, 54
+ Insert Constant . . . . . . . . . 7, 26, 27, 28, 41, 43, 48, 49
+
+ Kill Ring . . . . . . . . . . . . . 11, 14, 16, 18, 19, 28, 29, 30, 52
+
+ Lisp . . . . . . . . . . . . . . . 17, 21, 23, 25, 27, 28, 29, 31, 32, 33,
+ 34, 35, 36, 38, 43, 50, 55
+
+ Mark . . . . . . . . . . . . . . . 7, 22, 23, 25, 28, 34, 35, 47
+ Move Data . . . . . . . . . . . . 8, 14, 24, 25, 26, 27, 28, 42, 51, 53, 55
+ Move Point . . . . . . . . . . . . 8, 16, 17, 21, 22, 24, 25, 26, 35, 36,
+ 37, 38, 39, 40, 42, 44, 46, 53
+
+ Paragraph . . . . . . . . . . . . 9, 16, 23, 24, 35
+ Preserve . . . . . . . . . . . . . 8, 18, 42, 44, 51, 54
+
+ Region . . . . . . . . . . . . . . 9, 14, 18, 30, 33, 42, 50, 52, 54
+ Remove . . . . . . . . . . . . . 8, 16, 18, 19, 20, 28, 29, 30, 44
+
+ Select . . . . . . . . . . . . . . 8, 20, 26, 42, 43, 44
+ Sentence . . . . . . . . . . . . . 9, 16, 24, 25, 30
+ Set Global Variable . . . . . . . . 8, 17, 43, 46, 47, 48
+ Subsequent Command Modifier . . 8, 15, 17, 22, 32, 34, 40, 51
+
+ Text . . . . . . . . . . . . . . . 18, 23, 24, 25, 29, 30, 34, 35, 37, 38,
+ 49, 51, 52, 53
+ Topic Index - 72 - NMODE Manual
+ NMODE Manual - 3 - Table of Contents
+
+
+
+
+
+ CONTENTS
+
+
+
+ 1. Introduction ..................................................... 5
+
+ 2. Action Types .................................................... 7
+
+ 3. Definitions ....................................................... 9
+
+ 4. Globals ......................................................... 11
+
+ 5. Command Descriptions ........................................... 13
+
+ 6. Command Index ................................................. 57
+
+ 7. Function Index .................................................. 61
+
+ 8. Key Index ...................................................... 65
+
+ 9. Topic Index ..................................................... 71
ADDED psl-1983/3-1/doc/nmode/manual.r
Index: psl-1983/3-1/doc/nmode/manual.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/manual.r
@@ -0,0 +1,33 @@
+ Root file for NMODE Manual.
+.chp nm-introduction
+.
+.chp nm-screen
+.chp nm-characters
+.chp nm-editing
+.chp nm-arguments
+.chp nm-metax
+.chp nm-subsystems
+.chp nm-browsers
+.chp nm-selfdoc
+.chp nm-mark
+.chp nm-killing
+.chp nm-searching
+.chp nm-text
+.chp nm-typos
+.chp nm-files
+.chp nm-buffers
+.chp nm-display
+.chp nm-windows
+.chp nm-replacement
+.chp nm-programs
+.chp nm-misc
+.chp nm-customization
+.chp nm-bugs
+.
+.chp nm-actions
+.chp nm-definitions
+.chp nm-globals
+.chp nm-commands
+.chp nm-fun-index
+.chp nm-key-index
+.chp nm-top-index
ADDED psl-1983/3-1/doc/nmode/nm-actions.contents
Index: psl-1983/3-1/doc/nmode/nm-actions.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-actions.contents
@@ -0,0 +1,1 @@
+contents_entry(0 24 {Action Types} 24-1)
ADDED psl-1983/3-1/doc/nmode/nm-actions.ibm
Index: psl-1983/3-1/doc/nmode/nm-actions.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-actions.ibm
@@ -0,0 +1,113 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-ACTIONS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Action Types) Page 24-1
+
+
+ 202/24. Action Types
+
+ 201/This section defines a number of 203/action types201/, which are used in the
+ descriptions of NMODE commands.
+
+
+
+
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Alter Display Format
+
+
+ 201/This type of command alters how text is displayed without altering the
+ contents of existing buffers.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Alter Existing Text
+
+
+ 201/This type of command alters some part of the existing text, generally
+ transforming and/or moving text rather than just inserting or deleting it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Change Mode
+
+
+ 201/This type of command turns some feature(s) of the editor on or off. This
+ may include major modes, minor modes, timing, or scripting.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Escape
+
+
+ 201/Escape from the current level.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Inform
+
+
+ 201/This type of command informs the user of some property of the text being
+ worked with, or of the state of the editor (including where point is, what the
+ existing buffer(s) is(are), what is in the documentation, etc.).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Insert Constant
+
+
+ 201/This type of command inserts a character constant like tab or space or a
+ multiple thereof.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 24-2 NMODE Manual (Action Types)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Mark
+
+
+ 201/This type of command sets mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Move Data
+
+
+ 201/This command copies some data (which is not a constant wired into the
+ program) from one place to another.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Move Point
+
+
+ 201/This type of command moves point. It may move it within a buffer or from
+ buffer to buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Preserve
+
+
+ 201/Make a copy of something current and put it somewhere else (usually disc).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Remove
+
+
+ 201/This type of command allows a user to get rid of data, either killing or
+ deleting text or removing files or directory entries.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Select
+
+
+ 201/This type of command finds particular strings in text, and may perform some
+ action upon them, such as counting, replacement, or deletion.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Set Global Variable
+
+
+ 201/This type of command sets some global variable which tends to remain stable
+ for some time, such as prefix variables and key bindings.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Action Type Explanation: Subsequent Command Modifier
+
+
+ 201/This type of command modifies the meaning of the keys that immediately follow
+ it, as the prefix commands and the argument commands do.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
ADDED psl-1983/3-1/doc/nmode/nm-actions.topic
Index: psl-1983/3-1/doc/nmode/nm-actions.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-actions.topic
@@ -0,0 +1,14 @@
+.silent_index {Alter Display Format} idx 24-1
+.silent_index {Alter Existing Text} idx 24-1
+.silent_index {Change Mode} idx 24-1
+.silent_index {Escape} idx 24-1
+.silent_index {Inform} idx 24-1
+.silent_index {Insert Constant} idx 24-1
+.silent_index {Mark} idx 24-2
+.silent_index {Move Data} idx 24-2
+.silent_index {Move Point} idx 24-2
+.silent_index {Preserve} idx 24-2
+.silent_index {Remove} idx 24-2
+.silent_index {Select} idx 24-2
+.silent_index {Set Global Variable} idx 24-2
+.silent_index {Subsequent Command Modifier} idx 24-2
ADDED psl-1983/3-1/doc/nmode/nm-arguments.contents
Index: psl-1983/3-1/doc/nmode/nm-arguments.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-arguments.contents
@@ -0,0 +1,1 @@
+contents_entry(0 5 {Giving Numeric Arguments to NMODE Commands} 5-1)
ADDED psl-1983/3-1/doc/nmode/nm-arguments.function
Index: psl-1983/3-1/doc/nmode/nm-arguments.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-arguments.function
@@ -0,0 +1,4 @@
+.silent_index {universal-argument} idx 5-1
+.silent_index {open-line-command} idx 5-1
+.silent_index {argument-digit} idx 5-1
+.silent_index {negative-argument} idx 5-1
ADDED psl-1983/3-1/doc/nmode/nm-arguments.ibm
Index: psl-1983/3-1/doc/nmode/nm-arguments.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-arguments.ibm
@@ -0,0 +1,62 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-ARGUMENTS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Giving Numeric Arguments to NMODE Commands) Page 5-1
+
+
+ 202/5. Giving Numeric Arguments to NMODE Commands
+
+ 201/Any NMODE command can be given a 202/numeric argument201/. Some commands
+ interpret the argument as a repetition count. For example, giving an
+ argument of ten to the C-F command (move forward one character) moves
+ forward ten characters. With these commands, no argument is equivalent to
+ an argument of 1.
+
+ Some commands care only about whether there is an argument, and not
+ about its value; for example, the command M-Q (203/fill-paragraph-command201/) with
+ no arguments fills text, but with an argument justifies the text as well.
+
+ Some commands use the value of the argument, but do something peculiar
+ when there is no argument. For example, the C-K (203/kill-line201/) command with
+ an argument <n> kills <n> lines and the line separators that follow them. But
+ C-K with no argument is special; it kills the text up to the next line
+ separator, or, if point is right at the end of the line, it kills the line
+ separator itself. Thus, two C-K commands with no arguments can kill a
+ nonblank line, just like C-K with an argument of one.
+
+ The fundamental way of specifying an argument is to use the C-U
+ (203/universal-argument201/) command followed by the digits of the argument.
+ Negative arguments are allowed. Often they tell a command to move or act
+ backwards. A negative argument is entered with C-U followed by a minus
+ sign and the digits of the value of the argument. Another option for
+ entering arguments is to use C-digit or strings there of. This runs the
+ function 203/argument-digit 201/each time C-digit is entered. For example, C-U 1 2 3
+ does the same thing as C-1 C-2 C-3, both apply an argument of 123 to the
+ next command. Negative arguments can also be specified with C-- (C-minus)
+ which runs the function 203/negative-argument201/.
+
+ C-U followed by a character which is neither a digit nor a minus sign has
+ the special meaning of "multiply by four". It multiplies the argument for the
+ next command by four. Two such C-U's multiply it by sixteen. Thus, C-U
+ C-U C-F moves forward sixteen characters. This is a good way to move
+ forward "fast", since it moves about 1/4 of a line on most terminals. Other
+ useful combinations are C-U C-N, C-U C-U C-N (move down a good fraction
+ of a screen), C-U C-U C-O (make "a lot" of blank lines), and C-U C-K (kill
+ four lines). With commands like M-Q that care whether there is an argument
+ but not what the value is, C-U is a good way of saying "I want an
+ argument".
+
+ A few commands treat a plain C-U differently from an ordinary argument.
+ A few others may treat an argument of just a minus sign differently from an
+ argument of -1. These unusual cases will be described when they come up;
+ they are always for reasons of convenience of use.
ADDED psl-1983/3-1/doc/nmode/nm-arguments.key
Index: psl-1983/3-1/doc/nmode/nm-arguments.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-arguments.key
@@ -0,0 +1,2 @@
+.silent_index {C-U} idx 5-1
+.silent_index {C-O} idx 5-1
ADDED psl-1983/3-1/doc/nmode/nm-arguments.r
Index: psl-1983/3-1/doc/nmode/nm-arguments.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-arguments.r
@@ -0,0 +1,62 @@
+.so pndoc:nman
+.part NM-ARGUMENTS manual
+@Chapter[Giving Numeric Arguments to NMODE Commands]
+@node("arguments")
+@index{numeric arguments}
+ Any NMODE command can be given a @dfn[numeric argument]. Some commands
+interpret the argument as a repetition count. For example, giving an
+argument of ten to the C-F command (move forward one character)
+moves forward ten characters. With these commands, no argument is
+equivalent to an argument of 1.
+
+ Some commands care only about whether there is an argument, and not
+about its value; for example, the command M-Q
+(@fnc{fill-paragraph-command})
+with no arguments fills text, but with an argument justifies the text as
+well.
+
+ Some commands use the value of the argument, but do something
+peculiar when there is no argument. For example, the C-K (@fnc{kill-line})
+command with an argument <n> kills <n> lines and the line
+separators that follow them. But C-K with no argument is special; it
+kills the text up to the next line separator, or, if point is right at
+the end of the line, it kills the line separator itself. Thus, two
+C-K commands with no arguments can kill a nonblank line, just like C-K
+with an argument of one.
+
+@keyindex{C-U}
+@fncindex{universal-argument}
+@keyindex{C-O}
+@fncindex{open-line-command}
+@fncindex{argument-digit}
+@fncindex{negative-argument}
+ The fundamental way of specifying an argument is to use the C-U
+(@fnc{universal-argument})
+command followed by the digits of the
+argument. Negative arguments are allowed. Often they tell a command
+to move or act backwards. A negative argument is entered with C-U
+followed by a minus sign and the digits of the value of the argument.
+Another option for entering arguments is to use C-digit or strings
+there of.
+This runs the function @fnc{argument-digit} each time C-digit is entered.
+For example, C-U 1 2 3 does the same thing as C-1 C-2 C-3, both apply
+an argument of 123 to the next command.
+Negative arguments can also be specified with C-- (C-minus)
+which runs the function @fnc{negative-argument}.
+
+ C-U followed by a character which is neither a digit nor a minus
+sign has the special meaning of "multiply by four". It multiplies the
+argument for the next command by four. Two such C-U's multiply it by
+sixteen. Thus, @w[C-U C-U C-F] moves forward sixteen characters. This
+is a good way to move forward "fast", since it moves about 1/4 of a
+line on most terminals. Other useful combinations are @w[C-U C-N],
+@w[C-U C-U C-N] (move down a good fraction of a screen), @w[C-U C-U C-O]
+(make "a lot" of blank lines), and @w[C-U C-K] (kill four lines).
+With commands like M-Q that care whether there is an argument but not
+what the value is, C-U is a good way of saying "I want an argument".
+
+ A few commands treat a plain C-U differently from an ordinary
+argument. A few others may treat an argument of just a minus sign
+differently from an argument of -1. These unusual cases will be
+described when they come up; they are always for reasons of
+convenience of use.
ADDED psl-1983/3-1/doc/nmode/nm-arguments.topic
Index: psl-1983/3-1/doc/nmode/nm-arguments.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-arguments.topic
@@ -0,0 +1,1 @@
+.silent_index {numeric} idx 5-1
ADDED psl-1983/3-1/doc/nmode/nm-browsers.contents
Index: psl-1983/3-1/doc/nmode/nm-browsers.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-browsers.contents
@@ -0,0 +1,4 @@
+contents_entry(0 8 {Browser Subsystems} 8-1)
+contents_entry(1 8.1 {General Features of NMODE Browsers} 8-1)
+contents_entry(2 8.1.1 {Commands Common to Browser Subsystems} 8-1)
+contents_entry(1 8.2 {Invoking Browsers} 8-2)
ADDED psl-1983/3-1/doc/nmode/nm-browsers.function
Index: psl-1983/3-1/doc/nmode/nm-browsers.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-browsers.function
@@ -0,0 +1,10 @@
+.silent_index {browser-ignore-command} idx 8-1
+.silent_index {browser-help-command} idx 8-1
+.silent_index {browser-undo-filter-command} idx 8-1
+.silent_index {browser-view-command} idx 8-1
+.silent_index {browser-edit-command} idx 8-1
+.silent_index {apropos-command} idx 8-2
+.silent_index {buffer-browser-command} idx 8-2
+.silent_index {dired-command} idx 8-2
+.silent_index {edit-directory-command} idx 8-2
+.silent_index {browser-browser-command} idx 8-2
ADDED psl-1983/3-1/doc/nmode/nm-browsers.ibm
Index: psl-1983/3-1/doc/nmode/nm-browsers.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-browsers.ibm
@@ -0,0 +1,85 @@
+,MOD
+- R 44X (12 April 1983) <PSL.NMODE-DOC>NM-BROWSERS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Browser Subsystems) Page 8-1
+
+
+ 202/8. Browser Subsystems
+
+ 8.1 General Features of NMODE Browsers
+
+ 201/NMODE has a number of subsytems called browsers. Among NMODE's
+ browsers are a buffer browser, a file browser, a documentation browser, and
+ a browser browser. A browser is a subsystem that displays a list of objects
+ and allows the user to select particular objects from the list for viewing or
+ editing. The user can select objects by placing the cursor on their line.
+ The object pointed to by the cursor is considered the current object. The
+ list of the names of these objects is displayed immediately upon entering the
+ browser in question. Because of NMODE's multiple window features, the list
+ of objects in the browser can often be displayed at the same time as a portion
+ of one of the objects. In the buffer browser, for instance, it is possible to
+ view a buffer's contents in the lower window while still displaying the list of
+ all buffers in the upper window.
+
+ 202/8.1.1 Commands Common to Browser Subsystems
+
+ 201/A number of commands are common to all the browser subsystems. For
+ instance, in all the browsers the list of objects displayed can be shortened
+ selectively. The I command (203/browser-ignore-command201/) will remove the
+ current object from the list. The filter command F (which function is invoked
+ depends on the browser) will remove a set of objects, typically those
+ matching a user-supplied string in some way. The options availible in the
+ filter command differ from browser to browser. They can always be displayed
+ by typing ? after entering the filter command with an F. The list of objects
+ can be restored to its former size by using the N command
+ (203/browser-undo-filter-command201/).
+
+ Other common commands are the E command (203/browser-edit-command201/) and the
+ V command (203/browser-view-command201/). They allow closer examination of the
+ objects listed in the browser. The current object is displayed when the view
+ or edit command is given. In split screen mode, edit will select the bottom
+ window while view does not. Split screen mode can be activated by giving an
+ argument to E or V. In the buffer and file browsers, edit and view can be
+ used to initiate actual alteration of a buffer or file. The buffer and file
+ browsers are often used, in fact, to easily locate and enter buffers and files
+ with long names that the user has forgotten. After editing a file or buffer
+ one can escape back to the browser with C-M-L. Similarly, one can escape
+ back out of any browser with a quit, Q, command (which function is invoked
+ depends on the browser).
+
+ As can be seen from these examples, browser commands are often single
+ printing characters, which are not self-inserting in browser modes. The
+ browser helps users keep track of commands by displaying an information line
+ at the bottom of the screen. This line shows the commands available in the
+ browser, with the character that invokes the command capitalized. In
+ addition to this cue the browsers provide a line or two of on-line
+ documentation about each command. This information can be displayed by
+ typing ? (203/browser-help-command201/) to the browser's top level.
+ 201/Page 8-2 NMODE Manual (Invoking Browsers)
+
+
+ 202/8.2 Invoking Browsers
+
+ 201/Each browser can be entered with a particular command. The
+ documentation browser can be entered with M-X Apropos (203/apropos-command201/).
+ The buffer browser can be entered with C-X C-B (203/buffer-browser-command201/).
+ The file browser can be entered through either C-X D (203/dired-command201/) or
+ through M-X Edit Directory (203/edit-directory-command201/). The browser-browser
+ can be entered through M-X List Browsers (203/browser-browser-command201/). On
+ the HP9836, several of these commands are availible through soft keys.
+
+ Another way to enter most of the browsers is to enter the browser-browser
+ and then create or visit a particular browser with the B command
+ (203/browser-browser-browse-command201/). This will visit an existing browser, or
+ create a new browser from a browser template (possibly prompting the user
+ for some input in the process).
ADDED psl-1983/3-1/doc/nmode/nm-browsers.key
Index: psl-1983/3-1/doc/nmode/nm-browsers.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-browsers.key
@@ -0,0 +1,5 @@
+.silent_index {M-X} idx 8-2
+.silent_index {C-X} idx 8-2
+.silent_index {C-X} idx 8-2
+.silent_index {M-X} idx 8-2
+.silent_index {M-X} idx 8-2
ADDED psl-1983/3-1/doc/nmode/nm-browsers.r
Index: psl-1983/3-1/doc/nmode/nm-browsers.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-browsers.r
@@ -0,0 +1,104 @@
+.so pndoc:nman
+.part NM-BROWSERS manual
+@Chapter(Browser Subsystems)
+@node("browsers")
+@section[General Features of NMODE Browsers]
+NMODE has a number of subsytems called browsers.
+Among NMODE's browsers are
+a buffer browser,
+a file browser,
+a documentation browser,
+and a browser browser.
+A browser is a subsystem that displays a list of objects
+and allows the user to select particular objects
+from the list for viewing or editing.
+The user can select objects by placing the cursor on their line.
+The object pointed to by the cursor is considered the current object.
+The list of the names of these objects is displayed immediately upon
+entering the browser in question.
+Because of NMODE's multiple window features,
+the list of objects in the browser can often be displayed
+at the same time as a portion of one of the objects.
+In the buffer browser, for instance, it is possible to view
+a buffer's contents in the lower window while still displaying the
+list of all buffers in the upper window.
+@subsection[Commands Common to Browser Subsystems]
+@fncindex{browser-ignore-command}
+@fncindex{browser-help-command}
+@fncindex{browser-undo-filter-command}
+@fncindex{browser-view-command}
+@fncindex{browser-edit-command}
+A number of commands are common to all the browser subsystems.
+For instance,
+in all the browsers the list of objects displayed
+can be shortened selectively.
+The I command (@fnc{browser-ignore-command})
+will remove the current object
+from the list.
+The filter command F (which function is invoked depends on the browser)
+will remove a set of objects, typically those
+matching a user-supplied string in some way.
+The options availible in the filter command differ from browser to browser.
+They can always be displayed by typing ? after entering the filter
+command with an F.
+The list of objects can be restored to its former size by using the N
+command (@fnc{browser-undo-filter-command}).
+
+Other common commands are the
+E command (@fnc{browser-edit-command}) and
+the V command (@fnc{browser-view-command}).
+They allow closer examination of the objects listed in the browser.
+The current object is displayed when the view or edit command is given.
+In split screen mode, edit will select the bottom window while
+view does not.
+Split screen mode can be activated by giving an argument to E or V.
+In the buffer and file browsers, edit and view can be used to initiate
+actual alteration of a buffer or file.
+The buffer and file browsers are often used, in fact, to easily locate
+and enter buffers and files with long names that the user has forgotten.
+After editing a file or buffer one can escape back to the browser with
+C-M-L.
+Similarly, one can escape back out of any browser with a quit, Q,
+command (which function is invoked depends on the browser).
+
+As can be seen from these examples,
+browser commands are often single printing characters, which are not
+self-inserting in browser modes.
+The browser helps users keep track of commands by
+displaying an information line at the bottom of the screen.
+This line shows the commands available in the browser,
+with the character that invokes the command capitalized.
+In addition to this cue the browsers provide
+a line or two of on-line documentation
+about each command.
+This information can be displayed by typing ?
+(@fnc{browser-help-command})
+to the browser's top level.
+@section[Invoking Browsers]
+@keyindex{M-X Apropos}
+@fncindex{apropos-command}
+@keyindex{C-X C-B}
+@fncindex{buffer-browser-command}
+@keyindex{C-X D}
+@fncindex{dired-command}
+@keyindex{M-X Edit Directory}
+@fncindex{edit-directory-command}
+@keyindex{M-X List Browsers}
+@fncindex{browser-browser-command}
+ Each browser can be entered with a particular command.
+The documentation browser can be entered with M-X Apropos
+(@fnc{apropos-command}).
+The buffer browser can be entered with C-X C-B
+(@fnc{buffer-browser-command}).
+The file browser can be entered through either C-X D
+(@fnc{dired-command}) or through M-X Edit Directory
+(@fnc{edit-directory-command}).
+The browser-browser can be entered through M-X List Browsers
+(@fnc{browser-browser-command}).
+On the HP9836, several of these commands are availible through soft keys.
+
+Another way to enter most of the browsers is to enter the browser-browser
+and then create or visit a particular browser
+with the B command (@fnc{browser-browser-browse-command}).
+This will visit an existing browser, or create a new browser from a
+browser template (possibly prompting the user for some input in the process).
ADDED psl-1983/3-1/doc/nmode/nm-buffers.contents
Index: psl-1983/3-1/doc/nmode/nm-buffers.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-buffers.contents
@@ -0,0 +1,4 @@
+contents_entry(0 16 {Using Multiple Buffers} 16-1)
+contents_entry(1 16.1 {Creating and Selecting Buffers} 16-1)
+contents_entry(1 16.2 {Using Existing Buffers} 16-2)
+contents_entry(1 16.3 {Killing Buffers} 16-2)
ADDED psl-1983/3-1/doc/nmode/nm-buffers.function
Index: psl-1983/3-1/doc/nmode/nm-buffers.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-buffers.function
@@ -0,0 +1,11 @@
+.silent_index {select-buffer-command} idx 16-1
+.silent_index {select-previous-buffer-command} idx 16-1
+.silent_index {find-file-command} idx 16-1
+.silent_index {buffer-browser-command} idx 16-2
+.silent_index {save-file-command} idx 16-2
+.silent_index {save-all-files-command} idx 16-2
+.silent_index {rename-buffer-command} idx 16-2
+.silent_index {append-to-buffer-command} idx 16-2
+.silent_index {insert-buffer-command} idx 16-2
+.silent_index {kill-some-buffers-command} idx 16-2
+.silent_index {kill-buffer-command} idx 16-2
ADDED psl-1983/3-1/doc/nmode/nm-buffers.ibm
Index: psl-1983/3-1/doc/nmode/nm-buffers.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-buffers.ibm
@@ -0,0 +1,111 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-BUFFERS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Using Multiple Buffers) Page 16-1
+
+
+ 202/16. Using Multiple Buffers
+
+ 201/When we speak of "the buffer", which contains the text you are editing, we
+ have given the impression that there is only one. In fact, there may be
+ many of them, each with its own body of text. At any time only one buffer
+ can be 202/selected 201/and available for editing, but it isn't hard to switch to a
+ different one. Each buffer individually remembers which file it is visiting,
+ what modes are in effect, and whether there are any changes that need
+ saving.
+
+ C-X B Select or create a buffer.
+ C-M-L Select previous buffer.
+ C-X C-F Visit a file in its own buffer.
+ C-X C-B List the existing buffers.
+ C-X K Kill a buffer.
+
+ Each buffer in NMODE has a single name, which normally doesn't change.
+ A buffer's name can be any length. The name of the currently selected
+ buffer, and the name of the file visited in it, are visible in the mode line
+ when you are at top level. A newly started NMODE has only one buffer,
+ named "Main".
+
+ 202/16.1 Creating and Selecting Buffers
+
+ 201/To create a new buffer, you need only think of a name for it (say, "FOO")
+ and then do C-X B FOO<CR>, which is the command C-X B (Select Buffer)
+ followed by the name. This makes a new, empty buffer and selects it for
+ editing. The new buffer is not visiting any file, so if you try to save it you
+ will be asked for the filename to use. Each buffer has its own major mode;
+ the new buffer's major mode is taken from the value of the variable
+ nmode-default-mode. Normally nmode-default-mode is text mode.
+
+ To return to buffer FOO later after having switched to another, the same
+ command C-X B FOO<CR> is used, since C-X B can tell whether a buffer
+ named FOO exists already or not. It does not matter whether you use upper
+ case or lower case in typing the name of a buffer. C-X B Main<CR> reselects
+ the buffer Main that NMODE started out with. Just C-X B<CR> reselects the
+ previous buffer.
+
+ One can also return to the previous buffer with C-M-L
+ (203/select-previous-buffer-command201/). This will select the previous buffer, if
+ possible. Otherwise, it will select the MAIN buffer.
+
+ You can also read a file into its own newly created buffer, all with one
+ command: C-X C-F (203/find-file-command201/), followed by the filename. The name
+ of the file (within its directory) becomes the buffer name. C-F stands for
+ "Find", because if the specified file already resides in a buffer in your
+ NMODE, that buffer is reselected. So you need not remember whether you
+ have brought the file in already or not. A buffer created by C-X C-F can
+ be reselected later with C-X B or C-X C-F, whichever you find more
+ convenient. Nonexistent files can be created with C-X C-F just as they can
+ be with C-X C-V. See Section 15.1 [Visiting], page 1.
+ 201/Page 16-2 NMODE Manual (Using Existing Buffers)
+
+
+ 202/16.2 Using Existing Buffers
+
+ 201/To get a list of all the buffers that exist, do C-X C-B
+ (203/buffer-browser-command201/). Each buffer's name, size, and visited filenames
+ are printed. A star at the beginning of a line indicates a buffer which
+ contains changes that have not been saved.
+
+ If several buffers have stars, you should save some of them with M-X Save
+ All Files (203/save-all-files-command201/). This finds all the buffers that need
+ saving and asks about each one individually. Saving the buffers this way is
+ much easier and more efficient than selecting each one and typing C-X C-S.
+
+ M-X Rename Buffer<CR><new name><CR> (203/rename-buffer-command201/) changes
+ the name of the currently selected buffer. If <new name> is the null string,
+ a truncated version of the filename of the visited file is used as the new name
+ of the buffer.
+
+ The commands C-X A (203/append-to-buffer-command201/) and M-X Insert Buffer
+ (203/insert-buffer-command201/) can be used to copy text from one buffer to another.
+ See Section 11.3 [Copying], page 4.
+
+ 202/16.3 Killing Buffers
+
+ 201/After you use an NMODE for a while, it may fill up with buffers which you
+ no longer need. Eventually you can reach a point where trying to create any
+ more results in running out of memory space. So whenever it is convenient
+ you should do M-X Kill Some Buffers, (203/kill-some-buffers-command201/) which asks
+ about each buffer individually. You can say Y or N to kill it or not. Or
+ you can say Control-R to take a look at it first. This gives you a recursive
+ editing level in which you can move around and look at things. When you
+ have seen enough to make up your mind, exit the recursive editing level with
+ a y or n to kill or save the buffer. If you say to kill a buffer that needs
+ saving, you will be asked whether it should be saved.
+
+ You can kill the buffer FOO by doing C-X K FOO<CR>
+ (203/kill-buffer-command201/). If the buffer being killed has been modified since it
+ was last saved, NMODE will ask you to confirm your command to kill it. You
+ can kill the selected buffer, a common thing to do if you use C-X C-F, by
+ doing C-X K<CR>. If you kill the selected buffer, in any way, NMODE will
+ move you to another buffer.
ADDED psl-1983/3-1/doc/nmode/nm-buffers.key
Index: psl-1983/3-1/doc/nmode/nm-buffers.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-buffers.key
@@ -0,0 +1,6 @@
+.silent_index {C-X} idx 16-1
+.silent_index {C-M-L} idx 16-1
+.silent_index {C-X} idx 16-1
+.silent_index {C-X} idx 16-2
+.silent_index {C-X} idx 16-2
+.silent_index {C-X} idx 16-2
ADDED psl-1983/3-1/doc/nmode/nm-buffers.r
Index: psl-1983/3-1/doc/nmode/nm-buffers.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-buffers.r
@@ -0,0 +1,134 @@
+.so pndoc:nman
+.part NM-BUFFERS manual
+@Chapter[Using Multiple Buffers]
+@Node("buffers")
+@index{buffers}
+ When we speak of "the buffer", which contains the text you are
+editing, we have given the impression that there is only one. In fact,
+there may be many of them, each with its own body of text. At any
+time only one buffer can be @dfn[selected] and available for editing,
+but it isn't hard to switch to a different one. Each buffer
+individually remembers which file it is visiting, what modes are in
+effect, and whether there are any changes that need saving.
+@WideCommands{
+C-X B Select or create a buffer.
+
+C-M-L Select previous buffer.
+
+C-X C-F Visit a file in its own buffer.
+
+C-X C-B List the existing buffers.
+
+C-X K Kill a buffer.
+}
+@index{mode line}
+ Each buffer in NMODE has a single name, which normally doesn't
+change. A buffer's name can be any length. The name of the currently
+selected buffer, and the name of the file visited in it, are visible
+in the mode line when you are at top level. A newly started NMODE has
+only one buffer, named "Main".
+@Section[Creating and Selecting Buffers]
+@keyindex{C-X B}
+@fncindex{select-buffer-command}
+@index{Select Buffer}
+@index{nmode-default-mode}
+@index{Major Modes}
+ To create a new buffer, you need only think of a name for it (say,
+"FOO") and then do C-X B FOO@return2{}, which is the command C-X B (Select
+Buffer) followed by the name. This makes a new, empty buffer and
+selects it for editing. The new buffer is not visiting any
+file, so if you try to save it you will be asked for the filename to
+use. Each buffer has its own major mode; the new buffer's major mode
+is taken from the value of the variable nmode-default-mode.
+Normally nmode-default-mode is text mode.
+
+ To return to buffer FOO later after having switched to another, the
+same command C-X B FOO@return2{} is used, since C-X B can tell whether a
+buffer named FOO exists already or not. It does not matter whether
+you use upper case or lower case in typing the name of a buffer. C-X
+B Main@return2{} reselects the buffer Main that NMODE started out with.
+Just C-X B@return2{} reselects the previous buffer.
+
+@keyindex{C-M-L}
+@fncindex{select-previous-buffer-command}
+ One can also return to the previous buffer with
+C-M-L (@fnc{select-previous-buffer-command}). This will select the previous
+buffer, if possible. Otherwise, it will select the MAIN buffer.
+
+@keyindex{C-X C-F}
+@index{visiting}
+@index{Find File}
+@fncindex{find-file-command}
+ You can also read a file into its own newly created buffer, all with
+one command: C-X C-F (@fnc{find-file-command}), followed by the filename.
+The name of the file (within its directory)
+becomes the buffer name. C-F stands for "Find",
+because if the specified file already resides in a buffer in your
+NMODE, that buffer is reselected. So you need not remember
+whether you have brought the file in already or not. A buffer created
+by C-X C-F can be reselected later with C-X B or C-X C-F, whichever
+you find more convenient. Nonexistent files can be created with C-X
+C-F just as they can be with C-X C-V. @Note("Visiting").
+@Section[Using Existing Buffers]
+@keyindex{C-X C-B}
+@fncindex{buffer-browser-command}
+@index{List Buffers}
+ To get a list of all the buffers that exist, do C-X C-B
+(@fnc{buffer-browser-command}).
+Each buffer's name, size, and visited filenames are
+printed. A star at the beginning of a line indicates a buffer
+which contains changes that have not been saved.
+
+@index{Save All Files}
+@keyindex{C-X C-S}
+@fncindex{save-file-command}
+@fncindex{save-all-files-command}
+ If several buffers have stars, you should save some of them with
+M-X Save All Files (@fnc{save-all-files-command}).
+This finds all the buffers that need
+saving and asks about each one individually. Saving the buffers this
+way is much easier and more efficient than selecting each one and
+typing C-X C-S.
+
+@index{Rename Buffer}
+@fncindex{rename-buffer-command}
+@fncindex{append-to-buffer-command}
+@fncindex{insert-buffer-command}
+ M-X Rename Buffer@return1{}<new name>@return2{} (@fnc{rename-buffer-command})
+changes the name of the currently
+selected buffer. If <new name> is the null string,
+a truncated version of the filename
+of the visited file is used as the new name of the buffer.
+
+ The commands C-X A (@fnc{append-to-buffer-command}) and M-X Insert
+Buffer (@fnc{insert-buffer-command}) can be used to copy text from one
+buffer to another. @Note("Copying").
+@Section[Killing Buffers]
+@index{Kill Buffer}
+@index{Kill Some Buffers}
+@keyindex{C-X K}
+@index{recursive editing level}
+@fncindex{kill-some-buffers-command}
+ After you use an NMODE for a while, it may fill up with buffers which
+you no longer need. Eventually you can reach a point where trying to
+create any more results in running out of memory space. So whenever it is
+convenient you should do M-X Kill Some Buffers, (@fnc{kill-some-buffers-command})
+which asks about each
+buffer individually. You can say Y or N to kill it or not. Or you
+can say Control-R to take a look at it first. This gives you a recursive
+editing level in which you can move around and look at things. When
+you have seen enough to make up your mind, exit the recursive editing
+level with a y or n to kill or save the buffer. If you
+say to kill a buffer that needs saving, you will be asked whether it
+should be saved.
+
+@fncindex{kill-buffer-command}
+ You can kill the buffer FOO by doing C-X K FOO@return2{}
+(@fnc{kill-buffer-command}).
+If the buffer being killed has been modified since it was last saved,
+NMODE will ask you to confirm your command to kill it.
+You can kill
+the selected buffer, a common thing to do if you use C-X C-F, by doing
+C-X K@return1{}.
+If you kill the selected buffer, in any way, NMODE
+will move you to another buffer.
ADDED psl-1983/3-1/doc/nmode/nm-buffers.topic
Index: psl-1983/3-1/doc/nmode/nm-buffers.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-buffers.topic
@@ -0,0 +1,13 @@
+.silent_index {buffers} idx 16-1
+.silent_index {mode} idx 16-1
+.silent_index {Select} idx 16-1
+.silent_index {nmode-default-mode} idx 16-1
+.silent_index {Major} idx 16-1
+.silent_index {visiting} idx 16-1
+.silent_index {Find} idx 16-1
+.silent_index {List} idx 16-2
+.silent_index {Save} idx 16-2
+.silent_index {Rename} idx 16-2
+.silent_index {Kill} idx 16-2
+.silent_index {Kill} idx 16-2
+.silent_index {recursive} idx 16-2
ADDED psl-1983/3-1/doc/nmode/nm-bugs.contents
Index: psl-1983/3-1/doc/nmode/nm-bugs.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-bugs.contents
@@ -0,0 +1,6 @@
+contents_entry(0 23 {Correcting Mistakes and NMODE Problems} 23-1)
+contents_entry(1 23.1 {Quitting and Aborting} 23-1)
+contents_entry(2 23.1.1 {Garbage on the Screen} 23-1)
+contents_entry(1 23.2 {Reporting Bugs} 23-1)
+contents_entry(2 23.2.1 {When Is There a Bug} 23-1)
+contents_entry(2 23.2.2 {How to Report a Bug} 23-2)
ADDED psl-1983/3-1/doc/nmode/nm-bugs.function
Index: psl-1983/3-1/doc/nmode/nm-bugs.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-bugs.function
@@ -0,0 +1,1 @@
+.silent_index {nmode-abort-command} idx 23-1
ADDED psl-1983/3-1/doc/nmode/nm-bugs.ibm
Index: psl-1983/3-1/doc/nmode/nm-bugs.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-bugs.ibm
@@ -0,0 +1,165 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-BUGS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Correcting Mistakes and NMODE Problems) Page 23-1
+
+
+ 202/23. Correcting Mistakes and NMODE Problems
+
+ 201/If you type an NMODE command you did not intend, the results are often
+ mysterious. This chapter tells what you can do to cancel your mistake or
+ recover from a mysterious situation. NMODE bugs and system crashes are
+ also considered.
+
+ 202/23.1 Quitting and Aborting
+
+ 201/C-G Quit. Cancel partially typed command.
+
+ There are two ways of cancelling commands which are not finished
+ executing: 202/quitting 201/with C-G (203/nmode-abort-command201/), and 202/aborting 201/with C-C
+ on Twenex or STOP on the hp9836. Quitting is cancelling a partially typed
+ command. Aborting is cancelling a command which is already running.
+ Aborting generally doesn't allow a clean re-entry into the old NMODE
+ environment so it is generally not recommended.
+
+ Quitting with C-G is used for getting rid of a partially typed command, or
+ a numeric argument that you don't want. Quitting an incremental search does
+ special things documented under searching; in general, it may take two
+ successive C-G's to get out of a search.
+
+ 202/23.1.1 Garbage on the Screen
+
+ 201/If the data on the screen looks wrong, it could be due to line noise on
+ input or output, a bug in the terminal, a bug in NMODE redisplay, or a bug
+ in an NMODE command. To find out whether there is really anything wrong
+ with your text, the first thing to do is type C-L. This is a command to
+ clear the screen and redisplay it. Often this will display the text you
+ expected. Think of it as getting an opinion from another doctor.
+
+ 202/23.2 Reporting Bugs
+
+ 201/Sometimes you will encounter a bug in NMODE. To get it fixed, you must
+ report it. It is your duty to do so; but you must know when to do so and
+ how if it is to be constructive.
+
+ 202/23.2.1 When Is There a Bug
+
+ 201/If NMODE executes an illegal instruction, or dies with an operating system
+ error message that indicates a problem in the program (as opposed to "disk
+ full"), then it probably is a bug.
+
+ We say "probably" because you can also cause these errors yourself if you
+ execute your own code or modify NMODE by redefining its functions or
+ changing its variables.
+
+ If NMODE updates the display in a way that does not correspond to what is
+ in the buffer, then it is probably a bug. If a command seems to do the
+ wrong thing but the problem is gone if you type C-L, then it is a case of
+ incorrect display updating.
+ 201/Page 23-2 NMODE Manual (When Is There a Bug)
+
+
+ Taking forever to complete a command can be a bug, but you must make
+ certain that it was really NMODE's fault. Some commands simply take a long
+ time.
+
+ If a command you are familiar with causes an NMODE error message in a
+ case where its usual definition ought to be reasonable, it is probably a bug.
+
+ If a command does the wrong thing, that is a bug. But be sure you know
+ for certain what it ought to have done. If you aren't familiar with the
+ command, or don't know for certain how the command is supposed to work,
+ then it might actually be working right. Rather than jumping to conclusions,
+ show the problem to someone who knows for certain.
+
+ Finally, a command's intended definition may not be best for editing with.
+ This is a very important sort of problem, but it is also a matter of judgment.
+ Also, it is easy to come to such a conclusion out of ignorance of some of the
+ existing features. It is probably best not to complain about such a problem
+ until you have checked the documentation in the usual ways, feel confident
+ that you understand it, and know for certain that what you want is not
+ available. If you feel confused about the documentation instead, then you
+ don't have grounds for an opinion about whether the command's definition is
+ optimal. Make sure you read it through and check the index or the menus
+ for all references to subjects you don't fully understand. If you have done
+ this diligently and are still confused, or if you finally understand but think
+ you could have said it better, then you have a constructive complaint to make
+ 203/about the documentation201/. It is just as important to report documentation
+ bugs as program bugs.
+
+ 202/23.2.2 How to Report a Bug
+
+ 201/When you decide that there is a bug, it is important to report it and to
+ report it in a way which is useful. What is most useful is an exact
+ description of what commands you type, starting with a fresh NMODE just
+ loaded, until the problem happens. Send the bug report to the author (see
+ the preface for the address).
+
+ The most important principle in reporting a bug is to report 203/facts201/, not
+ hypotheses or conditions. It is always easier to report the facts, but people
+ seem to prefer to strain to think up explanations and report them instead. If
+ the explanations are based on guesses about how NMODE is implemented, they
+ will be useless; we will have to try to figure out what the facts must have
+ been to lead to such speculations. Sometimes this is impossible. But in any
+ case, it is unnecessary work for us.
+
+ For example, suppose that you type C-X C-V <GLORP>BAZ.UGH<CR>,
+ visiting a file which (you know) happens to be rather large, and NMODE
+ prints out "I feel pretty today". The best way to report the bug is with a
+ sentence like the preceding one, because it gives all the facts and nothing
+ but the facts.
+
+ Do not assume that the problem is due to the size of the file and say "When
+ I visit a large file, NMODE prints out 'I feel pretty today'". This is what we
+ mean by "guessing explanations". The problem is just as likely to be due to
+ 201/NMODE Manual (How to Report a Bug) Page 23-3
+
+
+ the fact that there is a "Z" in the filename. If this is so, then when we got
+ your report, we would try out the problem with some "big file", probably
+ with no "Z" in its name, and not find anything wrong. There is no way in
+ the world that we could guess that we should try visiting a file with a "Z" in
+ its name.
+
+ Alternatively, the problem might be due to the fact that the file starts with
+ exactly 25 spaces. For this reason, you should make sure that you don't
+ change the file until we have looked at it. Suppose the problem only occurs
+ when you have typed the C-X C-A command previously? This is why we ask
+ you to give the exact sequence of characters you typed since loading the
+ NMODE.
+
+ You should not even say "visit the file ..." instead of "C-X C-V" unless
+ you 203/know 201/that it makes no difference which visiting command is used.
+ Similarly, rather than saying "if I have three characters on the line", say
+ "after I type <CR>A B C<CR>C-P", if that is the way you entered the text.
+ In addition, you should say what mode you are in.
+
+ If the bug occurred in a customized NMODE, it is helpful to try to
+ reproduce the bug in a more standard NMODE. It is best if you can make
+ the problem happen in a completely standard NMODE. If the problem does
+ 203/not 201/occur in a standard NMODE, it is very important to report that fact,
+ because otherwise we will try to debug it in a standard NMODE, not find the
+ problem, and give up. If the problem does depend on an init file, then you
+ should make sure it is not a bug in the init file by complaining to the person
+ who wrote the file, first. He should check over his code, and verify the
+ definitions of the PSL commands he is using. Then if he verifies that the
+ bug is in NMODE he should report it. We cannot be responsible for
+ maintaining users' init files; we might not even be able to tell what they are
+ supposed to do.
+
+ If you can tell us a way to cause the problem without reading in any files,
+ please do so. This makes it much easier to debug. If you do need files,
+ make sure you arrange for us to see their exact contents. For example, it
+ can often matter whether there are spaces at the ends of lines, or a line
+ separator after the last line in the buffer (nothing ought to care whether the
+ last line is terminated, but tell that to the bugs).
ADDED psl-1983/3-1/doc/nmode/nm-bugs.key
Index: psl-1983/3-1/doc/nmode/nm-bugs.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-bugs.key
@@ -0,0 +1,2 @@
+.silent_index {C-G} idx 23-1
+.silent_index {C-G} idx 23-1
ADDED psl-1983/3-1/doc/nmode/nm-bugs.r
Index: psl-1983/3-1/doc/nmode/nm-bugs.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-bugs.r
@@ -0,0 +1,232 @@
+.so pndoc:nman
+.part NM-BUGS manual
+@Chapter[Correcting Mistakes and NMODE Problems]
+If you type an NMODE command you did not intend, the results are often
+mysterious. This chapter tells what you can do to cancel your mistake
+or recover from a mysterious situation. NMODE bugs and system crashes
+are also considered.
+@Section[Quitting and Aborting]
+@node("quitting")
+@fncindex{nmode-abort-command}
+@keyindex{C-G}
+@Commands{
+C-G Quit. Cancel partially typed command.
+}
+ There are two ways of cancelling commands which are not finished
+executing: @dfn[quitting] with C-G (@fnc{nmode-abort-command}),
+and @dfn[aborting] with
+C-C on Twenex or STOP on the hp9836.
+Quitting is cancelling a partially typed
+command. Aborting is cancelling a command which is already running.
+Aborting generally doesn't allow a clean re-entry into the old NMODE
+environment so it is generally not recommended.
+
+@index{quitting}@keyindex{C-G}
+ Quitting with C-G is used for getting rid of a partially typed
+command, or a numeric argument that you don't want. Quitting an
+incremental search does special things documented under searching; in
+general, it may take two successive C-G's to get out of a search.
+@SubSection[Garbage on the Screen]
+ If the data on the screen looks wrong, it could be due to line noise
+on input or output, a bug in the terminal, a bug in NMODE redisplay,
+or a bug in an NMODE command. To find out whether there is really
+anything wrong with your text, the first thing to do is type C-L.
+This is a command to clear the screen and redisplay it. Often this
+will display the text you expected. Think of it as getting an
+opinion from another doctor.
+ @SubSection[Garbage Displayed Persistently]
+
+ @index{terminal type}
+ @Twenex{@Index[Set Terminal Type]}
+ @ITS{@index[TCTYP]}
+ If NMODE persistently displays garbage on the screen, or if it
+ outputs the right things but scattered around all the wrong places on
+ the screen, it may be that NMODE has the wrong idea of your terminal
+ type. The first thing to do in this case is to exit from NMODE and
+ restart it. Each time NMODE is restarted it asks the system what
+ terminal type you are using. Whenever you detach and move to a
+ terminal of a different type you should restart NMODE as a matter of
+ course. If you stopped NMODE with the exit command, or by
+ interrupting it when it was awaiting a command, then this is sure to
+ be safe.
+
+ The system itself may not know what type of terminal you have. You
+ should try telling the system with the @ITS{:TCTYP
+ command.}@Twenex{TERMINAL TYPE command in EXEC. If your terminal is
+ compatible with one of the standard types but has a different size
+ screen, you must tell the system the size with the TERMINAL LENGTH and
+ TERMINAL WIDTH commands, because NMODE uses whatever size the system
+ says it knows. Alternatively, you can use Set Terminal Type.
+ @Note("Term Types" "Terminal Types"), for more information.}
+
+ @SubSection[URK Error (Address Space Exhausted)]
+ @label[NMODEURK]
+
+ @Index{Make Space}@INDEX{URK}@Index{Kill Ring}@Index{Undo}
+ @Index{Kill Libraries}@Index{Kill Some Buffers}
+ If attempting to visit a file or load a library causes an "URK"
+ error, it means you have filled up the address space; there is no room
+ inside NMODE for any more files or libraries. In this situation NMODE
+ will try to run the function Make Space for you. If NMODE is unable
+ to do it for you, you may still be able to do M-X Make Space yourself.
+ This command compacts the data inside NMODE
+ to free up some space. It also offers to discard data that may be
+ occupying a lot of space, such as the kill ring
+ (@Note("Killing").), the undo memory (@Note("Undo").), and
+ buffers created by @ITS(RMAIL,) TAGS and INFO. Another way of freeing
+ space is to kill buffers with M-X Kill Some Buffers
+ (@Note("Buffers")@.) or unload libraries with M-X Kill Libraries
+ (@Note("Libraries").).
+
+ @index{What Available Space}
+ Use the command M-X What Available Space to find out how close you
+ are to running out of space. It tells you how many K of space you
+ have available for additional files or libraries.
+@Section[Reporting Bugs]
+@node("bugs")
+@index{Bugs}
+ Sometimes you will encounter a bug in NMODE. To get it fixed, you
+must report it. It is your duty to do so; but you must know when to
+do so and how if it is to be constructive.
+@Subsection[When Is There a Bug]
+ If NMODE executes an illegal instruction, or dies with an operating
+system error message that indicates a problem in the program (as
+opposed to "disk full"), then it probably is a bug.
+
+ We say "probably" because you can also cause these errors yourself if you
+execute your own code or modify NMODE by redefining its functions or
+changing its variables.
+
+ If NMODE updates the display in a way that does not correspond to
+what is in the buffer, then it is probably a bug. If a command seems
+to do the wrong thing but the problem is gone if you type C-L, then it
+is a case of incorrect display updating.
+
+ Taking forever to complete a command can be a bug, but you must make
+certain that it was really NMODE's fault. Some commands simply take a
+long time.
+
+ If a command you are familiar with causes an NMODE error message in
+a case where its usual definition ought to be reasonable, it is
+probably a bug.
+
+ If a command does the wrong thing, that is a bug. But be sure you
+know for certain what it ought to have done. If you aren't
+familiar with the command, or don't know for certain how the command
+is supposed to work, then it might actually be working right. Rather
+than jumping to conclusions, show the problem to someone who knows for
+certain.
+
+ Finally, a command's intended definition may not be best for editing
+with. This is a very important sort of problem, but it is also a
+matter of judgment. Also, it is easy to come to such a conclusion
+out of ignorance of some of the existing features. It is probably
+best not to complain about such a problem until you have checked the
+documentation in the usual ways, feel confident that
+you understand it, and know for certain that what you want is not
+available. If you feel confused about the documentation instead, then
+you don't have grounds for an opinion about whether the command's
+definition is optimal. Make sure you read it through and check the
+index or the menus for all references to subjects you don't fully
+understand. If you have done this diligently and are still confused,
+or if you finally understand but think you could have said it better,
+then you have a constructive complaint to make @xxi(about the
+documentation). It is just as important to report documentation bugs
+as program bugs.
+@Subsection[How to Report a Bug]
+ When you decide that there is a bug, it is important to report it
+and to report it in a way which is useful. What is most useful is an
+exact description of what commands you type, starting with a fresh
+NMODE just loaded, until the problem happens. Send the bug report to
+the author (see the preface for the address).
+
+ The most important principle in reporting a bug is to report @xxii[facts],
+not hypotheses or conditions. It is always easier to report the
+facts, but people seem to prefer to strain to think up explanations
+and report them instead. If the explanations are based on guesses
+about how NMODE is implemented, they will be useless; we will
+have to try to figure out what the facts must have been to lead to
+such speculations. Sometimes this is impossible. But in any case, it
+is unnecessary work for us.
+
+ For example, suppose that you type C-X C-V <GLORP>BAZ.UGH@return1{},
+visiting a file which
+(you know) happens to be rather large, and NMODE prints out "I
+feel pretty today". The best way to report the bug is with a
+sentence like the preceding one, because it gives all the facts
+and nothing but the facts.
+
+ Do not assume that the problem is due to the size of the file and
+say "When I visit a large file, NMODE prints out 'I feel pretty
+today'". This is what we mean by "guessing explanations". The
+problem is just as likely to be due to the fact that there is a "Z" in
+the filename. If this is so, then when we got your report, we would
+try out the problem with some "big file", probably with no "Z" in its
+name, and not find anything wrong. There is no way in the world that
+we could guess that we should try visiting a file with a "Z" in its
+name.
+
+ Alternatively, the problem might be due to the fact that the file
+starts with exactly 25 spaces. For this reason, you should make sure
+that you don't change the file until we have looked at it. Suppose
+the problem only occurs when you have typed the C-X C-A command
+previously? This is why we ask you to give the exact sequence of
+characters you typed since loading the NMODE.
+
+ You should not even say "visit the file ..." instead of "C-X C-V"
+unless you @xxi[know] that it makes no difference which visiting
+command is used. Similarly, rather than saying "if I have three
+characters on the line", say "after I type @return1{}A B
+C@return1{}C-P", if that is the way you entered the text. In
+addition, you should say what mode you are in.
+ @index{FS Flags}@index{minibuffer}
+ Be sure to say what version of NMODE and TECO are running. If you
+ don't know, type Meta-Altmode QNMODE Version= FS Version= and
+ NMODE will print them out. (This is a use of the minibuffer.
+ @Note("Minibuffer").)
+
+ If the bug occurred in a customized NMODE, it is helpful to try to
+reproduce the bug in a more standard NMODE. It is best if you can
+make the problem happen in a completely standard NMODE. If the
+problem does @xxii[not] occur in a standard NMODE, it is very
+important to report that fact, because otherwise we will try to debug
+it in a standard NMODE, not find the problem, and give up. If the
+problem does depend on an init file, then you should make sure it is
+not a bug in the init file by complaining to the person who wrote the
+file, first. He should check over his code, and verify the
+definitions of the PSL commands he is using. Then if he verifies that
+the bug is in NMODE he should report it. We cannot be responsible for
+maintaining users' init files; we might not even be able to tell what
+they are supposed to do.
+
+ If you can tell us a way to cause the problem without reading in any
+files, please do so. This makes it much easier to debug. If you
+do need files, make sure you arrange for us to see their exact
+contents. For example, it can often matter whether there are spaces
+at the ends of lines, or a line separator after the last line in the
+buffer (nothing ought to care whether the last line is terminated, but
+tell that to the bugs).
+ If NMODE gets an operating system error message, such as for an
+ illegal instruction, then you can probably recover by restarting it.
+ But before doing so, you should make a dump file. If you restart or
+ continue the NMODE before making the dump, the trail will be covered
+ and it will probably be too late to find out what happened.
+ @Twenex{Use the SAVE command to do this; however, this does not record
+ the contents of the accumulators. To do that, use the EXEC commands
+ EXAMINE 0, EXAMINE 1, etc., through EXAMINE 17. Include the numbers
+ printed by these commands as part of your bug report.}@ITS{Use the DDT
+ command
+ @;@example[
+ :PDUMP CRASH;NMODE <yourname>
+ @;]
+ (or use any other suitable filename) to do this. Your bug report
+ should contain the filename you used for the dump, and the error
+ message printed when the NMODE stopped, as well as the events leading
+ up to the bug. The first number in the error message is the PC, which
+ is not recorded by :PDUMP, so it must be copied precisely. Also type
+ .JPC/ and include DDT's response in your report.}
+
+ A dump is also useful if NMODE gets into a wedged state in which
+ commands that usually work do strange things.
+
+ @manual{@include(wordab.mss)@String(Filename="NMODE")}
ADDED psl-1983/3-1/doc/nmode/nm-bugs.topic
Index: psl-1983/3-1/doc/nmode/nm-bugs.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-bugs.topic
@@ -0,0 +1,2 @@
+.silent_index {quitting} idx 23-1
+.silent_index {Bugs} idx 23-1
ADDED psl-1983/3-1/doc/nmode/nm-characters.contents
Index: psl-1983/3-1/doc/nmode/nm-characters.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-characters.contents
@@ -0,0 +1,5 @@
+contents_entry(0 3 {Character Sets and Command Input Conventions} 3-1)
+contents_entry(1 3.1 {The 9-bit Command Character Set} 3-1)
+contents_entry(1 3.2 {Prefix Characters} 3-2)
+contents_entry(1 3.3 {Commands, Functions, and Variables} 3-2)
+contents_entry(1 3.4 {Notational Conventions for ASCII Characters} 3-3)
ADDED psl-1983/3-1/doc/nmode/nm-characters.function
Index: psl-1983/3-1/doc/nmode/nm-characters.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-characters.function
@@ -0,0 +1,4 @@
+.silent_index {c-x-prefix} idx 3-2
+.silent_index {m-x-prefix} idx 3-2
+.silent_index {lisp-prefix} idx 3-2
+.silent_index {esc-prefix} idx 3-2
ADDED psl-1983/3-1/doc/nmode/nm-characters.ibm
Index: psl-1983/3-1/doc/nmode/nm-characters.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-characters.ibm
@@ -0,0 +1,172 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-CHARACTERS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Character Sets and Command Input Conventions) Page 3-1
+
+
+ 202/3. Character Sets and Command Input Conventions
+
+ 201/In this chapter we introduce the terminology and concepts used to talk
+ about NMODE commands. NMODE is designed to be used with a kind of
+ keyboard with two special shift keys which can type 512 different characters,
+ instead of the 128 different characters which ordinary ASCII keyboards can
+ send. The terminology of NMODE commands is formulated in terms of these
+ shift keys. So that NMODE can be used on ASCII terminals, we provide
+ two-character ASCII circumlocutions for the command characters which are not
+ ASCII.
+
+ 202/3.1 The 9-bit Command Character Set
+
+ 201/NMODE is designed ideally to be used with terminals whose keyboards have
+ a pair of shift keys, labeled "Control" and "Meta", either or both of which
+ can be combined with any character that you can type. These shift keys
+ produce 202/Control 201/characters and 202/Meta 201/characters, which are the editing
+ commands of NMODE. We name each of these characters by prefixing
+ "Control-" (or "C-"), "Meta-" (or "M-") or both to the basic character: thus,
+ Meta-F or M-F is the character which is F typed with the Meta key held
+ down. C-M-; is the Semicolon character with both the Control and Meta
+ keys. Control in the NMODE command character set is not precisely the same
+ as Control in the ASCII character set, but the general purpose is the same.
+
+ There are 128 basic characters. Multiplied by the four possibilities of the
+ Control and Meta keys, this makes 512 characters in the NMODE command
+ character set. So it is called the 512-character set, to distinguish it from
+ ASCII, which has only 128 characters. It is also called the 202/9-bit 201/character
+ set because 9 bits are required to express a number from 0 to 511. Note
+ that the 512-character set is used only for keyboard commands. Characters
+ in files being edited with NMODE are ASCII characters.
+
+ Sadly, most terminals do not have ideal NMODE keyboards. In fact, the
+ only ideal keyboards are at MIT. On nonideal keyboards, the Control key is
+ somewhat limited (it can only be combined with some characters, not with all),
+ and the Meta key may not exist at all. We make it possible to use NMODE on
+ a nonideal terminal by providing two-character circumlocutions, made up of
+ ASCII characters that you can type, for the characters that you can't type.
+ These circumlocutions start with a 202/bit prefix 201/character; see below. For
+ example, to use the Meta-A command, you could type C-A. On the hp9836,
+ the key labelled tab sends C-and acts as a meta prefix.
+
+ Both the NMODE 9-bit character set and ASCII have Control characters,
+ but the 9-bit character set has more different ones. In ASCII, only letters
+ and a few punctuation marks can be made into Control characters; in the
+ 9-bit character set every character has a Control version. For example, we
+ have Control-Space, Control-1, and Control-=. We also have two different
+ characters Control-A and Control-a! But they always do the same thing in
+ NMODE, so you can ignore the distinction between them, unless you are doing
+ customization. In practice, you can forget all about the distinction between
+ ASCII Control and NMODE Control, except to realize that NMODE uses some
+ "Control" characters which ASCII keyboards cannot type.
+ 201/Page 3-2 NMODE Manual (The 9-bit Command Character Set)
+
+
+ We have given some command characters special names which we always
+ capitalize. "<CR>" or "Return" stands for the carriage return character,
+ code 015 (all character codes are in octal). Note that C-R means the
+ character Control-R, never <CR>. "Rubout" is the character with code 177,
+ labeled "Delete" on some keyboards. "Altmode" is the character with code
+ 033, sometimes labeled "Escape". Other command characters with special
+ names are Tab (code 011), Backspace (code 010), Linefeed (code 012), Space
+ (code 040), Excl ("!", code 041), Comma (code 054), and Period (code 056).
+ Control is represented in the numeric code for a character by 400, and Meta
+ by 200; thus, Meta-Period is code 256 in the 9-bit character set.
+
+ 202/3.2 Prefix Characters
+
+ 201/A non-ideal keyboard can only send certain Control characters, and may
+ completely lack the ability to send Meta characters. To use these commands
+ on such keyboards, you need to use two-character circumlocutions starting
+ with a 202/bit prefix 201/character which turns on the Control or Meta bit in the
+ second character. The C-character turns on the Meta bit, so C-X can be
+ used to type a Meta-X, and C-Control-O can be used to type a C-M-O. C-is
+ known as the 202/Metizer201/. Other bit prefix characters are C-^ for Control, and
+ C-Z for Control and Meta together. Thus, C-^ < is a way of typing a
+ Control-<, and C-Z < can be used to type C-M-<. Because C-^ is awkward
+ to type on most keyboards, we have tried to minimize the number of
+ commands for which you will need it.
+
+ There are two other prefix characters, Control-X and Meta-X which are
+ used as the beginning of a large set of multi-character commands known as
+ 202/C-X commands 201/and 202/M-X commands201/. C-X is not a bit prefix character; C-X A
+ is not a circumlocution for any single character, and it must be typed as two
+ characters on any terminal. C-X actually runs the function 203/c-x-prefix201/, while
+ M-X runs 203/m-x-prefix201/. Two prefixes which are also used are ESC
+ (203/esc-prefix201/) and C-] (203/lisp-prefix201/) (also called Lisp-). Each of these is used
+ with a small set of single character suffixes. You can create new prefix
+ characters when you customize.
+
+ 202/3.3 Commands, Functions, and Variables
+
+ 201/Most of the NMODE commands documented herein are members of this 9-bit
+ character set. Others are pairs of characters from that set. However,
+ NMODE doesn't really implement commands directly. Instead, NMODE is
+ composed of 202/functions201/, which have long names such as
+ 203/move-down-extending-command 201/and which are programs that perform the
+ editing operations. 202/Commands 201/such as C-N are connected to functions
+ through the 202/command dispatch table201/. When we say that C-N moves the
+ cursor down a line, we are glossing over a distinction which is unimportant
+ for ordinary use, but essential for customization: it is the function
+ 203/move-down-extending-command 201/which knows how to move down a line, and
+ C-N moves down a line 203/because 201/it is connected to that function. We usually
+ ignore this subtlety to keep things simple. To give the extension-writer the
+ information he needs, we state the name of the function which really does the
+ work in parentheses after mentioning the command name. For example: "C-N
+ (203/move-down-extending-command201/) moves the cursor down a line". In the
+ NMODE wall chart, the function names are used as a form of very brief
+ 201/NMODE Manual (Commands, Functions, and Variables) Page 3-3
+
+
+ documentation for the command characters. See Section 6.2 [Functions], page
+ 2.
+
+ While we are on the subject of customization information which you should
+ not be frightened of, it's a good time to tell you about 202/variables201/. Often the
+ description of a command will say "to change this, set the variable Mumble
+ Foo". A variable is a name used to remember a value. NMODE contains many
+ variables which are there so that you can change them if you want to
+ customize. The variable's value is examined by some command, and changing
+ the value makes the command behave differently. Until you are interested in
+ customizing, you can ignore this information. When you are ready to be
+ interested, read the basic information on variables, and then the information
+ on individual variables will make sense. See Section 22.2 [Variables], page
+ 4.
+
+ 202/3.4 Notational Conventions for ASCII Characters
+
+ 201/Control characters in files, your NMODE buffer, or PSL programs, are
+ ordinary ASCII characters. The special 9-bit character set applies only to
+ typing NMODE commands. ASCII contains the printing characters, rubout,
+ and some control characters. Most ASCII control characters are represented
+ in this manual as uparrow or caret followed by the corresponding non-control
+ character: control-E is represented as ^E.
+
+ Some ASCII characters have special names. These include tab (011),
+ backspace (010), linefeed (012), Return (015), altmode (033), space (040),
+ and rubout (177). To make it clear whether we are talking about a 9-bit
+ character or an ASCII character, we capitalize names of 9-bit characters and
+ leave names of ASCII characters in lower case. Note that the 9-bit
+ characters Tab and Control-I are different, but the ASCII characters tab and
+ control-I are the same.
+
+ On the Dec-20 lines in files are separated by a sequence of two ASCII
+ control characters, carriage return followed by linefeed. This sequence is
+ called 202/CRLF201/. On the hp9836 lines in files are separated by other means.
+ Normally, NMODE treats this two-character sequence as if it were a single
+ character, a 202/line separator201/, linefeed. A Return which is not part of a CRLF
+ is called 202/stray201/. NMODE usually treats them as part of the text of a line and
+ displays them as ^Ms.
+
+ Most control characters when present in the NMODE buffer are displayed
+ with a caret; thus, ^A for ASCII ^A. Rubout is displayed as ^?, because by
+ stretching the meaning of "control" it can be interpreted as ASCII control-?.
+ A backspace is usually displayed as ^H since it is ASCII control-H, because
+ most displays cannot do overprinting.
ADDED psl-1983/3-1/doc/nmode/nm-characters.key
Index: psl-1983/3-1/doc/nmode/nm-characters.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-characters.key
@@ -0,0 +1,17 @@
+.silent_index {C-} idx 3-1
+.silent_index {M-} idx 3-1
+.silent_index {Altmode} idx 3-2
+.silent_index {Rubout} idx 3-2
+.silent_index {Space} idx 3-2
+.silent_index {Tab} idx 3-2
+.silent_index {C-^} idx 3-2
+.silent_index {C-X} idx 3-2
+.silent_index {M-X} idx 3-2
+.silent_index {C-]} idx 3-2
+.silent_index {ESC} idx 3-2
+.silent_index {tab} idx 3-3
+.silent_index {backspace} idx 3-3
+.silent_index {linefeed} idx 3-3
+.silent_index {altmode} idx 3-3
+.silent_index {space} idx 3-3
+.silent_index {rubout} idx 3-3
ADDED psl-1983/3-1/doc/nmode/nm-characters.r
Index: psl-1983/3-1/doc/nmode/nm-characters.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-characters.r
@@ -0,0 +1,215 @@
+.so pndoc:nman
+.part NM-CHARACTERS manual
+@Chapter[Character Sets and Command Input Conventions]
+@node("characters")
+ In this chapter we introduce the terminology and concepts used to
+talk about NMODE commands. NMODE is designed to be used with a kind
+of keyboard with two special shift keys which can type 512 different
+characters, instead of the 128 different characters which ordinary
+ASCII keyboards can send. The terminology of NMODE commands is
+formulated in terms of these shift keys. So that NMODE can be used on
+ASCII terminals, we provide two-character ASCII circumlocutions for
+the command characters which are not ASCII.
+@Section[The 9-bit Command Character Set]
+@index{control}
+@index{meta}
+@index{character set}
+@keyindex{C-}
+@keyindex{M-}
+@index{ASCII}
+ NMODE is designed ideally to be used with terminals whose keyboards
+have a pair of shift keys, labeled "Control" and "Meta", either or
+both of which can be combined with any character that you can type.
+These shift keys produce @dfn[Control] characters and @dfn[Meta]
+characters, which are the editing commands of NMODE. We name each of
+these characters by prefixing "Control-" (or "C-"), "Meta-" (or "M-")
+or both to the basic character: thus, Meta-F or M-F is the character
+which is F typed with the Meta key held down. C-M-; is the Semicolon
+character with both the Control and Meta keys. Control in the NMODE
+command character set is not precisely the same as Control in the
+ASCII character set, but the general purpose is the same.
+
+ There are 128 basic characters. Multiplied by the four possibilities of the
+Control and Meta keys, this makes 512 characters in the NMODE command
+character set. So it is called the 512-character set, to distinguish
+it from ASCII, which has only 128 characters. It is also called the
+@dfn[9-bit] character set because 9 bits are required to express a number
+from 0 to 511. Note that the 512-character set is used only for
+keyboard commands. Characters in files being edited with NMODE are
+ASCII characters.
+
+ Sadly, most terminals do not have ideal NMODE keyboards. In fact,
+the only ideal keyboards are at MIT. On nonideal keyboards, the Control key is somewhat
+limited (it can only be combined with some characters, not with
+all), and the Meta key may not exist at all. We make it possible to
+use NMODE on a nonideal terminal by providing two-character
+circumlocutions, made up of ASCII characters that you can type, for the
+characters that you can't type. These circumlocutions start with a
+@dfn[bit prefix] character; see below. For example, to use the Meta-A
+command, you could type C-\ A.
+On the hp9836, the key labelled tab sends C-\ and acts as a meta prefix.
+
+ Both the NMODE 9-bit character set and ASCII have Control
+characters, but the 9-bit character set has more different ones. In
+ASCII, only letters and a few punctuation marks can be made into
+Control characters; in the 9-bit character set every character has a
+Control version. For example, we have Control-Space, Control-1, and
+Control-=. We also have two different characters Control-A and
+Control-a! But they always do the same thing in NMODE, so you can
+ignore the distinction between them, unless you are doing
+customization. In practice, you can forget all about the distinction
+between ASCII Control and NMODE Control, except to realize that NMODE
+uses some "Control" characters which ASCII keyboards cannot type.
+
+@keyindex{Altmode}
+@keyindex{Rubout}
+@keyindex{Space}
+@index{@return1{}}
+ We have given some command characters special names which we always
+capitalize. "@Return1{}" or "@return3{}"
+stands for the carriage return
+character, code 015 (all character codes are in octal). Note that C-R
+means the character Control-R, never @Return1{}. "Rubout" is the
+character with code 177, labeled "Delete" on some keyboards.
+"Altmode" is the character with code 033, sometimes labeled "Escape".
+Other command characters with special names are Tab (code 011),
+Backspace (code 010), Linefeed (code 012), Space (code 040), Excl
+("!", code 041), Comma (code 054), and Period (code 056). Control is
+represented in the numeric code for a character by 400, and Meta by
+200; thus, Meta-Period is code 256 in the 9-bit character set.
+@section[Prefix Characters]
+@node("prefix")
+@index{prefix characters}
+@keyIndex{Tab}
+@Keyindex{C-^}
+@Twenex{@index[C-Z]}
+@index{Metizer}
+ A non-ideal keyboard can only send certain Control characters, and
+may completely lack the ability to send Meta characters. To use these
+commands on such keyboards, you need to use two-character
+circumlocutions starting with a @dfn[bit prefix] character which turns on
+the Control or Meta bit in the second character. The C-\
+character turns on the Meta bit, so C-\ X can be used to type a
+Meta-X, and C-\ Control-O can be used to type a C-M-O. C-\ is
+known as the @dfn[Metizer]. Other bit prefix characters are C-^ for
+Control, and @CC[] for Control and Meta together. Thus, C-^ < is a
+way of typing a Control-<, and @CC[] < can be used to type C-M-<.
+Because C-^ is awkward to type on most keyboards, we have tried to
+minimize the number of commands for which you will need it.
+
+@fncindex{c-x-prefix}
+@keyindex{C-X}
+@fncindex{m-x-prefix}
+@keyindex{M-X}
+ There are two other prefix characters, Control-X and Meta-X
+which are used as the
+beginning of a large set of multi-character commands known as @dfn[C-X
+commands] and @dfn[M-X commands].
+C-X is not a bit prefix character; C-X A is not a
+circumlocution for any single character, and it must be typed as two
+characters on any terminal. C-X actually runs the function @fnc{c-x-prefix},
+while M-X runs @fnc{m-x-prefix}.
+@keyindex{C-]}
+@fncindex{lisp-prefix}
+@keyindex{ESC}
+@fncindex{esc-prefix}
+Two prefixes which are also used are ESC (@fnc{esc-prefix}) and C-]
+(@fnc{lisp-prefix}) (also called Lisp-). Each of these is used with a
+small set of single character suffixes.
+You can create new prefix characters when
+you customize.
+@section[Commands, Functions, and Variables]
+@index{Functions}
+@index{Connected}
+@index{Customization}
+ Most of the NMODE commands documented herein are members of this
+9-bit character set. Others are pairs of characters from that set.
+However, NMODE doesn't really implement commands directly. Instead,
+NMODE is composed of @dfn[functions], which have long names such as
+@fnc{move-down-extending-command} and which are
+programs that perform the editing
+operations. @dfn[Commands] such as C-N are connected to
+functions through the @dfn[command dispatch table].
+When we say that C-N moves the cursor
+down a line, we are glossing over a distinction which is unimportant
+for ordinary use, but essential for customization: it is the function
+@fnc{move-down-extending-command}
+which knows how to move down a line, and C-N moves
+down a line @xxi[because] it is connected to that function. We
+usually ignore this subtlety to keep things simple. To give the
+extension-writer the information he needs, we state the name of the
+function which really does the work in parentheses after mentioning
+the command name. For example:
+"C-N (@fnc{move-down-extending-command})
+moves the
+cursor down a line". In the NMODE wall chart, the function names are
+used as a form of very brief documentation for the command characters.
+@Note("MMArcana" "Functions").
+
+@index{Variables}
+ While we are on the subject of customization information which you
+should not be frightened of, it's a good time to tell you about
+@dfn[variables]. Often the description of a command will say "to
+change this, set the variable Mumble Foo". A variable is a name used
+to remember a value. NMODE contains many variables which are there so
+that you can change them if you want to customize. The variable's
+value is examined by some command, and changing the value makes the
+command behave differently. Until you are interested in customizing,
+you can ignore this information. When you are ready to be interested,
+read the basic information on variables, and then the information on
+individual variables will make sense. @Note("Variables").
+@section[Notational Conventions for ASCII Characters]
+@index{ASCII}
+@index{control}
+@index{uparrow}
+@index{caret}
+@index{^}
+ Control characters in files, your NMODE buffer, or PSL programs,
+are ordinary ASCII characters. The special 9-bit character set
+applies only to typing NMODE commands. ASCII contains the printing
+characters, rubout, and some control characters. Most ASCII control
+characters are represented in this manual as uparrow or caret followed
+by the corresponding non-control character: control-E is represented
+as @CTL[E].
+
+@keyindex{tab}
+@keyindex{backspace}
+@keyindex{linefeed}
+@index{@return1{}}
+@keyindex{altmode}
+@keyindex{space}
+@keyindex{rubout}
+ Some ASCII characters have special names. These include tab (011),
+backspace (010), linefeed (012), @return3{} (015), altmode (033), space
+(040), and rubout (177). To make it clear whether we are talking
+about a 9-bit character or an ASCII character, we capitalize names of
+9-bit characters and leave names of ASCII characters in lower case.
+Note that the 9-bit characters Tab and Control-I are different, but
+the ASCII characters tab and control-I are the same.
+
+@index{CRLF}
+@index{@Return1{}, stray}
+@index{Linefeed, stray}
+@index{line separator}
+ On the Dec-20
+lines in files are separated by a sequence of two ASCII control
+characters, carriage return followed by linefeed. This sequence is
+called @dfn[CRLF].
+On the hp9836 lines in files are separated by other means.
+Normally, NMODE treats this two-character sequence
+as if it were a single character, a @dfn[line separator], linefeed.
+A @return3{}
+which is not part of a CRLF is called @dfn[stray]. NMODE
+usually treats them as part of the text of a line and displays them as
+^Ms.
+
+@index{Backspace}
+@index{Control characters, display of}
+ Most control characters when present in the NMODE buffer are
+displayed with a caret; thus, ^A for ASCII @CTL[A]. Rubout is displayed as
+^?, because by stretching the meaning of "control" it can be
+interpreted as ASCII control-?. A backspace is usually displayed as
+^H since it is ASCII control-H, because most displays cannot do
+overprinting.
+
+
ADDED psl-1983/3-1/doc/nmode/nm-characters.topic
Index: psl-1983/3-1/doc/nmode/nm-characters.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-characters.topic
@@ -0,0 +1,24 @@
+.silent_index {control} idx 3-1
+.silent_index {meta} idx 3-1
+.silent_index {character} idx 3-1
+.silent_index {ASCII} idx 3-1
+.silent_index {return1{}} idx 3-2
+.silent_index {prefix} idx 3-2
+.silent_index {C-Z} idx 3-2
+.silent_index {Metizer} idx 3-2
+.silent_index {Functions} idx 3-2
+.silent_index {Connected} idx 3-2
+.silent_index {Customization} idx 3-2
+.silent_index {Variables} idx 3-3
+.silent_index {ASCII} idx 3-3
+.silent_index {control} idx 3-3
+.silent_index {uparrow} idx 3-3
+.silent_index {caret} idx 3-3
+.silent_index {^} idx 3-3
+.silent_index {return1{}} idx 3-3
+.silent_index {CRLF} idx 3-3
+.silent_index {Return1{},} idx 3-3
+.silent_index {Linefeed,} idx 3-3
+.silent_index {line} idx 3-3
+.silent_index {Backspace} idx 3-3
+.silent_index {Control} idx 3-3
ADDED psl-1983/3-1/doc/nmode/nm-cmd-index.contents
Index: psl-1983/3-1/doc/nmode/nm-cmd-index.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-cmd-index.contents
@@ -0,0 +1,1 @@
+contents_entry(0 26 {Command Index} 26-1)
ADDED psl-1983/3-1/doc/nmode/nm-cmd-index.ibm
Index: psl-1983/3-1/doc/nmode/nm-cmd-index.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-cmd-index.ibm
@@ -0,0 +1,220 @@
+,MOD
+- R 44X (21 March 1983) <PSL.NMODE-DOC>NM-CMD-INDEX.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Command Index) Page 26-1
+
+
+ 202/26. Command Index
+
+ 201/Append Next Kill . . . . . . . . . . . . . . . . . . . . 25-2
+ Append To Buffer . . . . . . . . . . . . . . . . . . . . 25-2
+ Append To File . . . . . . . . . . . . . . . . . . . . . 25-2
+ Apropos . . . . . . . . . . . . . . . . . . . . . . . . . 25-2
+ Argument Digit . . . . . . . . . . . . . . . . . . . . . 25-3
+ Auto Fill Mode . . . . . . . . . . . . . . . . . . . . . . 25-3
+
+ Back To Indentation . . . . . . . . . . . . . . . . . . . 25-4
+ Backward Kill Sentence . . . . . . . . . . . . . . . . . 25-4
+ Backward Paragraph . . . . . . . . . . . . . . . . . . . 25-4
+ Backward Sentence . . . . . . . . . . . . . . . . . . . . 25-4
+ Backward Up List . . . . . . . . . . . . . . . . . . . . 25-5
+ Buffer Browser . . . . . . . . . . . . . . . . . . . . . 25-5
+ Buffer Not Modified . . . . . . . . . . . . . . . . . . . 25-5
+
+ C-X Prefix . . . . . . . . . . . . . . . . . . . . . . . . 25-5
+ Center Line . . . . . . . . . . . . . . . . . . . . . . . 25-6
+ Copy Region . . . . . . . . . . . . . . . . . . . . . . . 25-6
+ Count Occurrences . . . . . . . . . . . . . . . . . . . . 25-6
+
+ Delete And Expunge File . . . . . . . . . . . . . . . . . 25-6
+ Delete Backward Hacking Tabs . . . . . . . . . . . . . . 25-7
+ Delete Blank Lines . . . . . . . . . . . . . . . . . . . . 25-7
+ Delete File . . . . . . . . . . . . . . . . . . . . . . . . 25-7
+ Delete Forward Character . . . . . . . . . . . . . . . . 25-7
+ Delete Horizontal Space . . . . . . . . . . . . . . . . . 25-8
+ Delete Indentation . . . . . . . . . . . . . . . . . . . . 25-8
+ Delete Matching Lines . . . . . . . . . . . . . . . . . . 25-8
+ Delete Non-Matching Lines . . . . . . . . . . . . . . . . 25-8
+ Dired . . . . . . . . . . . . . . . . . . . . . . . . . . 25-8
+ Down List . . . . . . . . . . . . . . . . . . . . . . . . 25-9
+
+ Edit Directory . . . . . . . . . . . . . . . . . . . . . . 25-9
+ End Of Defun . . . . . . . . . . . . . . . . . . . . . . 25-9
+ Esc Prefix . . . . . . . . . . . . . . . . . . . . . . . . 25-10
+ Exchange Point And Mark . . . . . . . . . . . . . . . . 25-10
+ Exchange Windows . . . . . . . . . . . . . . . . . . . . 25-10
+ Execute Buffer . . . . . . . . . . . . . . . . . . . . . . 25-10
+ Execute Defun . . . . . . . . . . . . . . . . . . . . . . 25-10
+ Execute File . . . . . . . . . . . . . . . . . . . . . . . 25-11
+ Execute Form . . . . . . . . . . . . . . . . . . . . . . 25-11
+ Exit Nmode . . . . . . . . . . . . . . . . . . . . . . . 25-11
+
+ Fill Comment . . . . . . . . . . . . . . . . . . . . . . . 25-11
+ Fill Paragraph . . . . . . . . . . . . . . . . . . . . . . 25-12
+ Fill Region . . . . . . . . . . . . . . . . . . . . . . . . 25-12
+ Find File . . . . . . . . . . . . . . . . . . . . . . . . . 25-12
+ Forward Paragraph . . . . . . . . . . . . . . . . . . . . 25-13
+ Forward Sentence . . . . . . . . . . . . . . . . . . . . 25-13
+ Forward Up List . . . . . . . . . . . . . . . . . . . . . 25-13
+ 201/Page 26-2 NMODE Manual (Command Index)
+
+
+ Get Register . . . . . . . . . . . . . . . . . . . . . . . 25-13
+ Grow Window . . . . . . . . . . . . . . . . . . . . . . . 25-14
+
+ Help Dispatch . . . . . . . . . . . . . . . . . . . . . . 25-14
+
+ Incremental Search . . . . . . . . . . . . . . . . . . . . 25-14
+ Indent New line . . . . . . . . . . . . . . . . . . . . . 25-14
+ Insert Buffer . . . . . . . . . . . . . . . . . . . . . . 25-15
+ Insert Closing bracket . . . . . . . . . . . . . . . . . . 25-15
+ Insert Comment . . . . . . . . . . . . . . . . . . . . . 25-15
+ Insert Date . . . . . . . . . . . . . . . . . . . . . . . 25-15
+ Insert File . . . . . . . . . . . . . . . . . . . . . . . . 25-16
+ Insert Kill Buffer . . . . . . . . . . . . . . . . . . . . 25-16
+ Insert Next Character . . . . . . . . . . . . . . . . . . 25-16
+
+ Kill Backward Form . . . . . . . . . . . . . . . . . . . 25-16
+ Kill Backward Word . . . . . . . . . . . . . . . . . . . 25-17
+ Kill Buffer . . . . . . . . . . . . . . . . . . . . . . . . 25-17
+ Kill Forward Form . . . . . . . . . . . . . . . . . . . . 25-17
+ Kill Forward Word . . . . . . . . . . . . . . . . . . . . 25-17
+ Kill Line . . . . . . . . . . . . . . . . . . . . . . . . . 25-18
+ Kill Region . . . . . . . . . . . . . . . . . . . . . . . . 25-18
+ Kill Sentence . . . . . . . . . . . . . . . . . . . . . . . 25-18
+ Kill Some Buffers . . . . . . . . . . . . . . . . . . . . 25-18
+
+ Lisp Abort . . . . . . . . . . . . . . . . . . . . . . . . 25-19
+ Lisp Backtrace . . . . . . . . . . . . . . . . . . . . . . 25-19
+ Lisp Continue . . . . . . . . . . . . . . . . . . . . . . 25-19
+ Lisp Help . . . . . . . . . . . . . . . . . . . . . . . . 25-19
+ Lisp Indent Region . . . . . . . . . . . . . . . . . . . . 25-20
+ Lisp Indent sexpr . . . . . . . . . . . . . . . . . . . . 25-20
+ Lisp Mode . . . . . . . . . . . . . . . . . . . . . . . . 25-20
+ Lisp Prefix . . . . . . . . . . . . . . . . . . . . . . . 25-20
+ Lisp Quit . . . . . . . . . . . . . . . . . . . . . . . . 25-21
+ Lisp Retry . . . . . . . . . . . . . . . . . . . . . . . . 25-21
+ Lisp Tab . . . . . . . . . . . . . . . . . . . . . . . . . 25-21
+ Lowercase Region . . . . . . . . . . . . . . . . . . . . 25-21
+ Lowercase Word . . . . . . . . . . . . . . . . . . . . . 25-22
+
+ M-X Prefix . . . . . . . . . . . . . . . . . . . . . . . . 25-22
+ Make Parens . . . . . . . . . . . . . . . . . . . . . . . 25-22
+ Mark Beginning . . . . . . . . . . . . . . . . . . . . . 25-22
+ Mark Defun . . . . . . . . . . . . . . . . . . . . . . . 25-23
+ Mark End . . . . . . . . . . . . . . . . . . . . . . . . 25-23
+ Mark Form . . . . . . . . . . . . . . . . . . . . . . . . 25-23
+ Mark Paragraph . . . . . . . . . . . . . . . . . . . . . 25-23
+ Mark Whole Buffer . . . . . . . . . . . . . . . . . . . . 25-24
+ Mark Word . . . . . . . . . . . . . . . . . . . . . . . . 25-24
+ Move Backward Character . . . . . . . . . . . . . . . . 25-24
+ Move Backward Defun . . . . . . . . . . . . . . . . . . 25-24
+ Move Backward Form . . . . . . . . . . . . . . . . . . . 25-25
+ Move Backward List . . . . . . . . . . . . . . . . . . . 25-25
+ Move Backward Word . . . . . . . . . . . . . . . . . . . 25-25
+ 201/NMODE Manual (Command Index) Page 26-3
+
+
+ Move Down . . . . . . . . . . . . . . . . . . . . . . . . 25-25
+ Move Down Extending . . . . . . . . . . . . . . . . . . 25-26
+ Move Forward Character . . . . . . . . . . . . . . . . . 25-26
+ Move Forward Form . . . . . . . . . . . . . . . . . . . 25-26
+ Move Forward List . . . . . . . . . . . . . . . . . . . . 25-26
+ Move Forward Word . . . . . . . . . . . . . . . . . . . 25-27
+ Move Over Paren . . . . . . . . . . . . . . . . . . . . . 25-27
+ Move To Buffer End . . . . . . . . . . . . . . . . . . . 25-27
+ Move To Buffer Start . . . . . . . . . . . . . . . . . . 25-27
+ Move To End Of Line . . . . . . . . . . . . . . . . . . 25-28
+ Move To Screen Edge . . . . . . . . . . . . . . . . . . 25-28
+ Move To Start Of Line . . . . . . . . . . . . . . . . . . 25-28
+ Move Up . . . . . . . . . . . . . . . . . . . . . . . . . 25-28
+
+ Negative Argument . . . . . . . . . . . . . . . . . . . . 25-29
+ Next Screen . . . . . . . . . . . . . . . . . . . . . . . 25-29
+ Nmode Abort . . . . . . . . . . . . . . . . . . . . . . . 25-29
+ Nmode Exit To Superior . . . . . . . . . . . . . . . . . 25-29
+ Nmode Full Refresh . . . . . . . . . . . . . . . . . . . 25-29
+ Nmode Gc . . . . . . . . . . . . . . . . . . . . . . . . 25-30
+ Nmode Invert Video . . . . . . . . . . . . . . . . . . . 25-30
+ Nmode Refresh . . . . . . . . . . . . . . . . . . . . . . 25-30
+
+ One Window . . . . . . . . . . . . . . . . . . . . . . . 25-30
+ Open Line . . . . . . . . . . . . . . . . . . . . . . . . 25-30
+ Other Window . . . . . . . . . . . . . . . . . . . . . . 25-31
+
+ Prepend To File . . . . . . . . . . . . . . . . . . . . . 25-31
+ Previous Screen . . . . . . . . . . . . . . . . . . . . . 25-31
+ Put Register . . . . . . . . . . . . . . . . . . . . . . . 25-31
+
+ Query Replace . . . . . . . . . . . . . . . . . . . . . . 25-31
+
+ Rename Buffer . . . . . . . . . . . . . . . . . . . . . . 25-32
+ Replace String . . . . . . . . . . . . . . . . . . . . . . 25-32
+ Reposition Window . . . . . . . . . . . . . . . . . . . . 25-32
+ Return . . . . . . . . . . . . . . . . . . . . . . . . . . 25-33
+ Reverse Search . . . . . . . . . . . . . . . . . . . . . 25-33
+ Revert File . . . . . . . . . . . . . . . . . . . . . . . 25-33
+
+ Save All Files . . . . . . . . . . . . . . . . . . . . . . 25-33
+ Save File . . . . . . . . . . . . . . . . . . . . . . . . 25-33
+ Scroll Other Window . . . . . . . . . . . . . . . . . . . 25-34
+ Scroll Window Down Line . . . . . . . . . . . . . . . . . 25-34
+ Scroll Window Down Page . . . . . . . . . . . . . . . . . 25-34
+ Scroll Window Left . . . . . . . . . . . . . . . . . . . . 25-34
+ Scroll Window Right . . . . . . . . . . . . . . . . . . . 25-34
+ Scroll Window Up Line . . . . . . . . . . . . . . . . . . 25-35
+ Scroll Window Up Page . . . . . . . . . . . . . . . . . . 25-35
+ Select Buffer . . . . . . . . . . . . . . . . . . . . . . 25-35
+ Select Previous Buffer . . . . . . . . . . . . . . . . . . 25-35
+ Set Fill Column . . . . . . . . . . . . . . . . . . . . . 25-36
+ Set Fill Prefix . . . . . . . . . . . . . . . . . . . . . . 25-36
+ 201/Page 26-4 NMODE Manual (Command Index)
+
+
+ Set Goal Column . . . . . . . . . . . . . . . . . . . . . 25-36
+ Set Key . . . . . . . . . . . . . . . . . . . . . . . . . 25-36
+ Set Mark . . . . . . . . . . . . . . . . . . . . . . . . . 25-37
+ Set Visited Filename . . . . . . . . . . . . . . . . . . . 25-37
+ Split Line . . . . . . . . . . . . . . . . . . . . . . . . 25-37
+ Start Scripting . . . . . . . . . . . . . . . . . . . . . . 25-37
+ Start Timing . . . . . . . . . . . . . . . . . . . . . . . 25-38
+ Stop Scripting . . . . . . . . . . . . . . . . . . . . . . 25-38
+ Stop Timing . . . . . . . . . . . . . . . . . . . . . . . 25-38
+
+ Tab To Tab Stop . . . . . . . . . . . . . . . . . . . . 25-38
+ Text Mode . . . . . . . . . . . . . . . . . . . . . . . . 25-39
+ Transpose Characters . . . . . . . . . . . . . . . . . . 25-39
+ Transpose Forms . . . . . . . . . . . . . . . . . . . . . 25-39
+ Transpose Lines . . . . . . . . . . . . . . . . . . . . . 25-39
+ Transpose Regions . . . . . . . . . . . . . . . . . . . . 25-40
+ Transpose Words . . . . . . . . . . . . . . . . . . . . . 25-40
+ Two Windows . . . . . . . . . . . . . . . . . . . . . . . 25-40
+
+ Undelete File . . . . . . . . . . . . . . . . . . . . . . . 25-40
+ Universal Argument . . . . . . . . . . . . . . . . . . . 25-41
+ Unkill Previous . . . . . . . . . . . . . . . . . . . . . 25-41
+ Upcase Digit . . . . . . . . . . . . . . . . . . . . . . . 25-41
+ Uppercase Initial . . . . . . . . . . . . . . . . . . . . . 25-41
+ Uppercase Region . . . . . . . . . . . . . . . . . . . . 25-42
+ Uppercase Word . . . . . . . . . . . . . . . . . . . . . 25-42
+
+ View Two Windows . . . . . . . . . . . . . . . . . . . . 25-42
+ Visit File . . . . . . . . . . . . . . . . . . . . . . . . 25-42
+ Visit In Other Window . . . . . . . . . . . . . . . . . . 25-42
+
+ What Cursor Position . . . . . . . . . . . . . . . . . . . 25-43
+ Write File . . . . . . . . . . . . . . . . . . . . . . . . 25-43
+ Write Region . . . . . . . . . . . . . . . . . . . . . . . 25-43
+ Write Screen Photo . . . . . . . . . . . . . . . . . . . . 25-43
+
+ Yank Last Output . . . . . . . . . . . . . . . . . . . . 25-44
ADDED psl-1983/3-1/doc/nmode/nm-commands.command
Index: psl-1983/3-1/doc/nmode/nm-commands.command
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-commands.command
@@ -0,0 +1,174 @@
+.silent_index {Append Next Kill} idx 27-2
+.silent_index {Append To Buffer} idx 27-2
+.silent_index {Append To File} idx 27-2
+.silent_index {Apropos} idx 27-2
+.silent_index {Argument Digit} idx 27-3
+.silent_index {Auto Fill Mode} idx 27-3
+.silent_index {Back To Indentation} idx 27-4
+.silent_index {Backward Kill Sentence} idx 27-4
+.silent_index {Backward Paragraph} idx 27-4
+.silent_index {Backward Sentence} idx 27-4
+.silent_index {Backward Up List} idx 27-5
+.silent_index {Buffer Browser} idx 27-5
+.silent_index {Buffer Not Modified} idx 27-5
+.silent_index {C-X Prefix} idx 27-5
+.silent_index {Center Line} idx 27-6
+.silent_index {Copy Region} idx 27-6
+.silent_index {Count Occurrences} idx 27-6
+.silent_index {Delete And Expunge File} idx 27-6
+.silent_index {Delete Backward Character} idx 27-7
+.silent_index {Delete Backward Hacking Tabs} idx 27-7
+.silent_index {Delete Blank Lines} idx 27-7
+.silent_index {Delete File} idx 27-7
+.silent_index {Delete Forward Character} idx 27-8
+.silent_index {Delete Horizontal Space} idx 27-8
+.silent_index {Delete Indentation} idx 27-8
+.silent_index {Delete Matching Lines} idx 27-8
+.silent_index {Delete Non-Matching Lines} idx 27-8
+.silent_index {Dired} idx 27-9
+.silent_index {Down List} idx 27-9
+.silent_index {Edit Directory} idx 27-9
+.silent_index {End Of Defun} idx 27-10
+.silent_index {Esc Prefix} idx 27-10
+.silent_index {Exchange Point And Mark} idx 27-10
+.silent_index {Exchange Windows} idx 27-10
+.silent_index {Execute Buffer} idx 27-10
+.silent_index {Execute Defun} idx 27-11
+.silent_index {Execute File} idx 27-11
+.silent_index {Execute Form} idx 27-11
+.silent_index {Exit Nmode} idx 27-11
+.silent_index {Fill Comment} idx 27-12
+.silent_index {Fill Paragraph} idx 27-12
+.silent_index {Fill Region} idx 27-12
+.silent_index {Find File} idx 27-13
+.silent_index {Forward Paragraph} idx 27-13
+.silent_index {Forward Sentence} idx 27-13
+.silent_index {Forward Up List} idx 27-13
+.silent_index {Get Register} idx 27-14
+.silent_index {Grow Window} idx 27-14
+.silent_index {Help Dispatch} idx 27-14
+.silent_index {Incremental Search} idx 27-14
+.silent_index {Indent New line} idx 27-15
+.silent_index {Indent Region} idx 27-15
+.silent_index {Insert Buffer} idx 27-15
+.silent_index {Insert Closing bracket} idx 27-15
+.silent_index {Insert Comment} idx 27-16
+.silent_index {Insert Date} idx 27-16
+.silent_index {Insert File} idx 27-16
+.silent_index {Insert Kill Buffer} idx 27-16
+.silent_index {Insert Next Character} idx 27-17
+.silent_index {Kill Backward Form} idx 27-17
+.silent_index {Kill Backward Word} idx 27-17
+.silent_index {Kill Buffer} idx 27-17
+.silent_index {Kill Forward Form} idx 27-18
+.silent_index {Kill Forward Word} idx 27-18
+.silent_index {Kill Line} idx 27-18
+.silent_index {Kill Region} idx 27-18
+.silent_index {Kill Sentence} idx 27-19
+.silent_index {Kill Some Buffers} idx 27-19
+.silent_index {Lisp Abort} idx 27-19
+.silent_index {Lisp Backtrace} idx 27-19
+.silent_index {Lisp Continue} idx 27-20
+.silent_index {Lisp Help} idx 27-20
+.silent_index {Lisp Indent Region} idx 27-20
+.silent_index {Lisp Indent sexpr} idx 27-20
+.silent_index {Lisp Mode} idx 27-21
+.silent_index {Lisp Prefix} idx 27-21
+.silent_index {Lisp Quit} idx 27-21
+.silent_index {Lisp Retry} idx 27-21
+.silent_index {Lisp Tab} idx 27-22
+.silent_index {Lowercase Region} idx 27-22
+.silent_index {Lowercase Word} idx 27-22
+.silent_index {M-X Prefix} idx 27-22
+.silent_index {Make Parens} idx 27-23
+.silent_index {Mark Beginning} idx 27-23
+.silent_index {Mark Defun} idx 27-23
+.silent_index {Mark End} idx 27-23
+.silent_index {Mark Form} idx 27-24
+.silent_index {Mark Paragraph} idx 27-24
+.silent_index {Mark Whole Buffer} idx 27-24
+.silent_index {Mark Word} idx 27-24
+.silent_index {Move Backward Character} idx 27-25
+.silent_index {Move Backward Defun} idx 27-25
+.silent_index {Move Backward Form} idx 27-25
+.silent_index {Move Backward List} idx 27-25
+.silent_index {Move Backward Word} idx 27-26
+.silent_index {Move Down} idx 27-26
+.silent_index {Move Down Extending} idx 27-26
+.silent_index {Move Forward Character} idx 27-26
+.silent_index {Move Forward Form} idx 27-27
+.silent_index {Move Forward List} idx 27-27
+.silent_index {Move Forward Word} idx 27-27
+.silent_index {Move Over Paren} idx 27-27
+.silent_index {Move To Buffer End} idx 27-28
+.silent_index {Move To Buffer Start} idx 27-28
+.silent_index {Move To End Of Line} idx 27-28
+.silent_index {Move To Screen Edge} idx 27-28
+.silent_index {Move To Start Of Line} idx 27-28
+.silent_index {Move Up} idx 27-29
+.silent_index {Negative Argument} idx 27-29
+.silent_index {Next Screen} idx 27-29
+.silent_index {Nmode Abort} idx 27-29
+.silent_index {Nmode Exit To Superior} idx 27-29
+.silent_index {Nmode Full Refresh} idx 27-30
+.silent_index {Nmode Gc} idx 27-30
+.silent_index {Nmode Invert Video} idx 27-30
+.silent_index {Nmode Refresh} idx 27-30
+.silent_index {One Window} idx 27-30
+.silent_index {Open Line} idx 27-31
+.silent_index {Other Window} idx 27-31
+.silent_index {Prepend To File} idx 27-31
+.silent_index {Previous Screen} idx 27-31
+.silent_index {Put Register} idx 27-32
+.silent_index {Query Replace} idx 27-32
+.silent_index {Rename Buffer} idx 27-32
+.silent_index {Replace String} idx 27-33
+.silent_index {Reposition Window} idx 27-33
+.silent_index {Return} idx 27-33
+.silent_index {Reverse Search} idx 27-33
+.silent_index {Revert File} idx 27-33
+.silent_index {Save All Files} idx 27-34
+.silent_index {Save File} idx 27-34
+.silent_index {Scroll Other Window} idx 27-34
+.silent_index {Scroll Window Down Line} idx 27-34
+.silent_index {Scroll Window Down Page} idx 27-34
+.silent_index {Scroll Window Left} idx 27-35
+.silent_index {Scroll Window Right} idx 27-35
+.silent_index {Scroll Window Up Line} idx 27-35
+.silent_index {Scroll Window Up Page} idx 27-35
+.silent_index {Select Buffer} idx 27-35
+.silent_index {Select Previous Buffer} idx 27-36
+.silent_index {Set Fill Column} idx 27-36
+.silent_index {Set Fill Prefix} idx 27-36
+.silent_index {Set Goal Column} idx 27-36
+.silent_index {Set Key} idx 27-37
+.silent_index {Set Mark} idx 27-37
+.silent_index {Set Visited Filename} idx 27-37
+.silent_index {Split Line} idx 27-37
+.silent_index {Start Scripting} idx 27-38
+.silent_index {Start Timing} idx 27-38
+.silent_index {Stop Scripting} idx 27-38
+.silent_index {Stop Timing} idx 27-38
+.silent_index {Tab To Tab Stop} idx 27-39
+.silent_index {Text Mode} idx 27-39
+.silent_index {Transpose Characters} idx 27-39
+.silent_index {Transpose Forms} idx 27-39
+.silent_index {Transpose Lines} idx 27-40
+.silent_index {Transpose Regions} idx 27-40
+.silent_index {Transpose Words} idx 27-40
+.silent_index {Two Windows} idx 27-40
+.silent_index {Undelete File} idx 27-41
+.silent_index {Universal Argument} idx 27-41
+.silent_index {Unkill Previous} idx 27-41
+.silent_index {Upcase Digit} idx 27-41
+.silent_index {Uppercase Initial} idx 27-42
+.silent_index {Uppercase Region} idx 27-42
+.silent_index {Uppercase Word} idx 27-42
+.silent_index {View Two Windows} idx 27-42
+.silent_index {Visit File} idx 27-42
+.silent_index {Visit In Other Window} idx 27-43
+.silent_index {What Cursor Position} idx 27-43
+.silent_index {Write File} idx 27-43
+.silent_index {Write Region} idx 27-43
+.silent_index {Write Screen} idx 27-44
+.silent_index {Yank Last Output} idx 27-44
ADDED psl-1983/3-1/doc/nmode/nm-commands.contents
Index: psl-1983/3-1/doc/nmode/nm-commands.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-commands.contents
@@ -0,0 +1,1 @@
+contents_entry(0 27 {Command Descriptions} 27-1)
ADDED psl-1983/3-1/doc/nmode/nm-commands.function
Index: psl-1983/3-1/doc/nmode/nm-commands.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-commands.function
@@ -0,0 +1,174 @@
+.silent_index {append-next-kill-command} idx 27-2
+.silent_index {append-to-buffer-command} idx 27-2
+.silent_index {append-to-file-command} idx 27-2
+.silent_index {apropos-command} idx 27-2
+.silent_index {argument-digit} idx 27-3
+.silent_index {auto-fill-mode-command} idx 27-3
+.silent_index {back-to-indentation-command} idx 27-4
+.silent_index {backward-kill-sentence-command} idx 27-4
+.silent_index {backward-paragraph-command} idx 27-4
+.silent_index {backward-sentence-command} idx 27-4
+.silent_index {backward-up-list-command} idx 27-5
+.silent_index {buffer-browser-command} idx 27-5
+.silent_index {buffer-not-modified-command} idx 27-5
+.silent_index {c-x-prefix} idx 27-5
+.silent_index {center-line-command} idx 27-6
+.silent_index {copy-region} idx 27-6
+.silent_index {count-occurrences-command} idx 27-6
+.silent_index {delete-and-expunge-file-command} idx 27-6
+.silent_index {delete-backward-character-command} idx 27-7
+.silent_index {delete-backward-hacking-tabs-command} idx 27-7
+.silent_index {delete-blank-lines-command} idx 27-7
+.silent_index {delete-file-command} idx 27-7
+.silent_index {delete-forward-character-command} idx 27-8
+.silent_index {delete-horizontal-space-command} idx 27-8
+.silent_index {delete-indentation-command} idx 27-8
+.silent_index {delete-matching-lines-command} idx 27-8
+.silent_index {delete-non-matching-lines-command} idx 27-8
+.silent_index {dired-command} idx 27-9
+.silent_index {down-list-command} idx 27-9
+.silent_index {edit-directory-command} idx 27-9
+.silent_index {end-of-defun-command} idx 27-10
+.silent_index {esc-prefix} idx 27-10
+.silent_index {exchange-point-and-mark} idx 27-10
+.silent_index {exchange-windows-command} idx 27-10
+.silent_index {execute-buffer-command} idx 27-10
+.silent_index {execute-defun-command} idx 27-11
+.silent_index {execute-file-command} idx 27-11
+.silent_index {execute-form-command} idx 27-11
+.silent_index {exit-nmode} idx 27-11
+.silent_index {fill-comment-command} idx 27-12
+.silent_index {fill-paragraph-command} idx 27-12
+.silent_index {fill-region-command} idx 27-12
+.silent_index {find-file-command} idx 27-13
+.silent_index {forward-paragraph-command} idx 27-13
+.silent_index {forward-sentence-command} idx 27-13
+.silent_index {forward-up-list-command} idx 27-13
+.silent_index {get-register-command} idx 27-14
+.silent_index {grow-window-command} idx 27-14
+.silent_index {help-dispatch} idx 27-14
+.silent_index {incremental-search-command} idx 27-14
+.silent_index {indent-new-line-command} idx 27-15
+.silent_index {indent-region-command} idx 27-15
+.silent_index {insert-buffer-command} idx 27-15
+.silent_index {insert-closing-bracket} idx 27-15
+.silent_index {insert-comment-command} idx 27-16
+.silent_index {insert-date-command} idx 27-16
+.silent_index {insert-file-command} idx 27-16
+.silent_index {insert-kill-buffer} idx 27-16
+.silent_index {insert-next-character-command} idx 27-17
+.silent_index {kill-backward-form-command} idx 27-17
+.silent_index {kill-backward-word-command} idx 27-17
+.silent_index {kill-buffer-command} idx 27-17
+.silent_index {kill-forward-form-command} idx 27-18
+.silent_index {kill-forward-word-command} idx 27-18
+.silent_index {kill-line} idx 27-18
+.silent_index {kill-region} idx 27-18
+.silent_index {kill-sentence-command} idx 27-19
+.silent_index {kill-some-buffers-command} idx 27-19
+.silent_index {lisp-abort-command} idx 27-19
+.silent_index {lisp-backtrace-command} idx 27-19
+.silent_index {lisp-continue-command} idx 27-20
+.silent_index {lisp-help-command} idx 27-20
+.silent_index {lisp-indent-region-command} idx 27-20
+.silent_index {lisp-indent-sexpr} idx 27-20
+.silent_index {lisp-mode-command} idx 27-21
+.silent_index {lisp-prefix} idx 27-21
+.silent_index {lisp-quit-command} idx 27-21
+.silent_index {lisp-retry-command} idx 27-21
+.silent_index {lisp-tab-command} idx 27-22
+.silent_index {lowercase-region-command} idx 27-22
+.silent_index {lowercase-word-command} idx 27-22
+.silent_index {m-x-prefix} idx 27-22
+.silent_index {make-parens-command} idx 27-23
+.silent_index {mark-beginning-command} idx 27-23
+.silent_index {mark-defun-command} idx 27-23
+.silent_index {mark-end-command} idx 27-23
+.silent_index {mark-form-command} idx 27-24
+.silent_index {mark-paragraph-command} idx 27-24
+.silent_index {mark-whole-buffer-command} idx 27-24
+.silent_index {mark-word-command} idx 27-24
+.silent_index {move-backward-character-command} idx 27-25
+.silent_index {move-backward-defun-command} idx 27-25
+.silent_index {move-backward-form-command} idx 27-25
+.silent_index {move-backward-list-command} idx 27-25
+.silent_index {move-backward-word-command} idx 27-26
+.silent_index {move-down-command} idx 27-26
+.silent_index {move-down-extending-command} idx 27-26
+.silent_index {move-forward-character-command} idx 27-26
+.silent_index {move-forward-form-command} idx 27-27
+.silent_index {move-forward-list-command} idx 27-27
+.silent_index {move-forward-word-command} idx 27-27
+.silent_index {move-over-paren-command} idx 27-27
+.silent_index {move-to-buffer-end-command} idx 27-28
+.silent_index {move-to-buffer-start-command} idx 27-28
+.silent_index {move-to-end-of-line-command} idx 27-28
+.silent_index {move-to-screen-edge-command} idx 27-28
+.silent_index {move-to-start-of-line-command} idx 27-28
+.silent_index {move-up-command} idx 27-29
+.silent_index {negative-argument} idx 27-29
+.silent_index {next-screen-command} idx 27-29
+.silent_index {nmode-abort-command} idx 27-29
+.silent_index {nmode-exit-to-superior} idx 27-29
+.silent_index {nmode-full-refresh} idx 27-30
+.silent_index {nmode-gc} idx 27-30
+.silent_index {nmode-invert-video} idx 27-30
+.silent_index {nmode-refresh-command} idx 27-30
+.silent_index {one-window-command} idx 27-30
+.silent_index {open-line-command} idx 27-31
+.silent_index {other-window-command} idx 27-31
+.silent_index {prepend-to-file-command} idx 27-31
+.silent_index {previous-screen-command} idx 27-31
+.silent_index {put-register-command} idx 27-32
+.silent_index {query-replace-command} idx 27-32
+.silent_index {rename-buffer-command} idx 27-32
+.silent_index {replace-string-command} idx 27-33
+.silent_index {reposition-window-command} idx 27-33
+.silent_index {return-command} idx 27-33
+.silent_index {reverse-search-command} idx 27-33
+.silent_index {revert-file-command} idx 27-33
+.silent_index {save-all-files-command} idx 27-34
+.silent_index {save-file-command} idx 27-34
+.silent_index {scroll-other-window-command} idx 27-34
+.silent_index {scroll-window-down-line-command} idx 27-34
+.silent_index {scroll-window-down-page-command} idx 27-34
+.silent_index {scroll-window-left-command} idx 27-35
+.silent_index {scroll-window-right-command} idx 27-35
+.silent_index {scroll-window-up-line-command} idx 27-35
+.silent_index {scroll-window-up-page-command} idx 27-35
+.silent_index {select-buffer-command} idx 27-35
+.silent_index {select-previous-buffer-command} idx 27-36
+.silent_index {set-fill-column-command} idx 27-36
+.silent_index {set-fill-prefix-command} idx 27-36
+.silent_index {set-goal-column-command} idx 27-36
+.silent_index {set-key-command} idx 27-37
+.silent_index {set-mark-command} idx 27-37
+.silent_index {set-visited-filename-command} idx 27-37
+.silent_index {split-line-command} idx 27-37
+.silent_index {start-scripting-command} idx 27-38
+.silent_index {start-timing-command} idx 27-38
+.silent_index {stop-scripting-command} idx 27-38
+.silent_index {stop-timing-command} idx 27-38
+.silent_index {tab-to-tab-stop-command} idx 27-39
+.silent_index {text-mode-command} idx 27-39
+.silent_index {transpose-characters-command} idx 27-39
+.silent_index {transpose-forms} idx 27-39
+.silent_index {transpose-lines} idx 27-40
+.silent_index {transpose-regions} idx 27-40
+.silent_index {transpose-words} idx 27-40
+.silent_index {two-windows-command} idx 27-40
+.silent_index {undelete-file-command} idx 27-41
+.silent_index {universal-argument} idx 27-41
+.silent_index {unkill-previous} idx 27-41
+.silent_index {upcase-digit-command} idx 27-41
+.silent_index {uppercase-initial-command} idx 27-42
+.silent_index {uppercase-region-command} idx 27-42
+.silent_index {uppercase-word-command} idx 27-42
+.silent_index {view-two-windows-command} idx 27-42
+.silent_index {visit-file-command} idx 27-42
+.silent_index {visit-in-other-window-command} idx 27-43
+.silent_index {what-cursor-position-command} idx 27-43
+.silent_index {write-file-command} idx 27-43
+.silent_index {write-region-command} idx 27-43
+.silent_index {write-screen-command} idx 27-44
+.silent_index {yank-last-output-command} idx 27-44
ADDED psl-1983/3-1/doc/nmode/nm-commands.ibm
Index: psl-1983/3-1/doc/nmode/nm-commands.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-commands.ibm
@@ -0,0 +1,2184 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-COMMANDS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Command Descriptions) Page 27-1
+
+
+ 202/27. Command Descriptions
+
+ 201/This section defines the basic NMODE commands. Each command description
+ includes the following information:
+
+ 203/command 201/A descriptive name of the command.
+
+ 203/function 201/The name of the Lisp function that implements the command.
+
+ 203/key 201/The logical keys on the keyboard that normally have this command
+ attached to them. A 203/logical key 201/includes ordinary keys such as
+ Tab or Rubout, 203/shifted 201/keys using the 202/Control 201/and/or 202/Meta
+ 201/modifiers (e.g., C-F, M-F, and C-M-F), 203/prefixed commands 201/using
+ C-X, C-], or Escape (e.g., C-X C-F, C-] E, and Esc-L), and
+ 203/extended commands 201/using 202/Meta-X 201/(e.g., M-X Delete Matching
+ Lines).
+
+ 203/action type 201/One of a number of descriptive terms that categorize the behavior
+ of commands. Action types are defined in Chapter 24.
+
+ 203/mode 201/Some commands are defined only in certain modes. If present,
+ this attribute specifies the mode or modes in which the command
+ is normally defined.
+
+ 203/topic 201/A keyword that describes the command. Topics are listed in the
+ Topic Index, Chapter 30.
+ 201/Page 27-2 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Append Next Kill
+
+ 201/Function: append-next-kill-command
+ Key: C-M-W
+ See Global: Kill Ring
+ Action Type: Move Data
+
+ Make following kill commands append to last batch. Thus, C-K C-K, cursor
+ motion, this command, and C-K C-K, generate one block of killed stuff,
+ containing two lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Append To Buffer
+
+ 201/Function: append-to-buffer-command
+ Key: C-X A
+ Topic: Buffers
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to specified buffer. The buffer's name is read from the
+ keyboard; the buffer is created if nonexistent. A numeric argument causes
+ us to "prepend" instead. We always insert the text at that buffer's pointer,
+ but when "prepending" we leave the pointer before the inserted text.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Append To File
+
+ 201/Function: append-to-file-command
+ Key: M-X Append To File
+ Topic: Files
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to end of specified file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Apropos
+
+ 201/Function: apropos-command
+ Key: M-X Apropos
+ Key: Esc-_
+ Action Type: Inform
+
+ M-X Apropos lists functions with names containing a string for which the user
+ is prompted. The functions are displayed using a documentation browser,
+ which allows the user to view additional information on each function or
+ further filter the list of displayed functions by matching on addtional strings.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-3
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Argument Digit
+
+ 201/Function: argument-digit
+ Key: C-0
+ Key: C-1
+ Key: C-2
+ Key: C-3
+ Key: C-4
+ Key: C-5
+ Key: C-6
+ Key: C-7
+ Key: C-8
+ Key: C-9
+ Key: C-M-0
+ Key: C-M-1
+ Key: C-M-2
+ Key: C-M-3
+ Key: C-M-4
+ Key: C-M-5
+ Key: C-M-6
+ Key: C-M-7
+ Key: C-M-8
+ Key: C-M-9
+ Key: M-0
+ Key: M-1
+ Key: M-2
+ Key: M-3
+ Key: M-4
+ Key: M-5
+ Key: M-6
+ Key: M-7
+ Key: M-8
+ Key: M-9
+ Action Type: Subsequent Command Modifier
+
+ Specify numeric argument for next command. Several such digits typed in a
+ row all accumulate.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Auto Fill Mode
+
+ 201/Function: auto-fill-mode-command
+ Key: M-X Auto Fill Mode
+ See Command: Set Fill Column
+ Action Type: Change Mode
+
+ Break lines between words at the right margin. A positive argument turns
+ Auto Fill mode on; zero or negative, turns it off. With no argument, the
+ mode is toggled. When Auto Fill mode is on, lines are broken at spaces to fit
+ the right margin (position controlled by Fill Column). You can set the Fill
+ Column with the Set Fill Column command.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-4 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Back To Indentation
+
+ 201/Function: back-to-indentation-command
+ Key: C-M-M
+ Key: C-M-RETURN
+ Key: M-M
+ Key: M-RETURN
+ Action Type: Move Point
+
+ Move to end of this line's indentation.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Kill Sentence
+
+ 201/Function: backward-kill-sentence-command
+ Key: C-X RUBOUT
+ See Global: Kill Ring
+ See Definition: Sentence
+ Action Type: Remove
+
+ Kill back to beginning of sentence. With a command argument n kills
+ backward (n>0) or forward (n>0) by |n| sentences.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Paragraph
+
+ 201/Function: backward-paragraph-command
+ Key: M-[
+ See Definition: Paragraph
+ Action Type: Move Point
+
+ Move backward to start of paragraph. When given argument moves backward
+ (n>0) or forward (n<0) by |n| paragraphs where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Sentence
+
+ 201/Function: backward-sentence-command
+ Key: M-A
+ See Definition: Sentence
+ Action Type: Move Point
+
+ Move to beginning of sentence. When given argument moves backward (n>0)
+ or forward (n<0) by |n| sentences where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-5
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Backward Up List
+
+ 201/Function: backward-up-list-command
+ Key: C-(
+ Key: C-M-(
+ Key: C-M-U
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move up one level of list structure, backward. Given a command argument n
+ move up |n| levels backward (n>0) or forward (n<0).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Buffer Browser
+
+ 201/Function: buffer-browser-command
+ Key: C-X C-B
+ Key: M-X List Buffers
+ Topic: Buffers
+ Action Type: Inform
+
+ Put up a buffer browser subsystem. If an argument is given, then include
+ buffers whose names begin with "+".
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Buffer Not Modified
+
+ 201/Function: buffer-not-modified-command
+ Key: M-~
+ Topic: Buffers
+ Action Type: Set Global Variable
+
+ Pretend that this buffer hasn't been altered.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: C-X Prefix
+
+ 201/Function: c-x-prefix
+ Key: C-X
+ Action Type: Subsequent Command Modifier
+
+ The command Control-X is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-6 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Center Line
+
+ 201/Function: center-line-command
+ Key: M-S
+ Topic: Text
+ See Global: Fill Column
+ Action Type: Alter Existing Text
+
+ Center this line's text within the line. With argument, centers that many
+ lines and moves past. Centers current and preceding lines with negative
+ argument. The width is Fill Column.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Copy Region
+
+ 201/Function: copy-region
+ Key: M-W
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Preserve
+
+ Stick region into kill-ring without killing it. Like killing and getting back,
+ but doesn't mark buffer modified.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Count Occurrences
+
+ 201/Function: count-occurrences-command
+ Key: M-X Count Occurrences
+ Key: M-X How Many
+ Action Type: Inform
+
+ Counts occurrences of a string, after point. The user is prompted for the
+ string. Case is ignored in the count.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete And Expunge File
+
+ 201/Function: delete-and-expunge-file-command
+ Key: M-X Delete And Expunge File
+ Topic: Files
+ Action Type: Remove
+
+ This command prompts the user for the name of the file. NMODE will fill in
+ defaults in a partly specified filename (eg filetype can be defaulted). If
+ possible, the file will then be deleted and expunged, and a message to that
+ effect will be displayed. If the operation fails, the bell will sound.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-7
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Backward Character
+
+ 201/Function: delete-backward-character-command
+ Key: BACKSPACE
+ Key: RUBOUT
+ Mode: Text
+ Action Type: Remove
+
+ Delete character before point. With positive arguments this operation is
+ performed multiple times on the text before point. With negative arguments
+ this operation is performed multiple times on the text after point.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Backward Hacking Tabs
+
+ 201/Function: delete-backward-hacking-tabs-command
+ Key: BACKSPACE
+ Key: C-RUBOUT
+ Key: RUBOUT
+ Mode: Lisp
+ Action Type: Remove
+
+ Delete character before point, turning tabs into spaces. Rather than deleting
+ a whole tab, the tab is converted into the appropriate number of spaces and
+ then one space is deleted. With positive arguments this operation is
+ performed multiple times on the text before point. With negative arguments
+ this operation is performed multiple times on the text after point.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Blank Lines
+
+ 201/Function: delete-blank-lines-command
+ Key: C-X C-O
+ Action Type: Remove
+
+ Delete all blank lines around this line's end. If done on a non-blank line,
+ deletes all spaces and tabs at the end of it, and all following blank lines
+ (Lines are blank if they contain only spaces and tabs). If done on a blank
+ line, deletes all preceding blank lines as well.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete File
+
+ 201/Function: delete-file-command
+ Key: M-X Delete File
+ Key: M-X Kill File
+ Topic: Files
+ Action Type: Remove
+
+ Delete a file. Prompts for filename.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-8 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Forward Character
+
+ 201/Function: delete-forward-character-command
+ Key: C-D
+ Key: ESC-P
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Delete character after point. With argument, kill that many characters
+ (saving them). Negative args kill characters backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Horizontal Space
+
+ 201/Function: delete-horizontal-space-command
+ Key: M-\
+ Action Type: Remove
+
+ Delete all spaces and tabs around point.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Indentation
+
+ 201/Function: delete-indentation-command
+ Key: M-^
+ Action Type: Remove
+
+ Delete CRLF and indentation at front of line. Leaves one space in place of
+ them. With argument, moves down one line first (deleting CRLF after current
+ line).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Matching Lines
+
+ 201/Function: delete-matching-lines-command
+ Key: M-X Delete Matching Lines
+ Key: M-X Flush Lines
+ Action Type: Select
+ Action Type: Remove
+
+ Delete Matching Lines: Prompts user for string. Deletes all lines containing
+ specified string.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Delete Non-Matching Lines
+
+ 201/Function: delete-non-matching-lines-command
+ Key: M-X Delete Non-Matching Lines
+ Key: M-X Keep Lines
+ Action Type: Select
+ Action Type: Remove
+
+ Delete Non-Matching Lines: Prompts user for string. Deletes all lines not
+ containing specified string.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-9
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Dired
+
+ 201/Function: dired-command
+ Key: C-X D
+
+ Run Dired on the directory of the current buffer file. With no argument,
+ edits that directory. With an argument of 1, shows only the versions of the
+ file in the buffer. With an argument of 4, asks for input, only versions of
+ that file are shown.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Down List
+
+ 201/Function: down-list-command
+ Key: C-M-D
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move down one level of list structure, forward. In other words, move
+ forward past the next open bracket, unless there is in an intervening close
+ bracket. With a positive command argument, move forward down that many
+ levels. With a negative command argument, move backward down that many
+ levels.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Edit Directory
+
+ 201/Function: edit-directory-command
+ Key: M-X Dired
+ Key: M-X Edit Directory
+
+ DIRED: Edit a directory. The string argument may contain the filespec (with
+ wildcards of course)
+ D deletes the file which is on the current line. (also K,^D,^K)
+ U undeletes the current line file.
+ Rubout undeletes the previous line file.
+ Space is like ^N - moves down a line.
+ E edit the file.
+ S sorts files according to size, read or write date.
+ R does a reverse sort.
+ ? types a list of commands.
+ Q lists files to be deleted and asks for confirmation:
+ Typing YES deletes them; X aborts; N resumes DIRED.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-10 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: End Of Defun
+
+ 201/Function: end-of-defun-command
+ Key: C-M-E
+ Key: C-M-]
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Move Point
+
+ Move to end of this or next defun. With argument of 2, finds end of
+ following defun. With argument of -1, finds end of previous defun, etc.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Esc Prefix
+
+ 201/Function: esc-prefix
+ Key: ESCAPE
+ Action Type: Subsequent Command Modifier
+
+ The command esc-prefix is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it. Used for escape sequences
+ sent by function keys on the keyboard.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Exchange Point And Mark
+
+ 201/Function: exchange-point-and-mark
+ Key: C-X C-X
+ Action Type: Mark
+ Action Type: Move Point
+
+ Exchange positions of point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Exchange Windows
+
+ 201/Function: exchange-windows-command
+ Key: C-X E
+ Action Type: Alter Display Format
+
+ Exchanges the current window with the other window, which becomes current.
+ In two window mode, the windows swap physical positions.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute Buffer
+
+ 201/Function: execute-buffer-command
+ Key: M-X Execute Buffer
+ Topic: Buffers
+
+ This command makes NMODE take input from the specified buffer as if it were
+ typed in. This command supercedes any such previous request. Newline
+ characters are ignored when reading from a buffer. If a command argument
+ is given then only the last refresh of the screen triggered by the commands
+ actually occurs, otherwise all of the updating of the screen is visible.
+ 201/NMODE Manual (Command Descriptions) Page 27-11
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute Defun
+
+ 201/Function: execute-defun-command
+ Key: Lisp-D
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Mark
+
+ Causes the Lisp reader to read and evaluate the current defun. If there is
+ no current defin, the Lisp reader will read a form starting at the current
+ location. We arrange for output to go to the end of the output buffer. The
+ mark is set at the current location in the input buffer, in case user wants to
+ go back.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute File
+
+ 201/Function: execute-file-command
+ Key: M-X Execute File
+ Topic: Files
+
+ This command makes NMODE take input from the specified file as if it were
+ typed in. This command supercedes any such previous request. Newline
+ characters are ignored when reading from a buffer. If a command argument
+ is given then only the last refresh of the screen triggered by the commands
+ actually occurs, otherwise all of the updating of the screen is visible.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Execute Form
+
+ 201/Function: execute-form-command
+ Key: Lisp-E
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Mark
+
+ Causes the Lisp reader to read and evaluate a form starting at the beginning
+ of the current line. We arrange for output to go to the end of the output
+ buffer. The mark is set at the current location in the input buffer, in case
+ user wants to go back.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Exit Nmode
+
+ 201/Function: exit-nmode
+ Key: Lisp-L
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ Leave NMODE, return to normal listen loop.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-12 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Fill Comment
+
+ 201/Function: fill-comment-command
+ Key: M-Z
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ Action Type: Alter Existing Text
+
+ This command creates a temporary fill prefix from the start of the current
+ line. It replaces the surrounding paragraph (determined using fill-prefix)
+ with a filled version. It leaves point at the a position bearing the same
+ relation to the filled text that the old point did to the old text.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Fill Paragraph
+
+ 201/Function: fill-paragraph-command
+ Key: M-Q
+ Topic: Text
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ Action Type: Alter Existing Text
+
+ This fills (or justifies) this (or next) paragraph. It leaves point at the a
+ position bearing the same relation to the filled text that the old point did to
+ the old text. A numeric argument triggers justification rather than filling.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Fill Region
+
+ 201/Function: fill-region-command
+ Key: M-G
+ Topic: Text
+ See Command: Set Fill Column
+ See Command: Set Fill Prefix
+ See Global: Fill Prefix
+ See Global: Fill Column
+ See Definition: Paragraph
+ See Definition: Sentence
+ Action Type: Alter Existing Text
+
+ Fill text from point to mark. Fill Column specifies the desired text width.
+ Fill Prefix if present is a string that goes at the front of each line and is not
+ included in the filling. See Set Fill Column and Set Fill Prefix. An explicit
+ argument causes justification instead of filling. Each sentence which ends
+ within a line is followed by two spaces.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-13
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Find File
+
+ 201/Function: find-file-command
+ Key: C-X C-F
+ Key: M-X Find File
+ Topic: Files
+ Topic: Buffers
+ Action Type: Move Data
+ Action Type: Move Point
+
+ Visit a file in its own buffer. If the file is already in some buffer, select
+ that buffer. Otherwise, visit the file in a buffer named after the file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Forward Paragraph
+
+ 201/Function: forward-paragraph-command
+ Key: M-]
+ Topic: Text
+ See Definition: Paragraph
+ Action Type: Move Point
+
+ Move forward to end of this or the next paragraph. When given argument
+ moves forward (n>0) or backward (n<0) by |n| paragraphs where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Forward Sentence
+
+ 201/Function: forward-sentence-command
+ Key: M-E
+ Topic: Text
+ See Definition: Sentence
+ Action Type: Move Point
+
+ Move forward to end of this or the next sentence. When given argument
+ moves forward (n>0) or backward (n<0) by |n| sentences. where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Forward Up List
+
+ 201/Function: forward-up-list-command
+ Key: C-)
+ Key: C-M-)
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move up one level of list structure, forward. Given a command argument n
+ move up |n| levels forward (n>0) or backward (n<0).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-14 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Get Register
+
+ 201/Function: get-register-command
+ Key: C-X G
+ Action Type: Move Data
+ Action Type: Mark
+
+ Get contents of register (reads name from keyboard). The name is a single
+ letter or digit. Usually leaves the pointer before, and the mark after, the
+ text. With argument, puts point after and mark before.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Grow Window
+
+ 201/Function: grow-window-command
+ Key: C-X ^
+ Action Type: Alter Display Format
+
+ Make this window use more lines. Argument is number of extra lines (can be
+ negative).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Help Dispatch
+
+ 201/Function: help-dispatch
+ Key: C-?
+ Key: M-/
+ Key: M-?
+ Action Type: Inform
+
+ Prints the documentation of a command (not a function). The command
+ character is read from the terminal.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Incremental Search
+
+ 201/Function: incremental-search-command
+ Key: C-S
+ Action Type: Move Point
+ Action Type: Select
+
+ Search for character string as you type it. C-Q quotes special characters.
+ Rubout cancels last character. C-S repeats the search, forward, and C-R
+ repeats it backward. C-R or C-S with search string empty changes the
+ direction of search or brings back search string from previous search.
+ Altmode exits the search. Other Control and Meta chars exit the search and
+ then are executed. If not all the input string can be found, the rest is not
+ discarded. You can rub it out, discard it all with C-G, exit, or use C-R or
+ C-S to search the other way. Quitting a successful search aborts the search
+ and moves point back; quitting a failing search just discards whatever input
+ wasn't found.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-15
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Indent New line
+
+ 201/Function: indent-new-line-command
+ Key: NEWLINE
+ Action Type: Insert Constant
+
+ This function performs the following actions: Executes whatever function, if
+ any, is associated with <CR>. Executes whatever function, if any, is
+ associated with TAB, as if no command argument was given.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Indent Region
+
+ 201/Function: indent-region-command
+ Key: C-M-\
+ Mode: Text
+
+ Indent all lines between point and mark. With argument, indents each line to
+ exactly that column. A line is processed if its first character is in the
+ region. It tries to preserve the textual context of point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Buffer
+
+ 201/Function: insert-buffer-command
+ Key: M-X Insert Buffer
+ Topic: Buffers
+ Action Type: Move Data
+
+ Insert contents of another buffer into existing text. The user is prompted
+ for the buffer name. Point is left just before the inserted material, and mark
+ is left just after it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Closing bracket
+
+ 201/Function: insert-closing-bracket
+ Key: )
+ Key: ]
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Insert the character typed, which should be a closing bracket, then display
+ the matching opening bracket.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-16 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Comment
+
+ 201/Function: insert-comment-command
+ Key: M-;
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Move to the end of the current line, then add a "%" and a space at its end.
+ Leave point after the space.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Date
+
+ 201/Function: insert-date-command
+ Key: M-X Insert Date
+ Action Type: Move Data
+
+ Insert the current time and date after point. The mark is put after the
+ inserted text.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert File
+
+ 201/Function: insert-file-command
+ Key: M-X Insert File
+ Topic: Files
+ Action Type: Move Data
+
+ Insert contents of file into existing text. File name is string argument. The
+ pointer is left at the beginning, and the mark at the end.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Kill Buffer
+
+ 201/Function: insert-kill-buffer
+ Key: C-Y
+ See Global: Kill Ring
+ Action Type: Move Data
+ Action Type: Mark
+
+ Re-insert the last stuff killed. Puts point after it and the mark before it.
+ An argument n says un-kill the n'th most recent string of killed stuff (1 =
+ most recent). A null argument (just C-U) means leave point before, mark
+ after.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-17
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Insert Next Character
+
+ 201/Function: insert-next-character-command
+ Key: C-Q
+ Action Type: Move Data
+
+ Reads a character and inserts it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Backward Form
+
+ 201/Function: kill-backward-form-command
+ Key: C-M-RUBOUT
+ Mode: Lisp
+ Topic: Lisp
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the last form. With a command argument kill the last (n>0) or next (n<0)
+ |n| forms, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Backward Word
+
+ 201/Function: kill-backward-word-command
+ Key: M-RUBOUT
+ Topic: Text
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill last word. With a command argument kill the last (n>0) or next (n<0)
+ |n| words, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Buffer
+
+ 201/Function: kill-buffer-command
+ Key: C-X K
+ Key: M-X Kill Buffer
+ Topic: Buffers
+ Action Type: Remove
+
+ Kill the buffer with specified name. The buffer name is taken from the
+ keyboard. Name completion is performed by SPACE and RETURN. If the
+ buffer has changes in it, the user is asked for confirmation.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-18 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Forward Form
+
+ 201/Function: kill-forward-form-command
+ Key: C-M-K
+ Mode: Lisp
+ Topic: Lisp
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the next form. With a command argument kill the next (n>0) or last
+ (n<0) |n| forms, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Forward Word
+
+ 201/Function: kill-forward-word-command
+ Key: M-D
+ Topic: Text
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill the next word. With a command argument kill the next (n>0) or last
+ (n<0) |n| words, where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Line
+
+ 201/Function: kill-line
+ Key: C-K
+ Key: ESC-M
+ See Global: Kill Ring
+ Action Type: Remove
+
+ Kill to end of line, or kill an end of line. At the end of a line (only blanks
+ following) kill through the CRLF. Otherwise, kill the rest of the line but not
+ the CRLF. With argument (positive or negative), kill specified number of
+ lines forward or backward respectively. An argument of zero means kill to
+ the beginning of the ine, nothing if at the beginning. Killed text is pushed
+ onto the kill ring for retrieval.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Region
+
+ 201/Function: kill-region
+ Key: C-W
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Remove
+
+ Kill from point to mark. Use Control-Y and Meta-Y to get it back.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-19
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Sentence
+
+ 201/Function: kill-sentence-command
+ Key: M-K
+ Topic: Text
+ See Global: Kill Ring
+ See Definition: Sentence
+ Action Type: Remove
+
+ Kill forward to end of sentence. With minus one as an argument it kills back
+ to the beginning of the sentence. Positive or negative arguments mean to kill
+ that many sentences forward or backward respectively.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Kill Some Buffers
+
+ 201/Function: kill-some-buffers-command
+ Key: M-X Kill Some Buffers
+ Topic: Buffers
+ Action Type: Remove
+
+ Kill Some Buffers: Offer to kill each buffer, one by one. If the buffer
+ contains a modified file and you say to kill it, you are asked for confirmation.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Abort
+
+ 201/Function: lisp-abort-command
+ Key: Lisp-A
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This command will pop out of an arbitrarily deep break loop.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Backtrace
+
+ 201/Function: lisp-backtrace-command
+ Key: Lisp-B
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Inform
+
+ This lists all the function calls on the stack. It is a good way to see how the
+ offending expression got generated.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-20 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Continue
+
+ 201/Function: lisp-continue-command
+ Key: Lisp-C
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This causes the expression last printed to be returned as the value of the
+ offending expression. This allows a user to recover from a low level error in
+ an involved calculation if they know what should have been returned by the
+ offending expression. This is also often useful as an automatic stub: If an
+ expression containing an undefined function is evaluated, a Break loop is
+ entered, and this may be used to return the value of the function call.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Help
+
+ 201/Function: lisp-help-command
+ Key: Lisp-?
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Inform
+
+ If in break print:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+ else print:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp
+ Listener"
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Indent Region
+
+ 201/Function: lisp-indent-region-command
+ Key: C-M-\
+ Mode: Lisp
+ Topic: Lisp
+
+ Indent all lines between point and mark. With argument, indents each line to
+ exactly that column. Otherwise, lisp indents each line. A line is processed
+ if its first character is in the region. It tries to preserve the textual
+ context of point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Indent sexpr
+
+ 201/Function: lisp-indent-sexpr
+ Key: C-M-Q
+ Mode: Lisp
+ Topic: Lisp
+
+ Lisp Indent each line contained in the next form. This command does NOT
+ respond to command arguments.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-21
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Mode
+
+ 201/Function: lisp-mode-command
+ Key: M-X Lisp Mode
+ Topic: Lisp
+ Action Type: Change Mode
+
+ Set things up for editing Lisp code. Tab indents for Lisp. Rubout hacks
+ tabs. Lisp execution commands availible. Paragraphs are delimited only by
+ blank lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Prefix
+
+ 201/Function: lisp-prefix
+ Key: C-]
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Subsequent Command Modifier
+
+ The command lisp-prefix is an escape-prefix for more commands. It reads a
+ character (subcommand) and dispatches on it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Quit
+
+ 201/Function: lisp-quit-command
+ Key: Lisp-Q
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This exits the current break loop. It only pops up one level, unlike abort.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Retry
+
+ 201/Function: lisp-retry-command
+ Key: Lisp-R
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Escape
+
+ This tries to evaluate the offending expression again, and to continue the
+ computation. This is often useful after defining a missing function, or
+ assigning a value to a variable.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-22 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lisp Tab
+
+ 201/Function: lisp-tab-command
+ Key: C-M-I
+ Key: C-M-TAB
+ Key: TAB
+ Mode: Lisp
+ Topic: Lisp
+ See Command: Tab To Tab Stop
+ Action Type: Alter Existing Text
+
+ Indent this line for a Lisp-like language. With arg, moves over and indents
+ that many lines. With negative argument, indents preceding lines.
+ Note that the binding of TAB to this function holds only in Lisp mode. In
+ text mode TAB is bound to the Tab To Tab Stop command and the other keys
+ bound to this function are undefined.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lowercase Region
+
+ 201/Function: lowercase-region-command
+ Key: C-X C-L
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Convert region to lower case.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Lowercase Word
+
+ 201/Function: lowercase-word-command
+ Key: M-L
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Convert one word to lower case, moving past it. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: M-X Prefix
+
+ 201/Function: m-x-prefix
+ Key: C-M-X
+ Key: M-X
+ Action Type: Subsequent Command Modifier
+
+ Read an extended command from the terminal with completion. Completion is
+ performed by SPACE and RETURN. This command reads the name of an
+ extended command, with completion, then executes that command. The
+ command may itself prompt for input.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-23
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Make Parens
+
+ 201/Function: make-parens-command
+ Key: M-(
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Insert Constant
+
+ Insert () putting point after the (. Also make a space before the (, if
+ appropriate. With argument, put the ) after the specified number of already
+ existing forms. Thus, with argument 1, puts extra parens around the
+ following form.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Beginning
+
+ 201/Function: mark-beginning-command
+ Key: C-<
+ Action Type: Mark
+
+ Set mark at beginning of buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Defun
+
+ 201/Function: mark-defun-command
+ Key: C-M-BACKSPACE
+ Key: C-M-H
+ Key: M-BACKSPACE
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Mark
+
+ Put point and mark around this defun (or next).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark End
+
+ 201/Function: mark-end-command
+ Key: C->
+ Action Type: Mark
+
+ Set mark at end of buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-24 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Form
+
+ 201/Function: mark-form-command
+ Key: C-M-@
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Mark
+
+ Set mark after (n>0) or before (n<0) |n| forms from point where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Paragraph
+
+ 201/Function: mark-paragraph-command
+ Key: M-H
+ Topic: Text
+ See Definition: Paragraph
+ Action Type: Mark
+ Action Type: Move Point
+
+ Put point and mark around this paragraph. In between paragraphs, puts it
+ around the next one.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Whole Buffer
+
+ 201/Function: mark-whole-buffer-command
+ Key: C-X H
+ Action Type: Mark
+ Action Type: Move Point
+
+ Set point at beginning and mark at end of buffer. Pushes the old point on
+ the mark first, so two pops restore it.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Mark Word
+
+ 201/Function: mark-word-command
+ Key: M-@
+ Topic: Text
+ Action Type: Mark
+
+ Set mark after (n>0) or before (n<0) |n| words from point where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-25
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Character
+
+ 201/Function: move-backward-character-command
+ Key: C-B
+ Key: ESC-D
+ Action Type: Move Point
+
+ Move back one character. With argument, move that many characters
+ backward. Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Defun
+
+ 201/Function: move-backward-defun-command
+ Key: C-M-A
+ Key: C-M-[
+ Mode: Lisp
+ Topic: Lisp
+ See Definition: Defun
+ Action Type: Move Point
+
+ Move to beginning of this or previous defun. With a negative argument,
+ moves forward to the beginning of a defun.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Form
+
+ 201/Function: move-backward-form-command
+ Key: C-M-B
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move back one form. With argument, move that many forms backward.
+ Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward List
+
+ 201/Function: move-backward-list-command
+ Key: C-M-P
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move back one list. With argument, move that many lists backward.
+ Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-26 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Backward Word
+
+ 201/Function: move-backward-word-command
+ Key: ESC-4
+ Key: M-B
+ Topic: Text
+ Action Type: Move Point
+
+ Move back one word. With argument, move that many words backward.
+ Negative arguments move forward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Down
+
+ 201/Function: move-down-command
+ Key: ESC-B
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move point down a line. If a command argument n is given, move point down
+ (n>0) or up (n<0) by |n| lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Down Extending
+
+ 201/Function: move-down-extending-command
+ Key: C-N
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move down vertically to next line. If given an argument moves down (n>0)
+ or up (n<0) |n| lines where n is the command argument. If given without an
+ argument after the last LF in the buffer, makes a new one at the end.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward Character
+
+ 201/Function: move-forward-character-command
+ Key: C-F
+ Key: ESC-C
+ Action Type: Move Point
+
+ Move forward one character. With argument, move that many characters
+ forward. Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-27
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward Form
+
+ 201/Function: move-forward-form-command
+ Key: C-M-F
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward one form. With argument, move that many forms forward.
+ Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward List
+
+ 201/Function: move-forward-list-command
+ Key: C-M-N
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward one list. With argument, move that many lists forward.
+ Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Forward Word
+
+ 201/Function: move-forward-word-command
+ Key: ESC-5
+ Key: M-F
+ Topic: Text
+ Action Type: Move Point
+
+ Move forward one word. With argument, move that many words forward.
+ Negative args move backward.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Over Paren
+
+ 201/Function: move-over-paren-command
+ Key: M-)
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Point
+
+ Move forward past the next closing bracket. If a positive command argument
+ is given, move forward past that many closing brackets. Delete all
+ indentation before the first closing bracket passed. After the last closing
+ bracket passed, insert an end-of-line and then indent the new line according
+ to Lisp.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-28 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Buffer End
+
+ 201/Function: move-to-buffer-end-command
+ Key: ESC-F
+ Key: M->
+ Action Type: Move Point
+
+ Go to end of buffer (leaving mark behind).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Buffer Start
+
+ 201/Function: move-to-buffer-start-command
+ Key: ESC-H
+ Key: M-<
+ Action Type: Move Point
+
+ Go to beginning of buffer (leaving mark behind).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To End Of Line
+
+ 201/Function: move-to-end-of-line-command
+ Key: C-E
+ Action Type: Move Point
+
+ Move point to end of line. With positive argument n goes down n-1 lines,
+ then to the end of line. With zero argument goes up a line, then to line
+ end. With negative argument n goes up |n|+1 lines, then to the end of line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Screen Edge
+
+ 201/Function: move-to-screen-edge-command
+ Key: M-R
+ Action Type: Move Point
+
+ Jump to top or bottom of screen. Like Control-L except that point is
+ changed instead of the window. With no argument, jumps to the center. An
+ argument specifies the number of lines from the top, (negative args count
+ from the bottom).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move To Start Of Line
+
+ 201/Function: move-to-start-of-line-command
+ Key: C-A
+ Action Type: Move Point
+
+ Move point to beginning of line. With positive argument n goes down n-1
+ lines, then to the beginning of line. With zero argument goes up a line, then
+ to line beginning. With negative argument n goes up |n|+1 lines, then to the
+ beginning of line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-29
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Move Up
+
+ 201/Function: move-up-command
+ Key: C-P
+ Key: ESC-A
+ See Global: Goal Column
+ Action Type: Move Point
+
+ Move up vertically to next line. If given an argument moves up (n>0) or
+ down (n<0) |n| lines where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Negative Argument
+
+ 201/Function: negative-argument
+ Key: C--
+ Key: C-M--
+ Key: M--
+ Action Type: Subsequent Command Modifier
+
+ Make argument to next command negative.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Next Screen
+
+ 201/Function: next-screen-command
+ Key: C-V
+ Action Type: Move Point
+
+ Move down to display next screenful of text. With argument, moves window
+ down <arg> lines (negative moves up). Just minus as an argument moves up
+ a full screen.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Abort
+
+ 201/Function: nmode-abort-command
+ Key: C-G
+ Action Type: Escape
+
+ This command provides a way of aborting input requests.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Exit To Superior
+
+ 201/Function: nmode-exit-to-superior
+ Key: C-X C-Z
+ Action Type: Escape
+
+ Go back to EMACS's superior job.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-30 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Full Refresh
+
+ 201/Function: nmode-full-refresh
+ Key: ESC-J
+ Action Type: Alter Display Format
+
+ This function refreshes the screen after first clearing the display. It it used
+ when the state of the display is in doubt.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Gc
+
+ 201/Function: nmode-gc
+ Key: M-X Make Space
+
+ Reclaims any internal wasted space.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Invert Video
+
+ 201/Function: nmode-invert-video
+ Key: C-X V
+ Action Type: Alter Display Format
+
+ Toggle between normal and inverse video.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Nmode Refresh
+
+ 201/Function: nmode-refresh-command
+ Key: C-L
+ Action Type: Alter Display Format
+
+ Choose new window putting point at center, top or bottom. With no
+ argument, chooses a window to put point at the center. An argument gives
+ the line to put point on; negative args count from the bottom.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: One Window
+
+ 201/Function: one-window-command
+ Key: C-X 1
+ Action Type: Alter Display Format
+
+ Display only one window. Normally, we display what used to be in the top
+ window, but a numeric argument says to display what was in the bottom one.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-31
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Open Line
+
+ 201/Function: open-line-command
+ Key: C-O
+ Key: ESC-L
+ Action Type: Insert Constant
+
+ Insert a CRLF after point. Differs from ordinary insertion in that point
+ remains before the inserted characters. With positive argument, inserts
+ several CRLFs. With negative argument does nothing.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Other Window
+
+ 201/Function: other-window-command
+ Key: C-X O
+ Action Type: Alter Display Format
+ Action Type: Move Point
+
+ Switch to the other window. In two-window mode, moves cursor to other
+ window. In one-window mode, exchanges contents of visible window with
+ remembered contents of (invisible) window two. An argument means switch
+ windows but select the same buffer in the other window.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Prepend To File
+
+ 201/Function: prepend-to-file-command
+ Key: M-X Prepend To File
+ Topic: Files
+ See Definition: Region
+ Action Type: Move Data
+
+ Append region to start of specified file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Previous Screen
+
+ 201/Function: previous-screen-command
+ Key: M-V
+ Action Type: Move Point
+
+ Move up to display previous screenful of text. When an argument is present,
+ move the window back (n>0) or forward (n<0) |n| lines, where n is the
+ command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-32 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Put Register
+
+ 201/Function: put-register-command
+ Key: C-X X
+ Action Type: Preserve
+
+ Put point to mark into register (reads name from keyboard). With an
+ argument, the text is also deleted.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Query Replace
+
+ 201/Function: query-replace-command
+ Key: M-%
+ Key: M-X Query Replace
+ Action Type: Alter Existing Text
+ Action Type: Select
+
+ Replace occurrences of a string from point to the end of the buffer, asking
+ about each occurrence. Query Replace prompts for the string to be replaced
+ and for its potential replacement. Query Replace displays each occurrence of
+ the string to be replaced, you then type a character to say what to do.
+ Space => replace it with the potential replacement and show the next copy.
+ Rubout or Backspace => don't replace, but show next copy. Comma =>
+ replace this copy and show result, waiting for next command. ^ => return to
+ site of previous copy. C-L => redisplay screen. Exclamation mark => replace
+ all remaining copys without asking. Period => replace this copy and exit.
+ Escape => just exit. Anything else exits and is reread.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Rename Buffer
+
+ 201/Function: rename-buffer-command
+ Key: M-X Rename Buffer
+ Topic: Buffers
+ Action Type: Set Global Variable
+
+ Change the name of the current buffer. The new name is read from the
+ keyboard. If the user provides an empty string, the buffer name will be set
+ to a truncated version of the filename associated with the buffer. The buffer
+ name is automatically converted to upper case. An error is reported if the
+ user provides the name of another existing buffer. The buffers MAIN and
+ OUTPUT may not be renamed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-33
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Replace String
+
+ 201/Function: replace-string-command
+ Key: C-%
+ Key: M-X Replace String
+ Action Type: Alter Existing Text
+ Action Type: Select
+
+ Replace string with another from point to buffer end.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Reposition Window
+
+ 201/Function: reposition-window-command
+ Key: C-M-R
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Alter Display Format
+
+ Reposition screen window appropriately. Tries to get all of current defun on
+ screen. Never moves the pointer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Return
+
+ 201/Function: return-command
+ Key: RETURN
+ Action Type: Insert Constant
+
+ Insert CRLF, or move onto empty line. Repeated by positive argument. No
+ action with negative argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Reverse Search
+
+ 201/Function: reverse-search-command
+ Key: C-R
+ See Command: Incremental Search
+ Action Type: Move Point
+ Action Type: Select
+
+ Incremental Search Backwards. Like Control-S but in reverse.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Revert File
+
+ 201/Function: revert-file-command
+ Key: M-X Revert File
+ Topic: Files
+ Action Type: Remove
+
+ Undo changes to a file. Reads back the file being edited from disk
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-34 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Save All Files
+
+ 201/Function: save-all-files-command
+ Key: M-X Save All Files
+ Topic: Buffers
+ Topic: Files
+ Action Type: Preserve
+
+ Offer to write back each buffer which may need it. For each buffer which is
+ visiting a file and which has been modified, you are asked whether to save
+ it. A numeric arg means don't ask; save everything.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Save File
+
+ 201/Function: save-file-command
+ Key: C-X C-S
+ Topic: Files
+ Action Type: Preserve
+
+ Save visited file on disk if modified.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Other Window
+
+ 201/Function: scroll-other-window-command
+ Key: C-M-V
+ Action Type: Alter Display Format
+
+ Scroll other window up several lines. Specify the number as a numeric
+ argument, negative for down. The default is a whole screenful up. Just
+ Meta-Minus as argument means scroll a whole screenful down.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Down Line
+
+ 201/Function: scroll-window-down-line-command
+ Key: ESC-T
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window down (n > 0) or up (n < 0) by |n| lines
+ where n is the command argument. The "window position" may be adjusted to
+ keep it within the window. Ding if the window contents does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Down Page
+
+ 201/Function: scroll-window-down-page-command
+ Key: ESC-V
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window down (n > 0) or up (n < 0) by |n|
+ screenfuls where n is the command argument. The "window position" may be
+ adjusted to keep it within the window. Ding if the window contents does not
+ move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-35
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Left
+
+ 201/Function: scroll-window-left-command
+ Key: C-X <
+ Action Type: Alter Display Format
+
+ Scroll the contents of the specified window right (n > 0) or left (n < 0) by
+ |n| columns where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Right
+
+ 201/Function: scroll-window-right-command
+ Key: C-X >
+ Action Type: Alter Display Format
+
+ Scroll the contents of the specified window left (n > 0) or right (n < 0) by
+ |n| columns where n is the command argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Up Line
+
+ 201/Function: scroll-window-up-line-command
+ Key: ESC-S
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines
+ where n is the command argument. The "window position" may be adjusted to
+ keep it within the window. Ding if the window contents does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Scroll Window Up Page
+
+ 201/Function: scroll-window-up-page-command
+ Key: ESC-U
+ Action Type: Alter Display Format
+
+ Scroll the contents of the window up (n > 0) or down (n < 0) by |n|
+ screenfuls where n is the command argument. The "window position" may be
+ adjusted to keep it within the window. Ding if the window contents does not
+ move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Select Buffer
+
+ 201/Function: select-buffer-command
+ Key: C-X B
+ Key: M-X Select Buffer
+ Topic: Buffers
+ Action Type: Move Point
+
+ Select or create buffer with specified name. Buffer name is read from
+ keyboard. Name completion is performed by SPACE and RETURN.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-36 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Select Previous Buffer
+
+ 201/Function: select-previous-buffer-command
+ Key: C-M-L
+ Topic: Buffers
+ Action Type: Move Point
+
+ Select the previous buffer of the current buffer, if it exists and is
+ selectable. Otherwise, select the MAIN buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Fill Column
+
+ 201/Function: set-fill-column-command
+ Key: C-X F
+ See Global: Fill Column
+ Action Type: Set Global Variable
+
+ Set fill column to numeric arg or current column. If there is an argument,
+ that is used. Otherwise, the current position of the cursor is used. The
+ Fill Column variable controls where Auto Fill mode and the fill commands put
+ the right margin.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Fill Prefix
+
+ 201/Function: set-fill-prefix-command
+ Key: C-X .
+ See Global: Fill Prefix
+ Action Type: Set Global Variable
+
+ Defines Fill Prefix from current line. All of the current line up to point
+ becomes the value of Fill Prefix. Auto Fill Mode inserts the prefix on each
+ line; the Fill Paragraph command assumes that each non-blank line starts
+ with the prefix (which is ignored for filling purposes). To stop using a Fill
+ Prefix, do Control-X . at the front of a line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Goal Column
+
+ 201/Function: set-goal-column-command
+ Key: C-X C-N
+ Action Type: Set Global Variable
+
+ Set (or flush) a permanent goal for vertical motion. With no argument, makes
+ the current column the goal for vertical motion commands. They will always
+ try to go to that column. With argument, clears out any previously set goal.
+ Only Control-P and Control-N are affected.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-37
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Key
+
+ 201/Function: set-key-command
+ Key: M-X Set Key
+ Action Type: Set Global Variable
+
+ Put a function on a key. The function name is a string argument. The key
+ is always read from the terminal (not a string argument). It may contain
+ metizers and other prefix characters.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Mark
+
+ 201/Function: set-mark-command
+ Key: C-@
+ Key: C-SPACE
+ Action Type: Mark
+
+ Sets or pops the mark. With no ^U's, pushes point as the mark. With one
+ ^U, pops the mark into point. With two ^U's, pops the mark and throws it
+ away.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Set Visited Filename
+
+ 201/Function: set-visited-filename-command
+ Key: M-X Set Visited Filename
+ Topic: Files
+ Action Type: Set Global Variable
+
+ Change visited filename, without writing or reading any file. The user is
+ prompted for a filename. What NMODE believes to be the name of the visited
+ file associated with the current buffer is set from the user's input. No file's
+ name is actually changed. If possible, the new name will be adjusted to
+ reflect an actual file name, as if the specified file were visited.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Split Line
+
+ 201/Function: split-line-command
+ Key: C-M-O
+ Action Type: Insert Constant
+
+ Move rest of this line vertically down. Inserts a CRLF, and then enough
+ tabs/spaces so that what had been the rest of the current line is indented as
+ much as it had been. Point does not move, except to skip over indentation
+ that originally followed it. With positive argument, makes extra blank lines in
+ between. No action with negative argument.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-38 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Start Scripting
+
+ 201/Function: start-scripting-command
+ Key: M-X Start Scripting
+ Action Type: Change Mode
+
+ This function prompts the user for a buffer name, into which it will copy all
+ the user's commands (as well as executing them) until the
+ stop-scripting-command is invoked. This command supercedes any such
+ previous request. Note that to keep the lines of reasonable length, free
+ Newlines will be inserted from time to time. Because of this, and because
+ many file systems cannot represent stray Newlines, the Newline character is
+ itself scripted as a CR followed by a TAB, since this is its normal definition.
+ Someday, perhaps, this hack will be replaced by a better one.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Start Timing
+
+ 201/Function: start-timing-command
+ Key: M-X Start Timing Nmode
+ Action Type: Change Mode
+
+ This cleans up a number of global variables associated with timing, prompts
+ for a file in which to put the timing data (or defaults to a file named
+ "timing", of type "txt"), and starts the timing. Information is collected on
+ the total time, refresh time, read time, command execution time, total number
+ of cons cells built, and total number of garbage collections performed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Stop Scripting
+
+ 201/Function: stop-scripting-command
+ Key: M-X Stop Scripting
+ Action Type: Change Mode
+
+ This command stops the echoing of user commands into a script buffer. This
+ command is itself echoed before the creation of the script stops.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Stop Timing
+
+ 201/Function: stop-timing-command
+ Key: M-X Stop Timing Nmode
+ Action Type: Change Mode
+
+ This stops the timing, formats the output data, and closes the file into which
+ the timing information is going. Information is collected on the total time,
+ refresh time, read time, command execution time, total number of cons cells
+ built, and total number of garbage collections performed. In addition to
+ these numbers, some ratios are printed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-39
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Tab To Tab Stop
+
+ 201/Function: tab-to-tab-stop-command
+ Key: M-I
+ Key: M-TAB
+ Key: TAB
+ See Command: Lisp Tab
+ Action Type: Insert Constant
+
+ Insert a tab character. Note that the binding of TAB to this command only
+ holds in text mode, not in lisp mode, where it is bound to the Lisp Tab
+ command. In lisp mode, the other keys continue to be bound to this command.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Text Mode
+
+ 201/Function: text-mode-command
+ Key: M-X Text Mode
+ Topic: Text
+ Action Type: Change Mode
+
+ Set things up for editing English text. Tab inserts tab characters. There
+ are no comments. Auto Fill does not indent new lines.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Characters
+
+ 201/Function: transpose-characters-command
+ Key: C-T
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the characters before and after the cursor. For more details, see
+ Meta-T, reading "character" for "word". However: at the end of a line, with
+ no argument, the preceding two characters are transposed.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Forms
+
+ 201/Function: transpose-forms
+ Key: C-M-T
+ Mode: Lisp
+ Topic: Lisp
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the forms before and after the cursor. For more details, see
+ Meta-T, reading "Form" for "Word".
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-40 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Lines
+
+ 201/Function: transpose-lines
+ Key: C-X C-T
+ See Command: Transpose Words
+ Action Type: Alter Existing Text
+
+ Transpose the lines before and after the cursor. For more details, see
+ Meta-T, reading "Line" for "Word".
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Regions
+
+ 201/Function: transpose-regions
+ Key: C-X T
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Transpose regions defined by cursor and last 3 marks. To transpose two
+ non-overlapping regions, set the mark successively at three of the four
+ boundaries, put point at the fourth, and call this function.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Transpose Words
+
+ 201/Function: transpose-words
+ Key: M-T
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Transpose the words before and after the cursor. With a positive argument
+ it transposes the words before and after the cursor, moves right, and
+ repeats the specified number of times, dragging the word to the left of the
+ cursor right. With a negative argument, it transposes the two words to the
+ left of the cursor, moves between them, and repeats the specified number of
+ times, exactly undoing the positive argument form. With a zero argument, it
+ transposes the words at point and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Two Windows
+
+ 201/Function: two-windows-command
+ Key: C-X 2
+ Action Type: Alter Display Format
+
+ Show two windows and select window two. An argument > 1 means give
+ window 2 the same buffer as in Window 1.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-41
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Undelete File
+
+ 201/Function: undelete-file-command
+ Key: M-X Undelete File
+ Topic: Files
+ Action Type: Move Data
+ Action Type: Preserve
+
+ This command prompts the user for the name of the file. NMODE will fill in a
+ partly specified filename (eg filetype can be defaulted). If possible, the file
+ will then be undeleted, and a message to that effect will be displayed. If the
+ operation fails, the bell will sound.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Universal Argument
+
+ 201/Function: universal-argument
+ Key: C-U
+ Action Type: Subsequent Command Modifier
+
+ Sets argument or multiplies it by four. Followed by digits, uses them to
+ specify the argument for the command after the digits. If not followed by
+ digits, multiplies the argument by four.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Unkill Previous
+
+ 201/Function: unkill-previous
+ Key: M-Y
+ See Global: Kill Ring
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Delete (without saving away) the current region, and then unkill (yank) the
+ specified entry in the kill ring. "Ding" if the current region does not
+ contain the same text as the current entry in the kill ring. If one has just
+ retrieved the top entry from the kill ring this has the effect of displaying the
+ item just beneath it, then the item beneath that and so on until the original
+ top entry rotates back into view.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Upcase Digit
+
+ 201/Function: upcase-digit-command
+ Key: M-'
+ Action Type: Alter Existing Text
+
+ Convert last digit to shifted character. Looks on current line back from
+ point, and previous line. The first time you use this command, it asks you
+ to type the row of digits from 1 to 9 and then 0, holding down Shift, to
+ determine how your keyboard is set up.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-42 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Uppercase Initial
+
+ 201/Function: uppercase-initial-command
+ Key: M-C
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Put next word in lower case, but capitalize initial. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Uppercase Region
+
+ 201/Function: uppercase-region-command
+ Key: C-X C-U
+ See Definition: Region
+ Action Type: Alter Existing Text
+
+ Convert region to upper case.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Uppercase Word
+
+ 201/Function: uppercase-word-command
+ Key: M-U
+ Topic: Text
+ Action Type: Alter Existing Text
+
+ Convert one word to upper case, moving past it. With arg, applies to that
+ many words backward or forward. If backward, the cursor does not move.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: View Two Windows
+
+ 201/Function: view-two-windows-command
+ Key: C-X 3
+ Action Type: Alter Display Format
+
+ Show two windows but stay in first.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Visit File
+
+ 201/Function: visit-file-command
+ Key: C-X C-V
+ Key: M-X Visit File
+ Topic: Files
+ Action Type: Move Data
+ Action Type: Move Point
+
+ Visit new file in current buffer. The user is prompted for the filename. If
+ the current buffer is modified, the user is asked whether to write it out.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/NMODE Manual (Command Descriptions) Page 27-43
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Visit In Other Window
+
+ 201/Function: visit-in-other-window-command
+ Key: C-X 4
+ Topic: Files
+ Topic: Buffers
+ Action Type: Move Point
+ Action Type: Alter Display Format
+
+ Find buffer or file in other window. Follow this command by B and a buffer
+ name, or by F and a file name. We find the buffer or file in the other
+ window, creating the other window if necessary.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: What Cursor Position
+
+ 201/Function: what-cursor-position-command
+ Key: C-=
+ Key: C-X =
+ Action Type: Inform
+
+ Print various things about where cursor is. Print the X position, the Y
+ position, the octal code for the following character, point absolutely and as a
+ percentage of the total file size, and the virtual boundaries, if any. If a
+ positive argument is given point will jump to the line number specified by the
+ argument. A negative argument triggers a jump to the first line in the
+ buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Write File
+
+ 201/Function: write-file-command
+ Key: C-X C-W
+ Key: M-X Write File
+ Topic: Files
+ Action Type: Preserve
+
+ Prompts for file name. Stores the current buffer in specified file. This file
+ becomes the one being visited.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Write Region
+
+ 201/Function: write-region-command
+ Key: M-X Write Region
+ Topic: Files
+ See Definition: Region
+ Action Type: Preserve
+
+ Write region to file. Prompts for file name.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 201/Page 27-44 NMODE Manual (Command Descriptions)
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Write Screen
+
+ 201/Function: write-screen-command
+ Key: C-X P
+ Topic: Files
+ Action Type: Preserve
+
+ Ask for filename, write out the screen to the file.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Command: Yank Last Output
+
+ 201/Function: yank-last-output-command
+ Key: Lisp-Y
+ Mode: Lisp
+ Topic: Lisp
+ Action Type: Move Data
+
+ Insert "last output" typed in the OUTPUT buffer.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
ADDED psl-1983/3-1/doc/nmode/nm-commands.key
Index: psl-1983/3-1/doc/nmode/nm-commands.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-commands.key
@@ -0,0 +1,252 @@
+.silent_index {C-M-W} idx 27-2
+.silent_index {C-X A} idx 27-2
+.silent_index {M-X Append To File} idx 27-2
+.silent_index {M-X Apropos} idx 27-2
+.silent_index {Esc-_} idx 27-2
+.silent_index {C-0} idx 27-3
+.silent_index {C-1} idx 27-3
+.silent_index {C-2} idx 27-3
+.silent_index {C-3} idx 27-3
+.silent_index {C-4} idx 27-3
+.silent_index {C-5} idx 27-3
+.silent_index {C-6} idx 27-3
+.silent_index {C-7} idx 27-3
+.silent_index {C-8} idx 27-3
+.silent_index {C-9} idx 27-3
+.silent_index {C-M-0} idx 27-3
+.silent_index {C-M-1} idx 27-3
+.silent_index {C-M-2} idx 27-3
+.silent_index {C-M-3} idx 27-3
+.silent_index {C-M-4} idx 27-3
+.silent_index {C-M-5} idx 27-3
+.silent_index {C-M-6} idx 27-3
+.silent_index {C-M-7} idx 27-3
+.silent_index {C-M-8} idx 27-3
+.silent_index {C-M-9} idx 27-3
+.silent_index {M-0} idx 27-3
+.silent_index {M-1} idx 27-3
+.silent_index {M-2} idx 27-3
+.silent_index {M-3} idx 27-3
+.silent_index {M-4} idx 27-3
+.silent_index {M-5} idx 27-3
+.silent_index {M-6} idx 27-3
+.silent_index {M-7} idx 27-3
+.silent_index {M-8} idx 27-3
+.silent_index {M-9} idx 27-3
+.silent_index {M-X Auto Fill Mode} idx 27-3
+.silent_index {C-M-M} idx 27-4
+.silent_index {C-M-RETURN} idx 27-4
+.silent_index {M-M} idx 27-4
+.silent_index {M-RETURN} idx 27-4
+.silent_index {C-X RUBOUT} idx 27-4
+.silent_index {M-[} idx 27-4
+.silent_index {M-A} idx 27-4
+.silent_index {C-(} idx 27-5
+.silent_index {C-M-(} idx 27-5
+.silent_index {C-M-U} idx 27-5
+.silent_index {C-X C-B} idx 27-5
+.silent_index {M-X List Buffers} idx 27-5
+.silent_index {M-~} idx 27-5
+.silent_index {C-X} idx 27-5
+.silent_index {M-S} idx 27-6
+.silent_index {M-W} idx 27-6
+.silent_index {M-X Count Occurrences} idx 27-6
+.silent_index {M-X How Many} idx 27-6
+.silent_index {M-X Delete And Expunge File} idx 27-6
+.silent_index {BACKSPACE} idx 27-7
+.silent_index {RUBOUT} idx 27-7
+.silent_index {BACKSPACE} idx 27-7
+.silent_index {C-RUBOUT} idx 27-7
+.silent_index {RUBOUT} idx 27-7
+.silent_index {C-X C-O} idx 27-7
+.silent_index {M-X Delete File} idx 27-7
+.silent_index {M-X Kill File} idx 27-7
+.silent_index {C-D} idx 27-8
+.silent_index {ESC-P} idx 27-8
+.silent_index {M-\} idx 27-8
+.silent_index {M-^} idx 27-8
+.silent_index {M-X Delete Matching Lines} idx 27-8
+.silent_index {M-X Flush Lines} idx 27-8
+.silent_index {M-X Delete Non-Matching Lines} idx 27-8
+.silent_index {M-X Keep Lines} idx 27-8
+.silent_index {C-X D} idx 27-9
+.silent_index {C-M-D} idx 27-9
+.silent_index {M-X Dired} idx 27-9
+.silent_index {M-X Edit Directory} idx 27-9
+.silent_index {C-M-E} idx 27-10
+.silent_index {C-M-]} idx 27-10
+.silent_index {ESCAPE} idx 27-10
+.silent_index {C-X C-X} idx 27-10
+.silent_index {C-X E} idx 27-10
+.silent_index {M-X Execute Buffer} idx 27-10
+.silent_index {Lisp-D} idx 27-11
+.silent_index {M-X Execute File} idx 27-11
+.silent_index {Lisp-E} idx 27-11
+.silent_index {Lisp-L} idx 27-11
+.silent_index {M-Z} idx 27-12
+.silent_index {M-Q} idx 27-12
+.silent_index {M-G} idx 27-12
+.silent_index {C-X C-F} idx 27-13
+.silent_index {M-X Find File} idx 27-13
+.silent_index {M-]} idx 27-13
+.silent_index {M-E} idx 27-13
+.silent_index {C-)} idx 27-13
+.silent_index {C-M-)} idx 27-13
+.silent_index {C-X G} idx 27-14
+.silent_index {C-X ^} idx 27-14
+.silent_index {C-?} idx 27-14
+.silent_index {M-/} idx 27-14
+.silent_index {M-?} idx 27-14
+.silent_index {C-S} idx 27-14
+.silent_index {NEWLINE} idx 27-15
+.silent_index {C-M-\} idx 27-15
+.silent_index {M-X Insert Buffer} idx 27-15
+.silent_index {)} idx 27-15
+.silent_index {]} idx 27-15
+.silent_index {M-;} idx 27-16
+.silent_index {M-X Insert Date} idx 27-16
+.silent_index {M-X Insert File} idx 27-16
+.silent_index {C-Y} idx 27-16
+.silent_index {C-Q} idx 27-17
+.silent_index {C-M-RUBOUT} idx 27-17
+.silent_index {M-RUBOUT} idx 27-17
+.silent_index {C-X K} idx 27-17
+.silent_index {M-X Kill Buffer} idx 27-17
+.silent_index {C-M-K} idx 27-18
+.silent_index {M-D} idx 27-18
+.silent_index {C-K} idx 27-18
+.silent_index {ESC-M} idx 27-18
+.silent_index {C-W} idx 27-18
+.silent_index {M-K} idx 27-19
+.silent_index {M-X Kill Some Buffers} idx 27-19
+.silent_index {Lisp-A} idx 27-19
+.silent_index {Lisp-B} idx 27-19
+.silent_index {Lisp-C} idx 27-20
+.silent_index {Lisp-?} idx 27-20
+.silent_index {C-M-\} idx 27-20
+.silent_index {C-M-Q} idx 27-20
+.silent_index {M-X Lisp Mode} idx 27-21
+.silent_index {C-]} idx 27-21
+.silent_index {Lisp-Q} idx 27-21
+.silent_index {Lisp-R} idx 27-21
+.silent_index {C-M-I} idx 27-22
+.silent_index {C-M-TAB} idx 27-22
+.silent_index {TAB} idx 27-22
+.silent_index {C-X C-L} idx 27-22
+.silent_index {M-L} idx 27-22
+.silent_index {C-M-X} idx 27-22
+.silent_index {M-X} idx 27-22
+.silent_index {M-(} idx 27-23
+.silent_index {C-<} idx 27-23
+.silent_index {C-M-BACKSPACE} idx 27-23
+.silent_index {C-M-H} idx 27-23
+.silent_index {M-BACKSPACE} idx 27-23
+.silent_index {C->} idx 27-23
+.silent_index {C-M-@} idx 27-24
+.silent_index {M-H} idx 27-24
+.silent_index {C-X H} idx 27-24
+.silent_index {M-@} idx 27-24
+.silent_index {C-B} idx 27-25
+.silent_index {ESC-D} idx 27-25
+.silent_index {C-M-A} idx 27-25
+.silent_index {C-M-[} idx 27-25
+.silent_index {C-M-B} idx 27-25
+.silent_index {C-M-P} idx 27-25
+.silent_index {ESC-4} idx 27-26
+.silent_index {M-B} idx 27-26
+.silent_index {ESC-B} idx 27-26
+.silent_index {C-N} idx 27-26
+.silent_index {C-F} idx 27-26
+.silent_index {ESC-C} idx 27-26
+.silent_index {C-M-F} idx 27-27
+.silent_index {C-M-N} idx 27-27
+.silent_index {ESC-5} idx 27-27
+.silent_index {M-F} idx 27-27
+.silent_index {M-)} idx 27-27
+.silent_index {ESC-F} idx 27-28
+.silent_index {M->} idx 27-28
+.silent_index {ESC-H} idx 27-28
+.silent_index {M-<} idx 27-28
+.silent_index {C-E} idx 27-28
+.silent_index {M-R} idx 27-28
+.silent_index {C-A} idx 27-28
+.silent_index {C-P} idx 27-29
+.silent_index {ESC-A} idx 27-29
+.silent_index {C--} idx 27-29
+.silent_index {C-M--} idx 27-29
+.silent_index {M--} idx 27-29
+.silent_index {C-V} idx 27-29
+.silent_index {C-G} idx 27-29
+.silent_index {C-X C-Z} idx 27-29
+.silent_index {ESC-J} idx 27-30
+.silent_index {M-X Make Space} idx 27-30
+.silent_index {C-X V} idx 27-30
+.silent_index {C-L} idx 27-30
+.silent_index {C-X 1} idx 27-30
+.silent_index {C-O} idx 27-31
+.silent_index {ESC-L} idx 27-31
+.silent_index {C-X O} idx 27-31
+.silent_index {M-X Prepend To File} idx 27-31
+.silent_index {M-V} idx 27-31
+.silent_index {C-X X} idx 27-32
+.silent_index {M-%} idx 27-32
+.silent_index {M-X Query Replace} idx 27-32
+.silent_index {M-X Rename Buffer} idx 27-32
+.silent_index {C-%} idx 27-33
+.silent_index {M-X Replace String} idx 27-33
+.silent_index {C-M-R} idx 27-33
+.silent_index {RETURN} idx 27-33
+.silent_index {C-R} idx 27-33
+.silent_index {M-X Revert File} idx 27-33
+.silent_index {M-X Save All Files} idx 27-34
+.silent_index {C-X C-S} idx 27-34
+.silent_index {C-M-V} idx 27-34
+.silent_index {ESC-T} idx 27-34
+.silent_index {ESC-V} idx 27-34
+.silent_index {C-X <} idx 27-35
+.silent_index {C-X >} idx 27-35
+.silent_index {ESC-S} idx 27-35
+.silent_index {ESC-U} idx 27-35
+.silent_index {C-X B} idx 27-35
+.silent_index {M-X Select Buffer} idx 27-35
+.silent_index {C-M-L} idx 27-36
+.silent_index {C-X F} idx 27-36
+.silent_index {C-X .} idx 27-36
+.silent_index {C-X C-N} idx 27-36
+.silent_index {M-X Set Key} idx 27-37
+.silent_index {C-@} idx 27-37
+.silent_index {C-SPACE} idx 27-37
+.silent_index {M-X Set Visited Filename} idx 27-37
+.silent_index {C-M-O} idx 27-37
+.silent_index {M-X Start Scripting} idx 27-38
+.silent_index {M-X Start Timing Nmode} idx 27-38
+.silent_index {M-X Stop Scripting} idx 27-38
+.silent_index {M-X Stop Timing Nmode} idx 27-38
+.silent_index {M-I} idx 27-39
+.silent_index {M-TAB} idx 27-39
+.silent_index {TAB} idx 27-39
+.silent_index {M-X Text Mode} idx 27-39
+.silent_index {C-T} idx 27-39
+.silent_index {C-M-T} idx 27-39
+.silent_index {C-X C-T} idx 27-40
+.silent_index {C-X T} idx 27-40
+.silent_index {M-T} idx 27-40
+.silent_index {C-X 2} idx 27-40
+.silent_index {M-X Undelete File} idx 27-41
+.silent_index {C-U} idx 27-41
+.silent_index {M-Y} idx 27-41
+.silent_index {M-'} idx 27-41
+.silent_index {M-C} idx 27-42
+.silent_index {C-X C-U} idx 27-42
+.silent_index {M-U} idx 27-42
+.silent_index {C-X 3} idx 27-42
+.silent_index {C-X C-V} idx 27-42
+.silent_index {M-X Visit File} idx 27-42
+.silent_index {C-X 4} idx 27-43
+.silent_index {C-=} idx 27-43
+.silent_index {C-X =} idx 27-43
+.silent_index {C-X C-W} idx 27-43
+.silent_index {M-X Write File} idx 27-43
+.silent_index {M-X Write Region} idx 27-43
+.silent_index {C-X P} idx 27-44
+.silent_index {Lisp-Y} idx 27-44
ADDED psl-1983/3-1/doc/nmode/nm-commands.topic
Index: psl-1983/3-1/doc/nmode/nm-commands.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-commands.topic
@@ -0,0 +1,313 @@
+.silent_index {Kill Ring} idx 27-2
+.silent_index {Move Data} idx 27-2
+.silent_index {Buffers} idx 27-2
+.silent_index {Region} idx 27-2
+.silent_index {Move Data} idx 27-2
+.silent_index {Files} idx 27-2
+.silent_index {Region} idx 27-2
+.silent_index {Move Data} idx 27-2
+.silent_index {Inform} idx 27-2
+.silent_index {Subsequent Command Modifier} idx 27-3
+.silent_index {Change Mode} idx 27-3
+.silent_index {Move Point} idx 27-4
+.silent_index {Kill Ring} idx 27-4
+.silent_index {Sentence} idx 27-4
+.silent_index {Remove} idx 27-4
+.silent_index {Paragraph} idx 27-4
+.silent_index {Move Point} idx 27-4
+.silent_index {Sentence} idx 27-4
+.silent_index {Move Point} idx 27-4
+.silent_index {Lisp} idx 27-5
+.silent_index {Move Point} idx 27-5
+.silent_index {Buffers} idx 27-5
+.silent_index {Inform} idx 27-5
+.silent_index {Buffers} idx 27-5
+.silent_index {Set Global Variable} idx 27-5
+.silent_index {Subsequent Command Modifier} idx 27-5
+.silent_index {Text} idx 27-6
+.silent_index {Fill Column} idx 27-6
+.silent_index {Alter Existing Text} idx 27-6
+.silent_index {Kill Ring} idx 27-6
+.silent_index {Region} idx 27-6
+.silent_index {Preserve} idx 27-6
+.silent_index {Inform} idx 27-6
+.silent_index {Files} idx 27-6
+.silent_index {Remove} idx 27-6
+.silent_index {Remove} idx 27-7
+.silent_index {Remove} idx 27-7
+.silent_index {Remove} idx 27-7
+.silent_index {Files} idx 27-7
+.silent_index {Remove} idx 27-7
+.silent_index {Kill Ring} idx 27-8
+.silent_index {Remove} idx 27-8
+.silent_index {Remove} idx 27-8
+.silent_index {Remove} idx 27-8
+.silent_index {Select} idx 27-8
+.silent_index {Remove} idx 27-8
+.silent_index {Select} idx 27-8
+.silent_index {Remove} idx 27-8
+.silent_index {Lisp} idx 27-9
+.silent_index {Move Point} idx 27-9
+.silent_index {Lisp} idx 27-10
+.silent_index {Defun} idx 27-10
+.silent_index {Move Point} idx 27-10
+.silent_index {Subsequent Command Modifier} idx 27-10
+.silent_index {Mark} idx 27-10
+.silent_index {Move Point} idx 27-10
+.silent_index {Alter Display Format} idx 27-10
+.silent_index {Buffers} idx 27-10
+.silent_index {Lisp} idx 27-11
+.silent_index {Defun} idx 27-11
+.silent_index {Mark} idx 27-11
+.silent_index {Files} idx 27-11
+.silent_index {Lisp} idx 27-11
+.silent_index {Mark} idx 27-11
+.silent_index {Lisp} idx 27-11
+.silent_index {Escape} idx 27-11
+.silent_index {Fill Prefix} idx 27-12
+.silent_index {Fill Column} idx 27-12
+.silent_index {Paragraph} idx 27-12
+.silent_index {Alter Existing Text} idx 27-12
+.silent_index {Text} idx 27-12
+.silent_index {Fill Prefix} idx 27-12
+.silent_index {Fill Column} idx 27-12
+.silent_index {Paragraph} idx 27-12
+.silent_index {Alter Existing Text} idx 27-12
+.silent_index {Text} idx 27-12
+.silent_index {Fill Prefix} idx 27-12
+.silent_index {Fill Column} idx 27-12
+.silent_index {Paragraph} idx 27-12
+.silent_index {Sentence} idx 27-12
+.silent_index {Alter Existing Text} idx 27-12
+.silent_index {Files} idx 27-13
+.silent_index {Buffers} idx 27-13
+.silent_index {Move Data} idx 27-13
+.silent_index {Move Point} idx 27-13
+.silent_index {Text} idx 27-13
+.silent_index {Paragraph} idx 27-13
+.silent_index {Move Point} idx 27-13
+.silent_index {Text} idx 27-13
+.silent_index {Sentence} idx 27-13
+.silent_index {Move Point} idx 27-13
+.silent_index {Lisp} idx 27-13
+.silent_index {Move Point} idx 27-13
+.silent_index {Move Data} idx 27-14
+.silent_index {Mark} idx 27-14
+.silent_index {Alter Display Format} idx 27-14
+.silent_index {Inform} idx 27-14
+.silent_index {Move Point} idx 27-14
+.silent_index {Select} idx 27-14
+.silent_index {Insert Constant} idx 27-15
+.silent_index {Buffers} idx 27-15
+.silent_index {Move Data} idx 27-15
+.silent_index {Lisp} idx 27-15
+.silent_index {Insert Constant} idx 27-15
+.silent_index {Lisp} idx 27-16
+.silent_index {Insert Constant} idx 27-16
+.silent_index {Move Data} idx 27-16
+.silent_index {Files} idx 27-16
+.silent_index {Move Data} idx 27-16
+.silent_index {Kill Ring} idx 27-16
+.silent_index {Move Data} idx 27-16
+.silent_index {Mark} idx 27-16
+.silent_index {Move Data} idx 27-17
+.silent_index {Lisp} idx 27-17
+.silent_index {Kill Ring} idx 27-17
+.silent_index {Remove} idx 27-17
+.silent_index {Text} idx 27-17
+.silent_index {Kill Ring} idx 27-17
+.silent_index {Remove} idx 27-17
+.silent_index {Buffers} idx 27-17
+.silent_index {Remove} idx 27-17
+.silent_index {Lisp} idx 27-18
+.silent_index {Kill Ring} idx 27-18
+.silent_index {Remove} idx 27-18
+.silent_index {Text} idx 27-18
+.silent_index {Kill Ring} idx 27-18
+.silent_index {Remove} idx 27-18
+.silent_index {Kill Ring} idx 27-18
+.silent_index {Remove} idx 27-18
+.silent_index {Kill Ring} idx 27-18
+.silent_index {Region} idx 27-18
+.silent_index {Remove} idx 27-18
+.silent_index {Text} idx 27-19
+.silent_index {Kill Ring} idx 27-19
+.silent_index {Sentence} idx 27-19
+.silent_index {Remove} idx 27-19
+.silent_index {Buffers} idx 27-19
+.silent_index {Remove} idx 27-19
+.silent_index {Lisp} idx 27-19
+.silent_index {Escape} idx 27-19
+.silent_index {Lisp} idx 27-19
+.silent_index {Inform} idx 27-19
+.silent_index {Lisp} idx 27-20
+.silent_index {Escape} idx 27-20
+.silent_index {Lisp} idx 27-20
+.silent_index {Inform} idx 27-20
+.silent_index {Lisp} idx 27-20
+.silent_index {Lisp} idx 27-20
+.silent_index {Lisp} idx 27-21
+.silent_index {Change Mode} idx 27-21
+.silent_index {Lisp} idx 27-21
+.silent_index {Subsequent Command Modifier} idx 27-21
+.silent_index {Lisp} idx 27-21
+.silent_index {Escape} idx 27-21
+.silent_index {Lisp} idx 27-21
+.silent_index {Escape} idx 27-21
+.silent_index {Lisp} idx 27-22
+.silent_index {Alter Existing Text} idx 27-22
+.silent_index {Region} idx 27-22
+.silent_index {Alter Existing Text} idx 27-22
+.silent_index {Text} idx 27-22
+.silent_index {Alter Existing Text} idx 27-22
+.silent_index {Subsequent Command Modifier} idx 27-22
+.silent_index {Lisp} idx 27-23
+.silent_index {Insert Constant} idx 27-23
+.silent_index {Mark} idx 27-23
+.silent_index {Lisp} idx 27-23
+.silent_index {Defun} idx 27-23
+.silent_index {Mark} idx 27-23
+.silent_index {Mark} idx 27-23
+.silent_index {Lisp} idx 27-24
+.silent_index {Mark} idx 27-24
+.silent_index {Text} idx 27-24
+.silent_index {Paragraph} idx 27-24
+.silent_index {Mark} idx 27-24
+.silent_index {Move Point} idx 27-24
+.silent_index {Mark} idx 27-24
+.silent_index {Move Point} idx 27-24
+.silent_index {Text} idx 27-24
+.silent_index {Mark} idx 27-24
+.silent_index {Move Point} idx 27-25
+.silent_index {Lisp} idx 27-25
+.silent_index {Defun} idx 27-25
+.silent_index {Move Point} idx 27-25
+.silent_index {Lisp} idx 27-25
+.silent_index {Move Point} idx 27-25
+.silent_index {Lisp} idx 27-25
+.silent_index {Move Point} idx 27-25
+.silent_index {Text} idx 27-26
+.silent_index {Move Point} idx 27-26
+.silent_index {Goal Column} idx 27-26
+.silent_index {Move Point} idx 27-26
+.silent_index {Goal Column} idx 27-26
+.silent_index {Move Point} idx 27-26
+.silent_index {Move Point} idx 27-26
+.silent_index {Lisp} idx 27-27
+.silent_index {Move Point} idx 27-27
+.silent_index {Lisp} idx 27-27
+.silent_index {Move Point} idx 27-27
+.silent_index {Text} idx 27-27
+.silent_index {Move Point} idx 27-27
+.silent_index {Lisp} idx 27-27
+.silent_index {Move Point} idx 27-27
+.silent_index {Move Point} idx 27-28
+.silent_index {Move Point} idx 27-28
+.silent_index {Move Point} idx 27-28
+.silent_index {Move Point} idx 27-28
+.silent_index {Move Point} idx 27-28
+.silent_index {Goal Column} idx 27-29
+.silent_index {Move Point} idx 27-29
+.silent_index {Subsequent Command Modifier} idx 27-29
+.silent_index {Move Point} idx 27-29
+.silent_index {Escape} idx 27-29
+.silent_index {Escape} idx 27-29
+.silent_index {Alter Display Format} idx 27-30
+.silent_index {Alter Display Format} idx 27-30
+.silent_index {Alter Display Format} idx 27-30
+.silent_index {Alter Display Format} idx 27-30
+.silent_index {Insert Constant} idx 27-31
+.silent_index {Alter Display Format} idx 27-31
+.silent_index {Move Point} idx 27-31
+.silent_index {Files} idx 27-31
+.silent_index {Region} idx 27-31
+.silent_index {Move Data} idx 27-31
+.silent_index {Move Point} idx 27-31
+.silent_index {Preserve} idx 27-32
+.silent_index {Alter Existing Text} idx 27-32
+.silent_index {Select} idx 27-32
+.silent_index {Buffers} idx 27-32
+.silent_index {Set Global Variable} idx 27-32
+.silent_index {Alter Existing Text} idx 27-33
+.silent_index {Select} idx 27-33
+.silent_index {Lisp} idx 27-33
+.silent_index {Alter Display Format} idx 27-33
+.silent_index {Insert Constant} idx 27-33
+.silent_index {Move Point} idx 27-33
+.silent_index {Select} idx 27-33
+.silent_index {Files} idx 27-33
+.silent_index {Remove} idx 27-33
+.silent_index {Buffers} idx 27-34
+.silent_index {Files} idx 27-34
+.silent_index {Preserve} idx 27-34
+.silent_index {Files} idx 27-34
+.silent_index {Preserve} idx 27-34
+.silent_index {Alter Display Format} idx 27-34
+.silent_index {Alter Display Format} idx 27-34
+.silent_index {Alter Display Format} idx 27-34
+.silent_index {Alter Display Format} idx 27-35
+.silent_index {Alter Display Format} idx 27-35
+.silent_index {Alter Display Format} idx 27-35
+.silent_index {Alter Display Format} idx 27-35
+.silent_index {Buffers} idx 27-35
+.silent_index {Move Point} idx 27-35
+.silent_index {Buffers} idx 27-36
+.silent_index {Move Point} idx 27-36
+.silent_index {Fill Column} idx 27-36
+.silent_index {Set Global Variable} idx 27-36
+.silent_index {Fill Prefix} idx 27-36
+.silent_index {Set Global Variable} idx 27-36
+.silent_index {Set Global Variable} idx 27-36
+.silent_index {Set Global Variable} idx 27-37
+.silent_index {Mark} idx 27-37
+.silent_index {Files} idx 27-37
+.silent_index {Set Global Variable} idx 27-37
+.silent_index {Insert Constant} idx 27-37
+.silent_index {Change Mode} idx 27-38
+.silent_index {Change Mode} idx 27-38
+.silent_index {Change Mode} idx 27-38
+.silent_index {Change Mode} idx 27-38
+.silent_index {Insert Constant} idx 27-39
+.silent_index {Text} idx 27-39
+.silent_index {Change Mode} idx 27-39
+.silent_index {Alter Existing Text} idx 27-39
+.silent_index {Lisp} idx 27-39
+.silent_index {Alter Existing Text} idx 27-39
+.silent_index {Alter Existing Text} idx 27-40
+.silent_index {Region} idx 27-40
+.silent_index {Alter Existing Text} idx 27-40
+.silent_index {Text} idx 27-40
+.silent_index {Alter Existing Text} idx 27-40
+.silent_index {Alter Display Format} idx 27-40
+.silent_index {Files} idx 27-41
+.silent_index {Move Data} idx 27-41
+.silent_index {Preserve} idx 27-41
+.silent_index {Subsequent Command Modifier} idx 27-41
+.silent_index {Kill Ring} idx 27-41
+.silent_index {Region} idx 27-41
+.silent_index {Alter Existing Text} idx 27-41
+.silent_index {Alter Existing Text} idx 27-41
+.silent_index {Text} idx 27-42
+.silent_index {Alter Existing Text} idx 27-42
+.silent_index {Region} idx 27-42
+.silent_index {Alter Existing Text} idx 27-42
+.silent_index {Text} idx 27-42
+.silent_index {Alter Existing Text} idx 27-42
+.silent_index {Alter Display Format} idx 27-42
+.silent_index {Files} idx 27-42
+.silent_index {Move Data} idx 27-42
+.silent_index {Move Point} idx 27-42
+.silent_index {Files} idx 27-43
+.silent_index {Buffers} idx 27-43
+.silent_index {Move Point} idx 27-43
+.silent_index {Alter Display Format} idx 27-43
+.silent_index {Inform} idx 27-43
+.silent_index {Files} idx 27-43
+.silent_index {Preserve} idx 27-43
+.silent_index {Files} idx 27-43
+.silent_index {Region} idx 27-43
+.silent_index {Preserve} idx 27-43
+.silent_index {Files} idx 27-44
+.silent_index {Preserve} idx 27-44
+.silent_index {Lisp} idx 27-44
+.silent_index {Move Data} idx 27-44
ADDED psl-1983/3-1/doc/nmode/nm-contents.ibm
Index: psl-1983/3-1/doc/nmode/nm-contents.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-contents.ibm
@@ -0,0 +1,50 @@
+,MOD
+- R 44X (1 March 1983) <PSL.NMODE-DOC>NM-CONTENTS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/Contents NMODE Manual Page i
+
+
+ Chapter 1. Introduction
+
+
+ Chapter 4. Basic Editing Commands
+
+ 4.1. Inserting Text 4-1
+ 4.2. Moving The Cursor 4-1
+ 4.3. Erasing Text 4-2
+ 4.4. Files 4-2
+ 4.5. Help 4-3
+ 4.6. Using Blank Lines Can Make Editing Faster 4-4
+
+ Chapter 21. Action Types
+
+
+ Chapter 22. Definitions
+
+
+ Chapter 23. Globals
+
+
+ Chapter 24. Command Descriptions
+
+
+ Chapter 25. Command Index
+
+
+ Chapter 26. Function Index
+
+
+ Chapter 27. Key Index
+
+
+ Chapter 28. Topic Index
ADDED psl-1983/3-1/doc/nmode/nm-customization.contents
Index: psl-1983/3-1/doc/nmode/nm-customization.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-customization.contents
@@ -0,0 +1,4 @@
+contents_entry(0 22 {Simple Customization} 22-1)
+contents_entry(1 22.1 {Init Files} 22-1)
+contents_entry(1 22.2 {Variables} 22-4)
+contents_entry(1 22.3 {Minor Modes} 22-4)
ADDED psl-1983/3-1/doc/nmode/nm-customization.function
Index: psl-1983/3-1/doc/nmode/nm-customization.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-customization.function
@@ -0,0 +1,1 @@
+.silent_index {set-fill-column-command} idx 22-5
ADDED psl-1983/3-1/doc/nmode/nm-customization.ibm
Index: psl-1983/3-1/doc/nmode/nm-customization.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-customization.ibm
@@ -0,0 +1,246 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-CUSTOMIZATION.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Simple Customization) Page 22-1
+
+
+ 202/22. Simple Customization
+
+ 201/In this chapter we describe simple ways of customizing NMODE.
+
+ NMODE is designed to be customizable; each user can rearrange things to
+ suit his taste. Simple customizations are primarily of two types: moving
+ functions from one character to another, and setting variables which functions
+ refer to so as to direct their actions. Beyond this, extensions can involve
+ redefining existing functions, or writing entirely new functions and creating
+ sharable libraries of them.
+
+ 202/22.1 Init Files
+
+ 201/This section explains how to customize NMODE by redefining the effect of
+ input keystrokes. NMODE is customized by executing Lisp forms. These
+ forms may be executed directly within NMODE (using Lisp-E), or may be
+ stored in an INIT file, which is read by NMODE when it first starts up. The
+ name of the INIT file read by NMODE is "NMODE.INIT" in the user's home
+ directory.
+
+ There are three concepts that must be understood to customize NMODE:
+ Commands, Functions, and Modes.
+
+ 1) Commands. The effect of given keystroke or sequence of keystrokes in
+ NMODE is based on a mapping between "commands" and "functions". A
+ "command" may be either a single "extended character" or a sequence of
+ characters. An extended character is a 9-bit character with distinct
+ "Control" and "Meta" bits. Thus "C-M-A" is a single "extended character",
+ even though on many terminals you have to use two keystrokes to enter it.
+ Extended characters are specified using the macro X-CHAR, for example:
+
+ (x-char A) the letter "A" (upper case)
+ (x-char C-F) Control-F
+ (x-char C-M-Z) Control-Meta-Z
+ (x-char CR) Carriage-Return
+ (x-char TAB) Tab
+ (x-char BACKSPACE) Backspace
+ (x-char NEWLINE) Newline
+ (x-char RUBOUT) Rubout
+ (x-char C-M-RUBOUT) Control-Meta-Rubout
+
+ (The macros described in this section are defined in the load module
+ EXTENDED-CHAR.) It is important to note that on most terminals, some Ascii
+ control characters are mapped to extended "Control" characters and some
+ aren't. Those that aren't are: Backspace, CR, Newline, Tab, and Escape.
+ Even if you type "CTRL-I" on the keyboard, you will get "Tab" and not
+ "Control-I". The remaining Ascii control characters are mapped to extended
+ "Control" characters, thus typing "CTRL-A" on the keyboard gives
+ "Control-A".
+
+ As mentioned above, a command can be a sequence of characters. There are
+ two forms: Prefix commands and Extended commands.
+ 201/Page 22-2 NMODE Manual (Init Files)
+
+
+ Prefix commands: A prefix command consists of two characters, the first of
+ which is a defined "prefix character". In NMODE, there are 3 predefined
+ prefix characters: C-X, ESC, and C-]. Prefix commands are specified using
+ the X-CHARS macro, for example:
+
+ (x-chars C-X C-F)
+ (x-chars ESC A)
+ (x-chars C-] E)
+
+ Extended commands: An extended command consists of the character M-X and
+ a string. Extended commands are defined using the M-X macro, for example:
+
+
+ (M-X "Lisp Mode")
+ (M-X "Revert File")
+
+ The case of the letters in the string is irrelevant, except to specify how the
+ command name will be displayed when "completion" is used by the user. By
+ convention, the first letter of each word in an extended command name is
+ capitalized.
+
+ 2) Functions. NMODE commands are implemented by PSL functions. By
+ convention, most (but not all) PSL functions that implement NMODE commands
+ have names ending with "-COMMAND", for example,
+ 203/move-forward-character-command201/.
+
+ An NMODE command function should take no arguments. The function can
+ perform its task using a large number of existing support functions; see
+ PN:BUFFER.SL and PN:MOVE-COMMANDS.SL for examples. A command
+ function can determine the command argument (given by C-U) by inspecting
+ global variables:
+
+ nmode-command-argument: the numeric value (default: 1)
+ nmode-command-argument-given: T if the user specified an argument
+ nmode-command-number-given: T if the user typed digits in the argument
+
+ See the files PN:MOVE-COMMANDS.SL, PN:LISP-COMMANDS.SL, and
+ PN:COMMANDS.SL for many examples of NMODE command functions.
+
+ 3) Modes. The mapping between commands and functions is dependent on the
+ current "mode". Examples of existing modes are "Text Mode", which is the
+ basic mode for text editing, "Lisp Mode", which is an extension of "Text
+ Mode" for editing and executing Lisp code, and "Dired Mode", which is a
+ specialized mode for the Directory Editor Subsystem.
+
+ A mode is defined by a list of Lisp forms which are evaluated to determine
+ the state of a Dispatch Table. The Dispatch Table is what is actually used to
+ map from commands to functions. Every time the user selects a new buffer,
+ the Dispatch Table is cleared and the Lisp forms defining the mode for the
+ new buffer are evaluated to fill the Dispatch Table. The forms are evaluated
+ in reverse order, so that the first form is evaluated last. Thus, any
+ command definitions made by one form supersede those made by forms
+ appearing after it in the list.
+ 201/NMODE Manual (Init Files) Page 22-3
+
+
+ Two functions are commonly invoked by mode-defining forms:
+ 203/nmode-establish-mode 201/and 203/nmode-define-commands201/. 203/nmode-establish-mode
+ 201/takes one argument, a list of mode defining forms, and evaluates those forms.
+ Thus, 203/nmode-establish-mode 201/can be used to define one mode in terms of (as
+ an extension of or a modification to) another mode.
+
+ 203/nmode-define-commands 201/takes one argument, a list of pairs, where each pair
+ consists of a COMMAND and a FUNCTION. This form of list is called a
+ "command list". Command lists are not used directly to map from commands
+ to functions. Instead, 203/nmode-define-commands 201/reads the command list it is
+ given and for each COMMAND-FUNCTION pair in the command list (in order),
+ it alters the Dispatch Table to map the specified COMMAND to the
+ corresponding FUNCTION.
+
+ Note that as a convenience, whenever you define an "upper case" command,
+ the corresponding "lower case" command is also defined to map to the same
+ function. Thus, if you define C-M-A, you automatically define C-M-a to map
+ to the same function. If you want the lower case command to map to a
+ different function, you must define the lower case command "after" defining
+ the upper case command.
+
+ The usual technique for modifying one or more existing modes is to modify
+ one of the command lists given to 203/nmode-define-commands201/. The file
+ PN:MODE-DEFS.SL contains the definition of most predefined NMODE command
+ lists, as well as the definition of most predefined modes. To modify a mode
+ or modes, you must alter one or more command lists by adding (or perhaps
+ removing) entries. Command lists are manipulated using two functions:
+
+ (add-to-command-list list-name command func)
+ (remove-from-command-list list-name command)
+
+ Here are some examples:
+
+ (add-to-command-list
+ 'read-only-text-command-list (x-char M-@) 'set-mark-command)
+
+ [The above form makes M-@ set the mark.]
+
+ (add-to-command-list
+ 'read-only-terminal-command-list (x-chars ESC Y) 'print-buffer-names-command)
+
+ [The above form makes Esc-Y print a list of all buffer names. Esc-Y is
+ sent by HP264X terminals when the "Display Functions" key is hit.]
+
+ Note that these functions change only the command lists, not the Dispatch
+ Table which is actually used to map from commands to functions. To cause
+ the Dispatch Table to be updated to reflect any changes in the command lists,
+ you must invoke the function 203/nmode-establish-current-mode201/.
+ 201/Page 22-4 NMODE Manual (Variables)
+
+
+ 202/22.2 Variables
+
+ 201/Since the init file consists of a series of PSL forms, it can contain simple
+ assignment statements which set up global variables in NMODE. A variable is
+ a name which is associated with a value. NMODE uses many variables
+ internally, and has others whose purpose is to be set by the user for
+ customization. If you want to set a variable a particular way each time you
+ use NMODE, you can use your init file to do so. Global variables may also
+ be set automatically by major modes.
+
+ Two examples of global variables are *outwindow and nmode-default-mode.
+ Nmode-default-mode is the mode used for most newly created buffers. It is
+ normally set to text-mode, but might be set to lisp-interface-mode by a user
+ who expects to be editing programs most of the time. The other variable
+ controls the automatic pop up of the output window. If *outwindow is T, the
+ output buffer will automatically appear if it is not already displayed when
+ output (i.e. from a lisp calculation) occurs.
+
+ Another example of such a variable is the Fill Column variable, which
+ specifies the position of the right margin (in characters from the left margin)
+ to be used by the fill and justify commands.
+
+ To set a variable, include in the init file a line containing
+
+ (setq <variable_name> <variable_value>).
+
+ This is just an assignment statement in PSL. To adjust the fill column to 60,
+ for instance, include a line:
+
+ (setq fill-column 60).
+
+ 202/22.3 Minor Modes
+
+ 201/Since init files can execute arbitrary PSL forms, they can run the same
+ functions that one can call from the terminal by appropriate commands. In
+ particular they can turn major or minor modes on or off.
+
+ Minor modes are options which you can use or not. For example, Auto Fill
+ mode is a minor mode in which Spaces break lines between words as you
+ type. All the minor modes are independent of each other and of the selected
+ major mode. Most minor modes say in the mode line when they are on; for
+ example, "Fill" in the mode line means that Auto Fill mode is on.
+
+ Minor modes are controlled by a global variable: nmode-minor-modes. This
+ is a list of currently active minor modes. Rather than directly setting this
+ list, it is generally preferable to use some existing functions to turn the
+ modes on and off, since they correctly handle some side effects. Minor modes
+ can be added to this list with 203/activate-minor-mode 201/and removed from it with
+ 203/deactivate-minor-mode201/. For example, auto fill mode can be turned on when
+ NMODE is started by including
+
+ (activate-minor-mode auto-fill-mode)
+ 201/NMODE Manual (Minor Modes) Page 22-5
+
+
+ in the init file.
+
+ Each minor mode is associated with a function that can be used to turn it
+ on or off. The function turns the mode on if it was off and off if it was on.
+ This is known as 202/toggling201/. All the minor mode functions are suitable for
+ connecting to single or double character commands if you want to enter and
+ exit a minor mode frequently.
+
+ Auto Fill mode allows you to type text endlessly without worrying about the
+ width of your screen. Line separators are be inserted where needed to
+ prevent lines from becoming too long. A variable called fill-column sets the
+ maximum number of columns allowed in a line. See Section 13.4 [Filling],
+ page 4.
ADDED psl-1983/3-1/doc/nmode/nm-customization.key
Index: psl-1983/3-1/doc/nmode/nm-customization.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-customization.key
@@ -0,0 +1,3 @@
+.silent_index {C-X} idx 22-2
+.silent_index {M-X} idx 22-2
+.silent_index {C-X} idx 22-5
ADDED psl-1983/3-1/doc/nmode/nm-customization.r
Index: psl-1983/3-1/doc/nmode/nm-customization.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-customization.r
@@ -0,0 +1,395 @@
+.so pndoc:nman
+.part NM-CUSTOMIZATION manual
+@Chapter[Simple Customization]
+@label[NMODECustomization]
+@node("customization")
+ In this chapter we describe simple ways of customizing NMODE.
+
+ NMODE is designed to be customizable; each user can rearrange things
+to suit his taste. Simple customizations are primarily of two types:
+moving functions from one character to another, and setting variables
+which functions refer to so as to direct their actions. Beyond this,
+extensions can involve redefining existing functions, or writing
+entirely new functions and creating sharable libraries of them.
+@index{redefining commands}
+@Section[Init Files]
+@node("init")
+@index{init files}
+@index{customization}
+This section explains how to customize NMODE by redefining the effect of input
+keystrokes. NMODE is customized by executing Lisp forms. These forms may be
+executed directly within NMODE (using Lisp-E), or may be stored in an INIT
+file, which is read by NMODE when it first starts up. The name of the INIT
+file read by NMODE is "NMODE.INIT" in the user's home directory.
+
+There are three concepts that must be understood to customize NMODE: Commands,
+Functions, and Modes.
+
+@index{control}
+@index{meta}
+@index{character set}
+1) Commands. The effect of given keystroke or sequence of keystrokes in
+NMODE is based on a mapping between "commands" and "functions".
+A "command" may be either a single "extended character" or a sequence
+of characters. An extended character is a 9-bit character with
+distinct "Control" and "Meta" bits. Thus "C-M-A" is a single "extended
+character", even though on many terminals you have to use two keystrokes
+to enter it. Extended characters are specified using the macro X-CHAR,
+for example:
+@verbatim{
+ (x-char A) the letter "A" (upper case)
+ (x-char C-F) Control-F
+ (x-char C-M-Z) Control-Meta-Z
+ (x-char CR) Carriage-Return
+ (x-char TAB) Tab
+ (x-char BACKSPACE) Backspace
+ (x-char NEWLINE) Newline
+ (x-char RUBOUT) Rubout
+ (x-char C-M-RUBOUT) Control-Meta-Rubout
+}
+(The macros described in this section are defined in the load module
+EXTENDED-CHAR.) It is important to note that on most terminals, some Ascii
+control characters are mapped to extended "Control" characters and some aren't.
+Those that aren't are: Backspace, CR, Newline, Tab, and Escape. Even if you
+type "CTRL-I" on the keyboard, you will get "Tab" and not "Control-I". The
+remaining Ascii control characters are mapped to extended "Control" characters,
+thus typing "CTRL-A" on the keyboard gives "Control-A".
+
+As mentioned above, a command can be a sequence of characters. There are two
+forms: Prefix commands and Extended commands.
+
+@keyindex{C-X}
+@index{prefix characters}
+Prefix commands: A prefix command consists of two characters, the first of
+which is a defined "prefix character". In NMODE, there are 3 predefined prefix
+characters: C-X, ESC, and C-]. Prefix commands are specified using the X-CHARS
+macro, for example:
+@verbatim{
+ (x-chars C-X C-F)
+ (x-chars ESC A)
+ (x-chars C-] E)
+}
+@index{extended commands}
+@keyindex{M-X}
+@index{functions}
+@index{commands}
+Extended commands: An extended command consists of the character M-X and a
+string. Extended commands are defined using the M-X macro, for example:
+@verbatim{
+ (M-X "Lisp Mode")
+ (M-X "Revert File")
+}
+The case of the letters in the string is irrelevant, except to specify how the
+command name will be displayed when "completion" is used by the user. By
+convention, the first letter of each word in an extended command name is
+capitalized.
+
+2) Functions. NMODE commands are implemented by PSL functions. By convention,
+most (but not all) PSL functions that implement NMODE commands have names
+ending with "-COMMAND", for example, @fnc{move-forward-character-command}.
+
+An NMODE command function should take no arguments. The function can perform
+its task using a large number of existing support functions; see PN:BUFFER.SL
+and PN:MOVE-COMMANDS.SL for examples. A command function can determine the
+command argument (given by C-U) by inspecting global variables:
+@verbatim{
+ nmode-command-argument: the numeric value (default: 1)
+ nmode-command-argument-given: T if the user specified an argument
+ nmode-command-number-given: T if the user typed digits in the argument
+}
+See the files PN:MOVE-COMMANDS.SL, PN:LISP-COMMANDS.SL, and PN:COMMANDS.SL for
+many examples of NMODE command functions.
+
+3) Modes. The mapping between commands and functions is dependent on the
+current "mode". Examples of existing modes are "Text Mode", which is the basic
+mode for text editing, "Lisp Mode", which is an extension of "Text Mode" for
+editing and executing Lisp code, and "Dired Mode", which is a specialized mode
+for the Directory Editor Subsystem.
+
+A mode is defined by a list of Lisp forms which are evaluated to determine the
+state of a Dispatch Table. The Dispatch Table is what is actually used to map
+from commands to functions. Every time the user selects a new buffer, the
+Dispatch Table is cleared and the Lisp forms defining the mode for the new
+buffer are evaluated to fill the Dispatch Table. The forms are evaluated in
+reverse order, so that the first form is evaluated last. Thus, any command
+definitions made by one form supersede those made by forms appearing after it
+in the list.
+
+Two functions are commonly invoked by mode-defining forms:
+@fnc{nmode-establish-mode}
+and @fnc{nmode-define-commands}.
+@fnc{nmode-establish-mode} takes one argument, a list of
+mode defining forms, and evaluates those forms.
+Thus, @fnc{nmode-establish-mode} can
+be used to define one mode in terms of (as an extension of or a modification
+to) another mode.
+
+@fnc{nmode-define-commands} takes one argument, a list of pairs, where
+each pair consists of a COMMAND and a FUNCTION. This form of list is
+called a "command list". Command lists are not used directly to map
+from commands to functions. Instead, @fnc{nmode-define-commands}
+reads the command list it is given and for each COMMAND-FUNCTION pair
+in the command list (in order), it alters the Dispatch Table to map
+the specified COMMAND to the corresponding FUNCTION.
+
+Note that as a convenience, whenever you define an "upper case" command, the
+corresponding "lower case" command is also defined to map to the same function.
+Thus, if you define C-M-A, you automatically define C-M-a to map to the same
+function. If you want the lower case command to map to a different function,
+you must define the lower case command "after" defining the upper case command.
+
+The usual technique for modifying one or more existing modes is to modify one
+of the command lists given to @fnc{nmode-define-commands}. The file PN:MODE-DEFS.SL
+contains the definition of most predefined NMODE command lists, as well as the
+definition of most predefined modes. To modify a mode or modes, you must alter
+one or more command lists by adding (or perhaps removing) entries. Command
+lists are manipulated using two functions:
+@verbatim{
+ (add-to-command-list list-name command func)
+ (remove-from-command-list list-name command)
+}
+Here are some examples:
+@verbatim{
+(add-to-command-list
+ 'read-only-text-command-list (x-char M-@) 'set-mark-command)
+
+ [The above form makes M-@ set the mark.]
+
+(add-to-command-list
+ 'read-only-terminal-command-list (x-chars ESC Y) 'print-buffer-names-command)
+
+ [The above form makes Esc-Y print a list of all buffer names. Esc-Y is
+ sent by HP264X terminals when the "Display Functions" key is hit.]
+}
+Note that these functions change only the command lists, not the Dispatch Table
+which is actually used to map from commands to functions. To cause the
+Dispatch Table to be updated to reflect any changes in the command lists, you
+must invoke the function @fnc{nmode-establish-current-mode}.
+@Section[Variables]
+@node("variables")
+@index{variables}
+@index{options}
+@index{Fill Column}
+ Since the init file consists of a series of PSL forms, it can
+contain simple assignment statements which set up global variables in
+NMODE. A variable is a name which is associated with a value. NMODE
+uses many variables internally, and has others whose purpose is to be
+set by the user for customization. If you want to set a variable a
+particular way each time you use NMODE, you can use your init file to
+do so. Global variables may also be set automatically by major modes.
+
+ Two examples of global variables are *outwindow and nmode-default-mode.
+Nmode-default-mode is the mode used for most newly created buffers.
+It is normally set to text-mode, but might be set to lisp-interface-mode
+by a user who expects to be editing programs most of the time.
+The other variable controls the automatic pop up of the output window.
+If *outwindow is T, the output buffer will automatically appear if it is
+not already displayed when output (i.e. from a lisp calculation) occurs.
+
+Another example of such a variable is the Fill Column variable, which
+specifies the position of the right margin (in characters from the
+left margin) to be used by the fill and justify commands.
+
+@Index{NMODE.VARS}
+@index{variables}
+ To set a variable, include in the init file a line containing
+@verbatim{
+(setq <variable_name> <variable_value>).
+}
+This is just an assignment statement in PSL.
+To adjust the fill column to 60, for instance, include a line:
+@verbatim{
+(setq fill-column 60).
+}
+@Section[Minor Modes]
+@node("minormodes")
+@index{minor modes}
+@index{numeric arguments}
+@index{mode line}
+@index{toggling}
+ Since init files can execute arbitrary PSL forms, they can run the
+same functions that one can call from the terminal by appropriate commands.
+In particular they can turn major or minor modes on or off.
+
+ Minor modes are options which you can use or not. For example, Auto
+Fill mode is a minor mode in which Spaces break lines between words as
+you type. All the minor modes are independent of each other and of
+the selected major mode. Most minor modes say in the mode line when
+they are on; for example, "Fill" in the mode line means that Auto Fill
+mode is on.
+
+ Minor modes are controlled by a global variable: nmode-minor-modes.
+This is a list of currently active minor modes. Rather than directly
+setting this list, it is generally preferable to use some existing
+functions to turn the modes on and off, since they correctly handle
+some side effects. Minor modes can be added to this list with
+@fnc{activate-minor-mode} and removed from it with
+@fnc{deactivate-minor-mode}. For example, auto
+fill mode can be turned on when NMODE is started by including
+@verbatim{
+(activate-minor-mode auto-fill-mode)
+}
+in the init file.
+
+ Each minor mode is associated with a function that can be used to
+turn it on or off. The function turns the mode on if it was off and
+off if it was on. This is known as @dfn[toggling]. All the minor
+mode functions are suitable for connecting to single or double
+character commands if you want to enter and exit a minor mode
+frequently.
+
+@index{Auto Fill mode}
+@keyindex{C-X F}
+@index{Fill Column}
+@fncindex{set-fill-column-command}
+ Auto Fill mode allows you to type text endlessly without worrying
+about the width of your screen. Line separators are be inserted where
+needed to prevent lines from becoming too long. A variable called
+fill-column sets the maximum number of columns allowed in a line.
+@Note("Filling").
+ @node("kbdmac")
+
+ @Section[Keyboard Macros]
+
+ @WideCommands[
+ C-X ( Start defining a keyboard macro.
+
+ C-X ) End the definition of a keyboard macro.
+
+ C-X E Execute the most recent keyboard macro.
+
+ C-U C-X ( Re-execute last keyboard macro and append to its definition.
+
+ C-X Q Ask for confirmation when the keyboard macro is executed.
+
+ C-U C-X Q Allow the user to edit for a while, each time the keyboard
+ macro is executed.
+
+ M-X Name Kbd Macro Make the most recent keyboard macro into the
+ permanent definition of a command.
+
+ M-X Write Kbd Macro Save a keyboard macro in a file.
+ ]
+
+ @index{keyboard macros}
+ A @dfn[keyboard macro] is a command defined by the user to abbreviate a
+ sequence of other commands. If you discover that you are about to
+ type C-N C-D forty times, you can define a keyboard macro to do C-N
+ C-D and call it with a repeat count of forty.
+
+ @index{TECO}
+ Keyboard macros differ from ordinary NMODE commands, in that they
+ are written in the NMODE command language rather than in TECO. This
+ makes it easier for the novice to write them, and makes them more
+ convenient as temporary hacks. However, the NMODE command language is
+ not powerful enough as a programming language to be useful for writing
+ anything intelligent or general. For such things, TECO must be used.
+
+ NMODE functions were formerly known as macros (which is part of the
+ explanation of the name NMODE), because they were macros within the
+ context of TECO as an editor. We decided to change the terminology
+ because, when thinking of NMODE, we consider TECO a programming
+ language rather than an editor. The only "macros" in NMODE now are
+ keyboard macros.
+
+ You define a keyboard macro while executing the commands which are
+ the definition. Put differently, as you are defining a keyboard
+ macro, the definition is being executed for the first time. This way,
+ you can see what the effects of your commands are, so that you don't
+ have to figure them out in your head. When you are finished, the
+ keyboard macro is defined and also has been, in effect, executed once.
+ You can then do the whole thing over again by invoking the macro.
+
+ @SubSection[Basic Use]
+
+ @index{C-X (}@index{C-X )}@index{C-X E}@fncindex{start kbd macro-command}@fncindex{end kbd macro-command}
+ @fncindex{execute kbd macro-command}
+ To start defining a keyboard macro, type the @w[C-X (] command
+ (@fnc{start kbd macro-command}). From then on, your commands continue to be
+ executed, but also become part of the definition of the macro. "Def"
+ appears in the mode line to remind you of what is going on. When you
+ are finished, the @w[C-X )] command (@fnc{end kbd macro-command}) terminates
+ the definition (without becoming part of it!).
+
+ The macro thus defined can be invoked again with the C-X E command
+ (@fnc{execute kbd macro-command}), which may be given a repeat count as a
+ numeric argument to execute the macro many times. @w[C-X )] can also
+ be given a repeat count as an argument, in which case it repeats the
+ macro that many times right after defining it, but defining the macro
+ counts as the first repetition (since it is executed as you define
+ it). So, giving @w[C-X )] an argument of 2 executes the macro
+ immediately one additional time. An argument of zero to @w[C-X E] or
+ @w[C-X )] means repeat the macro indefinitely (until it gets an
+ error).
+
+ If you want to perform an operation on each line, then either you
+ should start by positioning point on the line above the first one to
+ be processed and then begin the macro definition with a C-N, or you
+ should start on the proper line and end with a C-N. Either way,
+ repeating the macro will operate on successive lines.
+
+ After you have terminated the definition of a keyboard macro, you
+ can add to the end of its definition by typing C-U @w[C-X (]. This is
+ equivalent to plain @w[C-X (] followed by retyping the whole
+ definition so far. As a consequence it re-executes the macro as
+ previously defined.
+
+ @index{Name Kbd Macro}
+ If you wish to save a keyboard macro for longer than until you
+ define the next one, you must give it a name. If you do M-X Name Kbd
+ MacroFOO@return2{}, the last keyboard macro defined (the one which C-X E
+ would invoke) is turned into a function and given the name FOO. M-X
+ FOO will from then on invoke that particular macro. Name Kbd Macro
+ also reads a character from the keyboard and redefines that character
+ command to invoke the macro. You can use a bit prefix character in
+ specifying the command; you can also type a C-X command to be
+ redefined. When you have finished typing the command characters, Name
+ Kbd Macro asks you whether it should go ahead and redefine the
+ character.
+
+ @index{Write Kbd Macro}
+ To save a keyboard macro permanently, do M-X Write Kbd Macro.
+ Supply the function name of the keyboard macro as a string argument,
+ or else it will ask you to type the character which invokes the
+ keyboard macro. The keyboard macro is saved as a library which, when
+ loaded, automatically redefines the keyboard macro. The filename is
+ read from the terminal. Its second name should be :EJ, like other
+ libraries; that is the default.
+
+ @index{View Kbd Macro}
+ To examine the definition of a keyboard macro, use the function View
+ Kbd Macro. Either supply the name of the function which runs the
+ macro, as a string argument, or type the command which invokes the
+ macro when View Kbd Macro asks for it.
+
+ @SubSection[Executing Macros with Variations]
+
+ @index{C-X Q}@fncindex{kbd macro query-command}
+ If you want to be allowed to do arbitrary editing at a certain point
+ each time around the macro (different each time, and not remembered as
+ part of the macro), you can use the C-U C-X Q command (@fnc{kbd macro
+ query-command}). When you are defining the macro, this lets you do some
+ editing, which does @xxii[not] become part of the macro. When you are done,
+ exit with @CMC[] to return to defining the macro. When
+ you execute the macro, at that same point, you will again be allowed
+ to do some editing. When you exit this time with @CMC[], the execution
+ of the macro will resume. If you abort the recursive editing level
+ with C-], you will abort the macro definition or execution.
+
+ @index{Query Replace}@index{Space}@index{Rubout}@index{C-L}@index{C-R}@index{Altmode}
+ You can get the effect of Query Replace, where the macro asks you
+ each time around whether to make a change, by using the command C-X Q
+ with no argument in your keyboard macro. When you are defining
+ the macro, the C-X Q does nothing, but when the macro is invoked the
+ C-X Q reads a character from the terminal to decide whether to
+ continue. The special answers are Space, Rubout, Altmode, C-L, C-R.
+ A Space means to continue. A Rubout means to skip the
+ remainder of this repetition of the macro, starting again from the
+ beginning in the next repetition. An Altmode ends all repetitions of
+ the macro, but only the innermost macro (in case it was called from
+ another macro). C-L clears the screen and asks you again for a
+ character to say what to do. C-R enters a recursive editing level;
+ when you exit, you are asked again (if you type a Space, the macro
+ will continue from wherever you left things when you exited the C-R).
+ Anything else exits all levels of keyboard macros and is reread as a
+ command.
ADDED psl-1983/3-1/doc/nmode/nm-customization.topic
Index: psl-1983/3-1/doc/nmode/nm-customization.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-customization.topic
@@ -0,0 +1,21 @@
+.silent_index {redefining} idx 22-1
+.silent_index {init} idx 22-1
+.silent_index {customization} idx 22-1
+.silent_index {control} idx 22-1
+.silent_index {meta} idx 22-1
+.silent_index {character} idx 22-1
+.silent_index {prefix} idx 22-2
+.silent_index {extended} idx 22-2
+.silent_index {functions} idx 22-2
+.silent_index {commands} idx 22-2
+.silent_index {variables} idx 22-4
+.silent_index {options} idx 22-4
+.silent_index {Fill} idx 22-4
+.silent_index {NMODE.VARS} idx 22-4
+.silent_index {variables} idx 22-4
+.silent_index {minor} idx 22-4
+.silent_index {numeric} idx 22-4
+.silent_index {mode} idx 22-4
+.silent_index {toggling} idx 22-4
+.silent_index {Auto} idx 22-5
+.silent_index {Fill} idx 22-5
ADDED psl-1983/3-1/doc/nmode/nm-definitions.contents
Index: psl-1983/3-1/doc/nmode/nm-definitions.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-definitions.contents
@@ -0,0 +1,1 @@
+contents_entry(0 25 {Definitions} 25-1)
ADDED psl-1983/3-1/doc/nmode/nm-definitions.ibm
Index: psl-1983/3-1/doc/nmode/nm-definitions.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-definitions.ibm
@@ -0,0 +1,57 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-DEFINITIONS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Definitions) Page 25-1
+
+
+ 202/25. Definitions
+
+ 201/This section defines a number of terms used in the descriptions of NMODE
+ commands.
+
+
+
+
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Defun
+
+
+ 201/A defun is a list whose ( falls in column 0. Its end is after the CRLF
+ following its ).
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Paragraph
+
+
+ 201/Paragraphs are delimited by blank lines and psuedo-blank lines, which are
+ lines which don't match the existing fill prefix (when there is one), and,
+ when in text mode, also by indentation and by text justifier command lines,
+ which are currently defined as lines starting with a period and which are
+ treated as another type of psuedo-blank line. Paragraphs contain the final
+ CRLF after their last test, and contain any immediately preceding empty line.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Region
+
+
+ 201/The region is that portion of text between point, the current buffer position,
+ and mark.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Definition: Sentence
+
+
+ 201/A sentence is ended by a ., ? or ! followed by two spaces or a CRLF (with
+ optional space), with any number of "closing characters" ", ', ) and ]
+ between. A sentence also starts at the start of a paragraph. A sentence
+ also ends at the end of a paragraph.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
ADDED psl-1983/3-1/doc/nmode/nm-definitions.topic
Index: psl-1983/3-1/doc/nmode/nm-definitions.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-definitions.topic
@@ -0,0 +1,4 @@
+.silent_index {Defun} idx 25-1
+.silent_index {Paragraph} idx 25-1
+.silent_index {Region} idx 25-1
+.silent_index {Sentence} idx 25-1
ADDED psl-1983/3-1/doc/nmode/nm-display.contents
Index: psl-1983/3-1/doc/nmode/nm-display.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-display.contents
@@ -0,0 +1,1 @@
+contents_entry(0 17 {Controlling the Display} 17-1)
ADDED psl-1983/3-1/doc/nmode/nm-display.function
Index: psl-1983/3-1/doc/nmode/nm-display.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-display.function
@@ -0,0 +1,12 @@
+.silent_index {nmode-refresh-command} idx 17-1
+.silent_index {nmode-full-refresh} idx 17-1
+.silent_index {next-screen-command} idx 17-2
+.silent_index {previous-screen-command} idx 17-2
+.silent_index {scroll-window-up-line-command} idx 17-2
+.silent_index {scroll-window-down-line-command} idx 17-2
+.silent_index {scroll-window-up-page-command} idx 17-2
+.silent_index {scroll-window-down-page-command} idx 17-2
+.silent_index {reposition-window-command} idx 17-2
+.silent_index {scroll-window-left-command} idx 17-2
+.silent_index {scroll-window-right-command} idx 17-2
+.silent_index {move-to-screen-edge-command} idx 17-2
ADDED psl-1983/3-1/doc/nmode/nm-display.ibm
Index: psl-1983/3-1/doc/nmode/nm-display.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-display.ibm
@@ -0,0 +1,121 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-DISPLAY.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Controlling the Display) Page 17-1
+
+
+ 202/17. Controlling the Display
+
+ 201/Since only part of a large file fits on the screen, NMODE tries to show the
+ part that is likely to be interesting. The display control commands allow you
+ to ask to see a different part of the file.
+
+ C-L Clear and redisplay screen, putting point at a specified
+ vertical position.
+ ESC-J Clear and rewrite display, but without moving text or point.
+ C-V Scroll forwards (a screen or a few lines).
+ M-V Scroll backwards.
+ M-R Move point to the text at a given vertical position.
+ C-M-R Shift the function point is in onto the screen.
+ ESC-S scroll window up line
+ ESC-T scroll window down line
+ ESC-U scroll window up page
+ ESC-V scroll window down page
+ C-X < scroll window left
+ C-X > scroll window right
+
+ The terminal screen is rarely large enough to display all of your file. If
+ the whole buffer doesn't fit on the screen, NMODE shows a contiguous portion
+ of it, containing point. It continues to show approximately the same portion
+ until point moves outside of it; then NMODE chooses a new portion centered
+ around the new point. This is NMODE's guess as to what you are most
+ interested in seeing. But if the guess is wrong, you can use the display
+ control commands to see a different portion. The finite area of screen
+ through which you can see part of the buffer is called 202/the window201/, and the
+ choice of where in the buffer to start displaying is also called 202/the window201/.
+
+ The basic display control command is C-L (203/nmode-refresh-command201/). In its
+ simplest form, with no argument, it clears the screen and tells NMODE to
+ choose a new window position. If enough of the buffer is above point,
+ NMODE will pick the window's position in the file so that point is about
+ two-thirds of the way down the screen. If there is not enough of the buffer
+ above point to fill up two-thirds of the screen, NMODE will pick the window
+ position so that point is one-third of the way down the screen. If there isn't
+ even enough of the buffer above point to fill a third of the screen, NMODE
+ will put the top of the buffer at the top of the screen and let point fall
+ where it may.
+
+ Another command that can be used to help clear up the screen is ESC-J
+ (203/nmode-full-refresh201/). This clears and rewrites the display, but without
+ changing the portion of the buffer displayed on the screen.
+
+ C-L with a positive argument chooses a new window so as to put point that
+ many lines from the top. An argument of zero puts point on the very top
+ line. Point does not move with respect to the text; rather, the text and
+ point move rigidly on the screen. C-L with a negative argument puts point
+ that many lines from the bottom of the window. For example, C-U -1 C-L
+ puts point on the bottom line, and C-U -5 C-L puts it five lines from the
+ bottom. C-L with an argument does not clear the screen, so that it can move
+ the text on the screen instead of printing it again if the terminal allows that.
+ 201/Page 17-2 NMODE Manual (Controlling the Display)
+
+
+ The 202/scrolling 201/commands C-V and M-V let you move the whole display up or
+ down a few lines. C-V (203/next-screen-command201/) with an argument shows you
+ that many more lines at the bottom of the screen, moving the text and point
+ up together as C-L might. C-V with a negative argument shows you more
+ lines at the top of the screen, as does Meta-V (203/previous-screen-command201/)
+ with a positive argument.
+
+ There are two other commands that let you move the whole display up or
+ down by a few lines. These are ESC-S (203/scroll-window-up-line-command201/) and
+ ESC-T (203/scroll-window-down-line-command201/). These move text and point
+ together up and down respectively relative to the screen.
+
+ To read the buffer a screenful at a time, use the C-V command with no
+ argument. Each C-V shows the "next screenful" of text. Point is put at the
+ same point on the screen as on the previous screen. To move backward, use
+ M-V without an argument, which moves a whole screenful backwards.
+
+ To move by multiple screenfuls in the buffer, ESC-U
+ (203/scroll-window-up-page-command201/) and ESC-V
+ (203/scroll-window-down-page-command201/) can be used. These functions accept
+ command arguments and then move the text in the screen up or down by
+ command-argument pages. They will reverse direction if given negative
+ arguments.
+
+ In Lisp mode, one can use the C-M-R command
+ (203/reposition-window-command201/) to scroll the buffer so that the current function
+ (defun) is positioned conveniently on the screen. This command tries to get
+ as much as possible of the current function, preferring the beginning to the
+ end, but not moving point off the screen.
+
+ There are also commands to scroll the window horizontally. C-X <
+ (203/scroll-window-left-command201/) and C-X > (203/scroll-window-right-command201/).
+ These scroll the portion of the buffer viewed by the screen to the left or
+ right respectively. These commands have the opposite movement conventions
+ from the other scrolling commands. In all the other commands, one gets the
+ correct direction of movement by imagining that it is the characters visible on
+ the CRT that are moving. For these commands one should think of the
+ screen as a movable hole looking at the buffer, and it is the movement of the
+ hole that is named by the commands.
+
+ C-L in all its forms changes the position of point on the screen, carrying
+ the text with it. Another command moves point the same way but leaves the
+ text fixed. It is called Meta-R (203/move-to-screen-edge-command201/). With no
+ argument, it puts point in the line at the center of the screen, at the
+ current vertical column. An argument is used to specify the line to put it
+ on, counting from the top if the argument is positive, or from the bottom if it
+ is negative. Thus, Meta-R with an argument of 0 puts point on the top line
+ of the screen. Meta-R never causes any text to move on the screen; it
+ causes point to move with respect to the screen and the text.
ADDED psl-1983/3-1/doc/nmode/nm-display.key
Index: psl-1983/3-1/doc/nmode/nm-display.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-display.key
@@ -0,0 +1,12 @@
+.silent_index {C-L} idx 17-1
+.silent_index {ESC-J} idx 17-1
+.silent_index {C-V} idx 17-2
+.silent_index {M-V} idx 17-2
+.silent_index {ESC-S} idx 17-2
+.silent_index {ESC-T} idx 17-2
+.silent_index {ESC-U} idx 17-2
+.silent_index {ESC-V} idx 17-2
+.silent_index {C-M-R} idx 17-2
+.silent_index {C-X} idx 17-2
+.silent_index {C-X} idx 17-2
+.silent_index {M-R} idx 17-2
ADDED psl-1983/3-1/doc/nmode/nm-display.r
Index: psl-1983/3-1/doc/nmode/nm-display.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-display.r
@@ -0,0 +1,156 @@
+.so pndoc:nman
+.part NM-DISPLAY manual
+@Chapter[Controlling the Display]
+@node("display")
+@index{scrolling}
+@index{screen}
+ Since only part of a large file fits on the screen, NMODE tries to
+show the part that is likely to be interesting. The display control
+commands allow you to ask to see a different part of the file.
+@Commands[
+C-L Clear and redisplay screen, putting point at a specified vertical position.
+
+ESC-J Clear and rewrite display, but without moving text or point.
+
+C-V Scroll forwards (a screen or a few lines).
+
+M-V Scroll backwards.
+
+M-R Move point to the text at a given vertical position.
+
+C-M-R Shift the function point is in onto the screen.
+
+ESC-S scroll window up line
+
+ESC-T scroll window down line
+
+ESC-U scroll window up page
+
+ESC-V scroll window down page
+
+C-X < scroll window left
+
+C-X > scroll window right
+]
+ The terminal screen is rarely large enough to display all of your
+file. If the whole buffer doesn't fit on the screen, NMODE shows a
+contiguous portion of it, containing point. It continues to
+show approximately the same portion until point moves outside of
+it; then NMODE chooses a new portion centered around the new
+point. This is NMODE's guess as to what you are most interested in
+seeing. But if the guess is wrong, you can use the display control
+commands to see a different portion. The finite area of screen
+through which you can see part of the buffer is called @dfn[the window],
+and the choice of where in the buffer to start displaying is also
+called @dfn[the window].
+
+@keyindex{C-L}
+@index{clear screen}
+@fncindex{nmode-refresh-command}
+ The basic display control command is C-L
+(@fnc{nmode-refresh-command}). In its simplest form, with no
+argument, it clears the screen and tells NMODE to choose a new window
+position. If enough of the buffer is above point, NMODE will pick the
+window's position in the file so that point is about two-thirds of the
+way down the screen. If there is not enough of the buffer above point
+to fill up two-thirds of the screen, NMODE will pick the window
+position so that point is one-third of the way down the screen. If
+there isn't even enough of the buffer above point to fill a third of
+the screen, NMODE will put the top of the buffer at the top of the
+screen and let point fall where it may.
+
+@keyindex{ESC-J}
+@fncindex{nmode-full-refresh}
+ Another command that can be used to help clear up the screen is ESC-J
+(@fnc{nmode-full-refresh}). This clears and rewrites the display, but
+without changing the portion of the buffer displayed on the screen.
+
+@index{numeric arguments}
+ C-L with a positive argument chooses a new window so as to put point
+that many lines from the top. An argument of zero puts point on the
+very top line. Point does not move with respect to the text;
+rather, the text and point move rigidly on the screen. C-L with a
+negative argument puts point that many lines from the bottom of the
+window. For example, @w[C-U -1] C-L puts point on the bottom line, and
+@w[C-U -5] C-L puts it five lines from the bottom. C-L with an argument
+does not clear the screen, so that it can move the text on the screen
+instead of printing it again if the terminal allows that.
+
+@keyindex{C-V}
+@keyindex{M-V}
+@fncindex{next-screen-command}
+@fncindex{previous-screen-command}
+@index{Scrolling}
+ The @dfn[scrolling] commands C-V and M-V let you move the whole
+display up or down a few lines. C-V (@fnc{next-screen-command}) with an
+argument shows you that many more lines at the bottom of the screen,
+moving the text and point up together as C-L might. C-V with a
+negative argument shows you more lines at the top of the screen, as
+does Meta-V (@fnc{previous-screen-command}) with a positive argument.
+
+@keyindex{ESC-S}
+@fncindex{scroll-window-up-line-command}
+@keyindex{ESC-T}
+@fncindex{scroll-window-down-line-command}
+ There are two other commands that let you move the whole display up
+or down by a few lines. These are ESC-S
+(@fnc{scroll-window-up-line-command}) and ESC-T
+(@fnc{scroll-window-down-line-command}). These move text and point
+together up and down respectively relative to the screen.
+
+ To read the buffer a screenful at a time, use the C-V command with
+no argument. Each C-V shows the "next screenful" of text. Point is
+put at the same point on the screen as on the previous screen. To
+move backward, use M-V without an argument, which moves a whole
+screenful backwards.
+
+@keyindex{ESC-U}
+@fncindex{scroll-window-up-page-command}
+@keyindex{ESC-V}
+@fncindex{scroll-window-down-page-command}
+ To move by multiple screenfuls in the buffer, ESC-U
+(@fnc{scroll-window-up-page-command}) and ESC-V
+(@fnc{scroll-window-down-page-command}) can be used. These functions
+accept command arguments and then move the text in the screen up or
+down by command-argument pages. They will reverse direction if given
+negative arguments.
+
+@keyindex{C-M-R}
+@fncindex{reposition-window-command}
+ In Lisp mode, one can
+use the C-M-R command
+(@fnc{reposition-window-command})
+to scroll the buffer so that the current function (defun) is
+positioned conveniently on the screen. This command tries to get as much
+as possible of the current function, preferring the beginning to the
+end, but not moving point off the screen.
+
+@keyindex{C-X <}
+@fncindex{scroll-window-left-command}
+@keyindex{C-X >}
+@fncindex{scroll-window-right-command}
+ There are also commands to scroll the window horizontally. C-X <
+(@fnc{scroll-window-left-command}) and C-X >
+(@fnc{scroll-window-right-command}). These scroll the portion of the
+buffer viewed by the screen to the left or right respectively. These
+commands have the opposite movement conventions from the other
+scrolling commands. In all the other commands, one gets the correct
+direction of movement by imagining that it is the characters visible
+on the CRT that are moving. For these commands one should think of
+the screen as a movable hole looking at the buffer, and it is the
+movement of the hole that is named by the commands.
+
+@keyindex{M-R}
+@fncindex{move-to-screen-edge-command}
+ C-L in all its forms changes the position of point on the screen,
+carrying the text with it. Another command moves point the same way
+but leaves the text fixed. It is called Meta-R
+(@fnc{move-to-screen-edge-command}).
+With no argument, it puts point in the line
+at the center of the screen, at the current vertical column.
+An argument is used to specify the line
+to put it on, counting from the top if the argument is positive, or
+from the bottom if it is negative. Thus, Meta-R with an argument of 0
+puts point on the top line of the screen. Meta-R never causes
+any text to move on the screen; it causes point to move with respect
+to the screen and the text.
ADDED psl-1983/3-1/doc/nmode/nm-display.topic
Index: psl-1983/3-1/doc/nmode/nm-display.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-display.topic
@@ -0,0 +1,5 @@
+.silent_index {scrolling} idx 17-1
+.silent_index {screen} idx 17-1
+.silent_index {clear} idx 17-1
+.silent_index {numeric} idx 17-1
+.silent_index {Scrolling} idx 17-2
ADDED psl-1983/3-1/doc/nmode/nm-editing.contents
Index: psl-1983/3-1/doc/nmode/nm-editing.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-editing.contents
@@ -0,0 +1,6 @@
+contents_entry(0 4 {Basic Editing Commands} 4-1)
+contents_entry(1 4.1 {Inserting Text} 4-1)
+contents_entry(1 4.2 {Moving The Cursor} 4-1)
+contents_entry(1 4.3 {Erasing Text} 4-2)
+contents_entry(1 4.4 {Files} 4-3)
+contents_entry(1 4.5 {Using Blank Lines Can Make Editing Faster} 4-3)
ADDED psl-1983/3-1/doc/nmode/nm-editing.function
Index: psl-1983/3-1/doc/nmode/nm-editing.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-editing.function
@@ -0,0 +1,20 @@
+.silent_index {delete-backward-character-command} idx 4-1
+.silent_index {return-command} idx 4-1
+.silent_index {insert-next-character-command} idx 4-1
+.silent_index {move-down-command} idx 4-1
+.silent_index {move-to-start-of-line-command} idx 4-1
+.silent_index {move-to-end-of-line-command} idx 4-1
+.silent_index {move-forward-character-command} idx 4-1
+.silent_index {move-backward-character-command} idx 4-1
+.silent_index {move-down-extending-command} idx 4-1
+.silent_index {move-up-command} idx 4-1
+.silent_index {nmode-refresh-command} idx 4-1
+.silent_index {transpose-characters-command} idx 4-1
+.silent_index {move-to-buffer-start-command} idx 4-1
+.silent_index {move-to-buffer-end-command} idx 4-1
+.silent_index {set-goal-column-command} idx 4-2
+.silent_index {what-cursor-position-command} idx 4-2
+.silent_index {visit-file-command} idx 4-3
+.silent_index {save-file-command} idx 4-3
+.silent_index {open-line-command} idx 4-3
+.silent_index {delete-blank-lines-command} idx 4-3
ADDED psl-1983/3-1/doc/nmode/nm-editing.ibm
Index: psl-1983/3-1/doc/nmode/nm-editing.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-editing.ibm
@@ -0,0 +1,170 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-EDITING.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Basic Editing Commands) Page 4-1
+
+
+ 202/4. Basic Editing Commands
+
+ 201/We now give the basics of how to enter text, make corrections, and save
+ the text in a file. If this material is new to you, you might learn it more
+ easily by running the NTEACH program.
+
+ 202/4.1 Inserting Text
+
+ 201/To insert printing characters into the text you are editing, just type them.
+ When the selected buffer is an editing buffer, all printing characters you
+ type are inserted into the text at the cursor (that is, at 202/point201/), and the
+ cursor moves forward. Any characters after the cursor move forward too.
+ If the text in the buffer is FOOBAR, with the cursor before the B, then if
+ you type XX, you get FOOXXBAR, with the cursor still before the B.
+
+ To correct text you have just inserted, you can use Backspace. Backspace
+ deletes the character 203/before 201/the cursor (not the one that the cursor is on top
+ of or under; that is the character 203/after 201/the cursor). The cursor and all
+ characters after it move backwards. Therefore, if you type a printing
+ character and then type Backspace, they cancel out.
+
+ To end a line and start typing a new one, type Return (Customizers, note:
+ this runs the function 203/return-command201/). Return operates by inserting a line
+ separator, so if you type Return in the middle of a line, you break the line
+ in two.
+
+ If you add too many characters to one line, without breaking it with a
+ Return, the line will display a "!" at the extreme right margin. This does
+ not stop you from adding further characters, but those characters will not be
+ visible until the line is somehow broken, or until you scroll the window
+ horizontally using C-X >.
+
+ Direct insertion works for printing characters and space, but other
+ characters act as editing commands and do not insert themselves. If you
+ need to insert a control character, Altmode, Tab, Backspace or Rubout, you
+ must 202/quote 201/it by typing the Control-Q (203/insert-next-character-command201/)
+ command first. See Section 3 [Control], page 1.
+
+ 202/4.2 Moving The Cursor
+
+ 201/To do more than insert characters, you have to know how to move the
+ cursor. Here are a few of the commands for doing that.
+
+
+ C-A Move to the beginning of the line.
+ C-E Move to the end of the line.
+ C-F Move forward over one character.
+ ESC-C Same as C-F.
+ Many terminals have an arrow key pointing right which
+ sends
+ this escape sequence.
+ 201/Page 4-2 NMODE Manual (Moving The Cursor)
+
+
+ C-B Move backward over one character.
+ ESC-D Same as C-B.
+ Many terminals have an arrow key pointing left which sends
+ this escape sequence.
+ C-N Move down one line, vertically. If you start in the middle of
+ one line, you end in the middle of the next. From the last
+ line of text, it creates a new line.
+ ESC-B Same as C-N except that it will not create a new line.
+ Many terminals have an arrow key pointing down which
+ sends
+ this escape sequence.
+ C-P Move up one line, vertically.
+ ESC-A Same as C-P.
+ Many terminals have an arrow key pointing up which sends
+ this escape sequence.
+ C-L Clear the screen and reprints everything. C-U C-L reprints
+ just the line that the cursor is on.
+ C-T Transpose two characters (the ones before and after the
+ cursor).
+ M-< Move to the top of your text.
+ M-> Move to the end of your text.
+
+ There is a special command: C-X C-N (203/set-goal-column-command201/), which
+ affects how C-P, ESC-A, C-N, and ESC-B act. Without an argument, C-X
+ C-N will store the current column so that the vertical movement commands will
+ try to move into it when they move point up or down, regardless of the
+ column that point is in prior to the vertical movement. To remove the goal
+ column, give the C-X C-N command with an argument.
+
+ There is a command, C-X = (203/what-cursor-position-command201/), which is
+ normally used to obtain information about where one is in a buffer. If given
+ an argument, however, it will treat the argument as a line-number and it will
+ jump to the corresponding line.
+
+ 202/4.3 Erasing Text
+
+ 201/Backspace Delete the character before the cursor.
+ C-D Delete the character after the cursor.
+ C-K Kill to the end of the line.
+
+ You already know about the Backspace command which deletes the character
+ before the cursor. Another command, Control-D, deletes the character after
+ the cursor, causing the rest of the text on the line to shift left. If
+ Control-D is typed at the end of a line, that line and the next line are joined
+ together.
+
+ To erase a larger amount of text, use the Control-K command, which kills a
+ line at a time. If Control-K is done at the beginning or middle of a line, it
+ kills all the text up to the end of the line. If Control-K is done at the end
+ of a line, it joins that line and the next line. See Section 11 [Killing], page
+ 1, for more flexible ways of killing text.
+ 201/NMODE Manual (Files) Page 4-3
+
+
+ 202/4.4 Files
+
+ 201/The commands above are sufficient for creating text in the NMODE buffer.
+ The more advanced NMODE commands just make things easier. But to keep
+ any text permanently you must put it in a 202/file201/. Files are the objects which
+ the operating system uses for storing data for communication between
+ different programs or to hold onto for a length of time. To tell NMODE to
+ edit text in a file, choose a 202/filename201/, such as FOO, and type C-X C-V
+ FOO<CR>. This 202/visits 201/the file FOO so that its contents appear on the screen
+ for editing. You can make changes, and then 202/save 201/the file by typing C-X
+ C-S. This makes the changes permanent and actually changes the file FOO.
+ Until then, the changes are only inside your NMODE, and the file FOO is not
+ really changed. If the file FOO doesn't exist, and you want to create it,
+ visit it as if it did exist. When you save your text with C-X C-S the file
+ will be created.
+
+ Of course, there is a lot more to learn about using files. See Section 15
+ [Files], page 1.
+
+ 202/4.5 Using Blank Lines Can Make Editing Faster
+
+ 201/C-O Insert one or more blank lines after the cursor.
+ C-X C-O Delete all but one of many consecutive blank lines.
+
+ It is much more efficient to insert text at the end of a line than in the
+ middle. So if you want to stick a new line before an existing one, the best
+ way is to make a blank line there first and then type the text into it, rather
+ than inserting the new text at the beginning of the existing line and finally
+ inserting a line separator. Making the blank line first also makes the
+ meaning of the text clearer while you are typing it in.
+
+ To make a blank line, you can type Return and then C-B. But there is a
+ single character for this: C-O (Customizers: this is the function
+ 203/open-line-command201/) So, FOO<CR> is equivalent to C-O FOO C-F.
+
+ If you want to insert many lines, you can type many C-O's at the
+ beginning (or you can give C-O an argument to tell it how many blank lines
+ to make. See Section 5 [Arguments], page 1, for how). As you then insert
+ lines of text, you will notice that Return behaves strangely: it "uses up" the
+ blank lines instead of pushing them down.
+
+ If you don't use up all the blank lines, you can type C-X C-O (the
+ function 203/delete-blank-lines-command201/) to get rid of all but one. When point is
+ on a blank line, C-X C-O replaces all the blank lines around that one with a
+ single blank line. When point is on a nonblank line, C-X C-O deletes any
+ blank lines following that nonblank line.
ADDED psl-1983/3-1/doc/nmode/nm-editing.key
Index: psl-1983/3-1/doc/nmode/nm-editing.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-editing.key
@@ -0,0 +1,23 @@
+.silent_index {C-Q} idx 4-1
+.silent_index {C-A} idx 4-1
+.silent_index {C-E} idx 4-1
+.silent_index {C-F} idx 4-1
+.silent_index {ESC-C} idx 4-1
+.silent_index {C-B} idx 4-1
+.silent_index {ESC-D} idx 4-1
+.silent_index {C-N} idx 4-1
+.silent_index {ESC-B} idx 4-1
+.silent_index {C-P} idx 4-1
+.silent_index {ESC-A} idx 4-1
+.silent_index {C-L} idx 4-1
+.silent_index {C-T} idx 4-1
+.silent_index {M->} idx 4-1
+.silent_index {M-<} idx 4-1
+.silent_index {C-X} idx 4-2
+.silent_index {C-X} idx 4-2
+.silent_index {C-D} idx 4-2
+.silent_index {C-K} idx 4-2
+.silent_index {C-X} idx 4-3
+.silent_index {C-X} idx 4-3
+.silent_index {C-O} idx 4-3
+.silent_index {C-X} idx 4-3
ADDED psl-1983/3-1/doc/nmode/nm-editing.r
Index: psl-1983/3-1/doc/nmode/nm-editing.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-editing.r
@@ -0,0 +1,231 @@
+.so pndoc:nman
+.part NM-EDITING manual
+@Chapter[Basic Editing Commands]
+@node("editing")
+@node("basic")
+ We now give the basics of how to enter text, make corrections, and
+save the text in a file. If this material is new to you, you might
+learn it more easily by running the NTEACH program.
+@Section[Inserting Text]
+@index{insertion}
+@index{point}
+@index{cursor}
+@index{printing characters}
+ To insert printing characters into the text you are editing, just
+type them.
+When the selected buffer is an editing buffer,
+ When NMODE is in either Text or Lisp mode,
+all printing characters you
+type are inserted into the text at the cursor (that is, at
+@dfn[point]), and the cursor moves forward.
+Any characters after the
+cursor move forward too. If the text in the buffer is FOOBAR, with
+the cursor before the B, then if you type XX, you get FOOXXBAR, with
+the cursor still before the B.
+
+@index{Backspace}
+@index{deletion}
+@fncindex{delete-backward-character-command}
+ To correct text you have just inserted, you can use Backspace. Backspace
+deletes the character @xxii[before] the cursor (not the one that the cursor
+is on top of or under; that is the character @xxii[after] the cursor). The
+cursor and all characters after it move backwards. Therefore, if you
+type a printing character and then type Backspace, they cancel out.
+
+@index{@Return1{}}
+@index{CRLF}
+@fncindex{return-command}
+@index{line separator}
+ To end a line and start typing a new one, type @Return3{} (Customizers,
+note: this runs the function @fnc{return-command}). @Return3{} operates by
+inserting a line separator, so if you type @Return3{} in the middle of a
+line, you break the line in two.
+
+@index{!}
+ If you add too many characters to one line, without breaking it with
+a @Return3{}, the line
+will display a "!" at the extreme right margin.
+This does not stop you from adding further characters,
+but those characters will not be visible until the line is somehow broken,
+or until you scroll the window horizontally using C-X >.
+
+@index{Quoting}
+@index{Control characters, inserting}
+@keyindex{C-Q}
+@fncindex{insert-next-character-command}
+ Direct insertion works for printing characters and space, but other
+characters act as editing commands and do not insert themselves. If
+you need to insert a control character, Altmode, Tab, Backspace
+or Rubout, you
+must @dfn[quote] it by typing the Control-Q
+(@fnc{insert-next-character-command})
+command first. @Note("Characters" "Control").
+@Section[Moving The Cursor]
+ To do more than insert characters, you have to know how to move the
+cursor. Here are a few of the commands for doing that.
+
+@keyindex{C-A}
+@keyindex{C-E}
+@keyindex{C-F}
+@keyindex{ESC-C}
+@keyindex{C-B}
+@keyindex{ESC-D}
+@keyindex{C-N}
+@keyindex{ESC-B}
+@keyindex{C-P}
+@keyindex{ESC-A}
+@keyindex{C-L}
+@keyindex{C-T}
+@keyindex{M->}
+@keyindex{M-<}
+@fncindex{move-down-command}
+@fncindex{move-to-start-of-line-command}
+@fncindex{move-to-end-of-line-command}
+@fncindex{move-forward-character-command}
+@fncindex{move-backward-character-command}
+@fncindex{move-down-extending-command}
+@fncindex{move-up-command}
+@fncindex{nmode-refresh-command}
+@fncindex{transpose-characters-command}
+@fncindex{move-to-buffer-start-command}
+@fncindex{move-to-buffer-end-command}
+@Commands[
+C-A Move to the beginning of the line.
+
+C-E Move to the end of the line.
+
+C-F Move forward over one character.
+
+ESC-C Same as C-F.
+ Many terminals have an arrow key pointing right which sends
+ this escape sequence.
+
+C-B Move backward over one character.
+
+ESC-D Same as C-B.
+ Many terminals have an arrow key pointing left which sends
+ this escape sequence.
+
+C-N Move down one line, vertically. If you start in the
+middle of one line, you end in the middle of the next.
+From the last line of text, it creates a new line.
+
+ESC-B Same as C-N except that it will not create a new line.
+ Many terminals have an arrow key pointing down which sends
+ this escape sequence.
+
+C-P Move up one line, vertically.
+
+ESC-A Same as C-P.
+ Many terminals have an arrow key pointing up which sends
+ this escape sequence.
+
+C-L Clear the screen and reprints everything.
+@w[C-U C-L] reprints just the line that the cursor is on.
+
+C-T Transpose two characters
+(the ones before and after the cursor).
+
+M-< Move to the top of your text.
+
+M-> Move to the end of your text.
+]
+@keyindex{C-X C-N}
+@fncindex{set-goal-column-command}
+ There is a special command: C-X C-N (@fnc{set-goal-column-command}),
+which affects how C-P, ESC-A, C-N, and ESC-B act. Without an argument,
+C-X C-N will store the current column so that the vertical movement
+commands will try to move into it when they move point up or down,
+regardless of the column that point is in prior to the vertical movement.
+To remove the goal column, give the C-X C-N command with an argument.
+
+@keyindex{C-X =}
+@fncindex{what-cursor-position-command}
+ There is a command, C-X = (@fnc{what-cursor-position-command}), which is
+normally used to obtain information about where one is in a buffer.
+If given an argument, however, it will treat the argument as a line-number and
+it will jump to the corresponding line.
+@Section[Erasing Text]
+@Commands[
+Backspace Delete the character before the cursor.
+
+C-D Delete the character after the cursor.
+
+C-K Kill to the end of the line.
+]
+@Index{Backspace}
+@Keyindex{C-D}
+@Keyindex{C-K}
+ You already know about the Backspace command which deletes the
+character before the cursor. Another command, Control-D, deletes the
+character after the cursor, causing the rest of the text on the line
+to shift left. If Control-D is typed at the end of a line, that line
+and the next line are joined together.
+
+ To erase a larger amount of text, use the Control-K command, which
+kills a line at a time. If Control-K is done at the beginning or
+middle of a line, it kills all the text up to the end of the line. If
+Control-K is done at the end of a line, it joins that line and the
+next line.
+@Note("Killing"), for more flexible ways of killing text.
+@Section[Files]
+@index{files}
+@keyindex{C-X C-V}
+@index{visiting}
+@keyindex{C-X C-S}
+@fncindex{visit-file-command}
+@fncindex{save-file-command}
+ The commands above are sufficient for creating text in the NMODE
+buffer. The more advanced NMODE commands just make things easier.
+But to keep any text permanently you must put it in a @dfn[file].
+Files are the objects which the operating system uses for storing
+data for communication between different programs or to hold onto for a
+length of time. To tell NMODE to edit text in a file, choose a
+@dfn[filename], such as FOO, and type C-X C-V
+FOO@return2{}. This @dfn[visits] the file FOO
+so that its
+contents appear on the screen for editing. You can make changes, and
+then @dfn[save] the file by typing C-X C-S. This makes the changes
+permanent and actually changes the file FOO. Until then,
+the changes are only inside your NMODE, and the file FOO
+is not really changed. If the file FOO doesn't exist,
+and you want to create it, visit it as if it did exist. When you save
+your text with C-X C-S the file will be created.
+
+ Of course, there is a lot more to learn about using files.
+@Note("Files").
+@Section[Using Blank Lines Can Make Editing Faster]
+@WideCommands[
+C-O Insert one or more blank lines after the cursor.
+
+C-X C-O Delete all but one of many consecutive blank lines.
+]
+@keyindex{C-O}
+@keyindex{C-X C-O}
+@index{blank lines}
+@fncindex{open-line-command}
+@fncindex{delete-blank-lines-command}
+ It is much more efficient to
+insert text at the end of a line than in the middle. So if you want
+to stick a new line before an existing one, the best way is to make a
+blank line there first and then type the text into it, rather than
+inserting the new text at the beginning of the existing line and finally
+inserting a line separator. Making the blank line first also makes
+the meaning of the text clearer while you are typing it in.
+
+ To make a blank line, you can type @Return3{} and then C-B. But there
+is a single character for this: C-O (Customizers: this is the function
+@fnc{open-line-command})
+So, FOO@Return2{} is equivalent to C-O FOO C-F.
+
+ If you want to insert many lines, you can type many C-O's at the
+beginning (or you can give C-O an argument to tell it how many blank
+lines to make. @Note("Arguments"), for how). As you then insert
+lines of text, you will notice that @Return3{} behaves strangely: it "uses
+up" the blank lines instead of pushing them down.
+
+ If you don't use up all the blank lines, you can type C-X C-O (the
+function @fnc{delete-blank-lines-command}) to get rid of all but one. When
+point is on a blank line, C-X C-O replaces all the blank lines around
+that one with a single blank line. When point is on a nonblank line,
+C-X C-O deletes any blank lines following that nonblank line.
ADDED psl-1983/3-1/doc/nmode/nm-editing.topic
Index: psl-1983/3-1/doc/nmode/nm-editing.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-editing.topic
@@ -0,0 +1,16 @@
+.silent_index {insertion} idx 4-1
+.silent_index {point} idx 4-1
+.silent_index {cursor} idx 4-1
+.silent_index {printing} idx 4-1
+.silent_index {Backspace} idx 4-1
+.silent_index {deletion} idx 4-1
+.silent_index {Return1{}} idx 4-1
+.silent_index {CRLF} idx 4-1
+.silent_index {line} idx 4-1
+.silent_index {!} idx 4-1
+.silent_index {Quoting} idx 4-1
+.silent_index {Control} idx 4-1
+.silent_index {Backspace} idx 4-2
+.silent_index {files} idx 4-3
+.silent_index {visiting} idx 4-3
+.silent_index {blank} idx 4-3
ADDED psl-1983/3-1/doc/nmode/nm-files.contents
Index: psl-1983/3-1/doc/nmode/nm-files.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-files.contents
@@ -0,0 +1,9 @@
+contents_entry(0 15 {File Handling} 15-1)
+contents_entry(1 15.1 {Visiting Files} 15-1)
+contents_entry(1 15.2 {How to Undo Drastic Changes to a File} 15-2)
+contents_entry(1 15.3 {Listing a File Directory} 15-2)
+contents_entry(1 15.4 {DIRED, the Directory Editor Subsystem} 15-2)
+contents_entry(2 15.4.1 {Basic DIRED Commands} 15-2)
+contents_entry(2 15.4.2 {Other DIRED Commands} 15-3)
+contents_entry(2 15.4.3 {Invoking DIRED} 15-3)
+contents_entry(1 15.5 {Miscellaneous File Operations} 15-3)
ADDED psl-1983/3-1/doc/nmode/nm-files.function
Index: psl-1983/3-1/doc/nmode/nm-files.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-files.function
@@ -0,0 +1,16 @@
+.silent_index {visit-file-command} idx 15-1
+.silent_index {save-file-command} idx 15-1
+.silent_index {buffer-not-modified-command} idx 15-2
+.silent_index {revert-file-command} idx 15-2
+.silent_index {dired-command} idx 15-2
+.silent_index {edit-directory-command} idx 15-2
+.silent_index {dired-command} idx 15-3
+.silent_index {write-file-command} idx 15-3
+.silent_index {insert-file-command} idx 15-4
+.silent_index {write-region-command} idx 15-4
+.silent_index {append-to-file-command} idx 15-4
+.silent_index {prepend-to-file-command} idx 15-4
+.silent_index {set-visited-filename-command} idx 15-4
+.silent_index {delete-file-command} idx 15-4
+.silent_index {delete-and-expunge-file-command} idx 15-4
+.silent_index {undelete-file-command} idx 15-4
ADDED psl-1983/3-1/doc/nmode/nm-files.ibm
Index: psl-1983/3-1/doc/nmode/nm-files.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-files.ibm
@@ -0,0 +1,216 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-FILES.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (File Handling) Page 15-1
+
+
+ 202/15. File Handling
+
+ 201/The basic unit of stored data is the file. Each program, each paper, lives
+ usually in its own file. To edit a program or paper, the editor must be told
+ the name of the file that contains it. This is called 202/visiting 201/the file. To
+ make your changes to the file permanent on disk, you must 202/save 201/the file.
+ NMODE also has facilities for deleting files conveniently, and for listing your
+ file directory.
+
+ 202/15.1 Visiting Files
+
+ 201/C-X C-V Visit a file.
+ C-X C-S Save the visited file.
+ Meta-~ Tell NMODE to forget that the buffer has been changed.
+
+ 202/Visiting 201/a file means copying its contents into NMODE where you can edit
+ them. NMODE remembers the name of the file you visited. Unless you use
+ the multiple buffer or window features of NMODE, you can only be visiting
+ one file at a time. The name of the file you are visiting in the currently
+ selected buffer is visible in the mode line.
+
+ The changes you make with NMODE are made in a copy inside NMODE. The
+ file itself is not changed. The changed text is not permanent until you 202/save
+ 201/it in a file. The first time you change the text, a star appears at the end of
+ the mode line; this indicates that the text contains fresh changes which will
+ be lost unless you save them.
+
+ To visit a file, use the command C-X C-V (203/visit-file-command201/). Follow the
+ command with the name of the file you wish to visit, terminated by a Return.
+ After C-X C-V is entered, 203/visit-file-command 201/will display a prompt. This
+ prompt may contain a default filename, if so then any component of the
+ filename which you don't specify is taken from it. You can abort the
+ command by typing C-G, or edit the filename with normal NMODE editing
+ commands. If you do type a Return to finish the command, the new file's
+ text appears on the screen, and its name appears in the mode line.
+
+ When you wish to save the file and make your changes permanent, type
+ C-X C-S (203/save-file-command201/). After the save is finished, C-X C-S prints
+ "Written: <filename>" in the echo area at the bottom of the screen. If there
+ are no changes to save (no star at the end of the mode line), the file is not
+ saved; it would be redundant to save a duplicate of the previous version.
+
+ What if you want to create a file? Just visit it. NMODE prints "(New
+ File)" but aside from that behaves as if you had visited an existing empty
+ file. If you make any changes and save them, the file is created. If you
+ visit a nonexistent file unintentionally (because you typed the wrong file
+ name), go ahead and visit the file you meant. If you don't save the
+ unwanted file, it is not created.
+
+ If you alter one file and then visit another in the same buffer, NMODE
+ offers to save the old one. If you answer YES, the old file is saved; if you
+ answer NO, all the changes you have made to it since the last save are lost.
+ 201/Page 15-2 NMODE Manual (Visiting Files)
+
+
+ Sometimes you will change a buffer by accident. Even if you undo the
+ change by hand, NMODE still knows that "the buffer has been changed".
+ You can tell NMODE to believe that there have been no changes with the
+ Meta-~ (203/buffer-not-modified-command201/) command. This command simply clears
+ the "modified" flag which says that the buffer contains changes which need to
+ be saved. Even if the buffer really 203/is 201/changed NMODE will still act as if it
+ were not. If we take "~" to mean "not", then Meta-~ is "not", metafied.
+
+ 202/15.2 How to Undo Drastic Changes to a File
+
+ 201/If you have made extensive changes to a file and then change your mind
+ about them, you can get rid of them by reading in the previous version of
+ the file. To do this, use M-X Revert File (203/revert-file-command201/).
+
+ M-X Revert File does not change point, so that if the file was only edited
+ slightly, you will be at approximately the same piece of text after the Revert
+ as before. If you have made drastic changes, the same value of point in the
+ old file may address a totally different piece of text.
+
+ 202/15.3 Listing a File Directory
+
+ 201/To look at a file directory, use the C-X D command (203/dired-command201/). With
+ no argument, it shows you the directory of the file you are visiting. C-U
+ C-X D reads a directory specification from the keyboard and shows you the
+ files related to that directory specification. M-X DIRED
+ (203/edit-directory-command201/) differs in that it prompts for a directory
+ specification even without an argument.
+
+ 202/15.4 DIRED, the Directory Editor Subsystem
+
+ 201/DIRED makes it easy to delete many of the files in a single directory at
+ once. It presents a copy of a listing of the directory, which you can move
+ around in, marking files for deletion. When you are satisfied, you can tell
+ DIRED to go ahead and delete the marked files.
+
+ Invoke DIRED with C-X D or M-X DIRED<CR><CR> to edit the current
+ default directory, or M-X DIRED<CR><dir><CR> to edit directory <dir>. You
+ are then given a listing of the directory which you can move around in with
+ all the normal NMODE motion commands. Some NMODE commands are made
+ undefined and others do special things, but it's still a recursive editing level
+ which you can exit normally with Q.
+
+ 202/15.4.1 Basic DIRED Commands
+
+ 201/You can mark a file for deletion by moving to the line describing the file
+ and typing D. The deletion mark is visible as a D at the beginning of the
+ line. Point is moved to the beginning of the next line, so that several D's
+ delete several files. Alternatively, if you give D an argument it marks that
+ many consecutive files. Given a negative argument, it marks the preceding
+ file (or several files) and puts point at the first (in the buffer) line marked.
+ Most of the DIRED commands (D, U, E, Space) repeat this way with numeric
+ arguments.
+ 201/NMODE Manual (Basic DIRED Commands) Page 15-3
+
+
+ If you wish to remove a deletion mark, use the U (for Undelete) command,
+ which is invoked like D: it removes the deletion mark from the current line
+ (or next few lines, if given an argument). The Rubout command removes the
+ deletion mark from the previous line, moving up to that line. Thus, a
+ Rubout after a D precisely cancels the D.
+
+ For extra convenience, Space is made a command similar to C-N. Moving
+ down a line is done so often in DIRED that it deserves to be easy to type.
+ Rubout is often useful simply for moving up.
+
+ If you are not sure whether you want to delete a file, you can examine it
+ by typing E. This enters a recursive editing mode on the file, which you
+ can exit with C-M-L. This also allows you to modify files. When you exit
+ the recursive editing level, you return to DIRED.
+
+ When you have marked the files you wish to mark, you can exit DIRED with
+ Q. If any files were marked for deletion, DIRED lists them in a concise
+ format, several per line. You can type "YES" (Just "Y" won't do) to go
+ ahead and delete them, "N" to return to editing the directory so you can
+ change the marks, or "X" to give up and delete nothing. No Return
+ character is needed. No other inputs are accepted at this point.
+
+ 202/15.4.2 Other DIRED Commands
+
+ 201/S sorts the files into a different order. It reads another character to say
+ which order: F for filename (the default), S for size, R for read date, or W
+ for write date.
+
+ R does the same sorting as S, but uses the reverse order (small files,
+ older files or end of alphabet first).
+
+ ? displays documentation on DIRED.
+
+ 202/15.4.3 Invoking DIRED
+
+ 201/There are some other ways to invoke DIRED. The command C-X D
+ (203/dired-command201/) puts you in DIRED on the directory containing the file you
+ are currently editing. With a numeric argument of 1 (C-U 1 C-X D), only
+ the current file is displayed instead of the whole directory. This is present
+ for historical reasons. On file systems which contain multiple versions of
+ files, such as twenex, this allows one to see how much space old versions of
+ a file are consuming. With a numeric argument of 4 (C-U C-X D), it asks
+ you for the directory name. Type a directory name and/or a file name. If
+ you explicitly specify a file name only versions of that file are displayed,
+ otherwise the whole directory is displayed.
+
+ 202/15.5 Miscellaneous File Operations
+
+ 201/NMODE has extended commands for performing many other operations on
+ files.
+
+ M-X Write File<CR><file><CR> (203/write-file-command201/) writes the contents of
+ the buffer into the file <file>, and then visits that file. It can be thought of
+ 201/Page 15-4 NMODE Manual (Miscellaneous File Operations)
+
+
+ as a way of "changing the name" of the file you are visiting. Unlike C-X
+ C-S, Write File saves even if the buffer has not been changed. C-X C-W is
+ another way of getting at this command.
+
+ M-X Insert File<CR><file><CR> (203/insert-file-command201/) inserts the contents of
+ <file> into the buffer at point, leaving point unchanged before the contents
+ and mark after them.
+
+ M-X Write Region<CR><file><CR> (203/write-region-command201/) writes the region
+ (the text between point and mark) to the specified file. It does not set the
+ visited filename. The buffer is not changed.
+
+ M-X Append to File<CR><file><CR> (203/append-to-file-command201/) appends the
+ region to <file>. The text is added to the end of <file>.
+
+ M-X Prepend to File<CR><file><CR> (203/prepend-to-file-command201/) adds the text
+ to the beginning of <file> instead of the end.
+
+ M-X Set Visited Filename<CR><file><CR> (203/set-visited-filename-command201/)
+ changes the name of the file being visited without reading or writing the data
+ in the buffer. M-X Write File is approximately equivalent to this command
+ followed by a C-X C-S.
+
+ M-X Delete File<CR><file><CR> (203/delete-file-command201/) deletes the file. In
+ twenex this has the effect of putting the file in the directory of deleted files,
+ from which it can be retrieved until the next expunge. On the hp9836, this
+ has the effect of irretrievably removing the file.
+
+ M-X Delete and Expunge File<CR><file><CR>
+ (203/delete-and-expunge-file-command201/) will, if possible, irretrievably delete a
+ file. If the operation fails, a bell will sound.
+
+ M-X Undelete File<CR><file><CR> (203/undelete-file-command201/) will attempt to
+ retrieve a deleted file. This only works on Twenex.
ADDED psl-1983/3-1/doc/nmode/nm-files.key
Index: psl-1983/3-1/doc/nmode/nm-files.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-files.key
@@ -0,0 +1,16 @@
+.silent_index {C-X} idx 15-1
+.silent_index {C-G} idx 15-1
+.silent_index {C-X} idx 15-1
+.silent_index {M-~} idx 15-2
+.silent_index {C-X} idx 15-2
+.silent_index {M-X} idx 15-2
+.silent_index {C-X} idx 15-3
+.silent_index {M-X} idx 15-3
+.silent_index {C-X} idx 15-3
+.silent_index {M-X} idx 15-4
+.silent_index {M-X} idx 15-4
+.silent_index {M-X} idx 15-4
+.silent_index {M-X} idx 15-4
+.silent_index {M-X} idx 15-4
+.silent_index {M-X} idx 15-4
+.silent_index {M-X} idx 15-4
ADDED psl-1983/3-1/doc/nmode/nm-files.r
Index: psl-1983/3-1/doc/nmode/nm-files.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-files.r
@@ -0,0 +1,278 @@
+.so pndoc:nman
+.part NM-FILES manual
+@Chapter[File Handling]
+@node("files")
+ The basic unit of stored data is the file. Each program, each
+paper, lives usually in its own file. To edit a program or paper, the
+editor must be told the name of the file that contains it. This is
+called @dfn[visiting] the file. To make your changes to the file
+permanent on disk, you must @dfn[save] the file. NMODE also has
+facilities for deleting files conveniently, and for listing your
+file directory.
+@Section[Visiting Files]
+@node("visiting")
+@WideCommands{
+C-X C-V Visit a file.
+
+C-X C-S Save the visited file.
+
+Meta-~ Tell NMODE to forget that the buffer has been changed.
+}
+@index{files}
+@index{visiting}
+@index{saving}
+ @dfn[Visiting] a file means copying its contents into NMODE where
+you can edit them. NMODE remembers the name of the file you visited.
+Unless you use the multiple buffer or window features of NMODE, you
+can only be visiting one file at a time. The name of the file you are
+visiting in the currently selected buffer is visible in the mode line.
+
+ The changes you make with NMODE are made in a copy inside NMODE.
+The file itself is not changed. The changed text is not permanent
+until you @dfn[save] it in a file. The first time you change the
+text, a star appears at the end of the mode line; this indicates that
+the text contains fresh changes which will be lost unless you save
+them.
+
+@keyindex{C-X C-V}
+@keyindex{C-G}
+@fncindex{visit-file-command}
+ To visit a file, use the command C-X C-V (@fnc{visit-file-command}).
+Follow
+the command with the name of the file you wish to visit, terminated by
+a @Return3{}.
+After C-X C-V is entered, @fnc{visit-file-command} will display a prompt.
+This prompt may contain a default filename, if so then
+any component of the filename which you don't
+specify is taken from it.
+You can abort the command by typing
+C-G, or edit the filename with normal NMODE editing commands.
+If you do type
+a @Return3{} to finish the command, the new file's text appears on the
+screen, and its name appears in the mode line.
+
+@keyindex{C-X C-S}
+@fncindex{save-file-command}
+ When you wish to save the file and make your changes permanent, type
+C-X C-S (@fnc{save-file-command}). After the save is finished, C-X C-S prints
+"Written: <filename>" in the echo area at the bottom of the screen.
+If there are no changes
+to save (no star at the end of the mode line), the file is not saved;
+it would be redundant to save a duplicate of the previous version.
+
+@Index{Create File}
+ What if you want to create a file? Just visit it. NMODE prints
+@w["(New File)"] but aside from that behaves as if you had visited an
+existing empty file. If you make any changes and save them, the file
+is created. If you visit a nonexistent file unintentionally (because
+you typed the wrong file name), go ahead and visit the file you meant.
+If you don't save the unwanted file, it is not created.
+
+@ITS{
+@index{Set Visited Filename}
+ When you read a file which is a link, you get the contents of the
+target file, but if you save under the name of the link, you break the
+link and a new file is created. The target does not change. If you
+would prefer to alter the target file, use Set Visited Filename to
+change the visited name to the target file's name. @Note("Filadv"
+"Set Visited Filename").
+}
+@index{Visit File Save Old}
+ If you alter one file and then visit another in the same buffer,
+NMODE offers to save the old one. If you answer YES, the old file is
+saved; if you answer NO, all the changes you have made to it since the
+last save are lost.
+
+@fncindex{buffer-not-modified-command}
+@keyindex{M-~}
+ Sometimes you will change a buffer by accident. Even if you undo
+the change by hand, NMODE still knows that "the buffer has been
+changed". You can tell NMODE to believe that there have been no
+changes with the Meta-~ (@fnc{buffer-not-modified-command}) command. This
+command simply clears the "modified" flag which says that the buffer
+contains changes which need to be saved. Even if the buffer really
+@xxi(is) changed NMODE will still act as if it were not. If we take
+"~" to mean "not", then Meta-~ is "not", metafied.
+@Section[How to Undo Drastic Changes to a File]
+@node("revert")
+@fncindex{revert-file-command}
+@index{files}
+@index{Drastic Changes}
+ If you have made extensive changes to a file and then change your
+mind about them, you can get rid of them by reading in the previous
+version of the file. To do this, use M-X Revert File
+(@fnc{revert-file-command}).
+
+ M-X Revert File does not change point, so that if the file was only
+edited slightly, you will be at approximately the same piece of text
+after the Revert as before. If you have made drastic changes, the
+same value of point in the old file may address a totally different
+piece of text.
+@Section[Listing a File Directory]
+@node("listdir")
+@index{file directory}
+@keyindex{C-X D}
+@fncindex{dired-command}
+@keyindex{M-X DIRED}
+@fncindex{edit-directory-command}
+ To look at a file directory, use the C-X D command
+(@fnc{dired-command}). With no argument, it shows
+you the directory of the file you are visiting. @w[C-U C-X D] reads a
+directory specification
+from the keyboard and shows you the files related to that
+directory specification.
+M-X DIRED (@fnc{edit-directory-command}) differs in that it prompts
+for a directory specification even without an argument.
+@Section[DIRED, the Directory Editor Subsystem]
+@node("dired")
+@index{DIRED}
+@index{file deletion}
+ DIRED makes it easy to delete many of the files in a single
+directory at once. It presents a copy of a listing of the directory,
+which you can move around in, marking files for deletion. When you
+are satisfied, you can tell DIRED to go ahead and delete the marked
+files.
+
+@index{recursive editing level}
+ Invoke DIRED with C-X D or M-X DIRED@Return1{}@Return2{}
+to edit the current default directory,
+or M-X DIRED@Return1{}<dir>@Return2{} to edit directory <dir>. You are then
+given a listing of the directory which you can move around in with
+all the normal NMODE motion commands. Some NMODE commands are made
+undefined and others do special things, but it's still a recursive
+editing level which you can exit normally with Q.
+@SubSection[Basic DIRED Commands]
+ You can mark a file for deletion by moving to the line describing the
+file and typing D. The deletion mark is
+visible as a D at the beginning of the line. Point is moved to the
+beginning of the next line, so that several D's delete several
+files. Alternatively, if you give D an argument it marks that
+many consecutive files. Given a negative argument, it marks the
+preceding file (or several files) and puts point at the first (in the
+buffer) line marked. Most of the DIRED commands (D, U, E, Space)
+repeat this way with numeric arguments.
+
+ If you wish to remove a deletion mark, use the U (for Undelete)
+command, which is invoked like D: it removes the deletion mark
+from the current line (or next few lines, if given an argument). The
+Rubout command removes the deletion mark from the previous line,
+moving up to that line. Thus, a Rubout after a D precisely cancels
+the D.
+
+ For extra convenience, Space is made a command similar to C-N.
+Moving down a line is done so often in DIRED that it deserves to be
+easy to type. Rubout is often useful simply for moving up.
+
+ If you are not sure whether you want to delete a file, you can
+examine it by typing E. This enters a recursive editing mode on the
+file, which you can exit with C-M-L.
+This also allows you to modify files.
+When you exit the
+recursive editing level, you return to DIRED.
+
+@index{confirmation}
+ When you have marked the files you wish to mark, you can exit DIRED
+with Q. If any files were marked for deletion, DIRED lists them in a
+concise format, several per line. You can type "YES" (Just "Y" won't
+do) to go ahead and delete them, "N" to return to editing the
+directory so you can change the marks, or "X" to give up and delete
+nothing. No @Return3{} character is needed. No other inputs are accepted
+at this point.
+@SubSection[Other DIRED Commands]
+ S sorts the files into a different order. It reads another
+character to say which order: F for filename (the default), S for
+size, R for read date, or W for write date.
+
+ R does the same sorting as S, but uses the reverse order (small
+files, older files or end of alphabet first).
+
+ ? displays documentation on DIRED.
+@SubSection[Invoking DIRED]
+@keyindex{C-X D}
+@index{directory}
+@fncindex{dired-command}
+ There are some other ways to invoke DIRED. The command C-X D
+(@fnc{dired-command}) puts you in DIRED on the directory containing the file you
+are currently editing. With a numeric argument of 1 (@w[C-U 1] C-X D),
+only the current file is displayed instead of the whole directory.
+This is present for historical reasons.
+On file systems which contain multiple versions of files, such as twenex,
+this allows one to see how much space old versions of a file are consuming.
+With a
+numeric argument of 4 (C-U C-X D), it asks you for the directory name.
+Type a directory name and/or a file
+name. If you explicitly specify a file name only versions of that
+file are displayed, otherwise the whole directory is displayed.
+@Section[Miscellaneous File Operations]
+@node("filadv")
+@index{insertion}
+@index{files}
+ NMODE has extended commands for performing many other operations on
+files.
+
+@fncindex{write-file-command}
+@keyindex{M-X Write File}
+@keyindex{C-X C-W}
+ M-X Write File@return1{}<file>@return2{} (@fnc{write-file-command})
+writes the contents of the buffer into
+the file <file>, and then visits that file. It can be thought of as a
+way of "changing the name" of the file you are visiting. Unlike C-X
+C-S, Write File saves even if the buffer has not been changed. C-X
+C-W is another way of getting at this command.
+
+@fncindex{insert-file-command}
+@keyindex{M-X Insert File}
+ M-X Insert File@return1{}<file>@return2{} (@fnc{insert-file-command})
+inserts the contents of <file> into the
+buffer at point, leaving point unchanged before the contents and mark
+after them.
+
+@index{mark}
+@index{Region}
+@fncindex{write-region-command}
+@keyindex{M-X Write Region}
+ M-X Write Region@return1{}<file>@return2{} (@fnc{write-region-command})
+writes the region (the text between
+point and mark) to the specified file. It does not set the visited
+filename. The buffer is not changed.
+
+@fncindex{append-to-file-command}
+@keyindex{M-X Append to File}
+ M-X Append to File@return1{}<file>@return2{} (@fnc{append-to-file-command})
+appends the region to <file>. The text
+is added to the end of <file>.
+
+@fncindex{prepend-to-file-command}
+@keyindex{M-X Prepend to File}
+ M-X Prepend to File@return1{}<file>@return2{} (@fnc{prepend-to-file-command})
+adds the text to the beginning of
+<file> instead of the end.
+
+@index{Set Visited Filename}
+@fncindex{set-visited-filename-command}
+ M-X Set Visited Filename@return1{}<file>@return2{} (@fnc{set-visited-filename-command})
+changes the name of the file
+being visited without reading or writing the data in the buffer. M-X
+Write File is approximately equivalent to this command followed by a
+C-X C-S.
+
+@fncindex{delete-file-command}
+@index{Delete File}
+@keyindex{M-X Delete File}
+ M-X Delete File@return1{}<file>@return2{} (@fnc{delete-file-command})
+deletes the file.
+In twenex this has the effect of putting the file in the directory of
+deleted files, from which it can be retrieved until the next expunge.
+On the hp9836, this has the effect of irretrievably removing the file.
+
+@fncindex{delete-and-expunge-file-command}
+@index{Delete File}
+@keyindex{M-X Delete and Expunge File}
+ M-X Delete and Expunge File@return1{}<file>@return2{}
+(@fnc{delete-and-expunge-file-command}) will, if possible,
+irretrievably delete a file. If the operation fails, a bell will sound.
+
+@fncindex{undelete-file-command}
+@keyindex{M-X Undelete File}
+ M-X Undelete File@return1{}<file>@return2{} (@fnc{undelete-file-command})
+will attempt to retrieve a deleted file. This only works on Twenex.
ADDED psl-1983/3-1/doc/nmode/nm-files.topic
Index: psl-1983/3-1/doc/nmode/nm-files.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-files.topic
@@ -0,0 +1,21 @@
+.silent_index {files} idx 15-1
+.silent_index {visiting} idx 15-1
+.silent_index {saving} idx 15-1
+.silent_index {Create} idx 15-1
+.silent_index {Set} idx 15-1
+.silent_index {Visit} idx 15-1
+.silent_index {files} idx 15-2
+.silent_index {Drastic} idx 15-2
+.silent_index {file} idx 15-2
+.silent_index {DIRED} idx 15-2
+.silent_index {file} idx 15-2
+.silent_index {recursive} idx 15-2
+.silent_index {confirmation} idx 15-3
+.silent_index {directory} idx 15-3
+.silent_index {insertion} idx 15-3
+.silent_index {files} idx 15-3
+.silent_index {mark} idx 15-4
+.silent_index {Region} idx 15-4
+.silent_index {Set} idx 15-4
+.silent_index {Delete} idx 15-4
+.silent_index {Delete} idx 15-4
ADDED psl-1983/3-1/doc/nmode/nm-fun-index.contents
Index: psl-1983/3-1/doc/nmode/nm-fun-index.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-fun-index.contents
@@ -0,0 +1,1 @@
+contents_entry(0 28 {Function Index} 28-1)
ADDED psl-1983/3-1/doc/nmode/nm-fun-index.ibm
Index: psl-1983/3-1/doc/nmode/nm-fun-index.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-fun-index.ibm
@@ -0,0 +1,230 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-FUN-INDEX.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Function Index) Page 28-1
+
+
+ 202/28. Function Index
+
+ 201/append-next-kill-command . . . . . . . . . . . . . . . . 11-3, 27-2
+ append-to-buffer-command . . . . . . . . . . . . . . . . 11-4, 16-2, 27-2
+ append-to-file-command . . . . . . . . . . . . . . . . . 11-4, 15-4, 27-2
+ apropos-command . . . . . . . . . . . . . . . . . . . . . 8-1, 9-1, 27-2
+ argument-digit . . . . . . . . . . . . . . . . . . . . . . 5-1, 27-3
+ auto-fill-mode-command . . . . . . . . . . . . . . . . . . 6-1, 13-4, 27-3
+
+ back-to-indentation-command . . . . . . . . . . . . . . . 13-4, 27-4
+ backward-kill-sentence-command . . . . . . . . . . . . . 11-1, 13-2, 14-1,
+ 27-4
+ backward-paragraph-command . . . . . . . . . . . . . . 13-3, 27-4
+ backward-sentence-command . . . . . . . . . . . . . . . 13-2, 27-4
+ backward-up-list-command . . . . . . . . . . . . . . . . 20-4, 27-5
+ browser-browser-command . . . . . . . . . . . . . . . . 8-1
+ buffer-browser-command . . . . . . . . . . . . . . . . . 8-1, 16-2, 27-5
+ buffer-not-modified-command . . . . . . . . . . . . . . . 15-2, 27-5
+
+ c-x-prefix . . . . . . . . . . . . . . . . . . . . . . . . 3-2, 27-5
+ center-line-command . . . . . . . . . . . . . . . . . . . 13-5, 27-6
+ copy-region . . . . . . . . . . . . . . . . . . . . . . . 11-3, 27-6
+ count-occurrences-command . . . . . . . . . . . . . . . 19-1, 27-6
+
+ delete-and-expunge-file-command . . . . . . . . . . . . . 15-4, 27-6
+ delete-backward-character-command . . . . . . . . . . . 4-1, 14-1, 27-7
+ delete-backward-hacking-tabs-command . . . . . . . . . . 11-1, 20-3, 27-7
+ delete-blank-lines-command . . . . . . . . . . . . . . . . 4-3, 11-1, 27-7
+ delete-file-command . . . . . . . . . . . . . . . . . . . 15-4, 27-7
+ delete-forward-character-command . . . . . . . . . . . . 11-1, 27-8
+ delete-horizontal-space-command . . . . . . . . . . . . . 11-1, 13-3, 20-2,
+ 27-8
+ delete-indentation-command . . . . . . . . . . . . . . . . 11-1, 13-3, 20-2,
+ 20-6, 27-8
+ delete-matching-lines-command . . . . . . . . . . . . . . 19-1, 27-8
+ delete-non-matching-lines-command . . . . . . . . . . . . 19-1, 27-8
+ dired-command . . . . . . . . . . . . . . . . . . . . . . 8-1, 15-2, 15-3,
+ 27-9
+ down-list-command . . . . . . . . . . . . . . . . . . . . 20-4, 27-9
+
+ edit-directory-command . . . . . . . . . . . . . . . . . . 8-1, 15-2, 27-9
+ end-of-defun-command . . . . . . . . . . . . . . . . . . 20-5, 27-10
+ esc-prefix . . . . . . . . . . . . . . . . . . . . . . . . 3-2, 27-10
+ exchange-point-and-mark . . . . . . . . . . . . . . . . . 10-1, 27-10
+ exchange-windows-command . . . . . . . . . . . . . . . 18-1, 27-10
+ execute-buffer-command . . . . . . . . . . . . . . . . . 27-10
+ execute-defun-command . . . . . . . . . . . . . . . . . 20-7, 27-11
+ execute-file-command . . . . . . . . . . . . . . . . . . . 27-11
+ execute-form-command . . . . . . . . . . . . . . . . . . 20-7, 27-11
+ exit-nmode . . . . . . . . . . . . . . . . . . . . . . . . 7-2, 27-11
+ 201/Page 28-2 NMODE Manual (Function Index)
+
+
+ fill-comment-command . . . . . . . . . . . . . . . . . . . 20-3, 27-12
+ fill-paragraph-command . . . . . . . . . . . . . . . . . . 13-4, 27-12
+ fill-region-command . . . . . . . . . . . . . . . . . . . 13-4, 27-12
+ find-file-command . . . . . . . . . . . . . . . . . . . . 16-1, 27-13
+ forward-paragraph-command . . . . . . . . . . . . . . . 13-3, 27-13
+ forward-sentence-command . . . . . . . . . . . . . . . . 13-2, 27-13
+ forward-up-list-command . . . . . . . . . . . . . . . . . 20-4, 27-13
+
+ get-register-command . . . . . . . . . . . . . . . . . . 11-5, 27-14
+ grow-window-command . . . . . . . . . . . . . . . . . . 18-2, 27-14
+
+ help-dispatch . . . . . . . . . . . . . . . . . . . . . . 9-1, 27-14
+
+ incremental-search-command . . . . . . . . . . . . . . . 12-1, 27-14
+ indent-new-line-command . . . . . . . . . . . . . . . . . 20-1, 20-2, 20-6,
+ 27-15
+ indent-region-command . . . . . . . . . . . . . . . . . . 13-3, 27-15
+ insert-buffer-command . . . . . . . . . . . . . . . . . . 11-4, 16-2, 27-15
+ insert-closing-bracket . . . . . . . . . . . . . . . . . . 20-2, 27-15
+ insert-comment-command . . . . . . . . . . . . . . . . . 20-3, 27-16
+ insert-date-command . . . . . . . . . . . . . . . . . . . 21-1, 27-16
+ insert-file-command . . . . . . . . . . . . . . . . . . . 15-4, 27-16
+ insert-kill-buffer . . . . . . . . . . . . . . . . . . . . . 11-2, 27-16
+ insert-next-character-command . . . . . . . . . . . . . . 4-1, 27-17
+
+ kill-backward-form-command . . . . . . . . . . . . . . . 11-1, 20-4, 27-17
+ kill-backward-word-command . . . . . . . . . . . . . . . 11-1, 13-1, 14-1,
+ 27-17
+ kill-buffer-command . . . . . . . . . . . . . . . . . . . 16-2, 27-17
+ kill-forward-form-command . . . . . . . . . . . . . . . . 11-1, 20-4, 27-18
+ kill-forward-word-command . . . . . . . . . . . . . . . . 11-1, 13-1, 27-18
+ kill-line . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 27-18
+ kill-region . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 11-2, 27-18
+ kill-sentence-command . . . . . . . . . . . . . . . . . . 11-1, 13-2, 27-19
+ kill-some-buffers-command . . . . . . . . . . . . . . . . 16-2, 27-19
+
+ lisp-abort-command . . . . . . . . . . . . . . . . . . . . 20-8, 27-19
+ lisp-backtrace-command . . . . . . . . . . . . . . . . . 20-8, 27-19
+ lisp-continue-command . . . . . . . . . . . . . . . . . . 20-8, 27-20
+ lisp-help-command . . . . . . . . . . . . . . . . . . . . 20-8, 27-20
+ lisp-indent-region-command . . . . . . . . . . . . . . . . 20-7, 27-20
+ lisp-indent-sexpr . . . . . . . . . . . . . . . . . . . . 20-6, 27-20
+ lisp-mode-command . . . . . . . . . . . . . . . . . . . . 20-1, 27-21
+ lisp-prefix . . . . . . . . . . . . . . . . . . . . . . . . 3-2, 27-21
+ lisp-quit-command . . . . . . . . . . . . . . . . . . . . 20-8, 27-21
+ lisp-retry-command . . . . . . . . . . . . . . . . . . . . 20-8, 27-21
+ lisp-tab-command . . . . . . . . . . . . . . . . . . . . . 20-3, 20-6, 27-22
+ lowercase-region-command . . . . . . . . . . . . . . . . 13-6, 27-22
+ lowercase-word-command . . . . . . . . . . . . . . . . . 13-5, 14-2, 27-22
+ 201/NMODE Manual (Function Index) Page 28-3
+
+
+ m-x-prefix . . . . . . . . . . . . . . . . . . . . . . . . 3-2, 6-1, 27-22
+ make-parens-command . . . . . . . . . . . . . . . . . . 20-5, 27-23
+ mark-beginning-command . . . . . . . . . . . . . . . . . 10-2, 27-23
+ mark-defun-command . . . . . . . . . . . . . . . . . . . 10-2, 20-5, 27-23
+ mark-end-command . . . . . . . . . . . . . . . . . . . . 10-2, 27-23
+ mark-form-command . . . . . . . . . . . . . . . . . . . 10-2, 20-5, 27-24
+ mark-paragraph-command . . . . . . . . . . . . . . . . . 10-2, 13-3, 27-24
+ mark-whole-buffer-command . . . . . . . . . . . . . . . 10-2, 27-24
+ mark-word-command . . . . . . . . . . . . . . . . . . . 10-2, 13-2, 27-24
+ move-backward-character-command . . . . . . . . . . . . 4-1, 27-25
+ move-backward-defun-command . . . . . . . . . . . . . . 20-5, 27-25
+ move-backward-form-command . . . . . . . . . . . . . . 20-4, 27-25
+ move-backward-list-command . . . . . . . . . . . . . . . 20-4, 27-25
+ move-backward-word-command . . . . . . . . . . . . . . 13-1, 27-26
+ move-down-command . . . . . . . . . . . . . . . . . . . 4-1, 27-26
+ move-down-extending-command . . . . . . . . . . . . . . 4-1, 27-26
+ move-forward-character-command . . . . . . . . . . . . . 4-1, 27-26
+ move-forward-form-command . . . . . . . . . . . . . . . 20-4, 27-27
+ move-forward-list-command . . . . . . . . . . . . . . . . 20-4, 27-27
+ move-forward-word-command . . . . . . . . . . . . . . . 13-1, 27-27
+ move-over-paren-command . . . . . . . . . . . . . . . . 20-5, 27-27
+ move-to-buffer-end-command . . . . . . . . . . . . . . . 4-1, 27-28
+ move-to-buffer-start-command . . . . . . . . . . . . . . 4-1, 27-28
+ move-to-end-of-line-command . . . . . . . . . . . . . . . 4-1, 27-28
+ move-to-screen-edge-command . . . . . . . . . . . . . . 17-2, 27-28
+ move-to-start-of-line-command . . . . . . . . . . . . . . 4-1, 27-28
+ move-up-command . . . . . . . . . . . . . . . . . . . . 4-1, 27-29
+
+ negative-argument . . . . . . . . . . . . . . . . . . . . 5-1, 27-29
+ next-screen-command . . . . . . . . . . . . . . . . . . . 17-2, 27-29
+ nmode-abort-command . . . . . . . . . . . . . . . . . . 23-1, 27-29
+ nmode-exit-to-superior . . . . . . . . . . . . . . . . . . 7-2, 27-29
+ nmode-full-refresh . . . . . . . . . . . . . . . . . . . . 17-1, 27-30
+ nmode-gc . . . . . . . . . . . . . . . . . . . . . . . . 21-1, 27-30
+ nmode-invert-video . . . . . . . . . . . . . . . . . . . . 2-1, 27-30
+ nmode-refresh-command . . . . . . . . . . . . . . . . . 4-1, 17-1, 27-30
+
+ one-window-command . . . . . . . . . . . . . . . . . . . 18-1, 27-30
+ open-line-command . . . . . . . . . . . . . . . . . . . . 4-3, 5-1, 27-31
+ other-window-command . . . . . . . . . . . . . . . . . . 18-1, 27-31
+
+ prepend-to-file-command . . . . . . . . . . . . . . . . . 11-4, 15-4, 27-31
+ previous-screen-command . . . . . . . . . . . . . . . . . 17-2, 27-31
+ put-register-command . . . . . . . . . . . . . . . . . . 11-5, 27-32
+
+ query-replace-command . . . . . . . . . . . . . . . . . . 19-1, 27-32
+
+ rename-buffer-command . . . . . . . . . . . . . . . . . 16-2, 27-32
+ replace-string-command . . . . . . . . . . . . . . . . . 19-1, 27-33
+ reposition-window-command . . . . . . . . . . . . . . . . 17-2, 27-33
+ return-command . . . . . . . . . . . . . . . . . . . . . 4-1, 27-33
+ reverse-search-command . . . . . . . . . . . . . . . . . 12-1, 27-33
+ revert-file-command . . . . . . . . . . . . . . . . . . . 15-2, 27-33
+ 201/Page 28-4 NMODE Manual (Function Index)
+
+
+ save-all-files-command . . . . . . . . . . . . . . . . . . 16-2, 27-34
+ save-file-command . . . . . . . . . . . . . . . . . . . . 4-3, 15-1, 16-2,
+ 27-34
+ scroll-other-window-command . . . . . . . . . . . . . . . 18-2, 27-34
+ scroll-window-down-line-command . . . . . . . . . . . . . 17-2, 27-34
+ scroll-window-down-page-command . . . . . . . . . . . . 17-2, 27-34
+ scroll-window-left-command . . . . . . . . . . . . . . . . 17-2, 27-35
+ scroll-window-right-command . . . . . . . . . . . . . . . 17-2, 27-35
+ scroll-window-up-line-command . . . . . . . . . . . . . . 17-2, 27-35
+ scroll-window-up-page-command . . . . . . . . . . . . . 17-2, 27-35
+ select-buffer-command . . . . . . . . . . . . . . . . . . 16-1, 27-35
+ select-previous-buffer-command . . . . . . . . . . . . . 16-1, 27-36
+ set-fill-column-command . . . . . . . . . . . . . . . . . 13-5, 22-5, 27-36
+ set-fill-prefix-command . . . . . . . . . . . . . . . . . . 13-5, 27-36
+ set-goal-column-command . . . . . . . . . . . . . . . . . 4-2, 27-36
+ set-key-command . . . . . . . . . . . . . . . . . . . . . 6-2, 27-37
+ set-mark-command . . . . . . . . . . . . . . . . . . . . 10-1, 27-37
+ set-visited-filename-command . . . . . . . . . . . . . . . 15-4, 27-37
+ split-line-command . . . . . . . . . . . . . . . . . . . . 20-2, 27-37
+ start-scripting-command . . . . . . . . . . . . . . . . . 27-38
+ start-timing-command . . . . . . . . . . . . . . . . . . . 27-38
+ stop-scripting-command . . . . . . . . . . . . . . . . . 27-38
+ stop-timing-command . . . . . . . . . . . . . . . . . . . 27-38
+
+ tab-to-tab-stop-command . . . . . . . . . . . . . . . . . 13-1, 13-3, 27-39
+ text-mode-command . . . . . . . . . . . . . . . . . . . . 13-1, 20-1, 27-39
+ transpose-characters-command . . . . . . . . . . . . . . 4-1, 14-1, 27-39
+ transpose-forms . . . . . . . . . . . . . . . . . . . . . 20-5, 27-39
+ transpose-lines . . . . . . . . . . . . . . . . . . . . . . 14-2, 27-40
+ transpose-regions . . . . . . . . . . . . . . . . . . . . 14-2, 27-40
+ transpose-words . . . . . . . . . . . . . . . . . . . . . 13-1, 27-40
+ two-windows-command . . . . . . . . . . . . . . . . . . 18-1, 27-40
+
+ undelete-file-command . . . . . . . . . . . . . . . . . . 15-4, 27-41
+ universal-argument . . . . . . . . . . . . . . . . . . . . 5-1, 27-41
+ unkill-previous . . . . . . . . . . . . . . . . . . . . . . 11-3, 27-41
+ upcase-digit-command . . . . . . . . . . . . . . . . . . 14-2, 27-41
+ uppercase-initial-command . . . . . . . . . . . . . . . . 13-5, 14-2, 27-42
+ uppercase-region-command . . . . . . . . . . . . . . . . 10-1, 13-6, 27-42
+ uppercase-word-command . . . . . . . . . . . . . . . . . 13-5, 14-2, 27-42
+
+ view-two-windows-command . . . . . . . . . . . . . . . . 18-2, 27-42
+ visit-file-command . . . . . . . . . . . . . . . . . . . . 4-3, 15-1, 27-42
+ visit-in-other-window-command . . . . . . . . . . . . . . 18-3, 27-43
+
+ what-cursor-position-command . . . . . . . . . . . . . . 4-2, 13-5, 27-43
+ write-file-command . . . . . . . . . . . . . . . . . . . . 15-3, 27-43
+ write-region-command . . . . . . . . . . . . . . . . . . 15-4, 27-43
+ write-screen-command . . . . . . . . . . . . . . . . . . 21-1, 27-44
+ 201/NMODE Manual (Function Index) Page 28-5
+
+
+ yank-last-output-command . . . . . . . . . . . . . . . . 20-7, 27-44
ADDED psl-1983/3-1/doc/nmode/nm-globals.contents
Index: psl-1983/3-1/doc/nmode/nm-globals.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-globals.contents
@@ -0,0 +1,1 @@
+contents_entry(0 26 {Globals} 26-1)
ADDED psl-1983/3-1/doc/nmode/nm-globals.ibm
Index: psl-1983/3-1/doc/nmode/nm-globals.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-globals.ibm
@@ -0,0 +1,76 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-GLOBALS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Globals) Page 26-1
+
+
+ 202/26. Globals
+
+ 201/This section defines a number of conceptual 203/global variables201/, which are
+ referred to in the descriptions of NMODE commands. These 203/globals 201/represent
+ state information that can affect the behavior of various NMODE commands.
+ The value of NMODE globals are set as the result of various NMODE
+ commands.
+
+
+
+
+
+
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Fill Column
+
+
+ 201/The fill column is the column beyond which all the fill commands: auto fill, fill
+ paragraph, fill region, and fill comment, will try to break up lines. The fill
+ column can be set by the Set Fill Column command.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Fill Prefix
+
+
+ 201/The fill prefix, if present, is a string that the fill paragraph and fill region
+ commands expect to see on the areas that they are filling. It is useful, for
+ instance, in filling indented text. Only the indented area will be filled, and
+ any new lines created by the filling will be properly indented. Autofill will
+ also insert it on each new line it starts.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Goal Column
+
+
+ 201/The goal column is set or unset using the C-X C-N command. When the goal
+ column is defined, the commands C-N and C-P will always leave the cursor at
+ the specified column position, if the current line is sufficiently long.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+ 202/Global Explanation: Kill Ring
+
+
+ 201/The kill ring is a stack of the 16 most recently killed pieces of text. The
+ Insert Kill Buffer command reads text on the top of the kill ring and inserts
+ it back into the buffer. It can accept an argument, specifying an argument
+ other than the top one. If one knows that the text one wants is on the kill
+ ring, but is not certain how deeply it is buried, one can retrieve the top
+ item with the Insert Kill Buffer command, then look through the other items
+ one by one with the Unkill Previous command. This rotates the items on the
+ kill ring, displaying them one by one in a cycle.
+ Most kill commands push their text onto the top of the kill ring. If two kill
+ commands are performed right after each other, the text they kill is
+ concatenated. Commands the kill forward add onto the end of the previously
+ killed text. Commands that kill backward add onto the beginning. That way,
+ the text is assembled in its original order. If intervening commands have
+ 201/Page 26-2 NMODE Manual (Globals)
+
+
+ taken place one can issue an Append Next Kill command before the next kill
+ in order to assemble the next killed text together with the text on top of the
+ kill ring.
+ 204/$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
ADDED psl-1983/3-1/doc/nmode/nm-globals.topic
Index: psl-1983/3-1/doc/nmode/nm-globals.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-globals.topic
@@ -0,0 +1,4 @@
+.silent_index {Fill Column} idx 26-1
+.silent_index {Fill Prefix} idx 26-1
+.silent_index {Goal Column} idx 26-1
+.silent_index {Kill Ring} idx 26-1
ADDED psl-1983/3-1/doc/nmode/nm-introduction.contents
Index: psl-1983/3-1/doc/nmode/nm-introduction.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-introduction.contents
@@ -0,0 +1,2 @@
+contents_entry(0 1 {Introduction} 1-1)
+contents_entry(1 1.1 {Preface} 1-2)
ADDED psl-1983/3-1/doc/nmode/nm-introduction.ibm
Index: psl-1983/3-1/doc/nmode/nm-introduction.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-introduction.ibm
@@ -0,0 +1,103 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-INTRODUCTION.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Introduction) Page 1-1
+
+
+ 202/1. Introduction
+
+ 201/This document describes the NMODE text editor. NMODE is an advanced,
+ self-documenting, customizable, extensible, interactive, multiple-window,
+ screen-oriented editor written in PSL (Portable Standard Lisp). NMODE
+ provides a compatible subset of the EMACS text editor, developed at M.I.T.
+ It also contains a number of extensions, most notably an interface to the
+ underlying Lisp system for Lisp programmers.
+
+ NMODE was developed at the Hewlett-Packard Laboratories Computer Research
+ Center by Alan Snyder. A number of significant extensions have been
+ contributed by Jeff Soreff.
+
+ NMODE is based on an earlier editor, EMODE, written in PSL by William F.
+ Galway at the University of Utah. Many of the basic ideas and the
+ underlying structure of the NMODE editor come directly from EMODE.
+
+ This document is only partially complete, but is being reprinted at this time
+ for the benefit of new users that are not familiar with EMACS. The bulk of
+ this document has been borrowed from EMACS documentation and modified (by
+ Jeff Soreff) appropriately in areas where NMODE and EMACS differ. The
+ EMACS documentation was written by Richard M. Stallman.
+
+ We say that NMODE is a screen-oriented editor because normally the text
+ being edited is visible on the screen and is updated automatically as you type
+ your commands. See Section 2 [Display], page 1.
+
+ We call it an interactive editor because the display is updated very
+ frequently, usually after each character or pair of characters you type. This
+ minimizes the amount of information you must keep in your head as you edit.
+
+ We call NMODE advanced because it provides facilities that go beyond simple
+ insertion and deletion: filling of text; automatic indentation of programs;
+ viewing two files at once; and dealing in terms of characters, words, lines,
+ sentences, and paragraphs, as well as LISP constructs. It is much easier to
+ type one command meaning "go to the end of the paragraph" than to find the
+ desired spot with repetition of simpler commands.
+
+ Self-documenting means that there are on-line functions to find out the
+ function of any command and to view documentation about that command. See
+ Section 9 [Help], page 1.
+
+ Customizable means that you can change the definitions of NMODE commands
+ in little ways. For example, you can rearrange the command set. If you
+ prefer the four basic cursor motion commands (up, down, left and right) on
+ keys in a diamond pattern on the keyboard, you can have it. See Section 22
+ [Customization], page 1.
+
+ Extensible means that you can go beyond simple customization and write
+ entirely new commands, programs in the language PSL. NMODE is an "on-line
+ extensible" system, which means that it is divided into many functions that
+ call each other, any of which can be redefined in the middle of an editing
+ session. Any part of NMODE can be replaced without making a separate copy
+ 201/Page 1-2 NMODE Manual (Introduction)
+
+
+ of all of NMODE.
+
+ 202/1.1 Preface
+
+ 201/This manual documents the use and simple customization of the display
+ editor NMODE with the hp9836 operating system. The reader is 203/not 201/expected
+ to be a programmer. Even simple customizations do not require programming
+ skill, but the user who is not interested in customizing can ignore the
+ scattered customization hints.
+
+ This is primarily a reference manual, but can also be used as a primer.
+ However, I recommend that the newcomer first use the on-line,
+ learn-by-doing tutorial NTEACH. With it, you learn NMODE by using NMODE
+ on a specially designed file which describes commands, tells you when to try
+ them, and then explains the results you see. This gives a more vivid
+ introduction than a printed manual.
+
+ On first reading, you need not make any attempt to memorize chapters 2
+ and 3, which describe the notational conventions of the manual and the
+ general appearance of the NMODE display screen. It is enough to be aware
+ of what questions are answered in these chapters, so you can refer back
+ when you later become interested in the answers. After reading the Basic
+ Editing chapter you should practice the commands there. The next few
+ chapters describe fundamental techniques and concepts that are referred to
+ again and again. It is best to understand them thoroughly, experimenting
+ with them if necessary.
+
+ To find the documentation on a particular command, look in the index if you
+ know what the command is. Both command characters and function names are
+ indexed. If you know vaguely what the command does, look in the topic
+ index.
ADDED psl-1983/3-1/doc/nmode/nm-introduction.r
Index: psl-1983/3-1/doc/nmode/nm-introduction.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-introduction.r
@@ -0,0 +1,99 @@
+.so pndoc:nman
+.part nm-introduction manual
+.chapter Introduction
+.label Introduction
+.
+@node("intro")
+This document describes the NMODE text editor.
+NMODE is an
+advanced, self-documenting,
+customizable, extensible,
+interactive, multiple-window, screen-oriented
+editor written in PSL (Portable Standard Lisp).
+NMODE provides a compatible subset of the EMACS text editor,
+developed at M.I.T. It also contains a number of
+extensions, most notably an interface to the underlying
+Lisp system for Lisp programmers.
+
+NMODE was developed at the Hewlett-Packard Laboratories
+Computer Research Center by Alan Snyder.
+A number of significant extensions have been contributed by
+Jeff Soreff.
+
+NMODE is based on an earlier editor, EMODE, written in PSL
+by William F. Galway at the University of Utah.
+Many of the basic ideas and the underlying structure
+of the NMODE editor come directly from EMODE.
+
+This document is only partially complete, but is being
+reprinted at this time for the benefit of new users that
+are not familiar with EMACS. The bulk of this document
+has been borrowed from EMACS documentation and modified
+(by Jeff Soreff)
+appropriately in areas where NMODE and EMACS differ.
+The EMACS documentation was written by Richard M. Stallman.
+
+ We say that NMODE is a screen-oriented editor because normally the text
+being edited is visible on the screen and is updated automatically as
+you type your commands. @Note("Screen" "Display").
+
+ We call it an interactive editor because the display is updated very
+frequently, usually after each character or pair of characters you
+type. This minimizes the amount of information you must keep in your
+head as you edit.
+
+ We call NMODE advanced because it provides facilities that go beyond
+simple insertion and deletion: filling of text; automatic indentation
+of programs; viewing two files at once; and dealing in terms of
+characters, words, lines, sentences, and paragraphs, as well as
+LISP constructs.
+It is much easier to type one command meaning "go to the end of the
+paragraph" than to find the desired spot with repetition of simpler
+commands.
+
+ Self-documenting means that there are on-line functions to find out the
+function of any command and to view documentation about that command.
+@Note("Help").
+
+ Customizable means that you can change the definitions of NMODE
+commands in little ways.
+For example, you can rearrange the command set.
+If you prefer the four basic cursor motion commands (up,
+down, left and right) on keys in a diamond pattern on the keyboard,
+you can have it.
+@Manual{@Note("Customization")}.
+
+ Extensible means that you can go beyond simple customization and
+write entirely new commands, programs in the language PSL. NMODE is
+an "on-line extensible" system, which means that it is divided into
+many functions that call each other, any of which can be redefined in
+the middle of an editing session. Any part of NMODE can be replaced
+without making a separate copy of all of NMODE.
+@Section(Preface)
+ This manual documents the use and simple customization of the
+display editor NMODE with the hp9836 operating system. The reader is @i(not)
+expected to be a programmer. Even simple customizations do not
+require programming skill, but the user who is not interested in
+customizing can ignore the scattered customization hints.
+
+ This is primarily a reference manual, but can also be used as a
+primer. However, I recommend that the newcomer first use the on-line,
+learn-by-doing tutorial NTEACH. With it, you learn NMODE by using
+NMODE on a specially designed file which describes commands, tells you
+when to try them, and then explains the results you see. This gives a
+more vivid introduction than a printed manual.
+
+ On first reading, you need not make any attempt to memorize chapters
+2 and 3, which describe the notational conventions of the manual and the
+general appearance of the NMODE display screen. It is enough to be
+aware of what questions are answered in these chapters, so you can
+refer back when you later become interested in the answers. After
+reading the Basic Editing chapter you should practice the commands
+there. The next few chapters describe fundamental techniques and
+concepts that are referred to again and again. It is best to
+understand them thoroughly, experimenting with them if necessary.
+
+ To find the documentation on a particular command, look in the index
+if you know what the command is. Both command characters and function
+names are indexed. If you know vaguely what the command
+does, look in the topic index.
ADDED psl-1983/3-1/doc/nmode/nm-key-index.contents
Index: psl-1983/3-1/doc/nmode/nm-key-index.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-key-index.contents
@@ -0,0 +1,1 @@
+contents_entry(0 29 {Key Index} 29-1)
ADDED psl-1983/3-1/doc/nmode/nm-key-index.ibm
Index: psl-1983/3-1/doc/nmode/nm-key-index.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-key-index.ibm
@@ -0,0 +1,354 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-KEY-INDEX.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Key Index) Page 29-1
+
+
+ 202/29. Key Index
+
+ 201/) . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-15
+
+ Altmode . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ altmode . . . . . . . . . . . . . . . . . . . . . . . . . 3-3
+
+ backspace . . . . . . . . . . . . . . . . . . . . . . . . 3-3, 20-1
+ BACKSPACE . . . . . . . . . . . . . . . . . . . . . . . 27-7
+
+ C- . . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-1
+ C-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ C-% . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-33
+ C-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-5
+ C-) . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-13
+ C-- . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-29
+ C-0 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-1 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-2 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-3 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-4 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-5 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-6 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-7 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-8 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-9 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-< . . . . . . . . . . . . . . . . . . . . . . . . . . . 10-2, 27-23
+ C-= . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-43
+ C-> . . . . . . . . . . . . . . . . . . . . . . . . . . . 10-2, 27-23
+ C-? . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-14
+ C-@ . . . . . . . . . . . . . . . . . . . . . . . . . . . 10-1, 27-37
+ C-A . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 13-2, 20-2,
+ 27-28
+ C-B . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-25
+ C-D . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-2, 6-1, 11-1,
+ 27-8
+ C-E . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 13-2, 20-2,
+ 27-28
+ C-F . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-26
+ C-G . . . . . . . . . . . . . . . . . . . . . . . . . . . 6-1, 12-2, 15-1,
+ 23-1, 27-29
+ C-K . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-2, 11-1, 13-2,
+ 27-18
+ C-L . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 17-1, 27-30
+ C-M-\ . . . . . . . . . . . . . . . . . . . . . . . . . . 13-3, 20-7,
+ 27-15, 27-20
+ C-M-( . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4
+ C-M-) . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4
+ C-M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5
+ C-M-] . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5
+ C-M-( . . . . . . . . . . . . . . . . . . . . . . . . . . 27-5
+ C-M-) . . . . . . . . . . . . . . . . . . . . . . . . . . 27-13
+ C-M-- . . . . . . . . . . . . . . . . . . . . . . . . . . 27-29
+ 201/Page 29-2 NMODE Manual (Key Index)
+
+
+ C-M-0 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-1 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-2 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-3 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-4 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-5 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-6 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-7 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-8 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-9 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ C-M-@ . . . . . . . . . . . . . . . . . . . . . . . . . . 10-2, 20-5, 27-24
+ C-M-A . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5, 27-25
+ C-M-B . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4, 27-25
+ C-M-BACKSPACE . . . . . . . . . . . . . . . . . . . . 27-23
+ C-M-D . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4, 27-9
+ C-M-E . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5, 27-10
+ C-M-F . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4, 27-27
+ C-M-H . . . . . . . . . . . . . . . . . . . . . . . . . . 10-2, 20-5, 27-23
+ C-M-I . . . . . . . . . . . . . . . . . . . . . . . . . . 27-22
+ C-M-K . . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 20-4, 27-18
+ C-M-L . . . . . . . . . . . . . . . . . . . . . . . . . . 16-1, 27-36
+ C-M-M . . . . . . . . . . . . . . . . . . . . . . . . . . 13-4, 20-2, 27-4
+ C-M-N . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4, 27-27
+ C-M-O . . . . . . . . . . . . . . . . . . . . . . . . . . 20-2, 27-37
+ C-M-P . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4, 27-25
+ C-M-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 20-6, 27-20
+ C-M-R . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-33
+ C-M-RETURN . . . . . . . . . . . . . . . . . . . . . . 27-4
+ C-M-Rubout . . . . . . . . . . . . . . . . . . . . . . . 11-1, 20-4
+ C-M-RUBOUT . . . . . . . . . . . . . . . . . . . . . . 27-17
+ C-M-T . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5, 27-39
+ C-M-Tab . . . . . . . . . . . . . . . . . . . . . . . . . 20-6
+ C-M-TAB . . . . . . . . . . . . . . . . . . . . . . . . 27-22
+ C-M-U . . . . . . . . . . . . . . . . . . . . . . . . . . 20-4, 27-5
+ C-M-V . . . . . . . . . . . . . . . . . . . . . . . . . . 18-2, 27-34
+ C-M-W . . . . . . . . . . . . . . . . . . . . . . . . . . 11-3, 27-2
+ C-M-X . . . . . . . . . . . . . . . . . . . . . . . . . . 27-22
+ C-M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . 27-25
+ C-M-] . . . . . . . . . . . . . . . . . . . . . . . . . . 27-10
+ C-M-^ . . . . . . . . . . . . . . . . . . . . . . . . . . 20-6
+ C-N . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-26
+ C-O . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-3, 5-1, 20-2,
+ 27-31
+ C-P . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-29
+ C-Q . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 13-3, 27-17
+ C-R . . . . . . . . . . . . . . . . . . . . . . . . . . . 12-1, 27-33
+ C-RUBOUT . . . . . . . . . . . . . . . . . . . . . . . 27-7
+ C-S . . . . . . . . . . . . . . . . . . . . . . . . . . . 12-1, 27-14
+ C-Space . . . . . . . . . . . . . . . . . . . . . . . . . 10-1
+ C-SPACE . . . . . . . . . . . . . . . . . . . . . . . . 27-37
+ C-T . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 14-1, 27-39
+ C-U . . . . . . . . . . . . . . . . . . . . . . . . . . . 5-1, 10-2, 13-3,
+ 27-41
+ 201/NMODE Manual (Key Index) Page 29-3
+
+
+ C-V . . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-29
+ C-W . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 13-3, 27-18
+ C-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2, 4-2, 4-3,
+ 8-1, 10-1, 10-2,
+ 11-1, 11-4, 11-5,
+ 13-2, 13-5, 13-6,
+ 14-1, 14-2, 15-1,
+ 15-2, 15-3, 16-1,
+ 16-2, 17-2, 18-1,
+ 18-2, 18-3, 22-2,
+ 22-5, 27-5
+ C-X < . . . . . . . . . . . . . . . . . . . . . . . . . . 27-35
+ C-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-36
+ C-X 1 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-30
+ C-X 2 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-40
+ C-X 3 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-42
+ C-X 4 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-43
+ C-X = . . . . . . . . . . . . . . . . . . . . . . . . . . 27-43
+ C-X > . . . . . . . . . . . . . . . . . . . . . . . . . . 27-35
+ C-X A . . . . . . . . . . . . . . . . . . . . . . . . . . 27-2
+ C-X B . . . . . . . . . . . . . . . . . . . . . . . . . . 27-35
+ C-X C-B . . . . . . . . . . . . . . . . . . . . . . . . . 27-5
+ C-X C-F . . . . . . . . . . . . . . . . . . . . . . . . . 27-13
+ C-X C-L . . . . . . . . . . . . . . . . . . . . . . . . . 27-22
+ C-X C-N . . . . . . . . . . . . . . . . . . . . . . . . . 27-36
+ C-X C-O . . . . . . . . . . . . . . . . . . . . . . . . . 27-7
+ C-X C-S . . . . . . . . . . . . . . . . . . . . . . . . . 27-34
+ C-X C-T . . . . . . . . . . . . . . . . . . . . . . . . . 27-40
+ C-X C-U . . . . . . . . . . . . . . . . . . . . . . . . . 27-42
+ C-X C-V . . . . . . . . . . . . . . . . . . . . . . . . . 27-42
+ C-X C-W . . . . . . . . . . . . . . . . . . . . . . . . . 27-43
+ C-X C-X . . . . . . . . . . . . . . . . . . . . . . . . . 27-10
+ C-X C-Z . . . . . . . . . . . . . . . . . . . . . . . . . 27-29
+ C-X D . . . . . . . . . . . . . . . . . . . . . . . . . . 27-9
+ C-X E . . . . . . . . . . . . . . . . . . . . . . . . . . 27-10
+ C-X F . . . . . . . . . . . . . . . . . . . . . . . . . . 27-36
+ C-X G . . . . . . . . . . . . . . . . . . . . . . . . . . 27-14
+ C-X H . . . . . . . . . . . . . . . . . . . . . . . . . . 27-24
+ C-X K . . . . . . . . . . . . . . . . . . . . . . . . . . 27-17
+ C-X O . . . . . . . . . . . . . . . . . . . . . . . . . . 27-31
+ C-X P . . . . . . . . . . . . . . . . . . . . . . . . . . 27-44
+ C-X RUBOUT . . . . . . . . . . . . . . . . . . . . . . 27-4
+ C-X T . . . . . . . . . . . . . . . . . . . . . . . . . . 27-40
+ C-X V . . . . . . . . . . . . . . . . . . . . . . . . . . 27-30
+ C-X X . . . . . . . . . . . . . . . . . . . . . . . . . . 27-32
+ C-X ^ . . . . . . . . . . . . . . . . . . . . . . . . . . 27-14
+ C-Y . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-2, 27-16
+ C-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-21
+ C-^ . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ 201/Page 29-4 NMODE Manual (Key Index)
+
+
+ ESC . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ ESC-4 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-26
+ ESC-5 . . . . . . . . . . . . . . . . . . . . . . . . . . 27-27
+ ESC-A . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-29
+ ESC-B . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-26
+ ESC-C . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-26
+ ESC-D . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-25
+ ESC-F . . . . . . . . . . . . . . . . . . . . . . . . . . 27-28
+ ESC-H . . . . . . . . . . . . . . . . . . . . . . . . . . 27-28
+ ESC-J . . . . . . . . . . . . . . . . . . . . . . . . . . 17-1, 27-30
+ ESC-L . . . . . . . . . . . . . . . . . . . . . . . . . . 27-31
+ ESC-M . . . . . . . . . . . . . . . . . . . . . . . . . . 27-18
+ ESC-P . . . . . . . . . . . . . . . . . . . . . . . . . . 27-8
+ ESC-S . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-35
+ ESC-T . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-34
+ ESC-U . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-35
+ ESC-V . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-34
+ Esc-_ . . . . . . . . . . . . . . . . . . . . . . . . . . 27-2
+ ESCape . . . . . . . . . . . . . . . . . . . . . . . . . 19-1
+ ESCAPE . . . . . . . . . . . . . . . . . . . . . . . . . 27-10
+
+ linefeed . . . . . . . . . . . . . . . . . . . . . . . . . 3-3
+ Linefeed . . . . . . . . . . . . . . . . . . . . . . . . . 20-1
+ lisp-? . . . . . . . . . . . . . . . . . . . . . . . . . . 20-8
+ Lisp-? . . . . . . . . . . . . . . . . . . . . . . . . . . 27-20
+ lisp-A . . . . . . . . . . . . . . . . . . . . . . . . . . 20-8
+ Lisp-A . . . . . . . . . . . . . . . . . . . . . . . . . . 27-19
+ lisp-B . . . . . . . . . . . . . . . . . . . . . . . . . . 20-8
+ Lisp-B . . . . . . . . . . . . . . . . . . . . . . . . . . 27-19
+ lisp-C . . . . . . . . . . . . . . . . . . . . . . . . . . 20-8
+ Lisp-C . . . . . . . . . . . . . . . . . . . . . . . . . . 27-20
+ Lisp-D . . . . . . . . . . . . . . . . . . . . . . . . . . 27-11
+ Lisp-E . . . . . . . . . . . . . . . . . . . . . . . . . . 27-11
+ Lisp-L . . . . . . . . . . . . . . . . . . . . . . . . . . 27-11
+ lisp-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 20-8
+ Lisp-Q . . . . . . . . . . . . . . . . . . . . . . . . . . 27-21
+ lisp-R . . . . . . . . . . . . . . . . . . . . . . . . . . 20-8
+ Lisp-R . . . . . . . . . . . . . . . . . . . . . . . . . . 27-21
+ Lisp-Y . . . . . . . . . . . . . . . . . . . . . . . . . . 27-44
+
+ M- . . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-1
+ M-\ . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 13-3, 20-2,
+ 27-8
+ M-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5
+ M-) . . . . . . . . . . . . . . . . . . . . . . . . . . . 20-5
+ M-% . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-32
+ M-' . . . . . . . . . . . . . . . . . . . . . . . . . . . 14-2, 27-41
+ M-( . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-23
+ M-) . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-27
+ M-- . . . . . . . . . . . . . . . . . . . . . . . . . . . 14-2, 27-29
+ M-/ . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-14
+ M-0 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-1 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ 201/NMODE Manual (Key Index) Page 29-5
+
+
+ M-2 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-3 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-4 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-5 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-6 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-7 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-8 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-9 . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-3
+ M-; . . . . . . . . . . . . . . . . . . . . . . . . . . . 20-3, 27-16
+ M-< . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-28
+ M-> . . . . . . . . . . . . . . . . . . . . . . . . . . . 4-1, 27-28
+ M-? . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-14
+ M-@ . . . . . . . . . . . . . . . . . . . . . . . . . . . 10-2, 13-2, 27-24
+ M-A . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-2, 27-4
+ M-B . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-1, 27-26
+ M-Backspace . . . . . . . . . . . . . . . . . . . . . . . 11-1, 13-1, 14-1
+ M-BACKSPACE . . . . . . . . . . . . . . . . . . . . . . 27-23
+ M-C . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-5, 14-2, 27-42
+ M-D . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 13-1, 27-18
+ M-E . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-2, 27-13
+ M-F . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-1, 27-27
+ M-G . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-4, 27-12
+ M-H . . . . . . . . . . . . . . . . . . . . . . . . . . . 10-2, 13-3, 13-4,
+ 27-24
+ M-I . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-39
+ M-K . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 13-2, 27-19
+ M-L . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-5, 14-2, 27-22
+ M-M . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-4, 20-2, 27-4
+ M-Q . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-4, 27-12
+ M-R . . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-28
+ M-RETURN . . . . . . . . . . . . . . . . . . . . . . . . 27-4
+ M-RUBOUT . . . . . . . . . . . . . . . . . . . . . . . 27-17
+ M-S . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-5, 27-6
+ M-T . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-1, 27-40
+ M-Tab . . . . . . . . . . . . . . . . . . . . . . . . . . 13-3
+ M-TAB . . . . . . . . . . . . . . . . . . . . . . . . . . 27-39
+ M-U . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-5, 14-2, 27-42
+ M-V . . . . . . . . . . . . . . . . . . . . . . . . . . . 17-2, 27-31
+ M-W . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-3, 27-6
+ M-X . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2, 6-1, 6-2,
+ 8-1, 15-2, 15-3,
+ 15-4, 21-1, 22-2,
+ 27-22
+ M-X Append To File . . . . . . . . . . . . . . . . . . . 27-2
+ M-X Apropos . . . . . . . . . . . . . . . . . . . . . . . 27-2
+ M-X Auto Fill Mode . . . . . . . . . . . . . . . . . . . 27-3
+ M-X Count Occurrences . . . . . . . . . . . . . . . . . 27-6
+ M-X Delete And Expunge File . . . . . . . . . . . . . . 27-6
+ M-X Delete File . . . . . . . . . . . . . . . . . . . . . 27-7
+ M-X Delete Matching Lines . . . . . . . . . . . . . . . . 27-8
+ M-X Delete Non-Matching Lines . . . . . . . . . . . . . . 27-8
+ M-X Dired . . . . . . . . . . . . . . . . . . . . . . . . 27-9
+ M-X Edit Directory . . . . . . . . . . . . . . . . . . . . 27-9
+ 201/Page 29-6 NMODE Manual (Key Index)
+
+
+ M-X Execute Buffer . . . . . . . . . . . . . . . . . . . 27-10
+ M-X Execute File . . . . . . . . . . . . . . . . . . . . . 27-11
+ M-X Find File . . . . . . . . . . . . . . . . . . . . . . 27-13
+ M-X Flush Lines . . . . . . . . . . . . . . . . . . . . . 27-8
+ M-X How Many . . . . . . . . . . . . . . . . . . . . . . 27-6
+ M-X Insert Buffer . . . . . . . . . . . . . . . . . . . . 27-15
+ M-X Insert Date . . . . . . . . . . . . . . . . . . . . . 27-16
+ M-X Insert File . . . . . . . . . . . . . . . . . . . . . 27-16
+ M-X Keep Lines . . . . . . . . . . . . . . . . . . . . . 27-8
+ M-X Kill Buffer . . . . . . . . . . . . . . . . . . . . . 27-17
+ M-X Kill File . . . . . . . . . . . . . . . . . . . . . . . 27-7
+ M-X Kill Some Buffers . . . . . . . . . . . . . . . . . . 27-19
+ M-X Lisp Mode . . . . . . . . . . . . . . . . . . . . . . 27-21
+ M-X List Buffers . . . . . . . . . . . . . . . . . . . . . 27-5
+ M-X Make Space . . . . . . . . . . . . . . . . . . . . . 27-30
+ M-X Prepend To File . . . . . . . . . . . . . . . . . . . 27-31
+ M-X Query Replace . . . . . . . . . . . . . . . . . . . 27-32
+ M-X Rename Buffer . . . . . . . . . . . . . . . . . . . 27-32
+ M-X Replace String . . . . . . . . . . . . . . . . . . . 27-33
+ M-X Revert File . . . . . . . . . . . . . . . . . . . . . 27-33
+ M-X Save All Files . . . . . . . . . . . . . . . . . . . . 27-34
+ M-X Select Buffer . . . . . . . . . . . . . . . . . . . . 27-35
+ M-X Set Key . . . . . . . . . . . . . . . . . . . . . . . 27-37
+ M-X Set Visited Filename . . . . . . . . . . . . . . . . . 27-37
+ M-X Start Scripting . . . . . . . . . . . . . . . . . . . 27-38
+ M-X Start Timing Nmode . . . . . . . . . . . . . . . . . 27-38
+ M-X Stop Scripting . . . . . . . . . . . . . . . . . . . 27-38
+ M-X Stop Timing Nmode . . . . . . . . . . . . . . . . . 27-38
+ M-X Text Mode . . . . . . . . . . . . . . . . . . . . . 27-39
+ M-X Undelete File . . . . . . . . . . . . . . . . . . . . 27-41
+ M-X Visit File . . . . . . . . . . . . . . . . . . . . . . 27-42
+ M-X Write File . . . . . . . . . . . . . . . . . . . . . . 27-43
+ M-X Write Region . . . . . . . . . . . . . . . . . . . . 27-43
+ M-Y . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-3, 27-41
+ M-Z . . . . . . . . . . . . . . . . . . . . . . . . . . . 20-3, 27-12
+ M-[ . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-3, 27-4
+ M-] . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-3, 27-13
+ M-^ . . . . . . . . . . . . . . . . . . . . . . . . . . . 11-1, 13-3, 20-2,
+ 20-6, 27-8
+ M-~ . . . . . . . . . . . . . . . . . . . . . . . . . . . 15-2, 27-5
+
+ NEWLINE . . . . . . . . . . . . . . . . . . . . . . . . . 27-15
+
+ RETURN . . . . . . . . . . . . . . . . . . . . . . . . . 27-33
+ Rubout . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ rubout . . . . . . . . . . . . . . . . . . . . . . . . . . 3-3
+ Rubout . . . . . . . . . . . . . . . . . . . . . . . . . 20-1
+ RUBOUT . . . . . . . . . . . . . . . . . . . . . . . . . 27-7
+ 201/NMODE Manual (Key Index) Page 29-7
+
+
+ Space . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ space . . . . . . . . . . . . . . . . . . . . . . . . . . 3-3
+ Space . . . . . . . . . . . . . . . . . . . . . . . . . . 13-4
+
+ Tab . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-2
+ tab . . . . . . . . . . . . . . . . . . . . . . . . . . . 3-3
+ Tab . . . . . . . . . . . . . . . . . . . . . . . . . . . 13-1, 13-3, 20-1,
+ 20-3, 20-6
+ TAB . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-22, 27-39
+
+ ] . . . . . . . . . . . . . . . . . . . . . . . . . . . . 27-15
ADDED psl-1983/3-1/doc/nmode/nm-killing.contents
Index: psl-1983/3-1/doc/nmode/nm-killing.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-killing.contents
@@ -0,0 +1,11 @@
+contents_entry(0 11 {Killing and Moving Text} 11-1)
+contents_entry(1 11.1 {Deletion and Killing} 11-1)
+contents_entry(2 11.1.1 {Deletion} 11-1)
+contents_entry(2 11.1.2 {Killing by Lines} 11-2)
+contents_entry(2 11.1.3 {Other Kill Commands} 11-2)
+contents_entry(1 11.2 {Un-Killing} 11-2)
+contents_entry(2 11.2.1 {Appending Kills} 11-3)
+contents_entry(2 11.2.2 {Un-killing Earlier Kills} 11-3)
+contents_entry(1 11.3 {Other Ways of Copying Text} 11-4)
+contents_entry(2 11.3.1 {Accumulating Text} 11-4)
+contents_entry(2 11.3.2 {Copying Text Many Times} 11-5)
ADDED psl-1983/3-1/doc/nmode/nm-killing.function
Index: psl-1983/3-1/doc/nmode/nm-killing.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-killing.function
@@ -0,0 +1,24 @@
+.silent_index {kill-forward-word-command} idx 11-1
+.silent_index {kill-backward-word-command} idx 11-1
+.silent_index {kill-forward-form-command} idx 11-1
+.silent_index {kill-backward-form-command} idx 11-1
+.silent_index {backward-kill-sentence-command} idx 11-1
+.silent_index {kill-sentence-command} idx 11-1
+.silent_index {delete-forward-character-command} idx 11-1
+.silent_index {delete-backward-hacking-tabs-command} idx 11-1
+.silent_index {kill-line} idx 11-1
+.silent_index {kill-region} idx 11-1
+.silent_index {delete-horizontal-space-command} idx 11-1
+.silent_index {delete-blank-lines-command} idx 11-1
+.silent_index {delete-indentation-command} idx 11-1
+.silent_index {kill-region} idx 11-2
+.silent_index {insert-kill-buffer} idx 11-2
+.silent_index {copy-region} idx 11-3
+.silent_index {append-next-kill-command} idx 11-3
+.silent_index {unkill-previous} idx 11-3
+.silent_index {append-to-buffer-command} idx 11-4
+.silent_index {insert-buffer-command} idx 11-4
+.silent_index {append-to-file-command} idx 11-4
+.silent_index {prepend-to-file-command} idx 11-4
+.silent_index {put-register-command} idx 11-5
+.silent_index {get-register-command} idx 11-5
ADDED psl-1983/3-1/doc/nmode/nm-killing.ibm
Index: psl-1983/3-1/doc/nmode/nm-killing.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-killing.ibm
@@ -0,0 +1,271 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-KILLING.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Killing and Moving Text) Page 11-1
+
+
+ 202/11. Killing and Moving Text
+
+ 201/The commonest way of moving or copying text with NMODE is to kill it, and
+ get it back again in one or more places. This is very safe because the last
+ several pieces of killed text are all remembered, and it is versatile, because
+ the many commands for killing syntactic units can also be used for moving
+ those units. There are also other ways of moving text for special purposes.
+
+ 202/11.1 Deletion and Killing
+
+ 201/Most commands which erase text from the buffer save it so that you can get
+ it back if you change your mind, or move or copy it to other parts of the
+ buffer. These commands are known as 202/kill 201/commands. The rest of the
+ commands that erase text do not save it; they are known as 202/delete 201/commands.
+ The delete commands include C-D and Backspace, which delete only one
+ character at a time, and those commands that delete only spaces or line
+ separators. Commands that can destroy significant amounts of nontrivial data
+ generally kill. The commands' names and individual descriptions use the
+ words "kill" and "delete" to say which they do.
+
+ C-D Delete next character.
+ Backspace Delete previous character.
+ M-\ Delete spaces and tabs around point.
+ C-X C-O Delete blank lines around the current line.
+ M-^ Join two lines by deleting the line separator and any
+ indentation.
+ C-K Kill rest of line or one or more lines.
+ C-W Kill region (from point to the mark).
+ M-D Kill word.
+ M-Backspace Kill word backwards.
+ C-X Rubout Kill back to beginning of sentence.
+ M-K Kill to end of sentence.
+ C-M-K Kill Lisp form.
+ C-M-Rubout Kill Lisp form backwards.
+
+
+ 202/11.1.1 Deletion
+
+ 201/The most basic delete commands are C-D and Backspace. C-D deletes the
+ character after the cursor, the one the cursor is "on top of" or
+ "underneath". The cursor doesn't move. Backspace deletes the character
+ before the cursor, and moves the cursor back. Line separators act like
+ single characters when deleted. Actually, C-D and Backspace aren't always
+ delete commands; if you give an argument, they kill instead. This prevents
+ you from losing a great deal of text by typing a large argument to a C-D or
+ Backspace.
+
+ The other delete commands are those which delete only formatting
+ characters: spaces, tabs and line separators. M-\
+ (203/delete-horizontal-space-command201/) deletes all the spaces and tab characters
+ before and after point. C-X C-O (203/delete-blank-lines-command201/) deletes all
+ blank lines after the current line, and if the current line is blank deletes all
+ blank lines preceding the current line as well (leaving one blank line, the
+ 201/Page 11-2 NMODE Manual (Deletion)
+
+
+ current line). M-^ (203/delete-indentation-command201/) joins the current line and
+ the previous line, or the current line and the next line if given an argument.
+ See Section 13.3 [Indentation], page 3.
+
+ 202/11.1.2 Killing by Lines
+
+ 201/The simplest kill command is the C-K command (203/kill-line201/). If given at the
+ beginning of a line, it kills all the text on the line, leaving it blank. If
+ given on a blank line, the blank line disappears. As a consequence, if you
+ go to the front of a non-blank line and type two C-K's, the line disappears
+ completely.
+
+ More generally, C-K kills from point up to the end of the line, unless it is
+ at the end of a line. In that case it kills the line separator following the
+ line, thus merging the next line into the current one. Invisible spaces and
+ tabs at the end of the line are ignored when deciding which case applies, so
+ if point appears to be at the end of the line, you can be sure the line
+ separator will be killed.
+
+ If C-K is given a positive argument, it kills that many lines, and the
+ separators that follow them (however, text on the current line before point is
+ spared). With a negative argument, it kills back to a number of line
+ beginnings. An argument of -2 means kill back to the second line beginning.
+ If point is at the beginning of a line, that line beginning doesn't count, so
+ C-U - 2 C-K with point at the front of a line kills the two previous lines.
+
+ C-K with an argument of zero kills all the text before point on the current
+ line.
+
+ 202/11.1.3 Other Kill Commands
+
+ 201/A kill command which is very general is C-W (203/kill-region201/), which kills
+ everything between point and the mark. With this command, you can kill any
+ contiguous characters, if you first set the mark at one end of them and go to
+ the other end.
+
+ Other syntactic units can be killed: words, with M-Backspace and M-D (See
+ Section 13.1 [Words], page 1.); forms, with C-M-Rubout and C-M-K (See
+ Section 20.5.1 [Forms], page 3.); sentences, with C-X Rubout and M-K (See
+ Section 13.2 [Sentences], page 2.).
+
+ 202/11.2 Un-Killing
+
+ 201/Un-killing is getting back text which was killed. The usual way to move or
+ copy text is to kill it and then un-kill it one or more times.
+
+ C-Y Yank (re-insert) last killed text.
+ M-Y Replace re-inserted killed text with the previously killed text.
+ M-W Save region as last killed text without killing.
+ C-M-W Append next kill to last batch of killed text.
+
+ Killed text is pushed onto a 202/ring buffer 201/called the 202/kill ring 201/that remembers
+ the last 16 blocks of text that were killed. (Why it is called a ring buffer
+ 201/NMODE Manual (Un-Killing) Page 11-3
+
+
+ will be explained below). The command C-Y (203/insert-kill-buffer201/) reinserts the
+ text of the most recent kill. It leaves the cursor at the end of the text, and
+ puts the mark at the beginning. Thus, a single C-W undoes the C-Y. C-U
+ C-Y leaves the cursor in front of the text, and the mark after. This is only
+ if the argument is specified with just a C-U, precisely. Any other sort of
+ argument, including C-U and digits, has an effect described below.
+
+ If you wish to copy a block of text, you might want to use M-W
+ (203/copy-region201/), which copies the region into the kill ring without removing it
+ from the buffer. This is approximately equivalent to C-W followed by C-Y,
+ except that M-W does not mark the buffer as "changed" and does not
+ temporarily change the screen.
+
+ There is only one kill ring, and switching buffers or files has no effect on
+ it. After visiting a new file, whatever was last killed in the previous file is
+ still on top of the kill ring. This is important for moving text between files.
+
+ 202/11.2.1 Appending Kills
+
+ 201/Normally, each kill command pushes a new block onto the kill ring.
+ However, two or more kill commands in a row combine their text into a single
+ entry on the ring, so that a single C-Y command gets it all back as it was
+ before it was killed. This means that you don't have to kill all the text in
+ one command; you can keep killing line after line, or word after word, until
+ you have killed it all, and you can still get it all back at once. (Thus we
+ join television in leading people to kill thoughtlessly).
+
+ Commands that kill forward from point add onto the end of the previous
+ killed text. Commands that kill backward from point add onto the beginning.
+ This way, any sequence of mixed forward and backward kill commands puts
+ all the killed text into one entry without rearrangement.
+
+ If a kill command is separated from the last kill command by other
+ commands, it starts a new entry on the kill ring, unless you tell it not to by
+ saying C-M-W (203/append-next-kill-command201/) in front of it. The C-M-W tells
+ the following command, if it is a kill command, to append the text it kills to
+ the last killed text, instead of starting a new entry. With C-M-W, you can
+ kill several separated pieces of text and accumulate them to be yanked back
+ in one place.
+
+ 202/11.2.2 Un-killing Earlier Kills
+
+ 201/To recover killed text that is no longer the most recent kill, you need the
+ Meta-Y (203/unkill-previous201/) command. The M-Y command should be used only
+ after a C-Y command or another M-Y. It takes the un-killed text inserted by
+ the C-Y and replaces it with the text from an earlier kill. So, to recover the
+ text of the next-to-the-last kill, you first use C-Y to recover the last kill,
+ and then use M-Y to move back to the previous kill.
+
+ You can think of all the last few kills as living in a ring. After a C-Y
+ command, the text at the front of the ring is also present in the buffer.
+ M-Y "rotates" the ring, bringing the previous string of text to the front,
+ and this text replaces the other text in the buffer as well. Enough M-Y
+ 201/Page 11-4 NMODE Manual (Un-killing Earlier Kills)
+
+
+ commands can rotate any part of the ring to the front, so you can get at any
+ killed text as long as it is recent enough to be still in the ring. Eventually
+ the ring rotates all the way around and the most recent killed text comes to
+ the front (and into the buffer) again. M-Y with a negative argument rotates
+ the ring backwards. If the region doesn't match the text at the front of the
+ ring, M-Y is not allowed.
+
+ In any case, when the text you are looking for is brought into the buffer,
+ you can stop doing M-Y's and it will stay there. It's really just a copy of
+ what's at the front of the ring, so editing it does not change what's in the
+ ring. And the ring, once rotated, stays rotated, so that doing another C-Y
+ gets another copy of what you rotated to the front with M-Y.
+
+ If you change your mind about un-killing, a C-W gets rid of the un-killed
+ text at any point, after any number of M-Y's. C-W pushes the text onto the
+ ring again.
+
+ If you know how many M-Y's it would take to find the text you want, then
+ there is an alternative. C-Y with an argument greater than one restores the
+ text the specified number of entries down on the ring. Thus, C-U 2 C-Y
+ gets the next to the last block of killed text. It differs from C-Y M-Y in
+ that C-U 2 C-Y does not permanently rotate the ring.
+
+ 202/11.3 Other Ways of Copying Text
+
+ 201/Usually we copy or move text by killing it and un-killing it, but there are
+ other ways that are useful for copying one block of text in many places, or
+ for copying many scattered blocks of text into one place.
+
+
+ 202/11.3.1 Accumulating Text
+
+ 201/You can accumulate blocks of text from scattered locations either into a
+ buffer or into a file if you like.
+
+ To append them into a buffer, use the command C-X A
+ (203/append-to-buffer-command201/), which inserts a copy of the region into the
+ specified buffer at the location of point in that buffer. This command will
+ prompt for the name of a buffer, which should be terminated with Return. If
+ there is no buffer with the name you specify, one is created. If you append
+ text into a buffer which has been used for editing, the copied text goes into
+ the middle of the text of the buffer, wherever point happens to be in it.
+
+ Point in that buffer is left at the end of the copied text, so successive
+ uses of C-X A accumulate the text in the specified buffer in the same order
+ as they were copied. If C-X A is given an argument, point in the other
+ buffer is left before the copied text, so successive uses of C-X A add text in
+ reverse order.
+
+ You can retrieve the accumulated text from that buffer with M-X Insert
+ Buffer (203/insert-buffer-command201/). This inserts a copy of the text in that
+ buffer into the selected buffer. It prompts for the buffer name needed. You
+ can also select the other buffer for editing. See Section 16 [Buffers], page
+ 201/NMODE Manual (Accumulating Text) Page 11-5
+
+
+ 1, for background information on buffers.
+
+ Strictly speaking, C-X A does not always append to the text already in the
+ buffer. But if it is used on a buffer which starts out empty, it does keep
+ appending to the end.
+
+ Instead of accumulating text within NMODE, in a buffer, you can append
+ text directly into a disk file with the command M-X Append to File
+ (203/append-to-file-command201/). It adds the text of the region to the end of the
+ specified file. M-X Prepend to File (203/prepend-to-file-command201/) adds the text
+ to the beginning of the file instead. Both commands prompt for the file
+ name. The file is changed immediately on disk. These commands are
+ normally used with files that are 203/not 201/being visited in NMODE. They have the
+ advantage of working even on files too large to fit into the NMODE address
+ space.
+
+ 202/11.3.2 Copying Text Many Times
+
+ 201/When you want to insert a copy of the same piece of text frequently, the
+ kill ring becomes impractical, since the text moves down on the ring as you
+ edit, and will be in an unpredictable place on the ring when you need it
+ again. For this case, you can use the commands C-X X
+ (203/put-register-command201/) and C-X G (203/get-register-command201/) to move the text.
+
+ C-X X stores a copy of the text of the region in a place called a register.
+ With an argument, C-X X deletes the text as well. C-X G inserts the text
+ from a register into the buffer. Both these commands prompt for the register
+ name, which must be a single letter or digit. This gives 36 places in which
+ you can store a piece of text. Normally C-X G leaves point before the text
+ and places the mark after, but with a numeric argument it puts point after
+ the text and the mark before.
ADDED psl-1983/3-1/doc/nmode/nm-killing.key
Index: psl-1983/3-1/doc/nmode/nm-killing.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-killing.key
@@ -0,0 +1,22 @@
+.silent_index {M-D} idx 11-1
+.silent_index {M-Backspace} idx 11-1
+.silent_index {C-M-K} idx 11-1
+.silent_index {C-M-Rubout} idx 11-1
+.silent_index {C-X} idx 11-1
+.silent_index {M-K} idx 11-1
+.silent_index {C-D} idx 11-1
+.silent_index {C-K} idx 11-1
+.silent_index {C-W} idx 11-1
+.silent_index {C-D} idx 11-1
+.silent_index {C-K} idx 11-1
+.silent_index {C-W} idx 11-1
+.silent_index {M-\} idx 11-1
+.silent_index {C-X} idx 11-1
+.silent_index {M-^} idx 11-1
+.silent_index {C-Y} idx 11-2
+.silent_index {M-W} idx 11-3
+.silent_index {C-M-W} idx 11-3
+.silent_index {M-Y} idx 11-3
+.silent_index {C-X} idx 11-4
+.silent_index {C-X} idx 11-5
+.silent_index {C-X} idx 11-5
ADDED psl-1983/3-1/doc/nmode/nm-killing.r
Index: psl-1983/3-1/doc/nmode/nm-killing.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-killing.r
@@ -0,0 +1,327 @@
+.so pndoc:nman
+.part NM-KILLING manual
+@chapter(Killing and Moving Text)
+ The commonest way of moving or copying text with NMODE is to kill
+it, and get it back again in one or more places. This is very safe
+because the last several pieces of killed text are all remembered, and
+it is versatile, because the many commands for killing syntactic units
+can also be used for moving those units. There are also other ways of
+moving text for special purposes.
+@node("killing")
+@section(Deletion and Killing)
+@keyindex{M-D}
+@fncindex{kill-forward-word-command}
+@keyindex{M-Backspace}
+@fncindex{kill-backward-word-command}
+@keyindex{C-M-K}
+@fncindex{kill-forward-form-command}
+@keyindex{C-M-Rubout}
+@fncindex{kill-backward-form-command}
+@keyindex{C-X Rubout}
+@fncindex{backward-kill-sentence-command}
+@keyindex{M-K}
+@fncindex{kill-sentence-command}
+@keyindex{C-D}
+@fncindex{delete-forward-character-command}
+@index{Backspace}
+@fncindex{delete-backward-hacking-tabs-command}
+@keyindex{C-K}
+@fncindex{kill-line}
+@keyindex{C-W}
+@fncindex{kill-region}
+@index{killing}
+@index{deletion}
+@keyindex{C-D}
+@index{Backspace}
+@keyindex{C-K}
+@keyindex{C-W}
+@index{lines}
+ Most commands which erase text from the buffer save it so that you
+can get it back if you change your mind, or move or copy it to other
+parts of the buffer. These commands are known as @dfn[kill] commands.
+The rest of the commands that erase text do not save it; they are
+known as @dfn[delete] commands. The delete commands include C-D and
+Backspace, which delete only one character at a time, and those commands
+that delete only spaces or line separators. Commands that can destroy
+significant amounts of nontrivial data generally kill. The commands'
+names and individual descriptions use the words "kill" and "delete" to
+say which they do.
+@DoubleWideCommands[
+C-D Delete next character.
+
+Backspace Delete previous character.
+
+M-\ Delete spaces and tabs around point.
+
+C-X C-O Delete blank lines around the current line.
+
+M-^ Join two lines by deleting the line separator and any indentation.
+
+C-K Kill rest of line or one or more lines.
+
+C-W Kill region (from point to the mark).
+
+M-D Kill word.
+
+M-Backspace Kill word backwards.
+
+C-X Rubout Kill back to beginning of sentence.
+
+M-K Kill to end of sentence.
+
+C-M-K Kill Lisp form.
+
+C-M-Rubout Kill Lisp form backwards.
+]
+@Subsection[Deletion]
+ The most basic delete commands are C-D and Backspace. C-D deletes the
+character after the cursor, the one the cursor is "on top of" or
+"underneath". The cursor doesn't move. Backspace deletes the character
+before the cursor, and moves the cursor back. Line separators act
+like single characters when deleted. Actually, C-D and Backspace aren't
+always delete commands; if you give an argument, they kill instead.
+This prevents you from losing a great deal of text by typing a large
+argument to a C-D or Backspace.
+
+@keyindex{M-\}
+@fncindex{delete-horizontal-space-command}
+@Keyindex{C-X C-O}
+@fncindex{delete-blank-lines-command}
+@keyindex{M-^}
+@fncindex{delete-indentation-command}
+ The other delete commands are those which delete only formatting
+characters: spaces, tabs and line separators. M-\
+(@fnc{delete-horizontal-space-command}) deletes all the spaces and tab
+characters before and after point. C-X C-O
+(@fnc{delete-blank-lines-command}) deletes all blank lines after the
+current line, and if the current line is blank deletes all blank lines
+preceding the current line as well (leaving one blank line, the
+current line). M-^ (@fnc{delete-indentation-command}) joins the
+current line and the previous line, or the current line and the next
+line if given an argument.
+@Note("TextIndent" "Indentation").
+@Subsection[Killing by Lines]
+@index{blank lines}
+ The simplest kill command is the C-K command (@fnc{kill-line}).
+If given at the beginning of a line, it kills all the text on the
+line, leaving it blank. If given on a blank line, the blank line
+disappears. As a consequence, if you go to the front of a non-blank
+line and type two C-K's, the line disappears completely.
+
+ More generally, C-K kills from point up to the end of the line,
+unless it is at the end of a line. In that case it kills the line
+separator following the line, thus merging the next line into the
+current one. Invisible spaces and tabs at the end of the line are
+ignored when deciding which case applies, so if point appears to be at
+the end of the line, you can be sure the line separator will be
+killed.
+
+@index{numeric arguments}
+ If C-K is given a positive argument, it kills that many lines, and
+the separators that follow them (however, text on the current line
+before point is spared). With a negative argument, it kills back to a
+number of line beginnings. An argument of -2 means kill back to the
+second line beginning. If point is at the beginning of a line, that
+line beginning doesn't count, so @w[C-U - 2 C-K] with point at the front
+of a line kills the two previous lines.
+
+ C-K with an argument of zero kills all the text before point
+on the current line.
+@Subsection[Other Kill Commands]
+@index{mark}
+@index{Region}
+@fncindex{kill-region}
+ A kill command which is very general is C-W (@fnc{kill-region}), which
+kills everything between point and the mark. With this command, you
+can kill any contiguous characters, if you first set the mark at one
+end of them and go to the other end.
+
+ Other syntactic units can be killed: words, with M-Backspace and M-D
+(@Note("Words").); forms, with C-M-Rubout and C-M-K
+(@Note("Lists" "Forms").); sentences, with C-X
+Rubout and M-K (@Note("Sentences").).
+@Section[Un-Killing]
+@node("un-killing")
+@index{killing}
+@index{moving text}
+@index{kill ring}
+ Un-killing is getting back text which was killed. The usual way to
+move or copy text is to kill it and then un-kill it one or more times.
+@Commands[
+C-Y Yank (re-insert) last killed text.
+
+M-Y Replace re-inserted killed text with the
+previously killed text.
+
+M-W Save region as last killed text without killing.
+
+C-M-W Append next kill to last batch of killed text.
+]
+@keyindex{C-Y}
+@fncindex{insert-kill-buffer}
+ Killed text is pushed onto a @dfn[ring buffer] called the @dfn[kill
+ring] that remembers the last 16 blocks of text that were killed.
+(Why it is called a ring buffer will be explained below). The command
+C-Y (@fnc{insert-kill-buffer}) reinserts the text of the most recent
+kill. It leaves the cursor at the end of the text, and puts the mark
+at the beginning. Thus, a single C-W undoes the C-Y. @w[C-U C-Y]
+leaves the cursor in front of the text, and the mark after. This is
+only if the argument is specified with just a C-U, precisely. Any
+other sort of argument, including C-U and digits, has an effect
+described below.
+
+@index{mark}
+@index{Region}
+@keyindex{M-W}
+@fncindex{copy-region}
+ If you wish to copy a block of text, you might want to use M-W
+(@fnc{copy-region}), which copies the region into the kill ring without
+removing it from the buffer. This is approximately equivalent to C-W
+followed by C-Y, except that M-W does not mark the buffer as "changed"
+and does not temporarily change the screen.
+
+ There is only one kill ring, and switching buffers or files has no
+effect on it. After visiting a new file, whatever was last killed in
+the previous file is still on top of the kill ring. This is important
+for moving text between files.
+@Subsection[Appending Kills]
+@keyindex{C-M-W}
+@fncindex{append-next-kill-command}
+ Normally, each kill command pushes a new block onto the kill ring.
+However, two or more kill commands in a row combine their text into a
+single entry on the ring, so that a single C-Y command gets it all
+back as it was before it was killed. This means that you don't have
+to kill all the text in one command; you can keep killing line after
+line, or word after word, until you have killed it all, and you can
+still get it all back at once. (Thus we join television in
+leading people to kill thoughtlessly).
+
+ Commands that kill forward from point add onto the end of the
+previous killed text. Commands that kill backward from point add onto
+the beginning. This way, any sequence of mixed forward and backward
+kill commands puts all the killed text into one entry without
+rearrangement.
+
+ If a kill command is separated from the last kill command by other
+commands, it starts a new entry on the kill ring, unless you tell it
+not to by saying C-M-W (@fnc{append-next-kill-command}) in front of
+it. The C-M-W tells the following command, if it is a kill command,
+to append the text it kills to the last killed text, instead of
+starting a new entry. With C-M-W, you can kill several separated
+pieces of text and accumulate them to be yanked back in one place.
+@Subsection[Un-killing Earlier Kills]
+@keyindex{M-Y}
+@fncindex{unkill-previous}
+ To recover killed text that is no longer the most recent kill, you
+need the Meta-Y (@fnc{unkill-previous}) command. The M-Y command should
+be used only after a C-Y command or another M-Y. It takes the
+un-killed text inserted by the C-Y and replaces it with the text from
+an earlier kill. So, to recover the text of the next-to-the-last
+kill, you first use C-Y to recover the last kill, and then use M-Y to
+move back to the previous kill.
+
+ You can think of all the last few kills as living in a ring. After
+a C-Y command, the text at the front of the ring is also present in
+the buffer. M-Y "rotates" the ring, bringing the previous string of
+text to the front, and this text replaces the other text in the buffer
+as well. Enough M-Y commands can rotate any part of the ring to the
+front, so you can get at any killed text as long as it is recent
+enough to be still in the ring. Eventually the ring rotates all
+the way around and the most recent killed text comes to the front
+(and into the buffer) again. M-Y with a negative argument rotates the
+ring backwards. If the region doesn't match the text at the front of
+the ring, M-Y is not allowed.
+
+ In any case, when the text you are looking for is brought into the
+buffer, you can stop doing M-Y's and it will stay there. It's really
+just a copy of what's at the front of the ring, so editing it does not
+change what's in the ring. And the ring, once rotated, stays rotated,
+so that doing another C-Y gets another copy of what you rotated to
+the front with M-Y.
+
+ If you change your mind about un-killing, a C-W gets
+rid of the un-killed text at any point, after any number of M-Y's.
+C-W pushes the text onto the ring again.
+
+@index{numeric arguments}
+ If you know how many M-Y's it would take to find the text you want,
+then there is an alternative. C-Y with an argument greater than one
+restores the text the specified number of entries down on the ring.
+Thus, @w[C-U 2 C-Y] gets the next to the last block of killed text. It
+differs from C-Y M-Y in that @w[C-U 2 C-Y] does not permanently rotate the
+ring.
+@Section[Other Ways of Copying Text]
+@node("copying")
+ Usually we copy or move text by killing it and un-killing it, but
+there are other ways that are useful for copying one block of text in
+many places, or for copying many scattered blocks of text into one
+place.
+
+@Subsection[Accumulating Text]
+@keyindex{C-X A}
+@fncindex{append-to-buffer-command}
+@fncindex{insert-buffer-command}
+@fncindex{append-to-file-command}
+@fncindex{prepend-to-file-command}
+ You can accumulate blocks of text from scattered locations either
+into a buffer or into a file if you like.
+
+ To append them into a buffer, use the command C-X A
+(@fnc{append-to-buffer-command}), which inserts a copy of the region
+into the specified buffer at the location of point in that buffer.
+This command will prompt for the name of a buffer, which should be
+terminated with @Return3{}.
+If there is no buffer with the name you specify, one is
+created. If you append text into a buffer which has been used for
+editing, the copied text goes into the middle of the text of the
+buffer, wherever point happens to be in it.
+
+ Point in that buffer is left at the end of the copied text, so
+successive uses of C-X A accumulate the text in the specified buffer
+in the same order as they were copied. If C-X A is given an argument,
+point in the other buffer is left before the copied text, so
+successive uses of C-X A add text in reverse order.
+
+ You can retrieve the accumulated text from that buffer with M-X
+Insert Buffer (@fnc{insert-buffer-command}). This inserts a copy of
+the text in that buffer into the selected buffer. It prompts for the
+buffer name needed. You can also select the other buffer for editing.
+@Note("Buffers"), for background information on buffers.
+
+ Strictly speaking, C-X A does not always append to the text already
+in the buffer. But if it is used on a buffer which starts out empty,
+it does keep appending to the end.
+
+ Instead of accumulating text within NMODE, in a buffer, you can
+append text directly into a disk file with the command M-X Append to
+File (@fnc{append-to-file-command}). It adds the text of the region
+to the end of the specified file. M-X Prepend to File
+(@fnc{prepend-to-file-command}) adds the text to the beginning of the
+file instead. Both commands prompt for the file name. The file is
+changed immediately on disk. These commands are normally used with
+files that are @xxi(not) being visited in NMODE. They have the
+advantage of working even on files too large to fit into the NMODE
+address space.
+@Subsection[Copying Text Many Times]
+@keyindex{C-X X}
+@keyindex{C-X G}
+@fncindex{put-register-command}
+@fncindex{get-register-command}
+@index{registers}
+@label{NMODEregisters}
+@label{NMODE-registers}
+ When you want to insert a copy of the same piece of text frequently,
+the kill ring becomes impractical, since the text moves down on the
+ring as you edit, and will be in an unpredictable place on the ring
+when you need it again. For this case, you can use the commands C-X X
+(@fnc{put-register-command}) and C-X G (@fnc{get-register-command}) to
+move the text.
+
+ C-X X stores a copy of the text of the region in a place called a
+register. With an argument, C-X X deletes the text as well. C-X G
+inserts the text from a register into the buffer.
+Both these commands
+prompt for the register name, which must be a single letter or digit.
+This gives 36 places in which you can store a piece of text. Normally
+C-X G leaves point before the text and places the mark after, but with
+a numeric argument it puts point after the text and the mark before.
ADDED psl-1983/3-1/doc/nmode/nm-killing.topic
Index: psl-1983/3-1/doc/nmode/nm-killing.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-killing.topic
@@ -0,0 +1,16 @@
+.silent_index {Backspace} idx 11-1
+.silent_index {killing} idx 11-1
+.silent_index {deletion} idx 11-1
+.silent_index {Backspace} idx 11-1
+.silent_index {lines} idx 11-1
+.silent_index {blank} idx 11-2
+.silent_index {numeric} idx 11-2
+.silent_index {mark} idx 11-2
+.silent_index {Region} idx 11-2
+.silent_index {killing} idx 11-2
+.silent_index {moving} idx 11-2
+.silent_index {kill} idx 11-2
+.silent_index {mark} idx 11-3
+.silent_index {Region} idx 11-3
+.silent_index {numeric} idx 11-4
+.silent_index {registers} idx 11-5
ADDED psl-1983/3-1/doc/nmode/nm-mark.contents
Index: psl-1983/3-1/doc/nmode/nm-mark.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-mark.contents
@@ -0,0 +1,3 @@
+contents_entry(0 10 {The Mark and the Region} 10-1)
+contents_entry(1 10.1 {Commands to Mark Textual Objects} 10-2)
+contents_entry(1 10.2 {The Ring of Marks} 10-2)
ADDED psl-1983/3-1/doc/nmode/nm-mark.function
Index: psl-1983/3-1/doc/nmode/nm-mark.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-mark.function
@@ -0,0 +1,10 @@
+.silent_index {uppercase-region-command} idx 10-1
+.silent_index {set-mark-command} idx 10-1
+.silent_index {exchange-point-and-mark} idx 10-1
+.silent_index {mark-word-command} idx 10-2
+.silent_index {mark-form-command} idx 10-2
+.silent_index {mark-beginning-command} idx 10-2
+.silent_index {mark-end-command} idx 10-2
+.silent_index {mark-paragraph-command} idx 10-2
+.silent_index {mark-defun-command} idx 10-2
+.silent_index {mark-whole-buffer-command} idx 10-2
ADDED psl-1983/3-1/doc/nmode/nm-mark.ibm
Index: psl-1983/3-1/doc/nmode/nm-mark.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-mark.ibm
@@ -0,0 +1,117 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-MARK.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (The Mark and the Region) Page 10-1
+
+
+ 202/10. The Mark and the Region
+
+ 201/In general, a command which processes an arbitrary part of the buffer must
+ know where to start and where to stop. In NMODE, such commands usually
+ operate on the text between point and 202/the mark201/. This range of text is called
+ 202/the region201/. To specify a region, you set point to one end of it and mark at
+ the other. It doesn't matter which one is set first chronologically, or which
+ one comes earlier in the text. Here are some commands for setting the mark:
+
+ C-@ Set the mark where point is.
+ C-Space The same.
+ C-X C-X Interchange mark and point.
+ M-@ Set mark after end of next word. This command and the
+ following three do not move point.
+ C-M-@ Set mark after end of next Lisp form.
+ C-< Set mark at beginning of buffer.
+ C-> Set mark at end of buffer.
+ M-H Put region around current paragraph.
+ C-M-H Put region around current Lisp defun.
+ C-X H Put region around entire buffer.
+
+ For example, if you wish to convert part of the buffer to all upper-case,
+ you can use the C-X C-U command, which operates on the text in the region.
+ You can first go to the beginning of the text to be capitalized, put the mark
+ there, move to the end, and then type C-X C-U. Or, you can set the mark
+ at the end of the text, move to the beginning, and then type C-X C-U. C-X
+ C-U runs the function 203/uppercase-region-command201/, whose name signifies that
+ the region, or everything between point and the mark, is to be capitalized.
+
+ The most common way to set the mark is with the C-@ command or the
+ C-Space command (203/set-mark-command201/). They set the mark where point is.
+ Then you can move point away, leaving the mark behind.
+
+ It isn't actually possible to type C-Space on non-Meta keyboards. Yet on
+ many terminals the command appears to work anyway! This is because trying
+ to type a Control-Space on those terminals actually sends the character C-@,
+ which means the same thing as C-Space. A few keyboards just send a Space.
+ If you have one of them, you type C-@, or customize your NMODE.
+
+ Since terminals have only one cursor, there is no way for NMODE to show
+ you where the mark is located. You have to remember. The usual solution
+ to this problem is to set the mark and then use it soon, before you forget
+ where it is. But you can see where the mark is with the command C-X C-X
+ (203/exchange-point-and-mark201/) which puts the mark where point was and point
+ where the mark was. The extent of the region is unchanged, but the cursor
+ and point are now at the previous location of the mark.
+
+ C-X C-X is also useful when you are satisfied with the location of point but
+ want to move the mark; do C-X C-X to put point there and then you can
+ move it. A second use of C-X C-X, if necessary, puts the mark at the new
+ location with point back at its original location.
+
+ If you insert or delete before the mark, the mark may drift through the
+ 201/Page 10-2 NMODE Manual (The Mark and the Region)
+
+
+ text. If the buffer contains "FOO BAR" and the mark is before the "B",
+ then if you delete the "F" the mark will be before the "A". This is an
+ unfortunate result of the simple way the mark is implemented. It is best not
+ to delete or insert at places above the mark until you are finished using it
+ and don't care where it drifts to.
+
+ 202/10.1 Commands to Mark Textual Objects
+
+
+ 201/There are commands for placing the mark on the other side of a certain
+ object such as a word or a list, without having to move there first. M-@
+ (203/mark-word-command201/) puts the mark at the end of the next word, while
+ C-M-@ (203/mark-form-command201/) puts it at the end of the next s-expression.
+ C-> (203/mark-end-command201/) puts the mark at the end of the buffer, while C-<
+ (203/mark-beginning-command201/) puts it at the beginning. These characters allow
+ you to save a little typing or redisplay, sometimes.
+
+ Other commands set both point and mark, to delimit an object in the buffer.
+ M-H (203/mark-paragraph-command201/) puts point at the beginning of the paragraph
+ it was inside of (or before), and puts the mark at the end. M-H does all
+ that's necessary if you wish to case-convert or kill a whole paragraph.
+ C-M-H (203/mark-defun-command201/) similarly puts point before and the mark after
+ the current or next defun. Finally, C-X H (203/mark-whole-buffer-command201/)
+ makes the region the entire buffer by putting point at the beginning and the
+ mark at the end.
+
+ 202/10.2 The Ring of Marks
+
+ 201/Aside from delimiting the region, the mark is also useful for remembering a
+ spot that you may want to go back to. To make this feature more useful,
+ NMODE remembers 16 previous locations of the mark for each buffer. Most
+ commands that set the mark push the old mark onto this stack. To return to
+ a marked location, use C-U C-@ (or C-U C-Space). This moves point to
+ where the mark was, and restores the mark from the stack of former marks.
+ So repeated use of this command moves point to all of the old marks on the
+ stack, one by one. Since the stack is actually a ring, enough uses of C-U
+ C-@ bring point back to where it was originally. Insertion and deletion can
+ cause the saved marks to drift, but they will still be good for this purpose
+ because they are unlikely to drift very far.
+
+ Some commands whose primary purpose is to move point a great distance
+ take advantage of the stack of marks to give you a way to undo the
+ command. The best example is M-<, which moves to the beginning of the
+ buffer. It sets the mark first, so that you can use C-U C-@ or C-X C-X to
+ go back to where you were.
ADDED psl-1983/3-1/doc/nmode/nm-mark.key
Index: psl-1983/3-1/doc/nmode/nm-mark.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-mark.key
@@ -0,0 +1,13 @@
+.silent_index {C-X} idx 10-1
+.silent_index {C-@} idx 10-1
+.silent_index {C-Space} idx 10-1
+.silent_index {C-X} idx 10-1
+.silent_index {M-@} idx 10-2
+.silent_index {C-M-@} idx 10-2
+.silent_index {C->} idx 10-2
+.silent_index {C-<} idx 10-2
+.silent_index {M-H} idx 10-2
+.silent_index {C-M-H} idx 10-2
+.silent_index {C-X} idx 10-2
+.silent_index {C-U} idx 10-2
+.silent_index {C-U} idx 10-2
ADDED psl-1983/3-1/doc/nmode/nm-mark.r
Index: psl-1983/3-1/doc/nmode/nm-mark.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-mark.r
@@ -0,0 +1,145 @@
+.so pndoc:nman
+.part NM-MARK manual
+@Chapter[The Mark and the Region]
+@node("mark")
+@index{mark}
+@index{Region}
+@keyindex{C-X C-U}
+@fncindex{uppercase-region-command}
+ In general, a command which processes an arbitrary part of the
+buffer must know where to start and where to stop. In NMODE, such
+commands usually operate on the text between point and @dfn[the mark].
+This range of text is called @dfn[the region]. To specify a region,
+you set point to one end of it and mark at the other. It doesn't
+matter which one is set first chronologically, or which one comes
+earlier in the text.
+Here are some commands for setting the mark:
+@WideCommands[
+C-@ Set the mark where point is.
+
+C-Space The same.
+
+C-X C-X Interchange mark and point.
+
+M-@ Set mark after end of next word. This command and the following
+three do not move point.
+
+C-M-@ Set mark after end of next Lisp form.
+
+C-< Set mark at beginning of buffer.
+
+C-> Set mark at end of buffer.
+
+M-H Put region around current paragraph.
+
+C-M-H Put region around current Lisp defun.
+
+C-X H Put region around entire buffer.
+]
+ For example, if you wish to convert part of the buffer to all
+upper-case, you can use the C-X C-U command, which operates on the
+text in the region. You can first go to the beginning of the text to
+be capitalized, put the mark there, move to the end, and then type C-X
+C-U. Or, you can set the mark at the end of the text, move to the
+beginning, and then type C-X C-U. C-X C-U runs the function
+@fnc{uppercase-region-command}, whose name signifies that the region, or
+everything between point and the mark, is to be capitalized.
+
+@keyindex{C-@}
+@keyindex{C-Space}
+@fncindex{set-mark-command}
+ The most common way to set the mark is with the C-@ command or the
+C-Space command (@fnc{set-mark-command}). They set the mark where
+point is. Then you can move point away, leaving the mark
+behind.
+
+ It isn't actually possible to type C-Space on non-Meta keyboards.
+Yet on many terminals the command appears to work anyway! This is
+because trying to type a Control-Space on those terminals actually
+sends the character C-@, which means the same thing as C-Space. A
+few keyboards just send a Space. If you have one of them, you type C-@,
+or customize your NMODE.
+
+@keyindex{C-X C-X}
+@fncindex{exchange-point-and-mark}
+ Since terminals have only one cursor, there is no way for NMODE to
+show you where the mark is located. You have to remember. The usual
+solution to this problem is to set the mark and then use it soon,
+before you forget where it is. But you can see where the mark is with
+the command C-X C-X (@fnc{exchange-point-and-mark}) which puts the
+mark where point was and point where the mark was. The extent of the
+region is unchanged, but the cursor and point are now at the previous
+location of the mark.
+
+ C-X C-X is also useful when you are satisfied with the location of
+point but want to move the mark; do C-X C-X to put point there
+and then you can move it. A second use of C-X C-X, if necessary,
+puts the mark at the new location with point back at its original
+location.
+
+ If you insert or delete before the mark, the mark may drift through
+the text. If the buffer contains "FOO BAR" and the mark is before the
+"B", then if you delete the "F" the mark will be before the "A". This
+is an unfortunate result of the simple way the mark is implemented.
+It is best not to delete or insert at places above the mark until you
+are finished using it and don't care where it drifts to.
+@Section[Commands to Mark Textual Objects]
+@keyindex{M-@}
+@keyindex{C-M-@}
+@index{words}
+@index{lists}
+@keyindex{C->}
+@keyindex{C-<}
+@fncindex{mark-word-command}
+@fncindex{mark-form-command}
+@fncindex{mark-beginning-command}
+@fncindex{mark-end-command}
+ There are commands for placing the mark on the other side of a
+certain object such as a word or a list, without having to move there
+first. M-@ (@fnc{mark-word-command}) puts the mark at the end of the
+next word, while C-M-@ (@fnc{mark-form-command}) puts it at the end
+of the next s-expression. C-> (@fnc{mark-end-command}) puts the mark
+at the end of the buffer, while C-< (@fnc{mark-beginning-command})
+puts it at the beginning. These characters allow you to save a little
+typing or redisplay, sometimes.
+
+@index{paragraphs}
+@index{Defuns}
+@index{pages}
+@keyindex{M-H}
+@keyindex{C-M-H}
+@keyindex{C-X H}
+@fncindex{mark-paragraph-command}
+@fncindex{mark-defun-command}
+@fncindex{mark-whole-buffer-command}
+ Other commands set both point and mark, to delimit an object in the
+buffer. M-H (@fnc{mark-paragraph-command}) puts point at the
+beginning of the paragraph it was inside of (or before), and puts the
+mark at the end. M-H does all that's necessary if you wish to
+case-convert or kill a whole paragraph. C-M-H
+(@fnc{mark-defun-command}) similarly puts point before and the mark
+after the current or next defun. Finally, C-X H
+(@fnc{mark-whole-buffer-command}) makes the region the entire buffer
+by putting point at the beginning and the mark at the end.
+@Section[The Ring of Marks]
+@keyindex{C-U C-@}
+@keyindex{C-U C-Space}
+ Aside from delimiting the region, the mark is also useful for
+remembering a spot that you may want to go back to. To make this
+feature more useful, NMODE remembers 16 previous locations of the mark
+for each buffer.
+Most commands that set the mark push the old mark onto this stack. To
+return to a marked location, use @w[C-U C-@] (or @w[C-U C-Space]). This
+moves point to where the mark was, and restores the mark from the
+stack of former marks. So repeated use of this command moves
+point to all of the old marks on the stack, one by one. Since the
+stack is actually a ring, enough uses of @w[C-U C-@] bring point
+back to where it was originally. Insertion and deletion can cause
+the saved marks to drift, but they will still be good for this purpose
+because they are unlikely to drift very far.
+
+ Some commands whose primary purpose is to move point a great
+distance take advantage of the stack of marks to give you a way to
+undo the command. The best example is M-<, which moves to the
+beginning of the buffer. It sets the mark first, so that you can use
+@w[C-U C-@] or @w[C-X C-X] to go back to where you were.
ADDED psl-1983/3-1/doc/nmode/nm-mark.topic
Index: psl-1983/3-1/doc/nmode/nm-mark.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-mark.topic
@@ -0,0 +1,7 @@
+.silent_index {mark} idx 10-1
+.silent_index {Region} idx 10-1
+.silent_index {words} idx 10-2
+.silent_index {lists} idx 10-2
+.silent_index {paragraphs} idx 10-2
+.silent_index {Defuns} idx 10-2
+.silent_index {pages} idx 10-2
ADDED psl-1983/3-1/doc/nmode/nm-metax.contents
Index: psl-1983/3-1/doc/nmode/nm-metax.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.contents
@@ -0,0 +1,5 @@
+contents_entry(0 6 {Extended (Meta-X) Commands and Functions} 6-1)
+contents_entry(1 6.1 {Issuing Extended Commands} 6-1)
+contents_entry(2 6.1.1 {Typing The Command Name} 6-1)
+contents_entry(2 6.1.2 {Completion} 6-1)
+contents_entry(1 6.2 {Arcane Information about M-X Commands} 6-2)
ADDED psl-1983/3-1/doc/nmode/nm-metax.function
Index: psl-1983/3-1/doc/nmode/nm-metax.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.function
@@ -0,0 +1,3 @@
+.silent_index {m-x-prefix} idx 6-1
+.silent_index {auto-fill-mode-command} idx 6-1
+.silent_index {set-key-command} idx 6-2
ADDED psl-1983/3-1/doc/nmode/nm-metax.ibm
Index: psl-1983/3-1/doc/nmode/nm-metax.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.ibm
@@ -0,0 +1,115 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-METAX.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Extended (Meta-X) Commands and Functions) Page 6-1
+
+
+ 202/6. Extended (Meta-X) Commands and Functions
+
+ 201/Not all NMODE commands are of the one or two character variety you have
+ seen so far. Most commands have long invocations composed of English
+ words. This is for two reasons: the long invocations are easier to remember
+ and more suggestive, and there are not enough two-character combinations
+ for every command to have one.
+
+ The commands with long names are known as 202/extended commands 201/because
+ they extend the set of two-character commands.
+
+ 202/6.1 Issuing Extended Commands
+
+ 201/M-X Begin an extended command. Follow by the command
+ invocation only; the command will ask for any
+ arguments.
+ C-M-X Same as M-X.
+
+ Extended commands are also called 202/M-X commands201/, because they all start
+ with the character Meta-X (203/m-x-prefix201/). The M-X is followed by the
+ command's long, suggestive invocation. The invocation is terminated with a
+ Return. For example, Meta-X Auto Fill Mode<CR> invokes
+ 203/auto-fill-mode-command201/. This function when executed turns Auto Fill mode on
+ or off.
+
+ There are a great many functions in NMODE for you to call. They will be
+ described elsewhere in the manual, according to what they do. Here we are
+ concerned only with extended commands in general.
+
+ 202/6.1.1 Typing The Command Name
+
+ 201/When you type M-X, the cursor moves down to the echo area at the bottom
+ of the screen. "Extended Command:" is printed there, and when you type
+ the command name it echoes there. This is known as 202/reading a line in the
+ echo area201/. You can use any moving or deleting command (C-A, C-E, C-F,
+ C-B , C-D, Backspace, etc.) to help construct the M-X command. A C-G
+ cancels the whole M-X. These editing characters apply any time NMODE
+ reads a line in the echo area, not just within M-X.
+
+ The string "Extended Command:" which appears in the echo area is called a
+ 202/prompt201/. The prompt always tells you what sort of argument is required and
+ what it is going to be used for; "Extended Command:" means that you are
+ inside of the command M-X, and should type the invocation of a function to
+ be called.
+
+ 202/6.1.2 Completion
+
+ 201/You can abbreviate the name of the command, typing only the beginning of
+ the name, as much as is needed to identify the command unambiguously. You
+ can also use completion on the function name. This means that you type part
+ of the command name, and NMODE visibly fills in the rest, or as much as can
+ be determined from the part you have typed.
+ 201/Page 6-2 NMODE Manual (Completion)
+
+
+ You request completion by typing Return. For example, if you type M-X
+ Au<CR>, the "Au" expands to "Auto Fill Mode" because "Auto Fill Mode" is
+ the only command invocation that starts with "Au". If you ask for completion
+ when there are several alternatives for the next character, the bell rings and
+ nothing else happens.
+
+ Space is another way to request completion, but it completes only one word.
+ Successive Spaces complete one word each, until either there are multiple
+ possibilities or the end of the name is reached. If the first word of a
+ command is Edit, List, Kill, View or What, it is sufficient to type just the
+ first letter and complete it with a Space. (This does not follow from the
+ usual definition of completion, since the single letter is ambiguous; it is a
+ special feature added because these words are so common).
+
+ 202/6.2 Arcane Information about M-X Commands
+
+ 201/You can skip this section if you are not interested in customization, unless
+ you want to know what is going on behind the scenes.
+
+ Actually, 203/every 201/command in NMODE simply runs a function. For example,
+ when you type the command C-N, it runs the function
+ "203/move-down-extending-command201/". C-N can be thought of as a sort of
+ abbreviation. We say that the command C-N has been 202/connected 201/to the
+ function 203/move-down-extending-command201/. The name is looked up once when
+ the command and function are connected, so that it does not have to be
+ looked up again each time the command is used. The documentation for
+ individual NMODE commands usually gives the name of the function which
+ really implements the command in parentheses after the command itself.
+
+ Just as any function can be called directly with M-X, so almost any
+ function can be connected to a command. You can use the command M-X Set
+ Key (203/set-key-command201/) to do this. M-X Set Key reads the name of the
+ function from the keyboard, then reads the character command (including
+ metizers or other prefix characters) directly from the terminal. To define
+ C-N, you could type
+
+ M-X Set Key<CR>move-down-extending-command<CR>
+
+ and then type C-N. If, for instance, you use the function
+ 203/{auto-fill-mode-command} 201/often, you could connect it to the command C-X Z
+ (not normally defined). You could even connect it to the command C-M-V,
+ replacing that command's normal definition. Set Key is good for redefining
+ commands in the middle of editing. An init file can do it each time you run
+ NMODE. See Section 22.1 [Init], page 1.
ADDED psl-1983/3-1/doc/nmode/nm-metax.key
Index: psl-1983/3-1/doc/nmode/nm-metax.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.key
@@ -0,0 +1,4 @@
+.silent_index {M-X} idx 6-1
+.silent_index {C-D} idx 6-1
+.silent_index {C-G} idx 6-1
+.silent_index {M-X} idx 6-2
ADDED psl-1983/3-1/doc/nmode/nm-metax.lpt
Index: psl-1983/3-1/doc/nmode/nm-metax.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.lpt
@@ -0,0 +1,140 @@
+
+
+
+ Node("M-X")
+
+ Chapter[Extended (Meta-X) Commands and Functions]
+
+ Not all NMODE commands are of the one or two character variety
+ you have seen so far. Most commands have long invocations
+ composed of English words. This is for two reasons: the long
+ invocations are easier to remember and more suggestive, and there
+ are not enough two-character combinations for every command to
+ have one.
+
+ The commands with long names are known as dfn[extended
+ commands] because they extend the set of two-character commands.
+
+ Section[Issuing Extended Commands]
+
+ DoubleWideCommands[ M-X Begin an extended command.
+ Follow by the command invocation only; the command will ask for
+ any arguments.
+
+ C-M-X Begin an extended command. Follow by the command
+ invocation only; the command will ask for any arguments. ]
+
+ index{extended
+ commands} index{M-X} index{functions} index{commands}
+ Extended commands are also called dfn[M-X commands], because
+ they all start with the character Meta-X (fnc{m-x-prefix}). The
+ M-X is followed by the command's long, suggestive invocation.
+ Terminate the invocation with a Return3{}. For example, Meta-X
+ Auto Fill Mode return2{} invokes the function
+ auto-fill-mode-command. This function when executed turns Auto
+ Fill mode on or off.
+
+ There are a great many functions in NMODE for you to call.
+ They will be described elsewhere in the manual, according to what
+ they do. Here we are concerned only with extended commands in
+ general.
+
+ SubSection[Typing The Command Name]
+
+ index{Backspace} index{C-D} index{C-U} index{C-G} index{echo
+ area}
+ When you type M-X, the cursor moves down to the echo area at
+ the bottom of the screen. "M-X" is printed there, and when you
+ type the command name it echoes there. This is known as
+ dfn[reading a line in the echo area]. You can use any moving or
+ deleting command (C-A, C-E, C-F, C-B , C-D, Backspace, etc.) to
+ help construct the M-X command. A C-G cancels the whole M-X.
+ These editing characters apply any time NMODE reads a line in the
+ echo area, not just within M-X.
+ - 2 -
+
+
+ index{prompting} index{TECO} index{Read Command Prompt}
+ The string "M-X" which appears in the echo area is called a
+ dfn[prompt]. The prompt always tells you what sort of argument
+ is required and what it is going to be used for; "M-X" means that
+ you are inside of the command M-X, and should type the invocation
+ of a function to be called.
+
+ SubSection[Completion]
+
+ index{command completion} index{Altmode} index{Space}
+ You can abbreviate the name of the command, typing only the
+ beginning of the name, as much as is needed to identify the
+ command unambiguously. You can also use completion on the
+ function name. This means that you type part of the command
+ name, and NMODE visibly fills in the rest, or as much as can be
+ determined from the part you have typed.
+
+ You request completion by typing Return3{}. For example, if
+ you type W[M-X Au Return2{}, the "Au" expands to W["Auto Fill
+ Mode"] because "Auto Fill Mode" is the only command invocation
+ that starts with "Au". If you ask for completion when there are
+ several alternatives for the next character, the bell rings and
+ nothing else happens.
+
+ Space is another way to request completion, but it completes
+ only one word. Successive Spaces complete one word each, until
+ either there are multiple possibilities or the end of the name is
+ reached. If the first word of a command is Edit, List, Kill,
+ View or What, it is sufficient to type just the first letter and
+ complete it with a Space. (This does not follow from the usual
+ definition of completion, since the single letter is ambiguous;
+ it is a special feature added because these words are so common).
+
+ INFO{ Note("MMArcana" "MM"), for more information on this and
+ other topics related to how extended commands work, how they are
+ really the foundation of everything in NMODE, and how they relate
+ to customization.}
+
+ Node("MMArcana")
+
+ Section[Arcane Information about M-X Commands] index{M-X}
+
+ You can skip this section if you are not interested in
+ customization, unless you want to know what is going on behind
+ the scenes.
+
+ index{customization} index{Connected} index{Functions}
+ Actually, xxi[every] command in NMODE simply runs a function.
+ For example, when you type the command C-N, it runs the function
+ " fnc{move-down-extending-command}" C-N can be thought of as a
+ sort of abbreviation. We say that the command C-N has been
+ - 3 -
+
+
+ dfn[connected] to the function
+ fnc{move-down-extending-command}. The name is looked up once
+ when the command and function are connected, so that it does not
+ have to be looked up again each time the command is used. The
+ documentation for individual NMODE commands usually gives the
+ name of the function which really implements the command in
+ parentheses after the command itself.
+
+ index{Set Key}
+ Just as any function can be called directly with M-X, so almost
+ any function can be connected to a command. You can use the
+ function Set Key to do this. Set Key takes the name of the
+ function as a string argument, then reads the character command
+ (including metizers or other prefix characters) directly from the
+ terminal. To define C-N, you could type example[ M-X Set
+ Key Return1{}move-down-extending-command Return1{} ] and then
+ type C-N. If you use the function View File often, you could
+ connect it to the command C-X Z (not normally defined). You
+ could even connect it to the command C-M-V, replacing that
+ command's normal definition. Set Key is good for redefining
+ commands in the middle of editing. An init file or EVARS() file
+ can do it each time you run NMODE. Note("Init").
+
+ Subsection[Subroutines]
+
+ index{subroutines} index{command completion}
+ NMODE is composed of a large number of functions, each with a
+ name. Some of these functions are connected to commands; some
+ are there for you to call with M-X; some are called by other
+ functions. The last group are called subroutines.
ADDED psl-1983/3-1/doc/nmode/nm-metax.r
Index: psl-1983/3-1/doc/nmode/nm-metax.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.r
@@ -0,0 +1,129 @@
+.so pndoc:nman
+.part NM-METAX manual
+@Chapter[Extended (Meta-X) Commands and Functions]
+@node("m-x")
+ Not all NMODE commands are of the one or two character variety you
+have seen so far. Most commands have long invocations composed of English
+words. This is for two reasons: the long invocations are easier to remember
+and more suggestive, and there are not enough two-character
+combinations for every command to have one.
+
+ The commands with long names are known as @dfn[extended commands]
+because they extend the set of two-character commands.
+@Section[Issuing Extended Commands]
+@DoubleWideCommands[
+M-X Begin an extended command. Follow by the command invocation only;
+the command will ask for any arguments.
+
+C-M-X Same as M-X.
+]
+@index{extended commands}
+@keyindex{M-X}
+@fncindex{m-x-prefix}
+@index{functions}
+@index{commands}
+@fncindex{auto-fill-mode-command}
+ Extended commands are also called @dfn[M-X commands], because they
+all start with the character Meta-X (@fnc{m-x-prefix}).
+The M-X is followed by the command's long, suggestive invocation.
+The invocation is terminated with a @Return3{}. For example, Meta-X
+Auto Fill Mode@return2{} invokes @fnc{auto-fill-mode-command}.
+This function when executed turns Auto Fill mode on or off.
+
+ There are a great many functions in NMODE for you to call. They
+will be described elsewhere in the manual, according to what they do.
+Here we are concerned only with extended commands in general.
+@SubSection[Typing The Command Name]
+@index{Backspace}
+@keyindex{C-D}
+@keyindex{C-G}
+@index{echo area}
+ When you type M-X, the cursor moves down to the echo
+area at the bottom of the screen. "Extended Command:" is printed there, and
+when you type the command name it echoes there. This is known as
+@dfn[reading a line in the echo area]. You can use any moving
+or deleting command (C-A, C-E, C-F, C-B , C-D, Backspace, etc.)
+to help construct the M-X command.
+A C-G cancels the whole M-X. These editing characters apply any
+time NMODE reads a line in the echo area, not just within M-X.
+
+@index{prompting}
+@index{Read Command Prompt}
+ The string "Extended Command:" which appears in the echo area is called a
+@dfn[prompt]. The prompt always tells you what sort of argument is
+required and what it is going to be used for; "Extended Command:" means that you are
+inside of the command M-X, and should type the invocation of a function to be
+called.
+@SubSection[Completion]
+@index{command completion}
+@index{return3{}}
+@index{Space}
+ You can abbreviate the name of the command, typing only the
+beginning of the name, as much as is needed to identify the command
+unambiguously. You can also use completion on the function name.
+This means that you type part of the command name, and NMODE visibly
+fills in the rest, or as much as can be determined from the part you
+have typed.
+
+ You request completion by typing @Return3{}. For example, if you
+type @W[M-X Au@Return2{}], the "Au" expands to @W["Auto Fill Mode"] because
+"Auto Fill Mode" is the only command invocation that starts with "Au".
+If you ask for
+completion when there are several alternatives for the next character,
+the bell rings and nothing else happens.
+
+ Space is another way to request completion, but it completes only
+one word. Successive Spaces complete one word each, until either
+there are multiple possibilities or the end of the name is reached.
+If the first word of a command is Edit, List, Kill, View or What, it
+is sufficient to type just the first letter and complete it with a Space.
+(This does not follow from the usual definition of completion, since
+the single letter is ambiguous; it is a special feature added because
+these words are so common).
+@INFO{
+@Note("MMArcana" "MM"), for more information on this and
+other topics related to how extended commands work, how they are
+really the foundation of everything in NMODE, and how they relate to
+customization.}
+@Section[Arcane Information about M-X Commands]
+@node("mmarcana")
+@keyindex{M-X}
+ You can skip this section if you are not interested in
+customization, unless you want to know what is going on behind the
+scenes.
+
+@index{customization}
+@index{Connected}
+@index{Functions}
+ Actually, @xxi[every] command in NMODE simply runs a function. For
+example, when you type the command C-N, it runs the function
+"@fnc{move-down-extending-command}".
+C-N can be thought of as a sort of
+abbreviation. We say that the command C-N has been @dfn[connected] to the
+function @fnc{move-down-extending-command}.
+The name is looked up once when the
+command and function are connected, so that it does not have to be
+looked up again each time the command is used. The
+documentation for individual NMODE commands usually gives the name of
+the function which really implements the command in parentheses after
+the command itself.
+
+@fncindex{set-key-command}
+ Just as any function can be called directly with M-X, so almost any
+function can be connected to a command.
+You can use the command M-X Set Key (@fnc{set-key-command}) to do this.
+M-X Set Key reads the name of the function from the keyboard, then
+reads the character command (including metizers or other prefix
+characters) directly from the terminal.
+To define C-N, you could type
+@example[
+M-X Set Key@Return1{}move-down-extending-command@Return1{}
+]
+and then type C-N. If, for instance,
+you use the function @fnc({auto-fill-mode-command})
+often, you could
+connect it to the command C-X Z (not normally defined). You could
+even connect it to the command C-M-V, replacing that command's normal
+definition. Set Key is good for redefining commands in the middle of
+editing. An init file can do it each time you run
+NMODE. @Note("Init").
ADDED psl-1983/3-1/doc/nmode/nm-metax.topic
Index: psl-1983/3-1/doc/nmode/nm-metax.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-metax.topic
@@ -0,0 +1,13 @@
+.silent_index {extended} idx 6-1
+.silent_index {functions} idx 6-1
+.silent_index {commands} idx 6-1
+.silent_index {Backspace} idx 6-1
+.silent_index {echo} idx 6-1
+.silent_index {prompting} idx 6-1
+.silent_index {Read} idx 6-1
+.silent_index {command} idx 6-1
+.silent_index {return3{}} idx 6-1
+.silent_index {Space} idx 6-1
+.silent_index {customization} idx 6-2
+.silent_index {Connected} idx 6-2
+.silent_index {Functions} idx 6-2
ADDED psl-1983/3-1/doc/nmode/nm-misc.contents
Index: psl-1983/3-1/doc/nmode/nm-misc.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-misc.contents
@@ -0,0 +1,1 @@
+contents_entry(0 21 {Miscellaneous Commands} 21-1)
ADDED psl-1983/3-1/doc/nmode/nm-misc.function
Index: psl-1983/3-1/doc/nmode/nm-misc.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-misc.function
@@ -0,0 +1,3 @@
+.silent_index {insert-date-command} idx 21-1
+.silent_index {nmode-gc} idx 21-1
+.silent_index {write-screen-command} idx 21-1
ADDED psl-1983/3-1/doc/nmode/nm-misc.ibm
Index: psl-1983/3-1/doc/nmode/nm-misc.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-misc.ibm
@@ -0,0 +1,30 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-MISC.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Miscellaneous Commands) Page 21-1
+
+
+ 202/21. Miscellaneous Commands
+
+ 201/This chapter covers some miscellaneous commands which don't fit naturally
+ into earlier chapters.
+
+ M-X Insert Date (203/insert-date-command201/) inserts the current date into the
+ text in the current buffer. The mark is put after the inserted date and
+ point is left unchanged.
+
+ M-X Make Space (203/nmode-gc201/) reclaims any wasted internal space. It also
+ indicates the remaining amount of free space.
+
+ M-X Write Screen (203/write-screen-command201/) writes a copy of the current
+ screen to a file.
ADDED psl-1983/3-1/doc/nmode/nm-misc.key
Index: psl-1983/3-1/doc/nmode/nm-misc.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-misc.key
@@ -0,0 +1,3 @@
+.silent_index {M-X} idx 21-1
+.silent_index {M-X} idx 21-1
+.silent_index {M-X} idx 21-1
ADDED psl-1983/3-1/doc/nmode/nm-misc.r
Index: psl-1983/3-1/doc/nmode/nm-misc.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-misc.r
@@ -0,0 +1,21 @@
+.so pndoc:nman
+.part NM-MISC manual
+@Chapter[Miscellaneous Commands]
+ This chapter covers some miscellaneous commands which don't fit
+naturally into earlier chapters.
+
+@keyindex{M-X Insert Date}
+@fncindex{insert-date-command}
+ M-X Insert Date (@fnc{insert-date-command}) inserts the current date into
+the text in the current buffer. The mark is put after the inserted date and
+point is left unchanged.
+
+@keyindex{M-X Make Space}
+@fncindex{nmode-gc}
+ M-X Make Space (@fnc{nmode-gc}) reclaims any wasted internal space.
+It also indicates the remaining amount of free space.
+
+@keyindex{M-X Write Screen}
+@fncindex{write-screen-command}
+ M-X Write Screen (@fnc{write-screen-command}) writes a copy of the
+current screen to a file.
ADDED psl-1983/3-1/doc/nmode/nm-misc.topic
Index: psl-1983/3-1/doc/nmode/nm-misc.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-misc.topic
@@ -0,0 +1,3 @@
+.silent_index {M-X} idx 20-1
+.silent_index {M-X} idx 20-1
+.silent_index {M-X} idx 20-1
ADDED psl-1983/3-1/doc/nmode/nm-programs.contents
Index: psl-1983/3-1/doc/nmode/nm-programs.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-programs.contents
@@ -0,0 +1,12 @@
+contents_entry(0 20 {Editing Programs} 20-1)
+contents_entry(1 20.1 {Major Modes} 20-1)
+contents_entry(1 20.2 {Indentation Commands for Code} 20-1)
+contents_entry(1 20.3 {Automatic Display Of Matching Parentheses} 20-2)
+contents_entry(1 20.4 {Manipulating Comments} 20-3)
+contents_entry(1 20.5 {Lisp Mode} 20-3)
+contents_entry(2 20.5.1 {Moving Over and Killing Lists and forms} 20-3)
+contents_entry(2 20.5.2 {Commands for Manipulating Defuns} 20-5)
+contents_entry(1 20.6 {Lisp Grinding} 20-6)
+contents_entry(1 20.7 {Lisp Language Interface} 20-7)
+contents_entry(2 20.7.1 {Evaluation} 20-7)
+contents_entry(2 20.7.2 {Debugging} 20-7)
ADDED psl-1983/3-1/doc/nmode/nm-programs.function
Index: psl-1983/3-1/doc/nmode/nm-programs.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-programs.function
@@ -0,0 +1,42 @@
+.silent_index {indent-new-line-command} idx 20-1
+.silent_index {text-mode-command} idx 20-1
+.silent_index {lisp-mode-command} idx 20-1
+.silent_index {indent-new-line-command} idx 20-2
+.silent_index {delete-indentation-command} idx 20-2
+.silent_index {delete-horizontal-space-command} idx 20-2
+.silent_index {split-line-command} idx 20-2
+.silent_index {insert-closing-bracket} idx 20-2
+.silent_index {insert-comment-command} idx 20-3
+.silent_index {fill-comment-command} idx 20-3
+.silent_index {lisp-tab-command} idx 20-3
+.silent_index {delete-backward-hacking-tabs-command} idx 20-3
+.silent_index {move-forward-form-command} idx 20-4
+.silent_index {move-backward-form-command} idx 20-4
+.silent_index {move-forward-list-command} idx 20-4
+.silent_index {move-backward-list-command} idx 20-4
+.silent_index {kill-backward-form-command} idx 20-4
+.silent_index {kill-forward-form-command} idx 20-4
+.silent_index {backward-up-list-command} idx 20-4
+.silent_index {forward-up-list-command} idx 20-4
+.silent_index {down-list-command} idx 20-4
+.silent_index {transpose-forms} idx 20-5
+.silent_index {mark-form-command} idx 20-5
+.silent_index {make-parens-command} idx 20-5
+.silent_index {move-over-paren-command} idx 20-5
+.silent_index {move-backward-defun-command} idx 20-5
+.silent_index {end-of-defun-command} idx 20-5
+.silent_index {mark-defun-command} idx 20-5
+.silent_index {lisp-tab-command} idx 20-6
+.silent_index {indent-new-line-command} idx 20-6
+.silent_index {delete-indentation-command} idx 20-6
+.silent_index {lisp-indent-sexpr} idx 20-6
+.silent_index {lisp-indent-region-command} idx 20-7
+.silent_index {execute-defun-command} idx 20-7
+.silent_index {execute-form-command} idx 20-7
+.silent_index {yank-last-output-command} idx 20-7
+.silent_index {lisp-abort-command} idx 20-8
+.silent_index {lisp-quit-command} idx 20-8
+.silent_index {lisp-backtrace-command} idx 20-8
+.silent_index {lisp-continue-command} idx 20-8
+.silent_index {lisp-retry-command} idx 20-8
+.silent_index {lisp-help-command} idx 20-8
ADDED psl-1983/3-1/doc/nmode/nm-programs.ibm
Index: psl-1983/3-1/doc/nmode/nm-programs.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-programs.ibm
@@ -0,0 +1,444 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-PROGRAMS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Editing Programs) Page 20-1
+
+
+ 202/20. Editing Programs
+
+ 201/Special features for editing lisp programs include automatic indentation,
+ parenthesis matching, and the ability to move over and kill balanced
+ expressions.
+
+ Lisp mode defines paragraphs to be separated only by blank lines and page
+ boundaries. This makes the paragraph commands useful for editing
+ programs. See Section 13.2 [Paragraphs], page 2.
+
+ Moving over words is useful for editing programs as well as text. See
+ Section 13.1 [Words], page 1.
+
+ 202/20.1 Major Modes
+
+ 201/NMODE has many different 202/major modes201/. Two such modes are Text mode
+ and Lisp mode. Each of these customizes NMODE, one for text, the other for
+ Lisp programs. The major modes are mutually exclusive, and one major mode
+ is current at any time. When at top level, NMODE always says in the mode
+ line which major mode you are in. These modes tell NMODE to change the
+ meanings of a few commands to become more specifically adapted to the
+ language being edited. Most commands remain unchanged; the ones which
+ usually change are Tab, Backspace, and Linefeed. In addition, a few special
+ move and mark commands are turned on in Lisp mode which are not available
+ in text mode.
+
+ Selecting a new major mode can be done with a M-X command. For example
+ M-X Text Mode (203/text-mode-command201/) enters text mode and M-X Lisp Mode
+ (203/lisp-mode-command201/) enters lisp mode. As can be seen from these examples,
+ some major mode's names are the same as the invocations of the functions to
+ select those modes.
+
+ Often NMODE enters the correct major mode for a file simply based on the
+ file's extension, and you do not have to worry about selecting a mode.
+
+ Lisp mode specifies that only blank lines separate paragraphs. This is so
+ that the paragraph commands remain useful.
+
+ 202/20.2 Indentation Commands for Code
+
+ 201/Tab Indents current line.
+ Linefeed Equivalent to Return followed by Tab.
+ M-^ Joins two lines, leaving one space between if appropriate.
+ C-M-O Split the current line.
+ M-\ Deletes all spaces and tabs around point.
+ M-M Moves to the first nonblank character on the line.
+
+ Most programming languages have some indentation convention. For Lisp
+ code, lines are indented according to their nesting in parentheses.
+
+ Whatever the language, to indent a line, use the Tab command. Each major
+ mode defines this command to perform the sort of indentation appropriate for
+ the particular language. In Lisp mode, Tab aligns the line according to its
+ 201/Page 20-2 NMODE Manual (Indentation Commands for Code)
+
+
+ depth in parentheses. No matter where in the line you are when you type
+ Tab, it aligns the line as a whole.
+
+ The command Linefeed (203/indent-new-line-command201/) does a Return and then
+ does a Tab on the next line. Thus, Linefeed at the end of the line makes a
+ following blank line and supplies it with the usual amount of indentation.
+ Linefeed in the middle of a line breaks the line and supplies the usual
+ indentation in front of the new line.
+
+
+ The inverse of Linefeed is Meta-^ or C-M-^ (203/delete-indentation-command201/).
+ This command deletes the indentation at the front of the current line, and the
+ line separator as well. They are replaced by a single space, or by no space
+ if before a ")" or after a "(", or at the beginning of a line. With an
+ argument, M-^ joins the current line and the 203/next 201/line, removing indentation
+ at the front of the next line beforehand. To delete just the indentation of a
+ line, go to the beginning of the line and use Meta-\
+ (203/delete-horizontal-space-command201/), which deletes all spaces and tabs around
+ the cursor.
+
+ Another command which affects indentation is C-M-O (203/split-line-command201/).
+ It moves the rest of the current line, after point, down vertically. It
+ indents the new line so that the rest of the line winds up in the same column
+ that it was in before the split. If this command is given a positive argument,
+ it adds enough empty lines between the old line and the new line that the
+ total number of lines added equals the argument. The command leaves point
+ unchanged.
+
+ To insert an indented line before the current one, do C-A, C-O, and then
+ Tab. To make an indented line after the current one, use C-E Linefeed.
+
+ To move over the indentation on a line, use Meta-M or C-M-M
+ (203/back-to-indentation-command201/). These commands move the cursor forward or
+ back to the first nonblank character on the line.
+
+ 202/20.3 Automatic Display Of Matching Parentheses
+
+ 201/The NMODE parenthesis-matching feature is designed to show automatically
+ how parentheses balance in text as it is typed in. When this feature is
+ enabled, after a close parenthesis or other close bracket character is inserted
+ (using 203/insert-closing-bracket201/) the cursor automatically moves for an instant to
+ the open bracket which balances the newly inserted character. The cursor
+ stays at the open parenthesis for a second before returning home, unless you
+ type another command before the second is up.
+
+ It is worth emphasizing that the location of point, the place where your
+ type-in will be inserted, is not affected by the parenthesis matching feature.
+ It stays after the close parenthesis, where it ought to be. Only the cursor
+ on the screen moves away and back. You can type ahead freely as if the
+ parenthesis display feature did not exist. In fact, if you type fast enough,
+ you won't see the cursor move. You must pause after typing a close
+ parenthesis to let the cursor move to the open parenthesis.
+ 201/NMODE Manual (Automatic Display Of Matching Parentheses) Page 20-3
+
+
+ An additional function is whether NMODE should warn you by ringing the
+ bell if you type an unmatched close parenthesis. NMODE will warn you if you
+ are editing a language in which parentheses are paramount, such as Lisp, but
+ will not do so for languages in which parentheses are not so crucial.
+
+ 202/20.4 Manipulating Comments
+
+ 201/M-; Insert comment.
+ M-Z Fill a block of comments.
+
+ There are two NMODE commands which affect comments. First there is M-;
+ (203/insert-comment-command201/), which jumps to the end of the current line and
+ inserts a percent sign and a space, thus starting a comment. Second, there
+ is M-Z (203/fill-comment-command201/), which allows filling of blocks of comments. It
+ fills a paragraph using whatever text is adjacent to the current line and
+ begins with the same sequence of blank characters, nonalphanumeric
+ characters, and more blank characters as the current line. As a result, it
+ will fill all lines starting with " % ", for instance. Notice that it will NOT do
+ any filling if the current line differs in indentation from the rest of the
+ paragraph of comments (i.e. if it is an indented first line).
+
+ 202/20.5 Lisp Mode
+
+ 201/Lisp's simple syntax makes it much easier for an editor to understand; as a
+ result, NMODE can do more for Lisp, and with less work, than for any other
+ language.
+
+ Lisp programs should be edited in Lisp mode. In this mode, Tab is defined
+ to indent the current line according to the conventions of Lisp programming
+ style. It does not matter where in the line Tab is used; the effect on the
+ line is the same. The function which does the work is called
+ 203/lisp-tab-command201/. Linefeed, as usual, does a Return and a Tab, so it moves
+ to the next line and indents it.
+
+ As in most modes where indentation is likely to vary from line to line,
+ Backspace (203/delete-backward-hacking-tabs-command 201/in Lisp mode) is redefined
+ to treat a tab as if it were the equivalent number of spaces. This makes it
+ possible to rub out indentation one position at a time without worrying
+ whether it is made up of spaces or tabs.
+
+ Paragraphs are defined to start only with blank lines so that the paragraph
+ commands can be useful. Auto Fill indents the new lines which it creates.
+ Comments start with "%".
+
+ 202/20.5.1 Moving Over and Killing Lists and forms
+
+ 201/C-M-F Move Forward over form.
+ C-M-B Move Backward over form.
+ C-M-K Kill form forward.
+ C-M-Rubout Kill form backward.
+ 201/Page 20-4 NMODE Manual (Moving Over and Killing Lists and forms)
+
+
+ C-M-U Move Up and backward in list structure.
+ C-M-( Same as C-M-U.
+ C-( Same as C-M-U.
+ C-M-) Move up and forward in list structure.
+ C-) Same as C-M-).
+ C-M-D Move Down and forward in list structure.
+ C-M-N Move forward over a list.
+ C-M-P Move backward over a list.
+ C-M-T Transpose forms.
+ C-M-@ Put mark after form.
+ M-( Put parentheses around next form(s).
+ M-) Move past next close parenthesis and re-indent.
+
+ By convention, NMODE commands that deal with balanced parentheses are
+ usually Control-Meta- characters. They tend to be analogous in function to
+ their Control- and Meta- equivalents. These commands are usually thought of
+ as pertaining to Lisp, but can be useful with any language in which some
+ sort of parentheses exist (including English). They are, however, only
+ defined in Lisp mode.
+
+ To move forward over a form, use C-M-F (203/move-forward-form-command201/). If
+ the first significant character after point is an "(", C-M-F moves past the
+ matching ")". If the first character is a ")", C-M-F just moves past it. If
+ the character begins an atom, C-M-F moves to the end of the atom. C-M-F
+ with an argument repeats that operation the specified number of times; with a
+ negative argument, it moves backward instead.
+
+ The command C-M-B (203/move-backward-form-command201/) moves backward over a
+ form; it is like C-M-F with the argument's sign reversed. If there are
+ "'"-like characters in front of the form moved over, they are moved over as
+ well. Thus, with point after " 'FOO ", C-M-B leaves point before the "'",
+ not before the "F".
+
+ These two commands (and the commands in this section) know how to handle
+ comments, string literals, and all other token syntax in (unaltered) PSL.
+ NMODE makes one restriction: it will not handle string literals that extend
+ over multiple lines.
+
+ Two other commands move over lists instead of forms are often useful.
+ They are C-M-N (203/move-forward-list-command201/) and C-M-P
+ (203/move-backward-list-command201/). They act like C-M-F and C-M-B except that
+ they don't stop on atoms; after moving over an atom, they move over the
+ next expression, stopping after moving over a list. With these commands,
+ you can avoid stopping after all of the atomic arguments to a function.
+
+ Killing a form at a time can be done with C-M-K
+ (203/kill-forward-form-command201/) and C-M-Rubout (203/kill-backward-form-command201/)
+ commands. C-M-K kills the characters that C-M-F would move over, and
+ C-M-Rubout kills what C-M-B would move over.
+
+ C-M-F and C-M-B stay at the same level in parentheses, when that's
+ possible. To move 203/up 201/one (or n) levels, use C-M-( or C-M-)
+ (203/backward-up-list 201/and 203/forward-up-list-command201/). C-M-( moves backward up
+ 201/NMODE Manual (Moving Over and Killing Lists and forms) Page 20-5
+
+
+ past one containing "(". C-M-) moves forward up past one containing ")".
+ Given a positive argument, these commands move up the specified number of
+ levels of parentheses. C-M-U is another name for C-M-(, which is easier to
+ type, especially on non-Meta keyboards. If you use that name, it is useful
+ to know that a negative argument makes the command move up forwards, like
+ C-M-). C-M-( and C-M-) are also availible as C-( and C-), respectively,
+ which are easier to type on the hp9836 keyboard.
+
+ To move 203/down 201/in list structure, use C-M-D (203/down-list-command201/). It is
+ nearly the same as searching for a "(".
+
+ A somewhat random-sounding command which is nevertheless easy to use is
+ C-M-T (203/transpose-forms201/), which drags the previous form across the next
+ one. An argument serves as a repeat count, and a negative argument drags
+ backwards (thus canceling out the effect of C-M-T with a positive argument).
+ An argument of zero, rather than doing nothing, transposes the forms at the
+ point and the mark.
+
+ To make the region be the next form in the buffer, use C-M-@
+ (203/mark-form-command201/) which sets mark at the same place that C-M-F would
+ move to. C-M-@ takes arguments like C-M-F. In particular, a negative
+ argument is useful for putting the mark at the beginning of the previous
+ form.
+
+ The commands M-( (203/make-parens-command201/) and M-)
+ (203/move-over-paren-command201/) are designed for a style of editing which keeps
+ parentheses balanced at all times. M-( inserts a pair of parentheses, either
+ together as in "()", or, if given an argument, around the next several
+ forms, and leaves point after the open parenthesis. Instead of typing
+ "(FOO)", you can type M-( FOO, which has the same effect except for
+ leaving the cursor before the close parenthesis. Then you type M-), which
+ moves past the close parenthesis, deleting any indentation preceding it (in
+ this example there is none), and indenting with Linefeed after it.
+
+ 202/20.5.2 Commands for Manipulating Defuns
+
+ 201/C-M-[, C-M-A Move to beginning of defun.
+ C-M-], C-M-E Move to end of defun.
+ C-M-H Put region around whole defun.
+
+ For historical reasons, an expression at the top level in the buffer is called
+ a 202/defun201/, regardless of what function is actually called by the expression.
+
+ One might imagine that NMODE finds defuns by moving upward a level of
+ parentheses until there were no more levels to go up. This would require
+ scanning all the way back to the beginning of the file. To speed up the
+ operation, NMODE assumes that any "(" in column 0 is the start of a defun.
+ This heuristic is nearly always right and avoids the costly scan.
+
+ The commands to move to the beginning and end of the current defun are
+ C-M-[ (203/move-backward-defun-command201/) and C-M-] (203/end-of-defun-command201/).
+ Alternate names for these two commands are C-M-A for C-M-[ and C-M-E for
+ C-M-]. The alternate names are easier to type on many non-Meta keyboards.
+ 201/Page 20-6 NMODE Manual (Commands for Manipulating Defuns)
+
+
+ If you wish to operate on the current defun, use C-M-H
+ (203/mark-defun-command201/) which puts point at the beginning and mark at the end
+ of the current or next defun.
+
+ 202/20.6 Lisp Grinding
+
+ 201/The best way to keep Lisp code properly indented ("ground") is to use
+ NMODE to re-indent it when it is changed. NMODE has commands to indent
+ properly either a single line, a specified number of lines, or all of the lines
+ inside a single form.
+
+ Tab In Lisp mode, re-indents line according to parenthesis
+ depth.
+ Linefeed Equivalent to Return followed by Tab.
+ M-^ Join two lines, leaving one space between them if
+ appropriate.
+ C-M-Q Re-indent all the lines within one list.
+
+ The basic indentation function is 203/lisp-tab-command201/, which gives the current
+ line the correct indentation as determined from the previous lines' indentation
+ and parenthesis structure. This function is placed on Tab in Lisp mode (Use
+ Meta-Tab or C-Q Tab to insert a tab). If executed at the beginning of a
+ line, it leaves point after the indentation; when given inside the text on the
+ line, it leaves point fixed with respect to the characters around it.
+
+ When entering a large amount of new code, use Linefeed
+ (203/indent-new-line-command201/), which is equivalent to a Return followed by a
+ Tab. In Lisp mode, a Linefeed creates or moves down onto a blank line, and
+ then gives it the appropriate indentation.
+
+ To join two lines together, use the Meta-^ or Control-Meta-^ command
+ (203/delete-indentation-command201/), which is approximately the opposite of
+ Linefeed. It deletes any spaces and tabs at the front of the current line,
+ and then deletes the line separator before the line. A single space is then
+ inserted, if NMODE thinks that one is needed there. Spaces are not needed
+ before a close parenthesis, or after an open parenthesis.
+
+ If you are dissatisfied about where Tab indents the second and later lines
+ of an form, you can override it. If you alter the indentation of one of the
+ lines yourself, then Tab will indent successive lines of the same list to be
+ underneath it. This is the right thing for functions which Tab indents
+ unaesthetically.
+
+ When you wish to re-indent code which has been altered or moved to a
+ different level in the list structure, you have several commands available.
+ You can re-indent a specific number of lines by giving the ordinary indent
+ command (Tab, in Lisp mode) an argument. This indents as many lines as
+ you say and moves to the line following them. Thus, if you underestimate,
+ you can repeat the process later.
+
+ You can re-indent the contents of a single form by positioning point before
+ the beginning of it and typing Control-Meta-Q (203/lisp-indent-sexpr201/). The line
+ the form starts on is not re-indented; thus, only the relative indentation
+ 201/NMODE Manual (Lisp Grinding) Page 20-7
+
+
+ with in the form, and not its position, is changed. To correct the position
+ as well, type a Tab before the C-M-Q.
+
+ Another way to specify the range to be re-indented is with point and mark.
+ The command C-M-\ (203/lisp-indent-region-command201/) applies Tab to every line
+ whose first character is between point and mark. In Lisp mode, this does a
+ Lisp indent.
+
+ The standard pattern of indentation is as follows: the second line of the
+ expression is indented under the first argument, if that is on the same line
+ as the beginning of the expression; otherwise, the second line is indented
+ two spaces more than the entire expression. Each following line is indented
+ under the previous line whose nesting depth is the same.
+
+ 202/20.7 Lisp Language Interface
+
+ 201/The following section contains many commands starting with "Lisp-". This
+ prefix is equivalent to C-], but can sometimes be typed using a soft key.
+
+ 202/20.7.1 Evaluation
+
+ 201/NMODE contains a number of facilities to allow the user to use the
+ underlying LISP language. In addition to editing and pretty-printing LISP
+ expressions with the commands in the preceding sections, the user can
+ execute the LISP expressions in the buffer.
+
+ Lisp-D Execute the current Defun.
+ Lisp-E Execute the form starting on this line.
+ Lisp-Y Yanks the last output into current buffer.
+
+ Lisp-D (203/execute-defun-command201/) causes the Lisp reader to read and evaluate
+ the current defun. If there is no current defun, the Lisp reader will read a
+ form starting at the current location. We arrange for output to be appended
+ to the end of the output buffer. The mark is set at the current location in
+ the input buffer, in case user wants to go back.
+
+ Lisp-E (203/execute-form-command201/) causes the Lisp reader to read and evaluate a
+ form starting at the beginning of the current line. We arrange for output to
+ be appended to the end of the output buffer. The mark is set at the current
+ location in the input buffer, in case user wants to go back.
+
+ Lisp-Y (203/yank-last-output-command201/) copies the last piece of output from the
+ output buffer back into the current buffer, allowing it to be added to some
+ code or text within the current buffer.
+
+
+ 202/20.7.2 Debugging
+
+ 201/The commands of the last subsection allow one to use the underlying LISP,
+ provided that no errors occur in the evaluation of expressions. The
+ commands of this subsection allow recovery from errors in evaluations. When
+ an error occurs, one enters a "break loop". This is indicated by the
+ presence of more than one angle bracket on the lisp prompt at the right hand
+ 201/Page 20-8 NMODE Manual (Debugging)
+
+
+ side of the mode line under the output buffer. When one is in a break loop,
+ one can still evaluate lisp expressions. Additional errors at this point will
+ wrap additional break loops around the current one. Commands available in
+ break loops include:
+
+ Lisp-A Abort break loops.
+ Lisp-Q Quit current break loop.
+ Lisp-B Backtrace function calls.
+ Lisp-C Continue execution.
+ Lisp-R Retry expression.
+ Lisp-? Help command
+
+ Lisp-A (203/lisp-abort-command201/) will pop out of an arbitrarily deep break loop.
+ Lisp-Q (203/lisp-quit-command201/) exits the current break loop. It only pops up one
+ level, unlike abort.
+
+ Lisp-B (203/lisp-backtrace-command201/) lists all the function calls on the stack. The
+ most recently invoked function is listed first. It is a good way to see how
+ the offending expression got generated. Unfortunately, many internal
+ functions of Lisp and NMODE are shown, so the list may get somewhat
+ cluttered.
+
+ Lisp-C (203/lisp-continue-command201/) causes the expression last printed to be
+ returned as the value of the offending expression. This allows a user to
+ recover from a low level error in an involved calculation if they know what
+ should have been returned by the offending expression. This is also often
+ useful as an automatic stub: If an expression containing an undefined
+ function is evaluated, a Break loop is entered, and this may be used to
+ return the value of the function call.
+
+ Lisp-R (203/lisp-retry-command201/) tries to evaluate the offending expression again,
+ and to continue the computation. This is often useful after defining a
+ missing function, or assigning a value to a variable.
+
+ Lisp-? (203/lisp-help-command201/) lists the lisp commands available. When in a
+ break loop it prints:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+ Otherwise it prints:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp
+ Listener"
ADDED psl-1983/3-1/doc/nmode/nm-programs.key
Index: psl-1983/3-1/doc/nmode/nm-programs.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-programs.key
@@ -0,0 +1,48 @@
+.silent_index {Tab} idx 20-1
+.silent_index {Rubout} idx 20-1
+.silent_index {Linefeed} idx 20-1
+.silent_index {backspace} idx 20-1
+.silent_index {Tab} idx 20-1
+.silent_index {M-^} idx 20-2
+.silent_index {M-\} idx 20-2
+.silent_index {C-M-O} idx 20-2
+.silent_index {C-A} idx 20-2
+.silent_index {C-O} idx 20-2
+.silent_index {C-E} idx 20-2
+.silent_index {M-M} idx 20-2
+.silent_index {C-M-M} idx 20-2
+.silent_index {M-;} idx 20-3
+.silent_index {M-Z} idx 20-3
+.silent_index {Tab} idx 20-3
+.silent_index {C-M-F} idx 20-4
+.silent_index {C-M-B} idx 20-4
+.silent_index {C-M-N} idx 20-4
+.silent_index {C-M-P} idx 20-4
+.silent_index {C-M-Rubout} idx 20-4
+.silent_index {C-M-K} idx 20-4
+.silent_index {C-M-U} idx 20-4
+.silent_index {C-M-(} idx 20-4
+.silent_index {C-M-)} idx 20-4
+.silent_index {C-M-D} idx 20-4
+.silent_index {C-M-T} idx 20-5
+.silent_index {C-M-@} idx 20-5
+.silent_index {M-(} idx 20-5
+.silent_index {M-)} idx 20-5
+.silent_index {C-M-A} idx 20-5
+.silent_index {C-M-E} idx 20-5
+.silent_index {C-M-H} idx 20-5
+.silent_index {C-M-[} idx 20-5
+.silent_index {C-M-]} idx 20-5
+.silent_index {Tab} idx 20-6
+.silent_index {C-M-Tab} idx 20-6
+.silent_index {C-M-Tab} idx 20-6
+.silent_index {C-M-^} idx 20-6
+.silent_index {M-^} idx 20-6
+.silent_index {C-M-Q} idx 20-6
+.silent_index {C-M-\} idx 20-7
+.silent_index {lisp-A} idx 20-8
+.silent_index {lisp-Q} idx 20-8
+.silent_index {lisp-B} idx 20-8
+.silent_index {lisp-C} idx 20-8
+.silent_index {lisp-R} idx 20-8
+.silent_index {lisp-?} idx 20-8
ADDED psl-1983/3-1/doc/nmode/nm-programs.r
Index: psl-1983/3-1/doc/nmode/nm-programs.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-programs.r
@@ -0,0 +1,604 @@
+.so pndoc:nman
+.part NM-PROGRAMS manual
+@Chapter(Editing Programs)
+@node("programs")
+ Special features for editing lisp programs include automatic
+indentation, parenthesis matching, and the ability to move over and
+kill balanced expressions.
+
+Lisp mode defines paragraphs to be separated only by blank lines and
+page boundaries. This makes the paragraph commands useful for editing
+programs. @Note("Sentences" "Paragraphs").
+
+Moving over words is useful for editing programs as well as text.
+@Note("Words").
+@Section[Major Modes]
+@node("majormodes")
+@index{major modes}
+@keyindex{Tab}
+@keyindex{Rubout}
+@keyindex{Linefeed}
+@keyindex{backspace}
+@index{comments}
+@fncindex{indent-new-line-command}
+ NMODE has many different @dfn[major modes]. Two such modes are Text
+mode and Lisp mode. Each of these customizes NMODE, one for text, the
+other for Lisp programs. The major modes are mutually exclusive, and
+one major mode is current at any time. When at top level, NMODE
+always says in the mode line which major mode you are in. These modes
+tell NMODE to change the meanings of a few commands to become more
+specifically adapted to the language being edited. Most commands
+remain unchanged; the ones which usually change are Tab, Backspace, and
+Linefeed. In addition, a few special move and mark commands are turned
+on in Lisp mode which are not available in text mode.
+
+@fncindex{text-mode-command}
+@fncindex{lisp-mode-command}
+ Selecting a new major mode can be done with a M-X command. For
+example M-X Text Mode (@fnc{text-mode-command}) enters text mode and
+M-X Lisp Mode (@fnc{lisp-mode-command}) enters lisp mode. As can be
+seen from these examples, some major mode's names are the same as the
+invocations of the functions to select those modes.
+
+ Often NMODE enters the correct major mode for a file simply
+based on the file's extension, and you do not have to worry about
+selecting a mode.
+
+ Lisp mode specifies that only blank lines separate paragraphs. This
+is so that the paragraph commands remain useful.
+ They also cause Auto
+ Fill mode to use the definition of Tab to indent the new lines it
+ creates. This is because most lines in a program are usually indented.
+@Section[Indentation Commands for Code]
+@node("indenting")
+@WideCommands[
+Tab Indents current line.
+
+Linefeed Equivalent to @Return3{} followed by Tab.
+
+M-^ Joins two lines, leaving one space between if appropriate.
+
+C-M-O Split the current line.
+
+M-\ Deletes all spaces and tabs around point.
+
+M-M Moves to the first nonblank character on the line.
+]
+@keyindex{Tab}
+@index{indentation}
+@index{Lisp}
+ Most programming languages have some indentation convention. For
+Lisp code, lines are indented according to their nesting in
+parentheses.
+
+ Whatever the language, to indent a line, use the Tab command. Each
+major mode defines this command to perform the sort of indentation
+appropriate for the particular language. In Lisp mode, Tab aligns the
+line according to its depth in parentheses. No matter where in the
+line you are when you type Tab, it aligns the line as a whole.
+
+@index{Linefeed}
+@fncindex{indent-new-line-command}
+ The command Linefeed (@fnc{indent-new-line-command}) does a @Return3{} and then
+does a Tab on the next line. Thus, Linefeed at the end of the line
+makes a following blank line and supplies it with the usual amount of
+indentation. Linefeed in the middle of a line breaks the line and
+supplies the usual indentation in front of the new line.
+
+@keyindex{M-^}
+@fncindex{delete-indentation-command}
+@keyindex{M-\}
+@fncindex{delete-horizontal-space-command}
+ The inverse of Linefeed is Meta-^ or C-M-^
+(@fnc{delete-indentation-command}). This command deletes the
+indentation at the front of the current line, and the line separator
+as well. They are replaced by a single space, or by no space if
+before a ")" or after a "(", or at the beginning of a line.
+With an argument, M-^ joins the current line and the @xxi[next] line,
+removing indentation at the front of the next line beforehand.
+To delete
+just the indentation of a line, go to the beginning of the line and
+use Meta-\ (@fnc{delete-horizontal-space-command}), which deletes all
+spaces and tabs around the cursor.
+
+@keyindex{C-M-O}
+@fncindex{split-line-command}
+ Another command which affects indentation is
+C-M-O (@fnc{split-line-command}). It moves the rest of the current line, after
+point, down vertically. It indents the new line so that the rest of the line
+winds up in the same column that it was in before the split. If this command
+is given a positive argument, it adds enough empty lines between the old line
+and the new line that the total number of lines added equals the argument.
+The command leaves point unchanged.
+
+@keyindex{C-A}
+@keyindex{C-O}
+@keyindex{C-E}
+ To insert an indented line before the current one, do C-A, C-O, and
+then Tab.
+To make an indented line after the current one, use C-E Linefeed.
+
+@keyindex{M-M}
+@keyindex{C-M-M}
+ To move over the indentation on a line, use Meta-M or C-M-M
+(@fnc{back-to-indentation-command}). These commands move the cursor forward
+or back to the first nonblank character on the line.
+@Section[Automatic Display Of Matching Parentheses]
+@index{matching}
+@index{parentheses}
+@node("matching")
+@fncindex{insert-closing-bracket}
+ The NMODE parenthesis-matching feature is designed to show
+automatically how parentheses balance in text as it is typed in. When
+this feature is enabled, after a close parenthesis or other close
+bracket character is inserted (using @fnc{insert-closing-bracket})
+the cursor automatically moves for an
+instant to the open bracket
+which balances the newly inserted character. The
+cursor stays at the open parenthesis for a second before returning
+home, unless you type another command before the second is up.
+
+ It is worth emphasizing that the location of point, the place where
+your type-in will be inserted, is not affected by the parenthesis
+matching feature. It stays after the close parenthesis, where it
+ought to be. Only the cursor on the screen moves away and back. You
+can type ahead freely as if the parenthesis display feature did not
+exist. In fact, if you type fast enough, you won't see the cursor
+move. You must pause after typing a close parenthesis to let the
+cursor move to the open parenthesis.
+
+ An additional function is whether NMODE should warn you by ringing
+the bell if you type an unmatched close parenthesis. NMODE will warn
+you if you are editing a language in which parentheses are paramount,
+such as Lisp, but will not do so for languages in which parentheses
+are not so crucial.
+@Section[Manipulating Comments]
+@index{comments}
+@node("comments")
+@keyindex{M-;}
+@keyindex{M-Z}
+@fncindex{insert-comment-command}
+@fncindex{fill-comment-command}
+@WideCommands[
+M-; Insert comment.
+
+M-Z Fill a block of comments.
+]
+ There are two NMODE commands which affect comments. First there is
+M-; (@fnc{insert-comment-command}), which jumps to the end of the
+current line and inserts a percent sign and a space, thus starting a
+comment. Second, there is M-Z (@fnc{fill-comment-command}), which
+allows filling of blocks of comments. It fills a paragraph using
+whatever text is adjacent to the current line and begins with the same
+sequence of blank characters, nonalphanumeric characters, and more
+blank characters as the current line. As a result, it will fill all
+lines starting with " % ", for instance. Notice that it will NOT do
+any filling if the current line differs in indentation from the rest
+of the paragraph of comments (i.e. if it is an indented first line).
+@Section[Lisp Mode]
+@node("lisp")
+ Lisp's simple syntax makes it much easier for an editor to
+understand; as a result, NMODE can do more for Lisp, and with less
+work, than for any other language.
+
+@fncindex{lisp-tab-command}
+@keyindex{Tab}
+@index{Lisp mode}
+ Lisp programs should be edited in Lisp mode. In this mode, Tab is
+defined to indent the current line according to the conventions of
+Lisp programming style. It does not matter where in the line Tab is
+used; the effect on the line is the same. The function which does the
+work is called @fnc{lisp-tab-command}. Linefeed, as usual, does a @Return3{}
+and a Tab, so it moves to the next line and indents it.
+
+@index{Backspace}
+@fncindex{delete-backward-hacking-tabs-command}
+ As in most modes where indentation is likely to vary from line to
+line, Backspace (@fnc{delete-backward-hacking-tabs-command} in Lisp
+mode) is redefined to treat a tab as if it were the equivalent number
+of spaces. This makes it possible to rub out indentation one position
+at a time without worrying whether it is made up of spaces or tabs.
+
+@index{Paragraphs}
+@index{syntax table}
+@index{comments}
+@index{Auto Fill}
+@index{blank lines}
+ Paragraphs are defined to start only with blank lines so that the
+paragraph commands can be useful. Auto Fill indents the new lines
+which it creates. Comments start with "%".
+@SubSection[Moving Over and Killing Lists and forms]
+@index{Lists}
+@index{forms}
+@node("lists")
+@DoubleWideCommands[
+
+C-M-F Move Forward over form.
+
+C-M-B Move Backward over form.
+
+C-M-K Kill form forward.
+
+C-M-Rubout Kill form backward.
+
+C-M-U Move Up and backward in list structure.
+
+C-M-( Same as C-M-U.
+
+C-( Same as C-M-U.
+
+C-M-) Move up and forward in list structure.
+
+C-) Same as C-M-).
+
+C-M-D Move Down and forward in list structure.
+
+C-M-N Move forward over a list.
+
+C-M-P Move backward over a list.
+
+C-M-T Transpose forms.
+
+C-M-@ Put mark after form.
+
+M-( Put parentheses around next form(s).
+
+M-) Move past next close parenthesis and re-indent.
+]
+@index{Control-Meta}
+ By convention, NMODE commands that deal with balanced parentheses
+are usually Control-Meta- characters. They tend to be analogous in
+function to their Control- and Meta- equivalents. These commands are
+usually thought of as pertaining to Lisp, but can be useful with any
+language in which some sort of parentheses exist (including English).
+They are, however, only defined in Lisp mode.
+
+@index{motion}
+@keyindex{C-M-F}
+@keyindex{C-M-B}
+@fncindex{move-forward-form-command}
+@fncindex{move-backward-form-command}
+ To move forward over a form, use C-M-F (@fnc{move-forward-form-command}).
+If the first significant character after point is an "(", C-M-F
+moves past the matching ")". If the first character is a ")", C-M-F
+just moves past it. If the character begins an atom, C-M-F moves to
+the end of the atom. C-M-F with an argument
+repeats that operation the specified number of times; with a negative
+argument, it moves backward instead.
+
+ The command C-M-B (@fnc{move-backward-form-command}) moves backward over a
+form; it is like C-M-F with the argument's sign reversed. If there
+are "'"-like characters in front of the form moved over, they
+are moved over as well. Thus, with point after @w[" 'FOO "], C-M-B
+leaves point before the "'", not before the "F".
+
+@index{comments}
+ These two commands (and the commands in this section)
+know how to handle comments, string literals, and all other token
+syntax in (unaltered) PSL.
+NMODE makes one restriction: it will not handle string
+literals that extend over multiple lines.
+
+@keyindex{C-M-N}
+@keyindex{C-M-P}
+@fncindex{move-forward-list-command}
+@fncindex{move-backward-list-command}
+ Two other commands move over lists instead of
+forms are often useful. They are C-M-N
+(@fnc{move-forward-list-command}) and C-M-P
+(@fnc{move-backward-list-command}). They act like C-M-F and C-M-B
+except that they don't stop on atoms; after moving over an atom, they
+move over the next expression, stopping after moving over a list.
+With these commands, you can avoid stopping after all of the
+atomic arguments to a function.
+
+@index{killing}
+@keyindex{C-M-Rubout}
+@keyindex{C-M-K}
+@fncindex{kill-backward-form-command}
+@fncindex{kill-forward-form-command}
+ Killing a form at a time can be done with C-M-K
+(@fnc{kill-forward-form-command}) and C-M-Rubout
+(@fnc{kill-backward-form-command}) commands. C-M-K kills the
+characters that C-M-F would move over, and C-M-Rubout kills what C-M-B
+would move over.
+
+@keyindex{C-M-U}
+@keyindex{C-M-(}
+@keyindex{C-M-)}
+@keyindex{C-M-D}
+@fncindex{backward-up-list-command}
+@fncindex{forward-up-list-command}
+@fncindex{down-list-command}
+ C-M-F and C-M-B stay at the same level in parentheses, when that's
+possible. To move @xxii[up] one (or n) levels, use C-M-( or C-M-)
+(@fnc{backward-up-list} and @fnc{forward-up-list-command}).
+C-M-( moves backward
+up past one containing "(". C-M-) moves forward up past one
+containing ")". Given a positive argument, these commands move up the
+specified number of levels of parentheses. C-M-U is another name for
+C-M-(, which is easier to type, especially on non-Meta keyboards. If
+you use that name, it is useful to know that a negative argument makes
+the command move up forwards, like C-M-).
+C-M-( and C-M-) are also availible as C-( and C-), respectively,
+which are easier to type on the hp9836 keyboard.
+
+ To move @xxii[down] in list structure, use C-M-D
+(@fnc{down-list-command}). It is nearly the same as searching for a
+"(".
+
+@index{transposition}
+@keyindex{C-M-T}
+@fncindex{transpose-forms}
+ A somewhat random-sounding command which is nevertheless easy to use
+is C-M-T (@fnc{transpose-forms}), which drags the previous
+form across the next one. An argument
+serves as a repeat count, and a negative argument drags backwards
+(thus canceling out the effect of C-M-T with a positive argument). An argument
+of zero, rather than doing nothing, transposes the forms at the
+point and the mark.
+
+@index{mark}
+@keyindex{C-M-@}
+@fncindex{mark-form-command}
+ To make the region be the next form in the buffer, use
+C-M-@ (@fnc{mark-form-command}) which sets mark at the same place that C-M-F
+would move to. C-M-@ takes arguments like C-M-F. In particular, a
+negative argument is useful for putting the mark at the beginning of
+the previous form.
+
+@keyindex{M-(}
+@keyindex{M-)}
+@fncindex{make-parens-command}
+@fncindex{move-over-paren-command}
+ The commands M-( (@fnc{make-parens-command})
+and M-) (@fnc{move-over-paren-command})
+are designed for a style of editing which keeps parentheses balanced at
+all times. M-( inserts a pair of parentheses, either together as in
+"()", or, if given an argument, around the next several forms,
+and leaves point after the open parenthesis. Instead of typing
+"(FOO)", you can type M-( FOO, which has the same effect except for
+leaving the cursor before the close parenthesis. Then you type M-),
+which moves past the close parenthesis, deleting any indentation
+preceding it (in this example there is none), and indenting with
+Linefeed after it.
+@SubSection[Commands for Manipulating Defuns]
+@index{Defuns}
+@node("defuns")
+@DoubleWideCommands(
+
+C-M-[, C-M-A Move to beginning of defun.
+
+C-M-], C-M-E Move to end of defun.
+
+C-M-H Put region around whole defun.
+)
+@keyindex{C-M-A}
+@fncindex{move-backward-defun-command}
+@keyindex{C-M-E}
+@fncindex{end-of-defun-command}
+@keyindex{C-M-H}
+@fncindex{mark-defun-command}
+@index{mark}
+@index{Region}
+@index{motion}
+@keyindex{C-M-[}
+@keyindex{C-M-]}
+ For historical reasons, an expression
+at the top level in the buffer is called a
+@dfn[defun], regardless of what function is actually called by the
+expression.
+
+ One might imagine that NMODE finds
+defuns by moving upward a level of
+parentheses until there were no more levels to go up. This would require
+scanning all the way back to the beginning of the file. To speed up
+the operation, NMODE assumes that any "("
+in column 0 is the start of a defun.
+This heuristic is nearly always right and avoids the costly scan.
+
+ The commands to move to the beginning and end of the current defun
+are C-M-[ (@fnc{move-backward-defun-command}) and
+C-M-] (@fnc{end-of-defun-command}).
+Alternate names for these two commands are C-M-A for C-M-[ and C-M-E
+for C-M-]. The alternate names are easier to type on many non-Meta
+keyboards.
+
+ If you wish to operate on the current defun, use C-M-H
+(@fnc{mark-defun-command}) which puts point at the beginning and mark
+at the end of the current or next defun.
+@Section[Lisp Grinding]
+@node("grinding")
+@index{indentation}
+@index{formatting}
+@index{grinding}
+@keyindex{Tab}
+@keyindex{C-M-Tab}
+
+ The best way to keep Lisp code properly indented ("ground") is to
+use NMODE to re-indent it when it is changed. NMODE has commands to
+indent properly either a single line, a specified number of lines, or
+all of the lines inside a single form.
+@WideCommands[
+Tab In Lisp mode, re-indents line according to parenthesis depth.
+
+Linefeed Equivalent to @Return3{} followed by Tab.
+
+M-^ Join two lines, leaving one space between them if appropriate.
+
+C-M-Q Re-indent all the lines within one list.
+]
+@fncindex{lisp-tab-command}
+@keyindex{C-M-Tab}
+ The basic indentation function is @fnc{lisp-tab-command}, which gives
+the current line the correct indentation as determined from the
+previous lines' indentation and parenthesis structure. This function
+is placed on Tab in Lisp mode
+(Use Meta-Tab or C-Q Tab to insert a tab). If executed at the
+beginning of a line, it leaves point after the indentation; when given
+inside the text on the line, it leaves point fixed with respect to the
+characters around it.
+
+@index{Linefeed}
+@fncindex{indent-new-line-command}
+ When entering a large amount of new code, use Linefeed
+(@fnc{indent-new-line-command}), which is equivalent to a @Return3{}
+followed by a Tab. In Lisp mode, a Linefeed creates or moves down
+onto a blank line, and then gives it the appropriate indentation.
+
+@keyindex{C-M-^}
+@keyindex{M-^}
+@fncindex{delete-indentation-command}
+ To join two lines together, use the Meta-^ or Control-Meta-^ command
+(@fnc{delete-indentation-command}), which is approximately the opposite of
+Linefeed. It deletes any spaces and tabs at the front of the current
+line, and then deletes the line separator before the line. A single
+space is then inserted, if NMODE thinks that one is needed there.
+Spaces are not needed before a close parenthesis, or after an open parenthesis.
+
+ If you are dissatisfied about where Tab indents the second
+and later lines of an form, you can override it. If you alter
+the indentation of one of the lines yourself, then Tab will indent
+successive lines of the same list to be underneath it. This is the
+right thing for functions which Tab indents unaesthetically.
+
+@index{numeric arguments}
+ When you wish to re-indent code which has been altered or moved to a
+different level in the list structure, you have several commands
+available. You can re-indent a specific number of lines by giving the
+ordinary indent command (Tab, in Lisp mode) an argument. This
+indents as many lines as you say and moves to the line following them.
+Thus, if you underestimate, you can repeat the process later.
+
+@keyindex{C-M-Q}
+@fncindex{lisp-indent-sexpr}
+ You can re-indent the contents of a single form by
+positioning point before the beginning of it and typing Control-Meta-Q
+(@fnc{lisp-indent-sexpr}). The line the form starts on is not
+re-indented; thus, only the relative indentation with in the
+form, and not its position, is changed. To correct the
+position as well, type a Tab before the C-M-Q.
+
+@keyindex{C-M-\}
+@index{Region}
+@fncindex{lisp-indent-region-command}
+ Another way to specify the range to be re-indented is with point and
+mark. The command C-M-\ (@fnc{lisp-indent-region-command}) applies
+Tab to every line whose first character is between point and mark. In
+Lisp mode, this does a Lisp indent.
+
+ The standard pattern of indentation is as follows:
+the second line
+of the expression is indented under the first argument,
+if that is on
+the same line as the beginning of the expression; otherwise, the
+second line is indented
+two spaces
+more than the entire expression.
+Each following line is indented under the previous line whose nesting
+depth is the same.
+@section[Lisp Language Interface]
+ The following section contains many commands starting with "Lisp-".
+This prefix is equivalent to C-], but can sometimes be typed using
+a soft key.
+@subsection[Evaluation]
+ NMODE contains a number of facilities to allow the user to use the
+underlying LISP language.
+In addition to editing and pretty-printing LISP expressions with the
+commands in the preceding sections, the user can execute the LISP
+expressions in the buffer.
+@doublewidecommands(
+Lisp-D Execute the current Defun.
+
+Lisp-E Execute the form starting on this line.
+
+Lisp-Y Yanks the last output into current buffer.)
+@fncindex{execute-defun-command}
+Lisp-D (@fnc{execute-defun-command}) causes the Lisp reader to read
+and evaluate the current defun. If there is no current defun, the
+Lisp reader will read a form starting at the current location. We
+arrange for output to be appended to the end of the output buffer. The mark is
+set at the current location in the input buffer, in case user wants to
+go back.
+
+@fncindex{execute-form-command}
+Lisp-E (@fnc{execute-form-command}) causes the Lisp reader to read and
+evaluate a form starting at the beginning of the current line. We
+arrange for output to be appended to the end of the output buffer.
+The mark is set at the current location in the input buffer, in case
+user wants to go back.
+
+@fncindex{yank-last-output-command}
+Lisp-Y (@fnc{yank-last-output-command})
+copies the last piece of output from the output buffer back into the
+current buffer, allowing it to be added to some code or text within the
+current buffer.
+
+@subsection[Debugging]
+ The commands of the last subsection allow one to use the underlying
+LISP, provided that no errors occur in the evaluation of expressions.
+The commands of this subsection allow recovery from errors in
+evaluations. When an error occurs, one enters a "break loop". This
+is indicated by the presence of more than one angle bracket on the
+lisp prompt at the right hand side of the mode line under the output
+buffer. When one is in a break loop, one can still evaluate lisp
+expressions. Additional errors at this point will wrap additional
+break loops around the current one. Commands available in break loops
+include:
+@doublewidecommands(
+Lisp-A Abort break loops.
+
+Lisp-Q Quit current break loop.
+
+Lisp-B Backtrace function calls.
+
+Lisp-C Continue execution.
+
+Lisp-R Retry expression.
+
+Lisp-? Help command)
+@fncindex{lisp-abort-command}
+@keyindex{lisp-A}
+ Lisp-A (@fnc{lisp-abort-command})
+will pop out of an arbitrarily deep break loop.
+@fncindex{lisp-quit-command}
+@keyindex{lisp-Q}
+Lisp-Q (@fnc{lisp-quit-command})
+exits the current break loop. It only pops up one level, unlike abort.
+
+@fncindex{lisp-backtrace-command}
+@keyindex{lisp-B}
+Lisp-B (@fnc{lisp-backtrace-command})
+lists all the function calls on the stack.
+The most recently invoked function is listed first.
+It is a good way to
+see how the offending expression got generated.
+Unfortunately, many internal functions of Lisp and NMODE are shown, so the
+list may get somewhat cluttered.
+
+@fncindex{lisp-continue-command}
+@keyindex{lisp-C}
+Lisp-C (@fnc{lisp-continue-command})
+causes the expression last printed to be returned as the value of the
+offending expression. This allows a user to recover from a low level error
+in an involved calculation if they know what should have been returned by the
+offending expression. This is also often useful as an automatic stub:
+If an expression containing an undefined function is evaluated, a Break loop is
+entered, and this may be used to return the value of the function call.
+
+@fncindex{lisp-retry-command}
+@keyindex{lisp-R}
+Lisp-R (@fnc{lisp-retry-command})
+tries to evaluate the offending expression again, and to continue the
+computation. This is often useful after defining a missing function,
+or assigning a value to a variable.
+
+@fncindex{lisp-help-command}
+@keyindex{lisp-?}
+Lisp-? (@fnc{lisp-help-command})
+lists the lisp commands available.
+When in a break loop it prints:
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+Otherwise it prints:
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp Listener"
+
ADDED psl-1983/3-1/doc/nmode/nm-programs.topic
Index: psl-1983/3-1/doc/nmode/nm-programs.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-programs.topic
@@ -0,0 +1,33 @@
+.silent_index {major} idx 20-1
+.silent_index {comments} idx 20-1
+.silent_index {indentation} idx 20-1
+.silent_index {Lisp} idx 20-1
+.silent_index {Linefeed} idx 20-2
+.silent_index {matching} idx 20-2
+.silent_index {parentheses} idx 20-2
+.silent_index {comments} idx 20-3
+.silent_index {Lisp} idx 20-3
+.silent_index {Backspace} idx 20-3
+.silent_index {Paragraphs} idx 20-3
+.silent_index {syntax} idx 20-3
+.silent_index {comments} idx 20-3
+.silent_index {Auto} idx 20-3
+.silent_index {blank} idx 20-3
+.silent_index {Lists} idx 20-3
+.silent_index {forms} idx 20-3
+.silent_index {Control-Meta} idx 20-4
+.silent_index {motion} idx 20-4
+.silent_index {comments} idx 20-4
+.silent_index {killing} idx 20-4
+.silent_index {transposition} idx 20-5
+.silent_index {mark} idx 20-5
+.silent_index {Defuns} idx 20-5
+.silent_index {mark} idx 20-5
+.silent_index {Region} idx 20-5
+.silent_index {motion} idx 20-5
+.silent_index {indentation} idx 20-6
+.silent_index {formatting} idx 20-6
+.silent_index {grinding} idx 20-6
+.silent_index {Linefeed} idx 20-6
+.silent_index {numeric} idx 20-6
+.silent_index {Region} idx 20-7
ADDED psl-1983/3-1/doc/nmode/nm-replacement.contents
Index: psl-1983/3-1/doc/nmode/nm-replacement.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-replacement.contents
@@ -0,0 +1,3 @@
+contents_entry(0 19 {Replacement Commands} 19-1)
+contents_entry(1 19.1 {Query Replace} 19-1)
+contents_entry(1 19.2 {Other Search-and-loop Functions} 19-1)
ADDED psl-1983/3-1/doc/nmode/nm-replacement.function
Index: psl-1983/3-1/doc/nmode/nm-replacement.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-replacement.function
@@ -0,0 +1,5 @@
+.silent_index {replace-string-command} idx 19-1
+.silent_index {query-replace-command} idx 19-1
+.silent_index {count-occurrences-command} idx 19-1
+.silent_index {delete-non-matching-lines-command} idx 19-1
+.silent_index {delete-matching-lines-command} idx 19-1
ADDED psl-1983/3-1/doc/nmode/nm-replacement.ibm
Index: psl-1983/3-1/doc/nmode/nm-replacement.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-replacement.ibm
@@ -0,0 +1,77 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-REPLACEMENT.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Replacement Commands) Page 19-1
+
+
+ 202/19. Replacement Commands
+
+ 201/Global search-and-replace operations are not needed as often in NMODE as
+ they are in other editors, but they are available. In addition to the simple
+ Replace operation which is like that found in most editors, there is a Query
+ Replace operation which asks you, for each occurrence of the pattern,
+ whether to replace it.
+
+ To replace every instance of FOO after point with BAR, you can do
+
+ M-X Replace<CR>FOO<CR>BAR<CR>
+
+ This invokes 203/replace-string-command201/. Replacement occurs only after point,
+ so if you want to cover the whole buffer you must go to the beginning first.
+ Replacement continues to the end of the buffer.
+
+ 202/19.1 Query Replace
+
+ 201/If you want to change only some of the occurrences of FOO, not all, then
+ you cannot use an ordinary Replace. Instead, use M-X Query
+ Replace<CR>FOO<CR>BAR<CR> (203/query-replace-command201/). This displays each
+ occurrence of FOO and waits for you to say whether to replace it with a
+ BAR. The things you can type when you are shown an occurrence of FOO
+ are:
+
+ Space to replace the FOO
+ Rubout to skip to the next FOO without replacing this one.
+ Comma to replace this FOO and display the result. You are then
+ asked for another input character, except that since the
+ replacement has already been made, Rubout and Space are
+ equivalent.
+ Escape to exit without doing any more replacements.
+ Period to replace this FOO and then exit.
+ ! to replace all remaining FOO's without asking.
+ ^ to go back to the previous FOO (or, where it was), in
+ case you have made a mistake.
+
+ If you type any other character, the Query Replace is exited, and the
+ character executed as a command.
+
+ 202/19.2 Other Search-and-loop Functions
+
+ 201/Here are some other functions related to replacement. Their arguments are
+ strings.
+
+
+
+ M-X How Many<CR>FOO<CR> invoke 203/count-occurrences-command 201/and
+ print the number of occurrences of FOO after point.
+ M-X Count Occurrences<CR>FOO<CR> Same as M-X How Many.
+ 201/Page 19-2 NMODE Manual (Other Search-and-loop Functions)
+
+
+ M-X Keep Lines<CR>FOO<CR> invoke
+ 203/delete-non-matching-lines-command 201/and kill all lines
+ after point that don't contain FOO.
+ M-X Delete Non-Matching Lines<CR>FOO<CR> Same as M-X Keep
+ Lines.
+ M-X Flush Lines<CR>FOO<CR> invoke 203/delete-matching-lines-command
+ 201/and kill all lines after point that contain FOO.
+ M-X Delete Matching Lines<CR>FOO<CR> Same as M-X Flush Lines.
ADDED psl-1983/3-1/doc/nmode/nm-replacement.key
Index: psl-1983/3-1/doc/nmode/nm-replacement.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-replacement.key
@@ -0,0 +1,1 @@
+.silent_index {ESCape} idx 19-1
ADDED psl-1983/3-1/doc/nmode/nm-replacement.r
Index: psl-1983/3-1/doc/nmode/nm-replacement.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-replacement.r
@@ -0,0 +1,87 @@
+.so pndoc:nman
+.part NM-REPLACEMENT manual
+@Chapter[Replacement Commands]
+@node("replace")
+@index{searching}
+@index{replacement}
+@index{Replace String}
+ Global search-and-replace operations are not needed as often in NMODE
+as they are in other editors, but they are available. In
+addition to the simple Replace operation which is like that found in
+most editors, there is a Query Replace operation which asks you, for
+each occurrence of the pattern, whether to replace it.
+
+@fncindex{replace-string-command}
+ To replace every instance of FOO after point with BAR, you can do
+@example[
+M-X Replace@return1{}FOO@return1{}BAR@return1{}
+]
+This invokes @fnc{replace-string-command}.
+Replacement occurs only after point, so if you want to cover the
+whole buffer you must go to the beginning first. Replacement
+continues to the end of the buffer.
+@Section[Query Replace]
+@index{Query Replace}
+@fncindex{query-replace-command}
+ If you want to change only some of the occurrences of FOO, not all,
+then you cannot use an ordinary Replace.
+Instead, use M-X Query Replace@return1{}FOO@return1{}BAR@return2{}
+(@fnc{query-replace-command}).
+This displays each occurrence of FOO and waits
+for you to say whether to replace it with a BAR. The things you can
+type when you are shown an occurrence of FOO are:
+@index{Space}
+@index{Rubout}
+@index{Comma}
+@keyindex{ESCape (Execute)}
+@index{.}
+@index{!}
+@index{^}
+@WideCommands{
+Space to replace the FOO
+
+Rubout to skip to the next FOO without replacing this one.
+
+Comma to replace this FOO and display the result.
+You are then asked for another input character,
+except that since the replacement has already been
+made, Rubout and Space are equivalent.
+
+Escape to exit without doing any more replacements.
+
+Period to replace this FOO and then exit.
+
+! to replace all remaining FOO's without asking.
+
+^ to go back to the previous FOO (or, where it was),
+in case you have made a mistake.
+}
+If you type any other character, the Query Replace is exited, and
+the character executed as a command.
+@Section[Other Search-and-loop Functions]
+ Here are some other functions related to replacement. Their
+arguments are strings.
+
+@fncindex{count-occurrences-command}
+@fncindex{delete-non-matching-lines-command}
+@fncindex{delete-matching-lines-command}
+@index{deletion}@index{replacement}
+@GrossCommands[
+M-X How Many@return1{}FOO@return1{}
+invoke @fnc{count-occurrences-command} and
+print the number of occurrences of FOO after point.
+
+M-X Count Occurrences@return1{}FOO@return1{} Same as M-X How Many.
+
+M-X Keep Lines@return1{}FOO@return1{}
+invoke @fnc{delete-non-matching-lines-command} and
+kill all lines after point that don't contain FOO.
+
+M-X Delete Non-Matching Lines@return1{}FOO@return1{} Same as M-X Keep Lines.
+
+M-X Flush Lines@return1{}FOO@return1{}
+invoke @fnc{delete-matching-lines-command} and
+kill all lines after point that contain FOO.
+
+M-X Delete Matching Lines@return1{}FOO@return1{} Same as M-X Flush Lines.
+]
ADDED psl-1983/3-1/doc/nmode/nm-replacement.topic
Index: psl-1983/3-1/doc/nmode/nm-replacement.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-replacement.topic
@@ -0,0 +1,12 @@
+.silent_index {searching} idx 19-1
+.silent_index {replacement} idx 19-1
+.silent_index {Replace} idx 19-1
+.silent_index {Query} idx 19-1
+.silent_index {Space} idx 19-1
+.silent_index {Rubout} idx 19-1
+.silent_index {Comma} idx 19-1
+.silent_index {.} idx 19-1
+.silent_index {!} idx 19-1
+.silent_index {^} idx 19-1
+.silent_index {deletion} idx 19-1
+.silent_index {replacement} idx 19-1
ADDED psl-1983/3-1/doc/nmode/nm-screen.contents
Index: psl-1983/3-1/doc/nmode/nm-screen.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-screen.contents
@@ -0,0 +1,2 @@
+contents_entry(0 2 {The Organization of the Screen} 2-1)
+contents_entry(1 2.1 {The Mode Line} 2-1)
ADDED psl-1983/3-1/doc/nmode/nm-screen.function
Index: psl-1983/3-1/doc/nmode/nm-screen.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-screen.function
@@ -0,0 +1,1 @@
+.silent_index {nmode-invert-video} idx 2-1
ADDED psl-1983/3-1/doc/nmode/nm-screen.ibm
Index: psl-1983/3-1/doc/nmode/nm-screen.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-screen.ibm
@@ -0,0 +1,99 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-SCREEN.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (The Organization of the Screen) Page 2-1
+
+
+ 202/2. The Organization of the Screen
+
+ 201/NMODE divides the screen into several areas, each of which contains its
+ own sorts of information. The biggest area, of course, is the one in which
+ you usually see the text you are editing. The terminal's cursor usually
+ appears in the middle of the text, showing the position of 202/point201/, the location
+ at which editing takes place. While the cursor appears to point 203/at 201/a
+ character, point should be thought of as 203/between 201/two characters; it points
+ 203/before 201/the character that the cursor appears on top of. Terminals have only
+ one cursor, and when output is in progress it must appear where the typing
+ is being done. This does not mean that point is moving. It is only that
+ NMODE has no way to show you the location of point except when the terminal
+ is idle.
+
+ One terminal function which 203/is 201/flexible is the choice of normal or inverse
+ video for displaying text. Nmode lets you toggle this feature with the C-X V
+ (203/nmode-invert-video201/) command.
+
+ A few lines at the bottom of the screen compose what is called the 202/echo
+ area201/. 202/Echoing 201/means printing out the commands that you type. NMODE
+ commands are usually not echoed at all, but if you pause for more than a
+ second in the middle of a multi-character command then all the characters
+ typed so far are echoed. This is intended to 202/prompt 201/you for the rest of the
+ command. The rest of the command is echoed, too, as you type it. This
+ behavior is designed to give confident users optimum response, while giving
+ hesitant users maximum feedback.
+
+ NMODE also uses the echo area for reading and displaying the arguments
+ for some commands, such as searches, and for printing brief information in
+ response to certain commands.
+
+ 202/2.1 The Mode Line
+
+ 201/The line above the echo area is known as the 202/mode line201/. It is the line that
+ usually starts with "NMODE something". Its purpose is to tell you anything
+ that may affect the meaning of your commands aside from the text itself.
+
+ NMODE major (minor) [bfr] file --pos-- *
+
+ 202/major 201/is always the name of the 202/major mode 201/you are in. At any time,
+ NMODE is in one and only one of its possible major modes. The major modes
+ available include Text mode, Lisp mode (which NMODE starts out in), Recurse
+ mode, Browser modes, and others. See Section 20.1 [Major Modes], page 1,
+ for details of how the modes differ and how to select one.
+
+ 202/minor 201/is a list of some of the 202/minor modes 201/that are turned on at the
+ moment. "Fill" means that Auto Fill mode is on.
+
+ 202/bfr 201/is the name of the currently selected 202/buffer201/. Each buffer has its own
+ name and holds a file being edited; this is how NMODE can hold several files
+ at once. But at any time you are editing only one of them, the 202/selected
+ 201/buffer. When we speak of what some command does to "the buffer", we are
+ talking about the currently selected buffer. Multiple buffers make it easy to
+ 201/Page 2-2 NMODE Manual (The Mode Line)
+
+
+ switch around between several files, and then it is very useful that the mode
+ line tells you which one you are editing at any time. However, before you
+ learn how to use multiple buffers, you will always be in the buffer called
+ "Main", which is one that exists when NMODE starts up. If the name of the
+ buffer is the same as the name of the file you are visiting, then the buffer
+ name is left out of the mode line. See Section 16 [Buffers], page 1, for how
+ to use more than one buffer in one NMODE.
+
+ 202/file 201/is the name of the file that you are editing. It is the last file that was
+ visited in the buffer you are in.
+
+ The star at the end of the mode line means that there are changes in the
+ buffer that have not been saved in the file. If the file has not been changed
+ since it was read in or saved, there is no star.
+
+ 202/pos 201/tells you whether there is additional text above the top of the screen,
+ or below the bottom. If your file is small and it is all on the screen, --pos--
+ is omitted. Otherwise, it is --TOP-- if you are looking at the beginning of
+ the file, --BOT-- if you are looking at the end of the file, or --nn%-- where
+ nn is the percentage of the file above the top of the screen.
+
+ If you are accustomed to other display editors, you may be surprised that
+ NMODE does not always display the page number and line number of point in
+ the mode line. This is because the text is stored in a way that makes it
+ difficult to compute this information. Displaying them all the time would be
+ too slow to be borne. However, once you are adjusted to NMODE, you will
+ rarely have any reason to be concerned with page numbers or line numbers.
ADDED psl-1983/3-1/doc/nmode/nm-screen.r
Index: psl-1983/3-1/doc/nmode/nm-screen.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-screen.r
@@ -0,0 +1,112 @@
+.so pndoc:nman
+.part NM-SCREEN manual
+@Chapter[The Organization of the Screen]
+@node("screen")
+@index{cursor}
+@index{screen}
+@index{Point}
+ NMODE divides the screen into several areas, each of which contains
+its own sorts of information. The biggest area, of course, is the one
+in which you usually see the text you are editing. The terminal's
+cursor usually appears in the middle of the text, showing the position
+of @dfn[point], the location at which editing takes place. While the
+cursor appears to point @xxii[at] a character, point should be thought
+of as @xxii[between] two characters; it points @xxii[before] the
+character that the cursor appears on top of. Terminals have only one
+cursor, and when output is in progress it must appear where the
+typing is being done. This does not mean that point is moving. It is
+only that NMODE has no way to show you the location of point except
+when the terminal is idle.
+
+@fncindex{nmode-invert-video}
+One terminal function which @xxii[is] flexible is the choice of normal
+or inverse video for displaying text.
+Nmode lets you toggle this feature with the C-X V (@fnc{nmode-invert-video})
+command.
+
+@index{echo area}
+@index{prompting}
+ A few lines at the bottom of the screen compose what is called the
+@dfn[echo area]. @dfn[Echoing] means printing out the commands that
+you type.
+NMODE commands are usually not echoed at all, but if you pause
+for more than a second in the middle of a multi-character command then
+all the characters typed so far are echoed. This is intended to
+@dfn[prompt] you for the rest of the command. The rest of the command
+is echoed, too, as you type it. This behavior is designed to give
+confident users optimum response, while giving hesitant users
+maximum feedback.
+
+ NMODE also uses the echo area for reading and displaying the
+arguments for some commands, such as searches, and for printing
+brief information in response to certain commands.
+@INFO{
+ The line above the echo area is known as the @dfn[mode line]. It is the
+line that usually starts with "NMODE something". Its purpose is to
+tell what is going on in the NMODE, and to show any reasons why
+commands may not be interpreted in the standard way. The mode line
+is very important, and if you are surprised by how NMODE reacts to
+your commands you should look there for enlightenment.}
+@Section[The Mode Line]
+@index{mode line}
+@node("modeline")
+ The line above the echo area is known as the @dfn[mode line].
+It is the line that usually starts with "NMODE something".
+Its purpose is to tell you anything that may affect the meaning of
+your commands aside from the text itself.
+@Example[
+NMODE major (minor) [bfr] file --pos-- *
+]
+@index{major modes}@index{submode}
+ @dfn[major] is always the name of the @dfn[major mode] you are in.
+At any time, NMODE is in one and only one of its possible major modes.
+The major modes available include Text mode,
+Lisp mode (which NMODE starts out in),
+Recurse mode,
+Browser modes, and others.
+@Note("MajorModes" "Major Modes"), for details of how the
+modes differ and how to select one.
+
+@index{minor modes}
+@index{Auto Fill mode}
+ @dfn[minor] is a list of some of the @dfn[minor modes] that are
+turned on at the moment. "Fill" means that Auto Fill mode is on.
+
+@index{buffers}
+ @dfn[bfr] is the name of the currently selected @dfn[buffer]. Each
+buffer has its own name and holds a file being edited; this is how
+NMODE can hold several files at once. But at any time you are editing
+only one of them, the @dfn[selected] buffer. When we speak of what
+some command does to "the buffer", we are talking about the currently
+selected buffer. Multiple buffers make it easy to switch around
+between several files, and then it is very useful that the mode line
+tells you which one you are editing at any time. However, before you
+learn how to use multiple buffers, you will always be in the buffer
+called "Main", which is one that exists when NMODE starts up.
+If the name of the buffer is the same as the name of the file
+you are visiting, then the buffer name is left out of the mode line.
+@Note("Buffers"), for how to use more than one buffer in one
+NMODE.
+
+@index{files}
+ @dfn[file] is the name of the file that you are editing. It is the
+last file that was visited in the buffer you are in.
+
+ The star at the end of the mode line means that there are changes in
+the buffer that have not been saved in the file. If the file has not
+been changed since it was read in or saved, there is no star.
+
+ @dfn[pos] tells you whether there is additional text above the top of
+the screen, or below the bottom. If your file is small and it is all
+on the screen, --pos-- is omitted. Otherwise, it is --TOP-- if you
+are looking at the beginning of the file, --BOT-- if you are looking
+at the end of the file, or --nn%-- where nn is the percentage of the
+file above the top of the screen.
+
+ If you are accustomed to other display editors, you may be surprised
+that NMODE does not always display the page number and line number of
+point in the mode line. This is because the text is stored in a way
+that makes it difficult to compute this information. Displaying them
+all the time would be too slow to be borne.
+However, once you are adjusted to NMODE, you will rarely have any
+reason to be concerned with page numbers or line numbers.
ADDED psl-1983/3-1/doc/nmode/nm-screen.topic
Index: psl-1983/3-1/doc/nmode/nm-screen.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-screen.topic
@@ -0,0 +1,12 @@
+.silent_index {cursor} idx 2-1
+.silent_index {screen} idx 2-1
+.silent_index {Point} idx 2-1
+.silent_index {echo} idx 2-1
+.silent_index {prompting} idx 2-1
+.silent_index {mode} idx 2-1
+.silent_index {major} idx 2-1
+.silent_index {submode} idx 2-1
+.silent_index {minor} idx 2-1
+.silent_index {Auto} idx 2-1
+.silent_index {buffers} idx 2-1
+.silent_index {files} idx 2-2
ADDED psl-1983/3-1/doc/nmode/nm-searching.contents
Index: psl-1983/3-1/doc/nmode/nm-searching.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-searching.contents
@@ -0,0 +1,1 @@
+contents_entry(0 12 {Searching} 12-1)
ADDED psl-1983/3-1/doc/nmode/nm-searching.function
Index: psl-1983/3-1/doc/nmode/nm-searching.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-searching.function
@@ -0,0 +1,2 @@
+.silent_index {incremental-search-command} idx 12-1
+.silent_index {reverse-search-command} idx 12-1
ADDED psl-1983/3-1/doc/nmode/nm-searching.ibm
Index: psl-1983/3-1/doc/nmode/nm-searching.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-searching.ibm
@@ -0,0 +1,107 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-SEARCHING.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Searching) Page 12-1
+
+
+ 202/12. Searching
+
+ 201/Like other editors, NMODE has commands for searching for an occurrence of
+ a string. The search command is unusual in that it is 202/incremental201/; it begins
+ to search before you have finished typing the search string. As you type in
+ the search string, NMODE shows you where it would be found. When you
+ have typed enough characters to identify the place you want, you can stop.
+ Depending on what you will do next, you may or may not need to terminate
+ the search explicitly with an Escape (Execute on the hp9836) first.
+
+ C-S Search forward.
+ C-R Search backward.
+
+ The command to search is C-S (203/incremental-search-command201/). C-S reads in
+ characters and positions the cursor at the first occurrence of the characters
+ that you have typed. If you type C-S and then F, the cursor moves right
+ after the first "F". Type an "O", and see the cursor move to after the first
+ "FO". After another "O", the cursor is after the first "FOO" after the place
+ where you started the search. At the same time, the "FOO" has echoed at
+ the bottom of the screen.
+
+ If you type a mistaken character, you can delete it. After the FOO,
+ typing a Backspace makes the "O" disappear from the bottom of the screen,
+ leaving only "FO". The cursor moves back to the "FO". Deleting the "O"
+ and "F" moves the cursor back to where you started the search.
+
+ When you are satisfied with the place you have reached, you can type an
+ Escape, which stops searching, leaving the cursor where the search brought
+ it. Also, any command not specially meaningful in searches stops the
+ searching and is then executed. 204/1 201/Thus, typing C-A would exit the search
+ and then move to the beginning of the line. escape is necessary only if the
+ next command you want to type is a printing character, Rubout, Backspace,
+ Escape, C-Q, or another search command, since those are the characters that
+ have special meanings inside the search.
+
+ Sometimes you search for "FOO" and find it, but not the one you expected
+ to find. There was a second FOO that you forgot about, before the one you
+ were looking for. Then type another C-S and the cursor will find the next
+ FOO. This can be done any number of times. If you overshoot, you can
+ delete the C-S's.
+
+ After you exit a search, you can search for the same string again by
+ typing just C-S C-S: one C-S command to start the search and then another
+ C-S to mean "search again".
+
+
+ ______________________________
+
+ 201/ 1. A few other commands are not executed after a search. Most special
+ function keys send commands which begin with Escape. This escape is taken
+ as terminating the search, and the rest of the command is then executed.
+ ESC-A, for instance, will terminate the search and insert A, instead of
+ terminating the search and jumping up a line.
+ 201/Page 12-2 NMODE Manual (Searching)
+
+
+ If your string is not found at all, the echo area says "Failing I-Search".
+ The cursor is after the place where NMODE found as much of your string as
+ it could. Thus, if you search for FOOT, and there is no FOOT, you might
+ see the cursor after the FOO in FOOL. At this point there are several
+ things you can do. If your string was mistyped, you can rub some of it out
+ and correct it. If you like the place you have found, you can type Escape
+ or some other NMODE command to "accept what the search offered". Or you
+ can type C-G, which throws away the characters that could not be found (the
+ "T" in "FOOT"), leaving those that were found (the "FOO" in "FOOT"). A
+ second C-G at that point undoes the search entirely.
+
+ The C-G "quit" command does special things during searches; just what,
+ depends on the status of the search. If the search has found what you
+ specified and is waiting for input, C-G cancels the entire search. The
+ cursor moves back to where you started the search. If C-G is typed while
+ the search is actually searching for something or updating the display, or
+ after search failed to find some of your input (having searched all the way to
+ the end of the file), then only the characters which have not been found are
+ discarded. Having discarded them, the search is now successful and waiting
+ for more input, so a second C-G will cancel the entire search. Make sure
+ you wait for the first C-G to ring the bell before typing the second one; if
+ typed too soon, the second C-G may be confused with the first and
+ effectively lost.
+
+ You can also type C-R at any time to start searching backwards. If a
+ search fails because the place you started was too late in the file, you should
+ do this. Repeated C-R's keep looking for more occurrences backwards. A
+ C-S starts going forwards again. C-R's can be rubbed out just like anything
+ else. If you know that you want to search backwards, you can use C-R
+ instead of C-S to start the search, because C-R is also a command
+ (203/reverse-search-command201/) to search backward.
+
+ All sorts of searches in NMODE normally ignore the case of the text they
+ are searching through; if you specify searching for FOO, then Foo and foo
+ are also considered a match.
ADDED psl-1983/3-1/doc/nmode/nm-searching.key
Index: psl-1983/3-1/doc/nmode/nm-searching.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-searching.key
@@ -0,0 +1,3 @@
+.silent_index {C-S} idx 12-1
+.silent_index {C-R} idx 12-1
+.silent_index {C-G} idx 12-2
ADDED psl-1983/3-1/doc/nmode/nm-searching.r
Index: psl-1983/3-1/doc/nmode/nm-searching.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-searching.r
@@ -0,0 +1,105 @@
+.so pndoc:nman
+.part NM-SEARCHING manual
+@Chapter[Searching]
+@node("search")
+ Like other editors, NMODE has commands for searching for an
+occurrence of a string. The search command is unusual in that it
+is @dfn[incremental]; it begins to search before you have finished typing
+the search string. As you type in the search string, NMODE shows you
+where it would be found. When you have typed enough characters to
+identify the place you want, you can stop. Depending on what you will
+do next, you may or may not need to terminate the search explicitly
+with an Escape (Execute on the hp9836) first.
+@WideCommands[
+C-S Search forward.
+
+C-R Search backward.
+]
+@index{searching}
+@keyindex{C-S}
+@keyindex{C-R}
+@fncindex{incremental-search-command}
+@fncindex{reverse-search-command}
+ The command to search is C-S (@fnc{incremental-search-command}). C-S reads in
+characters and positions the cursor at the first occurrence of the
+characters that you have typed. If you type C-S and then F, the
+cursor moves right after the first "F". Type an "O", and see
+the cursor move to after the first "FO". After another "O", the
+cursor is after the first "FOO" after the place where you started
+the search. At the same time, the "FOO" has echoed at the bottom of
+the screen.
+
+ If you type a mistaken character, you can delete it. After the
+FOO, typing a Backspace makes the "O" disappear from the bottom of
+the screen, leaving only "FO". The cursor moves back to the "FO".
+Deleting the "O" and "F" moves the cursor back to where you
+started the search.
+
+ When you are satisfied with the place you have reached, you can type
+an Escape, which stops searching, leaving the cursor where
+the search brought it. Also, any command not specially meaningful in
+searches stops the searching and is then executed.
+@foot{A few other commands are not executed after a search.
+Most special function keys send commands which begin with Escape.
+This escape is taken as terminating the search, and the rest of the
+command is then executed. ESC-A, for instance, will terminate the search
+and insert A, instead of terminating the search and jumping up a line.}
+Thus, typing C-A
+would exit the search and then move to the beginning of the line.
+escape is necessary only if the next command you want to
+type is a printing character, Rubout, Backspace, Escape,
+C-Q, or another search command, since those are the characters that
+have special meanings inside the search.
+
+ Sometimes you search for "FOO" and find it, but not the one you
+expected to find. There was a second FOO that you forgot about,
+before the one you were looking for. Then type another C-S and
+the cursor will find the next FOO. This can be done any number of
+times. If you overshoot, you can delete the C-S's.
+
+ After you exit a search, you can search for the same string again by
+typing just C-S C-S: one C-S command to start the search and then
+another C-S to mean "search again".
+
+ If your string is not found at all, the echo area says "Failing
+I-Search". The cursor is after the place where NMODE found as
+much of your string as it could. Thus, if you search for FOOT, and
+there is no FOOT, you might see the cursor after the FOO in FOOL. At
+this point there are several things you can do. If your string was
+mistyped, you can rub some of it out and correct it. If you like the
+place you have found, you can type Escape or some other NMODE command
+to "accept what the search offered". Or you can type C-G, which
+throws away the characters that could not be found (the "T" in "FOOT"),
+leaving those that were found (the "FOO" in "FOOT"). A second C-G
+at that point undoes the search entirely.
+
+@index{quitting}
+@keyindex{C-G}
+ The C-G "quit" command does special things during searches; just
+what, depends on the status of the search. If the search has found
+what you specified and is waiting for input, C-G cancels the entire
+search. The cursor moves back to where you started the search. If
+C-G is typed while the search is actually searching for something or
+updating the display, or after search failed to find some of your
+input (having searched all the way to the end of the file), then only
+the characters which have not been found are discarded. Having
+discarded them, the search is now successful and waiting for more
+input, so a second C-G will cancel the entire search. Make sure you
+wait for the first C-G to ring the bell before typing the second one;
+if typed too soon, the second C-G may be confused with the first and
+effectively lost.
+
+ You can also type C-R at any time to start searching backwards.
+If a search fails because the place you started was too late in the
+file, you should do this. Repeated C-R's keep looking for more
+occurrences backwards. A C-S starts going forwards again. C-R's
+can be rubbed out just like anything else. If you know that you want
+to search backwards, you can use C-R instead of C-S to start the
+search, because C-R is also a command
+(@fnc{reverse-search-command})
+to search backward.
+
+@Index{Case Search}
+ All sorts of searches in NMODE normally ignore the case of the text
+they are searching through; if you specify searching for FOO, then Foo
+and foo are also considered a match.
ADDED psl-1983/3-1/doc/nmode/nm-searching.topic
Index: psl-1983/3-1/doc/nmode/nm-searching.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-searching.topic
@@ -0,0 +1,3 @@
+.silent_index {searching} idx 12-1
+.silent_index {quitting} idx 12-2
+.silent_index {Case} idx 12-2
ADDED psl-1983/3-1/doc/nmode/nm-selfdoc.contents
Index: psl-1983/3-1/doc/nmode/nm-selfdoc.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-selfdoc.contents
@@ -0,0 +1,1 @@
+contents_entry(0 9 {Help} 9-1)
ADDED psl-1983/3-1/doc/nmode/nm-selfdoc.function
Index: psl-1983/3-1/doc/nmode/nm-selfdoc.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-selfdoc.function
@@ -0,0 +1,2 @@
+.silent_index {apropos-command} idx 9-1
+.silent_index {help-dispatch} idx 9-1
ADDED psl-1983/3-1/doc/nmode/nm-selfdoc.ibm
Index: psl-1983/3-1/doc/nmode/nm-selfdoc.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-selfdoc.ibm
@@ -0,0 +1,76 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-SELFDOC.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Help) Page 9-1
+
+
+ 202/9. Help
+
+ 201/NMODE has a great deal of internal documentation. There are two basic
+ commands, the Apropos command and the Help Dispatch command. The
+ Apropos command can be started by typing a "+" on the key pad at the far
+ right hand side of the hp9836 keyboard or by typing M-X Apropos. The
+ Help Dispatch command can be started by typing C-?, M-/, or M-?.
+
+ The Help Dispatch command tells you what function is connected to a given
+ key or key combination. The function names are often descriptive, so you
+ can sometimes find out which key does what with the Help Dispatch command.
+ To find out the function of a key or key combination, type M-?, then type
+ the keys exactly as if you wanted NMODE to act on them.
+
+ The Apropos command basically looks up command names containing a given
+ word or phrase, or relating to a given topic. When you have started it, it
+ will ask you for the word or phrase you are looking for in a command name
+ (like "Move" or "Text" or "Remove", for instance). It will then temporarily
+ cover up your text and show you a list of commands that match the phrase
+ you typed in. At this point you can move up and down the list with the
+ normal NMODE move commands, or you can look at the documentation for a
+ particular command by typing V (for view). This temporarily covers up the
+ list of commands while showing documentation for the command that you
+ choose. Among other things this documentation tells you what key calls the
+ command. You can get back to the list of commands by typing "Q" (for quit)
+ or C-M-L. You can then get a more specific list of commands by typing "F"
+ (for filter) and another phrase relevant to the command(s) you want to find.
+ You can get back from the list of commands to your original text by typing
+ "Q" (for quit).
+
+ Here is a set of Apropos strings that covers many classes of NMODE
+ commands, since there are strong conventions for naming the standard NMODE
+ commands. By giving you a feel for the naming conventions, this set should
+ also serve to aid you in developing a technique for picking Apropos strings.
+
+ character, line, word, sentence, paragraph, region, page, buffer,
+ screen, window, bounds, file, dir, beginning, end, case, mode,
+ forward, backward, next, previous, up, down, search, kill, delete, mark,
+ fill, indent, change.
+
+ There is also a convention for how command names start for certain common
+ kinds of operations: many commands start with one of the words "Edit",
+ "View", "Insert", "List", or "What" "Move" "Mark".
+
+ Note that the ability to apply filters allows you to search for commands which
+ contain a set of strings, even if you don't know the order of the strings in
+ the command name. If you find the list of commands containing or otherwise
+ tied to "word", you can then filter the list to find the sublist that is also
+ tied to "kill" and to "back" (in two filter operations), without knowing that
+ the operation being searched for is kill-backward-word-command, rather than
+ backward-kill-word-command or some other permutation.
+
+ Because topics and action types and modes are also searched for, it is
+ 201/Page 9-2 NMODE Manual (Help)
+
+
+ possible to find broader classes of commands than would be possible from
+ names alone. "Remove", for instance, is given as an action type for both kill
+ commands and delete commands, so one can search for both at once by
+ searching for "remove" and other specifying words.
ADDED psl-1983/3-1/doc/nmode/nm-selfdoc.r
Index: psl-1983/3-1/doc/nmode/nm-selfdoc.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-selfdoc.r
@@ -0,0 +1,67 @@
+.so pndoc:nman
+.part NM-SELFDOC manual
+@chapter[Help]
+@node("help")
+@fncindex{apropos-command}
+@fncindex{help-dispatch}
+NMODE has a great deal of internal
+documentation. There are two basic commands, the Apropos command and
+the Help Dispatch command. The Apropos command can be started by
+typing a "+" on the key pad at the far right hand side of the hp9836
+keyboard or by typing M-X Apropos. The Help Dispatch command can be
+started by typing C-?, M-/, or M-?.
+
+The Help Dispatch command tells you what function is connected to a
+given key or key combination. The function names are often
+descriptive, so you can sometimes find out which key does what with
+the Help Dispatch command. To find out the function of a key or key
+combination, type M-?, then type the keys exactly as if you wanted
+NMODE to act on them.
+
+The Apropos command basically looks up command names containing a
+given word or phrase, or relating to a given topic. When you have
+started it, it will ask you for the word or phrase you are looking for
+in a command name (like "Move" or "Text" or "Remove", for instance).
+It will then temporarily cover up your text and show you a list of
+commands that match the phrase you typed in. At this point you can
+move up and down the list with the normal NMODE move commands,
+or you can look at the documentation for a particular
+command by typing V (for view). This temporarily covers up the list
+of commands while showing documentation for the command that you
+choose. Among other things this documentation tells you what key calls
+the command. You can get back to the list of commands by typing "Q"
+(for quit) or C-M-L. You can then get a more specific list
+of commands by typing "F" (for filter) and another phrase relevant to
+the command(s) you want to find. You can get back from the list of
+commands to your original text by typing "Q" (for quit).
+
+Here is a set of Apropos strings that covers many classes of
+NMODE commands, since there are strong conventions for naming the
+standard NMODE commands. By giving you a feel for the naming
+conventions, this set should also serve to aid you in developing a
+technique for picking Apropos strings.
+@begin[quotation]
+character, line, word, sentence, paragraph, region, page, buffer,
+screen, window, bounds, file, dir, beginning, end, case, mode,
+forward, backward, next, previous, up, down, search, kill, delete, mark,
+fill, indent, change.
+@end[quotation]
+There is also a convention for how command names start for
+certain common kinds of operations: many commands
+start with one of the words "Edit", "View", "Insert", "List", or
+"What" "Move" "Mark".
+
+Note that the ability to apply filters allows you to search for
+commands which contain a set of strings, even if you don't know the
+order of the strings in the command name.
+If you find the list of commands containing or otherwise tied to "word",
+you can then filter the list to find the sublist that is also tied to
+"kill" and to "back" (in two filter operations), without knowing that
+the operation being searched for is kill-backward-word-command, rather than
+backward-kill-word-command or some other permutation.
+
+Because topics and action types and modes are also searched for, it is
+possible to find broader classes of commands than would be possible
+from names alone. "Remove", for instance, is given as an action type
+for both kill commands and delete commands, so one can search for both
+at once by searching for "remove" and other specifying words.
ADDED psl-1983/3-1/doc/nmode/nm-subsystems.contents
Index: psl-1983/3-1/doc/nmode/nm-subsystems.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-subsystems.contents
@@ -0,0 +1,4 @@
+contents_entry(0 7 {Moving Up And Down Levels} 7-1)
+contents_entry(1 7.1 {Subsystems} 7-1)
+contents_entry(1 7.2 {Recursive Editing Levels} 7-1)
+contents_entry(1 7.3 {Exiting Levels; Exiting NMODE} 7-2)
ADDED psl-1983/3-1/doc/nmode/nm-subsystems.function
Index: psl-1983/3-1/doc/nmode/nm-subsystems.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-subsystems.function
@@ -0,0 +1,2 @@
+.silent_index {exit-nmode} idx 7-2
+.silent_index {nmode-exit-to-superior} idx 7-2
ADDED psl-1983/3-1/doc/nmode/nm-subsystems.ibm
Index: psl-1983/3-1/doc/nmode/nm-subsystems.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-subsystems.ibm
@@ -0,0 +1,80 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-SUBSYSTEMS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Moving Up And Down Levels) Page 7-1
+
+
+ 202/7. Moving Up And Down Levels
+
+
+ 201/Subsystems and recursive editing levels are two states in which you are
+ temporarily doing something other than editing the visited file as usual. For
+ example, you might be editing the arguments prompted for by a M-X
+ command, or using a browser.
+
+ 202/7.1 Subsystems
+
+ 201/A 202/subsystem 201/is an NMODE function which is an interactive program in its
+ own right: it reads commands in a language of its own, and displays the
+ results. You enter a subsystem by typing an NMODE command which invokes
+ it. Once entered, the subsystem usually runs until a specific command to
+ exit the subsystem is typed. An example of an NMODE subsystem is the
+ buffer-browser, invoked by typing C-X C-B.
+
+ The commands understood by a subsystem are usually not like NMODE
+ commands, because their purpose is something other than editing text. In
+ the buffer-browser, for instance, the commands are tailored to moving up and
+ down a list of the existing buffers, reordering this list in various ways, and
+ to deleting buffers. In NMODE, most commands are Control or Meta
+ characters because printing characters insert themselves. In most
+ subsystems, there is no insertion of text, so non-Control non-Meta characters
+ can be the commands.
+
+ While you are inside a subsystem, the mode line identifies the subsystem by
+ identifying the mode of the current buffer. The special properties of the
+ subsystem are due to the kinds of commands that are available in this mode,
+ and to the keys that the mode associates with them. Because each buffer has
+ its own associated mode at any given time, if a user moves out of the buffer
+ associated with the subsystem into an ordinary text buffer, he/she will have
+ left the subsystem, even though he/she will not have used the normal
+ command for doing so.
+
+ Because each subsystem implements its own commands, we cannot guarantee
+ anything about them. However, there are conventions for what certain
+ commands ought to do:
+
+ Space Moves downwards, like C-N in NMODE.
+ Q Exits normally.
+ Help or ? Prints documentation on the subsystem's commands.
+
+ Not all of these necessarily exist in every subsystem, however.
+
+ 202/7.2 Recursive Editing Levels
+
+ 201/A 202/recursive editing level 201/is a state in which part of the execution of one
+ command involves doing some editing. You may be editing the file you are
+ working on, or you may be editing completely something totally different from
+ what you were working on at top level. Currently, the completion of
+ extended commands, the preparation of prompted input strings, and the
+ examination of buffers in the kill-some-buffers-command function all involve
+ 201/Page 7-2 NMODE Manual (Recursive Editing Levels)
+
+
+ recursive editing levels within which the full power of NMODE is available.
+
+ 202/7.3 Exiting Levels; Exiting NMODE
+
+ 201/L]
+ On the hp9836, <STOP> will exit from NMODE to the hp9836 workstation top
+ level command interpreter. C-X C-Z will exit from NMODE into the PSL
+ interpreter, as will C-] L (Lisp-L) in Lisp mode.
ADDED psl-1983/3-1/doc/nmode/nm-subsystems.r
Index: psl-1983/3-1/doc/nmode/nm-subsystems.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-subsystems.r
@@ -0,0 +1,74 @@
+.so pndoc:nman
+.part NM-SUBSYSTEMS manual
+@Chapter[Moving Up And Down Levels]
+ Subsystems and recursive editing levels are two states in which
+you are temporarily doing something other than editing the visited
+file as usual. For example, you might be editing the arguments
+prompted for by a M-X command, or using a browser.
+@Section[Subsystems]
+@node("subsystems")
+ A @dfn[subsystem] is an NMODE function which is an interactive program in
+its own right: it reads commands in a language of its own, and
+displays the results. You enter a subsystem by typing an NMODE
+command which invokes it.
+Once entered, the subsystem usually runs until a
+specific command to exit the subsystem is typed.
+An example of an
+NMODE subsystem is the buffer-browser, invoked by typing C-X C-B.
+
+ The commands understood by a subsystem are usually not like NMODE
+commands, because their purpose is something other than editing text.
+In the buffer-browser, for instance,
+the commands are tailored to moving up and down
+a list of the existing buffers, reordering this list in various ways,
+and to deleting buffers.
+In NMODE, most commands are
+Control or Meta characters because printing characters insert
+themselves. In most subsystems, there is no insertion of text, so
+non-Control non-Meta characters can be the commands.
+
+ While you are inside a subsystem, the mode line identifies the subsystem
+by identifying the mode of the current buffer.
+The special properties of the subsystem are due to the kinds of commands
+that are available in this mode, and to the keys that the mode associates
+with them.
+Because each buffer has its own associated mode at any given time, if
+a user moves out of the buffer associated with the subsystem into an
+ordinary text buffer, he/she will have left the subsystem, even though
+he/she will not have used the normal command for doing so.
+
+ Because each subsystem implements its own commands, we cannot
+guarantee anything about them. However, there are conventions for
+what certain commands ought to do:
+@DoubleWideCommands{
+Space Moves downwards, like C-N in NMODE.
+
+Q Exits normally.
+
+Help or ? Prints documentation on the subsystem's commands.
+}
+Not all of these necessarily exist in every subsystem, however.
+@Section[Recursive Editing Levels]
+@node("recursive")
+@Index{Recursive Editing Level}
+@Index{Mode Line}
+ A @dfn[recursive editing level] is a state in which part of the
+execution of one command involves doing some editing. You may be
+editing the file you are working on, or you may be editing completely
+something totally different from what you were working on at top
+level. Currently, the completion of extended commands, the preparation
+of prompted input strings, and the examination of buffers in the
+kill-some-buffers-command function all involve recursive editing levels
+within which the full power of NMODE is available.
+@Section[Exiting Levels; Exiting NMODE]
+@index[stop]
+@index[C-X C-Z]
+@index[C-] L]
+@fncindex{exit-nmode}
+@fncindex{nmode-exit-to-superior}
+@index{exiting}
+ On the hp9836, <STOP> will exit from NMODE to the hp9836 workstation top
+level command interpreter.
+C-X C-Z will exit from
+NMODE into the PSL interpreter,
+as will C-] L (Lisp-L) in Lisp mode.
ADDED psl-1983/3-1/doc/nmode/nm-subsystems.topic
Index: psl-1983/3-1/doc/nmode/nm-subsystems.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-subsystems.topic
@@ -0,0 +1,6 @@
+.silent_index {Recursive} idx 7-1
+.silent_index {Mode} idx 7-1
+.silent_index {stop} idx 7-2
+.silent_index {C-X} idx 7-2
+.silent_index {C-} idx 7-2
+.silent_index {exiting} idx 7-2
ADDED psl-1983/3-1/doc/nmode/nm-text.contents
Index: psl-1983/3-1/doc/nmode/nm-text.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-text.contents
@@ -0,0 +1,8 @@
+contents_entry(0 13 {Commands for English Text} 13-1)
+contents_entry(1 13.1 {Word Commands} 13-1)
+contents_entry(1 13.2 {Sentence and Paragraph Commands} 13-2)
+contents_entry(2 13.2.1 {Sentences} 13-2)
+contents_entry(2 13.2.2 {Paragraphs} 13-3)
+contents_entry(1 13.3 {Indentation Commands for Text} 13-3)
+contents_entry(1 13.4 {Text Filling} 13-4)
+contents_entry(1 13.5 {Case Conversion Commands} 13-5)
ADDED psl-1983/3-1/doc/nmode/nm-text.function
Index: psl-1983/3-1/doc/nmode/nm-text.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-text.function
@@ -0,0 +1,32 @@
+.silent_index {tab-to-tab-stop-command} idx 13-1
+.silent_index {text-mode-command} idx 13-1
+.silent_index {move-forward-word-command} idx 13-1
+.silent_index {move-backward-word-command} idx 13-1
+.silent_index {kill-forward-word-command} idx 13-1
+.silent_index {kill-backward-word-command} idx 13-1
+.silent_index {transpose-words} idx 13-1
+.silent_index {mark-word-command} idx 13-2
+.silent_index {backward-sentence-command} idx 13-2
+.silent_index {forward-sentence-command} idx 13-2
+.silent_index {kill-sentence-command} idx 13-2
+.silent_index {backward-kill-sentence-command} idx 13-2
+.silent_index {backward-paragraph-command} idx 13-3
+.silent_index {forward-paragraph-command} idx 13-3
+.silent_index {mark-paragraph-command} idx 13-3
+.silent_index {tab-to-tab-stop-command} idx 13-3
+.silent_index {indent-region-command} idx 13-3
+.silent_index {delete-horizontal-space-command} idx 13-3
+.silent_index {delete-indentation-command} idx 13-3
+.silent_index {back-to-indentation-command} idx 13-4
+.silent_index {auto-fill-mode-command} idx 13-4
+.silent_index {fill-region-command} idx 13-4
+.silent_index {fill-paragraph-command} idx 13-4
+.silent_index {center-line-command} idx 13-5
+.silent_index {set-fill-column-command} idx 13-5
+.silent_index {set-fill-prefix-command} idx 13-5
+.silent_index {what-cursor-position-command} idx 13-5
+.silent_index {lowercase-word-command} idx 13-5
+.silent_index {uppercase-word-command} idx 13-5
+.silent_index {uppercase-initial-command} idx 13-5
+.silent_index {lowercase-region-command} idx 13-6
+.silent_index {uppercase-region-command} idx 13-6
ADDED psl-1983/3-1/doc/nmode/nm-text.ibm
Index: psl-1983/3-1/doc/nmode/nm-text.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-text.ibm
@@ -0,0 +1,313 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-TEXT.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Commands for English Text) Page 13-1
+
+
+ 202/13. Commands for English Text
+
+ 201/NMODE enables you to manipulate words, sentences, or paragraphs of text.
+ In addition, there are commands to fill text, and convert case.
+ Editing files of text in a human language ought to be done using Text
+ mode. Invoke M-X Text Mode to enter Text mode. See Section 20.1 [Major
+ Modes], page 1. M-X Text Mode (203/text-mode-command201/) causes Tab to run the
+ function 203/tab-to-tab-stop-command201/. Automatic display of parenthesis matching
+ is turned off, which is what most people want.
+
+ 202/13.1 Word Commands
+
+ 201/NMODE has commands for moving over or operating on words. By
+ convention, they are all Meta- characters.
+
+ M-F Move Forward over a word.
+ M-B Move Backward over a word.
+ M-D Kill up to the end of a word.
+ M-Backspace Kill back to the beginning of a word.
+ M-@ Mark the end of the next word.
+ M-T Transpose two words; drag a word forward or backward
+ across other words.
+
+ Notice how these commands form a group that parallels the character based
+ commands C-F, C-B, C-D, C-T and Backspace. M-@ is related to C-@.
+
+ The commands Meta-F (203/move-forward-word-command201/) and Meta-B
+ (203/move-backward-word-command201/) move forward and backward over words.
+ They are thus analogous to Control-F and Control-B, which move over single
+ characters. Like their Control- equivalents, Meta-F and Meta-B move several
+ words if given an argument. Meta-F with a negative argument moves
+ backward like Meta-B, and Meta-B with a negative argument moves forward.
+ Forward motion stops right after the last letter of the word, while backward
+ motion stops right before the first letter.
+
+ It is easy to kill a word at a time. Meta-D (203/kill-forward-word-command201/)
+ kills the word after point. To be precise, it kills everything from point to
+ the place Meta-F would move to. Thus, if point is in the middle of a word,
+ only the part after point is killed. If some punctuation occurs between point
+ and the end of the next word it will be killed. If you wish to kill only the
+ next word but not the punctuation, simply do Meta-F to get the end, and kill
+ the word backwards with Meta-Backspace. Meta-D takes arguments just like
+ Meta-F.
+
+ Meta-Backspace (203/kill-backward-word-command201/) kills the word before point.
+ It kills everything from point back to where Meta-B would move to. If point
+ is after the space in "FOO, BAR", then "FOO, " is killed. If you wish to
+ kill just "FOO", then do a Meta-B and a Meta-D instead of a Meta-Backspace.
+
+ Meta-T (203/transpose-words201/) moves the cursor forward over a word, dragging
+ the word preceding or containing the cursor forward as well. A numeric
+ argument serves as a repeat count. Meta-T with a negative argument undoes
+ the effect of Meta-T with a positive argument; it drags the word behind the
+ 201/Page 13-2 NMODE Manual (Word Commands)
+
+
+ cursor backward over a word. An argument of zero, instead of doing
+ nothing, transposes the word at point (surrounding or adjacent to it) with
+ the word at mark. In any case, the delimiter characters between the words
+ do not move. For example, "FOO, BAR" transposes into "BAR, FOO" rather
+ than "BAR FOO,".
+
+ To operate on the next n words with an operation which applies between
+ point and mark, you can either set the mark at point and then move over the
+ words, or you can use the command Meta-@ (203/mark-word-command201/) which does
+ not move point, but sets the mark where Meta-F would move to. It can be
+ given arguments just like Meta-F.
+
+ 202/13.2 Sentence and Paragraph Commands
+
+ 201/The NMODE commands for manipulating sentences and paragraphs are mostly
+ Meta- commands, so as to resemble the word-handling commands.
+
+ M-A Move back to the beginning of the sentence.
+ M-E Move forward to the end of the sentence.
+ M-K Kill forward to the end of the sentence.
+ M-[ Move back to previous paragraph beginning.
+ M-] Move forward to next paragraph end.
+ M-H Put point and mark around this paragraph (around the
+ following one, if between paragraphs).
+ C-X Rubout Kill back to the beginning of the sentence.
+
+
+ 202/13.2.1 Sentences
+
+ 201/The commands Meta-A and Meta-E (203/backward-sentence-command 201/and
+ 203/forward-sentence-command201/) move to the beginning and end of the current
+ sentence, respectively. They were chosen to resemble Control-A and
+ Control-E, which move to the beginning and end of a line. Unlike them,
+ Meta-A and Meta-E if repeated or given numeric arguments move over
+ successive sentences. NMODE considers a sentence to end wherever there is
+ a ".", "?" or "!" followed by the end of a line or two spaces, with any
+ number of ")"'s, "]"'s, "'"'s, or '"' 's allowed in between. Neither M-A nor
+ M-E moves past the line separator or spaces which delimit the sentence.
+
+ Just as C-A and C-E have a kill command, C-K, to go with them, so M-A
+ and M-E have a corresponding kill command M-K (203/kill-sentence-command201/)
+ which kills from point to the end of the sentence. With minus one as an
+ argument it kills back to the beginning of the sentence. Larger arguments
+ serve as a repeat count.
+
+ There is a special command, C-X Rubout (203/backward-kill-sentence-command201/)
+ for killing back to the beginning of a sentence, because this is useful when
+ you change your mind in the middle of composing text. It also accepts
+ arguments, acting as C-U (minus argument given) M-K would.
+ 201/NMODE Manual (Paragraphs) Page 13-3
+
+
+ 202/13.2.2 Paragraphs
+
+ 201/Meta-[ (203/backward-paragraph-command201/) moves to the beginning of the
+ current or previous paragraph, while Meta-] (203/forward-paragraph-command201/)
+ moves to the end of the current or next paragraph. Blank lines and text
+ justifier command lines (text mode only for these!) separate paragraphs and
+ are not part of any paragraph. Also, an indented line starts a new
+ paragraph. (text mode only!)
+
+ A text justifier command line is part of no paragraph in text mode. A text
+ justifier command line is any line that begins with a period.
+
+ In major modes for programs (as opposed to Text mode), paragraphs are
+ determined only by blank lines. This makes the paragraph commands
+ continue to be useful even though there are no paragraphs per se.
+
+ When there is a fill prefix, then paragraphs are delimited by all lines which
+ don't start with the fill prefix. See Section 13.4 [Filling], page 4.
+
+ When you wish to operate on a paragraph, you can use the command Meta-H
+ (203/mark-paragraph-command201/) to set the region around it. This command puts
+ point at the beginning and mark at the end of the paragraph point was in.
+ Before setting the new mark at the end, a mark is set at the old location of
+ point; this allows you to undo a mistaken Meta-H with two C-U C-@'s. If
+ point is between paragraphs (in a run of blank lines, or at a boundary), the
+ paragraph following point is surrounded by point and mark. Thus, for
+ example, Meta-H C-W kills the paragraph around or after point.
+
+ 202/13.3 Indentation Commands for Text
+
+ 201/Tab Indents "appropriately" in a mode-dependent fashion.
+ M-Tab Inserts a tab character.
+ Linefeed Is the same as Return followed by Tab.
+ M-^ Undoes a Linefeed. Merges two lines.
+ M-M Moves to the line's first nonblank character.
+ M-I Indent to tab stop. In Text mode, Tab does this also.
+ C-M-\ Indent several lines to same column.
+
+ The way to request indentation is with the Tab command. Its precise effect
+ depends on the major mode. In Text mode, it runs 203/tab-to-tab-stop-command201/,
+ which inserts a Tab character. If you are not in Text mode, this function
+ can be found on M-I anyway. You can also do this with M-Tab or C-Q Tab.
+
+ One also indent a group of lines to a known column by using C-M-\
+ (203/indent-region-command201/). This must be given a command argument. It will
+ then indent all the lines in the current region to the argument-the column.
+
+ For English text, usually only the first line of a paragraph should be
+ indented. So, in Text mode, new lines created by Auto Fill mode are not
+ indented. But sometimes you want to have an indented paragraph. This can
+ be done by setting fill prefix to the desired indentation.
+
+ To undo a line-break, whether done manually or by Auto Fill, use Meta-^
+ 201/Page 13-4 NMODE Manual (Indentation Commands for Text)
+
+
+ (203/delete-indentation-command201/) to delete the indentation at the front of the
+ current line, and the line boundary as well. They are replaced by a single
+ space, or by no space if before a ")" or after a "(", or at the beginning of a
+ line. To delete just the indentation of a line, go to the beginning of the line
+ and use Meta-\ (203/delete-horizontal-space-command201/), which deletes all spaces
+ and tabs around the cursor.
+
+ To insert an indented line before the current line, do C-A, C-O, and then
+ Tab. To make an indented line after the current line, use C-E Linefeed.
+
+ To move over the indentation on a line, do Meta-M or C-M-M
+ (203/back-to-indentation-command201/). These commands, given anywhere on a line,
+ position the cursor at the first nonblank character on the line.
+
+ 202/13.4 Text Filling
+
+ 201/Space in Auto Fill mode, breaks lines when appropriate.
+ M-Q Fill paragraph.
+ M-G Fill region (G is for Grind, by analogy with Lisp).
+ M-S Center a line.
+ C-X = Show current cursor position.
+
+ Auto Fill mode lets you type in text that is 202/filled 201/(broken up into lines that
+ fit in a specified width) as you go. If you alter existing text and thus cause
+ it to cease to be properly filled, NMODE can fill it again if you ask.
+
+ Entering Auto Fill mode is done with M-X Auto Fill
+ (203/auto-fill-mode-command201/). From then on, lines are broken automatically at
+ spaces when they get longer than the desired width. To leave Auto Fill mode,
+ execute M-X Auto Fill again. When Auto Fill mode is in effect, the word
+ "Fill" appears in the mode line.
+
+ When you finish a paragraph, you can type Space with an argument of
+ zero. This doesn't insert any spaces, but it does move the last word of the
+ paragraph to a new line if it doesn't fit in the old line. Return also moves
+ the last word, but it may create another blank line.
+
+ If you edit the middle of a paragraph, it may no longer be correctly filled.
+ To refill a paragraph, use the command Meta-Q (203/fill-paragraph-command201/). It
+ causes the paragraph that point is inside, or the one after point if point is
+ between paragraphs, to be refilled. All the line-breaks are removed, and
+ then new ones are inserted where necessary.
+
+ If you are not happy with Meta-Q's idea of where paragraphs start and end
+ (the same as Meta-H's. See Section 13.2 [Paragraphs], page 2.), you can
+ use Meta-G (203/fill-region-command201/) which refills everything between point and
+ mark. Sometimes, it is ok to fill a region of several paragraphs at once.
+ Meta-G recognizes a blank line or (in text mode) an indented line as starting
+ a paragraph and does not fill it in with the preceding line. The purpose of
+ M-G is to allow you to override NMODE's usual criteria for paragraph
+ boundaries.
+
+ Giving an argument to M-G or M-Q causes the text to be 202/justified 201/as well as
+ 201/NMODE Manual (Text Filling) Page 13-5
+
+
+ filled. This means that extra spaces are inserted between the words so as to
+ make the right margin come out exactly even. I do not recommend doing
+ this. If someone else has uglified some text by justifying it, you can
+ unjustify it (remove the spaces) with M-G or M-Q without an argument.
+
+ The command Meta-S (203/center-line-command201/) centers a line within the
+ current line width. With an argument, it centers several lines individually
+ and moves past them. With a negative argument it centers lines above the
+ current one.
+
+ The maximum line width for filling is in the variable Fill-Column. Both M-Q
+ and Auto Fill make sure that no line exceeds this width. The easiest way to
+ set the variable is to use the command C-X F (203/set-fill-column-command201/),
+ which places the margin at the column point is on, or at the column specified
+ by a numeric argument. The fill column is initially column 70.
+
+ To fill a paragraph in which each line starts with a special marker (which
+ might be a few spaces, giving an indented paragraph), use the 202/fill prefix
+ 201/feature. Move point to a spot right after the special marker and give the
+ command C-X Period (203/set-fill-prefix-command201/). Then, filling the paragraph
+ will remove the marker from each line beforehand, perform the filling, and
+ put the marker back in on each line afterward. Auto Fill when there is a fill
+ prefix inserts the fill prefix at the front of each new line. Also, any line
+ which does not start with the fill prefix is considered to delimit a paragraph.
+ To turn off the fill prefix, do C-X Period with point at the front of a line.
+ The fill prefix is kept in the variable Fill-Prefix.
+
+ The command C-X = (203/what-cursor-position-command201/) can be used to find
+ out the column that the cursor is in, and other miscellaneous information
+ about point which is quick to compute. It prints a line in the echo area that
+ looks like this:
+
+ X=2 Y=19 CH=10 line=428 (74 percent of 574 lines)
+
+ In this line, the X value is the column the cursor is in (zero at the left), the
+ Y value is the screen line that the cursor is in (zero at the top), the CH
+ value is the ascii value of the character after point and the other values show
+ how large the buffer is and where the current line is in it.
+
+ 202/13.5 Case Conversion Commands
+
+ 201/NMODE has commands for converting either a single word or any arbitrary
+ range of text to upper case or to lower case.
+
+ M-L Convert following word to lower case.
+ M-U Convert following word to upper case.
+ M-C Capitalize the following word.
+ C-X C-L Convert region to lower case.
+ C-X C-U Convert region to upper case.
+
+ The word conversion commands are the most useful. Meta-L
+ (203/lowercase-word-command201/) converts the word after point to lower case,
+ moving past it. Thus, successive Meta-L's convert successive words.
+ 201/Page 13-6 NMODE Manual (Case Conversion Commands)
+
+
+ Meta-U (203/uppercase-word-command201/) converts to all capitals instead, while
+ Meta-C (203/uppercase-initial-command201/) puts the first letter of the word into
+ upper case and the rest into lower case. All these commands convert several
+ words at once if given an argument. They are especially convenient for
+ converting a large amount of text from all upper case to mixed case, because
+ you can move through the text using M-L, M-U or M-C on each word as
+ appropriate.
+
+ When given a negative argument, the word case conversion commands apply
+ to the appropriate number of words before point, but do not move point.
+ This is convenient when you have just typed a word in the wrong case. You
+ can give the case conversion command and continue typing.
+
+ If a word case conversion command is given in the middle of a word, it
+ applies only to the part of the word which follows the cursor, treating it as a
+ whole word.
+
+ The other case conversion commands are C-X C-U
+ (203/uppercase-region-command201/) and C-X C-L (203/lowercase-region-command201/), which
+ convert everything between point and mark to the specified case. Point and
+ mark do not move.
ADDED psl-1983/3-1/doc/nmode/nm-text.key
Index: psl-1983/3-1/doc/nmode/nm-text.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-text.key
@@ -0,0 +1,40 @@
+.silent_index {Tab} idx 13-1
+.silent_index {M-F} idx 13-1
+.silent_index {M-B} idx 13-1
+.silent_index {M-Backspace} idx 13-1
+.silent_index {M-D} idx 13-1
+.silent_index {M-T} idx 13-1
+.silent_index {M-@} idx 13-2
+.silent_index {M-A} idx 13-2
+.silent_index {M-E} idx 13-2
+.silent_index {C-A} idx 13-2
+.silent_index {C-E} idx 13-2
+.silent_index {C-K} idx 13-2
+.silent_index {M-K} idx 13-2
+.silent_index {C-X} idx 13-2
+.silent_index {M-[} idx 13-3
+.silent_index {M-]} idx 13-3
+.silent_index {C-W} idx 13-3
+.silent_index {C-U} idx 13-3
+.silent_index {M-H} idx 13-3
+.silent_index {Tab} idx 13-3
+.silent_index {M-Tab} idx 13-3
+.silent_index {C-Q} idx 13-3
+.silent_index {C-M-\} idx 13-3
+.silent_index {M-\} idx 13-3
+.silent_index {M-^} idx 13-3
+.silent_index {M-M} idx 13-4
+.silent_index {C-M-M} idx 13-4
+.silent_index {Space} idx 13-4
+.silent_index {M-Q} idx 13-4
+.silent_index {M-G} idx 13-4
+.silent_index {M-H} idx 13-4
+.silent_index {M-S} idx 13-5
+.silent_index {C-X} idx 13-5
+.silent_index {C-X} idx 13-5
+.silent_index {C-X} idx 13-5
+.silent_index {M-L} idx 13-5
+.silent_index {M-U} idx 13-5
+.silent_index {M-C} idx 13-5
+.silent_index {C-X} idx 13-6
+.silent_index {C-X} idx 13-6
ADDED psl-1983/3-1/doc/nmode/nm-text.r
Index: psl-1983/3-1/doc/nmode/nm-text.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-text.r
@@ -0,0 +1,469 @@
+.so pndoc:nman
+.part NM-TEXT manual
+@Chapter[Commands for English Text]
+@node("text")
+@manual{NMODE enables you to manipulate words, sentences, or
+paragraphs of text. In addition, there are commands to fill text,
+and convert case.
+}
+@fncindex{tab-to-tab-stop-command}
+@index{Text mode}
+@keyindex{Tab}
+@fncindex{text-mode-command}
+@index{parentheses}
+ Editing files of text in a human language ought to be done using
+Text mode. Invoke M-X Text Mode to enter
+Text mode. @Note("MajorModes" "Major Modes"). M-X Text Mode
+(@fnc{text-mode-command})
+causes Tab to run the function @fnc{tab-to-tab-stop-command}.
+Automatic display of
+parenthesis matching is turned off, which is what most people want.
+@Section[Word Commands]
+@node("words")
+@index{words}
+@index{Meta}
+ NMODE has commands for moving over or operating on words. By
+convention, they are all Meta- characters.
+@WideCommands[
+M-F Move Forward over a word.
+
+M-B Move Backward over a word.
+
+M-D Kill up to the end of a word.
+
+M-Backspace Kill back to the beginning of a word.
+
+M-@ Mark the end of the next word.
+
+M-T Transpose two words; drag a word forward
+or backward across other words.
+]
+ Notice how these commands form a group that parallels the character
+based commands C-F, C-B, C-D, C-T and Backspace. M-@ is related to C-@.
+
+@index{motion}
+@keyindex{M-F}
+@keyindex{M-B}
+@fncindex{move-forward-word-command}
+@fncindex{move-backward-word-command}
+ The commands Meta-F (@fnc{move-forward-word-command}) and Meta-B
+(@fnc{move-backward-word-command}) move forward and
+backward over words. They are thus analogous
+to Control-F and Control-B, which move over single characters. Like
+their Control- equivalents, Meta-F and Meta-B move several words if
+given an argument. Meta-F with a negative argument moves backward
+like Meta-B, and Meta-B with a negative argument moves forward.
+Forward motion stops right after the last letter of the word, while
+backward motion stops right before the first letter.
+
+@index{killing}
+@keyindex{M-Backspace}
+@keyindex{M-D}
+@fncindex{kill-forward-word-command}
+@fncindex{kill-backward-word-command}
+ It is easy to kill a word at a time. Meta-D
+(@fnc{kill-forward-word-command}) kills the word after point. To be
+precise, it kills everything from point to the place Meta-F would move
+to. Thus, if point is in the middle of a word, only the part after
+point is killed. If some punctuation occurs between point and the end
+of the next word it will be killed. If you wish to kill only the next
+word but not the punctuation, simply do Meta-F to get the end, and
+kill the word backwards with Meta-Backspace. Meta-D takes arguments
+just like Meta-F.
+
+ Meta-Backspace (@fnc{kill-backward-word-command}) kills the word before point.
+It kills everything from point back to where Meta-B would move to. If
+point is after the space in @w["FOO, BAR"], then @w["FOO, "] is
+killed. If you wish to kill just "FOO", then do
+a Meta-B and a Meta-D instead of a Meta-Backspace.
+
+@index{transposition}
+@index{numeric arguments}
+@keyindex{M-T}
+@fncindex{transpose-words}
+ Meta-T (@fnc{transpose-words}) moves the cursor forward over a
+word, dragging the word preceding or containing the cursor forward as
+well. A numeric argument serves as a repeat count. Meta-T with a
+negative argument undoes the effect of Meta-T with a positive
+argument; it drags the word behind the cursor backward over a word.
+An argument of zero, instead of doing nothing, transposes the word at
+point (surrounding or adjacent to it) with the word at mark. In any
+case, the delimiter characters between the words do not move. For
+example, @w["FOO, BAR"] transposes into @w["BAR, FOO"] rather than
+@w["BAR FOO,"].
+
+@index{mark}
+@keyindex{M-@}
+@fncindex{mark-word-command}
+ To operate on the next n words with an operation which applies
+between point and mark, you can either set the mark at point and then
+move over the words, or you can use the
+command Meta-@ (@fnc{mark-word-command})
+which does not move point, but sets the mark where Meta-F would move
+to. It can be given arguments just like Meta-F.
+@Section[Sentence and Paragraph Commands]
+@node("sentences")
+@index{sentences}
+@index{paragraphs}
+ The NMODE commands for manipulating sentences and paragraphs are mostly
+Meta- commands, so as to resemble the word-handling commands.
+@Commands{
+M-A Move back to the beginning of the sentence.
+
+M-E Move forward to the end of the sentence.
+
+M-K Kill forward to the end of the sentence.
+
+M-[ Move back to previous paragraph beginning.
+
+M-] Move forward to next paragraph end.
+
+M-H Put point and mark around this paragraph
+(around the following one, if between paragraphs).
+
+C-X Rubout Kill back to the beginning of the sentence.
+}
+@SubSection[Sentences]
+@index{motion}
+@keyindex{M-A}
+@keyindex{M-E}
+@fncindex{backward-sentence-command}
+@fncindex{forward-sentence-command}
+ The commands Meta-A and Meta-E (@fnc{backward-sentence-command} and
+@fnc{forward-sentence-command}) move to the beginning and end of the current
+sentence, respectively. They were chosen to resemble Control-A and
+Control-E, which move to the beginning and end of a line. Unlike
+them, Meta-A and Meta-E if repeated or given numeric arguments move
+over successive sentences. NMODE considers a sentence to end wherever
+there is a ".", "?" or "!" followed by the end of a line or two
+spaces, with any number of ")"'s, "]"'s, "'"'s, or '"' 's allowed in
+between. Neither M-A nor M-E moves past the line separator or spaces which
+delimit the sentence.
+
+@keyindex{C-A}
+@keyindex{C-E}
+@keyindex{C-K}
+@index{killing}
+@keyindex{M-K}
+@keyindex{C-X Rubout}
+@fncindex{kill-sentence-command}
+@fncindex{backward-kill-sentence-command}
+ Just as C-A and C-E have a kill command, C-K, to go with them, so
+M-A and M-E have a corresponding kill command M-K (@fnc{kill-sentence-command})
+which kills from point to the end of the sentence. With minus one as
+an argument it kills back to the beginning of the sentence. Larger
+arguments serve as a repeat count.
+
+ There is a special command, C-X Rubout (@fnc{backward-kill-sentence-command})
+for killing back to the beginning of a sentence, because this is
+useful when you change your mind in the middle of composing text.
+It also accepts arguments, acting as C-U (minus argument given) M-K would.
+@SubSection[Paragraphs]
+@keyindex{M-[}
+@keyindex{M-]}
+@fncindex{backward-paragraph-command}
+@fncindex{forward-paragraph-command}
+ Meta-[ (@fnc{backward-paragraph-command}) moves to the beginning of the
+current or previous paragraph, while Meta-] (@fnc{forward-paragraph-command})
+moves to the end of the current or next paragraph. Blank lines and
+text justifier command lines (text mode only for these!)
+separate paragraphs and are not part of
+any paragraph. Also, an indented line starts a new paragraph. (text mode only!)
+
+@index{Paragraph Delimiter}
+A text justifier command line is part of no paragraph in text mode.
+A text justifier command line is any line that begins with a period.
+
+@index{blank lines}
+ In major modes for programs (as opposed to Text mode), paragraphs
+are determined only by blank lines. This makes the paragraph commands
+continue to be useful even though there are no paragraphs per se.
+
+@index{fill-prefix}
+ When there is a fill prefix, then paragraphs are delimited by all
+lines which don't start with the fill prefix. @Note("Filling").
+
+@index{Region}
+@index{mark}
+@keyindex{C-W}
+@keyindex{C-U C-@}
+@keyindex{M-H}
+@fncindex{mark-paragraph-command}
+ When you wish to operate on a paragraph, you can use the command
+Meta-H (@fnc{mark-paragraph-command}) to set the region around it. This
+command puts point at the beginning and mark at the end of the
+paragraph point was in. Before setting the new mark at the end, a
+mark is set at the old location of point; this allows you to undo a
+mistaken Meta-H with two C-U C-@'s. If point is between paragraphs
+(in a run of blank lines, or at a boundary), the paragraph following
+point is surrounded by point and mark. Thus, for example, Meta-H C-W
+kills the paragraph around or after point.
+@Section[Indentation Commands for Text]
+@node("textindent")
+@index{indentation}
+@index{formatting}
+@WideCommands[
+Tab Indents "appropriately" in a mode-dependent fashion.
+
+M-Tab Inserts a tab character.
+
+Linefeed Is the same as @Return3{} followed by Tab.
+
+M-^ Undoes a Linefeed. Merges two lines.
+
+M-M Moves to the line's first nonblank character.
+
+M-I Indent to tab stop. In Text mode, Tab does this also.
+
+C-M-\ Indent several lines to same column.
+
+ C-X Tab Shift block of lines rigidly right or left.
+]
+@keyindex{Tab}
+@index{Linefeed}
+@fncindex{tab-to-tab-stop-command}
+@keyindex{M-Tab}
+@keyindex{C-Q}
+ The way to request indentation is with the Tab command. Its precise
+effect depends on the major mode. In Text mode, it runs
+@fnc{tab-to-tab-stop-command}, which inserts a Tab character.
+If you are not in Text mode, this function can be found on M-I anyway.
+You can also do this with M-Tab or C-Q Tab.
+
+@keyindex{C-M-\}
+@fncindex{indent-region-command}
+ One also indent a group of lines to a known column by using C-M-\
+(@fnc{indent-region-command}). This must be given a command argument.
+It will then indent all the lines in the current region to the
+argument-the column.
+
+@index{Auto Fill Mode}
+ For English text, usually only the first line of a paragraph should
+be indented. So, in Text mode, new lines created by Auto Fill mode
+are not indented. But sometimes you want to have an indented paragraph.
+This can be done by setting fill prefix to the desired indentation.
+
+@keyindex{M-\}
+@keyindex{M-^}
+@fncindex{delete-horizontal-space-command}
+@fncindex{delete-indentation-command}
+ To undo a line-break, whether done manually or by Auto Fill, use
+Meta-^ (@fnc{delete-indentation-command}) to delete the indentation at
+the front of the current line, and the line boundary as well. They
+are replaced by a single space, or by no space if before a ")" or
+after a "(", or at the beginning of a line. To delete just the
+indentation of a line, go to the beginning of the line and use Meta-\
+(@fnc{delete-horizontal-space-command}), which deletes all
+spaces and tabs around the cursor.
+
+ To insert an indented line before the current line, do C-A, C-O, and
+then Tab.
+To make an indented line after the current line, use C-E Linefeed.
+
+@keyindex{M-M}
+@keyindex{C-M-M}
+@fncindex{back-to-indentation-command}
+ To move over the indentation on a line, do Meta-M or
+C-M-M (@fnc{back-to-indentation-command}).
+These commands, given anywhere on a line,
+position the cursor at the first nonblank character on the line.
+ @index{numeric arguments}
+ @index{C-M-\}
+ @index{C-X Tab}
+ @fncindex{indent region}
+ @fncindex{indent rigidly}
+ There are also commands for changing the indentation of several
+ lines at once. Control-Meta-\ (@fnc{indent region}) gives each line
+ which begins in the region the "usual" indentation by invoking Tab at
+ the beginning of the line. A numeric argument specifies the
+ indentation, and each line is shifted left or right so that it has
+ exactly that much. C-X Tab (@fnc{indent
+ rigidly}) moves all of the lines in the region right by its argument
+ (left, for negative arguments). The whole group of lines move rigidly
+ sideways, which is how the command gets its name.
+ @Index{Tabify}
+ @Index{Untabify}
+ To convert all tabs in a file to spaces, you can use M-X Untabify.
+ M-X Tabify performs the opposite transformation, replacing spaces with
+ tabs whenever possible, but only if there are at least three of them
+ so as not to obscure ends of sentences. A numeric argument to Tabify
+ or Untabify specifies the interval between tab stops to use for
+ computing how to change the file. By default, they use the same
+ interval being used for display. The visual appearance of the text
+ should never be changed by Tabify or Untabify without a numeric
+ argument.
+@Section[Text Filling]
+@node("filling")
+@index{filling}
+@Commands[
+Space in Auto Fill mode, breaks lines when appropriate.
+
+M-Q Fill paragraph.
+
+M-G Fill region (G is for Grind, by analogy with Lisp).
+
+M-S Center a line.
+
+C-X = Show current cursor position.
+]
+@index{Auto Fill Mode}
+@keyindex{Space}
+ Auto Fill mode lets you type in text that is @dfn[filled] (broken
+up into lines that fit in a specified width) as you go. If you
+alter existing text and thus cause it to cease to be properly filled,
+NMODE can fill it again if you ask.
+
+@fncindex{auto-fill-mode-command}
+ Entering Auto Fill mode is done with M-X Auto Fill
+(@fnc{auto-fill-mode-command}).
+From then on,
+lines are broken automatically at spaces when they get longer than the
+desired width.
+To leave Auto Fill mode, execute M-X
+Auto Fill again. When Auto Fill mode is in effect, the word "Fill"
+appears in the mode line.
+
+@index{numeric arguments}
+ When you finish a paragraph, you can type Space with an argument of
+zero. This doesn't insert any spaces, but it does move the last word
+of the paragraph to a new line if it doesn't fit in the old line.
+@Return3{} also moves the last word, but it may create another blank line.
+
+@keyindex{M-Q}
+@index{paragraphs}
+@keyindex{M-G}
+@fncindex{fill-region-command}
+@fncindex{fill-paragraph-command}
+ If you edit the middle of a paragraph, it may no longer be correctly
+filled. To refill a paragraph, use the command Meta-Q
+(@fnc{fill-paragraph-command}).
+It causes the paragraph that point is inside, or the one
+after point if point is between paragraphs, to be refilled. All the
+line-breaks are removed, and then new ones are inserted where
+necessary.
+
+@keyindex{M-H}
+ If you are not happy with Meta-Q's idea of where paragraphs start
+and end (the same as Meta-H's.
+@note("Sentences" "Paragraphs").),
+you can use Meta-G (@fnc{fill-region-command}) which
+refills everything between point and mark. Sometimes, it is ok to
+fill a region of several paragraphs at once. Meta-G recognizes a
+blank line or (in text mode) an indented
+line as starting a paragraph and does not fill it
+in with the preceding line. The purpose of M-G is to allow you to
+override NMODE's usual criteria for paragraph boundaries.
+
+@index{justification}
+ Giving an argument to M-G or M-Q causes the text to be @dfn[justified]
+as well as filled. This means that extra spaces are inserted
+between the words so as to make the right margin come out exactly
+even. I do not recommend doing this. If someone else has uglified
+some text by justifying it, you can unjustify it (remove the spaces)
+with M-G or M-Q without an argument.
+
+@keyindex{M-S}
+@index{centering}
+@fncindex{center-line-command}
+ The command Meta-S (@fnc{center-line-command}) centers a line within the
+current line width. With an argument, it centers several lines
+individually and moves past them.
+With a negative argument it centers lines above the current one.
+
+@index{Fill Column}
+@keyindex{C-X F}
+@fncindex{set-fill-column-command}
+ The maximum line width for filling is in the variable Fill-Column.
+Both M-Q and Auto Fill make sure that no line exceeds this width. The
+easiest way to set the variable is to use the command C-X F
+(@fnc{set-fill-column-command}),
+which places the margin at the column point is on, or at
+the column specified by a numeric argument. The fill column is
+initially column 70.
+
+@index{Fill Prefix}
+@keyindex{C-X .}
+@fncindex{set-fill-prefix-command}
+ To fill a paragraph in which each line starts with a special marker
+(which might be a few spaces, giving an indented paragraph), use the
+@dfn[fill prefix] feature. Move point to a spot right after the
+special marker and give the command @w[C-X Period]
+(@fnc{set-fill-prefix-command}). Then,
+filling the paragraph will remove the marker from each line
+beforehand, perform the filling,
+and put the marker back in on each line afterward. Auto
+Fill when there is a fill prefix inserts the fill prefix at the
+front of each new line. Also, any line which does not start with the
+fill prefix is considered to delimit a paragraph. To turn off the
+fill prefix, do C-X Period with point at the front of a line.
+The fill prefix is kept in the variable Fill-Prefix.
+
+@keyindex{C-X =}
+@index{echo area}
+@fncindex{what-cursor-position-command}
+ The command @w[C-X =] (@fnc{what-cursor-position-command})
+can be used to find out the
+column that the cursor is in, and other miscellaneous information
+about point which is quick to compute. It prints a line in the
+echo area that looks like this:
+@example[
+X=2 Y=19 CH=10 line=428 (74 percent of 574 lines)
+]
+In this line, the X value is the column the cursor is in (zero at
+the left), the Y value is the screen line that the cursor is in (zero
+at the top), the CH value is the ascii value of the character after
+point and the other values show how large the buffer is and where the
+current line is in it.
+@Section[Case Conversion Commands]
+@node("case")
+@index{case conversion}
+ NMODE has commands for converting either a single word or any
+arbitrary range of text to upper case or to lower case.
+@WideCommands[
+M-L Convert following word to lower case.
+
+M-U Convert following word to upper case.
+
+M-C Capitalize the following word.
+
+C-X C-L Convert region to lower case.
+
+C-X C-U Convert region to upper case.
+]
+@keyindex{M-L}
+@keyindex{M-U}
+@keyindex{M-C}
+@index{words}
+@fncindex{lowercase-word-command}
+@fncindex{uppercase-word-command}
+@fncindex{uppercase-initial-command}
+ The word conversion commands are the most useful. Meta-L
+(@fnc{lowercase-word-command}) converts the word after point to lower case,
+moving past it. Thus, successive Meta-L's convert successive
+words. Meta-U (@fnc{uppercase-word-command}) converts to all capitals instead,
+while Meta-C (@fnc{uppercase-initial-command}) puts the first letter of the word
+into upper case and the rest into lower case. All these commands
+convert several words at once if given an argument. They are
+especially convenient for converting a large amount of text from all
+upper case to mixed case, because you can move through the text
+using M-L, M-U or M-C on each word as appropriate.
+
+@index{numeric arguments}
+ When given a negative argument, the word case conversion commands
+apply to the appropriate number of words before point, but do not move
+point. This is convenient when you have just typed a word in the
+wrong case. You can give the case conversion command and continue
+typing.
+
+ If a word case conversion command is given in the middle of a
+word, it applies only to the part of the word which follows the
+cursor, treating it as a whole word.
+
+@keyindex{C-X C-L}
+@keyindex{C-X C-U}
+@index{Region}
+@fncindex{lowercase-region-command}
+@fncindex{uppercase-region-command}
+ The other case conversion commands are C-X C-U (@fnc{uppercase-region-command})
+and C-X C-L (@fnc{lowercase-region-command}), which convert everything between
+point and mark to the specified case. Point and mark do not move.
ADDED psl-1983/3-1/doc/nmode/nm-text.topic
Index: psl-1983/3-1/doc/nmode/nm-text.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-text.topic
@@ -0,0 +1,35 @@
+.silent_index {Text} idx 13-1
+.silent_index {parentheses} idx 13-1
+.silent_index {words} idx 13-1
+.silent_index {Meta} idx 13-1
+.silent_index {motion} idx 13-1
+.silent_index {killing} idx 13-1
+.silent_index {transposition} idx 13-1
+.silent_index {numeric} idx 13-1
+.silent_index {mark} idx 13-2
+.silent_index {sentences} idx 13-2
+.silent_index {paragraphs} idx 13-2
+.silent_index {motion} idx 13-2
+.silent_index {killing} idx 13-2
+.silent_index {Paragraph} idx 13-3
+.silent_index {blank} idx 13-3
+.silent_index {fill-prefix} idx 13-3
+.silent_index {Region} idx 13-3
+.silent_index {mark} idx 13-3
+.silent_index {indentation} idx 13-3
+.silent_index {formatting} idx 13-3
+.silent_index {Linefeed} idx 13-3
+.silent_index {Auto} idx 13-3
+.silent_index {filling} idx 13-4
+.silent_index {Auto} idx 13-4
+.silent_index {numeric} idx 13-4
+.silent_index {paragraphs} idx 13-4
+.silent_index {justification} idx 13-4
+.silent_index {centering} idx 13-5
+.silent_index {Fill} idx 13-5
+.silent_index {Fill} idx 13-5
+.silent_index {echo} idx 13-5
+.silent_index {case} idx 13-5
+.silent_index {words} idx 13-5
+.silent_index {numeric} idx 13-6
+.silent_index {Region} idx 13-6
ADDED psl-1983/3-1/doc/nmode/nm-top-index.contents
Index: psl-1983/3-1/doc/nmode/nm-top-index.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-top-index.contents
@@ -0,0 +1,1 @@
+contents_entry(0 30 {Topic Index} 30-1)
ADDED psl-1983/3-1/doc/nmode/nm-top-index.ibm
Index: psl-1983/3-1/doc/nmode/nm-top-index.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-top-index.ibm
@@ -0,0 +1,242 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-TOP-INDEX.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Topic Index) Page 30-1
+
+
+ 202/30. Topic Index
+
+ 201/<CR> . . . . . . . . . . . . . . 3-2, 3-3
+ <CR> . . . . . . . . . . . . . . 4-1
+ <CR>, . . . . . . . . . . . . . . 3-3
+
+ ! . . . . . . . . . . . . . . . . 4-1, 19-1
+
+ . . . . . . . . . . . . . . . . . 19-1
+
+ Alter Display Format . . . . . . . 24-1, 27-10, 27-14, 27-30, 27-31, 27-33,
+ 27-34, 27-35, 27-40, 27-42, 27-43
+ Alter Existing Text . . . . . . . 24-1, 27-6, 27-12, 27-22, 27-32, 27-33,
+ 27-39, 27-40, 27-41, 27-42
+ ASCII . . . . . . . . . . . . . . 3-1, 3-3
+ Auto . . . . . . . . . . . . . . . 2-1, 13-3, 13-4, 20-3, 22-5
+
+ Backspace . . . . . . . . . . . . 3-3, 4-1, 4-2, 6-1, 11-1, 14-1, 20-3
+ blank . . . . . . . . . . . . . . 4-3, 11-2, 13-3, 20-3
+ buffers . . . . . . . . . . . . . 2-1, 16-1, 18-2, 18-3
+ Buffers . . . . . . . . . . . . . 27-2, 27-5, 27-10, 27-13, 27-15, 27-17,
+ 27-19, 27-32, 27-34, 27-35, 27-36, 27-43
+ Bugs . . . . . . . . . . . . . . 23-1
+
+ C- . . . . . . . . . . . . . . . . 7-2
+ C-X . . . . . . . . . . . . . . . 7-2
+ C-Z . . . . . . . . . . . . . . . 3-2
+ caret . . . . . . . . . . . . . . 3-3
+ Case . . . . . . . . . . . . . . . 12-2
+ case . . . . . . . . . . . . . . . 13-5, 14-2
+ centering . . . . . . . . . . . . 13-5
+ Change Mode . . . . . . . . . . . 24-1, 27-3, 27-21, 27-38, 27-39
+ character . . . . . . . . . . . . 3-1, 22-1
+ clear . . . . . . . . . . . . . . . 17-1
+ Comma . . . . . . . . . . . . . . 19-1
+ command . . . . . . . . . . . . . 6-1
+ commands . . . . . . . . . . . . 6-1, 22-2
+ comments . . . . . . . . . . . . 20-1, 20-3, 20-4
+ confirmation . . . . . . . . . . . 15-3
+ Connected . . . . . . . . . . . . 3-2, 6-2
+ control . . . . . . . . . . . . . . 3-1, 3-3
+ Control . . . . . . . . . . . . . 3-3, 4-1
+ control . . . . . . . . . . . . . . 22-1
+ Control-Meta . . . . . . . . . . . 20-4
+ Create . . . . . . . . . . . . . . 15-1
+ CRLF . . . . . . . . . . . . . . 3-3, 4-1
+ cursor . . . . . . . . . . . . . . 2-1, 4-1
+ Customization . . . . . . . . . . 3-2
+ customization . . . . . . . . . . . 6-2, 22-1
+ 201/Page 30-2 NMODE Manual (Topic Index)
+
+
+ Defun . . . . . . . . . . . . . . 25-1, 27-10, 27-11, 27-23, 27-25
+ Defuns . . . . . . . . . . . . . . 10-2, 20-5
+ Delete . . . . . . . . . . . . . . 15-4
+ deletion . . . . . . . . . . . . . 4-1, 11-1, 14-1, 19-1
+ directory . . . . . . . . . . . . 15-3
+ DIRED . . . . . . . . . . . . . . 15-2
+ Drastic . . . . . . . . . . . . . 15-2
+
+ echo . . . . . . . . . . . . . . . 2-1, 6-1, 13-5
+ Escape . . . . . . . . . . . . . . 24-1, 27-11, 27-19, 27-20, 27-21, 27-29
+ exiting . . . . . . . . . . . . . . 7-2
+ extended . . . . . . . . . . . . . 6-1, 22-2
+
+ file . . . . . . . . . . . . . . . 15-2
+ files . . . . . . . . . . . . . . . 2-2, 4-3, 15-1, 15-2, 15-3, 18-3
+ Files . . . . . . . . . . . . . . . 27-2, 27-6, 27-7, 27-11, 27-13, 27-16,
+ 27-31, 27-33, 27-34, 27-37, 27-41, 27-42,
+ 27-43, 27-44
+ Fill . . . . . . . . . . . . . . . 13-5, 22-4, 22-5
+ Fill Column . . . . . . . . . . . 26-1, 27-6, 27-12, 27-36
+ Fill Prefix . . . . . . . . . . . . 26-1, 27-12, 27-36
+ fill-prefix . . . . . . . . . . . . 13-3
+ filling . . . . . . . . . . . . . . 13-4
+ Find . . . . . . . . . . . . . . . 16-1
+ formatting . . . . . . . . . . . . 13-3, 20-6
+ forms . . . . . . . . . . . . . . 20-3
+ Functions . . . . . . . . . . . . 3-2
+ functions . . . . . . . . . . . . 6-1
+ Functions . . . . . . . . . . . . 6-2
+ functions . . . . . . . . . . . . 22-2
+
+ Goal Column . . . . . . . . . . . 26-1, 27-26, 27-29
+ grinding . . . . . . . . . . . . . 20-6
+
+ indentation . . . . . . . . . . . . 13-3, 20-1, 20-6
+ Inform . . . . . . . . . . . . . . 24-1, 27-2, 27-5, 27-6, 27-14, 27-19,
+ 27-20, 27-43
+ init . . . . . . . . . . . . . . . 22-1
+ Insert Constant . . . . . . . . . 24-1, 27-15, 27-16, 27-23, 27-31, 27-33,
+ 27-37, 27-39
+ insertion . . . . . . . . . . . . . 4-1, 15-3
+
+ justification . . . . . . . . . . . 13-4
+
+ kill . . . . . . . . . . . . . . . 11-2
+ Kill . . . . . . . . . . . . . . . 16-2
+ Kill Ring . . . . . . . . . . . . . 26-1, 27-2, 27-4, 27-6, 27-8, 27-16,
+ 27-17, 27-18, 27-19, 27-41
+ killing . . . . . . . . . . . . . . 11-1, 11-2, 13-1, 13-2, 14-1, 20-4
+ 201/NMODE Manual (Topic Index) Page 30-3
+
+
+ line . . . . . . . . . . . . . . . 3-3, 4-1
+ Linefeed . . . . . . . . . . . . . 13-3, 20-2, 20-6
+ Linefeed, . . . . . . . . . . . . 3-3
+ lines . . . . . . . . . . . . . . . 11-1
+ Lisp . . . . . . . . . . . . . . . 20-1, 20-3, 27-5, 27-9, 27-10, 27-11,
+ 27-13, 27-15, 27-16, 27-17, 27-18, 27-19,
+ 27-20, 27-21, 27-22, 27-23, 27-24, 27-25,
+ 27-27, 27-33, 27-39, 27-44
+ List . . . . . . . . . . . . . . . 16-2
+ lists . . . . . . . . . . . . . . . 10-2
+ Lists . . . . . . . . . . . . . . . 20-3
+
+ M-X . . . . . . . . . . . . . . . 20-1
+ major . . . . . . . . . . . . . . 2-1
+ Major . . . . . . . . . . . . . . 16-1
+ major . . . . . . . . . . . . . . 20-1
+ mark . . . . . . . . . . . . . . . 10-1, 11-2, 11-3, 13-2, 13-3, 15-4, 20-5
+ Mark . . . . . . . . . . . . . . . 24-2, 27-10, 27-11, 27-14, 27-16, 27-23,
+ 27-24, 27-37
+ matching . . . . . . . . . . . . . 20-2
+ meta . . . . . . . . . . . . . . . 3-1
+ Meta . . . . . . . . . . . . . . . 13-1
+ meta . . . . . . . . . . . . . . . 22-1
+ Metizer . . . . . . . . . . . . . 3-2
+ minor . . . . . . . . . . . . . . 2-1, 22-4
+ mode . . . . . . . . . . . . . . . 2-1
+ Mode . . . . . . . . . . . . . . . 7-1
+ mode . . . . . . . . . . . . . . . 16-1, 22-4
+ motion . . . . . . . . . . . . . . 13-1, 13-2, 20-4, 20-5
+ Move Data . . . . . . . . . . . . 24-2, 27-2, 27-13, 27-14, 27-15, 27-16,
+ 27-17, 27-31, 27-41, 27-42, 27-44
+ Move Point . . . . . . . . . . . . 24-2, 27-4, 27-5, 27-9, 27-10, 27-13,
+ 27-14, 27-24, 27-25, 27-26, 27-27, 27-28,
+ 27-29, 27-31, 27-33, 27-35, 27-36, 27-42,
+ 27-43
+ moving . . . . . . . . . . . . . . 11-2
+
+ nmode-default-mode . . . . . . . 16-1
+ NMODE.VARS . . . . . . . . . . 22-4
+ numeric . . . . . . . . . . . . . 5-1, 11-2, 11-4, 13-1, 13-4, 13-6, 17-1,
+ 18-2, 20-6, 22-4
+
+ options . . . . . . . . . . . . . 22-4
+ OUTPUT . . . . . . . . . . . . . 18-1
+
+ pages . . . . . . . . . . . . . . 10-2
+ Paragraph . . . . . . . . . . . . 13-3, 25-1, 27-4, 27-12, 27-13, 27-24
+ paragraphs . . . . . . . . . . . 10-2, 13-2, 13-4
+ Paragraphs . . . . . . . . . . . 20-3
+ parentheses . . . . . . . . . . . 13-1, 20-2
+ Point . . . . . . . . . . . . . . 2-1
+ point . . . . . . . . . . . . . . 4-1
+ prefix . . . . . . . . . . . . . . 3-2, 22-2
+ 201/Page 30-4 NMODE Manual (Topic Index)
+
+
+ Preserve . . . . . . . . . . . . . 24-2, 27-6, 27-32, 27-34, 27-41, 27-43,
+ 27-44
+ printing . . . . . . . . . . . . . 4-1
+ prompting . . . . . . . . . . . . 2-1, 6-1
+
+ Query . . . . . . . . . . . . . . 19-1
+ quitting . . . . . . . . . . . . . 12-2, 23-1
+ Quoting . . . . . . . . . . . . . 4-1
+
+ Read . . . . . . . . . . . . . . . 6-1
+ Recursive . . . . . . . . . . . . 7-1
+ recursive . . . . . . . . . . . . 15-2, 16-2
+ redefining . . . . . . . . . . . . 22-1
+ Region . . . . . . . . . . . . . . 10-1, 11-2, 11-3, 13-3, 13-6, 15-4, 20-5,
+ 20-7, 25-1, 27-2, 27-6, 27-18, 27-22,
+ 27-31, 27-40, 27-41, 27-42, 27-43
+ registers . . . . . . . . . . . . . 11-5
+ Remove . . . . . . . . . . . . . 24-2, 27-4, 27-6, 27-7, 27-8, 27-17,
+ 27-18, 27-19, 27-33
+ Rename . . . . . . . . . . . . . 16-2
+ Replace . . . . . . . . . . . . . 19-1
+ replacement . . . . . . . . . . . 19-1
+ return3{} . . . . . . . . . . . . 6-1
+ Rubout . . . . . . . . . . . . . 19-1
+
+ Save . . . . . . . . . . . . . . . 16-2
+ saving . . . . . . . . . . . . . . 15-1
+ screen . . . . . . . . . . . . . . 2-1, 17-1
+ scrolling . . . . . . . . . . . . . 17-1
+ Scrolling . . . . . . . . . . . . . 17-2
+ scrolling . . . . . . . . . . . . . 18-2
+ searching . . . . . . . . . . . . 12-1, 19-1
+ Select . . . . . . . . . . . . . . 16-1, 24-2, 27-8, 27-14, 27-32, 27-33
+ Sentence . . . . . . . . . . . . . 25-1, 27-4, 27-12, 27-13, 27-19
+ sentences . . . . . . . . . . . . 13-2, 14-1
+ Set . . . . . . . . . . . . . . . 15-1, 15-4
+ Set Global Variable . . . . . . . . 24-2, 27-5, 27-32, 27-36, 27-37
+ shifted-digits-association-list . . . 14-2
+ Space . . . . . . . . . . . . . . 6-1, 19-1
+ stop . . . . . . . . . . . . . . . 7-2
+ submode . . . . . . . . . . . . . 2-1
+ Subsequent Command Modifier . . 24-2, 27-3, 27-5, 27-10, 27-21, 27-22,
+ 27-29, 27-41
+ syntax . . . . . . . . . . . . . . 20-3
+
+ Text . . . . . . . . . . . . . . . 13-1, 27-6, 27-12, 27-13, 27-17, 27-18,
+ 27-19, 27-22, 27-24, 27-26, 27-27, 27-39,
+ 27-40, 27-42
+ toggling . . . . . . . . . . . . . 22-4
+ transposition . . . . . . . . . . . 13-1, 14-1, 20-5
+ two . . . . . . . . . . . . . . . 18-1
+ typos . . . . . . . . . . . . . . 14-1, 14-2
+ 201/NMODE Manual (Topic Index) Page 30-5
+
+
+ uparrow . . . . . . . . . . . . . 3-3
+
+ Variables . . . . . . . . . . . . 3-3
+ variables . . . . . . . . . . . . . 22-4
+ Visit . . . . . . . . . . . . . . . 15-1
+ visiting . . . . . . . . . . . . . 4-3, 15-1, 16-1, 18-3
+
+ windows . . . . . . . . . . . . . 18-1
+ words . . . . . . . . . . . . . . 10-2, 13-1, 13-5, 14-1, 14-2
+
+ ^ . . . . . . . . . . . . . . . . 3-3, 19-1
ADDED psl-1983/3-1/doc/nmode/nm-typos.contents
Index: psl-1983/3-1/doc/nmode/nm-typos.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-typos.contents
@@ -0,0 +1,4 @@
+contents_entry(0 14 {Commands for Fixing Typos} 14-1)
+contents_entry(1 14.1 {Killing Your Mistakes} 14-1)
+contents_entry(1 14.2 {Transposition} 14-1)
+contents_entry(1 14.3 {Case Conversion} 14-2)
ADDED psl-1983/3-1/doc/nmode/nm-typos.function
Index: psl-1983/3-1/doc/nmode/nm-typos.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-typos.function
@@ -0,0 +1,10 @@
+.silent_index {delete-backward-character-command} idx 14-1
+.silent_index {kill-backward-word-command} idx 14-1
+.silent_index {backward-kill-sentence-command} idx 14-1
+.silent_index {transpose-characters-command} idx 14-1
+.silent_index {transpose-lines} idx 14-2
+.silent_index {transpose-regions} idx 14-2
+.silent_index {lowercase-word-command} idx 14-2
+.silent_index {uppercase-word-command} idx 14-2
+.silent_index {uppercase-initial-command} idx 14-2
+.silent_index {upcase-digit-command} idx 14-2
ADDED psl-1983/3-1/doc/nmode/nm-typos.ibm
Index: psl-1983/3-1/doc/nmode/nm-typos.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-typos.ibm
@@ -0,0 +1,110 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-TYPOS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Commands for Fixing Typos) Page 14-1
+
+
+ 202/14. Commands for Fixing Typos
+
+ 201/In this section we describe the commands that are especially useful for the
+ times when you catch a mistake in your text just after you have made it, or
+ change your mind while composing text on line.
+
+ Backspace Delete last character.
+ M-Backspace Kill last word.
+ C-X Rubout Kill to beginning of sentence.
+ C-T Transpose two characters.
+ C-X C-T Transpose two lines.
+ C-X T Transpose two arbitrary regions.
+
+ The next three commands are just M-L, M-U and M-C with arguments of -1.
+ The argument could be entered with M-Minus, C-Minus, or C-U -1.
+
+ M-Minus M-L Convert last word to lower case.
+ M-Minus M-U Convert last word to all upper case.
+ M-Minus M-C Convert last word to lower case with capital initial.
+ M-' Fix up omitted shift key on digit.
+
+
+ 202/14.1 Killing Your Mistakes
+
+ 201/The Backspace command is the most important correction command. When
+ used among printing (self-inserting) characters, it can be thought of as
+ canceling the last character typed.
+
+ When your mistake is longer than a couple of characters, it might be more
+ convenient to use M-Backspace (203/kill-backward-word-command201/) or C-X Rubout
+ (203/backward-kill-sentence-command201/). M-Backspace kills back to the start of
+ the last word, and C-X Rubout kills back to the start of the last sentence.
+ C-X Rubout is particularly useful when you are thinking of what to write as
+ you type it, in case you change your mind about phrasing. M-Backspace
+ and C-X Rubout save the killed text for C-Y and M-Y to retrieve (See
+ Section 11.2 [Un-killing], page 2.).
+
+ M-Rubout is often useful even when you have typed only a few characters
+ wrong, if you know you are confused in your typing and aren't sure exactly
+ what you typed. At such a time, you cannot correct with Rubout except by
+ looking at the screen to see what you did. It requires less thought to kill
+ the whole word and start over again.
+
+ 202/14.2 Transposition
+
+ 201/The common error of transposing two characters can be fixed, when they
+ are adjacent, with the C-T command (203/transpose-characters-command201/).
+ Normally, C-T transposes the two characters on either side of the cursor.
+ When given at the end of a line, rather than transposing the last character of
+ the line with the line separator, which would be useless, C-T transposes the
+ last two characters on the line. So, if you catch your transposition error
+ right away, you can fix it with just a C-T. If you don't catch it so fast,
+ you must move the cursor back to between the two transposed characters. If
+ 201/Page 14-2 NMODE Manual (Transposition)
+
+
+ you transposed a space with the last character of the word before it, the
+ word motion commands are a good way of getting there. Otherwise, a reverse
+ search (C-R) is often the best way. See Section 12 [Search], page 1.
+
+ To transpose two lines, use the C-X C-T command (203/transpose-lines201/). M-T
+ transposes words and C-M-T transposes Lisp forms (in Lisp mode).
+
+ A more general transpose command is C-X T (203/transpose-regions201/). This
+ transposes two arbitrary blocks of text, which need not even be next to each
+ other. To use it, set the mark at one end of one of the blocks, then at the
+ other end of this block; then go to the other block and set the mark at one
+ end, and put point at the other. In other words, point and the last three
+ marks should be at the four locations which are the ends of the two blocks.
+ It does not matter which of the four locations point is at, or which order the
+ others were marked. C-X T transposes the two blocks of text thus
+ identified.
+
+ 202/14.3 Case Conversion
+
+ 201/A very common error is to type words in the wrong case. Because of this,
+ the word case-conversion commands M-L, M-U and M-C have a special feature
+ when used with a negative argument: they do not move the cursor. As soon
+ as you see you have mistyped the last word, you can simply case-convert it
+ and go on typing. See Section 13.5 [Case], page 5.
+
+ Another common error is to type a special character and miss the shift key,
+ producing a digit instead. There is a special command for fixing this: M-'
+ (203/upcase-digit-command201/), which fixes the last digit before point in this way
+ (but only if that digit appears on the current line or the previous line.
+ Otherwise, to minimize random effects of accidental use, M-' does nothing).
+ Once again, the cursor does not move, so you can use M-' when you notice
+ the error and immediately continue typing. Because M-' needs to know the
+ arrangement of your keyboard, the first time you use it you must supply the
+ information by typing the row of digits 1, 2, ... , 9, 0 but 203/holding down the
+ shift key201/. This tells M-' the correspondence between digits and special
+ characters, which is remembered for the duration of the NMODE in the
+ variable shifted-digits-association-list. This command is called M-' because its
+ main use is to replace "7" with a single-quote.
ADDED psl-1983/3-1/doc/nmode/nm-typos.key
Index: psl-1983/3-1/doc/nmode/nm-typos.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-typos.key
@@ -0,0 +1,12 @@
+.silent_index {M-Backspace} idx 14-1
+.silent_index {C-X} idx 14-1
+.silent_index {C-T} idx 14-1
+.silent_index {C-X} idx 14-2
+.silent_index {C-X} idx 14-2
+.silent_index {M--} idx 14-2
+.silent_index {M--} idx 14-2
+.silent_index {M--} idx 14-2
+.silent_index {M-L} idx 14-2
+.silent_index {M-U} idx 14-2
+.silent_index {M-C} idx 14-2
+.silent_index {M-'} idx 14-2
ADDED psl-1983/3-1/doc/nmode/nm-typos.r
Index: psl-1983/3-1/doc/nmode/nm-typos.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-typos.r
@@ -0,0 +1,139 @@
+.so pndoc:nman
+.part NM-TYPOS manual
+@Chapter[Commands for Fixing Typos]
+@node("fixit")
+@index{typos}
+ In this section we describe the commands that are especially
+useful for the times when you catch a mistake in your text just after
+you have made it, or change your mind while composing text on line.
+@DoubleWideCommands[
+Backspace Delete last character.
+
+M-Backspace Kill last word.
+
+C-X Rubout Kill to beginning of sentence.
+
+C-T Transpose two characters.
+
+C-X C-T Transpose two lines.
+
+C-X T Transpose two arbitrary regions.
+]
+The next three commands are just M-L, M-U and
+M-C with arguments of -1. The argument could be
+entered with M-Minus, C-Minus, or C-U -1.
+@DoubleWideCommands[
+M-Minus M-L Convert last word to lower case.
+
+M-Minus M-U Convert last word to all upper case.
+
+M-Minus M-C Convert last word to lower case with
+capital initial.
+
+M-' Fix up omitted shift key on digit.
+]
+@Section[Killing Your Mistakes]
+@index{Backspace}
+@index{deletion}
+@fncindex{delete-backward-character-command}
+ The Backspace command is the most important correction command. When
+used among printing (self-inserting) characters, it can be thought of
+as canceling the last character typed.
+
+@keyindex{M-Backspace}
+@keyindex{C-X Rubout}
+@index{words}
+@index{sentences}
+@index{killing}
+@fncindex{kill-backward-word-command}
+@fncindex{backward-kill-sentence-command}
+ When your mistake is longer than a couple of characters, it might be
+more convenient to use M-Backspace (@fnc{kill-backward-word-command})
+or C-X Rubout (@fnc{backward-kill-sentence-command}).
+M-Backspace kills back to
+the start of the last word, and C-X Rubout kills back to the start of
+the last sentence. C-X Rubout is particularly useful when you are
+thinking of what to write as you type it, in case you change your mind
+about phrasing. M-Backspace and C-X Rubout save the killed text for C-Y
+and M-Y to retrieve (@Note("Un-killing").).
+
+ M-Rubout is often useful even when you have typed only a few
+characters wrong, if you know you are confused in your typing and
+aren't sure exactly what you typed. At such a time, you cannot
+correct with Rubout except by looking at the screen to see what you
+did. It requires less thought to kill the whole word and start over
+again.
+@Section[Transposition]
+@index{transposition}
+@keyindex{C-T}
+@fncindex{transpose-characters-command}
+ The common error of transposing two characters can be fixed, when
+they are adjacent, with the C-T command (@fnc{transpose-characters-command}).
+Normally, C-T transposes the
+two characters on either side of the cursor. When given at the end of
+a line, rather than transposing the last character of the line with
+the line separator, which would be useless, C-T transposes the last
+two characters on the line. So, if you catch your transposition error
+right away, you can fix it with just a C-T. If you don't catch it so
+fast, you must move the cursor back to between the two transposed
+characters. If you transposed a space with the last character of the
+word before it, the word motion commands are a good way of getting
+there. Otherwise, a reverse search (C-R) is often the best way.
+@Note("Search").
+
+@keyindex{C-X C-T}
+@fncindex{transpose-lines}
+ To transpose two lines, use the C-X C-T command (@fnc{transpose-lines}).
+M-T transposes words and C-M-T transposes Lisp forms (in Lisp mode).
+
+@Keyindex{C-X T}
+@fncindex{transpose-regions}
+ A more general transpose command is C-X T (@fnc{transpose-regions}).
+This transposes two arbitrary blocks of text, which need not even
+be next to each other. To use it, set the mark at one end of one of the blocks,
+then at the other end of this block; then go to the other block and set
+the mark at one end, and put point at the other. In other words,
+point and the last three marks should be at the four locations which
+are the ends of the two blocks. It does not matter which of the four
+locations point is at, or which order the others were marked. C-X T
+transposes the two blocks of text thus identified.
+ , and relocates point
+ and the three marks without changing their order.
+@Section[Case Conversion]
+@fncindex{lowercase-word-command}
+@fncindex{uppercase-word-command}
+@fncindex{uppercase-initial-command}
+@keyindex{M-- M-L}
+@keyindex{M-- M-U}
+@keyindex{M-- M-C}
+@keyindex{M-L}
+@keyindex{M-U}
+@keyindex{M-C}
+@index{case conversion}
+@index{words}
+ A very common error is to type words in the wrong case. Because of
+this, the word case-conversion commands M-L, M-U and M-C have a
+special feature when used with a negative argument: they do not move
+the cursor. As soon as you see you have mistyped the last word, you
+can simply case-convert it and go on typing. @Note("Case").
+
+@keyindex{M-'}
+@index{typos}
+@fncindex{upcase-digit-command}
+@index{shifted-digits-association-list}
+ Another common error is to type a special character and miss the
+shift key, producing a digit instead. There is a special command for
+fixing this: M-' (@fnc{upcase-digit-command}), which fixes the last digit
+before point in this way (but only if that digit appears on the
+current line or the previous line. Otherwise, to minimize random
+effects of accidental use, M-' does nothing). Once again, the cursor
+does not move, so you can use M-' when you notice the error and
+immediately continue typing. Because M-' needs to know the
+arrangement of your keyboard, the first time you use it you must
+supply the information by typing the row of digits 1, 2, ... , 9, 0
+but @xxii[holding down the shift key]. This tells M-' the
+correspondence between digits and special characters, which is
+remembered for the duration of the NMODE in
+the variable shifted-digits-association-list.
+This command is called M-' because its main use is to replace
+"7" with a single-quote.
ADDED psl-1983/3-1/doc/nmode/nm-typos.topic
Index: psl-1983/3-1/doc/nmode/nm-typos.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-typos.topic
@@ -0,0 +1,11 @@
+.silent_index {typos} idx 14-1
+.silent_index {Backspace} idx 14-1
+.silent_index {deletion} idx 14-1
+.silent_index {words} idx 14-1
+.silent_index {sentences} idx 14-1
+.silent_index {killing} idx 14-1
+.silent_index {transposition} idx 14-1
+.silent_index {case} idx 14-2
+.silent_index {words} idx 14-2
+.silent_index {typos} idx 14-2
+.silent_index {shifted-digits-association-list} idx 14-2
ADDED psl-1983/3-1/doc/nmode/nm-windows.contents
Index: psl-1983/3-1/doc/nmode/nm-windows.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-windows.contents
@@ -0,0 +1,2 @@
+contents_entry(0 18 {Two Window Mode} 18-1)
+contents_entry(1 18.1 {Multiple Windows and Multiple Buffers} 18-2)
ADDED psl-1983/3-1/doc/nmode/nm-windows.function
Index: psl-1983/3-1/doc/nmode/nm-windows.function
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-windows.function
@@ -0,0 +1,8 @@
+.silent_index {two-windows-command} idx 18-1
+.silent_index {one-window-command} idx 18-1
+.silent_index {other-window-command} idx 18-1
+.silent_index {exchange-windows-command} idx 18-1
+.silent_index {scroll-other-window-command} idx 18-2
+.silent_index {view-two-windows-command} idx 18-2
+.silent_index {grow-window-command} idx 18-2
+.silent_index {visit-in-other-window-command} idx 18-3
ADDED psl-1983/3-1/doc/nmode/nm-windows.ibm
Index: psl-1983/3-1/doc/nmode/nm-windows.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-windows.ibm
@@ -0,0 +1,141 @@
+,MOD
+- R 44X (11 April 1983) <PSL.NMODE-DOC>NM-WINDOWS.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Two Window Mode) Page 18-1
+
+
+ 202/18. Two Window Mode
+
+ 201/NMODE allows you to split the screen into two 202/windows 201/and use them to
+ display parts of two files, or two parts of the same file.
+
+ C-X 2 Start showing two windows.
+ C-X 3 Show two windows but stay "in" the top one.
+ C-X 1 Show only one window again.
+ C-X O Switch to the Other window
+ C-X E Exchange Windows
+ C-X 4 Find buffer or file in other window.
+ C-X ^ Make this window bigger.
+ C-M-V Scroll the other window.
+
+ In 202/two window 201/mode, the text display portion of the screen is divided into
+ two parts called 202/windows201/, which display different pieces of text. The two
+ windows can display two different files, or two parts of the same file. Only
+ one of the windows is selected; that is the window which the cursor is in.
+ Editing normally takes place in that window alone. To edit in the other
+ window, you would give a special command to move the cursor to the other
+ window, and then edit there.
+
+ The command C-X 2 (203/two-windows-command201/) enters two-window mode. A
+ second mode line appears across the middle of the screen, dividing the text
+ display area into two halves. Window one, containing the same text as
+ previously occupied the whole screen, fills the top half, while window two
+ fills the bottom half. The cursor moves to window two. If this is your first
+ entry to two-window mode, window two contains the output buffer OUTPUT.
+ Otherwise, it contains the same text it held the last time you looked at it. If
+ given an argument, the same buffer that previously occupied the whole screen
+ will appear in the lower window as well.
+
+ To return to viewing only one window, use the command C-X 1
+ (203/one-window-command201/). Window one expands to fill the whole screen, and
+ window two disappears until the next C-X 2. C-U C-X 1 gets rid of window
+ one and makes window two use the whole screen. Neither of these depends
+ on which window the cursor is in when the command is given.
+
+ While you are in two window mode you can use C-X O
+ (203/other-window-command201/) to switch between the windows. After doing C-X 2,
+ the cursor is in window two. Doing C-X O moves the cursor back to window
+ one, to exactly where it was before the C-X 2. The difference between this
+ and doing C-X 1 is that C-X O leaves window two visible on the screen. A
+ second C-X O moves the cursor back into window two, to where it was before
+ the first C-X O. And so on...
+
+ While you are in two window mode you can also call C-X E
+ (203/exchange-windows-command201/) , which exchanges the physical positions of the
+ two windows. This leaves the cursor in the current window, and leaves the
+ division of the screen unchanged, but it swaps the buffers displayed in the
+ two portions of the screen. As a result it can change the portion of each
+ buffer that is displayed.
+ 201/Page 18-2 NMODE Manual (Two Window Mode)
+
+
+ Often you will be editing one window while using the other just for
+ reference. Then, the command C-M-V (203/scroll-other-window-command201/) is very
+ useful. It scrolls the other window without switching to it and switching
+ back. It scrolls the same way C-V does: with no argument, a whole screen
+ up; with an argument, that many lines up (or down, for a negative
+ argument). With just a minus sign (no digits) as an argument, C-M-V scrolls
+ a whole screenful backwards (what M-V does).
+
+ The C-X 3 (203/view-two-windows-command201/) command is like C-X 2 but leaves
+ the cursor in window one. That is, it makes window two appear at the
+ bottom of the screen but leaves the cursor where it was. C-X 2 is equivalent
+ to C-X 3 C-X O. C-X 3 is equivalent to C-X 2 C-X O, but C-X 3 is much
+ faster.
+
+ Normally, the screen is divided evenly between the two windows. You can
+ also redistribute screen space between the windows with the C-X ^
+ (203/grow-window-command201/) command. It makes the currently selected window
+ get one line bigger, or as many lines as is specified with a numeric
+ argument. With a negative argument, it makes the selected window smaller.
+ Neither window can be squeezed to less than one line of visible text by C-X
+ ^. Overly large arguments squeeze one window to a line of text, then stop.
+ The allocation of space to the windows is remembered while you are in one
+ window mode and the same allocation is used when you return to two window
+ mode. The allocation changes only when you give a C-X ^ command.
+
+ After leaving two-window mode, you can still use C-X O, but its meaning is
+ different. Window two does not appear, but whatever was being shown in it
+ appears, in window one (the whole screen). Whatever buffer used to be in
+ window one is stuck, invisibly, into window two. Another C-X O reverses
+ the effect of the first. For example, if window one shows buffer B and
+ window two shows buffer OUTPUT (the usual case), and only window one is
+ visible, then after a C-X O window one shows buffer OUTPUT and window
+ two shows buffer B.
+
+ 202/18.1 Multiple Windows and Multiple Buffers
+
+ 201/Buffers can be selected independently in each window. The C-X B
+ command selects a new buffer in whichever window the cursor is in. The
+ other window's buffer does not change. Window two's buffer is remembered
+ while you are in one window mode, and when you return to two window mode
+ that same buffer reappears in window two. See Section 16 [Buffers], page 1.
+
+ You can view one buffer in both windows. Give C-X 2 an argument as in
+ C-U C-X 2 to go into two window mode, with both windows showing the
+ buffer which used to be in window one alone. Although the same buffer
+ appears in both windows, they have different values of point, so you can
+ move around in window two while window one continues to show the same
+ text. Then, having found in window two the place you wish to refer to, you
+ can go back to window one with C-X O to make your changes. Finally you
+ can do C-X 1 to make window two leave the screen. If you are already in
+ two window mode, C-U C-X O switches windows carrying the buffer from the
+ old window to the new one so that both windows show that buffer.
+ 201/NMODE Manual (Multiple Windows and Multiple Buffers) Page 18-3
+
+
+ If you have the same buffer in both windows, you must beware of trying to
+ visit a different file in one of the windows with C-X C-V, because if you
+ bring a new file into this buffer, it will replace the old file in 203/both 201/windows.
+ To view different files in the two windows again, you must switch buffers in
+ one of the windows first (with C-X B or C-X C-F, perhaps).
+
+ A convenient "combination" command for viewing something in the other
+ window is C-X 4 (203/visit-in-other-window-command201/). With this command you
+ can ask to see any specified buffer or file in the other window. Follow the
+ C-X 4 with either B and a buffer name, F or C-F and a file name. This
+ switches to the other window and finds there what you specified. If you
+ were previously in one-window mode, two-window mode is entered. C-X 4 B
+ is similar to to C-X 2 C-X B. C-X 4 F is similar to C-X 2 C-X C-F. The
+ difference is one of efficiency, and also that C-X 4 works equally well if you
+ are already using two windows.
ADDED psl-1983/3-1/doc/nmode/nm-windows.key
Index: psl-1983/3-1/doc/nmode/nm-windows.key
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-windows.key
@@ -0,0 +1,8 @@
+.silent_index {C-X} idx 18-1
+.silent_index {C-X} idx 18-1
+.silent_index {C-X} idx 18-1
+.silent_index {C-X} idx 18-1
+.silent_index {C-M-V} idx 18-2
+.silent_index {C-X} idx 18-2
+.silent_index {C-X} idx 18-2
+.silent_index {C-X} idx 18-3
ADDED psl-1983/3-1/doc/nmode/nm-windows.r
Index: psl-1983/3-1/doc/nmode/nm-windows.r
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-windows.r
@@ -0,0 +1,163 @@
+.so pndoc:nman
+.part NM-WINDOWS manual
+@Chapter[Two Window Mode]
+@node("windows")
+ NMODE allows you to split the screen into two @dfn[windows] and use
+them to display parts of two files, or two parts of the same file.
+@WideCommands[
+C-X 2 Start showing two windows.
+
+C-X 3 Show two windows but stay "in" the top one.
+
+C-X 1 Show only one window again.
+
+C-X O Switch to the Other window
+
+C-X E Exchange Windows
+
+C-X 4 Find buffer or file in other window.
+
+C-X ^ Make this window bigger.
+
+C-M-V Scroll the other window.
+]
+@index{windows}
+@index{two window mode}
+ In @dfn[two window] mode, the text display portion of the screen is
+divided into two parts called @dfn[windows], which display different
+pieces of text. The two windows can display two different files, or
+two parts of the same file. Only one of the windows is selected; that
+is the window which the cursor is in. Editing normally takes place in
+that window alone. To edit in the other window, you would give a
+special command to move the cursor to the other window, and then edit
+there.
+
+@index{OUTPUT}
+@keyindex{C-X 2}
+@fncindex{two-windows-command}
+ The command C-X 2 (@fnc{two-windows-command}) enters two-window
+mode. A second mode line appears across the middle of the screen,
+dividing the text display area into two halves. Window one,
+containing the same text as previously occupied the whole screen,
+fills the top half, while window two fills the bottom half. The
+cursor moves to window two. If this is your first entry to two-window
+mode, window two contains the output buffer OUTPUT. Otherwise,
+it contains the same text it held the last time you looked at it. If
+given an argument, the same buffer that previously occupied the whole
+screen will appear in the lower window as well.
+
+@keyindex{C-X 1}
+@fncindex{one-window-command}
+ To return to viewing only one window, use the command @w[C-X 1]
+(@fnc{one-window-command}). Window one expands to fill the whole screen, and
+window two disappears until the next @w[C-X 2]. @w[C-U C-X 1] gets
+rid of window one and makes window two use the whole screen. Neither
+of these depends on which window the cursor is in when the command is
+given.
+
+@keyindex{C-X O}
+@fncindex{other-window-command}
+ While you are in two window mode you can use C-X O
+(@fnc{other-window-command}) to switch between the windows. After
+doing C-X 2, the cursor is in window two. Doing C-X O moves the
+cursor back to window one, to exactly where it was before the @w[C-X
+2]. The difference between this and doing C-X 1 is that C-X O leaves
+window two visible on the screen. A second C-X O moves the cursor
+back into window two, to where it was before the first @w[C-X O].
+And so on...
+
+@keyindex{C-X E}
+@fncindex{exchange-windows-command}
+ While you are in two window mode you can also call C-X E
+(@fnc{exchange-windows-command}) , which exchanges the physical
+positions of the two windows. This leaves the cursor in the current
+window, and leaves the division of the screen unchanged, but it swaps
+the buffers displayed in the two portions of the screen. As a result
+it can change the portion of each buffer that is displayed.
+
+@index{scrolling}
+@index{numeric arguments}
+@keyindex{C-M-V}
+@fncindex{scroll-other-window-command}
+ Often you will be editing one window while using the other just for
+reference. Then, the command C-M-V (@fnc{scroll-other-window-command}) is very
+useful. It scrolls the other window without switching to it and
+switching back. It scrolls the same way C-V does: with no argument, a
+whole screen up; with an argument, that many lines up (or down, for a
+negative argument). With just a minus sign (no digits) as an
+argument, C-M-V scrolls a whole screenful backwards (what M-V does).
+
+@keyindex{C-X 3}
+@fncindex{view-two-windows-command}
+ The C-X 3 (@fnc{view-two-windows-command}) command is like C-X 2 but
+leaves the cursor in window one. That is, it makes window two appear
+at the bottom of the screen but leaves the cursor where it was. C-X 2
+is equivalent to C-X 3 @w[C-X O]. C-X 3 is equivalent to C-X 2 C-X
+O, but C-X 3 is much faster.
+
+@keyindex{C-X ^}
+@fncindex{grow-window-command}
+ Normally, the screen is divided evenly between the two windows. You
+can also redistribute screen space between the windows with the @w[C-X
+^] (@fnc{grow-window-command}) command. It makes the currently
+selected window get one line bigger, or as many lines as is specified
+with a numeric argument. With a negative argument, it makes the
+selected window smaller. Neither window can be squeezed to less than
+one line of visible text by C-X ^. Overly large arguments squeeze one
+window to a line of text, then stop. The allocation of space to the
+windows is remembered while you are in one window mode and the same
+allocation is used when you return to two window mode. The allocation
+changes only when you give a @w[C-X ^] command.
+
+ After leaving two-window mode, you can still use C-X O, but its
+meaning is different. Window two does not appear, but whatever was
+being shown in it appears, in window one (the whole screen). Whatever
+buffer used to be in window one is stuck, invisibly, into window two.
+Another C-X O reverses the effect of the first. For example, if
+window one shows buffer B and window two shows buffer OUTPUT (the
+usual case), and only window one is visible, then after a C-X O window
+one shows buffer OUTPUT and window two shows buffer B.
+@Section[Multiple Windows and Multiple Buffers]
+@index{buffers}
+ Buffers can be selected independently in each window. The C-X B
+command selects a new buffer in whichever window the cursor is in.
+The other window's buffer does not change. Window two's buffer is
+remembered while you are in one window mode, and when you return to
+two window mode that same buffer reappears in window two.
+@Note("Buffers").
+
+@index{numeric arguments}
+ You can view one buffer in both windows. Give C-X 2 an argument as
+in C-U C-X 2 to go into two window mode, with both windows showing the
+buffer which used to be in window one alone. Although the same buffer
+appears in both windows, they have different values of point, so you
+can move around in window two while window one continues to show the
+same text. Then, having found in window two the place you wish to
+refer to, you can go back to window one with C-X O to make your
+changes. Finally you can do C-X 1 to make window two leave the
+screen. If you are already in two window mode, C-U C-X O switches
+windows carrying the buffer from the old window to the new one so that
+both windows show that buffer.
+
+ If you have the same buffer in both windows, you must
+beware of trying to visit a different file in one of the windows
+with C-X C-V, because if you bring a new file into this buffer, it
+will replace the old file in @xxii[both] windows. To view different
+files in the two windows again, you must switch buffers in one of the
+windows first (with C-X B or C-X C-F, perhaps).
+
+@keyindex{C-X 4}
+@index{visiting}
+@index{buffers}
+@index{files}
+@fncindex{visit-in-other-window-command}
+ A convenient "combination" command for viewing something in the
+other window is C-X 4 (@fnc{visit-in-other-window-command}). With
+this command you can ask to see any specified buffer or file in the
+other window. Follow the C-X 4 with either B and a buffer name, F or
+C-F and a file name. This switches to the other window and finds
+there what you specified. If you were previously in one-window mode,
+two-window mode is entered. C-X 4 B is similar to to C-X 2 C-X B.
+C-X 4 F is similar to C-X 2 C-X C-F. The difference is one of
+efficiency, and also that C-X 4 works equally well if you are already
+using two windows.
ADDED psl-1983/3-1/doc/nmode/nm-windows.topic
Index: psl-1983/3-1/doc/nmode/nm-windows.topic
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nm-windows.topic
@@ -0,0 +1,10 @@
+.silent_index {windows} idx 18-1
+.silent_index {two} idx 18-1
+.silent_index {OUTPUT} idx 18-1
+.silent_index {scrolling} idx 18-2
+.silent_index {numeric} idx 18-2
+.silent_index {buffers} idx 18-2
+.silent_index {numeric} idx 18-2
+.silent_index {visiting} idx 18-3
+.silent_index {buffers} idx 18-3
+.silent_index {files} idx 18-3
ADDED psl-1983/3-1/doc/nmode/nman.rmac
Index: psl-1983/3-1/doc/nmode/nman.rmac
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nman.rmac
@@ -0,0 +1,52 @@
+ Master macro file for NMODE Manual.
+
+.dv ibm
+.so no-overprint
+.
+.nr both_sides 1
+ .sr left_heading \section_title
+.sr left_heading NMODE Manual (\section_title)
+.sr center_heading
+.sr right_heading Page \page_number
+.nr top_margin_size 600
+.nr bottom_margin_size 1400
+.nr heading_pos 400
+.sd file_date_string fdate
+.nr macro_arg_limit 20
+.sr list_left_margin 0
+.sr list_right_margin 0
+.
+.so multipart
+.so std
+.so send
+.so xref
+.so environments
+.
+.so <user-utilities>index
+.nr index_tab 3000
+.
+.de letter_break
+.sp 1
+.ne 4
+.in index_tab!m
+.ta index_tab!m
+.em
+.
+.de before_index_entry
+.br
+.ti 0
+.em
+.
+.sr term_page_separator .
+.sr page_page_separator ,
+.sr subentry_separator ||||
+.
+.de odd_page
+.top_of_page
+.if page%2==0
+.rs
+.bp
+.en
+.em
+.
+.so pndoc:nmode-macros
ADDED psl-1983/3-1/doc/nmode/nmode-macros.rmac
Index: psl-1983/3-1/doc/nmode/nmode-macros.rmac
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/nmode-macros.rmac
@@ -0,0 +1,374 @@
+.nd frames 0
+.
+.tr @ @
+.cc x @
+.ec t \ tab
+.ec a @ text at-sign
+.ec s text space
+.
+ ------------------------------------------------------------------------------
+ Sending Macros
+ ------------------------------------------------------------------------------
+.
+.de send_topic
+.if ~frames
+.setup_file topic
+.wl .silent_index {\0} idx \page_number
+.we
+.en
+.em
+.
+.de send_fnc
+.if ~frames
+.setup_file function
+.wl .silent_index {\0} idx \page_number
+.we
+.en
+.em
+.
+.de send_name
+.if ~frames
+.setup_file command
+.wl .silent_index {\0} idx \page_number
+.we
+.en
+.em
+.
+.de send_key
+.if ~frames
+.setup_file key
+.wl .silent_index {\0} idx \page_number
+.we
+.en
+.em
+.
+.
+ ------------------------------------------------------------------------------
+ Environment Definitions
+ ------------------------------------------------------------------------------
+.
+
+ Environments that don't change Filling
+
+.define_environment group sp -1 0 0 {ne 3i} noop
+.define_environment fnc sp -1 0 0 {nv font 2} noop
+.define_environment hp9836 sp -1 0 0 noop noop
+
+ Filled Environments:
+
+.define_environment cmd_doc sp 1 1 1 begdoc enddoc
+.define_environment multiple sp 1 0 0 noop noop
+
+ List Environments:
+
+.define_environment description next 1 0 0 desc end_list
+.define_environment enumerate next 1 0 0 enum end_list
+.define_environment commands next 1 0 0 cmds end_list
+.define_environment widecommands next 1 0 0 wcmds end_list
+.define_environment doublewidecommands next 1 0 0 dwcmds end_list
+.define_environment grosscommands next 1 0 0 dwcmds end_list
+
+ NoFill Environments:
+
+.define_environment quotation sp 0 1 1 quot noop
+.define_environment verbatim sp 0 1 1 noop noop
+.define_environment format sp 0 1 1 noop noop
+.define_environment example sp 0 1 1 noop noop
+.define_environment equation sp 0 1 1 noop noop
+.define_environment programexample sp 0 1 1 noop noop
+.define_environment funenv sp 0 1 1 noop noop
+.define_environment code sp 0 1 1 noop noop
+.define_environment lispexample sp 0 1 1 noop noop
+.define_environment center sp 0 0 0 centst noop
+
+ Ignored Environments:
+
+.define_environment comment noop 0 0 0 ignore end_ignore
+.define_environment info noop 0 0 0 ignore end_ignore
+.define_environment twenex noop 0 0 0 ignore end_ignore
+.define_environment its noop 0 0 0 ignore end_ignore
+.
+.de funstt
+.hv indent 5
+.hv rindent 5
+.em
+.
+.de centst
+.nr adjust 2
+.em
+.
+.de quot
+.hv indent 5
+.ti indent!m
+.em
+.
+.de desc
+.sv list_start
+.ilist 14
+.em
+.
+.de enum
+.sv list_start \\,list_count.\s\t
+.ilist 5
+.em
+.
+.de itmz
+.sv list_start \\list_count.\s\t
+.ilist 5
+.em
+.
+.de cmds
+.sv list_left_margin 8
+.ilist 8 0
+.em
+.
+.de wcmds
+.sv list_left_margin 8
+.ilist 12 0
+.em
+.
+.de dwcmds
+.sv list_left_margin 8
+.ilist 16 0
+.em
+.
+.de begdoc
+.if frames
+.nr adjust 0
+.en
+.em
+.
+.de enddoc
+.if ~frames
+.dashes
+.en
+.ns
+.em
+.
+.de psep
+.sp
+.ns
+.em
+.
+.
+ ------------------------------------------------------------------------------
+ Cross-Reference Stuff
+ ------------------------------------------------------------------------------
+.
+.de node
+.label {\0}
+.em
+.
+.de note
+.lbegin
+.sv node \0
+.sv name \1
+.if nargs<2
+.sr name \0
+.en
+See Section ref(\node) [\name], page pageref(\node)
+.en
+.em
+.
+ ------------------------------------------------------------------------------
+ Sectioning Macros
+ ------------------------------------------------------------------------------
+.
+.eq old_chapter chapter
+.eq old_section section
+.eq old_subsection subsection
+.
+.de chapter
+.nr indent 0
+.nr rindent 0
+.old_chapter {\:*}
+.em
+.
+.de section
+.ti 0
+.in 0
+.ir 0
+.old_section {\:*}
+.em
+.
+.de subsection
+.ti 0
+.in 0
+.ir 0
+.old_subsection {\:*}
+.em
+.
+ ------------------------------------------------------------------------------
+ Footnotes
+ ------------------------------------------------------------------------------
+.
+.de foot {text}
+\fn
+.sfoot
+\*
+.efoot
+.em
+.
+ ------------------------------------------------------------------------------
+ Indexes
+ ------------------------------------------------------------------------------
+.
+.de fncindex
+.send_fnc \*
+.em
+.
+.de keyindex
+.send_key \*
+.em
+.
+.de index
+.send_topic \*
+.em
+.
+.
+ ------------------------------------------------------------------------------
+ Bibliography
+ ------------------------------------------------------------------------------
+.
+.de cite
+[\*]
+.em
+.
+.
+ ------------------------------------------------------------------------------
+ Miscellaneous Macros
+ ------------------------------------------------------------------------------
+.
+.de traceon
+.nr trace 1
+.em
+.
+.de traceoff
+.nr trace 0
+.em
+.
+.de tabdivide n
+.if
+.nv n \0
+.nv w ll/n
+.ta w!m 2*w!m 3*w!m 4*w!m 5*w!m 6*w!m 7*w!m 8*w!m 9*w!m 10*w!m
+.en
+.em
+.
+.de include foo.mss
+.if
+.sv the_filename \0
+.nv i 0
+.sv period .
+.si i period the_filename
+.if i>0
+.sb the_filename the_filename 1 i-1
+.en
+.so \the_filename.r
+.en
+.em
+.
+.de newpage
+.bp
+.em
+.
+.de comment
+.em
+.
+.de blankspace
+.sp \0
+.em
+.
+.de manual
+\*
+.em
+.
+.de w
+\*
+.em
+.
+.de ctl
+^\0
+.em
+.
+.de return1
+<CR>
+.em
+.
+.de return2
+<CR>
+.em
+.
+.de return3
+Return
+.em
+.
+.de cz
+C-C
+.em
+.
+.de cc
+C-Z
+.em
+.
+ ------------------------------------------------------------------------------
+ Font Specifications
+ ------------------------------------------------------------------------------
+.
+.de i italic
+2\**
+.em
+.
+.de r roman
+0\**
+.em
+.
+.de b bold
+1\**
+.em
+.
+.de up superscript
+\*
+.em
+.
+.de down subscript
+\*
+.em
+.
+.eq c r small capitals
+.eq k b capitals?
+.eq ei i
+.eq u b underline
+.eq dq b
+.eq xxi i
+.eq xxii i
+.eq xxu b
+.eq xxuu b
+.
+.de u_if_we_could underline
+.if
+.nv ul 1
+.nv ul_space 0
+\*
+.en
+.em
+.
+.eq fnc i
+.eq dfn b
+.
+.nr dashes_page -1
+.nr dashes_vpos -1
+.
+.de dashes
+.if page~=dashes_page|vpos>dashes_vpos+100
+. br
+. if ibm
+4$*
+. ef
+-
+. en
+. br
+. nr dashes_page page
+. nr dashes_vpos vpos
+. en
+.em
ADDED psl-1983/3-1/doc/nmode/r.contents
Index: psl-1983/3-1/doc/nmode/r.contents
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/r.contents
@@ -0,0 +1,2 @@
+contents_entry(0 1 {Introduction} 1-1)
+contents_entry(1 1.1 {Preface} 1-2)
ADDED psl-1983/3-1/doc/nmode/r.out
Index: psl-1983/3-1/doc/nmode/r.out
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/r.out
@@ -0,0 +1,106 @@
+,MOD
+- R 44X (23 March 1983) R.OUT
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+ 201/NMODE Manual (Introduction) Page 1-1
+
+
+ 202/1. Introduction
+
+ 201/This document describes the NMODE text editor. NMODE is an advanced,
+ self-documenting, customizable, extensible, interactive, multiple-window,
+ screen-oriented editor written in PSL (Portable Standard Lisp). NMODE
+ provides a compatible subset of the EMACS text editor, developed at M.I.T.
+ It also contains a number of extensions, most notably an interface to the
+ underlying Lisp system for Lisp programmers.
+
+ NMODE was developed at the Hewlett-Packard Laboratories Computer Research
+ Center by Alan Snyder. A number of significant extensions have been
+ contributed by Jeff Soreff.
+
+ NMODE is based on an earlier editor, EMODE, written in PSL by William F.
+ Galway at the University of Utah. Many of the basic ideas and the
+ underlying structure of the NMODE editor come directly from EMODE.
+
+ This document is only partially complete, but is being reprinted at this time
+ for the benefit of new users that are not familiar with EMACS. The bulk of
+ this document has been borrowed from EMACS documentation and modified
+ appropriately in areas where NMODE and EMACS differ. The original author
+ of the EMACS documentation was Richard M. Stallman.
+
+ We say that NMODE is a screen-oriented editor because normally the text
+ being edited is visible on the screen and is updated automatically as you type
+ your commands. See Section 2 [Display], page 1.
+
+ We call it an interactive editor because the display is updated very
+ frequently, usually after each character or pair of characters you type. This
+ minimizes the amount of information you must keep in your head as you edit.
+
+ We call NMODE advanced because it provides facilities that go beyond simple
+ insertion and deletion: filling of text; automatic indentation of programs;
+ viewing two files at once; and dealing in terms of characters, words, lines,
+ sentences, paragraphs, and pages, as well as expressions and comments in
+ several different programming languages. It is much easier to type one
+ command meaning "go to the end of the paragraph" than to find the desired
+ spot with repetition of simpler commands.
+
+ Self-documenting means that there are on-line functions to find out the
+ function of any command and to view documentation about that command. See
+ Section 8 [Help], page 1.
+
+ Customizable means that you can change the definitions of NMODE commands
+ in little ways. For example, you can rearrange the command set. If you
+ prefer the four basic cursor motion commands (up, down, left and right) on
+ keys in a diamond pattern on the keyboard, you can have it. See Section 21
+ [Customization], page 1.
+
+ Extensible means that you can go beyond simple customization and write
+ entirely new commands, programs in the language PSL. NMODE is an "on-line
+ extensible" system, which means that it is divided into many functions that
+ call each other, any of which can be redefined in the middle of an editing
+ 201/Page 1-2 NMODE Manual (Introduction)
+
+
+ session. Any part of NMODE can be replaced without making a separate copy
+ of all of NMODE.
+
+ 202/1.1 Preface
+
+ 201/This manual documents the use and simple customization of the display
+ editor NMODE with the 9836 operating system. The reader is 203/not 201/expected to
+ be a programmer. Even simple customizations do not require programming
+ skill, but the user who is not interested in customizing can ignore the
+ scattered customization hints.
+
+ This is primarily a reference manual, but can also be used as a primer.
+ However, I recommend that the newcomer first use the on-line,
+ learn-by-doing tutorial NTEACH. With it, you learn NMODE by using NMODE
+ on a specially designed file which describes commands, tells you when to try
+ them, and then explains the results you see. This gives a more vivid
+ introduction than a printed manual.
+
+ On first reading, you need not make any attempt to memorize chapters 2
+ and 3, which describe the notational conventions of the manual and the
+ general appearance of the NMODE display screen. It is enough to be aware
+ of what questions are answered in these chapters, so you can refer back
+ when you later become interested in the answers. After reading the Basic
+ Editing chapter you should practice the commands there. The next few
+ chapters describe fundamental techniques and concepts that are referred to
+ again and again. It is best to understand them thoroughly, experimenting
+ with them if necessary.
+
+ To find the documentation on a particular command, look in the index if you
+ know what the command is. Both command characters and function names are
+ indexed. If you know vaguely what the command does, look in the command
+ summary. The command summary contains a line or two about each command,
+ and a cross reference to the section of the manual that describes the command
+ in more detail; related commands are grouped together.
ADDED psl-1983/3-1/doc/nmode/simple-chart.ibm
Index: psl-1983/3-1/doc/nmode/simple-chart.ibm
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/nmode/simple-chart.ibm
@@ -0,0 +1,114 @@
+,MOD
+- R 44X (11 February 1983) <PSL.NMODE-DOC>SIMPLE-CHART.ibm
+PLA 97_LAS 80 0_FIR 2_INT 1 6.0_TYP 160 163 162 193_INP 12 101_MAR 2
+,END
+,PRO
+201 OUT 160_202 OUT 163_203 OUT 162_204 OUT 193
+205 INP 12 101_206 INP 12 102
+,END
+,DEFINE
+ UNIT SPACE
+ FUNCTION
+,END
+
+
+
+
+
+
+ 202/Simplified 9836 NMODE Command Summary
+
+ 201/10 February 1983
+
+
+
+ 202/Information
+
+ 201/Show Function on Key M-?
+ List Matching Commands <help>
+
+ 202/Files
+
+ 201/Find File C-X C-F
+ Save File C-X C-S
+
+ 202/Buffers
+
+ 201/Select Buffer C-X B
+ List Buffers C-X C-B
+ Go to Buffer Start M-< (or) <clr-end>
+ Go to Buffer End M-> (or) Shift-<clr-end>
+ Kill Buffer C-X K
+
+ 202/Characters
+
+ 201/Move Forward Character C-F (or) <right-arrow>
+ Move Backward Character C-B (or) <left-arrow>
+ Forward Delete Character C-D (or) <del-chr>
+ Backward Delete Character Rubout
+ Quote Character C-Q
+
+ 202/Lines
+
+ 201/Move to Next Line C-N (or) <down-arrow>
+ Move to Previous Line C-P (or) <up-arrow>
+ Goto Start of Line C-A
+ Goto End of Line C-E
+ Kill Line C-K (or) <del-ln>
+ Insert Blank Line C-O (or) <ins-ln>
+
+ 202/Killing and Unkilling Text
+
+ 201/Kill Line C-K (or) <del-ln>
+ Yank Killed Text C-Y
+ Yank Previous Kill M-Y
+
+
+
+
+
+ 202/String Search
+
+ 201/Foward Search C-S
+ Reverse Search C-R
+
+ 202/String Replacement
+
+ 201/Query Replace M-%
+ Replace String C-%
+
+ 202/Indentation
+
+ 201/Indent Line Tab
+ Indent New Line Newline
+
+ 202/Text Filling and Justification
+
+ 201/Fill Paragraph M-Q
+ Fill Comment M-Z
+ Auto Fill Mode (toggle) M-X Auto Fill Mode
+
+ 202/Modes
+
+ 201/Enter Lisp Mode M-X Lisp Mode
+ Enter Text Mode M-X Text Mode
+
+ 202/Lisp Execution
+
+ 201/Execute Form C-] E
+ Execute Defun C-] D
+ Quit from Break Loop C-] Q
+ Backtrace from Break Loop C-] B
+ Retry from Break Loop C-] R
+
+ 202/Screen Management
+
+ 201/Redisplay Screen C-L
+ Scroll to Next Screenful C-V (or) <recall>
+ Scroll to Previous Screenful M-V (or) Shift-<recall>
+
+ 202/Windows
+
+ 201/Two Windows C-X 2
+ One Window C-X 1
+ Go to Other Window C-X O
ADDED psl-1983/3-1/doc/psl-vm.doc
Index: psl-1983/3-1/doc/psl-vm.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/psl-vm.doc
@@ -0,0 +1,401 @@
+ NOTES ON THE PSL VIRTUAL MACHINE
+ Cris Perdue
+ 3-8-83
+ -------------------------------------
+
+NOTES ON THE SYSLISP DATATYPES
+------------------------------
+
+Most of the PSL low-level operators deal with values that are of
+a standard size for a given machine. Tagged LISP "items" are of
+this size, as are "machine-integers" and "machine-pointers" (see
+below for details on these datatypes).
+
+A machine-integer is a value to which operations such as WPLUS2,
+WOR and WSHIFT apply. These are listed in the documentation for
+SYSLISP. The arithmetic operators are all signed arithmetic.
+
+A machine-pointer is a machine-integer which may be an argument
+to byte, memory, putmem, wgetv, etc.. It is legitimate to use
+address arithmetic, but the difference between the addresses of
+two adjacent items may be an integer greater than one. The
+difference between the addresses of two adjacent items (words) is
+the value of the WCONST AddressingUnitsPerItem.
+
+PROBLEMS WITH THE USE OF MACHINE-INTEGERS AND MACHINE-POINTERS
+
+In the current implementation of PSL a machine-integer serves as
+the representation for every LISP integer of less than a certain
+size. Within this range of values, no conversion is required and
+machine integers can neither confuse the garbage collector nor be
+trashed by the garbage collector.
+
+If a machine integer outside this range resides where the garbage
+collector expects an item, for example in the stack, it is liable
+to be taken as a tagged pointer. If it appears to have a legal
+tag, the garbage collector is likely to try to examine the word
+pointed to and this may cause an odd address error or memory bus
+error. Also the integer may well be "relocated", i.e. altered to
+"point" to the new location of the data after the garbage
+collection -- the garbage collectors move heap objects. Even if
+none of these catastrophic events occurs, the garbage collector
+may be prevented from collecting some garbage because the integer
+gave the appearance of pointing to it.
+
+Machine-pointers suffer from some similar problems. If a garbage
+collection should occur during the active lifetime of a
+machine-pointer that points into the heap, that pointer will
+cease to point to the intended object.
+
+A NOTE ON PREDICATES
+
+All of the predicates described in this document return LISP
+boolean values, i.e. NIL or not-NIL. When used to affect flow of
+control, they compile just as the corresponding tests would in C
+or PASCAL, without reference to any LISPy values.
+
+
+ARITHMETIC AND LOGICAL OPERATIONS
+---------------------------------
+
+WPLUS2, WDIFFERENCE, WTIMES2, WQUOTIENT, WREMAINDER
+
+Signed arithmetic with word-sized arguments and result.
+
+(WSHIFT value amount)
+
+Logical shift left or right. Positive shift amounts mean
+shifting to the left. The absolute value of the shift amount
+should be less than the number of bits per item.
+
+WMINUS
+
+Unary negation.
+
+WAND, WOR, WXOR
+
+Binary bitwise logical operators.
+
+WNOT
+
+Unary logical complement (logical negation).
+
+WEQ, WNEQ
+
+Equality of item-sized values. Serves for both logical and
+arithmetic equality. The result is a LISP boolean value (NIL or
+not NIL), which is not necessarily materialized.
+
+WGREATERP, WLESSP, WGEQ, WLEQ
+
+Signed arithmetic booleans. The result is a LISP boolean value
+(NIL or not NIL) which is not necessarily materialized.
+
+(FIELD value startingbit length), (SIGNEDFIELD value startingbit length)
+
+These operators extract fields from item-sized quantities. The
+extracted field is right-justified. FIELD pads the result with
+zeroes, and SIGNEDFIELD pads the result with ones if the most
+significant bit of the field is a one. Bits are numbered with
+the most significant bit as bit zero. The startingbit and length
+arguments must be compile-time constants.
+
+
+MEMORY-ORIENTED OPERATIONS
+--------------------------
+
+(GETMEM pointer)
+
+Given a machine pointer, returns the word pointed to.
+
+(PUTMEM pointer value)
+
+Given a machine pointer and a word-sized value, stores the value
+into the word pointed to.
+
+(PUTFIELD pointer startingbit length value)
+
+Given a machine pointer, compile-time constants startingbit and
+length, and a word-sized value, the low-order bits of the value
+are stored into the specified field of the word referred to by
+pointer. Is a value returned?
+
+(WGETV pointer offset), (WPUTV pointer offset value)
+
+These provide access to words at addresses that are offset from
+some address. (WGETV pointer 0) is equivalent to (GETMEM
+pointer). Does WPUTV return a value?
+
+(BYTE pointer index), (PUTBYTE pointer index value)
+
+These provide access to vectors of byte-sized quantities. The
+pointer is a machine-pointer to the first word in which the bytes
+may be stored. The index must be zero or greater. BYTE extracts
+a byte and pads with zeroes. PUTBYTE stores the low-order bits
+of the value into a byte in memory. Does PUTBYTE return a value?
+
+(HALFWORD pointer index), (PUTHALFWORD pointer index value)
+
+These provide access to vectors of quantities packable 2 per
+word. They are analagous to BYTE and PUTBYTE, and the value of
+HALFWORD is zero-padded.
+
+LOC
+
+Use with variable names including WVARs and WARRAYs? Also with
+WGETV expressions?
+
+WCONST
+
+WCONSTs can be used in any LISP code by writing a compile-time
+constant expression: (WCONST <expression>). The expression may
+use WCONSTs by name. If WDECLARE is loaded (as in SYSLISP),
+named WCONSTs (and only WCONSTs) may be declared using the
+WDECLARE function.
+
+CROSS-COMPILER ONLY -- WVAR, WARRAY, WSTRING
+
+For WVARs, declare them first then use by name. <<So why say
+LISPVAR at all in SysLisp?>>
+
+Use WCONSTs as (WCONST expression) or alternatively (I think)
+declare first and use by name.
+
+Use of WARRAY or WSTRING by name means address of zeroth element,
+rather like a WCONST.(?)
+
+DECLARING WVARS, WARRAYS, WSTRINGS, AND WCONSTS
+
+(WDeclare scope type (name bound init) (name [bound init]) . . . )
+
+Scope is EXPORTED, EXTERNAL, or DEFAULT. (Meaning of DEFAULT?)
+Type is WVAR, WARRAY, WSTRING, or WCONST.
+Bound and Init are optional and mutually exclusive. Bound can
+ only apply to a WARRAY or WSTRING, and gives the upper bound of
+ the array or string. Init is a compile-time constant
+ expression in the case of a WVAR, or a list (of constant
+ expressions?) in the case of a WARRAY, or a string in the case
+ of a WSTRING. I think the list form is legal for a string, in
+ which case the members are taken as ASCII codes for characters.
+ (This information is not guaranteed!)
+
+
+CONVERSION BETWEEN LISP- AND MACHINE-VALUES
+-------------------------------------------
+
+INUMs need no conversion. For machine-integers in general, the
+functions SYS2INT and INT2SYS convert to and from LISP numeric
+values.
+
+
+ON "ITEMS"
+----------
+
+All PSL "pointers" are "items", also known as "tagged items". An
+item consists of a tag part and an information part. In current
+implementations the parts occupy fixed fields of a fixed-size
+quantity, but this has not been so in every implementation.
+
+In what follows note that BYTES are only partially implemented
+and that from the user's point of view, HALFWORDS are
+an experiment. Use them with the understanding that a redesign
+of the system datatypes might cause them to be eliminated.
+
+
+TAGGED ITEM CONSTRUCTORS
+------------------------
+
+(MkBTR MkID MkFIXN MkFLTN MkBIGN MkPAIR
+ MkVEC MkEVECT MkWRDS MkSTR MkBYTES
+ MkHalfWords MkCODE)
+
+Given a machine-integer data part, these return a tagged item of
+the type suggested by the name of the constructor, with data part
+same as the argument.
+
+
+TAGGED ITEM COMPONENTS
+----------------------
+
+(IDInf StrInf VecInf EvecInf PairInf WrdInf HalfWordInf CodeInf
+ FixInf FltInf BigInf)
+
+
+(PutIDInf PutStrInf PutVecInf PutPairInf PutWrdInf
+ PutHalfWordInf PutEvecInf
+ PutFixInf PutFltInf PutBigInf)
+
+Given a machine pointer to an item, these fetch or store the data
+part of the item pointed to. The value returned by the accessors
+is in machine format.
+
+Note: ByteInf and PutByteInf are missing.
+
+(Tag U)
+
+Gets the tag part of an item. Clear enough what this does now,
+but what are its specifications?
+
+
+PREDICATES ON TAGS
+------------------
+
+Each of these predicates takes a LISP item as its argument and
+returns a LISP boolean if used for its value.
+
+NOTE: By clever ordering of the values of the type tags, ALL of
+these tests are comparable in speed. In fact, on the 9836 they
+may soon all be just about the same speed, so don't hesitate to
+use the most appropriate one!
+
+PAIRP, STRINGP, VECTORP, CODEP, IDP, BYTESP, WRDSP, HALFWORDSP
+
+These are all independent predicates on the type of an item.
+
+FIXNP, FLOATP, BIGP
+
+These are checks for specific sorts of numbers. Testing for
+FLOATP is probably the most legitimate for use in user code,
+though see the function FLOAT also.
+
+INTP, FIXP, NUMBERP
+
+These are related type tests. FIXP and NUMBERP are quite
+legitimate to use in general user-level programs. INTP tests
+whether a number is in the "INUM range", that is, is represented
+directly by an item rather than using space in the heap. If a
+number is INTP, at present it has the same representation as a
+machine-integer of the same value.
+
+POSINTP, NEGINTP
+
+POSINTP checks for a positive INUM (or zero), and NEGINTP checks
+for a negative INUM. These happen at present to be separate type
+tags.
+
+There are actually even more obscure tags, but these are of very
+limited use in the author's view.
+
+
+ALLOCATORS AND DEALLOCATORS
+---------------------------
+
+(GtStr N)
+
+Space for a string of upper bound N. Returns a machine
+pointer. Header is initialized, last byte cleared.
+
+(GtConstStr N)
+
+Like GtStr, but gets space in BPS (using GtBPS). Used for print
+name storage of INTERNed IDs.
+
+(GtHalfWords N) (GtVect N) (GtEvect N) (GtWrds N)
+
+Gets enough heap space for an object of upper bound N and
+initializes the header.
+
+(GtBPS N)
+
+Gets N items of BPS (from the bottom). Returns a machine pointer.
+
+(DelBPS Bottom Top)
+
+Returns the space from bottom up to (not including) top, provided
+that it is the last space allocated but not deallocated
+(stack-like).
+
+(GtWarray N)
+
+Gets N words of BPS, but from the opposite end to GtBPS.
+
+(DelWarray Bottom Top)
+
+Returns WArray space like DelBPS does BPS.
+
+
+UPPER BOUNDS OF COMPOUND TYPES
+------------------------------
+
+(StrLen ByteLen VecLen EVecLen WrdLen HalfWordLen)
+
+Given a machine pointer to an object of the suggested type,
+returns the upper bound on indexes permitted for the object.
+
+
+ELEMENT RETRIEVAL
+-----------------
+
+(StrByte U N)
+
+U is a machine pointer to a string. Retrieves the Nth byte.
+
+(VecItm U N) (EVecItm U N) (WrdItm U N) (HalfWordItem U N)
+
+Returns the Nth element given a machine pointer U.
+
+
+WHAT?
+-----
+
+(StrBase U)
+
+Pointer to string translated to pointer to beginning of data part
+which can be accessed via Byte.
+
+So what about VectBase, etc.?
+
+
+FIXNUMS AND FLOATNUMS
+---------------------
+
+(FixVal U)
+
+Gets the data part of a fixnum.
+
+DO WE REALLY BELIEVE THIS STUFF ABOUT FLOATNUMS?
+
+(FloatBase U)
+
+Pointer to first word of data part of floatnum.
+
+(FloatHighOrder U)
+
+Gets high order part of floatnum representation.
+
+(FloatLowOrder U)
+
+Gets low order part of floatnum representation.
+
+(%code-number-of-arguments U)
+
+Gets the number of arguments information given a code pointer to
+a routine.
+
+
+ULTRAPRIMITIVES
+---------------
+
+The following functions appear in some system code, but are
+usually not needed even by system-level programmers because other
+slightly higher-level functions exist to serve most needs. One
+would use them if writing a new garbage collector, for example.
+
+(GtHeap N)
+
+Ultraprimitive. Gets N items from the heap. Returns a machine
+pointer. If an appropriate header is not installed in those
+words immediately the heap could be left in an inconsistent state
+and the garbage collector might break.
+
+(PairPack dum)
+
+Number of items in the representation of a pair.
+
+(StrPack N) (VectPack N) (EVectPack N) (WrdPack N) (HalfWordPack N)
+
+Number of items required to be allocated for data part of object
+of N+1 elements (upper bound of N). Many of these suffer from
+"off by one" errors in the conservative direction.
+
+Note: BytePack is missing.
ADDED psl-1983/3-1/doc/pslmac.lib
Index: psl-1983/3-1/doc/pslmac.lib
==================================================================
--- /dev/null
+++ psl-1983/3-1/doc/pslmac.lib
@@ -0,0 +1,82 @@
+@Marker(Library,PSLMacrosNames)
+@comment{ <GRISS>PSLMAC.LIB.2, by Griss, from}
+@comment{ <MAGUIRE>LOCALM.LIB.2, 13-May-82 05:46:06, Edit by MAGUIRE}
+@comment{ Started by G. Q. Maguire Jr. on 13.5.82 }
+@comment{ Various assorted commonly used macros for Local languages and
+ papers, so they look consistent. }
+@comment{ Commonly used and abused words}
+
+@Commandstring(Dec20="DECSystem-20")
+@Commandstring(VAX750="VAX 11/750")
+@Commandstring(Apollo="Apollo DOMAIN")
+@Commandstring(68000="Motorola MC68000")
+@Commandstring(Wicat="Wicat System 100")
+@Commandstring(PSL="@r[PSL]")
+
+@comment{ The Short version of the names }
+@Commandstring(sDec20="DEC-20")
+@Commandstring(sVAX750="VAX 11/750")
+@Commandstring(sApollo="Apollo")
+@Commandstring(s68000="MC68000")
+@Commandstring(sWicat="Wicat")
+
+@comment[to be set spacially]
+@Commandstring(cmacro="c-macro")
+@Commandstring(anyreg="anyreg")
+
+@TextForm(TM="@+[TM]@Foot[Trademark of @parm(text)]")
+
+@comment{ Favorite Abbreviations and macros }
+
+@Commandstring(xs = "s") @Comment{Plural for abbrevs}
+@Commandstring(xlisp = "@r[L@c[isp]]")
+@Commandstring(xlisps = "@xlisp systems")
+@Commandstring(Franzlisp = "@r[F@c[ranz]]@xlisp")
+@Commandstring(CommonLisp = "@r[C@c[ommon ]]@xlisp")
+@Commandstring(lmlisp = "@r[Lisp Machine @xlisp]")
+@Commandstring(newlisp = "@r[N@c[il]]")
+@Commandstring(slisp = "@r[S@c[pice]] @xlisp")
+@Commandstring(maclisp = "@r[M@c[ac]]@xlisp")
+@Commandstring(interlisp = "@r[I@c[nter]]@xlisp")
+@Commandstring(rlisp = "@r[R]@xlisp")
+@Commandstring(picturerlisp = "@r[P@c[icture]]@rlisp")
+@Commandstring(emode = "@r[E@c[mode]]")
+@Commandstring(syslisp = "@r[S@c[ys]]@xlisp")
+@Commandstring(stdlisp = "@r[S@c[tandard]] @xlisp")
+@Commandstring(macsyma = "@r[MACSYMA]")
+@Commandstring(reduce = "@r[REDUCE]")
+
+@Commandstring(fortran = "@r[FORTRAN]")
+
+@Comment[ Set Alpha_1 logo properly on the Omnitech ]
+@Case(GenericDevice,
+ Omnitech <
+ @Define(FSS,Script -0.2 lines,Size 14)
+ @CommandString(Alpha1="A@c(LPHA)@FSS(-)1")
+ @commandstring(LTS="@value(LT)")
+ @commandstring(EQS="@value(EQ)")
+ @commandstring(PLS="@value(PLUSSIGN)")
+ >,
+ Else <
+ @CommandString(Alpha1="Alpha_1")
+ @commandString(PLS="+")
+ @commandstring(EQS="=")
+ @commandstring(LTS="<")
+ >)
+
+@comment{ Do the Ada, UNIX, etc. TradeMark stuff }
+@Case(GenericDevice,
+ Omnitech <
+ @Define(Marks,Script +.5 lines, Size -5)
+ @CommandString(TMS="@Marks(TM)")
+ >,
+ Else <
+ @CommandString(TMS="@+(TM)")
+
+ >)
+@CommandString(ADA="Ada@TMS")
+@CommandString(UNIX="UNIX@TMS")
+
+@Case(GenericDevice, Omnitech {@TextForm<EI=[@i(@Parm(text))]>},
+ else {@TextForm<EI=[@DQ(@Parm(Text))]>}
+ )
ADDED psl-1983/3-1/full-logical-names.cmd
Index: psl-1983/3-1/full-logical-names.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/full-logical-names.cmd
@@ -0,0 +1,27 @@
+; Officially recognized logical names for FULL set of
+; PSL subdirectories on UTAH-20 for V3 PSL distribution
+; EDIT <PSL to your <name
+define psl: <psl> ! Executable files and miscellaneous
+define pc: <psl.comp> ! Compiler sources
+define p20c: <psl.comp.20> ! 20 Specific Compiler sources
+define pdist: <psl.dist> ! Distribution files
+define pd: <psl.doc> ! Documentation files
+define p20d: <psl.doc.20> ! 20 Specific Documentation
+define pndoc: <psl.doc.nmode> ! NMODE Documentation files
+; not distributed anymore define pe: <psl.emode> ! EMODE support and drivers
+define pg: <psl.glisp> ! Glisp sources
+define ph: <psl.help> ! Help files
+define pk: <psl.kernel> ! Kernel Source files
+define p20k: <psl.kernel.20> ! 20 Specific Kernel Sources
+define pl: <psl.lap> ! LAP files
+define plpt: <psl.lpt> ! Printer version of Documentation
+define pn: <psl.nmode> ! NMODE editor files
+define pnb: <psl.nmode.binary> ! NMODE editor binaries
+define pnk: <psl.nonkernel> ! PSL Non Kernel source files
+define pt: <psl.tests> ! Test files
+define p20t: <psl.tests.20> ! 20 Specific Test files
+define pu: <psl.util> ! Utility program sources
+define p20u: <psl.util.20> ! 20 Specific Utility files
+define pw: <psl.windows> ! NMODE Window files
+define pwb: <psl.windows.binary>! NMODE Window binaries
+take
ADDED psl-1983/3-1/full-restore.ctl
Index: psl-1983/3-1/full-restore.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/full-restore.ctl
@@ -0,0 +1,37 @@
+; Used to retrieve ALL ssnames for FULL PSL system
+; First edit FULL-LOGICAL-NAMES.CMD to reflect <name>
+; then TAKE to install names
+; then BUILD sub-directories
+; then mount TAPE, def X:
+@TERM PAGE 0
+@DUMPER
+*tape X:
+*density 1600
+*files
+*account system-default
+
+*; --- Skip over the logical names etc to do the restore.
+*skip 1
+*restore dsk*:<*>*.*.* PSL:*.*.*
+*restore dsk*:<*>*.*.* PC:*.*.*
+*restore dsk*:<*>*.*.* P20C:*.*.*
+*restore dsk*:<*>*.*.* PDIST:*.*.*
+*restore dsk*:<*>*.*.* PD:*.*.*
+*restore dsk*:<*>*.*.* P20D:*.*.*
+*restore dsk*:<*>*.*.* PNDOC:*.*.*
+; not distributed anymore *restore dsk*:<*>*.*.* PE:*.*.*
+*restore dsk*:<*>*.*.* PG:*.*.*
+*restore dsk*:<*>*.*.* ph:*.*.*
+*restore dsk*:<*>*.*.* pk:*.*.*
+*restore dsk*:<*>*.*.* p20:*.*.*
+*restore dsk*:<*>*.*.* pl:*.*.*
+*restore dsk*:<*>*.*.* plpt:*.*.*
+*restore dsk*:<*>*.*.* pn:*.*.*
+*restore dsk*:<*>*.*.* pnb:*.*.*
+*restore dsk*:<*>*.*.* pnk:*.*.*
+*restore dsk*:<*>*.*.* pT:*.*.*
+*restore dsk*:<*>*.*.* p20T:*.*.*
+*restore dsk*:<*>*.*.* pu:*.*.*
+*restore dsk*:<*>*.*.* p20u:*.*.*
+*restore dsk*:<*>*.*.* pw:*.*.*
+*restore dsk*:<*>*.*.* pwb:*.*.*
ADDED psl-1983/3-1/glisp/circle.sl
Index: psl-1983/3-1/glisp/circle.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/circle.sl
@@ -0,0 +1,51 @@
+% CIRCLE.SL.3 31 Jan. 83
+% Test program to draw a circle on a graphics screen.
+% G. Novak
+
+(DG CIRCLE
+ (XSTART:integer YSTART:integer RADIUS:INTEGER)
+% (* edited: "19-MAR-82 16:31")
+% (* Draw a circle incrementally.)
+ (PROG (X Y YLAST DELTA NP2)
+ (X_RADIUS)
+ (Y_0)
+ (DELTA_0)
+ (WHILE Y<X DO (YLAST_Y)
+ (DELTA _+
+ X + X - 1)
+ (WHILE DELTA>0 DO (DELTA _-
+ Y+Y+1)
+ (Y_+1))
+ (NP2 _(Y - YLAST + 1)/2)
+ (WHILE NP2>0 DO (NP2_-1)
+ (DRAWCIRCLEPOINT X YLAST XSTART YSTART)
+ (YLAST_+1))
+ (X_-1)
+ (WHILE YLAST<Y DO
+ (DRAWCIRCLEPOINT X YLAST XSTART YSTART)
+ (YLAST_+1)))))
+
+% for testing:
+(de drawcirclepoint (x y xstart ystart)
+ (prin1 x)(prin2 '! )(print y))
+
+(dg oldDRAWCIRCLEPOINT
+ (X:integer Y:integer XSTART:integer YSTART:INTEGER)
+% (* edited: "19-MAR-82 15:40")
+ (BITMAPBIT XSTART+X YSTART+Y 1)
+ (BITMAPBIT (XSTART - X)
+ YSTART+Y 1)
+ (BITMAPBIT (XSTART - X)
+ (YSTART - Y)
+ 1)
+ (BITMAPBIT XSTART+X (YSTART - Y)
+ 1)
+ (BITMAPBIT XSTART+Y YSTART+X 1)
+ (BITMAPBIT XSTART+Y (YSTART - X)
+ 1)
+ (BITMAPBIT (XSTART - Y)
+ YSTART+X 1)
+ (BITMAPBIT (XSTART - Y)
+ (YSTART - X)
+ 1))
+
ADDED psl-1983/3-1/glisp/crt.sl
Index: psl-1983/3-1/glisp/crt.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/crt.sl
@@ -0,0 +1,81 @@
+% CRT.SL.14 07 April 83
+% derived from <NOVAK>H19.PSL.1 20-Mar-83 12:40:06
+
+% Written by Gordon Novak Jr.
+% Copyright (c) 1983 Hewlett-Packard
+
+
+
+
+(GLOBAL '(TERMINAL))
+
+
+(GLISPOBJECTS
+
+
+(TERMINAL ATOM
+MSG ((MOVETOXY TERMINAL-MOVETOXY)
+ (PRINTCHAR TERMINAL-PRINTCHAR OPEN T)
+ (PRINTSTRING TERMINAL-PRINTSTRING)
+ (INVERTVIDEO (nil))
+
+ (NORMALVIDEO (nil))
+
+ (GRAPHICSMODE (nil))
+
+ (NORMALMODE (nil))
+
+ (ERASEEOL ((PBOUT (CHAR ESC))
+ (PBOUT (char K))))))
+
+)
+
+
+
+(GLISPGLOBALS
+(TERMINAL TERMINAL)
+
+)
+
+
+
+(GLISPCONSTANTS
+(BLANKCHAR 32 integer)
+(HORIZONTALLINECHAR 45 integer)
+(HORIZONTALBARCHAR 95 integer)
+(LVERTICALBARCHAR 124 integer)
+(RVERTICALBARCHAR 124 integer)
+(escapechar 27 INTEGER)
+)
+
+
+
+% edited: 14-Mar-83 22:48
+% Move cursor to a specified X Y position.
+(DG TERMINAL-MOVETOXY (TERM:TERMINAL X:INTEGER Y:INTEGER)
+(IF X<0 THEN X_0 ELSEIF X>79 X_79)(IF Y<0 THEN Y_0 ELSEIF Y>23 THEN Y_23)(SEND
+ TERMINAL PRINTCHAR (CHAR ESC))(SEND TERMINAL PRINTCHAR (char Y))(SEND
+ TERMINAL PRINTCHAR (55 - Y))(SEND TERMINAL PRINTCHAR
+ (32 + X)))
+
+
+% edited: 19-Mar-83 20:29
+(DG TERMINAL-PRINTCHAR (TERM:TERMINAL S:STRING)
+(PBOUT S))
+
+
+% edited: 19-Mar-83 20:29
+(DG TERMINAL-PRINTSTRING (TERM:TERMINAL S:STRING)
+ (prog (i n)
+ (if s is not a string then (S _ (gevstringify s)))
+ (n _ s:length)
+ (i _ 0)
+ (while (i<n) do (pbout (indx s i)) (i _+ 1)) ))
+
+
+(SETQ TERMINAL 'VT52)
+
+
+
+
+
ADDED psl-1983/3-1/glisp/gev.hlp
Index: psl-1983/3-1/glisp/gev.hlp
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gev.hlp
@@ -0,0 +1,47 @@
+ GEV Inspector/Editor for Lisp Data
+
+GEV (for GLISP Edit Value) is a display-based program which displays
+Lisp data in a window according to its GLISP datatype description.
+The user can "zoom in" on data of interest, display computed properties
+of objects by menu selection, send messages to objects, and write
+looping programs interactively using menu selection. GEV is available
+for Interlisp-D and for Interlisp-10 using a Heath-19 terminal.
+
+A demonstration file for GEV is available. From Interlisp, enter
+LOAD(<GLISP>GEVLOAD.LSP); then try (GEV C 'CIRCLE) and (GEV HPP 'PROJECT).
+
+The commands which can be entered at the "GEV:" prompt are as follows:
+
+ Q Quit.
+
+ POP Pop up to the earlier GEV edit window.
+
+ E Edit the current item using the Lisp editor.
+
+ PR Write a looping program using menu selection.
+
+ P Display a menu of computed PROPerties for selection.
+
+ A Display a menu of ADJectives for selection.
+
+ I Display a menu of ISA adjectives for selection.
+
+ M Display a menu of Messages to the object for selection.
+
+ R Redraw the current window.
+
+ T n Print the data type of item n.
+
+ n Push down to "zoom in" on data item n.
+
+When a menu option is selected, a separate menu is displayed and a
+"Menu:" prompt is given. Menu selections are made by entering the
+number of the desired menu item (followed by a carriage return). "Q"
+may be entered instead of a number to leave the menu mode without making
+any selection.
+
+The data used for the demonstration is contained in the file GEVDEMO.LSP.
+Documentation on GEV is contained in HPP Memo HPP-82-34, copies of which
+may be obtained in MJH 225. While designed for use with GLISP, GEV may
+be used for any Lisp data which is described by a GLISP structure
+description.
ADDED psl-1983/3-1/glisp/gev.old
Index: psl-1983/3-1/glisp/gev.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gev.old
@@ -0,0 +1,1315 @@
+
+% {DSK}GEV.PSL;2 25-MAR-83 11:36:28
+
+
+
+
+
+(FLUID '(GLNATOM RESULT Y))
+
+(GLOBAL '(GEVACTIVEFLG GEVEDITCHAIN GEVEDITFLG GEVLASTITEMNUMBER GEVMENUWINDOW
+ GEVMENUWINDOWHEIGHT GEVMOUSEAREA GEVSHORTCHARS
+ GEVWINDOW GEVWINDOWY))
+
+
+% GEV Structure Inspector
+
+
+
+
+
+
+% The following files are required: VECTOR GEVAUX WINDOW
+
+
+
+
+
+(GLISPGLOBALS
+(GEVACTIVEFLG BOOLEAN)
+
+(GEVEDITCHAIN EDITCHAIN)
+
+(GEVEDITFLG BOOLEAN)
+
+(GEVLASTITEMNUMBER INTEGER)
+
+(GEVMENUWINDOW WINDOW)
+
+(GEVMENUWINDOWHEIGHT INTEGER)
+
+(GEVMOUSEAREA MOUSESTATE)
+
+(GEVSHORTCHARS INTEGER)
+
+(GEVWINDOW WINDOW)
+
+(GEVWINDOWY INTEGER)
+
+)
+
+
+
+(GLISPCONSTANTS
+(GEVMOUSEBUTTON 4 INTEGER)
+(GEVNAMECHARS 11 INTEGER)
+(GEVVALUECHARS 27 INTEGER)
+(GEVNAMEPOS (GEVNUMBERPOS + (IF GEVNUMBERCHARS > 0 THEN (GEVNUMBERCHARS + 1)
+ *WINDOWCHARWIDTH ELSE 0)) INTEGER)
+(GEVTILDEPOS (GEVNAMEPOS + (GEVNAMECHARS+1)
+ *WINDOWCHARWIDTH) INTEGER)
+(GEVVALUEPOS (GEVTILDEPOS + 2*WINDOWCHARWIDTH) INTEGER)
+)
+
+
+
+(GLISPOBJECTS
+
+
+(EDITCHAIN (LISTOF EDITFRAME)
+PROP ((TOPFRAME ((CAR self)))
+ (TOPITEM ((CAR TOPFRAME:PREVS)))))
+
+
+(EDITFRAME (LIST (PREVS (LISTOF GSEITEM))
+ (SUBITEMS (LISTOF GSEITEM))
+ (PROPS (LISTOF GSEITEM))))
+
+
+(GSEITEM (LIST (NAME ATOM)
+ (VALUE ANYTHING)
+ (TYPE ANYTHING)
+ (SHORTVALUE ATOM)
+ (NODETYPE ATOM)
+ (SUBVALUES (LISTOF GSEITEM))
+ (NAMEPOS VECTOR)
+ (VALUEPOS VECTOR))
+PROP ((NAMEAREA ((VIRTUAL REGION WITH START = NAMEPOS WIDTH =
+ WINDOWCHARWIDTH* (NCHARS NAME)
+ HEIGHT = WINDOWLINEYSPACING)))
+ (VALUEAREA ((VIRTUAL REGION WITH START = VALUEPOS WIDTH =
+ WINDOWCHARWIDTH* (NCHARS NAME)
+ HEIGHT = WINDOWLINEYSPACING)))))
+
+
+(MOUSESTATE (LIST (AREA REGION)
+ (ITEM GSEITEM)
+ (FLAG BOOLEAN)
+ (GROUP INTEGER)))
+
+)
+
+
+
+% GSN 9-FEB-83 11:40
+% GLISP Edit Value function. Edit VAL according to structure
+% description STR.
+(DF GEV (ARGS)
+(GEVA (CAR ARGS)
+ (EVAL (CAR ARGS))
+ (AND (CDR ARGS)
+ (COND ((OR (NOT (ATOM (CADR ARGS)))
+ (NOT (UNBOUNDP (CADR ARGS))))
+ (EVAL (CADR ARGS)))
+ (T (CADR ARGS))))))
+
+
+% edited: 15-MAR-83 10:40
+% GLISP Edit Value function. Edit VAL according to structure
+% description STR.
+(DG GEVA (VAR VAL STR)
+(PROG (GLNATOM TMP HEADER)
+ (GEVENTER)
+ (COND ((OR (NOT (NOT (UNBOUNDP 'GEVWINDOW)))
+ (NULL GEVWINDOW))
+ (GEVINITEDITWINDOW)))
+ (IF GEVMENUWINDOW THEN (SEND GEVMENUWINDOW OPEN))
+ (SEND GEVWINDOW OPEN)
+ (GEVACTIVEFLG_T)
+ (GEVEDITFLG_NIL)
+ (GLNATOM_0)
+ (GEVSHORTCHARS_GEVVALUECHARS)
+ (IF VAR IS A LIST AND (CAR VAR)
+ ='QUOTE THEN VAR_ (CONCAT "'" (GEVSTRINGIFY (CADR VAR))))
+ (IF ~STR THEN (IF VAL IS ATOMIC AND (GET VAL 'GLSTRUCTURE)
+ THEN STR_'GLTYPE ELSEIF (GEVGLISPP)
+ THEN STR_ (GLCLASS VAL)))
+ (HEADER_ (A GSEITEM WITH NAME = VAR VALUE = VAL TYPE = STR))
+ (GEVEDITCHAIN_ (LIST (LIST (LIST HEADER)
+ NIL NIL)))
+ (GEVREFILLWINDOW)
+ (GEVMOUSELOOP)
+ (GEVEXIT)))
+
+
+% GSN 2-MAR-83 14:06
+(DG GEVCOMMANDFN (COMMANDWORD:ATOM)
+(PROG (PL SUBPL PROPNAME VAL PROPNAMES TOPITEM)
+ (CASE COMMANDWORD OF (EDIT (GEVEDIT))
+ (QUIT (IF GEVMOUSEAREA THEN (SEND GEVWINDOW INVERTAREA
+ GEVMOUSEAREA:AREA)
+ (GEVMOUSEAREA_NIL)
+ ELSE
+ (GEVQUIT)))
+ (POP (GEVPOP T 1))
+ (PROGRAM (GEVPROGRAM))
+ ((PROP ADJ ISA MSG)
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (GEVCOMMANDPROP TOPITEM COMMANDWORD NIL))
+ ELSE
+ (ERROR 0 NIL))))
+
+
+% GSN 25-MAR-83 10:14
+(DG GEVCOMMANDPROP (ITEM:GSEITEM COMMANDWORD:ATOM PROPNAME:ATOM)
+(PROG (VAL PROPNAMES FLG)
+ (IF PROPNAME THEN FLG_T)
+ (IF ITEM:TYPE IS ATOMIC THEN (PROPNAMES_ (GEVCOMMANDPROPNAMES ITEM:TYPE
+ COMMANDWORD
+ GEVEDITCHAIN:TOPFRAME)))
+ (IF ITEM:TYPE IS ATOMIC OR COMMANDWORD='PROP THEN
+ (IF COMMANDWORD='PROP THEN (IF (CDR PROPNAMES)
+ THEN PROPNAMES+_'All)
+ PROPNAMES+_'self)
+ (IF ~PROPNAMES (RETURN NIL))
+ (IF ~PROPNAME (PROPNAME _ (SEND (A MENU WITH ITEMS = PROPNAMES)
+ SELECT)))
+ (IF ~PROPNAME (RETURN NIL)
+ ELSEIF PROPNAME='self THEN (PRIN1 PROPNAME)
+ (PRINC " = ")
+ (PRINT ITEM:VALUE)
+ ELSEIF COMMANDWORD='PROP AND PROPNAME='All THEN
+ (FOR X IN (OR (CDDR PROPNAMES)
+ (CDR PROPNAMES))
+ DO
+ (GEVDOPROP ITEM X COMMANDWORD FLG))
+ ELSE
+ (GEVDOPROP ITEM PROPNAME COMMANDWORD FLG))
+ (IF COMMANDWORD='MSG THEN (GEVREFILLWINDOW)
+ (GEVEDITFLG_T)))))
+
+
+% edited: 22-DEC-82 11:09
+% Get all property names of properties of type PROPTYPE for OBJ.
+% Properties are filtered to remove system properties and those
+% which are already displayed.
+(DG GEVCOMMANDPROPNAMES (OBJ:GLTYPE PROPTYPE:ATOM TOPFRAME:EDITFRAME)
+(PROG (RESULT TYPE)
+ (RESULT _ (FOR P IN (CASE PROPTYPE OF (PROP OBJ:PROPS)
+ (ADJ OBJ:ADJS)
+ (ISA OBJ:ISAS)
+ (MSG OBJ:MSGS))
+ WHEN ~ (PROPTYPE~='MSG AND
+ (THE PROP OF TOPFRAME WITH NAME =
+ (CAR P)))
+ AND ~ (PROPTYPE='PROP AND (MEMQ (CAR P)
+ '(SHORTVALUE DISPLAYPROPS)
+ ))
+ AND ~ (PROPTYPE='MSG
+ AND
+ (CADR P)
+ IS ATOMIC AND (~ (GETDDD (CADR P))
+ OR
+ (LENGTH (CADR (GETDDD (CADR P))))
+ >1))
+ COLLECT P:NAME))
+ (FOR S IN OBJ:SUPERS DO (RESULT _ (NCONC RESULT (GEVCOMMANDPROPNAMES
+ S PROPTYPE TOPFRAME))))
+ (RETURN RESULT)))
+
+
+% GSN 2-MAR-83 10:42
+% Compile a property whose name is PROPNAME and whose property type
+% (ADJ, ISA, PROP, MSG) is PROPTYPE for the object type STR.
+(DG GEVCOMPPROP (STR:GLTYPE PROPNAME:ATOM PROPTYPE:ATOM)
+(PROG (PROPENT)
+ (IF ~ (MEMQ PROPTYPE '(ADJ ISA PROP MSG))
+ (RETURN 'GEVERROR))
+
+% If the property is implemented by a named function, return the
+% function name.
+
+ (IF (PROPENT_ (GEVGETPROP STR PROPNAME PROPTYPE))
+ AND
+ (CADR PROPENT)
+ IS ATOMIC THEN (RETURN (CADR PROPENT)))
+
+% Compile code for this property and save it. First be sure the GLISP
+% compiler is loaded.
+
+ (RETURN (COND ((GEVGLISPP)
+ (GLCOMPPROP STR PROPNAME PROPTYPE)
+ OR
+ 'GEVERROR)
+ (T (ERROR 0 (LIST
+ "GLISP compiler must be loaded for PROPs which"
+
+ "are not specified with function name equivalents."
+ STR PROPTYPE PROPNAME)))))))
+
+
+% edited: 4-NOV-82 16:08
+% Get a flattened list of names and types from a given structure
+% description.
+(DG GEVDATANAMES (OBJ:GLTYPE FILTER:ATOM)
+(PROG (RESULT)
+ (GEVDATANAMESB OBJ:STRDES FILTER)
+ (RETURN (REVERSIP RESULT))))
+
+
+% GSN 4-FEB-83 17:39
+% Get a flattened list of names and types from a given structure
+% description.
+(DG GEVDATANAMESB (STR:ANYTHING FILTER:ATOM)
+(GLOBAL RESULT)(PROG (TMP)
+ (IF STR IS ATOMIC THEN (RETURN NIL)
+ ELSE
+ (CASE (CAR STR)
+ OF
+ (CONS (GEVDATANAMESB (CADR STR)
+ FILTER)
+ (GEVDATANAMESB (CADDR STR)
+ FILTER))
+ ((ALIST PROPLIST LIST)
+ (FOR X IN (CDR STR)
+ DO
+ (GEVDATANAMESB X FILTER)))
+ (RECORD (FOR X IN (CDDR STR)
+ DO
+ (GEVDATANAMESB X FILTER)))
+ (ATOM (GEVDATANAMESB (CADR STR)
+ FILTER)
+ (GEVDATANAMESB (CADDR STR)
+ FILTER))
+ (BINDING (GEVDATANAMESB (CADR STR)
+ FILTER))
+ (LISTOF (RETURN NIL))
+ ELSE
+ (IF (GEVFILTER (CADR STR)
+ FILTER)
+ THEN
+ (RESULT +_ (LIST (CAR STR)
+ (CADR STR))))
+ (GEVDATANAMESB (CADR STR)
+ FILTER)))))
+
+
+% GSN 25-MAR-83 09:48
+% Display a newly added property in the window.
+(DG GEVDISPLAYNEWPROP NIL
+(PROG (Y NEWONE:GSEITEM)
+ (Y_GEVWINDOWY)
+ (NEWONE_ (CAR (LASTPAIR GEVEDITCHAIN:TOPFRAME:PROPS)))
+ (GEVPPS NEWONE 0 GEVWINDOW)
+ (GEVWINDOWY_Y)))
+
+
+% GSN 4-FEB-83 16:58
+% Add the property PROPNAME of type COMMANDWORD to the display for
+% ITEM.
+(DG GEVDOPROP (ITEM:GSEITEM PROPNAME:ATOM COMMANDWORD:ATOM FLG:BOOLEAN)
+(PROG (VAL)
+ (VAL_ (GEVEXPROP ITEM:VALUE ITEM:TYPE PROPNAME COMMANDWORD NIL))
+ (GEVEDITCHAIN:TOPFRAME:PROPS_+ (A GSEITEM WITH NAME = PROPNAME TYPE =
+ (GEVPROPTYPE ITEM:TYPE PROPNAME
+ COMMANDWORD)
+ VALUE = VAL NODETYPE = COMMANDWORD))
+ (IF ~FLG THEN (GEVDISPLAYNEWPROP))))
+
+
+% GSN 25-MAR-83 09:48
+% Edit the currently displayed item.
+(DG GEVEDIT NIL
+(PROG (CHANGEDFLG GEVTOPITEM)
+ (GEVTOPITEM_GEVEDITCHAIN:TOPITEM)
+ (IF GEVTOPITEM:TYPE IS ATOMIC AND (GEVEXPROP GEVTOPITEM:VALUE
+ GEVTOPITEM:TYPE
+ 'EDIT
+ 'MSG
+ NIL)
+ ~='GEVERROR THEN CHANGEDFLG_T ELSEIF GEVTOPITEM:VALUE IS A LIST THEN
+ (EDITV GEVTOPITEM:VALUE)
+ (CHANGEDFLG_T)
+ ELSE
+ (RETURN NIL))
+ (IF CHANGEDFLG THEN (SEND GEVWINDOW OPEN)
+ (GEVREFILLWINDOW))
+ (GEVEDITFLG_CHANGEDFLG)))
+
+
+% GSN 25-MAR-83 09:49
+% Execute a property whose name is PROPNAME and whose property type
+% (ADJ, ISA, PROP, MSG) is PROPTYPE on the object OBJ whose type is
+% STR.
+(DG GEVEXPROP (OBJ STR PROPNAME:ATOM PROPTYPE:ATOM ARGS)
+(PROG (FN)
+ (IF ~ (MEMQ PROPTYPE '(ADJ ISA PROP MSG))
+ OR
+ (ARGS AND PROPTYPE~='MSG)
+ (RETURN 'GEVERROR))
+ (IF (FN_ (GEVCOMPPROP STR PROPNAME PROPTYPE))
+ ='GEVERROR THEN (RETURN FN)
+ ELSE
+ (RETURN (GEVAPPLY FN (CONS OBJ ARGS))))))
+
+
+% edited: 15-MAR-83 12:40
+% Fill the GEV editor window with the item which is at the top of
+% GEVEDITCHAIN.
+(DG GEVFILLWINDOW NIL
+(PROG (Y TOP)
+ (SEND GEVWINDOW CLEAR)
+
+% Compute an initial Y value for printing titles in the window.
+
+ (Y_GEVWINDOW:HEIGHT - WINDOWLINEYSPACING)
+
+% Print the titles from the edit chain first.
+
+ (GEVLASTITEMNUMBER _ 0)
+ (TOP_GEVEDITCHAIN:TOPFRAME)
+ (FOR X IN (REVERSE TOP:PREVS)
+ DO
+ (GEVPPS X 0 GEVWINDOW))
+ (GEVHORIZLINE GEVWINDOW)
+ (FOR X IN TOP:SUBITEMS DO (GEVPPS X 0 GEVWINDOW))
+ (GEVHORIZLINE GEVWINDOW)
+ (FOR X IN TOP:PROPS DO (GEVPPS X 0 GEVWINDOW))
+ (GEVWINDOWY_Y)))
+
+
+% GSN 21-JAN-83 10:24
+% Filter types according to a specified FILTER.
+(DG GEVFILTER (TYPE FILTER)
+(TYPE_ (GEVXTRTYPE TYPE))(CASE FILTER OF
+ (NUMBER ~ (MEMQ TYPE
+ '(ATOM STRING BOOLEAN ANYTHING))
+ AND ~ ((PAIRP TYPE)
+ AND
+ (CAR TYPE)
+ ='LISTOF))
+ (LIST (PAIRP TYPE)
+ AND
+ (CAR TYPE)
+ ='LISTOF)
+ ELSE T))
+
+
+% edited: 14-OCT-82 11:32
+(DG GEVFINDITEMPOS (POS:VECTOR ITEM:GSEITEM N:INTEGER)
+(RESULT MOUSESTATE)
+% Test whether ITEM contains the mouse position POS. The result is NIL
+% if not found, else a list of the sub-item and a flag which is NIL
+% if the NAME part is identified, T if the VALUE part is identified.
+(OR (GEVPOSTEST POS ITEM:NAMEPOS ITEM:NAME ITEM NIL N)
+ (GEVPOSTEST POS ITEM:VALUEPOS ITEM:SHORTVALUE ITEM T N)
+ ((ITEM:NODETYPE='STRUCTURE OR ITEM:NODETYPE='SUBTREE OR
+ ITEM:NODETYPE='LISTOF)
+ AND
+ (GEVFINDLISTPOS POS ITEM:SUBVALUES N))))
+
+
+% edited: 13-OCT-82 12:03
+(DG GEVFINDLISTPOS (POS:VECTOR ITEMS: (LISTOF GSEITEM)
+ N)
+(RESULT MOUSESTATE)
+% Find some ITEM corresponding to the mouse position POS.
+(IF ITEMS THEN (GEVFINDITEMPOS POS (CAR ITEMS)
+ N)
+ OR
+ (GEVFINDLISTPOS POS (CDR ITEMS)
+ N)))
+
+
+% edited: 13-OCT-82 12:06
+(DG GEVFINDPOS (POS:VECTOR FRAME:EDITFRAME)
+(RESULT MOUSESTATE)
+% Find the sub-item of FRAME corresponding to the mouse position POS.
+% The result is NIL if not found, else a list of the sub-item and a
+% flag which is NIL if the NAME part is identified, T if the VALUE
+% part is identified.
+(PROG (TMP N ITEMS: (LISTOF gseitem))
+
+ (N_0)
+ (WHILE FRAME AND ~TMP DO (N_+1)
+ ITEMS-_FRAME
+ (TMP_ (GEVFINDLISTPOS POS ITEMS N)))
+ (RETURN TMP)))
+
+
+% edited: 22-DEC-82 14:53
+% Get all names of properties and stored data from a GLISP object
+% type.
+(DG GEVGETNAMES (OBJ:GLTYPE FILTER:ATOM)
+(PROG (DATANAMES PROPNAMES)
+ (SETQ DATANAMES (GEVDATANAMES OBJ FILTER))
+ (SETQ PROPNAMES (GEVPROPNAMES OBJ 'PROP
+ FILTER))
+ (RETURN (NCONC DATANAMES PROPNAMES))))
+
+
+% GSN 4-FEB-83 16:59
+% Retrieve a GLISP property whose name is PROPNAME and whose property
+% type (ADJ, ISA, PROP, MSG) is PROPTYPE for the object type STR.
+(DG GEVGETPROP (STR PROPNAME:ATOM PROPTYPE:ATOM)
+(PROG (PL SUBPL PROPENT)
+ (IF ~ (MEMQ PROPTYPE '(ADJ ISA PROP MSG))
+ (ERROR 0 NIL))
+ (RETURN (AND (PL_ (GET STR 'GLSTRUCTURE))
+ (SUBPL_ (LISTGET (CDR PL)
+ PROPTYPE))
+ (PROPENT_ (ASSOC PROPNAME SUBPL))))))
+
+
+% edited: 11-NOV-82 15:53
+(DE GEVGLISPP NIL
+(NOT (UNBOUNDP 'GLBASICTYPES)))
+
+
+% edited: 14-MAR-83 16:41
+(DG GEVHORIZLINE (W:WINDOW)
+(GLOBAL Y:INTEGER)
+% Draw a horizontal line across window W at Y and decrease Y.
+(SEND W DRAWLINE (A VECTOR WITH X = W:LEFTMARGIN Y = Y+WINDOWLINEYSPACING/2)
+ (A VECTOR WITH X = W:RIGHTMARGIN Y = Y+WINDOWLINEYSPACING/2))(
+ Y_-WINDOWLINEYSPACING))
+
+
+% edited: 11-MAR-83 16:03
+(DE GEVINIT NIL
+(SETQ GLNATOM 0)(COND ((NOT (NOT (UNBOUNDP 'GLLISPDIALECT)))
+ (SETQ GLLISPDIALECT 'INTERLISP)))(SETQ GEVWINDOW NIL))
+
+
+% GSN 25-MAR-83 10:14
+% Respond to an event which selects an item. GROUP gives the group in
+% which the item occurs. 1 = edit path. FLAG is T if the type of the
+% item is selected, NIL if the value is selected.
+(DG GEVITEMEVENTFN (ITEM:GSEITEM GROUP:INTEGER FLAG:BOOLEAN)
+(PROG (TMP TOP N)
+ (IF FLAG THEN (IF GROUP=1 THEN (TMP_GEVEDITCHAIN:TOPFRAME:PREVS)
+ (N_0)
+ (WHILE TMP AND (TOP-_TMP)
+ <>ITEM DO N_+1)
+ (GEVPOP NIL N)
+ ELSE
+ (GEVPUSH ITEM))
+ ELSE
+ (PRIN1 ITEM:NAME)
+ (PRINC " is ")
+ (PRIN1 ITEM:TYPE)
+ (TERPRI))))
+
+
+% GSN 2-MAR-83 16:14
+% Bound the length of VAL to NCHARS.
+(DG GEVLENGTHBOUND (VAL NCHARS)
+(COND ((GREATERP (FlatSize2 VAL)
+ NCHARS)
+ ((SUBSTRING VAL 1 (SUB1 NCHARS))
+ + "-"))
+ (T VAL)))
+
+
+% GSN 2-MAR-83 16:33
+% Make a function to perform OPERATION on set SETNAME from INPUTTYPE
+% following PATH to get to the data.
+(DG GEVMAKENEWFN (OPERATION:ATOM INPUTTYPE:ATOM SET: (LIST (NAME ATOM)
+ (TYPE GLTYPE))
+ PATH:
+ (LISTOF (LIST (NAME ATOM)
+ (TYPE GLTYPE))))
+(PROG
+ (LASTPATH)
+ (SETQ LASTPATH (CAR (LASTPAIR PATH)))
+ (RETURN
+ (LIST
+ (LIST
+ 'GLAMBDA
+ (LIST (MKATOM (CONCAT "GEVNEWFNTOP:" INPUTTYPE:PNAME)))
+ (LIST
+ 'PROG
+ (CONS 'GEVNEWFNVALUE
+ (CASE OPERATION OF (COLLECT '(GEVNEWFNRESULT))
+ ((MAXIMUM MINIMUM)
+ '(GEVNEWFNTESTVAL GEVNEWFNINSTANCE))
+ (TOTAL '((GEVNEWFNSUM 0)))
+ (AVERAGE '((GEVNEWFNSUM 0.0)
+ (GEVNEWFNCOUNT 0)))
+ ELSE
+ (ERROR 0 NIL)))
+ (NCONC (LIST 'FOR
+ 'GEVNEWFNLOOPVAR
+ 'IN
+ (MKATOM (CONCAT "GEVNEWFNTOP:" SET:NAME:PNAME))
+ 'DO
+ (LIST 'GEVNEWFNVALUE
+ '_
+ (REVERSIP (CONS 'GEVNEWFNLOOPVAR
+ (MAPCAN PATH
+ (FUNCTION
+ (LAMBDA (X)
+ (LIST 'OF
+ (CAR X)
+ 'THE))))))))
+ (COPY (CASE OPERATION OF (COLLECT '((GEVNEWFNRESULT +_
+ GEVNEWFNVALUE)))
+ (MAXIMUM '((IF ~ GEVNEWFNINSTANCE
+ OR GEVNEWFNVALUE >
+ GEVNEWFNTESTVAL
+ THEN (GEVNEWFNTESTVAL _
+ GEVNEWFNVALUE)
+ (GEVNEWFNINSTANCE _
+ GEVNEWFNLOOPVAR))))
+ (MINIMUM '((IF ~ GEVNEWFNINSTANCE
+ OR GEVNEWFNVALUE <
+ GEVNEWFNTESTVAL
+ THEN (GEVNEWFNTESTVAL _
+ GEVNEWFNVALUE)
+ (GEVNEWFNINSTANCE _
+ GEVNEWFNLOOPVAR))))
+ (AVERAGE '((GEVNEWFNSUM _+
+ GEVNEWFNVALUE)
+ (GEVNEWFNCOUNT _+
+ 1)))
+ (TOTAL '((GEVNEWFNSUM _+
+ GEVNEWFNVALUE))))))
+ (LIST 'RETURN
+ (CASE OPERATION OF (COLLECT '(DREVERSE GEVNEWFNRESULT))
+ ((MAXIMUM MINIMUM)
+ '(LIST GEVNEWFNTESTVAL GEVNEWFNINSTANCE))
+ (AVERAGE '(QUOTIENT GEVNEWFNSUM (FLOAT GEVNEWFNCOUNT)))
+ (TOTAL 'GEVNEWFNSUM)))))
+ (CASE OPERATION OF (COLLECT (LIST 'LISTOF
+ (CADR LASTPATH)))
+ ((MAXIMUM MINIMUM)
+ (LIST 'LIST
+ (COPY LASTPATH)
+ (LIST 'WINNER
+ (CADR SET:TYPE))))
+ (AVERAGE 'REAL)
+ (TOTAL (CADR LASTPATH)))))))
+
+
+% edited: 8-OCT-82 10:43
+(DG GEVMATCH (STR VAL FLG)
+(RESULT (LISTOF GSEITEM))
+% Match a structure description, STR, and a value VAL which matches
+% that description, to form a structure editor tree structure.
+(PROG (RESULT)
+ (GEVMATCHB STR VAL NIL FLG)
+ (RETURN (REVERSIP RESULT))))
+
+
+% edited: 8-OCT-82 10:01
+% Make a single item which matches structure STR and value VAL.
+(DG GEVMATCHA (STR VAL FLG)
+(PROG (RES)
+ (RES_ (GEVMATCH STR VAL FLG))
+ (IF ~ (CDR RES)
+ THEN
+ (RETURN (CAR RES))
+ ELSE
+ (RETURN (A GSEITEM WITH VALUE = VAL TYPE = STR SUBVALUES = RES
+ NODETYPE = 'SUBTREE)))))
+
+
+% edited: 7-OCT-82 16:38
+% Match an ATOM structure to a given value.
+(DG GEVMATCHATOM (STR VAL NAME)
+(PROG (L STRB TMP)
+ (IF VAL IS NOT ATOMIC OR VAL IS NULL THEN (RETURN NIL))
+ (STRB_ (CADR STR))
+ (IF (CAR STRB)
+ ~='PROPLIST THEN (RETURN NIL))
+ (L_ (CDR STRB))
+ (FOR X IN L DO (IF TMP_ (GET VAL (CAR X))
+ THEN
+ (GEVMATCHB X TMP NIL NIL)))))
+
+
+% edited: 7-OCT-82 16:57
+% Match an ALIST structure to a given value.
+(DG GEVMATCHALIST (STR VAL NAME)
+(PROG (L TMP)
+ (L_ (CDR STR))
+ (FOR X IN L DO (IF TMP_ (ASSOC (CAR X)
+ VAL)
+ THEN
+ (GEVMATCHB X (CDR TMP)
+ NIL NIL)))))
+
+
+% edited: 22-DEC-82 15:26
+% Match a structure description, STR, and a value VAL which matches
+% that description, to form a structure editor tree structure. If
+% FLG is set, the match will descend inside an atomic type name.
+% Results are added to the free variable RESULT.
+(DG GEVMATCHB (STR: (LISTOF ANYTHING)
+ VAL NAME:ATOM FLG:BOOLEAN)
+(GLOBAL RESULT)(PROG (X Y STRB XSTR TOP TMP)
+ (XSTR_ (GEVXTRTYPE STR))
+ (IF STR IS ATOMIC THEN
+ (IF FLG AND (STRB _ (CAR (GET STR 'GLSTRUCTURE)))
+ THEN
+ (RESULT +_
+ (A GSEITEM WITH NAME = NAME VALUE = VAL
+ SUBVALUES = (GEVMATCH STRB VAL NIL)
+ TYPE = STR NODETYPE = 'STRUCTURE))
+ ELSE
+ (RESULT +_
+ (A GSEITEM WITH NAME = NAME VALUE = VAL
+ TYPE = STR)))
+ (RETURN NIL)
+ ELSE
+ (CASE (CAR STR)
+ OF
+ (CONS (GEVMATCHB (CADR STR)
+ (CAR VAL)
+ NIL NIL)
+ (GEVMATCHB (CADDR STR)
+ (CDR VAL)
+ NIL NIL))
+ (LIST (FOR X IN (CDR STR)
+ DO
+ (IF VAL (GEVMATCHB X (CAR VAL)
+ NIL NIL)
+ (VAL_ (CDR VAL)))))
+ (ATOM (GEVMATCHATOM STR VAL NAME))
+ (ALIST (GEVMATCHALIST STR VAL NAME))
+ (PROPLIST (GEVMATCHPROPLIST STR VAL NAME))
+ (LISTOF (GEVMATCHLISTOF STR VAL NAME))
+ (RECORD (GEVMATCHRECORD STR VAL NAME))
+ ((OBJECT ATOMOBJECT LISTOBJECT)
+ (GEVMATCHOBJECT STR VAL NAME))
+ ELSE
+ (IF NAME THEN (TMP _ (GEVMATCH STR VAL NIL))
+ (TOP_ (CAR TMP))
+ (RESULT +_
+ (IF ~ (CDR TMP)
+ AND ~TOP:NAME THEN (
+ TOP:NAME_NAME)
+ TOP ELSE
+ (A GSEITEM WITH NAME = NAME
+ VALUE = VAL SUBVALUES = TMP
+ TYPE = XSTR NODETYPE =
+ 'SUBTREE)))
+ ELSEIF
+ (STRB _ (GEVXTRTYPE (CADR STR)))
+ IS ATOMIC THEN (GEVMATCHB STRB VAL
+ (CAR STR)
+ NIL)
+ ELSEIF
+ (TMP_ (GEVMATCH (CADR STR)
+ VAL NIL))
+ THEN
+ (TOP_ (CAR TMP))
+ (RESULT +_
+ (IF ~ (CDR TMP)
+ AND ~TOP:NAME THEN
+ (TOP:NAME_ (CAR STR))
+ TOP ELSE
+ (A GSEITEM WITH NAME =
+ (CAR STR)
+ VALUE = VAL SUBVALUES = TMP
+ TYPE = (CADR STR)
+ NODETYPE = 'SUBTREE)))
+ ELSE
+ (PRINT "GEVMATCHB Failed"))))))
+
+
+% edited: 8-OCT-82 10:15
+% Match a LISTOF structure.
+(DG GEVMATCHLISTOF (STR VAL NAME)
+(GLOBAL RESULT)(RESULT+_ (A GSEITEM WITH NAME = NAME VALUE = VAL TYPE = STR)))
+
+
+% edited: 22-DEC-82 10:04
+% Match the OBJECT structures.
+(DG GEVMATCHOBJECT (STR VAL NAME)
+(GLOBAL RESULT)(PROG (OBJECTTYPE TMP)
+ (SETQ OBJECTTYPE (CAR STR))
+ (RESULT _+ (A GSEITEM WITH NAME = 'CLASS
+ VALUE = (CASE OBJECTTYPE OF ((OBJECT
+ LISTOBJECT)
+ (TMP-_VAL))
+ (ATOMOBJECT
+ (GET VAL 'CLASS)))
+ TYPE = 'GLTYPE))
+ (FOR X IN (CDR STR)
+ DO
+ (CASE OBJECTTYPE OF ((OBJECT LISTOBJECT)
+ (IF VAL (GEVMATCHB X (TMP-_VAL)
+ NIL NIL)))
+ (ATOMOBJECT (IF TMP_ (GET VAL (CAR X))
+ THEN
+ (GEVMATCHB X TMP NIL NIL)))))))
+
+
+% edited: 24-NOV-82 16:31
+% Match an PROPLIST structure to a given value.
+(DG GEVMATCHPROPLIST (STR VAL NAME)
+(PROG (L TMP)
+ (L_ (CDR STR))
+ (FOR X IN L DO (IF TMP_ (LISTGET VAL (CAR X))
+ THEN
+ (GEVMATCHB X TMP NIL NIL)))))
+
+
+% edited: 11-MAR-83 16:31
+% Match a RECORD structure.
+(DG GEVMATCHRECORD (STR VAL NAME)
+(PROG (STRNAME FIELDS N)
+ (IF (CADR STR)
+ IS ATOMIC THEN STRNAME_ (CADR STR)
+ FIELDS_
+ (CDDR STR)
+ ELSE FIELDS_ (CDR STR))
+ (N_0)
+ (FOR X IN FIELDS DO (N_+1)
+ (GEVMATCHB X (GetV VAL N)
+ (CAR X)
+ NIL))))
+
+
+% GSN 2-MAR-83 17:33
+% Pop up from the current item to the previous one. If FLG is set,
+% popping continues through extended LISTOF elements.
+(DG GEVPOP (FLG:BOOLEAN N:INTEGER)
+(PROG (TMP TOP:GSEITEM TMPITEM)
+ (IF N<1 (RETURN NIL))
+ LP
+ (TMP-_GEVEDITCHAIN)
+ (IF ~GEVEDITCHAIN THEN (RETURN (GEVQUIT)))
+ (TOP_ (CAAAR GEVEDITCHAIN))
+
+% Test for repeated LISTOF elements.
+
+ (TMPITEM_ (CAR TMP:PREVS))
+ (IF FLG AND TMPITEM:NODETYPE='FORWARD THEN (GO LP))
+ (IF (N_-1)
+ >0 THEN (GO LP))
+ (IF TOP:TYPE IS A LIST AND (CAR TOP:TYPE)
+ ='LISTOF AND ~ (CDR TOP:VALUE)
+ THEN
+ (GO LP))
+ (IF GEVEDITFLG AND ~ (MEMBER TMPITEM:SHORTVALUE '("(...)" "---"))
+ THEN
+ (GEVREFILLWINDOW)
+ ELSE GEVEDITFLG_NIL (GEVFILLWINDOW))))
+
+
+% edited: 11-MAR-83 15:06
+(DG GEVPOSTEST (POS:VECTOR TPOS:VECTOR NAME:STRING ITEM:GSEITEM FLG N:INTEGER)
+(RESULT MOUSESTATE)
+% Test whether TPOS contains the mouse position POS. The result is NIL
+% if not found, else a list of the sub-item and a flag which is NIL
+% if the NAME part is identified, T if the VALUE part is identified.
+(IF POS:Y>=TPOS:Y AND POS:Y<=TPOS:Y+WINDOWLINEYSPACING AND POS:X>=TPOS:X AND
+ POS:X<TPOS:X+GEVNAMECHARS*WINDOWCHARWIDTH THEN
+ (A MOUSESTATE WITH AREA =
+ (A REGION WITH START =
+ (A VECTOR WITH X = TPOS:X Y = TPOS:Y - 1)
+ SIZE = (A VECTOR WITH X = WINDOWCHARWIDTH*NAME:LENGTH Y =
+ WINDOWLINEYSPACING))
+ ITEM = ITEM FLAG = FLG GROUP = N)))
+
+
+% edited: 15-MAR-83 12:38
+(DG GEVPPS (ITEM:GSEITEM COL:INTEGER WINDOW:WINDOW)
+(GLOBAL Y:INTEGER)
+% Pretty-print a structure defined by ITEM in the window WINDOW,
+% beginning ar horizontal column COL and vertical position Y. The
+% positions in ITEM are modified to match the positions in the
+% window.
+(PROG (NAMEX TOP)
+
+% Make sure there is room in window.
+
+ (IF Y<0 THEN (RETURN NIL))
+ (IF GEVNUMBERCHARS>0 THEN (GEVLASTITEMNUMBER _+ 1)
+ (SEND WINDOW PRINTAT (GEVSTRINGIFY GEVLASTITEMNUMBER)
+ (A VECTOR WITH X = GEVNUMBERPOS Y = Y)))
+
+% Position in window for slot name.
+
+ (NAMEX _ GEVNAMEPOS + COL*WINDOWCHARWIDTH)
+ (ITEM:NAMEPOS:X_NAMEX)
+ (ITEM:NAMEPOS:Y_Y)
+ (IF ITEM:NODETYPE='FULLVALUE THEN
+ (SEND WINDOW PRINTAT "(expanded)"
+ (A VECTOR WITH X = NAMEX Y = Y))
+ ELSEIF ITEM:NAME THEN
+ (IF ITEM:NAME IS NUMERIC THEN
+ (SEND WINDOW PRINTAT "#"
+ (A VECTOR WITH X = NAMEX Y = Y))
+ (NAMEX_+WINDOWCHARWIDTH))
+ (SEND WINDOW PRINTAT (GEVLENGTHBOUND ITEM:NAME GEVNAMECHARS)
+ (A VECTOR WITH X = NAMEX Y = Y)))
+
+% See if there is a value to print for this name.
+
+ (IF ~ITEM:NODETYPE OR (MEMQ ITEM:NODETYPE
+ '(FORWARD BACKUP PROP ADJ MSG ISA))
+ THEN
+ (ITEM:VALUEPOS:X_GEVVALUEPOS)
+ (ITEM:VALUEPOS:Y_Y)
+ (SEND WINDOW PRINTAT (ITEM:SHORTVALUE OR
+ (ITEM:SHORTVALUE
+ _
+ (GEVSHORTVALUE ITEM:VALUE
+ ITEM:TYPE
+ (GEVSHORTCHARS
+ - COL))))
+ (A VECTOR WITH X = GEVVALUEPOS Y = Y))
+ (IF ~ (EQ ITEM:SHORTVALUE ITEM:VALUE)
+ THEN
+ (SEND WINDOW PRINTAT "~"
+ (A VECTOR WITH X = GEVTILDEPOS Y = Y)))
+ (Y_-WINDOWLINEYSPACING)
+ ELSEIF ITEM:NODETYPE='FULLVALUE THEN (Y_-WINDOWLINEYSPACING)
+ (SEND WINDOW PRETTYPRINTAT ITEM:VALUE
+ (A VECTOR WITH X = WINDOWCHARWIDTH Y = Y))
+ (Y_WINDOW:YPOSITION - WINDOWLINEYSPACING)
+ ELSEIF ITEM:NODETYPE='DISPLAY THEN (GEVEXPROP ITEM:VALUE ITEM:TYPE
+ 'GEVDISPLAY
+ 'MSG
+ (LIST WINDOW Y))
+ ELSE
+
+% This is a subtree
+
+ (Y_-WINDOWLINEYSPACING)
+ (FOR VSUB IN ITEM:SUBVALUES DO (GEVPPS VSUB COL+2 WINDOW)))))
+
+
+% GSN 25-MAR-83 10:15
+% Write an interactive program involving the current item.
+(DG GEVPROGRAM NIL
+(PROG (TOPITEM COMMAND SET PATH DONE NEXT TYPE NEWFN RESULT LAST ABORTFLG)
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (IF (COMMAND_ (SEND (A MENU WITH ITEMS =
+ '(Quit COLLECT TOTAL AVERAGE MAXIMUM MINIMUM))
+ SELECT))
+ ='Quit OR ~ COMMAND THEN (RETURN NIL))
+ (IF (SET_ (GEVPROPMENU TOPITEM:TYPE 'LIST
+ NIL))
+ ='Quit OR SET='Pop OR ~SET THEN (RETURN NIL))
+ (PATH_ (LIST SET (LIST TOPITEM:NAME TOPITEM:TYPE)))
+ (NEXT_SET)
+ (TYPE_ (CADADR SET))
+ (WHILE ~DONE AND ~ABORTFLG DO (NEXT_ (GEVPROPMENU TYPE
+ (COMMAND~='COLLECT
+ AND
+ 'NUMBER)
+ COMMAND='COLLECT))
+ (CASE NEXT OF ((NIL Quit)
+ (ABORTFLG_T))
+ (Pop (IF ~ (CDDR PATH)
+ THEN
+ (ABORTFLG_T)
+ ELSE
+ (NEXT-_PATH)
+ (NEXT_ (CAR PATH))
+ (TYPE_ (CADR NEXT))
+ (IF TYPE IS A LIST THEN TYPE_ (CADR TYPE))
+ (LAST_ (CAR NEXT))))
+ (Done (DONE_T))
+ ELSE
+ (PROGN (PATH+_NEXT)
+ (TYPE_ (CADR NEXT))
+ (LAST_ (CAR NEXT))))
+ (IF (MEMQ TYPE '(ATOM INTEGER STRING REAL BOOLEAN NIL))
+ DONE_T))
+ (IF ABORTFLG (RETURN NIL))
+ (PATH_ (REVERSIP PATH))
+ (NEWFN_ (GEVMAKENEWFN COMMAND TOPITEM:TYPE SET (CDDR PATH)))
+ (GEVPUTD 'GEVNEWFN
+ (CAR NEWFN))
+ (RESULT_ (GEVNEWFN TOPITEM:VALUE))
+
+% Print result as well as displaying it.
+
+ (PRIN1 COMMAND)
+ (SPACES 1)
+ (FOR X IN (CDDR PATH)
+ DO
+ (PRIN1 (CAR X))
+ (SPACES 1))
+ (PRINC "OF ")
+ (PRIN1 (CAAR PATH))
+ (SPACES 1)
+ (PRIN1 (CAADR PATH))
+ (PRINC " = ")
+ (PRINT RESULT)
+ (GEVEDITCHAIN:TOPFRAME:PROPS_+ (A GSEITEM WITH NAME =
+ (CONCAT (GEVSTRINGIFY COMMAND)
+ (CONCAT " " (GEVSTRINGIFY
+ LAST)))
+ TYPE = (CADR NEWFN)
+ VALUE = RESULT NODETYPE =
+ 'MSG))
+ (GEVDISPLAYNEWPROP)))
+
+
+% GSN 21-JAN-83 10:32
+% Make a menu to get properties of object OBJ with filter FILTER. FLG
+% is T if it is okay to stop before reaching a basic type.
+(DG GEVPROPMENU (OBJ:GLTYPE FILTER:ATOM FLG:BOOLEAN)
+(PROG (PROPS SEL PNAMES MENU)
+ (PROPS_ (GEVGETNAMES OBJ FILTER))
+ (IF ~PROPS THEN (RETURN NIL)
+ ELSE
+ (PNAMES_ (MAPCAR PROPS (FUNCTION CAR)))
+ (SEL_ (SEND (A MENU WITH ITEMS =
+ (CONS 'Quit
+ (CONS 'Pop
+ (IF FLG THEN (CONS 'Done
+ PNAMES)
+ ELSE PNAMES))))
+ SELECT))
+ (RETURN (CASE SEL OF ((Quit Pop Done NIL)
+ SEL)
+ ELSE
+ (ASSOC SEL PROPS))))))
+
+
+% GSN 4-FEB-83 17:01
+% Get all property names and types of properties of type PROPTYPE for
+% OBJ when they satisfy FILTER.
+(DG GEVPROPNAMES (OBJ:GLTYPE PROPTYPE:ATOM FILTER:ATOM)
+(PROG (RESULT TYPE)
+ (RESULT _ (FOR P IN (CASE PROPTYPE OF (PROP OBJ:PROPS)
+ (ADJ OBJ:ADJS)
+ (ISA OBJ:ISAS)
+ (MSG OBJ:MSGS))
+ WHEN
+ (TYPE_ (GEVPROPTYPES OBJ P:NAME 'PROP))
+ AND
+ (GEVFILTER TYPE FILTER)
+ COLLECT
+ (LIST P:NAME TYPE)))
+ (FOR S IN OBJ:SUPERS DO (RESULT _ (NCONC RESULT (GEVPROPNAMES S PROPTYPE
+ FILTER))))
+ (RETURN RESULT)))
+
+
+% GSN 4-FEB-83 17:02
+% Find the type of a computed property.
+(DG GEVPROPTYPE (STR:ATOM PROPNAME:ATOM PROPTYPE:ATOM)
+(PROG (PL SUBPL PROPENT TMP)
+ (IF STR IS NOT ATOMIC THEN (RETURN NIL)
+ ELSEIF
+ (PROPENT_ (GEVGETPROP STR PROPNAME PROPTYPE))
+ AND
+ (TMP_ (LISTGET (CDDR PROPENT)
+ 'RESULT))
+ THEN
+ (RETURN TMP)
+ ELSEIF PROPENT AND (CADR PROPENT)
+ IS ATOMIC AND (TMP_ (GET (CADR PROPENT)
+ 'GLRESULTTYPE))
+ THEN
+ (RETURN TMP)
+ ELSEIF
+ (AND (PL_ (GET STR 'GLPROPFNS))
+ (SUBPL_ (ASSOC PROPTYPE PL))
+ (PROPENT_ (ASSOC PROPNAME (CDR SUBPL)))
+ (TMP_ (CADDR PROPENT)))
+ THEN
+ (RETURN TMP)
+ ELSEIF PROPTYPE='ADJ THEN (RETURN 'BOOLEAN))))
+
+
+% edited: 4-NOV-82 15:39
+(DE GEVPROPTYPES (OBJ NAME TYPE)
+(OR (GEVPROPTYPE OBJ NAME TYPE)
+ (AND (GEVCOMPPROP OBJ NAME TYPE)
+ (GEVPROPTYPE OBJ NAME TYPE))))
+
+
+% GSN 2-MAR-83 17:32
+% Push down to look at an item referenced from the current item.
+(DG GEVPUSH (ITEM:GSEITEM)
+(PROG (NEWITEMS TOPITEM LSTITEM:GSEITEM)
+ (IF ITEM:NODETYPE='BACKUP THEN (GEVPOP NIL 1)
+ (RETURN NIL))
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (IF ITEM:NODETYPE='FORWARD THEN (NEWITEMS_ (GEVPUSHLISTOF ITEM T))
+ ELSEIF ITEM:TYPE IS ATOMIC AND ~ (GET ITEM:TYPE 'GLSTRUCTURE)
+ THEN
+ (CASE ITEM:TYPE OF
+ ((ATOM NUMBER REAL INTEGER STRING ANYTHING)
+ (IF ITEM:VALUE=ITEM:SHORTVALUE THEN (RETURN NIL)
+ ELSE
+ (NEWITEMS_ (LIST (A GSEITEM WITH NAME = ITEM:NAME VALUE =
+ ITEM:VALUE SHORTVALUE =
+ ITEM:SHORTVALUE TYPE = ITEM:TYPE
+ NODETYPE = 'FULLVALUE)))))
+ ELSE
+ (RETURN NIL))
+ ELSEIF ITEM:TYPE IS A LIST AND (CAR ITEM:TYPE)
+ ='LISTOF THEN (NEWITEMS_ (GEVPUSHLISTOF ITEM NIL)))
+ (GEVEDITCHAIN+_ (AN EDITFRAME WITH PREVS = (CONS ITEM
+ GEVEDITCHAIN:TOPFRAME:PREVS)
+ SUBITEMS = NEWITEMS))
+
+% Do another PUSH automatically for a list of only one item.
+
+ (GEVREFILLWINDOW)
+ (IF ITEM:TYPE IS A LIST AND (CAR ITEM:TYPE)
+ ='LISTOF AND ~ (CDR ITEM:VALUE)
+ THEN
+ (LSTITEM_ (CAADAR GEVEDITCHAIN))
+ (GEVPUSH (CAR LSTITEM:SUBVALUES))
+ (RETURN NIL))))
+
+
+% edited: 11-MAR-83 15:08
+% Push into a datum of type LISTOF, expanding it into the individual
+% elements. If FLG is set, ITEM is a FORWARD item to be continued.
+(DG GEVPUSHLISTOF (ITEM:GSEITEM FLG:BOOLEAN)
+(PROG (ITEMTYPE TOPFRAME N:INTEGER NROOM LST VALS: (LISTOF anything) TMP)
+
+
+% Compute the vertical room available in the window.
+
+ (IF ~ITEM:VALUE (RETURN NIL))
+ (TOPFRAME_GEVEDITCHAIN:TOPFRAME)
+ (NROOM _ GEVWINDOW:HEIGHT/WINDOWLINEYSPACING - 4 - (LENGTH
+ TOPFRAME:PREVS))
+
+% If there was a previous display of this list, insert an ellipsis
+% header.
+
+ (IF FLG THEN (LST+_ (A GSEITEM WITH SHORTVALUE = "(..." NODETYPE =
+ 'BACKUP))
+ (N_ITEM:NAME)
+ (ITEMTYPE_ITEM:TYPE)
+ (NROOM_-1)
+ (VALS_ITEM:SUBVALUES)
+ ELSE
+ (N_1)
+ (ITEMTYPE_ (CADR ITEM:TYPE))
+ (VALS_ITEM:VALUE))
+
+% Now make entries for each value on the list.
+
+ (WHILE VALS AND (NROOM>1 OR (NROOM=1 AND ~ (CDR VALS)))
+ DO
+ (LST+_ (A GSEITEM WITH VALUE = (TMP-_VALS)
+ TYPE = ITEMTYPE NAME = N))
+ (NROOM_-1)
+ (N_+1))
+ (IF VALS THEN (LST+_ (A GSEITEM WITH SHORTVALUE = "...)" NODETYPE =
+ 'FORWARD
+ TYPE = ITEMTYPE NAME = N SUBVALUES = VALS)))
+ (RETURN (LIST (A GSEITEM WITH NAME = "expanded" TYPE = ITEMTYPE NODETYPE
+ = 'LISTOF
+ SUBVALUES = (REVERSIP LST))))))
+
+
+% edited: 14-MAR-83 16:46
+(DG GEVQUIT NIL
+(SETQ GEVACTIVEFLG NIL)(SEND GEVWINDOW CLOSE)(IF GEVMENUWINDOW THEN
+ (SEND GEVMENUWINDOW CLOSE)))
+
+
+% edited: 19-OCT-82 10:23
+% Recompute property values for the item.
+(DG GEVREDOPROPS (TOP:EDITFRAME)
+(PROG (ITEM L)
+ (ITEM_ (CAR TOP:PREVS))
+ (IF ~TOP:PROPS AND (L_ (GEVEXPROP ITEM:VALUE ITEM:TYPE 'DISPLAYPROPS
+ 'PROP
+ NIL))
+ ~='GEVERROR THEN (IF L IS ATOMIC THEN (GEVCOMMANDPROP ITEM
+ 'PROP
+ 'All)
+ ELSEIF L IS A LIST THEN
+ (FOR X IN L (GEVCOMMANDPROP ITEM 'PROP
+ X)))
+ ELSE
+ (FOR X IN TOP:PROPS WHEN X:NODETYPE~='MSG DO
+ (X:VALUE _ (GEVEXPROP ITEM:VALUE ITEM:TYPE X:NAME X:NODETYPE
+ NIL))
+ (X:SHORTVALUE _ NIL)))))
+
+
+% edited: 14-OCT-82 12:46
+% Re-expand the top item of GEVEDITCHAIN, which may have been changed
+% due to editing.
+(DG GEVREFILLWINDOW NIL
+(PROG (TOP TOPITEM SUBS TOPSUB)
+ (TOP_GEVEDITCHAIN:TOPFRAME)
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (TOPSUB_ (CAR TOP:SUBITEMS))
+ (IF ~TOPSUB OR (TOPSUB:NODETYPE~='FULLVALUE AND TOPSUB:NODETYPE~='LISTOF)
+ THEN
+ (IF (GEVGETPROP TOPITEM:TYPE 'GEVDISPLAY
+ 'MSG)
+ THEN
+ (TOP:SUBITEMS_ (LIST (A GSEITEM WITH VALUE = TOPITEM:VALUE TYPE
+ = TOPITEM:TYPE NODETYPE = 'DISPLAY)))
+ ELSE
+ (SUBS_ (GEVMATCH TOPITEM:TYPE TOPITEM:VALUE T))
+ (TOPSUB_ (CAR SUBS))
+ (TOP:SUBITEMS_ (IF ~ (CDR SUBS)
+ AND TOPSUB:NODETYPE='STRUCTURE AND
+ TOPSUB:VALUE=TOPITEM:VALUE AND
+ TOPSUB:TYPE=TOPITEM:TYPE THEN
+ TOPSUB:SUBVALUES ELSE SUBS))))
+ (GEVREDOPROPS TOP)
+ (GEVFILLWINDOW)))
+
+
+% edited: 8-OCT-82 15:41
+(DE GEVSHORTATOMVAL (ATM NCHARS)
+(COND ((NUMBERP ATM)
+ (COND ((GREATERP (FlatSize2 ATM)
+ NCHARS)
+ (GEVSHORTSTRINGVAL (MKSTRING ATM)
+ NCHARS))
+ (T ATM)))
+ ((GREATERP (FlatSize2 ATM)
+ NCHARS)
+ (CONCAT (SUBSTRING ATM 1 (SUB1 NCHARS))
+ "-"))
+ (T ATM)))
+
+
+% GSN 25-MAR-83 10:02
+% Compute a short value for printing a CONS of two items.
+(DG GEVSHORTCONSVAL (VAL STR NCHARS:INTEGER)
+(PROG (NLEFT RES TMP NC)
+ (RES +_ "(")
+ (NLEFT _ NCHARS - 5)
+ (TMP_ (GEVSHORTVALUE (CAR VAL)
+ (CADR STR)
+ NLEFT - 3))
+ (NC_ (FlatSize2 TMP))
+ (IF NC>NLEFT - 3 THEN TMP_ "---" NC_3)
+ (RES+_ (GEVSTRINGIFY TMP))
+ (RES +_ " . ")
+ (NLEFT_-NC)
+ (TMP_ (GEVSHORTVALUE (CDR VAL)
+ (CADDR STR)
+ NLEFT))
+ (NC_ (FlatSize2 TMP))
+ (IF NC>NLEFT THEN TMP_ "---" NC_3)
+ (RES+_ (GEVSTRINGIFY TMP))
+ (RES+_ ")")
+ (RETURN (GEVCONCAT
+ (REVERSIP RES)))))
+
+
+% GSN 25-MAR-83 10:03
+% Compute a short value for printing a list of items.
+(DG GEVSHORTLISTVAL (VAL STR NCHARS:INTEGER)
+(PROG (NLEFT RES TMP QUIT NC NCI REST RSTR)
+ (RES +_ "(")
+ (REST_4)
+ (NLEFT _ NCHARS - 2)
+ (RSTR_ (CDR STR))
+ (WHILE VAL AND ~QUIT AND (NCI_ (IF (CDR VAL)
+ THEN NLEFT - REST ELSE NLEFT))
+ >2 DO (TMP_ (GEVSHORTVALUE (CAR VAL)
+ (IF (CAR STR)
+ ='LISTOF THEN (CADR STR)
+ ELSEIF
+ (CAR STR)
+ ='LIST THEN (CAR RSTR))
+ NCI))
+ (QUIT _ (MEMBER TMP '(GEVERROR "(...)" "---" "???")))
+ (NC_ (FlatSize2 TMP))
+ (IF NC>NCI AND (CDR RES)
+ THEN QUIT_T ELSE (IF NC>NCI THEN TMP_ "---" NC_3 QUIT_T)
+ (RES+_ (GEVSTRINGIFY TMP))
+ (NLEFT_-NC)
+ (VAL_ (CDR VAL))
+ (RSTR_ (CDR RSTR))
+ (IF VAL THEN (RES+_ " ")
+ (NLEFT_-1))))
+ (IF VAL THEN (RES+_ "..."))
+ (RES+_ ")")
+ (RETURN (GEVCONCAT
+ (REVERSIP RES)))))
+
+
+% edited: 12-OCT-82 12:14
+% Compute the short value of a string VAL. The result is a string
+% which can be printed within NCHARS.
+(DE GEVSHORTSTRINGVAL (VAL NCHARS)
+(COND ((STRINGP VAL)
+ (GEVLENGTHBOUND VAL NCHARS))
+ (T "???")))
+
+
+% edited: 11-MAR-83 15:34
+% Compute the short value of a given value VAL whose type is STR. The
+% result is an atom, string, or list structure which can be printed
+% within NCHARS.
+(DE GEVSHORTVALUE (VAL STR NCHARS)
+(PROG (TMP)
+ (SETQ STR (GEVXTRTYPE STR))
+ (RETURN (COND ((AND (ATOM STR)
+ (MEMQ STR '(ATOM INTEGER REAL)))
+ (GEVSHORTATOMVAL VAL NCHARS))
+ ((EQ STR 'STRING)
+ (GEVSHORTSTRINGVAL VAL NCHARS))
+ ((AND (ATOM STR)
+ (NE (SETQ TMP (GEVEXPROP VAL STR 'SHORTVALUE
+ 'PROP
+ NIL))
+ 'GEVERROR))
+ (GEVLENGTHBOUND TMP NCHARS))
+ ((OR (ATOM VAL)
+ (NUMBERP VAL))
+ (GEVSHORTATOMVAL VAL NCHARS))
+ ((STRINGP VAL)
+ (GEVSHORTSTRINGVAL VAL NCHARS))
+ ((PAIRP STR)
+ (CASEQ (CAR STR)
+ ((LISTOF LIST)
+ (COND ((PAIRP VAL)
+ (GEVSHORTLISTVAL VAL STR NCHARS))
+ (T "???")))
+ (CONS (COND ((PAIRP VAL)
+ (GEVSHORTCONSVAL VAL STR NCHARS))
+ (T "???")))
+ (T "---")))
+ ((PAIRP VAL)
+ (GEVSHORTLISTVAL VAL '(LISTOF ANYTHING)
+ NCHARS))
+ (T "---")))))
+
+
+% edited: 21-OCT-82 11:17
+% Extract an atomic type name from a type spec which may be either
+% <type> or (A <type>) .
+(DE GEVXTRTYPE (TYPE)
+(COND ((ATOM TYPE)
+ TYPE)
+ ((NOT (PAIRP TYPE))
+ NIL)
+ ((AND (MEMQ (CAR TYPE)
+ '(A AN a an An TRANSPARENT))
+ (CDR TYPE)
+ (ATOM (CADR TYPE)))
+ (CADR TYPE))
+ ((MEMQ (CAR TYPE)
+ GEVTYPENAMES)
+ TYPE)
+ ((AND (NOT (UNBOUNDP GLUSERSTRNAMES))
+ (ASSOC (CAR TYPE)
+ GLUSERSTRNAMES))
+ TYPE)
+ ((AND (ATOM (CAR TYPE))
+ (CDR TYPE))
+ (GEVXTRTYPE (CADR TYPE)))
+ (T (ERROR 0 (LIST 'GEVXTRTYPE
+ (LIST TYPE "is an illegal type specification.")))
+ NIL)))
+
+(SETQ GEVTYPENAMES '(CONS LIST RECORD LISTOF ALIST ATOM OBJECT LISTOBJECT
+ ATOMOBJECT))
ADDED psl-1983/3-1/glisp/gev.sl
Index: psl-1983/3-1/glisp/gev.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gev.sl
@@ -0,0 +1,1315 @@
+
+% {DSK}GEV.PSL;3 6-APR-83 16:26:08
+
+
+
+
+
+(FLUID '(GLNATOM RESULT Y))
+
+(GLOBAL '(GEVACTIVEFLG GEVEDITCHAIN GEVEDITFLG GEVLASTITEMNUMBER GEVMENUWINDOW
+ GEVMENUWINDOWHEIGHT GEVMOUSEAREA GEVSHORTCHARS
+ GEVWINDOW GEVWINDOWY))
+
+
+% GEV Structure Inspector
+
+
+
+
+
+
+% The following files are required: VECTOR GEVAUX WINDOW
+
+
+
+
+
+(GLISPGLOBALS
+(GEVACTIVEFLG BOOLEAN)
+
+(GEVEDITCHAIN EDITCHAIN)
+
+(GEVEDITFLG BOOLEAN)
+
+(GEVLASTITEMNUMBER INTEGER)
+
+(GEVMENUWINDOW WINDOW)
+
+(GEVMENUWINDOWHEIGHT INTEGER)
+
+(GEVMOUSEAREA MOUSESTATE)
+
+(GEVSHORTCHARS INTEGER)
+
+(GEVWINDOW WINDOW)
+
+(GEVWINDOWY INTEGER)
+
+)
+
+
+
+(GLISPCONSTANTS
+(GEVMOUSEBUTTON 4 INTEGER)
+(GEVNAMECHARS 11 INTEGER)
+(GEVVALUECHARS 27 INTEGER)
+(GEVNAMEPOS (GEVNUMBERPOS + (IF GEVNUMBERCHARS > 0 THEN (GEVNUMBERCHARS + 1)
+ *WINDOWCHARWIDTH ELSE 0)) INTEGER)
+(GEVTILDEPOS (GEVNAMEPOS + (GEVNAMECHARS+1)
+ *WINDOWCHARWIDTH) INTEGER)
+(GEVVALUEPOS (GEVTILDEPOS + 2*WINDOWCHARWIDTH) INTEGER)
+)
+
+
+
+(GLISPOBJECTS
+
+
+(EDITCHAIN (LISTOF EDITFRAME)
+PROP ((TOPFRAME ((CAR self)))
+ (TOPITEM ((CAR TOPFRAME:PREVS)))))
+
+
+(EDITFRAME (LIST (PREVS (LISTOF GSEITEM))
+ (SUBITEMS (LISTOF GSEITEM))
+ (PROPS (LISTOF GSEITEM))))
+
+
+(GSEITEM (LIST (NAME ATOM)
+ (VALUE ANYTHING)
+ (TYPE ANYTHING)
+ (SHORTVALUE ATOM)
+ (NODETYPE ATOM)
+ (SUBVALUES (LISTOF GSEITEM))
+ (NAMEPOS VECTOR)
+ (VALUEPOS VECTOR))
+PROP ((NAMEAREA ((VIRTUAL REGION WITH START = NAMEPOS WIDTH =
+ WINDOWCHARWIDTH* (NCHARS NAME)
+ HEIGHT = WINDOWLINEYSPACING)))
+ (VALUEAREA ((VIRTUAL REGION WITH START = VALUEPOS WIDTH =
+ WINDOWCHARWIDTH* (NCHARS NAME)
+ HEIGHT = WINDOWLINEYSPACING)))))
+
+
+(MOUSESTATE (LIST (AREA REGION)
+ (ITEM GSEITEM)
+ (FLAG BOOLEAN)
+ (GROUP INTEGER)))
+
+)
+
+
+
+% GSN 9-FEB-83 11:40
+% GLISP Edit Value function. Edit VAL according to structure
+% description STR.
+(DF GEV (ARGS)
+(GEVA (CAR ARGS)
+ (EVAL (CAR ARGS))
+ (AND (CDR ARGS)
+ (COND ((OR (NOT (ATOM (CADR ARGS)))
+ (NOT (UNBOUNDP (CADR ARGS))))
+ (EVAL (CADR ARGS)))
+ (T (CADR ARGS))))))
+
+
+% edited: 15-MAR-83 10:40
+% GLISP Edit Value function. Edit VAL according to structure
+% description STR.
+(DG GEVA (VAR VAL STR)
+(PROG (GLNATOM TMP HEADER)
+ (GEVENTER)
+ (COND ((OR (NOT (NOT (UNBOUNDP 'GEVWINDOW)))
+ (NULL GEVWINDOW))
+ (GEVINITEDITWINDOW)))
+ (IF GEVMENUWINDOW THEN (SEND GEVMENUWINDOW OPEN))
+ (SEND GEVWINDOW OPEN)
+ (GEVACTIVEFLG_T)
+ (GEVEDITFLG_NIL)
+ (GLNATOM_0)
+ (GEVSHORTCHARS_GEVVALUECHARS)
+ (IF VAR IS A LIST AND (CAR VAR)
+ ='QUOTE THEN VAR_ (CONCAT "'" (GEVSTRINGIFY (CADR VAR))))
+ (IF ~STR THEN (IF VAL IS ATOMIC AND (GET VAL 'GLSTRUCTURE)
+ THEN STR_'GLTYPE ELSEIF (GEVGLISPP)
+ THEN STR_ (GLCLASS VAL)))
+ (HEADER_ (A GSEITEM WITH NAME = VAR VALUE = VAL TYPE = STR))
+ (GEVEDITCHAIN_ (LIST (LIST (LIST HEADER)
+ NIL NIL)))
+ (GEVREFILLWINDOW)
+ (GEVMOUSELOOP)
+ (GEVEXIT)))
+
+
+% GSN 2-MAR-83 14:06
+(DG GEVCOMMANDFN (COMMANDWORD:ATOM)
+(PROG (PL SUBPL PROPNAME VAL PROPNAMES TOPITEM)
+ (CASE COMMANDWORD OF (EDIT (GEVEDIT))
+ (QUIT (IF GEVMOUSEAREA THEN (SEND GEVWINDOW INVERTAREA
+ GEVMOUSEAREA:AREA)
+ (GEVMOUSEAREA_NIL)
+ ELSE
+ (GEVQUIT)))
+ (POP (GEVPOP T 1))
+ (PROGRAM (GEVPROGRAM))
+ ((PROP ADJ ISA MSG)
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (GEVCOMMANDPROP TOPITEM COMMANDWORD NIL))
+ ELSE
+ (ERROR 0 NIL))))
+
+
+% GSN 25-MAR-83 10:14
+(DG GEVCOMMANDPROP (ITEM:GSEITEM COMMANDWORD:ATOM PROPNAME:ATOM)
+(PROG (VAL PROPNAMES FLG)
+ (IF PROPNAME THEN FLG_T)
+ (IF ITEM:TYPE IS ATOMIC THEN (PROPNAMES_ (GEVCOMMANDPROPNAMES ITEM:TYPE
+ COMMANDWORD
+ GEVEDITCHAIN:TOPFRAME)))
+ (IF ITEM:TYPE IS ATOMIC OR COMMANDWORD='PROP THEN
+ (IF COMMANDWORD='PROP THEN (IF (CDR PROPNAMES)
+ THEN PROPNAMES+_'All)
+ PROPNAMES+_'self)
+ (IF ~PROPNAMES (RETURN NIL))
+ (IF ~PROPNAME (PROPNAME _ (SEND (A MENU WITH ITEMS = PROPNAMES)
+ SELECT)))
+ (IF ~PROPNAME (RETURN NIL)
+ ELSEIF PROPNAME='self THEN (PRIN1 PROPNAME)
+ (PRINC " = ")
+ (PRINT ITEM:VALUE)
+ ELSEIF COMMANDWORD='PROP AND PROPNAME='All THEN
+ (FOR X IN (OR (CDDR PROPNAMES)
+ (CDR PROPNAMES))
+ DO
+ (GEVDOPROP ITEM X COMMANDWORD FLG))
+ ELSE
+ (GEVDOPROP ITEM PROPNAME COMMANDWORD FLG))
+ (IF COMMANDWORD='MSG THEN (GEVREFILLWINDOW)
+ (GEVEDITFLG_T)))))
+
+
+% edited: 22-DEC-82 11:09
+% Get all property names of properties of type PROPTYPE for OBJ.
+% Properties are filtered to remove system properties and those
+% which are already displayed.
+(DG GEVCOMMANDPROPNAMES (OBJ:GLTYPE PROPTYPE:ATOM TOPFRAME:EDITFRAME)
+(PROG (RESULT TYPE)
+ (RESULT _ (FOR P IN (CASE PROPTYPE OF (PROP OBJ:PROPS)
+ (ADJ OBJ:ADJS)
+ (ISA OBJ:ISAS)
+ (MSG OBJ:MSGS))
+ WHEN ~ (PROPTYPE~='MSG AND
+ (THE PROP OF TOPFRAME WITH NAME =
+ (CAR P)))
+ AND ~ (PROPTYPE='PROP AND (MEMQ (CAR P)
+ '(SHORTVALUE DISPLAYPROPS)
+ ))
+ AND ~ (PROPTYPE='MSG
+ AND
+ (CADR P)
+ IS ATOMIC AND (~ (GETDDD (CADR P))
+ OR
+ (LENGTH (CADR (GETDDD (CADR P))))
+ >1))
+ COLLECT P:NAME))
+ (FOR S IN OBJ:SUPERS DO (RESULT _ (NCONC RESULT (GEVCOMMANDPROPNAMES
+ S PROPTYPE TOPFRAME))))
+ (RETURN RESULT)))
+
+
+% GSN 2-MAR-83 10:42
+% Compile a property whose name is PROPNAME and whose property type
+% (ADJ, ISA, PROP, MSG) is PROPTYPE for the object type STR.
+(DG GEVCOMPPROP (STR:GLTYPE PROPNAME:ATOM PROPTYPE:ATOM)
+(PROG (PROPENT)
+ (IF ~ (MEMQ PROPTYPE '(ADJ ISA PROP MSG))
+ (RETURN 'GEVERROR))
+
+% If the property is implemented by a named function, return the
+% function name.
+
+ (IF (PROPENT_ (GEVGETPROP STR PROPNAME PROPTYPE))
+ AND
+ (CADR PROPENT)
+ IS ATOMIC THEN (RETURN (CADR PROPENT)))
+
+% Compile code for this property and save it. First be sure the GLISP
+% compiler is loaded.
+
+ (RETURN (COND ((GEVGLISPP)
+ (GLCOMPPROP STR PROPNAME PROPTYPE)
+ OR
+ 'GEVERROR)
+ (T (ERROR 0 (LIST
+ "GLISP compiler must be loaded for PROPs which"
+
+ "are not specified with function name equivalents."
+ STR PROPTYPE PROPNAME)))))))
+
+
+% edited: 4-NOV-82 16:08
+% Get a flattened list of names and types from a given structure
+% description.
+(DG GEVDATANAMES (OBJ:GLTYPE FILTER:ATOM)
+(PROG (RESULT)
+ (GEVDATANAMESB OBJ:STRDES FILTER)
+ (RETURN (REVERSIP RESULT))))
+
+
+% GSN 4-FEB-83 17:39
+% Get a flattened list of names and types from a given structure
+% description.
+(DG GEVDATANAMESB (STR:ANYTHING FILTER:ATOM)
+(GLOBAL RESULT)(PROG (TMP)
+ (IF STR IS ATOMIC THEN (RETURN NIL)
+ ELSE
+ (CASE (CAR STR)
+ OF
+ (CONS (GEVDATANAMESB (CADR STR)
+ FILTER)
+ (GEVDATANAMESB (CADDR STR)
+ FILTER))
+ ((ALIST PROPLIST LIST)
+ (FOR X IN (CDR STR)
+ DO
+ (GEVDATANAMESB X FILTER)))
+ (RECORD (FOR X IN (CDDR STR)
+ DO
+ (GEVDATANAMESB X FILTER)))
+ (ATOM (GEVDATANAMESB (CADR STR)
+ FILTER)
+ (GEVDATANAMESB (CADDR STR)
+ FILTER))
+ (BINDING (GEVDATANAMESB (CADR STR)
+ FILTER))
+ (LISTOF (RETURN NIL))
+ ELSE
+ (IF (GEVFILTER (CADR STR)
+ FILTER)
+ THEN
+ (RESULT +_ (LIST (CAR STR)
+ (CADR STR))))
+ (GEVDATANAMESB (CADR STR)
+ FILTER)))))
+
+
+% GSN 25-MAR-83 09:48
+% Display a newly added property in the window.
+(DG GEVDISPLAYNEWPROP NIL
+(PROG (Y NEWONE:GSEITEM)
+ (Y_GEVWINDOWY)
+ (NEWONE_ (CAR (LASTPAIR GEVEDITCHAIN:TOPFRAME:PROPS)))
+ (GEVPPS NEWONE 0 GEVWINDOW)
+ (GEVWINDOWY_Y)))
+
+
+% GSN 4-FEB-83 16:58
+% Add the property PROPNAME of type COMMANDWORD to the display for
+% ITEM.
+(DG GEVDOPROP (ITEM:GSEITEM PROPNAME:ATOM COMMANDWORD:ATOM FLG:BOOLEAN)
+(PROG (VAL)
+ (VAL_ (GEVEXPROP ITEM:VALUE ITEM:TYPE PROPNAME COMMANDWORD NIL))
+ (GEVEDITCHAIN:TOPFRAME:PROPS_+ (A GSEITEM WITH NAME = PROPNAME TYPE =
+ (GEVPROPTYPE ITEM:TYPE PROPNAME
+ COMMANDWORD)
+ VALUE = VAL NODETYPE = COMMANDWORD))
+ (IF ~FLG THEN (GEVDISPLAYNEWPROP))))
+
+
+% GSN 25-MAR-83 09:48
+% Edit the currently displayed item.
+(DG GEVEDIT NIL
+(PROG (CHANGEDFLG GEVTOPITEM)
+ (GEVTOPITEM_GEVEDITCHAIN:TOPITEM)
+ (IF GEVTOPITEM:TYPE IS ATOMIC AND (GEVEXPROP GEVTOPITEM:VALUE
+ GEVTOPITEM:TYPE
+ 'EDIT
+ 'MSG
+ NIL)
+ ~='GEVERROR THEN CHANGEDFLG_T ELSEIF GEVTOPITEM:VALUE IS A LIST THEN
+ (EDITV GEVTOPITEM:VALUE)
+ (CHANGEDFLG_T)
+ ELSE
+ (RETURN NIL))
+ (IF CHANGEDFLG THEN (SEND GEVWINDOW OPEN)
+ (GEVREFILLWINDOW))
+ (GEVEDITFLG_CHANGEDFLG)))
+
+
+% GSN 25-MAR-83 09:49
+% Execute a property whose name is PROPNAME and whose property type
+% (ADJ, ISA, PROP, MSG) is PROPTYPE on the object OBJ whose type is
+% STR.
+(DG GEVEXPROP (OBJ STR PROPNAME:ATOM PROPTYPE:ATOM ARGS)
+(PROG (FN)
+ (IF ~ (MEMQ PROPTYPE '(ADJ ISA PROP MSG))
+ OR
+ (ARGS AND PROPTYPE~='MSG)
+ (RETURN 'GEVERROR))
+ (IF (FN_ (GEVCOMPPROP STR PROPNAME PROPTYPE))
+ ='GEVERROR THEN (RETURN FN)
+ ELSE
+ (RETURN (GEVAPPLY FN (CONS OBJ ARGS))))))
+
+
+% edited: 15-MAR-83 12:40
+% Fill the GEV editor window with the item which is at the top of
+% GEVEDITCHAIN.
+(DG GEVFILLWINDOW NIL
+(PROG (Y TOP)
+ (SEND GEVWINDOW CLEAR)
+
+% Compute an initial Y value for printing titles in the window.
+
+ (Y_GEVWINDOW:HEIGHT - WINDOWLINEYSPACING)
+
+% Print the titles from the edit chain first.
+
+ (GEVLASTITEMNUMBER _ 0)
+ (TOP_GEVEDITCHAIN:TOPFRAME)
+ (FOR X IN (REVERSE TOP:PREVS)
+ DO
+ (GEVPPS X 0 GEVWINDOW))
+ (GEVHORIZLINE GEVWINDOW)
+ (FOR X IN TOP:SUBITEMS DO (GEVPPS X 0 GEVWINDOW))
+ (GEVHORIZLINE GEVWINDOW)
+ (FOR X IN TOP:PROPS DO (GEVPPS X 0 GEVWINDOW))
+ (GEVWINDOWY_Y)))
+
+
+% GSN 21-JAN-83 10:24
+% Filter types according to a specified FILTER.
+(DG GEVFILTER (TYPE FILTER)
+(TYPE_ (GEVXTRTYPE TYPE))(CASE FILTER OF
+ (NUMBER ~ (MEMQ TYPE
+ '(ATOM STRING BOOLEAN ANYTHING))
+ AND ~ ((PAIRP TYPE)
+ AND
+ (CAR TYPE)
+ ='LISTOF))
+ (LIST (PAIRP TYPE)
+ AND
+ (CAR TYPE)
+ ='LISTOF)
+ ELSE T))
+
+
+% edited: 14-OCT-82 11:32
+(DG GEVFINDITEMPOS (POS:VECTOR ITEM:GSEITEM N:INTEGER)
+(RESULT MOUSESTATE)
+% Test whether ITEM contains the mouse position POS. The result is NIL
+% if not found, else a list of the sub-item and a flag which is NIL
+% if the NAME part is identified, T if the VALUE part is identified.
+(OR (GEVPOSTEST POS ITEM:NAMEPOS ITEM:NAME ITEM NIL N)
+ (GEVPOSTEST POS ITEM:VALUEPOS ITEM:SHORTVALUE ITEM T N)
+ ((ITEM:NODETYPE='STRUCTURE OR ITEM:NODETYPE='SUBTREE OR
+ ITEM:NODETYPE='LISTOF)
+ AND
+ (GEVFINDLISTPOS POS ITEM:SUBVALUES N))))
+
+
+% edited: 13-OCT-82 12:03
+(DG GEVFINDLISTPOS (POS:VECTOR ITEMS: (LISTOF GSEITEM)
+ N)
+(RESULT MOUSESTATE)
+% Find some ITEM corresponding to the mouse position POS.
+(IF ITEMS THEN (GEVFINDITEMPOS POS (CAR ITEMS)
+ N)
+ OR
+ (GEVFINDLISTPOS POS (CDR ITEMS)
+ N)))
+
+
+% edited: 13-OCT-82 12:06
+(DG GEVFINDPOS (POS:VECTOR FRAME:EDITFRAME)
+(RESULT MOUSESTATE)
+% Find the sub-item of FRAME corresponding to the mouse position POS.
+% The result is NIL if not found, else a list of the sub-item and a
+% flag which is NIL if the NAME part is identified, T if the VALUE
+% part is identified.
+(PROG (TMP N ITEMS: (LISTOF GSEITEM))
+ (N_0)
+ (WHILE FRAME AND ~TMP DO (N_+1)
+ ITEMS-_FRAME
+ (TMP_ (GEVFINDLISTPOS POS ITEMS N)))
+ (RETURN TMP)))
+
+
+% edited: 22-DEC-82 14:53
+% Get all names of properties and stored data from a GLISP object
+% type.
+(DG GEVGETNAMES (OBJ:GLTYPE FILTER:ATOM)
+(PROG (DATANAMES PROPNAMES)
+ (SETQ DATANAMES (GEVDATANAMES OBJ FILTER))
+ (SETQ PROPNAMES (GEVPROPNAMES OBJ 'PROP
+ FILTER))
+ (RETURN (NCONC DATANAMES PROPNAMES))))
+
+
+% GSN 4-FEB-83 16:59
+% Retrieve a GLISP property whose name is PROPNAME and whose property
+% type (ADJ, ISA, PROP, MSG) is PROPTYPE for the object type STR.
+(DG GEVGETPROP (STR PROPNAME:ATOM PROPTYPE:ATOM)
+(PROG (PL SUBPL PROPENT)
+ (IF ~ (MEMQ PROPTYPE '(ADJ ISA PROP MSG))
+ (ERROR 0 NIL))
+ (RETURN (AND (PL_ (GET STR 'GLSTRUCTURE))
+ (SUBPL_ (LISTGET (CDR PL)
+ PROPTYPE))
+ (PROPENT_ (ASSOC PROPNAME SUBPL))))))
+
+
+% edited: 11-NOV-82 15:53
+(DE GEVGLISPP NIL
+(NOT (UNBOUNDP 'GLBASICTYPES)))
+
+
+% edited: 6-APR-83 15:54
+(DG GEVHORIZLINE (W:WINDOW)
+(GLOBAL Y:INTEGER)
+% Draw a horizontal line across window W at Y and decrease Y.
+(SEND W DRAWLINE (A VECTOR WITH X = W:LEFTMARGIN Y = Y+WINDOWLINEYSPACING / 2)
+ (A VECTOR WITH X = W:RIGHTMARGIN Y = Y+WINDOWLINEYSPACING / 2))(
+ Y_-WINDOWLINEYSPACING))
+
+
+% edited: 11-MAR-83 16:03
+(DE GEVINIT NIL
+(SETQ GLNATOM 0)(COND ((NOT (NOT (UNBOUNDP 'GLLISPDIALECT)))
+ (SETQ GLLISPDIALECT 'INTERLISP)))(SETQ GEVWINDOW NIL))
+
+
+% GSN 25-MAR-83 10:14
+% Respond to an event which selects an item. GROUP gives the group in
+% which the item occurs. 1 = edit path. FLAG is T if the type of the
+% item is selected, NIL if the value is selected.
+(DG GEVITEMEVENTFN (ITEM:GSEITEM GROUP:INTEGER FLAG:BOOLEAN)
+(PROG (TMP TOP N)
+ (IF FLAG THEN (IF GROUP=1 THEN (TMP_GEVEDITCHAIN:TOPFRAME:PREVS)
+ (N_0)
+ (WHILE TMP AND (TOP-_TMP)
+ <>ITEM DO N_+1)
+ (GEVPOP NIL N)
+ ELSE
+ (GEVPUSH ITEM))
+ ELSE
+ (PRIN1 ITEM:NAME)
+ (PRINC " is ")
+ (PRIN1 ITEM:TYPE)
+ (TERPRI))))
+
+
+% GSN 2-MAR-83 16:14
+% Bound the length of VAL to NCHARS.
+(DG GEVLENGTHBOUND (VAL NCHARS)
+(COND ((GREATERP (FlatSize2 VAL)
+ NCHARS)
+ ((SUBSTRING VAL 1 (SUB1 NCHARS))
+ + "-"))
+ (T VAL)))
+
+
+% edited: 6-APR-83 16:01
+% Make a function to perform OPERATION on set SETNAME from INPUTTYPE
+% following PATH to get to the data.
+(DG GEVMAKENEWFN (OPERATION:ATOM INPUTTYPE:ATOM SET: (LIST (NAME ATOM)
+ (TYPE GLTYPE))
+ PATH:
+ (LISTOF (LIST (NAME ATOM)
+ (TYPE GLTYPE))))
+(PROG
+ (LASTPATH VIEWSPEC)
+ (SETQ LASTPATH (CAR (LASTPAIR PATH)))
+ (RETURN
+ (LIST
+ (LIST 'GLAMBDA
+ (LIST (MKATOM (CONCAT "GEVNEWFNTOP:" INPUTTYPE:PNAME)))
+ (LIST 'PROG
+ (CONS 'GEVNEWFNVALUE
+ (CASE OPERATION OF (COLLECT '(GEVNEWFNRESULT))
+ ((MAXIMUM MINIMUM)
+ '(GEVNEWFNTESTVAL GEVNEWFNINSTANCE))
+ (TOTAL '((GEVNEWFNSUM 0)))
+ (AVERAGE '((GEVNEWFNSUM 0.0)
+ (GEVNEWFNCOUNT 0)))
+ ELSE
+ (ERROR 0 NIL)))
+ (NCONC (LIST 'FOR
+ 'GEVNEWFNLOOPVAR
+ 'IN
+ (MKATOM (CONCAT "GEVNEWFNTOP:" SET:NAME:PNAME))
+ 'DO
+ (LIST 'GEVNEWFNVALUE
+ '_
+ (PROGN (VIEWSPEC _ (LIST 'GEVNEWFNLOOPVAR)
+ )
+ (FOR X IN PATH DO
+ (VIEWSPEC +_ 'OF)
+ (VIEWSPEC +_ X:NAME)
+ (VIEWSPEC +_ 'THE))
+ VIEWSPEC)))
+ (COPY (CASE OPERATION OF
+ (COLLECT '((GEVNEWFNRESULT +_
+ GEVNEWFNVALUE)))
+ (MAXIMUM '((IF ~ GEVNEWFNINSTANCE
+ OR GEVNEWFNVALUE >
+ GEVNEWFNTESTVAL
+ THEN (GEVNEWFNTESTVAL
+ _ GEVNEWFNVALUE)
+ (GEVNEWFNINSTANCE
+ _ GEVNEWFNLOOPVAR)))
+ )
+ (MINIMUM '((IF ~ GEVNEWFNINSTANCE
+ OR GEVNEWFNVALUE
+ < GEVNEWFNTESTVAL
+ THEN (GEVNEWFNTESTVAL
+ _ GEVNEWFNVALUE)
+ (GEVNEWFNINSTANCE
+ _ GEVNEWFNLOOPVAR)))
+ )
+ (AVERAGE '((GEVNEWFNSUM _+
+ GEVNEWFNVALUE)
+ (GEVNEWFNCOUNT _+
+ 1)))
+ (TOTAL '((GEVNEWFNSUM _+
+ GEVNEWFNVALUE))))))
+ (LIST 'RETURN
+ (CASE OPERATION OF (COLLECT '(DREVERSE GEVNEWFNRESULT))
+ ((MAXIMUM MINIMUM)
+ '(LIST GEVNEWFNTESTVAL GEVNEWFNINSTANCE))
+ (AVERAGE '(QUOTIENT GEVNEWFNSUM (FLOAT
+ GEVNEWFNCOUNT)))
+ (TOTAL 'GEVNEWFNSUM)))))
+ (CASE OPERATION OF (COLLECT (LIST 'LISTOF
+ (CADR LASTPATH)))
+ ((MAXIMUM MINIMUM)
+ (LIST 'LIST
+ (COPY LASTPATH)
+ (LIST 'WINNER
+ (CADR SET:TYPE))))
+ (AVERAGE 'REAL)
+ (TOTAL (CADR LASTPATH)))))))
+
+
+% edited: 8-OCT-82 10:43
+(DG GEVMATCH (STR VAL FLG)
+(RESULT (LISTOF GSEITEM))
+% Match a structure description, STR, and a value VAL which matches
+% that description, to form a structure editor tree structure.
+(PROG (RESULT)
+ (GEVMATCHB STR VAL NIL FLG)
+ (RETURN (REVERSIP RESULT))))
+
+
+% edited: 8-OCT-82 10:01
+% Make a single item which matches structure STR and value VAL.
+(DG GEVMATCHA (STR VAL FLG)
+(PROG (RES)
+ (RES_ (GEVMATCH STR VAL FLG))
+ (IF ~ (CDR RES)
+ THEN
+ (RETURN (CAR RES))
+ ELSE
+ (RETURN (A GSEITEM WITH VALUE = VAL TYPE = STR SUBVALUES = RES
+ NODETYPE = 'SUBTREE)))))
+
+
+% edited: 7-OCT-82 16:38
+% Match an ATOM structure to a given value.
+(DG GEVMATCHATOM (STR VAL NAME)
+(PROG (L STRB TMP)
+ (IF VAL IS NOT ATOMIC OR VAL IS NULL THEN (RETURN NIL))
+ (STRB_ (CADR STR))
+ (IF (CAR STRB)
+ ~='PROPLIST THEN (RETURN NIL))
+ (L_ (CDR STRB))
+ (FOR X IN L DO (IF TMP_ (GET VAL (CAR X))
+ THEN
+ (GEVMATCHB X TMP NIL NIL)))))
+
+
+% edited: 7-OCT-82 16:57
+% Match an ALIST structure to a given value.
+(DG GEVMATCHALIST (STR VAL NAME)
+(PROG (L TMP)
+ (L_ (CDR STR))
+ (FOR X IN L DO (IF TMP_ (ASSOC (CAR X)
+ VAL)
+ THEN
+ (GEVMATCHB X (CDR TMP)
+ NIL NIL)))))
+
+
+% edited: 22-DEC-82 15:26
+% Match a structure description, STR, and a value VAL which matches
+% that description, to form a structure editor tree structure. If
+% FLG is set, the match will descend inside an atomic type name.
+% Results are added to the free variable RESULT.
+(DG GEVMATCHB (STR: (LISTOF ANYTHING)
+ VAL NAME:ATOM FLG:BOOLEAN)
+(GLOBAL RESULT)(PROG (X Y STRB XSTR TOP TMP)
+ (XSTR_ (GEVXTRTYPE STR))
+ (IF STR IS ATOMIC THEN
+ (IF FLG AND (STRB _ (CAR (GET STR 'GLSTRUCTURE)))
+ THEN
+ (RESULT +_
+ (A GSEITEM WITH NAME = NAME VALUE = VAL
+ SUBVALUES = (GEVMATCH STRB VAL NIL)
+ TYPE = STR NODETYPE = 'STRUCTURE))
+ ELSE
+ (RESULT +_
+ (A GSEITEM WITH NAME = NAME VALUE = VAL
+ TYPE = STR)))
+ (RETURN NIL)
+ ELSE
+ (CASE (CAR STR)
+ OF
+ (CONS (GEVMATCHB (CADR STR)
+ (CAR VAL)
+ NIL NIL)
+ (GEVMATCHB (CADDR STR)
+ (CDR VAL)
+ NIL NIL))
+ (LIST (FOR X IN (CDR STR)
+ DO
+ (IF VAL (GEVMATCHB X (CAR VAL)
+ NIL NIL)
+ (VAL_ (CDR VAL)))))
+ (ATOM (GEVMATCHATOM STR VAL NAME))
+ (ALIST (GEVMATCHALIST STR VAL NAME))
+ (PROPLIST (GEVMATCHPROPLIST STR VAL NAME))
+ (LISTOF (GEVMATCHLISTOF STR VAL NAME))
+ (RECORD (GEVMATCHRECORD STR VAL NAME))
+ ((OBJECT ATOMOBJECT LISTOBJECT)
+ (GEVMATCHOBJECT STR VAL NAME))
+ ELSE
+ (IF NAME THEN (TMP _ (GEVMATCH STR VAL NIL))
+ (TOP_ (CAR TMP))
+ (RESULT +_
+ (IF ~ (CDR TMP)
+ AND ~TOP:NAME THEN (
+ TOP:NAME_NAME)
+ TOP ELSE
+ (A GSEITEM WITH NAME = NAME
+ VALUE = VAL SUBVALUES = TMP
+ TYPE = XSTR NODETYPE =
+ 'SUBTREE)))
+ ELSEIF
+ (STRB _ (GEVXTRTYPE (CADR STR)))
+ IS ATOMIC THEN (GEVMATCHB STRB VAL
+ (CAR STR)
+ NIL)
+ ELSEIF
+ (TMP_ (GEVMATCH (CADR STR)
+ VAL NIL))
+ THEN
+ (TOP_ (CAR TMP))
+ (RESULT +_
+ (IF ~ (CDR TMP)
+ AND ~TOP:NAME THEN
+ (TOP:NAME_ (CAR STR))
+ TOP ELSE
+ (A GSEITEM WITH NAME =
+ (CAR STR)
+ VALUE = VAL SUBVALUES = TMP
+ TYPE = (CADR STR)
+ NODETYPE = 'SUBTREE)))
+ ELSE
+ (PRINT "GEVMATCHB Failed"))))))
+
+
+% edited: 8-OCT-82 10:15
+% Match a LISTOF structure.
+(DG GEVMATCHLISTOF (STR VAL NAME)
+(GLOBAL RESULT)(RESULT+_ (A GSEITEM WITH NAME = NAME VALUE = VAL TYPE = STR)))
+
+
+% edited: 22-DEC-82 10:04
+% Match the OBJECT structures.
+(DG GEVMATCHOBJECT (STR VAL NAME)
+(GLOBAL RESULT)(PROG (OBJECTTYPE TMP)
+ (SETQ OBJECTTYPE (CAR STR))
+ (RESULT _+ (A GSEITEM WITH NAME = 'CLASS
+ VALUE = (CASE OBJECTTYPE OF ((OBJECT
+ LISTOBJECT)
+ (TMP-_VAL))
+ (ATOMOBJECT
+ (GET VAL 'CLASS)))
+ TYPE = 'GLTYPE))
+ (FOR X IN (CDR STR)
+ DO
+ (CASE OBJECTTYPE OF ((OBJECT LISTOBJECT)
+ (IF VAL (GEVMATCHB X (TMP-_VAL)
+ NIL NIL)))
+ (ATOMOBJECT (IF TMP_ (GET VAL (CAR X))
+ THEN
+ (GEVMATCHB X TMP NIL NIL)))))))
+
+
+% edited: 24-NOV-82 16:31
+% Match an PROPLIST structure to a given value.
+(DG GEVMATCHPROPLIST (STR VAL NAME)
+(PROG (L TMP)
+ (L_ (CDR STR))
+ (FOR X IN L DO (IF TMP_ (LISTGET VAL (CAR X))
+ THEN
+ (GEVMATCHB X TMP NIL NIL)))))
+
+
+% edited: 11-MAR-83 16:31
+% Match a RECORD structure.
+(DG GEVMATCHRECORD (STR VAL NAME)
+(PROG (STRNAME FIELDS N)
+ (IF (CADR STR)
+ IS ATOMIC THEN STRNAME_ (CADR STR)
+ FIELDS_
+ (CDDR STR)
+ ELSE FIELDS_ (CDR STR))
+ (N_0)
+ (FOR X IN FIELDS DO (N_+1)
+ (GEVMATCHB X (GetV VAL N)
+ (CAR X)
+ NIL))))
+
+
+% GSN 2-MAR-83 17:33
+% Pop up from the current item to the previous one. If FLG is set,
+% popping continues through extended LISTOF elements.
+(DG GEVPOP (FLG:BOOLEAN N:INTEGER)
+(PROG (TMP TOP:GSEITEM TMPITEM)
+ (IF N<1 (RETURN NIL))
+ LP
+ (TMP-_GEVEDITCHAIN)
+ (IF ~GEVEDITCHAIN THEN (RETURN (GEVQUIT)))
+ (TOP_ (CAAAR GEVEDITCHAIN))
+
+% Test for repeated LISTOF elements.
+
+ (TMPITEM_ (CAR TMP:PREVS))
+ (IF FLG AND TMPITEM:NODETYPE='FORWARD THEN (GO LP))
+ (IF (N_-1)
+ >0 THEN (GO LP))
+ (IF TOP:TYPE IS A LIST AND (CAR TOP:TYPE)
+ ='LISTOF AND ~ (CDR TOP:VALUE)
+ THEN
+ (GO LP))
+ (IF GEVEDITFLG AND ~ (MEMBER TMPITEM:SHORTVALUE '("(...)" "---"))
+ THEN
+ (GEVREFILLWINDOW)
+ ELSE GEVEDITFLG_NIL (GEVFILLWINDOW))))
+
+
+% edited: 11-MAR-83 15:06
+(DG GEVPOSTEST (POS:VECTOR TPOS:VECTOR NAME:STRING ITEM:GSEITEM FLG N:INTEGER)
+(RESULT MOUSESTATE)
+% Test whether TPOS contains the mouse position POS. The result is NIL
+% if not found, else a list of the sub-item and a flag which is NIL
+% if the NAME part is identified, T if the VALUE part is identified.
+(IF POS:Y>=TPOS:Y AND POS:Y<=TPOS:Y+WINDOWLINEYSPACING AND POS:X>=TPOS:X AND
+ POS:X<TPOS:X+GEVNAMECHARS*WINDOWCHARWIDTH THEN
+ (A MOUSESTATE WITH AREA =
+ (A REGION WITH START =
+ (A VECTOR WITH X = TPOS:X Y = TPOS:Y - 1)
+ SIZE = (A VECTOR WITH X = WINDOWCHARWIDTH*NAME:LENGTH Y =
+ WINDOWLINEYSPACING))
+ ITEM = ITEM FLAG = FLG GROUP = N)))
+
+
+% edited: 15-MAR-83 12:38
+(DG GEVPPS (ITEM:GSEITEM COL:INTEGER WINDOW:WINDOW)
+(GLOBAL Y:INTEGER)
+% Pretty-print a structure defined by ITEM in the window WINDOW,
+% beginning ar horizontal column COL and vertical position Y. The
+% positions in ITEM are modified to match the positions in the
+% window.
+(PROG (NAMEX TOP)
+
+% Make sure there is room in window.
+
+ (IF Y<0 THEN (RETURN NIL))
+ (IF GEVNUMBERCHARS>0 THEN (GEVLASTITEMNUMBER _+ 1)
+ (SEND WINDOW PRINTAT (GEVSTRINGIFY GEVLASTITEMNUMBER)
+ (A VECTOR WITH X = GEVNUMBERPOS Y = Y)))
+
+% Position in window for slot name.
+
+ (NAMEX _ GEVNAMEPOS + COL*WINDOWCHARWIDTH)
+ (ITEM:NAMEPOS:X_NAMEX)
+ (ITEM:NAMEPOS:Y_Y)
+ (IF ITEM:NODETYPE='FULLVALUE THEN
+ (SEND WINDOW PRINTAT "(expanded)"
+ (A VECTOR WITH X = NAMEX Y = Y))
+ ELSEIF ITEM:NAME THEN
+ (IF ITEM:NAME IS NUMERIC THEN
+ (SEND WINDOW PRINTAT "#"
+ (A VECTOR WITH X = NAMEX Y = Y))
+ (NAMEX_+WINDOWCHARWIDTH))
+ (SEND WINDOW PRINTAT (GEVLENGTHBOUND ITEM:NAME GEVNAMECHARS)
+ (A VECTOR WITH X = NAMEX Y = Y)))
+
+% See if there is a value to print for this name.
+
+ (IF ~ITEM:NODETYPE OR (MEMQ ITEM:NODETYPE
+ '(FORWARD BACKUP PROP ADJ MSG ISA))
+ THEN
+ (ITEM:VALUEPOS:X_GEVVALUEPOS)
+ (ITEM:VALUEPOS:Y_Y)
+ (SEND WINDOW PRINTAT (ITEM:SHORTVALUE OR
+ (ITEM:SHORTVALUE
+ _
+ (GEVSHORTVALUE ITEM:VALUE
+ ITEM:TYPE
+ (GEVSHORTCHARS
+ - COL))))
+ (A VECTOR WITH X = GEVVALUEPOS Y = Y))
+ (IF ~ (EQ ITEM:SHORTVALUE ITEM:VALUE)
+ THEN
+ (SEND WINDOW PRINTAT "~"
+ (A VECTOR WITH X = GEVTILDEPOS Y = Y)))
+ (Y_-WINDOWLINEYSPACING)
+ ELSEIF ITEM:NODETYPE='FULLVALUE THEN (Y_-WINDOWLINEYSPACING)
+ (SEND WINDOW PRETTYPRINTAT ITEM:VALUE
+ (A VECTOR WITH X = WINDOWCHARWIDTH Y = Y))
+ (Y_WINDOW:YPOSITION - WINDOWLINEYSPACING)
+ ELSEIF ITEM:NODETYPE='DISPLAY THEN (GEVEXPROP ITEM:VALUE ITEM:TYPE
+ 'GEVDISPLAY
+ 'MSG
+ (LIST WINDOW Y))
+ ELSE
+
+% This is a subtree
+
+ (Y_-WINDOWLINEYSPACING)
+ (FOR VSUB IN ITEM:SUBVALUES DO (GEVPPS VSUB COL+2 WINDOW)))))
+
+
+% edited: 6-APR-83 16:03
+% Write an interactive program involving the current item.
+(DG GEVPROGRAM NIL
+(PROG (TOPITEM COMMAND SET PATH DONE NEXT TYPE NEWFN RESULT LAST ABORTFLG)
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (IF (COMMAND_ (SEND (A MENU WITH ITEMS =
+ '(Quit COLLECT TOTAL AVERAGE MAXIMUM MINIMUM))
+ SELECT))
+ ='Quit OR ~ COMMAND THEN (RETURN NIL))
+ (IF (SET_ (GEVPROPMENU TOPITEM:TYPE 'LIST
+ NIL))
+ ='Quit OR SET='Pop OR ~SET THEN (RETURN NIL))
+ (PATH_ (LIST SET (LIST TOPITEM:NAME TOPITEM:TYPE)))
+ (NEXT_SET)
+ (TYPE_ (CADADR SET))
+ (WHILE ~DONE AND ~ABORTFLG DO (NEXT_ (GEVPROPMENU TYPE
+ (COMMAND~='COLLECT
+ AND
+ 'NUMBER)
+ COMMAND='COLLECT))
+ (IF NEXT IS ATOMIC THEN
+ (CASE NEXT OF ((NIL Quit)
+ (ABORTFLG_T))
+ (Pop (IF ~ (CDDR PATH)
+ THEN
+ (ABORTFLG_T)
+ ELSE
+ (NEXT-_PATH)
+ (NEXT_ (CAR PATH))
+ (TYPE_ (CADR NEXT))
+ (IF TYPE IS A LIST THEN TYPE_ (CADR TYPE))
+ (LAST_ (CAR NEXT))))
+ (Done (DONE_T)))
+ ELSE
+ (PATH+_NEXT)
+ (TYPE_ (CADR NEXT))
+ (LAST_ (CAR NEXT)))
+ (IF (MEMQ TYPE '(ATOM INTEGER STRING REAL BOOLEAN NIL))
+ DONE_T))
+ (IF ABORTFLG (RETURN NIL))
+ (PATH_ (REVERSIP PATH))
+ (NEWFN_ (GEVMAKENEWFN COMMAND TOPITEM:TYPE SET (CDDR PATH)))
+ (GEVPUTD 'GEVNEWFN
+ (CAR NEWFN))
+ (RESULT_ (GEVNEWFN TOPITEM:VALUE))
+
+% Print result as well as displaying it.
+
+ (PRIN1 COMMAND)
+ (SPACES 1)
+ (FOR X IN (CDDR PATH)
+ DO
+ (PRIN1 (CAR X))
+ (SPACES 1))
+ (PRINC "OF ")
+ (PRIN1 (CAAR PATH))
+ (SPACES 1)
+ (PRIN1 (CAADR PATH))
+ (PRINC " = ")
+ (PRINT RESULT)
+ (GEVEDITCHAIN:TOPFRAME:PROPS_+ (A GSEITEM WITH NAME =
+ (CONCAT (GEVSTRINGIFY COMMAND)
+ (CONCAT " " (GEVSTRINGIFY
+ LAST)))
+ TYPE = (CADR NEWFN)
+ VALUE = RESULT NODETYPE =
+ 'MSG))
+ (GEVDISPLAYNEWPROP)))
+
+
+% GSN 21-JAN-83 10:32
+% Make a menu to get properties of object OBJ with filter FILTER. FLG
+% is T if it is okay to stop before reaching a basic type.
+(DG GEVPROPMENU (OBJ:GLTYPE FILTER:ATOM FLG:BOOLEAN)
+(PROG (PROPS SEL PNAMES MENU)
+ (PROPS_ (GEVGETNAMES OBJ FILTER))
+ (IF ~PROPS THEN (RETURN NIL)
+ ELSE
+ (PNAMES_ (MAPCAR PROPS (FUNCTION CAR)))
+ (SEL_ (SEND (A MENU WITH ITEMS =
+ (CONS 'Quit
+ (CONS 'Pop
+ (IF FLG THEN (CONS 'Done
+ PNAMES)
+ ELSE PNAMES))))
+ SELECT))
+ (RETURN (CASE SEL OF ((Quit Pop Done NIL)
+ SEL)
+ ELSE
+ (ASSOC SEL PROPS))))))
+
+
+% GSN 4-FEB-83 17:01
+% Get all property names and types of properties of type PROPTYPE for
+% OBJ when they satisfy FILTER.
+(DG GEVPROPNAMES (OBJ:GLTYPE PROPTYPE:ATOM FILTER:ATOM)
+(PROG (RESULT TYPE)
+ (RESULT _ (FOR P IN (CASE PROPTYPE OF (PROP OBJ:PROPS)
+ (ADJ OBJ:ADJS)
+ (ISA OBJ:ISAS)
+ (MSG OBJ:MSGS))
+ WHEN
+ (TYPE_ (GEVPROPTYPES OBJ P:NAME 'PROP))
+ AND
+ (GEVFILTER TYPE FILTER)
+ COLLECT
+ (LIST P:NAME TYPE)))
+ (FOR S IN OBJ:SUPERS DO (RESULT _ (NCONC RESULT (GEVPROPNAMES S PROPTYPE
+ FILTER))))
+ (RETURN RESULT)))
+
+
+% GSN 4-FEB-83 17:02
+% Find the type of a computed property.
+(DG GEVPROPTYPE (STR:ATOM PROPNAME:ATOM PROPTYPE:ATOM)
+(PROG (PL SUBPL PROPENT TMP)
+ (IF STR IS NOT ATOMIC THEN (RETURN NIL)
+ ELSEIF
+ (PROPENT_ (GEVGETPROP STR PROPNAME PROPTYPE))
+ AND
+ (TMP_ (LISTGET (CDDR PROPENT)
+ 'RESULT))
+ THEN
+ (RETURN TMP)
+ ELSEIF PROPENT AND (CADR PROPENT)
+ IS ATOMIC AND (TMP_ (GET (CADR PROPENT)
+ 'GLRESULTTYPE))
+ THEN
+ (RETURN TMP)
+ ELSEIF
+ (AND (PL_ (GET STR 'GLPROPFNS))
+ (SUBPL_ (ASSOC PROPTYPE PL))
+ (PROPENT_ (ASSOC PROPNAME (CDR SUBPL)))
+ (TMP_ (CADDR PROPENT)))
+ THEN
+ (RETURN TMP)
+ ELSEIF PROPTYPE='ADJ THEN (RETURN 'BOOLEAN))))
+
+
+% edited: 4-NOV-82 15:39
+(DE GEVPROPTYPES (OBJ NAME TYPE)
+(OR (GEVPROPTYPE OBJ NAME TYPE)
+ (AND (GEVCOMPPROP OBJ NAME TYPE)
+ (GEVPROPTYPE OBJ NAME TYPE))))
+
+
+% GSN 2-MAR-83 17:32
+% Push down to look at an item referenced from the current item.
+(DG GEVPUSH (ITEM:GSEITEM)
+(PROG (NEWITEMS TOPITEM LSTITEM:GSEITEM)
+ (IF ITEM:NODETYPE='BACKUP THEN (GEVPOP NIL 1)
+ (RETURN NIL))
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (IF ITEM:NODETYPE='FORWARD THEN (NEWITEMS_ (GEVPUSHLISTOF ITEM T))
+ ELSEIF ITEM:TYPE IS ATOMIC AND ~ (GET ITEM:TYPE 'GLSTRUCTURE)
+ THEN
+ (CASE ITEM:TYPE OF
+ ((ATOM NUMBER REAL INTEGER STRING ANYTHING)
+ (IF ITEM:VALUE=ITEM:SHORTVALUE THEN (RETURN NIL)
+ ELSE
+ (NEWITEMS_ (LIST (A GSEITEM WITH NAME = ITEM:NAME VALUE =
+ ITEM:VALUE SHORTVALUE =
+ ITEM:SHORTVALUE TYPE = ITEM:TYPE
+ NODETYPE = 'FULLVALUE)))))
+ ELSE
+ (RETURN NIL))
+ ELSEIF ITEM:TYPE IS A LIST AND (CAR ITEM:TYPE)
+ ='LISTOF THEN (NEWITEMS_ (GEVPUSHLISTOF ITEM NIL)))
+ (GEVEDITCHAIN+_ (AN EDITFRAME WITH PREVS = (CONS ITEM
+ GEVEDITCHAIN:TOPFRAME:PREVS)
+ SUBITEMS = NEWITEMS))
+
+% Do another PUSH automatically for a list of only one item.
+
+ (GEVREFILLWINDOW)
+ (IF ITEM:TYPE IS A LIST AND (CAR ITEM:TYPE)
+ ='LISTOF AND ~ (CDR ITEM:VALUE)
+ THEN
+ (LSTITEM_ (CAADAR GEVEDITCHAIN))
+ (GEVPUSH (CAR LSTITEM:SUBVALUES))
+ (RETURN NIL))))
+
+
+% edited: 6-APR-83 16:04
+% Push into a datum of type LISTOF, expanding it into the individual
+% elements. If FLG is set, ITEM is a FORWARD item to be continued.
+(DG GEVPUSHLISTOF (ITEM:GSEITEM FLG:BOOLEAN)
+(PROG (ITEMTYPE TOPFRAME N:INTEGER NROOM LST VALS: (LISTOF ANYTHING) TMP)
+
+
+% Compute the vertical room available in the window.
+
+ (IF ~ITEM:VALUE (RETURN NIL))
+ (TOPFRAME_GEVEDITCHAIN:TOPFRAME)
+ (NROOM _ GEVWINDOW:HEIGHT / WINDOWLINEYSPACING - 4 - (LENGTH
+ TOPFRAME:PREVS))
+
+% If there was a previous display of this list, insert an ellipsis
+% header.
+
+ (IF FLG THEN (LST+_ (A GSEITEM WITH SHORTVALUE = "(..." NODETYPE =
+ 'BACKUP))
+ (N_ITEM:NAME)
+ (ITEMTYPE_ITEM:TYPE)
+ (NROOM_-1)
+ (VALS_ITEM:SUBVALUES)
+ ELSE
+ (N_1)
+ (ITEMTYPE_ (CADR ITEM:TYPE))
+ (VALS_ITEM:VALUE))
+
+% Now make entries for each value on the list.
+
+ (WHILE VALS AND (NROOM>1 OR (NROOM=1 AND ~ (CDR VALS)))
+ DO
+ (LST+_ (A GSEITEM WITH VALUE = (TMP-_VALS)
+ TYPE = ITEMTYPE NAME = N))
+ (NROOM_-1)
+ (N_+1))
+ (IF VALS THEN (LST+_ (A GSEITEM WITH SHORTVALUE = "...)" NODETYPE =
+ 'FORWARD
+ TYPE = ITEMTYPE NAME = N SUBVALUES = VALS)))
+ (RETURN (LIST (A GSEITEM WITH NAME = "expanded" TYPE = ITEMTYPE NODETYPE
+ = 'LISTOF
+ SUBVALUES = (REVERSIP LST))))))
+
+
+% edited: 14-MAR-83 16:46
+(DG GEVQUIT NIL
+(SETQ GEVACTIVEFLG NIL)(SEND GEVWINDOW CLOSE)(IF GEVMENUWINDOW THEN
+ (SEND GEVMENUWINDOW CLOSE)))
+
+
+% edited: 19-OCT-82 10:23
+% Recompute property values for the item.
+(DG GEVREDOPROPS (TOP:EDITFRAME)
+(PROG (ITEM L)
+ (ITEM_ (CAR TOP:PREVS))
+ (IF ~TOP:PROPS AND (L_ (GEVEXPROP ITEM:VALUE ITEM:TYPE 'DISPLAYPROPS
+ 'PROP
+ NIL))
+ ~='GEVERROR THEN (IF L IS ATOMIC THEN (GEVCOMMANDPROP ITEM
+ 'PROP
+ 'All)
+ ELSEIF L IS A LIST THEN
+ (FOR X IN L (GEVCOMMANDPROP ITEM 'PROP
+ X)))
+ ELSE
+ (FOR X IN TOP:PROPS WHEN X:NODETYPE~='MSG DO
+ (X:VALUE _ (GEVEXPROP ITEM:VALUE ITEM:TYPE X:NAME X:NODETYPE
+ NIL))
+ (X:SHORTVALUE _ NIL)))))
+
+
+% edited: 14-OCT-82 12:46
+% Re-expand the top item of GEVEDITCHAIN, which may have been changed
+% due to editing.
+(DG GEVREFILLWINDOW NIL
+(PROG (TOP TOPITEM SUBS TOPSUB)
+ (TOP_GEVEDITCHAIN:TOPFRAME)
+ (TOPITEM_GEVEDITCHAIN:TOPITEM)
+ (TOPSUB_ (CAR TOP:SUBITEMS))
+ (IF ~TOPSUB OR (TOPSUB:NODETYPE~='FULLVALUE AND TOPSUB:NODETYPE~='LISTOF)
+ THEN
+ (IF (GEVGETPROP TOPITEM:TYPE 'GEVDISPLAY
+ 'MSG)
+ THEN
+ (TOP:SUBITEMS_ (LIST (A GSEITEM WITH VALUE = TOPITEM:VALUE TYPE
+ = TOPITEM:TYPE NODETYPE = 'DISPLAY)))
+ ELSE
+ (SUBS_ (GEVMATCH TOPITEM:TYPE TOPITEM:VALUE T))
+ (TOPSUB_ (CAR SUBS))
+ (TOP:SUBITEMS_ (IF ~ (CDR SUBS)
+ AND TOPSUB:NODETYPE='STRUCTURE AND
+ TOPSUB:VALUE=TOPITEM:VALUE AND
+ TOPSUB:TYPE=TOPITEM:TYPE THEN
+ TOPSUB:SUBVALUES ELSE SUBS))))
+ (GEVREDOPROPS TOP)
+ (GEVFILLWINDOW)))
+
+
+% edited: 6-APR-83 16:05
+(DE GEVSHORTATOMVAL (ATM NCHARS)
+(COND ((NUMBERP ATM)
+ (COND ((GREATERP (FlatSize2 ATM)
+ NCHARS)
+ (GEVSHORTSTRINGVAL (GEVSTRINGIFY ATM)
+ NCHARS))
+ (T ATM)))
+ ((GREATERP (FlatSize2 ATM)
+ NCHARS)
+ (CONCAT (SUBSTRING ATM 1 (SUB1 NCHARS))
+ "-"))
+ (T ATM)))
+
+
+% GSN 4-APR-83 16:23
+% Compute a short value for printing a CONS of two items.
+(DG GEVSHORTCONSVAL (VAL STR NCHARS:INTEGER)
+(PROG (NLEFT RES TMP NC)
+ (RES +_ "(")
+ (NLEFT _ NCHARS - 5)
+ (TMP_ (GEVSHORTVALUE (CAR VAL)
+ (CADR STR)
+ NLEFT - 3))
+ (NC_ (FlatSize2 TMP))
+ (IF NC>NLEFT - 3 THEN TMP_ "---" NC_3)
+ (RES+_ (GEVSTRINGIFY TMP))
+ (RES +_ " . ")
+ (NLEFT_-NC)
+ (TMP_ (GEVSHORTVALUE (CDR VAL)
+ (CADDR STR)
+ NLEFT))
+ (NC_ (FlatSize2 TMP))
+ (IF NC>NLEFT THEN TMP_ "---" NC_3)
+ (RES+_ (GEVSTRINGIFY TMP))
+ (RES+_ ")")
+ (RETURN (GEVCONCAT (REVERSIP RES)))))
+
+
+% GSN 4-APR-83 16:24
+% Compute a short value for printing a list of items.
+(DG GEVSHORTLISTVAL (VAL STR NCHARS:INTEGER)
+(PROG (NLEFT RES TMP QUIT NC NCI REST RSTR)
+ (RES +_ "(")
+ (REST_4)
+ (NLEFT _ NCHARS - 2)
+ (RSTR_ (CDR STR))
+ (WHILE VAL AND ~QUIT AND (NCI_ (IF (CDR VAL)
+ THEN NLEFT - REST ELSE NLEFT))
+ >2 DO (TMP_ (GEVSHORTVALUE (CAR VAL)
+ (IF (CAR STR)
+ ='LISTOF THEN (CADR STR)
+ ELSEIF
+ (CAR STR)
+ ='LIST THEN (CAR RSTR))
+ NCI))
+ (QUIT _ (MEMBER TMP '(GEVERROR "(...)" "---" "???")))
+ (NC_ (FlatSize2 TMP))
+ (IF NC>NCI AND (CDR RES)
+ THEN QUIT_T ELSE (IF NC>NCI THEN TMP_ "---" NC_3 QUIT_T)
+ (RES+_ (GEVSTRINGIFY TMP))
+ (NLEFT_-NC)
+ (VAL_ (CDR VAL))
+ (RSTR_ (CDR RSTR))
+ (IF VAL THEN (RES+_ " ")
+ (NLEFT_-1))))
+ (IF VAL THEN (RES+_ "..."))
+ (RES+_ ")")
+ (RETURN (GEVCONCAT (REVERSIP RES)))))
+
+
+% edited: 12-OCT-82 12:14
+% Compute the short value of a string VAL. The result is a string
+% which can be printed within NCHARS.
+(DE GEVSHORTSTRINGVAL (VAL NCHARS)
+(COND ((STRINGP VAL)
+ (GEVLENGTHBOUND VAL NCHARS))
+ (T "???")))
+
+
+% edited: 11-MAR-83 15:34
+% Compute the short value of a given value VAL whose type is STR. The
+% result is an atom, string, or list structure which can be printed
+% within NCHARS.
+(DE GEVSHORTVALUE (VAL STR NCHARS)
+(PROG (TMP)
+ (SETQ STR (GEVXTRTYPE STR))
+ (RETURN (COND ((AND (ATOM STR)
+ (MEMQ STR '(ATOM INTEGER REAL)))
+ (GEVSHORTATOMVAL VAL NCHARS))
+ ((EQ STR 'STRING)
+ (GEVSHORTSTRINGVAL VAL NCHARS))
+ ((AND (ATOM STR)
+ (NE (SETQ TMP (GEVEXPROP VAL STR 'SHORTVALUE
+ 'PROP
+ NIL))
+ 'GEVERROR))
+ (GEVLENGTHBOUND TMP NCHARS))
+ ((OR (ATOM VAL)
+ (NUMBERP VAL))
+ (GEVSHORTATOMVAL VAL NCHARS))
+ ((STRINGP VAL)
+ (GEVSHORTSTRINGVAL VAL NCHARS))
+ ((PAIRP STR)
+ (CASEQ (CAR STR)
+ ((LISTOF LIST)
+ (COND ((PAIRP VAL)
+ (GEVSHORTLISTVAL VAL STR NCHARS))
+ (T "???")))
+ (CONS (COND ((PAIRP VAL)
+ (GEVSHORTCONSVAL VAL STR NCHARS))
+ (T "???")))
+ (T "---")))
+ ((PAIRP VAL)
+ (GEVSHORTLISTVAL VAL '(LISTOF ANYTHING)
+ NCHARS))
+ (T "---")))))
+
+
+% edited: 21-OCT-82 11:17
+% Extract an atomic type name from a type spec which may be either
+% <type> or (A <type>) .
+(DE GEVXTRTYPE (TYPE)
+(COND ((ATOM TYPE)
+ TYPE)
+ ((NOT (PAIRP TYPE))
+ NIL)
+ ((AND (MEMQ (CAR TYPE)
+ '(A AN a an An TRANSPARENT))
+ (CDR TYPE)
+ (ATOM (CADR TYPE)))
+ (CADR TYPE))
+ ((MEMQ (CAR TYPE)
+ GEVTYPENAMES)
+ TYPE)
+ ((AND (NOT (UNBOUNDP GLUSERSTRNAMES))
+ (ASSOC (CAR TYPE)
+ GLUSERSTRNAMES))
+ TYPE)
+ ((AND (ATOM (CAR TYPE))
+ (CDR TYPE))
+ (GEVXTRTYPE (CADR TYPE)))
+ (T (ERROR 0 (LIST 'GEVXTRTYPE
+ (LIST TYPE "is an illegal type specification.")))
+ NIL)))
+
+(SETQ GEVTYPENAMES '(CONS LIST RECORD LISTOF ALIST ATOM OBJECT LISTOBJECT
+ ATOMOBJECT))
ADDED psl-1983/3-1/glisp/gevaux.sl
Index: psl-1983/3-1/glisp/gevaux.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevaux.sl
@@ -0,0 +1,54 @@
+% GEVAUX.SL.14 07 April 83
+% Auxiliary functions for PSL version of GEV.
+% GSN 07 March 83
+
+% Interlisp Substring function.
+(de substring (string first last)
+ (cond ((not (stringp string)) (setq string (gevstringify string))))
+ (cond ((minusp first)
+ (setq first (add1 (plus (add1 (size string)) first)))))
+ (cond ((minusp last)
+ (setq last (add1 (plus (add1 (size string)) last)))))
+ (subseq string (sub1 first) last) )
+
+
+% Make a string out of anything
+(de gevstringify (x)
+ (cond ((stringp x) x)
+ (t (bldmsg "%p" x))))
+
+
+
+% Concatenate an arbitrary number of items
+(de concatn (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (car l)))
+ (t (concat (gevstringify (car l)) (concatn (cdr l))))))
+
+(de concatln (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (eval (car l))))
+ (t (concat (gevstringify (eval (car l))) (concatln (cdr l))))))
+
+(df concatl (concatlarg) (concatln concatlarg))
+(de gevconcat (l) (concatn l))
+
+(de dreverse (l) (reversip l))
+
+(de mkatom (s) (intern s))
+
+(de gevputd (fn form)
+ (put fn 'gloriginalexpr (cons 'lambda (cdr form)))
+ (put fn 'glcompiled nil)
+ (remd fn)
+ (putd fn 'macro '(lambda (gldgform) (glhook gldgform))))
+
+% Apply a function to arguments, Glisp-compiling first if needed.
+(de gevapply (fn args)
+ (cond ((and (atom fn)
+ (or (null (get fn 'glcompiled))
+ (not (eq (getddd fn) (get fn 'glcompiled)))))
+ (glcc fn)
+ (apply fn args))
+ (t (apply fn args))))
+
ADDED psl-1983/3-1/glisp/gevaux20.old
Index: psl-1983/3-1/glisp/gevaux20.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevaux20.old
@@ -0,0 +1,53 @@
+% GEVAUX20.SL.21
+% Auxiliary functions for PSL version of GEV.
+% GSN 07 March 83
+
+% Interlisp Substring function.
+(de substring (string first last)
+ (cond ((not (stringp string)) (setq string (gevstringify string))))
+ (cond ((minusp first)
+ (setq first (add1 (plus (add1 (size string)) first)))))
+ (cond ((minusp last)
+ (setq last (add1 (plus (add1 (size string)) last)))))
+ (subseq string (sub1 first) last) )
+
+
+% Make a string out of anything
+(de gevstringify (x)
+ (cond ((stringp x) x)
+ (t (bldmsg "%p" x))))
+
+
+
+% Concatenate an arbitrary number of items
+(de concatn (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (car l)))
+ (t (concat (gevstringify (car l)) (concatn (cdr l))))))
+
+(de concatln (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (eval (car l))))
+ (t (concat (gevstringify (eval (car l))) (concatln (cdr l))))))
+
+(df concatl (concatlarg) (concatln concatlarg))
+(de gevconcat (l) (concatn l))
+
+(de dreverse (l) (reversip l))
+
+(de mkatom (s) (intern s))
+
+(de gevputd (fn form)
+ (put fn 'gloriginalexpr (cons 'lambda (cdr form)))
+ (put fn 'glcompiled nil)
+ (remd fn)
+ (putd fn 'macro '(lambda (gldgform) (glhook gldgform))))
+
+% Apply a function to arguments, Glisp-compiling first if needed.
+(de gevapply (fn args)
+ (cond ((and (atom fn)
+ (or (null (get fn 'glcompiled))
+ (not (eq (getddd fn) (get fn 'glcompiled)))))
+ (glcc fn)
+ (apply fn args))
+ (t (apply fn args))))
ADDED psl-1983/3-1/glisp/gevaux20.sl
Index: psl-1983/3-1/glisp/gevaux20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevaux20.sl
@@ -0,0 +1,53 @@
+% GEVAUX20.SL.21
+% Auxiliary functions for PSL version of GEV.
+% GSN 07 March 83
+
+% Interlisp Substring function.
+(de substring (string first last)
+ (cond ((not (stringp string)) (setq string (gevstringify string))))
+ (cond ((minusp first)
+ (setq first (add1 (plus (add1 (size string)) first)))))
+ (cond ((minusp last)
+ (setq last (add1 (plus (add1 (size string)) last)))))
+ (subseq string (sub1 first) last) )
+
+
+% Make a string out of anything
+(de gevstringify (x)
+ (cond ((stringp x) x)
+ (t (bldmsg "%p" x))))
+
+
+
+% Concatenate an arbitrary number of items
+(de concatn (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (car l)))
+ (t (concat (gevstringify (car l)) (concatn (cdr l))))))
+
+(de concatln (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (eval (car l))))
+ (t (concat (gevstringify (eval (car l))) (concatln (cdr l))))))
+
+(df concatl (concatlarg) (concatln concatlarg))
+(de gevconcat (l) (concatn l))
+
+(de dreverse (l) (reversip l))
+
+(de mkatom (s) (intern s))
+
+(de gevputd (fn form)
+ (put fn 'gloriginalexpr (cons 'lambda (cdr form)))
+ (put fn 'glcompiled nil)
+ (remd fn)
+ (putd fn 'macro '(lambda (gldgform) (glhook gldgform))))
+
+% Apply a function to arguments, Glisp-compiling first if needed.
+(de gevapply (fn args)
+ (cond ((and (atom fn)
+ (or (null (get fn 'glcompiled))
+ (not (eq (getddd fn) (get fn 'glcompiled)))))
+ (glcc fn)
+ (apply fn args))
+ (t (apply fn args))))
ADDED psl-1983/3-1/glisp/gevauxold.sl
Index: psl-1983/3-1/glisp/gevauxold.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevauxold.sl
@@ -0,0 +1,163 @@
+% GEVAUX.SL.21 28 March 83
+% Auxiliary functions for PSL version of GEV, HP 9836 version.
+% GSN 07 March 83
+
+% Interlisp Substring function.
+(de substring (string first last)
+ (cond ((not (stringp string)) (setq string (gevstringify string))))
+ (cond ((minusp first)
+ (setq first (add1 (plus (add1 (size string)) first)))))
+ (cond ((minusp last)
+ (setq last (add1 (plus (add1 (size string)) last)))))
+ (subseq string (sub1 first) last) )
+
+
+% Make a string out of anything
+(de gevstringify (x)
+ (cond ((stringp x) x)
+ (t (bldmsg "%p" x))))
+
+
+
+% Concatenate an arbitrary number of items
+(de concatn (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (car l)))
+ (t (concat (gevstringify (car l)) (concatn (cdr l))))))
+
+(de concatln (l)
+ (cond ((null l) "")
+ ((null (cdr l)) (gevstringify (eval (car l))))
+ (t (concat (gevstringify (eval (car l))) (concatln (cdr l))))))
+
+(df concatl (concatlarg) (concatln concatlarg))
+(de gevconcat (l) (concatn l))
+
+(de dreverse (l) (reversip l))
+
+(de mkatom (s) (intern s))
+
+(de gevputd (fn form)
+ (put fn 'gloriginalexpr (cons 'lambda (cdr form)))
+ (put fn 'glcompiled nil)
+ (remd fn)
+ (putd fn 'macro '(lambda (gldgform) (glhook gldgform))))
+
+% Apply a function to arguments, Glisp-compiling first if needed.
+(de gevapply (fn args)
+ (cond ((and (atom fn)
+ (or (null (get fn 'glcompiled))
+ (not (eq (getddd fn) (get fn 'glcompiled)))))
+ (glcc fn)
+ (apply fn args))
+ (t (apply fn args))))
+
+
+% TTY input replacement for mouse operations.
+% GSN 07 March 83
+(dg gevmouseloop ()
+ (prog (input n tmp)
+lp (prin2 "GEV: ")
+ (input _ (read))
+ (if input='t and (n _ (read))
+ is numeric then (gevnselect n nil)
+ (go lp)
+ elseif input is numeric
+ then (gevnselect input t) (go lp)
+ elseif (tmp _ (assoc input
+ '((q quit)(pop pop)(e edit)(pr program)
+ (p prop)(a adj)(i isa)(m msg))))
+ then (gevcommandfn (cadr tmp))
+ (if (cadr tmp)='quit or ~gevactiveflg
+ then (return nil)
+ else (go lp)))
+err (prin2 "? Quit POP Edit PRogram Prop Adj Isa Msg")
+ (terpri)
+ (go lp) ))
+
+
+% GEVCRT.SL.4 28 March 83
+% derived from <NOVAK>GEVCRT.PSL.1 20-Mar-83 12:41:24
+
+
+
+
+
+(GLOBAL '(GEVMENUWINDOW GEVSAVEESC GEVSAVEGLQUIET GEVSAVEGCGAG GEVMOUSEAREA))
+
+(DE GEVENTER NIL
+ (setq gevsavegcgag !*GC)
+ (setq !*GC nil)
+ (SETQ GEVSAVEGLQUIET GLQUIETFLG)
+ (SETQ GLQUIETFLG T)
+ (window-init nil))
+
+
+(DE GEVEXIT NIL
+ (setq !*GC gevsavegcgag)
+ (SETQ GLQUIETFLG GEVSAVEGLQUIET)
+ (window-term nil))
+
+
+% edited: 19-Mar-83 22:41
+(DG GEVINITEDITWINDOW NIL
+(PROG NIL (GEVWINDOW _ (A WINDOW WITH START =
+ (A VECTOR WITH X = 0 Y = 0)
+ SIZE =
+ (A VECTOR WITH X = 300 Y = 500)
+ TITLE = "GEV Structure Inspector"))
+ (RETURN GEVWINDOW)))
+
+
+
+% edited: 19-Mar-83 21:42
+% Select the Nth item in the display and push down to zoom in on it.
+(DG GEVNSELECT (N:INTEGER FLAG:BOOLEAN)
+(PROG (L TOP SUBLIST GROUP ITEM)
+ (GROUP _ 0)
+ (TOP _ GEVEDITCHAIN:TOPFRAME)
+ LP
+ (IF ~TOP THEN (RETURN NIL))
+ (SUBLIST -_ TOP)
+ (GROUP _+ 1)
+ (IF GROUP=1 AND (L _ (LENGTH SUBLIST))
+ >=N THEN (ITEM _ (CAR (PNth SUBLIST (L + 1 - N))))
+ ELSEIF ~ (ITEM _ (GEVNTHITEM SUBLIST))
+ THEN
+ (GO LP))
+ (IF ITEM:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
+ THEN
+ (RETURN NIL)
+ ELSE
+ (RETURN (GEVITEMEVENTFN ITEM GROUP FLAG)))))
+
+
+% edited: 19-Mar-83 22:15
+% Find the Nth item in a tree structure of items.
+(DG GEVNTHITEM (L: (LISTOF GSEITEM))
+(GLOBAL N:INTEGER)(PROG (TMP RES)
+ (IF N<=0 THEN (ERROR 0 NIL)
+ ELSEIF ~L THEN (RETURN NIL)
+ ELSEIF N=1 THEN (RETURN (CAR L))
+ ELSE
+ (N _- 1)
+ (TMP -_ L)
+ (IF TMP:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
+ AND
+ (RES _ (GEVNTHITEM TMP:SUBVALUES))
+ THEN
+ (RETURN RES)
+ ELSE
+ (RETURN (GEVNTHITEM L))))))
+
+
+(GLISPCONSTANTS
+(GEVNUMBERCHARS 2 INTEGER)
+(GEVNUMBERPOS 1 INTEGER)
+)
+
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ GEVMOUSEAREA NIL)
+
ADDED psl-1983/3-1/glisp/gevcrt.sl
Index: psl-1983/3-1/glisp/gevcrt.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevcrt.sl
@@ -0,0 +1,134 @@
+% GEVCRT.SL.9 07 April 83
+% derived from <NOVAK>GEVCRT.PSL.1 20-Mar-83 12:41:24
+
+% Written by Gordon Novak Jr.
+% Copyright (c) Hewlett-Packard 1983
+
+
+(fluid '(n p))
+
+(GLOBAL '(GEVMENUWINDOW GEVSAVEESC GEVSAVEGLQUIET GEVSAVEGCGAG GEVMOUSEAREA
+ glquietflg gllispdialect gevtypenames gluserstrnames mouse terminal
+))
+
+(DE GEVENTER NIL
+(setq gevsavegcgag !*GC)
+(setq !*GC nil)
+(SETQ GEVSAVEGLQUIET GLQUIETFLG)
+(SETQ GLQUIETFLG T)
+(echooff))
+
+
+(DE GEVEXIT NIL
+(setq !*GC gevsavegcgag)
+(SETQ GLQUIETFLG GEVSAVEGLQUIET)
+(echoon))
+
+
+% edited: 19-Mar-83 22:41
+(DG GEVINITEDITWINDOW NIL
+(PROG NIL (GEVWINDOW _ (A WINDOW WITH START =
+ (A VECTOR WITH X = 0 Y = 3)
+ SIZE =
+ (A VECTOR WITH X = 46 Y = 20)
+ TITLE = "GEV Structure Inspector"))
+ (RETURN GEVWINDOW)))
+
+
+% edited: 19-Mar-83 21:12
+% Wait in a loop for mouse actions within the edit window.
+(DG GEVMOUSELOOP NIL
+(PROG (INP N TMP)
+ LP
+ (SEND GEVWINDOW MOVETOXY 0 -1)
+ (SEND TERMINAL ERASEEOL)
+ (SEND GEVWINDOW MOVETOXY 0 -1)
+ (SEND TERMINAL PRINTSTRING "GEV: ")
+ (echoon)
+ (INP _ (READ))
+ (echooff)
+ (SEND TERMINAL ERASEEOL)
+ (IF INP=T AND (N _ (READ))
+ IS NUMERIC THEN (GEVNSELECT N NIL)
+ (GO LP)
+ ELSEIF INP IS NUMERIC THEN (GEVNSELECT INP T)
+ (GO LP)
+ ELSEIF
+ (TMP _ (ASSOC INP '((Q QUIT)
+ (POP POP)
+ (E EDIT)
+ (PR PROGRAM)
+ (P PROP)
+ (A ADJ)
+ (I ISA)
+ (M MSG))))
+ THEN
+ (GEVCOMMANDFN (CADR TMP))
+ (IF (CADR TMP)
+ ='QUIT OR ~GEVACTIVEFLG THEN (SEND GEVWINDOW MOVETOXY 0 -1)
+ (SEND TERMINAL ERASEEOL)
+ (RETURN NIL)
+ ELSE
+ (GO LP))
+ ELSEIF INP = 'R
+ THEN
+ (SEND GEVWINDOW OPEN)
+ (GEVFILLWINDOW)
+ (GO LP)
+ ELSE
+ (PRIN1 "? Quit POP Edit PRogram Prop Adj Isa Msg Redraw")
+ (TERPRI)
+ (GO LP))))
+
+
+% edited: 19-Mar-83 21:42
+% Select the Nth item in the display and push down to zoom in on it.
+(DG GEVNSELECT (N:INTEGER FLAG:BOOLEAN)
+(PROG (L TOP SUBLIST GROUP ITEM)
+ (GROUP _ 0)
+ (TOP _ GEVEDITCHAIN:TOPFRAME)
+ LP
+ (IF ~TOP THEN (RETURN NIL))
+ (SUBLIST -_ TOP)
+ (GROUP _+ 1)
+ (IF GROUP=1 AND (L _ (LENGTH SUBLIST))
+ >=N THEN (ITEM _ (CAR (PNth SUBLIST (L + 1 - N))))
+ ELSEIF ~ (ITEM _ (GEVNTHITEM SUBLIST))
+ THEN
+ (GO LP))
+ (IF ITEM:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
+ THEN
+ (RETURN NIL)
+ ELSE
+ (RETURN (GEVITEMEVENTFN ITEM GROUP FLAG)))))
+
+
+% edited: 19-Mar-83 22:15
+% Find the Nth item in a tree structure of items.
+(DG GEVNTHITEM (L: (LISTOF GSEITEM))
+(GLOBAL N:INTEGER)(PROG (TMP RES)
+ (IF N<=0 THEN (ERROR 0 NIL)
+ ELSEIF ~L THEN (RETURN NIL)
+ ELSEIF N=1 THEN (RETURN (CAR L))
+ ELSE
+ (N _- 1)
+ (TMP -_ L)
+ (IF TMP:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
+ AND
+ (RES _ (GEVNTHITEM TMP:SUBVALUES))
+ THEN
+ (RETURN RES)
+ ELSE
+ (RETURN (GEVNTHITEM L))))))
+
+
+(GLISPCONSTANTS
+(GEVNUMBERCHARS 2 INTEGER)
+(GEVNUMBERPOS 1 INTEGER)
+)
+
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ GEVMOUSEAREA NIL)
+
ADDED psl-1983/3-1/glisp/gevdemo.old
Index: psl-1983/3-1/glisp/gevdemo.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevdemo.old
@@ -0,0 +1,328 @@
+(FILECREATED " 8-NOV-82 09:44:50" {DSK}GEVDEMO.LSP;22 10081
+
+ changes to: (FNS GEVDEMO-INIT)
+ (VARS GEVDEMOCOMS)
+
+ previous date: "26-OCT-82 16:10:02" {DSK}GEVDEMO.LSP;20)
+
+
+(PRETTYCOMPRINT GEVDEMOCOMS)
+
+(RPAQQ GEVDEMOCOMS ((GLISPOBJECTS PROJECT CONTRACT AGENCY PERSON BUDGET ADDRESS PHONE-NUMBER DATE
+ PICTURE CAMPUS-ADDRESS BUILDING CIRCLE VECTOR RADIANS DEGREES
+ RVECTOR)
+ (FNS GEVDEMO-INIT TODAYS-DATE TOTAL-BUDGET)
+ (PROP GLRESULTTYPE TODAYS-DATE)
+ (P (GEVDEMO-INIT))))
+
+
+[GLISPOBJECTS
+
+
+(PROJECT
+
+ [ATOM (PROPLIST (TITLE STRING)
+ (ABBREVIATION ATOM)
+ (ADMINISTRATOR PERSON)
+ (CONTRACTS (LISTOF CONTRACT))
+ (EXECUTIVES (LISTOF PERSON]
+
+ PROP ((SHORTVALUE (ABBREVIATION))
+ (DISPLAYPROPS (T))
+ (BUDGET TOTAL-BUDGET)) )
+
+(CONTRACT
+
+ (ATOM (PROPLIST (TITLE STRING)
+ (LEADER PERSON)
+ (SPONSOR AGENCY)
+ (BUDGET BUDGET)))
+
+ PROP ((SHORTVALUE (TITLE))) )
+
+(AGENCY
+
+ (ATOM (PROPLIST (NAME STRING)
+ (ABBREVIATION ATOM)
+ (ADDRESS ADDRESS)
+ (PHONE PHONE-NUMBER)))
+
+ PROP ((SHORTVALUE (ABBREVIATION))) )
+
+(PERSON
+
+ (ATOM (PROPLIST (NAME STRING)
+ (INITIALS ATOM)
+ (TITLE ATOM)
+ (PROJECT PROJECT)
+ (SALARY REAL)
+ (SSNO INTEGER)
+ (BIRTHDATE DATE)
+ (PHONE PHONE-NUMBER)
+ (OFFICE CAMPUS-ADDRESS)
+ (HOME-ADDRESS ADDRESS)
+ (HOME-PHONE PHONE-NUMBER)
+ (PICTURE PICTURE)))
+
+ PROP ((SHORTVALUE (INITIALS))
+ (CONTRACTS ((THOSE CONTRACTS OF PROJECT WITH LEADER=self)))
+ (AGE ((THE YEAR OF (TODAYS-DATE))
+ - BIRTHDATE:YEAR))
+ (MONTHLY-SALARY (SALARY/12))
+ (DISPLAYPROPS (T)))
+
+ ADJ [(FACULTY ((MEMB TITLE (QUOTE (PROF ASSOC-PROF ASST-PROF] )
+
+(BUDGET
+
+ (LIST (LABOR REAL)
+ (COMPUTER REAL))
+
+ PROP ((OVERHEAD (LABOR*0.59))
+ (TOTAL (LABOR+OVERHEAD+COMPUTER))
+ (SHORTVALUE (TOTAL))
+ (DISPLAYPROPS (T))) )
+
+(ADDRESS
+
+ (LIST (STREET STRING)
+ (CITY STRING)
+ (STATE ATOM)
+ (ZIP INTEGER))
+
+ PROP [(SHORTVALUE ((CONCAT CITY ", " STATE] )
+
+(PHONE-NUMBER
+
+ (LIST (AREA INTEGER)
+ (NUMBER INTEGER))
+
+ PROP [(SHORTVALUE ((CONCAT "(" AREA ") " (SUBSTRING NUMBER 1 3)
+ "-"
+ (SUBSTRING NUMBER 4 7]
+
+ ADJ ((LOCAL (AREA=415 OR AREA=408))) )
+
+(DATE
+
+ (LIST (MONTH INTEGER)
+ (DAY INTEGER)
+ (SHORTYEAR INTEGER))
+
+ PROP [[MONTHNAME ((CAR (NTH (QUOTE (January February March April May June July August September
+ October November December))
+ MONTH]
+ (YEAR (SHORTYEAR + 1900))
+ (SHORTVALUE ((CONCAT MONTHNAME " " DAY ", " YEAR] )
+
+(PICTURE
+
+ ANYTHING
+
+ MSG ((EDIT PAINTW)
+ (GEVDISPLAY PICTURE-GEVDISPLAY)) )
+
+(CAMPUS-ADDRESS
+
+ (LIST (BUILDING BUILDING)
+ (ROOM ATOM))
+
+ PROP [(SHORTVALUE ((CONCAT BUILDING:ABBREVIATION " " ROOM] )
+
+(BUILDING
+
+ (ATOM (PROPLIST (ABBREVIATION ATOM)
+ (NAME STRING)
+ (NUMBER INTEGER)))
+
+ PROP ((SHORTVALUE (NAME))) )
+
+(CIRCLE
+
+ (LIST (START VECTOR)
+ (RADIUS REAL))
+
+ PROP [(PI (3.141593))
+ (DIAMETER (RADIUS*2))
+ (CIRCUMFERENCE (PI*DIAMETER))
+ (AREA (PI*RADIUS^2))
+ (SQUARESIDE ((SQRT AREA)))
+ (DISPLAYPROPS ((QUOTE (DIAMETER CIRCUMFERENCE AREA]
+
+ MSG ((GROW (AREA_+100))
+ (SHRINK (AREA_AREA/2))
+ (STANDARD (AREA_100.0)))
+
+ ADJ ((BIG (AREA>100))
+ (SMALL (AREA<80))) )
+
+(VECTOR
+
+ (LIST (X INTEGER)
+ (Y INTEGER))
+
+ PROP [(MAGNITUDE ((SQRT X^2 + Y^2)))
+ (ANGLE ((ARCTAN2 Y X T))
+ RESULT RADIANS)
+ (UNITVECTOR ((A RVECTOR WITH X = X/MAGNITUDE , Y = Y/MAGNITUDE]
+
+ ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)))
+
+ MSG [(PRIN1 ((PRIN1 "(")
+ (PRIN1 X)
+ (PRIN1 ",")
+ (PRIN1 Y)
+ (PRIN1 ")")))
+ (PRINT ((_ self PRIN1)
+ (TERPRI] )
+
+(RADIANS
+
+ REAL
+
+ PROP ((DEGREES (self* (180.0/3.1415926))
+ RESULT DEGREES)
+ (DISPLAYPROPS (T))) )
+
+(DEGREES
+
+ REAL
+
+ PROP ((RADIANS (self* (3.1415926/180.0))
+ RESULT RADIANS)
+ (DISPLAYPROPS (T))) )
+
+(RVECTOR
+
+ (LIST (X REAL)
+ (Y REAL))
+
+ SUPERS (VECTOR) )
+]
+
+(DEFINEQ
+
+(GEVDEMO-INIT
+ [GLAMBDA NIL (* edited: " 6-NOV-82 14:41")
+ (* Initialize data structures for GEV demo.)
+ (PROG NIL
+ (HPP _(A PROJECT WITH TITLE = "Heuristic Programming Project" , ABBREVIATION =(QUOTE
+ HPP)))
+ (MJH _(A BUILDING WITH ABBREVIATION =(QUOTE MJH)
+ , NAME = "Margaret Jacks Hall" , NUMBER = 460))
+ (ARPA _(AN AGENCY WITH NAME = "Defense Advanced Research Projects Agency" ,
+ ABBREVIATION =(QUOTE ARPA)
+ , ADDRESS =(AN ADDRESS WITH STREET = "1400 Wilson Blvd." , CITY =
+ "Arlington"
+ , STATE =(QUOTE VA)
+ , ZIP = 22209)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 202 , NUMBER = 6944349)))
+ (NSF _(AN AGENCY WITH NAME = "National Science Foundation" , ABBREVIATION =(QUOTE
+ NSF)
+ , ADDRESS =(AN ADDRESS WITH STREET = "1800 G STREET N.W." , CITY =
+ "Washington"
+ , STATE =(QUOTE DC)
+ , ZIP = 20550)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 202 , NUMBER = 6327346)))
+ (NIH _(AN AGENCY WITH NAME = "National Institutes of Health" , ABBREVIATION =(QUOTE
+ NIH)
+ , ADDRESS =(AN ADDRESS WITH STREET = "9000 Rockville Pike" , CITY =
+ "Bethesda"
+ , STATE =(QUOTE MD)
+ , ZIP = 20001)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 301 , NUMBER = 4964000)))
+ (GSN _(A PERSON WITH NAME = "Gordon S. Novak Jr." , INITIALS =(QUOTE GSN)
+ , TITLE =(QUOTE VISITOR)
+ , PROJECT = HPP , SALARY = 30000.0 , SSNO = 455827977 , BIRTHDATE =(A
+ DATE WITH DAY = 21 , MONTH = 7 , SHORTYEAR = 47)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4974532)
+ , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 244)
+ , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4935807)
+ , HOME-ADDRESS =(AN ADDRESS WITH STREET = "3857 Ross Road" , CITY =
+ "Palo Alto"
+ , STATE =(QUOTE CA)
+ , ZIP = 94303)))
+ (TCR _(A PERSON WITH NAME = "Tom C. Rindfleisch" , INITIALS =(QUOTE TCR)
+ , TITLE =(QUOTE ADMINISTRATOR)
+ , PROJECT = HPP , SALARY = 30000.0 , SSNO = 452123477 , BIRTHDATE =(A
+ DATE WITH DAY = 2 , MONTH = 1 , SHORTYEAR = 47)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4972780)
+ , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4324321)
+ , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 236)
+ , HOME-ADDRESS =(AN ADDRESS)))
+ (EAF _(A PERSON WITH NAME = "Edward A. Feigenbaum" , INITIALS =(QUOTE EAF)
+ , TITLE =(QUOTE PROF)
+ , PROJECT = HPP , SALARY = 99999.0 , SSNO = 123123477 , BIRTHDATE =(A
+ DATE WITH DAY = 2 , MONTH = 1 , SHORTYEAR = 37)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4974878)
+ , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 226)
+ , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4931234)
+ , HOME-ADDRESS =(AN ADDRESS WITH STREET = " " , CITY = "Stanford" , STATE =(
+ QUOTE CA)
+ , ZIP = 94305)))
+ (MRG _(A PERSON WITH NAME = "Michael R. Genesereth" , INITIALS =(QUOTE MRG)
+ , TITLE =(QUOTE ASST-PROF)
+ , PROJECT = HPP , SALARY = 31234.0 , SSNO = 123123477 , BIRTHDATE =(A
+ DATE WITH DAY = 2 , MONTH = 1 , SHORTYEAR = 50)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4970324)
+ , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 234)
+ , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4324321)
+ , HOME-ADDRESS =(AN ADDRESS)))
+ (J5 _(A CONTRACT WITH TITLE = "Advanced A.I. Architectures" , LEADER = EAF , SPONSOR
+ = ARPA , BUDGET =(A BUDGET WITH LABOR = 50000.0 , COMPUTER = 10000.0)))
+ (IA _(A CONTRACT WITH TITLE = "Intelligent Agents" , LEADER = MRG , SPONSOR = ARPA ,
+ BUDGET =(A BUDGET WITH LABOR = 70000.0 , COMPUTER = 50000.0)))
+ (DART _(A CONTRACT WITH TITLE = "Diagnosis and Repair Techniques" , LEADER = MRG ,
+ SPONSOR = ARPA , BUDGET =(A BUDGET WITH LABOR = 100000.0 , COMPUTER =
+ 150000.0)))
+ (GLISP _(A CONTRACT WITH TITLE = "GLISP" , LEADER = GSN , SPONSOR = ARPA , BUDGET =(
+ A BUDGET WITH LABOR = 50000.0 , COMPUTER = 20000.0)))
+ (CMPICTURE _(CREATEW (create REGION
+ LEFT _ 0
+ BOTTOM _ 0
+ WIDTH _ 100
+ HEIGHT _ 100)))
+ (CM _(A PERSON WITH NAME = "Cookie Monster" , INITIALS =(QUOTE CM)
+ , TITLE =(QUOTE MONSTER)
+ , PROJECT = HPP , SALARY = 1.0 , SSNO = 123456789 , BIRTHDATE =(A DATE WITH
+ MONTH = 4
+ , DAY = 1
+ ,
+ SHORTYEAR =
+ 65)
+ , PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4971234)
+ , OFFICE =(A CAMPUS-ADDRESS WITH BUILDING = MJH , ROOM = 252)
+ , HOME-PHONE =(A PHONE-NUMBER WITH AREA = 415 , NUMBER = 4561234)
+ , HOME-ADDRESS =(AN ADDRESS WITH STREET = "123 Sesame Street" , CITY =
+ "Palo Alto"
+ , STATE =(QUOTE CA)
+ , ZIP = 94303)
+ , PICTURE = CMPICTURE))
+ (CARBM _(A CONTRACT WITH TITLE = "Carbohydrate Metabolism in Atypical Hominids" ,
+ LEADER = CM , SPONSOR = NIH , BUDGET =(A BUDGET WITH LABOR = 1.39 ,
+ COMPUTER = 5.0)))
+ (HPP:ADMINISTRATOR _ TCR)
+ (HPP:CONTRACTS _(LIST J5 IA DART GLISP CARBM))
+ (HPP:EXECUTIVES _(LIST EAF MRG GSN TCR))
+ (C _(A CIRCLE WITH START =(A VECTOR WITH X = 1 , Y = 1)
+ , RADIUS = 5.0])
+
+(TODAYS-DATE
+ (GLAMBDA NIL (* edited: "22-OCT-82 16:54")
+ (A DATE WITH MONTH = 10 , DAY = 15 , SHORTYEAR = 82)))
+
+(TOTAL-BUDGET
+ (GLAMBDA (P:PROJECT) (* edited: "22-OCT-82 17:13")
+ (PROG (SUM)
+ (SUM_0.0)
+ (FOR EACH CONTRACT SUM_+BUDGET:TOTAL)
+ (RETURN SUM))))
+)
+
+(PUTPROPS TODAYS-DATE GLRESULTTYPE DATE)
+(GEVDEMO-INIT)
+(DECLARE: DONTCOPY
+ (FILEMAP (NIL (4061 9998 (GEVDEMO-INIT 4071 . 9592) (TODAYS-DATE 9594 . 9764) (TOTAL-BUDGET 9766 .
+9996)))))
+STOP
ADDED psl-1983/3-1/glisp/gevdemo.sl
Index: psl-1983/3-1/glisp/gevdemo.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevdemo.sl
@@ -0,0 +1,260 @@
+
+% {DSK}GEVDEMO.PSL;1 5-FEB-83 15:41:04
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(PROJECT (ATOM (PROPLIST (TITLE STRING)
+ (ABBREVIATION ATOM)
+ (ADMINISTRATOR PERSON)
+ (CONTRACTS (LISTOF CONTRACT))
+ (EXECUTIVES (LISTOF PERSON))))
+PROP ((SHORTVALUE (ABBREVIATION))
+ (DISPLAYPROPS (T))
+ (BUDGET TOTAL-BUDGET)))
+
+
+(CONTRACT (ATOM (PROPLIST (TITLE STRING)
+ (LEADER PERSON)
+ (SPONSOR AGENCY)
+ (BUDGET BUDGET)))
+PROP ((SHORTVALUE (TITLE))))
+
+
+(AGENCY (ATOM (PROPLIST (NAME STRING)
+ (ABBREVIATION ATOM)
+ (ADDRESS ADDRESS)
+ (PHONE PHONE-NUMBER)))
+PROP ((SHORTVALUE (ABBREVIATION))))
+
+
+(PERSON (ATOM (PROPLIST (NAME STRING)
+ (INITIALS ATOM)
+ (TITLE ATOM)
+ (PROJECT PROJECT)
+ (SALARY REAL)
+ (SSNO INTEGER)
+ (BIRTHDATE DATE)
+ (PHONE PHONE-NUMBER)
+ (OFFICE CAMPUS-ADDRESS)
+ (HOME-ADDRESS ADDRESS)
+ (HOME-PHONE PHONE-NUMBER)
+ (PICTURE PICTURE)))
+PROP ((SHORTVALUE (INITIALS))
+ (CONTRACTS ((THOSE CONTRACTS OF PROJECT WITH LEADER=self)))
+ (AGE ((THE YEAR OF (TODAYS-DATE))
+ - BIRTHDATE:YEAR))
+ (MONTHLY-SALARY (SALARY/12))
+ (DISPLAYPROPS (T)))
+ADJ ((FACULTY ((MEMQ TITLE '(PROF ASSOC-PROF ASST-PROF))))))
+
+
+(BUDGET (LIST (LABOR REAL)
+ (COMPUTER REAL))
+PROP ((OVERHEAD (LABOR * 0.59))
+ (TOTAL (LABOR+OVERHEAD+COMPUTER))
+ (SHORTVALUE (TOTAL))
+ (DISPLAYPROPS (T))))
+
+
+(ADDRESS (LIST (STREET STRING)
+ (CITY STRING)
+ (STATE ATOM)
+ (ZIP INTEGER))
+PROP ((SHORTVALUE ((CONCATL CITY ", " STATE)))))
+
+
+(PHONE-NUMBER (LIST (AREA INTEGER)
+ (NUMBER INTEGER))
+PROP ((SHORTVALUE ((CONCATL "(" AREA ") " (SUBSTRING NUMBER 1 3)
+ "-"
+ (SUBSTRING NUMBER 4 7)))))
+ADJ ((LOCAL (AREA=415 OR AREA=408))))
+
+
+(DATE (LIST (MONTH INTEGER)
+ (DAY INTEGER)
+ (SHORTYEAR INTEGER))
+PROP ((MONTHNAME ((NTH '(January February March April May June July
+ August September October November
+ December)
+ MONTH)))
+ (YEAR (SHORTYEAR + 1900))
+ (SHORTVALUE ((CONCATL MONTHNAME " " DAY ", " YEAR)))))
+
+
+(PICTURE ANYTHING
+MSG ((EDIT PAINTW)
+ (GEVDISPLAY PICTURE-GEVDISPLAY)))
+
+
+(CAMPUS-ADDRESS (LIST (BUILDING BUILDING)
+ (ROOM ATOM))
+PROP ((SHORTVALUE ((CONCATL BUILDING:ABBREVIATION " " ROOM)))))
+
+
+(BUILDING (ATOM (PROPLIST (ABBREVIATION ATOM)
+ (NAME STRING)
+ (NUMBER INTEGER)))
+PROP ((SHORTVALUE (NAME))))
+
+
+(CIRCLE (LIST (START VECTOR)
+ (RADIUS REAL))
+PROP ((PI (3.141593))
+ (DIAMETER (RADIUS*2))
+ (CIRCUMFERENCE (PI*DIAMETER))
+ (AREA (PI*RADIUS^2))
+ (SQUARESIDE ((SQRT AREA)))
+ (DISPLAYPROPS ('(DIAMETER CIRCUMFERENCE AREA))))
+MSG ((GROW (AREA_+100))
+ (SHRINK (AREA_AREA/2))
+ (STANDARD (AREA_100.0)))
+ADJ ((BIG (AREA>100))
+ (SMALL (AREA<80))))
+
+
+
+)
+
+
+
+% edited: 6-NOV-82 14:41
+% Initialize data structures for GEV demo.
+(DG GEVDEMO-INIT NIL
+(PROG NIL (HPP _ (A PROJECT WITH TITLE = "Heuristic Programming Project"
+ ABBREVIATION = 'HPP))
+ (MJH _ (A BUILDING WITH ABBREVIATION = 'MJH
+ NAME = "Margaret Jacks Hall" NUMBER = 460))
+ (ARPA _ (AN AGENCY WITH NAME =
+ "Defense Advanced Research Projects Agency"
+ ABBREVIATION = 'ARPA
+ ADDRESS =
+ (AN ADDRESS WITH STREET = "1400 Wilson Blvd." CITY =
+ "Arlington"
+ STATE = 'VA
+ ZIP = 22209)
+ PHONE = (A PHONE-NUMBER WITH AREA = 202 NUMBER = 6944349)))
+ (NSF _ (AN AGENCY WITH NAME = "National Science Foundation" ABBREVIATION
+ = 'NSF
+ ADDRESS =
+ (AN ADDRESS WITH STREET = "1800 G STREET N.W." CITY =
+ "Washington"
+ STATE = 'DC
+ ZIP = 20550)
+ PHONE = (A PHONE-NUMBER WITH AREA = 202 NUMBER = 6327346)))
+ (NIH _ (AN AGENCY WITH NAME = "National Institutes of Health"
+ ABBREVIATION = 'NIH
+ ADDRESS =
+ (AN ADDRESS WITH STREET = "9000 Rockville Pike" CITY =
+ "Bethesda"
+ STATE = 'MD
+ ZIP = 20001)
+ PHONE = (A PHONE-NUMBER WITH AREA = 301 NUMBER = 4964000)))
+ (GSN _
+ (A PERSON WITH NAME = "Gordon S. Novak Jr." INITIALS =
+ 'GSN
+ TITLE = 'VISITOR
+ PROJECT = HPP SALARY = 30000.0 SSNO = 455827977 BIRTHDATE =
+ (A DATE WITH DAY = 21 MONTH = 7 SHORTYEAR = 47)
+ PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4974532)
+ OFFICE = (A CAMPUS-ADDRESS WITH BUILDING = MJH ROOM = 244)
+ HOME-PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4935807)
+ HOME-ADDRESS =
+ (AN ADDRESS WITH STREET = "3857 Ross Road" CITY = "Palo Alto"
+ STATE = 'CA
+ ZIP = 94303)))
+ (TCR _
+ (A PERSON WITH NAME = "Tom C. Rindfleisch" INITIALS = 'TCR
+ TITLE = 'ADMINISTRATOR
+ PROJECT = HPP SALARY = 30000.0 SSNO = 452123477 BIRTHDATE =
+ (A DATE WITH DAY = 2 MONTH = 1 SHORTYEAR = 47)
+ PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4972780)
+ HOME-PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4324321)
+ OFFICE = (A CAMPUS-ADDRESS WITH BUILDING = MJH ROOM = 236)
+ HOME-ADDRESS = (AN ADDRESS)))
+ (EAF _
+ (A PERSON WITH NAME = "Edward A. Feigenbaum" INITIALS =
+ 'EAF
+ TITLE = 'PROF
+ PROJECT = HPP SALARY = 99999.0 SSNO = 123123477 BIRTHDATE =
+ (A DATE WITH DAY = 2 MONTH = 1 SHORTYEAR = 37)
+ PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4974878)
+ OFFICE = (A CAMPUS-ADDRESS WITH BUILDING = MJH ROOM = 226)
+ HOME-PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4931234)
+ HOME-ADDRESS =
+ (AN ADDRESS WITH STREET = " " CITY = "Stanford" STATE =
+ 'CA
+ ZIP = 94305)))
+ (MRG _
+ (A PERSON WITH NAME = "Michael R. Genesereth" INITIALS =
+ 'MRG
+ TITLE = 'ASST-PROF
+ PROJECT = HPP SALARY = 31234.0 SSNO = 123123477 BIRTHDATE =
+ (A DATE WITH DAY = 2 MONTH = 1 SHORTYEAR = 50)
+ PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4970324)
+ OFFICE = (A CAMPUS-ADDRESS WITH BUILDING = MJH ROOM = 234)
+ HOME-PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4324321)
+ HOME-ADDRESS = (AN ADDRESS)))
+ (J5 _
+ (A CONTRACT WITH TITLE = "Advanced A.I. Architectures" LEADER = EAF
+ SPONSOR = ARPA BUDGET =
+ (A BUDGET WITH LABOR = 50000.0 COMPUTER = 10000.0)))
+ (IA _
+ (A CONTRACT WITH TITLE = "Intelligent Agents" LEADER = MRG SPONSOR =
+ ARPA BUDGET = (A BUDGET WITH LABOR = 70000.0 COMPUTER = 50000.0)))
+ (DART _
+ (A CONTRACT WITH TITLE = "Diagnosis and Repair Techniques" LEADER
+ = MRG SPONSOR = ARPA BUDGET =
+ (A BUDGET WITH LABOR = 100000.0 COMPUTER = 150000.0)))
+ (GLISP _
+ (A CONTRACT WITH TITLE = "GLISP" LEADER = GSN SPONSOR = ARPA
+ BUDGET = (A BUDGET WITH LABOR = 50000.0 COMPUTER = 20000.0)))
+ (CM _
+ (A PERSON WITH NAME = "Cookie Monster" INITIALS = 'CM
+ TITLE = 'MONSTER
+ PROJECT = HPP SALARY = 1.0 SSNO = 123456789 BIRTHDATE =
+ (A DATE WITH MONTH = 4 DAY = 1 SHORTYEAR = 65)
+ PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4971234)
+ OFFICE = (A CAMPUS-ADDRESS WITH BUILDING = MJH ROOM = 252)
+ HOME-PHONE = (A PHONE-NUMBER WITH AREA = 415 NUMBER = 4561234)
+ HOME-ADDRESS =
+ (AN ADDRESS WITH STREET = "123 Sesame Street" CITY = "Palo Alto"
+ STATE = 'CA
+ ZIP = 94303)
+ ))
+ (CARBM _
+ (A CONTRACT WITH TITLE =
+ "Carbohydrate Metabolism in Atypical Hominids"
+ LEADER = CM SPONSOR = NIH BUDGET =
+ (A BUDGET WITH LABOR = 1.39 COMPUTER = 5.0)))
+ (HPP:ADMINISTRATOR _ TCR)
+ (HPP:CONTRACTS _ (LIST J5 IA DART GLISP CARBM))
+ (HPP:EXECUTIVES _ (LIST EAF MRG GSN TCR))
+ (C _ (A CIRCLE WITH START =
+ (A VECTOR WITH X = 1 Y = 1)
+ RADIUS = 5.0))))
+
+
+% edited: 22-OCT-82 16:54
+(DG TODAYS-DATE NIL
+(A DATE WITH MONTH = 10 DAY = 15 SHORTYEAR = 82))
+
+
+% edited: 22-OCT-82 17:13
+(DG TOTAL-BUDGET (P:PROJECT)
+(PROG (SUM)
+ (SUM_0.0)
+ (FOR EACH CONTRACT SUM _+ BUDGET:TOTAL)
+ (RETURN SUM)))
+
+ (PUT 'TODAYS-DATE
+ 'GLRESULTTYPE
+ 'DATE)
+
+% Now initialize te data structures for the demo.
+(gevdemo-init)
ADDED psl-1983/3-1/glisp/gevhrd.sl
Index: psl-1983/3-1/glisp/gevhrd.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevhrd.sl
@@ -0,0 +1,110 @@
+
+% GEVHRD.SL.4 07 April 83
+% derived from <NOVAK>GEVCRT.PSL.1 20-Mar-83 12:41:24
+
+
+
+(fluid '(n))
+
+(GLOBAL '(GEVMENUWINDOW GEVSAVEESC GEVSAVEGLQUIET GEVSAVEGCGAG GEVMOUSEAREA
+ glquietflg gllispdialect gevtypenames gluserstrnames mouse terminal
+))
+
+
+% TTY input replacement for mouse operations.
+% GSN 07 March 83
+(dg gevmouseloop ()
+ (prog (input n tmp)
+lp (prin2 "GEV: ")
+ (input _ (read))
+ (if input='t and (n _ (read))
+ is numeric then (gevnselect n nil)
+ (go lp)
+ elseif input is numeric
+ then (gevnselect input t) (go lp)
+ elseif (tmp _ (assoc input
+ '((q quit)(pop pop)(e edit)(pr program)
+ (p prop)(a adj)(i isa)(m msg))))
+ then (gevcommandfn (cadr tmp))
+ (if (cadr tmp)='quit or ~gevactiveflg
+ then (return nil)
+ else (go lp)))
+err (prin2 "? Quit POP Edit PRogram Prop Adj Isa Msg")
+ (terpri)
+ (go lp) ))
+
+
+(DE GEVENTER NIL
+ (setq gevsavegcgag !*GC)
+ (setq !*GC nil)
+ (SETQ GEVSAVEGLQUIET GLQUIETFLG)
+ (SETQ GLQUIETFLG T))
+
+
+(DE GEVEXIT NIL
+ (setq !*GC gevsavegcgag)
+ (SETQ GLQUIETFLG GEVSAVEGLQUIET))
+
+
+% edited: 19-Mar-83 22:41
+(DG GEVINITEDITWINDOW NIL
+(PROG NIL (GEVWINDOW _ (A WINDOW WITH START =
+ (A VECTOR WITH X = 0 Y = 0)
+ SIZE =
+ (A VECTOR WITH X = 400 Y = 500)
+ TITLE = "GEV Structure Inspector"))
+ (RETURN GEVWINDOW)))
+
+
+
+% edited: 19-Mar-83 21:42
+% Select the Nth item in the display and push down to zoom in on it.
+(DG GEVNSELECT (N:INTEGER FLAG:BOOLEAN)
+(PROG (L TOP SUBLIST GROUP ITEM)
+ (GROUP _ 0)
+ (TOP _ GEVEDITCHAIN:TOPFRAME)
+ LP
+ (IF ~TOP THEN (RETURN NIL))
+ (SUBLIST -_ TOP)
+ (GROUP _+ 1)
+ (IF GROUP=1 AND (L _ (LENGTH SUBLIST))
+ >=N THEN (ITEM _ (CAR (PNth SUBLIST (L + 1 - N))))
+ ELSEIF ~ (ITEM _ (GEVNTHITEM SUBLIST))
+ THEN
+ (GO LP))
+ (IF ITEM:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
+ THEN
+ (RETURN NIL)
+ ELSE
+ (RETURN (GEVITEMEVENTFN ITEM GROUP FLAG)))))
+
+
+% edited: 19-Mar-83 22:15
+% Find the Nth item in a tree structure of items.
+(DG GEVNTHITEM (L: (LISTOF GSEITEM))
+(GLOBAL N:INTEGER)(PROG (TMP RES)
+ (IF N<=0 THEN (ERROR 0 NIL)
+ ELSEIF ~L THEN (RETURN NIL)
+ ELSEIF N=1 THEN (RETURN (CAR L))
+ ELSE
+ (N _- 1)
+ (TMP -_ L)
+ (IF TMP:NODETYPE <= '(STRUCTURE SUBTREE LISTOF)
+ AND
+ (RES _ (GEVNTHITEM TMP:SUBVALUES))
+ THEN
+ (RETURN RES)
+ ELSE
+ (RETURN (GEVNTHITEM L))))))
+
+
+(GLISPCONSTANTS
+(GEVNUMBERCHARS 2 INTEGER)
+(GEVNUMBERPOS 1 INTEGER)
+)
+
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ GEVMOUSEAREA NIL)
+
ADDED psl-1983/3-1/glisp/gevnew.sl
Index: psl-1983/3-1/glisp/gevnew.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevnew.sl
@@ -0,0 +1,1 @@
+(de gevdonewfn (x) (gevnewfn x))
ADDED psl-1983/3-1/glisp/gevt.b
Index: psl-1983/3-1/glisp/gevt.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevt.b
cannot compute difference between binary files
ADDED psl-1983/3-1/glisp/gevt.sl
Index: psl-1983/3-1/glisp/gevt.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gevt.sl
@@ -0,0 +1,724 @@
+(fluid '(p))
+
+(DE SUBSTRING (STRING FIRST LAST) (COND ((NOT (STRINGP STRING)) (SETQ STRING (
+GEVSTRINGIFY STRING)))) (COND ((MINUSP FIRST) (SETQ FIRST (ADD1 (PLUS (ADD1 (
+SIZE STRING)) FIRST))))) (COND ((MINUSP LAST) (SETQ LAST (ADD1 (PLUS (ADD1 (
+SIZE STRING)) LAST))))) (SUBSEQ STRING (SUB1 FIRST) LAST))
+
+(DE GEVSTRINGIFY (X) (COND ((STRINGP X) X) (T (BLDMSG "%p" X))))
+
+(DE CONCATN (L) (COND ((NULL L) "") ((NULL (CDR L)) (GEVSTRINGIFY (CAR L))) (
+T (CONCAT (GEVSTRINGIFY (CAR L)) (CONCATN (CDR L))))))
+
+(DE CONCATLN (L) (COND ((NULL L) "") ((NULL (CDR L)) (GEVSTRINGIFY (EVAL (
+CAR L)))) (T (CONCAT (GEVSTRINGIFY (EVAL (CAR L))) (CONCATLN (CDR L))))))
+
+(DF CONCATL (CONCATLARG) (CONCATLN CONCATLARG))
+
+(DE GEVCONCAT (L) (CONCATN L))
+
+(DE DREVERSE (L) (REVERSIP L))
+
+(DE MKATOM (S) (INTERN S))
+
+(DE GEVPUTD (FN FORM) (PUT FN (QUOTE GLORIGINALEXPR) (CONS (QUOTE LAMBDA) (
+CDR FORM))) (PUT FN (QUOTE GLCOMPILED) NIL) (REMD FN) (PUTD FN (QUOTE MACRO) (
+QUOTE (LAMBDA (GLDGFORM) (GLHOOK GLDGFORM)))))
+
+(DE GEVAPPLY (FN ARGS) (COND ((AND (ATOM FN) (OR (NULL (GET FN (QUOTE
+GLCOMPILED))) (NOT (EQ (GETDDD FN) (GET FN (QUOTE GLCOMPILED)))))) (GLCC FN) (
+APPLY FN ARGS)) (T (APPLY FN ARGS))))
+
+(GLOBAL (QUOTE (TERMINAL)))
+
+(GLISPOBJECTS (TERMINAL ATOM MSG ((MOVETOXY TERMINAL-MOVETOXY) (PRINTCHAR
+TERMINAL-PRINTCHAR OPEN T) (PRINTSTRING TERMINAL-PRINTSTRING) (INVERTVIDEO (
+NIL)) (NORMALVIDEO (NIL)) (GRAPHICSMODE (NIL)) (NORMALMODE (NIL)) (ERASEEOL ((
+PBOUT (CHAR ESC)) (PBOUT (CHAR K)))))))
+
+(GLISPGLOBALS (TERMINAL TERMINAL))
+
+(GLISPCONSTANTS (BLANKCHAR 32 INTEGER) (HORIZONTALLINECHAR 45 INTEGER) (
+HORIZONTALBARCHAR 95 INTEGER) (LVERTICALBARCHAR 124 INTEGER) (
+RVERTICALBARCHAR 124 INTEGER) (ESCAPECHAR 27 INTEGER))
+
+(DE TERMINAL-MOVETOXY (TERM X Y) (COND ((LESSP X 0) (SETQ X 0)) ((GREATERP X
+79) (SETQ X 79))) (COND ((LESSP Y 0) (SETQ Y 0)) ((GREATERP Y 23) (SETQ Y
+23))) (PROG (S) (SETQ S (CHAR ESC)) (PBOUT S)) (PROG (S) (SETQ S (CHAR Y)) (
+PBOUT S)) (PROG (S) (SETQ S (DIFFERENCE 55 Y)) (PBOUT S)) (PROG (S) (SETQ S (
+PLUS 32 X)) (RETURN (PBOUT S))))
+
+(DE TERMINAL-PRINTCHAR (TERM S) (PBOUT S))
+
+(DE TERMINAL-PRINTSTRING (TERM S) (PROG (I N) (COND ((NOT (STRINGP S)) (SETQ
+S (GEVSTRINGIFY S)))) (SETQ N (ADD1 (SIZE S))) (SETQ I 0) (PROG NIL GLLABEL1 (
+COND ((LESSP I N) (PBOUT (INDX S I)) (SETQ I (ADD1 I)) (GO GLLABEL1))))))
+
+(SETQ TERMINAL (QUOTE VT52))
+
+(GLOBAL (QUOTE (MENUSTART)))
+
+(GLISPOBJECTS (MENU (LISTOBJECT (ITEMS (LISTOF ATOM)) (WINDOW WINDOW)) MSG ((
+SELECT MENU-SELECT RESULT ATOM))) (MOUSE ANYTHING) (WINDOW (LISTOBJECT (
+START VECTOR) (SIZE VECTOR) (TITLE STRING) (LASTFILLEDLINE INTEGER)) PROP ((
+YPOSITION (LASTFILLEDLINE)) (LEFTMARGIN (1)) (RIGHTMARGIN (WIDTH !- 2))) MSG ((
+CLEAR WINDOW-CLEAR) (OPEN WINDOW-OPEN) (CLOSE WINDOW-CLOSE) (INVERTAREA
+WINDOW-INVERTAREA OPEN T) (MOVETOXY WINDOW-MOVETOXY OPEN T) (MOVETO
+WINDOW-MOVETO OPEN T) (PRINTAT WINDOW-PRINTAT OPEN T) (PRETTYPRINTAT
+WINDOW-PRETTYPRINTAT OPEN T) (UNPRINTAT WINDOW-UNPRINTAT OPEN T) (DRAWLINE
+WINDOW-DRAWLINE OPEN T) (UNDRAWLINE WINDOW-UNDRAWLINE OPEN T) (CENTEROFFSET
+WINDOW-CENTEROFFSET OPEN T)) SUPERS (REGION)))
+
+(GLISPGLOBALS (MOUSE MOUSE))
+
+(GLISPCONSTANTS (WINDOWCHARWIDTH 1 INTEGER) (WINDOWLINEYSPACING 1 INTEGER))
+
+(SETQ MOUSE (QUOTE MOUSE))
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ MENUSTART (A VECTOR WITH X = 50 Y = 3))
+
+(DE MENU-SELECT (M) (PROG (MAXW I N SAVEESC SAVEGLQ SAVEGCG RESULT) (COND ((
+NOT GEVACTIVEFLG) (GEVENTER))) (SETQ SAVEGLQ GLQUIETFLG) (SETQ GLQUIETFLG T) (
+SETQ MAXW 0) (MAPC (CADR M) (FUNCTION (LAMBDA (X) (SETQ MAXW (MAX MAXW (PROG (
+SELF) (SETQ SELF (ID2STRING X)) (RETURN (ADD1 (SIZE SELF))))))))) (COND ((
+GREATERP MAXW 20) (SETQ MAXW 20))) (RPLACA (CDDR M) (LIST (QUOTE WINDOW)
+MENUSTART (LIST (TIMES (PLUS MAXW 5) 1) (TIMES (MIN (ADD1 (LENGTH (CADR M)))
+19) 1)) "Menu" 0)) (WINDOW-OPEN (CADDR M)) (SETQ I 0) (MAPC (CADR M) (
+FUNCTION (LAMBDA (X) (SETQ I (ADD1 I)) (PROG (W S POS) (SETQ W (CADDR M)) (
+SETQ S (CONCAT (GEVSTRINGIFY I) (CONCAT (COND ((LESSP I 10) " ") (T " ")) (
+GEVSTRINGIFY X)))) (SETQ POS (LIST 1 (DIFFERENCE (PROG (SELF) (SETQ SELF (
+CADDR M)) (RETURN (CADR (CADDR SELF)))) I))) (COND ((GREATERP (CADR POS)
+0) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY
+TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (TERMINAL-PRINTSTRING
+TERMINAL S) (TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH W 5))) (RPLACA (
+PNTH W 5) (CADR POS)))))))))) (PROG (W) (SETQ W (CADDR M)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))) (PBOUT (
+CHAR ESC)) (PBOUT (CHAR K)) LP (PROG (W) (SETQ W (CADDR M)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))) (
+TERMINAL-PRINTSTRING TERMINAL "Menu: ") (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (
+ECHOON) (SETQ N (READ)) (ECHOOFF) (COND ((AND (FIXP N) (GREATERP N 0) (NOT (
+GREATERP N (LENGTH (CADR M))))) (SETQ RESULT (CAR (PNTH (CADR M) N))) (GO
+OUT)) ((EQ N (QUOTE Q)) (SETQ RESULT NIL) (GO OUT)) (T (PRIN1 N) (SPACES
+1) (TERMINAL-PRINTSTRING TERMINAL "?") (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (
+GO LP))) OUT (WINDOW-CLOSE (CADDR M)) (PROG (W) (SETQ W (CADDR M)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))) (TERPRI) (
+PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (SETQ GLQUIETFLG SAVEGLQ) (COND ((NOT
+GEVACTIVEFLG) (GEVEXIT))) (RETURN RESULT)))
+
+(DE PRINTNC (N C) (PROG NIL GLLABEL1 (COND ((GREATERP N 0) (SETQ N (SUB1 N)) (
+PBOUT C) (GO GLLABEL1)))))
+
+(DE WINDOW-CLEAR (W) (PROG (TTL NBL Y NLINES) (SETQ NLINES 0) NIL (SETQ Y (
+SUB1 (CADR (CADDR W)))) (PROG NIL GLLABEL1 (COND ((NOT (LESSP Y (CAR (PNTH W
+5)))) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS Y (CADADR W))) (
+PBOUT 124) (COND ((LESSP Y (PLUS (CADADR W) (CADR (CADDR W)))) (PBOUT (CHAR
+ESC)) (PBOUT (CHAR K)))) (PROG (X) (SETQ X (SUB1 (CAADDR W))) (
+TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PBOUT
+124) (COND ((GREATERP (SETQ NLINES (ADD1 NLINES)) 3) (TERPRI) (SETQ NLINES
+0))) (SETQ Y (SUB1 Y)) (GO GLLABEL1)))) NIL (TERMINAL-MOVETOXY TERMINAL (
+PLUS 0 (CAADR W)) (PLUS -1 (CADADR W))) (TERPRI) (RPLACA (PNTH W 5) (CADR (
+CADDR W))) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W))))
+)
+
+(DE WINDOW-CLOSE (W) (PROG (Y NLINES) (SETQ Y (CADR (CADDR W))) (SETQ NLINES
+0) (PROG NIL GLLABEL1 (COND ((NOT (LESSP Y 0)) (TERMINAL-MOVETOXY TERMINAL (
+PLUS 0 (CAADR W)) (PLUS Y (CADADR W))) (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (
+COND ((GREATERP (SETQ NLINES (ADD1 NLINES)) 8) (TERPRI) (SETQ NLINES 0))) (
+SETQ Y (SUB1 Y)) (GO GLLABEL1)))) (TERPRI)))
+
+(DE WINDOW-DRAWLINE (W FROM TO) (COND ((EQN (CADR FROM) (CADR TO)) (PROG (X
+Y) (SETQ X (CAR FROM)) (SETQ Y (CADR FROM)) (TERMINAL-MOVETOXY TERMINAL (
+PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (ADD1 (DIFFERENCE (CAR TO) (
+CAR FROM))) 45) (COND ((LESSP (CADR FROM) (CAR (PNTH W 5))) (CAR (RPLACA (
+PNTH W 5) (CADR FROM))))))))
+
+(DE WINDOW-INVERTAREA (W AREA) NIL)
+
+(DE WINDOW-MOVETO (W POS) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (
+RETURN (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W))))))
+
+(DE WINDOW-MOVETOXY (W X Y) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (
+PLUS Y (CADADR W))))
+
+(DE WINDOW-OPEN (W) (PROG (TTL NBL L) (PROG (Y) (SETQ Y (CADR (CADDR W))) (
+TERMINAL-MOVETOXY TERMINAL (PLUS 1 (CAADR W)) (PLUS Y (CADADR W)))) (SETQ
+TTL (OR (CADDDR W) " ")) (SETQ L (ADD1 (SIZE TTL))) NIL (COND ((GREATERP (
+ADD1 (SIZE TTL)) (DIFFERENCE (CAADDR W) 2)) (SETQ TTL (SUBSTRING TTL 1 (
+DIFFERENCE (CAADDR W) 2))))) (SETQ NBL (SUB1 (QUOTIENT (DIFFERENCE (CAADDR W) (
+ADD1 (SIZE TTL))) 2))) (PRINTNC NBL 32) (TERMINAL-PRINTSTRING TERMINAL TTL) (
+PRINTNC (DIFFERENCE (DIFFERENCE (DIFFERENCE (CAADDR W) (ADD1 (SIZE TTL)))
+NBL) 2) 32) NIL (TERPRI) NIL (RPLACA (PNTH W 5) 1) (PROG (Y) (SETQ Y (CADR (
+CADDR W))) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS Y (CADADR W))))
+(PBOUT 124) (PROG (X Y) (SETQ X (SUB1 (CAADDR W))) (SETQ Y (CADR (CADDR W))) (
+TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PBOUT
+124) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR W)) (PLUS 0 (CADADR W))) (
+PBOUT 124) (PRINTNC (DIFFERENCE (CAADDR W) 2) 95) (PBOUT 124) (PBOUT (CHAR
+ESC)) (PBOUT (CHAR K)) NIL (TERPRI) (WINDOW-CLEAR W) (TERMINAL-MOVETOXY
+TERMINAL (PLUS 0 (CAADR W)) (PLUS -1 (CADADR W)))))
+
+(DE WINDOW-PRETTYPRINTAT (W VALUE POSITION) (PROG (X Y) (SETQ X (CAR
+POSITION)) (SETQ Y (CADR POSITION)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
+CAADR W)) (PLUS Y (CADADR W)))) (RESETLST (RESETSAVE SYSPRETTYFLG T) (
+RESETSAVE TTYLINELENGTH (SUB1 (DIFFERENCE (CAADDR W) (CAR POSITION)))) (
+SHOWPRINT VALUE) (CAR (RPLACA (PNTH W 5) 1))))
+
+(DE WINDOW-PRINTAT (W S POS) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (
+SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
+CAADR W)) (PLUS Y (CADADR W)))) (TERMINAL-PRINTSTRING TERMINAL S) (TERPRI) (
+COND ((LESSP (CADR POS) (CAR (PNTH W 5))) (CAR (RPLACA (PNTH W 5) (CADR POS)))))
+)))
+
+(DE WINDOW-UNDRAWLINE (W FROM TO) (COND ((EQN (CADR FROM) (CADR TO)) (PROG (
+X Y) (SETQ X (CAR FROM)) (SETQ Y (CADR FROM)) (TERMINAL-MOVETOXY TERMINAL (
+PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (ADD1 (DIFFERENCE (CAR TO) (
+CAR FROM))) 32))))
+
+(DE WINDOW-UNPRINTAT (W S POS) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (
+SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
+CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (ADD1 (SIZE S)) 32))))
+
+(FLUID (QUOTE (N)))
+
+(GLOBAL (QUOTE (GEVMENUWINDOW GEVSAVEESC GEVSAVEGLQUIET GEVSAVEGCGAG
+GEVMOUSEAREA GLQUIETFLG GLLISPDIALECT GEVTYPENAMES GLUSERSTRNAMES MOUSE
+TERMINAL)))
+
+(DE GEVENTER NIL (SETQ GEVSAVEGCGAG *GC) (SETQ *GC NIL) (SETQ GEVSAVEGLQUIET
+GLQUIETFLG) (SETQ GLQUIETFLG T) (ECHOOFF))
+
+(DE GEVEXIT NIL (SETQ *GC GEVSAVEGCGAG) (SETQ GLQUIETFLG GEVSAVEGLQUIET) (
+ECHOON))
+
+(DE GEVINITEDITWINDOW NIL (PROG NIL (SETQ GEVWINDOW (LIST (QUOTE WINDOW) (
+APPEND (QUOTE (0 3)) NIL) (APPEND (QUOTE (46 20)) NIL)
+"GEV Structure Inspector" 0)) (RETURN GEVWINDOW)))
+
+(DE GEVMOUSELOOP NIL (PROG (INP N TMP) LP (TERMINAL-MOVETOXY TERMINAL (PLUS
+0 (CAADR GEVWINDOW)) (PLUS -1 (CADADR GEVWINDOW))) (PBOUT (CHAR ESC)) (PBOUT (
+CHAR K)) (TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR GEVWINDOW)) (PLUS -1 (
+CADADR GEVWINDOW))) (TERMINAL-PRINTSTRING TERMINAL "GEV: ") (ECHOON) (SETQ
+INP (READ)) (ECHOOFF) (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (COND ((AND (EQUAL
+INP T) (NUMBERP (SETQ N (READ)))) (GEVNSELECT N NIL) (GO LP)) ((NUMBERP INP) (
+GEVNSELECT INP T) (GO LP)) ((SETQ TMP (ASSOC INP (QUOTE ((Q QUIT) (POP POP) (
+E EDIT) (PR PROGRAM) (P PROP) (A ADJ) (I ISA) (M MSG))))) (GEVCOMMANDFN (
+CADR TMP)) (COND ((OR (EQ (CADR TMP) (QUOTE QUIT)) (NOT GEVACTIVEFLG)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS 0 (CAADR GEVWINDOW)) (PLUS -1 (CADADR
+GEVWINDOW))) (PBOUT (CHAR ESC)) (PBOUT (CHAR K)) (RETURN NIL)) (T (GO LP)))) ((
+EQ INP (QUOTE R)) (WINDOW-OPEN GEVWINDOW) (GEVFILLWINDOW) (GO LP)) (T (PRIN1
+"? Quit POP Edit PRogram Prop Adj Isa Msg Redraw") (TERPRI) (GO LP)))))
+
+(DE GEVNSELECT (N FLAG) (PROG (L TOP SUBLIST GROUP ITEM) (SETQ GROUP 0) (
+SETQ TOP (CAR GEVEDITCHAIN)) LP (COND ((NOT TOP) (RETURN NIL))) (SETQ
+SUBLIST (CAR TOP)) (SETQ TOP (CDR TOP)) (SETQ GROUP (ADD1 GROUP)) (COND ((
+AND (EQN GROUP 1) (NOT (LESSP (SETQ L (LENGTH SUBLIST)) N))) (SETQ ITEM (CAR (
+PNTH SUBLIST (DIFFERENCE (ADD1 L) N))))) ((NOT (SETQ ITEM (GEVNTHITEM
+SUBLIST))) (GO LP))) (COND ((MEMQ (CAR (PNTH ITEM 5)) (QUOTE (STRUCTURE
+SUBTREE LISTOF))) (RETURN NIL)) (T (RETURN (GEVITEMEVENTFN ITEM GROUP FLAG))))))
+
+(DE GEVNTHITEM (L) (PROG (TMP RES) (COND ((NOT (GREATERP N 0)) (ERROR 0 NIL)) ((
+NOT L) (RETURN NIL)) ((EQN N 1) (RETURN (CAR L))) (T (SETQ N (SUB1 N)) (SETQ
+TMP (CAR L)) (SETQ L (CDR L)) (COND ((AND (MEMQ (CAR (PNTH TMP 5)) (QUOTE (
+STRUCTURE SUBTREE LISTOF))) (SETQ RES (GEVNTHITEM (CAR (PNTH TMP 6))))) (
+RETURN RES)) (T (RETURN (GEVNTHITEM L))))))))
+
+(GLISPCONSTANTS (GEVNUMBERCHARS 2 INTEGER) (GEVNUMBERPOS 1 INTEGER))
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ GEVMOUSEAREA NIL)
+
+(FLUID (QUOTE (GLNATOM RESULT Y)))
+
+(GLOBAL (QUOTE (GEVACTIVEFLG GEVEDITCHAIN GEVEDITFLG GEVLASTITEMNUMBER
+GEVMENUWINDOW GEVMENUWINDOWHEIGHT GEVMOUSEAREA GEVSHORTCHARS GEVWINDOW
+GEVWINDOWY)))
+
+(GLISPGLOBALS (GEVACTIVEFLG BOOLEAN) (GEVEDITCHAIN EDITCHAIN) (GEVEDITFLG
+BOOLEAN) (GEVLASTITEMNUMBER INTEGER) (GEVMENUWINDOW WINDOW) (
+GEVMENUWINDOWHEIGHT INTEGER) (GEVMOUSEAREA MOUSESTATE) (GEVSHORTCHARS
+INTEGER) (GEVWINDOW WINDOW) (GEVWINDOWY INTEGER))
+
+(GLISPCONSTANTS (GEVMOUSEBUTTON 4 INTEGER) (GEVNAMECHARS 11 INTEGER) (
+GEVVALUECHARS 27 INTEGER) (GEVNAMEPOS (GEVNUMBERPOS !+ (IF GEVNUMBERCHARS >
+0 THEN (GEVNUMBERCHARS !+ 1) *WINDOWCHARWIDTH ELSE 0)) INTEGER) (GEVTILDEPOS (
+GEVNAMEPOS !+ (GEVNAMECHARS+1) *WINDOWCHARWIDTH) INTEGER) (GEVVALUEPOS (
+GEVTILDEPOS !+ !2*WINDOWCHARWIDTH) INTEGER))
+
+(GLISPOBJECTS (EDITCHAIN (LISTOF EDITFRAME) PROP ((TOPFRAME ((CAR SELF))) (
+TOPITEM ((CAR TOPFRAME:PREVS))))) (EDITFRAME (LIST (PREVS (LISTOF GSEITEM)) (
+SUBITEMS (LISTOF GSEITEM)) (PROPS (LISTOF GSEITEM)))) (GSEITEM (LIST (NAME
+ATOM) (VALUE ANYTHING) (TYPE ANYTHING) (SHORTVALUE ATOM) (NODETYPE ATOM) (
+SUBVALUES (LISTOF GSEITEM)) (NAMEPOS VECTOR) (VALUEPOS VECTOR)) PROP ((
+NAMEAREA ((VIRTUAL REGION WITH START = NAMEPOS WIDTH = WINDOWCHARWIDTH* (
+NCHARS NAME) HEIGHT = WINDOWLINEYSPACING))) (VALUEAREA ((VIRTUAL REGION WITH
+START = VALUEPOS WIDTH = WINDOWCHARWIDTH* (NCHARS NAME) HEIGHT =
+WINDOWLINEYSPACING))))) (MOUSESTATE (LIST (AREA REGION) (ITEM GSEITEM) (FLAG
+BOOLEAN) (GROUP INTEGER))))
+
+(DF GEV (ARGS) (GEVA (CAR ARGS) (EVAL (CAR ARGS)) (AND (CDR ARGS) (COND ((OR (
+NOT (ATOM (CADR ARGS))) (NOT (UNBOUNDP (CADR ARGS)))) (EVAL (CADR ARGS))) (T (
+CADR ARGS))))))
+
+(DE GEVA (VAR VAL STR) (PROG (GLNATOM TMP HEADER) (GEVENTER) (COND ((OR (NOT (
+NOT (UNBOUNDP (QUOTE GEVWINDOW)))) (NULL GEVWINDOW)) (GEVINITEDITWINDOW))) (
+COND (GEVMENUWINDOW (WINDOW-OPEN GEVMENUWINDOW))) (WINDOW-OPEN GEVWINDOW) (
+SETQ GEVACTIVEFLG T) (SETQ GEVEDITFLG NIL) (SETQ GLNATOM 0) (SETQ
+GEVSHORTCHARS 27) (COND ((AND (PAIRP VAR) (EQ (CAR VAR) (QUOTE QUOTE))) (
+SETQ VAR (CONCAT "'" (GEVSTRINGIFY (CADR VAR)))))) (COND ((NOT STR) (COND ((
+AND (ATOM VAL) (GET VAL (QUOTE GLSTRUCTURE))) (SETQ STR (QUOTE GLTYPE))) ((
+GEVGLISPP) (SETQ STR (GLCLASS VAL)))))) (SETQ HEADER (LIST VAR VAL STR NIL
+NIL NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL))) (SETQ
+GEVEDITCHAIN (LIST (LIST (LIST HEADER) NIL NIL))) (GEVREFILLWINDOW) (
+GEVMOUSELOOP) (GEVEXIT)))
+
+(DE GEVCOMMANDFN (COMMANDWORD) (PROG (PL SUBPL PROPNAME VAL PROPNAMES
+TOPITEM) (CASEQ COMMANDWORD (EDIT (GEVEDIT)) (QUIT (COND (GEVMOUSEAREA (PROG (
+AREA) (SETQ AREA (CAR GEVMOUSEAREA))) (SETQ GEVMOUSEAREA NIL)) (T (GEVQUIT)))) (
+POP (GEVPOP T 1)) (PROGRAM (GEVPROGRAM)) ((PROP ADJ ISA MSG) (SETQ TOPITEM (
+CAAAR GEVEDITCHAIN)) (GEVCOMMANDPROP TOPITEM COMMANDWORD NIL)) (T (ERROR
+0 NIL)))))
+
+(DE GEVCOMMANDPROP (ITEM COMMANDWORD PROPNAME) (PROG (VAL PROPNAMES FLG) (
+COND (PROPNAME (SETQ FLG T))) (COND ((ATOM (CADDR ITEM)) (SETQ PROPNAMES (
+GEVCOMMANDPROPNAMES (CADDR ITEM) COMMANDWORD (CAR GEVEDITCHAIN))))) (COND ((
+OR (ATOM (CADDR ITEM)) (EQ COMMANDWORD (QUOTE PROP))) (COND ((EQ COMMANDWORD (
+QUOTE PROP)) (COND ((CDR PROPNAMES) (SETQ PROPNAMES (CONS (QUOTE ALL)
+PROPNAMES)))) (SETQ PROPNAMES (CONS (QUOTE SELF) PROPNAMES)))) (COND ((NOT
+PROPNAMES) (RETURN NIL))) (COND ((NOT PROPNAME) (SETQ PROPNAME (MENU-SELECT (
+LIST (QUOTE MENU) PROPNAMES (COPY (QUOTE (WINDOW (0 0) (0 0) NIL 0)))))))) (
+COND ((NOT PROPNAME) (RETURN NIL)) ((EQ PROPNAME (QUOTE SELF)) (PRIN1
+PROPNAME) (PRINC " = ") (PRINT (CADR ITEM))) ((AND (EQ COMMANDWORD (QUOTE
+PROP)) (EQ PROPNAME (QUOTE ALL))) (MAPC (OR (CDDR PROPNAMES) (CDR PROPNAMES)) (
+FUNCTION (LAMBDA (X) (GEVDOPROP ITEM X COMMANDWORD FLG))))) (T (GEVDOPROP
+ITEM PROPNAME COMMANDWORD FLG))) (COND ((EQ COMMANDWORD (QUOTE MSG)) (
+GEVREFILLWINDOW) (SETQ GEVEDITFLG T)))))))
+
+(DE GEVCOMMANDPROPNAMES (OBJ PROPTYPE TOPFRAME) (PROG (RESULT TYPE) (SETQ
+RESULT (MAPCAN (CASEQ PROPTYPE (PROP (LISTGET (CDR (GET OBJ (QUOTE
+GLSTRUCTURE))) (QUOTE PROP))) (ADJ (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE)))
+(QUOTE ADJ))) (ISA (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE ISA))) (
+MSG (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE MSG)))) (FUNCTION (
+LAMBDA (P) (AND (NOT (AND (NE PROPTYPE (QUOTE MSG)) (CAR (SOME (CADDR
+TOPFRAME) (FUNCTION (LAMBDA (GLVAR1) (EQ (CAR GLVAR1) (CAR P)))))))) (NOT (
+AND (EQ PROPTYPE (QUOTE PROP)) (MEMQ (CAR P) (QUOTE (SHORTVALUE DISPLAYPROPS))))
+) (NOT (AND (EQ PROPTYPE (QUOTE MSG)) (ATOM (CADR P)) (OR (NOT (GETDDD (CADR
+P))) (GREATERP (LENGTH (CADR (GETDDD (CADR P)))) 1)))) (CONS (CAR P) NIL)))))) (
+MAPC (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE SUPERS)) (FUNCTION (
+LAMBDA (S) (SETQ RESULT (NCONC RESULT (GEVCOMMANDPROPNAMES S PROPTYPE
+TOPFRAME)))))) (RETURN RESULT)))
+
+(DE GEVCOMPPROP (STR PROPNAME PROPTYPE) (PROG (PROPENT) (COND ((NOT (MEMQ
+PROPTYPE (QUOTE (ADJ ISA PROP MSG)))) (RETURN (QUOTE GEVERROR)))) (COND ((
+AND (SETQ PROPENT (GEVGETPROP STR PROPNAME PROPTYPE)) (ATOM (CADR PROPENT))) (
+RETURN (CADR PROPENT)))) (RETURN (COND ((GEVGLISPP) (OR (GLCOMPPROP STR
+PROPNAME PROPTYPE) (QUOTE GEVERROR))) (T (ERROR 0 (LIST
+"GLISP compiler must be loaded for PROPs which"
+"are not specified with function name equivalents." STR PROPTYPE PROPNAME)))))))
+
+(DE GEVDATANAMES (OBJ FILTER) (PROG (RESULT) (GEVDATANAMESB (CAR (GET OBJ (
+QUOTE GLSTRUCTURE))) FILTER) (RETURN (REVERSIP RESULT))))
+
+(DE GEVDATANAMESB (STR FILTER) (PROG (TMP) (COND ((ATOM STR) (RETURN NIL)) (
+T (CASEQ (CAR STR) (CONS (GEVDATANAMESB (CADR STR) FILTER) (GEVDATANAMESB (
+CADDR STR) FILTER)) ((ALIST PROPLIST LIST) (MAPC (CDR STR) (FUNCTION (LAMBDA (
+X) (GEVDATANAMESB X FILTER))))) (RECORD (MAPC (CDDR STR) (FUNCTION (LAMBDA (
+X) (GEVDATANAMESB X FILTER))))) (ATOM (GEVDATANAMESB (CADR STR) FILTER) (
+GEVDATANAMESB (CADDR STR) FILTER)) (BINDING (GEVDATANAMESB (CADR STR) FILTER)) (
+LISTOF (RETURN NIL)) (T (COND ((GEVFILTER (CADR STR) FILTER) (SETQ RESULT (
+CONS (LIST (CAR STR) (CADR STR)) RESULT)))) (GEVDATANAMESB (CADR STR) FILTER))))
+)))
+
+(DE GEVDISPLAYNEWPROP NIL (PROG (Y NEWONE) (SETQ Y GEVWINDOWY) (SETQ NEWONE (
+CAR (LASTPAIR (CADDAR GEVEDITCHAIN)))) (GEVPPS NEWONE 0 GEVWINDOW) (SETQ
+GEVWINDOWY Y)))
+
+(DE GEVDOPROP (ITEM PROPNAME COMMANDWORD FLG) (PROG (VAL) (SETQ VAL (
+GEVEXPROP (CADR ITEM) (CADDR ITEM) PROPNAME COMMANDWORD NIL)) (RPLACA (CDDAR
+GEVEDITCHAIN) (ACONC (CADDAR GEVEDITCHAIN) (LIST PROPNAME VAL (GEVPROPTYPE (
+CADDR ITEM) PROPNAME COMMANDWORD) NIL COMMANDWORD NIL (APPEND (QUOTE (0
+0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) (COND ((NOT FLG) (GEVDISPLAYNEWPROP)))))
+
+(DE GEVEDIT NIL (PROG (CHANGEDFLG GEVTOPITEM) (SETQ GEVTOPITEM (CAAAR
+GEVEDITCHAIN)) (COND ((AND (ATOM (CADDR GEVTOPITEM)) (NE (GEVEXPROP (CADR
+GEVTOPITEM) (CADDR GEVTOPITEM) (QUOTE EDIT) (QUOTE MSG) NIL) (QUOTE GEVERROR)))
+(SETQ CHANGEDFLG T)) ((PAIRP (CADR GEVTOPITEM)) (EDITV (CADR GEVTOPITEM)) (
+SETQ CHANGEDFLG T)) (T (RETURN NIL))) (COND (CHANGEDFLG (WINDOW-OPEN
+GEVWINDOW) (GEVREFILLWINDOW))) (SETQ GEVEDITFLG CHANGEDFLG)))
+
+(DE GEVEXPROP (OBJ STR PROPNAME PROPTYPE ARGS) (PROG (FN) (COND ((OR (NOT (
+MEMQ PROPTYPE (QUOTE (ADJ ISA PROP MSG)))) (AND ARGS (NE PROPTYPE (QUOTE MSG))))
+(RETURN (QUOTE GEVERROR)))) (COND ((EQ (SETQ FN (GEVCOMPPROP STR PROPNAME
+PROPTYPE)) (QUOTE GEVERROR)) (RETURN FN)) (T (RETURN (GEVAPPLY FN (CONS OBJ
+ARGS)))))))
+
+(DE GEVFILLWINDOW NIL (PROG (Y TOP) (WINDOW-CLEAR GEVWINDOW) (SETQ Y (SUB1 (
+CADR (CADDR GEVWINDOW)))) (SETQ GEVLASTITEMNUMBER 0) (SETQ TOP (CAR
+GEVEDITCHAIN)) (MAPC (REVERSE (CAR TOP)) (FUNCTION (LAMBDA (X) (GEVPPS X
+0 GEVWINDOW)))) (GEVHORIZLINE GEVWINDOW) (MAPC (CADR TOP) (FUNCTION (LAMBDA (
+X) (GEVPPS X 0 GEVWINDOW)))) (GEVHORIZLINE GEVWINDOW) (MAPC (CADDR TOP) (
+FUNCTION (LAMBDA (X) (GEVPPS X 0 GEVWINDOW)))) (SETQ GEVWINDOWY Y)))
+
+(DE GEVFILTER (TYPE FILTER) (SETQ TYPE (GEVXTRTYPE TYPE)) (CASEQ FILTER (
+NUMBER (AND (NOT (MEMQ TYPE (QUOTE (ATOM STRING BOOLEAN ANYTHING)))) (NOT (
+AND (PAIRP TYPE) (EQ (CAR TYPE) (QUOTE LISTOF)))))) (LIST (AND (PAIRP TYPE) (
+EQ (CAR TYPE) (QUOTE LISTOF)))) (T T)))
+
+(DE GEVFINDITEMPOS (POS ITEM N) (OR (GEVPOSTEST POS (CAR (PNTH ITEM 7)) (CAR
+ITEM) ITEM NIL N) (GEVPOSTEST POS (CAR (PNTH ITEM 8)) (CADDDR ITEM) ITEM T N) (
+AND (OR (EQ (CAR (PNTH ITEM 5)) (QUOTE STRUCTURE)) (EQ (CAR (PNTH ITEM
+5)) (QUOTE SUBTREE)) (EQ (CAR (PNTH ITEM 5)) (QUOTE LISTOF))) (
+GEVFINDLISTPOS POS (CAR (PNTH ITEM 6)) N))))
+
+(DE GEVFINDLISTPOS (POS ITEMS N) (COND (ITEMS (OR (GEVFINDITEMPOS POS (CAR
+ITEMS) N) (GEVFINDLISTPOS POS (CDR ITEMS) N)))))
+
+(DE GEVFINDPOS (POS FRAME) (PROG (TMP N ITEMS) (SETQ N 0) (PROG NIL GLLABEL1 (
+COND ((AND FRAME (NOT TMP)) (SETQ N (ADD1 N)) (SETQ ITEMS (CAR FRAME)) (SETQ
+FRAME (CDR FRAME)) (SETQ TMP (GEVFINDLISTPOS POS ITEMS N)) (GO GLLABEL1)))) (
+RETURN TMP)))
+
+(DE GEVGETNAMES (OBJ FILTER) (PROG (DATANAMES PROPNAMES) (SETQ DATANAMES (
+GEVDATANAMES OBJ FILTER)) (SETQ PROPNAMES (GEVPROPNAMES OBJ (QUOTE PROP)
+FILTER)) (RETURN (NCONC DATANAMES PROPNAMES))))
+
+(DE GEVGETPROP (STR PROPNAME PROPTYPE) (PROG (PL SUBPL PROPENT) (COND ((NOT (
+MEMQ PROPTYPE (QUOTE (ADJ ISA PROP MSG)))) (ERROR 0 NIL))) (RETURN (AND (
+SETQ PL (GET STR (QUOTE GLSTRUCTURE))) (SETQ SUBPL (LISTGET (CDR PL)
+PROPTYPE)) (SETQ PROPENT (ASSOC PROPNAME SUBPL))))))
+
+(DE GEVGLISPP NIL (NOT (UNBOUNDP (QUOTE GLBASICTYPES))))
+
+(DE GEVHORIZLINE (W) (PROG (FROM TO) (SETQ FROM (LIST 1 (PLUS Y 0))) (SETQ
+TO (LIST (DIFFERENCE (CAADDR W) 2) (PLUS Y 0))) (COND ((EQN (CADR FROM) (
+CADR TO)) (PROG (X Y) (SETQ X (CAR FROM)) (SETQ Y (CADR FROM)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR W)) (PLUS Y (CADADR W)))) (PRINTNC (
+ADD1 (DIFFERENCE (CAR TO) (CAR FROM))) 45) (COND ((LESSP (CADR FROM) (CAR (
+PNTH W 5))) (RPLACA (PNTH W 5) (CADR FROM))))))) (SETQ Y (SUB1 Y)))
+
+(DE GEVINIT NIL (SETQ GLNATOM 0) (COND ((NOT (NOT (UNBOUNDP (QUOTE
+GLLISPDIALECT)))) (SETQ GLLISPDIALECT (QUOTE INTERLISP)))) (SETQ GEVWINDOW
+NIL))
+
+(DE GEVITEMEVENTFN (ITEM GROUP FLAG) (PROG (TMP TOP N) (COND (FLAG (COND ((
+EQN GROUP 1) (SETQ TMP (CAAR GEVEDITCHAIN)) (SETQ N 0) (PROG NIL GLLABEL1 (
+COND ((AND TMP (NOT (EQUAL (PROG1 (SETQ TOP (CAR TMP)) (SETQ TMP (CDR TMP)))
+ITEM))) (SETQ N (ADD1 N)) (GO GLLABEL1)))) (GEVPOP NIL N)) (T (GEVPUSH ITEM))))
+(T (PRIN1 (CAR ITEM)) (PRINC " is ") (PRIN1 (CADDR ITEM)) (TERPRI)))))
+
+(DE GEVLENGTHBOUND (VAL NCHARS) (COND ((GREATERP (FLATSIZE2 VAL) NCHARS) (
+CONCAT (SUBSTRING VAL 1 (SUB1 NCHARS)) "-")) (T VAL)))
+
+(DE GEVMAKENEWFN (OPERATION INPUTTYPE SET PATH) (PROG (LASTPATH VIEWSPEC) (
+SETQ LASTPATH (CAR (LASTPAIR PATH))) (RETURN (LIST (LIST (QUOTE GLAMBDA) (
+LIST (MKATOM (CONCAT "GEVNEWFNTOP:" (ID2STRING INPUTTYPE)))) (LIST (QUOTE
+PROG) (CONS (QUOTE GEVNEWFNVALUE) (CASEQ OPERATION (COLLECT (QUOTE (
+GEVNEWFNRESULT))) ((MAXIMUM MINIMUM) (QUOTE (GEVNEWFNTESTVAL
+GEVNEWFNINSTANCE))) (TOTAL (QUOTE ((GEVNEWFNSUM 0)))) (AVERAGE (QUOTE ((
+GEVNEWFNSUM 0.0) (GEVNEWFNCOUNT 0)))) (T (ERROR 0 NIL)))) (NCONC (LIST (
+QUOTE FOR) (QUOTE GEVNEWFNLOOPVAR) (QUOTE IN) (MKATOM (CONCAT "GEVNEWFNTOP:" (
+ID2STRING (CAR SET)))) (QUOTE DO) (LIST (QUOTE GEVNEWFNVALUE) (QUOTE _) (
+PROGN (SETQ VIEWSPEC (LIST (QUOTE GEVNEWFNLOOPVAR))) (MAPC PATH (FUNCTION (
+LAMBDA (X) (SETQ VIEWSPEC (CONS (QUOTE OF) VIEWSPEC)) (SETQ VIEWSPEC (CONS (
+CAR X) VIEWSPEC)) (SETQ VIEWSPEC (CONS (QUOTE THE) VIEWSPEC))))) VIEWSPEC))) (
+COPY (CASEQ OPERATION (COLLECT (QUOTE ((GEVNEWFNRESULT !+_ GEVNEWFNVALUE)))) (
+MAXIMUM (QUOTE ((IF ~ GEVNEWFNINSTANCE OR GEVNEWFNVALUE > GEVNEWFNTESTVAL
+THEN (GEVNEWFNTESTVAL _ GEVNEWFNVALUE) (GEVNEWFNINSTANCE _ GEVNEWFNLOOPVAR)))))
+(MINIMUM (QUOTE ((IF ~ GEVNEWFNINSTANCE OR GEVNEWFNVALUE < GEVNEWFNTESTVAL
+THEN (GEVNEWFNTESTVAL _ GEVNEWFNVALUE) (GEVNEWFNINSTANCE _ GEVNEWFNLOOPVAR)))))
+(AVERAGE (QUOTE ((GEVNEWFNSUM _+ GEVNEWFNVALUE) (GEVNEWFNCOUNT _+ 1)))) (
+TOTAL (QUOTE ((GEVNEWFNSUM _+ GEVNEWFNVALUE))))))) (LIST (QUOTE RETURN) (
+CASEQ OPERATION (COLLECT (QUOTE (DREVERSE GEVNEWFNRESULT))) ((MAXIMUM
+MINIMUM) (QUOTE (LIST GEVNEWFNTESTVAL GEVNEWFNINSTANCE))) (AVERAGE (QUOTE (
+QUOTIENT GEVNEWFNSUM (FLOAT GEVNEWFNCOUNT)))) (TOTAL (QUOTE GEVNEWFNSUM)))))) (
+CASEQ OPERATION (COLLECT (LIST (QUOTE LISTOF) (CADR LASTPATH))) ((MAXIMUM
+MINIMUM) (LIST (QUOTE LIST) (COPY LASTPATH) (LIST (QUOTE WINNER) (CADADR SET))))
+(AVERAGE (QUOTE REAL)) (TOTAL (CADR LASTPATH)))))))
+
+(DE GEVMATCH (STR VAL FLG) (PROG (RESULT) (GEVMATCHB STR VAL NIL FLG) (
+RETURN (REVERSIP RESULT))))
+
+(DE GEVMATCHA (STR VAL FLG) (PROG (RES) (SETQ RES (GEVMATCH STR VAL FLG)) (
+COND ((NOT (CDR RES)) (RETURN (CAR RES))) (T (RETURN (LIST NIL VAL STR NIL (
+QUOTE SUBTREE) RES (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))))))
+
+(DE GEVMATCHATOM (STR VAL NAME) (PROG (L STRB TMP) (COND ((OR (NOT (ATOM VAL)) (
+NULL VAL)) (RETURN NIL))) (SETQ STRB (CADR STR)) (COND ((NE (CAR STRB) (
+QUOTE PROPLIST)) (RETURN NIL))) (SETQ L (CDR STRB)) (MAPC L (FUNCTION (
+LAMBDA (X) (COND ((SETQ TMP (GET VAL (CAR X))) (GEVMATCHB X TMP NIL NIL))))))))
+
+(DE GEVMATCHALIST (STR VAL NAME) (PROG (L TMP) (SETQ L (CDR STR)) (MAPC L (
+FUNCTION (LAMBDA (X) (COND ((SETQ TMP (ASSOC (CAR X) VAL)) (GEVMATCHB X (CDR
+TMP) NIL NIL))))))))
+
+(DE GEVMATCHB (STR VAL NAME FLG) (PROG (X Y STRB XSTR TOP TMP) (SETQ XSTR (
+GEVXTRTYPE STR)) (COND ((ATOM STR) (COND ((AND FLG (SETQ STRB (CAR (GET STR (
+QUOTE GLSTRUCTURE))))) (SETQ RESULT (CONS (LIST NAME VAL STR NIL (QUOTE
+STRUCTURE) (GEVMATCH STRB VAL NIL) (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (
+0 0)) NIL)) RESULT))) (T (SETQ RESULT (CONS (LIST NAME VAL STR NIL NIL NIL (
+APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) RESULT)))) (RETURN NIL)) (
+T (CASEQ (CAR STR) (CONS (GEVMATCHB (CADR STR) (CAR VAL) NIL NIL) (GEVMATCHB (
+CADDR STR) (CDR VAL) NIL NIL)) (LIST (MAPC (CDR STR) (FUNCTION (LAMBDA (X) (
+COND (VAL (GEVMATCHB X (CAR VAL) NIL NIL) (SETQ VAL (CDR VAL)))))))) (ATOM (
+GEVMATCHATOM STR VAL NAME)) (ALIST (GEVMATCHALIST STR VAL NAME)) (PROPLIST (
+GEVMATCHPROPLIST STR VAL NAME)) (LISTOF (GEVMATCHLISTOF STR VAL NAME)) (
+RECORD (GEVMATCHRECORD STR VAL NAME)) ((OBJECT ATOMOBJECT LISTOBJECT) (
+GEVMATCHOBJECT STR VAL NAME)) (T (COND (NAME (SETQ TMP (GEVMATCH STR VAL NIL)) (
+SETQ TOP (CAR TMP)) (SETQ RESULT (CONS (COND ((AND (NOT (CDR TMP)) (NOT (CAR
+TOP))) (RPLACA TOP NAME) TOP) (T (LIST NAME VAL XSTR NIL (QUOTE SUBTREE) TMP (
+APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) RESULT))) ((ATOM (
+SETQ STRB (GEVXTRTYPE (CADR STR)))) (GEVMATCHB STRB VAL (CAR STR) NIL)) ((
+SETQ TMP (GEVMATCH (CADR STR) VAL NIL)) (SETQ TOP (CAR TMP)) (SETQ RESULT (
+CONS (COND ((AND (NOT (CDR TMP)) (NOT (CAR TOP))) (RPLACA TOP (CAR STR)) TOP) (
+T (LIST (CAR STR) VAL (CADR STR) NIL (QUOTE SUBTREE) TMP (APPEND (QUOTE (
+0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) RESULT))) (T (PRINT "GEVMATCHB Failed")
+))))))))
+
+(DE GEVMATCHLISTOF (STR VAL NAME) (SETQ RESULT (CONS (LIST NAME VAL STR NIL
+NIL NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) RESULT)))
+
+(DE GEVMATCHOBJECT (STR VAL NAME) (PROG (OBJECTTYPE TMP) (SETQ OBJECTTYPE (
+CAR STR)) (SETQ RESULT (ACONC RESULT (LIST (QUOTE CLASS) (CASEQ OBJECTTYPE ((
+OBJECT LISTOBJECT) (PROG1 (SETQ TMP (CAR VAL)) (SETQ VAL (CDR VAL)))) (
+ATOMOBJECT (GET VAL (QUOTE CLASS)))) (QUOTE GLTYPE) NIL NIL NIL (APPEND (
+QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))) (MAPC (CDR STR) (FUNCTION (
+LAMBDA (X) (CASEQ OBJECTTYPE ((OBJECT LISTOBJECT) (COND (VAL (GEVMATCHB X (
+PROG1 (SETQ TMP (CAR VAL)) (SETQ VAL (CDR VAL))) NIL NIL)))) (ATOMOBJECT (
+COND ((SETQ TMP (GET VAL (CAR X))) (GEVMATCHB X TMP NIL NIL))))))))))
+
+(DE GEVMATCHPROPLIST (STR VAL NAME) (PROG (L TMP) (SETQ L (CDR STR)) (MAPC L (
+FUNCTION (LAMBDA (X) (COND ((SETQ TMP (LISTGET VAL (CAR X))) (GEVMATCHB X
+TMP NIL NIL))))))))
+
+(DE GEVMATCHRECORD (STR VAL NAME) (PROG (STRNAME FIELDS N) (COND ((ATOM (
+CADR STR)) (SETQ STRNAME (CADR STR)) (SETQ FIELDS (CDDR STR))) (T (SETQ
+FIELDS (CDR STR)))) (SETQ N 0) (MAPC FIELDS (FUNCTION (LAMBDA (X) (SETQ N (
+ADD1 N)) (GEVMATCHB X (GETV VAL N) (CAR X) NIL))))))
+
+(DE GEVPOP (FLG N) (PROG (TMP TOP TMPITEM) (COND ((LESSP N 1) (RETURN NIL)))
+LP (SETQ TMP (CAR GEVEDITCHAIN)) (SETQ GEVEDITCHAIN (CDR GEVEDITCHAIN)) (
+COND ((NOT GEVEDITCHAIN) (RETURN (GEVQUIT)))) (SETQ TOP (CAAAR GEVEDITCHAIN)) (
+SETQ TMPITEM (CAAR TMP)) (COND ((AND FLG (EQ (CAR (PNTH TMPITEM 5)) (QUOTE
+FORWARD))) (GO LP))) (COND ((GREATERP (SETQ N (SUB1 N)) 0) (GO LP))) (COND ((
+AND (PAIRP (CADDR TOP)) (EQ (CAADDR TOP) (QUOTE LISTOF)) (NOT (CDADR TOP))) (
+GO LP))) (COND ((AND GEVEDITFLG (NOT (MEMBER (CADDDR TMPITEM) (QUOTE ("(...)"
+"---"))))) (GEVREFILLWINDOW)) (T (SETQ GEVEDITFLG NIL) (GEVFILLWINDOW)))))
+
+(DE GEVPOSTEST (POS TPOS NAME ITEM FLG N) (COND ((AND (NOT (LESSP (CADR POS) (
+CADR TPOS))) (NOT (GREATERP (CADR POS) (ADD1 (CADR TPOS)))) (NOT (LESSP (CAR
+POS) (CAR TPOS))) (LESSP (CAR POS) (PLUS (CAR TPOS) 11))) (LIST (LIST (LIST (
+CAR TPOS) (SUB1 (CADR TPOS))) (LIST (TIMES 1 (ADD1 (SIZE NAME))) 1)) ITEM
+FLG N))))
+
+(DE GEVPPS (ITEM COL WINDOW) (PROG (NAMEX TOP) (COND ((LESSP Y 0) (RETURN
+NIL))) (SETQ GEVLASTITEMNUMBER (ADD1 GEVLASTITEMNUMBER)) (PROG (S POS) (SETQ
+S (GEVSTRINGIFY GEVLASTITEMNUMBER)) (SETQ POS (LIST 1 Y)) (COND ((GREATERP (
+CADR POS) 0) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (
+TERMINAL-PRINTSTRING TERMINAL S) (TERPRI) (COND ((LESSP (CADR POS) (CAR (
+PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 5) (CADR POS))))))) (SETQ NAMEX (PLUS
+4 (TIMES COL 1))) (RPLACA (CAR (PNTH ITEM 7)) NAMEX) (RPLACA (CDAR (PNTH
+ITEM 7)) Y) (COND ((EQ (CAR (PNTH ITEM 5)) (QUOTE FULLVALUE)) (PROG (POS) (
+SETQ POS (LIST NAMEX Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (SETQ X (
+CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR
+WINDOW)) (PLUS Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL "(expanded)")
+(TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH
+WINDOW 5) (CADR POS)))))))) ((CAR ITEM) (COND ((NUMBERP (CAR ITEM)) (PROG (
+POS) (SETQ POS (LIST NAMEX Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (
+SETQ X (CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (
+CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL "#") (
+TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH WINDOW
+5) (CADR POS))))))) (SETQ NAMEX (ADD1 NAMEX)))) (PROG (S POS) (SETQ S (
+GEVLENGTHBOUND (CAR ITEM) 11)) (SETQ POS (LIST NAMEX Y)) (COND ((GREATERP (
+CADR POS) 0) (PROG (X Y) (SETQ X (CAR POS)) (SETQ Y (CADR POS)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (
+TERMINAL-PRINTSTRING TERMINAL S) (TERPRI) (COND ((LESSP (CADR POS) (CAR (
+PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 5) (CADR POS))))))))) (COND ((OR (NOT (
+CAR (PNTH ITEM 5))) (MEMQ (CAR (PNTH ITEM 5)) (QUOTE (FORWARD BACKUP PROP
+ADJ MSG ISA)))) (RPLACA (CAR (PNTH ITEM 8)) 18) (RPLACA (CDAR (PNTH ITEM
+8)) Y) (PROG (S POS) (SETQ S (OR (CADDDR ITEM) (CAR (RPLACA (CDDDR ITEM) (
+GEVSHORTVALUE (CADR ITEM) (CADDR ITEM) (DIFFERENCE GEVSHORTCHARS COL)))))) (
+SETQ POS (LIST 18 Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (SETQ X (
+CAR POS)) (SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR
+WINDOW)) (PLUS Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL S) (
+TERPRI) (COND ((LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH WINDOW
+5) (CADR POS))))))) (COND ((NE (CADDDR ITEM) (CADR ITEM)) (PROG (POS) (SETQ
+POS (LIST 16 Y)) (COND ((GREATERP (CADR POS) 0) (PROG (X Y) (SETQ X (CAR POS)) (
+SETQ Y (CADR POS)) (TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS
+Y (CADADR WINDOW)))) (TERMINAL-PRINTSTRING TERMINAL "~") (TERPRI) (COND ((
+LESSP (CADR POS) (CAR (PNTH WINDOW 5))) (RPLACA (PNTH WINDOW 5) (CADR POS)))))))
+)) (SETQ Y (SUB1 Y))) ((EQ (CAR (PNTH ITEM 5)) (QUOTE FULLVALUE)) (SETQ Y (
+SUB1 Y)) (PROG (VALUE POSITION) (SETQ VALUE (CADR ITEM)) (SETQ POSITION (
+LIST 1 Y)) (PROG (X Y) (SETQ X (CAR POSITION)) (SETQ Y (CADR POSITION)) (
+TERMINAL-MOVETOXY TERMINAL (PLUS X (CAADR WINDOW)) (PLUS Y (CADADR WINDOW)))) (
+RESETLST (RESETSAVE SYSPRETTYFLG T) (RESETSAVE TTYLINELENGTH (SUB1 (
+DIFFERENCE (CAADDR WINDOW) (CAR POSITION)))) (SHOWPRINT VALUE) (CAR (RPLACA (
+PNTH WINDOW 5) 1)))) (SETQ Y (SUB1 (CAR (PNTH WINDOW 5))))) ((EQ (CAR (PNTH
+ITEM 5)) (QUOTE DISPLAY)) (GEVEXPROP (CADR ITEM) (CADDR ITEM) (QUOTE
+GEVDISPLAY) (QUOTE MSG) (LIST WINDOW Y))) (T (SETQ Y (SUB1 Y)) (MAPC (CAR (
+PNTH ITEM 6)) (FUNCTION (LAMBDA (VSUB) (GEVPPS VSUB (PLUS COL 2) WINDOW))))))))
+
+(DE GEVPROGRAM NIL (PROG (TOPITEM COMMAND SET PATH DONE NEXT TYPE NEWFN
+RESULT LAST ABORTFLG) (SETQ TOPITEM (CAAAR GEVEDITCHAIN)) (COND ((OR (EQ (
+SETQ COMMAND (MENU-SELECT (COPY (QUOTE (MENU (QUIT COLLECT TOTAL AVERAGE
+MAXIMUM MINIMUM) (WINDOW (0 0) (0 0) NIL 0)))))) (QUOTE QUIT)) (NOT COMMAND)) (
+RETURN NIL))) (COND ((OR (EQ (SETQ SET (GEVPROPMENU (CADDR TOPITEM) (QUOTE
+LIST) NIL)) (QUOTE QUIT)) (EQ SET (QUOTE POP)) (NOT SET)) (RETURN NIL))) (
+SETQ PATH (LIST SET (LIST (CAR TOPITEM) (CADDR TOPITEM)))) (SETQ NEXT SET) (
+SETQ TYPE (CADADR SET)) (PROG NIL GLLABEL1 (COND ((AND (NOT DONE) (NOT
+ABORTFLG)) (SETQ NEXT (GEVPROPMENU TYPE (AND (NE COMMAND (QUOTE COLLECT)) (
+QUOTE NUMBER)) (EQ COMMAND (QUOTE COLLECT)))) (COND ((ATOM NEXT) (CASEQ NEXT ((
+NIL QUIT) (SETQ ABORTFLG T)) (POP (COND ((NOT (CDDR PATH)) (SETQ ABORTFLG T)) (
+T (SETQ NEXT (CAR PATH)) (SETQ PATH (CDR PATH)) (SETQ NEXT (CAR PATH)) (SETQ
+TYPE (CADR NEXT)) (COND ((PAIRP TYPE) (SETQ TYPE (CADR TYPE)))) (SETQ LAST (
+CAR NEXT))))) (DONE (SETQ DONE T)))) (T (SETQ PATH (CONS NEXT PATH)) (SETQ
+TYPE (CADR NEXT)) (SETQ LAST (CAR NEXT)))) (COND ((MEMQ TYPE (QUOTE (ATOM
+INTEGER STRING REAL BOOLEAN NIL))) (SETQ DONE T))) (GO GLLABEL1)))) (COND (
+ABORTFLG (RETURN NIL))) (SETQ PATH (REVERSIP PATH)) (SETQ NEWFN (
+GEVMAKENEWFN COMMAND (CADDR TOPITEM) SET (CDDR PATH))) (GEVPUTD (QUOTE
+GEVNEWFN) (CAR NEWFN)) (SETQ RESULT (GEVdoNEWFN (CADR TOPITEM))) (PRIN1
+COMMAND) (SPACES 1) (MAPC (CDDR PATH) (FUNCTION (LAMBDA (X) (PRIN1 (CAR X)) (
+SPACES 1)))) (PRINC "OF ") (PRIN1 (CAAR PATH)) (SPACES 1) (PRIN1 (CAADR PATH)) (
+PRINC " = ") (PRINT RESULT) (RPLACA (CDDAR GEVEDITCHAIN) (ACONC (CADDAR
+GEVEDITCHAIN) (LIST (CONCAT (GEVSTRINGIFY COMMAND) (CONCAT " " (GEVSTRINGIFY
+LAST))) RESULT (CADR NEWFN) NIL (QUOTE MSG) NIL (APPEND (QUOTE (0 0)) NIL) (
+APPEND (QUOTE (0 0)) NIL)))) (GEVDISPLAYNEWPROP)))
+
+(DE GEVPROPMENU (OBJ FILTER FLG) (PROG (PROPS SEL PNAMES MENU) (SETQ PROPS (
+GEVGETNAMES OBJ FILTER)) (COND ((NOT PROPS) (RETURN NIL)) (T (SETQ PNAMES (
+MAPCAR PROPS (FUNCTION CAR))) (SETQ SEL (MENU-SELECT (LIST (QUOTE MENU) (
+CONS (QUOTE QUIT) (CONS (QUOTE POP) (COND (FLG (CONS (QUOTE DONE) PNAMES)) (
+T PNAMES)))) (COPY (QUOTE (WINDOW (0 0) (0 0) NIL 0)))))) (RETURN (CASEQ SEL ((
+QUIT POP DONE NIL) SEL) (T (ASSOC SEL PROPS))))))))
+
+(DE GEVPROPNAMES (OBJ PROPTYPE FILTER) (PROG (RESULT TYPE) (SETQ RESULT (
+MAPCAN (CASEQ PROPTYPE (PROP (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (
+QUOTE PROP))) (ADJ (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE ADJ))) (
+ISA (LISTGET (CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE ISA))) (MSG (LISTGET (
+CDR (GET OBJ (QUOTE GLSTRUCTURE))) (QUOTE MSG)))) (FUNCTION (LAMBDA (P) (AND (
+SETQ TYPE (GEVPROPTYPES OBJ (CAR P) (QUOTE PROP))) (GEVFILTER TYPE FILTER) (
+CONS (LIST (CAR P) TYPE) NIL)))))) (MAPC (LISTGET (CDR (GET OBJ (QUOTE
+GLSTRUCTURE))) (QUOTE SUPERS)) (FUNCTION (LAMBDA (S) (SETQ RESULT (NCONC
+RESULT (GEVPROPNAMES S PROPTYPE FILTER)))))) (RETURN RESULT)))
+
+(DE GEVPROPTYPE (STR PROPNAME PROPTYPE) (PROG (PL SUBPL PROPENT TMP) (COND ((
+NOT (ATOM STR)) (RETURN NIL)) ((AND (SETQ PROPENT (GEVGETPROP STR PROPNAME
+PROPTYPE)) (SETQ TMP (LISTGET (CDDR PROPENT) (QUOTE RESULT)))) (RETURN TMP)) ((
+AND PROPENT (ATOM (CADR PROPENT)) (SETQ TMP (GET (CADR PROPENT) (QUOTE
+GLRESULTTYPE)))) (RETURN TMP)) ((AND (SETQ PL (GET STR (QUOTE GLPROPFNS))) (
+SETQ SUBPL (ASSOC PROPTYPE PL)) (SETQ PROPENT (ASSOC PROPNAME (CDR SUBPL))) (
+SETQ TMP (CADDR PROPENT))) (RETURN TMP)) ((EQ PROPTYPE (QUOTE ADJ)) (RETURN (
+QUOTE BOOLEAN))))))
+
+(DE GEVPROPTYPES (OBJ NAME TYPE) (OR (GEVPROPTYPE OBJ NAME TYPE) (AND (
+GEVCOMPPROP OBJ NAME TYPE) (GEVPROPTYPE OBJ NAME TYPE))))
+
+(DE GEVPUSH (ITEM) (PROG (NEWITEMS TOPITEM LSTITEM) (COND ((EQ (CAR (PNTH
+ITEM 5)) (QUOTE BACKUP)) (GEVPOP NIL 1) (RETURN NIL))) (SETQ TOPITEM (CAAAR
+GEVEDITCHAIN)) (COND ((EQ (CAR (PNTH ITEM 5)) (QUOTE FORWARD)) (SETQ
+NEWITEMS (GEVPUSHLISTOF ITEM T))) ((AND (ATOM (CADDR ITEM)) (NOT (GET (CADDR
+ITEM) (QUOTE GLSTRUCTURE)))) (CASEQ (CADDR ITEM) ((ATOM NUMBER REAL INTEGER
+STRING ANYTHING) (COND ((EQ (CADR ITEM) (CADDDR ITEM)) (RETURN NIL)) (T (
+SETQ NEWITEMS (LIST (LIST (CAR ITEM) (CADR ITEM) (CADDR ITEM) (CADDDR ITEM) (
+QUOTE FULLVALUE) NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)))))))
+(T (RETURN NIL)))) ((AND (PAIRP (CADDR ITEM)) (EQ (CAADDR ITEM) (QUOTE
+LISTOF))) (SETQ NEWITEMS (GEVPUSHLISTOF ITEM NIL)))) (SETQ GEVEDITCHAIN (
+CONS (LIST (CONS ITEM (CAAR GEVEDITCHAIN)) NEWITEMS NIL) GEVEDITCHAIN)) (
+GEVREFILLWINDOW) (COND ((AND (PAIRP (CADDR ITEM)) (EQ (CAADDR ITEM) (QUOTE
+LISTOF)) (NOT (CDADR ITEM))) (SETQ LSTITEM (CAADAR GEVEDITCHAIN)) (GEVPUSH (
+CAAR (PNTH LSTITEM 6))) (RETURN NIL)))))
+
+(DE GEVPUSHLISTOF (ITEM FLG) (PROG (ITEMTYPE TOPFRAME N NROOM LST VALS TMP) (
+COND ((NOT (CADR ITEM)) (RETURN NIL))) (SETQ TOPFRAME (CAR GEVEDITCHAIN)) (
+SETQ NROOM (DIFFERENCE (DIFFERENCE (QUOTIENT (CADR (CADDR GEVWINDOW)) 1)
+4) (LENGTH (CAR TOPFRAME)))) (COND (FLG (SETQ LST (CONS (LIST NIL NIL NIL
+"(..." (QUOTE BACKUP) NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0
+0)) NIL)) LST)) (SETQ N (CAR ITEM)) (SETQ ITEMTYPE (CADDR ITEM)) (SETQ NROOM (
+SUB1 NROOM)) (SETQ VALS (CAR (PNTH ITEM 6)))) (T (SETQ N 1) (SETQ ITEMTYPE (
+CADR (CADDR ITEM))) (SETQ VALS (CADR ITEM)))) (PROG NIL GLLABEL1 (COND ((AND
+VALS (OR (GREATERP NROOM 1) (AND (EQN NROOM 1) (NOT (CDR VALS))))) (SETQ LST (
+CONS (LIST N (PROG1 (SETQ TMP (CAR VALS)) (SETQ VALS (CDR VALS))) ITEMTYPE
+NIL NIL NIL (APPEND (QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) LST)) (
+SETQ NROOM (SUB1 NROOM)) (SETQ N (ADD1 N)) (GO GLLABEL1)))) (COND (VALS (
+SETQ LST (CONS (LIST N NIL ITEMTYPE "...)" (QUOTE FORWARD) VALS (APPEND (
+QUOTE (0 0)) NIL) (APPEND (QUOTE (0 0)) NIL)) LST)))) (RETURN (LIST (LIST
+"expanded" NIL ITEMTYPE NIL (QUOTE LISTOF) (REVERSIP LST) (APPEND (QUOTE (
+0 0)) NIL) (APPEND (QUOTE (0 0)) NIL))))))
+
+(DE GEVQUIT NIL (SETQ GEVACTIVEFLG NIL) (WINDOW-CLOSE GEVWINDOW) (COND (
+GEVMENUWINDOW (WINDOW-CLOSE GEVMENUWINDOW))))
+
+(DE GEVREDOPROPS (TOP) (PROG (ITEM L) (SETQ ITEM (CAAR TOP)) (COND ((AND (
+NOT (CADDR TOP)) (NE (SETQ L (GEVEXPROP (CADR ITEM) (CADDR ITEM) (QUOTE
+DISPLAYPROPS) (QUOTE PROP) NIL)) (QUOTE GEVERROR))) (COND ((ATOM L) (
+GEVCOMMANDPROP ITEM (QUOTE PROP) (QUOTE ALL))) ((PAIRP L) (MAPC L (FUNCTION (
+LAMBDA (X) (GEVCOMMANDPROP ITEM (QUOTE PROP) X))))))) (T (MAPC (CADDR TOP) (
+FUNCTION (LAMBDA (X) (COND ((NE (CAR (PNTH X 5)) (QUOTE MSG)) (RPLACA (CDR X) (
+GEVEXPROP (CADR ITEM) (CADDR ITEM) (CAR X) (CAR (PNTH X 5)) NIL)) (RPLACA (
+CDDDR X) NIL))))))))))
+
+(DE GEVREFILLWINDOW NIL (PROG (TOP TOPITEM SUBS TOPSUB) (SETQ TOP (CAR
+GEVEDITCHAIN)) (SETQ TOPITEM (CAAAR GEVEDITCHAIN)) (SETQ TOPSUB (CAADR TOP)) (
+COND ((OR (NOT TOPSUB) (AND (NE (CAR (PNTH TOPSUB 5)) (QUOTE FULLVALUE)) (NE (
+CAR (PNTH TOPSUB 5)) (QUOTE LISTOF)))) (COND ((GEVGETPROP (CADDR TOPITEM) (
+QUOTE GEVDISPLAY) (QUOTE MSG)) (RPLACA (CDR TOP) (LIST (LIST NIL (CADR
+TOPITEM) (CADDR TOPITEM) NIL (QUOTE DISPLAY) NIL (APPEND (QUOTE (0 0)) NIL) (
+APPEND (QUOTE (0 0)) NIL))))) (T (SETQ SUBS (GEVMATCH (CADDR TOPITEM) (CADR
+TOPITEM) T)) (SETQ TOPSUB (CAR SUBS)) (RPLACA (CDR TOP) (COND ((AND (NOT (
+CDR SUBS)) (EQ (CAR (PNTH TOPSUB 5)) (QUOTE STRUCTURE)) (EQUAL (CADR TOPSUB) (
+CADR TOPITEM)) (EQUAL (CADDR TOPSUB) (CADDR TOPITEM))) (CAR (PNTH TOPSUB
+6))) (T SUBS))))))) (GEVREDOPROPS TOP) (GEVFILLWINDOW)))
+
+(DE GEVSHORTATOMVAL (ATM NCHARS) (COND ((NUMBERP ATM) (COND ((GREATERP (
+FLATSIZE2 ATM) NCHARS) (GEVSHORTSTRINGVAL (GEVSTRINGIFY ATM) NCHARS)) (T ATM)))
+((GREATERP (FLATSIZE2 ATM) NCHARS) (CONCAT (SUBSTRING ATM 1 (SUB1 NCHARS)) "-"))
+(T ATM)))
+
+(DE GEVSHORTCONSVAL (VAL STR NCHARS) (PROG (NLEFT RES TMP NC) (SETQ RES (
+CONS "(" RES)) (SETQ NLEFT (DIFFERENCE NCHARS 5)) (SETQ TMP (GEVSHORTVALUE (
+CAR VAL) (CADR STR) (DIFFERENCE NLEFT 3))) (SETQ NC (FLATSIZE2 TMP)) (COND ((
+GREATERP NC (DIFFERENCE NLEFT 3)) (SETQ TMP "---") (SETQ NC 3))) (SETQ RES (
+CONS (GEVSTRINGIFY TMP) RES)) (SETQ RES (CONS " . " RES)) (SETQ NLEFT (
+DIFFERENCE NLEFT NC)) (SETQ TMP (GEVSHORTVALUE (CDR VAL) (CADDR STR) NLEFT)) (
+SETQ NC (FLATSIZE2 TMP)) (COND ((GREATERP NC NLEFT) (SETQ TMP "---") (SETQ
+NC 3))) (SETQ RES (CONS (GEVSTRINGIFY TMP) RES)) (SETQ RES (CONS ")" RES)) (
+RETURN (GEVCONCAT (REVERSIP RES)))))
+
+(DE GEVSHORTLISTVAL (VAL STR NCHARS) (PROG (NLEFT RES TMP QUIT NC NCI REST
+RSTR) (SETQ RES (CONS "(" RES)) (SETQ REST 4) (SETQ NLEFT (DIFFERENCE NCHARS
+2)) (SETQ RSTR (CDR STR)) (PROG NIL GLLABEL1 (COND ((AND VAL (NOT QUIT) (
+GREATERP (SETQ NCI (COND ((CDR VAL) (DIFFERENCE NLEFT REST)) (T NLEFT)))
+2)) (SETQ TMP (GEVSHORTVALUE (CAR VAL) (COND ((EQ (CAR STR) (QUOTE LISTOF)) (
+CADR STR)) ((EQ (CAR STR) (QUOTE LIST)) (CAR RSTR))) NCI)) (SETQ QUIT (
+MEMBER TMP (QUOTE (GEVERROR "(...)" "---" "???")))) (SETQ NC (FLATSIZE2 TMP)) (
+COND ((AND (GREATERP NC NCI) (CDR RES)) (SETQ QUIT T)) (T (COND ((GREATERP
+NC NCI) (SETQ TMP "---") (SETQ NC 3) (SETQ QUIT T))) (SETQ RES (CONS (
+GEVSTRINGIFY TMP) RES)) (SETQ NLEFT (DIFFERENCE NLEFT NC)) (SETQ VAL (CDR
+VAL)) (SETQ RSTR (CDR RSTR)) (COND (VAL (SETQ RES (CONS " " RES)) (SETQ
+NLEFT (SUB1 NLEFT)))))) (GO GLLABEL1)))) (COND (VAL (SETQ RES (CONS "..."
+RES)))) (SETQ RES (CONS ")" RES)) (RETURN (GEVCONCAT (REVERSIP RES)))))
+
+(DE GEVSHORTSTRINGVAL (VAL NCHARS) (COND ((STRINGP VAL) (GEVLENGTHBOUND VAL
+NCHARS)) (T "???")))
+
+(DE GEVSHORTVALUE (VAL STR NCHARS) (PROG (TMP) (SETQ STR (GEVXTRTYPE STR)) (
+RETURN (COND ((AND (ATOM STR) (MEMQ STR (QUOTE (ATOM INTEGER REAL)))) (
+GEVSHORTATOMVAL VAL NCHARS)) ((EQ STR (QUOTE STRING)) (GEVSHORTSTRINGVAL VAL
+NCHARS)) ((AND (ATOM STR) (NE (SETQ TMP (GEVEXPROP VAL STR (QUOTE SHORTVALUE) (
+QUOTE PROP) NIL)) (QUOTE GEVERROR))) (GEVLENGTHBOUND TMP NCHARS)) ((OR (ATOM
+VAL) (NUMBERP VAL)) (GEVSHORTATOMVAL VAL NCHARS)) ((STRINGP VAL) (
+GEVSHORTSTRINGVAL VAL NCHARS)) ((PAIRP STR) (CASEQ (CAR STR) ((LISTOF LIST) (
+COND ((PAIRP VAL) (GEVSHORTLISTVAL VAL STR NCHARS)) (T "???"))) (CONS (COND ((
+PAIRP VAL) (GEVSHORTCONSVAL VAL STR NCHARS)) (T "???"))) (T "---"))) ((PAIRP
+VAL) (GEVSHORTLISTVAL VAL (QUOTE (LISTOF ANYTHING)) NCHARS)) (T "---")))))
+
+(DE GEVXTRTYPE (TYPE) (COND ((ATOM TYPE) TYPE) ((NOT (PAIRP TYPE)) NIL) ((
+AND (MEMQ (CAR TYPE) (QUOTE (A AN A AN AN TRANSPARENT))) (CDR TYPE) (ATOM (
+CADR TYPE))) (CADR TYPE)) ((MEMQ (CAR TYPE) GEVTYPENAMES) TYPE) ((AND (NOT (
+UNBOUNDP GLUSERSTRNAMES)) (ASSOC (CAR TYPE) GLUSERSTRNAMES)) TYPE) ((AND (
+ATOM (CAR TYPE)) (CDR TYPE)) (GEVXTRTYPE (CADR TYPE))) (T (ERROR 0 (LIST (
+QUOTE GEVXTRTYPE) (LIST TYPE "is an illegal type specification."))) NIL)))
+
+(SETQ GEVTYPENAMES (QUOTE (CONS LIST RECORD LISTOF ALIST ATOM OBJECT
+LISTOBJECT ATOMOBJECT)))
ADDED psl-1983/3-1/glisp/glcase.sl
Index: psl-1983/3-1/glisp/glcase.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glcase.sl
@@ -0,0 +1,69 @@
+
+% GSN 10-FEB-83 12:56
+% Compile code for Case statement.
+(DE GLDOCASE (EXPR)
+(PROG
+ (SELECTOR SELECTORTYPE RESULT TMP RESULTTYPE TYPEOK ELSECLAUSE TMPB)
+ (SETQ TYPEOK T)
+ (SETQ TMP (GLPUSHEXPR (LIST (CADR EXPR))
+ NIL CONTEXT T))
+ (SETQ SELECTOR (CAR TMP))
+ (SETQ SELECTORTYPE (CADR TMP))
+ (SETQ EXPR (CDDR EXPR))
+
+% Get rid of of if present
+
+ (COND ((MEMQ (CAR EXPR)
+ '(OF Of of))
+ (SETQ EXPR (CDR EXPR))))
+ A
+ (COND
+ ((NULL EXPR)
+ (RETURN (LIST (GLGENCODE (CONS 'SELECTQ
+ (CONS SELECTOR (ACONC RESULT ELSECLAUSE))))
+ RESULTTYPE)))
+ ((MEMQ (CAR EXPR)
+ '(ELSE Else
+ else))
+ (SETQ TMP (GLPROGN (CDR EXPR)
+ CONTEXT))
+ (SETQ ELSECLAUSE (COND ((CDAR TMP)
+ (CONS 'PROGN
+ (CAR TMP)))
+ (T (CAAR TMP))))
+ (SETQ EXPR NIL))
+ (T
+ (SETQ TMP (GLPROGN (CDAR EXPR)
+ CONTEXT))
+ (SETQ
+ RESULT
+ (ACONC RESULT
+ (CONS (COND
+ ((ATOM (CAAR EXPR))
+ (OR (AND (SETQ TMPB (GLSTRPROP SELECTORTYPE
+ 'VALUES
+ (CAAR EXPR)
+ NIL))
+ (CADR TMPB))
+ (CAAR EXPR)))
+ (T (MAPCAR (CAAR EXPR)
+ (FUNCTION
+ (LAMBDA (X)
+ (OR (AND (SETQ TMPB (GLSTRPROP
+ SELECTORTYPE
+ 'VALUES
+ X NIL))
+ (CADR TMPB))
+ X))))))
+ (CAR TMP))))))
+
+% If all the result types are the same, then we know the result of the
+% Case statement.
+
+ (COND (TYPEOK (COND ((NULL RESULTTYPE)
+ (SETQ RESULTTYPE (CADR TMP)))
+ ((EQUAL RESULTTYPE (CADR TMP)))
+ (T (SETQ TYPEOK NIL)
+ (SETQ RESULTTYPE NIL)))))
+ (cond (expr (SETQ EXPR (CDR EXPR)) ))
+ (GO A)))
ADDED psl-1983/3-1/glisp/glhead.psl
Index: psl-1983/3-1/glisp/glhead.psl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glhead.psl
@@ -0,0 +1,41 @@
+%
+% GLHEAD.PSL.13 16 FEB. 1983
+%
+% HEADER FOR GLISP FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
+% G. NOVAK 20 OCTOBER 1982
+%
+
+
+(GLOBAL '(GLQUIETFLG GLSEPBITTBL GLUNITPKGS GLSEPMINUS GLOBJECTNAMES
+ GLTYPENAMES GLBREAKONERROR GLUSERSTRNAMES GLLASTFNCOMPILED
+ GLLASTSTREDITED GLCAUTIOUSFLG GLLISPDIALECT GLBASICTYPES
+ GLOBJECTTYPES GLTYPESUSED))
+
+(FLUID '(TTLIST SPECS SOURCE GLGLOBALVARS DOMAINNAME ARGTYPES NOTFLG
+ GLAMBDAFN ADDISATYPE PAIRLIST PROGG BITTBL KEY Y TYPES
+ CONTEXT EXPR VALBUSY FAULTFN GLSEPATOM GLSEPPTR *GL* *GLVAL*
+ GLTOPCTX RESULTTYPE RESULT GLNATOM FIRST OPNDS OPERS
+ GLEXPR DESLIST EXPRSTACK GLTYPESUBS GLPROGLST
+ TYPE GLNRECURSIONS GLFNSUBS GLEVALSUBS))
+
+% CASEQ MACRO FOR PSL
+(DM CASEQ (L)
+ (PROG (CVAR CODE)
+ (SETQ CVAR (COND ((ATOM (CADR L))(CADR L))
+ (T 'CASEQSELECTORVAR)))
+ (SETQ CODE (CONS 'COND (MAPCAR (CDDR L)
+ (FUNCTION (LAMBDA (X)
+ (COND ((EQ (CAR X) T) X)
+ ((ATOM (CAR X))
+ (CONS (LIST 'EQ CVAR
+ (LIST 'QUOTE (CAR X)))
+ (CDR X)))
+ (T (CONS (LIST 'MEMQ CVAR
+ (LIST 'QUOTE (CAR X)))
+ (CDR X)))))))))
+ (RETURN (COND ((ATOM (CADR L)) CODE)
+ (T (LIST 'PROG (LIST CVAR)
+ (LIST 'SETQ CVAR (CADR L))
+ (LIST 'RETURN CODE)))))))
+
+
ADDED psl-1983/3-1/glisp/glhead.sl
Index: psl-1983/3-1/glisp/glhead.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glhead.sl
@@ -0,0 +1,40 @@
+%
+% GLHEAD.PSL.9 14 Jan. 1983
+%
+% HEADER FOR GLISP FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
+% G. NOVAK 20 OCTOBER 1982
+%
+
+
+(GLOBAL '(GLQUIETFLG GLSEPBITTBL GLUNITPKGS GLSEPMINUS GLOBJECTNAMES
+ GLTYPENAMES GLBREAKONERROR GLUSERSTRNAMES GLLASTFNCOMPILED
+ GLLASTSTREDITED GLCAUTIOUSFLG GLLISPDIALECT GLBASICTYPES
+ GLOBJECTTYPES))
+
+(FLUID '(TTLIST SPECS SOURCE GLGLOBALVARS DOMAINNAME ARGTYPES NOTFLG
+ GLAMBDAFN ADDISATYPE PAIRLIST PROGG BITTBL KEY Y TYPES
+ CONTEXT EXPR VALBUSY FAULTFN GLSEPATOM GLSEPPTR *GL* *GLVAL*
+ GLTOPCTX RESULTTYPE RESULT GLNATOM FIRST OPNDS OPERS
+ GLEXPR DESLIST EXPRSTACK GLTYPESUBS GLPROGLST))
+
+% CASEQ MACRO FOR PSL
+(DM CASEQ (L)
+ (PROG (CVAR CODE)
+ (SETQ CVAR (COND ((ATOM (CADR L))(CADR L))
+ (T 'CASEQSELECTORVAR)))
+ (SETQ CODE (CONS 'COND (MAPCAR (CDDR L)
+ (FUNCTION (LAMBDA (X)
+ (COND ((EQ (CAR X) T) X)
+ ((ATOM (CAR X))
+ (CONS (LIST 'EQ CVAR
+ (LIST 'QUOTE (CAR X)))
+ (CDR X)))
+ (T (CONS (LIST 'MEMQ CVAR
+ (LIST 'QUOTE (CAR X)))
+ (CDR X)))))))))
+ (RETURN (COND ((ATOM (CADR L)) CODE)
+ (T (LIST 'PROG (LIST CVAR)
+ (LIST 'SETQ CVAR (CADR L))
+ (LIST 'RETURN CODE)))))))
+
+
ADDED psl-1983/3-1/glisp/glisp.b
Index: psl-1983/3-1/glisp/glisp.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glisp.b
cannot compute difference between binary files
ADDED psl-1983/3-1/glisp/glisp.sl
Index: psl-1983/3-1/glisp/glisp.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glisp.sl
@@ -0,0 +1,6511 @@
+%
+% GLHEAD.PSL.13 16 FEB. 1983
+%
+% HEADER FOR GLISP FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
+% G. NOVAK 20 OCTOBER 1982
+%
+
+
+(GLOBAL '(GLQUIETFLG GLSEPBITTBL GLUNITPKGS GLSEPMINUS GLOBJECTNAMES
+ GLTYPENAMES GLBREAKONERROR GLUSERSTRNAMES GLLASTFNCOMPILED
+ GLLASTSTREDITED GLCAUTIOUSFLG GLLISPDIALECT GLBASICTYPES
+ GLOBJECTTYPES GLTYPESUSED))
+
+(FLUID '(TTLIST SPECS SOURCE GLGLOBALVARS DOMAINNAME ARGTYPES NOTFLG
+ GLAMBDAFN ADDISATYPE PAIRLIST PROGG BITTBL KEY Y TYPES
+ CONTEXT EXPR VALBUSY FAULTFN GLSEPATOM GLSEPPTR *GL* *GLVAL*
+ GLTOPCTX RESULTTYPE RESULT GLNATOM FIRST OPNDS OPERS
+ GLEXPR DESLIST EXPRSTACK GLTYPESUBS GLPROGLST
+ TYPE GLNRECURSIONS GLFNSUBS GLEVALSUBS))
+
+% CASEQ MACRO FOR PSL
+(DM CASEQ (L)
+ (PROG (CVAR CODE)
+ (SETQ CVAR (COND ((ATOM (CADR L))(CADR L))
+ (T 'CASEQSELECTORVAR)))
+ (SETQ CODE (CONS 'COND (MAPCAR (CDDR L)
+ (FUNCTION (LAMBDA (X)
+ (COND ((EQ (CAR X) T) X)
+ ((ATOM (CAR X))
+ (CONS (LIST 'EQ CVAR
+ (LIST 'QUOTE (CAR X)))
+ (CDR X)))
+ (T (CONS (LIST 'MEMQ CVAR
+ (LIST 'QUOTE (CAR X)))
+ (CDR X)))))))))
+ (RETURN (COND ((ATOM (CADR L)) CODE)
+ (T (LIST 'PROG (LIST CVAR)
+ (LIST 'SETQ CVAR (CADR L))
+ (LIST 'RETURN CODE)))))))
+
+
+%
+% GLTAIL.PSL.4 18 Feb. 1983
+%
+% FILE OF FUNCTIONS FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
+% G. NOVAK 20 OCTOBER 1982
+%
+
+
+(DE GETDDD (X)
+ (COND ((PAIRP (GETD X)) (CDR (GETD X)))
+ (T NIL)))
+
+(DE PUTDDD (FN DEF) (REMD FN) (PUTD FN 'EXPR DEF))
+
+
+(DE LISTGET (L PROP)
+ (COND ((NOT (PAIRP L)) NIL)
+ ((EQ (CAR L) PROP) (CADR L))
+ (T (LISTGET (CDDR L) PROP) )) )
+
+
+
+% NOTE -- THIS VERSION OF NLEFT ONLY WORKS FOR N=2.
+(DE NLEFT (L N)
+ (COND ((NOT (EQN N 2)) (ERROR 0 N))
+ ((NULL L) NIL)
+ ((NULL (CDDR L)) L)
+ (T (NLEFT (CDR L) N) )) )
+
+
+(DE NLISTP (X) (NOT (PAIRP X)))
+(DF COMMENT (X) NIL)
+
+
+% ASSUME EVERYTHING UPPER-CASE FOR PSL.
+(DE U-CASEP (X) T)
+(de glucase (x) x)
+
+
+% PARTIAL IMPLEMENTATION OF SUBATOM FOR POSITIVE NUMBERS.
+(DE SUBATOM (ATM N M)
+ (PROG (LST SZ)
+ (setq sz (flatsize2 atm))
+ (cond ((minusp n) (setq n (add1 (plus sz n)))))
+ (cond ((minusp m) (setq m (add1 (plus sz m)))))
+ (COND ((GREATERP M sz)(RETURN NIL)))
+A (COND ((GREATERP N M)(RETURN (AND LST (IMPLODE (REVERSIP LST))))))
+ (SETQ LST (CONS (GLNTHCHAR ATM N) LST))
+ (COND ((MEMQ (CAR LST) '(!' !, !!))
+ (RPLACD LST (CONS (QUOTE !!) (CDR LST))) ))
+ (SETQ N (ADD1 N))
+ (GO A) ))
+
+
+% FIND THE STRING POSITION IN ATOM ATM WHERE A CHARACTER IN THE
+% BIT TABLE BITTBL OCCURS, STARTING WITH CHARACTER N.
+(DE STRPOSL (BITTBL ATM N)
+ (PROG (NC)
+ (COND ((NULL N)(SETQ N 1)))
+ (SETQ NC (FLATSIZE2 ATM))
+A (COND ((GREATERP N NC)(RETURN NIL))
+ ((INDX GLSEPBITTBL (id2int (GLNTHCHAR ATM N)))(RETURN N)))
+ (SETQ N (ADD1 N))
+ (GO A) ))
+
+% MAKE A BIT TABLE FROM A LIST OF CHARACTERS.
+(DE MAKEBITTABLE (L)
+ (PROG ()
+ (SETQ GLSEPBITTBL (MkVect 255))
+ (MAPC L (FUNCTION (LAMBDA (X)
+ (PutV GLSEPBITTBL (id2int X) T) )))
+ (RETURN GLSEPBITTBL) ))
+
+
+% Fexpr for defining GLISP functions.
+(df dg (x)
+ (put (car x) 'gloriginalexpr (cons 'lambda (cdr x)))
+ (glputhook (car x)) )
+
+% Put the hook macro onto a function to cause auto compilation.
+(de glputhook (x)
+ (put x 'glcompiled nil)
+ (putd x 'macro '(lambda (gldgform)(glhook gldgform))) )
+
+% Hook for compiling a GLISP function on its first call.
+(de glhook (gldgform) (glcc (car gldgform)) gldgform)
+
+% Interlisp-style NTHCHAR.
+(de glnthchar (x n)
+ (prog (s l)
+ (setq s (id2string x))
+ (setq l (size s))
+ (cond ((minusp n)(setq n (add1 (plus l n))))
+ (t (setq n (sub1 n))))
+ (cond ((or (minusp n)(greaterp n l))(return nil)))
+ (return (int2id (indx s n)))))
+
+
+% FIND FIRST ELEMENT OF A LIST FOR WHICH FN IS TRUE
+(DE SOME (L FN)
+ (COND ((NULL L) NIL)
+ ((APPLY FN (LIST (CAR L))) L)
+ (T (SOME (CDR L) FN))))
+
+% TEST IF FN IS TRUE FOR EVERY ELEMENT OF A LIST
+% SOME and EVERY switched FN and L
+(DE EVERY (L FN)
+ (COND ((NULL L) T)
+ ((APPLY FN (LIST (CAR L))) (EVERY (CDR L) FN))
+ (T NIL)))
+
+% SUBSET OF A LIST FOR WHICH FN IS TRUE
+(DE SUBSET (L FN)
+ (PROG (RESULT)
+ A (COND ((NULL L)(RETURN (REVERSIP RESULT)))
+ ((APPLY FN (LIST (CAR L)))
+ (SETQ RESULT (CONS (CAR L) RESULT))))
+ (SETQ L (CDR L))
+ (GO A)))
+
+(DE REMOVE (X L) (DELETE X L))
+
+% LIST DIFFERENCE X - Y
+(DE LDIFFERENCE (X Y)
+ (MAPCAN X (FUNCTION (LAMBDA (Z)
+ (COND ((MEMQ Z Y) NIL)
+ (T (CONS Z NIL)))))))
+
+% FIRST A FEW FUNCTION DEFINITIONS.
+
+% GET FUNCTION DEFINITION FOR THE GLISP COMPILER.
+(DE GLGETD (FN)
+ (OR (and (or (null (get fn 'glcompiled))
+ (eq (getddd fn) (get fn 'glcompiled)))
+ (GET FN 'GLORIGINALEXPR))
+ (GETDDD FN)))
+
+(DE GLGETDB (FN) (GLGETD FN))
+
+(DE GLAMBDATRAN (GLEXPR)
+ (PROG (NEWEXPR)
+ (SETQ GLLASTFNCOMPILED FAULTFN)
+ (PUT FAULTFN 'GLORIGINALEXPR GLEXPR)
+ (COND ((SETQ NEWEXPR (GLCOMP FAULTFN GLEXPR NIL NIL NIL))
+ (putddd FAULTFN NEWEXPR)
+ (put faultfn 'glcompiled newexpr) ))
+ (RETURN NEWEXPR) ))
+
+(DE GLERROR (FN MSGLST)
+ (PROG ()
+ (TERPRI)
+ (PRIN2 "GLISP error detected by ")
+ (PRIN1 FN)
+ (PRIN2 " in function ")
+ (PRINT FAULTFN)
+ (MAPC MSGLST (FUNCTION (LAMBDA (X) (PRIN1 X)(SPACES 1))))
+ (TERPRI)
+ (PRIN2 "in expression: ")
+ (PRINT (CAR EXPRSTACK))
+ (TERPRI)
+ (PRIN2 "within expression: ")
+ (PRINT (CADR EXPRSTACK))
+ (COND (GLBREAKONERROR (ERROR 0 (CAR EXPRSTACK))))
+ (RETURN (LIST (LIST 'GLERR (LIST 'QUOTE (CAR EXPRSTACK))))) ))
+
+% PRINT THE RESULT OF GLISP COMPILATION.
+(DE GLP (FN)
+ (PROG ()
+ (SETQ FN (OR FN GLLASTFNCOMPILED))
+ (TERPRI)
+ (PRIN2 "GLRESULTTYPE: ")
+ (PRINT (GET FN 'GLRESULTTYPE))
+ (PRETTYPRINT (GETDDD FN))
+ (RETURN FN)))
+
+
+% GLISP STRUCTURE EDITOR
+(DE GLEDS (STRNAME)
+ (EDITV (GET STRNAME 'GLSTRUCTURE))
+ STRNAME)
+
+% GLISP PROPERTY-LIST EDITOR
+(DE GLED (ATM) (EDITV (PROP ATM)))
+
+% GLISP FUNCTION EDITOR
+(DE GLEDF (FNNAME)
+ (EDITV (GLGETD FNNAME))
+ FNNAME)
+
+(DE KWOTE (X)
+ (COND ((NUMBERP X) X)
+ (T (LIST (QUOTE QUOTE) X))) )
+
+
+
+
+% {DSK}GLISP.PSL;1 16-MAR-83 12:28:51
+
+
+
+
+
+% GSN 7-MAR-83 16:41
+% Transform an expression X for Portable Standard Lisp dialect.
+(DE GLPSLTRANSFM (X)
+(PROG (TMP NOTFLG)
+
+% First do argument reversals.
+
+ (COND ((NOT (PAIRP X))
+ (RETURN X))
+ ((MEMQ (CAR X)
+ '(push PUSH))
+ (SETQ X (LIST (CAR X)
+ (CADDR X)
+ (CADR X))))
+ ((MEMQ (CAR X)
+ NIL)
+ (SETQ X (LIST (CAR X)
+ (CADR X)
+ (CADDDR X)
+ (CADDR X))))
+ ((EQ (CAR X)
+ 'APPLY*)
+ (SETQ X (LIST 'APPLY
+ (CADR X)
+ (CONS 'LIST
+ (CDDR X))))))
+
+% Now see if the result will be negated.
+
+ (SETQ NOTFLG (MEMQ (CAR X)
+ '(NLISTP BOUNDP GEQ LEQ IGEQ ILEQ)))
+ (COND ((SETQ TMP (ASSOC (CAR X)
+ '((MEMB MEMQ)
+ (FMEMB MEMQ)
+ (FASSOC ASSOC)
+ (LITATOM IDP)
+ (GETPROP GET)
+ (GETPROPLIST PROP)
+ (PUTPROP PUT)
+ (LISTP PAIRP)
+ (NLISTP PAIRP)
+ (NEQ NE)
+ (IGREATERP GREATERP)
+ (IGEQ LESSP)
+ (GEQ LESSP)
+ (ILESSP LESSP)
+ (ILEQ GREATERP)
+ (LEQ GREATERP)
+ (IPLUS PLUS)
+ (IDIFFERENCE DIFFERENCE)
+ (ITIMES TIMES)
+ (IQUOTIENT QUOTIENT)
+ (* CommentOutCode)
+ (MAPCONC MAPCAN)
+ (DECLARE CommentOutCode)
+ (NCHARS FlatSize2)
+ (NTHCHAR GLNTHCHAR)
+ (DREVERSE REVERSIP)
+ (STREQUAL String!=)
+ (ALPHORDER String!<!=)
+ (GLSTRGREATERP String!>)
+ (GLSTRGEP String!>!=)
+ (GLSTRLESSP String!<)
+ (EQP EQN)
+ (LAST LASTPAIR)
+ (NTH PNth)
+ (NCONC1 ACONC)
+ (U-CASE GLUCASE)
+ (DSUBST SUBSTIP)
+ (BOUNDP UNBOUNDP)
+ (UNPACK EXPLODE)
+ (PACK IMPLODE)
+ (DREMOVE DELETIP)
+ (GETD GETDDD)
+ (PUTD PUTDDD))))
+ (SETQ X (CONS (CADR TMP)
+ (CDR X))))
+ ((AND (EQ (CAR X)
+ 'RETURN)
+ (NULL (CDR X)))
+ (SETQ X (LIST (CAR X)
+ NIL)))
+ ((AND (EQ (CAR X)
+ 'APPEND)
+ (NULL (CDDR X)))
+ (SETQ X (LIST (CAR X)
+ (CADR X)
+ NIL)))
+ ((EQ (CAR X)
+ 'ERROR)
+ (SETQ X (LIST (CAR X)
+ 0
+ (COND ((NULL (CDR X))
+ NIL)
+ ((NULL (CDDR X))
+ (CADR X))
+ (T (CONS 'LIST
+ (CDR X)))))))
+ ((EQ (CAR X)
+ 'SELECTQ)
+ (RPLACA X 'CASEQ)
+ (SETQ TMP (NLEFT X 2))
+ (COND ((NULL (CADR TMP))
+ (RPLACD TMP NIL))
+ (T (RPLACD TMP (LIST (LIST T (CADR TMP))))))))
+ (RETURN (COND (NOTFLG (LIST 'NOT
+ X))
+ (T X)))))
+
+
+% edited: 18-NOV-82 11:47
+(DF A (L)
+(GLAINTERPRETER L))
+
+
+% edited: 18-NOV-82 11:47
+(DF AN (L)
+(GLAINTERPRETER L))
+
+
+% edited: 29-OCT-81 14:25
+(DE GL-A-AN? (X)
+(MEMQ X '(A AN a an An)))
+
+
+% GSN 17-FEB-83 11:31
+% Test whether FNNAME is an abstract function.
+(DE GLABSTRACTFN? (FNNAME)
+(PROG (DEFN)
+ (RETURN (AND (SETQ DEFN (GLGETD FNNAME))
+ (PAIRP DEFN)
+ (EQ (CAR DEFN)
+ 'MLAMBDA)))))
+
+
+% GSN 16-FEB-83 12:39
+% Add a PROPerty entry of type PROPTYPE to structure STRNAME.
+(DE GLADDPROP (STRNAME PROPTYPE LST)
+(PROG (PL SUBPL)
+ (COND ((NOT (AND (ATOM STRNAME)
+ (SETQ PL (GET STRNAME 'GLSTRUCTURE))))
+ (ERROR 0 (LIST STRNAME " has no structure definition.")))
+ ((SETQ SUBPL (LISTGET (CDR PL)
+ PROPTYPE))
+ (NCONC SUBPL (LIST LST)))
+ (T (NCONC PL (LIST PROPTYPE (LIST LST)))))))
+
+
+% edited: 25-Jan-81 18:17
+% Add the type SDES to RESULTTYPE in GLCOMP
+(DE GLADDRESULTTYPE (SDES)
+(COND ((NULL RESULTTYPE)
+ (SETQ RESULTTYPE SDES))
+ ((AND (PAIRP RESULTTYPE)
+ (EQ (CAR RESULTTYPE)
+ 'OR))
+ (COND ((NOT (MEMBER SDES (CDR RESULTTYPE)))
+ (ACONC RESULTTYPE SDES))))
+ ((NOT (EQUAL SDES RESULTTYPE))
+ (SETQ RESULTTYPE (LIST 'OR
+ RESULTTYPE SDES)))))
+
+
+% edited: 2-Jan-81 13:37
+% Add an entry to the current context for a variable ATM, whose NAME
+% in context is given, and which has structure STR. The entry is
+% pushed onto the front of the list at the head of the context.
+(DE GLADDSTR (ATM NAME STR CONTEXT)
+(RPLACA CONTEXT (CONS (LIST ATM NAME STR)
+ (CAR CONTEXT))))
+
+
+% GSN 10-FEB-83 12:56
+% edited: 17-Sep-81 13:58
+% Compile code to test if SOURCE is PROPERTY.
+(DE GLADJ (SOURCE PROPERTY ADJWD)
+(PROG (ADJL TRANS TMP FETCHCODE)
+ (COND ((EQ ADJWD 'ISASELF)
+ (COND ((SETQ ADJL (GLSTRPROP PROPERTY 'ISA
+ 'self
+ NIL))
+ (GO A))
+ (T (RETURN NIL))))
+ ((SETQ ADJL (GLSTRPROP (CADR SOURCE)
+ ADJWD PROPERTY NIL))
+ (GO A)))
+
+% See if the adjective can be found in a TRANSPARENT substructure.
+
+ (SETQ TRANS (GLTRANSPARENTTYPES (CADR SOURCE)))
+ B
+ (COND ((NULL TRANS)
+ (RETURN NIL))
+ ((SETQ TMP (GLADJ (LIST '*GL*
+ (GLXTRTYPE (CAR TRANS)))
+ PROPERTY ADJWD))
+ (SETQ FETCHCODE (GLSTRFN (CAR TRANS)
+ (CADR SOURCE)
+ NIL))
+ (GLSTRVAL TMP (CAR FETCHCODE))
+ (GLSTRVAL TMP (CAR SOURCE))
+ (RETURN TMP))
+ (T (SETQ TRANS (CDR TRANS))
+ (GO B)))
+ A
+ (COND ((AND (PAIRP (CADR ADJL))
+ (MEMQ (CAADR ADJL)
+ '(NOT Not not))
+ (ATOM (CADADR ADJL))
+ (NULL (CDDADR ADJL))
+ (SETQ TMP (GLSTRPROP (CADR SOURCE)
+ ADJWD
+ (CADADR ADJL)
+ NIL)))
+ (SETQ ADJL TMP)
+ (SETQ NOTFLG (NOT NOTFLG))
+ (GO A)))
+ (RETURN (GLCOMPMSGL SOURCE ADJWD ADJL NIL CONTEXT))))
+
+
+% GSN 10-FEB-83 15:08
+(DE GLAINTERPRETER (L)
+(PROG (CODE GLNATOM FAULTFN CONTEXT VALBUSY GLSEPATOM GLSEPPTR EXPRSTACK
+ GLTOPCTX GLGLOBALVARS GLNRECURSIONS)
+ (SETQ GLNATOM 0)
+ (SETQ GLNRECURSIONS 0)
+ (SETQ FAULTFN 'GLAINTERPRETER)
+ (SETQ VALBUSY T)
+ (SETQ GLSEPPTR 0)
+ (SETQ CONTEXT (SETQ GLTOPCTX (LIST NIL)))
+ (SETQ CODE (GLDOA (CONS 'A
+ L)))
+ (RETURN (EVAL (CAR CODE)))))
+
+
+% edited: 26-DEC-82 15:40
+% AND operator
+(DE GLANDFN (LHS RHS)
+(COND ((NULL LHS)
+ RHS)
+ ((NULL RHS)
+ LHS)
+ ((AND (PAIRP (CAR LHS))
+ (EQ (CAAR LHS)
+ 'AND)
+ (PAIRP (CAR RHS))
+ (EQ (CAAR RHS)
+ 'AND))
+ (LIST (APPEND (CAR LHS)
+ (CDAR RHS))
+ (CADR LHS)))
+ ((AND (PAIRP (CAR LHS))
+ (EQ (CAAR LHS)
+ 'AND))
+ (LIST (APPEND (CAR LHS)
+ (LIST (CAR RHS)))
+ (CADR LHS)))
+ ((AND (PAIRP (CAR RHS))
+ (EQ (CAAR RHS)
+ 'AND))
+ (LIST (CONS 'AND
+ (CONS (CAR LHS)
+ (CDAR RHS)))
+ (CADR LHS)))
+ ((AND (PAIRP (CADR RHS))
+ (EQ (CAADR RHS)
+ 'LISTOF)
+ (EQUAL (CADR LHS)
+ (CADR RHS)))
+ (LIST (LIST 'INTERSECTION
+ (CAR LHS)
+ (CAR RHS))
+ (CADR RHS)))
+ ((GLDOMSG LHS 'AND
+ (LIST RHS)))
+ ((GLUSERSTROP LHS 'AND
+ RHS))
+ (T (LIST (LIST 'AND
+ (CAR LHS)
+ (CAR RHS))
+ (CADR RHS)))))
+
+
+% edited: 19-MAY-82 13:54
+% Test if ATM is the name of any CAR/CDR combination. If so, the value
+% is a list of the intervening letters in reverse order.
+(DE GLANYCARCDR? (ATM)
+(PROG (RES N NMAX TMP)
+ (OR (AND (EQ (GLNTHCHAR ATM 1)
+ 'C)
+ (EQ (GLNTHCHAR ATM -1)
+ 'R))
+ (RETURN NIL))
+ (SETQ NMAX (SUB1 (FlatSize2 ATM)))
+ (SETQ N 2)
+ A
+ (COND ((GREATERP N NMAX)
+ (RETURN RES))
+ ((OR (EQ (SETQ TMP (GLNTHCHAR ATM N))
+ 'D)
+ (EQ TMP 'A))
+ (SETQ RES (CONS TMP RES))
+ (SETQ N (ADD1 N))
+ (GO A))
+ (T (RETURN NIL)))))
+
+
+% edited: 26-OCT-82 15:26
+% Try to get indicator IND from an ATOM structure.
+(DE GLATOMSTRFN (IND DES DESLIST)
+(PROG (TMP)
+ (RETURN (OR (AND (SETQ TMP (ASSOC 'PROPLIST
+ (CDR DES)))
+ (GLPROPSTRFN IND TMP DESLIST T))
+ (AND (SETQ TMP (ASSOC 'BINDING
+ (CDR DES)))
+ (GLSTRVALB IND (CADR TMP)
+ '(EVAL *GL*)))))))
+
+
+% GSN 1-FEB-83 16:35
+% edited: 14-Sep-81 12:45
+% Test whether STR is a legal ATOM structure.
+(DE GLATMSTR? (STR)
+(PROG (TMP)
+ (COND ((OR (AND (CDR STR)
+ (OR (NOT (PAIRP (CADR STR)))
+ (AND (CDDR STR)
+ (OR (NOT (PAIRP (CADDR STR)))
+ (CDDDR STR))))))
+ (RETURN NIL)))
+ (COND ((SETQ TMP (ASSOC 'BINDING
+ (CDR STR)))
+ (COND ((OR (CDDR TMP)
+ (NULL (GLOKSTR? (CADR TMP))))
+ (RETURN NIL)))))
+ (COND ((SETQ TMP (ASSOC 'PROPLIST
+ (CDR STR)))
+ (RETURN (EVERY (CDR TMP)
+ (FUNCTION (LAMBDA (X)
+ (AND (ATOM (CAR X))
+ (GLOKSTR? (CADR X)))))))))
+ (RETURN T)))
+
+
+% edited: 23-DEC-82 10:43
+% Test whether TYPE is implemented as an ATOM structure.
+(DE GLATOMTYPEP (TYPE)
+(PROG (TYPEB)
+ (RETURN (OR (EQ TYPE 'ATOM)
+ (AND (PAIRP TYPE)
+ (MEMQ (CAR TYPE)
+ '(ATOM ATOMOBJECT)))
+ (AND (NE (SETQ TYPEB (GLXTRTYPEB TYPE))
+ TYPE)
+ (GLATOMTYPEP TYPEB))))))
+
+
+% edited: 24-AUG-82 17:21
+(DE GLBUILDALIST (ALIST PREVLST)
+(PROG (LIS TMP1 TMP2)
+ A
+ (COND ((NULL ALIST)
+ (RETURN (AND LIS (GLBUILDLIST LIS NIL)))))
+ (SETQ TMP1 (pop ALIST))
+ (COND ((SETQ TMP2 (GLBUILDSTR TMP1 PAIRLIST PREVLST))
+ (SETQ LIS (ACONC LIS (GLBUILDCONS (KWOTE (CAR TMP1))
+ TMP2 T)))))
+ (GO A)))
+
+
+% edited: 9-DEC-82 17:14
+% Generate code to build a CONS structure. OPTFLG is true iff the
+% structure does not need to be a newly created one.
+(DE GLBUILDCONS (X Y OPTFLG)
+(COND ((NULL Y)
+ (GLBUILDLIST (LIST X)
+ OPTFLG))
+ ((AND (PAIRP Y)
+ (EQ (CAR Y)
+ 'LIST))
+ (GLBUILDLIST (CONS X (CDR Y))
+ OPTFLG))
+ ((AND OPTFLG (GLCONST? X)
+ (GLCONST? Y))
+ (LIST 'QUOTE
+ (CONS (GLCONSTVAL X)
+ (GLCONSTVAL Y))))
+ ((AND (GLCONSTSTR? X)
+ (GLCONSTSTR? Y))
+ (LIST 'COPY
+ (LIST 'QUOTE
+ (CONS (GLCONSTVAL X)
+ (GLCONSTVAL Y)))))
+ (T (LIST 'CONS
+ X Y))))
+
+
+% edited: 9-DEC-82 17:13
+% Build a LIST structure, possibly doing compile-time constant
+% folding. OPTFLG is true iff the structure does not need to be a
+% newly created copy.
+(DE GLBUILDLIST (LST OPTFLG)
+(COND ((EVERY LST (FUNCTION GLCONST?))
+ (COND (OPTFLG (LIST 'QUOTE
+ (MAPCAR LST (FUNCTION GLCONSTVAL))))
+ (T (GLGENCODE (LIST 'APPEND
+ (LIST 'QUOTE
+ (MAPCAR LST (FUNCTION GLCONSTVAL))))))))
+ ((EVERY LST (FUNCTION GLCONSTSTR?))
+ (GLGENCODE (LIST 'COPY
+ (LIST 'QUOTE
+ (MAPCAR LST (FUNCTION GLCONSTVAL))))))
+ (T (CONS 'LIST
+ LST))))
+
+
+% edited: 19-OCT-82 15:05
+% Build code to do (NOT CODE) , doing compile-time folding if
+% possible.
+(DE GLBUILDNOT (CODE)
+(PROG (TMP)
+ (COND ((GLCONST? CODE)
+ (RETURN (NOT (GLCONSTVAL CODE))))
+ ((NOT (PAIRP CODE))
+ (RETURN (LIST 'NOT
+ CODE)))
+ ((EQ (CAR CODE)
+ 'NOT)
+ (RETURN (CADR CODE)))
+ ((NOT (ATOM (CAR CODE)))
+ (RETURN NIL))
+ ((SETQ TMP (ASSOC (CAR CODE)
+ '((EQ NE)
+ (NE EQ)
+ (LEQ GREATERP)
+ (GEQ LESSP))))
+ (RETURN (CONS (CADR TMP)
+ (CDR CODE))))
+ (T (RETURN (LIST 'NOT
+ CODE))))))
+
+
+% edited: 26-OCT-82 16:02
+(DE GLBUILDPROPLIST (PLIST PREVLST)
+(PROG (LIS TMP1 TMP2)
+ A
+ (COND ((NULL PLIST)
+ (RETURN (AND LIS (GLBUILDLIST LIS NIL)))))
+ (SETQ TMP1 (pop PLIST))
+ (COND ((SETQ TMP2 (GLBUILDSTR TMP1 PAIRLIST PREVLST))
+ (SETQ LIS (NCONC LIS (LIST (KWOTE (CAR TMP1))
+ TMP2)))))
+ (GO A)))
+
+
+% edited: 12-NOV-82 11:26
+% Build a RECORD structure.
+(DE GLBUILDRECORD (STR PAIRLIST PREVLST)
+(PROG (TEMP ITEMS RECORDNAME)
+ (COND ((ATOM (CADR STR))
+ (SETQ RECORDNAME (CADR STR))
+ (SETQ ITEMS (CDDR STR)))
+ (T (SETQ ITEMS (CDR STR))))
+ (COND ((EQ (CAR STR)
+ 'OBJECT)
+ (SETQ ITEMS (CONS '(CLASS ATOM)
+ ITEMS))))
+ (RETURN (CONS 'Vector
+ (MAPCAR ITEMS (FUNCTION (LAMBDA (X)
+ (GLBUILDSTR X PAIRLIST PREVLST)))
+ )))))
+
+
+% GSN 7-MAR-83 17:01
+% edited: 13-Aug-81 14:06
+% Generate code to build a structure according to the structure
+% description STR. PAIRLIST is a list of elements of the form
+% (SLOTNAME CODE TYPE) for each named slot to be filled in in the
+% structure.
+(DE GLBUILDSTR (STR PAIRLIST PREVLST)
+(PROG (PROPLIS TEMP PROGG TMPCODE ATMSTR)
+ (SETQ ATMSTR '((ATOM)
+ (INTEGER . 0)
+ (REAL . 0.0)
+ (NUMBER . 0)
+ (BOOLEAN)
+ (NIL)
+ (ANYTHING)))
+ (COND ((NULL STR)
+ (RETURN NIL))
+ ((ATOM STR)
+ (COND ((SETQ TEMP (ASSOC STR ATMSTR))
+ (RETURN (CDR TEMP)))
+ ((MEMQ STR PREVLST)
+ (RETURN NIL))
+ ((SETQ TEMP (GLGETSTR STR))
+ (RETURN (GLBUILDSTR TEMP NIL (CONS STR PREVLST))))
+ (T (RETURN NIL))))
+ ((NOT (PAIRP STR))
+ (GLERROR 'GLBUILDSTR
+ (LIST "Illegal structure type encountered:" STR))
+ (RETURN NIL)))
+ (RETURN (CASEQ (CAR STR)
+ (CONS (GLBUILDCONS (GLBUILDSTR (CADR STR)
+ PAIRLIST PREVLST)
+ (GLBUILDSTR (CADDR STR)
+ PAIRLIST PREVLST)
+ NIL))
+ (LIST (GLBUILDLIST (MAPCAR (CDR STR)
+ (FUNCTION (LAMBDA (X)
+ (GLBUILDSTR X
+ PAIRLIST
+ PREVLST))))
+ NIL))
+ (LISTOBJECT (GLBUILDLIST
+ (CONS (KWOTE (CAR PREVLST))
+ (MAPCAR (CDR STR)
+ (FUNCTION (LAMBDA (X)
+ (GLBUILDSTR
+ X PAIRLIST
+ PREVLST)))))
+ NIL))
+ (ALIST (GLBUILDALIST (CDR STR)
+ PREVLST))
+ (PROPLIST (GLBUILDPROPLIST (CDR STR)
+ PREVLST))
+ (ATOM (SETQ PROGG
+ (LIST 'PROG
+ (LIST 'ATOMNAME)
+ (LIST 'SETQ
+ 'ATOMNAME
+ (COND
+ ((AND PREVLST
+ (ATOM (CAR PREVLST)))
+ (LIST 'GLMKATOM
+ (KWOTE (CAR PREVLST))))
+ (T (LIST 'GENSYM))))))
+ (COND ((SETQ TEMP (ASSOC 'BINDING
+ (CDR STR)))
+ (SETQ TMPCODE (GLBUILDSTR (CADR TEMP)
+ PAIRLIST PREVLST))
+ (ACONC PROGG (LIST 'SET
+ 'ATOMNAME
+ TMPCODE))))
+ (COND ((SETQ TEMP (ASSOC 'PROPLIST
+ (CDR STR)))
+ (SETQ PROPLIS (CDR TEMP))
+ (GLPUTPROPS PROPLIS PREVLST)))
+ (ACONC PROGG (COPY '(RETURN ATOMNAME)))
+ PROGG)
+ (ATOMOBJECT
+ (SETQ PROGG
+ (LIST 'PROG
+ (LIST 'ATOMNAME)
+ (LIST 'SETQ
+ 'ATOMNAME
+ (COND ((AND PREVLST
+ (ATOM (CAR PREVLST)))
+ (LIST 'GLMKATOM
+ (KWOTE (CAR PREVLST))))
+ (T (LIST 'GENSYM))))))
+ (ACONC PROGG (GLGENCODE (LIST 'PUTPROP
+ 'ATOMNAME
+ (LIST 'QUOTE
+ 'CLASS)
+ (KWOTE (CAR PREVLST)))))
+ (GLPUTPROPS (CDR STR)
+ PREVLST)
+ (ACONC PROGG (COPY '(RETURN ATOMNAME))))
+ (TRANSPARENT (AND (NOT (MEMQ (CADR STR)
+ PREVLST))
+ (SETQ TEMP (GLGETSTR (CADR STR)))
+ (GLBUILDSTR TEMP PAIRLIST
+ (CONS (CADR STR)
+ PREVLST))))
+ (LISTOF NIL)
+ (RECORD (GLBUILDRECORD STR PAIRLIST PREVLST))
+ (OBJECT (GLBUILDRECORD STR
+ (CONS (LIST 'CLASS
+ (KWOTE (CAR PREVLST))
+ 'ATOM)
+ PAIRLIST)
+ PREVLST))
+ (T (COND ((ATOM (CAR STR))
+ (COND ((SETQ TEMP (ASSOC (CAR STR)
+ PAIRLIST))
+ (CADR TEMP))
+ ((AND (ATOM (CADR STR))
+ (NOT (ASSOC (CADR STR)
+ ATMSTR)))
+ (GLBUILDSTR (CADR STR)
+ NIL PREVLST))
+ (T (GLBUILDSTR (CADR STR)
+ PAIRLIST PREVLST))))
+ (T NIL)))))))
+
+
+% edited: 14-MAR-83 16:59
+% Find the result type for a CAR/CDR function applied to a structure
+% whose description is STR. LST is a list of A and D in application
+% order.
+(DE GLCARCDRRESULTTYPE (LST STR)
+(COND ((NULL LST)
+ STR)
+ ((NULL STR)
+ NIL)
+ ((MEMQ STR GLBASICTYPES)
+ NIL)
+ ((ATOM STR)
+ (GLCARCDRRESULTTYPE LST (GLGETSTR STR)))
+ ((NOT (PAIRP STR))
+ (ERROR 0 NIL))
+ (T (GLCARCDRRESULTTYPEB LST (GLXTRTYPE STR)))))
+
+
+% edited: 19-MAY-82 14:41
+% Find the result type for a CAR/CDR function applied to a structure
+% whose description is STR. LST is a list of A and D in application
+% order.
+(DE GLCARCDRRESULTTYPEB (LST STR)
+(COND ((NULL STR)
+ NIL)
+ ((ATOM STR)
+ (GLCARCDRRESULTTYPE LST STR))
+ ((NOT (PAIRP STR))
+ (ERROR 0 NIL))
+ ((AND (ATOM (CAR STR))
+ (NOT (MEMQ (CAR STR)
+ GLTYPENAMES))
+ (CDR STR)
+ (NULL (CDDR STR)))
+ (GLCARCDRRESULTTYPE LST (CADR STR)))
+ ((EQ (CAR LST)
+ 'A)
+ (COND ((OR (EQ (CAR STR)
+ 'LISTOF)
+ (EQ (CAR STR)
+ 'CONS)
+ (EQ (CAR STR)
+ 'LIST))
+ (GLCARCDRRESULTTYPE (CDR LST)
+ (CADR STR)))
+ (T NIL)))
+ ((EQ (CAR LST)
+ 'D)
+ (COND ((EQ (CAR STR)
+ 'CONS)
+ (GLCARCDRRESULTTYPE (CDR LST)
+ (CADDR STR)))
+ ((EQ (CAR STR)
+ 'LIST)
+ (COND ((CDDR STR)
+ (GLCARCDRRESULTTYPE (CDR LST)
+ (CONS 'LIST
+ (CDDR STR))))
+ (T NIL)))
+ ((EQ (CAR STR)
+ 'LISTOF)
+ (GLCARCDRRESULTTYPE (CDR LST)
+ STR))))
+ (T (ERROR 0 NIL))))
+
+
+% edited: 13-JAN-82 13:45
+% Test if X is a CAR or CDR combination up to 3 long.
+(DE GLCARCDR? (X)
+(MEMQ X
+ '(CAR CDR CAAR CADR CDAR CDDR CAAAR CAADR CADAR CDAAR CADDR CDADR CDDAR
+ CDDDR)))
+
+
+% edited: 5-OCT-82 15:24
+(DE GLCC (FN)
+(SETQ FN (OR FN GLLASTFNCOMPILED))(COND ((NOT (GLGETD FN))
+ (PRIN1 FN)
+ (PRIN1 " ?")
+ (TERPRI))
+ (T (GLCOMPILE FN))))
+
+
+% GSN 18-JAN-83 15:04
+% Get the Class of object OBJ.
+(DE GLCLASS (OBJ)
+(PROG (CLASS)
+ (RETURN (AND (SETQ CLASS (COND ((VectorP OBJ)
+ (GetV OBJ 0))
+ ((ATOM OBJ)
+ (GET OBJ 'CLASS))
+ ((PAIRP OBJ)
+ (CAR OBJ))
+ (T NIL)))
+ (GLCLASSP CLASS)
+ CLASS))))
+
+
+% edited: 11-NOV-82 11:23
+% Test whether the object OBJ is a member of class CLASS.
+(DE GLCLASSMEMP (OBJ CLASS)
+(GLDESCENDANTP (GLCLASS OBJ)
+ CLASS))
+
+
+% edited: 11-NOV-82 11:45
+% See if CLASS is a Class name.
+(DE GLCLASSP (CLASS)
+(PROG (TMP)
+ (RETURN (AND (ATOM CLASS)
+ (SETQ TMP (GET CLASS 'GLSTRUCTURE))
+ (MEMQ (CAR (GLXTRTYPE (CAR TMP)))
+ '(OBJECT ATOMOBJECT LISTOBJECT))))))
+
+
+% GSN 9-FEB-83 16:58
+% Execute a message to CLASS with selector SELECTOR and arguments
+% ARGS. PROPNAME is one of MSG, ADJ, ISA, PROP.
+(DE GLCLASSSEND (CLASS SELECTOR ARGS PROPNAME)
+(PROG (FNCODE)
+ (COND ((SETQ FNCODE (GLCOMPPROP CLASS SELECTOR PROPNAME))
+ (RETURN (COND ((ATOM FNCODE)
+ (EVAL (CONS FNCODE (MAPCAR ARGS
+ (FUNCTION KWOTE)))))
+ (T (APPLY FNCODE ARGS))))))
+ (RETURN 'GLSENDFAILURE)))
+
+
+% GSN 10-FEB-83 15:09
+% GLISP compiler function. GLAMBDAFN is the atom whose function
+% definition is being compiled; GLEXPR is the GLAMBDA expression to
+% be compiled. The compiled function is saved on the property list
+% of GLAMBDAFN under the indicator GLCOMPILED. The property
+% GLRESULTTYPE is the RESULT declaration, if specified; GLGLOBALS is
+% a list of global variables referenced and their types.
+(DE GLCOMP (GLAMBDAFN GLEXPR GLTYPESUBS GLFNSUBS ARGTYPES)
+(PROG (NEWARGS NEWEXPR GLNATOM GLTOPCTX RESULTTYPE GLGLOBALVARS RESULT
+ GLSEPATOM GLSEPPTR VALBUSY EXPRSTACK GLTU GLNRECURSIONS)
+ (SETQ GLSEPPTR 0)
+ (SETQ GLNRECURSIONS 0)
+ (COND ((NOT GLQUIETFLG)
+ (PRINT (LIST 'GLCOMP
+ GLAMBDAFN))))
+ (SETQ EXPRSTACK (LIST GLEXPR))
+ (SETQ GLNATOM 0)
+ (SETQ GLTOPCTX (LIST NIL))
+ (SETQ GLTU GLTYPESUSED)
+ (SETQ GLTYPESUSED NIL)
+
+% Process the argument list of the GLAMBDA.
+
+ (SETQ NEWARGS (GLDECL (CADR GLEXPR)
+ '(T NIL)
+ GLTOPCTX GLAMBDAFN ARGTYPES))
+
+% See if there is a RESULT declaration.
+
+ (SETQ GLEXPR (CDDR GLEXPR))
+ (GLSKIPCOMMENTS)
+ (GLRESGLOBAL)
+ (GLSKIPCOMMENTS)
+ (GLRESGLOBAL)
+ (SETQ VALBUSY (NULL (CDR GLEXPR)))
+ (SETQ NEWEXPR (GLPROGN GLEXPR (CONS NIL GLTOPCTX)))
+ (PUT GLAMBDAFN 'GLRESULTTYPE
+ (OR RESULTTYPE (CADR NEWEXPR)))
+ (PUT GLAMBDAFN 'GLTYPESUSED
+ GLTYPESUSED)
+ (GLSAVEFNTYPES GLAMBDAFN GLTYPESUSED)
+ (SETQ RESULT (GLUNWRAP (CONS 'LAMBDA
+ (CONS NEWARGS (CAR NEWEXPR)))
+ T))
+ (SETQ GLTYPESUSED GLTU)
+ (RETURN RESULT)))
+
+
+% GSN 2-FEB-83 14:52
+% Compile an abstract function into an instance function given the
+% specified set of type substitutions and function substitutions.
+(DE GLCOMPABSTRACT (FN INSTFN TYPESUBS FNSUBS ARGTYPES)
+(PROG (TMP)
+ (COND (INSTFN)
+ ((SETQ TMP (ASSOC FN FNSUBS))
+ (SETQ INSTFN (CDR TMP)))
+ (T (SETQ INSTFN (GLINSTANCEFNNAME FN))))
+ (SETQ FNSUBS (CONS (CONS FN INSTFN)
+ FNSUBS))
+
+% Now compile the abstract function with the specified type
+% substitutions.
+
+ (PUTDDD INSTFN (GLCOMP INSTFN (GLGETD FN)
+ TYPESUBS FNSUBS ARGTYPES))
+ (RETURN INSTFN)))
+
+
+% GSN 10-FEB-83 15:09
+% Compile a GLISP expression. CODE is a GLISP expression. VARLST is a
+% list of lists (VAR TYPE) . The result is a list (OBJCODE TYPE)
+% where OBJCODE is the Lisp code corresponding to CODE and TYPE is
+% the type returned by OBJCODE.
+(DE GLCOMPEXPR (CODE VARLST)
+(PROG (OBJCODE GLNATOM CONTEXT VALBUSY GLSEPATOM GLSEPPTR EXPRSTACK GLTOPCTX
+ GLGLOBALVARS GLTYPESUBS FAULTFN GLNRECURSIONS)
+ (SETQ FAULTFN 'GLCOMPEXPR)
+ (SETQ GLNRECURSIONS 0)
+ (SETQ GLNATOM 0)
+ (SETQ VALBUSY T)
+ (SETQ GLSEPPTR 0)
+ (SETQ CONTEXT (SETQ GLTOPCTX (LIST NIL)))
+ (MAPC VARLST (FUNCTION (LAMBDA (X)
+ (GLADDSTR (CAR X)
+ NIL
+ (CADR X)
+ CONTEXT))))
+ (COND ((SETQ OBJCODE (GLPUSHEXPR CODE T CONTEXT T))
+ (RETURN (LIST (GLUNWRAP (CAR OBJCODE)
+ T)
+ (CADR OBJCODE)))))))
+
+
+% edited: 27-MAY-82 12:58
+% Compile the function definition stored for the atom FAULTFN using
+% the GLISP compiler.
+(DE GLCOMPILE (FAULTFN)
+(GLAMBDATRAN (GLGETD FAULTFN))FAULTFN)
+
+
+% edited: 4-MAY-82 11:13
+% Compile FN if not already compiled.
+(DE GLCOMPILE? (FN)
+(OR (GET FN 'GLCOMPILED)
+ (GLCOMPILE FN)))
+
+
+% GSN 10-FEB-83 15:33
+% Compile a Message. MSGLST is the Message list, consisting of message
+% selector, code, and properties defined with the message.
+(DE GLCOMPMSG (OBJECT MSGLST ARGLIST CONTEXT)
+(PROG (RESULT)
+ (COND ((GREATERP (SETQ GLNRECURSIONS (ADD1 GLNRECURSIONS))
+ 9)
+ (RETURN (GLERROR 'GLCOMPMSG
+ (LIST "Infinite loop detected in compiling"
+ (CAR MSGLST)
+ "for object of type"
+ (CADR OBJECT))))))
+ (SETQ RESULT (GLCOMPMSGB OBJECT MSGLST ARGLIST CONTEXT))
+ (SETQ GLNRECURSIONS (SUB1 GLNRECURSIONS))
+ (RETURN RESULT)))
+
+
+% GSN 10-FEB-83 15:13
+% Compile a Message. MSGLST is the Message list, consisting of message
+% selector, code, and properties defined with the message.
+(DE GLCOMPMSGB (OBJECT MSGLST ARGLIST CONTEXT)
+(PROG
+ (GLPROGLST RESULTTYPE METHOD RESULT VTYPE)
+ (SETQ RESULTTYPE (LISTGET (CDDR MSGLST)
+ 'RESULT))
+ (SETQ METHOD (CADR MSGLST))
+ (COND
+ ((ATOM METHOD)
+
+% Function name is specified.
+
+ (COND
+ ((LISTGET (CDDR MSGLST)
+ 'OPEN)
+ (RETURN (GLCOMPOPEN METHOD (CONS OBJECT ARGLIST)
+ (CONS (CADR OBJECT)
+ (LISTGET (CDDR MSGLST)
+ 'ARGTYPES))
+ RESULTTYPE
+ (LISTGET (CDDR MSGLST)
+ 'SPECVARS))))
+ (T (RETURN (LIST (CONS METHOD (CONS (CAR OBJECT)
+ (MAPCAR ARGLIST
+ (FUNCTION CAR))))
+ (OR (GLRESULTTYPE
+ METHOD
+ (CONS (CADR OBJECT)
+ (MAPCAR ARGLIST (FUNCTION CADR))))
+ (LISTGET (CDDR MSGLST)
+ 'RESULT)))))))
+ ((NOT (PAIRP METHOD))
+ (RETURN (GLERROR 'GLCOMPMSG
+ (LIST "The form of Response is illegal for message"
+ (CAR MSGLST)))))
+ ((AND (PAIRP (CAR METHOD))
+ (MEMQ (CAAR METHOD)
+ '(virtual Virtual VIRTUAL)))
+ (OR (SETQ VTYPE (LISTGET (CDDR MSGLST)
+ 'VTYPE))
+ (PROGN (SETQ VTYPE (GLMAKEVTYPE (CADR OBJECT)
+ (CAR METHOD)))
+ (NCONC MSGLST (LIST 'VTYPE
+ VTYPE))))
+ (RETURN (LIST (CAR OBJECT)
+ VTYPE))))
+
+% The Method is a list of stuff to be compiled open.
+
+ (SETQ CONTEXT (LIST NIL))
+ (COND ((ATOM (CAR OBJECT))
+ (GLADDSTR (LIST 'PROG1
+ (CAR OBJECT))
+ 'self
+ (CADR OBJECT)
+ CONTEXT))
+ ((AND (PAIRP (CAR OBJECT))
+ (EQ (CAAR OBJECT)
+ 'PROG1)
+ (ATOM (CADAR OBJECT))
+ (NULL (CDDAR OBJECT)))
+ (GLADDSTR (CAR OBJECT)
+ 'self
+ (CADR OBJECT)
+ CONTEXT))
+ (T (SETQ GLPROGLST (CONS (LIST 'self
+ (CAR OBJECT))
+ GLPROGLST))
+ (GLADDSTR 'self
+ NIL
+ (CADR OBJECT)
+ CONTEXT)))
+ (SETQ RESULT (GLPROGN METHOD CONTEXT))
+
+% If more than one expression resulted, embed in a PROGN.
+
+ (RPLACA RESULT (COND ((CDAR RESULT)
+ (CONS 'PROGN
+ (CAR RESULT)))
+ (T (CAAR RESULT))))
+ (RETURN (LIST (COND (GLPROGLST (GLGENCODE (LIST 'PROG
+ GLPROGLST
+ (LIST 'RETURN
+ (CAR RESULT)))))
+ (T (CAR RESULT)))
+ (OR RESULTTYPE (CADR RESULT))))))
+
+
+% GSN 16-FEB-83 17:37
+% Attempt to compile code for a message list for an object. OBJECT is
+% the destination, in the form (<code> <type>) , PROPTYPE is the
+% property type (ADJ etc.) , MSGLST is the message list, and ARGS is
+% a list of arguments of the form (<code> <type>) . The result is of
+% the form (<code> <type>) , or NIL if failure.
+(DE GLCOMPMSGL (OBJECT PROPTYPE MSGLST ARGS CONTEXT)
+(PROG
+ (TYPE SELECTOR NEWFN NEWMSGLST)
+ (SETQ TYPE (GLXTRTYPE (CADR OBJECT)))
+ (SETQ SELECTOR (CAR MSGLST))
+ (RETURN
+ (COND
+ ((LISTGET (CDDR MSGLST)
+ 'MESSAGE)
+ (SETQ CONTEXT (LIST NIL))
+ (GLADDSTR (CAR OBJECT)
+ 'self
+ TYPE CONTEXT)
+ (LIST
+ (COND
+ ((EQ PROPTYPE 'MSG)
+ (CONS 'SEND
+ (CONS (CAR OBJECT)
+ (CONS SELECTOR (MAPCAR ARGS (FUNCTION CAR))))))
+ (T (CONS 'SENDPROP
+ (CONS (CAR OBJECT)
+ (CONS SELECTOR (CONS PROPTYPE
+ (MAPCAR ARGS
+ (FUNCTION CAR))))))))
+ (GLEVALSTR (LISTGET (CDDR MSGLST)
+ 'RESULT)
+ CONTEXT)))
+ ((LISTGET (CDDR MSGLST)
+ 'SPECIALIZE)
+ (SETQ NEWFN (GLINSTANCEFNNAME (CADR MSGLST)))
+ (SETQ NEWMSGLST (LIST (CAR MSGLST)
+ NEWFN
+ 'SPECIALIZATION
+ T))
+ (GLADDPROP (CADR OBJECT)
+ PROPTYPE NEWMSGLST)
+ (GLCOMPABSTRACT (CADR MSGLST)
+ NEWFN NIL NIL (CONS (CADR OBJECT)
+ (MAPCAR ARGS
+ (FUNCTION CADR))))
+ (PUT NEWFN 'GLSPECIALIZATION
+ (CONS (LIST (CADR MSGLST)
+ (CADR OBJECT)
+ PROPTYPE SELECTOR)
+ (GET NEWFN 'GLSPECIALIZATION)))
+ (NCONC NEWMSGLST (LIST 'RESULT
+ (GET NEWFN 'GLRESULTTYPE)))
+ (GLCOMPMSG OBJECT NEWMSGLST ARGS CONTEXT))
+ (T (GLCOMPMSG OBJECT MSGLST ARGS CONTEXT))))))
+
+
+% GSN 4-MAR-83 14:17
+% Compile the function FN Open, given as arguments ARGS with argument
+% types ARGTYPES. Types may be defined in the definition of function
+% FN (which may be either a GLAMBDA or LAMBDA function) or by
+% ARGTYPES; ARGTYPES takes precedence.
+(DE GLCOMPOPEN (FN ARGS ARGTYPES RESULTTYPE SPCVARS)
+(PROG (PTR FNDEF GLPROGLST NEWEXPR CONTEXT NEWARGS)
+
+% Put a new level on top of CONTEXT.
+
+ (SETQ CONTEXT (LIST NIL))
+ (SETQ FNDEF (GLGETD FN))
+
+% Get the parameter declarations and add to CONTEXT.
+
+ (GLDECL (CADR FNDEF)
+ '(T NIL)
+ CONTEXT NIL NIL)
+
+% Make the function parameters into names and put in the values,
+% hiding any which are simple variables.
+
+ (SETQ PTR (REVERSIP (CAR CONTEXT)))
+ (RPLACA CONTEXT NIL)
+ LP
+ (COND ((NULL PTR)
+ (GO B)))
+ (COND ((EQ ARGS T)
+ (GLADDSTR (CAAR PTR)
+ NIL
+ (OR (CAR ARGTYPES)
+ (CADDAR PTR))
+ CONTEXT)
+ (SETQ NEWARGS (CONS (CAAR PTR)
+ NEWARGS)))
+ ((AND (ATOM (CAAR ARGS))
+ (NE SPCVARS T)
+ (NOT (MEMQ (CAAR PTR)
+ SPCVARS)))
+
+% Wrap the atom in a PROG1 so it won't match as a name; the PROG1 will
+% generally be stripped later.
+
+ (GLADDSTR (LIST 'PROG1
+ (CAAR ARGS))
+ (CAAR PTR)
+ (OR (CADAR ARGS)
+ (CAR ARGTYPES)
+ (CADDAR PTR))
+ CONTEXT))
+ ((AND (NE SPCVARS T)
+ (NOT (MEMQ (CAAR PTR)
+ SPCVARS))
+ (PAIRP (CAAR ARGS))
+ (EQ (CAAAR ARGS)
+ 'PROG1)
+ (ATOM (CADAAR ARGS))
+ (NULL (CDDAAR ARGS)))
+ (GLADDSTR (CAAR ARGS)
+ (CAAR PTR)
+ (OR (CADAR ARGS)
+ (CAR ARGTYPES)
+ (CADDAR PTR))
+ CONTEXT))
+ (T
+% Since the actual argument is not atomic, make a PROG variable for
+% it.
+
+ (SETQ GLPROGLST (CONS (LIST (CAAR PTR)
+ (CAAR ARGS))
+ GLPROGLST))
+ (GLADDSTR (CAAR PTR)
+ (CADAR PTR)
+ (OR (CADAR ARGS)
+ (CAR ARGTYPES)
+ (CADDAR PTR))
+ CONTEXT)))
+ (SETQ PTR (CDR PTR))
+ (COND ((PAIRP ARGS)
+ (SETQ ARGS (CDR ARGS))))
+ (SETQ ARGTYPES (CDR ARGTYPES))
+ (GO LP)
+ B
+ (SETQ FNDEF (CDDR FNDEF))
+
+% Get rid of comments at start of function.
+
+ C
+ (COND ((AND FNDEF (PAIRP (CAR FNDEF))
+ (MEMQ (CAAR FNDEF)
+ '(RESULT * GLOBAL)))
+ (SETQ FNDEF (CDR FNDEF))
+ (GO C)))
+ (SETQ NEWEXPR (GLPROGN FNDEF CONTEXT))
+
+% Get rid of atomic result if it isnt busy outside.
+
+ (COND ((AND (NOT VALBUSY)
+ (CDAR EXPR)
+ (OR (ATOM (CADR (SETQ PTR (NLEFT (CAR NEWEXPR)
+ 2))))
+ (AND (PAIRP (CADR PTR))
+ (EQ (CAADR PTR)
+ 'PROG1)
+ (ATOM (CADADR PTR))
+ (NULL (CDDADR PTR)))))
+ (RPLACD PTR NIL)))
+ (SETQ RESULT (LIST (COND (GLPROGLST (SETQ PTR (LASTPAIR (CAR NEWEXPR)))
+ (RPLACA PTR (LIST 'RETURN
+ (CAR PTR)))
+ (GLGENCODE
+ (CONS 'PROG
+ (CONS (REVERSIP GLPROGLST)
+ (CAR NEWEXPR)))))
+ ((CDAR NEWEXPR)
+ (CONS 'PROGN
+ (CAR NEWEXPR)))
+ (T (CAAR NEWEXPR)))
+ (OR RESULTTYPE (GLRESULTTYPE FN NIL)
+ (CADR NEWEXPR))))
+ (COND ((EQ ARGS T)
+ (RPLACA RESULT (LIST 'LAMBDA
+ (REVERSIP NEWARGS)
+ (CAR RESULT)))))
+ (RETURN RESULT)))
+
+
+% GSN 1-FEB-83 16:18
+% Compile a LAMBDA expression to compute the property PROPNAME of type
+% PROPTYPE for structure STR. The property type STR is allowed for
+% structure access.
+(DE GLCOMPPROP (STR PROPNAME PROPTYPE)
+(PROG (CODE PL SUBPL PROPENT)
+
+% See if the property has already been compiled.
+
+ (COND ((AND (SETQ PL (GET STR 'GLPROPFNS))
+ (SETQ SUBPL (ASSOC PROPTYPE PL))
+ (SETQ PROPENT (ASSOC PROPNAME (CDR SUBPL))))
+ (RETURN (CADR PROPENT))))
+
+% Compile code for this property and save it.
+
+ (COND ((NOT (MEMQ PROPTYPE '(STR ADJ ISA PROP MSG)))
+ (ERROR 0 NIL)))
+ (OR (SETQ CODE (GLCOMPPROPL STR PROPNAME PROPTYPE))
+ (RETURN NIL))
+ (COND ((NOT PL)
+ (PUT STR 'GLPROPFNS
+ (SETQ PL (COPY '((STR)
+ (PROP)
+ (ADJ)
+ (ISA)
+ (MSG)))))
+ (SETQ SUBPL (ASSOC PROPTYPE PL))))
+ (RPLACD SUBPL (CONS (CONS PROPNAME CODE)
+ (CDR SUBPL)))
+ (RETURN (CAR CODE))))
+
+
+% GSN 16-FEB-83 11:25
+% Compile a message as a closed form, i.e., function name or LAMBDA
+% form.
+(DE GLCOMPPROPL (STR PROPNAME PROPTYPE)
+(PROG (CODE MSGL TRANS TMP FETCHCODE NEWVAR GLNATOM CONTEXT VALBUSY GLSEPATOM
+ GLSEPPTR EXPRSTACK GLTOPCTX GLGLOBALVARS GLTYPESUBS FAULTFN
+ GLNRECURSIONS)
+ (SETQ FAULTFN 'GLCOMPPROPL)
+ (SETQ GLNRECURSIONS 0)
+ (SETQ GLNATOM 0)
+ (SETQ VALBUSY T)
+ (SETQ GLSEPPTR 0)
+ (SETQ CONTEXT (SETQ GLTOPCTX (LIST NIL)))
+ (COND ((EQ PROPTYPE 'STR)
+ (COND ((SETQ CODE (GLSTRFN PROPNAME STR NIL))
+ (RETURN (LIST (LIST 'LAMBDA
+ (LIST 'self)
+ (GLUNWRAP (SUBSTIP 'self
+ '*GL*
+ (CAR CODE))
+ T))
+ (CADR CODE))))
+ (T (RETURN NIL))))
+ ((SETQ MSGL (GLSTRPROP STR PROPTYPE PROPNAME NIL))
+ (COND ((ATOM (CADR MSGL))
+ (COND ((LISTGET (CDDR MSGL)
+ 'OPEN)
+ (SETQ CODE (GLCOMPOPEN (CADR MSGL)
+ T
+ (LIST STR)
+ NIL NIL)))
+ (T (SETQ CODE (LIST (CADR MSGL)
+ (GLRESULTTYPE (CADR MSGL)
+ NIL))))))
+ ((SETQ CODE (GLADJ (LIST 'self
+ STR)
+ PROPNAME PROPTYPE))
+ (SETQ CODE (LIST (LIST 'LAMBDA
+ (LIST 'self)
+ (GLUNWRAP (CAR CODE)
+ T))
+ (CADR CODE))))))
+ ((SETQ TRANS (GLTRANSPARENTTYPES STR))
+ (GO B))
+ (T (RETURN NIL)))
+ (RETURN (LIST (GLUNWRAP (CAR CODE)
+ T)
+ (OR (CADR CODE)
+ (LISTGET (CDDR MSGL)
+ 'RESULT))))
+
+% Look for the message in a contained TRANSPARENT type.
+
+ B
+ (COND ((NULL TRANS)
+ (RETURN NIL))
+ ((SETQ TMP (GLCOMPPROPL (GLXTRTYPE (CAR TRANS))
+ PROPNAME PROPTYPE))
+ (COND ((ATOM (CAR TMP))
+ (GLERROR 'GLCOMPPROPL
+ (LIST "GLISP cannot currently"
+ "handle inheritance of the property"
+ PROPNAME
+ "which is specified as a function name"
+ "in a TRANSPARENT subtype. Sorry."))
+ (RETURN NIL)))
+ (SETQ FETCHCODE (GLSTRFN (CAR TRANS)
+ STR NIL))
+ (SETQ NEWVAR (GLMKVAR))
+ (GLSTRVAL FETCHCODE NEWVAR)
+ (RETURN (LIST (GLUNWRAP (LIST 'LAMBDA
+ (CONS NEWVAR (CDADAR TMP))
+ (LIST 'PROG
+ (LIST (LIST (CAADAR TMP)
+ (CAR FETCHCODE)))
+ (LIST 'RETURN
+ (CADDAR TMP))))
+ T)
+ (CADR TMP))))
+ (T (SETQ TRANS (CDR TRANS))
+ (GO B)))))
+
+
+% edited: 14-MAR-83 17:07
+% Attempt to infer the type of a constant expression.
+(DE GLCONSTANTTYPE (EXPR)
+(PROG (TMP TYPES)
+ (COND ((SETQ TMP (COND ((FIXP EXPR)
+ 'INTEGER)
+ ((NUMBERP EXPR)
+ 'NUMBER)
+ ((ATOM EXPR)
+ 'ATOM)
+ ((STRINGP EXPR)
+ 'STRING)
+ ((NOT (PAIRP EXPR))
+ 'ANYTHING)
+ ((NOT (OR (NULL (CDR EXPR))
+ (PAIRP (CDR EXPR))))
+ 'ANYTHING)
+ ((EVERY EXPR (FUNCTION FIXP))
+ '(LISTOF INTEGER))
+ ((EVERY EXPR (FUNCTION NUMBERP))
+ '(LISTOF NUMBER))
+ ((EVERY EXPR (FUNCTION ATOM))
+ '(LISTOF ATOM))
+ ((EVERY EXPR (FUNCTION STRINGP))
+ '(LISTOF STRING))))
+ (RETURN TMP)))
+ (SETQ TYPES (MAPCAR EXPR (FUNCTION GLCONSTANTTYPE)))
+ (COND ((EVERY (CDR TYPES)
+ (FUNCTION (LAMBDA (Y)
+ (EQUAL Y (CAR TYPES)))))
+ (RETURN (LIST 'LISTOF
+ (CAR TYPES))))
+ (T (RETURN (CONS 'LIST
+ TYPES))))))
+
+
+% edited: 31-AUG-82 15:38
+% Test X to see if it represents a compile-time constant value.
+(DE GLCONST? (X)
+(OR (NULL X)
+ (EQ X T)
+ (NUMBERP X)
+ (AND (PAIRP X)
+ (EQ (CAR X)
+ 'QUOTE)
+ (ATOM (CADR X)))
+ (AND (ATOM X)
+ (GET X 'GLISPCONSTANTFLG))))
+
+
+% edited: 9-DEC-82 17:02
+% Test to see if X is a constant structure.
+(DE GLCONSTSTR? (X)
+(OR (GLCONST? X)
+ (AND (PAIRP X)
+ (OR (EQ (CAR X)
+ 'QUOTE)
+ (AND (MEMQ (CAR X)
+ '(COPY APPEND))
+ (PAIRP (CADR X))
+ (EQ (CAADR X)
+ 'QUOTE)
+ (OR (NE (CAR X)
+ 'APPEND)
+ (NULL (CDDR X))
+ (NULL (CADDR X))))
+ (AND (EQ (CAR X)
+ 'LIST)
+ (EVERY (CDR X)
+ (FUNCTION GLCONSTSTR?)))
+ (AND (EQ (CAR X)
+ 'CONS)
+ (GLCONSTSTR? (CADR X))
+ (GLCONSTSTR? (CADDR X)))))))
+
+
+% edited: 9-DEC-82 17:07
+% Get the value of a compile-time constant
+(DE GLCONSTVAL (X)
+(COND ((OR (NULL X)
+ (EQ X T)
+ (NUMBERP X))
+ X)
+ ((AND (PAIRP X)
+ (EQ (CAR X)
+ 'QUOTE))
+ (CADR X))
+ ((PAIRP X)
+ (COND ((AND (MEMQ (CAR X)
+ '(COPY APPEND))
+ (PAIRP (CADR X))
+ (EQ (CAADR X)
+ 'QUOTE)
+ (OR (NULL (CDDR X))
+ (NULL (CADDR X))))
+ (CADADR X))
+ ((EQ (CAR X)
+ 'LIST)
+ (MAPCAR (CDR X)
+ (FUNCTION GLCONSTVAL)))
+ ((EQ (CAR X)
+ 'CONS)
+ (CONS (GLCONSTVAL (CADR X))
+ (GLCONSTVAL (CADDR X))))
+ (T (ERROR 0 NIL))))
+ ((AND (ATOM X)
+ (GET X 'GLISPCONSTANTFLG))
+ (GET X 'GLISPCONSTANTVAL))
+ (T (ERROR 0 NIL))))
+
+
+% edited: 5-OCT-82 15:23
+(DE GLCP (FN)
+(SETQ FN (OR FN GLLASTFNCOMPILED))(COND ((NOT (GLGETD FN))
+ (PRIN1 FN)
+ (PRIN1 " ?")
+ (TERPRI))
+ (T (GLCOMPILE FN)
+ (GLP FN))))
+
+
+% GSN 28-JAN-83 09:29
+% edited: 1-Jun-81 16:02
+% Process a declaration list from a GLAMBDA expression. Each element
+% of the list is of the form <var>, <var>:<str-descr>, :<str-descr>,
+% or <var>: (A <str-descr>) or (A <str-descr>) . Forms without a
+% variable are accepted only if NOVAROK is true. If VALOK is true, a
+% PROG form (variable value) is allowed. The result is a list of
+% variable names.
+(DE GLDECL (LST FLGS GLTOPCTX FN ARGTYPES)
+(PROG (RESULT FIRST SECOND THIRD TOP TMP EXPR VARS STR NOVAROK VALOK)
+ (SETQ NOVAROK (CAR FLGS))
+ (SETQ VALOK (CADR FLGS))
+ (COND ((NULL GLTOPCTX)
+ (ERROR 0 NIL)))
+ A
+
+% Get the next variable/description from LST
+
+ (COND ((NULL LST)
+ (SETQ ARGTYPES NIL)
+ (SETQ CONTEXT GLTOPCTX)
+ (MAPC (CAR GLTOPCTX)
+ (FUNCTION (LAMBDA (S)
+ (SETQ ARGTYPES (CONS (GLEVALSTR (CADDR S)
+ GLTOPCTX)
+ ARGTYPES))
+ (RPLACA (CDDR S)
+ (CAR ARGTYPES)))))
+ (SETQ RESULT (REVERSIP RESULT))
+ (COND (FN (PUT FN 'GLARGUMENTTYPES
+ ARGTYPES)))
+ (RETURN RESULT)))
+ (SETQ TOP (pop LST))
+ (COND ((NOT (ATOM TOP))
+ (GO B)))
+ (SETQ VARS NIL)
+ (SETQ STR NIL)
+ (GLSEPINIT TOP)
+ (SETQ FIRST (GLSEPNXT))
+ (SETQ SECOND (GLSEPNXT))
+ (COND ((EQ FIRST ':)
+ (COND ((NULL SECOND)
+ (COND ((AND NOVAROK LST (GLOKSTR? (CAR LST)))
+ (GLDECLDS (GLMKVAR)
+ (pop LST))
+ (GO A))
+ (T (GO E))))
+ ((AND NOVAROK (GLOKSTR? SECOND)
+ (NULL (GLSEPNXT)))
+ (GLDECLDS (GLMKVAR)
+ SECOND)
+ (GO A))
+ (T (GO E)))))
+ D
+
+% At least one variable name has been found. Collect other variable
+% names until a <type> is found.
+
+ (SETQ VARS (ACONC VARS FIRST))
+ (COND ((NULL SECOND)
+ (GO C))
+ ((EQ SECOND ':)
+ (COND ((AND (SETQ THIRD (GLSEPNXT))
+ (GLOKSTR? THIRD)
+ (NULL (GLSEPNXT)))
+ (SETQ STR THIRD)
+ (GO C))
+ ((AND (NULL THIRD)
+ (GLOKSTR? (CAR LST)))
+ (SETQ STR (pop LST))
+ (GO C))
+ (T (GO E))))
+ ((EQ SECOND '!,)
+ (COND ((SETQ FIRST (GLSEPNXT))
+ (SETQ SECOND (GLSEPNXT))
+ (GO D))
+ ((ATOM (CAR LST))
+ (GLSEPINIT (pop LST))
+ (SETQ FIRST (GLSEPNXT))
+ (SETQ SECOND (GLSEPNXT))
+ (GO D))))
+ (T (GO E)))
+ C
+
+% Define the <type> for each variable on VARS.
+
+ (MAPC VARS (FUNCTION (LAMBDA (X)
+ (GLDECLDS X STR))))
+ (GO A)
+ B
+
+% The top of LST is non-atomic. Must be either (A <type>) or
+% (<var> <value>) .
+
+ (COND ((AND (GL-A-AN? (CAR TOP))
+ NOVAROK
+ (GLOKSTR? TOP))
+ (GLDECLDS (GLMKVAR)
+ TOP))
+ ((AND VALOK (NOT (GL-A-AN? (CAR TOP)))
+ (ATOM (CAR TOP))
+ (CDR TOP))
+ (SETQ EXPR (CDR TOP))
+ (SETQ TMP (GLDOEXPR NIL GLTOPCTX T))
+ (COND (EXPR (GO E)))
+ (GLADDSTR (CAR TOP)
+ NIL
+ (CADR TMP)
+ GLTOPCTX)
+ (SETQ RESULT (CONS (LIST (CAR TOP)
+ (CAR TMP))
+ RESULT)))
+ ((AND NOVAROK (GLOKSTR? TOP))
+ (GLDECLDS (GLMKVAR)
+ TOP))
+ (T (GO E)))
+ (GO A)
+ E
+ (GLERROR 'GLDECL
+ (LIST "Bad argument structure" LST))
+ (RETURN NIL)))
+
+
+% GSN 26-JAN-83 13:17
+% edited: 2-Jan-81 13:39
+% Add ATM to the RESULT list of GLDECL, and declare its structure.
+(DE GLDECLDS (ATM STR)
+(PROG NIL
+% If a substitution exists for this type, use it.
+
+ (COND (ARGTYPES (SETQ STR (pop ARGTYPES)))
+ (GLTYPESUBS (SETQ STR (GLSUBSTTYPE STR GLTYPESUBS))))
+ (SETQ RESULT (CONS ATM RESULT))
+ (GLADDSTR ATM NIL STR GLTOPCTX)))
+
+
+% GSN 26-JAN-83 10:28
+% Declare variables and types in top of CONTEXT.
+(DE GLDECLS (VARS TYPES CONTEXT)
+(PROG NIL A (COND ((NULL VARS)
+ (RETURN NIL)))
+ (GLADDSTR (CAR VARS)
+ NIL
+ (CAR TYPES)
+ CONTEXT)
+ (SETQ VARS (CDR VARS))
+ (SETQ TYPES (CDR TYPES))
+ (GO A)))
+
+
+% edited: 19-MAY-82 13:33
+% Define the result types for a list of functions. The format of the
+% argument is a list of dotted pairs, (FN . TYPE)
+(DE GLDEFFNRESULTTYPES (LST)
+(MAPC LST (FUNCTION (LAMBDA (X)
+ (MAPC (CADR X)
+ (FUNCTION (LAMBDA (Y)
+ (PUT Y 'GLRESULTTYPE
+ (CAR X)))))))))
+
+
+% edited: 19-MAY-82 13:05
+% Define the result type functions for a list of functions. The format
+% of the argument is a list of dotted pairs, (FN . TYPEFN)
+(DE GLDEFFNRESULTTYPEFNS (LST)
+(MAPC LST (FUNCTION (LAMBDA (X)
+ (PUT (CAR X)
+ 'GLRESULTTYPEFN
+ (CDR X))))))
+
+
+% GSN 2-MAR-83 10:14
+% Define properties for an object type. Each property is of the form
+% (<propname> (<definition>) <properties>)
+(DE GLDEFPROP (OBJECT PROP LST)
+(PROG (LSTP)
+ (MAPC LST (FUNCTION (LAMBDA (X)
+ (COND
+ ((NOT (OR (EQ PROP 'DOC)
+ (AND (EQ PROP 'SUPERS)
+ (ATOM X))
+ (AND (PAIRP X)
+ (ATOM (CAR X))
+ (CDR X))))
+ (PRIN1 "GLDEFPROP: For object ")
+ (PRIN1 OBJECT)
+ (PRIN1 " the ")
+ (PRIN1 PROP)
+ (PRIN1 " property ")
+ (PRIN1 X)
+ (PRIN1 " has bad form.")
+ (TERPRI)
+ (PRIN1 "This property was ignored.")
+ (TERPRI))
+ (T (SETQ LSTP (CONS X LSTP)))))))
+ (NCONC (GET OBJECT 'GLSTRUCTURE)
+ (LIST PROP (REVERSIP LSTP)))))
+
+
+% GSN 10-FEB-83 12:31
+% edited: 17-Sep-81 12:21
+% Process a Structure Description. The format of the argument is the
+% name of the structure followed by its structure description,
+% followed by other optional arguments.
+(DE GLDEFSTR (LST SYSTEMFLG)
+(PROG (STRNAME STR OLDSTR)
+ (SETQ STRNAME (pop LST))
+ (COND ((AND (NOT SYSTEMFLG)
+ (MEMQ STRNAME GLBASICTYPES))
+ (PRIN1 "The GLISP type ")
+ (PRIN1 STRNAME)
+ (PRIN1 " may not be redefined by the user.")
+ (TERPRI)
+ (RETURN NIL))
+ ((SETQ OLDSTR (GET STRNAME 'GLSTRUCTURE))
+ (COND ((EQUAL OLDSTR LST)
+ (RETURN NIL))
+ ((NOT GLQUIETFLG)
+ (PRIN1 STRNAME)
+ (PRIN1 " structure redefined.")
+ (TERPRI)))
+ (GLSTRCHANGED STRNAME))
+ ((NOT SYSTEMFLG)
+ NIL))
+ (SETQ STR (pop LST))
+ (PUT STRNAME 'GLSTRUCTURE
+ (LIST STR))
+ (COND ((NOT (GLOKSTR? STR))
+ (PRIN1 STRNAME)
+ (PRIN1 " has faulty structure specification.")
+ (TERPRI)))
+ (COND ((NOT (MEMQ STRNAME GLOBJECTNAMES))
+ (SETQ GLOBJECTNAMES (CONS STRNAME GLOBJECTNAMES))))
+
+% Process the remaining specifications, if any. Each additional
+% specification is a list beginning with a keyword.
+
+ LP
+ (COND ((NULL LST)
+ (RETURN NIL)))
+ (CASEQ (CAR LST)
+ ((ADJ Adj adj)
+ (GLDEFPROP STRNAME 'ADJ
+ (CADR LST)))
+ ((PROP Prop prop)
+ (GLDEFPROP STRNAME 'PROP
+ (CADR LST)))
+ ((ISA Isa IsA isA isa)
+ (GLDEFPROP STRNAME 'ISA
+ (CADR LST)))
+ ((MSG Msg msg)
+ (GLDEFPROP STRNAME 'MSG
+ (CADR LST)))
+ (T (GLDEFPROP STRNAME (CAR LST)
+ (CADR LST))))
+ (SETQ LST (CDDR LST))
+ (GO LP)))
+
+
+% edited: 27-APR-82 11:01
+(DF GLDEFSTRNAMES (LST)
+(MAPC LST (FUNCTION (LAMBDA (X)
+ (PROG (TMP)
+ (COND
+ ((SETQ TMP (ASSOC (CAR X)
+ GLUSERSTRNAMES))
+ (RPLACD TMP (CDR X)))
+ (T (SETQ GLUSERSTRNAMES (ACONC GLUSERSTRNAMES X))
+ )))))))
+
+
+% GSN 10-FEB-83 11:50
+% Define named structure descriptions. The descriptions are of the
+% form (<name> <description>) . Each description is put on the
+% property list of <name> as GLSTRUCTURE
+(DF GLDEFSTRQ (ARGS)
+(MAPC ARGS (FUNCTION (LAMBDA (ARG)
+ (GLDEFSTR ARG NIL)))))
+
+
+% GSN 10-FEB-83 12:13
+% Define named structure descriptions. The descriptions are of the
+% form (<name> <description>) . Each description is put on the
+% property list of <name> as GLSTRUCTURE
+(DF GLDEFSYSSTRQ (ARGS)
+(MAPC ARGS (FUNCTION (LAMBDA (ARG)
+ (GLDEFSTR ARG T)))))
+
+
+% edited: 27-MAY-82 13:00
+% This function is called by the user to define a unit package to the
+% GLISP system. The argument, a unit record, is a list consisting of
+% the name of a function to test an entity to see if it is a unit of
+% the units package, the name of the unit package's runtime GET
+% function, and an ALIST of operations on units and the functions to
+% perform those operations. Operations include GET, PUT, ISA, ISADJ,
+% NCONC, REMOVE, PUSH, and POP.
+(DE GLDEFUNITPKG (UNITREC)
+(PROG (LST)
+ (SETQ LST GLUNITPKGS)
+ A
+ (COND ((NULL LST)
+ (SETQ GLUNITPKGS (ACONC GLUNITPKGS UNITREC))
+ (RETURN NIL))
+ ((EQ (CAAR LST)
+ (CAR UNITREC))
+ (RPLACA LST UNITREC)))
+ (SETQ LST (CDR LST))
+ (GO A)))
+
+
+% GSN 23-JAN-83 15:39
+% Remove the GLISP structure definition for NAME.
+(DE GLDELDEF (NAME TYPE)
+(PUT NAME 'GLSTRUCTURE
+ NIL))
+
+
+% edited: 28-NOV-82 15:18
+(DE GLDESCENDANTP (SUBCLASS CLASS)
+(PROG (SUPERS)
+ (COND ((EQ SUBCLASS CLASS)
+ (RETURN T)))
+ (SETQ SUPERS (GLGETSUPERS SUBCLASS))
+ LP
+ (COND ((NULL SUPERS)
+ (RETURN NIL))
+ ((GLDESCENDANTP (CAR SUPERS)
+ CLASS)
+ (RETURN T)))
+ (SETQ SUPERS (CDR SUPERS))
+ (GO LP)))
+
+
+% GSN 25-FEB-83 16:41
+% edited: 25-Jun-81 15:26
+% Function to compile an expression of the form (A <type> ...)
+(DE GLDOA (EXPR)
+(PROG (TYPE UNITREC TMP)
+ (SETQ TYPE (CADR EXPR))
+ (COND ((AND (PAIRP TYPE)
+ (EQ (CAR TYPE)
+ 'TYPEOF))
+ (SETQ TYPE (GLGETTYPEOF TYPE))
+ (GLNOTICETYPE TYPE)
+ (RETURN (GLMAKESTR TYPE (CDDR EXPR))))
+ ((GLGETSTR TYPE)
+ (GLNOTICETYPE TYPE)
+ (RETURN (GLMAKESTR TYPE (CDDR EXPR))))
+ ((AND (SETQ UNITREC (GLUNIT? TYPE))
+ (SETQ TMP (ASSOC 'A
+ (CADDR UNITREC))))
+ (RETURN (APPLY (CDR TMP)
+ (LIST EXPR))))
+ (T (GLERROR 'GLDOA
+ (LIST "The type" TYPE "is not defined."))))))
+
+
+% GSN 7-MAR-83 16:54
+% Compile code for Case statement.
+(DE GLDOCASE (EXPR)
+(PROG
+ (SELECTOR SELECTORTYPE RESULT TMP RESULTTYPE TYPEOK ELSECLAUSE TMPB)
+ (SETQ TYPEOK T)
+ (SETQ TMP (GLPUSHEXPR (LIST (CADR EXPR))
+ NIL CONTEXT T))
+ (SETQ SELECTOR (CAR TMP))
+ (SETQ SELECTORTYPE (CADR TMP))
+ (SETQ EXPR (CDDR EXPR))
+
+% Get rid of of if present
+
+ (COND ((MEMQ (CAR EXPR)
+ '(OF Of of))
+ (SETQ EXPR (CDR EXPR))))
+ A
+ (COND
+ ((NULL EXPR)
+ (RETURN (LIST (GLGENCODE (CONS 'SELECTQ
+ (CONS SELECTOR (ACONC RESULT ELSECLAUSE))))
+ RESULTTYPE)))
+ ((MEMQ (CAR EXPR)
+ '(ELSE Else
+ else))
+ (SETQ TMP (GLPROGN (CDR EXPR)
+ CONTEXT))
+ (SETQ ELSECLAUSE (COND ((CDAR TMP)
+ (CONS 'PROGN
+ (CAR TMP)))
+ (T (CAAR TMP))))
+ (SETQ EXPR NIL))
+ (T
+ (SETQ TMP (GLPROGN (CDAR EXPR)
+ CONTEXT))
+ (SETQ
+ RESULT
+ (ACONC RESULT
+ (CONS (COND
+ ((ATOM (CAAR EXPR))
+ (OR (AND (SETQ TMPB (GLSTRPROP SELECTORTYPE
+ 'VALUES
+ (CAAR EXPR)
+ NIL))
+ (CADR TMPB))
+ (CAAR EXPR)))
+ (T (MAPCAR (CAAR EXPR)
+ (FUNCTION
+ (LAMBDA (X)
+ (OR (AND (SETQ TMPB (GLSTRPROP
+ SELECTORTYPE
+ 'VALUES
+ X NIL))
+ (CADR TMPB))
+ X))))))
+ (CAR TMP))))))
+
+% If all the result types are the same, then we know the result of the
+% Case statement.
+
+ (COND (TYPEOK (COND ((NULL RESULTTYPE)
+ (SETQ RESULTTYPE (CADR TMP)))
+ ((EQUAL RESULTTYPE (CADR TMP)))
+ (T (SETQ TYPEOK NIL)
+ (SETQ RESULTTYPE NIL)))))
+ (COND (EXPR (SETQ EXPR (CDR EXPR))))
+ (GO A)))
+
+
+% edited: 23-APR-82 14:38
+% Compile a COND expression.
+(DE GLDOCOND (CONDEXPR)
+(PROG (RESULT TMP TYPEOK RESULTTYPE)
+ (SETQ TYPEOK T)
+ A
+ (COND ((NULL (SETQ CONDEXPR (CDR CONDEXPR)))
+ (GO B)))
+ (SETQ TMP (GLPROGN (CAR CONDEXPR)
+ CONTEXT))
+ (COND ((NE (CAAR TMP)
+ NIL)
+ (SETQ RESULT (ACONC RESULT (CAR TMP)))
+ (COND (TYPEOK (COND ((NULL RESULTTYPE)
+ (SETQ RESULTTYPE (CADR TMP)))
+ ((EQUAL RESULTTYPE (CADR TMP)))
+ (T (SETQ RESULTTYPE NIL)
+ (SETQ TYPEOK NIL)))))))
+ (COND ((NE (CAAR TMP)
+ T)
+ (GO A)))
+ B
+ (RETURN (LIST (COND ((AND (NULL (CDR RESULT))
+ (EQ (CAAR RESULT)
+ T))
+ (CONS 'PROGN
+ (CDAR RESULT)))
+ (T (CONS 'COND
+ RESULT)))
+ (AND TYPEOK RESULTTYPE)))))
+
+
+% GSN 4-MAR-83 14:06
+% edited: 23-Sep-81 17:08
+% Compile a single expression. START is set if EXPR is the start of a
+% new expression, i.e., if EXPR might be a function call. The global
+% variable EXPR is the expression, CONTEXT the context in which it
+% is compiled. VALBUSY is T if the value of the expression is needed
+% outside the expression. The value is a list of the new expression
+% and its value-description.
+(DE GLDOEXPR (START CONTEXT VALBUSY)
+(PROG (FIRST TMP RESULT)
+ (SETQ EXPRSTACK (CONS EXPR EXPRSTACK))
+ (COND ((NOT (PAIRP EXPR))
+ (GLERROR 'GLDOEXPR
+ (LIST "Expression is not a list."))
+ (GO OUT))
+ ((AND (NOT START)
+ (STRINGP (CAR EXPR)))
+ (GO A))
+ ((OR (NOT (IDP (CAR EXPR)))
+ (NOT START))
+ (GO A)))
+
+% Test the initial atom to see if it is a function name. It is assumed
+% to be a function name if it doesnt contain any GLISP operators and
+% the following atom doesnt start with a GLISP binary operator.
+
+ (COND ((AND (EQ GLLISPDIALECT 'INTERLISP)
+ (EQ (CAR EXPR)
+ '*))
+ (SETQ RESULT (LIST EXPR NIL))
+ (GO OUT))
+ ((MEMQ (CAR EXPR)
+ ''Quote)
+ (SETQ FIRST (CAR EXPR))
+ (GO B)))
+ (GLSEPINIT (CAR EXPR))
+
+% See if the initial atom contains an expression operator.
+
+ (COND ((NE (SETQ FIRST (GLSEPNXT))
+ (CAR EXPR))
+ (COND ((OR (MEMQ (CAR EXPR)
+ '(APPLY* BLKAPPLY* PACK* PP*))
+ (GETDDD (CAR EXPR))
+ (GET (CAR EXPR)
+ 'MACRO)
+ (AND (NE FIRST '~)
+ (GLOPERATOR? FIRST)))
+ (GLSEPCLR)
+ (SETQ FIRST (CAR EXPR))
+ (GO B))
+ (T (GLSEPCLR)
+ (GO A))))
+ ((OR (EQ FIRST '~)
+ (EQ FIRST '-))
+ (GLSEPCLR)
+ (GO A))
+ ((OR (NOT (PAIRP (CDR EXPR)))
+ (NOT (IDP (CADR EXPR))))
+ (GO B)))
+
+% See if the initial atom is followed by an expression operator.
+
+ (GLSEPINIT (CADR EXPR))
+ (SETQ TMP (GLSEPNXT))
+ (GLSEPCLR)
+ (COND ((GLOPERATOR? TMP)
+ (GO A)))
+
+% The EXPR is a function reference. Test for system functions.
+
+ B
+ (SETQ RESULT (CASEQ FIRST ('Quote
+ (LIST EXPR (GLCONSTANTTYPE (CADR EXPR))))
+ ((GO Go go)
+ (LIST EXPR NIL))
+ ((PROG Prog prog)
+ (GLDOPROG EXPR CONTEXT))
+ ((FUNCTION Function function)
+ (GLDOFUNCTION EXPR NIL CONTEXT T))
+ ((SETQ Setq setq)
+ (GLDOSETQ EXPR))
+ ((COND Cond cond)
+ (GLDOCOND EXPR))
+ ((RETURN Return return)
+ (GLDORETURN EXPR))
+ ((FOR For for)
+ (GLDOFOR EXPR))
+ ((THE The the)
+ (GLDOTHE EXPR))
+ ((THOSE Those those)
+ (GLDOTHOSE EXPR))
+ ((IF If if)
+ (GLDOIF EXPR CONTEXT))
+ ((A a AN An an)
+ (GLDOA EXPR))
+ ((_ SEND Send send)
+ (GLDOSEND EXPR))
+ ((PROGN PROG2)
+ (GLDOPROGN EXPR))
+ (PROG1 (GLDOPROG1 EXPR CONTEXT))
+ ((SELECTQ CASEQ)
+ (GLDOSELECTQ EXPR CONTEXT))
+ ((WHILE While while)
+ (GLDOWHILE EXPR CONTEXT))
+ ((REPEAT Repeat repeat)
+ (GLDOREPEAT EXPR))
+ ((CASE Case case)
+ (GLDOCASE EXPR))
+ ((MAP MAPLIST MAPCON MAPC MAPCAR MAPCONC MAPCAN)
+ (GLDOMAP EXPR))
+ (T (GLUSERFN EXPR))))
+ (GO OUT)
+ A
+
+% The current EXPR is possibly a GLISP expression. Parse the next
+% subexpression using GLPARSEXPR.
+
+ (SETQ RESULT (GLPARSEXPR))
+ OUT
+ (SETQ EXPRSTACK (CDR EXPRSTACK))
+ (RETURN RESULT)))
+
+
+% GSN 2-MAR-83 17:03
+% edited: 21-Apr-81 11:25
+% Compile code for a FOR loop.
+(DE GLDOFOR (EXPR)
+(PROG (DOMAIN DOMAINNAME DTYPE ORIGEXPR LOOPVAR NEWCONTEXT LOOPCONTENTS
+ SINGFLAG LOOPCOND COLLECTCODE)
+ (SETQ ORIGEXPR EXPR)
+ (pop EXPR)
+
+% Parse the forms (FOR EACH <set> ...) and (FOR <var> IN <set> ...)
+
+ (COND ((MEMQ (CAR EXPR)
+ '(EACH Each each))
+ (SETQ SINGFLAG T)
+ (pop EXPR))
+ ((AND (ATOM (CAR EXPR))
+ (MEMQ (CADR EXPR)
+ '(IN In in)))
+ (SETQ LOOPVAR (pop EXPR))
+ (pop EXPR))
+ (T (GO X)))
+
+% Now get the <set>
+
+ (COND ((NULL (SETQ DOMAIN (GLDOMAIN SINGFLAG)))
+ (GO X)))
+ (SETQ DTYPE (GLXTRTYPE (CADR DOMAIN)))
+ (COND ((OR (NULL DTYPE)
+ (EQ DTYPE 'ANYTHING))
+ (SETQ DTYPE '(LISTOF ANYTHING)))
+ ((OR (NOT (PAIRP DTYPE))
+ (NE (CAR DTYPE)
+ 'LISTOF))
+ (COND ((OR (AND (PAIRP (SETQ DTYPE (GLXTRTYPE (GLGETSTR DTYPE))))
+ (EQ (CAR DTYPE)
+ 'LISTOF))
+ (NULL DTYPE)))
+ (T (GLERROR 'GLDOFOR
+ (LIST
+ "Warning: The domain of a FOR loop is of type"
+ DTYPE "which is not a LISTOF type."))
+ (SETQ DTYPE '(LISTOF ANYTHING))))))
+
+% Add a level onto the context for the inside of the loop.
+
+ (SETQ NEWCONTEXT (CONS NIL CONTEXT))
+
+% If a loop variable wasnt specified, make one.
+
+ (OR LOOPVAR (SETQ LOOPVAR (GLMKVAR)))
+ (GLADDSTR LOOPVAR (AND SINGFLAG DOMAINNAME)
+ (CADR DTYPE)
+ NEWCONTEXT)
+
+% See if a condition is specified. If so, add it to LOOPCOND.
+
+ (COND ((MEMQ (CAR EXPR)
+ '(WITH With with))
+ (pop EXPR)
+ (SETQ LOOPCOND (GLPREDICATE (LIST LOOPVAR (CADR DTYPE))
+ NEWCONTEXT NIL NIL)))
+ ((MEMQ (CAR EXPR)
+ '(WHICH Which which WHO Who who THAT That that))
+ (pop EXPR)
+ (SETQ LOOPCOND (GLPREDICATE (LIST LOOPVAR (CADR DTYPE))
+ NEWCONTEXT T T))))
+ (COND ((AND EXPR (MEMQ (CAR EXPR)
+ '(when When WHEN)))
+ (pop EXPR)
+ (SETQ LOOPCOND (GLANDFN LOOPCOND (GLDOEXPR NIL NEWCONTEXT T)))))
+ (COND ((MEMQ (CAR EXPR)
+ '(collect Collect COLLECT))
+ (pop EXPR)
+ (SETQ COLLECTCODE (GLDOEXPR NIL NEWCONTEXT T)))
+ (T (COND ((MEMQ (CAR EXPR)
+ '(DO Do do))
+ (pop EXPR)))
+ (SETQ LOOPCONTENTS (CAR (GLPROGN EXPR NEWCONTEXT)))))
+ (RETURN (GLMAKEFORLOOP LOOPVAR DOMAIN LOOPCONTENTS LOOPCOND COLLECTCODE))
+ X
+ (RETURN (GLUSERFN ORIGEXPR))))
+
+
+% GSN 26-JAN-83 10:14
+% Compile a functional expression. TYPES is a list of argument types
+% which is sent in from outside, e.g. when a mapping function is
+% compiled.
+(DE GLDOFUNCTION (EXPR ARGTYPES CONTEXT VALBUSY)
+(PROG (NEWCODE RESULTTYPE PTR ARGS)
+ (COND ((NOT (AND (PAIRP EXPR)
+ (MEMQ (CAR EXPR)
+ ''FUNCTION)))
+ (RETURN (GLPUSHEXPR EXPR T CONTEXT T)))
+ ((ATOM (CADR EXPR))
+ (RETURN (LIST EXPR (GLRESULTTYPE (CADR EXPR)
+ ARGTYPES))))
+ ((NOT (MEMQ (CAADR EXPR)
+ '(GLAMBDA LAMBDA)))
+ (GLERROR 'GLDOFUNCTION
+ (LIST "Bad functional form."))))
+ (SETQ CONTEXT (CONS NIL CONTEXT))
+ (SETQ ARGS (GLDECL (CADADR EXPR)
+ '(T NIL)
+ CONTEXT NIL NIL))
+ (SETQ PTR (REVERSIP (CAR CONTEXT)))
+ (RPLACA CONTEXT NIL)
+ LP
+ (COND ((NULL PTR)
+ (GO B)))
+ (GLADDSTR (CAAR PTR)
+ NIL
+ (OR (CADDAR PTR)
+ (CAR ARGTYPES))
+ CONTEXT)
+ (SETQ PTR (CDR PTR))
+ (SETQ ARGTYPES (CDR ARGTYPES))
+ (GO LP)
+ B
+ (SETQ NEWCODE (GLPROGN (CDDADR EXPR)
+ CONTEXT))
+ (RETURN (LIST (LIST 'FUNCTION
+ (CONS 'LAMBDA
+ (CONS ARGS (CAR NEWCODE))))
+ (CADR NEWCODE)))))
+
+
+% edited: 4-MAY-82 10:46
+% Process an IF ... THEN expression.
+(DE GLDOIF (EXPR CONTEXT)
+(PROG (PRED ACTIONS CONDLIST TYPE TMP OLDCONTEXT)
+ (SETQ OLDCONTEXT CONTEXT)
+ (pop EXPR)
+ A
+ (COND ((NULL EXPR)
+ (RETURN (LIST (CONS 'COND
+ CONDLIST)
+ TYPE))))
+ (SETQ CONTEXT (CONS NIL OLDCONTEXT))
+ (SETQ PRED (GLPREDICATE NIL CONTEXT NIL T))
+ (COND ((MEMQ (CAR EXPR)
+ '(THEN Then
+ then))
+ (pop EXPR)))
+ (SETQ ACTIONS (CONS (CAR PRED)
+ NIL))
+ (SETQ TYPE (CADR PRED))
+ C
+ (SETQ CONDLIST (ACONC CONDLIST ACTIONS))
+ B
+ (COND ((NULL EXPR)
+ (GO A))
+ ((MEMQ (CAR EXPR)
+ '(ELSEIF ElseIf Elseif elseIf
+ elseif))
+ (pop EXPR)
+ (GO A))
+ ((MEMQ (CAR EXPR)
+ '(ELSE Else
+ else))
+ (pop EXPR)
+ (SETQ ACTIONS (CONS T NIL))
+ (SETQ TYPE 'BOOLEAN)
+ (GO C))
+ ((SETQ TMP (GLDOEXPR NIL CONTEXT T))
+ (ACONC ACTIONS (CAR TMP))
+ (SETQ TYPE (CADR TMP))
+ (GO B))
+ (T (GLERROR 'GLDOIF
+ (LIST "IF statement contains bad code."))))))
+
+
+% edited: 16-DEC-81 15:47
+% Compile a LAMBDA expression for which the ARGTYPES are given.
+(DE GLDOLAMBDA (EXPR ARGTYPES CONTEXT)
+(PROG (ARGS NEWEXPR VALBUSY)
+ (SETQ ARGS (CADR EXPR))
+ (SETQ CONTEXT (CONS NIL CONTEXT))
+ LP
+ (COND (ARGS (GLADDSTR (CAR ARGS)
+ NIL
+ (CAR ARGTYPES)
+ CONTEXT)
+ (SETQ ARGS (CDR ARGS))
+ (SETQ ARGTYPES (CDR ARGTYPES))
+ (GO LP)))
+ (SETQ VALBUSY T)
+ (SETQ NEWEXPR (GLPROGN (CDDR EXPR)
+ CONTEXT))
+ (RETURN (LIST (CONS 'LAMBDA
+ (CONS (CADR EXPR)
+ (CAR NEWEXPR)))
+ (CADR NEWEXPR)))))
+
+
+% edited: 30-MAY-82 16:12
+% Get a domain specification from the EXPR. If SINGFLAG is set and the
+% top of EXPR is a simple atom, the atom is made plural and used as
+% a variable or field name.
+(DE GLDOMAIN (SINGFLAG)
+(PROG (NAME FIRST)
+ (COND ((MEMQ (CAR EXPR)
+ '(THE The the))
+ (SETQ FIRST (CAR EXPR))
+ (RETURN (GLPARSFLD NIL)))
+ ((ATOM (CAR EXPR))
+ (GLSEPINIT (CAR EXPR))
+ (COND ((EQ (SETQ NAME (GLSEPNXT))
+ (CAR EXPR))
+ (pop EXPR)
+ (SETQ DOMAINNAME NAME)
+ (RETURN (COND (SINGFLAG (COND ((MEMQ (CAR EXPR)
+ '(OF Of of))
+ (SETQ FIRST 'THE)
+ (SETQ EXPR
+ (CONS (GLPLURAL
+ NAME)
+ EXPR))
+ (GLPARSFLD NIL))
+ (T (GLIDNAME (GLPLURAL
+ NAME)
+ NIL))))
+ (T (GLIDNAME NAME NIL)))))
+ (T (GLSEPCLR)
+ (RETURN (GLDOEXPR NIL CONTEXT T)))))
+ (T (RETURN (GLDOEXPR NIL CONTEXT T))))))
+
+
+% edited: 29-DEC-82 14:50
+% Compile code for MAP functions. MAPs are treated specially so that
+% types can be propagated.
+(DE GLDOMAP (EXPR)
+(PROG (MAPFN MAPSET SETTYPE MAPCODE NEWCODE RESULTTYPE ITEMTYPE)
+ (SETQ MAPFN (CAR EXPR))
+ (SETQ EXPR (CDR EXPR))
+ (PROGN (SETQ MAPSET (GLDOEXPR NIL CONTEXT T))
+ (COND ((OR (NULL EXPR)
+ (CDR EXPR))
+ (GLERROR 'GLDOMAP
+ (LIST "Bad form of mapping function.")))
+ (T (SETQ MAPCODE (CAR EXPR)))))
+ (SETQ SETTYPE (GLXTRTYPEB (CADR MAPSET)))
+ (COND ((AND (PAIRP SETTYPE)
+ (EQ (CAR SETTYPE)
+ 'LISTOF))
+ (SETQ ITEMTYPE (CASEQ MAPFN ((MAP MAPLIST MAPCON)
+ SETTYPE)
+ ((MAPC MAPCAR MAPCONC MAPCAN)
+ (CADR SETTYPE))
+ (T (ERROR 0 NIL))))))
+ (SETQ NEWCODE (GLDOFUNCTION MAPCODE (LIST ITEMTYPE)
+ CONTEXT
+ (MEMQ MAPFN
+ '(MAPLIST MAPCON MAPCAR MAPCONC MAPCAN)
+ )))
+ (SETQ RESULTTYPE (CASEQ MAPFN ((MAP MAPC)
+ NIL)
+ ((MAPLIST MAPCON MAPCAR MAPCONC MAPCAN)
+ (LIST 'LISTOF
+ (CADR NEWCODE)))
+ (T (ERROR 0 NIL))))
+ (RETURN (LIST (GLGENCODE (LIST MAPFN (CAR MAPSET)
+ (CAR NEWCODE)))
+ RESULTTYPE))))
+
+
+% GSN 10-FEB-83 12:56
+% Attempt to compile code for the sending of a message to an object.
+% OBJECT is the destination, in the form (<code> <type>) , SELECTOR
+% is the message selector, and ARGS is a list of arguments of the
+% form (<code> <type>) . The result is of this form, or NIL if
+% failure.
+(DE GLDOMSG (OBJECT SELECTOR ARGS)
+(PROG (UNITREC TYPE TMP METHOD TRANS FETCHCODE)
+ (SETQ TYPE (GLXTRTYPE (CADR OBJECT)))
+ (COND ((SETQ METHOD (GLSTRPROP TYPE 'MSG
+ SELECTOR ARGS))
+ (RETURN (GLCOMPMSGL OBJECT 'MSG
+ METHOD ARGS CONTEXT)))
+ ((AND (SETQ UNITREC (GLUNIT? TYPE))
+ (SETQ TMP (ASSOC 'MSG
+ (CADDR UNITREC))))
+ (RETURN (APPLY (CDR TMP)
+ (LIST OBJECT SELECTOR ARGS))))
+ ((SETQ TRANS (GLTRANSPARENTTYPES (CADR OBJECT))))
+ ((AND (MEMQ TYPE '(NUMBER REAL INTEGER))
+ (MEMQ SELECTOR
+ '(+ - * / ^ > < >= <=))
+ ARGS
+ (NULL (CDR ARGS))
+ (MEMQ (GLXTRTYPE (CADAR ARGS))
+ '(NUMBER REAL INTEGER)))
+ (RETURN (GLREDUCEARITH SELECTOR OBJECT (CAR ARGS))))
+ (T (RETURN NIL)))
+
+% See if the message can be handled by a TRANSPARENT subobject.
+
+ B
+ (COND ((NULL TRANS)
+ (RETURN NIL))
+ ((SETQ TMP (GLDOMSG (LIST '*GL*
+ (GLXTRTYPE (CAR TRANS)))
+ SELECTOR ARGS))
+ (SETQ FETCHCODE (GLSTRFN (CAR TRANS)
+ (CADR OBJECT)
+ NIL))
+ (GLSTRVAL TMP (CAR FETCHCODE))
+ (GLSTRVAL TMP (CAR OBJECT))
+ (RETURN TMP))
+ ((SETQ TMP (CDR TMP))
+ (GO B)))))
+
+
+% GSN 26-JAN-83 10:14
+% edited: 17-Sep-81 14:01
+% Compile a PROG expression.
+(DE GLDOPROG (EXPR CONTEXT)
+(PROG (PROGLST NEWEXPR RESULT NEXTEXPR TMP RESULTTYPE)
+ (pop EXPR)
+ (SETQ CONTEXT (CONS NIL CONTEXT))
+ (SETQ PROGLST (GLDECL (pop EXPR)
+ '(NIL T)
+ CONTEXT NIL NIL))
+ (SETQ CONTEXT (CONS NIL CONTEXT))
+
+% Compile the contents of the PROG onto NEWEXPR
+
+
+% Compile the next expression in a PROG.
+
+ L
+ (COND ((NULL EXPR)
+ (GO X)))
+ (SETQ NEXTEXPR (pop EXPR))
+ (COND ((ATOM NEXTEXPR)
+ (SETQ NEWEXPR (CONS NEXTEXPR NEWEXPR))
+
+% *****
+
+
+% Set up the context for the label we just found.
+
+ (GO L))
+ ((NOT (PAIRP NEXTEXPR))
+ (GLERROR 'GLDOPROG
+ (LIST "PROG contains bad stuff:" NEXTEXPR))
+ (GO L))
+ ((EQ (CAR NEXTEXPR)
+ '*)
+ (SETQ NEWEXPR (CONS NEXTEXPR NEWEXPR))
+ (GO L)))
+ (COND ((SETQ TMP (GLPUSHEXPR NEXTEXPR T CONTEXT NIL))
+ (SETQ NEWEXPR (CONS (CAR TMP)
+ NEWEXPR))))
+ (GO L)
+ X
+ (SETQ RESULT (CONS 'PROG
+ (CONS PROGLST (REVERSIP NEWEXPR))))
+ (RETURN (LIST RESULT RESULTTYPE))))
+
+
+% edited: 5-NOV-81 14:31
+% Compile a PROGN in the source program.
+(DE GLDOPROGN (EXPR)
+(PROG (RES)
+ (SETQ RES (GLPROGN (CDR EXPR)
+ CONTEXT))
+ (RETURN (LIST (CONS (CAR EXPR)
+ (CAR RES))
+ (CADR RES)))))
+
+
+% edited: 25-JAN-82 17:34
+% Compile a PROG1, whose result is the value of its first argument.
+(DE GLDOPROG1 (EXPR CONTEXT)
+(PROG (RESULT TMP TYPE TYPEFLG)
+ (SETQ EXPR (CDR EXPR))
+ A
+ (COND ((NULL EXPR)
+ (RETURN (LIST (CONS 'PROG1
+ (REVERSIP RESULT))
+ TYPE)))
+ ((SETQ TMP (GLDOEXPR NIL CONTEXT (NOT TYPEFLG)))
+ (SETQ RESULT (CONS (CAR TMP)
+ RESULT))
+
+% Get the result type from the first item of the PROG1.
+
+ (COND ((NOT TYPEFLG)
+ (SETQ TYPE (CADR TMP))
+ (SETQ TYPEFLG T)))
+ (GO A))
+ (T (GLERROR 'GLDOPROG1
+ (LIST "PROG1 contains bad subexpression."))
+ (pop EXPR)
+ (GO A)))))
+
+
+% edited: 26-MAY-82 15:12
+(DE GLDOREPEAT (EXPR)
+(PROG
+ (ACTIONS TMP LABEL)
+ (pop EXPR)
+ A
+ (COND ((MEMQ (CAR EXPR)
+ '(UNTIL Until until))
+ (pop EXPR))
+ ((AND EXPR (SETQ TMP (GLDOEXPR NIL CONTEXT T)))
+ (SETQ ACTIONS (ACONC ACTIONS (CAR TMP)))
+ (GO A))
+ (EXPR (RETURN (GLERROR 'GLDOREPEAT
+ (LIST "REPEAT contains bad subexpression.")))))
+ (COND ((OR (NULL EXPR)
+ (NULL (SETQ TMP (GLPREDICATE NIL CONTEXT NIL NIL)))
+ EXPR)
+ (GLERROR 'GLDOREPEAT
+ (LIST "REPEAT contains no UNTIL or bad UNTIL clause"))
+ (SETQ TMP (LIST T 'BOOLEAN))))
+ (SETQ LABEL (GLMKLABEL))
+ (RETURN
+ (LIST (CONS 'PROG
+ (CONS NIL (CONS LABEL
+ (ACONC ACTIONS
+ (LIST 'COND
+ (LIST (GLBUILDNOT (CAR TMP))
+ (LIST 'GO
+ LABEL)))))))
+ NIL))))
+
+
+% edited: 7-Apr-81 11:49
+% Compile a RETURN, capturing the type of the result as a type of the
+% function result.
+(DE GLDORETURN (EXPR)
+(PROG (TMP)
+ (pop EXPR)
+ (COND ((NULL EXPR)
+ (GLADDRESULTTYPE NIL)
+ (RETURN '((RETURN)
+ NIL)))
+ (T (SETQ TMP (GLDOEXPR NIL CONTEXT T))
+ (GLADDRESULTTYPE (CADR TMP))
+ (RETURN (LIST (LIST 'RETURN
+ (CAR TMP))
+ (CADR TMP)))))))
+
+
+% edited: 26-AUG-82 09:30
+% Compile a SELECTQ. Special treatment is necessary in order to quote
+% the selectors implicitly.
+(DE GLDOSELECTQ (EXPR CONTEXT)
+(PROG (RESULT RESULTTYPE TYPEOK KEY TMP TMPB FN)
+ (SETQ FN (CAR EXPR))
+ (SETQ RESULT (LIST (CAR (GLPUSHEXPR (LIST (CADR EXPR))
+ NIL CONTEXT T))))
+ (SETQ TYPEOK T)
+ (SETQ EXPR (CDDR EXPR))
+
+% If the selection criterion is constant, do it directly.
+
+ (COND ((OR (SETQ KEY (NUMBERP (CAR RESULT)))
+ (AND (PAIRP (CAR RESULT))
+ (EQ (CAAR RESULT)
+ 'QUOTE)
+ (SETQ KEY (CADAR RESULT))))
+ (SETQ TMP (SOME EXPR (FUNCTION (LAMBDA (X)
+ (COND
+ ((ATOM (CAR X))
+ (EQUAL KEY (CAR X)))
+ ((PAIRP (CAR X))
+ (MEMBER KEY (CAR X)))
+ (T NIL))))))
+ (COND ((OR (NULL TMP)
+ (NULL (CDR TMP)))
+ (SETQ TMPB (GLPROGN (LASTPAIR EXPR)
+ CONTEXT)))
+ (T (SETQ TMPB (GLPROGN (CDAR TMP)
+ CONTEXT))))
+ (RETURN (LIST (CONS 'PROGN
+ (CAR TMPB))
+ (CADR TMPB)))))
+ A
+ (COND ((NULL EXPR)
+ (RETURN (LIST (GLGENCODE (CONS FN RESULT))
+ RESULTTYPE))))
+ (SETQ RESULT (ACONC RESULT (COND ((OR (CDR EXPR)
+ (EQ FN 'CASEQ))
+ (SETQ TMP (GLPROGN (CDAR EXPR)
+ CONTEXT))
+ (CONS (CAAR EXPR)
+ (CAR TMP)))
+ (T (SETQ TMP (GLDOEXPR NIL CONTEXT T))
+ (CAR TMP)))))
+ (COND (TYPEOK (COND ((NULL RESULTTYPE)
+ (SETQ RESULTTYPE (CADR TMP)))
+ ((EQUAL RESULTTYPE (CADR TMP)))
+ (T (SETQ TYPEOK NIL)
+ (SETQ RESULTTYPE NIL)))))
+ (SETQ EXPR (CDR EXPR))
+ (GO A)))
+
+
+% edited: 4-JUN-82 15:35
+% Compile code for the sending of a message to an object. The syntax
+% of the message expression is
+% (_ <object> <selector> <arg1>...<argn>) , where the _ may
+% optionally be SEND, Send, or send.
+(DE GLDOSEND (EXPRR)
+(PROG
+ (EXPR OBJECT SELECTOR ARGS TMP FNNAME)
+ (SETQ FNNAME (CAR EXPRR))
+ (SETQ EXPR (CDR EXPRR))
+ (SETQ OBJECT (GLPUSHEXPR (LIST (pop EXPR))
+ NIL CONTEXT T))
+ (SETQ SELECTOR (pop EXPR))
+ (COND ((OR (NULL SELECTOR)
+ (NOT (IDP SELECTOR)))
+ (RETURN (GLERROR 'GLDOSEND
+ (LIST SELECTOR "is an illegal message Selector.")))))
+
+% Collect arguments of the message, if any.
+
+ A
+ (COND
+ ((NULL EXPR)
+ (COND
+ ((SETQ TMP (GLDOMSG OBJECT SELECTOR ARGS))
+ (RETURN TMP))
+ (T
+
+% No message was defined, so just pass it through and hope one will be
+% defined by runtime.
+
+ (RETURN
+ (LIST (GLGENCODE
+ (CONS FNNAME (CONS (CAR OBJECT)
+ (CONS SELECTOR
+ (MAPCAR ARGS
+ (FUNCTION CAR))))))
+ (CADR OBJECT))))))
+ ((SETQ TMP (GLDOEXPR NIL CONTEXT T))
+ (SETQ ARGS (ACONC ARGS TMP))
+ (GO A))
+ (T (GLERROR 'GLDOSEND
+ (LIST "A message argument is bad."))))))
+
+
+% edited: 7-Apr-81 11:52
+% Compile a SETQ expression
+(DE GLDOSETQ (EXPR)
+(PROG (VAR)
+ (pop EXPR)
+ (SETQ VAR (pop EXPR))
+ (RETURN (GLDOVARSETQ VAR (GLDOEXPR NIL CONTEXT T)))))
+
+
+% edited: 20-MAY-82 15:13
+% Process a THE expression in a list.
+(DE GLDOTHE (EXPR)
+(PROG (RESULT)
+ (SETQ RESULT (GLTHE NIL))
+ (COND (EXPR (GLERROR 'GLDOTHE
+ (LIST "Stuff left over at end of The expression."
+ EXPR))))
+ (RETURN RESULT)))
+
+
+% edited: 20-MAY-82 15:16
+% Process a THE expression in a list.
+(DE GLDOTHOSE (EXPR)
+(PROG (RESULT)
+ (SETQ EXPR (CDR EXPR))
+ (SETQ RESULT (GLTHE T))
+ (COND (EXPR (GLERROR 'GLDOTHOSE
+ (LIST "Stuff left over at end of The expression."
+ EXPR))))
+ (RETURN RESULT)))
+
+
+% edited: 5-MAY-82 15:51
+% Compile code to do a SETQ of VAR to the RHS. If the type of VAR is
+% unknown, it is set to the type of RHS.
+(DE GLDOVARSETQ (VAR RHS)
+(PROG NIL (GLUPDATEVARTYPE VAR (CADR RHS))
+ (RETURN (LIST (LIST 'SETQ
+ VAR
+ (CAR RHS))
+ (CADR RHS)))))
+
+
+% edited: 4-MAY-82 10:46
+(DE GLDOWHILE (EXPR CONTEXT)
+(PROG (ACTIONS TMP LABEL)
+ (SETQ CONTEXT (CONS NIL CONTEXT))
+ (pop EXPR)
+ (SETQ ACTIONS (LIST (CAR (GLPREDICATE NIL CONTEXT NIL T))))
+ (COND ((MEMQ (CAR EXPR)
+ '(DO Do do))
+ (pop EXPR)))
+ A
+ (COND ((AND EXPR (SETQ TMP (GLDOEXPR NIL CONTEXT T)))
+ (SETQ ACTIONS (ACONC ACTIONS (CAR TMP)))
+ (GO A))
+ (EXPR (GLERROR 'GLDOWHILE
+ (LIST "Bad stuff in While statement:" EXPR))
+ (pop EXPR)
+ (GO A)))
+ (SETQ LABEL (GLMKLABEL))
+ (RETURN (LIST (LIST 'PROG
+ NIL LABEL (LIST 'COND
+ (ACONC ACTIONS (LIST 'GO
+ LABEL))))
+ NIL))))
+
+
+% edited: 23-DEC-82 10:47
+% Produce code to test the two sides for equality.
+(DE GLEQUALFN (LHS RHS)
+(PROG
+ (TMP LHSTP RHSTP)
+ (RETURN
+ (COND ((SETQ TMP (GLDOMSG LHS '=
+ (LIST RHS)))
+ TMP)
+ ((SETQ TMP (GLUSERSTROP LHS '=
+ RHS))
+ TMP)
+ (T (SETQ LHSTP (CADR LHS))
+ (SETQ RHSTP (CADR RHS))
+ (LIST (COND ((NULL (CAR RHS))
+ (LIST 'NULL
+ (CAR LHS)))
+ ((NULL (CAR LHS))
+ (LIST 'NULL
+ (CAR RHS)))
+ (T (GLGENCODE (LIST (COND
+ ((OR (EQ LHSTP 'INTEGER)
+ (EQ RHSTP 'INTEGER))
+ 'EQP)
+ ((OR (GLATOMTYPEP LHSTP)
+ (GLATOMTYPEP RHSTP))
+ 'EQ)
+ ((AND (EQ LHSTP 'STRING)
+ (EQ RHSTP 'STRING))
+ 'STREQUAL)
+ (T 'EQUAL))
+ (CAR LHS)
+ (CAR RHS)))))
+ 'BOOLEAN))))))
+
+
+% edited: 23-SEP-82 11:52
+(DF GLERR (ERREXP)
+(PRIN1 "Execution of GLISP error expression: ")(PRINT ERREXP)(ERROR 0 NIL))
+
+
+% GSN 26-JAN-83 13:42
+% Look through a structure to see if it involves evaluating other
+% structures to produce a concrete type.
+(DE GLEVALSTR (STR CONTEXT)
+(PROG (GLEVALSUBS)
+ (GLEVALSTRB STR)
+ (RETURN (COND (GLEVALSUBS (GLSUBLIS GLEVALSUBS STR))
+ (T STR)))))
+
+
+% GSN 30-JAN-83 15:34
+% Find places where substructures need to be evaluated and collect
+% substitutions for them.
+(DE GLEVALSTRB (STR)
+(PROG (TMP EXPR)
+ (COND ((ATOM STR)
+ (RETURN NIL))
+ ((NOT (PAIRP STR))
+ (ERROR 0 NIL))
+ ((EQ (CAR STR)
+ 'TYPEOF)
+ (SETQ EXPR (CDR STR))
+ (SETQ TMP (GLDOEXPR NIL CONTEXT T))
+ (COND ((CADR TMP)
+ (SETQ GLEVALSUBS (CONS (CONS STR (CADR TMP))
+ GLEVALSUBS)))
+ (T (GLERROR 'GLEVALSTRB
+ (LIST "The evaluated type" STR "was not found.")
+ )))
+ (RETURN NIL))
+ (T (MAPC (CDR STR)
+ (FUNCTION GLEVALSTRB))))))
+
+
+% GSN 27-JAN-83 13:56
+% If a PROGN occurs within a PROGN, expand it by splicing its contents
+% into the top-level list.
+(DE GLEXPANDPROGN (LST BUSY PROGFLG)
+(PROG (X Y)
+ (SETQ Y LST)
+ LP
+ (SETQ X (CDR Y))
+ (COND ((NULL X)
+ (RETURN LST))
+ ((NOT (PAIRP (CAR X)))
+
+% Eliminate non-busy atomic items.
+
+ (COND ((AND (NOT PROGFLG)
+ (OR (CDR X)
+ (NOT BUSY)))
+ (RPLACD Y (CDR X))
+ (GO LP))))
+ ((MEMQ (CAAR X)
+ '(PROGN PROG2))
+
+% Expand contained PROGNs in-line.
+
+ (COND ((CDDAR X)
+ (RPLACD (LASTPAIR (CAR X))
+ (CDR X))
+ (RPLACD X (CDDAR X))))
+ (RPLACA X (CADAR X)))
+ ((AND (EQ (CAAR X)
+ 'PROG)
+ (NULL (CADAR X))
+ (EVERY (CDDAR X)
+ (FUNCTION (LAMBDA (Y)
+ (NOT (ATOM Y)))))
+ (NOT (GLOCCURS 'RETURN
+ (CDDAR X))))
+
+% Expand contained simple PROGs.
+
+ (COND ((CDDDAR X)
+ (RPLACD (LASTPAIR (CAR X))
+ (CDR X))
+ (RPLACD X (CDDDAR X))))
+ (RPLACA X (CADDAR X))))
+ (SETQ Y (CDR Y))
+ (GO LP)))
+
+
+% edited: 9-JUN-82 12:55
+% Test if EXPR is expensive to compute.
+(DE GLEXPENSIVE? (EXPR)
+(COND ((ATOM EXPR)
+ NIL)
+ ((NOT (PAIRP EXPR))
+ (ERROR 0 NIL))
+ ((MEMQ (CAR EXPR)
+ '(CDR CDDR CDDDR CDDDDR CAR CAAR CADR CAADR CADDR CADDDR))
+ (GLEXPENSIVE? (CADR EXPR)))
+ ((AND (EQ (CAR EXPR)
+ 'PROG1)
+ (NULL (CDDR EXPR)))
+ (GLEXPENSIVE? (CADR EXPR)))
+ (T T)))
+
+
+% edited: 2-Jan-81 14:26
+% Find the first entry for variable VAR in the CONTEXT structure.
+(DE GLFINDVARINCTX (VAR CONTEXT)
+(AND CONTEXT (OR (ASSOC VAR (CAR CONTEXT))
+ (GLFINDVARINCTX VAR (CDR CONTEXT)))))
+
+
+% edited: 19-OCT-82 15:19
+% Generate code of the form X. The code generated by the compiler is
+% transformed, if necessary, for the output dialect.
+(DE GLGENCODE (X)
+(GLPSLTRANSFM X))
+
+
+% edited: 20-Mar-81 15:52
+% Get the value for the entry KEY from the a-list ALST. GETASSOC is
+% used so that the corresponding PUTASSOC can be generated by
+% GLPUTFN.
+(DE GLGETASSOC (KEY ALST)
+(PROG (TMP)
+ (RETURN (AND (SETQ TMP (ASSOC KEY ALST))
+ (CDR TMP)))))
+
+
+% edited: 30-AUG-82 10:25
+(DE GLGETCONSTDEF (ATM)
+(COND ((GET ATM 'GLISPCONSTANTFLG)
+ (LIST (KWOTE (GET ATM 'GLISPCONSTANTVAL))
+ (GET ATM 'GLISPCONSTANTTYPE)))
+ (T NIL)))
+
+
+% edited: 30-OCT-81 12:20
+% Get the GLISP object description for NAME for the file package.
+(DE GLGETDEF (NAME TYPE)
+(LIST 'GLDEFSTRQ
+ (CONS NAME (GET NAME 'GLSTRUCTURE))))
+
+
+% edited: 5-OCT-82 15:06
+% Find a way to retrieve the FIELD from the structure pointed to by
+% SOURCE (which may be a variable name, NIL, or a list (CODE DESCR))
+% relative to CONTEXT. The result is a list of code to get the field
+% and the structure description of the resulting field.
+(DE GLGETFIELD (SOURCE FIELD CONTEXT)
+(PROG (TMP CTXENTRY CTXLIST)
+ (COND ((NULL SOURCE)
+ (GO B))
+ ((ATOM SOURCE)
+ (COND ((SETQ CTXENTRY (GLFINDVARINCTX SOURCE CONTEXT))
+ (COND ((SETQ TMP (GLVALUE SOURCE FIELD (CADDR CTXENTRY)
+ NIL))
+ (RETURN TMP))
+ (T (GLERROR 'GLGETFIELD
+ (LIST "The property" FIELD
+ "cannot be found for"
+ SOURCE "whose type is"
+ (CADDR CTXENTRY))))))
+ ((SETQ TMP (GLGETFIELD NIL SOURCE CONTEXT))
+ (SETQ SOURCE TMP))
+ ((SETQ TMP (GLGETGLOBALDEF SOURCE))
+ (RETURN (GLGETFIELD TMP FIELD NIL)))
+ ((SETQ TMP (GLGETCONSTDEF SOURCE))
+ (RETURN (GLGETFIELD TMP FIELD NIL)))
+ (T (RETURN (GLERROR 'GLGETFIELD
+ (LIST "The name" SOURCE
+ "cannot be found.")))))))
+ (COND ((PAIRP SOURCE)
+ (COND ((SETQ TMP (GLVALUE (CAR SOURCE)
+ FIELD
+ (CADR SOURCE)
+ NIL))
+ (RETURN TMP))
+ (T (RETURN (GLERROR 'GLGETFIELD
+ (LIST "The property" FIELD
+ "cannot be found for type"
+ (CADR SOURCE)
+ "in"
+ (CAR SOURCE))))))))
+ B
+
+% No source is specified. Look for a source in the context.
+
+ (COND ((NULL CONTEXT)
+ (RETURN NIL)))
+ (SETQ CTXLIST (pop CONTEXT))
+ C
+ (COND ((NULL CTXLIST)
+ (GO B)))
+ (SETQ CTXENTRY (pop CTXLIST))
+ (COND ((EQ FIELD (CADR CTXENTRY))
+ (RETURN (LIST (CAR CTXENTRY)
+ (CADDR CTXENTRY))))
+ ((NULL (SETQ TMP (GLVALUE (CAR CTXENTRY)
+ FIELD
+ (CADDR CTXENTRY)
+ NIL)))
+ (GO C)))
+ (RETURN TMP)))
+
+
+% edited: 27-MAY-82 13:01
+% Call the appropriate function to compile code to get the indicator
+% (QUOTE IND') from the item whose description is DES, where DES
+% describes a unit in a unit package whose record is UNITREC.
+(DE GLGETFROMUNIT (UNITREC IND DES)
+(PROG (TMP)
+ (COND ((SETQ TMP (ASSOC 'GET
+ (CADDR UNITREC)))
+ (RETURN (APPLY (CDR TMP)
+ (LIST IND DES))))
+ (T (RETURN NIL)))))
+
+
+% edited: 23-APR-82 16:58
+(DE GLGETGLOBALDEF (ATM)
+(COND ((GET ATM 'GLISPGLOBALVAR)
+ (LIST ATM (GET ATM 'GLISPGLOBALVARTYPE)))
+ (T NIL)))
+
+
+% edited: 4-JUN-82 15:36
+% Get pairs of <field> = <value>, where the = and , are optional.
+(DE GLGETPAIRS (EXPR)
+(PROG (PROP VAL PAIRLIST)
+ A
+ (COND ((NULL EXPR)
+ (RETURN PAIRLIST))
+ ((NOT (ATOM (SETQ PROP (pop EXPR))))
+ (GLERROR 'GLGETPAIRS
+ (LIST PROP "is not a legal property name.")))
+ ((EQ PROP '!,)
+ (GO A)))
+ (COND ((MEMQ (CAR EXPR)
+ '(= _ :=))
+ (pop EXPR)))
+ (SETQ VAL (GLDOEXPR NIL CONTEXT T))
+ (SETQ PAIRLIST (ACONC PAIRLIST (CONS PROP VAL)))
+ (GO A)))
+
+
+% edited: 23-DEC-81 12:52
+(DE GLGETSTR (DES)
+(PROG (TYPE TMP)
+ (RETURN (AND (SETQ TYPE (GLXTRTYPE DES))
+ (ATOM TYPE)
+ (SETQ TMP (GET TYPE 'GLSTRUCTURE))
+ (CAR TMP)))))
+
+
+% edited: 28-NOV-82 15:10
+% Get the superclasses of CLASS.
+(DE GLGETSUPERS (CLASS)
+(LISTGET (CDR (GET CLASS 'GLSTRUCTURE))
+ 'SUPERS))
+
+
+% GSN 9-FEB-83 15:28
+% Get the type of an expression.
+(DE GLGETTYPEOF (TYPE)
+(PROG (TMP)
+ (COND ((SETQ TMP (GLPUSHEXPR (CDR TYPE)
+ NIL CONTEXT T))
+ (RETURN (CADR TMP))))))
+
+
+% edited: 21-MAY-82 17:01
+% Identify a given name as either a known variable name of as an
+% implicit field reference.
+(DE GLIDNAME (NAME DEFAULTFLG)
+(PROG (TMP)
+ (RETURN (COND ((ATOM NAME)
+ (COND ((NULL NAME)
+ (LIST NIL NIL))
+ ((IDP NAME)
+ (COND ((EQ NAME T)
+ (LIST NAME 'BOOLEAN))
+ ((SETQ TMP (GLVARTYPE NAME CONTEXT))
+ (LIST NAME (COND ((EQ TMP '*NIL*)
+ NIL)
+ (T TMP))))
+ ((GLGETFIELD NIL NAME CONTEXT))
+ ((SETQ TMP (GLIDTYPE NAME CONTEXT))
+ (LIST (CAR TMP)
+ (CADDR TMP)))
+ ((GLGETCONSTDEF NAME))
+ ((GLGETGLOBALDEF NAME))
+ (T (COND ((OR (NOT DEFAULTFLG)
+ GLCAUTIOUSFLG)
+ (GLERROR 'GLIDNAME
+ (LIST "The name" NAME
+ "cannot be found in this context."))))
+ (LIST NAME NIL))))
+ ((FIXP NAME)
+ (LIST NAME 'INTEGER))
+ ((FLOATP NAME)
+ (LIST NAME 'REAL))
+ (T (GLERROR 'GLIDNAME
+ (LIST NAME "is an illegal name.")))))
+ (T NAME)))))
+
+
+% edited: 27-MAY-82 13:02
+% Try to identify a name by either its referenced name or its type.
+(DE GLIDTYPE (NAME CONTEXT)
+(PROG (CTXLEVELS CTXLEVEL CTXENTRY)
+ (SETQ CTXLEVELS CONTEXT)
+ LPA
+ (COND ((NULL CTXLEVELS)
+ (RETURN NIL)))
+ (SETQ CTXLEVEL (pop CTXLEVELS))
+ LPB
+ (COND ((NULL CTXLEVEL)
+ (GO LPA)))
+ (SETQ CTXENTRY (CAR CTXLEVEL))
+ (SETQ CTXLEVEL (CDR CTXLEVEL))
+ (COND ((OR (EQ (CADR CTXENTRY)
+ NAME)
+ (EQ (CADDR CTXENTRY)
+ NAME)
+ (AND (PAIRP (CADDR CTXENTRY))
+ (GL-A-AN? (CAADDR CTXENTRY))
+ (EQ NAME (CADR (CADDR CTXENTRY)))))
+ (RETURN CTXENTRY)))
+ (GO LPB)))
+
+
+% GSN 4-MAR-83 11:57
+% Initialize things for GLISP
+(DE GLINIT NIL
+(PROG NIL
+ (SETQ GLSEPBITTBL
+ (MAKEBITTABLE '(: _ + - !' = ~ < > * / !, ^)))
+ (SETQ GLUNITPKGS NIL)
+ (SETQ GLSEPMINUS NIL)
+ (SETQ GLQUIETFLG NIL)
+ (SETQ GLSEPATOM NIL)
+ (SETQ GLSEPPTR 0)
+ (SETQ GLBREAKONERROR NIL)
+ (SETQ GLUSERSTRNAMES NIL)
+ (SETQ GLTYPESUSED NIL)
+ (SETQ GLLASTFNCOMPILED NIL)
+ (SETQ GLLASTSTREDITED NIL)
+ (SETQ GLCAUTIOUSFLG NIL)
+ (MAPC '(EQ NE EQUAL AND
+ OR NOT MEMQ ADD1 SUB1 EQN ASSOC PLUS MINUS TIMES SQRT EXPT
+ DIFFERENCE QUOTIENT GREATERP GEQ LESSP LEQ CAR CDR CAAR
+ CADR)
+ (FUNCTION (LAMBDA (X)
+ (PUT X 'GLEVALWHENCONST
+ T))))
+ (MAPC '(ADD1 SUB1 EQN PLUS MINUS TIMES SQRT EXPT DIFFERENCE QUOTIENT
+ GREATERP GEQ LESSP LEQ)
+ (FUNCTION (LAMBDA (X)
+ (PUT X 'GLARGSNUMBERP
+ T))))
+ (GLDEFFNRESULTTYPES '((NUMBER (PLUS MINUS DIFFERENCE TIMES EXPT QUOTIENT
+ REMAINDER MIN MAX ABS))
+ (INTEGER (LENGTH FIX ADD1 SUB1))
+ (REAL (SQRT LOG EXP SIN COS ATAN ARCSIN ARCCOS
+ ARCTAN ARCTAN2 FLOAT))
+ (BOOLEAN (ATOM NULL EQUAL MINUSP ZEROP GREATERP
+ LESSP NUMBERP FIXP FLOATP STRINGP
+ ARRAYP EQ NOT NULL BOUNDP))))
+ (GLDEFFNRESULTTYPES '((INTEGER (FLATSIZE FLATSIZE2))
+ (BOOLEAN (EQN NE PAIRP IDP UNBOUNDP))
+ (STRING (SUBSTRING CONCAT))))
+ (GLDEFFNRESULTTYPEFNS (APPEND '((CONS . GLLISTRESULTTYPEFN)
+ (LIST . GLLISTRESULTTYPEFN)
+ (NCONC . GLLISTRESULTTYPEFN))
+ '((PNTH . GLNTHRESULTTYPEFN))))
+ (GLDEFSYSSTRQ (STRING STRING PROP ((LENGTH ((ADD1 (SIZE self)))
+ RESULT INTEGER))
+ MSG
+ ((+ CONCAT RESULT STRING)))
+ (INTEGER INTEGER SUPERS (NUMBER))
+ (ATOM ATOM PROP ((PNAME ID2STRING RESULT STRING)))
+ (REAL REAL SUPERS (NUMBER)))))
+
+
+% edited: 26-JUL-82 17:07
+% Look up an instance function of an abstract function name which
+% takes arguments of the specified types.
+(DE GLINSTANCEFN (FNNAME ARGTYPES)
+(PROG (INSTANCES IARGS TMP)
+ (OR (SETQ INSTANCES (GET FNNAME 'GLINSTANCEFNS))
+ (RETURN NIL))
+
+% Get ultimate data types for arguments.
+
+ LP
+ (COND ((NULL INSTANCES)
+ (RETURN NIL)))
+ (SETQ IARGS (GET (CAAR INSTANCES)
+ 'GLARGUMENTTYPES))
+ (SETQ TMP ARGTYPES)
+
+% Match the ultimate types of each argument.
+
+ LPB
+ (COND ((NULL IARGS)
+ (RETURN (CAR INSTANCES)))
+ ((EQUAL (GLXTRTYPEB (CAR IARGS))
+ (GLXTRTYPEB (CAR TMP)))
+ (SETQ IARGS (CDR IARGS))
+ (SETQ TMP (CDR TMP))
+ (GO LPB)))
+ (SETQ INSTANCES (CDR INSTANCES))
+ (GO LP)))
+
+
+% GSN 3-FEB-83 14:13
+% Make a new name for an instance of a generic function.
+(DE GLINSTANCEFNNAME (FN)
+(PROG (INSTFN N)
+ (SETQ N (ADD1 (OR (GET FN 'GLINSTANCEFNNO)
+ 0)))
+ (PUT FN 'GLINSTANCEFNNO
+ N)
+ (SETQ INSTFN (IMPLODE (NCONC (EXPLODE FN)
+ (CONS '-
+ (EXPLODE N)))))
+ (PUT FN 'GLINSTANCEFNS
+ (CONS INSTFN (GET FN 'GLINSTANCEFNS)))
+ (RETURN INSTFN)))
+
+
+% edited: 30-AUG-82 10:28
+% Define compile-time constants.
+(DF GLISPCONSTANTS (ARGS)
+(PROG (TMP EXPR EXPRSTACK FAULTFN)
+ (MAPC ARGS (FUNCTION (LAMBDA (ARG)
+ (PUT (CAR ARG)
+ 'GLISPCONSTANTFLG
+ T)
+ (PUT (CAR ARG)
+ 'GLISPORIGCONSTVAL
+ (CADR ARG))
+ (PUT (CAR ARG)
+ 'GLISPCONSTANTVAL
+ (PROGN (SETQ EXPR (LIST (CADR ARG)))
+ (SETQ TMP (GLDOEXPR NIL NIL T))
+ (SET (CAR ARG)
+ (EVAL (CAR TMP)))))
+ (PUT (CAR ARG)
+ 'GLISPCONSTANTTYPE
+ (OR (CADDR ARG)
+ (CADR TMP))))))))
+
+
+% edited: 26-MAY-82 15:30
+% Define compile-time constants.
+(DF GLISPGLOBALS (ARGS)
+(MAPC ARGS (FUNCTION (LAMBDA (ARG)
+ (PUT (CAR ARG)
+ 'GLISPGLOBALVAR
+ T)
+ (PUT (CAR ARG)
+ 'GLISPGLOBALVARTYPE
+ (CADR ARG))))))
+
+
+% GSN 10-FEB-83 11:51
+% edited: 7-Jan-81 10:48
+% Define named structure descriptions. The descriptions are of the
+% form (<name> <description>) . Each description is put on the
+% property list of <name> as GLSTRUCTURE
+(DF GLISPOBJECTS (ARGS)
+(MAPC ARGS (FUNCTION (LAMBDA (ARG)
+ (GLDEFSTR ARG NIL)))))
+
+
+% GSN 4-MAR-83 13:53
+% Test the word ADJ to see if it is a LISP adjective. If so, return
+% the CONS of the name of the function to test it and the type of
+% the result.
+(DE GLLISPADJ (ADJ)
+(PROG (TMP)
+ (RETURN (AND (SETQ TMP (ASSOC (GLUCASE ADJ)
+ '((ATOMIC ATOM ATOM)
+ (NULL NULL NIL)
+ (NIL NULL NIL)
+ (INTEGER FIXP INTEGER)
+ (REAL FLOATP REAL)
+ (BOUND BOUNDP ATOM)
+ (ZERO ZEROP NUMBER)
+ (NUMERIC NUMBERP NUMBER)
+ (NEGATIVE MINUSP NUMBER)
+ (MINUS MINUSP NUMBER))))
+ (CDR TMP)))))
+
+
+% GSN 4-MAR-83 13:54
+% Test to see if ISAWORD is a LISP ISA word. If so, return the CONS of
+% the name of the function to test for it and the type of the result
+% if true.
+(DE GLLISPISA (ISAWORD)
+(PROG (TMP)
+ (COND ((SETQ TMP (ASSOC (GLUCASE ISAWORD)
+ '((ATOM ATOM ATOM)
+ (LIST LISTP (LISTOF ANYTHING))
+ (NUMBER NUMBERP NUMBER)
+ (INTEGER FIXP INTEGER)
+ (SYMBOL LITATOM ATOM)
+ (ARRAY ARRAYP ARRAY)
+ (STRING STRINGP STRING)
+ (BIGNUM BIGP BIGNUM)
+ (LITATOM LITATOM ATOM))))
+ (RETURN (CDR TMP))))))
+
+
+% edited: 12-NOV-82 10:53
+% Compute result types for Lisp functions.
+(DE GLLISTRESULTTYPEFN (FN ARGTYPES)
+(PROG (ARG1 ARG2)
+ (SETQ ARG1 (GLXTRTYPE (CAR ARGTYPES)))
+ (COND ((CDR ARGTYPES)
+ (SETQ ARG2 (GLXTRTYPE (CADR ARGTYPES)))))
+ (RETURN (CASEQ FN (CONS (OR (AND (PAIRP ARG2)
+ (COND ((EQ (CAR ARG2)
+ 'LIST)
+ (CONS 'LIST
+ (CONS ARG1 (CDR ARG2))))
+ ((AND (EQ (CAR ARG2)
+ 'LISTOF)
+ (EQUAL ARG1 (CADR ARG2)))
+ ARG2)))
+ (LIST FN ARGTYPES)))
+ (NCONC (COND ((EQUAL ARG1 ARG2)
+ ARG1)
+ ((AND (PAIRP ARG1)
+ (PAIRP ARG2)
+ (EQ (CAR ARG1)
+ 'LISTOF)
+ (EQ (CAR ARG2)
+ 'LIST)
+ (NULL (CDDR ARG2))
+ (EQUAL (CADR ARG1)
+ (CADR ARG2)))
+ ARG1)
+ (T (OR ARG1 ARG2))))
+ (LIST (CONS FN (MAPCAR ARGTYPES (FUNCTION GLXTRTYPE))))
+ (T (ERROR 0 NIL))))))
+
+
+% GSN 11-JAN-83 14:05
+% Create a function call to retrieve the field IND from a LIST
+% structure.
+(DE GLLISTSTRFN (IND DES DESLIST)
+(PROG (TMP N FNLST)
+ (SETQ N 1)
+ (SETQ FNLST '((CAR *GL*)
+ (CADR *GL*)
+ (CADDR *GL*)
+ (CADDDR *GL*)))
+ (COND ((EQ (CAR DES)
+ 'LISTOBJECT)
+ (SETQ N (ADD1 N))
+ (SETQ FNLST (CDR FNLST))))
+ C
+ (pop DES)
+ (COND ((NULL DES)
+ (RETURN NIL))
+ ((NOT (PAIRP (CAR DES))))
+ ((SETQ TMP (GLSTRFN IND (CAR DES)
+ DESLIST))
+ (RETURN (GLSTRVAL TMP (COND
+ (FNLST (COPY (CAR FNLST)))
+ (T (LIST 'CAR
+ (GLGENCODE (LIST 'NTH
+ '*GL*
+ N)))))))))
+ (SETQ N (ADD1 N))
+ (AND FNLST (SETQ FNLST (CDR FNLST)))
+ (GO C)))
+
+
+% edited: 24-AUG-82 17:36
+% Compile code for a FOR loop.
+(DE GLMAKEFORLOOP (LOOPVAR DOMAIN LOOPCONTENTS LOOPCOND COLLECTCODE)
+(COND
+ ((NULL COLLECTCODE)
+ (LIST (GLGENCODE (LIST 'MAPC
+ (CAR DOMAIN)
+ (LIST 'FUNCTION
+ (LIST 'LAMBDA
+ (LIST LOOPVAR)
+ (COND (LOOPCOND
+ (LIST 'COND
+ (CONS (CAR LOOPCOND)
+ LOOPCONTENTS)))
+ ((NULL (CDR LOOPCONTENTS))
+ (CAR LOOPCONTENTS))
+ (T (CONS 'PROGN
+ LOOPCONTENTS)))))))
+ NIL))
+ (T (LIST (COND
+ (LOOPCOND (GLGENCODE
+ (LIST 'MAPCONC
+ (CAR DOMAIN)
+ (LIST 'FUNCTION
+ (LIST 'LAMBDA
+ (LIST LOOPVAR)
+ (LIST 'AND
+ (CAR LOOPCOND)
+ (LIST 'CONS
+ (CAR COLLECTCODE)
+ NIL)))))))
+ ((AND (PAIRP (CAR COLLECTCODE))
+ (ATOM (CAAR COLLECTCODE))
+ (CDAR COLLECTCODE)
+ (EQ (CADAR COLLECTCODE)
+ LOOPVAR)
+ (NULL (CDDAR COLLECTCODE)))
+ (GLGENCODE (LIST 'MAPCAR
+ (CAR DOMAIN)
+ (LIST 'FUNCTION
+ (CAAR COLLECTCODE)))))
+ (T (GLGENCODE (LIST 'MAPCAR
+ (CAR DOMAIN)
+ (LIST 'FUNCTION
+ (LIST 'LAMBDA
+ (LIST LOOPVAR)
+ (CAR COLLECTCODE)))))))
+ (LIST 'LISTOF
+ (CADR COLLECTCODE))))))
+
+
+% GSN 1-MAR-83 11:36
+% Compile code to create a structure in response to a statement
+% (A <structure> WITH <field> = <value> ...)
+(DE GLMAKESTR (TYPE EXPR)
+(PROG (PAIRLIST STRDES)
+ (COND ((MEMQ (CAR EXPR)
+ '(WITH With with))
+ (pop EXPR)))
+ (COND ((NULL (SETQ STRDES (GLGETSTR TYPE)))
+ (GLERROR 'GLMAKESTR
+ (LIST "The type name" TYPE "is not defined."))))
+ (COND ((EQ (CAR STRDES)
+ 'LISTOF)
+ (RETURN (LIST (CONS 'LIST
+ (MAPCAR EXPR (FUNCTION (LAMBDA (EXPR)
+ (GLDOEXPR NIL
+ CONTEXT T)))
+ ))
+ TYPE))))
+ (SETQ PAIRLIST (GLGETPAIRS EXPR))
+ (RETURN (LIST (GLBUILDSTR STRDES PAIRLIST (LIST TYPE))
+ TYPE))))
+
+
+% GSN 3-FEB-83 12:12
+% Make a virtual type for a view of the original type.
+(DE GLMAKEVTYPE (ORIGTYPE VLIST)
+(PROG (SUPER PL PNAME TMP VTYPE)
+ (SETQ SUPER (CADR VLIST))
+ (SETQ VLIST (CDDR VLIST))
+ (COND ((MEMQ (CAR VLIST)
+ '(with With WITH))
+ (SETQ VLIST (CDR VLIST))))
+ LP
+ (COND ((NULL VLIST)
+ (GO OUT)))
+ (SETQ PNAME (CAR VLIST))
+ (SETQ VLIST (CDR VLIST))
+ (COND ((EQ (CAR VLIST)
+ '=)
+ (SETQ VLIST (CDR VLIST))))
+ (SETQ TMP NIL)
+ LPB
+ (COND ((OR (NULL VLIST)
+ (EQ (CAR VLIST)
+ '!,)
+ (AND (ATOM (CAR VLIST))
+ (CDR VLIST)
+ (EQ (CADR VLIST)
+ '=)))
+ (SETQ PL (CONS (LIST PNAME (REVERSIP TMP))
+ PL))
+ (COND ((AND VLIST (EQ (CAR VLIST)
+ '!,))
+ (SETQ VLIST (CDR VLIST))))
+ (GO LP)))
+ (SETQ TMP (CONS (CAR VLIST)
+ TMP))
+ (SETQ VLIST (CDR VLIST))
+ (GO LPB)
+ OUT
+ (SETQ VTYPE (GLMKVTYPE))
+ (PUT VTYPE 'GLSTRUCTURE
+ (LIST (LIST 'TRANSPARENT
+ ORIGTYPE)
+ 'PROP
+ PL
+ 'SUPERS
+ (LIST SUPER)))
+ (RETURN VTYPE)))
+
+
+% GSN 25-FEB-83 16:08
+% Test whether an item of type TNEW could be stored into a slot of
+% type TINTO.
+(DE GLMATCH (TNEW TINTO)
+(PROG (TMP RES)
+ (RETURN (COND ((OR (EQ TNEW TINTO)
+ (NULL TINTO)
+ (EQ TINTO 'ANYTHING)
+ (AND (MEMQ TNEW '(INTEGER REAL NUMBER))
+ (MEMQ TINTO '(NUMBER ATOM)))
+ (AND (EQ TNEW 'ATOM)
+ (PAIRP TINTO)
+ (EQ (CAR TINTO)
+ 'ATOM)))
+ TNEW)
+ ((AND (SETQ TMP (GLXTRTYPEC TNEW))
+ (SETQ RES (GLMATCH TMP TINTO)))
+ RES)
+ ((AND (SETQ TMP (GLXTRTYPEC TINTO))
+ (SETQ RES (GLMATCH TNEW TMP)))
+ RES)
+ (T NIL)))))
+
+
+% GSN 25-FEB-83 16:03
+% Test whether two types match as an element type and a list type. The
+% result is the resulting element type.
+(DE GLMATCHL (TELEM TLIST)
+(PROG (TMP RES)
+ (RETURN (COND ((AND (PAIRP TLIST)
+ (EQ (CAR TLIST)
+ 'LISTOF)
+ (GLMATCH TELEM (CADR TLIST)))
+ TELEM)
+ ((AND (SETQ TMP (GLXTRTYPEC TLIST))
+ (SETQ RES (GLMATCHL TELEM TMP))))
+ (T NIL)))))
+
+
+% edited: 26-MAY-82 15:33
+% Construct the NOT of the argument LHS.
+(DE GLMINUSFN (LHS)
+(OR (GLDOMSG LHS 'MINUS
+ NIL)
+ (GLUSERSTROP LHS 'MINUS
+ NIL)
+ (LIST (GLGENCODE (COND ((NUMBERP (CAR LHS))
+ (MINUS (CAR LHS)))
+ ((EQ (GLXTRTYPE (CADR LHS))
+ 'INTEGER)
+ (LIST 'IMINUS
+ (CAR LHS)))
+ (T (LIST 'MINUS
+ (CAR LHS)))))
+ (CADR LHS))))
+
+
+% edited: 11-NOV-82 11:54
+% Make a variable name for GLCOMP functions.
+(DE GLMKATOM (NAME)
+(PROG (N NEWATOM)
+ LP
+ (PUT NAME 'GLISPATOMNUMBER
+ (SETQ N (ADD1 (OR (GET NAME 'GLISPATOMNUMBER)
+ 0))))
+ (SETQ NEWATOM (IMPLODE (APPEND (EXPLODE NAME)
+ (EXPLODE N))))
+
+% If an atom with this name has something on its proplist, try again.
+
+ (COND ((PROP NEWATOM)
+ (GO LP))
+ (T (RETURN NEWATOM)))))
+
+
+% edited: 27-MAY-82 11:02
+% Make a variable name for GLCOMP functions.
+(DE GLMKLABEL NIL
+(PROG NIL (SETQ GLNATOM (ADD1 GLNATOM))
+ (RETURN (IMPLODE (APPEND '(G L L A B E L)
+ (EXPLODE GLNATOM))))))
+
+
+% edited: 27-MAY-82 11:04
+% Make a variable name for GLCOMP functions.
+(DE GLMKVAR NIL
+(PROG NIL (SETQ GLNATOM (ADD1 GLNATOM))
+ (RETURN (IMPLODE (APPEND '(G L V A R)
+ (EXPLODE GLNATOM))))))
+
+
+% edited: 18-NOV-82 11:58
+% Make a virtual type name for GLCOMP functions.
+(DE GLMKVTYPE NIL
+(GLMKATOM 'GLVIRTUALTYPE))
+
+
+% GSN 25-JAN-83 16:47
+% edited: 2-Jun-81 14:18
+% Produce a function to implement the _+ operator. Code is produced to
+% append the right-hand side to the left-hand side. Note: parts of
+% the structure provided are used multiple times.
+(DE GLNCONCFN (LHS RHS)
+(PROG (LHSCODE LHSDES NCCODE TMP STR)
+ (SETQ LHSCODE (CAR LHS))
+ (SETQ LHSDES (GLXTRTYPE (CADR LHS)))
+ (COND ((EQ LHSDES 'INTEGER)
+ (COND ((EQN (CAR RHS)
+ 1)
+ (SETQ NCCODE (LIST 'ADD1
+ LHSCODE)))
+ ((OR (FIXP (CAR RHS))
+ (EQ (CADR RHS)
+ 'INTEGER))
+ (SETQ NCCODE (LIST 'IPLUS
+ LHSCODE
+ (CAR RHS))))
+ (T (SETQ NCCODE (LIST 'PLUS
+ LHSCODE
+ (CAR RHS))))))
+ ((OR (EQ LHSDES 'NUMBER)
+ (EQ LHSDES 'REAL))
+ (SETQ NCCODE (LIST 'PLUS
+ LHSCODE
+ (CAR RHS))))
+ ((EQ LHSDES 'BOOLEAN)
+ (SETQ NCCODE (LIST 'OR
+ LHSCODE
+ (CAR RHS))))
+ ((NULL LHSDES)
+ (SETQ NCCODE (LIST 'NCONC1
+ LHSCODE
+ (CAR RHS)))
+ (COND ((AND (ATOM LHSCODE)
+ (CADR RHS))
+ (GLUPDATEVARTYPE LHSCODE (LIST 'LISTOF
+ (CADR RHS))))))
+ ((AND (PAIRP LHSDES)
+ (EQ (CAR LHSDES)
+ 'LISTOF)
+ (NOT (EQUAL LHSDES (CADR RHS))))
+ (SETQ NCCODE (LIST 'NCONC1
+ LHSCODE
+ (CAR RHS))))
+ ((SETQ TMP (GLUNITOP LHS RHS 'NCONC))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '_+
+ (LIST RHS)))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '+
+ (LIST RHS)))
+ (SETQ NCCODE (CAR TMP)))
+ ((AND (SETQ STR (GLGETSTR LHSDES))
+ (SETQ TMP (GLNCONCFN (LIST (CAR LHS)
+ STR)
+ RHS)))
+ (RETURN (LIST (CAR TMP)
+ (CADR LHS))))
+ ((SETQ TMP (GLUSERSTROP LHS '_+
+ RHS))
+ (RETURN TMP))
+ ((SETQ TMP (GLREDUCEARITH '+
+ LHS RHS))
+ (SETQ NCCODE (CAR TMP)))
+ (T (RETURN NIL)))
+ (RETURN (GLPUTFN LHS (LIST (GLGENCODE NCCODE)
+ LHSDES)
+ T))))
+
+
+% edited: 23-DEC-82 10:49
+% Produce code to test the two sides for inequality.
+(DE GLNEQUALFN (LHS RHS)
+(PROG (TMP)
+ (COND ((SETQ TMP (GLDOMSG LHS '~=
+ (LIST RHS)))
+ (RETURN TMP))
+ ((SETQ TMP (GLUSERSTROP LHS '~=
+ RHS))
+ (RETURN TMP))
+ ((OR (GLATOMTYPEP (CADR LHS))
+ (GLATOMTYPEP (CADR RHS)))
+ (RETURN (LIST (GLGENCODE (LIST 'NEQ
+ (CAR LHS)
+ (CAR RHS)))
+ 'BOOLEAN)))
+ (T (RETURN (LIST (GLGENCODE (LIST 'NOT
+ (CAR (GLEQUALFN LHS RHS))))
+ 'BOOLEAN))))))
+
+
+% GSN 7-MAR-83 16:55
+% If SOURCE represents a variable name, add the TYPE of SOURCE to the
+% CONTEXT.
+(DE GLNOTESOURCETYPE (SOURCE TYPE ADDISATYPE)
+(PROG (TMP)
+ (RETURN (COND (ADDISATYPE (COND ((ATOM (CAR SOURCE))
+ (GLADDSTR (CAR SOURCE)
+ NIL TYPE CONTEXT))
+ ((AND (PAIRP (CAR SOURCE))
+ (MEMQ (CAAR SOURCE)
+ '(SETQ PROG1))
+ (ATOM (CADAR SOURCE)))
+ (GLADDSTR (CADAR SOURCE)
+ (COND ((SETQ
+ TMP
+ (GLFINDVARINCTX
+ (CAR SOURCE)
+ CONTEXT))
+ (CADR TMP)))
+ TYPE CONTEXT))))))))
+
+
+% edited: 3-MAY-82 14:35
+% Construct the NOT of the argument LHS.
+(DE GLNOTFN (LHS)
+(OR (GLDOMSG LHS '~
+ NIL)
+ (GLUSERSTROP LHS '~
+ NIL)
+ (LIST (GLBUILDNOT (CAR LHS))
+ 'BOOLEAN)))
+
+
+% GSN 28-JAN-83 09:39
+% Add TYPE to the global variable GLTYPESUSED if not already there.
+(DE GLNOTICETYPE (TYPE)
+(COND ((NOT (MEMQ TYPE GLTYPESUSED))
+ (SETQ GLTYPESUSED (CONS TYPE GLTYPESUSED)))))
+
+
+% edited: 23-JUN-82 14:31
+% Compute the result type for the function NTH.
+(DE GLNTHRESULTTYPEFN (FN ARGTYPES)
+(PROG (TMP)
+ (RETURN (COND ((AND (PAIRP (SETQ TMP (GLXTRTYPE (CAR ARGTYPES))))
+ (EQ (CAR TMP)
+ 'LISTOF))
+ (CAR ARGTYPES))
+ (T NIL)))))
+
+
+% edited: 3-JUN-82 11:02
+% See if X occurs in STR, using EQ.
+(DE GLOCCURS (X STR)
+(COND ((EQ X STR)
+ T)
+ ((NOT (PAIRP STR))
+ NIL)
+ (T (OR (GLOCCURS X (CAR STR))
+ (GLOCCURS X (CDR STR))))))
+
+
+% GSN 30-JAN-83 15:35
+% Check a structure description for legality.
+(DE GLOKSTR? (STR)
+(COND ((NULL STR)
+ NIL)
+ ((ATOM STR)
+ T)
+ ((AND (PAIRP STR)
+ (ATOM (CAR STR)))
+ (CASEQ (CAR STR)
+ ((A AN a an An)
+ (COND ((CDDR STR)
+ NIL)
+ ((OR (GLGETSTR (CADR STR))
+ (GLUNIT? (CADR STR))
+ (COND (GLCAUTIOUSFLG (PRIN1 "The structure ")
+ (PRIN1 (CADR STR))
+ (PRIN1
+ " is not currently defined. Accepted.")
+ (TERPRI)
+ T)
+ (T T))))))
+ (CONS (AND (CDR STR)
+ (CDDR STR)
+ (NULL (CDDDR STR))
+ (GLOKSTR? (CADR STR))
+ (GLOKSTR? (CADDR STR))))
+ ((LIST OBJECT ATOMOBJECT LISTOBJECT)
+ (AND (CDR STR)
+ (EVERY (CDR STR)
+ (FUNCTION GLOKSTR?))))
+ (RECORD (COND ((AND (CDR STR)
+ (ATOM (CADR STR)))
+ (pop STR)))
+ (AND (CDR STR)
+ (EVERY (CDR STR)
+ (FUNCTION (LAMBDA (X)
+ (AND (ATOM (CAR X))
+ (GLOKSTR? (CADR X))))))))
+ (LISTOF (AND (CDR STR)
+ (NULL (CDDR STR))
+ (GLOKSTR? (CADR STR))))
+ ((ALIST PROPLIST)
+ (AND (CDR STR)
+ (EVERY (CDR STR)
+ (FUNCTION (LAMBDA (X)
+ (AND (ATOM (CAR X))
+ (GLOKSTR? (CADR X))))))))
+ (ATOM (GLATMSTR? STR))
+ (TYPEOF T)
+ (T (COND ((AND (CDR STR)
+ (NULL (CDDR STR)))
+ (GLOKSTR? (CADR STR)))
+ ((ASSOC (CAR STR)
+ GLUSERSTRNAMES))
+ (T NIL)))))
+ (T NIL)))
+
+
+% edited: 30-DEC-81 16:41
+% Get the next operand from the input list, EXPR (global) . The
+% operand may be an atom (possibly containing operators) or a list.
+(DE GLOPERAND NIL
+(PROG NIL (COND ((SETQ FIRST (GLSEPNXT))
+ (RETURN (GLPARSNFLD)))
+ ((NULL EXPR)
+ (RETURN NIL))
+ ((STRINGP (CAR EXPR))
+ (RETURN (LIST (pop EXPR)
+ 'STRING)))
+ ((ATOM (CAR EXPR))
+ (GLSEPINIT (pop EXPR))
+ (SETQ FIRST (GLSEPNXT))
+ (RETURN (GLPARSNFLD)))
+ (T (RETURN (GLPUSHEXPR (pop EXPR)
+ T CONTEXT T))))))
+
+
+% GSN 4-MAR-83 14:26
+% Test if an atom is a GLISP operator
+(DE GLOPERATOR? (ATM)
+(MEMQ ATM
+ '(_ := __ + - * / > < >=
+ <= ^ _+
+ +_ _-
+ -_ = ~= <> AND And and OR Or or __+
+ __-
+ _+_)))
+
+
+% edited: 26-DEC-82 15:48
+% OR operator
+(DE GLORFN (LHS RHS)
+(COND ((AND (PAIRP (CADR LHS))
+ (EQ (CAADR LHS)
+ 'LISTOF)
+ (EQUAL (CADR LHS)
+ (CADR RHS)))
+ (LIST (LIST 'UNION
+ (CAR LHS)
+ (CAR RHS))
+ (CADR LHS)))
+ ((GLDOMSG LHS 'OR
+ (LIST RHS)))
+ ((GLUSERSTROP LHS 'OR
+ RHS))
+ (T (LIST (LIST 'OR
+ (CAR LHS)
+ (CAR RHS))
+ (COND ((EQUAL (GLXTRTYPE (CADR LHS))
+ (GLXTRTYPE (CADR RHS)))
+ (CADR LHS))
+ (T NIL))))))
+
+
+% GSN 10-FEB-83 16:13
+% Remove unwanted system properties from LST for making an output
+% file.
+(DE GLOUTPUTFILTER (PROPTYPE LST)
+(COND
+ ((MEMQ PROPTYPE '(PROP ADJ ISA MSG))
+ (MAPCAN
+ LST
+ (FUNCTION
+ (LAMBDA (L)
+ (COND
+ ((LISTGET (CDDR L)
+ 'SPECIALIZATION)
+ NIL)
+ (T (LIST (CONS (CAR L)
+ (CONS (CADR L)
+ (MAPCON (CDDR L)
+ (FUNCTION (LAMBDA (PAIR)
+ (COND
+ ((MEMQ (CAR PAIR)
+ '(VTYPE))
+ NIL)
+ (T (LIST (CAR PAIR)
+ (CADR PAIR))))))
+ (FUNCTION CDDR)))))))))))
+ (T LST)))
+
+
+% edited: 22-SEP-82 17:16
+% Subroutine of GLDOEXPR to parse a GLISP expression containing field
+% specifications and/or operators. The global variable EXPR is used,
+% and is modified to reflect the amount of the expression which has
+% been parsed.
+(DE GLPARSEXPR NIL
+(PROG (OPNDS OPERS FIRST LHSP RHSP)
+
+% Get the initial part of the expression, i.e., variable or field
+% specification.
+
+ L
+ (SETQ OPNDS (CONS (GLOPERAND)
+ OPNDS))
+ M
+ (COND ((NULL FIRST)
+ (COND ((OR (NULL EXPR)
+ (NOT (ATOM (CAR EXPR))))
+ (GO B)))
+ (GLSEPINIT (CAR EXPR))
+ (COND
+ ((GLOPERATOR? (SETQ FIRST (GLSEPNXT)))
+ (pop EXPR)
+ (GO A))
+ ((MEMQ FIRST '(IS Is is HAS Has has))
+ (COND
+ ((AND OPERS (GREATERP (GLPREC (CAR OPERS))
+ 5))
+ (GLREDUCE)
+ (SETQ FIRST NIL)
+ (GO M))
+ (T (SETQ OPNDS
+ (CONS (GLPREDICATE
+ (pop OPNDS)
+ CONTEXT T
+ (AND (NOT (UNBOUNDP 'ADDISATYPE))
+ ADDISATYPE))
+ OPNDS))
+ (SETQ FIRST NIL)
+ (GO M))))
+ (T (GLSEPCLR)
+ (GO B))))
+ ((GLOPERATOR? FIRST)
+ (GO A))
+ (T (GLERROR 'GLPARSEXPR
+ (LIST FIRST
+ "appears illegally or cannot be interpreted."))))
+
+% FIRST now contains an operator
+
+ A
+
+% While top operator < top of stack in precedence, reduce.
+
+ (COND ((NOT (OR (NULL OPERS)
+ (LESSP (SETQ LHSP (GLPREC (CAR OPERS)))
+ (SETQ RHSP (GLPREC FIRST)))
+ (AND (EQN LHSP RHSP)
+ (MEMQ FIRST '(_ ^ :=)))))
+ (GLREDUCE)
+ (GO A)))
+
+% Push new operator onto the operator stack.
+
+ (SETQ OPERS (CONS FIRST OPERS))
+ (GO L)
+ B
+ (COND (OPERS (GLREDUCE)
+ (GO B)))
+ (RETURN (CAR OPNDS))))
+
+
+% edited: 30-DEC-82 10:55
+% Parse a field specification of the form var:field:field... Var may
+% be missing, and there may be zero or more fields. The variable
+% FIRST is used globally; it contains the first atom of the group on
+% entry, and the next atom on exit.
+(DE GLPARSFLD (PREV)
+(PROG (FIELD TMP)
+ (COND ((NULL PREV)
+ (COND ((EQ FIRST '!')
+ (COND ((SETQ TMP (GLSEPNXT))
+ (SETQ FIRST (GLSEPNXT))
+ (RETURN (LIST (KWOTE TMP)
+ 'ATOM)))
+ (EXPR (SETQ FIRST NIL)
+ (SETQ TMP (pop EXPR))
+ (RETURN (LIST (KWOTE TMP)
+ (GLCONSTANTTYPE TMP))))
+ (T (RETURN NIL))))
+ ((MEMQ FIRST '(THE The the))
+ (SETQ TMP (GLTHE NIL))
+ (SETQ FIRST NIL)
+ (RETURN TMP))
+ ((NE FIRST ':)
+ (SETQ PREV FIRST)
+ (SETQ FIRST (GLSEPNXT))))))
+ A
+ (COND ((EQ FIRST ':)
+ (COND ((SETQ FIELD (GLSEPNXT))
+ (SETQ PREV (GLGETFIELD PREV FIELD CONTEXT))
+ (SETQ FIRST (GLSEPNXT))
+ (GO A))))
+ (T (RETURN (COND ((EQ PREV '*NIL*)
+ (LIST NIL NIL))
+ (T (GLIDNAME PREV T))))))))
+
+
+% edited: 20-MAY-82 11:30
+% Parse a field specification which may be preceded by a ~.
+(DE GLPARSNFLD NIL
+(PROG (TMP UOP)
+ (COND ((OR (EQ FIRST '~)
+ (EQ FIRST '-))
+ (SETQ UOP FIRST)
+ (COND ((SETQ FIRST (GLSEPNXT))
+ (SETQ TMP (GLPARSFLD NIL)))
+ ((AND EXPR (ATOM (CAR EXPR)))
+ (GLSEPINIT (pop EXPR))
+ (SETQ FIRST (GLSEPNXT))
+ (SETQ TMP (GLPARSFLD NIL)))
+ ((AND EXPR (PAIRP (CAR EXPR)))
+ (SETQ TMP (GLPUSHEXPR (pop EXPR)
+ T CONTEXT T)))
+ (T (RETURN (LIST UOP NIL))))
+ (RETURN (COND ((EQ UOP '~)
+ (GLNOTFN TMP))
+ (T (GLMINUSFN TMP)))))
+ (T (RETURN (GLPARSFLD NIL))))))
+
+
+% edited: 27-MAY-82 10:42
+% Form the plural of a given word.
+(DE GLPLURAL (WORD)
+(PROG (TMP LST UCASE ENDING)
+ (COND ((SETQ TMP (GET WORD 'PLURAL))
+ (RETURN TMP)))
+ (SETQ LST (REVERSIP (EXPLODE WORD)))
+ (SETQ UCASE (U-CASEP (CAR LST)))
+ (COND ((AND (MEMQ (CAR LST)
+ '(Y y))
+ (NOT (MEMQ (CADR LST)
+ '(A a E e O o U u))))
+ (SETQ LST (CDR LST))
+ (SETQ ENDING (OR (AND UCASE '(S E I))
+ '(s e i))))
+ ((MEMQ (CAR LST)
+ '(S s X x))
+ (SETQ ENDING (OR (AND UCASE '(S E))
+ '(s e))))
+ (T (SETQ ENDING (OR (AND UCASE '(S))
+ '(s)))))
+ (RETURN (IMPLODE (REVERSIP (APPEND ENDING LST))))))
+
+
+% edited: 29-DEC-82 12:40
+% Produce a function to implement the -_ (pop) operator. Code is
+% produced to remove one element from the right-hand side and assign
+% it to the left-hand side.
+(DE GLPOPFN (LHS RHS)
+(PROG (RHSCODE RHSDES POPCODE GETCODE TMP STR)
+ (SETQ RHSCODE (CAR RHS))
+ (SETQ RHSDES (GLXTRTYPE (CADR RHS)))
+ (COND ((AND (PAIRP RHSDES)
+ (EQ (CAR RHSDES)
+ 'LISTOF))
+ (SETQ POPCODE (GLPUTFN RHS (LIST (LIST 'CDR
+ RHSCODE)
+ RHSDES)
+ T))
+ (SETQ GETCODE (GLPUTFN LHS (LIST (LIST 'CAR
+ (CAR RHS))
+ (CADR RHSDES))
+ NIL)))
+ ((EQ RHSDES 'BOOLEAN)
+ (SETQ POPCODE (GLPUTFN RHS '(NIL NIL)
+ NIL))
+ (SETQ GETCODE (GLPUTFN LHS RHS NIL)))
+ ((SETQ TMP (GLDOMSG RHS '-_
+ (LIST LHS)))
+ (RETURN TMP))
+ ((AND (SETQ STR (GLGETSTR RHSDES))
+ (SETQ TMP (GLPOPFN LHS (LIST (CAR RHS)
+ STR))))
+ (RETURN TMP))
+ ((SETQ TMP (GLUSERSTROP RHS '-_
+ LHS))
+ (RETURN TMP))
+ ((OR (GLATOMTYPEP RHSDES)
+ (AND (NE RHSDES 'ANYTHING)
+ (MEMQ (GLXTRTYPEB RHSDES)
+ GLBASICTYPES)))
+ (RETURN NIL))
+ (T
+% If all else fails, assume a list.
+
+ (SETQ POPCODE (GLPUTFN RHS (LIST (LIST 'CDR
+ RHSCODE)
+ RHSDES)
+ T))
+ (SETQ GETCODE (GLPUTFN LHS (LIST (LIST 'CAR
+ (CAR RHS))
+ (CADR RHSDES))
+ NIL))))
+ (RETURN (LIST (LIST 'PROG1
+ (CAR GETCODE)
+ (CAR POPCODE))
+ (CADR GETCODE)))))
+
+
+% edited: 30-OCT-82 14:36
+% Precedence numbers for operators
+(DE GLPREC (OP)
+(PROG (TMP)
+ (COND ((SETQ TMP (ASSOC OP '((_ . 1)
+ (:= . 1)
+ (__ . 1)
+ (_+ . 2)
+ (__+ . 2)
+ (+_ . 2)
+ (_+_ . 2)
+ (_- . 2)
+ (__- . 2)
+ (-_ . 2)
+ (= . 5)
+ (~= . 5)
+ (<> . 5)
+ (AND . 4)
+ (And . 4)
+ (and . 4)
+ (OR . 3)
+ (Or . 3)
+ (or . 3)
+ (/ . 7)
+ (+ . 6)
+ (- . 6)
+ (> . 5)
+ (< . 5)
+ (>= . 5)
+ (<= . 5)
+ (^ . 8))))
+ (RETURN (CDR TMP)))
+ ((EQ OP '*)
+ (RETURN 7))
+ (T (RETURN 10)))))
+
+
+% GSN 7-MAR-83 17:13
+% Get a predicate specification from the EXPR (referenced globally)
+% and return code to test the SOURCE for that predicate. VERBFLG is
+% true if a verb is expected as the top of EXPR.
+(DE GLPREDICATE (SOURCE CONTEXT VERBFLG ADDISATYPE)
+(PROG (NEWPRED SETNAME PROPERTY TMP NOTFLG)
+ (COND ((NULL VERBFLG)
+ (SETQ NEWPRED (GLDOEXPR NIL CONTEXT T)))
+ ((NULL SOURCE)
+ (GLERROR 'GLPREDICATE
+ (LIST "The object to be tested was not found. EXPR ="
+ EXPR)))
+ ((MEMQ (CAR EXPR)
+ '(HAS Has has))
+ (pop EXPR)
+ (COND ((MEMQ (CAR EXPR)
+ '(NO No no))
+ (SETQ NOTFLG T)
+ (pop EXPR)))
+ (SETQ NEWPRED (GLDOEXPR NIL CONTEXT T)))
+ ((MEMQ (CAR EXPR)
+ '(IS Is is ARE Are are))
+ (pop EXPR)
+ (COND ((MEMQ (CAR EXPR)
+ '(NOT Not not))
+ (SETQ NOTFLG T)
+ (pop EXPR)))
+ (COND ((GL-A-AN? (CAR EXPR))
+ (pop EXPR)
+ (SETQ SETNAME (pop EXPR))
+
+% The condition is to test whether SOURCE IS A SETNAME.
+
+ (COND ((SETQ NEWPRED (GLADJ SOURCE SETNAME 'ISA)))
+ ((SETQ NEWPRED (GLADJ (LIST (CAR SOURCE)
+ SETNAME)
+ SETNAME
+ 'ISASELF))
+ (GLNOTESOURCETYPE SOURCE SETNAME ADDISATYPE))
+ ((GLCLASSP SETNAME)
+ (SETQ NEWPRED (LIST (LIST 'GLCLASSMEMP
+ (CAR SOURCE)
+ (KWOTE SETNAME))
+ 'BOOLEAN)))
+ ((SETQ TMP (GLLISPISA SETNAME))
+ (SETQ NEWPRED (LIST (GLGENCODE (LIST (CAR TMP)
+ (CAR SOURCE)))
+ 'BOOLEAN))
+ (GLNOTESOURCETYPE SOURCE (CADR TMP)
+ ADDISATYPE))
+ (T (GLERROR 'GLPREDICATE
+ (LIST "IS A adjective" SETNAME
+ "could not be found for"
+ (CAR SOURCE)
+ "whose type is"
+ (CADR SOURCE)))
+ (SETQ NEWPRED (LIST (LIST 'GLERR
+ (CAR SOURCE)
+ 'IS
+ 'A
+ SETNAME)
+ 'BOOLEAN)))))
+ (T (SETQ PROPERTY (CAR EXPR))
+
+% The condition to test is whether SOURCE is PROPERTY.
+
+ (COND ((SETQ NEWPRED (GLADJ SOURCE PROPERTY
+ 'ADJ))
+ (pop EXPR))
+ ((SETQ TMP (GLLISPADJ PROPERTY))
+ (pop EXPR)
+ (SETQ NEWPRED (LIST (GLGENCODE
+ (LIST (CAR TMP)
+ (CAR SOURCE)))
+ 'BOOLEAN))
+ (GLNOTESOURCETYPE SOURCE (CADR TMP)
+ ADDISATYPE))
+ (T (GLERROR 'GLPREDICATE
+ (LIST "The adjective" PROPERTY
+ "could not be found for"
+ (CAR SOURCE)
+ "whose type is"
+ (CADR SOURCE)))
+ (pop EXPR)
+ (SETQ NEWPRED (LIST (LIST 'GLERR
+ (CAR SOURCE)
+ 'IS
+ PROPERTY)
+ 'BOOLEAN))))))))
+ (RETURN (COND (NOTFLG (LIST (GLBUILDNOT (CAR NEWPRED))
+ 'BOOLEAN))
+ (T NEWPRED)))))
+
+
+% edited: 25-MAY-82 16:09
+% Compile an implicit PROGN, that is, a list of items.
+(DE GLPROGN (EXPR CONTEXT)
+(PROG (RESULT TMP TYPE GLSEPATOM GLSEPPTR)
+ (SETQ GLSEPPTR 0)
+ A
+ (COND ((NULL EXPR)
+ (RETURN (LIST (REVERSIP RESULT)
+ TYPE)))
+ ((SETQ TMP (GLDOEXPR NIL CONTEXT VALBUSY))
+ (SETQ RESULT (CONS (CAR TMP)
+ RESULT))
+ (SETQ TYPE (CADR TMP))
+ (GO A))
+ (T (GLERROR 'GLPROGN
+ (LIST
+ "Illegal item appears in implicit PROGN. EXPR ="
+ EXPR))))))
+
+
+% edited: 14-MAR-83 17:12
+% Create a function call to retrieve the field IND from a
+% property-list type structure. FLG is true if a PROPLIST is inside
+% an ATOM structure.
+(DE GLPROPSTRFN (IND DES DESLIST FLG)
+(PROG (DESIND TMP RECNAME N)
+
+% Handle a PROPLIST by looking inside each property for IND.
+
+ (COND ((AND (EQ (SETQ DESIND (pop DES))
+ 'RECORD)
+ (ATOM (CAR DES)))
+ (SETQ RECNAME (pop DES))))
+ (SETQ N 0)
+ P
+ (COND ((NULL DES)
+ (RETURN NIL))
+ ((AND (PAIRP (CAR DES))
+ (ATOM (CAAR DES))
+ (CDAR DES)
+ (SETQ TMP (GLSTRFN IND (CAR DES)
+ DESLIST)))
+ (SETQ
+ TMP
+ (GLSTRVAL TMP
+ (CASEQ DESIND (ALIST (LIST 'GLGETASSOC
+ (KWOTE (CAAR DES))
+ '*GL*))
+ ((RECORD OBJECT)
+ (COND ((EQ DESIND 'OBJECT)
+ (SETQ N (ADD1 N))))
+ (LIST 'GetV
+ '*GL*
+ N))
+ ((PROPLIST ATOMOBJECT)
+ (GLGENCODE
+ (LIST (COND ((OR FLG (EQ DESIND
+ 'ATOMOBJECT))
+ 'GETPROP)
+ (T 'LISTGET))
+ '*GL*
+ (KWOTE (CAAR DES))))))))
+ (RETURN TMP))
+ (T (pop DES)
+ (SETQ N (ADD1 N))
+ (GO P)))))
+
+
+% edited: 4-JUN-82 13:37
+% Test if the function X is a pure computation, i.e., can be
+% eliminated if the result is not used.
+(DE GLPURE (X)
+(MEMQ X '(CAR CDR CXR CAAR CADR CDAR CDDR ADD1 SUB1 CADDR CADDDR)))
+
+
+% edited: 25-MAY-82 16:10
+% This function serves to call GLDOEXPR with a new expression,
+% rebinding the global variable EXPR.
+(DE GLPUSHEXPR (EXPR START CONTEXT VALBUSY)
+(PROG (GLSEPATOM GLSEPPTR)
+ (SETQ GLSEPPTR 0)
+ (RETURN (GLDOEXPR START CONTEXT VALBUSY))))
+
+
+% GSN 25-JAN-83 16:48
+% edited: 2-Jun-81 14:19
+% Produce a function to implement the +_ operator. Code is produced to
+% push the right-hand side onto the left-hand side. Note: parts of
+% the structure provided are used multiple times.
+(DE GLPUSHFN (LHS RHS)
+(PROG (LHSCODE LHSDES NCCODE TMP STR)
+ (SETQ LHSCODE (CAR LHS))
+ (SETQ LHSDES (GLXTRTYPE (CADR LHS)))
+ (COND ((EQ LHSDES 'INTEGER)
+ (COND ((EQN (CAR RHS)
+ 1)
+ (SETQ NCCODE (LIST 'ADD1
+ LHSCODE)))
+ ((OR (FIXP (CAR RHS))
+ (EQ (CADR RHS)
+ 'INTEGER))
+ (SETQ NCCODE (LIST 'IPLUS
+ LHSCODE
+ (CAR RHS))))
+ (T (SETQ NCCODE (LIST 'PLUS
+ LHSCODE
+ (CAR RHS))))))
+ ((OR (EQ LHSDES 'NUMBER)
+ (EQ LHSDES 'REAL))
+ (SETQ NCCODE (LIST 'PLUS
+ LHSCODE
+ (CAR RHS))))
+ ((EQ LHSDES 'BOOLEAN)
+ (SETQ NCCODE (LIST 'OR
+ LHSCODE
+ (CAR RHS))))
+ ((NULL LHSDES)
+ (SETQ NCCODE (LIST 'CONS
+ (CAR RHS)
+ LHSCODE))
+ (COND ((AND (ATOM LHSCODE)
+ (CADR RHS))
+ (GLUPDATEVARTYPE LHSCODE (LIST 'LISTOF
+ (CADR RHS))))))
+ ((AND (PAIRP LHSDES)
+ (MEMQ (CAR LHSDES)
+ '(LIST CONS LISTOF)))
+ (SETQ NCCODE (LIST 'CONS
+ (CAR RHS)
+ LHSCODE)))
+ ((SETQ TMP (GLUNITOP LHS RHS 'PUSH))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '+_
+ (LIST RHS)))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '+
+ (LIST RHS)))
+ (SETQ NCCODE (CAR TMP)))
+ ((AND (SETQ STR (GLGETSTR LHSDES))
+ (SETQ TMP (GLPUSHFN (LIST (CAR LHS)
+ STR)
+ RHS)))
+ (RETURN (LIST (CAR TMP)
+ (CADR LHS))))
+ ((SETQ TMP (GLUSERSTROP LHS '+_
+ RHS))
+ (RETURN TMP))
+ ((SETQ TMP (GLREDUCEARITH '+
+ RHS LHS))
+ (SETQ NCCODE (CAR TMP)))
+ (T (RETURN NIL)))
+ (RETURN (GLPUTFN LHS (LIST (GLGENCODE NCCODE)
+ LHSDES)
+ T))))
+
+
+% GSN 22-JAN-83 14:44
+% Process a store into a value which is computed by an arithmetic
+% expression.
+(DE GLPUTARITH (LHS RHS)
+(PROG (LHSC OP TMP NEWLHS NEWRHS)
+ (SETQ LHSC (CAR LHS))
+ (SETQ OP (CAR LHSC))
+ (COND ((NOT (SETQ TMP (ASSOC OP '((PLUS DIFFERENCE)
+ (MINUS MINUS)
+ (DIFFERENCE PLUS)
+ (TIMES QUOTIENT)
+ (QUOTIENT TIMES)
+ (IPLUS IDIFFERENCE)
+ (IMINUS IMINUS)
+ (IDIFFERENCE IPLUS)
+ (ITIMES IQUOTIENT)
+ (IQUOTIENT ITIMES)
+ (ADD1 SUB1)
+ (SUB1 ADD1)
+ (EXPT SQRT)
+ (SQRT EXPT)))))
+ (RETURN NIL)))
+ (SETQ NEWLHS (CADR LHSC))
+ (CASEQ OP ((ADD1 SUB1 MINUS IMINUS)
+ (SETQ NEWRHS (LIST (CADR TMP)
+ (CAR RHS))))
+ ((PLUS DIFFERENCE TIMES QUOTIENT IPLUS IDIFFERENCE ITIMES
+ IQUOTIENT)
+ (COND ((NUMBERP (CADDR LHSC))
+ (SETQ NEWRHS (LIST (CADR TMP)
+ (CAR RHS)
+ (CADDR LHSC))))
+ ((NUMBERP (CADR LHSC))
+ (SETQ NEWLHS (CADDR LHSC))
+ (CASEQ OP ((DIFFERENCE IDIFFERENCE QUOTIENT IQUOTIENT)
+ (SETQ NEWRHS (LIST OP (CADR LHSC)
+ (CAR RHS))))
+ (T (PROGN (SETQ NEWRHS (LIST (CADR TMP)
+ (CAR RHS)
+ (CADR LHSC)))))))))
+ (EXPT (COND ((EQUAL (CADDR LHSC)
+ 2)
+ (SETQ NEWRHS (LIST (CADR TMP)
+ (CAR RHS))))))
+ (SQRT (SETQ NEWRHS (LIST (CADR TMP)
+ (CAR RHS)
+ 2))))
+ (RETURN (AND NEWRHS (GLPUTFN (LIST NEWLHS (CADR LHS))
+ (LIST NEWRHS (CADR RHS))
+ NIL)))))
+
+
+% GSN 22-JAN-83 14:37
+% edited: 2-Jun-81 14:16
+% Create code to put the right-hand side datum RHS into the left-hand
+% side, whose access function and type are given by LHS.
+(DE GLPUTFN (LHS RHS OPTFLG)
+(PROG (LHSD LNAME TMP RESULT TMPVAR)
+ (SETQ LHSD (CAR LHS))
+ (COND ((ATOM LHSD)
+ (RETURN (OR (GLDOMSG LHS '_
+ (LIST RHS))
+ (GLUSERSTROP LHS '_
+ RHS)
+ (AND (NULL (CADR LHS))
+ (CADR RHS)
+ (GLUSERSTROP (LIST (CAR LHS)
+ (CADR RHS))
+ '_
+ RHS))
+ (GLDOVARSETQ LHSD RHS)))))
+ (SETQ LNAME (CAR LHSD))
+ (COND ((EQ LNAME 'CAR)
+ (SETQ RESULT (COND
+ ((AND OPTFLG (GLEXPENSIVE? (CADR LHSD)))
+ (LIST 'PROG
+ (LIST (LIST (SETQ TMPVAR (GLMKVAR))
+ (CADR LHSD)))
+ (LIST 'RETURN
+ (LIST 'CAR
+ (LIST 'RPLACA
+ TMPVAR
+ (SUBST TMPVAR (CADR LHSD)
+ (CAR RHS)))))))
+ (T (LIST 'CAR
+ (LIST 'RPLACA
+ (CADR LHSD)
+ (CAR RHS)))))))
+ ((EQ LNAME 'CDR)
+ (SETQ RESULT (COND
+ ((AND OPTFLG (GLEXPENSIVE? (CADR LHSD)))
+ (LIST 'PROG
+ (LIST (LIST (SETQ TMPVAR (GLMKVAR))
+ (CADR LHSD)))
+ (LIST 'RETURN
+ (LIST 'CDR
+ (LIST 'RPLACD
+ TMPVAR
+ (SUBST TMPVAR (CADR LHSD)
+ (CAR RHS)))))))
+ (T (LIST 'CDR
+ (LIST 'RPLACD
+ (CADR LHSD)
+ (CAR RHS)))))))
+ ((SETQ TMP (ASSOC LNAME '((CADR . CDR)
+ (CADDR . CDDR)
+ (CADDDR . CDDDR))))
+ (SETQ RESULT
+ (COND
+ ((AND OPTFLG (GLEXPENSIVE? (CADR LHSD)))
+ (LIST 'PROG
+ (LIST (LIST (SETQ TMPVAR (GLMKVAR))
+ (LIST (CDR TMP)
+ (CADR LHSD))))
+ (LIST 'RETURN
+ (LIST 'CAR
+ (LIST 'RPLACA
+ TMPVAR
+ (SUBST (LIST 'CAR
+ TMPVAR)
+ LHSD
+ (CAR RHS)))))))
+ (T (LIST 'CAR
+ (LIST 'RPLACA
+ (LIST (CDR TMP)
+ (CADR LHSD))
+ (CAR RHS)))))))
+ ((SETQ TMP (ASSOC LNAME '((GetV . PutV)
+ (IGetV . IPutV)
+ (GET . PUTPROP)
+ (GETPROP . PUTPROP)
+ (LISTGET . LISTPUT))))
+ (SETQ RESULT (LIST (CDR TMP)
+ (CADR LHSD)
+ (CADDR LHSD)
+ (CAR RHS))))
+ ((EQ LNAME 'CXR)
+ (SETQ RESULT (LIST 'CXR
+ (CADR LHSD)
+ (LIST 'RPLACX
+ (CADR LHSD)
+ (CADDR LHSD)
+ (CAR RHS)))))
+ ((EQ LNAME 'GLGETASSOC)
+ (SETQ RESULT (LIST 'PUTASSOC
+ (CADR LHSD)
+ (CAR RHS)
+ (CADDR LHSD))))
+ ((EQ LNAME 'EVAL)
+ (SETQ RESULT (LIST 'SET
+ (CADR LHSD)
+ (CAR RHS))))
+ ((EQ LNAME 'fetch)
+ (SETQ RESULT (LIST 'replace
+ (CADR LHSD)
+ 'of
+ (CADDDR LHSD)
+ 'with
+ (CAR RHS))))
+ ((SETQ TMP (GLUNITOP LHS RHS 'PUT))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '_
+ (LIST RHS)))
+ (RETURN TMP))
+ ((SETQ TMP (GLUSERSTROP LHS '_
+ RHS))
+ (RETURN TMP))
+ ((SETQ TMP (GLPUTARITH LHS RHS))
+ (RETURN TMP))
+ (T (RETURN (GLERROR 'GLPUTFN
+ (LIST "Illegal assignment. LHS =" LHS "RHS ="
+ RHS)))))
+ X
+ (RETURN (LIST (GLGENCODE RESULT)
+ (OR (CADR LHS)
+ (CADR RHS))))))
+
+
+% edited: 27-MAY-82 13:07
+% This function appends PUTPROP calls to the list PROGG (global) so
+% that ATOMNAME has its property list built.
+(DE GLPUTPROPS (PROPLIS PREVLST)
+(PROG (TMP TMPCODE)
+ A
+ (COND ((NULL PROPLIS)
+ (RETURN NIL)))
+ (SETQ TMP (pop PROPLIS))
+ (COND ((SETQ TMPCODE (GLBUILDSTR TMP PAIRLIST PREVLST))
+ (ACONC PROGG (GLGENCODE (LIST 'PUTPROP
+ 'ATOMNAME
+ (KWOTE (CAR TMP))
+ TMPCODE)))))
+ (GO A)))
+
+
+% edited: 26-JAN-82 10:29
+% This function implements the __ operator, which is interpreted as
+% assignment to the source of a variable (usually self) outside an
+% open-compiled function. Any other use of __ is illegal.
+(DE GLPUTUPFN (OP LHS RHS)
+(PROG (TMP TMPOP)
+ (OR (SETQ TMPOP (ASSOC OP '((__ . _)
+ (__+ . _+)
+ (__- . _-)
+ (_+_ . +_))))
+ (ERROR 0 (LIST (LIST 'GLPUTUPFN
+ OP)
+ " Illegal operator.")))
+ (COND ((AND (ATOM (CAR LHS))
+ (NOT (UNBOUNDP 'GLPROGLST))
+ (SETQ TMP (ASSOC (CAR LHS)
+ GLPROGLST)))
+ (RETURN (GLREDUCEOP (CDR TMPOP)
+ (LIST (CADR TMP)
+ (CADR LHS))
+ RHS)))
+ ((AND (PAIRP (CAR LHS))
+ (EQ (CAAR LHS)
+ 'PROG1)
+ (ATOM (CADAR LHS)))
+ (RETURN (GLREDUCEOP (CDR TMPOP)
+ (LIST (CADAR LHS)
+ (CADR LHS))
+ RHS)))
+ (T (RETURN (GLERROR 'GLPUTUPFN
+ (LIST
+ "A self-assignment __ operator is used improperly. LHS ="
+ LHS)))))))
+
+
+% edited: 30-OCT-82 14:38
+% Reduce the operator on OPERS and the operands on OPNDS
+% (in GLPARSEXPR) and put the result back on OPNDS
+(DE GLREDUCE NIL
+(PROG (RHS OPER)
+ (SETQ RHS (pop OPNDS))
+ (SETQ OPNDS
+ (CONS (COND ((MEMQ (SETQ OPER (pop OPERS))
+ '(_ := _+
+ +_ _-
+ -_ = ~= <> AND And and OR Or
+ or __+
+ __ _+_ __-))
+ (GLREDUCEOP OPER (pop OPNDS)
+ RHS))
+ ((MEMQ OPER
+ '(+ - * / > < >= <= ^))
+ (GLREDUCEARITH OPER (pop OPNDS)
+ RHS))
+ ((EQ OPER 'MINUS)
+ (GLMINUSFN RHS))
+ ((EQ OPER '~)
+ (GLNOTFN RHS))
+ (T (LIST (GLGENCODE (LIST OPER (CAR (pop OPNDS))
+ (CAR RHS)))
+ NIL)))
+ OPNDS))))
+
+
+% GSN 25-FEB-83 16:32
+% edited: 14-Aug-81 12:38
+% Reduce an arithmetic operator in an expression.
+(DE GLREDUCEARITH (OP LHS RHS)
+(PROG (TMP OPLIST IOPLIST PREDLIST NUMBERTYPES LHSTP RHSTP)
+ (SETQ OPLIST '((+ . PLUS)
+ (- . DIFFERENCE) (* . TIMES)
+ (/ . QUOTIENT)
+ (> . GREATERP)
+ (< . LESSP)
+ (>= . GEQ)
+ (<= . LEQ)
+ (^ . EXPT)))
+ (SETQ IOPLIST '((+ . IPLUS)
+ (- . IDIFFERENCE) (* . ITIMES)
+ (/ . IQUOTIENT)
+ (> . IGREATERP)
+ (< . ILESSP)
+ (>= . IGEQ)
+ (<= . ILEQ)))
+ (SETQ PREDLIST '(GREATERP LESSP GEQ LEQ IGREATERP ILESSP IGEQ ILEQ))
+ (SETQ NUMBERTYPES '(INTEGER REAL NUMBER))
+ (SETQ LHSTP (GLXTRTYPE (CADR LHS)))
+ (SETQ RHSTP (GLXTRTYPE (CADR RHS)))
+ (COND ((OR (AND (EQ LHSTP 'INTEGER)
+ (EQ RHSTP 'INTEGER)
+ (SETQ TMP (ASSOC OP IOPLIST)))
+ (AND (MEMQ LHSTP NUMBERTYPES)
+ (MEMQ RHSTP NUMBERTYPES)
+ (SETQ TMP (ASSOC OP OPLIST))))
+ (RETURN (LIST (COND ((AND (NUMBERP (CAR LHS))
+ (NUMBERP (CAR RHS)))
+ (EVAL (GLGENCODE (LIST (CDR TMP)
+ (CAR LHS)
+ (CAR RHS)))))
+ (T (GLGENCODE (COND
+ ((AND (EQ (CDR TMP)
+ 'IPLUS)
+ (EQN (CAR RHS)
+ 1))
+ (LIST 'ADD1
+ (CAR LHS)))
+ ((AND (EQ (CDR TMP)
+ 'IDIFFERENCE)
+ (EQN (CAR RHS)
+ 1))
+ (LIST 'SUB1
+ (CAR LHS)))
+ (T (LIST (CDR TMP)
+ (CAR LHS)
+ (CAR RHS)))))))
+ (COND ((MEMQ (CDR TMP)
+ PREDLIST)
+ 'BOOLEAN)
+ (T LHSTP))))))
+ (COND
+ ((EQ LHSTP 'STRING)
+ (COND ((NE RHSTP 'STRING)
+ (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST "operation on string and non-string"))))
+ ((SETQ TMP (ASSOC OP '((+ CONCAT STRING)
+ (> GLSTRGREATERP BOOLEAN)
+ (>= GLSTRGEP BOOLEAN)
+ (< GLSTRLESSP BOOLEAN)
+ (<= ALPHORDER BOOLEAN))))
+ (RETURN (LIST (GLGENCODE (LIST (CADR TMP)
+ (CAR LHS)
+ (CAR RHS)))
+ (CADDR TMP))))
+ (T (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST OP
+ "is an illegal operation for strings.")))))
+ )
+ ((EQ LHSTP 'BOOLEAN)
+ (COND
+ ((NE RHSTP 'BOOLEAN)
+ (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST "Operation on Boolean and non-Boolean"))))
+ ((MEMQ OP '(+ * -))
+ (RETURN (LIST (GLGENCODE (CASEQ OP (+ (LIST 'OR
+ (CAR LHS)
+ (CAR RHS)))
+ (* (LIST 'AND
+ (CAR LHS)
+ (CAR RHS)))
+ (- (LIST 'AND
+ (CAR LHS)
+ (LIST 'NOT
+ (CAR RHS))))))
+ 'BOOLEAN)))
+ (T (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST OP
+ "is an illegal operation for Booleans.")))))
+ )
+ ((AND (PAIRP LHSTP)
+ (EQ (CAR LHSTP)
+ 'LISTOF))
+ (COND ((AND (PAIRP RHSTP)
+ (EQ (CAR RHSTP)
+ 'LISTOF))
+ (COND ((NOT (EQUAL (CADR LHSTP)
+ (CADR RHSTP)))
+ (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST
+ "Operations on lists of different types"
+ (CADR LHSTP)
+ (CADR RHSTP))))))
+ (COND ((SETQ TMP (ASSOC OP '((+ UNION)
+ (- LDIFFERENCE)
+ (* INTERSECTION)
+ )))
+ (RETURN (LIST (GLGENCODE (LIST (CADR TMP)
+ (CAR LHS)
+ (CAR RHS)))
+ (CADR LHS))))
+ (T (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST "Illegal operation" OP
+ "on lists."))))))
+ ((AND (GLMATCH RHSTP (CADR LHSTP))
+ (MEMQ OP '(+ - >=)))
+ (RETURN (LIST (GLGENCODE (LIST (COND ((EQ OP '+)
+ 'CONS)
+ ((EQ OP '-)
+ 'REMOVE)
+ ((EQ OP '>=)
+ (COND
+ ((GLATOMTYPEP RHSTP)
+ 'MEMB)
+ (T 'MEMBER))))
+ (CAR RHS)
+ (CAR LHS)))
+ (CADR LHS))))
+ (T (RETURN (GLERROR 'GLREDUCEARITH
+ (LIST "Illegal operation on list."))))))
+ ((AND (MEMQ OP '(+ <=))
+ (GLMATCHL LHSTP RHSTP))
+ (RETURN (COND ((EQ OP '+)
+ (LIST (GLGENCODE (LIST 'CONS
+ (CAR LHS)
+ (CAR RHS)))
+ (CADR RHS)))
+ ((EQ OP '<=)
+ (LIST (GLGENCODE (LIST (COND ((GLATOMTYPEP LHSTP)
+ 'MEMB)
+ (T 'MEMBER))
+ (CAR LHS)
+ (CAR RHS)))
+ 'BOOLEAN)))))
+ ((AND (MEMQ OP '(+ - >=))
+ (SETQ TMP (GLMATCHL LHSTP RHSTP)))
+ (RETURN (GLREDUCEARITH (LIST (CAR LHS)
+ (LIST 'LISTOF
+ TMP))
+ OP
+ (LIST (CAR RHS)
+ TMP))))
+ ((SETQ TMP (GLDOMSG LHS OP (LIST RHS)))
+ (RETURN TMP))
+ ((SETQ TMP (GLUSERSTROP LHS OP RHS))
+ (RETURN TMP))
+ ((SETQ TMP (GLXTRTYPEC LHSTP))
+ (SETQ TMP (GLREDUCEARITH OP (LIST (CAR LHS)
+ TMP)
+ (LIST (CAR RHS)
+ (OR (GLXTRTYPEC RHSTP)
+ RHSTP))))
+ (RETURN (LIST (CAR TMP)
+ LHSTP)))
+ ((SETQ TMP (ASSOC OP OPLIST))
+ (AND LHSTP RHSTP (GLERROR 'GLREDUCEARITH
+ (LIST
+ "Warning: Arithmetic operation on non-numeric arguments of types:"
+ LHSTP RHSTP)))
+ (RETURN (LIST (GLGENCODE (LIST (CDR TMP)
+ (CAR LHS)
+ (CAR RHS)))
+ (COND ((MEMQ (CDR TMP)
+ PREDLIST)
+ 'BOOLEAN)
+ (T 'NUMBER)))))
+ (T (ERROR 0 (LIST 'GLREDUCEARITH
+ OP LHS RHS))))))
+
+
+% edited: 29-DEC-82 12:20
+% Reduce the operator OP with operands LHS and RHS.
+(DE GLREDUCEOP (OP LHS RHS)
+(PROG (TMP RESULT)
+ (COND ((MEMQ OP '(_ :=))
+ (RETURN (GLPUTFN LHS RHS NIL)))
+ ((SETQ TMP (ASSOC OP '((_+ . GLNCONCFN)
+ (+_ . GLPUSHFN)
+ (_- . GLREMOVEFN)
+ (-_ . GLPOPFN)
+ (= . GLEQUALFN)
+ (~= . GLNEQUALFN)
+ (<> . GLNEQUALFN)
+ (AND . GLANDFN)
+ (And . GLANDFN)
+ (and . GLANDFN)
+ (OR . GLORFN)
+ (Or . GLORFN)
+ (or . GLORFN))))
+ (COND ((SETQ RESULT (APPLY (CDR TMP)
+ (LIST LHS RHS)))
+ (RETURN RESULT))
+ (T (GLERROR 'GLREDUCEOP
+ (LIST "The operator" OP
+ "could not be interpreted for arguments"
+ LHS "and" RHS)))))
+ ((MEMQ OP '(__ __+
+ __-
+ _+_))
+ (RETURN (GLPUTUPFN OP LHS RHS)))
+ (T (ERROR 0 (LIST 'GLREDUCEOP
+ OP LHS RHS))))))
+
+
+% GSN 25-JAN-83 16:50
+% edited: 2-Jun-81 14:20
+% Produce a function to implement the _- operator. Code is produced to
+% remove the right-hand side from the left-hand side. Note: parts of
+% the structure provided are used multiple times.
+(DE GLREMOVEFN (LHS RHS)
+(PROG (LHSCODE LHSDES NCCODE TMP STR)
+ (SETQ LHSCODE (CAR LHS))
+ (SETQ LHSDES (GLXTRTYPE (CADR LHS)))
+ (COND ((EQ LHSDES 'INTEGER)
+ (COND ((EQN (CAR RHS)
+ 1)
+ (SETQ NCCODE (LIST 'SUB1
+ LHSCODE)))
+ (T (SETQ NCCODE (LIST 'IDIFFERENCE
+ LHSCODE
+ (CAR RHS))))))
+ ((OR (EQ LHSDES 'NUMBER)
+ (EQ LHSDES 'REAL))
+ (SETQ NCCODE (LIST 'DIFFERENCE
+ LHSCODE
+ (CAR RHS))))
+ ((EQ LHSDES 'BOOLEAN)
+ (SETQ NCCODE (LIST 'AND
+ LHSCODE
+ (LIST 'NOT
+ (CAR RHS)))))
+ ((OR (NULL LHSDES)
+ (AND (PAIRP LHSDES)
+ (EQ (CAR LHSDES)
+ 'LISTOF)))
+ (SETQ NCCODE (LIST 'REMOVE
+ (CAR RHS)
+ LHSCODE)))
+ ((SETQ TMP (GLUNITOP LHS RHS 'REMOVE))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '_-
+ (LIST RHS)))
+ (RETURN TMP))
+ ((SETQ TMP (GLDOMSG LHS '-
+ (LIST RHS)))
+ (SETQ NCCODE (CAR TMP)))
+ ((AND (SETQ STR (GLGETSTR LHSDES))
+ (SETQ TMP (GLREMOVEFN (LIST (CAR LHS)
+ STR)
+ RHS)))
+ (RETURN (LIST (CAR TMP)
+ (CADR LHS))))
+ ((SETQ TMP (GLUSERSTROP LHS '_-
+ RHS))
+ (RETURN TMP))
+ (T (RETURN NIL)))
+ (RETURN (GLPUTFN LHS (LIST (GLGENCODE NCCODE)
+ LHSDES)
+ T))))
+
+
+% GSN 26-JAN-83 13:41
+% Get GLOBAL and RESULT declarations for the GLISP compiler. The
+% property GLRESULTTYPE is the RESULT declaration, if specified;
+% GLGLOBALS is a list of global variables referenced and their
+% types.
+(DE GLRESGLOBAL NIL
+(COND ((PAIRP (CAR GLEXPR))
+ (COND ((MEMQ (CAAR GLEXPR)
+ '(RESULT Result result))
+ (COND ((AND (GLOKSTR? (CADAR GLEXPR))
+ (NULL (CDDAR GLEXPR)))
+ (PUT GLAMBDAFN 'GLRESULTTYPE
+ (SETQ RESULTTYPE (GLSUBSTTYPE (GLEVALSTR
+ (CADAR GLEXPR)
+ GLTOPCTX)
+ GLTYPESUBS)))
+ (pop GLEXPR))
+ (T (GLERROR 'GLCOMP
+ (LIST "Bad RESULT structure declaration:"
+ (CAR GLEXPR)))
+ (pop GLEXPR))))
+ ((MEMQ (CAAR GLEXPR)
+ '(GLOBAL Global global))
+ (SETQ GLGLOBALVARS (GLDECL (CDAR GLEXPR)
+ '(NIL NIL)
+ GLTOPCTX NIL NIL))
+ (PUT GLAMBDAFN 'GLGLOBALS
+ GLGLOBALVARS)
+ (pop GLEXPR))))))
+
+
+% edited: 26-MAY-82 16:14
+% Get the result type for a function which has a GLAMBDA definition.
+% ATM is the function name.
+(DE GLRESULTTYPE (ATM ARGTYPES)
+(PROG (TYPE FNDEF STR TMP)
+
+% See if this function has a known result type.
+
+ (COND ((SETQ TYPE (GET ATM 'GLRESULTTYPE))
+ (RETURN TYPE)))
+
+% If there exists a function to compute the result type, let it do so.
+
+ (COND ((SETQ TMP (GET ATM 'GLRESULTTYPEFN))
+ (RETURN (APPLY TMP (LIST ATM ARGTYPES))))
+ ((SETQ TMP (GLANYCARCDR? ATM))
+ (RETURN (GLCARCDRRESULTTYPE TMP (CAR ARGTYPES)))))
+ (SETQ FNDEF (GLGETDB ATM))
+ (COND ((OR (NOT (PAIRP FNDEF))
+ (NOT (MEMQ (CAR FNDEF)
+ '(LAMBDA GLAMBDA))))
+ (RETURN NIL)))
+ (SETQ FNDEF (CDDR FNDEF))
+ A
+ (COND ((OR (NULL FNDEF)
+ (NOT (PAIRP (CAR FNDEF))))
+ (RETURN NIL))
+ ((OR (AND (EQ GLLISPDIALECT 'INTERLISP)
+ (EQ (CAAR FNDEF)
+ '*))
+ (MEMQ (CAAR FNDEF)
+ '(GLOBAL Global global)))
+ (pop FNDEF)
+ (GO A))
+ ((AND (MEMQ (CAAR FNDEF)
+ '(RESULT Result result))
+ (GLOKSTR? (SETQ STR (CADAR FNDEF))))
+ (RETURN STR))
+ (T (RETURN NIL)))))
+
+
+% GSN 28-JAN-83 09:55
+(DE GLSAVEFNTYPES (GLAMBDAFN TYPELST)
+(PROG (Y)
+ (MAPC TYPELST (FUNCTION (LAMBDA (X)
+ (COND
+ ((NOT (MEMQ GLAMBDAFN (SETQ Y
+ (GET X 'GLFNSUSEDIN))))
+ (PUT X 'GLFNSUSEDIN
+ (CONS GLAMBDAFN Y)))))))))
+
+
+% GSN 16-FEB-83 11:30
+% Send a runtime message to OBJ.
+(DE GLSENDB (OBJ CLASS SELECTOR PROPTYPE ARGS)
+(PROG (RESULT ARGLIST FNCODE PUTCODE *GL* *GLVAL* SEL)
+ (COND (CLASS)
+ ((SETQ CLASS (GLCLASS OBJ)))
+ (T (ERROR 0 (LIST "Object" OBJ "has no Class."))))
+ (SETQ ARGLIST (CONS OBJ ARGS))
+ (COND ((NE (SETQ RESULT (GLCLASSSEND CLASS SELECTOR ARGLIST PROPTYPE))
+ 'GLSENDFAILURE)
+ (RETURN RESULT))
+ ((AND (EQ SELECTOR 'CLASS)
+ (MEMQ PROPTYPE '(PROP MSG)))
+ (RETURN CLASS))
+ ((NE PROPTYPE 'MSG)
+ (GO ERR))
+ ((AND ARGS (NULL (CDR ARGS))
+ (EQ (GLNTHCHAR SELECTOR -1)
+ ':)
+ (SETQ SEL (SUBATOM SELECTOR 1 -2))
+ (SETQ FNCODE (OR (GLCOMPPROP CLASS SEL 'STR)
+ (GLCOMPPROP CLASS SEL 'PROP)))
+ (SETQ PUTCODE (GLPUTFN (LIST (SUBST '*GL*
+ (CAADR FNCODE)
+ (CADDR FNCODE))
+ NIL)
+ (LIST '*GLVAL*
+ NIL)
+ NIL)))
+ (SETQ *GLVAL* (CAR ARGS))
+ (SETQ *GL* OBJ)
+ (RETURN (EVAL (CAR PUTCODE))))
+ (ARGS (GO ERR))
+ ((NE (SETQ RESULT (GLCLASSSEND CLASS SELECTOR ARGLIST
+ 'STR))
+ 'GLSENDFAILURE)
+ (RETURN RESULT))
+ ((NE (SETQ RESULT (GLCLASSSEND CLASS SELECTOR ARGLIST
+ 'PROP))
+ 'GLSENDFAILURE)
+ (RETURN RESULT))
+ ((NE (SETQ RESULT (GLCLASSSEND CLASS SELECTOR ARGLIST
+ 'ADJ))
+ 'GLSENDFAILURE)
+ (RETURN RESULT))
+ ((NE (SETQ RESULT (GLCLASSSEND CLASS SELECTOR ARGLIST
+ 'ISA))
+ 'GLSENDFAILURE)
+ (RETURN RESULT)))
+ ERR
+ (ERROR 0 (LIST "Message" SELECTOR "to object" OBJ "of class" CLASS
+ "not understood."))))
+
+
+% edited: 30-DEC-81 16:34
+(DE GLSEPCLR NIL
+(SETQ GLSEPPTR 0))
+
+
+% GSN 9-FEB-83 17:24
+% edited: 30-Dec-80 10:05
+% Initialize the scanning function which breaks apart atoms containing
+% embedded operators.
+(DE GLSEPINIT (ATM)
+(COND ((AND (ATOM ATM)
+ (NOT (STRINGP ATM)))
+ (SETQ GLSEPATOM ATM)
+ (SETQ GLSEPPTR 1))
+ (T (SETQ GLSEPATOM NIL)
+ (SETQ GLSEPPTR 0))))
+
+
+% edited: 30-OCT-82 14:40
+% Get the next sub-atom from the atom which was previously given to
+% GLSEPINIT. Sub-atoms are defined by splitting the given atom at
+% the occurrence of operators. Operators which are defined are : _
+% _+ __ +_ _- -_ ' = ~= <> > <
+(DE GLSEPNXT NIL
+(PROG (END TMP)
+ (COND ((ZEROP GLSEPPTR)
+ (RETURN NIL))
+ ((NULL GLSEPATOM)
+ (SETQ GLSEPPTR 0)
+ (RETURN '*NIL*))
+ ((NUMBERP GLSEPATOM)
+ (SETQ TMP GLSEPATOM)
+ (SETQ GLSEPPTR 0)
+ (RETURN TMP)))
+ (SETQ END (STRPOSL GLSEPBITTBL GLSEPATOM GLSEPPTR))
+ A
+ (COND ((NULL END)
+ (RETURN (PROG1 (COND ((EQN GLSEPPTR 1)
+ GLSEPATOM)
+ ((GREATERP GLSEPPTR (FlatSize2 GLSEPATOM))
+ NIL)
+ (T (GLSUBATOM GLSEPATOM GLSEPPTR
+ (FlatSize2 GLSEPATOM))))
+ (SETQ GLSEPPTR 0))))
+ ((MEMQ (SETQ TMP (GLSUBATOM GLSEPATOM GLSEPPTR (PLUS GLSEPPTR 2)))
+ '(__+
+ __-
+ _+_))
+ (SETQ GLSEPPTR (PLUS GLSEPPTR 3))
+ (RETURN TMP))
+ ((MEMQ (SETQ TMP (GLSUBATOM GLSEPATOM GLSEPPTR (ADD1 GLSEPPTR)))
+ '(:= __ _+
+ +_ _-
+ -_ ~= <> >= <=))
+ (SETQ GLSEPPTR (PLUS GLSEPPTR 2))
+ (RETURN TMP))
+ ((AND (NOT GLSEPMINUS)
+ (EQ (GLNTHCHAR GLSEPATOM END)
+ '-)
+ (NOT (EQ (GLNTHCHAR GLSEPATOM (ADD1 END))
+ '_)))
+ (SETQ END (STRPOSL GLSEPBITTBL GLSEPATOM (ADD1 END)))
+ (GO A))
+ ((GREATERP END GLSEPPTR)
+ (RETURN (PROG1 (GLSUBATOM GLSEPATOM GLSEPPTR (SUB1 END))
+ (SETQ GLSEPPTR END))))
+ (T (RETURN (PROG1 (GLSUBATOM GLSEPATOM GLSEPPTR GLSEPPTR)
+ (SETQ GLSEPPTR (ADD1 GLSEPPTR))))))))
+
+
+% edited: 26-MAY-82 16:17
+% Skip comments in GLEXPR.
+(DE GLSKIPCOMMENTS NIL
+(PROG NIL A (COND ((AND (PAIRP GLEXPR)
+ (PAIRP (CAR GLEXPR))
+ (OR (AND (EQ GLLISPDIALECT 'INTERLISP)
+ (EQ (CAAR GLEXPR)
+ '*))
+ (EQ (CAAR GLEXPR)
+ 'COMMENT)))
+ (pop GLEXPR)
+ (GO A)))))
+
+
+% GSN 17-FEB-83 12:36
+% This function is called when the structure STR has been changed. It
+% uncompiles code which depends on STR.
+(DE GLSTRCHANGED (STR)
+(PROG (FNS)
+ (COND ((NOT (GET STR 'GLSTRUCTURE))
+ (RETURN NIL))
+ ((GET STR 'GLPROPFNS)
+ (PUT STR 'GLPROPFNS
+ NIL)))
+ (SETQ FNS (GET STR 'GLFNSUSEDIN))
+ (PUT STR 'GLFNSUSEDIN
+ NIL)
+ (MAPC FNS (FUNCTION GLUNCOMPILE))))
+
+
+% GSN 28-JAN-83 10:19
+% Create a function call to retrieve the field IND from a structure
+% described by the structure description DES. The value is NIL if
+% failure, (NIL DESCR) if DES equals IND, or (FNSTR DESCR) if IND
+% can be gotten from within DES. In the latter case, FNSTR is a
+% function to get the IND from the atom *GL*. GLSTRFN only does
+% retrieval from a structure, and does not get properties of an
+% object unless they are part of a TRANSPARENT substructure. DESLIST
+% is a list of structure descriptions which have been tried already;
+% this prevents a compiler loop in case the user specifies circular
+% TRANSPARENT structures.
+(DE GLSTRFN (IND DES DESLIST)
+(PROG (DESIND TMP STR UNITREC)
+
+% If this structure has already been tried, quit to avoid a loop.
+
+ (COND ((MEMQ DES DESLIST)
+ (RETURN NIL)))
+ (SETQ DESLIST (CONS DES DESLIST))
+ (COND ((OR (NULL DES)
+ (NULL IND))
+ (RETURN NIL))
+ ((OR (ATOM DES)
+ (AND (PAIRP DES)
+ (ATOM (CADR DES))
+ (GL-A-AN? (CAR DES))
+ (SETQ DES (CADR DES))))
+ (RETURN (COND ((SETQ STR (GLGETSTR DES))
+ (GLNOTICETYPE DES)
+ (GLSTRFN IND STR DESLIST))
+ ((SETQ UNITREC (GLUNIT? DES))
+ (GLGETFROMUNIT UNITREC IND DES))
+ ((EQ IND DES)
+ (LIST NIL (CADR DES)))
+ (T NIL))))
+ ((NOT (PAIRP DES))
+ (GLERROR 'GLSTRFN
+ (LIST "Bad structure specification" DES))))
+ (SETQ DESIND (CAR DES))
+ (COND ((OR (EQ IND DES)
+ (EQ DESIND IND))
+ (RETURN (LIST NIL (CADR DES)))))
+ (RETURN (CASEQ DESIND (CONS (OR (GLSTRVALB IND (CADR DES)
+ '(CAR *GL*))
+ (GLSTRVALB IND (CADDR DES)
+ '(CDR *GL*))))
+ ((LIST LISTOBJECT)
+ (GLLISTSTRFN IND DES DESLIST))
+ ((PROPLIST ALIST RECORD ATOMOBJECT OBJECT)
+ (GLPROPSTRFN IND DES DESLIST NIL))
+ (ATOM (GLATOMSTRFN IND DES DESLIST))
+ (TRANSPARENT (GLSTRFN IND (CADR DES)
+ DESLIST))
+ (T (COND ((AND (SETQ TMP (ASSOC DESIND GLUSERSTRNAMES))
+ (CADR TMP))
+ (APPLY (CADR TMP)
+ (LIST IND DES DESLIST)))
+ ((OR (NULL (CDR DES))
+ (ATOM (CADR DES))
+ (AND (PAIRP (CADR DES))
+ (GL-A-AN? (CAADR DES))))
+ NIL)
+ (T (GLSTRFN IND (CADR DES)
+ DESLIST))))))))
+
+
+% GSN 16-MAR-83 10:49
+% If STR is a structured object, i.e., either a declared GLISP
+% structure or a Class of Units, get the property PROP from the
+% GLISP class of properties GLPROP.
+(DE GLSTRPROP (STR GLPROP PROP ARGS)
+(PROG (STRB UNITREC GLPROPS PROPL TMP SUPERS)
+ (OR (ATOM (SETQ STRB (GLXTRTYPE STR)))
+ (RETURN NIL))
+ (COND ((SETQ GLPROPS (GET STRB 'GLSTRUCTURE))
+ (GLNOTICETYPE STRB)
+ (COND ((AND (SETQ PROPL (LISTGET (CDR GLPROPS)
+ GLPROP))
+ (SETQ TMP (GLSTRPROPB PROP PROPL ARGS)))
+ (RETURN TMP)))))
+ (SETQ SUPERS (AND GLPROPS (LISTGET (CDR GLPROPS)
+ 'SUPERS)))
+ LP
+ (COND (SUPERS (COND ((SETQ TMP (GLSTRPROP (CAR SUPERS)
+ GLPROP PROP ARGS))
+ (RETURN TMP))
+ (T (SETQ SUPERS (CDR SUPERS))
+ (GO LP))))
+ ((AND (SETQ UNITREC (GLUNIT? STRB))
+ (SETQ TMP (APPLY (CADDDR UNITREC)
+ (LIST STRB GLPROP PROP))))
+ (RETURN TMP)))))
+
+
+% GSN 10-FEB-83 13:14
+% See if the property PROP can be found within the list of properties
+% PROPL. If ARGS is specified and ARGTYPES are specified for a
+% property entry, ARGS are required to match ARGTYPES.
+(DE GLSTRPROPB (PROP PROPL ARGS)
+(PROG (PROPENT ARGTYPES LARGS)
+ LP
+ (COND ((NULL PROPL)
+ (RETURN NIL)))
+ (SETQ PROPENT (CAR PROPL))
+ (SETQ PROPL (CDR PROPL))
+ (COND ((NE (CAR PROPENT)
+ PROP)
+ (GO LP)))
+ (OR (AND ARGS (SETQ ARGTYPES (LISTGET (CDDR PROPENT)
+ 'ARGTYPES)))
+ (RETURN PROPENT))
+ (SETQ LARGS ARGS)
+ LPB
+ (COND ((AND (NULL LARGS)
+ (NULL ARGTYPES))
+ (RETURN PROPENT))
+ ((OR (NULL LARGS)
+ (NULL ARGTYPES))
+ (GO LP))
+ ((GLTYPEMATCH (CADAR LARGS)
+ (CAR ARGTYPES))
+ (SETQ LARGS (CDR LARGS))
+ (SETQ ARGTYPES (CDR ARGTYPES))
+ (GO LPB))
+ (T (GO LP)))))
+
+
+% edited: 11-JAN-82 14:58
+% GLSTRVAL is a subroutine of GLSTRFN. Given an old partial retrieval
+% function, in which the item from which the retrieval is made is
+% specified by *GL*, and a new function to compute *GL*, a composite
+% function is made.
+(DE GLSTRVAL (OLDFN NEW)
+(PROG NIL (COND ((CAR OLDFN)
+ (RPLACA OLDFN (SUBST NEW '*GL*
+ (CAR OLDFN))))
+ (T (RPLACA OLDFN NEW)))
+ (RETURN OLDFN)))
+
+
+% edited: 13-Aug-81 16:13
+% If the indicator IND can be found within the description DES, make a
+% composite retrieval function using a copy of the function pattern
+% NEW.
+(DE GLSTRVALB (IND DES NEW)
+(PROG (TMP)
+ (COND ((SETQ TMP (GLSTRFN IND DES DESLIST))
+ (RETURN (GLSTRVAL TMP (COPY NEW))))
+ (T (RETURN NIL)))))
+
+
+% edited: 30-DEC-81 16:35
+(DE GLSUBATOM (X Y Z)
+(OR (SUBATOM X Y Z)
+ '*NIL*))
+
+
+% GSN 22-JAN-83 16:27
+% Same as SUBLIS, but allows first elements in PAIRS to be non-atomic.
+(DE GLSUBLIS (PAIRS EXPR)
+(PROG (TMP)
+ (RETURN (COND ((SETQ TMP (ASSOC EXPR PAIRS))
+ (CDR TMP))
+ ((NOT (PAIRP EXPR))
+ EXPR)
+ (T (CONS (GLSUBLIS PAIRS (CAR EXPR))
+ (GLSUBLIS PAIRS (CDR EXPR))))))))
+
+
+% edited: 30-AUG-82 10:29
+% Make subtype substitutions within TYPE according to GLTYPESUBS.
+(DE GLSUBSTTYPE (TYPE SUBS)
+(SUBLIS SUBS TYPE))
+
+
+% edited: 11-NOV-82 14:02
+% Get the list of superclasses for CLASS.
+(DE GLSUPERS (CLASS)
+(PROG (TMP)
+ (RETURN (AND (SETQ TMP (GET CLASS 'GLSTRUCTURE))
+ (LISTGET (CDR TMP)
+ 'SUPERS)))))
+
+
+% GSN 16-FEB-83 11:56
+% edited: 17-Apr-81 14:23
+% EXPR begins with THE. Parse the expression and return code.
+(DE GLTHE (PLURALFLG)
+(PROG (SOURCE SPECS NAME QUALFLG DTYPE NEWCONTEXT LOOPVAR LOOPCOND TMP)
+
+% Now trace the path specification.
+
+ (GLTHESPECS)
+ (SETQ QUALFLG
+ (AND EXPR
+ (MEMQ (CAR EXPR)
+ '(with With
+ WITH who Who WHO which Which WHICH that That THAT)))
+ )
+ B
+ (COND ((NULL SPECS)
+ (COND ((MEMQ (CAR EXPR)
+ '(IS Is is HAS Has has ARE Are are))
+ (RETURN (GLPREDICATE SOURCE CONTEXT T NIL)))
+ (QUALFLG (GO C))
+ (T (RETURN SOURCE))))
+ ((AND QUALFLG (NOT PLURALFLG)
+ (NULL (CDR SPECS)))
+
+% If this is a definite reference to a qualified entity, make the name
+% of the entity plural.
+
+ (SETQ NAME (CAR SPECS))
+ (RPLACA SPECS (GLPLURAL (CAR SPECS)))))
+
+% Try to find the next name on the list of SPECS from SOURCE.
+
+ (COND ((NULL SOURCE)
+ (OR (SETQ SOURCE (GLIDNAME (SETQ NAME (pop SPECS))
+ NIL))
+ (RETURN (GLERROR 'GLTHE
+ (LIST "The definite reference to" NAME
+ "could not be found.")))))
+ (SPECS (SETQ SOURCE (GLGETFIELD SOURCE (pop SPECS)
+ CONTEXT))))
+ (GO B)
+ C
+ (COND ((ATOM (SETQ DTYPE (GLXTRTYPE (CADR SOURCE))))
+ (SETQ DTYPE (GLXTRTYPE (GLGETSTR DTYPE)))))
+ (COND ((OR (NOT (PAIRP DTYPE))
+ (NE (CAR DTYPE)
+ 'LISTOF))
+ (GLERROR 'GLTHE
+ (LIST "The group name" NAME "has type" DTYPE
+ "which is not a legal group type."))))
+ (SETQ NEWCONTEXT (CONS NIL CONTEXT))
+ (GLADDSTR (SETQ LOOPVAR (GLMKVAR))
+ NAME
+ (CADR DTYPE)
+ NEWCONTEXT)
+ (SETQ LOOPCOND
+ (GLPREDICATE (LIST LOOPVAR (CADR DTYPE))
+ NEWCONTEXT
+ (MEMQ (pop EXPR)
+ '(who Who WHO which Which WHICH that That THAT))
+ NIL))
+ (SETQ TMP (GLGENCODE (LIST (COND (PLURALFLG 'SUBSET)
+ (T 'SOME))
+ (CAR SOURCE)
+ (LIST 'FUNCTION
+ (LIST 'LAMBDA
+ (LIST LOOPVAR)
+ (CAR LOOPCOND))))))
+ (RETURN (COND (PLURALFLG (LIST TMP (CADR SOURCE)))
+ (T (LIST (LIST 'CAR
+ TMP)
+ (CADR DTYPE)))))))
+
+
+% edited: 20-MAY-82 17:19
+% EXPR begins with THE. Parse the expression and return code in SOURCE
+% and path names in SPECS.
+(DE GLTHESPECS NIL
+(PROG NIL A (COND ((NULL EXPR)
+ (RETURN NIL))
+ ((MEMQ (CAR EXPR)
+ '(THE The the))
+ (pop EXPR)
+ (COND ((NULL EXPR)
+ (RETURN (GLERROR 'GLTHE
+ (LIST "Nothing following THE")))))))
+ (COND ((ATOM (CAR EXPR))
+ (GLSEPINIT (CAR EXPR))
+ (COND ((EQ (GLSEPNXT)
+ (CAR EXPR))
+ (SETQ SPECS (CONS (pop EXPR)
+ SPECS)))
+ (T (GLSEPCLR)
+ (SETQ SOURCE (GLDOEXPR NIL CONTEXT T))
+ (RETURN NIL))))
+ (T (SETQ SOURCE (GLDOEXPR NIL CONTEXT T))
+ (RETURN NIL)))
+
+% SPECS contains a path specification. See if there is any more.
+
+ (COND ((MEMQ (CAR EXPR)
+ '(OF Of of))
+ (pop EXPR)
+ (GO A)))))
+
+
+% edited: 14-DEC-81 10:51
+% Return a list of all transparent types defined for STR
+(DE GLTRANSPARENTTYPES (STR)
+(PROG (TTLIST)
+ (COND ((ATOM STR)
+ (SETQ STR (GLGETSTR STR))))
+ (GLTRANSPB STR)
+ (RETURN (REVERSIP TTLIST))))
+
+
+% edited: 13-NOV-81 15:37
+% Look for TRANSPARENT substructures for GLTRANSPARENTTYPES.
+(DE GLTRANSPB (STR)
+(COND ((NOT (PAIRP STR)))
+ ((EQ (CAR STR)
+ 'TRANSPARENT)
+ (SETQ TTLIST (CONS STR TTLIST)))
+ ((MEMQ (CAR STR)
+ '(LISTOF ALIST PROPLIST)))
+ (T (MAPC (CDR STR)
+ (FUNCTION GLTRANSPB)))))
+
+
+% edited: 4-JUN-82 11:18
+% Translate places where a PROG variable is initialized to a value as
+% allowed by Interlisp. This is done by adding a SETQ to set the
+% value of each PROG variable which is initialized. In some cases, a
+% change of variable name is required to preserve the same
+% semantics.
+(DE GLTRANSPROG (X)
+(PROG (TMP ARGVALS SETVARS)
+ (MAP (CADR X)
+ (FUNCTION (LAMBDA (Y)
+ (COND
+ ((PAIRP (CAR Y))
+
+% If possible, use the same variable; otherwise, make a new one.
+
+ (SETQ TMP
+ (COND
+ ((OR (SOME (CADR X)
+ (FUNCTION (LAMBDA (Z)
+ (AND
+ (PAIRP Z)
+ (GLOCCURS
+ (CAR Z)
+ (CADAR Y))))))
+ (SOME ARGVALS (FUNCTION (LAMBDA (Z)
+ (GLOCCURS
+ (CAAR Y)
+ Z)))))
+ (GLMKVAR))
+ (T (CAAR Y))))
+ (SETQ SETVARS (ACONC SETVARS (LIST 'SETQ
+ TMP
+ (CADAR Y))))
+ (SUBSTIP TMP (CAAR Y)
+ (CDDR X))
+ (SETQ ARGVALS (CONS (CADAR Y)
+ ARGVALS))
+ (RPLACA Y TMP))))))
+ (COND (SETVARS (RPLACD (CDR X)
+ (NCONC SETVARS (CDDR X)))))
+ (RETURN X)))
+
+
+% GSN 10-FEB-83 13:31
+% See if the type SUBTYPE matches the type TYPE, either directly or
+% because TYPE is a SUPER of SUBTYPE.
+(DE GLTYPEMATCH (SUBTYPE TYPE)
+(PROG NIL (SETQ SUBTYPE (GLXTRTYPE SUBTYPE))
+ (RETURN (OR (NULL SUBTYPE)
+ (NULL TYPE)
+ (EQ TYPE 'ANYTHING)
+ (EQUAL SUBTYPE TYPE)
+ (SOME (GLSUPERS SUBTYPE)
+ (FUNCTION (LAMBDA (Y)
+ (GLTYPEMATCH Y TYPE))))))))
+
+
+% GSN 3-FEB-83 14:41
+% Remove the GLISP-compiled definition and properties of GLAMBDAFN
+(DE GLUNCOMPILE (GLAMBDAFN)
+(PROG (SPECS SPECLST STR LST TMP)
+ (OR (GET GLAMBDAFN 'GLCOMPILED)
+ (SETQ SPECS (GET GLAMBDAFN 'GLSPECIALIZATION))
+ (RETURN NIL))
+ (COND ((NOT GLQUIETFLG)
+ (PRIN1 "uncompiling ")
+ (PRIN1 GLAMBDAFN)
+ (TERPRI)))
+ (PUT GLAMBDAFN 'GLCOMPILED
+ NIL)
+ (PUT GLAMBDAFN 'GLRESULTTYPE
+ NIL)
+ (GLUNSAVEDEF GLAMBDAFN)
+ (MAPC (GET GLAMBDAFN 'GLTYPESUSED)
+ (FUNCTION (LAMBDA (Y)
+ (PUT Y 'GLFNSUSEDIN
+ (DELETIP GLAMBDAFN (GET Y 'GLFNSUSEDIN))))))
+ (PUT GLAMBDAFN 'GLTYPESUSED
+ NIL)
+ (OR SPECS (RETURN NIL))
+
+% Uncompile a specialization of a generic function.
+
+
+% Remove the function definition so it will be garbage collected.
+
+ (PUTDDD GLAMBDAFN NIL)
+ A
+ (COND ((NULL SPECS)
+ (RETURN NIL)))
+ (SETQ SPECLST (pop SPECS))
+ (PUT (CAR SPECLST)
+ 'GLINSTANCEFNS
+ (DELETIP GLAMBDAFN (GET (CAR SPECLST)
+ 'GLINSTANCEFNS)))
+
+% Remove the specialization entry in the datatype where it was
+% created.
+
+ (OR (SETQ STR (GET (CADR SPECLST)
+ 'GLSTRUCTURE))
+ (GO A))
+ (SETQ LST (CDR STR))
+ LP
+ (COND ((NULL LST)
+ (GO A))
+ ((EQ (CAR LST)
+ (CADDR SPECLST))
+ (COND ((AND (SETQ TMP (ASSOC (CADDDR SPECLST)
+ (CADR LST)))
+ (EQ (CADR TMP)
+ GLAMBDAFN))
+ (RPLACA (CDR LST)
+ (DELETIP TMP (CADR LST)))))
+ (GO A))
+ (T (SETQ LST (CDDR LST))
+ (GO LP)))))
+
+
+% edited: 27-MAY-82 13:08
+% GLUNITOP calls a function to generate code for an operation on a
+% unit in a units package. UNITREC is the unit record for the units
+% package, LHS and RHS the code for the left-hand side and
+% right-hand side of the operation
+% (in general, the (QUOTE GET') code for each side) , and OP is the
+% operation to be performed.
+(DE GLUNITOP (LHS RHS OP)
+(PROG (TMP LST UNITREC)
+
+%
+
+ (SETQ LST GLUNITPKGS)
+ A
+ (COND ((NULL LST)
+ (RETURN NIL))
+ ((NOT (MEMQ (CAAR LHS)
+ (CADAR LST)))
+ (SETQ LST (CDR LST))
+ (GO A)))
+ (SETQ UNITREC (CAR LST))
+ (COND ((SETQ TMP (ASSOC OP (CADDR UNITREC)))
+ (RETURN (APPLY (CDR TMP)
+ (LIST LHS RHS)))))
+ (RETURN NIL)))
+
+
+% edited: 27-MAY-82 13:08
+% GLUNIT? tests a given structure to see if it is a unit of one of the
+% unit packages on GLUNITPKGS. If so, the value is the unit package
+% record for the unit package which matched.
+(DE GLUNIT? (STR)
+(PROG (UPS)
+ (SETQ UPS GLUNITPKGS)
+ LP
+ (COND ((NULL UPS)
+ (RETURN NIL))
+ ((APPLY (CAAR UPS)
+ (LIST STR))
+ (RETURN (CAR UPS))))
+ (SETQ UPS (CDR UPS))
+ (GO LP)))
+
+
+% GSN 28-JAN-83 11:15
+% Remove the GLISP-compiled definition of GLAMBDAFN
+(DE GLUNSAVEDEF (GLAMBDAFN)
+(GLPUTHOOK GLAMBDAFN))
+
+
+% GSN 27-JAN-83 13:58
+% Unwrap an expression X by removing extra stuff inserted during
+% compilation.
+(DE GLUNWRAP (X BUSY)
+(COND
+ ((NOT (PAIRP X))
+ X)
+ ((NOT (ATOM (CAR X)))
+ (ERROR 0 (LIST 'GLUNWRAP
+ X)))
+ ((CASEQ
+ (CAR X)
+ ('GO
+ X)
+ ((PROG2 PROGN)
+ (COND ((NULL (CDDR X))
+ (GLUNWRAP (CADR X)
+ BUSY))
+ (T (MAP (CDR X)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP
+ (CAR Y)
+ (AND BUSY (NULL (CDR Y))))))))
+ (GLEXPANDPROGN X BUSY NIL)
+ (COND ((NULL (CDDR X))
+ (CADR X))
+ (T X)))))
+ (PROG1 (COND ((NULL (CDDR X))
+ (GLUNWRAP (CADR X)
+ BUSY))
+ (T (MAP (CDR X)
+ (FUNCTION
+ (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP (CAR Y)
+ (AND BUSY
+ (EQ Y (CDR X))))))))
+ (COND (BUSY (GLEXPANDPROGN (CDR X)
+ BUSY NIL))
+ (T (RPLACA X 'PROGN)
+ (GLEXPANDPROGN X BUSY NIL)))
+ (COND ((NULL (CDDR X))
+ (CADR X))
+ (T X)))))
+ (FUNCTION (RPLACA (CDR X)
+ (GLUNWRAP (CADR X)
+ BUSY))
+ (MAP (CDDR X)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP (CAR Y)
+ T)))))
+ X)
+ ((MAP MAPC MAPCAR MAPCONC SUBSET SOME EVERY)
+ (GLUNWRAPMAP X BUSY))
+ (LAMBDA (MAP (CDDR X)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP (CAR Y)
+ (AND BUSY
+ (NULL (CDR Y))))))))
+ (GLEXPANDPROGN (CDR X)
+ BUSY NIL)
+ X)
+ (PROG (GLUNWRAPPROG X BUSY))
+ (COND (GLUNWRAPCOND X BUSY))
+ ((SELECTQ CASEQ)
+ (GLUNWRAPSELECTQ X BUSY))
+ ((UNION INTERSECTION LDIFFERENCE)
+ (GLUNWRAPINTERSECT X))
+ (T
+ (COND
+ ((AND (EQ (CAR X)
+ '*)
+ (EQ GLLISPDIALECT 'INTERLISP))
+ X)
+ ((AND (NOT BUSY)
+ (CDR X)
+ (NULL (CDDR X))
+ (GLPURE (CAR X)))
+ (GLUNWRAP (CADR X)
+ NIL))
+ (T (MAP (CDR X)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP (CAR Y)
+ T)))))
+ (COND
+ ((AND (CDR X)
+ (NULL (CDDR X))
+ (PAIRP (CADR X))
+ (GLCARCDR? (CAR X))
+ (GLCARCDR? (CAADR X))
+ (LESSP (PLUS (FlatSize2 (CAR X))
+ (FlatSize2 (CAADR X)))
+ 9))
+ (RPLACA X
+ (IMPLODE
+ (CONS 'C
+ (REVERSIP (CONS 'R
+ (NCONC (GLANYCARCDR?
+ (CAADR X))
+ (GLANYCARCDR?
+ (CAR X))))))))
+ (RPLACA (CDR X)
+ (CADADR X))
+ (GLUNWRAP X BUSY))
+ ((AND (GET (CAR X)
+ 'GLEVALWHENCONST)
+ (EVERY (CDR X)
+ (FUNCTION GLCONST?))
+ (OR (NOT (GET (CAR X)
+ 'GLARGSNUMBERP))
+ (EVERY (CDR X)
+ (FUNCTION NUMBERP))))
+ (EVAL X))
+ ((MEMQ (CAR X)
+ '(AND OR))
+ (GLUNWRAPLOG X))
+ (T X)))))))))
+
+
+% GSN 27-JAN-83 13:57
+% Unwrap a COND expression.
+(DE GLUNWRAPCOND (X BUSY)
+(PROG (RESULT)
+ (SETQ RESULT X)
+ A
+ (COND ((NULL (CDR RESULT))
+ (GO B)))
+ (RPLACA (CADR RESULT)
+ (GLUNWRAP (CAADR RESULT)
+ T))
+ (COND ((EQ (CAADR RESULT)
+ NIL)
+ (RPLACD RESULT (CDDR RESULT))
+ (GO A))
+ (T (MAP (CDADR RESULT)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP
+ (CAR Y)
+ (AND BUSY (NULL (CDR Y))))))))
+ (GLEXPANDPROGN (CADR RESULT)
+ BUSY NIL)))
+ (COND ((EQ (CAADR RESULT)
+ T)
+ (RPLACD (CDR RESULT)
+ NIL)))
+ (SETQ RESULT (CDR RESULT))
+ (GO A)
+ B
+ (COND ((AND (NULL (CDDR X))
+ (EQ (CAADR X)
+ T))
+ (RETURN (CONS 'PROGN
+ (CDADR X))))
+ (T (RETURN X)))))
+
+
+% GSN 17-FEB-83 13:40
+% Optimize intersections and unions of subsets of the same set:
+% (INTERSECT (SUBSET S P) (SUBSET S Q)) -> (SUBSET S (AND P Q))
+(DE GLUNWRAPINTERSECT (CODE)
+(PROG
+ (LHS RHS P Q QQ SA SB)
+ (SETQ LHS (GLUNWRAP (CADR CODE)
+ T))
+ (SETQ RHS (GLUNWRAP (CADDR CODE)
+ T))
+ (OR (AND (PAIRP LHS)
+ (PAIRP RHS)
+ (EQ (CAR LHS)
+ 'SUBSET)
+ (EQ (CAR RHS)
+ 'SUBSET))
+ (GO OUT))
+ (PROGN (SETQ SA (GLUNWRAP (CADR LHS)
+ T))
+ (SETQ SB (GLUNWRAP (CADR RHS)
+ T)))
+
+% Make sure the sets are the same.
+
+ (OR (EQUAL SA SB)
+ (GO OUT))
+ (PROGN (SETQ P (GLXTRFN (CADDR LHS)))
+ (SETQ Q (GLXTRFN (CADDR RHS))))
+ (SETQ QQ (SUBST (CAR P)
+ (CAR Q)
+ (CADR Q)))
+ (RETURN
+ (GLGENCODE
+ (LIST 'SUBSET
+ SA
+ (LIST 'FUNCTION
+ (LIST 'LAMBDA
+ (LIST (CAR P))
+ (GLUNWRAP (CASEQ (CAR CODE)
+ (INTERSECTION (LIST 'AND
+ (CADR P)
+ QQ))
+ (UNION (LIST 'OR
+ (CADR P)
+ QQ))
+ (LDIFFERENCE
+ (LIST 'AND
+ (CADR P)
+ (LIST 'NOT
+ QQ)))
+ (T (ERROR 0 NIL)))
+ T))))))
+ OUT
+ (MAP (CDR CODE)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP (CAR Y)
+ T)))))
+ (RETURN CODE)))
+
+
+% GSN 16-MAR-83 10:50
+% Unwrap a logical expression by performing constant transformations
+% and splicing in sublists of the same type, e.g., (AND X (AND Y Z))
+% -> (AND X Y Z) .
+(DE GLUNWRAPLOG (X)
+(PROG (Y LAST)
+ (SETQ Y (CDR X))
+ (SETQ LAST X)
+ LP
+ (COND ((NULL Y)
+ (GO OUT))
+ ((OR (AND (NULL (CAR Y))
+ (EQ (CAR X)
+ 'AND))
+ (AND (EQ (CAR Y)
+ T)
+ (EQ (CAR X)
+ 'OR)))
+ (RPLACD Y NIL))
+ ((OR (AND (NULL (CAR Y))
+ (EQ (CAR X)
+ 'OR))
+ (AND (EQ (CAR Y)
+ T)
+ (EQ (CAR X)
+ 'AND)))
+ (SETQ Y (CDR Y))
+ (RPLACD LAST Y)
+ (GO LP))
+ ((AND (PAIRP (CAR Y))
+ (EQ (CAAR Y)
+ (CAR X)))
+ (RPLACD (LASTPAIR (CAR Y))
+ (CDR Y))
+ (RPLACD Y (CDDAR Y))
+ (RPLACA Y (CADAR Y))))
+ (SETQ Y (CDR Y))
+ (SETQ LAST (CDR LAST))
+ (GO LP)
+ OUT
+ (COND ((NULL (CDR X))
+ (RETURN (EQ (CAR X)
+ 'AND)))
+ ((NULL (CDDR X))
+ (RETURN (CADR X))))
+ (RETURN X)))
+
+
+% edited: 19-OCT-82 16:03
+% Unwrap and optimize mapping-type functions.
+(DE GLUNWRAPMAP (X BUSY)
+(PROG (LST FN OUTSIDE INSIDE OUTFN INFN NEWFN NEWMAP TMPVAR NEWLST)
+ (PROGN (SETQ LST (GLUNWRAP (CADR X)
+ T))
+ (SETQ FN (GLUNWRAP (CADDR X)
+ (NOT (MEMQ (CAR X)
+ '(MAPC MAP))))))
+ (COND ((OR (NOT (MEMQ (SETQ OUTFN (CAR X))
+ '(SUBSET MAPCAR MAPC MAPCONC)))
+ (NOT (AND (PAIRP LST)
+ (MEMQ (SETQ INFN (CAR LST))
+ '(SUBSET MAPCAR)))))
+ (GO OUT)))
+
+% Optimize compositions of mapping functions to avoid construction of
+% lists of intermediate results.
+
+
+% These optimizations are not correct if the mapping functions have
+% interdependent side-effects. However, these are likely to be very
+% rare, so we do it anyway.
+
+ (SETQ OUTSIDE (GLXTRFN FN))
+ (SETQ INSIDE (GLXTRFN (PROGN (SETQ NEWLST (CADR LST))
+ (CADDR LST))))
+ (CASEQ INFN (SUBSET (CASEQ OUTFN ((SUBSET MAPCONC)
+ (SETQ NEWMAP OUTFN)
+ (SETQ NEWFN (LIST 'AND
+ (CADR INSIDE)
+ (SUBST (CAR INSIDE)
+ (CAR OUTSIDE)
+ (CADR OUTSIDE)))))
+ (MAPCAR (SETQ NEWMAP 'MAPCONC)
+ (SETQ
+ NEWFN
+ (LIST 'AND
+ (CADR INSIDE)
+ (LIST 'CONS
+ (SUBST (CAR INSIDE)
+ (CAR OUTSIDE)
+ (CADR OUTSIDE))
+ NIL))))
+ (MAPC (SETQ NEWMAP 'MAPC)
+ (SETQ NEWFN (LIST 'AND
+ (CADR INSIDE)
+ (SUBST (CAR INSIDE)
+ (CAR OUTSIDE)
+ (CADR OUTSIDE))
+ )))
+ (T (ERROR 0 NIL))))
+ (MAPCAR (SETQ NEWFN (LIST 'PROG
+ (LIST (SETQ TMPVAR (GLMKVAR)))
+ (LIST 'SETQ
+ TMPVAR
+ (CADR INSIDE))
+ (LIST 'RETURN
+ '*GLCODE*)))
+ (CASEQ OUTFN (SUBSET (SETQ NEWMAP 'MAPCONC)
+ (SETQ
+ NEWFN
+ (SUBST (LIST 'AND
+ (SUBST TMPVAR
+ (CAR OUTSIDE)
+ (CADR OUTSIDE))
+ (LIST 'CONS
+ TMPVAR NIL))
+ '*GLCODE*
+ NEWFN)))
+ (MAPCAR (SETQ NEWMAP 'MAPCAR)
+ (SETQ NEWFN (SUBST (SUBST TMPVAR
+ (CAR OUTSIDE)
+ (CADR OUTSIDE))
+ '*GLCODE*
+ NEWFN)))
+ (MAPC (SETQ NEWMAP 'MAPC)
+ (SETQ NEWFN (SUBST (SUBST TMPVAR
+ (CAR OUTSIDE)
+ (CADR OUTSIDE))
+ '*GLCODE*
+ NEWFN)))
+ (T (ERROR 0 NIL))))
+ (T (ERROR 0 NIL)))
+ (RETURN (GLUNWRAP (GLGENCODE (LIST NEWMAP NEWLST
+ (LIST 'FUNCTION
+ (LIST 'LAMBDA
+ (LIST (CAR INSIDE))
+ NEWFN))))
+ BUSY))
+ OUT
+ (RETURN (GLGENCODE (LIST OUTFN LST FN)))))
+
+
+% GSN 27-JAN-83 13:57
+% Unwrap a PROG expression.
+(DE GLUNWRAPPROG (X BUSY)
+(PROG (LAST)
+ (COND ((NE GLLISPDIALECT 'INTERLISP)
+ (GLTRANSPROG X)))
+
+% First see if the PROG is not busy and ends with a RETURN.
+
+ (COND ((AND (NOT BUSY)
+ (SETQ LAST (LASTPAIR X))
+ (PAIRP (CAR LAST))
+ (EQ (CAAR LAST)
+ 'RETURN))
+
+% Remove the RETURN. If atomic, remove the atom also.
+
+ (COND ((ATOM (CADAR LAST))
+ (RPLACD (NLEFT X 2)
+ NIL))
+ (T (RPLACA LAST (CADAR LAST))))))
+
+% Do any initializations of PROG variables.
+
+ (MAPC (CADR X)
+ (FUNCTION (LAMBDA (Y)
+ (COND
+ ((PAIRP Y)
+ (RPLACA (CDR Y)
+ (GLUNWRAP (CADR Y)
+ T)))))))
+ (MAP (CDDR X)
+ (FUNCTION (LAMBDA (Y)
+ (RPLACA Y (GLUNWRAP (CAR Y)
+ NIL)))))
+ (GLEXPANDPROGN (CDR X)
+ BUSY T)
+ (RETURN X)))
+
+
+% GSN 27-JAN-83 13:57
+% Unwrap a SELECTQ or CASEQ expression.
+(DE GLUNWRAPSELECTQ (X BUSY)
+(PROG (L SELECTOR)
+
+% First unwrap the component expressions.
+
+ (RPLACA (CDR X)
+ (GLUNWRAP (CADR X)
+ T))
+ (MAP (CDDR X)
+ (FUNCTION
+ (LAMBDA (Y)
+ (COND
+ ((OR (CDR Y)
+ (EQ (CAR X)
+ 'CASEQ))
+ (MAP (CDAR Y)
+ (FUNCTION (LAMBDA (Z)
+ (RPLACA Z
+ (GLUNWRAP
+ (CAR Z)
+ (AND BUSY (NULL (CDR Z))))))))
+ (GLEXPANDPROGN (CAR Y)
+ BUSY NIL))
+ (T (RPLACA Y (GLUNWRAP (CAR Y)
+ BUSY)))))))
+
+% Test if the selector is a compile-time constant.
+
+ (COND ((NOT (GLCONST? (CADR X)))
+ (RETURN X)))
+
+% Evaluate the selection at compile time.
+
+ (SETQ SELECTOR (GLCONSTVAL (CADR X)))
+ (SETQ L (CDDR X))
+ LP
+ (COND ((NULL L)
+ (RETURN NIL))
+ ((AND (NULL (CDR L))
+ (EQ (CAR X)
+ 'SELECTQ))
+ (RETURN (CAR L)))
+ ((AND (EQ (CAR X)
+ 'CASEQ)
+ (EQ (CAAR L)
+ T))
+ (RETURN (GLUNWRAP (CONS 'PROGN
+ (CDAR L))
+ BUSY)))
+ ((OR (EQ SELECTOR (CAAR L))
+ (AND (PAIRP (CAAR L))
+ (MEMQ SELECTOR (CAAR L))))
+ (RETURN (GLUNWRAP (CONS 'PROGN
+ (CDAR L))
+ BUSY))))
+ (SETQ L (CDR L))
+ (GO LP)))
+
+
+% edited: 5-MAY-82 15:49
+% Update the type of VAR to be TYPE.
+(DE GLUPDATEVARTYPE (VAR TYPE)
+(PROG (CTXENT)
+ (COND ((NULL TYPE))
+ ((SETQ CTXENT (GLFINDVARINCTX VAR CONTEXT))
+ (COND ((NULL (CADDR CTXENT))
+ (RPLACA (CDDR CTXENT)
+ TYPE))))
+ (T (GLADDSTR VAR NIL TYPE CONTEXT)))))
+
+
+% GSN 23-JAN-83 15:31
+% edited: 7-Apr-81 10:44
+% Process a user-function, i.e., any function which is not specially
+% compiled by GLISP. The function is tested to see if it is one
+% which a unit package wants to compile specially; if not, the
+% function is compiled by GLUSERFNB.
+(DE GLUSERFN (EXPR)
+(PROG (FNNAME TMP UPS)
+ (SETQ FNNAME (CAR EXPR))
+
+% First see if a user structure-name package wants to intercept this
+% function call.
+
+ (SETQ UPS GLUSERSTRNAMES)
+ LPA
+ (COND ((NULL UPS)
+ (GO B))
+ ((SETQ TMP (ASSOC FNNAME (CAR (CDDDDR (CAR UPS)))))
+ (RETURN (APPLY (CDR TMP)
+ (LIST EXPR CONTEXT)))))
+ (SETQ UPS (CDR UPS))
+ (GO LPA)
+ B
+
+% Test the function name to see if it is a function which some unit
+% package would like to intercept and compile specially.
+
+ (SETQ UPS GLUNITPKGS)
+ LP
+ (COND ((NULL UPS)
+ (GO C))
+ ((AND (MEMQ FNNAME (CAR (CDDDDR (CAR UPS))))
+ (SETQ TMP (ASSOC 'UNITFN
+ (CADDR (CAR UPS)))))
+ (RETURN (APPLY (CDR TMP)
+ (LIST EXPR CONTEXT)))))
+ (SETQ UPS (CDR UPS))
+ (GO LP)
+ C
+ (COND ((AND (NOT (UNBOUNDP 'GLFNSUBS))
+ (SETQ TMP (ASSOC FNNAME GLFNSUBS)))
+ (RETURN (GLUSERFNB (CONS (CDR TMP)
+ (CDR EXPR)))))
+ (T (RETURN (GLUSERFNB EXPR))))))
+
+
+% GSN 23-JAN-83 15:54
+% edited: 7-Apr-81 10:44
+% Parse an arbitrary function by getting the function name and then
+% calling GLDOEXPR to get the arguments.
+(DE GLUSERFNB (EXPR)
+(PROG (ARGS ARGTYPES FNNAME TMP)
+ (SETQ FNNAME (pop EXPR))
+ A
+ (COND ((NULL EXPR)
+ (SETQ ARGS (REVERSIP ARGS))
+ (SETQ ARGTYPES (REVERSIP ARGTYPES))
+ (RETURN (COND ((AND (GET FNNAME 'GLEVALWHENCONST)
+ (EVERY ARGS (FUNCTION GLCONST?)))
+ (LIST (EVAL (CONS FNNAME ARGS))
+ (GLRESULTTYPE FNNAME ARGTYPES)))
+ (T (LIST (CONS FNNAME ARGS)
+ (GLRESULTTYPE FNNAME ARGTYPES))))))
+ ((SETQ TMP (OR (GLDOEXPR NIL CONTEXT T)
+ (PROG1 (GLERROR 'GLUSERFNB
+ (LIST
+ "Function call contains illegal item. EXPR ="
+ EXPR))
+ (SETQ EXPR NIL))))
+ (SETQ ARGS (CONS (CAR TMP)
+ ARGS))
+ (SETQ ARGTYPES (CONS (CADR TMP)
+ ARGTYPES))
+ (GO A)))))
+
+
+% edited: 24-AUG-82 17:40
+% Get the arguments to an function call for use by a user compilation
+% function.
+(DE GLUSERGETARGS (EXPR CONTEXT)
+(PROG (ARGS TMP)
+ (pop EXPR)
+ A
+ (COND ((NULL EXPR)
+ (RETURN (REVERSIP ARGS)))
+ ((SETQ TMP (OR (GLDOEXPR NIL CONTEXT T)
+ (PROG1 (GLERROR 'GLUSERFNB
+ (LIST
+ "Function call contains illegal item. EXPR ="
+ EXPR))
+ (SETQ EXPR NIL))))
+ (SETQ ARGS (CONS TMP ARGS))
+ (GO A)))))
+
+
+% GSN 10-FEB-83 16:01
+% Try to perform an operation on a user-defined structure, which is
+% LHS. The type of LHS is looked up on GLUSERSTRNAMES, and if found,
+% the appropriate user function is called.
+(DE GLUSERSTROP (LHS OP RHS)
+(PROG (TMP DES TMPB)
+ (SETQ DES (CADR LHS))
+ (COND ((NULL DES)
+ (RETURN NIL))
+ ((ATOM DES)
+ (COND ((NE (SETQ TMP (GLGETSTR DES))
+ DES)
+ (RETURN (GLUSERSTROP (LIST (CAR LHS)
+ TMP)
+ OP RHS)))
+ (T (RETURN NIL))))
+ ((NOT (PAIRP DES))
+ (RETURN NIL))
+ ((AND (SETQ TMP (ASSOC (CAR DES)
+ GLUSERSTRNAMES))
+ (SETQ TMPB (ASSOC OP (CADDDR TMP))))
+ (RETURN (APPLY (CDR TMPB)
+ (LIST LHS RHS))))
+ (T (RETURN NIL)))))
+
+
+% GSN 10-FEB-83 12:57
+% Get the value of the property PROP from SOURCE, whose type is given
+% by TYPE. The property may be a field in the structure, or may be a
+% PROP virtual field.
+% DESLIST is a list of object types which have previously been tried,
+% so that a compiler loop can be prevented.
+(DE GLVALUE (SOURCE PROP TYPE DESLIST)
+(PROG (TMP PROPL TRANS FETCHCODE)
+ (COND ((MEMQ TYPE DESLIST)
+ (RETURN NIL))
+ ((SETQ TMP (GLSTRFN PROP TYPE DESLIST))
+ (RETURN (GLSTRVAL TMP SOURCE)))
+ ((SETQ PROPL (GLSTRPROP TYPE 'PROP
+ PROP NIL))
+ (SETQ TMP (GLCOMPMSGL (LIST SOURCE TYPE)
+ 'PROP
+ PROPL NIL CONTEXT))
+ (RETURN TMP)))
+
+% See if the value can be found in a TRANSPARENT subobject.
+
+ (SETQ TRANS (GLTRANSPARENTTYPES TYPE))
+ B
+ (COND ((NULL TRANS)
+ (RETURN NIL))
+ ((SETQ TMP (GLVALUE '*GL*
+ PROP
+ (GLXTRTYPE (CAR TRANS))
+ (CONS (CAR TRANS)
+ DESLIST)))
+ (SETQ FETCHCODE (GLSTRFN (CAR TRANS)
+ TYPE NIL))
+ (GLSTRVAL TMP (CAR FETCHCODE))
+ (GLSTRVAL TMP SOURCE)
+ (RETURN TMP))
+ ((SETQ TMP (CDR TMP))
+ (GO B)))))
+
+
+% edited: 16-DEC-81 12:00
+% Get the structure-description for a variable in the specified
+% context.
+(DE GLVARTYPE (VAR CONTEXT)
+(PROG (TMP)
+ (RETURN (COND ((SETQ TMP (GLFINDVARINCTX VAR CONTEXT))
+ (OR (CADDR TMP)
+ '*NIL*))
+ (T NIL)))))
+
+
+% edited: 3-DEC-82 10:24
+% Extract the code and variable from a FUNCTION list. If there is no
+% variable, a new one is created. The result is a list of the
+% variable and code.
+(DE GLXTRFN (FNLST)
+(PROG (TMP)
+
+% If only the function name is specified, make a LAMBDA form.
+
+ (COND ((ATOM (CADR FNLST))
+ (RPLACA (CDR FNLST)
+ (LIST 'LAMBDA
+ (LIST (SETQ TMP (GLMKVAR)))
+ (LIST (CADR FNLST)
+ TMP)))))
+ (COND ((CDDDR (CADR FNLST))
+ (RPLACD (CDADR FNLST)
+ (LIST (CONS 'PROGN
+ (CDDADR FNLST))))))
+ (RETURN (LIST (CAADR (CADR FNLST))
+ (CADDR (CADR FNLST))))))
+
+
+% edited: 26-JUL-82 14:03
+% Extract an atomic type name from a type spec which may be either
+% <type> or (A <type>) .
+(DE GLXTRTYPE (TYPE)
+(COND ((ATOM TYPE)
+ TYPE)
+ ((NOT (PAIRP TYPE))
+ NIL)
+ ((AND (OR (GL-A-AN? (CAR TYPE))
+ (EQ (CAR TYPE)
+ 'TRANSPARENT))
+ (CDR TYPE)
+ (ATOM (CADR TYPE)))
+ (CADR TYPE))
+ ((MEMQ (CAR TYPE)
+ GLTYPENAMES)
+ TYPE)
+ ((ASSOC (CAR TYPE)
+ GLUSERSTRNAMES)
+ TYPE)
+ ((AND (ATOM (CAR TYPE))
+ (CDR TYPE))
+ (GLXTRTYPE (CADR TYPE)))
+ (T (GLERROR 'GLXTRTYPE
+ (LIST TYPE "is an illegal type specification."))
+ NIL)))
+
+
+% edited: 26-JUL-82 14:02
+% Extract a -real- type from a type spec.
+(DE GLXTRTYPEB (TYPE)
+(COND ((NULL TYPE)
+ NIL)
+ ((ATOM TYPE)
+ (COND ((MEMQ TYPE GLBASICTYPES)
+ TYPE)
+ (T (GLXTRTYPEB (GLGETSTR TYPE)))))
+ ((NOT (PAIRP TYPE))
+ NIL)
+ ((MEMQ (CAR TYPE)
+ GLTYPENAMES)
+ TYPE)
+ ((ASSOC (CAR TYPE)
+ GLUSERSTRNAMES)
+ TYPE)
+ ((AND (ATOM (CAR TYPE))
+ (CDR TYPE))
+ (GLXTRTYPEB (CADR TYPE)))
+ (T (GLERROR 'GLXTRTYPE
+ (LIST TYPE "is an illegal type specification."))
+ NIL)))
+
+
+% edited: 1-NOV-82 16:38
+% Extract a -real- type from a type spec.
+(DE GLXTRTYPEC (TYPE)
+(AND (ATOM TYPE)
+ (NOT (MEMQ TYPE GLBASICTYPES))
+ (GLXTRTYPE (GLGETSTR TYPE))))
+
+
+% GSN 9-FEB-83 16:46
+(DF SEND (GLISPSENDARGS)
+(GLSENDB (EVAL (CAR GLISPSENDARGS))
+ NIL
+ (CADR GLISPSENDARGS)
+ 'MSG
+ (MAPCAR (CDDR GLISPSENDARGS)
+ (FUNCTION EVAL))))
+
+
+% GSN 9-FEB-83 16:48
+(DF SENDC (GLISPSENDARGS)
+(GLSENDB (EVAL (CAR GLISPSENDARGS))
+ (CADR GLISPSENDARGS)
+ (CADDR GLISPSENDARGS)
+ 'MSG
+ (MAPCAR (CDDDR GLISPSENDARGS)
+ (FUNCTION EVAL))))
+
+
+% GSN 9-FEB-83 16:46
+(DF SENDPROP (GLISPSENDPROPARGS)
+(GLSENDB (EVAL (CAR GLISPSENDPROPARGS))
+ NIL
+ (CADR GLISPSENDPROPARGS)
+ (CADDR GLISPSENDPROPARGS)
+ (MAPCAR (CDDDR GLISPSENDPROPARGS)
+ (FUNCTION EVAL))))
+
+
+% GSN 9-FEB-83 16:48
+(DF SENDPROPC (GLISPSENDPROPARGS)
+(GLSENDB (EVAL (CAR GLISPSENDPROPARGS))
+ (CADR GLISPSENDPROPARGS)
+ (CADDR GLISPSENDPROPARGS)
+ (CADDDR GLISPSENDPROPARGS)
+ (MAPCAR (CDDDDR GLISPSENDPROPARGS)
+ (FUNCTION EVAL))))
+
+(SETQ GLBASICTYPES '(ATOM INTEGER REAL NUMBER STRING BOOLEAN ANYTHING))
+
+(SETQ GLTYPENAMES '(CONS LIST RECORD LISTOF ALIST ATOM OBJECT LISTOBJECT
+ ATOMOBJECT))
+
+(SETQ GLOBJECTNAMES NIL)
+
+
+(GLISPOBJECTS
+
+
+(GLTYPE (ATOM (PROPLIST (GLSTRUCTURE (CONS (STRDES ANYTHING)
+ (PROPLIST (PROP (LISTOF GLPROPENTRY)
+ )
+ (ADJ (LISTOF GLPROPENTRY))
+ (ISA (LISTOF GLPROPENTRY))
+ (MSG (LISTOF GLPROPENTRY))
+ (DOC ANYTHING)
+ (SUPERS (LISTOF GLTYPE))))
+ )
+ (GLISPATOMNUMBER INTEGER)
+ (GLPROPFNS (ALIST (STR (LISTOF GLPROPFNENTRY))
+ (PROP (LISTOF GLPROPFNENTRY))
+ (ADJ (LISTOF GLPROPFNENTRY))
+ (ISA (LISTOF GLPROPFNENTRY))
+ (MSG (LISTOF GLPROPFNENTRY))))
+ (GLFNSUSEDIN (LISTOF GLFUNCTION))))
+PROP ((PROPS (PROP))
+ (ADJS (ADJ))
+ (ISAS (ISA))
+ (MSGS (MSG))))
+
+
+(GLPROPENTRY (CONS (NAME ATOM)
+ (CONS (CODE ANYTHING)
+ (PROPLIST (RESULT GLTYPE)
+ (OPEN BOOLEAN))))
+PROP ((SHORTVALUE (NAME))))
+
+
+(GLPROPFNENTRY (LIST (NAME ATOM)
+ (CODE ANYTHING)
+ (RESULT GLTYPE)))
+
+
+(GLFUNCTION (ATOM (PROPLIST (GLORIGINALEXPR ANYTHING)
+ (GLCOMPILED ANYTHING)
+ (GLRESULTTYPE ANYTHING)
+ (GLARGUMENTTYPES (LISTOF ANYTHING))
+ (GLTYPESUSED (LISTOF GLTYPE)))))
+
+)
+
+
+(SETQ GLLISPDIALECT 'PSL)
+
+(GLINIT)
ADDED psl-1983/3-1/glisp/glprop.sl
Index: psl-1983/3-1/glisp/glprop.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glprop.sl
@@ -0,0 +1,46 @@
+
+% GSN 11-JAN-83 09:59
+% Create a function call to retrieve the field IND from a
+% property-list type structure. FLG is true if a PROPLIST is inside
+% an ATOM structure.
+(DE GLPROPSTRFN (IND DES DESLIST FLG)
+(PROG (DESIND TMP RECNAME N)
+
+% Handle a PROPLIST by looking inside each property for IND.
+
+ (COND ((AND (EQ (SETQ DESIND (pop DES))
+ 'RECORD)
+ (ATOM (CAR DES)))
+ (SETQ RECNAME (pop DES))))
+ (SETQ N 0)
+ P
+ (COND ((NULL DES)
+ (RETURN NIL))
+ ((AND (PAIRP (CAR DES))
+ (ATOM (CAAR DES))
+ (CDAR DES)
+ (SETQ TMP (GLSTRFN IND (CAR DES)
+ DESLIST)))
+ (SETQ TMP (GLSTRVAL
+ TMP
+(glgencode (CASEQ DESIND (ALIST (LIST 'GLGETASSOC
+ (KWOTE (CAAR DES))
+ '*GL*))
+ ((RECORD OBJECT)
+ (COND ((EQ DESIND 'OBJECT)
+ (SETQ N (ADD1 N))))
+ (LIST 'GetV
+ '*GL*
+ N))
+ ((PROPLIST ATOMOBJECT)
+ (LIST (COND ((OR FLG (EQ DESIND 'ATOMOBJECT))
+ 'GETPROP)
+ (T 'LISTGET))
+ '*GL*
+ (KWOTE (CAAR DES))))))))
+
+ (RETURN TMP))
+ (T (pop DES)
+ (SETQ N (ADD1 N))
+ (GO P)))))
+
ADDED psl-1983/3-1/glisp/glscan.sl
Index: psl-1983/3-1/glisp/glscan.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/glscan.sl
@@ -0,0 +1,8 @@
+(setq GLispScanTable!* '
+[17 11 11 11 11 11 11 11 11 17 17 11 17 17 11 11 11 11 11 11 11 11 11 11
+11 11 11 11 11 11 11 11 17 14 15 11 11 12 11 11 11 11 13 19 11 18 20 11
+0 1 2 3 4 5 6 7 8 9 13 11 13 11 13 11 11 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 11 10 11 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+11 11 11 11 11 GLispDipthong])
+
ADDED psl-1983/3-1/glisp/gltail.psl
Index: psl-1983/3-1/glisp/gltail.psl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltail.psl
@@ -0,0 +1,207 @@
+%
+% GLTAIL.PSL.4 18 Feb. 1983
+%
+% FILE OF FUNCTIONS FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
+% G. NOVAK 20 OCTOBER 1982
+%
+
+
+(DE GETDDD (X)
+ (COND ((PAIRP (GETD X)) (CDR (GETD X)))
+ (T NIL)))
+
+(DE PUTDDD (FN DEF) (REMD FN) (PUTD FN 'EXPR DEF))
+
+
+(DE LISTGET (L PROP)
+ (COND ((NOT (PAIRP L)) NIL)
+ ((EQ (CAR L) PROP) (CADR L))
+ (T (LISTGET (CDDR L) PROP) )) )
+
+
+
+% NOTE -- THIS VERSION OF NLEFT ONLY WORKS FOR N=2.
+(DE NLEFT (L N)
+ (COND ((NOT (EQN N 2)) (ERROR 0 N))
+ ((NULL L) NIL)
+ ((NULL (CDDR L)) L)
+ (T (NLEFT (CDR L) N) )) )
+
+
+(DE NLISTP (X) (NOT (PAIRP X)))
+(DF COMMENT (X) NIL)
+
+
+% ASSUME EVERYTHING UPPER-CASE FOR PSL.
+(DE U-CASEP (X) T)
+(de glucase (x) x)
+
+
+% PARTIAL IMPLEMENTATION OF SUBATOM FOR POSITIVE NUMBERS.
+(DE SUBATOM (ATM N M)
+ (PROG (LST SZ)
+ (setq sz (flatsize2 atm))
+ (cond ((minusp n) (setq n (add1 (plus sz n)))))
+ (cond ((minusp m) (setq m (add1 (plus sz m)))))
+ (COND ((GREATERP M sz)(RETURN NIL)))
+A (COND ((GREATERP N M)(RETURN (AND LST (IMPLODE (REVERSIP LST))))))
+ (SETQ LST (CONS (GLNTHCHAR ATM N) LST))
+ (COND ((MEMQ (CAR LST) '(!' !, !!))
+ (RPLACD LST (CONS (QUOTE !!) (CDR LST))) ))
+ (SETQ N (ADD1 N))
+ (GO A) ))
+
+
+% FIND THE STRING POSITION IN ATOM ATM WHERE A CHARACTER IN THE
+% BIT TABLE BITTBL OCCURS, STARTING WITH CHARACTER N.
+(DE STRPOSL (BITTBL ATM N)
+ (PROG (NC)
+ (COND ((NULL N)(SETQ N 1)))
+ (SETQ NC (FLATSIZE2 ATM))
+A (COND ((GREATERP N NC)(RETURN NIL))
+ ((INDX GLSEPBITTBL (id2int (GLNTHCHAR ATM N)))(RETURN N)))
+ (SETQ N (ADD1 N))
+ (GO A) ))
+
+% MAKE A BIT TABLE FROM A LIST OF CHARACTERS.
+(DE MAKEBITTABLE (L)
+ (PROG ()
+ (SETQ GLSEPBITTBL (MkVect 255))
+ (MAPC L (FUNCTION (LAMBDA (X)
+ (PutV GLSEPBITTBL (id2int X) T) )))
+ (RETURN GLSEPBITTBL) ))
+
+
+% Fexpr for defining GLISP functions.
+(df dg (x)
+ (put (car x) 'gloriginalexpr (cons 'lambda (cdr x)))
+ (glputhook (car x)) )
+
+% Put the hook macro onto a function to cause auto compilation.
+(df glputhook (x)
+ (put x 'glcompiled nil)
+ (putd x 'macro '(lambda (gldgform)(glhook gldgform))) )
+
+% Hook for compiling a GLISP function on its first call.
+(de glhook (gldgform) (glcc (car gldgform)) gldgform)
+
+% Interlisp-style NTHCHAR.
+(de glnthchar (x n)
+ (prog (s l)
+ (setq s (id2string x))
+ (setq l (size s))
+ (cond ((minusp n)(setq n (add1 (plus l n))))
+ (t (setq n (sub1 n))))
+ (cond ((or (minusp n)(greaterp n l))(return nil)))
+ (return (int2id (indx s n)))))
+
+
+% FIND FIRST ELEMENT OF A LIST FOR WHICH FN IS TRUE
+(DE SOME (L FN)
+ (COND ((NULL L) NIL)
+ ((APPLY FN (LIST (CAR L))) L)
+ (T (SOME (CDR L) FN))))
+
+% TEST IF FN IS TRUE FOR EVERY ELEMENT OF A LIST
+% SOME and EVERY switched FN and L
+(DE EVERY (L FN)
+ (COND ((NULL L) T)
+ ((APPLY FN (LIST (CAR L))) (EVERY (CDR L) FN))
+ (T NIL)))
+
+% SUBSET OF A LIST FOR WHICH FN IS TRUE
+(DE SUBSET (L FN)
+ (PROG (RESULT)
+ A (COND ((NULL L)(RETURN (REVERSIP RESULT)))
+ ((APPLY FN (LIST (CAR L)))
+ (SETQ RESULT (CONS (CAR L) RESULT))))
+ (SETQ L (CDR L))
+ (GO A)))
+
+(DE REMOVE (X L) (DELETE X L))
+
+% LIST DIFFERENCE X - Y
+(DE LDIFFERENCE (X Y)
+ (MAPCAN X (FUNCTION (LAMBDA (Z)
+ (COND ((MEMQ Z Y) NIL)
+ (T (CONS Z NIL)))))))
+
+% FIRST A FEW FUNCTION DEFINITIONS.
+
+% GET FUNCTION DEFINITION FOR THE GLISP COMPILER.
+(DE GLGETD (FN)
+ (OR (and (or (null (get fn 'glcompiled))
+ (eq (getddd fn) (get fn 'glcompiled)))
+ (GET FN 'GLORIGINALEXPR))
+ (GETDDD FN)))
+
+(DE GLGETDB (FN) (GLGETD FN))
+
+(DE GLAMBDATRAN (GLEXPR)
+ (PROG (NEWEXPR)
+ (SETQ GLLASTFNCOMPILED FAULTFN)
+ (PUT FAULTFN 'GLORIGINALEXPR GLEXPR)
+ (COND ((SETQ NEWEXPR (GLCOMP FAULTFN GLEXPR NIL NIL NIL))
+ (putddd FAULTFN NEWEXPR)
+ (put faultfn 'glcompiled newexpr) ))
+ (RETURN NEWEXPR) ))
+
+(DE GLERROR (FN MSGLST)
+ (PROG ()
+ (TERPRI)
+ (PRIN2 "GLISP error detected by ")
+ (PRIN1 FN)
+ (PRIN2 " in function ")
+ (PRINT FAULTFN)
+ (MAPC MSGLST (FUNCTION (LAMBDA (X) (PRIN1 X)(SPACES 1))))
+ (TERPRI)
+ (PRIN2 "in expression: ")
+ (PRINT (CAR EXPRSTACK))
+ (TERPRI)
+ (PRIN2 "within expression: ")
+ (PRINT (CADR EXPRSTACK))
+ (COND (GLBREAKONERROR (ERROR 0 (CAR EXPRSTACK))))
+ (RETURN (LIST (LIST 'GLERR (LIST 'QUOTE (CAR EXPRSTACK))))) ))
+
+% PRINT THE RESULT OF GLISP COMPILATION.
+(DE GLP (FN)
+ (PROG ()
+ (SETQ FN (OR FN GLLASTFNCOMPILED))
+ (TERPRI)
+ (PRIN2 "GLRESULTTYPE: ")
+ (PRINT (GET FN 'GLRESULTTYPE))
+ (PRETTYPRINT (GETDDD FN))
+ (RETURN FN)))
+
+
+% GLISP STRUCTURE EDITOR
+(DE GLEDS (STRNAME)
+ (EDITV (GET STRNAME 'GLSTRUCTURE))
+ STRNAME)
+
+% GLISP PROPERTY-LIST EDITOR
+(DE GLED (ATM) (EDITV (PROP ATM)))
+
+% GLISP FUNCTION EDITOR
+(DE GLEDF (FNNAME)
+ (EDITV (GLGETD FNNAME))
+ FNNAME)
+
+(DE KWOTE (X)
+ (COND ((NUMBERP X) X)
+ (T (LIST (QUOTE QUOTE) X))) )
+
+
+
+
+% INITIALIZE
+
+(SETQ GLBASICTYPES '(ATOM INTEGER REAL NUMBER STRING BOOLEAN
+ ANYTHING))
+(SETQ GLTYPENAMES '(CONS LIST RECORD LISTOF ALIST ATOM
+ OBJECT ATOMOBJECT LISTOBJECT))
+(SETQ GLLISPDIALECT 'PSL)
+(setq globjectnames nil)
+(GLINIT)
+
+
ADDED psl-1983/3-1/glisp/gltail.sl
Index: psl-1983/3-1/glisp/gltail.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltail.sl
@@ -0,0 +1,197 @@
+%
+% GLTAIL.PSL.10 14 Jan. 1983
+%
+% FILE OF FUNCTIONS FOR COMPATIBILITY WITH PORTABLE STANDARD LISP (PSL)
+% G. NOVAK 20 OCTOBER 1982
+%
+
+
+(DE GETDDD (X) (CDR (GETD X)))
+
+(DE PUTDDD (FN DEF) (REMD FN) (PUTD FN 'EXPR DEF))
+
+
+(DE LISTGET (L PROP)
+ (COND ((NULL L) NIL)
+ ((EQ (CAR L) PROP) (CADR L))
+ (T (LISTGET (CDDR L) PROP) )) )
+
+
+
+% NOTE -- THIS VERSION OF NLEFT ONLY WORKS FOR N=2.
+(DE NLEFT (L N)
+ (COND ((NOT (EQN N 2)) (ERROR 0 N))
+ ((NULL L) NIL)
+ ((NULL (CDDR L)) L)
+ (T (NLEFT (CDR L) N) )) )
+
+
+(DE NLISTP (X) (NOT (PAIRP X)))
+(DF COMMENT (X) NIL)
+
+
+% ASSUME EVERYTHING UPPER-CASE FOR PSL.
+(DE U-CASEP (X) T)
+(de glucase (x) x)
+
+
+% PARTIAL IMPLEMENTATION OF SUBATOM FOR POSITIVE NUMBERS.
+(DE SUBATOM (ATM N M)
+ (PROG (LST)
+ (COND ((GREATERP M (FLATSIZE2 ATM))(RETURN NIL)))
+A (COND ((GREATERP N M)(RETURN (AND LST (IMPLODE (REVERSIP LST))))))
+ (SETQ LST (CONS (GLNTHCHAR ATM N) LST))
+ (COND ((MEMQ (CAR LST) '(!' !, !!))
+ (RPLACD LST (CONS (QUOTE !!) (CDR LST))) ))
+ (SETQ N (ADD1 N))
+ (GO A) ))
+
+
+% FIND THE STRING POSITION IN ATOM ATM WHERE A CHARACTER IN THE
+% BIT TABLE BITTBL OCCURS, STARTING WITH CHARACTER N.
+(DE STRPOSL (BITTBL ATM N)
+ (PROG (NC)
+ (COND ((NULL N)(SETQ N 1)))
+ (SETQ NC (FLATSIZE2 ATM))
+A (COND ((GREATERP N NC)(RETURN NIL))
+ ((INDX GLSEPBITTBL (id2int (GLNTHCHAR ATM N)))(RETURN N)))
+ (SETQ N (ADD1 N))
+ (GO A) ))
+
+% MAKE A BIT TABLE FROM A LIST OF CHARACTERS.
+(DE MAKEBITTABLE (L)
+ (PROG ()
+ (SETQ GLSEPBITTBL (MkVect 255))
+ (MAPC L (FUNCTION (LAMBDA (X)
+ (PutV GLSEPBITTBL (id2int X) T) )))
+ (RETURN GLSEPBITTBL) ))
+
+
+% Fexpr for defining GLISP functions.
+(df dg (x)
+ (put (car x) 'gloriginalexpr (cons 'lambda (cdr x)))
+ (put (car x) 'glcompiled nil)
+ (putd (car x) 'macro '(lambda (gldgform)(glhook gldgform))) )
+
+% Hook for compiling a GLISP function on its first call.
+(de glhook (gldgform) (glcc (car gldgform)) gldgform)
+
+% Interlisp-style NTHCHAR.
+(de glnthchar (x n)
+ (prog (s l)
+ (setq s (id2string x))
+ (setq l (size s))
+ (cond ((minusp n)(setq n (add1 (plus l n))))
+ (t (setq n (sub1 n))))
+ (cond ((or (minusp n)(greaterp n l))(return nil)))
+ (return (int2id (indx s n)))))
+
+
+% FIND FIRST ELEMENT OF A LIST FOR WHICH FN IS TRUE
+(DE SOME (L FN)
+ (COND ((NULL L) NIL)
+ ((APPLY FN (LIST (CAR L))) L)
+ (T (SOME (CDR L) FN))))
+
+% TEST IF FN IS TRUE FOR EVERY ELEMENT OF A LIST
+% SOME and EVERY switched FN and L
+(DE EVERY (L FN)
+ (COND ((NULL L) T)
+ ((APPLY FN (LIST (CAR L))) (EVERY (CDR L) FN))
+ (T NIL)))
+
+% SUBSET OF A LIST FOR WHICH FN IS TRUE
+(DE SUBSET (L FN)
+ (PROG (RESULT)
+ A (COND ((NULL L)(RETURN (REVERSIP RESULT)))
+ ((APPLY FN (LIST (CAR L)))
+ (SETQ RESULT (CONS (CAR L) RESULT))))
+ (SETQ L (CDR L))
+ (GO A)))
+
+(DE REMOVE (X L) (DELETE X L))
+
+% LIST DIFFERENCE X - Y
+(DE LDIFFERENCE (X Y)
+ (MAPCAN X (FUNCTION (LAMBDA (Z)
+ (COND ((MEMQ Z Y) NIL)
+ (T (CONS Z NIL)))))))
+
+% FIRST A FEW FUNCTION DEFINITIONS.
+
+% GET FUNCTION DEFINITION FOR THE GLISP COMPILER.
+(DE GLGETD (FN)
+ (OR (and (or (null (get fn 'glcompiled))
+ (eq (getddd fn) (get fn 'glcompiled)))
+ (GET FN 'GLORIGINALEXPR))
+ (GETDDD FN)))
+
+(DE GLGETDB (FN) (GLGETD FN))
+
+(DE GLAMBDATRAN (GLEXPR)
+ (PROG (NEWEXPR)
+ (SETQ GLLASTFNCOMPILED FAULTFN)
+ (PUT FAULTFN 'GLORIGINALEXPR GLEXPR)
+ (COND ((SETQ NEWEXPR (GLCOMP FAULTFN GLEXPR NIL))
+ (putddd FAULTFN NEWEXPR)
+ (put faultfn 'glcompiled newexpr) ))
+ (RETURN NEWEXPR) ))
+
+(DE GLERROR (FN MSGLST)
+ (PROG ()
+ (TERPRI)
+ (PRIN2 "GLISP error detected by ")
+ (PRIN1 FN)
+ (PRIN2 " in function ")
+ (PRINT FAULTFN)
+ (MAPC MSGLST (FUNCTION (LAMBDA (X) (PRIN1 X)(SPACES 1))))
+ (TERPRI)
+ (PRIN2 "in expression: ")
+ (PRINT (CAR EXPRSTACK))
+ (TERPRI)
+ (PRIN2 "within expression: ")
+ (PRINT (CADR EXPRSTACK))
+ (COND (GLBREAKONERROR (ERROR 0 (CAR EXPRSTACK))))
+ (RETURN (LIST (LIST 'GLERR (LIST 'QUOTE (CAR EXPRSTACK))))) ))
+
+% PRINT THE RESULT OF GLISP COMPILATION.
+(DE GLP (FN)
+ (PROG ()
+ (SETQ FN (OR FN GLLASTFNCOMPILED))
+ (TERPRI)
+ (PRIN2 "GLRESULTTYPE: ")
+ (PRINT (GET FN 'GLRESULTTYPE))
+ (PRETTYPRINT (GETDDD FN))
+ (RETURN FN)))
+
+
+% GLISP STRUCTURE EDITOR
+(DE GLEDS (STRNAME)
+ (EDITV (GET STRNAME 'GLSTRUCTURE))
+ STRNAME)
+
+% GLISP PROPERTY-LIST EDITOR
+(DE GLED (ATM) (EDITV (PROP ATM)))
+
+% GLISP FUNCTION EDITOR
+(DE GLEDF (FNNAME)
+ (EDITV (GLGETD FNNAME))
+ FNNAME)
+
+(DE KWOTE (X)
+ (COND ((NUMBERP X) X)
+ (T (LIST (QUOTE QUOTE) X))) )
+
+
+
+
+% INITIALIZE
+
+(SETQ GLBASICTYPES '(ATOM INTEGER REAL NUMBER STRING BOOLEAN
+ ANYTHING))
+(SETQ GLTYPENAMES '(CONS LIST RECORD LISTOF ALIST ATOM
+ OBJECT ATOMOBJECT LISTOBJECT))
+(SETQ GLLISPDIALECT 'PSL)
+(GLINIT)
+
+
ADDED psl-1983/3-1/glisp/gltest
Index: psl-1983/3-1/glisp/gltest
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltest
@@ -0,0 +1,336 @@
+
+
+% GLTEST.PSL.2 22 OCTOBER 82
+
+
+% GLISP TEST FUNCTIONS, PSL VERSION. GSN 22 OCTOBER 82
+
+
+
+
+
+(DE GIVE-RAISE
+ (:COMPANY)
+ (FOR EACH ELECTRICIAN WHO IS NOT A TRAINEE
+ DO (SALARY _+(IF SENIORITY > 1
+ THEN 2.5
+ ELSE 1.5))
+ (PRINT (THE NAME OF THE ELECTRICIAN))
+ (PRINT (THE PRETTYFORM OF DATE-HIRED))
+ (PRINT MONTHLY-SALARY) ))
+
+(DE CURRENTDATE ()
+ (A DATE WITH YEAR = 1981 !, MONTH = 11 !, DAY = 30))
+
+(PUTPROP 'CURRENTDATE 'GLRESULTTYPE 'DATE)
+
+
+
+(GLISPOBJECTS
+
+
+(EMPLOYEE
+
+ (LIST (NAME STRING)
+ (DATE-HIRED (A DATE))
+ (SALARY REAL)
+ (JOBTITLE ATOM)
+ (TRAINEE BOOLEAN))
+
+ PROP ((SENIORITY ((THE YEAR OF (CURRENTDATE))
+ -
+ (THE YEAR OF DATE-HIRED)))
+ (MONTHLY-SALARY (SALARY * 174)))
+
+ ADJ ((HIGH-PAID (MONTHLY-SALARY > 2000)))
+
+ ISA ((TRAINEE (TRAINEE))
+ (GREENHORN (TRAINEE AND SENIORITY < 2)))
+
+ MSG ((YOURE-FIRED (SALARY _ 0))) )
+
+(DATE
+
+ (LIST (MONTH INTEGER)
+ (DAY INTEGER)
+ (YEAR INTEGER))
+
+ PROP ((MONTHNAME ((NTH
+ ' (JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER
+ OCTOBER NOVEMBER DECEMBER)
+ MONTH)))
+ (PRETTYFORM ((LIST DAY MONTHNAME YEAR)))
+ (SHORTYEAR (YEAR - 1900))) )
+
+(COMPANY
+
+ (ATOM (PROPLIST (PRESIDENT (AN EMPLOYEE))
+ (EMPLOYEES (LISTOF EMPLOYEE) )))
+
+ PROP ((ELECTRICIANS ((THOSE EMPLOYEES WITH JOBTITLE='ELECTRICIAN)))) )
+
+)
+(PUTPROP 'COMPANY1 'PRESIDENT
+ '("OSCAR THE GROUCH" (3 15 1907) 88.0 PRESIDENT NIL) )
+(PUTPROP 'COMPANY1 'EMPLOYEES
+ '(("COOKIE MONSTER" (7 21 1947) 12.5 ELECTRICIAN NIL)
+ ("BETTY LOU" (5 14 1980) 9.0 ELECTRICIAN NIL)
+ ("GROVER" (6 13 1978) 3.0 ELECTRICIAN T)) )
+
+
+
+
+
+
+
+
+
+
+(GLISPOBJECTS
+
+(VECTOR
+
+ (LIST (X INTEGER)
+ (Y INTEGER))
+
+ PROP ((MAGNITUDE ((SQRT X^2 + Y^2))))
+
+ ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)))
+
+ MSG ((+ VECTORPLUS OPEN T)
+ (- VECTORDIFF OPEN T)
+ (* VECTORTIMES OPEN T)
+ (/ VECTORQUOTIENT OPEN T)
+ (_+ VECTORMOVE OPEN T)
+ (PRIN1 ((PRIN1 "(")
+ (PRIN1 X)
+ (PRIN1 ",")
+ (PRIN1 Y)
+ (PRIN1 ")")))
+ (PRINT ((_ SELF PRIN1)
+ (TERPRI))) ) )
+
+(GRAPHICSOBJECT
+
+ (LIST (SHAPE ATOM)
+ (START VECTOR)
+ (SIZE VECTOR))
+
+ PROP ((LEFT (START:X))
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH))
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2))
+ (AREA (WIDTH*HEIGHT)))
+
+ MSG ((DRAW ((APPLY (GET SHAPE 'DRAWFN)
+ (LIST SELF
+ (QUOTE PAINT)))))
+ (ERASE ((APPLY (GET SHAPE 'DRAWFN)
+ (LIST SELF
+ (QUOTE ERASE)))))
+ (MOVE GRAPHICSOBJECTMOVE OPEN T)) )
+
+(MOVINGGRAPHICSOBJECT
+
+ (LIST (TRANSPARENT GRAPHICSOBJECT)
+ (VELOCITY VECTOR))
+
+ MSG ((ACCELERATE MGO-ACCELERATE OPEN T)
+ (STEP ((_ SELF MOVE VELOCITY)))) )
+)
+
+
+
+(DE VECTORPLUS
+ (V1!,V2:VECTOR)
+ (A VECTOR WITH X = V1:X + V2:X !, Y = V1:Y + V2:Y))
+
+(DE VECTORDIFF
+ (V1!,V2:VECTOR)
+ (A VECTOR WITH X = V1:X - V2:X !, Y = V1:Y - V2:Y))
+
+(DE VECTORTIMES
+ (V:VECTOR N:NUMBER)
+ (A VECTOR WITH X = X*N !, Y = Y*N))
+
+(DE VECTORQUOTIENT
+ (V:VECTOR N:NUMBER)
+ (A VECTOR WITH X = X/N !, Y = Y/N))
+
+(DE VECTORMOVE
+ (V!,DELTA:VECTOR)
+ (V:X _+
+ DELTA:X)
+ (V:Y _+
+ DELTA:Y))
+
+(DE GRAPHICSOBJECTMOVE
+ (SELF:GRAPHICSOBJECT DELTA:VECTOR)
+ (_ SELF ERASE)
+ (START _+
+ DELTA)
+ (_ SELF DRAW))
+
+(DE MGO-ACCELERATE
+ (SELF: MOVINGGRAPHICSOBJECT ACCELERATION: VECTOR)
+ VELOCITY _+
+ ACCELERATION)
+
+(DE TESTFN1 ()
+ (PROG (MGO N)
+ (MGO _(A MOVINGGRAPHICSOBJECT WITH SHAPE =(QUOTE
+ RECTANGLE)
+ !, SIZE =(A VECTOR WITH X = 4 !, Y = 3)
+ !, VELOCITY =(A VECTOR WITH X = 3 !, Y = 4)))
+ (N _ 0)
+ (WHILE (N_+1)
+ <100 (_ MGO STEP))
+ (_(THE START OF MGO)
+ PRINT)))
+
+(DE TESTFN2
+ (:GRAPHICSOBJECT)
+ (LIST SHAPE
+ START
+ SIZE
+ LEFT
+ BOTTOM
+ RIGHT
+ TOP
+ WIDTH
+ HEIGHT
+ CENTER
+ AREA
+ ))
+
+(DE DRAWRECT
+ (SELF:GRAPHICSOBJECT DSPOP:ATOM)
+ (PROG (OLDDS)
+ (OLDDS _(CURRENTDISPLAYSTREAM DSPS))
+ (DSPOPERATION DSPOP)
+ (MOVETO LEFT BOTTOM)
+ (DRAWTO LEFT TOP)
+ (DRAWTO RIGHT TOP)
+ (DRAWTO RIGHT BOTTOM)
+ (DRAWTO LEFT BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS))))
+)
+
+
+
+
+
+
+
+(GLISPOBJECTS
+
+(LISPTREE
+
+ (CONS (CAR LISPTREE)
+ (CDR LISPTREE))
+
+ PROP ((LEFTSON ((IF SELF IS ATOMIC THEN NIL ELSE CAR)))
+ (RIGHTSON ((IF SELF IS ATOMIC THEN NIL ELSE CDR))))
+
+ ADJ ((EMPTY (~SELF))) )
+
+(PREORDERSEARCHRECORD
+
+ (CONS (NODE LISPTREE)
+ (PREVIOUSNODES (LISTOF LISPTREE)))
+
+ MSG ((NEXT ((PROG (TMP)
+ (IF TMP_NODE:LEFTSON THEN
+ (IF NODE:RIGHTSON THEN PREVIOUSNODES+_NODE)
+ NODE_TMP ELSE TMP-_PREVIOUSNODES NODE_TMP:RIGHTSON))))) )
+)
+
+
+
+(DE TP
+ (:LISPTREE)
+ (PROG (PSR)
+ (PSR _(A PREORDERSEARCHRECORD WITH NODE =(THE LISPTREE)))
+ (WHILE NODE (IF NODE IS ATOMIC (PRINT NODE))
+ (_ PSR NEXT))))
+
+
+
+(GLISPOBJECTS
+
+(ARITHMETICOPERATOR
+
+ (SELF ATOM)
+
+ PROP ((PRECEDENCE OPERATORPRECEDENCEFN RESULT INTEGER)
+ (PRINTFORM ((GET SELF (QUOTE PRINTFORM))
+ OR SELF)))
+
+ MSG ((PRIN1 ((PRIN1 THE PRINTFORM)))) )
+
+(INTEGERMOD7
+
+ (SELF INTEGER)
+
+ PROP ((MODULUS (7))
+ (INVERSE ((IF SELF IS ZERO THEN 0 ELSE (MODULUS - SELF)))))
+
+ ADJ ((EVEN ((ZEROP (LOGAND SELF 1))))
+ (ODD (NOT EVEN)))
+
+ ISA ((PRIME PRIMETESTFN))
+
+ MSG ((+ IMOD7PLUS OPEN T RESULT INTEGERMOD7)
+ (_ IMOD7STORE OPEN T RESULT INTEGERMOD7)) )
+)
+
+
+
+(DE IMOD7STORE
+ (LHS:INTEGERMOD7 RHS:INTEGER)
+ (LHS:SELF __(IREMAINDER RHS MODULUS)))
+
+(DE IMOD7PLUS
+ (X!,Y:INTEGERMOD7)
+ (IREMAINDER (X:SELF + Y:SELF)
+ X:MODULUS))
+
+(DE SA
+ (:ARITHMETICOPERATOR)
+ (IF PRECEDENCE>5 (_ (THE ARITHMETICOPERATOR)
+ PRIN1)))
+
+(DE SB
+ (X:INTEGERMOD7)
+ (PROG (Y)
+ (LIST MODULUS INVERSE)
+ (IF X IS ODD OR X IS EVEN OR X IS A PRIME THEN (Y _ 5)
+ (X _ 12)
+ (X _+5))))
+
+
+
+(GLISPOBJECTS
+(CIRCLE (LIST (START VECTOR) (RADIUS REAL))
+ PROP ((PI (3.1415926))
+ (DIAMETER (RADIUS*2))
+ (CIRCUMFERENCE (PI*DIAMETER))
+ (AREA (PI*RADIUS^2)) ) ))
+
+% EXAMPLE OF ASSIGNMENT TO COMPUTED PROPERTY
+(DE GROWCIRCLE (C:CIRCLE)
+ (C:AREA_+100)
+ (PRINT RADIUS) )
+
+(SETQ MYCIRCLE '((0 0) 0.0))
+
+% EXAMPLE OF ELIMINATION OF COMPILE-TIME CONSTANTS
+(DE SQUASH ()
+ (IF 1>3 THEN 'AMAZING
+ ELSEIF 6<2 THEN 'INCREDIBLE
+ ELSEIF 2 + 2 = 4 THEN 'OKAY
+ ELSE 'JEEZ))
ADDED psl-1983/3-1/glisp/gltest.sl
Index: psl-1983/3-1/glisp/gltest.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltest.sl
@@ -0,0 +1,562 @@
+% GLTEST.SL.2 18 February 1983
+
+% GLISP TEST FUNCTIONS, PSL VERSION.
+
+% Object descriptions for a Company database.
+(GLISPOBJECTS
+
+(EMPLOYEE % Name of the object type
+
+ (LIST (NAME STRING) % Actual storage structure
+ (DATE-HIRED (A DATE))
+ (SALARY REAL)
+ (JOBTITLE ATOM)
+ (TRAINEE BOOLEAN))
+
+ PROP ((SENIORITY ((THE YEAR OF (CURRENTDATE)) % Computed properties
+ -
+ (THE YEAR OF DATE-HIRED)))
+ (MONTHLY-SALARY (SALARY * 174)))
+
+ ADJ ((HIGH-PAID (MONTHLY-SALARY > 2000))) % Computed adjectives
+
+ ISA ((TRAINEE (TRAINEE))
+ (GREENHORN (TRAINEE AND SENIORITY < 2)))
+
+ MSG ((YOURE-FIRED (SALARY _ 0))) ) % Message definitions
+
+
+(Date
+ (List (MONTH INTEGER)
+ (DAY INTEGER)
+ (YEAR INTEGER))
+ PROP ((MONTHNAME ((NTH '(JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY
+ AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER)
+ MONTH)))
+ (PRETTYFORM ((LIST DAY MONTHNAME YEAR)))
+ (SHORTYEAR (YEAR - 1900))) )
+
+
+(COMPANY
+ (ATOM (PROPLIST (PRESIDENT (AN EMPLOYEE))
+ (EMPLOYEES (LISTOF EMPLOYEE) )))
+ PROP ((ELECTRICIANS ((THOSE EMPLOYEES WITH JOBTITLE='ELECTRICIAN)))) )
+
+)
+
+
+% Some test data for the above functions.
+(setq company1 (a company with
+ President = (An Employee with Name = "Oscar the Grouch"
+ Salary = 88.0
+ Jobtitle = 'President
+ Date-Hired = (A Date with Month = 3
+ Day = 15 Year = 1907))
+ Employees = (list
+ (An Employee with Name = "Cookie Monster"
+ Salary = 12.50
+ Jobtitle = 'Electrician
+ Date-Hired = (A Date with Month = 7
+ Day = 21 Year = 1947))
+ (An Employee with Name = "Betty Lou"
+ Salary = 9.00
+ Jobtitle = 'Electrician
+ Date-Hired = (A Date with Month = 5
+ Day = 15 Year = 1980))
+ (An Employee with Name = "Grover"
+ Salary = 3.00
+ Jobtitle = 'Electrician
+ Trainee = T
+ Date-Hired = (A Date with Month = 6
+ Day = 13 Year = 1978))
+)))
+
+% Program to give raises to the electricians.
+(DG GIVE-RAISE
+ (:COMPANY)
+ (FOR EACH ELECTRICIAN WHO IS NOT A TRAINEE
+ DO (SALARY _+(IF SENIORITY > 1
+ THEN 2.5
+ ELSE 1.5))
+ (PRINT (THE NAME OF THE ELECTRICIAN))
+ (PRINT (THE PRETTYFORM OF DATE-HIRED))
+ (PRINT MONTHLY-SALARY) ))
+
+(DG CURRENTDATE () (Result DATE)
+ (A DATE WITH YEAR = 1981 MONTH = 11 DAY = 30))
+
+
+
+
+
+
+
+% The following object descriptions are used in a graphics object test
+% program (derived from one written by D.G. Bobrow as a LOOPS example).
+% The test program MGO-TEST runs on a Xerox D-machine, but won't run on
+% other machines.
+
+(GLISPOBJECTS
+
+% The actual stored structure for a Vector is simple, but it is overloaded
+% with many properties.
+
+(VECTOR
+
+ (LIST (X INTEGER)
+ (Y INTEGER))
+
+ PROP ((MAGNITUDE ((SQRT X^2 + Y^2)))
+ (DIRECTION ((IF X IS ZERO THEN (IF Y IS NEGATIVE THEN -90.0
+ ELSE 90.0)
+ ELSE (ATAN2D Y X))) RESULT DEGREES)
+ )
+
+ ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)))
+
+ MSG ((+ VECTORPLUS OPEN T) % Defining operators as messages
+ % causes the compiler to automatically
+ % overload the operators.
+ (- VECTORDIFF OPEN T)
+ (* VECTORTIMESSCALAR ARGTYPES (NUMBER) OPEN T)
+ (* VECTORDOTPRODUCT ARGTYPES (VECTOR) OPEN T)
+ (/ VECTORQUOTIENTSCALAR OPEN T)
+ (_+ VECTORMOVE OPEN T)
+ (PRIN1 ((PRIN1 "(")
+ (PRIN1 X)
+ (PRIN1 ",")
+ (PRIN1 Y)
+ (PRIN1 ")")))
+ (PRINT ((SEND SELF PRIN1) % PRINT is defined in terms of the
+ (TERPRI))) ) ) % PRIN1 message of this object.
+
+
+(DEGREES REAL % Stored value is just a real number.
+ PROP ((RADIANS (self*(3.1415926 / 180.0)) RESULT RADIANS)))
+
+(RADIANS REAL
+ PROP ((DEGREES (self*(180.0 / 3.1415926)) RESULT DEGREES)))
+
+% A FVECTOR is a very different kind of VECTOR: it has a different
+% storage structure and different element types. However, it can
+% still inherit some vector properties, e.g., addition.
+(FVECTOR (CONS (Y STRING) (X BOOLEAN))
+ SUPERS (VECTOR))
+
+% The definition of GraphicsObject builds on that of Vector.
+(GRAPHICSOBJECT
+
+ (LIST (SHAPE ATOM)
+ (START VECTOR)
+ (SIZE VECTOR))
+
+ PROP ((LEFT (START:X)) % A property defined in terms of a
+ % property of a substructure
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH))
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2)) % Vector arithmetic
+ (AREA (WIDTH*HEIGHT)))
+
+ MSG ((DRAW ((APPLY (GET SHAPE 'DRAWFN) % A way to get runtime message
+ (List SELF % behavior without using the
+ (QUOTE PAINT))))) % message mechanism.
+ (ERASE ((APPLY (GET SHAPE 'DRAWFN)
+ (LIST SELF
+ (QUOTE ERASE)))))
+ (MOVE GRAPHICSOBJECTMOVE OPEN T)) )
+
+(MOVINGGRAPHICSOBJECT
+
+ (LIST (TRANSPARENT GRAPHICSOBJECT) % Includes properties of a
+ (VELOCITY VECTOR)) % GraphicsObject due to the
+ % TRANSPARENT declaration.
+ Msg ((ACCELERATE MGO-ACCELERATE OPEN T)
+ (STEP ((SEND SELF MOVE VELOCITY)))) )
+)
+
+
+% The following functions define arithmetic operations on Vectors.
+% These functions are generally called OPEN (macro-expanded) rather
+% than being called directly.
+(DG VECTORPLUS
+ (V1:vector V2:VECTOR)
+ (A (TYPEOF V1) WITH X = V1:X + V2:X Y = V1:Y + V2:Y))
+
+(DG VECTORDIFF
+ (V1:vector V2:VECTOR)
+ (A (TYPEOF V1) WITH X = V1:X - V2:X Y = V1:Y - V2:Y))
+
+(DG VECTORTIMESSCALAR
+ (V:VECTOR N:NUMBER)
+ (A (TYPEOF V) WITH X = X*N Y = Y*N))
+
+(DG VECTORDOTPRODUCT
+ (V1:vector V2:VECTOR)
+ (A (TYPEOF V1) WITH X = V1:X * V2:X Y = V1:Y * V2:Y))
+
+(DG VECTORQUOTIENTSCALAR
+ (V:VECTOR N:NUMBER)
+ (A (TYPEOF V) WITH X = X/N Y = Y/N))
+
+% VectorMove, which defines the _+ operator for vectors, does a destructive
+% addition to the vector which is its first argument. Thus, the expression
+% U_+V will destructively change U, while U_U+V will make a new vector with
+% the value U+V and assign its value to U.
+(DG VECTORMOVE
+ (V:vector DELTA:VECTOR)
+ (V:X _+ DELTA:X)
+ (V:Y _+ DELTA:Y)
+ V)
+
+% An object is moved by erasing it, changing its starting point, and
+% then redrawing it.
+(DG GRAPHICSOBJECTMOVE
+ (SELF:GRAPHICSOBJECT DELTA:VECTOR)
+ (SEND SELF ERASE) % Erase the object
+ (START _+ DELTA) % Destructively move start point by delta
+ (SEND SELF DRAW)) % Redraw the object in new location
+
+(DG MGO-ACCELERATE
+ (SELF: MOVINGGRAPHICSOBJECT ACCELERATION: VECTOR)
+ VELOCITY _+ ACCELERATION)
+
+
+% Now we define some test functions which use the above definitions.
+% First there are some simple functions which test vector operations.
+(DG TVPLUS (U:VECTOR V:VECTOR) U+V)
+(DG TVMOVE (U:VECTOR V:VECTOR) U_+V)
+(DG TVTIMESV (U:VECTOR V:VECTOR) U*V)
+(DG TVTIMESN (U:VECTOR V:NUMBER) U*V)
+(DG TFVPLUS (U:FVECTOR V:FVECTOR) U+V)
+
+
+% This test function creates a MovingGraphicsObject and then moves it
+% across the screen by sending it MOVE messages. Everything in this
+% example is compiled open; the STEP message involves a great deal of
+% message inheritance.
+(DG MGO-TEST ()
+ (PROG (MGO N)
+ (MGO _(A MOVINGGRAPHICSOBJECT WITH
+ SHAPE = (QUOTE RECTANGLE)
+ SIZE = (A VECTOR WITH X = 4 Y = 3)
+ VELOCITY = (A VECTOR WITH X = 3 Y = 4)))
+ (N _ 0)
+ (WHILE (N_+1)<100 (SEND MGO STEP))
+ (SEND (THE START OF MGO) PRINT)))
+
+
+% This function tests the properties of a GraphicsObject.
+(DG TESTFN2 (:GRAPHICSOBJECT)
+ (LIST SHAPE START SIZE LEFT BOTTOM RIGHT TOP
+ WIDTH HEIGHT CENTER AREA))
+
+% Function to draw a rectangle. Computed properties of the rectangle are
+% used within calls to the graphics functions, making the code easy to
+% write and understand.
+(DG DRAWRECT (SELF:GRAPHICSOBJECT DSPOP:ATOM)
+ (PROG (OLDDS)
+ (OLDDS _(CURRENTDISPLAYSTREAM DSPS))
+ (DSPOPERATION DSPOP)
+ (MOVETO LEFT BOTTOM)
+ (DRAWTO LEFT TOP)
+ (DRAWTO RIGHT TOP)
+ (DRAWTO RIGHT BOTTOM)
+ (DRAWTO LEFT BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS) ))
+
+
+
+
+
+% The LispTree and PreorderSearchRecord objects illustrate how generators
+% can be written.
+(GLISPOBJECTS
+
+% In defining a LispTree, which can actually be of multiple types (atom or
+% dotted pair), we define it as the more complex dotted-pair type and take
+% care of the simpler case in the PROPerty definitions.
+(LISPTREE
+ (CONS (CAR LISPTREE) % Defines a LispTree structure as the CONS
+ (CDR LISPTREE)) % of two fields named CAR and CDR.
+
+ PROP ((LEFTSON ((IF SELF IS ATOMIC THEN NIL ELSE CAR)))
+ (RIGHTSON ((IF SELF IS ATOMIC THEN NIL ELSE CDR))))
+
+ ADJ ((EMPTY (~SELF))) )
+
+% PreorderSearchRecord is defined to be a generator. Its data structure holds
+% the current node and a stack of previous nodes, and its NEXT message is
+% defined as code to step through the preorder search.
+(PREORDERSEARCHRECORD
+
+ (CONS (NODE LISPTREE)
+ (PREVIOUSNODES (LISTOF LISPTREE)))
+
+ MSG ((NEXT ((PROG (TMP)
+ (IF TMP_NODE:LEFTSON
+ THEN (IF NODE:RIGHTSON THEN PREVIOUSNODES+_NODE)
+ NODE_TMP
+ ELSE TMP-_PREVIOUSNODES
+ NODE_TMP:RIGHTSON))))) )
+)
+
+
+% PRINTLEAVES prints the leaves of the tree, using a PreorderSearchRecord
+% as the generator for searching the tree.
+(DG PRINTLEAVES (:LISPTREE)
+ (PROG (PSR)
+ (PSR _(A PREORDERSEARCHRECORD WITH NODE =(THE LISPTREE)))
+ (WHILE NODE (IF NODE IS ATOMIC (PRINT NODE))
+ (SEND PSR NEXT))))
+
+
+
+% The Circle objects illustrate the definition of a number of mathematical
+% properties of an object in terms of stored data and other properties.
+(Glispobjects
+
+(CIRCLE (LIST (START VECTOR) (RADIUS REAL))
+ PROP ((PI (3.1415926)) % A PROPerty can be a constant.
+ (DIAMETER (RADIUS*2))
+ (CIRCUMFERENCE (PI*DIAMETER)) % Defined in terms of other prop.
+ (AREA (PI*RADIUS^2)) )
+ ADJ ((BIG (AREA>120)) % BIG defined in terms of AREA
+ (MEDIUM (AREA >= 60 AND AREA <= 120))
+ (SMALL (AREA<60)))
+ MSG ((STANDARD (AREA_100)) % "Storing into" computed property
+ (GROW (AREA_+100))
+ (SHRINK (AREA_AREA/2)) )
+ )
+
+
+% A DCIRCLE is implemented differently from a circle.
+% The data structure is different, and DIAMETER is stored instead of RADIUS.
+% By defining RADIUS as a PROPerty, all of the CIRCLE properties defined
+% in terms of radius can be inherited.
+
+(DCIRCLE (LISTOBJECT (START VECTOR) (DIAMETER REAL))
+ PROP ((RADIUS (DIAMETER/2)))
+ SUPERS (CIRCLE) )
+)
+
+% Make a DCIRCLE for testing
+(setq dc (a dcircle with diameter = 10.0))
+
+% Since DCIRCLE is an Object type, it can be used with interpreted messages,
+% e.g., (send dc area) to get the area property,
+% (send dc standard) to set the area to the standard value,
+% (send dc diameter) to get the stored diameter value.
+
+
+
+% EXAMPLE OF ASSIGNMENT TO COMPUTED PROPERTY
+(DG GROWCIRCLE (C:CIRCLE)
+ (C:AREA_+100)
+ C )
+
+(SETQ MYCIRCLE (A CIRCLE))
+
+% Since SQRT is not defined in the bare-PSL system, we redefine it here.
+(DG SQRT (X)
+ (PROG (S)
+ (S_X)
+ (IF X < 0 THEN (ERROR)
+ ELSE (WHILE (ABS S*S - X) > 0.000001 DO (S _ (S+X/S) * 0.5)))
+ (RETURN S)))
+
+% Function SQUASH illustrates elimination of compile-time constants.
+% Of course, nobody would write such a function directly. However, such forms
+% can arise when inherited properties are compiled. Conditional compilation
+% occurs automatically when appropriate variables are defined to the GLISP
+% compiler as compile-time constants because the post-optimization phase of
+% the compiler makes the unwanted code disappear.
+
+(DG SQUASH ()
+ (IF 1>3 THEN 'AMAZING
+ ELSEIF (SQRT 7.2) < 2 THEN 'INCREDIBLE
+ ELSEIF 2 + 2 = 4 THEN 'OKAY
+ ELSE 'JEEZ))
+
+
+% The following object definitions describe a student records database.
+(glispobjects
+
+(student (atom (proplist (name string)
+ (sex atom)
+ (major atom)
+ (grades (listof integer))))
+ prop ((average student-average)
+ (grade-average student-grade-average))
+ adj ((male (sex='male))
+ (female (sex='female))
+ (winning (average>=95))
+ (losing (average<60)))
+ isa ((winner (self is winning))))
+
+(student-group (listof student)
+ prop ((n-students length) % This property is implemented by
+ % the Lisp function LENGTH.
+ (Average Student-group-average)))
+
+(class (atom (proplist (department atom)
+ (number integer)
+ (instructor string)
+ (students student-group)))
+ prop ((n-students (students:n-students))
+ (men ((those students who are male)))
+ (women ((those students who are female)))
+ (winners ((those students who are winning)))
+ (losers ((those students who are losing)))
+ (class-average (students:average))))
+
+)
+
+
+(dg student-average (s:student)
+ (prog ((sum 0.0)(n 0.0))
+ (for g in grades do n _+ 1.0 sum_+g)
+ (return sum/n) ))
+
+(dg student-grade-average (s:student)
+ (prog ((av s:average))
+ (return (if av >= 90.0 then 'a
+ elseif av >= 80.0 then 'b
+ elseif av >= 70.0 then 'c
+ elseif av >= 60.0 then 'd
+ else 'f))))
+
+
+(dg student-group-average (sg:student-group)
+ (prog ((sum 0.0))
+ (for s in sg do sum_+s:average)
+ (return sum/sg:n-students) ))
+
+% Print name and grade average for each student
+(dg test1 (c:class)
+ (for s in c:students (prin1 s:name)
+ (prin2 '! )
+ (print s:grade-average)))
+
+% Another version of the above function
+(dg test1b (:class)
+ (for each student (prin1 name)
+ (prin2 '! )
+ (print grade-average)))
+
+% Print name and average of the winners in the class
+(dg test2 (c:class)
+ (for s in c:winners (prin1 s:name)
+ (prin2 '! )
+ (print s:average)))
+
+% The average of all the male students' grades
+(dg test3 (c:class)
+ c:men:average)
+
+% The name and average of the winning women
+(dg test4 (c:class)
+ (for s in c:women when s is winning
+ (prin1 s:name)
+ (prin2 '! )
+ (print s:average)))
+
+% Another version of the above function. The * operator in this case
+% denotes the intersection of the sets of women and winners. The
+% GLISP compiler optimizes the code so that these intermediate sets are
+% not actually constructed.
+(dg test4b (c:class)
+ (for s in c:women*c:winners
+ (prin1 s:name)
+ (prin2 '! )
+ (print s:average)))
+
+% Make a list of the easy professors.
+(dg easy-profs (classes:(listof class))
+ (for each class with class-average > 90.0 collect (the instructor)))
+
+% A more Pascal-like version of easy-profs:
+(dg easy-profs-b (classes:(listof class))
+ (for c in classes when c:class-average > 90.0 collect c:instructor))
+
+
+% Some test data for testing the above functions.
+(setq class1 (a class with instructor = "A. Prof" department = 'cs
+ number = 102 students =
+ (list
+ (a student with name = "John Doe" sex = 'male major = 'cs
+ grades = '(99 98 97 93))
+ (a student with name = "Fred Failure" sex = 'male major = 'cs
+ grades = '(52 54 43 27))
+ (a student with name = "Mary Star" sex = 'female major = 'cs
+ grades = '(100 100 99 98))
+ (a student with name = "Doris Dummy" sex = 'female major = 'cs
+ grades = '(73 52 46 28))
+ (a student with name = "Jane Average" sex = 'female major = 'cs
+ grades = '(75 82 87 78))
+ (a student with name = "Lois Lane" sex = 'female major = 'cs
+ grades = '(98 95 97 96)) )))
+
+
+
+% The following object definitions illustrate inheritance of properties
+% from multiple parent classes. The three "bottom" classes Planet, Brick,
+% and Bowling-Ball all inherit the same definition of the property Density,
+% although they are represented in very different ways.
+(glispobjects
+
+(physical-object anything
+ prop ((density (mass/volume))))
+
+(ordinary-object anything
+ prop ((mass (weight / 9.88))) % Compute mass as weight/gravity
+ supers (physical-object))
+
+(sphere anything
+ prop ((volume ((4.0 / 3.0) * 3.1415926 * radius ^ 3))))
+
+(parallelepiped anything
+ prop ((volume (length*width*height))))
+
+(planet (listobject (mass real)(radius real))
+ supers (physical-object sphere)) % A planet is a physical-object
+ % and a sphere.
+
+(brick (object (length real)(width real)(height real)(weight real))
+ supers (ordinary-object parallelepiped))
+
+(bowling-ball (atomobject (type atom)(weight real))
+ prop ((radius ((if type='adult then 0.1 else 0.07))))
+ supers (ordinary-object sphere))
+
+)
+
+% Three test functions to demonstrate inheritance of the Density property.
+(dg dplanet (p:planet) density)
+
+(dg dbrick (b:brick) density)
+
+(dg dbb (b:bowling-ball) density)
+
+% Some objects to test the functions on.
+(setq earth (a planet with mass = 5.98e24 radius = 6.37e6))
+
+(setq brick1 (a brick with weight = 20.0 width = 0.10 height = 0.05
+ length = 0.20))
+
+(setq bb1 (a bowling-ball with type = 'adult weight = 60.0))
+
+
+% Since the object types Planet, Brick, and Bowling-Ball are defined as
+% Object types (i.e., they contain the Class name as part of their stored
+% data), messages can be sent to them directly from the keyboard for
+% interactive examination of the objects. For example, the following
+% messages could be used:
+% (send earth density)
+% (send brick1 weight: 25.0)
+% (send brick1 mass: 2.0)
+% (send bb1 radius)
+% (send bb1 type: 'child)
ADDED psl-1983/3-1/glisp/gltestb.psl
Index: psl-1983/3-1/glisp/gltestb.psl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltestb.psl
@@ -0,0 +1,152 @@
+(glispobjects
+
+
+(circle (list (start vector) (radius real) (color atom))
+ prop ((pi (3.14159265))
+ (diameter (2*radius))
+ (circumference (pi*diameter))
+ (area (pi*radius^2)))
+ adj ((big (area>100))
+ (small (area<80)))
+ msg ((grow (area_+100))
+ (shrink (area_area/2))
+ (standard (area_100))) )
+
+(student (atom (proplist (name string)
+ (sex atom)
+ (major atom)
+ (grades (listof integer))))
+ prop ((average student-average)
+ (grade-average student-grade-average))
+ adj ((male (sex='male))
+ (female (sex='female))
+ (winner (average>=95))
+ (loser (average<60)))
+ isa ((winner (self is winner))))
+
+(student-group (listof student)
+ prop ((n-students length)
+ (average student-group-average)))
+
+(class (atom (proplist (department atom)
+ (number integer)
+ (instructor string)
+ (students student-group)))
+ prop ((n-students (students:n-students))
+ (men ((those students who are male)) result student-group)
+ (women ((those students who are female)) result student-group)
+ (winners ((those students who are winner)) result student-group)
+ (losers ((those students who are loser)) result student-group)
+ (class-average (students:average))))
+
+)
+
+
+(dg student-average (s:student)
+ (prog ((sum 0.0)(n 0.0))
+ (for g in grades do n _+ 1.0 sum_+g)
+ (return sum/n) ))
+
+(dg student-grade-average (s:student)
+ (prog ((av s:average))
+ (return (if av >= 90.0 then 'a
+ elseif av >= 80.0 then 'b
+ elseif av >= 70.0 then 'c
+ elseif av >= 60.0 then 'd
+ else 'f))))
+
+
+(dg student-group-average (sg:student-group)
+ (prog ((sum 0.0)(n 0.0))
+ (for s in sg do sum_+s:average n _+ 1.0)
+ (return sum/n) ))
+
+(dg test1 (c:class)
+ (for s in c:students (prin1 s:name)
+ (prin2 '! )
+ (prin1 s:grade-average) (terpri)))
+
+(dg test2 (c:class)
+ (for s in c:winners (prin1 s:name)
+ (prin2 '! )
+ (prin1 s:average) (terpri)))
+
+(dg test3 (c:class)
+ c:men:average)
+
+(dg test4 (c:class)
+ (for s in c:women when s is winner
+ (prin1 s:name)
+ (prin2 '! )
+ (prin1 s:average) (terpri)))
+
+(dg test5 (c:class)
+ (for s in c:women*c:winners
+ (prin1 s:name)
+ (prin2 '! )
+ (prin1 s:average) (terpri)))
+
+
+(setq class1 (a class with instructor = "G. Novak" department = 'cs
+ number = 102 students = (list
+ (a student with name = "John Doe" sex = 'male major = 'cs
+ grades = '(99 98 97 93))
+ (a student with name = "Fred Failure" sex = 'male major = 'cs
+ grades = '(52 54 43 27))
+ (a student with name = "Mary Star" sex = 'female major = 'cs
+ grades = '(100 100 99 98))
+ (a student with name = "Doris Dummy" sex = 'female major = 'cs
+ grades = '(73 52 46 28))
+ (a student with name = "Jane Average" sex = 'female major = 'cs
+ grades = '(75 82 87 78))
+ (a student with name = "Lois Lane" sex = 'female major = 'cs
+ grades = '(98 95 97 96)) )))
+
+
+
+
+
+
+(glispobjects
+
+(physical-object anything
+ prop ((density (mass/volume))))
+
+(sphere anything
+ prop ((volume ((4.0 / 3.0) * 3.1415926 * radius ^ 3))))
+
+(planet (listobject (mass real)(radius real))
+ supers (physical-object sphere))
+
+(ordinary-object anything
+ prop ((mass (weight / 9.88)))
+ supers (physical-object))
+
+(parallelepiped anything
+ prop ((volume (length*width*height))))
+
+(brick (object (length real)(width real)(height real)(weight real))
+ supers (ordinary-object parallelepiped))
+
+(bowling-ball (atomobject (type atom)(weight real))
+ prop ((radius ((if type='adult then 0.1 else 0.07))))
+ supers (ordinary-object sphere))
+
+)
+
+(dg dplanet (p:planet) density)
+
+(dg dbrick (b:brick) density)
+
+(dg dbb (b:bowling-ball) density)
+
+
+(setq earth (a planet with mass = 5.98e24 radius = 6.37e6))
+
+(setq brick1 (a brick with weight = 20.0 width = 0.06 height = 0.04
+ length = 0.16))
+
+(setq bb1 (a bowling-ball with type = 'adult weight = 60.0))
+
+
+
ADDED psl-1983/3-1/glisp/gltrans.sl
Index: psl-1983/3-1/glisp/gltrans.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltrans.sl
@@ -0,0 +1,31 @@
+% GLTRANS.SL.1 12 April 1983
+%
+% Translate files from GLISP form to PSL.
+% G. Novak 12 April 83
+
+(global '(gltransfile))
+
+% Open a file for output
+(de gltransopen (filename)
+ (setq gltransfile (open filename 'output)))
+
+% Close the output file
+(de gltransclose () (close gltransfile))
+
+% Read a file, translate it, and append to the output file.
+(de gltransread (filename)
+ (prog (infile expr)
+ (setq infile (open filename 'input))
+lp (setq expr (channelread infile))
+ (cond ((eq expr !$EOF!$) (return t))
+ ((pairp expr)
+ (eval expr)
+ (channelterpri gltransfile)
+ (cond ((eq (car expr) 'dg)
+ (glcc (cadr expr))
+ (channelprin1 gltransfile
+ (cons 'de (cons (cadr expr)
+ (cdr (get (cadr expr) 'glcompiled))))))
+ (t (channelprin1 gltransfile expr)))
+ (channelterpri gltransfile)))
+ (go lp)))
ADDED psl-1983/3-1/glisp/gltype.sl
Index: psl-1983/3-1/glisp/gltype.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gltype.sl
@@ -0,0 +1,35 @@
+% Define the GLISP types. GSN 07 march 83
+(glispobjects
+
+(gltype
+ (atom (proplist
+(glstructure (cons (strdes anything)
+ (proplist (prop (listof glpropentry))
+ (adj (listof glpropentry))
+ (isa (listof glpropentry))
+ (msg (listof glpropentry))
+ (supers (listof gltype)))))
+(glispatomnumber integer)
+(glpropfns (alist (str (listof glpropfnentry))
+ (prop (listof glpropfnentry))
+ (adj (listof glpropfnentry))
+ (isa (listof glpropfnentry))
+ (msg (listof glpropfnentry))))))
+prop ((props (prop))
+ (adjs (adj))
+ (isas (isa))
+ (msgs (msg))))
+
+(glpropentry
+ (cons (name atom)
+ (cons (code anything)
+ (proplist (result gltype)
+ (open boolean)))))
+
+(glpropfnentry (list (name atom)
+ (code anything)
+ (result gltype)))
+)
+
+(put 'atom 'glstructure
+ '(atom prop ((pname id2string result string))))
ADDED psl-1983/3-1/glisp/gluser.mss
Index: psl-1983/3-1/glisp/gluser.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/gluser.mss
@@ -0,0 +1,1792 @@
+@Make(Manual)
+@Define(PE,FaceCode U)
+@Begin(TitlePage)
+@Begin(TitleBox)
+@MajorHeading[GLISP User's Manual]
+@BlankSpace(2)
+@Center(
+Gordon S. Novak Jr.
+Computer Science Department
+Stanford University
+Stanford, California 94305)
+@BlankSpace(3)
+@BlankSpace(2)
+@Center[@B<Revised:> @Value(Date)]
+@End(TitleBox)
+@Begin(ResearchCredit)
+This research was supported in part by NSF grant SED-7912803 in the Joint
+National Science Foundation - National Institute of Education Program
+of Research on Cognitive Processes and the Structure of Knowledge in
+Science and Mathematics, and in part by the Defense Advanced Research
+Projects Agency under contract MDA-903-80-c-007.
+@End(ResearchCredit)
+@End(TitlePage)
+@Chapter(Introduction)
+@Section(Overview of GLISP)
+
+ GLISP is a LISP-based language which provides high-level
+language features not found in ordinary LISP. The GLISP language
+is implemented by means of a compiler which accepts GLISP as input and
+produces ordinary LISP as output; this output can be further compiled
+to machine code by the LISP compiler. GLISP is available for several
+LISP dialects, including Interlisp, Maclisp, UCI Lisp, ELISP, Franz
+Lisp, and Portable Standard Lisp.
+
+ The goal of GLISP is to allow structured objects to be referenced
+in a convenient, succinct language, and to allow the structures of objects
+to be changed without changing the code which references the objects.
+GLISP provides both PASCAL-like and English-like syntaxes; much of the power
+and brevity of GLISP derive from the compiler features necessary to
+support the relatively informal, English-like language constructs.
+The following example function illustrates how GLISP permits definite
+reference to structured objects.
+@Begin(ProgramExample)
+
+(HourlySalaries (GLAMBDA ( (a DEPARTMENT) )
+ (for each EMPLOYEE who is HOURLY
+ (PRIN1 NAME) (SPACES 3) (PRINT SALARY) ) ))
+
+@End(ProgramExample)
+The features provided by GLISP include the following:
+@Begin(Enumerate)
+
+GLISP maintains knowledge of the "context" of the computation as the
+program is executed. Features of objects which are in context may be
+referenced directly; the compiler will determine how to reference the
+objects given the current context, and will add the newly referenced
+objects to the context. In the above example, the function's
+argument, an object whose class is
+DEPARTMENT, establishes an initial context relative to
+which EMPLOYEEs can be found. In the context of an EMPLOYEE, NAME
+and SALARY can be found.
+
+GLISP supports flexible object definition and reference with a
+powerful abstract datatype facility.
+Object classes are easily declared to the system. An object
+declaration includes a definition of the storage structure of the
+object and declarations of properties of the object; these may be
+declared in such a way that they compile open, resulting in efficient
+object code. GLISP supports object-centered programming, in which
+processes are invoked by means of "messages" sent to objects.
+Object structures may be LISP structures (for which code is
+automatically compiled) or Units in the user's favorite representation
+language (for which the user can supply compilation functions).
+
+Loop constructs, such as
+@ (FOR EACH <item> WITH <property> DO ...)@ ,
+are compiled into loops of the appropriate form.
+
+Compilation of infix expressions is provided for the arithmetic
+operators and for additional operators which facilitate list manipulation.
+Operators are interpreted appropriately for Lisp datatypes as well as
+for numbers; operator overloading for user-defined objects is provided
+using the message facility.
+
+The GLISP compiler infers the types of objects when possible, and uses
+this knowledge to generate efficient object code. By performing
+@I[ compilation relative to a knowledge base ], GLISP is able to perform
+certain computations (e.g., inheritance of an attached procedure
+from a parent class of an object
+in a knowledge base) at compile time rather than at runtime, resulting
+in much faster execution.
+
+By separating object definitions from the code which references objects,
+GLISP permits radical changes to object structures with no changes to
+code.
+@End(Enumerate)
+@Section(Implementation)
+
+ GLISP is implemented by means of a compiler, which produces a
+normal Lisp EXPR from the GLISP code; the GLISP code is saved on the
+function's property list, and the compiled definition replaces the
+GLISP definition. Use of GLISP entails the cost of a single
+compilation, but otherwise is about as efficient as normal LISP.
+The LISP code produced by GLISP can be further compiled to machine
+code by the LISP compiler.
+
+GLISP functions
+are indicated by the use of GLAMBDA instead of LAMBDA in the function
+definition. When the Lisp interpreter sees the GLAMBDA, it
+calls the GLISP compiler
+to incrementally compile the GLISP function.
+The compiled version replaces the GLISP version (which is saved on the
+function name's property list), and is used thereafter.
+This automatic compilation feature is currently implemented in Interlisp
+and in Franz Lisp. In other dialects, it is necessary for the user to
+explicitly invoke compilation of GLISP functions by calling the compiler
+function @PE[GLCC] for each one.
+
+ To use GLISP, it is first necessary to load the compiler file into
+Lisp. Users' files containing structure descriptions and GLISP code
+are then loaded. Compilation of a GLISP function is requested by:
+@Tabset(1.7 inch)
+@Begin(Format)
+
+@PE[(GLCC 'FN)]@\Compile @PE[FN].
+
+@PE[(GLCP 'FN)]@\Compile @PE[FN] and prettyprint the result.
+
+@PE[(GLP 'FN)]@\Print the compiled version of @PE[FN].
+@End(Format)
+In Interlisp, all the GLISP functions (beginning with GLAMBDA) in a file
+can be compiled by invoking @PE[(GLCOMPCOMS@ <file>COMS)], where
+@PE[<file>COMS] is the list of file package commands for the file.
+
+Properties of compiled functions are stored on the property list of
+the function name:
+@Begin(Format)
+@PE[GLORIGINALEXPR]@\Original (GLISP) version of the function.@FOOT[The
+original definition is saved as EXPR in Interlisp.]
+@PE[GLCOMPILED]@\GLISP-compiled version of the function.
+@PE[GLRESULTTYPE]@\Type of the result of the function.
+@PE[GLARGUMENTTYPES]@\Types of the arguments of the function.
+@End(format)
+Properties of GLISP functions can be examined with the function
+@PE[(GLED '<name>)], which calls the Lisp editor on the property
+list of @PE[<name>]. @PE[(GLEDF '<name>)] calls the Lisp editor on the
+original (GLISP) definition of @PE[<name>].
+
+@Section(Error Messages)
+GLISP provides detailed error messages when compilation errors are
+detected; many careless errors such as misspellings will be caught
+by the compiler. When the source program contains errors, the
+compiled code generates runtime errors upon execution of the
+erroneous expressions.
+
+@Section(Interactive Features of GLISP)
+Several features of GLISP are available interactively, as well as in
+compiled functions:
+@Enumerate{
+The @PE[A] function, which creates structured objects from a readable
+property/value list, is available as an interactive function.
+
+Messages to objects can be executed interactively.
+
+A display editor/inspector, GEV, is available for use with bitmap
+graphics terminals.@Foot[GEV is currently implemented only for Xerox
+Lisp machines.] GEV interprets objects according to their GLISP
+structure descriptions; it allows the user to inspect objects, edit
+them, interactively construct programs which operate on them, display
+computed properties, send messages to objects, and "push down" to
+inspect data values.}
+
+
+@Chapter(Object Descriptions)
+@Section(Declaration of Object Descriptions)
+An @I(Object Description) in GLISP is a description of the structure
+of an object in terms of named substructures, together with definitions
+of ways of referencing the object. The latter may include
+@I( properties )
+(i.e., data whose values are not stored, but are computed
+from the values of stored data), adjectival predicates, and
+@I(messages) which the object can receive; the messages can be used to
+implement operator overloading and other compilation features.
+
+Object Descriptions are obtained by GLISP in several ways:
+@Begin(Enumerate)
+The descriptions of basic datatypes (e.g., INTEGER) are automatically
+known to the compiler.
+
+Structure descriptions (but not full object descriptions) may be used
+directly as @I(types) in function definitions.
+
+The user may declare object descriptions to the system using the
+function GLISPOBJECTS; the names of the object types may then be
+used as @I[ types ] in function definitions and definitions of other
+structures.
+
+Object descriptions may be included as part of a knowledge
+representation language, and are then furnished to GLISP by the
+interface package written for that representation language.
+@End(Enumerate)
+
+LISP data structures are declared using the function GLISPOBJECTS@Foot{
+Once declared, object descriptions may be included in INTERLISP program
+files by including in the <file>COMS a statement of the form:
+@PE[(GLISPOBJECTS@ <object-name@-(1)>@ ...@ <object-name@-(n)>)]},
+which takes one or more object
+descriptions as arguments (assuming the descriptions to be quoted).
+Since GLISP compilation is performed relative to the knowledge base
+of object descriptions, the object descriptions must be declared
+prior to GLISP compilation of functions using those descriptions.
+The format of each description is as follows:
+@Begin(ProgramExample)
+
+(<object name> <structure description>
+ PROP <property descriptions>
+ ADJ <adjective descriptions>
+ ISA <predicate descriptions>
+ MSG <message descriptions>
+ SUPERS <list of superclasses>
+ VALUES <list of values> )
+
+@End(ProgramExample)
+The <object name> and <structure description> are required; the other
+property/value pairs are optional, and may appear in any order.
+The following example illustrates some of the
+declarations which might be made to describe the object type
+@PE(VECTOR).
+@Begin(ProgramExample)
+
+(GLISPOBJECTS
+
+ (VECTOR (CONS (X NUMBER) (Y NUMBER))
+
+ PROP ( (MAGNITUDE ((SQRT X*X + Y*Y))) )
+
+ ADJ ( (ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)) )
+
+ MSG ( (+ VECTORPLUS OPEN T)
+ (- VECTORDIFFERENCE) )
+
+ ))
+
+@End(ProgramExample)
+
+@Subsection(Property Descriptions)
+Each @PE[<description>] specified with PROP, ADJ, ISA, or MSG
+has the following format:
+@Begin(ProgramExample)
+
+(<name> <response> <prop@-[1]> <value@-[1]> ... <prop@-[n]> <value@-[n]>)
+
+@END(ProgramExample)
+where @PE[<name>] is the (atomic) name of the property, @PE[<response>]
+is a function name or a list of GLISP code to be compiled in place
+of the property, and the @PE[<prop>@ <value>] pairs are optional
+properties which affect compilation. All four kinds of
+properties are compiled in a similar fashion, as
+described in the section "Compilation of Messages".
+
+@Subsection(Supers Description)
+The SUPERS list specifies a list of @I[ superclasses ], i.e., the names
+of other object descriptions from which the object may inherit PROP,
+ADJ, ISA, and MSG properties. Inheritance from superclasses can be
+recursive, as described under "Compilation of Messages".
+
+@Subsection(Values Description)
+The VALUES list is a list of pairs, @PE[ (<name> <value>) ], which is
+used to associate symbolic names with constant values for an object
+type. If VALUES are defined for the type of the @I[ selector ] of a
+CASE statement, the corresponding symbolic names may be used as the
+selection values for the clauses of the CASE statement.
+
+@Section(Structure Descriptions)
+ Much of the power of GLISP is derived from its use of Structure
+Descriptions. A Structure Description (abbreviated "<sd>") is a means
+of describing a LISP data structure and giving names to parts of the
+structure; it is similar in concept to a Record declaration in PASCAL.
+Structure descriptions are used by the GLISP compiler to generate code
+to retrieve and store parts of structures.
+@Subsection(Syntax of Structure Descriptions)
+
+ The syntax of structure
+descriptions is recursively defined in terms of basic types and
+composite types which are built up from basic types. The syntax of
+structure descriptions is as follows:
+@Foot[The names of the basic types and the structuring operators must
+be all upper-case or lower-case, depending on the case which is usual for
+the underlying Lisp system. In general, other GLISP keywords and
+user program names may be in upper-case, lower-case, or mixed-case,
+if mixed cases are permitted by the Lisp system.]
+@Begin(Enumerate)
+
+The following basic types are known to the compiler:
+@Begin(Format)
+@Tabdivide(3)
+@B(ATOM)
+@B(INTEGER)
+@B(REAL)
+@B(NUMBER)@\(either INTEGER or REAL)
+@B(STRING)
+@B(BOOLEAN)@\(either T or NIL)
+@B(ANYTHING)@\(an arbitrary structure)
+@End(Format)
+
+An object type which is known to the compiler, either from a GLISPOBJECTS
+declaration or because it is a Class of units in the user's knowledge
+representation language, is a valid type for use in a structure
+description. The <name>@ of such an object type may be specified
+directly as <name> or, for readability, as @ @B[(A]@ <name>@B[)]@
+or @ @B[(AN]@ <name>@B[)].
+@Foot[Whenever the form @B<(A ...)> is allowed in GLISP, the form
+@B<(AN ...)> is also allowed.]@
+
+
+Any substructure can be named by enclosing it
+in a list prefixed by the name: @ @B[(]<name>@ @ <sd>@B[)]@ .
+This allows the same substructure to have multiple names.
+"A", "AN", and the names used in forming composite types (given below)
+are treated as reserved words, and may not be used as names.
+
+Composite Structures:@
+Structured data types composed of other structures are described using
+the following structuring operators:
+@Begin(Enumerate)
+
+(@B[CONS]@ @ <sd@-[1]>@ @ <sd@-[2]>)
+@*
+The CONS of two structures whose descriptions
+are <sd@-[1]> and <sd@-[2]>.
+
+(@B[LIST]@ @ <sd@-[1]>@ @ <sd@-[2]>@ @ ...@ @ <sd@-[n]>)
+@*
+A list of exactly the elements
+whose descriptions are <sd@-[1]>@ <sd@-[2]>@ ...@ <sd@-[n]>.
+
+(@B[LISTOF]@ @ <sd>)
+@*
+A list of zero or more elements, each of which has
+the description <sd>.
+
+(@B[ALIST]@ @ (<name@-[1]>@ <sd@-[1]>)@ ...@ (<name@-[n]>@ <sd@-[n]>))
+@*
+An association list
+in which the atom <name@-[i]>, if present, is associated with a structure
+whose description is <sd@-[i]>.
+
+(@B[PROPLIST]@ @ (<name@-[1]>@ <sd@-[1]>)@ ...@ (<name@-[n]>@ <sd@-[n]>))
+@*
+An association list in "property-list format" (alternating names and
+values)
+in which the atom <name@-[i]>, if present, is associated with a structure
+whose description is <sd@-[i]>.
+
+(@B[ATOM]@ @ @ (@B[BINDING]@ @ <sd>)
+@ @ @ @ (@B[PROPLIST]@ @ (<pname@-[1]>@ <sd@-[1]>)@ ...@ @~
+(<pname@-[n]>@ <sd@-[n]>)@ ))
+@*
+This describes an atom with its binding and/or its property list;
+either the BINDING or the PROPLIST group may be omitted.
+Each property name <pname@-[i]> is treated as a property list indicator
+as well as the name of the substructure. When creation of such a
+structure is specified, GLISP will compile code to create a GENSYM atom.
+
+(@B[RECORD]@ @ <recordname>@ @ (<name@-[1]>@ <sd@-[1]>)@ @ ...@ @ (<name@-[n]>@ <sd@-[n]>))
+@*
+RECORD specifies the use of contiguous records for data storage.
+<recordname> is the name of the record type; it is optional,
+and is not used in some Lisp dialects.@Foot[RECORDs are
+implemented using RECORDs in Interlisp, HUNKs in Maclisp and Franz Lisp,
+VECTORs in Portable Standard Lisp, and lists in UCI Lisp and ELISP.
+In Interlisp, appropriate RECORD declarations must be made to the system
+by the user in addition to the GLISP declarations.]
+
+(@B[TRANSPARENT]@ @ <type>)
+@*
+An object of type <type> is incorporated into the structure being
+defined in @I[transparent mode], which means that all fields and
+properties of the object of type <type> can be directly referenced
+as if they were properties of the object being defined. A substructure
+which is a named @I[ type ] and which is not declared to be TRANSPARENT
+is assumed to be opaque, i.e., its internal structure cannot be seen
+unless an access path explicitly names the subrecord.@Foot{For example,
+a PROFESSOR record might contain some fields which are unique to
+professors, plus a pointer to an EMPLOYEE record. If the declaration
+in the PROFESSOR record were @PE[(EMPREC@ (TRANSPARENT@ EMPLOYEE))],
+then a field of the employee record, say SALARY, could be referenced
+directly from a variable P which points to a PROFESSOR record as
+@PE[ P:SALARY ]; if the declaration were @PE[(EMPREC@ EMPLOYEE)],
+it would be necessary to say @PE[P:EMPREC:SALARY].}
+The object
+of type <type> may also contain TRANSPARENT objects; the graph of
+TRANSPARENT object references must of course be acyclic.
+
+(@B[OBJECT]@ @ (<name@-[1]>@ <sd@-[1]>)@ ...@ (<name@-[n]>@ <sd@-[n]>))
+@*(@B[ATOMOBJECT]@ @ (<name@-[1]>@ <sd@-[1]>)@ ...@ (<name@-[n]>@ <sd@-[n]>))
+@*(@B[LISTOBJECT]@ @ (<name@-[1]>@ <sd@-[1]>)@ ...@ (<name@-[n]>@ <sd@-[n]>))
+@*These declarations describe @I[ Objects ], data structures which can
+receive messages at runtime. The three types of objects are implemented
+as records, atoms, or lists, respectively. In each case, the system
+adds to the object
+a @PE[CLASS] datum which points to the name of the type of the
+object. An object declaration may only appear as the top-level
+declaration of a named object type.
+@End(Enumerate)
+@End(Enumerate)
+@Subsection(Examples of Structure Descriptions)
+ The following examples illustrate the use of Structure Descriptions.
+@Begin(ProgramExample)
+
+(GLISPOBJECTS
+
+ (CAT (LIST (NAME ATOM)
+ (PROPERTIES (LIST (CONS (SEX ATOM)
+ (WEIGHT INTEGER))
+ (AGE INTEGER)
+ (COLOR ATOM)))
+ (LIKESCATNIP BOOLEAN)))
+
+ (PERSON (ATOM
+ (PROPLIST
+ (CHILDREN (LISTOF (A PERSON)))
+ (AGE INTEGER)
+ (PETS (LIST (CATS (LISTOF CAT))
+ (DOGS (LISTOF (A DOG))) ))
+ )))
+ )
+
+@End(ProgramExample)
+ The first structure, CAT, is entirely composed of list structure.
+An CAT structure might look like:
+@Begin(ProgramExample)
+(PUFF ((MALE . 10) 5 CALICO) T)
+@End(ProgramExample)
+Given a CAT object X, we could ask for its WEIGHT [equivalent to
+(CDAADR X)] or for a subrecord such as PROPERTIES [equivalent
+to (CADR X)]. Having set a variable Y to the PROPERTIES,
+we could also ask for the WEIGHT from Y [equivalent to (CDAR Y)].
+In general, whenever a subrecord is accessed, the structure description
+of the subrecord is associated with it by the compiler,
+enabling further accesses to parts of the
+subrecord. Thus, the meaning
+of a subrecord name depends on the type of record from which the
+subrecord is retrieved. The subrecord AGE has two different
+meanings when applied to PERSONs and CATs.
+ The second structure, PERSON, illustrates a description of
+an object which is a Lisp atom with properties stored on its property
+list. Whereas no structure names appear in an actual CAT structure,
+the substructures of a PROPLIST operator must be named, and
+the names appear in the actual structures. For example, if X is a
+PERSON structure, retrieval of the AGE of X is equivalent to
+@PE[(GETPROP@ X@ 'AGE)].
+A subrecord of a PROPLIST record can be referenced directly; e.g., one
+can ask for the DOGS of a PERSON directly, without cognizance of
+the fact that DOGS is part of the PETS property.
+
+@Section(Editing of Object Descriptions)
+
+An object description can be edited by calling @PE[ (GLEDS TYPE) ],
+where @PE[ TYPE ] is the name of the object type. This will cause the
+Lisp editor to be called on the object description of @PE[ TYPE ].
+
+@Section(Interactive Editing of Objects)
+
+An interactive structure inspector/editor, GEV, is available for the
+Xerox 1100-series lisp machines. GEV allows the user to inspect and
+edit any structures which are described by GLISP object descriptions,
+to "zoom in" on substructures of interest, and to display the values
+of computed properties automatically or on demand. GEV is described
+in a separate document.
+
+@Section(Global Variables)
+
+The types of free variables can be declared within the functions which
+reference them. Alternatively, the types of global variables can be
+declared to the compiler using the
+form:@Foot[@PE{(GLISPGLOBALS@ <name@-(1)>@ ...@ <name@-(n)>)}
+is defined as a file package command for Interlisp.]
+@Begin(ProgramExample)
+
+(GLISPGLOBALS (<name> <type>) ... )
+
+@End(ProgramExample)
+Following such a declaration, the compiler will assume a free variable
+<name> is of the corresponding <type>. A GLOBAL object does not have
+to actually exist as a storage structure; for example, one could define
+a global object "MOUSE" or "SYSTEM" whose properties are actually
+implemented by calls to the operating system.
+
+@Section(Compile-Time Constants and Conditional Compilation)
+The values and types of compile-time constants can be declared to the
+compiler using the
+form:@Foot[@PE{(GLISPCONSTANTS@ <name@-(1)>@ ...@ <name@-(n)>)}
+is defined as a file package command for Interlisp.]
+@Programexample[
+
+(GLISPCONSTANTS (<name> <value-expression> <type>) ... )
+
+]
+The <name> and <type> fields are assumed to be quoted. The
+@PE[ <value-expression> ] field is a GLISP expression which is
+parsed and evaluated; this allows constants to be defined by expressions
+involving previously defined constants.
+
+The GLISP compiler will perform many kinds of computations on
+constants at compile time, reducing the size of the compiled code and
+improving execution speed.@Foot[Ordinary Lisp functions are evaluated
+on constant arguments if the property @PE(GLEVALWHENCONST) is set to T on
+the property list of the function name. This property is set by the
+compiler for the basic arithmetic functions.]
+In particular, arithmetic, comparison,
+logical, conditional, and CASE function calls are optimized, with
+elimination of dead code. This permits conditional compilation in
+a clean form. Code can be written which tests the values of flags
+in the usual way; if the flag values are then declared to be
+compile-time constants using GLISPCONSTANTS,
+the tests will be performed at compile time, and the unneeded code
+will vanish.
+
+@Chapter(Reference To Objects)
+@Section(Accessing Objects)
+
+The problem of reference is the problem of determining what object,
+or feature of a structured object, is referred to by some part of
+a statement in a language. Most programming languages solve the
+problem of reference by unique naming: each distinct object in a
+program unit has a unique name, and is referenced by that name.
+Reference to a part of a structured object is done by giving the name
+of the variable denoting that object and a path specification which
+tells how to get to the desired part from the whole.
+
+GLISP permits reference by unique naming and path specification,
+but in addition permits @I[definite reference relative to context.]
+A @I[definite reference] is a reference to an object which has not
+been explicitly named before, but which can be understood relative
+to the current context of computation. If, for example, an object
+of type VECTOR (as defined earlier) is in context, the program
+statement
+@Begin(ProgramExample)
+(IF X IS NEGATIVE ...
+@End(ProgramExample)
+contains a definite reference to "X", which may be interpreted as the
+X substructure of the VECTOR which is in context. The definition of
+the computational context and the way in which definite references
+are resolved are covered in a later section of this manual.
+
+In the following section, which describes the syntaxes of reference
+to objects in GLISP, the following notation is used. "<var>" refers
+to a variable name in the usual LISP sense, i.e., a LAMBDA variable,
+PROG variable, or GLOBAL variable; the variable is assumed to point
+to (be bound to) an object. "<type>" refers to the type of object
+pointed to by a variable. "<property>" refers to a property or subrecord of
+an object.
+
+ Two syntaxes are available for reference to objects: an
+English-like syntax, and a PASCAL-like syntax.
+The two are equivalent, and may be intermixed freely within a GLISP
+function. The allowable forms of references in the two syntaxes are
+shown in the table below.
+@Begin(Format)
+@TabDivide(3)
+@U("PASCAL" Syntax)@\@U("English" Syntax)@\@U(Meaning)
+
+<var>@\<var>@\The object denoted
+@\@\by <var>
+@B[:]<type>@\@B[The] <type>@\The object whose type
+@\@\is <type>
+@B[:]<property>@\@B[The] <property>@\The <property> of
+@I[or] <property>@\@\some object
+<var>@B[:]<property>@\@B[The] <property> @B[of] <var>@\The <property> of the
+@\@\object denoted by <var>
+@End(Format)
+These forms can be extended to specify longer paths in the obvious way,
+as in "The AGE of the SPOUSE of the HEAD of the DEPARTMENT" or
+"DEPARTMENT:HEAD:SPOUSE:AGE". Note that there is no distinction
+between reference to substructures and reference to properties as
+far as the syntax of the referencing code is concerned; this
+facilitates hiding the internal structures of objects.
+
+@Section(Creation of Objects)
+GLISP allows the creation of structures to be specified by expressions
+of the form:
+@BlankSpace(1)
+@B[(A] <type> @P[with] <property@-[1]> @P[=] <value@-[1]> @P[,] ... @P[,] @~
+<property@-[n]> @P[=] <value@-[n]>@B[)]
+@BlankSpace(1)
+In this expression, the "@I[with]", "=", and "," are allowed for
+readability, but may be omitted if desired@Foot[Some Lisp dialects,
+e.g. Maclisp, will interpret commas as "backquote" commands and generate
+error messages. In such dialects, the commas must be omitted or be
+"slashified".]; if present, they must all
+be delimited on both sides by blanks.
+In response to such an expression, GLISP will generate code to create
+a new instance of
+the specified structure. The <property> names may be specified in any
+order. Unspecified properties are defaulted according to the
+following rules:
+@Begin(Enumerate)
+
+Basic types are defaulted to 0 for INTEGER and NUMBER, 0.0 for REAL,
+and NIL for other types.
+
+Composite structures are created from the defaults of their
+components, except that missing PROPLIST and ALIST items which
+would default to NIL are omitted.
+@End(Enumerate)
+Except for missing PROPLIST and ALIST elements, as noted above, a
+newly created LISP structure will contain all of the fields specified
+in its structure description.
+
+@Section(Interpretive Creation of Objects)
+
+The "A" function is defined for interpretive use as well as for use
+within GLISP functions.
+
+@Section(Predicates on Objects)
+Adjectives defined for structures using the @PE[ADJ] and @PE[ISA]
+specifications may be used in predicate expressions on objects in
+@B[If] and @B[For] statements. The syntax of basic predicate
+expressions is:
+@Begin(ProgramExample)
+<object> @b[is] <adjective>
+<object> @B[is a] <isa-adjective>
+@End(ProgramExample)
+Basic predicate expressions may be combined using AND, OR, NOT or ~, and
+grouping parentheses.
+
+The compiler automatically recognizes the LISP adjectives
+ATOMIC, NULL, NIL, INTEGER,
+REAL, ZERO, NUMERIC, NEGATIVE, MINUS, and BOUND, and the ISA-adjectives
+ATOM, LIST, NUMBER, INTEGER, SYMBOL, STRING, ARRAY, and
+BIGNUM@Foot[where applicable.]; user definitions have precedence
+over these pre-defined adjectives.
+
+@Subsection(Self-Recognition Adjectives)
+If the ISA-adjective @PE[ self ] is defined for an object type, the
+type name may be used as an ISA-adjective to test whether a given
+object is a member of that type. Given a predicate phrase of the
+form "@PE[@ X@ is@ a@ Y@ ]", the compiler first looks at the definition
+of the object type of @PE[ X ] to see if @PE[ Y ] is defined as an
+ISA-adjective for such objects.
+If no such ISA-adjective is found, and @PE[ Y ]
+is a type name, the compiler looks to see if @PE[ self ]
+is defined as an ISA-adjective for @PE[ Y ], and if so, compiles it.
+
+If a @PE[ self ] ISA-adjective predicate is compiled as the test of an
+@B[If], @B[While], or @B[For] statement, and the tested object is a
+simple variable, the variable will be known to be of that type within
+the scope of the test. For example, in the statement
+@Begin(ProgramExample)
+
+ (If X is a FOO then (_ X Print) ...
+
+@End(ProgramExample)
+the compiler will know that X is a FOO if the test succeeds, and will
+compile the Print message appropriate for a FOO, even if the type of
+X was declared as something other than FOO earlier. This feature is
+useful in implementing disjunctive types, as discussed in a later
+section.
+
+@Subsection(Testing Object Classes)
+For those data types which are defined using one of the OBJECT
+structuring operators, the Class name is automatically defined as an
+ISA-adjective. The ISA test is implemented by runtime examination of
+the CLASS datum of the object.
+
+@Chapter(GLISP Program Syntax)
+@Section(Function Syntax)
+ GLISP function syntax is essentially the same as that of LISP
+with the addition of type information and RESULT and GLOBAL declarations.
+The basic function syntax is:
+@Foot[The PROG is not required. In Lisp dialects other than Interlisp,
+LAMBDA may be used instead of GLAMBDA.]
+@Begin(ProgramExample)
+
+(<function-name> (@B[GLAMBDA] (<arguments>)
+ @P[(RESULT] <result-description>@P[)]
+ @P[(GLOBAL] <global-variable-descriptions>@P[)]
+ (PROG (<prog-variables>)
+ <code> )))
+
+@End(ProgramExample)
+ The RESULT declaration is optional; in many cases, the compiler
+will infer the result type automatically. The main use of the RESULT
+declaration is to allow the compiler to determine the result type
+without compiling the function, which may be useful when compiling
+another function which calls it. The <result-description> is a
+standard structure description or <type>.
+
+ The GLOBAL declaration is used to inform the compiler of the
+types of free variables. The function GLISPGLOBALS can be used to
+declare the types of global variables, making GLOBAL declarations
+within individual functions unnecessary.
+
+ The major difference between a GLISP function definition and a
+standard LISP definition is the presence of type declarations for
+variables, which are in PASCAL-like syntax of the following forms:
+@Begin(ProgramExample)
+
+<variable>@B[:]<type>
+<variable>@B[:(A] <type>@B[)]
+<variable>@B[,]<variable>@B[,]...@B[:]<type>
+<variable>@B[,]<variable>@B[,]...@B[:(A] <type>@B[)]
+ @B[:]<type>
+ @B[(A] <type>@B[)]
+
+@End(ProgramExample)
+In addition to declared <type>s, a Structure Description may be
+used directly as a <type> in a variable declaration.
+
+Type declarations are required only for variables whose subrecords or
+properties will be referenced. In general, if the value of a variable is
+computed in such a way that the type of the value can be inferred, the
+variable will receive the appropriate type automatically; in such
+cases, no type declaration is necessary. Since GLISP maintains a
+@I[context] of the computation, it is often unnecessary to name a
+variable which is an argument of a function;
+in such cases, it is only necessary to specify the <type> of
+the argument, as shown in the latter two syntax forms above.
+PROG and GLOBAL declarations must always specify variable
+names (with optional types); the ability to directly reference features
+of objects reduces the number of PROG variables needed in many cases.
+
+Initial values for PROG variables may be specified, as in Interlisp,
+by enclosing the variable and its initial value in a list@Foot[This
+feature is available in all Lisp dialects.]:
+@ProgramExample{
+
+(PROG (X (N 0) Y) ...)
+}
+However, the syntax of variable declarations does not permit the type
+of a variable and its initial value to both be specified.
+
+@Section(Expressions)
+GLISP provides translation of infix expressions of the kind usually
+found in programming languages. In addition, it provides additional
+operators which facilitate list manipulation and other operations.
+Overloading of operators for user-defined types is provided by means
+of the @I[message] facility.
+
+Expressions may be written directly in-line within function references,
+as in
+@PE[ (SQRT X*X + Y*Y) ],
+or they may be written within parentheses; parentheses may be used for
+grouping in the usual way. Operators may be written with or without
+delimiting spaces, @I[except for the "-" operator, which @P(must) be delimited
+by spaces].
+@Foot[The "-" operator is required to be delimited by spaces since "-" is
+often used as a hyphen within variable names. The "-" operator will be
+recognized within "atom" names if the flag GLSEPMINUS is set to T.]
+Expression parsing is done by an operator precedence parser, using the
+same precedence ordering as in FORTRAN.
+@Foot[The precedence of compound operators is higher than assignment
+but lower than that of all other operators. The operators
+@PE[^ _ _+ +_ _- -_] are right-associative; all others are left-associative.]
+The operators which are recognized are as follows:@Foot<In Maclisp, the
+operator @PE[/] must be written @PE[//].>
+@Begin(Format)
+@TabDivide(3)
+Assignment@\@PE(_) @I[ or ] @PE[:=]
+Arithmetic@\@PE[+ - * / ^]
+Comparison@\@PE[= @R<~>= <> < <= > >=]
+Logical@\@PE[AND OR NOT @R<~>]
+Compound@\@PE(_+ _- +_ -_)
+@End(Format)
+
+@Subsection(Interpretation of Operators)
+In addition to the usual interpretation of operators when used with
+numeric arguments, some of the operators are interpreted appropriately
+for other Lisp types.
+
+@Paragraph(Operations on Strings)
+For operands of type STRING, the operator @PE[ + ] performs
+concatenation. All of the comparison operators are defined for STRINGs.
+
+@Paragraph(Operations on Lists)
+Several operators are defined in such a way that they perform set
+operations on lists of the form @PE[ (LISTOF@ <type>) ], where
+@PE[ <type> ] is considered to be the element type. The following
+table shows the interpretations of the operators:
+@Begin(Format)
+@Tabdivide(3)
+@PE[<list> + <list>]@\Set Union
+@PE[<list> - <list>]@\Set Difference
+@PE[<list> * <list>]@\Set Intersection
+
+@PE[<list> + <element>]@\CONS
+@PE[<element> + <list>]@\CONS
+@PE[<list> - <element>]@\REMOVE
+@PE[<element> <= <list>]@\MEMBER or MEMB
+@PE[<list> >= <element>]@\MEMBER or MEMB
+@End(Format)
+
+@Paragraph(Compound Operators)
+Each compound operator performs an operation involving the arguments
+of the operator and assigns a value to the left-hand argument;
+compound operators are therefore thought of as "destructive change"
+operators.
+The meaning of a compound operator depends on the type of its
+left-hand argument, as shown in the following table:
+@Begin(Group)
+@Begin(Format)
+@TabDivide(5)
+@U(Operator)@\@U(Mnemonic)@\@U(NUMBER)@\@U(LISTOF)@\@U(BOOLEAN)
+@B[@PE(_+)]@\@I(Accumulate)@\PLUS@\NCONC1@\OR
+@B[@PE(_-)]@\@I(Remove)@\DIFFERENCE@\REMOVE@\AND NOT
+@B[@PE(+_)]@\@I(Push)@\PLUS@\PUSH@\OR
+@B[@PE(-_)]@\@I(Pop)@\@\POP@Foot[For the Pop operator, the arguments are in
+the reverse of the usual order, i.e., (TOP@ @PE(-_)@ STACK) will pop the
+top element off STACK and assign the element removed to TOP.]
+@End(Format)
+@End(Group)
+As an aid in remembering the list operators, the arrow may be
+thought of as representing the list, with the head of the arrow being
+the front of the list and the operation (+ or -) appearing where the
+operation occurs on the list. Thus, for example, @PE(_+) adds an element
+at the end of the list, while @PE(+_) adds an element at the front of the
+list.
+
+Each of the compound operators performs an assignment to its left-hand
+side; the above table shows an abbreviation of the operation which is
+performed prior to the assignment.
+The following examples show the effects of the operator "@PE(_+)" on
+local variables of different types:
+@Begin(Format)
+@TabDivide(3)
+@U(Type)@\@U(Source Code)@\@U(Compiled Code)
+
+INTEGER@\@PE(I _+ 5)@\@PE[(SETQ I (IPLUS I 5))]
+BOOLEAN@\@PE(P _+ Q)@\@PE[(SETQ P (OR P Q))]
+LISTOF@\@PE(L _+ ITEM)@\@PE[(SETQ L (NCONC1 L ITEM))]
+@END(Format)
+
+When the compound operators are not specifically defined for a type,
+they are interpreted as specifying the operation (@PE[+] or @PE[-])
+on the two operands, followed by assignment of the result to the
+left-hand operand.
+
+@Paragraph(Assignment)
+Assignment of a value to the left-hand argument of an assignment
+operator is relatively flexible in GLISP. The following kinds of
+operands are allowed on the left-hand side of an assignment operator:
+@Begin(Enumerate)
+Variables.
+
+Stored substructures of a structured type.
+
+PROPerties of a structured type, whenever the interpretation of the PROPerty
+would be a legal left-hand side.
+
+Algebraic expressions involving numeric types, @I[ provided ] that
+the expression ultimately involves only one occurrence of a variable
+or stored value.@Foot{For example, @PE[(X^2 _ 2.0)] is acceptable,
+but @PE[(X*X@ _@ 2.0)] is not because the variable @PE[X] occurs twice.}
+@End(Enumerate)
+
+For example, consider the following Object Description for a CIRCLE:
+@ProgramExample{
+
+(CIRCLE (LIST (START VECTOR) (RADIUS REAL))
+ PROP ((PI (3.1415926))
+ (DIAMETER (RADIUS*2))
+ (CIRCUMFERENCE (PI*DIAMETER))
+ (AREA (PI*RADIUS^2))) )
+}
+Given this description, and a CIRCLE @PE[ C ],
+the following are legal assignments:
+@Programexample{
+
+(C:RADIUS _ 5.0)
+(C:AREA _ 100.0)
+(C:AREA _ C:AREA*2)
+(C:AREA _+ 100.0)
+}
+
+@Paragraph(Self-Assignment Operators
+@Foot[This section may be skipped by the casual user of GLISP.])
+
+There are some cases where it would be desirable to let an object
+perform an assignment of its own value. For example, the user might
+want to define @I[PropertyList] as an abstract datatype, with messages
+such as GETPROP and PUTPROP, and use PropertyLists as substructures
+of other datatypes. However, a message such as PUTPROP may cause the
+PropertyList object to modify its own structure, perhaps even changing
+its structure from NIL to a non-NIL value. If the function which
+implements PUTPROP performs a normal assignment to its "self" variable,
+the assignment will affect only the local variable, and will not modify
+the PropertyList component of the containing structure. The purpose
+of the Self-Assignment Operators is to allow such modification of the
+value within the containing structure.
+
+The Self-Assignment Operators are @PE[__], @PE[__+], @PE[_+_], and
+@PE[__-], corresponding to the operators @PE[_], @PE[_+], @PE[+_],
+and @PE[_-], respectively. The meaning of these operators is that
+the assignment is performed to the object on the left-hand side of
+the operator, @I[as seen from the structure containing the object].
+
+The use of these operators is highly restricted; any use of a
+Self-Assignment Operator must meet all of the following conditions:
+@Begin(Enumerate)
+A Self-Assignment Operator can only be used within a Message function
+which is compiled OPEN.
+
+The left-hand side of the assignment must be a simple variable which
+is an argument of the function.
+
+The left-hand-side variable must be given a unique (unusual) name to
+prevent accidental aliasing with a user variable name.
+@End(Enumerate)
+
+As an example, the PUTPROP message for a PropertyList datatype could
+be implemented as follows:
+@Begin(ProgramExample)
+
+ (PropertyList.PUTPROP (GLAMBDA (PropertyListPUTPROPself prop val)
+ (PropertyListPUTPROPself __
+ (LISTPUT PropertyListPUTPROPself prop val)) ))
+
+@End(ProgramExample)
+
+@Section(Control Statements)
+GLISP provides several PASCAL-like control statements.
+@Subsection(IF Statement)
+The syntax of the IF statement is as follows:
+@Begin(ProgramExample)
+(@B[IF] <condition@-[1]> @P[THEN] <action@-[11]>@ ...@ <action@-[1i]>
+ @P[ELSEIF] <condition@-[2]> @P[THEN] <action@-[21]>@ ...@ <action@-[2j]>
+ ...
+ @P[ELSE] <action@-[m1]>@ ...@ <action@-[mk]>)
+@End(ProgramExample)
+Such a statement is translated to a COND of the obvious form. The
+"THEN" keyword is optional, as are the "ELSEIF" and "ELSE" clauses.
+
+@Subsection(CASE Statement)
+The CASE statement selects a set of actions based on an atomic selector
+value; its syntax is:
+@Begin(ProgramExample)
+(@B[CASE] <selector> @B[OF]
+ (<case@-[1]> <action@-[11]>@ ...@ <action@-[1i]>)
+ (<case@-[2]> <action@-[21]>@ ...@ <action@-[2j]>)
+ ...
+ @P[ELSE] <action@-[m1]>@ ...@ <action@-[mk]>)
+@End(ProgramExample)
+The @PE[<selector>] is evaluated, and is compared with the given
+@PE[<case>] specifications. Each @PE[<case>] specification is either
+a single, atomic specification, or a list of atomic specifications.
+All @PE[<case>] specifications are assumed to be quoted. The "ELSE"
+clause is optional; the "ELSE" actions are executed if @PE[<selector>]
+does not match any @PE[<case>].
+
+If the @I[ type ] of the @PE[<selector>] has a VALUES specification,
+@PE[<case>] specifications which match the VALUES for that type will
+be translated into the corresponding values.
+
+@Subsection(FOR Statement)
+The FOR statement generates a loop through a set of elements (typically
+a list). Two syntaxes of the FOR statement are provided:
+@Begin(ProgramExample)
+
+(@B[FOR EACH] <set> @P[DO] <action@-[1]>@ ...@ <action@-[n]>)
+
+(@B[FOR] <variable> @B[IN] <set> @P[DO] <action@-[1]>@ ...@ <action@-[n]>)
+@End(ProgramExample)
+The keyword "DO" is optional. In the first form of the FOR statement,
+the singular form of the <set> is specified; GLISP will convert the
+given set name to the plural form.
+@Foot[For names with irregular plurals, the plural form should be put
+on the property list of the singular form under the property name
+PLURAL, e.g., @PE<(PUTPROP 'MAN 'PLURAL 'MEN)>.]
+The <set> may be qualified by an
+adjective or predicate phrase in the first form; the allowable syntaxes
+for such qualifying phrases are shown below:
+@Begin(ProgramExample)
+<set> @B[WITH] <predicate>
+<set> @B[WHICH IS] <adjective>
+<set> @B[WHO IS] <adjective>
+<set> @B[THAT IS] <adjective>
+@End(ProgramExample)
+The <predicate> and <adjective> phrases may be combined with AND, OR, NOT,
+and grouping parentheses. These phrases may be followed by a qualifying
+phrase of the form:
+@Begin(ProgramExample)
+@B[WHEN] <expression>
+@End(ProgramExample)
+The "WHEN" expression is ANDed with the other qualifying expressions to
+determine when the loop body will be executed.
+
+Within the FOR loop, the current member of
+the <set> which is being examined is automatically put into @I[context]
+at the highest level of priority.
+For example, suppose that the current context contains a substructure
+whose description is:
+@Begin(ProgramExample)
+(PLUMBERS (LISTOF EMPLOYEE))
+@END(ProgramExample)
+Assuming that EMPLOYEE contains the appropriate definitions, the
+following FOR loop could be written:
+@Begin(ProgramExample)
+(FOR EACH PLUMBER WHO IS NOT A TRAINEE DO SALARY _+ 1.50)
+@End(ProgramExample)
+
+To simplify the collection of features of a group of objects, the
+<action>s in the FOR loop may be replaced by the CLISP-like construct:
+@Begin(ProgramExample)
+ ... @B[COLLECT] <form>)
+@End(ProgramExample)
+
+@Subsection(WHILE Statement)
+The format of the WHILE statement is as follows:
+@Begin(ProgramExample)
+
+ (@B[WHILE] <condition> @B[DO] <action@-[1]> ... <action@-[n]>)
+
+@End(ProgramExample)
+The actions @PE(<action@-[1]>) through @PE(<action@-[n]>) are executed
+repeatedly as long as @PE(<condition>) is true. The keyword @B[DO]
+may be omitted. The value of the expression is NIL.
+
+@Subsection(REPEAT Statement)
+The format of the REPEAT statement is as follows:
+@Begin(ProgramExample)
+
+ (@B[REPEAT] <action@-[1]> ... <action@-[n]> @B[UNTIL] <condition>)
+
+@End(ProgramExample)
+The actions @PE(<action@-[1]>) through @PE(<action@-[n]>) are repeated
+(always at least once) until @PE[<condition>] is true. The value of
+the expression is NIL. The keyword @B[UNTIL] is required.
+
+@Section(Definite Reference to Particular Objects)
+In order to simplify reference to particular member(s) of a group,
+definite reference may be used. Such an expression is written using
+the word @B[THE] followed by the singular form of the group,
+or @B[THOSE] followed by the plural form of the group, and
+qualifying phrases (as described for the @B[FOR] statement).
+The following examples illustrate these expressions.
+@Begin(ProgramExample)
+ (THE SLOT WITH SLOTNAME = NAME)
+ (THOSE EMPLOYEES WITH JOBTITLE = 'ELECTRICIAN)
+@End(ProgramExample)
+The value of @B[THE] is a single object (or NIL if no object satisfies
+the specified conditions); @B[THOSE] produces a list of all objects
+satisfying the conditions.@Foot[In general, nested loops are optimized
+so that intermediate lists are not actually constructed. Therefore,
+use of nested THE or THOSE statements is not inefficient.]
+
+@Chapter(Messages)
+GLISP supports the @I[Message] metaphor, which has its roots in the
+languages SIMULA and SMALLTALK. These languages provide
+@I[Object-Centered Programming], in which objects are thought of as
+being active entities which communicate by sending each other
+@I[Messages]. The internal structures of objects are hidden; a program
+which wishes to access "variables" of an object does so by sending
+messages to the object requesting the access desired. Each object
+contains
+@Foot[typically by inheritance from some parent in a Class hierarchy]
+a list of @I[Selectors], which identify the messages to which the object
+can respond. A @I[Message] specifies the destination object, the
+selector, and any arguments associated with the message. When a
+message is executed at runtime, the selector is looked up for the
+destination object; associated with the selector is a procedure, which
+is executed with the destination object and message arguments as its
+arguments.
+
+GLISP treats reference to properties, adjectives, and predicates
+associated with an object similarly to the way it treats messages.
+The compiler is able to perform much of the lookup of @I[selectors]
+at compile time, resulting in efficient code while maintaining the
+flexibility of the
+message metaphor. Messages can be defined in such a way that they
+compile open, compile as function calls to the function which is
+associated with the selector, or compile as messages to be interpreted
+at runtime.
+
+Sending of a @I[message] in GLISP is specified using the following syntax:
+@Begin(ProgramExample)
+@B[(SEND] <object> <selector> <arg@-[1]>@ ...@ <arg@-[n]>@B[)]
+@End(ProgramExample)
+The keyword "SEND" may be replaced by "@B[@PE(_)]". The @PE[<selector>]
+is assumed to be quoted. Zero or more arguments may be specified;
+the arguments other than @PE[<selector>] are evaluated.
+@PE[<object>] is evaluated; if @PE[<object>] is a non-atomic expression,
+it must be enclosed in at least one set of parantheses, so that the
+@PE[<selector>] will always be the third element of the list.
+
+@SECTION(Compilation of Messages)
+When GLISP encounters a message statement, it looks up the <selector>
+in the MSG definition of the type of the object to which the message
+is sent, or in one of the SUPERS of the type.
+@Foot[If an appropriate representation language is provided, the
+<selector> and its associated <response>
+may be inherited from a parent class in the class hierarchy of the
+representation language.]
+Each <selector> is paired with the appropriate <response> to the message.
+Code is compiled depending on the form
+of the <response> associated with the <selector>, as follows:
+@Foot[If the type of the destination object is unknown, or if the
+<selector> cannot be found, GLISP compiles the (SEND@ ...) statement
+as if it is a normal function call.]
+@Begin(Enumerate)
+If the <response> is an atom, that atom is taken as the name of a
+function which is to be called in response to the message. The code
+which is compiled is a direct call to this function,
+@Begin(ProgramExample)
+(<response> <object> <arg@-[1]> ... <arg@-[n]>)
+@End(ProgramExample)
+
+If the <response> is a list, the contents of the list are recursively
+compiled in-line as GLISP code, with the name "@PE[self]" artificially
+"bound" to the <object> to which the message was sent. Because the
+compilation is recursive, a message may be defined in terms of other
+messages, substructures, or properties, which may themselves be defined
+as messages.
+@Foot[Such recursive definitions must of course be acyclic.]
+The outer pair of parentheses of the <response> serves only to bound
+its contents; thus, if the <response> is a function call, the function
+call must be enclosed in an additional set of parentheses.
+@End(Enumerate)
+
+The following examples illustrate the various ways of defining message
+responses.
+@Begin(ProgramExample)
+
+(EDIT EDITV)
+
+(SUCCESSOR (self + 1))
+
+(MAGNITUDE ((SQRT X*X + Y*Y)))
+
+@End(ProgramExample)
+In the first example, a message with <selector> EDIT is
+compiled as a direct call to the function EDITV. In the
+second example, the SUCCESSOR message is compiled as the sum of
+the object receiving the message (represented by "@PE[self]") and the
+constant 1; if the object receiving the message is the value of the
+variable J and has the type INTEGER, the code generated
+for the SUCCESSOR would be @PE[(ADD1 J)]. The third example illustrates
+a call to a function, SQRT, with arguments containing definite
+references to X and Y (which presumably are defined as part of the
+object whose MAGNITUDE is sought). Note that since MAGNITUDE is
+defined by a function call, an "extra" pair of parentheses is
+required around the function call to distinguish it from in-line code.
+
+The user can determine whether a message is to be compiled open,
+compiled as a function call, or compiled as a message which is to
+be executed at runtime.
+When a GLISP expression is specified as a <response>, the <response>
+is always compiled open; open compilation can be requested by using
+the OPEN property when the <response> is a function name.
+Open compilation operates like
+macro expansion; since the "macro" is a GLISP expression, it is easy
+to define messages and properties in terms of other messages and
+properties. The combined capabilities of open compilation, message
+inheritance, conditional compilation, and flexible assignment provide
+a great deal of power.
+The ability to use definite reference in GLISP makes
+the definition and use of the "macros" simple and natural.
+
+@Section(Compilation of Properties and Adjectives)
+Properties, Adjectives, and ISA-adjectives are compiled in the
+same way as Messages. Since the syntax of use of properties and
+adjectives does not permit specification of any arguments, the only
+argument available to code or a function which implements the
+@PE[<response>] for a property or adjective is the @PE[ self ]
+argument, which denotes the object to which the property or adjective
+applies. A @PE[<response>] which is written directly as GLISP code
+may use the name @PE[ self ] directly
+@Foot[The name @PE< self > is "declared" by the compiler, and does
+not have to be specified in the Structure Description.], as in the
+SUCCESSOR example above; a function which is specified as the
+@PE[<response>] will be called with the @PE[self]
+object as its single argument.
+
+@Section(Declarations for Message Compilation)
+Declarations which affect compilation of Messages, Adjectives, or
+Properties may be specified following the <response> for a given
+message; such declarations are in (Interlisp) property-list format,
+@PE[<prop@-[1]><value@-[1]>@ ...@ <prop@-[n]><value@-[n]>]. The
+following declarations may be specified:
+@Begin(Enumerate)
+@B[RESULT]@PE[ <type>]
+@*
+This declaration specifies the @I[type] of the result of the
+message or other property. Specification of result types helps the
+compiler to perform type inference, thus reducing the number of type
+declarations needed in user programs.
+The RESULT type for simple GLISP expressions will be inferred by the
+compiler; the RESULT declaration should be used if the @PE[<response>]
+is a complex GLISP expression or a function name.
+@Foot[Alternatively, the result of a function may be specified by the
+RESULT declaration within the function itself.]@
+
+@B[OPEN@ @ T]
+@*
+This declaration specifies that the function which is specified as the
+<response> is to be compiled open at each reference. A <response>
+which is a list of GLISP code is always compiled open; however, such
+a <response> can have only the @PE[self] argument. If it is desired to
+compile open a Message <response> which has arguments besides @PE[self],
+the <response> must be coded as a function (in order to bind the
+arguments) and the OPEN declaration must be used.
+Functions which are compiled open may not be recursive via any chain
+of open-compiled functions.
+
+@B[MESSAGE@ @ T]
+@*
+This declaration specifies that a runtime message should be generated
+for messages with this <selector> sent to objects of this Class.
+Typically, such a declaration would be used in a higher-level Class
+whose subclasses have different responses to the same message
+<selector>.
+@End(Enumerate)
+
+@Section(Operator Overloading)
+GLISP provides operator overloading for user-defined objects using
+the Message facility. If an arithmetic operator is defined as the
+@I[selector] of a message for a user datatype, an arithmetic
+subexpression using that operator will be compiled as if it were
+a message call with two arguments. For example, the type VECTOR
+might have the declaration and function definitions below:
+@Begin(ProgramExample)
+
+(GLISPOBJECTS
+ (VECTOR (CONS (X INTEGER) (Y INTEGER))
+ MSG ((+ VECTORPLUS OPEN T)
+ (_+ VECTORINCR OPEN T)) ) )
+
+(DEFINEQ
+
+ (VECTORPLUS (GLAMBDA (U,V:VECTOR)
+ (A VECTOR WITH X = U:X + V:X , Y = U:Y + V:Y) ))
+
+ (VECTORINCR (GLAMBDA (U,V:VECTOR)
+ (U:X _+ V:X)
+ (U:Y _+ V:Y) )) )
+
+@End(ProgramExample)
+With these definitions, an expression involving the operators @PE[+]
+or @PE[_+] will be compiled by open compilation of the respective
+functions.
+
+The compound operators (@PE[_+ +_ _- -_]) are conventionally thought of as
+"destructive replacement" operators; thus, the expression
+@PE[(U@ _@ U@ +@ V)] will create a new VECTOR structure and assign
+the new structure to U, while the expression @PE[(U@ _+@ V)] will
+smash the existing structure U, given the definitions above.
+The convention of letting the compound operators specify "destructive
+replacement" allows the user to specify both the destructive and
+non-destructive cases. However, if the compound operators are not
+overloaded but the arithmetic operators @PE[+] and @PE[-] are
+overloaded, the compound operators are compiled using the definitions
+of @PE[+] for @PE[_+] and @PE[+_], and @PE[-] for @PE[_-] and @PE[-_].
+Thus, if only the @PE[+] operator were overloaded for VECTOR, the
+expression @PE[(U@ _+@ V)] would be compiled as if it were
+@PE[(U@ _@ U@ +@ V)].
+
+@Section(Runtime Interpretation of Messages)
+In some cases, the type of the object which will receive a given message
+is not known at compile time; in such cases, the message must be
+executed interpretively, at runtime. Interpretive
+execution is provided for all types of GLISP messages.
+
+An interpretive message call (i.e., a call to the function @PE[SEND])
+is generated by the GLISP compiler in response to a message call in
+a GLISP program when the specified message selector cannot be found
+for the declared type of the object receiving the message, or when
+the MESSAGE flag is set for that selector. Alternatively, a call to
+SEND may be entered interactively by the user or may be contained in
+a function which has not been compiled by GLISP.
+
+Messages can be interpreted only for those objects which are represented
+as one of the OBJECT types, since it is necessary that the object
+contain a pointer to its CLASS. The <selector> of the message is
+looked up in the MSG declarations of the CLASS; if it is not found
+there, the SUPERS of the CLASS are examined (depth-first) until the
+selector is found. The <response> associated with the <selector> is
+then examined. If the <response> is a function name, that function is
+simply called with the specified arguments.@Foot{The object to which
+the message is sent is always inserted as the first argument, followed
+by the other arguments specified in the message call.} If the
+<response> is a GLISP expression, the expression is compiled as a
+LAMBDA form and cached for future use.
+
+Interpretive execution is available for other property types (PROP,
+ADJ, and ISA) using the call:
+@Programexample[
+
+(SENDPROP <object> <selector> <proptype>)
+
+]
+where @PE[<proptype>] is PROP, ADJ, or ISA. @PE[<proptype>] is not
+evaluated.
+
+@Chapter(Context Rules and Reference)
+The ability to use definite reference to features of objects which
+are in @I[Context] is the key to much of GLISP's power. At the
+same time, definite reference introduces the possibility of ambiguity,
+i.e., there could be more than one object in Context which has
+a feature with a specified name. In this chapter, guidelines are
+presented for use of definite reference to allow the user to avoid
+ambiguity.
+
+@Section(Organization of Context)
+The Context maintained by the compiler is organized in levels, each
+of which may have multiple entries; the sequence of
+levels is a stack. Searching of the Context
+proceeds from the top (nearest) level of the stack to the bottom
+(farthest) level. The bottom level of the stack is composed of the
+LAMBDA variables of the function being compiled. New levels
+are added to the Context in the following cases:
+@Begin(Enumerate)
+When a PROG is compiled. The PROG variables are added to the new
+level.
+
+When a @B[For] loop is compiled. The "loop index" variable (which may
+be either a user variable or a compiler variable) is added to the
+new level, so that it is in context during the loop.
+
+When a @B[While] loop is compiled.
+
+When a new clause of an @B[If] statement is compiled.
+@End(Enumerate)
+
+When a Message, Property, or Adjective is compiled, that compilation
+takes place in a @I[ new ] context consisting only of the @PE[ self ]
+argument and other message arguments.
+
+@Section(Rules for Using Definite Reference)
+The possibility of referential ambiguity is easily controlled in practice.
+First, it should be noted that the traditional methods of unique
+naming and complete path specification ("PASCAL style")
+are available, and should be
+used whenever there is any possibility of ambiguity. Second, there
+are several cases which are guaranteed to be unambiguous:
+@Begin(Enumerate)
+In compiling GLISP code which implements a Message, Property, or
+Adjective, only the @PE[@ self@ ] argument is in context initially;
+definite reference to any substructure or property of the object
+is therefore unambiguous.
+@Foot[Unless there are duplicated names in the object definition.
+However, if the same name is used as both a Property and an Adjective,
+for example, it is not considered a duplicate since Properties and
+Adjectives are specified by different source language constructs.]@
+
+Within a @B[For] loop, the loop variable is the closest thing in
+context.
+
+In many cases, a function will only have a single structured argument;
+in such cases, definite reference is unambiguous.
+@End(Enumerate)
+If "PASCAL" syntax (or the equivalent English-like form) is used for
+references other than the above cases, no ambiguities will occur.
+@Section(Type Inference)
+In order to interpret definite references to features of objects,
+the compiler must know the @I[ types ] of the objects. However,
+explicit type specification can be burdensome, and makes it difficult
+to change types without rewriting existing type declarations.
+The GLISP compiler performs type inference in many cases, relieving
+the programmer of the burden of specifying types explicitly. The
+following rules enable the programmer to know when types will be
+inferred by the compiler.
+@Begin(Enumerate)
+Whenever a variable is set to a value whose type is known,
+the type of the variable
+is inferred to be the type of the value to which it was set.
+
+If a variable whose initial type was NIL (e.g., an untyped PROG variable)
+appears on the left-hand side of the @PE[@ _+@ ] operator, its type
+is inferred to be @PE[(LISTOF@ <type>)], where @PE[@ <type>@ ] is
+the type of the right-hand side of the @PE[@ _+@ ] expression.
+
+Whenever a substructure of a structured object is retrieved, the type
+of the substructure is retrieved also.
+
+Types of infix expressions are inferred.
+
+Types of Properties, Adjectives, and Messages are inferred if:
+@Begin(Enumerate)
+The @PE[ <response> ] is GLISP code whose type can be inferred.
+
+The @PE[ <response> ] has a RESULT declaration associated with it.
+
+The @PE[ <response> ] is a function whose definition includes a
+RESULT declaration, or whose property list contains a GLRESULTTYPE
+declaration.
+@End(Enumerate)
+
+The type of the "loop variable" in a @B[For] loop is inferred and is
+added to a new level of Context by the compiler.
+
+If an @B[If] statement tests the type of a variable using a @PE[@ self@ ]
+adjective, the variable is inferred to be of that type if the test is
+satisfied. Similar type inference is performed if the test of the type
+of the variable is the condition of a @B[While] statement.
+
+When possible, GLISP infers the type of the function it is compiling
+and adds the type of the result to the property list of the function
+name under the indicator GLRESULTTYPE.
+
+The types returned by many standard Lisp functions are known by the
+compiler.
+@End(Enumerate)
+
+@Chapter(GLISP and Knowledge Representation Languages)
+GLISP provides a convenient @I[Access Language] which allows uniform
+specification of access to objects, without regard to the way in
+which the objects are actually stored; in addition, GLISP provides
+a basic @I[Representation Language], in which the structures and
+properties of objects can be declared. The field of Artificial
+Intelligence has spawned a number of powerful Representation
+Languages, which provide power in describing large numbers of object
+classes by allowing hierarchies of @I[Class] descriptions, in which
+instances of Classes can inherit properties and procedures from
+parent Classes. The @I[Access Languages] provided for these Representation
+Languages, however, have typically been rudimentary, often being no
+more than variations of LISP's GETPROP and PUTPROP. In addition,
+by performing inheritance of procedures and data values at runtime,
+these Representation Languages have often been computationally costly.
+
+Facilities are provided for interfacing GLISP with representation
+languages of the user's choice. When this is done,
+GLISP provides a convenient and uniform language for
+accessing both objects in the Representation Language and LISP objects.
+In addition, GLISP can greatly improve the efficiency of programs which
+access the representations by performing lookup of procedures and data
+in the Class hierarchy @I[at compile time]. Finally, a LISP structure
+can be specified @I[as the way of implementing] instances of a Class
+in the Representation Language, so that while the objects in such a
+class appear the same as other objects in the Representation Language
+and are accessed in the same way, they are actually implemented as
+LISP objects which are efficient in both time and storage.
+
+A clean
+@Foot[Cleanliness is in the eye of the beholder and, being next to
+Godliness, difficult to attain. However, it's @I(relatively) clean.]
+interface between GLISP and a Representation Language is provided.
+With such an interface, each @I[Class] in the Representation Language
+is acceptable as a GLISP @I[type]. When the program which is being
+compiled specifies an access to an object which is known to be a
+member of some Class, the interface module for the Representation
+Language is called to generate code to perform the access. The
+interface module can perform inheritance within the Class hierarchy,
+and can call GLISP compiler functions to compile code for
+subexpressions. Properties, Adjectives, and Messages in GLISP format
+can be added to Class definitions, and can be inherited by subclasses
+at compile time. In an Object-Centered representation language or
+other representation language which relies heavily on procedural
+inheritance, substantial improvements in execution speed can be
+achieved by performing the inheritance lookup at compile time and
+compiling direct procedure calls to inherited procedures when the
+procedures are static and the type of the object which inherits the
+procedure is known at compile time.
+
+Specifications for an interface module for GLISP are contained in a
+separate document@Foot[to be written.]. To date, GLISP has been
+interfaced to our own GIRL representation language, and to LOOPS.
+@Foot[LOOPS, a LISP Object Oriented Programming System, is being
+developed at Xerox Palo Alto Research Center by Dan Bobrow and
+yMark Stefik.]
+
+@Chapter(Obtaining and Using GLISP)
+GLISP and its documentation are available free of charge over the
+ARPANET. The host computers involved will accept the login
+"ANONYMOUS GUEST" for transferring files with FTP.
+@Section(Documentation)
+This user's manual, in line-printer format, is contained in
+@PE([UTEXAS-20]<CS.NOVAK>GLUSER.LPT) . The SCRIBE source file is
+@PE([SU-SCORE]<CSD.NOVAK>GLUSER.MSS) . Printed copies of this manual
+can be ordered from Publications Coordinator, Computer Science
+Department, Stanford University, Stanford, CA 94305, as technical report
+STAN-CS-82-895 ($3.15 prepaid); the printed version may not be as
+up-to-date as the on-line version.
+@Section(Compiler Files)
+There are two files, GLISP (the compiler itself) and GLTEST (a file
+of examples). The files for the different Lisp dialects are:
+@Tabset(1.4 inch)
+@Begin(Format)
+Interlisp:@\@PE([SU-SCORE]<CSD.NOVAK>GLISP.LSP) and @PE(GLTEST.LSP)
+Maclisp:@\@PE([SU-SCORE]<CSD.NOVAK>GLISP.MAC) and @PE(GLTEST.MAC)
+UCI Lisp:@\@PE([UTEXAS-20]<CS.NOVAK>GLISP.UCI) and @PE(GLTEST.UCI)
+ELISP:@\the UCI version plus @PE([UTEXAS-20]<CS.NOVAK>ELISP.FIX)
+Franz Lisp:@\@PE([SUMEX-AIM]<NOVAK>GLISP.FRANZ) and @PE(GLTEST.FRANZ)
+PSL:@\@PE([SU-SCORE]<CSD.NOVAK>GLISP.PSL) and @PE(GLTEST.PSL)
+@End(Format)
+@Section(Getting Started)
+Useful functions for invoking GLISP are:
+@Begin(Format)
+@PE[(GLCC 'FN)]@\Compile FN.
+
+@PE[(GLCP 'FN)]@\Compile FN and prettyprint result.
+
+@PE[(GLP 'FN)]@\Prettyprint GLISP-compiled version of FN.
+
+@PE[(GLED 'NAME)]@\Edit the property list of NAME.
+
+@PE[(GLEDF 'FN)]@\Edit the original (GLISP) definition of FN.
+@\(The original definition is saved under the property
+@\"GLORIGINALEXPR" when the function is compiled, and
+@\the compiled version replaces the function
+@\definition.)
+
+@PE[(GLEDS 'STR)]@\Edit the structure declarations of STR.
+@End(Format)
+The editing functions call the "BBN/Interlisp" structure editor.
+
+To try out GLISP, load the GLTEST file and use GLCP to compile the
+functions CURRENTDATE, GIVE-RAISE, TESTFN1, TESTFN2, DRAWRECT,
+TP, GROWCIRCLE, and SQUASH. To run compiled functions on test data,
+do:
+@Begin(ProgramExample)
+(GIVE-RAISE 'COMPANY1)
+(TP '(((A (B (C D (E (G H (I J (K))))))))))
+(GROWCIRCLE MYCIRCLE)
+@END(ProgramExample)
+
+@Section(Reserved Words and Characters)
+GLISP contains ordinary lisp as a sublanguage. However, in order to
+avoid having code which was intended as "ordinary lisp" interpreted
+as GLISP code, it is necessary to follow certain conventions when
+writing "ordinary lisp" code.
+
+@Subsection(Reserved Characters)
+The colon and the characters which represent the arithmetic operators
+should not be used within atom names, since GLISP splits apart "atoms"
+which contain operators. The set of characters to be avoided within
+atom names is:
+@Programexample{
+
++ * / ^ _ ~ = < > : ' ,
+
+}
+The character "minus" (@PE[ - ]) is permitted within atom names unless
+the flag @PE[GLSEPMINUS] is set.
+
+Some GLISP constructs permit (but do
+not require) use of the character "comma" (@PE[ , ]); since the comma
+is used as a "backquote" character in some Lisp dialects, the user may
+wish to avoid its use. When used in Lisp dialects which use comma as
+a backquote character, all commas must be "escaped" or "slashified";
+this makes porting of GLISP code containing commas more difficult.
+
+@Subsection(Reserved Function Names)
+Most GLISP function, variable, and property names begin with "@PE[GL]"
+to avoid conflict with user names. Those "function" names which are
+used in GLISP constructs or in interpretive functions should be
+avoided. This set includes the following names:
+@Programexample{
+
+A AN CASE FOR IF
+REPEAT SEND SENDPROP THE WHILE
+
+}
+
+@SUBSECTION(Other Reserved Names)
+Words which are used within GLISP constructs should be avoided as
+variable names. This set of names includes:
+@ProgramExample{
+
+A AN DO ELSE ELSEIF
+IS OF THE THEN UNTIL
+}
+
+@SECTION(Lisp Dialect Idiosyncrasies)
+
+GLISP code passes through the Lisp reader before it is seen by GLISP.
+For this reason, operators in expressions may need to be set off from
+operands by blanks; the operator "@PE[-]" should always be surrounded
+by blanks, and the operator "@PE[+]" should be separated from numbers
+by blanks.
+
+@Subsection(Interlisp)
+GLISP compilation happens automatically, and usually does not need
+to be invoked explicitly. GLISP declarations are integrated with the
+file package.
+@Subsection(UCI Lisp)
+The following command is needed before loading to make room for GLISP:
+@ProgramExample[(REALLOC 3000 1000 1000 1000 35000)]
+The compiler file modifies the syntax of the character @B[~] to be
+"alphabetic" so it can be used as a GLISP operator.
+The character "@PE[/]" must be "slashified" to "@PE[//]".
+@Subsection(ELISP)
+For ELISP, the UCI Lisp version of the compiler is used, together with
+a small compatibility file. The above comments about UCI lisp do not
+apply to ELISP.
+The characters "@PE[/]" and "@PE[,]" must be "slashified" to "@PE[//]"
+and "@PE[/,]".
+@Subsection(Maclisp)
+The characters "@PE[/]" and "@PE[,]" must be "slashified" to "@PE[//]"
+and "@PE[/,]".
+@Subsection(Franz Lisp)
+Automatic compilation is implemented for Franz Lisp.
+The character "@PE[,]" and the operators "@PE[+_]" and "@PE[-_]"
+must be "slashified" to "@PE[\,]", "@PE[+\_]", and "@PE[-\_]",
+respectively. Before loading GLISP, edit something to cause the
+editor files to be loaded@Foot[Some versions of the "CMU editor"
+contain function definitions which may conflict with those of
+GLISP; if the editor is loaded first, the GLISP versions override.].
+The Franz Lisp version of GLISP has been tested
+on Opus 38 Franz Lisp; users with earlier versions of Franz might
+encounter difficulties.
+
+@Section(Bug Reports and Mailing List)
+To get on the GLISP mailing list or to report bugs, send mail to
+CSD.NOVAK@@SU-SCORE.
+
+
+@Chapter(GLISP Hacks)
+This chapter discusses some ways of doing things in GLISP which might
+not be entirely obvious at first glance.
+@Section(Overloading Basic Types)
+GLISP provides the ability to define properties of structures described
+in the Structure Description language; since the elementary LISP types
+are structures in this language, objects whose storage representation
+is an elementary type can be "overloaded" by specifying properties
+and operators for them. The following examples illustrate how this
+can be done.
+@Begin(ProgramExample)
+
+(GLDEFSTRQ
+
+
+(ArithmeticOperator (self ATOM)
+
+ PROP ((Precedence OperatorPrecedenceFn RESULT INTEGER)
+ (PrintForm ((GETPROP self 'PRINTFORM) or self)) )
+
+ MSG ((PRIN1 ((PRIN1 the PrintForm)))) )
+
+
+(IntegerMod7 (self INTEGER)
+
+ PROP ((Modulus (7))
+ (Inverse ((If self is ZERO then 0
+ else (Modulus - self))) ))
+
+ ADJ ((Even ((ZEROP (LOGAND self 1))))
+ (Odd (NOT Even)))
+
+ ISA ((Prime PrimeTestFn))
+
+ MSG ((+ IMod7Plus OPEN T RESULT IntegerMod7)
+ (_ IMod7Store OPEN T RESULT IntegerMod7)) )
+
+)
+(DEFINEQ
+
+(IMod7Store (GLAMBDA (LHS:IntegerMod7 RHS:INTEGER)
+ (LHS:self __ (IREMAINDER RHS Modulus)) ))
+
+(IMod7Plus (GLAMBDA (X,Y:IntegerMod7)
+ (IREMAINDER (X:self + Y:self) X:Modulus) ))
+)
+@End(ProgramExample)
+A few subtleties of the function IMod7Store are worth noting.
+First, the left-hand-side expression used in storing the result is
+LHS:self rather than simply LHS. LHS and LHS:self of course refer
+to the same actual structure; however, the @I[type] of LHS is
+IntegerMod7, while the type of LHS:self is INTEGER. If LHS were
+used on the left-hand side, since the @PE[ _ ] operator is
+overloaded for IntegerMod7, the function IMod7Store would be invoked
+again to perform its own function; since the function is compiled
+OPEN, this would be an infinite loop. A second subtlety is that the
+assignment to LHS:self must use the self-assignment operator, @PE[@ __@ ],
+since it is desired to perform assignment as seen "outside" the
+function IMod7Store, i.e., in the environment in which the original
+assignment operation was specified.
+@Section(Disjunctive Types)
+LISP programming often involves objects which may in fact be of
+different types, but which are for some purposes treated alike.
+For example, LISP data structures are typically constructed of
+CONS cells whose fields may point to other CONS cells or to ATOMs.
+The GLISP Structure Description language does not permit the user
+to specify that a certain field of a structure is a CONS cell @P[or]
+an ATOM. However, it is possible to create a GLISP datatype which
+encompasses both. Typically, this is done by declaring the structure
+of the object to be the complex structure, and testing for the
+simpler structure explicitly. This is illustrated for the case of
+the LISP tree below.
+@Begin(ProgramExample)
+
+ (LISPTREE (CONS (CAR LISPTREE) (CDR LISPTREE))
+
+ ADJ ((EMPTY (@R<~>self)))
+
+ PROP ((LEFTSON ((If self is ATOMIC then NIL else CAR)))
+ (RIGHTSON ((If self is ATOMIC then NIL else CDR)))))
+
+@End(ProgramExample)
+@Section(Generators)
+Often, one would like to define such properties of an object as the
+way of enumerating its parts in some order. Such things
+cannot be specified directly as properties of the object because they
+depend on the previous state of the enumeration. However, it is
+possible to define an object, associated with the original datatype,
+which contains the state of the enumeration and responds to Messages.
+This is illustrated below by an object which searches a tree in Preorder.
+@Begin(ProgramExample)
+
+(PreorderSearchRecord (CONS (Node LISPTREE)
+ (PreviousNodes (LISTOF LISPTREE)))
+
+ MSG ((NEXT ((PROG (TMP)
+ (If TMP_Node:LEFTSON
+ then (If Node:RIGHTSON
+ then PreviousNodes+_Node)
+ Node_TMP
+ else TMP-_PreviousNodes
+ Node_TMP:RIGHTSON) ))))
+
+
+(TP (GLAMBDA ((A LISPTREE))
+ (PROG (PSR)
+ (PSR _ (A PreorderSearchRecord
+ with Node = (the LISPTREE)))
+ (While Node (If Node is ATOMIC (PRINT Node))
+ (_ PSR NEXT)) )))
+
+@End(ProgramExample)
+The object class PreorderSearchRecord serves two purposes: it holds
+the state of the enumeration, and it responds to messages to step
+through the enumeration. With these definitions, it is easy to write
+a program involving enumeration of a LISPTREE, as illustrated by
+the example function TP above. By being open-compiled, messages to
+an object can be as efficient as in-line hand coding; yet, the code
+for the messages only has to be written once, and can easily be
+changed without changing the programs which use the messages.
+@Chapter(Program Examples)
+In this chapter, examples of GLISP object declarations and programs
+are presented. Each example is discussed as a section of this
+chapter; the code for the examples and the code produced by the
+compiler are shown for each example at the end of the chapter.
+@Section(GLTST1 File)
+The GLTST1 file illustrates the use of several types of LISP
+structures, and the use of fairly complex Property definitions
+for objects. SENIORITY of an EMPLOYEE, for example, is defined
+in terms of the YEAR of DATE-HIRED, which is a substructure of
+EMPLOYEE, and the YEAR of the function (CURRENTDATE).
+@Foot[The @I<type> of (CURRENTDATE) must be known to the compiler,
+either by compiling it first, or by including a RESULT declaration
+in the function definition of CURRENTDATE, or by specifying the
+GLRESULTTYPE property for the function name.]
+@Section(GLTST2 File)
+The GLTST2 file illustrates the use of Messages for ordinary LISP
+objects. By defining the arithmetic operators as Message selectors
+for the object VECTOR, use of vectors in arithmetic expressions
+is enabled; OPEN compilation is specified for these messages.
+
+The definition of GRAPHICSOBJECT uses VECTORs as components.
+While the actual structure of a GRAPHICSOBJECT is simple,
+numerous properties are defined for user convenience.
+The definition of CENTER is easily stated as a VECTOR expression.
+
+The Messages of GRAPHICSOBJECT illustrate how different responses
+to a message for different types of objects can be achieved, even
+though for GLISP compilation of messages to LISP objects the code
+for a message must be resolved at compile time.
+@Foot[For objects in a Representation Language, messages may be
+compiled directly as LISP code or as messages to be interpreted at
+runtime, depending on how much is known about the object to which the
+message is sent and the compilation declarations in effect.]
+The DRAW and
+ERASE messages get the function to be used from the property list
+of the SHAPE name of the GRAPHICSOBJECT and APPLY it to draw the
+desired object.
+
+MOVINGGRAPHICSOBJECT contains a GRAPHICSOBJECT as a TRANSPARENT
+component, so that it inherits the properties of a GRAPHICSOBJECT;
+a MOVINGGRAPHICSOBJECT is a GRAPHICSOBJECT which has a VELOCITY,
+and will move itself by the amount of its velocity upon the message
+command STEP.@Foot[This example is adapted from the MovingPoint
+example written by Dan Bobrow for LOOPS.]
+The compilation of the message
+@PE[(_@ MGO@ STEP)] in the function TESTFN1 is of particular
+interest. This message is expanded
+into the sending of the message @PE[(_@ self@ MOVE@ VELOCITY)]
+to the MOVINGGRAPHICSOBJECT. The MOVINGGRAPHICSOBJECT cannot respond
+to such a message; however, since it contains a GRAPHICSOBJECT as a
+TRANSPARENT component, its GRAPHICSOBJECT responds to the message.
+@Foot[TRANSPARENT substructures thus permit procedural inheritance by
+LISP objects.]
+A GRAPHICSOBJECT responds to a MOVE message by
+erasing itself, increasing its START point by the (vector) distance
+to be moved, and
+then redrawing itself. All of the messages are specified as being
+compiled open, so that the short original message actually generates
+a large amount of code.
+
+A rectangle is drawn by the function DRAWRECT. Note how the use of
+the properties defined for a GRAPHICSOBJECT allows an easy interface
+to the system functions MOVETO and DRAWTO in terms of the properties
+LEFT, RIGHT, TOP, and BOTTOM.
ADDED psl-1983/3-1/glisp/grtree.old
Index: psl-1983/3-1/glisp/grtree.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/grtree.old
@@ -0,0 +1,229 @@
+(FILECREATED "15-JAN-83 16:03:58" {DSK}GRTREE.LSP;11 7426
+
+ changes to: (FNS STRINGDATA-DRAW TREEELEMENT-DRAWIN BOXTYPE-DRAW BOXTYPE-ERASE DRAWRECTANGLE
+ GRAPHICSBOX-DRAWIN GRAPHICSBOX-ERASEIN MATCHTREE RECTANGLESIZE
+ BOXTYPE-SETSIZE GRAPHICSTREE-BOXTYPE GRAPHICSTREE-WIDTH)
+ (VARS GRTREECOMS GRAPHICSBOXTYPES)
+ (PROPS (RECTANGLE SIZEPROGRAM)
+ (RECTANGLE DRAWPROGRAM))
+
+ previous date: "13-JAN-83 10:32:08" {DSK}GRTREE.LSP;1)
+
+
+(PRETTYCOMPRINT GRTREECOMS)
+
+(RPAQQ GRTREECOMS [(GLISPOBJECTS BOXTYPE GRAPHICSBOX GRAPHICSTREE LISPGRAPHICSTREE LISPNODEDISPLAY
+ TREEELEMENT)
+ (FNS BOXTYPE-DRAW BOXTYPE-ERASE BOXTYPE-SETSIZE DRAWRECTANGLE GRAPHICSBOX-DRAWIN
+ GRAPHICSBOX-ERASEIN MATCHTREE RECTANGLESIZE STRINGDATA-DRAW
+ TREEELEMENT-DRAWIN)
+ (GLISPGLOBALS GRAPHICSBOXTYPES)
+ (PROP DRAWPROGRAM RECTANGLE)
+ (PROP SIZEPROGRAM RECTANGLE)
+ (VARS GRAPHICSBOXTYPES)
+ (GLOBALVARS GRAPHICSBOXTYPES)
+ (P (LOAD? (QUOTE VECTOR.LSP])
+
+
+[GLISPOBJECTS
+
+
+(BOXTYPE
+
+ (ATOM (PROPLIST (DRAWPROGRAM ATOM)
+ (SIZEPROGRAM ATOM)))
+
+ MSG ((DRAW BOXTYPE-DRAW OPEN T)
+ (ERASE BOXTYPE-ERASE OPEN T)
+ (SETSIZE BOXTYPE-SETSIZE OPEN T)) )
+
+(GRAPHICSBOX
+
+ (LISTOBJECT (BOXTYPE BOXTYPE)
+ (START VECTOR)
+ (SIZE VECTOR)
+ (CONTENTSOFFSET VECTOR)
+ (DISPLAYCONTENTS ANYTHING)
+ (CONTENTSSIZE VECTOR))
+
+ MSG [(DRAWIN GRAPHICSBOX-DRAWIN OPEN T)
+ (ERASEIN GRAPHICSBOX-ERASEIN OPEN T)
+ (SETSIZE ((SEND BOXTYPE SETSIZE self]
+
+ SUPERS (REGION) )
+
+(GRAPHICSTREE
+
+ ANYTHING
+
+ PROP ((BOXTYPE (BOXTYPENAME)
+ RESULT BOXTYPE))
+
+ MSG ((MAKEGRAPHICSTREE MATCHTREE)
+ (DRAW GRAPHICSTREE-DRAW)
+ (TERMINAL? (self IS TERMINAL))) )
+
+(LISPGRAPHICSTREE
+
+ (LISTOBJECT (EXPR ANYTHING))
+
+ PROP ((BOXTYPENAME ((QUOTE RECTANGLE)))
+ [BOXCONTENTS ((IF EXPR IS ATOMIC THEN EXPR ELSE (CAR EXPR]
+ (BOXDISPLAYCONTENTS ((A LISPNODEDISPLAY WITH CONTENTS = BOXCONTENTS)))
+ (SUCCESSORS [(IF EXPR IS ATOMIC THEN NIL ELSE (FOR X IN (CDR EXPR)
+ COLLECT
+ (A LISPGRAPHICSTREE WITH EXPR = X]
+ RESULT
+ (LISTOF LISPGRAPHICSTREE)))
+
+ ADJ ((TERMINAL (EXPR IS ATOMIC)))
+
+ SUPERS (GRAPHICSTREE) )
+
+(LISPNODEDISPLAY
+
+ (LISTOBJECT (CONTENTS ANYTHING))
+
+ PROP [(DISPLAYSIZE ((A VECTOR WITH X = (NCHARS CONTENTS)
+ *8 Y = 12]
+
+ MSG ((DRAW STRINGDATA-DRAW)) )
+
+(TREEELEMENT
+
+ (LISTOBJECT (BOX GRAPHICSBOX)
+ (ORIGINALNODE ANYTHING)
+ (SUCCESSORS (LISTOF TREEELEMENT))
+ (DISPLAYSIZE VECTOR))
+
+ PROP ((DISPLAYWIDTH (DISPLAYSIZE:X))
+ (DISPLAYHEIGHT (DISPLAYSIZE:Y)))
+
+ MSG ((DRAWIN TREEELEMENT-DRAWIN)) )
+]
+
+(DEFINEQ
+
+(BOXTYPE-DRAW
+ (GLAMBDA (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX W:WINDOW) (* GSN "14-JAN-83 12:58")
+ (APPLY* BOXTYPE:DRAWPROGRAM BOX (QUOTE PAINT)
+ W)))
+
+(BOXTYPE-ERASE
+ (GLAMBDA (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX W:WINDOW) (* GSN "14-JAN-83 12:58")
+ (APPLY* BOXTYPE:DRAWPROGRAM BOX (QUOTE ERASE)
+ W)))
+
+(BOXTYPE-SETSIZE
+ (GLAMBDA (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX) (* GSN "14-JAN-83 09:52")
+ (BOX:CONTENTSSIZE _(SEND BOX:DISPLAYCONTENTS DISPLAYSIZE))
+ (APPLY* BOXTYPE:SIZEPROGRAM BOX)))
+
+(DRAWRECTANGLE
+ (GLAMBDA (BOX:GRAPHICSBOX DSPOP:ATOM W:WINDOW) (* GSN "14-JAN-83 13:01")
+ (PROG (OLDDS)
+ (OLDDS _(CURRENTDISPLAYSTREAM W))
+ (DSPOPERATION DSPOP)
+ (MOVETO BOX:LEFT BOX:BOTTOM)
+ (DRAWTO BOX:LEFT BOX:TOP)
+ (DRAWTO BOX:RIGHT BOX:TOP)
+ (DRAWTO BOX:RIGHT BOX:BOTTOM)
+ (DRAWTO BOX:LEFT BOX:BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS))))
+
+(GRAPHICSBOX-DRAWIN
+ (GLAMBDA (BOX:GRAPHICSBOX W:WINDOW) (* GSN "14-JAN-83 12:55")
+ (SEND BOX:BOXTYPE DRAW BOX W)))
+
+(GRAPHICSBOX-ERASEIN
+ (GLAMBDA (BOX:GRAPHICSBOX W:WINDOW) (* GSN "14-JAN-83 12:55")
+ (SEND BOX:BOXTYPE ERASE BOX W)))
+
+(MATCHTREE
+ (GLAMBDA (TR) (* GSN "14-JAN-83 10:46")
+ (* Build a TREEELEMENT structure to match the given tree
+ TR.)
+ (RESULT TREEELEMENT)
+ (PROG (TE SUM)
+ [TE _(A TREEELEMENT WITH ORIGINALNODE = TR BOX =(A GRAPHICSBOX WITH BOXTYPE =(SEND
+ TR BOXTYPE)
+ DISPLAYCONTENTS =(SEND TR
+ BOXDISPLAYCONTENTS))
+ SUCCESSORS =(FOR X IN (SEND TR SUCCESSORS) COLLECT (SEND X MAKEGRAPHICSTREE]
+ (SEND TE:BOX SETSIZE)
+ (TE:DISPLAYWIDTH _(IF (SEND TR TERMINAL?)
+ THEN TE:BOX:WIDTH + 10
+ ELSE (SUM_0)
+ (FOR X IN TE:SUCCESSORS DO SUM_+X:DISPLAYWIDTH)
+ (MAX (TE:BOX:WIDTH + 10)
+ SUM)))
+ [TE:DISPLAYHEIGHT _(IF (SEND TR TERMINAL?)
+ THEN TE:BOX:HEIGHT
+ ELSE TE:BOX:HEIGHT + 20 +(APPLY (FUNCTION MAX)
+ (FOR X IN TE:SUCCESSORS
+ COLLECT X:BOX:HEIGHT]
+ (RETURN TE))))
+
+(RECTANGLESIZE
+ (GLAMBDA (BOX:GRAPHICSBOX) (* GSN "14-JAN-83 10:28")
+ (BOX:SIZE _ BOX:CONTENTSSIZE +(A VECTOR WITH X = 10 Y = 10))
+ (BOX:CONTENTSOFFSET _(A VECTOR WITH X = 5 Y = 5))))
+
+(STRINGDATA-DRAW
+ (GLAMBDA (self:LISPNODEDISPLAY POS:VECTOR W:WINDOW) (* GSN "14-JAN-83 14:35")
+ (SEND W PRINTAT self:CONTENTS POS)))
+
+(TREEELEMENT-DRAWIN
+ [GLAMBDA (TREE:TREEELEMENT AREA:REGION W:WINDOW) (* GSN "14-JAN-83 14:42")
+ (* Draw the subtree beginning with TREE inside area AREA
+ in window W.)
+ (PROG (NEWX NEWY SUM FSPN (TB TREE:BOX))
+ (IF TREE:DISPLAYSIZE>AREA:SIZE
+ THEN (ERROR "Area is too small for tree."))
+ (TB:START _(A VECTOR WITH X =(AREA:LEFT + AREA:RIGHT - TB:SIZE:X)/2 Y = AREA:TOP -
+ TB:SIZE:Y))
+ (SEND TB DRAWIN W)
+ (SEND TB:DISPLAYCONTENTS DRAW TB:START+TB:CONTENTSOFFSET W)
+ (* Now compute positions for successors of top node.)
+ (IF TREE:SUCCESSORS
+ THEN (NEWY _ AREA:TOP - TB:SIZE:Y - 20)
+ (SUM_0)
+ (FOR S IN TREE:SUCCESSORS DO SUM_+S:DISPLAYSIZE:X)
+ (* Calculate free space for each box.)
+ (FSPN _(AREA:SIZE:X - SUM)/(LENGTH SUCCESSORS))
+ (NEWX _ AREA:START:X + FSPN/2) (* Draw each subtree.)
+ (FOR S IN TREE:SUCCESSORS
+ DO (* Draw arc to new subtree.)
+ (SEND W DRAWLINE TB:BOTTOMCENTER
+ (A VECTOR WITH X = NEWX+S:DISPLAYSIZE:X/2 Y = NEWY))
+ (SEND S DRAWIN
+ (AN AREA WITH START =(A VECTOR WITH X = NEWX Y = AREA:START:Y)
+ SIZE =(A VECTOR WITH X = S:DISPLAYSIZE:X Y = NEWY -
+ AREA:START:Y))
+ W)
+ (NEWX_+S:DISPLAYSIZE:X+FSPN])
+)
+
+
+[GLISPGLOBALS
+
+(GRAPHICSBOXTYPES (LISTOF BOXTYPE) )
+]
+
+
+(PUTPROPS RECTANGLE DRAWPROGRAM DRAWRECTANGLE)
+
+(PUTPROPS RECTANGLE SIZEPROGRAM RECTANGLESIZE)
+
+(RPAQQ GRAPHICSBOXTYPES (RECTANGLE))
+(DECLARE: DOEVAL@COMPILE DONTCOPY
+
+(ADDTOVAR GLOBALVARS GRAPHICSBOXTYPES)
+)
+(LOAD? (QUOTE VECTOR.LSP))
+(DECLARE: DONTCOPY
+ (FILEMAP (NIL (2714 7091 (BOXTYPE-DRAW 2724 . 2892) (BOXTYPE-ERASE 2894 . 3063) (BOXTYPE-SETSIZE 3065
+ . 3278) (DRAWRECTANGLE 3280 . 3715) (GRAPHICSBOX-DRAWIN 3717 . 3867) (GRAPHICSBOX-ERASEIN 3869 . 4021
+) (MATCHTREE 4023 . 5126) (RECTANGLESIZE 5128 . 5358) (STRINGDATA-DRAW 5360 . 5512) (
+TREEELEMENT-DRAWIN 5514 . 7089)))))
+STOP
ADDED psl-1983/3-1/glisp/grtree.sl
Index: psl-1983/3-1/glisp/grtree.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/grtree.sl
@@ -0,0 +1,326 @@
+
+% {DSK}GRTREE.PSL;11 4-FEB-83 16:48:01
+
+
+
+
+
+(GLOBAL '(GRAPHICSBOXTYPES))
+
+
+% Tree Drawing Package. To test, do (DLT TX WW) where WW is a window.
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(BOXTYPE (ATOM (PROPLIST (DRAWPROGRAM ATOM)
+ (SIZEPROGRAM ATOM)))
+MSG ((DRAW BOXTYPE-DRAW OPEN T)
+ (ERASE BOXTYPE-ERASE OPEN T)
+ (SETSIZE BOXTYPE-SETSIZE OPEN T)))
+
+
+(GRAPHICSBOX (LISTOBJECT (BOXTYPE BOXTYPE)
+ (START VECTOR)
+ (SIZE VECTOR)
+ (CONTENTSOFFSET VECTOR)
+ (DISPLAYCONTENTS ANYTHING)
+ (CONTENTSSIZE VECTOR))
+MSG ((DRAWIN GRAPHICSBOX-DRAWIN OPEN T)
+ (ERASEIN GRAPHICSBOX-ERASEIN OPEN T)
+ (SETSIZE ((SEND BOXTYPE SETSIZE self))))
+SUPERS (REGION))
+
+
+(GRAPHICSTREE (LISTOBJECT (TOPNODE TREE)
+ (GRTREE TREEELEMENT)
+ (BOXTYPE BOXTYPE)
+ (LINESTYPE LINESTYPE)
+ (SPACING VECTOR))
+MSG ((CREATE CREATETREE SPECIALIZE T)
+ (MATCH MATCHTREE SPECIALIZE T)
+ (SELECTNODE GRAPHICSTREE-SELECTNODE OPEN T)))
+
+
+(LISPGRAPHICSTREE (LISTOBJECT (TOPNODE LISPTREE)
+ (GRTREE TREEELEMENT))
+PROP ((BOXTYPE ('RECTANGLE)
+ RESULT BOXTYPE)
+ (LINESTYPE ('STRAIGHT)
+ RESULT LINESTYPE)
+ (SPACING ('(10 20))
+ RESULT VECTOR))
+SUPERS (GRAPHICSTREE))
+
+
+(LISPNODEDISPLAY (LISTOBJECT (CONTENTS ANYTHING))
+PROP ((DISPLAYSIZE ((A VECTOR WITH X = (NCHARS CONTENTS)
+ *7 Y = 10))))
+MSG ((DRAW STRINGDATA-DRAW)))
+
+
+(LISPTREE (EXPR ANYTHING)
+PROP ((CONTENTS ((A LISPNODEDISPLAY WITH CONTENTS =
+ (IF EXPR IS ATOMIC THEN EXPR ELSE (CAR EXPR)))))
+ (SUCCESSORS ((IF EXPR IS ATOMIC THEN NIL ELSE (CDR EXPR)))
+ RESULT
+ (LISTOF LISPTREE)))
+ADJ ((TERMINAL (EXPR IS ATOMIC))))
+
+
+(TREEELEMENT (LISTOBJECT (BOX GRAPHICSBOX)
+ (ORIGINALNODE ANYTHING)
+ (SUCCESSORS (LISTOF TREEELEMENT))
+ (DISPLAYSIZE VECTOR))
+PROP ((DISPLAYWIDTH (DISPLAYSIZE:X))
+ (DISPLAYHEIGHT (DISPLAYSIZE:Y))
+ (TOTALAREA ((VIRTUAL REGION WITH START = TOTALSTART SIZE =
+ DISPLAYSIZE)))
+ (TOTALSTART ((VIRTUAL VECTOR WITH X = BOX:START:X + (BOX:SIZE:X
+ - DISPLAYSIZE:X)
+ / 2 Y = BOX:START:Y + BOX:SIZE:Y -
+ DISPLAYSIZE:Y))))
+MSG ((DRAWIN TREEELEMENT-DRAWIN)
+ (SELECTNODE TREEELEMENT-SELECTNODE)))
+
+)
+
+
+
+% GSN 14-JAN-83 12:58
+(DG BOXTYPE-DRAW (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX W:WINDOW)
+(APPLY BOXTYPE:DRAWPROGRAM (LIST BOX 'PAINT
+ W)))
+
+
+% GSN 14-JAN-83 12:58
+(DG BOXTYPE-ERASE (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX W:WINDOW)
+(APPLY BOXTYPE:DRAWPROGRAM (LIST BOX 'ERASE
+ W)))
+
+
+% GSN 14-JAN-83 09:52
+(DG BOXTYPE-SETSIZE (BOXTYPE:BOXTYPE BOX:GRAPHICSBOX)
+(BOX:CONTENTSSIZE _ (SEND BOX:DISPLAYCONTENTS DISPLAYSIZE))(APPLY
+ BOXTYPE:SIZEPROGRAM
+ (LIST BOX)))
+
+
+% GSN 2-FEB-83 12:58
+(DG CIRCLESIZE (BOX:GRAPHICSBOX)
+(PROG (DIAM)
+ (DIAM _ BOX:CONTENTSSIZE:IMAGNITUDE + 10)
+ (BOX:SIZE _ (A VECTOR WITH X = DIAM Y = DIAM))
+ (BOX:CONTENTSOFFSET _ (A VECTOR WITH X = (DIAM - BOX:CONTENTSSIZE:X)
+ /2 Y = (DIAM - BOX:CONTENTSSIZE:Y)
+ /2))))
+
+
+% GSN 2-FEB-83 11:23
+(DG CREATETREE (TR:GRAPHICSTREE)
+(SEND TR MATCH TOPNODE))
+
+
+% GSN 2-FEB-83 14:04
+% Draw a Lisp tree.
+(DG DLT (EXPR WW:WINDOW)
+(PROG (TREE)
+ (SEND WW CLEAR)
+ (TREE _ (SEND (A LISPGRAPHICSTREE WITH TOPNODE = EXPR)
+ CREATE))
+ (IF TREE:DISPLAYSIZE > WW:SIZE THEN (ERROR 0 "Window is too small")
+ ELSE
+ (SEND TREE DRAWIN (AN AREA WITH SIZE = TREE:DISPLAYSIZE START =
+ (SEND WW CENTEROFFSET TREE:DISPLAYSIZE))
+ WW))))
+
+
+% GSN 2-FEB-83 12:16
+(DG DRAWGRCIRCLE (BOX:GRAPHICSBOX DSPOP:ATOM W:WINDOW)
+(PROG (OLDDS)
+ (OLDDS _ (CURRENTDISPLAYSTREAM W))
+ (DSPOPERATION DSPOP)
+ (DRAWCIRCLE BOX:CENTER:X BOX:CENTER:Y BOX:SIZE:X/2 NIL W)
+ (CURRENTDISPLAYSTREAM OLDDS)))
+
+
+% GSN 2-FEB-83 13:12
+(DG DRAWGRELLIPSE (BOX:GRAPHICSBOX DSPOP:ATOM W:WINDOW)
+(PROG (OLDDS)
+ (OLDDS _ (CURRENTDISPLAYSTREAM W))
+ (DSPOPERATION DSPOP)
+ (DRAWELLIPSE BOX:CENTER:X BOX:CENTER:Y BOX:SIZE:Y/2 BOX:SIZE:X/2 0 NIL
+ NIL W)
+ (CURRENTDISPLAYSTREAM OLDDS)))
+
+
+% GSN 14-JAN-83 13:01
+(DG DRAWRECTANGLE (BOX:GRAPHICSBOX DSPOP:ATOM W:WINDOW)
+(PROG (OLDDS)
+ (OLDDS _ (CURRENTDISPLAYSTREAM W))
+ (DSPOPERATION DSPOP)
+ (MOVETO BOX:LEFT BOX:BOTTOM)
+ (DRAWTO BOX:LEFT BOX:TOP)
+ (DRAWTO BOX:RIGHT BOX:TOP)
+ (DRAWTO BOX:RIGHT BOX:BOTTOM)
+ (DRAWTO BOX:LEFT BOX:BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS)))
+
+
+% GSN 2-FEB-83 13:12
+(DG ELLIPSESIZE (BOX:GRAPHICSBOX)
+(PROG (DIAM)
+ (DIAM _ BOX:CONTENTSSIZE:IMAGNITUDE + 10)
+ (BOX:SIZE _ (A VECTOR WITH X = DIAM Y = BOX:CONTENTSSIZE:Y + 10))
+ (BOX:CONTENTSOFFSET _ (A VECTOR WITH X = (DIAM - BOX:CONTENTSSIZE:X)
+ /2 + 1 Y = 6))))
+
+
+% GSN 14-JAN-83 12:55
+(DG GRAPHICSBOX-DRAWIN (BOX:GRAPHICSBOX W:WINDOW)
+(SEND BOX:BOXTYPE DRAW BOX W))
+
+
+% GSN 14-JAN-83 12:55
+(DG GRAPHICSBOX-ERASEIN (BOX:GRAPHICSBOX W:WINDOW)
+(SEND BOX:BOXTYPE ERASE BOX W))
+
+
+% GSN 2-FEB-83 16:14
+(DG GRAPHICSTREE-SELECTNODE (GT:GRAPHICSTREE V:VECTOR)
+(SEND GT:GRTREE SELECTNODE V))
+
+
+% GSN 3-FEB-83 13:29
+% Build a TREEELEMENT structure to match the given tree TR.
+(DG MATCHTREE (TR:GRAPHICSTREE NODE:TREE)
+(RESULT TREEELEMENT)(PROG (TE SUM MAXH)
+ (TE _
+ (A TREEELEMENT WITH ORIGINALNODE = NODE BOX =
+ (A GRAPHICSBOX WITH BOXTYPE = TR:BOXTYPE
+ DISPLAYCONTENTS = NODE:CONTENTS)
+ SUCCESSORS = (FOR X IN NODE:SUCCESSORS
+ COLLECT
+ (SEND TR MATCH X))))
+ (SEND TE:BOX SETSIZE)
+ (TE:DISPLAYWIDTH _
+ (IF NODE IS TERMINAL THEN
+ TE:BOX:WIDTH + TR:SPACING:X
+ ELSE (SUM_0)
+ (FOR X IN TE:SUCCESSORS DO
+ SUM_+X:DISPLAYWIDTH)
+ (MAX (TE:BOX:WIDTH +
+ TR:SPACING:X)
+ SUM)))
+ (TE:DISPLAYHEIGHT _
+ (IF NODE IS TERMINAL THEN
+ TE:BOX:HEIGHT ELSE (MAXH_0)
+ (FOR X IN TE:SUCCESSORS DO
+ (MAXH_ (MAX MAXH
+ X:DISPLAYHEIGHT)))
+ (TE:BOX:HEIGHT + TR:SPACING:Y
+ + MAXH)))
+ (RETURN TE)))
+
+
+% GSN 2-FEB-83 12:02
+(DG RECTANGLESIZE (BOX:GRAPHICSBOX)
+(BOX:SIZE _ BOX:CONTENTSSIZE + (A VECTOR WITH X = 10 Y = 10))(
+ BOX:CONTENTSOFFSET _ (A VECTOR WITH X = 6 Y = 6)))
+
+
+% GSN 14-JAN-83 14:35
+(DG STRINGDATA-DRAW (self:LISPNODEDISPLAY POS:VECTOR W:WINDOW)
+(SEND W PRINTAT self:CONTENTS POS))
+
+
+% GSN 14-JAN-83 14:42
+% Draw the subtree beginning with TREE inside area AREA in window W.
+(DG TREEELEMENT-DRAWIN (TREE:TREEELEMENT AREA:REGION W:WINDOW)
+(PROG (NEWX NEWY SUM FSPN TB)
+ (IF TREE:DISPLAYSIZE>AREA:SIZE THEN (ERROR 0
+ "Area is too small for tree."))
+ (TB:START _ (A VECTOR WITH X = (AREA:LEFT + AREA:RIGHT - TB:SIZE:X)
+ /2 Y = AREA:TOP - TB:SIZE:Y))
+ (SEND TB DRAWIN W)
+ (SEND TB:DISPLAYCONTENTS DRAW TB:START+TB:CONTENTSOFFSET W)
+
+% Now compute positions for successors of top node.
+
+ (IF TREE:SUCCESSORS THEN (NEWY _ AREA:TOP - TB:SIZE:Y - 20)
+ (SUM_0)
+ (FOR S IN TREE:SUCCESSORS DO SUM_+S:DISPLAYSIZE:X)
+
+% Calculate free space for each box.
+
+ (FSPN _ (AREA:SIZE:X - SUM)
+ /
+ (LENGTH SUCCESSORS))
+ (NEWX _ AREA:START:X + FSPN/2)
+
+% Draw each subtree.
+
+ (FOR S IN TREE:SUCCESSORS DO
+% Draw arc to new subtree.
+
+ (SEND W DRAWLINE TB:BOTTOMCENTER
+ (A VECTOR WITH X = NEWX+S:DISPLAYSIZE:X/2 Y = NEWY))
+ (SEND S DRAWIN
+ (AN AREA WITH START =
+ (A VECTOR WITH X = NEWX Y = AREA:START:Y)
+ SIZE =
+ (A VECTOR WITH X = S:DISPLAYSIZE:X Y = NEWY -
+ AREA:START:Y))
+ W)
+ (NEWX_+S:DISPLAYSIZE:X+FSPN)))))
+
+
+% GSN 2-FEB-83 17:37
+(DG TREEELEMENT-SELECTNODE (TE:TREEELEMENT V:VECTOR)
+(PROG (RESULT LST TMP)
+ (IF (SEND TE:BOX CONTAINS? V)
+ THEN
+ (RETURN TE)
+ ELSEIF
+ (SEND TE:TOTALAREA CONTAINS? V)
+ THEN
+ (LST_TE:SUCCESSORS)
+ (WHILE ~RESULT AND (TMP-_LST)
+ DO
+ (RESULT _ (SEND TMP SELECTNODE V)))
+ (RETURN RESULT))))
+
+
+(GLISPGLOBALS
+(GRAPHICSBOXTYPES (LISTOF BOXTYPE))
+
+)
+
+
+ (PUT 'RECTANGLE
+ 'DRAWPROGRAM
+ 'DRAWRECTANGLE)
+ (PUT 'CIRCLE
+ 'DRAWPROGRAM
+ 'DRAWGRCIRCLE)
+ (PUT 'ELLIPSE
+ 'DRAWPROGRAM
+ 'DRAWGRELLIPSE)
+ (PUT 'RECTANGLE
+ 'SIZEPROGRAM
+ 'RECTANGLESIZE)
+ (PUT 'CIRCLE
+ 'SIZEPROGRAM
+ 'CIRCLESIZE)
+ (PUT 'ELLIPSE
+ 'SIZEPROGRAM
+ 'ELLIPSESIZE)
+(SETQ GRAPHICSBOXTYPES '(RECTANGLE))
+(SETQ TX '(/(+(- B)
+ (SQRT (-(^ B 2) (* 4 (* A C))
+ ))) (* 2 A)
+ ))
ADDED psl-1983/3-1/glisp/h19.sl
Index: psl-1983/3-1/glisp/h19.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/h19.sl
@@ -0,0 +1,66 @@
+
+% <NOVAK>H19.PSL.1 20-Mar-83 12:40:06
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(TERMINAL ATOM
+MSG ((MOVETOXY TERMINAL-MOVETOXY)
+ (PRINTCHAR TERMINAL-PRINTCHAR OPEN T)
+ (PRINTSTRING TERMINAL-PRINTSTRING OPEN T)
+ (INVERTVIDEO ((PRIN1 ESCAPECHAR)
+ (PRIN1 "p")))
+ (NORMALVIDEO ((PRIN1 ESCAPECHAR)
+ (PRIN1 "q")))
+ (GRAPHICSMODE ((PRIN1 ESCAPECHAR)
+ (PRIN1 "F")))
+ (NORMALMODE ((PRIN1 ESCAPECHAR)
+ (PRIN1 "G")))
+ (ERASEEOL ((PRIN1 ESCAPECHAR)
+ (PRIN1 "K")))))
+
+)
+
+
+
+(GLISPGLOBALS
+(TERMINAL TERMINAL)
+
+)
+
+
+
+(GLISPCONSTANTS
+(BLANKCHAR " " STRING)
+(HORIZONTALLINECHAR "-" STRING)
+(HORIZONTALBARCHAR "{" STRING)
+(LVERTICALBARCHAR "}" STRING)
+(RVERTICALBARCHAR "|" STRING)
+(ESCAPECHAR (CHARACTER 27) STRING)
+)
+
+
+
+% edited: 14-Mar-83 22:48
+% Move cursor to a specified X Y position.
+(DG TERMINAL-MOVETOXY (TERM:TERMINAL X:INTEGER Y:INTEGER)
+(IF X<0 THEN X_0 ELSEIF X>79 X_79)(IF Y<0 THEN Y_0 ELSEIF Y>23 THEN Y_23)(SEND
+ TERMINAL PRINTCHAR ESCAPECHAR)(SEND TERMINAL PRINTCHAR "Y")(SEND
+ TERMINAL PRINTCHAR (CHARACTER 55 - Y))(SEND TERMINAL PRINTCHAR
+ (CHARACTER 32 + X)))
+
+
+% edited: 19-Mar-83 20:29
+(DG TERMINAL-PRINTCHAR (TERM:TERMINAL S:STRING)
+(PRIN1 S))
+
+
+% edited: 19-Mar-83 20:29
+(DG TERMINAL-PRINTSTRING (TERM:TERMINAL S:STRING)
+(PRIN1 S))
+
+(SETQ TERMINAL 'H19)
ADDED psl-1983/3-1/glisp/hrd.sl
Index: psl-1983/3-1/glisp/hrd.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/hrd.sl
@@ -0,0 +1,19 @@
+% HRD.SL.2 07 April 83
+
+% Programs to interface to Methius high-resolution display on HP 9836.
+% G. Novak 07 April 83
+
+(DE M-MOVEP1 (X Y)
+ (M_MOVEP1 X (DIFFERENCE 551 Y)))
+
+(DE M-CHAR (ASCIIN)
+ (M_CHAR ASCIIN))
+
+(DE M-ERASE (X1 Y1 X2 Y2)
+ (M_ERASE X1 (DIFFERENCE 551 Y1) X2 (DIFFERENCE 551 Y2)))
+
+(DE M-RECT-OUTLINE (X1 Y1 X2 Y2)
+ (M_RECT_OUTLINE X1 (DIFFERENCE 551 Y1) X2 (DIFFERENCE 551 Y2)))
+
+(DE M-VECTOR (X1 Y1 X2 Y2)
+ (M_VECTOR X1 (DIFFERENCE 551 Y1) X2 (DIFFERENCE 551 Y2)))
ADDED psl-1983/3-1/glisp/irewrite.b
Index: psl-1983/3-1/glisp/irewrite.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/irewrite.b
cannot compute difference between binary files
ADDED psl-1983/3-1/glisp/irewrite.sl
Index: psl-1983/3-1/glisp/irewrite.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/irewrite.sl
@@ -0,0 +1,565 @@
+
+% {DSK}IREWRITE.PSL;2 6-JAN-83 10:08:06
+
+
+
+
+
+(DE ADD-LEMMA (TERM)
+(COND ((AND (NOT (ATOM TERM))
+ (EQ (CAR TERM)
+ 'EQUAL)
+ (NOT (ATOM (CADR TERM))))
+ (PUT (CAR (CADR TERM))
+ 'LEMMAS
+ (CONS TERM (GET (CAR (CADR TERM))
+ 'LEMMAS))))
+ (T (ERROR 0 (LIST 'ADD-LEMMA-DID-NOT-LIKE-TERM
+ TERM)))))
+
+
+(DE ADD-LEMMA-LST (LST)
+(COND ((NULL LST)
+ T)
+ (T (ADD-LEMMA (CAR LST))
+ (ADD-LEMMA-LST (CDR LST)))))
+
+
+% lmm 7-JUN-81 10:07
+(DE APPLY-SUBST (ALIST TERM)
+(COND ((NOT (PAIRP TERM))
+ ((LAMBDA (TEM)
+ (COND
+ (TEM (CDR TEM))
+ (T TERM)))
+ (ASSOC TERM ALIST)))
+ (T (CONS (CAR TERM)
+ (MAPCAR (CDR TERM)
+ (FUNCTION (LAMBDA (X)
+ (APPLY-SUBST ALIST X))))))))
+
+
+(DE APPLY-SUBST-LST (ALIST LST)
+(COND ((NULL LST)
+ NIL)
+ (T (CONS (APPLY-SUBST ALIST (CAR LST))
+ (APPLY-SUBST-LST ALIST (CDR LST))))))
+
+
+(DE FALSEP (X LST)
+(OR (EQUAL X '(F))
+ (MEMBER X LST)))
+
+
+(DE ONE-WAY-UNIFY (TERM1 TERM2)
+(PROGN (SETQ UNIFY-SUBST NIL)
+ (ONE-WAY-UNIFY1 TERM1 TERM2)))
+
+
+% lmm 7-JUN-81 09:47
+(DE ONE-WAY-UNIFY1 (TERM1 TERM2)
+(COND ((NOT (PAIRP TERM2))
+ ((LAMBDA (TEM)
+ (COND
+ (TEM (EQUAL TERM1 (CDR TEM)))
+ (T (SETQ UNIFY-SUBST (CONS (CONS TERM2 TERM1)
+ UNIFY-SUBST))
+ T)))
+ (ASSOC TERM2 UNIFY-SUBST)))
+ ((NOT (PAIRP TERM1))
+ NIL)
+ ((EQ (CAR TERM1)
+ (CAR TERM2))
+ (ONE-WAY-UNIFY1-LST (CDR TERM1)
+ (CDR TERM2)))
+ (T NIL)))
+
+
+(DE ONE-WAY-UNIFY1-LST (LST1 LST2)
+(COND ((NULL LST1)
+ T)
+ ((ONE-WAY-UNIFY1 (CAR LST1)
+ (CAR LST2))
+ (ONE-WAY-UNIFY1-LST (CDR LST1)
+ (CDR LST2)))
+ (T NIL)))
+
+
+(DE PTIME NIL
+(PROG (GCTM)
+ (SETQ GCTM 0)
+ (RETURN (CONS (time)
+ GCTM))))
+
+
+% lmm 7-JUN-81 10:04
+(DE REWRITE (TERM)
+(COND ((NOT (PAIRP TERM))
+ TERM)
+ (T (REWRITE-WITH-LEMMAS (CONS (CAR TERM)
+ (MAPCAR (CDR TERM)
+ (FUNCTION REWRITE)))
+ (GET (CAR TERM)
+ 'LEMMAS)))))
+
+
+(DE REWRITE-WITH-LEMMAS (TERM LST)
+(COND ((NULL LST)
+ TERM)
+ ((ONE-WAY-UNIFY TERM (CADR (CAR LST)))
+ (REWRITE (APPLY-SUBST UNIFY-SUBST (CADDR (CAR LST)))))
+ (T (REWRITE-WITH-LEMMAS TERM (CDR LST)))))
+
+
+(DE SETUP NIL
+(ADD-LEMMA-LST
+ '((EQUAL (COMPILE FORM)
+ (REVERSE (CODEGEN (OPTIMIZE FORM)
+ (NIL))))
+ (EQUAL (EQP X Y)
+ (EQUAL (FIX X)
+ (FIX Y)))
+ (EQUAL (GREATERP X Y)
+ (LESSP Y X))
+ (EQUAL (LESSEQP X Y)
+ (NOT (LESSP Y X)))
+ (EQUAL (GREATEREQP X Y)
+ (NOT (LESSP X Y)))
+ (EQUAL (BOOLEAN X)
+ (OR (EQUAL X (T))
+ (EQUAL X (F))))
+ (EQUAL (IFF X Y)
+ (AND (IMPLIES X Y)
+ (IMPLIES Y X)))
+ (EQUAL (EVEN1 X)
+ (IF (ZEROP X)
+ (T)
+ (ODD (SUB1 X))))
+ (EQUAL (COUNTPS- L PRED)
+ (COUNTPS-LOOP L PRED (ZERO)))
+ (EQUAL (FACT- I)
+ (FACT-LOOP I 1))
+ (EQUAL (REVERSE- X)
+ (REVERSE-LOOP X (NIL)))
+ (EQUAL (DIVIDES X Y)
+ (ZEROP (REMAINDER Y X)))
+ (EQUAL (ASSUME-TRUE VAR ALIST)
+ (CONS (CONS VAR (T))
+ ALIST))
+ (EQUAL (ASSUME-FALSE VAR ALIST)
+ (CONS (CONS VAR (F))
+ ALIST))
+ (EQUAL (TAUTOLOGY-CHECKER X)
+ (TAUTOLOGYP (NORMALIZE X)
+ (NIL)))
+ (EQUAL (FALSIFY X)
+ (FALSIFY1 (NORMALIZE X)
+ (NIL)))
+ (EQUAL (PRIME X)
+ (AND (NOT (ZEROP X))
+ (NOT (EQUAL X (ADD1 (ZERO))))
+ (PRIME1 X (SUB1 X))))
+ (EQUAL (AND P Q)
+ (IF P (IF Q (T)
+ (F))
+ (F)))
+ (EQUAL (OR P Q)
+ (IF P (T)
+ (IF Q (T)
+ (F))
+ (F)))
+ (EQUAL (NOT P)
+ (IF P (F)
+ (T)))
+ (EQUAL (IMPLIES P Q)
+ (IF P (IF Q (T)
+ (F))
+ (T)))
+ (EQUAL (FIX X)
+ (IF (NUMBERP X)
+ X
+ (ZERO)))
+ (EQUAL (IF (IF A B C)
+ D E)
+ (IF A (IF B D E)
+ (IF C D E)))
+ (EQUAL (ZEROP X)
+ (OR (EQUAL X (ZERO))
+ (NOT (NUMBERP X))))
+ (EQUAL (PLUS (PLUS X Y)
+ Z)
+ (PLUS X (PLUS Y Z)))
+ (EQUAL (EQUAL (PLUS A B)
+ (ZERO))
+ (AND (ZEROP A)
+ (ZEROP B)))
+ (EQUAL (DIFFERENCE X X)
+ (ZERO))
+ (EQUAL (EQUAL (PLUS A B)
+ (PLUS A C))
+ (EQUAL (FIX B)
+ (FIX C)))
+ (EQUAL (EQUAL (ZERO)
+ (DIFFERENCE X Y))
+ (NOT (LESSP Y X)))
+ (EQUAL (EQUAL X (DIFFERENCE X Y))
+ (AND (NUMBERP X)
+ (OR (EQUAL X (ZERO))
+ (ZEROP Y))))
+ (EQUAL (MEANING (PLUS-TREE (APPEND X Y))
+ A)
+ (PLUS (MEANING (PLUS-TREE X)
+ A)
+ (MEANING (PLUS-TREE Y)
+ A)))
+ (EQUAL (MEANING (PLUS-TREE (PLUS-FRINGE X))
+ A)
+ (FIX (MEANING X A)))
+ (EQUAL (APPEND (APPEND X Y)
+ Z)
+ (APPEND X (APPEND Y Z)))
+ (EQUAL (REVERSE (APPEND A B))
+ (APPEND (REVERSE B)
+ (REVERSE A)))
+ (EQUAL (TIMES X (PLUS Y Z))
+ (PLUS (TIMES X Y)
+ (TIMES X Z)))
+ (EQUAL (TIMES (TIMES X Y)
+ Z)
+ (TIMES X (TIMES Y Z)))
+ (EQUAL (EQUAL (TIMES X Y)
+ (ZERO))
+ (OR (ZEROP X)
+ (ZEROP Y)))
+ (EQUAL (EXEC (APPEND X Y)
+ PDS ENVRN)
+ (EXEC Y (EXEC X PDS ENVRN)
+ ENVRN))
+ (EQUAL (MC-FLATTEN X Y)
+ (APPEND (FLATTEN X)
+ Y))
+ (EQUAL (MEMBER X (APPEND A B))
+ (OR (MEMBER X A)
+ (MEMBER X B)))
+ (EQUAL (MEMBER X (REVERSE Y))
+ (MEMBER X Y))
+ (EQUAL (LENGTH (REVERSE X))
+ (LENGTH X))
+ (EQUAL (MEMBER A (INTERSECT B C))
+ (AND (MEMBER A B)
+ (MEMBER A C)))
+ (EQUAL (NTH (ZERO)
+ I)
+ (ZERO))
+ (EQUAL (EXP I (PLUS J K))
+ (TIMES (EXP I J)
+ (EXP I K)))
+ (EQUAL (EXP I (TIMES J K))
+ (EXP (EXP I J)
+ K))
+ (EQUAL (REVERSE-LOOP X Y)
+ (APPEND (REVERSE X)
+ Y))
+ (EQUAL (REVERSE-LOOP X (NIL))
+ (REVERSE X))
+ (EQUAL (COUNT-LIST Z (SORT-LP X Y))
+ (PLUS (COUNT-LIST Z X)
+ (COUNT-LIST Z Y)))
+ (EQUAL (EQUAL (APPEND A B)
+ (APPEND A C))
+ (EQUAL B C))
+ (EQUAL (PLUS (REMAINDER X Y)
+ (TIMES Y (QUOTIENT X Y)))
+ (FIX X))
+ (EQUAL (POWER-EVAL (BIG-PLUS1 L I BASE)
+ BASE)
+ (PLUS (POWER-EVAL L BASE)
+ I))
+ (EQUAL (POWER-EVAL (BIG-PLUS X Y I BASE)
+ BASE)
+ (PLUS I (PLUS (POWER-EVAL X BASE)
+ (POWER-EVAL Y BASE))))
+ (EQUAL (REMAINDER Y 1)
+ (ZERO))
+ (EQUAL (LESSP (REMAINDER X Y)
+ Y)
+ (NOT (ZEROP Y)))
+ (EQUAL (REMAINDER X X)
+ (ZERO))
+ (EQUAL (LESSP (QUOTIENT I J)
+ I)
+ (AND (NOT (ZEROP I))
+ (OR (ZEROP J)
+ (NOT (EQUAL J 1)))))
+ (EQUAL (LESSP (REMAINDER X Y)
+ X)
+ (AND (NOT (ZEROP Y))
+ (NOT (ZEROP X))
+ (NOT (LESSP X Y))))
+ (EQUAL (POWER-EVAL (POWER-REP I BASE)
+ BASE)
+ (FIX I))
+ (EQUAL (POWER-EVAL (BIG-PLUS (POWER-REP I BASE)
+ (POWER-REP J BASE)
+ (ZERO)
+ BASE)
+ BASE)
+ (PLUS I J))
+ (EQUAL (GCD X Y)
+ (GCD Y X))
+ (EQUAL (NTH (APPEND A B)
+ I)
+ (APPEND (NTH A I)
+ (NTH B (DIFFERENCE I (LENGTH A)))))
+ (EQUAL (DIFFERENCE (PLUS X Y)
+ X)
+ (FIX Y))
+ (EQUAL (DIFFERENCE (PLUS Y X)
+ X)
+ (FIX Y))
+ (EQUAL (DIFFERENCE (PLUS X Y)
+ (PLUS X Z))
+ (DIFFERENCE Y Z))
+ (EQUAL (TIMES X (DIFFERENCE C W))
+ (DIFFERENCE (TIMES C X)
+ (TIMES W X)))
+ (EQUAL (REMAINDER (TIMES X Z)
+ Z)
+ (ZERO))
+ (EQUAL (DIFFERENCE (PLUS B (PLUS A C))
+ A)
+ (PLUS B C))
+ (EQUAL (DIFFERENCE (ADD1 (PLUS Y Z))
+ Z)
+ (ADD1 Y))
+ (EQUAL (LESSP (PLUS X Y)
+ (PLUS X Z))
+ (LESSP Y Z))
+ (EQUAL (LESSP (TIMES X Z)
+ (TIMES Y Z))
+ (AND (NOT (ZEROP Z))
+ (LESSP X Y)))
+ (EQUAL (LESSP Y (PLUS X Y))
+ (NOT (ZEROP X)))
+ (EQUAL (GCD (TIMES X Z)
+ (TIMES Y Z))
+ (TIMES Z (GCD X Y)))
+ (EQUAL (VALUE (NORMALIZE X)
+ A)
+ (VALUE X A))
+ (EQUAL (EQUAL (FLATTEN X)
+ (CONS Y (NIL)))
+ (AND (NLISTP X)
+ (EQUAL X Y)))
+ (EQUAL (LISTP (GOPHER X))
+ (LISTP X))
+ (EQUAL (SAMEFRINGE X Y)
+ (EQUAL (FLATTEN X)
+ (FLATTEN Y)))
+ (EQUAL (EQUAL (GREATEST-FACTOR X Y)
+ (ZERO))
+ (AND (OR (ZEROP Y)
+ (EQUAL Y 1))
+ (EQUAL X (ZERO))))
+ (EQUAL (EQUAL (GREATEST-FACTOR X Y)
+ 1)
+ (EQUAL X 1))
+ (EQUAL (NUMBERP (GREATEST-FACTOR X Y))
+ (NOT (AND (OR (ZEROP Y)
+ (EQUAL Y 1))
+ (NOT (NUMBERP X)))))
+ (EQUAL (TIMES-LIST (APPEND X Y))
+ (TIMES (TIMES-LIST X)
+ (TIMES-LIST Y)))
+ (EQUAL (PRIME-LIST (APPEND X Y))
+ (AND (PRIME-LIST X)
+ (PRIME-LIST Y)))
+ (EQUAL (EQUAL Z (TIMES W Z))
+ (AND (NUMBERP Z)
+ (OR (EQUAL Z (ZERO))
+ (EQUAL W 1))))
+ (EQUAL (GREATEREQPR X Y)
+ (NOT (LESSP X Y)))
+ (EQUAL (EQUAL X (TIMES X Y))
+ (OR (EQUAL X (ZERO))
+ (AND (NUMBERP X)
+ (EQUAL Y 1))))
+ (EQUAL (REMAINDER (TIMES Y X)
+ Y)
+ (ZERO))
+ (EQUAL (EQUAL (TIMES A B)
+ 1)
+ (AND (NOT (EQUAL A (ZERO)))
+ (NOT (EQUAL B (ZERO)))
+ (NUMBERP A)
+ (NUMBERP B)
+ (EQUAL (SUB1 A)
+ (ZERO))
+ (EQUAL (SUB1 B)
+ (ZERO))))
+ (EQUAL (LESSP (LENGTH (DELETE X L))
+ (LENGTH L))
+ (MEMBER X L))
+ (EQUAL (SORT2 (DELETE X L))
+ (DELETE X (SORT2 L)))
+ (EQUAL (DSORT X)
+ (SORT2 X))
+ (EQUAL (LENGTH (CONS X1 (CONS X2 (CONS X3 (CONS X4
+ (CONS X5 (CONS X6 X7)))))))
+ (PLUS 6 (LENGTH X7)))
+ (EQUAL (DIFFERENCE (ADD1 (ADD1 X))
+ 2)
+ (FIX X))
+ (EQUAL (QUOTIENT (PLUS X (PLUS X Y))
+ 2)
+ (PLUS X (QUOTIENT Y 2)))
+ (EQUAL (SIGMA (ZERO)
+ I)
+ (QUOTIENT (TIMES I (ADD1 I))
+ 2))
+ (EQUAL (PLUS X (ADD1 Y))
+ (IF (NUMBERP Y)
+ (ADD1 (PLUS X Y))
+ (ADD1 X)))
+ (EQUAL (EQUAL (DIFFERENCE X Y)
+ (DIFFERENCE Z Y))
+ (IF (LESSP X Y)
+ (NOT (LESSP Y Z))
+ (IF (LESSP Z Y)
+ (NOT (LESSP Y X))
+ (EQUAL (FIX X)
+ (FIX Z)))))
+ (EQUAL (MEANING (PLUS-TREE (DELETE X Y))
+ A)
+ (IF (MEMBER X Y)
+ (DIFFERENCE (MEANING (PLUS-TREE Y)
+ A)
+ (MEANING X A))
+ (MEANING (PLUS-TREE Y)
+ A)))
+ (EQUAL (TIMES X (ADD1 Y))
+ (IF (NUMBERP Y)
+ (PLUS X (TIMES X Y))
+ (FIX X)))
+ (EQUAL (NTH (NIL)
+ I)
+ (IF (ZEROP I)
+ (NIL)
+ (ZERO)))
+ (EQUAL (LAST (APPEND A B))
+ (IF (LISTP B)
+ (LAST B)
+ (IF (LISTP A)
+ (CONS (CAR (LAST A))
+ B)
+ B)))
+ (EQUAL (EQUAL (LESSP X Y)
+ Z)
+ (IF (LESSP X Y)
+ (EQUAL T Z)
+ (EQUAL F Z)))
+ (EQUAL (ASSIGNMENT X (APPEND A B))
+ (IF (ASSIGNEDP X A)
+ (ASSIGNMENT X A)
+ (ASSIGNMENT X B)))
+ (EQUAL (CAR (GOPHER X))
+ (IF (LISTP X)
+ (CAR (FLATTEN X))
+ (ZERO)))
+ (EQUAL (FLATTEN (CDR (GOPHER X)))
+ (IF (LISTP X)
+ (CDR (FLATTEN X))
+ (CONS (ZERO)
+ (NIL))))
+ (EQUAL (QUOTIENT (TIMES Y X)
+ Y)
+ (IF (ZEROP Y)
+ (ZERO)
+ (FIX X)))
+ (EQUAL (GET J (SET I VAL MEM))
+ (IF (EQP J I)
+ VAL
+ (GET J MEM))))))
+
+
+% lmm 7-JUN-81 09:44
+(DE TAUTOLOGYP (X TRUE-LST FALSE-LST)
+(COND ((TRUEP X TRUE-LST)
+ T)
+ ((FALSEP X FALSE-LST)
+ NIL)
+ ((NOT (PAIRP X))
+ NIL)
+ ((EQ (CAR X)
+ 'IF)
+ (COND ((TRUEP (CADR X)
+ TRUE-LST)
+ (TAUTOLOGYP (CADDR X)
+ TRUE-LST FALSE-LST))
+ ((FALSEP (CADR X)
+ FALSE-LST)
+ (TAUTOLOGYP (CADDDR X)
+ TRUE-LST FALSE-LST))
+ (T (AND (TAUTOLOGYP (CADDR X)
+ (CONS (CADR X)
+ TRUE-LST)
+ FALSE-LST)
+ (TAUTOLOGYP (CADDDR X)
+ TRUE-LST
+ (CONS (CADR X)
+ FALSE-LST))))))
+ (T NIL)))
+
+
+(DE TAUTP (X)
+(TAUTOLOGYP (REWRITE X)
+ NIL NIL))
+
+
+(DE TEST NIL
+(PROG (TM1 TM2 ANS TERM)
+ (SETQ TM1 (PTIME))
+ (SETQ TERM (APPLY-SUBST '((X F (PLUS (PLUS A B)
+ (PLUS C (ZERO))))
+ (Y F (TIMES (TIMES A B)
+ (PLUS C D)))
+ (Z F (REVERSE (APPEND (APPEND A B)
+ (NIL))))
+ (U EQUAL (PLUS A B)
+ (DIFFERENCE X Y))
+ (W LESSP (REMAINDER A B)
+ (MEMBER A (LENGTH B))))
+ '(IMPLIES (AND (IMPLIES X Y)
+ (AND (IMPLIES Y Z)
+ (AND (IMPLIES Z U)
+ (IMPLIES U W))))
+ (IMPLIES X W))))
+ (SETQ ANS (TAUTP TERM))
+ (SETQ TM2 (PTIME))
+ (RETURN (LIST ANS (DIFFERENCE (CAR TM2)
+ (CAR TM1))
+ (DIFFERENCE (CDR TM2)
+ (CDR TM1))))))
+
+
+(DE TRANS-OF-IMPLIES (N)
+(LIST 'IMPLIES
+ (TRANS-OF-IMPLIES1 N)
+ (LIST 'IMPLIES
+ 0 N)))
+
+
+(DE TRANS-OF-IMPLIES1 (N)
+(COND ((EQUAL N 1)
+ (LIST 'IMPLIES
+ 0 1))
+ (T (LIST 'AND
+ (LIST 'IMPLIES
+ (SUB1 N)
+ N)
+ (TRANS-OF-IMPLIES1 (SUB1 N))))))
+
+
+(DE TRUEP (X LST)
+(OR (EQUAL X '(T))
+ (MEMBER X LST)))
ADDED psl-1983/3-1/glisp/menu.sl
Index: psl-1983/3-1/glisp/menu.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/menu.sl
@@ -0,0 +1,19 @@
+% MENU.SL.1
+% Abstract datatype for Menu operations.
+% G. Novak 31 Jan. 83
+
+
+(glispobjects
+
+(menu (listobject (items (listof atom)))
+ msg ((create menu-create)
+ (select menu-select)))
+
+)
+
+% Initialize a menu which has been newly created.
+(dg menu-create (m:menu))
+
+% Ask the user for a selection from a menu.
+(dg menu-select (m:menu)
+)
ADDED psl-1983/3-1/glisp/newdg.sl
Index: psl-1983/3-1/glisp/newdg.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/newdg.sl
@@ -0,0 +1,16 @@
+
+% Fexpr for defining GLISP functions.
+(dm dg (x)
+ (prog (result)
+ (put (cadr x) 'gloriginalexpr (cons 'lambda (cddr x)))
+ (return
+ (cond (glcompiledefflg
+ (glcc (cadr x))
+ (setq result (cons 'df
+ (cons (cadr x)
+ (cdr (get (cadr x) 'glcompiled)))))
+ (put (cadr x) 'glcompiled nil)
+ result)
+ (t (glputhook (cadr x))
+ (list 'quote (cadr x)) )) )))
+
ADDED psl-1983/3-1/glisp/oldgltest.sl
Index: psl-1983/3-1/glisp/oldgltest.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/oldgltest.sl
@@ -0,0 +1,557 @@
+% GLTEST.SL.8 17 January 1983
+
+% GLISP TEST FUNCTIONS, PSL VERSION.
+
+% Object descriptions for a Company database.
+(GLISPOBJECTS
+
+(EMPLOYEE % Name of the object type
+
+ (LIST (NAME STRING) % Actual storage structure
+ (DATE-HIRED (A DATE))
+ (SALARY REAL)
+ (JOBTITLE ATOM)
+ (TRAINEE BOOLEAN))
+
+ PROP ((SENIORITY ((THE YEAR OF (CURRENTDATE)) % Computed properties
+ -
+ (THE YEAR OF DATE-HIRED)))
+ (MONTHLY-SALARY (SALARY * 174)))
+
+ ADJ ((HIGH-PAID (MONTHLY-SALARY > 2000))) % Computed adjectives
+
+ ISA ((TRAINEE (TRAINEE))
+ (GREENHORN (TRAINEE AND SENIORITY < 2)))
+
+ MSG ((YOURE-FIRED (SALARY _ 0))) ) % Message definitions
+
+
+(Date
+ (List (MONTH INTEGER)
+ (DAY INTEGER)
+ (YEAR INTEGER))
+ PROP ((MONTHNAME ((NTH '(JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY
+ AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER)
+ MONTH)))
+ (PRETTYFORM ((LIST DAY MONTHNAME YEAR)))
+ (SHORTYEAR (YEAR - 1900))) )
+
+
+(COMPANY
+ (ATOM (PROPLIST (PRESIDENT (AN EMPLOYEE))
+ (EMPLOYEES (LISTOF EMPLOYEE) )))
+ PROP ((ELECTRICIANS ((THOSE EMPLOYEES WITH JOBTITLE='ELECTRICIAN)))) )
+
+)
+
+
+% Some test data for the above functions.
+(setq company1 (a company with
+ President = (An Employee with Name = "Oscar the Grouch"
+ Salary = 88.0
+ Jobtitle = 'President
+ Date-Hired = (A Date with Month = 3
+ Day = 15 Year = 1907))
+ Employees = (list
+ (An Employee with Name = "Cookie Monster"
+ Salary = 12.50
+ Jobtitle = 'Electrician
+ Date-Hired = (A Date with Month = 7
+ Day = 21 Year = 1947))
+ (An Employee with Name = "Betty Lou"
+ Salary = 9.00
+ Jobtitle = 'Electrician
+ Date-Hired = (A Date with Month = 5
+ Day = 15 Year = 1980))
+ (An Employee with Name = "Grover"
+ Salary = 3.00
+ Jobtitle = 'Electrician
+ Trainee = T
+ Date-Hired = (A Date with Month = 6
+ Day = 13 Year = 1978))
+)))
+
+% Program to give raises to the electricians.
+(DG GIVE-RAISE
+ (:COMPANY)
+ (FOR EACH ELECTRICIAN WHO IS NOT A TRAINEE
+ DO (SALARY _+(IF SENIORITY > 1
+ THEN 2.5
+ ELSE 1.5))
+ (PRINT (THE NAME OF THE ELECTRICIAN))
+ (PRINT (THE PRETTYFORM OF DATE-HIRED))
+ (PRINT MONTHLY-SALARY) ))
+
+(DG CURRENTDATE () (Result DATE)
+ (A DATE WITH YEAR = 1981 MONTH = 11 DAY = 30))
+
+
+
+
+
+
+
+% The following object descriptions are used in a graphics object test
+% program (derived from one written by D.G. Bobrow as a LOOPS example).
+% The test program MGO-TEST runs on a Xerox D-machine, but won't run on
+% other machines.
+
+(GLISPOBJECTS
+
+% The actual stored structure for a Vector is simple, but it is overloaded
+% with many properties.
+
+(VECTOR
+
+ (LIST (X INTEGER)
+ (Y INTEGER))
+
+ PROP ((MAGNITUDE ((SQRT X^2 + Y^2)))
+ (DIRECTION ((IF X IS ZERO THEN (IF Y IS NEGATIVE THEN -90.0
+ ELSE 90.0)
+ ELSE (ATAN2D Y X))) RESULT DEGREES)
+ )
+
+ ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)))
+
+ MSG ((+ VECTORPLUS OPEN T) % Defining operators as messages
+ % causes the compiler to automatically
+ % overload the operators.
+ (- VECTORDIFF OPEN T)
+ (* VECTORTIMES OPEN T ARGTYPES (NUMBER))
+ (* vectordotproduct open t argtypes (vector))
+ (/ VECTORQUOTIENT OPEN T)
+ (_+ VECTORMOVE OPEN T)
+ (PRIN1 ((PRIN1 "(")
+ (PRIN1 X)
+ (PRIN1 ",")
+ (PRIN1 Y)
+ (PRIN1 ")")))
+ (PRINT ((SEND SELF PRIN1) % PRINT is defined in terms of the
+ (TERPRI))) ) ) % PRIN1 message of this object.
+
+
+(DEGREES REAL % Stored value is just a real number.
+ PROP ((RADIANS (self*(3.1415926 / 180.0)) RESULT RADIANS)))
+
+(RADIANS REAL
+ PROP ((DEGREES (self*(180.0 / 3.1415926)) RESULT DEGREES)))
+
+
+% The definition of GraphicsObject builds on that of Vector.
+(GRAPHICSOBJECT
+
+ (LIST (SHAPE ATOM)
+ (START VECTOR)
+ (SIZE VECTOR))
+
+ PROP ((LEFT (START:X)) % A property defined in terms of a
+ % property of a substructure
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH)) % Vector addition.
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2)) % Vector arithmetic
+ (AREA (WIDTH*HEIGHT)))
+
+ MSG ((DRAW ((APPLY (GET SHAPE 'DRAWFN) % A way to get runtime message
+ (List SELF % behavior without using the
+ (QUOTE PAINT))))) % message mechanism.
+ (ERASE ((APPLY (GET SHAPE 'DRAWFN)
+ (LIST SELF
+ (QUOTE ERASE)))))
+ (MOVE GRAPHICSOBJECTMOVE OPEN T)) )
+
+(MOVINGGRAPHICSOBJECT
+
+ (LIST (TRANSPARENT GRAPHICSOBJECT) % Includes properties of a
+ (VELOCITY VECTOR)) % GraphicsObject due to the
+ % TRANSPARENT declaration.
+ Msg ((ACCELERATE MGO-ACCELERATE OPEN T)
+ (STEP ((SEND SELF MOVE VELOCITY)))) )
+)
+
+
+% The following functions define arithmetic operations on Vectors.
+% These functions are generally called OPEN (macro-expanded) rather
+% than being called directly.
+(DG VECTORPLUS
+ (V1:vector V2:VECTOR)
+ (A (typeof v1) WITH X = V1:X + V2:X Y = V1:Y + V2:Y))
+
+(DG VECTORDIFF
+ (V1:vector V2:VECTOR)
+ (A (typeof v1) WITH X = V1:X - V2:X Y = V1:Y - V2:Y))
+
+(DG VECTORTIMES
+ (V:VECTOR N:NUMBER)
+ (A (typeof v) WITH X = X*N Y = Y*N))
+
+(DG VECTORDOTPRODUCT
+ (V1:vector V2:VECTOR)
+ (A (typeof v1) WITH X = V1:X * V2:X Y = V1:Y * V2:Y))
+
+(DG VECTORQUOTIENT
+ (V:VECTOR N:NUMBER)
+ (A (typeof v) WITH X = X/N Y = Y/N))
+
+% VectorMove, which defines the _+ operator for vectors, does a destructive
+% addition to the vector which is its first argument. Thus, the expression
+% U_+V will destructively change U, while U_U+V will make a new vector with
+% the value U+V and assign its value to U.
+(DG VECTORMOVE
+ (V:vector DELTA:VECTOR)
+ (V:X _+ DELTA:X)
+ (V:Y _+ DELTA:Y)
+ V)
+
+% An object is moved by erasing it, changing its starting point, and
+% then redrawing it.
+(DG GRAPHICSOBJECTMOVE
+ (SELF:GRAPHICSOBJECT DELTA:VECTOR)
+ (SEND SELF ERASE) % Erase the object
+ (START _+ DELTA) % Destructively move start point by delta
+ (SEND SELF DRAW)) % Redraw the object in new location
+
+(DG MGO-ACCELERATE
+ (SELF: MOVINGGRAPHICSOBJECT ACCELERATION: VECTOR)
+ VELOCITY _+ ACCELERATION)
+
+
+% Now we define some test functions which use the above definitions.
+% First there are some simple functions which test vector operations.
+(DG TVPLUS (U:VECTOR V:VECTOR) U+V)
+(DG TVMOVE (U:VECTOR V:VECTOR) U_+V)
+(DG TVTIMESN (U:VECTOR N:NUMBER) U*N)
+(DG TVTIMESV (U:VECTOR V:VECTOR) U*V)
+
+% This test function creates a MovingGraphicsObject and then moves it
+% across the screen by sending it MOVE messages. Everything in this
+% example is compiled open; the STEP message involves a great deal of
+% message inheritance.
+(DG MGO-TEST ()
+ (PROG (MGO N)
+ (MGO _(A MOVINGGRAPHICSOBJECT WITH
+ SHAPE = (QUOTE RECTANGLE)
+ SIZE = (A VECTOR WITH X = 4 Y = 3)
+ VELOCITY = (A VECTOR WITH X = 3 Y = 4)))
+ (N _ 0)
+ (WHILE (N_+1)<100 (SEND MGO STEP))
+ (SEND (THE START OF MGO) PRINT)))
+
+
+% This function tests the properties of a GraphicsObject.
+(DG TESTFN2 (:GRAPHICSOBJECT)
+ (LIST SHAPE START SIZE LEFT BOTTOM RIGHT TOP
+ WIDTH HEIGHT CENTER AREA))
+
+% Function to draw a rectangle. Computed properties of the rectangle are
+% used within calls to the graphics functions, making the code easy to
+% write and understand.
+(DG DRAWRECT (SELF:GRAPHICSOBJECT DSPOP:ATOM)
+ (PROG (OLDDS)
+ (OLDDS _(CURRENTDISPLAYSTREAM DSPS))
+ (DSPOPERATION DSPOP)
+ (MOVETO LEFT BOTTOM)
+ (DRAWTO LEFT TOP)
+ (DRAWTO RIGHT TOP)
+ (DRAWTO RIGHT BOTTOM)
+ (DRAWTO LEFT BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS) ))
+
+
+
+
+
+% The LispTree and PreorderSearchRecord objects illustrate how generators
+% can be written.
+(GLISPOBJECTS
+
+% In defining a LispTree, which can actually be of multiple types (atom or
+% dotted pair), we define it as the more complex dotted-pair type and take
+% care of the simpler case in the PROPerty definitions.
+(LISPTREE
+ (CONS (CAR LISPTREE) % Defines a LispTree structure as the CONS
+ (CDR LISPTREE)) % of two fields named CAR and CDR.
+
+ PROP ((LEFTSON ((IF SELF IS ATOMIC THEN NIL ELSE CAR)))
+ (RIGHTSON ((IF SELF IS ATOMIC THEN NIL ELSE CDR))))
+
+ ADJ ((EMPTY (~SELF))) )
+
+% PreorderSearchRecord is defined to be a generator. Its data structure holds
+% the current node and a stack of previous nodes, and its NEXT message is
+% defined as code to step through the preorder search.
+(PREORDERSEARCHRECORD
+
+ (CONS (NODE LISPTREE)
+ (PREVIOUSNODES (LISTOF LISPTREE)))
+
+ MSG ((NEXT ((PROG (TMP)
+ (IF TMP_NODE:LEFTSON
+ THEN (IF NODE:RIGHTSON THEN PREVIOUSNODES+_NODE)
+ NODE_TMP
+ ELSE TMP-_PREVIOUSNODES
+ NODE_TMP:RIGHTSON))))) )
+)
+
+
+% PRINTLEAVES prints the leaves of the tree, using a PreorderSearchRecord
+% as the generator for searching the tree.
+(DG PRINTLEAVES (:LISPTREE)
+ (PROG (PSR)
+ (PSR _(A PREORDERSEARCHRECORD WITH NODE =(THE LISPTREE)))
+ (WHILE NODE (IF NODE IS ATOMIC (PRINT NODE))
+ (SEND PSR NEXT))))
+
+
+
+% The Circle objects illustrate the definition of a number of mathematical
+% properties of an object in terms of stored data and other properties.
+(Glispobjects
+
+(CIRCLE (LIST (START VECTOR) (RADIUS REAL))
+ PROP ((PI (3.1415926)) % A PROPerty can be a constant.
+ (DIAMETER (RADIUS*2))
+ (CIRCUMFERENCE (PI*DIAMETER)) % Defined in terms of other prop.
+ (AREA (PI*RADIUS^2)) )
+ ADJ ((BIG (AREA>120)) % BIG defined in terms of AREA
+ (MEDIUM (AREA >= 60 AND AREA <= 120))
+ (SMALL (AREA<60)))
+ MSG ((STANDARD (AREA_100)) % "Storing into" computed property
+ (GROW (AREA_+100))
+ (SHRINK (AREA_AREA/2)) )
+ )
+
+
+% A DCIRCLE is implemented differently from a circle.
+% The data structure is different, and DIAMETER is stored instead of RADIUS.
+% By defining RADIUS as a PROPerty, all of the CIRCLE properties defined
+% in terms of radius can be inherited.
+
+(DCIRCLE (LISTOBJECT (START VECTOR) (DIAMETER REAL))
+ PROP ((RADIUS (DIAMETER/2)))
+ SUPERS (CIRCLE) )
+)
+
+% Make a DCIRCLE for testing
+(setq dc (a dcircle with diameter = 10.0))
+
+% Since DCIRCLE is an Object type, it can be used with interpreted messages,
+% e.g., (send dc area) to get the area property,
+% (send dc standard) to set the area to the standard value,
+% (send dc diameter) to get the stored diameter value.
+
+
+
+% EXAMPLE OF ASSIGNMENT TO COMPUTED PROPERTY
+(DG GROWCIRCLE (C:CIRCLE)
+ (C:AREA_+100)
+ (PRINT RADIUS) )
+
+(SETQ MYCIRCLE (A CIRCLE))
+
+% Since SQRT is not defined in the bare-PSL system, we redefine it here.
+(DG SQRT (X)
+ (PROG (S)
+ (S_X)
+ (IF X < 0 THEN (ERROR)
+ ELSE (WHILE (ABS S*S - X) > 0.000001 DO (S _ (S+X/S) * 0.5)))
+ (RETURN S)))
+
+% Function SQUASH illustrates elimination of compile-time constants.
+% Of course, nobody would write such a function directly. However, such forms
+% can arise when inherited properties are compiled. Conditional compilation
+% occurs automatically when appropriate variables are defined to the GLISP
+% compiler as compile-time constants because the post-optimization phase of
+% the compiler makes the unwanted code disappear.
+
+(DG SQUASH ()
+ (IF 1>3 THEN 'AMAZING
+ ELSEIF 6<2 THEN 'INCREDIBLE
+ ELSEIF 2 + 2 = 4 THEN 'OKAY
+ ELSE 'JEEZ))
+
+
+% The following object definitions describe a student records database.
+(glispobjects
+
+(student (atom (proplist (name string)
+ (sex atom)
+ (major atom)
+ (grades (listof integer))))
+ prop ((average student-average)
+ (grade-average student-grade-average))
+ adj ((male (sex='male))
+ (female (sex='female))
+ (winning (average>=95))
+ (losing (average<60)))
+ isa ((winner (self is winning))))
+
+(student-group (listof student)
+ prop ((n-students length) % This property is implemented by
+ % the Lisp function LENGTH.
+ (Average Student-group-average)))
+
+(class (atom (proplist (department atom)
+ (number integer)
+ (instructor string)
+ (students student-group)))
+ prop ((n-students (students:n-students))
+ (men ((those students who are male)))
+ (women ((those students who are female)))
+ (winners ((those students who are winning)))
+ (losers ((those students who are losing)))
+ (class-average (students:average))))
+
+)
+
+
+(dg student-average (s:student)
+ (prog ((sum 0.0)(n 0.0))
+ (for g in grades do n _+ 1.0 sum_+g)
+ (return sum/n) ))
+
+(dg student-grade-average (s:student)
+ (prog ((av s:average))
+ (return (if av >= 90.0 then 'a
+ elseif av >= 80.0 then 'b
+ elseif av >= 70.0 then 'c
+ elseif av >= 60.0 then 'd
+ else 'f))))
+
+
+(dg student-group-average (sg:student-group)
+ (prog ((sum 0.0))
+ (for s in sg do sum_+s:average)
+ (return sum/sg:n-students) ))
+
+% Print name and grade average for each student
+(dg test1 (c:class)
+ (for s in c:students (prin1 s:name)
+ (prin2 '! )
+ (print s:grade-average)))
+
+% Another version of the above function
+(dg test1b (:class)
+ (for each student (prin1 name)
+ (prin2 '! )
+ (print grade-average)))
+
+% Print name and average of the winners in the class
+(dg test2 (c:class)
+ (for s in c:winners (prin1 s:name)
+ (prin2 '! )
+ (print s:average)))
+
+% The average of all the male students' grades
+(dg test3 (c:class)
+ c:men:average)
+
+% The name and average of the winning women
+(dg test4 (c:class)
+ (for s in c:women when s is winning
+ (prin1 s:name)
+ (prin2 '! )
+ (print s:average)))
+
+% Another version of the above function. The * operator in this case
+% denotes the intersection of the sets of women and winners. The
+% GLISP compiler optimizes the code so that these intermediate sets are
+% not actually constructed.
+(dg test5 (c:class)
+ (for s in c:women*c:winners
+ (prin1 s:name)
+ (prin2 '! )
+ (print s:average)))
+
+
+% Make a list of the easy professors.
+(dg easy-profs (classes:(listof class))
+ (for each class with class-average > 90.0 collect (the instructor)))
+
+
+% A more Pascal-like version of easy-profs:
+(dg easy-profs-b (classes:(listof class))
+ (for c in classes when c:class-average > 90.0 collect c:instructor))
+
+
+% Some test data for testing the above functions.
+(setq class1 (a class with instructor = "G. Novak" department = 'cs
+ number = 102 students =
+ (list
+ (a student with name = "John Doe" sex = 'male major = 'cs
+ grades = '(99 98 97 93))
+ (a student with name = "Fred Failure" sex = 'male major = 'cs
+ grades = '(52 54 43 27))
+ (a student with name = "Mary Star" sex = 'female major = 'cs
+ grades = '(100 100 99 98))
+ (a student with name = "Doris Dummy" sex = 'female major = 'cs
+ grades = '(73 52 46 28))
+ (a student with name = "Jane Average" sex = 'female major = 'cs
+ grades = '(75 82 87 78))
+ (a student with name = "Lois Lane" sex = 'female major = 'cs
+ grades = '(98 95 97 96)) )))
+
+
+
+% The following object definitions illustrate inheritance of properties
+% from multiple parent classes. The three "bottom" classes Planet, Brick,
+% and Bowling-Ball all inherit the same definition of the property Density,
+% although they are represented in very different ways.
+(glispobjects
+
+(physical-object anything
+ prop ((density (mass/volume))))
+
+(ordinary-object anything
+ prop ((mass (weight / 9.88))) % Compute mass as weight/gravity
+ supers (physical-object))
+
+(sphere anything
+ prop ((volume ((4.0 / 3.0) * 3.1415926 * radius ^ 3))))
+
+(parallelepiped anything
+ prop ((volume (length*width*height))))
+
+(planet (listobject (mass real)(radius real))
+ supers (physical-object sphere)) % A planet is a physical-object
+ % and a sphere.
+
+(brick (object (length real)(width real)(height real)(weight real))
+ supers (ordinary-object parallelepiped))
+
+(bowling-ball (atomobject (type atom)(weight real))
+ prop ((radius ((if type='adult then 0.1 else 0.07))))
+ supers (ordinary-object sphere))
+
+)
+
+% Three test functions to demonstrate inheritance of the Density property.
+(dg dplanet (p:planet) density)
+
+(dg dbrick (b:brick) density)
+
+(dg dbb (b:bowling-ball) density)
+
+% Some objects to test the functions on.
+(setq earth (a planet with mass = 5.98e24 radius = 6.37e6))
+
+(setq brick1 (a brick with weight = 20.0 width = 0.10 height = 0.05
+ length = 0.20))
+
+(setq bb1 (a bowling-ball with type = 'adult weight = 60.0))
+
+
+% Since the object types Planet, Brick, and Bowling-Ball are defined as
+% Object types (i.e., they contain the Class name as part of their stored
+% data), messages can be sent to them directly from the keyboard for
+% interactive examination of the objects. For example, the following
+% messages could be used:
+% (send earth density)
+% (send brick1 weight: 25.0)
+% (send brick1 mass: 2.0)
+% (send bb1 radius)
+% (send bb1 type: 'child)
ADDED psl-1983/3-1/glisp/permute.old
Index: psl-1983/3-1/glisp/permute.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/permute.old
@@ -0,0 +1,285 @@
+(FILECREATED " 2-JAN-83 14:20:01" {DSK}PERMUTE.LSP;4 9267
+
+ changes to: (FNS HISTO-CREATE HISTO-PEAKS HISTO-ADD)
+ (VARS PERMUTECOMS)
+
+ previous date: "28-DEC-82 11:32:40" {DSK}PERMUTE.LSP;1)
+
+
+(PRETTYCOMPRINT PERMUTECOMS)
+
+(RPAQQ PERMUTECOMS ((GLISPOBJECTS HISTOGRAM PERMUTATION)
+ (VARS PERM3S FOLD3S PERM4S FOLD4S)
+ (FNS ALLPERMS BINLIST BITSHUFFLE COMPOSEBITSHUFFLES DOBITSHUFFLE GENPERMS HISTO-ADD
+ HISTO-CREATE HISTO-PEAKS IDPERM LISTOFC LOG2 NEGINPPERM OUTPERMS PERM-INVERSE)
+ (PROP GLRESULTTYPE BITSHUFFLE DOBITSHUFFLE)))
+
+
+[GLISPOBJECTS
+
+
+(HISTOGRAM
+
+ (LISTOBJECT (MIN INTEGER)
+ (MAX INTEGER)
+ (TOTAL INTEGER)
+ (COUNTS (LISTOF INTEGER)))
+
+ PROP ((PEAKS HISTO-PEAKS))
+
+ MSG ((CREATE HISTO-CREATE)
+ (+ HISTO-ADD)) )
+
+(PERMUTATION
+
+ (LISTOF INTEGER)
+
+ PROP ((LENGTH LENGTH)
+ (INVERSE PERM-INVERSE RESULT PERMUTATION))
+
+ MSG ((* COMPOSEBITSHUFFLES RESULT PERMUTATION)) )
+]
+
+
+(RPAQQ PERM3S ((7 3 5 1 6 2 4 0)
+ (7 5 3 1 6 4 2 0)
+ (7 3 6 2 5 1 4 0)
+ (7 5 6 4 3 1 2 0)
+ (7 6 3 2 5 4 1 0)))
+
+(RPAQQ FOLD3S ((3 2 1 0 7 6 5 4)
+ (5 4 7 6 1 0 3 2)
+ (6 7 4 5 2 3 0 1)))
+
+(RPAQQ PERM4S ((15 7 11 3 13 5 9 1 14 6 10 2 12 4 8 0)
+ (15 11 7 3 13 9 5 1 14 10 6 2 12 8 4 0)
+ (15 7 13 5 11 3 9 1 14 6 12 4 10 2 8 0)
+ (15 11 13 9 7 3 5 1 14 10 12 8 6 2 4 0)
+ (15 13 7 5 11 9 3 1 14 12 6 4 10 8 2 0)
+ (15 13 11 9 7 5 3 1 14 12 10 8 6 4 2 0)
+ (15 7 11 3 14 6 10 2 13 5 9 1 12 4 8 0)
+ (15 11 7 3 14 10 6 2 13 9 5 1 12 8 4 0)
+ (15 7 13 5 14 6 12 4 11 3 9 1 10 2 8 0)
+ (15 11 13 9 14 10 12 8 7 3 5 1 6 2 4 0)
+ (15 13 7 5 14 12 6 4 11 9 3 1 10 8 2 0)
+ (15 13 11 9 14 12 10 8 7 5 3 1 6 4 2 0)
+ (15 7 14 6 11 3 10 2 13 5 12 4 9 1 8 0)
+ (15 11 14 10 7 3 6 2 13 9 12 8 5 1 4 0)
+ (15 7 14 6 13 5 12 4 11 3 10 2 9 1 8 0)
+ (15 11 14 10 13 9 12 8 7 3 6 2 5 1 4 0)
+ (15 13 14 12 7 5 6 4 11 9 10 8 3 1 2 0)
+ (15 13 14 12 11 9 10 8 7 5 6 4 3 1 2 0)
+ (15 14 7 6 11 10 3 2 13 12 5 4 9 8 1 0)
+ (15 14 11 10 7 6 3 2 13 12 9 8 5 4 1 0)
+ (15 14 7 6 13 12 5 4 11 10 3 2 9 8 1 0)
+ (15 14 11 10 13 12 9 8 7 6 3 2 5 4 1 0)
+ (15 14 13 12 7 6 5 4 11 10 9 8 3 2 1 0)))
+
+(RPAQQ FOLD4S ((7 6 5 4 3 2 1 0 15 14 13 12 11 10 9 8)
+ (11 10 9 8 15 14 13 12 3 2 1 0 7 6 5 4)
+ (13 12 15 14 9 8 11 10 5 4 7 6 1 0 3 2)
+ (14 15 12 13 10 11 8 9 6 7 4 5 2 3 0 1)))
+(DEFINEQ
+
+(ALLPERMS
+ (GLAMBDA (N:INTEGER) (* edited: "27-DEC-82 15:36")
+ (* Generate a list of all permutations of length N.
+ The identity permutation is always the first member of
+ the list.)
+ (RESULT (LISTOF PERMUTATION))
+ (DECLARE (SPECVARS LST))
+ (PROG (LST)
+ (IF N>5 (ERROR "TOO MANY PERMUTATIONS!"))
+ (GENPERMS NIL (IDPERM N))
+ (RETURN LST))))
+
+(BINLIST
+ (GLAMBDA (N,NBITS:INTEGER) (* edited: "28-DEC-82 11:26")
+ (* Convert N to a list of bit values.)
+ (RESULT (LISTOF INTEGER))
+ (PROG (L I BIT)
+ (I_0)
+ (BIT_1)
+ (WHILE I<NBITS DO (L+_(IF (LOGAND N BIT)=0
+ THEN 0
+ ELSE 1))
+ (I_+1)
+ (BIT_+BIT))
+ (RETURN L))))
+
+(BITSHUFFLE
+ [LAMBDA (INPUT LST) (* edited: " 6-MAY-82 16:33")
+
+ (* Compute a bit-shuffle of the input according to the specification list LST. LST gives, for each output bit in
+ order, the input bit from which it comes.)
+
+
+ (PROG (RES)
+ (SETQ RES 0)
+ [MAPC LST (FUNCTION (LAMBDA (X)
+ (SETQ RES (IPLUS (IPLUS RES RES)
+ (COND
+ ((NULL X)
+ 0)
+ ((NOT (NUMBERP X))
+ 1)
+ ((ZEROP (LOGAND INPUT (BITPICK X)))
+ 0)
+ (T 1]
+ (RETURN RES])
+
+(COMPOSEBITSHUFFLES
+ [LAMBDA (FIRST SECOND) (* edited: "23-JUN-82 15:17")
+ (* Compose two bitshuffles to produce a single
+ bitshuffle which is equivalent.)
+ (PROG (L)
+ (COND
+ ((NOT (EQUAL (SETQ L (LENGTH FIRST))
+ (LENGTH SECOND)))
+ (ERROR)))
+ (RETURN (MAPCAR SECOND (FUNCTION (LAMBDA (X)
+ (COND
+ [(FIXP X)
+ (CAR (NTH FIRST (IDIFFERENCE L X]
+ (T X])
+
+(DOBITSHUFFLE
+ [LAMBDA (INT PERM) (* edited: "27-DEC-82 15:44")
+ (BITSHUFFLE INT PERM])
+
+(GENPERMS
+ [GLAMBDA (PREV,L:(LISTOF INTEGER)) (* edited: "27-DEC-82 15:38")
+
+ (* Generate all permutations consisting of the list PREV followed by all permutations of the list L.
+ The permutations which are generated are added to the global LST. Called by ALLPERMS.)
+
+
+ (GLOBAL LST:(LISTOF PERMUTATION))
+ (PROG (I TMP N)
+ (IF ~L
+ THEN LST+_PREV
+ (RETURN))
+ (N_(LENGTH L))
+ (I_0)
+ (WHILE (I_+1)
+ <=N DO (TMP_(CAR (NTH L I)))
+ (GENPERMS (PREV+TMP)
+ (L - TMP])
+
+(HISTO-ADD
+ (GLAMBDA (H:HISTOGRAM N:INTEGER) (* edited: "30-DEC-82 13:26")
+ (IF N>MAX OR N<MIN
+ THEN (ERROR)
+ ELSE TOTAL_+1
+ (CAR (NTH COUNTS (N - MIN + 1)))_+1)
+ H))
+
+(HISTO-CREATE
+ (GLAMBDA (H:HISTOGRAM) (* edited: " 2-JAN-83 14:14")
+ (RESULT HISTOGRAM) (* Initialize a histogram.)
+ (TOTAL_0)
+ (COUNTS_(LISTOFC 0 (MAX - MIN + 1)))
+ H))
+
+(HISTO-PEAKS
+ [GLAMBDA (H:HISTOGRAM) (* edited: " 2-JAN-83 14:10")
+ (PROG (THRESH L MX N)
+ (MX_0)
+ (FOR X IN COUNTS (IF X>MX MX_X))
+ (THRESH_MX/2)
+ (N_MIN)
+ (FOR X IN COUNTS DO (IF X>=THRESH L+_N)
+ N_+1)
+ (RETURN (DREVERSE L])
+
+(IDPERM
+ (GLAMBDA (N:INTEGER) (* edited: "28-DEC-82 11:23")
+ (* Produce an identity permutation of length N.)
+ (RESULT PERMUTATION)
+ (PROG (L (I 0))
+ (WHILE I<N L+_I
+ I_+1)
+ (RETURN L))))
+
+(LISTOFC
+ (GLAMBDA (C N:INTEGER) (* edited: "28-DEC-82 11:23")
+ (* Make a list of N copies of the constant C.)
+ (RESULT (LISTOF ATOM))
+ (PROG (I L)
+ (I_0)
+ (WHILE (I_+1)
+ <=N DO L+_C)
+ (RETURN L))))
+
+(LOG2
+ (GLAMBDA (N:INTEGER) (* edited: "28-DEC-82 11:07")
+ (* Log to the base 2 of an integer, rounded up.)
+ (RESULT INTEGER)
+ (PROG ((I 0)
+ (M 1))
+ (WHILE M<N DO I_+1
+ M_+M)
+ (RETURN I))))
+
+(NEGINPPERM
+ (GLAMBDA (N,M:INTEGER) (* edited: "28-DEC-82 11:03")
+ (* Compute the permutation to be applied to the output
+ of a boolean function of N inputs to account for
+ negating the Mth input.)
+ (RESULT PERMUTATION)
+ (PROG (TWON TWOM (I 0)
+ L)
+ (TWON_2^N)
+ (TWOM_2^M)
+ (WHILE I<TWON L+_(IF (LOGAND I TWOM)
+ ~=0
+ THEN I - TWOM
+ ELSE I+TWOM)
+ I_+1)
+ (RETURN L))))
+
+(OUTPERMS
+ (GLAMBDA (N:INTEGER) (* edited: "28-DEC-82 11:02")
+
+ (* Create the set of permutations of the set of 2^N outputs corresponding to isomorphisms, i.e., renamings of the
+ N inputs of a boolean function. The identity isomorphism is omitted.)
+
+
+ (RESULT (LISTOF PERMUTATION))
+ (PROG (I TMP RES TWON)
+ (TWON_2^N)
+ (FOR X IN (CDR (ALLPERMS N)) DO (I_0)
+ (TMP_NIL)
+ (WHILE I<TWON DO (TMP+_(DOBITSHUFFLE I X))
+ (I_+1))
+ (RES+_TMP))
+ (RETURN RES))))
+
+(PERM-INVERSE
+ (GLAMBDA (P:PERMUTATION) (* edited: " 2-SEP-82 10:47")
+ (RESULT PERMUTATION) (* edited: " 2-SEP-82 10:44")
+ (* Compute the inverse of a permutation.)
+ (PROG (LST N M (I 0)
+ J PP TMP)
+ (N_P:LENGTH)
+ (WHILE I<N DO (J _ N - 1)
+ (PP_P)
+ [WHILE PP DO (IF (CAR PP)=I
+ THEN LST+_J
+ PP_NIL
+ ELSE TMP-_PP
+ J_-1
+ (IF ~PP (ERROR]
+ (I_+1))
+ (RETURN LST))))
+)
+
+(PUTPROPS BITSHUFFLE GLRESULTTYPE INTEGER)
+
+(PUTPROPS DOBITSHUFFLE GLRESULTTYPE INTEGER)
+(DECLARE: DONTCOPY
+ (FILEMAP (NIL (2528 9147 (ALLPERMS 2538 . 3071) (BINLIST 3073 . 3528) (BITSHUFFLE 3530 . 4122) (
+COMPOSEBITSHUFFLES 4124 . 4654) (DOBITSHUFFLE 4656 . 4799) (GENPERMS 4801 . 5395) (HISTO-ADD 5397 .
+5635) (HISTO-CREATE 5637 . 5902) (HISTO-PEAKS 5904 . 6268) (IDPERM 6270 . 6598) (LISTOFC 6600 . 6950)
+(LOG2 6952 . 7296) (NEGINPPERM 7298 . 7897) (OUTPERMS 7899 . 8504) (PERM-INVERSE 8506 . 9145)))))
+STOP
ADDED psl-1983/3-1/glisp/permute.sl
Index: psl-1983/3-1/glisp/permute.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/permute.sl
@@ -0,0 +1,254 @@
+
+% {DSK}PERMUTE.PSL;1 5-FEB-83 15:53:01
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(HISTOGRAM (LISTOBJECT (MIN INTEGER)
+ (MAX INTEGER)
+ (TOTAL INTEGER)
+ (COUNTS (LISTOF INTEGER)))
+PROP ((PEAKS HISTO-PEAKS))
+MSG ((CREATE HISTO-CREATE)
+ (+ HISTO-ADD)))
+
+
+(PERMUTATION (LISTOF INTEGER)
+PROP ((LENGTH LENGTH)
+ (INVERSE PERM-INVERSE RESULT PERMUTATION))
+MSG ((* COMPOSEBITSHUFFLES RESULT PERMUTATION)))
+
+)
+
+
+(SETQ PERM3S '((7 3 5 1 6 2 4 0)
+ (7 5 3 1 6 4 2 0)
+ (7 3 6 2 5 1 4 0)
+ (7 5 6 4 3 1 2 0)
+ (7 6 3 2 5 4 1 0)))
+(SETQ FOLD3S '((3 2 1 0 7 6 5 4)
+ (5 4 7 6 1 0 3 2)
+ (6 7 4 5 2 3 0 1)))
+(SETQ PERM4S '((15 7 11 3 13 5 9 1 14 6 10 2 12 4 8 0)
+ (15 11 7 3 13 9 5 1 14 10 6 2 12 8 4 0)
+ (15 7 13 5 11 3 9 1 14 6 12 4 10 2 8 0)
+ (15 11 13 9 7 3 5 1 14 10 12 8 6 2 4 0)
+ (15 13 7 5 11 9 3 1 14 12 6 4 10 8 2 0)
+ (15 13 11 9 7 5 3 1 14 12 10 8 6 4 2 0)
+ (15 7 11 3 14 6 10 2 13 5 9 1 12 4 8 0)
+ (15 11 7 3 14 10 6 2 13 9 5 1 12 8 4 0)
+ (15 7 13 5 14 6 12 4 11 3 9 1 10 2 8 0)
+ (15 11 13 9 14 10 12 8 7 3 5 1 6 2 4 0)
+ (15 13 7 5 14 12 6 4 11 9 3 1 10 8 2 0)
+ (15 13 11 9 14 12 10 8 7 5 3 1 6 4 2 0)
+ (15 7 14 6 11 3 10 2 13 5 12 4 9 1 8 0)
+ (15 11 14 10 7 3 6 2 13 9 12 8 5 1 4 0)
+ (15 7 14 6 13 5 12 4 11 3 10 2 9 1 8 0)
+ (15 11 14 10 13 9 12 8 7 3 6 2 5 1 4 0)
+ (15 13 14 12 7 5 6 4 11 9 10 8 3 1 2 0)
+ (15 13 14 12 11 9 10 8 7 5 6 4 3 1 2 0)
+ (15 14 7 6 11 10 3 2 13 12 5 4 9 8 1 0)
+ (15 14 11 10 7 6 3 2 13 12 9 8 5 4 1 0)
+ (15 14 7 6 13 12 5 4 11 10 3 2 9 8 1 0)
+ (15 14 11 10 13 12 9 8 7 6 3 2 5 4 1 0)
+ (15 14 13 12 7 6 5 4 11 10 9 8 3 2 1 0)))
+(SETQ FOLD4S '((7 6 5 4 3 2 1 0 15 14 13 12 11 10 9 8)
+ (11 10 9 8 15 14 13 12 3 2 1 0 7 6 5 4)
+ (13 12 15 14 9 8 11 10 5 4 7 6 1 0 3 2)
+ (14 15 12 13 10 11 8 9 6 7 4 5 2 3 0 1)))
+
+% edited: 27-DEC-82 15:36
+% Generate a list of all permutations of length N. The identity
+% permutation is always the first member of the list.
+(DG ALLPERMS (N:INTEGER)
+(RESULT (LISTOF PERMUTATION))
+% (SPECVARS LST)
+(PROG (LST)
+ (IF N>5 (ERROR 0 "TOO MANY PERMUTATIONS!"))
+ (GENPERMS NIL (IDPERM N))
+ (RETURN LST)))
+
+
+% edited: 28-DEC-82 11:26
+% Convert N to a list of bit values.
+(DG BINLIST (N,NBITS:INTEGER)
+(RESULT (LISTOF INTEGER))(PROG (L I BIT)
+ (I_0)
+ (BIT_1)
+ (WHILE I<NBITS DO
+ (L+_ (IF (LOGAND N BIT)
+ =0 THEN 0 ELSE 1))
+ (I_+1)
+ (BIT_+BIT))
+ (RETURN L)))
+
+
+% edited: 6-MAY-82 16:33
+% Compute a bit-shuffle of the input according to the specification
+% list LST. LST gives, for each output bit in order, the input bit
+% from which it comes.
+(DE BITSHUFFLE (INPUT LST)
+(PROG (RES)
+ (SETQ RES 0)
+ (MAPC LST (FUNCTION (LAMBDA (X)
+ (SETQ RES (PLUS (PLUS RES RES)
+ (COND
+ ((NULL X)
+ 0)
+ ((NOT (NUMBERP X))
+ 1)
+ ((ZEROP (LOGAND INPUT
+ (BITPICK X)))
+ 0)
+ (T 1)))))))
+ (RETURN RES)))
+
+
+% edited: 23-JUN-82 15:17
+% Compose two bitshuffles to produce a single bitshuffle which is
+% equivalent.
+(DE COMPOSEBITSHUFFLES (FIRST SECOND)
+(PROG (L)
+ (COND ((NOT (EQUAL (SETQ L (LENGTH FIRST))
+ (LENGTH SECOND)))
+ (ERROR 0 NIL)))
+ (RETURN (MAPCAR SECOND (FUNCTION (LAMBDA (X)
+ (COND
+ ((FIXP X)
+ (CAR (PNth FIRST
+ (DIFFERENCE L X))))
+ (T X))))))))
+
+
+% edited: 27-DEC-82 15:44
+(DE DOBITSHUFFLE (INT PERM)
+(BITSHUFFLE INT PERM))
+
+
+% edited: 27-DEC-82 15:38
+% Generate all permutations consisting of the list PREV followed by
+% all permutations of the list L. The permutations which are
+% generated are added to the global LST. Called by ALLPERMS.
+(DG GENPERMS (PREV,L: (LISTOF INTEGER))
+(GLOBAL LST: (LISTOF PERMUTATION))(PROG (I TMP N)
+ (IF ~L THEN LST+_PREV (RETURN NIL))
+ (N_ (LENGTH L))
+ (I_0)
+ (WHILE (I_+1)
+ <=N DO
+ (TMP_ (CAR (PNth L I)))
+ (GENPERMS (PREV+TMP)
+ (L - TMP)))))
+
+
+% edited: 30-DEC-82 13:26
+(DG HISTO-ADD (H:HISTOGRAM N:INTEGER)
+(IF N>MAX OR N<MIN THEN (ERROR 0 NIL)
+ ELSE TOTAL_+1 (CAR (PNth COUNTS (N - MIN + 1)))
+ _+1)H)
+
+
+% edited: 2-JAN-83 14:14
+(DG HISTO-CREATE (H:HISTOGRAM)
+(RESULT HISTOGRAM)% Initialize a histogram.
+(TOTAL_0)(COUNTS_ (LISTOFC 0 (MAX - MIN + 1)))H)
+
+
+% edited: 2-JAN-83 14:10
+(DG HISTO-PEAKS (H:HISTOGRAM)
+(PROG (THRESH L MX N)
+ (MX_0)
+ (FOR X IN COUNTS (IF X>MX MX_X))
+ (THRESH_MX/2)
+ (N_MIN)
+ (FOR X IN COUNTS DO (IF X>=THRESH L+_N)
+ N_+1)
+ (RETURN (REVERSIP L))))
+
+
+% edited: 28-DEC-82 11:23
+% Produce an identity permutation of length N.
+(DG IDPERM (N:INTEGER)
+(RESULT PERMUTATION)(PROG (L I)
+ (SETQ I 0)
+ (WHILE I<N L+_I I_+1)
+ (RETURN L)))
+
+
+% edited: 28-DEC-82 11:23
+% Make a list of N copies of the constant C.
+(DG LISTOFC (C N:INTEGER)
+(RESULT (LISTOF ATOM))(PROG (I L)
+ (I_0)
+ (WHILE (I_+1)
+ <=N DO L+_C)
+ (RETURN L)))
+
+
+% edited: 28-DEC-82 11:07
+% Log to the base 2 of an integer, rounded up.
+(DG LOG2 (N:INTEGER)
+(RESULT INTEGER)(PROG (I M)
+ (SETQ I 0)
+ (SETQ M 1)
+ (WHILE M<N DO I_+1 M_+M)
+ (RETURN I)))
+
+
+% edited: 28-DEC-82 11:03
+% Compute the permutation to be applied to the output of a boolean
+% function of N inputs to account for negating the Mth input.
+(DG NEGINPPERM (N,M:INTEGER)
+(RESULT PERMUTATION)(PROG (TWON TWOM I L)
+ (SETQ I 0)
+ (TWON_2^N)
+ (TWOM_2^M)
+ (WHILE I<TWON L+_ (IF (LOGAND I TWOM)
+ ~=0 THEN I - TWOM ELSE I+TWOM)
+ I_+1)
+ (RETURN L)))
+
+
+% edited: 28-DEC-82 11:02
+% Create the set of permutations of the set of 2^N outputs
+% corresponding to isomorphisms, i.e., renamings of the N inputs of
+% a boolean function. The identity isomorphism is omitted.
+(DG OUTPERMS (N:INTEGER)
+(RESULT (LISTOF PERMUTATION))(PROG (I TMP RES TWON)
+ (TWON_2^N)
+ (FOR X IN (CDR (ALLPERMS N))
+ DO
+ (I_0)
+ (TMP_NIL)
+ (WHILE I<TWON DO
+ (TMP+_ (DOBITSHUFFLE I X))
+ (I_+1))
+ (RES+_TMP))
+ (RETURN RES)))
+
+
+% edited: 2-SEP-82 10:47
+(DG PERM-INVERSE (P:PERMUTATION)
+(RESULT PERMUTATION)% edited: 2-SEP-82 10:44
+% Compute the inverse of a permutation.
+(PROG (LST N M I J PP TMP)
+ (SETQ I 0)
+ (N_P:LENGTH)
+ (WHILE I<N DO (J _ N - 1)
+ (PP_P)
+ (WHILE PP DO (IF (CAR PP)
+ =I THEN LST+_J PP_NIL ELSE TMP-_PP J_-1
+ (IF ~PP (ERROR 0 NIL))))
+ (I_+1))
+ (RETURN LST)))
+
+ (PUT 'BITSHUFFLE
+ 'GLRESULTTYPE
+ 'INTEGER)
+ (PUT 'DOBITSHUFFLE
+ 'GLRESULTTYPE
+ 'INTEGER)
ADDED psl-1983/3-1/glisp/rawio.red
Index: psl-1983/3-1/glisp/rawio.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/rawio.red
@@ -0,0 +1,278 @@
+
+% RAWIO.RED - Support routines for PSL Emode
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981, 1982 University of Utah
+% Modified and maintained by William F. Galway.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% DEC-20 version
+
+FLUID '(!*rawio); % T if terminal is using "raw" i.o.
+
+CompileTime <<
+load if!-system;
+load syslisp$
+off UserMode; % csp 8/20/82
+
+if_system(Dec20,
+ <<
+ load monsym$
+ load jsys$
+ >>)
+>>;
+
+BothTimes if_system(Dec20, % CompileTime probably suffices.
+<<
+FLUID '( % Global?
+ OldCCOCWords
+ OldTIW
+ OldJFNModeWord
+ );
+
+lisp procedure BITS1 U;
+ if not NumberP U then Error(99, "Non-numeric argument to BITS")
+ else lsh(1, 35 - U);
+
+macro procedure BITS U;
+begin scalar V;
+ V := 0;
+ for each X in cdr U do V := lor(V, BITS1 X);
+ return V;
+end;
+
+>>);
+
+LoadTime if_system(Dec20,
+<<
+OldJfnModeWord := NIL; % Flag "modes not saved yet"
+
+lap '((!*entry PBIN expr 0)
+% Read a single character from the TTY as a Lisp integer
+ (pbin) % Issue PBIN
+ (!*CALL Sys2Int) % Turn it into a number
+
+ (!*exit 0)
+);
+
+lap '((!*entry PBOUT expr 1)
+% write a single charcter to the TTY, works for integers and single char IDs
+% Don't bother with Int2Sys?
+ (pbout)
+ (!*exit 0)
+);
+
+lap '((!*entry CharsInInputBuffer expr 0)
+% Returns the number of characters in the terminal input buffer.
+ (!*MOVE (WConst 8#101) (reg 1)) % The input file (the terminal, =
+ % 8#101)
+ (sibe) % skip if input buffer empty
+ (skipa (reg 1) (reg 2)) % otherwise # chars in r2
+ (setz (reg 1) 0) % if skipped, then zero
+ (!*CALL Sys2Int) % Turn it into a number
+
+ (!*exit 0)
+);
+
+lap '((!*entry RFMOD expr 1)
+% returns the JFN mode word as Lisp integer
+ (hrrzs (reg 1))
+ (rfmod)
+ (!*MOVE (reg 2) (reg 1)) % Get mode word from R2
+ (!*CALL Sys2Int)
+ (!*exit 0)
+);
+
+lap '((!*entry RFCOC expr 1)
+% returns the 2 CCOC words for JFN as dotted pair of Lisp integers
+ (hrrzs (reg 1))
+ (rfcoc)
+ (!*PUSH (reg 2)) % save the first word
+ (!*MOVE (reg 3) (reg 1))
+ (!*CALL Sys2Int) % make second into number
+
+ (exch (reg 1) (indexed (reg st) 0)) % grab first word, save
+ % tagged 2nd word.
+ (!*CALL Sys2Int) % make first into number
+ (!*POP (reg 2))
+ (!*JCALL Cons) % and cons them together
+);
+
+lap '((!*entry RTIW expr 1)
+% Returns terminal interrupt word for specified process, or -5 for entire job,
+% as Lisp integer
+ (hrrzs (reg 1)) % strip tag
+ (rtiw)
+ (!*MOVE (reg 2) (reg 1)) % result in r2, return in r1
+ (!*JCALL Sys2Int) % return as Lisp integer
+);
+
+lisp procedure SaveInitialTerminalModes();
+% Save the terminal modes, if not already saved.
+ if null OldJfnModeWord then
+ << OldJFNModeWord := RFMOD(8#101);
+ OldCCOCWords := RFCOC(8#101);
+ OldTIW := RTIW(-5);
+ >>;
+
+lap '((!*entry SFMOD expr 2)
+% SFMOD(JFN, ModeWord);
+% set program related modes for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (sfmod)
+ (!*exit 0)
+);
+
+lap '((!*entry STPAR expr 2)
+% STPAR(JFN, ModeWord);
+% set device related modes for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (stpar)
+ (!*exit 0)
+);
+
+lap '((!*entry SFCOC expr 3)
+% SFCOC(JFN, CCOCWord1, CCOCWord2);
+% set control character output control for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*PUSH (reg 3))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (exch (reg 1) (indexed (reg st) 0))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 3))
+ (!*POP (reg 2))
+ (!*POP (reg 1))
+ (sfcoc)
+ (!*exit 0)
+);
+
+lap '((!*entry STIW expr 2)
+% STIW(JFN, ModeWord);
+% set terminal interrupt word for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (stiw)
+ (!*exit 0)
+);
+
+lisp procedure EchoOff();
+% A bit of a misnomer, perhaps "on_rawio" would be better.
+% Off echo, On formfeed, send all control characters
+% Allow input of 8-bit characters (meta key)
+if not !*rawio then % Avoid doing anything if already "raw mode"
+<<
+ SaveInitialTerminalModes();
+
+ % Note that 8#101, means "the terminal".
+ % Clear bit 24 to turn echo off,
+ % bits 28,29 turn off "translation"
+ SFMOD(8#101, LAND(OldJFNModeWord, LNOT BITS(24, 28, 29)));
+
+ % Set bit 0 to indicate "has mechanical tab" (so cntrl-L gets
+ % through?).
+ % Clear bit 34 to turn off cntrl-S/cntrl-Q
+ STPAR(8#101, LAND(lor(OldJFNModeWord, BITS 1), LNOT BITS(34)));
+
+ % More nonsense to turn off processing of control characters?
+ SFCOC(8#101,
+ LNOT(8#252525252525),
+ LNOT(8#252525252525));
+
+ % Turn off terminal interrupts for entire job (-5), for everything
+ % except cntrl-C (the bit number three that's one).
+ STIW(-5,8#040000000000);
+
+ !*rawio := T; % Turn on flag
+>>;
+
+lisp procedure EchoOn();
+% Restore initial terminal echoing modes
+<<
+ % Avoid doing anything if OldJFNModeWord is NIL, means terminal mode
+ % already "restored".
+ if OldJFNModeWord then
+ <<
+ SFMOD(8#101,OldJFNModeWord);
+ STPAR(8#101,OldJFNModeWord);
+ SFCOC(8#101,car OldCCOCWords,cdr OldCCOCWords);
+ STIW(-5,OldTIW);
+ >>;
+
+ % Set to NIL so that things get saved again by
+ % SaveInitialTerminalModes. (The terminal status may have been changed
+ % between times.)
+ OldJFNModeWord := NIL;
+ !*rawio := NIL; % Indicate "cooked" i/o.
+>>;
+
+% Flush output buffer for stdoutput. (On theory that we're using buffered
+% I/O to speed things up.)
+Symbolic Procedure FlushStdOutputBuffer();
+NIL; % Just a dummy routine for the 20.
+>>
+);
+% END OF DEC-20 version.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% VAX Unix version
+
+LoadTime if_system(Unix,
+<<
+% EchoOn, EchoOff, and CharsInInputBuffer are part of "kernel".
+
+Symbolic Procedure PBIN();
+% Read a "raw character". NOTE--assumption that 0 gives terminal input.
+ VaxReadChar(0); % Just call this with "raw mode" on.
+
+Symbolic Procedure PBOUT(chr);
+% NOTE ASSUMPTION that 1 gives terminal output.
+ VaxWriteChar(1,chr);
+
+>>);
+% END OF Unix version.
+
+fluid '(!*EMODE);
+
+LoadTime
+<<
+!*EMODE := NIL;
+
+Symbolic Procedure rawio_break();
+% Redefined break handler to turn echoes back on after a break, unless
+% EMODE is running.
+<<
+ if !*rawio and not !*EMODE then
+ EchoOn();
+
+ pre_rawio_break(); % May want to be paranoid and use a "catch(nil,
+ % '(pre_rawio_break)" here.
+>>;
+
+% Carefully redefine the break handler.
+if null getd('pre_rawio_break) then
+<<
+CopyD('pre_rawio_break, 'Break);
+CopyD('break, 'rawio_break);
+>>;
+
+>>;
+
ADDED psl-1983/3-1/glisp/tlg.sl
Index: psl-1983/3-1/glisp/tlg.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/tlg.sl
@@ -0,0 +1,19 @@
+% TLG.SL.3 31 Jan. 83 G. Novak
+% Program to test speed of line graphics by filling a square with lines.
+(de TLG (WINDOW)
+ (PROG (XMIN XMAX DELTA XA XB)
+ (SETQ XMIN 100)
+ (SETQ XMAX 500)
+ (SETQ XA XMIN)
+ (SETQ XB XMAX)
+ (SETQ DELTA 4)
+ LP (COND
+ ((IGREATERP XA XMAX)
+ (RETURN)))
+ (DRAWLINE XA XMIN XB XMAX 1 (QUOTE PAINT)
+ WINDOW)
+ (DRAWLINE XMIN XA XMAX XB 1 (QUOTE PAINT)
+ WINDOW)
+ (SETQ XA (IPLUS XA DELTA))
+ (SETQ XB (IDIFFERENCE XB DELTA))
+ (GO LP)))
ADDED psl-1983/3-1/glisp/vector.old
Index: psl-1983/3-1/glisp/vector.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/vector.old
@@ -0,0 +1,258 @@
+% VECTOR.SL.3 28 Feb 83
+% {DSK}VECTOR.PSL;1 5-FEB-83 15:48:43
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(DEGREES REAL
+PROP ((RADIANS (self* (3.1415926/180.0))
+ RESULT RADIANS)
+ (DISPLAYPROPS (T))))
+
+
+(DOLPHINREGION (LIST (LEFT INTEGER)
+ (BOTTOM INTEGER)
+ (WIDTH INTEGER)
+ (HEIGHT INTEGER))
+PROP ((START (self)
+ RESULT VECTOR)
+ (SIZE ((CDDR self))
+ RESULT VECTOR))
+SUPERS (REGION))
+
+
+(GRAPHICSOBJECT (LIST (SHAPE ATOM)
+ (START VECTOR)
+ (SIZE VECTOR))
+PROP ((LEFT (START:X))
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH))
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2))
+ (AREA (WIDTH*HEIGHT)))
+MSG ((DRAW ((APPLY* (GETPROP SHAPE 'DRAWFN)
+ self
+ 'PAINT)))
+ (ERASE ((APPLY* (GETPROP SHAPE 'DRAWFN)
+ self
+ 'ERASE)))
+ (MOVE GRAPHICSOBJECTMOVE OPEN T)))
+
+
+(RADIANS REAL
+PROP ((DEGREES (self* (180.0/3.1415926))
+ RESULT DEGREES)
+ (DISPLAYPROPS (T))))
+
+
+(REGION (LIST (START VECTOR)
+ (SIZE VECTOR))
+PROP ((LEFT (START:X))
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH))
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2))
+ (TOPCENTER ((A VECTOR WITH X = LEFT+WIDTH/2 Y = TOP)))
+ (BOTTOMCENTER ((A VECTOR WITH X = LEFT+WIDTH/2 Y = BOTTOM)))
+ (AREA (WIDTH*HEIGHT)))
+ADJ ((EMPTY (WIDTH IS ZERO OR HEIGHT IS ZERO))
+ (ZERO (self IS EMPTY)))
+MSG ((CONTAINS? REGION-CONTAINS OPEN T)
+ (SETPOSITION REGION-SETPOSITION OPEN T)
+ (CENTEROFFSET REGION-CENTEROFFSET OPEN T)))
+
+
+(RVECTOR (LIST (X REAL)
+ (Y REAL))
+SUPERS (VECTOR))
+
+
+(SYMMETRY INTEGER
+PROP ((SWAPXY ((LOGAND self 4)
+ <>0))
+ (INVERTY ((LOGAND self 2)
+ <>0))
+ (INVERTX ((LOGAND self 1)
+ <>0))))
+
+
+(VECTOR (LIST (X INTEGER)
+ (Y INTEGER))
+PROP ((MAGNITUDE ((SQRT X^2 + Y^2)))
+ (IMAGNITUDE ((FIX MAGNITUDE + .9999)))
+ (ANGLE ((ARCTAN2 Y X T))
+ RESULT RADIANS)
+ (UNITVECTOR ((A RVECTOR WITH X = X/MAGNITUDE Y= Y/MAGNITUDE))))
+ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)))
+MSG ((+ VECTORPLUS OPEN T)
+ (- VECTORDIFF OPEN T)
+ (* VECTORTIMES OPEN T)
+ (/ VECTORQUOTIENT OPEN T)
+ (> VECTORGREATERP OPEN T)
+ (<= VECTORLEQP OPEN T)
+ (_+ VECTORMOVE OPEN T)
+ (PRIN1 ((PRIN1 "(")
+ (PRIN1 X)
+ (PRIN1 ",")
+ (PRIN1 Y)
+ (PRIN1 ")")))
+ (PRINT ((_ self PRIN1)
+ (TERPRI)))))
+
+)
+
+
+
+% edited: 11-JAN-82 12:40
+(DG DRAWRECT ((A GRAPHICSOBJECT)
+ DSPOP:ATOM)
+(PROG (OLDDS)
+ (OLDDS _ (CURRENTDISPLAYSTREAM DSPS))
+ (DSPOPERATION DSPOP)
+ (MOVETO LEFT BOTTOM)
+ (DRAWTO LEFT TOP)
+ (DRAWTO RIGHT TOP)
+ (DRAWTO RIGHT BOTTOM)
+ (DRAWTO LEFT BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS)))
+
+
+% edited: 11-JAN-82 16:07
+(DG GRAPHICSOBJECTMOVE (self:GRAPHICSOBJECT DELTA:VECTOR)
+(_ self ERASE)(START _+ DELTA)(_ self DRAW))
+
+
+% GSN 30-JAN-83 15:44
+% Transform the starting point of an object as appropriate for the
+% specified symmetry transform.
+(DG NEWSTART (START:VECTOR SIZE:VECTOR SYM:SYMMETRY)
+(PROG (W H TMP)
+ (W_SIZE:X)
+ (H_SIZE:Y)
+ (IF SYM:SWAPXY THEN TMP_W W_H H_TMP)
+ (IF ~SYM:INVERTY THEN H_0)
+ (IF ~SYM:INVERTX THEN W_0)
+ (RETURN (A (TYPEOF START)
+ WITH X = START:X+W Y = START:Y+H))))
+
+
+% GSN 30-JAN-83 15:44
+% Transform a given relative POINT for specified symmetry transform.
+(DG NEWPOINT (START:VECTOR POINT:VECTOR SYM:SYMMETRY)
+(PROG (W H TMP)
+ (W_POINT:X)
+ (H_POINT:Y)
+ (IF SYM:SWAPXY THEN TMP_W W_H H_TMP)
+ (IF ~SYM:INVERTY THEN H _ - H)
+ (IF ~SYM:INVERTX THEN W _ - W)
+ (RETURN (A (TYPEOF POINT)
+ WITH X = START:X+W Y = START:Y+H))))
+
+
+% GSN 2-FEB-83 14:00
+(DG REGION-CENTEROFFSET (R:REGION V:VECTOR)
+(A (TYPEOF V)
+ WITH X = (R:WIDTH - V:X)
+ /2 Y = (R:HEIGHT - V:Y)
+ /2))
+
+
+% edited: 26-OCT-82 11:45
+% Test whether an area contains a point P.
+(DG REGION-CONTAINS (AREA P)
+(P:X>=AREA:LEFT AND P:X<=AREA:RIGHT AND P:Y>=AREA:BOTTOM AND P:Y<=AREA:TOP))
+
+
+% GSN 30-JAN-83 15:45
+(DG REGION-INTERSECT (P:AREA Q:AREA)
+(RESULT (TYPEOF P))
+% Produce an AREA which is the intersection of two given AREAs.
+(PROG (NEWBOTTOM NEWLEFT NEWAREA XSIZE YSIZE)
+ (NEWBOTTOM _ (IMAX P:BOTTOM Q:BOTTOM))
+ (YSIZE _ (IMIN P:TOP Q:TOP)
+ - NEWBOTTOM)
+ (NEWLEFT _ (IMAX P:LEFT Q:LEFT))
+ (XSIZE _ (IMIN P:RIGHT Q:RIGHT)
+ - NEWLEFT)
+ (NEWAREA _ (A (TYPEOF P)))
+ (IF XSIZE>0 AND YSIZE>0 THEN NEWAREA:LEFT_NEWLEFT
+ NEWAREA:BOTTOM_NEWBOTTOM NEWAREA:WIDTH_XSIZE NEWAREA:HEIGHT_YSIZE)
+ (RETURN NEWAREA)))
+
+
+% GSN 14-JAN-83 11:52
+% Change the START point of AREA so that the position APOS relative to
+% the area will have the position NEWPOS.
+(DG REGION-SETPOSITION (AREA APOS:VECTOR NEWPOS:VECTOR)
+(AREA:START _+ NEWPOS - APOS))
+
+
+% GSN 30-JAN-83 15:46
+(DG REGION-UNION (P:AREA Q:AREA)
+(RESULT (TYPEOF P))% Produce an AREA which is the union of two given AREAs.
+(PROG (NEWBOTTOM NEWLEFT XSIZE YSIZE NEWAREA)
+ (NEWBOTTOM _ (IMIN P:BOTTOM Q:BOTTOM))
+ (YSIZE _ (IMAX P:TOP Q:TOP)
+ - NEWBOTTOM)
+ (NEWLEFT _ (IMIN P:LEFT Q:LEFT))
+ (XSIZE _ (IMAX P:RIGHT Q:RIGHT)
+ - NEWLEFT)
+ (NEWAREA _ (A (TYPEOF P)))
+ (NEWAREA:LEFT_NEWLEFT)
+ (NEWAREA:BOTTOM_NEWBOTTOM)
+ (NEWAREA:WIDTH_XSIZE)
+ (NEWAREA:HEIGHT_YSIZE)
+ (RETURN NEWAREA)))
+
+
+% GSN 30-JAN-83 15:36
+(DG VECTORPLUS (V1:VECTOR V2:VECTOR)
+(A (TYPEOF V1)
+ WITH X = V1:X + V2:X Y = V1:Y + V2:Y))
+
+
+% GSN 30-JAN-83 15:47
+(DG VECTORDIFF (V1:VECTOR V2:VECTOR)
+(A (TYPEOF V1)
+ WITH X = V1:X - V2:X Y = V1:Y - V2:Y))
+
+
+% GSN 14-JAN-83 12:33
+% This version of > tests whether one box will fit inside the other.
+(DG VECTORGREATERP (U:VECTOR V:VECTOR)
+(U:X>V:X OR U:Y>V:Y))
+
+
+% GSN 14-JAN-83 12:31
+(DG VECTORLEQP (U:VECTOR V:VECTOR)
+(U:X<=V:X AND U:Y<=V:Y))
+
+
+% GSN 30-JAN-83 15:47
+(DG VECTORTIMES (V:VECTOR N:NUMBER)
+(A (TYPEOF V)
+ WITH X = X*N Y = Y*N))
+
+
+% GSN 30-JAN-83 15:47
+(DG VECTORQUOTIENT (V:VECTOR N:NUMBER)
+(A (TYPEOF V)
+ WITH X = X/N Y = Y/N))
+
+
+% GSN 23-JAN-83 16:28
+(DG VECTORMOVE (V:VECTOR DELTA:VECTOR)
+(V:X _+ DELTA:X)(V:Y _+ DELTA:Y)V)
+
+ (PUT 'RECTANGLE
+ 'DRAWFN
+ 'DRAWRECT)
ADDED psl-1983/3-1/glisp/vector.sl
Index: psl-1983/3-1/glisp/vector.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/vector.sl
@@ -0,0 +1,255 @@
+
+% {DSK}VECTOR.PSL;1 4-MAR-83 16:25:56
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(DEGREES REAL
+PROP ((RADIANS (self* (3.1415926/180.0))
+ RESULT RADIANS)
+ (DISPLAYPROPS (T))))
+
+
+(GRAPHICSOBJECT (LIST (SHAPE ATOM)
+ (START VECTOR)
+ (SIZE VECTOR))
+PROP ((LEFT (START:X))
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH))
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2))
+ (AREA (WIDTH*HEIGHT)))
+MSG ((DRAW ((APPLY* (GETPROP SHAPE 'DRAWFN)
+ self
+ 'PAINT)))
+ (ERASE ((APPLY* (GETPROP SHAPE 'DRAWFN)
+ self
+ 'ERASE)))
+ (MOVE GRAPHICSOBJECTMOVE OPEN T)))
+
+
+(RADIANS REAL
+PROP ((DEGREES (self* (180.0/3.1415926))
+ RESULT DEGREES)
+ (DISPLAYPROPS (T))))
+
+
+(REGION (LIST (START VECTOR)
+ (SIZE VECTOR))
+PROP ((LEFT (START:X))
+ (BOTTOM (START:Y))
+ (RIGHT (LEFT+WIDTH))
+ (TOP (BOTTOM+HEIGHT))
+ (WIDTH (SIZE:X))
+ (HEIGHT (SIZE:Y))
+ (CENTER (START+SIZE/2))
+ (TOPCENTER ((A VECTOR WITH X = LEFT+WIDTH/2 Y = TOP)))
+ (BOTTOMCENTER ((A VECTOR WITH X = LEFT+WIDTH/2 Y = BOTTOM)))
+ (AREA (WIDTH*HEIGHT)))
+ADJ ((EMPTY (WIDTH IS ZERO OR HEIGHT IS ZERO))
+ (ZERO (self IS EMPTY)))
+MSG ((CONTAINS? REGION-CONTAINS OPEN T)
+ (SETPOSITION REGION-SETPOSITION OPEN T)
+ (CENTEROFFSET REGION-CENTEROFFSET OPEN T)))
+
+
+(RVECTOR (LIST (X REAL)
+ (Y REAL))
+SUPERS (VECTOR))
+
+
+(SYMMETRY INTEGER
+PROP ((SWAPXY ((LOGAND self 4)
+ <>0))
+ (INVERTY ((LOGAND self 2)
+ <>0))
+ (INVERTX ((LOGAND self 1)
+ <>0))))
+
+
+(VECTOR (LIST (X INTEGER)
+ (Y INTEGER))
+PROP ((MAGNITUDE ((SQRT X^2 + Y^2)))
+ (IMAGNITUDE ((FIX MAGNITUDE + .9999)))
+ (ANGLE ((ARCTAN2 Y X T))
+ RESULT RADIANS)
+ (UNITVECTOR ((A RVECTOR WITH X = X/MAGNITUDE Y = Y/MAGNITUDE))))
+ADJ ((ZERO (X IS ZERO AND Y IS ZERO))
+ (NORMALIZED (MAGNITUDE = 1.0)))
+MSG ((+ VECTORPLUS OPEN T ARGTYPES (VECTOR))
+ (- VECTORDIFF OPEN T ARGTYPES (VECTOR))
+ (* VECTORTIMES OPEN T ARGTYPES (NUMBER))
+ (* VECTORDOTPRODUCT OPEN T ARGTYPES (VECTOR))
+ (/ VECTORQUOTIENT OPEN T ARGTYPES (NUMBER))
+ (> VECTORGREATERP OPEN T ARGTYPES (VECTOR))
+ (<= VECTORLEQP OPEN T ARGTYPES (VECTOR))
+ (_+ VECTORMOVE OPEN T ARGTYPES (VECTOR))
+ (PRIN1 ((PRIN1 "(")
+ (PRIN1 X)
+ (PRIN1 ",")
+ (PRIN1 Y)
+ (PRIN1 ")")))
+ (PRINT ((_ self PRIN1)
+ (TERPRI)))))
+
+)
+
+
+
+% edited: 11-JAN-82 12:40
+(DG DRAWRECT ((A GRAPHICSOBJECT)
+ DSPOP:ATOM)
+(PROG (OLDDS)
+ (OLDDS _ (CURRENTDISPLAYSTREAM DSPS))
+ (DSPOPERATION DSPOP)
+ (MOVETO LEFT BOTTOM)
+ (DRAWTO LEFT TOP)
+ (DRAWTO RIGHT TOP)
+ (DRAWTO RIGHT BOTTOM)
+ (DRAWTO LEFT BOTTOM)
+ (CURRENTDISPLAYSTREAM OLDDS)))
+
+
+% edited: 11-JAN-82 16:07
+(DG GRAPHICSOBJECTMOVE (self:GRAPHICSOBJECT DELTA:VECTOR)
+(_ self ERASE)(START _+ DELTA)(_ self DRAW))
+
+
+% GSN 30-JAN-83 15:44
+% Transform the starting point of an object as appropriate for the
+% specified symmetry transform.
+(DG NEWSTART (START:VECTOR SIZE:VECTOR SYM:SYMMETRY)
+(PROG (W H TMP)
+ (W_SIZE:X)
+ (H_SIZE:Y)
+ (IF SYM:SWAPXY THEN TMP_W W_H H_TMP)
+ (IF ~SYM:INVERTY THEN H_0)
+ (IF ~SYM:INVERTX THEN W_0)
+ (RETURN (A (TYPEOF START)
+ WITH X = START:X+W Y = START:Y+H))))
+
+
+% GSN 30-JAN-83 15:44
+% Transform a given relative POINT for specified symmetry transform.
+(DG NEWPOINT (START:VECTOR POINT:VECTOR SYM:SYMMETRY)
+(PROG (W H TMP)
+ (W_POINT:X)
+ (H_POINT:Y)
+ (IF SYM:SWAPXY THEN TMP_W W_H H_TMP)
+ (IF ~SYM:INVERTY THEN H _ - H)
+ (IF ~SYM:INVERTX THEN W _ - W)
+ (RETURN (A (TYPEOF POINT)
+ WITH X = START:X+W Y = START:Y+H))))
+
+
+% GSN 2-FEB-83 14:00
+(DG REGION-CENTEROFFSET (R:REGION V:VECTOR)
+(A (TYPEOF V)
+ WITH X = (R:WIDTH - V:X)
+ /2 Y = (R:HEIGHT - V:Y)
+ /2))
+
+
+% edited: 26-OCT-82 11:45
+% Test whether an area contains a point P.
+(DG REGION-CONTAINS (AREA P)
+(P:X>=AREA:LEFT AND P:X<=AREA:RIGHT AND P:Y>=AREA:BOTTOM AND P:Y<=AREA:TOP))
+
+
+% GSN 28-FEB-83 16:03
+(DG REGION-INTERSECT (P:AREA Q:AREA)
+(RESULT (TYPEOF P))
+% Produce an AREA which is the intersection of two given AREAs.
+(PROG (NEWBOTTOM NEWLEFT NEWAREA XSIZE YSIZE)
+ (NEWBOTTOM _ (IMAX P:BOTTOM Q:BOTTOM))
+ (YSIZE _ (IMIN P:TOP Q:TOP)
+ - NEWBOTTOM)
+ (NEWLEFT _ (IMAX P:LEFT Q:LEFT))
+ (XSIZE _ (IMIN P:RIGHT Q:RIGHT)
+ - NEWLEFT)
+ (NEWAREA _ (A (TYPEOF P)))
+ (IF XSIZE>0 AND YSIZE>0 THEN NEWAREA:LEFT_NEWLEFT
+ NEWAREA:BOTTOM_NEWBOTTOM NEWAREA:WIDTH_XSIZE NEWAREA:HEIGHT_YSIZE)
+ (RETURN NEWAREA)))
+
+
+% GSN 14-JAN-83 11:52
+% Change the START point of AREA so that the position APOS relative to
+% the area will have the position NEWPOS.
+(DG REGION-SETPOSITION (AREA APOS:VECTOR NEWPOS:VECTOR)
+(AREA:START _+ NEWPOS - APOS))
+
+
+% GSN 28-FEB-83 16:04
+(DG REGION-UNION (P:AREA Q:AREA)
+(RESULT (TYPEOF P))
+% Produce an AREA which is the union of two given AREAs.
+(PROG (NEWBOTTOM NEWLEFT XSIZE YSIZE NEWAREA)
+ (NEWBOTTOM _ (IMIN P:BOTTOM Q:BOTTOM))
+ (YSIZE _ (IMAX P:TOP Q:TOP)
+ - NEWBOTTOM)
+ (NEWLEFT _ (IMIN P:LEFT Q:LEFT))
+ (XSIZE _ (IMAX P:RIGHT Q:RIGHT)
+ - NEWLEFT)
+ (NEWAREA _ (A (TYPEOF P)))
+ (NEWAREA:LEFT_NEWLEFT)
+ (NEWAREA:BOTTOM_NEWBOTTOM)
+ (NEWAREA:WIDTH_XSIZE)
+ (NEWAREA:HEIGHT_YSIZE)
+ (RETURN NEWAREA)))
+
+
+% GSN 10-FEB-83 13:41
+(DG VECTORPLUS (V1:VECTOR V2:VECTOR)
+(A (TYPEOF V1)
+ WITH X = V1:X + V2:X Y = V1:Y + V2:Y))
+
+
+% GSN 10-FEB-83 13:41
+(DG VECTORDIFF (V1:VECTOR V2:VECTOR)
+(A (TYPEOF V1)
+ WITH X = V1:X - V2:X Y = V1:Y - V2:Y))
+
+
+% GSN 10-FEB-83 13:42
+(DG VECTORDOTPRODUCT (V1:VECTOR V2:VECTOR)
+(A (TYPEOF V1)
+ WITH X = V1:X * V2:X Y = V1:Y * V2:Y))
+
+
+% GSN 14-JAN-83 12:33
+% This version of > tests whether one box will fit inside the other.
+(DG VECTORGREATERP (U:VECTOR V:VECTOR)
+(U:X>V:X OR U:Y>V:Y))
+
+
+% GSN 14-JAN-83 12:31
+(DG VECTORLEQP (U:VECTOR V:VECTOR)
+(U:X<=V:X AND U:Y<=V:Y))
+
+
+% GSN 10-FEB-83 13:41
+(DG VECTORTIMES (V:VECTOR N:NUMBER)
+(A (TYPEOF V)
+ WITH X = X*N Y = Y*N))
+
+
+% GSN 10-FEB-83 13:42
+(DG VECTORQUOTIENT (V:VECTOR N:NUMBER)
+(A (TYPEOF V)
+ WITH X = X/N Y = Y/N))
+
+
+% GSN 10-FEB-83 13:43
+(DG VECTORMOVE (V:VECTOR DELTA:VECTOR)
+(V:X _+ DELTA:X)(V:Y _+ DELTA:Y)V)
+
+ (PUT 'RECTANGLE
+ 'DRAWFN
+ 'DRAWRECT)
ADDED psl-1983/3-1/glisp/window.old
Index: psl-1983/3-1/glisp/window.old
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/window.old
@@ -0,0 +1,73 @@
+% WINDOW.SL 28 Feb 83
+% {DSK}WINDOW.PSL;1 5-FEB-83 15:51:00
+
+
+
+
+
+% GSN 2-FEB-83 13:57
+(DG WINDOW-CENTEROFFSET (W:WINDOW V:VECTOR)
+(SEND W:REGION CENTEROFFSET V))
+
+
+% GSN 13-JAN-83 16:28
+(DG WINDOW-DRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+(DRAWLINE FROM:X FROM:Y TO:X TO:Y 1 'PAINT
+ W))
+
+
+% GSN 13-JAN-83 15:29
+(DG WINDOW-MOVETO (W:WINDOW POS:VECTOR)
+(MOVETO POS:X POS:Y W))
+
+
+% GSN 13-JAN-83 16:25
+(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:VECTOR)
+(PROG (LASTWOP)
+ (SEND W MOVETO POS)
+ (SETQ LASTWOP (DSPOPERATION 'PAINT
+ W))
+ (PRIN1 S W)
+ (DSPOPERATION LASTWOP W)))
+
+
+% GSN 13-JAN-83 16:28
+(DG WINDOW-UNDRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+(DRAWLINE FROM:X FROM:Y TO:X TO:Y 1 'ERASE
+ W))
+
+
+% GSN 13-JAN-83 16:24
+(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
+(PROG (LASTWOP)
+ (SEND W MOVETO POS)
+ (SETQ LASTWOP (DSPOPERATION 'ERASE
+ W))
+ (PRIN1 S W)
+ (DSPOPERATION LASTWOP W)))
+
+
+(GLISPOBJECTS
+
+
+(WINDOW ANYTHING
+PROP ((REGION ((DSPCLIPPINGREGION NIL self))
+ RESULT DOLPHINREGION)
+ (XPOSITION ((DSPXPOSITION NIL self))
+ RESULT INTEGER)
+ (YPOSITION ((DSPYPOSITION NIL self))
+ RESULT INTEGER)
+ (HEIGHT (REGION:HEIGHT))
+ (WIDTH (REGION:WIDTH))
+ (LEFT ((DSPXOFFSET NIL self))
+ RESULT INTEGER)
+ (BOTTOM ((DSPYOFFSET NIL self))
+ RESULT INTEGER)
+ (START (REGION:START))
+ (SIZE (REGION:SIZE)))
+MSG ((CLEAR CLEARW)
+ (OPEN OPENW)
+ (CLOSE CLOSEW)))
+
+)
+
ADDED psl-1983/3-1/glisp/window.sl
Index: psl-1983/3-1/glisp/window.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/window.sl
@@ -0,0 +1,244 @@
+% WINDOW.SL.10 28 March 83
+
+% derived from {DSK}WINDOW.PSL;1 4-MAR-83 16:25:00
+
+
+
+
+(glispconstants
+
+(screenxoffset -255 integer)
+(screenyoffset -255 integer)
+(screenxscale 256.0 real)
+(screenyscale 256.0 real)
+)
+
+
+
+(GLISPOBJECTS
+
+
+(MENU (listobject (ITEMS (LISTOF ATOM))
+ (window window))
+MSG ((SELECT MENU-select RESULT ATOM)))
+
+
+(MOUSE ANYTHING)
+
+(grpos integer
+prop ((screenvalue ((self + screenxoffset) / screenxscale ))))
+
+(grvector (list (x grpos) (y grpos))
+ supers (vector))
+
+(WINDOW (listobject (start grvector)
+ (size grvector)
+ (title string)
+ (lastfilledline integer)
+ (lastposition grvector))
+
+PROP ((leftmargin (left + 1))
+ (rightmargin (right - 2)))
+
+MSG ((CLEAR window-clear)
+ (OPEN window-open)
+ (CLOSE window-close)
+ (movetoxy window-movetoxy OPEN T)
+ (INVERTAREA WINDOW-INVERTAREA)
+ (MOVETO WINDOW-MOVETO OPEN T)
+ (PRINTAT WINDOW-PRINTAT OPEN T)
+ (printatxy window-printatxy)
+ (PRETTYPRINTAT WINDOW-PRETTYPRINTAT)
+ (UNPRINTAT WINDOW-UNPRINTAT OPEN T)
+ (unprintatxy window-unprintatxy)
+ (DRAWLINE WINDOW-DRAWLINE OPEN T)
+ (drawlinexy window-drawlinexy OPEN T)
+ (UNDRAWLINE WINDOW-UNDRAWLINE OPEN T)
+ (undrawlinexy window-undrawlinexy OPEN T)
+ (CENTEROFFSET WINDOW-CENTEROFFSET))
+supers (region) )
+
+)
+
+
+
+(GLISPGLOBALS
+(MOUSE MOUSE)
+)
+
+(glispconstants
+(windowcharwidth 8 integer)
+(windowlineyspacing 20 integer)
+)
+
+
+(setq mouse 'mouse)
+(setq gevmenuwindow nil)
+(setq menustart (a vector with x = 320 y = 0))
+
+% Initialize graphics routines.
+(dg window-init (w:window)
+ (prog ()
+ (graphics-init)
+ (color-display)
+ (set-color white)
+ (set-line-style solid)
+ (set-char-size (quotient 7.0 screenxscale) (quotient 16.0 screenyscale))
+))
+
+% Done with graphics
+(dg window-term (w:window)
+ (prog ()
+ (graphics-term)))
+
+
+% Alias graphics function names without underline characters
+(de graphics-init () (graphics_init))
+(de graphics-term () (graphics_term))
+(de display-init (unit mode) (display_init unit mode))
+(de set-color (x) (set_color x))
+(de set-line-style (x) (set_line_style x))
+(de clear-display () (clear_display))
+(de set-char-size (w h) (set_char_size w h))
+(de set-text-rot (x y) (set_text_rot x y))
+(de set-display-lim (x0 x1 y0 y1) (set_display_lim x0 x1 y0 y1))
+(de set-viewport (x0 x1 y0 y1) (set_viewport x0 x1 y0 y1))
+(de init-9111 () (init_9111))
+(de sample-locator () (sample_locator))
+(de await-locator () (await_locator))
+(de color-display () (color_display))
+
+
+% Clear a graphics window.
+(dg window-clear (w:window)
+)
+
+% Open a graphics window.
+(dg window-open (w:window)
+(send w drawlinexy w:left w:bottom w:left w:top)
+(send w drawlinexy w:left w:top w:right w:top)
+(send w drawlinexy w:right w:top w:right w:bottom)
+(send w drawlinexy w:right w:bottom w:left w:bottom)
+)
+
+% Open a graphics window.
+(dg window-close (w:window)
+(send w undrawlinexy w:left w:bottom w:left w:top)
+(send w undrawlinexy w:left w:top w:right w:top)
+(send w undrawlinexy w:right w:top w:right w:bottom)
+(send w undrawlinexy w:right w:bottom w:left w:bottom)
+)
+
+% GSN 2-MAR-83 16:19
+(DG MOUSE-POSITIONIN (M:MOUSE W:WINDOW)
+(GETMOUSESTATE)(A VECTOR WITH X = (LASTMOUSEX W)
+ Y = (LASTMOUSEY W)))
+
+
+% GSN 2-MAR-83 16:19
+(DG MOUSE-TESTBUTTON (M:MOUSE BUTTON:INTEGER)
+(GETMOUSESTATE)(NOT (ZEROP (LOGAND LASTMOUSEBUTTONS BUTTON))))
+
+
+% GSN 2-FEB-83 13:57
+(DG WINDOW-CENTEROFFSET (W:WINDOW V:VECTOR)
+(SEND W:REGION CENTEROFFSET V))
+
+
+% GSN 28-FEB-83 16:10
+(DG WINDOW-DRAWLINE (W:WINDOW FROM:grVECTOR TO:grVECTOR)
+ (send w drawlinexy from:x from:y to:x to:y))
+
+(DG WINDOW-DRAWLINExy (W:WINDOW fromx:grpos fromy:grpos tox:grpos toy:grpos)
+ (gdraw white solid fromx:screenvalue fromy:screenvalue
+ tox:screenvalue toy:screenvalue))
+
+% GSN 28-FEB-83 16:58
+(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
+ nil)
+
+
+% GSN 13-JAN-83 15:29
+(DG WINDOW-MOVETO (W:WINDOW POS:grVECTOR)
+ (send w movetoxy pos:x pos:y))
+
+% Move to position specified as separate x and y coordinates.
+(dg window-movetoxy (w:window x:grpos y:grpos)
+ (gmove x:screenvalue y:screenvalue))
+
+% GSN 2-MAR-83 13:58
+(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:grVECTOR)
+ (set-color white)
+ (send w moveto pos)
+ (w:lastposition _ position)
+ (gtext value))
+
+
+% GSN 13-JAN-83 16:25
+(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:grVECTOR)
+ (set-color white)
+ (send w moveto pos)
+ (gtext s))
+
+(DG WINDOW-PRINTATxy (W:WINDOW S:STRING x:grpos y:grpos)
+ (set-color white)
+ (send w movetoxy x y)
+ (gtext s))
+
+
+% GSN 28-FEB-83 16:11
+(DG WINDOW-UNDRAWLINE (W:WINDOW FROM:VECTOR TO:grVECTOR)
+ (send w undrawlinexy from:x from:y to:x to:y))
+
+(DG WINDOW-unDRAWLINExy (W:WINDOW fromx:grpos fromy:grpos tox:grpos toy:grpos)
+ (gdraw background solid fromx:screenvalue fromy:screenvalue
+ tox:screenvalue toy:screenvalue))
+
+
+% GSN 13-JAN-83 16:24
+(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:grVECTOR)
+ (set-color background)
+ (send w moveto pos)
+ (gtext s))
+
+(DG WINDOW-UNPRINTATxy (W:WINDOW S:STRING x:grpos y:grpos)
+ (set-color background)
+ (send w movetoxy x y)
+ (gtext s))
+
+% Present a pop-up menu and select an item from it. GSN 14 March 83
+(dg menu-select (m:menu)
+(prog (maxw i n saveglq result)
+ (if ~gevactiveflg then (geventer))
+ (saveglq _ glquietflg)
+ (glquiteflg _ t)
+ (maxw _ 0)
+ (for x in m:items do (maxw _ (max maxw x:pname:length)))
+ (maxw _ (min maxw 20))
+ (m:window _ (a window with start = menustart
+ size = (a vector with x = (maxw + 5)* windowcharwidth
+ y = (min (length m:items) 19) * windowlineyspacing)
+ title = "Menu"))
+ (send m:window open)
+ (I _ 0)
+ (for x in m:items do
+ (i _+ 1)
+ (send m:window printatxy (concat (gevstringify i)
+ (concat (if i<10 then " " else " ")
+ (gevstringify x)))
+ 1 (m:window:height - i * windowlineyspacing) ))
+lp
+ (prin2 "Menu:")
+ (n _ (read))
+ (if n is integer and n > 0 and n <= (length m:items)
+ then (result _ (car (PNth m:items n))) (go out)
+ elseif n = 'q then (result _ nil) (go out)
+ else (prin1 n)
+ (prin2 " ?")
+ (terpri)
+ (go lp) )
+out
+ (setq glquietflg saveglq)
+ (if ~gevactiveflg then (gevexit))
+ (return result)
+))
ADDED psl-1983/3-1/glisp/window20.sl
Index: psl-1983/3-1/glisp/window20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/window20.sl
@@ -0,0 +1,206 @@
+
+% {DSK}WINDOW.PSL;1 4-MAR-83 16:25:00
+
+
+
+
+
+(GLISPOBJECTS
+
+
+(MENU (listobject (ITEMS (LISTOF ATOM))
+ (window window))
+MSG ((SELECT MENU-select RESULT ATOM)))
+
+
+(MOUSE ANYTHING)
+
+
+(WINDOW (listobject (start vector)
+ (size vector)
+ (title string)
+ (lastfilledline integer))
+
+PROP ((leftmargin (left + 1))
+ (rightmargin (right - 2)))
+
+MSG ((CLEAR window-clear)
+ (OPEN window-open)
+ (CLOSE window-close)
+ (movetoxy window-movetoxy)
+ (invertvideo ((pbout escapechar)(pbout (char !p))))
+ (normalvideo ((pbout escapechar)(pbout (char !q))))
+ (graphicsmode (nil))
+ (normalmode (nil))
+ (eraseeol ((pbout escapechar)(pbout (char K))))
+ (INVERTAREA WINDOW-INVERTAREA)
+ (MOVETO WINDOW-MOVETO)
+ (PRINTAT WINDOW-PRINTAT)
+ (printatxy window-printatxy)
+ (PRETTYPRINTAT WINDOW-PRETTYPRINTAT)
+ (UNPRINTAT WINDOW-UNPRINTAT)
+ (unprintatxy window-unprintatxy)
+ (DRAWLINE WINDOW-DRAWLINE)
+ (drawlinexy window-drawlinexy)
+ (UNDRAWLINE WINDOW-UNDRAWLINE)
+ (undrawlinexy window-undrawlinexy)
+ (CENTEROFFSET WINDOW-CENTEROFFSET))
+supers (region) )
+
+)
+
+
+
+(GLISPGLOBALS
+(MOUSE MOUSE)
+)
+
+(glispconstants
+(windowcharwidth 8 integer)
+(windowlineyspacing 12 integer)
+(verticalbarchar 73 integer)
+(horizontalbarchar 33 integer)
+(escapechar 27 integer)
+(blankchar 32 integer)
+)
+
+% Initialize graphics routines.
+(dg window-init (w:window)
+)
+
+% Done with graphics
+(dg window-term (w:window)
+)
+
+
+
+% Open a graphics window.
+(dg window-open (w:window)
+(prog (ttl nbl)
+ (send w movetoxy w:left + 1 w:top)
+ (ttl _ w:title or " ")
+ (l _ ttl:length)
+ (send w invertvideo)
+ (if ttl:length > w:width - 2
+ then (ttl _ (substring ttl 1 w:width - 2)))
+ (nbl _ (w:width - ttl:length)/2 - 1)
+ (printnc nbl blankchar)
+ (prin2 ttl)
+ (printnc (w:width - ttl:length - nbl - 2) blankchar)
+ (send w normalvideo)
+ (terpri)
+ (w:lastfilledline _ w:bottom + 1)
+ (send w movetoxy w:left w:top)
+ (pbout verticalbarchar)
+ (send w movetoxy w:right - 1 w:top)
+ (pbout verticalbarchar)
+ (send w movetoxy w:left w:bottom)
+ (pbout verticalbarchar)
+ (printnc w:width - 2 horizontalbarchar)
+ (pbout verticalbarchar)
+ (terpri)
+ (send w clear)
+ (send w movetoxy 0 2))
+)
+
+% Close a graphics window.
+(dg window-close (w:window)
+
+)
+
+
+% GSN 2-FEB-83 13:57
+(DG WINDOW-CENTEROFFSET (W:WINDOW V:VECTOR)
+(SEND W:REGION CENTEROFFSET V))
+
+
+% GSN 28-FEB-83 16:10
+(DG WINDOW-DRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+ (if from:y=to:y then (send w moveto from)
+ (printnc (to:x - from:x + 1) horizontalbarchar)))
+
+
+% GSN 28-FEB-83 16:58
+(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
+ nil)
+
+
+% GSN 13-JAN-83 15:29
+(DG WINDOW-MOVETO (W:WINDOW POS:VECTOR)
+ (send w movetoxy pos:x pos:y))
+
+% Move to position specified as separate x and y coordinates.
+(dg window-movetoxy (w:window x:integer y:integer)
+ (if x < 0 then (x _ 0) elseif x > 79 then (x _ 79))
+ (if y < 0 then (y _ 0) elseif Y > 23 then (y _ 23))
+ (pbout escapechar)
+ (pbout (char Y))
+ (pbout (55 - y))
+ (pbout (32 + x)))
+
+% GSN 2-MAR-83 13:58
+(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:VECTOR)
+ (send w printat value position))
+
+
+% GSN 13-JAN-83 16:25
+(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:VECTOR)
+ (send w moveto pos)
+ (prin2 s))
+
+
+% GSN 28-FEB-83 16:10
+(DG WINDOW-unDRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+ (if from:y=to:y then (send w moveto from)
+ (printnc (to:x - from:x + 1) blankchar)))
+
+% GSN 13-JAN-83 16:24
+(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
+ (send w moveto pos)
+ (printnc s:length " "))
+
+% Present a pop-up menu and select an item from it. GSN 14 March 83
+(dg menu-select (m:menu)
+(prog (maxw i n)
+ (maxw _ 0)
+ (for x in m:items do (maxw _ (max maxw x:pname:length)))
+ (maxw _ (min maxw 20))
+ (m:window _ (a window with start = menustart
+ size = (a vector with x = (maxw + 5)* windowcharwidth
+ y = (min (length n:items) 19) * windowlineyspacing)
+ title = "Menu"))
+ (send m:window open)
+ (I _ 0)
+ (for x in m:items do
+ (i _+ 1)
+ (send m:window printatxy (concat (gevstringify i)
+ (if i<10 then " " else " ")
+ (gevstringify x))))
+ (send m:window movetoxy 0 2)
+ (send m:window eraseeol)
+lp
+ (send m:window movetoxy 0 2)
+ (prin2 "Menu:")
+ (n _ (read))
+ (if n is integer and n > 0 and n <= (length m:items)
+ then (return (nth m:items n))
+ else (prin1 n)
+ (prin2 " ?")
+ (send m:window eraseeol)
+ (go lp) )))
+
+% Print the same character n times.
+(dg printnc (n:integer c:integer)
+ (while n > 0 do (n _- 1) (prin2 c)))
+
+(dg window-clear (w:window)
+ (prog (y)
+ (y _ w:top - 1)
+ (while y >= w:lastfilledline do
+ (send w movetoxy w:left y)
+ (prin2 verticalbarchar)
+ (send w eraseeol)
+ (send w movetoxy w:right - 1 y)
+ (prin2 verticalbarchar)
+ (y _- 1))
+))
ADDED psl-1983/3-1/glisp/windowcrt.sl
Index: psl-1983/3-1/glisp/windowcrt.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/windowcrt.sl
@@ -0,0 +1,256 @@
+% WINDOWCRT.SL.11 07 April 83
+% derived from <NOVAK>WINDOWCRT.PSL.1 20-Mar-83 12:40:45
+
+% Written by Gordon Novak Jr.
+% Copyright (c) 1983 Hewlett-Packard
+
+
+
+(GLOBAL '(MENUSTART))
+
+(GLISPOBJECTS
+
+
+(MENU (LISTOBJECT (ITEMS (LISTOF ATOM))
+ (WINDOW WINDOW))
+MSG ((SELECT MENU-SELECT RESULT ATOM)))
+
+
+(MOUSE ANYTHING)
+
+
+(WINDOW (LISTOBJECT (START VECTOR)
+ (SIZE VECTOR)
+ (TITLE STRING)
+ (LASTFILLEDLINE INTEGER))
+PROP ((YPOSITION (LASTFILLEDLINE))
+ (LEFTMARGIN (1))
+ (RIGHTMARGIN (WIDTH - 2)))
+MSG ((CLEAR WINDOW-CLEAR)
+ (OPEN WINDOW-OPEN)
+ (CLOSE WINDOW-CLOSE)
+ (INVERTAREA WINDOW-INVERTAREA OPEN T)
+ (MOVETOXY WINDOW-MOVETOXY OPEN T)
+ (MOVETO WINDOW-MOVETO OPEN T)
+ (PRINTAT WINDOW-PRINTAT OPEN T)
+ (PRETTYPRINTAT WINDOW-PRETTYPRINTAT OPEN T)
+ (UNPRINTAT WINDOW-UNPRINTAT OPEN T)
+ (DRAWLINE WINDOW-DRAWLINE OPEN T)
+ (UNDRAWLINE WINDOW-UNDRAWLINE OPEN T)
+ (CENTEROFFSET WINDOW-CENTEROFFSET OPEN T))
+SUPERS (REGION))
+
+)
+
+
+
+(GLISPGLOBALS
+(MOUSE MOUSE)
+
+)
+
+
+
+(GLISPCONSTANTS
+(WINDOWCHARWIDTH 1 INTEGER)
+(WINDOWLINEYSPACING 1 INTEGER)
+)
+
+(SETQ MOUSE 'MOUSE)
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ MENUSTART (A VECTOR WITH X = 50 Y = 3))
+
+
+
+
+
+% edited: 16-Mar-83 15:04
+% Select an item from a pop-up menu.
+(DG MENU-SELECT (M:MENU)
+(PROG (MAXW I N SAVEESC SAVEGLQ SAVEGCG RESULT)
+ (if ~gevactiveflg then (geventer))
+ (SAVEGLQ _ GLQUIETFLG)
+ (GLQUIETFLG _ T)
+
+ (MAXW_0)
+ (FOR X IN M:ITEMS DO (MAXW_ (MAX MAXW X:PNAME:LENGTH)))
+ (IF MAXW > 20 THEN (MAXW _ 20))
+ (M:WINDOW _ (A WINDOW WITH START = MENUSTART SIZE =
+ (A VECTOR WITH X = (MAXW + 5)
+ *WINDOWCHARWIDTH Y = (MIN (LENGTH M:ITEMS)
+ + 1 19)
+ *WINDOWLINEYSPACING)
+ TITLE = "Menu"))
+ (SEND M:WINDOW OPEN)
+ (I_0)
+ (FOR X IN M:ITEMS DO (I _+ 1)
+ (SEND M:WINDOW PRINTAT (CONCAT (GEVSTRINGIFY I)
+ (concat (IF I<10 THEN " " ELSE " ")
+ (gevstringify X)))
+ (A VECTOR WITH X = 1 Y = M:WINDOW:HEIGHT - I)))
+ (SEND M:WINDOW MOVETOXY 0 -1)
+ (SEND TERMINAL ERASEEOL)
+ LP
+ (SEND M:WINDOW MOVETOXY 0 -1)
+ (SEND TERMINAL PRINTSTRING "Menu: ")
+ (SEND TERMINAL ERASEEOL)
+ (echoon)
+ (N _ (READ))
+ (echooff)
+ (IF N IS INTEGER AND N>0 AND N<= (LENGTH M:ITEMS)
+ THEN
+ (RESULT _ (CAR (PNth M:ITEMS N)))
+ (GO OUT)
+ ELSEIF N = 'Q
+ THEN
+ (RESULT _ NIL)
+ (GO OUT)
+ ELSE
+ (PRIN1 N)
+ (SPACES 1)
+ (SEND TERMINAL PRINTSTRING "?")
+ (SEND TERMINAL ERASEEOL)
+ (GO LP))
+ OUT
+ (SEND M:WINDOW CLOSE)
+ (SEND M:WINDOW MOVETOXY 0 -1)
+ (TERPRI)
+ (SEND TERMINAL ERASEEOL)
+
+ (SETQ GLQUIETFLG SAVEGLQ)
+ (if ~gevactiveflg then (gevexit))
+ (RETURN RESULT)))
+
+
+% edited: 11-Mar-83 22:42
+% Print a character N times.
+(DG PRINTNC (N:INTEGER C:STRING)
+(WHILE N > 0 DO (N _- 1)
+ (SEND TERMINAL PRINTCHAR C)))
+
+
+% edited: 16-Mar-83 14:02
+% Open a window in a H-19 terminal.
+(DG WINDOW-CLEAR (W:WINDOW)
+(PROG (TTL NBL Y NLINES)
+ (NLINES_0)
+ (SEND TERMINAL GRAPHICSMODE)
+ (Y _ W:HEIGHT - 1)
+ (WHILE Y >= W:LASTFILLEDLINE DO (SEND W MOVETOXY 0 Y)
+ (SEND TERMINAL PRINTCHAR LVERTICALBARCHAR)
+ (IF Y<W:TOP THEN (SEND TERMINAL ERASEEOL))
+ (SEND W MOVETOXY W:WIDTH - 1 Y)
+ (SEND TERMINAL PRINTCHAR RVERTICALBARCHAR)
+ (IF (NLINES _+ 1)
+ >3 THEN (TERPRI)
+ (NLINES_0))
+ (Y_-1))
+ (SEND TERMINAL NORMALMODE)
+ (SEND W MOVETOXY 0 -1)
+ (TERPRI)
+ (W:LASTFILLEDLINE _ W:HEIGHT)
+ (SEND W MOVETOXY 0 -1)))
+
+
+(DG WINDOW-CLOSE (W:WINDOW)
+(PROG (Y NLINES)
+ (Y _ W:HEIGHT)
+ (NLINES _ 0)
+ (WHILE Y >= 0 DO (SEND W MOVETOXY 0 Y)
+ (SEND TERMINAL ERASEEOL)
+ (IF (NLINES _+ 1)
+ > 8 THEN (TERPRI)
+ (NLINES _ 0))
+ (Y _- 1))
+ (TERPRI)))
+
+
+% edited: 12-Mar-83 15:22
+(DG WINDOW-DRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+(IF FROM:Y=TO:Y THEN (SEND W MOVETO FROM)
+ (PRINTNC (TO:X - FROM:X + 1)
+ HORIZONTALLINECHAR)
+ (IF FROM:Y < W:LASTFILLEDLINE THEN (W:LASTFILLEDLINE _ FROM:Y))))
+
+
+% edited: 12-Mar-83 15:17
+(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
+NIL)
+
+
+% edited: 12-Mar-83 15:18
+(DG WINDOW-MOVETO (W:WINDOW POS:VECTOR)
+(SEND W MOVETOXY POS:X POS:Y))
+
+
+% edited: 19-Mar-83 20:25
+% Move cursor to X-Y position relative to window.
+(DG WINDOW-MOVETOXY (W:WINDOW X:INTEGER Y:INTEGER)
+(SEND TERMINAL MOVETOXY X+W:LEFT Y+W:BOTTOM))
+
+
+% edited: 19-Mar-83 20:39
+% Open a window on a H-19 terminal.
+(DG WINDOW-OPEN (W:WINDOW)
+(PROG (TTL NBL L)
+ (SEND W MOVETOXY 1 W:HEIGHT)
+ (TTL _ W:TITLE OR " ")
+ (L_TTL:LENGTH)
+ (SEND TERMINAL INVERTVIDEO)
+ (IF TTL:LENGTH > W:WIDTH - 2 THEN
+ (TTL _ (SUBSTRING TTL 1 W:WIDTH - 2)))
+ (NBL _ (W:WIDTH - TTL:LENGTH)
+ /2 - 1)
+ (PRINTNC NBL BLANKCHAR)
+ (SEND TERMINAL PRINTSTRING TTL)
+ (PRINTNC (W:WIDTH - TTL:LENGTH - NBL - 2)
+ BLANKCHAR)
+ (SEND TERMINAL NORMALVIDEO)
+ (TERPRI)
+ (SEND TERMINAL GRAPHICSMODE)
+ (W:LASTFILLEDLINE _ 1)
+ (SEND W MOVETOXY 0 W:HEIGHT)
+ (SEND TERMINAL PRINTCHAR LVERTICALBARCHAR)
+ (SEND W MOVETOXY W:WIDTH - 1 W:HEIGHT)
+ (SEND TERMINAL PRINTCHAR RVERTICALBARCHAR)
+ (SEND W MOVETOXY 0 0)
+ (SEND TERMINAL PRINTCHAR LVERTICALBARCHAR)
+ (PRINTNC W:WIDTH - 2 HORIZONTALBARCHAR)
+ (SEND TERMINAL PRINTCHAR RVERTICALBARCHAR)
+ (send terminal eraseeol)
+ (SEND TERMINAL NORMALMODE)
+ (TERPRI)
+ (SEND W CLEAR)
+ (SEND W MOVETOXY 0 -1)))
+
+
+% edited: 12-Mar-83 17:03
+(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:VECTOR)
+(SEND W MOVETO POSITION)(RESETLST (RESETSAVE SYSPRETTYFLG T)
+ (RESETSAVE TTYLINELENGTH
+ (W:WIDTH - POSITION:X - 1))
+ (SHOWPRINT VALUE)
+ (W:LASTFILLEDLINE _ 1)))
+
+
+% edited: 16-Mar-83 14:18
+(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:VECTOR)
+(IF POS:Y > 0 THEN (SEND W MOVETO POS)
+ (SEND TERMINAL PRINTSTRING S)
+ (TERPRI)
+ (IF POS:Y < W:LASTFILLEDLINE THEN (W:LASTFILLEDLINE _ POS:Y))))
+
+
+% edited: 12-Mar-83 15:23
+(DG WINDOW-UNDRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+(IF FROM:Y=TO:Y THEN (SEND W MOVETO FROM)
+ (PRINTNC (TO:X - FROM:X + 1)
+ BLANKCHAR)))
+
+
+% edited: 16-Mar-83 14:19
+(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
+(IF POS:Y > 0 THEN (SEND W MOVETO POS)
+ (PRINTNC S:LENGTH BLANKCHAR)))
ADDED psl-1983/3-1/glisp/windowhrd.sl
Index: psl-1983/3-1/glisp/windowhrd.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/glisp/windowhrd.sl
@@ -0,0 +1,198 @@
+% WINDOWHRD.SL.7 07 April 83
+% Window package for Methius display on HP 9836
+% derived from <NOVAK>WINDOWCRT.PSL.1 20-Mar-83 12:40:45
+
+
+
+(GLOBAL '(MENUSTART))
+
+(GLISPOBJECTS
+
+
+(MENU (LISTOBJECT (ITEMS (LISTOF ATOM))
+ (WINDOW WINDOW))
+MSG ((SELECT MENU-SELECT RESULT ATOM)))
+
+
+(MOUSE ANYTHING)
+
+
+(WINDOW (LISTOBJECT (START VECTOR)
+ (SIZE VECTOR)
+ (TITLE STRING)
+ (LASTFILLEDLINE INTEGER))
+PROP ((YPOSITION (LASTFILLEDLINE))
+ (LEFTMARGIN (1))
+ (RIGHTMARGIN (WIDTH - 2)))
+MSG ((CLEAR WINDOW-CLEAR)
+ (OPEN WINDOW-OPEN)
+ (CLOSE WINDOW-CLOSE)
+ (INVERTAREA WINDOW-INVERTAREA OPEN T)
+ (MOVETOXY WINDOW-MOVETOXY OPEN T)
+ (MOVETO WINDOW-MOVETO OPEN T)
+ (PRINTAT WINDOW-PRINTAT OPEN T)
+ (PRETTYPRINTAT WINDOW-PRETTYPRINTAT OPEN T)
+ (UNPRINTAT WINDOW-UNPRINTAT OPEN T)
+ (DRAWLINE WINDOW-DRAWLINE OPEN T)
+ (UNDRAWLINE WINDOW-UNDRAWLINE OPEN T)
+ (PRINTCHAR WINDOW-PRINTCHAR OPEN T)
+ (PRINTSTRING WINDOW-PRINTSTRING)
+ (PRINTNC WINDOW-PRINTNC)
+ (CENTEROFFSET WINDOW-CENTEROFFSET OPEN T))
+SUPERS (REGION))
+
+)
+
+
+
+(GLISPGLOBALS
+(MOUSE MOUSE)
+
+)
+
+
+
+(GLISPCONSTANTS
+(WINDOWCHARWIDTH 8 INTEGER)
+(WINDOWLINEYSPACING 16 INTEGER)
+)
+
+(SETQ MOUSE 'MOUSE)
+
+(SETQ GEVMENUWINDOW NIL)
+
+(SETQ MENUSTART (A VECTOR WITH X = 500 Y = 1))
+
+
+
+
+
+% edited: 16-Mar-83 15:04
+% Select an item from a pop-up menu.
+(DG MENU-SELECT (M:MENU)
+(PROG (MAXW I N SAVEESC SAVEGLQ SAVEGCG RESULT)
+ (if ~gevactiveflg then (geventer))
+ (SAVEGLQ _ GLQUIETFLG)
+ (GLQUIETFLG _ T)
+
+ (MAXW_0)
+ (FOR X IN M:ITEMS DO (MAXW_ (MAX MAXW X:PNAME:LENGTH)))
+ (IF MAXW > 20 THEN (MAXW _ 20))
+ (M:WINDOW _ (A WINDOW WITH START = MENUSTART SIZE =
+ (A VECTOR WITH X = (MAXW + 5)
+ *WINDOWCHARWIDTH Y = (MIN (LENGTH M:ITEMS)
+ + 1 19)
+ *WINDOWLINEYSPACING)
+ TITLE = "Menu"))
+ (SEND M:WINDOW OPEN)
+ (I_0)
+ (FOR X IN M:ITEMS DO (I _+ 1)
+ (SEND M:WINDOW PRINTAT (CONCAT (GEVSTRINGIFY I)
+ (concat (IF I<10 THEN " " ELSE " ")
+ (gevstringify X)))
+ (A VECTOR WITH X = 1 Y = M:WINDOW:HEIGHT
+ - I * windowlineyspacing)))
+ LP
+ (PRIN1 "Menu: ")
+ (N _ (READ))
+ (IF N IS INTEGER AND N>0 AND N<= (LENGTH M:ITEMS)
+ THEN
+ (RESULT _ (CAR (PNth M:ITEMS N)))
+ (GO OUT)
+ ELSEIF N = 'Q
+ THEN
+ (RESULT _ NIL)
+ (GO OUT)
+ ELSE
+ (PRIN1 N)
+ (SPACES 1)
+ (PRINC "?")
+ (terpri)
+ (GO LP))
+ OUT
+ (SEND M:WINDOW CLOSE)
+ (TERPRI)
+ (SETQ GLQUIETFLG SAVEGLQ)
+ (if ~gevactiveflg then (gevexit))
+ (RETURN RESULT)))
+
+
+% edited: 16-Mar-83 14:02
+% Open a window in a H-19 terminal.
+(DG WINDOW-CLEAR (W:WINDOW)
+(PROG ()
+ (M-ERASE W:LEFT W:BOTTOM W:RIGHT W:TOP)
+ (M-RECT-OUTLINE W:LEFT W:BOTTOM W:RIGHT W:TOP) ))
+
+(DG WINDOW-CLOSE (W:WINDOW)
+ (M-ERASE W:LEFT W:BOTTOM W:RIGHT W:TOP)
+)
+
+
+% edited: 12-Mar-83 15:22
+(DG WINDOW-DRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+ (M-VECTOR FROM:X FROM:Y TO:X TO:Y))
+
+% edited: 12-Mar-83 15:17
+(DG WINDOW-INVERTAREA (W:WINDOW AREA:REGION)
+NIL)
+
+
+% edited: 12-Mar-83 15:18
+(DG WINDOW-MOVETO (W:WINDOW POS:VECTOR)
+(SEND W MOVETOXY POS:X POS:Y))
+
+
+% edited: 19-Mar-83 20:25
+% Move cursor to X-Y position relative to window.
+(DG WINDOW-MOVETOXY (W:WINDOW X:INTEGER Y:INTEGER)
+(M-MOVEP1 X+W:LEFT Y+W:BOTTOM))
+
+
+% edited: 19-Mar-83 20:39
+% Open a window on a terminal.
+(DG WINDOW-OPEN (W:WINDOW)
+ (SEND W CLEAR))
+
+% edited: 12-Mar-83 17:03
+(DG WINDOW-PRETTYPRINTAT (W:WINDOW VALUE POSITION:VECTOR)
+ (SEND W PRINTAT VALUE POSITION))
+
+
+% edited: 16-Mar-83 14:18
+(DG WINDOW-PRINTAT (W:WINDOW S:STRING POS:VECTOR)
+(IF POS:Y > 0 THEN (SEND W MOVETO POS)
+ (SEND W PRINTSTRING S)
+ (IF POS:Y < W:LASTFILLEDLINE THEN (W:LASTFILLEDLINE _ POS:Y))))
+
+
+% edited: 12-Mar-83 15:23
+(DG WINDOW-UNDRAWLINE (W:WINDOW FROM:VECTOR TO:VECTOR)
+ NIL)
+
+
+% edited: 16-Mar-83 14:19
+(DG WINDOW-UNPRINTAT (W:WINDOW S:STRING POS:VECTOR)
+(IF POS:Y > 0 THEN (SEND W MOVETO POS)
+ (SEND W PRINTNC S:LENGTH " ")))
+
+
+
+% edited: 11-Mar-83 22:42
+% Print a character N times.
+(DG WINDOW-PRINTNC (W:WINDOW N:INTEGER C:STRING)
+(WHILE N > 0 DO (N _- 1)
+ (SEND W PRINTCHAR C)))
+
+% Print a character on the display
+(DG WINDOW-PRINTCHAR (W:WINDOW S:STRING)
+ (M-CHAR (INDX S 0)))
+
+% Print a string on the display.
+(DG WINDOW-PRINTSTRING (W:WINDOW S:STRING)
+ (PROG (L:INTEGER I)
+ (S _ (GEVSTRINGIFY S))
+ (L _ (SIZE S))
+ (I _ 0)
+ (WHILE I <= L DO (M-CHAR (INDX S I))
+ (I _+ 1)) ))
ADDED psl-1983/3-1/help/-notes.txt
Index: psl-1983/3-1/help/-notes.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/-notes.txt
@@ -0,0 +1,2 @@
+See PU:-FILES-NOTES.TXT for synopses of some of the packages not
+documented in the reference manual.
ADDED psl-1983/3-1/help/big.doc
Index: psl-1983/3-1/help/big.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/big.doc
@@ -0,0 +1,255 @@
+
+
+
+Beryl Morrison, 4 June 1982
+
+BigNum Structure and "Constants"
+
+The current PSL bignum package was written using vectors of "Big Digits" or
+"Bigits". The first element of each vector is either BIGPOS or BIGNEG,
+depending whether the number is positive or negative. A bignum of the form
+
+[BIGPOS a b c d]
+
+has a value of
+
+a + b * bbase!* + c * bbase!* ** 2 + d * bbase!* ** 3
+
+BBase!* is a fluid variable which varies from one machine to another. For the
+VAX and the DEC-20, it is calculated as follows:
+
+bbits!* := (n-1)/2;
+bbase!* := 2 ** bbits!*;
+
+"n" is the total number of bits per word on the given machine. On the DEC-20,
+n is 36, so bbits!* is 17 and bbase!* is 131072. On the VAX, n is 32, so
+bbits!* is 15 and bbase!* is 32768.
+
+There are some other constants used in the system as well. The sources are in
+pu:bigbig.red on the DEC-20, /u/benson/psl-dist/util/bigbig.red on the VAX.
+
+Starting BigNums
+
+"Load Big;" will bring in the bignum package. A file called big.lap loads
+
+arith.b which provides an interface via tags for when inum functions
+ and when bignum functions should be used; (sources are in
+ test-arith.red)
+vector-fix.b which provides a means of truncating vectors without copying
+ them;
+bigbig.b which provides the bignum versions of functions as required by
+ arith.b;
+bigface.b which provides the final interface between bigbig.b and
+ arith.b.
+
+The order of loading the files must remain as shown; arith and vector-fix may
+be swapped, but otherwise function definitions must be presented in the order
+given.
+
+Building the BigNum Package
+
+Each of the individual files may be rebuilt (to form a new *.b file)
+separately. A file XXX.red may be rebuilt as follows:
+
+[1] faslout "YYY";
+[2] in "XXX.red"$
+ 2
+
+
+[3] faslout;
+
+On the DEC-20, the resulting YYY.b file is put on the directory pl:; on the
+VAX, it is put on the connected directory. They should be on pl: on the DEC-20
+for public access, and on /usr/local/lib/psl on the VAX.
+
+The Functions in BigBig
+
+The functions defined by BigBig for bignums are as follows:
+
+BLOr Takes two BigNum arguments, returning a bignum. Calls BSize,
+ GtPos, PosIfZero.
+
+BLXOr Takes two BigNum arguments, returning a bignum. Calls BSize,
+ GtPos, TrimBigNum1.
+
+BLAnd Takes two BigNum arguments, returning a bignum. Calls BSize,
+ GtPos, TrimBigNum1.
+
+BLNot Takes one BigNum argument, returning a bignum. Calls BMinus,
+ BSmallAdd.
+
+BLShift Takes two BigNum arguments, returning a bignum. Calls BMinusP,
+ BQuotient, BTwoPower, BMinus, BTimes2.
+
+BMinus Takes one BigNum argument, returning a bignum. Calls BZeroP,
+ BSize, BMinusP, GtPos, GtNeg.
+
+BMinusP Takes one BigNum argument, returning a bignum or NIL.
+
+BPlus2 Takes two BigNum arguments, returning a bignum. Calls BMinusP,
+ BDifference2, BMinus, BPlusA2.
+
+BDifference BZeroP, BMinus, BMinusP, BPlusA2, BDifference2.
+
+BTimes2 Takes two BigNum arguments, returning a bignum. Calls BSize,
+ BMinusP, GtPos, GtNeg, BDigitTimes2, PosIfZero, TrimBigNum1.
+
+BDivide Takes two BigNum arguments, returning a pair of bignums. Calls
+ BSize, GtPos, BSimpleDivide, BHardDivide.
+
+BGreaterP Takes two BigNum arguments, returning a bignum or NIL. Calls
+ BMinusP, BDifference.
+
+BLessP Takes two BigNum arguments, returning a bignum or NIL. Calls
+ BMinusP, BDifference.
+
+BAdd1 Takes a BigNum argument, returning a bignum. Calls BSmallAdd.
+
+BSub1 Takes a BigNum argument, returning a bignum. Calls
+ BigSmallDiff.
+ 3
+
+
+FloatFromBigNum Takes a bignum, returning a float. Calls BZeroP, BGreaterP,
+ BLessP, BSize, BMinusP.
+
+BChannelPrin2 Calls BigNumP, NonBigNumError, BSimpleDivide, BSize, BZeroP.
+
+BRead Calls GtPos, BReadAdd, BMinus.
+
+BigFromFloat Takes a float and converts to a bignum. Calls BNum, BPlus2,
+ BTimes2, BTwoPower, FloatFromBigNum, BMinus, PosIfZero.
+
+The following functions are support functions for those given above.
+
+SetBits Takes as an argument the total number of bits per word on a
+ given machine; sets some fluid variables accordingly. NOTE:
+ FloatHi!* must be changed separately from this procedure by
+ hand when moving to a new machine both in bigbig.red and in
+ bigface.red. Calls TwoPower, BNum, BMinus, BSub1, BTwoPower,
+ BAdd1.
+
+BigNumP Checks if the argument is a bignum. Calls no special
+ functions.
+
+NonBigNumError Calls no special functions.
+
+BSize Gives size of a bignum, i.e. total number of bigits (the tag
+ "BIGPOS" or "BIGNEG" is number 0). Calls BigNumP.
+
+PosIfZero Takes a bignum; if it is a negative zero, it is converted to a
+ positive zero. Calls BPosOrNegZeroP, BMinusP.
+
+BPosOrNegZeroP Takes a BigNum; checks if magnitude is zero. Calls BSize.
+
+GtPos Takes an inum/fixnum. Returns a vector of size of the
+ argument; first (i.e.0th) element is BIGPOS, others are NIL.
+
+GtNeg Takes an inum/fixnum. Returns a vector of size of the
+ argument; first (i.e.0th) element is BIGNEG, others are NIL.
+
+TrimBigNum Takes a BigNum as an argument; truncates any trailing "NIL"s.
+ Calls BigNumP, NonBigNumError, TrimBigNum1, BSize.
+
+TrimBigNum1 Does dirty work for TrimBigNum, with second argument the size
+ of the BigNum.
+
+Big2Sys Calls BLessP, BGreaterP, BSize, BMinusP.
+
+TwoPower Takes and returns a fix/inum. 2**n.
+
+BTwoPower Takes a fix/inum or bignum, returns a bignum of value 2**n.
+ Calls BigNumP, Big2Sys, GtPos, TwoPower, TrimBigNum1.
+
+BZeroP Checks size of BigNum (0) and sign. Calls BSize, BMinusP.
+ 4
+
+
+BOneP Calls BMinusP, BSize.
+
+BAbs Calls BMinusP, BMinus.
+
+BGeq Calls BLessP.
+
+BLeq Calls BGreaterP.
+
+BMax Calls BGeq.
+
+BMin Calls BLeq.
+
+BExpt Takes a BigNum and a fix/inum. Calls Int2B, BTimes2,
+ BQuotient.
+
+AddCarry Support for trapping the carry in addition.
+
+BPlusA2 Does the dirty work of addition of two BigNums with signs
+ pre-checked and identical. Calls BSize, GtNeg, GtPos,
+ AddCarry, PosIfZero, TrimBigNum1.
+
+SubCarry Mechanism to get carry in subtractions.
+
+BDifference2 Does the dirty work of subtraction with signs pre-checked and
+ identical. Calls BSize, GtNeg, GtPos, SubCarry, PosIfZero,
+ TrimBigNum1.
+
+BDigitTimes2 Multiplies the first argument (BigNum) by a single Bigit of the
+ second BigNum argument. Returns the partially completed
+ result. Calls no special functions.
+
+BSmallTimes2 Takes a BigNum argument and a fixnum argument, returning a
+ bignum. Calls GtPos, BMinusP, GtNeg, PosIfZero, TrimBigNum1.
+
+BQuotient Takes two BigNum arguments, returning a bignum. Calls BDivide.
+
+BRemainder Takes two BigNum arguments, returning a bignum. Calls BDivide.
+
+BSimpleQuotient Calls BSimpleDivide.
+
+BSimpleRemainder
+ Calls BSimpleDivide.
+
+BSimpleDivide Used to divide a BigNum by an inum. Returns a dotted pair of
+ quotient and remainder, both being bignums. Calls BMinusP,
+ GtPos, GtNeg, PosIfZero, TrimBigNum1.
+
+BHardDivide Used to divide two "true" BigNums. Returns a pair of bignums.
+ Algorithm taken from Knuth. Calls BMinusP, GtPos, GtNeg, BAbs,
+ BSmallTimes2, BSize, BDifference, BPlus2, TrimBigNum1,
+ BSimpleQuotient, PosIfZero.
+ 5
+
+
+BReadAdd Calls BSmallTimes2, BSmallAdd.
+
+BSmallAdd Adds an inum to a BigNum, returning a bignum. Calls BZeroP,
+ BMinusP, BMinus, BSmallDiff, BSize, GtPos, AddCarry, PosIfZero,
+ TrimBigNum1.
+
+BNum Takes an inum and returns a BigNum of one bigit; test that the
+ inum is less than bbase!* is assumed done. Calls GtPos, GtNeg.
+
+BSmallDiff Calls BZeroP, BMinusP, BMinus, BSmallAdd, GtPos, SubCarry,
+ PosIfZero, TrimBigNum1.
+
+int2b Takes a fix/inum and converts to a BigNum. Calls BNum, BRead.
+
+Problems
+
+ - Should the "vectors" be changed to hwords?
+ - Should there be primitives so that each bigit uses almost the whole
+ word instead of almost half the word? This would involve writing
+ "overflow" functions, checking and trapping overflow in operations
+ such as multiplication. This would allow integers to be returned as
+ inums or fixnums if they are geq the current bbase!* and lessp 2 **
+ (n-1). Currently, anything bbase!* or larger is kept as a bignum
+ once the bignum package is loaded.
+ - Make the constants real constants instead of fluids: bbase!*,
+ bbits!*, floathi!*, floatlow!*, logicalbits!*, wordhi!*, wordlow!*,
+ syshi!*, syslo!*, digit2letter!*. Carry!* should be a fluid.
+ - Try to make the whole package loaded as one *.b file.
+ - Change arith.b so that divide is used for the interface instead of
+ quotient and remainder. As it stands, doing a "Divide" when bignums
+ are loaded would mean doing the quotient and then the remainder
+ separately, although Knuth's algorithm computes them together.
+ - Get rid of superfluous functions.
+ - Put in more calls to NonBigNumError for greater safety?
ADDED psl-1983/3-1/help/break.hlp
Index: psl-1983/3-1/help/break.hlp
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/break.hlp
@@ -0,0 +1,20 @@
+BREAK():{Error,return-value}
+----------------------------
+This is a Read-Eval-Print loop, similar to the top level loop, except
+that the following IDs at the top level cause functions to be called
+rather than being evaluated:
+
+? Print this message, listing active Break IDs
+T Print stack backtrace
+Q Exit break loop back to ErrorSet
+A Abort to top level, i.e. restart PSL
+C Return last value to the ContinuableError call
+R Reevaluate ErrorForm!* and return
+M Display ErrorForm!* as the "message"
+E Invoke a simple structure editor on ErrorForm!*
+ (For more information do Help Editor.)
+I Show a trace of any interpreted functions
+
+See the manual for details on the Backtrace, and how ErrorForm!* is
+set. The Break Loop attempts to use the same TopLoopRead!* etc, as
+the calling top loop, just expanding the PromptString!*.
ADDED psl-1983/3-1/help/exec.doc
Index: psl-1983/3-1/help/exec.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/exec.doc
@@ -0,0 +1,42 @@
+EXEC0.RED: A Simple TOPS20 Interface 26 April 1982
+------------------------------------
+This is a loadable option but currently is non-functional.
+
+Top Level Functions of Interest:
+ RUN FileName; Run A File in sub-fork
+ EXEC(); Run Exec
+ EMACS(); Run EMACS
+ MM(); Run MM
+ FileP FileName; Test If File exists
+ CMDS (!%L); Submit List of commands (FEXPR)
+ DoCmds (L); Submit List of commands (EXPR)
+ Use CRLF or BL in string
+ VDIR (L); DoCmds LIST("VDIR ",L,CRLF,"POP");
+ HelpDir(); DoCmds LIST("DIR PH:*.HLP",CRLF,"POP");
+ Take (FileName); DoCmds LIST("Take ",FileName,CRLF,"POP");
+ SYS (L); DoCmds LIST("SYS ", L, CRLF, "POP");
+ TALK (L); DoCmds LIST("TALK ",L,CRLF);
+ TYPE (L); DoCmds LIST("TYPE ",L,CRLF,"POP");
+
+Fork manipulation: [return forkhandle, FH, an integer returned by system]
+ OPENFork FileName; Get a File into a Fork
+ RUNFork FH; Normal use, to run a Fork
+ KILLFork FH; Kill a Fork
+ GetFork Jfn; Create Fork, READ File on Jfn
+ STARTFork FH; Start (Restart) a Fork
+ WAITFork FH; Wait for completion
+
+File manipulation functions: [Mostly return JFN, as small integer]
+ GetOLDJfn FileName; test If file OLD and return Jfn
+ GetNEWJfn FileName; test If file NEW and return Jfn
+ RELJfn Jfn; return Jfn to system
+ OPENOLDJfn Jfn; OPEN to READ
+ OPENNEWJfn Jfn; Open to WRITE
+ GTJfn FileName; Get a Jfn
+ NAMEFROMJfn Jfn; name of File on a Jfn
+
+
+Miscellaneous Functions:
+ GetUNAME(); Get USER name
+ GetCDIR(); Get Connected DIRECTORY
+
ADDED psl-1983/3-1/help/find.doc
Index: psl-1983/3-1/help/find.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/find.doc
@@ -0,0 +1,24 @@
+FIND.RED - Recognition and search OBLIST functions
+-------------------------------------------------
+This is a loadable option [Load Find; in RLISP, (Load Find) in LISP].
+These functions take a string or id, and map the Symbol Table to
+collect a list of ids with Prefix or Suffix as given:
+
+FindPrefix(Key:{Id, String}):id-list Scan Symbol Table for prefix
+FindSuffix(Key:{Id, String}):id-list Scan Symbol Table for suffix
+Find(Pattern:{Id,String}):id-list Scan Symbol Table for matching string
+
+Thus X:=FindPrefix '!*; Finds all ids starting with *
+
+The 'GSORT' package is used to sort the list.
+
+The Pattern is a string, with special characters, prefixed by %, like the
+format string in PrintF; StringMatch(pattern,subject) is called:
+
+ %% Match a % in subject string
+ %? Match any one character
+ %* Match any series of characters (0..n)
+
+Thus Find "*%*"; is equivalent to FindPrefix "*";
+ Find "%**"; is equivalent to FindSuffix "*";
+ Find "A%*B"; matches any string starting with A and ending with B.
ADDED psl-1983/3-1/help/hcons.doc
Index: psl-1983/3-1/help/hcons.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/hcons.doc
@@ -0,0 +1,59 @@
+HCONS - Hashing (unique) CONS and associated utilities.
+
+The Hcons function creates unique dotted pairs. In other words, Hcons(A,B)
+eq Hcons(C,D) if and only if A eq C and B eq D. This allows very rapid
+tests for equality between structures, at the cost of expending more time
+in creating the structures. The use of Hcons may also save space in cases
+where lists share a large amount of common substructure, since only one
+copy of the substructure is stored.
+
+The system works by keeping a hash table of all pairs that have been
+created by Hcons. (So the space advantage of sharing substructure may be
+offset by the space consumed by table entries.) This hash table allows the
+system to store property lists for pairs--in the same way that Lisp has
+property lists for identifiers.
+
+Pairs created by Hcons SHOULD NOT be modified with RPLACA and RPLACD.
+Doing so will make the pair hash table inconsistent, as well as being very
+likely to modify structure shared with something that you don't wish to
+change. Also note that large numbers may be equal without being eq, so the
+Hcons of two large numbers may not be eq to the Hcons of two other numbers
+that appear to be the same. (Similar warnings hold for strings and
+vectors.)
+
+The following "user" functions are provided by HCONS:
+
+Hcons([U:any]): pair macro
+ - --- ---- -----
+The Hcons macro takes one or more arguments and returns their "hashed cons"
+(right associatively). Two arguments corresponds to a call of Cons.
+
+Hlist([U:any]): list nexpr
+ - --- ---- -----
+Hlist is the "Hcons version" of the List function.
+
+Hcopy(U:any): any macro
+ - --- --- -----
+Hcopy is the Hcons version of the copy function. Note that Hcopy serves a
+very different purpose than copy--which is usually used to copy a structure
+so that destructive changes can be made to the copy without changing the
+original. Hcopy, on the other hand, will only actually copy those parts of
+the structure which haven't already been "consed together" by Hcons.
+
+Happend (U:list, V:list): list expr
+ - ---- - ---- ---- ----
+Hcons version of append.
+
+Hreverse (U:list): list expr
+ - ---- ---- ----
+Hcons version of reverse.
+
+The following two functions can be used to "get" and "put" properties for
+pairs or identifiers. The pairs for these functions must be created by
+Hcons. These functions are known to the Setf macro.
+
+extended-put (U:id-or-pair, IND:id, PROP:any): any expr
+ - ---------- --- -- ---- --- --- ----
+
+extended-get (U:id-or-pair, IND:any): any expr
+ - ---------- --- --- --- ----
ADDED psl-1983/3-1/help/help.hlp
Index: psl-1983/3-1/help/help.hlp
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/help.hlp
@@ -0,0 +1,15 @@
+HELP([ARGS:id-list]):NIL mlg, 31 dec 1981
+------------------------
+Type: NOEVAL, NOSPREAD
+If no arguments are given, this file is printed. Otherwise, each of
+the id arguments is checked to see if any help information is
+available. If it has a value under the property list indicator
+HelpFunction, that function is called. If it has a value under the
+indicator HelpString, the value is printed. If it has a value under
+the indicator HelpFile, the file is displayed on the terminal.
+
+(SHOWSTATE U:id-list) Show information about Switches and Globals
+ on list U, or ALL known switches and globals if
+ U is NIL
+(SHOWGLOBALS U:id-list) Globals only
+(SHOWSWITCHES U:id-list) Switches only
ADDED psl-1983/3-1/help/help.tbl
Index: psl-1983/3-1/help/help.tbl
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/help.tbl
@@ -0,0 +1,31 @@
+% Edit by Cris Perdue, 4 Apr 1983 0950-PST
+% Switchs --> Switches
+
+(put 'Help 'HelpFunction 'HelpHelp)
+(put '!? 'HelpFunction 'HelpHelp)
+(put 'Br 'HelpFile 'mini!-trace)
+(put 'Break 'HelpFunction 'HelpBreak)
+(put 'Edit 'HelpFile 'Editor)
+(put 'EditF 'HelpFile 'ZPEdit)
+(put 'Switches 'HelpFunction 'ShowSwitches)
+(put 'Globals 'HelpFunction 'ShowGlobals)
+(put 'LapIn 'HelpFile 'Load)
+(put 'Load 'HelpFile 'Load)
+(put 'MiniEditor 'HelpFile 'Mini!-Editor)
+(put 'MiniTrace 'HelpFile 'Mini!-Trace)
+(put 'TopLoop 'HelpFunction 'HelpTopLoop)
+(put 'Tr 'HelpFile 'mini!-trace)
+(put 'UnBr 'HelpFile 'mini!-trace)
+(put 'UnTr 'HelpFile 'mini!-trace)
+
+(DefineSwitch 'Echo "Echo input characters if T")
+(DefineSwitch 'Time "Print TimeCheck in TopLoop")
+(DefineSwitch 'Defn "Output Parsed Expression, bypass EVAL")
+
+(defineGlobal 'OutputBase!* "Output base for numbers")
+(defineGlobal 'PromptString!* "Current input prompt")
+%(defineGlobal 'Module!* "Module name for help system")
+(defineGlobal 'TopLoopName!* "Name of current top loop")
+(defineGlobal 'TopLoopRead!* "Current reader in top loop")
+(defineGlobal 'TopLoopEval!* "Current evaluator in top loop")
+(defineGlobal 'TopLoopPrint!* "Current printer in top loop")
ADDED psl-1983/3-1/help/history.doc
Index: psl-1983/3-1/help/history.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/history.doc
@@ -0,0 +1,126 @@
+
+ How to use the history mechanism implemented in PSL/FRL:
+
+ PSL/FRL allows you to take any previous input or output and substitute
+ it in place of what you typed. Thus you can either print or redo
+ any input you have previously done. You can also print or
+ execute any result you have previously received.
+ The system will work identify commands by either their history number,
+ or by a subword in the input command.
+
+ PSL/FRL also allows you to take any previously expression and do
+ global substitutions on subwords inside words or numbers inside
+ expressions(Thus allowing spelling corrections, and other word
+ changes easily.)
+
+ PSL/FRL is a set of read macros that insert the previous history
+ text asked for inplace of them selves. Thus they can be put inside
+ any lisp expression typed by the user. The system will evaluate
+ the resulting expression the same as if the user had retyped everything
+ in himself.
+
+ ^^ : means insert last input command inplace of ^^.
+ As an input command by itself,
+ ^^ by itself means redo last command.
+
+ ^n : where n is a number replaces itself with the result of
+ (inp n). ^n by itself means (redo n).
+ ^+n : same as ^n.
+ ^-n : is replaced by the nth back command.
+ replaced with the result of
+ (inp (- current-history-number n)).
+ by itself means (redo (- current-history-number n))
+
+ ^word : where word starts with 'a'-'z' or 'A'-'Z', means
+ take the last input command that has word as a subword
+ or pattern of what was typed (after readmacros were
+ executed.), and replace that ^word with that entire input
+ command.
+ If you want a word that doesn't begin with 'a'-'z', or 'A'-'Z',
+ use ^?word where word can be any lisp atom.
+ (say 23, *, |"ab|, word).
+ ex.: 1 lisp> (plus 2 3)
+ 5
+ 2 lisp> (* 4 5)
+ 20
+ 3 lisp> ^us
+ (PLUS 2 3)
+ 5
+ 4 lisp> (* 3 ^lu)
+ (PLUS 2 3)
+ 15
+
+ Case is ignored in word. Word is read by the command read,
+ And thus should be a normal lisp atom. Use the escape
+ character as needed.
+
+ If the first ^ in any of the above commands is replaced with
+ ^@, then instead of (inp n) , the read macro is replaced with
+ (ans n). Words are still matched against the input, not the
+ answer. (Probably something should be added to allow matching
+ of subwords against the answer also.)
+
+ Thus:(if typed as commands by themselves):
+
+ ^@^ = (eval (ans (last-command)))
+ ^@3 = (eval (ans 3))
+
+ ^@plus = (eval (ans (last-command which has plus as a subword in
+ its input))).
+
+
+ Once the ^ readmacro is replaced with its history expression, you are
+ allowed to do some editing of the command. The way to do this
+ is to type a colon immediately after the ^ command as described
+ above before any space or other delimiting character.
+ ex.: ^plus:p
+ ^2:s/ab/cd/
+ ^^:p
+ ^@^:p
+
+ Currently there are two types of editing commands allowed.
+
+ :p means print only, do not insert in expression, whole
+ read macro returns only nil.
+
+ :s/word1/word2/ means take each atom in the expression found,
+ and if word1 is a subword of that atom, replace the
+ subword word1 with word2. Read is used to read word1
+ and word2, thus the system expects an atom and will
+ ignore anything after what read sees before the /.
+ Use escape characters as necessary.
+
+ :n where n is a positive unsigned number, means take the nth
+ element of the command(must be a list) and return it.
+
+ ^string1^string2^ is equivalent to :s/string1/string2/.
+ ex.: ^plus^plus^times^ is equivalent to ^plus:s/plus/times/ .
+
+ After a :s, ^ or :<n> command you may have another :s command, ^
+ or a :p
+ command. :p command may not be followed by any other command.
+
+ The expression as modified by the :s commands is what is
+ returned in place of the ^ readmacro.
+ You need a closing / as seen in the :s command above.
+ After the command you should type a delimiting character if
+ you wish the next expression to begin with a :, since a :
+ will be interpreted as another editing command.
+
+ On substitution, case is ignored when matching the subword,
+ and the replacement subword
+ is capitalized(unless you use an escape character before
+ typing a lowercase letter).
+
+ Examples:
+ 1 lisp> (plus 23 34)
+ 57
+ 2 lisp> ^^:s/plus/times/
+ (TIMES 23 34)
+ 782
+ 3 lisp> ^plus:s/3/5/
+ (PLUS 25 54)
+ 79
+ 4 lisp>
+
+
ADDED psl-1983/3-1/help/inspect.doc
Index: psl-1983/3-1/help/inspect.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/inspect.doc
@@ -0,0 +1,33 @@
+INSPECT M.L. Griss, Monday, 31 May 1982
+-------
+
+This is a simple utility to scan the contents of a source file to tell
+what functions are defined in it. It will be embellished slightly to
+permit the on-line querying of certain attributes of files. INSPECT
+reads one or more files, printing and collecting information on
+defined functions.
+
+Usage:
+
+LOAD INSPECT;
+
+INSPECT "file-name"; % Scans the file, and prints proc names.
+ % It also builds the lists ProcedureList!*
+ % FileList!* and ProcFileList!*
+
+ % File-Name can IN other files
+
+On the Fly printing is controlled by !*PrintInspect, default is T.
+Other lists built include FileList!* and ProcFileList!*, which
+is a list of (procedure . filename) for multi-file processing.
+
+For more complete process, do:
+
+LOAD Inspect;
+Off PrintInspect;
+InspectOut(); % Later will get a file Name
+IN ....;
+IN ...;
+InspectEnd;
+
+Now use Gsort etc. to process the lists
ADDED psl-1983/3-1/help/loop.doc
Index: psl-1983/3-1/help/loop.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/loop.doc
@@ -0,0 +1,201 @@
+;Loop macro blathering.
+;
+; This doc is totally wrong. Complete documentation (nice looking
+; hardcopy) is available from GSB, or from ML:LSBDOC;LPDOC (which
+; needs to be run through BOLIO).
+;
+;This is intended to be a cleaned-up version of PSZ's FOR package
+;which is a cleaned-up version of the Interlisp CLisp FOR package.
+;Note that unlike those crocks, the order of evaluation is the
+;same as the textual order of the code, always.
+;
+;The form is introduced by the word LOOP followed by a series of clauses,
+;each of which is introduced by a keyword which however need not be
+;in any particular package. Certain keywords may be made "major"
+;which means they are global and macros themselves, so you could put
+;them at the front of the form and omit the initial "LOOP".
+;
+;Each clause can generate:
+;
+; Variables local to the loop.
+;
+; Prologue Code.
+;
+; Main Code.
+;
+; Epilogue Code.
+;
+;Within each of the three code sections, code is always executed strictly
+;in the order that the clauses were written by the user. For parallel assignments
+;and such there are special syntaxes within a clause. The prologue is executed
+;once to set up. The main code is executed several times as the loop. The epilogue
+;is executed once after the loop terminates.
+;
+;The term expression means any Lisp form. The term expression(s) means any number
+;of Lisp forms, where only the first may be atomic. It stops at the first atom
+;after the first form.
+;
+;The following clauses exist:
+;
+;Prologue:
+; INITIALLY expression(s)
+; This explicitly inserts code into the prologue. More commonly
+; code comes from variable initializations.
+;
+;Epilogue:
+; FINALLY expression(s)
+; This is the only way to explicitly insert code into the epilogue.
+;
+;Side effects:
+; DO expression(s)
+; The expressions are evaluated. This is how you make a "body".
+; DOING is synonymous with DO.
+;
+;Return values:
+; RETURN expression(s)
+; The last expression is returned immediately as the value of the form.
+; This is equivalent to DO (RETURN expression) which you will
+; need to use if you want to return multiple values.
+; COLLECT expression(s)
+; The return value of the form will be a list (unless over-ridden
+; with a RETURN). The list is formed out of the values of the
+; last expression.
+; COLLECTING is synonymous with COLLECT.
+; APPEND (or APPENDING) and NCONC (or NCONCING) can be used
+; in place of COLLECT, forming the list in the appropriate ways.
+; COUNT expression(s)
+; The return value of the form will be the number of times the
+; value of the last expression was non-NIL.
+; SUM expression(s)
+; The return value of the form will be the arithmetic sum of
+; the values of the last expression.
+; The following are a bit wierd syntactically, but Interlisp has them
+; so they must be good.
+; ALWAYS expression(s)
+; The return value will be T if the last expression is true on
+; every iteration, NIL otherwise.
+; NEVER expressions(s)
+; The return value will be T if the last expression is false on
+; every iteration, NIL otherwise.
+; THEREIS expression(s)
+; This is wierd, I'm not sure what it really does.
+
+
+; You probably want WHEN (NUMBERP X) RETURN X
+; or maybe WHEN expression RETURN IT
+;
+;Conditionals: (these all affect only the main code)
+;
+; WHILE expression
+; The loop terminates at this point if expression is false.
+; UNTIL expression
+; The loop terminates at this point if expression is true.
+; WHEN expression clause
+; Clause is performed only if expression is true.
+; This affects only the main-code portion of a clause
+; such as COLLECT. Use with FOR is a little unclear.
+; IF is synonymous with WHEN.
+; WHEN expression RETURN IT (also COLLECT IT, COUNT IT, SUM IT)
+; This is a special case, the value of expression is returned if non-NIL.
+; This works by generating a temporary variable to hold
+; the value of the expression.
+; UNLESS expression clause
+; Clause is performed only if expression is false.
+;
+;Variables and iterations: (this is the hairy part)
+;
+; WITH variable = expression {AND variable = expression}...
+; The variable is set to the expression in the prologue.
+; If several variables are chained together with AND
+; the setq's happen in parallel. Note that all variables
+; are bound before any expressions are evaluated (unlike DO).
+;
+; FOR variable = expression {AND variable = expression}...
+; At this point in the main code the variable is set to the expression.
+; Equivalent to DO (PSETQ variable expression variable expression...)
+; except that the variables are bound local to the loop.
+;
+; FOR variable FROM expression TO expression {BY expression}
+; Numeric iteration. BY defaults to 1.
+; BY and TO may be in either order.
+; If you say DOWNTO instead of TO, BY defaults to -1 and
+; the end-test is reversed.
+; If you say BELOW instead of TO or ABOVE instead of DOWNTO
+; the iteration stops before the end-value instead of after.
+; The expressions are evaluated in the prologue then the
+; variable takes on its next value at this point in the loop;
+; hair is required to win the first time around if this FOR is
+; not the first thing in the main code.
+; FOR variable IN expression
+; Iteration down members of a list.
+; FOR variable ON expression
+; Iteration down tails of a list.
+; FOR variable IN/ON expression BY expression
+; This is an Interlisp crock which looks useful.
+; FOR var ON list BY expression[var]
+; is the same as FOR var = list THEN expression[var]
+; FOR var IN list BY expression[var]
+; is similar except that var gets tails of the list
+; and, kludgiferously, the internal tail-variable
+; is substituted for var in expression.
+; FOR variable = expression THEN expression
+; General DO-type iteration.
+; Note that all the different types of FOR clauses can be tied together
+; with AND to achieve parallel assignment. Is this worthwhile?
+; [It's only implemented for = mode.]
+; AS is synonymous with FOR.
+;
+; FOR variable BEING expression(s) AND ITS pathname
+; FOR variable BEING expression(s) AND ITS a-r
+; FOR variable BEING {EACH} pathname {OF expression(s)}
+; FOR variable BEING {EACH} a-r {OF expression(s)}
+; Programmable iteration facility. Each pathname has a
+; function associated with it, on LOOP-PATH-KEYWORD-ALIST; the
+; alist has entries of the form (pathname function prep-list).
+; prep-list is a list of allowed prepositions; after either of
+; the above formats is parsed, then pairs of (preposition expression)
+; are collected, while preposition is in prep-list. The expression
+; may be a progn if there are multiple prepositions before the next
+; keyword. The function is then called with arguments of:
+; pathnname variable prep-phrases inclusive? prep-list
+; Prep-phrases is the list of pairs collected, in order. Inclusive?
+; is T for the first format, NIL otherwise; it says that the init
+; value of the form takes on expression. For the first format, the
+; list (OF expression) is pushed onto the fromt of the prep-phrases.
+; In the above examples, a-r is a form to be evaluated to get an
+; attachment-relationship. In this case, the pathname is taken as
+; being ATTACHMENTS, and a-r is passed in by being treated as if it
+; had been used with the preposition IN. The function should return
+; a list of the form (bindings init-form step-form end-test); bindings
+; are stuffed onto loop-variables, init-form is initialization code,
+; step-form is step-code, and end-test tells whether or not to exit.
+;
+;Declarations? Not needed by Lisp machine. For Maclisp these will be done
+;by a reserved word in front of the variable name as in PSZ's macro.
+;
+;The implementation is as a PROG. No initial values are given for the
+;PROG-variables. PROG1 is used for parallel assignment.
+;
+;The iterating forms of FOR present a special problem. The problem is that
+;you must do everything in the order that it was written by the user, but the
+;FOR-variable gets its value in a different way in the first iteration than
+;in the subsequent iterations. Note that the end-tests created by FOR have
+;to be done in the appropriate order, since otherwise the next clause might get
+;an error.
+;
+;The most general way is to introduce a flag, !FIRST-TIME, and compile the
+;clause "FOR var = first TO last" as "INITIALLY (SETQ var first)
+;WHEN (NOT !FIRST-TIME) DO (SETQ var (1+ var)) WHILE (<= var last)".
+;However we try to optimize this by recognizing a special case:
+;The special case is recognized where all FOR clauses are at the front of
+;the main code; in this case if there is only one its stepping and
+;endtest are moved to the end, and a jump to the endtest put at the
+;front. If there are more than one their stepping and endtests are moved
+;to the end, with duplicate endtests at the front except for the last
+;which doesn't need a duplicate endtest. If FORs are embedded in the
+;main code it can only be implemented by either a first-time flag or
+;starting the iteration variable at a special value (initial minus step
+;in the numeric iteration case). This could probably just be regarded as
+;an error. The important thing is that it never does anything out of
+;order.
+
ADDED psl-1983/3-1/help/objects.doc
Index: psl-1983/3-1/help/objects.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/objects.doc
@@ -0,0 +1,530 @@
+ The OBJECTS Module
+ Cris Perdue
+ Alan Snyder
+ 11/22/82
+ -----------------------------
+
+ INTRODUCTION
+ ------------
+
+The OBJECTS module provides simple support for object-oriented
+programming in PSL. It is based on the "flavors" facility of the
+LISP machine, which is the source of its terminology. The LISP
+Machine Manual contains a much longer introduction to the idea of
+object oriented programming, generic operations, and the flavors
+facility in particular. This discussion goes over the basics of
+using flavored objects once briefly to give you an idea of what
+is involved, then goes into details.
+
+A datatype is known as a flavor (don't ask). The definition of a
+flavor can be thought of in two parts: the DEFFLAVOR form
+("flavor definition"), plus a set of DEFMETHOD forms ("method
+definitions") for operating on objects of that flavor.
+
+With the objects package the programmer completely controls what
+operations are to be done on objects of each flavor, so this is a
+true object-oriented programming facility. Also, all operations
+on flavored objects are automatically "generic" operations. This
+means that any programs you write that USE flavored objects have
+an extra degree of built-in generality.
+
+What does it mean to say that operations on flavored objects are
+generic? This means that the operations can be done on an object
+of any flavor, just so long as the operations are defined for
+that flavor of object. The same operation can be defined for
+many flavors, and whenever the operation is invoked, what is
+actually done will depend on the flavor of the object it is being
+done to.
+
+We may wish to write a scanner that reads a sequence of
+characters out of some object and processes them. It does not
+need to assume that the characters are coming from a file, or
+even from an I/O channel.
+
+Suppose the scanner gets a character by invoking the
+GET-CHARACTER operation. In this case any object of a flavor
+with a GET-CHARACTER operation can be passed to the scanner, and
+the GET-CHARACTER operation defined for that object's flavor will
+be done to fetch the character. This means that the scanner can
+get characters from a string, or from a text editor's buffer, or
+from any object at all that provides a GET-CHARACTER operation.
+The scanner is automatically general.
+
+DEFFLAVOR
+
+A flavor definition looks like:
+
+(defflavor flavor-name (var1 var2 ...) () option1 option2 ...)
+
+Example:
+
+(defflavor complex-number
+ (real-part
+ (imaginary-part 0.0))
+ ()
+ gettable-instance-variables
+ initable-instance-variables
+ )
+
+A flavor definition specifies the fields, components, or in our
+terminology, the "instance variables" that each object of that
+flavor is to have. The mention of the instance variable
+imaginary-part indicated that by default the imaginary part of a
+complex number will be initialized to 0.0. There is no default
+initialization for the real-part.
+
+Instance variables may be strictly part of the implementation of
+a flavor, totally invisible to users. Typically though, some of
+the instance variables are directly visible in some way to the
+user of the object. The flavor definition may specify
+"initable-instance-variables", "gettable-instance-variables", and
+"settable-instance-variables". None, some of, or all of the
+instance variables may be specified in each option.
+
+CREATING OBJECTS
+
+The function MAKE-INSTANCE provides a convenient way to create
+objects of any flavor. The flavor of the object to be created
+and the initializations to be done are given as parameters in a
+way that is fully independent of the internal representation of
+the object.
+
+METHODS
+
+The function "=>", whose name is intended to suggest the sending
+of a message to an object, is usually used to invoke a method.
+
+Examples:
+
+(=> my-object zap)
+(=> thing1 set-location 2.0 3.4)
+
+The first "argument" to => is the object being operated on:
+my-object and thing1 in the examples. The second "argument" is
+the name of the method to be invoked: zap and set-location. The
+method name IS NOT EVALUATED. Any further arguments become
+arguments to the method. (There is a function SEND which is just
+like => except that the method name argument is evaluated just
+like everything else.)
+
+Once an object is created, all operations on it are performed by
+"methods" defined for objects of its flavor. The flavor
+definition itself also defines some methods. For each "gettable"
+instance variable, a method of the same name is defined which
+returns the current value of that instance variable. For
+"settable" instance variables a method named "set-<variable
+name>" is defined. Given a new value for the instance variable,
+the method sets the instance variable to have that value.
+
+SANCTITY OF OBJECTS
+
+Most LISPs and PSL in particular leave open the possibility for
+the user to perform illicit operations on LISP objects. Objects
+defined by the objects package are represented as ordinary LISP
+objects (vectors at present), so in a sense it is quite easy to
+do illicit operations on them: just operate directly on its
+representation (do vector operations).
+
+On the other hand, there are major practical pitfalls in doing
+this. The representation of a flavor of objects is generated
+automatically, and there is no guarantee that a particular flavor
+definition will result in a particular representation of the
+objects. There is also no guarantee that the representation of a
+flavor will remain the same over time. It is likely that at some
+point vectors will no longer even be used as the representation.
+
+In addition, using the objects package is quite convenient, so
+the temptation to operate on the underlying representation is
+reduced. For debugging, one can even define a couple of extra
+methods "on the fly" if need be.
+
+ REFERENCE INFORMATION
+ ---------------------
+
+
+LOADING THE MODULE
+
+NOTE: THIS FILE DEFINES BOTH MACROS AND ORDINARY LISP FUNCTIONS.
+IT MUST BE LOADED BEFORE ANY OF THESE FUNCTIONS ARE USED. The
+recommended way of doing this is to put the expression:
+(BothTimes (load objects)) at the beginning of your source file.
+This will cause the package to be loaded at both compile and load
+time.
+
+
+DEFFLAVOR - Define a new flavor of Object
+
+The form is:
+
+(defflavor <name> <instance-variables> <mixin-flavors> <options>)
+
+Examples:
+
+(defflavor complex-number (real-part imaginary-part) ()
+ gettable-instance-variables
+ initable-instance-variables
+ )
+
+(defflavor complex-number ((real-part 0.0)
+ (imaginary-part 0.0)
+ )
+ ()
+ gettable-instance-variables
+ (settable-instance-variables real-part)
+ )
+
+The <instance-variables> form a list. Each member of the list is
+either a symbol (id) or a list of 2 elements. The 2-element list
+form consists of a symbol and a default initialization form.
+
+Note: Do not use names like "IF" or "WHILE" for instance
+variables: they are translated freely within method bodies (see
+DEFMETHOD). The translation process is not very smart about
+which occurrences of the symbol for an instance variable are
+actually uses of the variable, though it does understand the
+nature of QUOTE.
+
+The <mixin-flavors> list must be empty. In the LISP machine
+flavors facility, this may be a list of names of other flavors.
+
+Recognized options are:
+
+ (GETTABLE-INSTANCE-VARIABLES var1 var2 ...)
+ (SETTABLE-INSTANCE-VARIABLES var1 var2 ...)
+ (INITABLE-INSTANCE-VARIABLES var1 var2 ...)
+
+ GETTABLE-INSTANCE-VARIABLES [make all instance variables GETTABLE]
+ SETTABLE-INSTANCE-VARIABLES [make all instance variables SETTABLE]
+ INITABLE-INSTANCE-VARIABLES [make all instance variables INITABLE]
+
+An empty list of variables is taken as meaning all variables
+rather than none, so (GETTABLE-INSTANCE-VARIABLES) is equivalent
+to GETTABLE-INSTANCE-VARIABLES.
+
+For each gettable instance variable a method of the same name is
+generated to access the instance variable. If instance variable
+LOCATION is gettable, one can invoke (=> <object> LOCATION).
+
+For each settable instance variable a method with the name
+SET-<name> is generated. If instance variable LOCATION is
+settable, one can invoke (=> <object> SET-LOCATION <expression>).
+Settable instance variables are always also gettable and initable
+by implication. If this feature is not desired, define a method
+such as SET-LOCATION directly rather than declaring the instance
+variable to be settable.
+
+Initable instance variables may be initialized via options to
+MAKE-INSTANCE or INSTANTIATE-FLAVOR. See below.
+
+
+DEFMETHOD - Define a method on an existing flavor.
+
+The form is:
+
+(defmethod (<flavor-name> <method-name>) (<arg> <arg> . . . )
+ <expression>
+ <expression>
+ . . .
+ )
+
+The <flavor-name>, the <method-name>, and each <arg> are all
+identifiers. There may be zero or more <arg>s.
+
+Examples:
+
+(defmethod (complex-number real-part) ()
+ real-part)
+
+(defmethod (complex-number set-real-part) (new-real-part)
+ (setf real-part new-real-part))
+
+The body of a method can refer to any instance variable of the
+flavor by using the name just like an ordinary variable. They
+can set them using SETF. All occurrences of instance variables
+(except within vectors or quoted lists) are translated to an
+invocation of the form (IGETV SELF n).
+
+The body of a method can also freely use SELF much as though it
+were another instance variable. SELF is bound to the object that
+the method applies to. SELF may not be setq'ed or setf'ed.
+
+Example using SELF:
+
+(defmethod (toaster plug-into) (socket)
+ (setf plugged-into socket)
+ (=> socket assert-as-plugged-in self))
+
+
+MAKE-INSTANCE - Create a new instance of a flavor.
+
+Examples:
+
+(make-instance 'complex-number)
+(make-instance 'complex-number 'real-part 0.0 'imaginary-part 1.0)
+
+MAKE-INSTANCE takes as arguments a flavor name and an optional
+sequence of initializations, consisting of alternating pairs of
+instance variable names and corresponding initial values. Note
+that all the arguments are evaluated.
+
+Initialization of a newly made object happens as follows:
+
+Each instance variable with initialization specified in the call
+to make-instance is initialized to the value given. Any instance
+variables not initialized in this way, but having default
+initializations specified in the flavor definition are
+initialized by the default initialization specified there. All
+other instance variables are initialized to the symbol *UNBOUND*.
+
+If a method named INIT is defined for this flavor of object, that
+method is invoked automatically after the initializations just
+discussed. The INIT method is passed as its one argument a list
+of alternating variable names and initial values. This list is
+the result of evaluating the initializations given to
+MAKE-INSTANCE. For example, if we call:
+
+(make-instance 'complex-number 'real-part (sin 30)
+ 'imaginary-part (cos 30))
+
+then the argument to the INIT method (if any) would be
+
+(real-part .5 imaginary-part .866).
+
+The INIT method may do anything desired to set up the desired
+initial state of the object.
+
+At present, this value passed to the INIT method is of virtually
+no use to the INIT method since the values have been stored into
+the instance variables already. In the future, though, the
+objects package may be extended to permit keywords other than
+names of instance variables to be in the initialization part of
+calls to make-instance. If this is done, INIT methods will be
+able to use the information by scanning the argument.
+
+
+INSTANTIATE-FLAVOR
+
+This is the same as MAKE-INSTANCE, except that the initialization
+list is provided as a single (required) argument.
+
+Example:
+
+(instantiate-flavor 'complex-number
+ (list 'real-part (sin 30) 'imaginary-part (cos 30)))
+
+ OPERATING ON OBJECTS
+ --------------------
+
+Operations on an object are done by the methods of the flavor of
+the object. We say that a method is invoked, or we may say that
+a message is sent to the object. The notation suggests the
+sending of messages. In this metaphor, the name of the method to
+use is part of the message sent to the object, and the arguments
+of the method are the rest of the message. There are several
+approaches to invoking a method:
+
+=> - Convenient form for sending a message
+
+Examples:
+
+(=> r real-part)
+
+(=> r set-real-part 1.0)
+
+The message name is not quoted. Arguments to the method are
+supplied as arguments to =>. In these examples, r is the object,
+real-part and set-real-part are the methods, and 1.0 is the
+argument to the set-real-part method.
+
+SEND - Send a Message (Evaluated Message Name)
+
+Examples:
+
+(send r 'real-part)
+
+(send r 'set-real-part 1.0)
+
+The meanings of these two examples are the same as the meanings
+of the previous two. Only the syntax is different: the message
+name is quoted.
+
+
+FANCY FORMS OF SEND
+
+SEND-IF-HANDLES - Conditionally Send a Message (Evaluated Message Name)
+
+Examples:
+
+(send-if-handles r 'real-part)
+
+(send-if-handles r 'set-real-part 1.0)
+
+SEND-IF-HANDLES is like SEND, except that if the object defines no method
+to handle the message, no error is reported and NIL is returned.
+
+
+LEXPR-SEND - Send a Message (Explicit "Rest" Argument List)
+
+Examples:
+
+(lexpr-send foo 'bar a b c list)
+
+The last argument to LEXPR-SEND is a list of the remaining arguments.
+
+
+LEXPR-SEND-IF-HANDLES
+
+This is the same as LEXPR-SEND, except that no error is reported
+if the object fails to handle the message.
+
+
+LEXPR-SEND-1 - Send a Message (Explicit Argument List)
+
+Examples:
+
+(lexpr-send-1 r 'real-part nil)
+
+(lexpr-send-1 r 'set-real-part (list 1.0))
+
+Note that the message name is quoted and that the argument list
+is passed as a single argument to LEXPR-SEND-1.
+
+
+LEXPR-SEND-1-IF-HANDLES
+
+This is the same as LEXPR-SEND-1, except that no error is reported
+if the object fails to handle the message.
+
+ USEFUL FUNCTION(s) ON OBJECTS
+ -----------------------------
+
+OBJECT-TYPE
+
+The OBJECT-TYPE function returns the type (an ID) of the
+specified object, or NIL, if the argument is not an object. At
+present this function cannot be guaranteed to distinguish between
+objects created by the OBJECTS package and other LISP entities,
+but the only possible confusion is with vectors.
+
+ DEBUGGING INFORMATION
+ ---------------------
+
+Any object may be displayed symbolically by invoking the method
+DESCRIBE, e.g. (=> x describe). This method prints the name of
+each instance variable and its value, using the ordinary LISP
+printing routines. Flavored objects are liable to be complex and
+nested deeply or even circular. This makes it often a good idea
+to set PRINLEVEL to a small integer before printing structures
+containing objects to control the amount of output.
+
+When printed by the standard LISP printing routines, "flavored
+objects" appear as vectors whose zeroth element is the name of
+the flavor.
+
+For each method defined, there is a corresponding LISP function
+named <flavor-name>$<method-name>. Such function names show up
+in backtrace printouts.
+
+It is permissible to define new methods on the fly for debugging
+purposes.
+
+ DECLARE and UNDECLARE
+ ---------------------
+
+*** Read these warnings carefully! ***
+
+This facility can reduce the overhead of invoking methods on
+particular variables, but it should be used sparingly. It is not
+well integrated with the rest of the language. At some point a
+proper declaration facility is expected and then it will be
+possible to make declarations about objects, integers, vectors,
+etc., all in a uniform and clean way.
+
+The DECLARE macro allows you to declare that a specific symbol is
+bound to an object of a specific flavor. This allows the flavors
+implementation to eliminate the run-time method lookup normally
+associated with sending a message to that variable, which can
+result in an appreciable improvement in execution speed. This
+feature is motivated solely by efficiency considerations and
+should be used ONLY where the performance improvement is
+critical.
+
+Details: if you declare the variable X to be bound to an object
+of flavor FOO, then WITHIN THE CONTEXT OF THE DECLARATION (see
+below), expressions of the form (=> X GORP ...) or (SEND X 'GORP
+...) will be replaced by function invocations of the form
+(FOO$GORP X ...). Note that there is no check made that the
+flavor FOO actually contains a method GORP. If it does not, then
+a run-time error "Invocation of undefined function FOO$GORP" will
+be reported.
+
+WARNING: The DECLARE feature is not presently well integrated
+with the compiler. Currently, the DECLARE macro may be used only
+as a top-level form, like the PSL FLUID declaration. It takes
+effect for all code evaluated or compiled henceforth. Thus, if
+you should later compile a different file in the same compiler,
+the declaration will still be in effect! THIS IS A DANGEROUS
+CROCK, SO BE CAREFUL! To avoid problems, I recommend that
+DECLARE be used only for uniquely-named variables. The effect of
+a DECLARE can be undone by an UNDECLARE, which also may be used
+only as a top-level form. Therefore, it is good practice to
+bracket your code in the source file with a DECLARE and a
+corresponding UNDECLARE.
+
+Here are the syntactic details:
+
+(DECLARE FLAVOR-NAME VAR1 VAR2 ...)
+(UNDECLARE VAR1 VAR2 ...)
+
+*** Did you read the above warnings??? ***
+
+ REPRESENTATION INFORMATION
+ --------------------------
+
+(You don't need to know any of this to use this stuff.)
+
+A flavor-name is an ID. It has the following properties:
+
+VARIABLE-NAMES A list of the instance variables of the flavor, in
+ order of their location in the instance vector.
+ This property exists at compile time, dskin time, and
+ load time.
+
+INITABLE-VARIABLES A list of the instance variables that have been
+ declared to be INITABLE. This property exists at
+ dskin time and at load time.
+
+METHOD-TABLE An association list mapping each method name (ID)
+ defined for the flavor to the corresponding function
+ name (ID) that implements the method. This property
+ exists at dskin time and at load time.
+
+INSTANCE-VECTOR-SIZE An integer that specifies the number of elements
+ in the vector that represents an instance of this
+ flavor. This property exists at dskin time and at
+ load time. It is used by MAKE-INSTANCE.
+
+The function that implements a method has a name of the form
+FLAVOR$METHOD. Each such function ID has the following properties:
+
+SOURCE-CODE A list of the form (LAMBDA (SELF ...) ...) which is
+ the untransformed source code for the method.
+ This property exists at compile time and dskin time.
+
+
+Implementation Note:
+
+A tricky aspect of the code that implements the objects package
+is making sure that the right things happen at the right time.
+When a source file is read and evaluated (using DSKIN), then
+everything must happen at once. However, when a source file is
+compiled to produce a FASL file, then some actions must be
+performed at compile-time, whereas other actions are supposed to
+occur when the FASL file is loaded. Actions to occur at compile
+time are performed by macros; actions to occur at load time are
+performed by the forms returned by macros.
+
+Another goal of the implementation is to avoid consing whenever
+possible during method invocation. The current scheme prefers to
+compile into (APPLY HANDLER (LIST args...)), for which the PSL
+compiler will produce code that performs no consing.
ADDED psl-1983/3-1/help/pcheck.doc
Index: psl-1983/3-1/help/pcheck.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/pcheck.doc
@@ -0,0 +1,11 @@
+PCHECK.RED MLG, 10 June 1982
+----------
+
+PCHECK will READ a .SL file, printing some of the top-level of each
+S-expression. It is meant to survey the file, and if the file has
+unbalanced parensthesis, will show where things get confused.
+
+To use:
+ LOAD PCHECK;
+ PCHECK "foo.sl";
+
ADDED psl-1983/3-1/help/poly.doc
Index: psl-1983/3-1/help/poly.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/poly.doc
@@ -0,0 +1,31 @@
+POLY.RED MLG July 82
+--------
+
+POLY is a simple (pedagogic) Rational Function Evaluator.
+
+After loading POLY.RED, run function ALGG(); or RAT();
+These accept a sequence of expressions:
+
+ <exp> ; | QUIT; (Semicolon terminator)
+ <exp> ::= <term> [+ <exp> | - <exp>]
+ <term> ::= <primary> [* <term> | / <term>]
+ <primary> ::= <primary0> [^ <primary0> | ' <primary0> ]
+ ^ is exponentiation, ' is derivative
+ <primary0> ::= <number> | <variable> | ( <exp> )
+
+It includes a simple parser (RPARSE), 2 evaluators (RSIMP x)
+and (PRESIMP), and 2 prettyprinters, (RATPRINT) and (PREPRINT)
+
+ PREFIX Format: <number> | <id> | (op arg1 arg2)
+ + -> PLUS2
+ - -> DIFFERENCE (or MINUS)
+ * -> TIMES2
+ / -> QUOTIENT
+ ^ -> EXPT
+ ' -> DIFF
+
+ Canonical Formats: Polynomial: integer | (term . polynomial)
+ term : (power . polynomial)
+ power : (variable . integer)
+ Rational : (polynomial . polynomial)
+
ADDED psl-1983/3-1/help/prlisp.hlp
Index: psl-1983/3-1/help/prlisp.hlp
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/prlisp.hlp
@@ -0,0 +1,41 @@
+3D version of PictureRLISP MLG 4 Jan 1983
+------------------------------------------------------
+
+This is a brief guide to the 3D version of Picture RLISP. This is much
+slower than the PRLISP2D subset, which is better if only planar
+displays are required. PRLISP can now be run under PSL as well, though
+of course with no syntax.
+
+RLISP Use:
+
+LOAD PRLISP; % Load 3D version of PictureRLISP
+HP!.INIT(); % Select Driver, this is most common HP2648a version
+
+Line := {0,0} _ {10,10}; % Line from center towards upper-right
+Show Line; % Draw it
+Show Line | ZROT(25); % Draw rotated by 25 degrees
+Erase(); % Clear screen
+Show Line & (Line | scale 3 | zrot 20 ) | xmove 10;
+
+For more examples, see PU:PR-DEMO.RED, use IN "PU:PR-DEMO.RED"$
+
+PRLISP can also be loaded and run from PSL, but no syntax is
+available:
+
+(LOAD PRLISP)
+(HP!.INIT)
+
+(setq LINE (POINTSET (ONEPOINT 0 0) (ONEPOINT 10 10)))
+
+(SHOW LINE)
+(SHOW (TRANSFORM LINE (ZROT 25)))
+
+(ERASE)
+
+(SHOW (GROUP LINE (TRANSFORM
+ (TRANSFORM (TRANSFORM Line (SCALE 3))
+ (ZROT 20))
+ (XMOVE 10))))
+
+For more examples, see PU:PR-DEMO.SL, run with
+(LAPIN "PU:PR-DEMO.SL")
ADDED psl-1983/3-1/help/prlisp.mss
Index: psl-1983/3-1/help/prlisp.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/prlisp.mss
@@ -0,0 +1,927 @@
+@Device(lpt)
+@style(justification yes)
+@style(linewidth 80, spacing 1,indent 5)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@make(article)
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(appendix,numbered=<APPENDIX @A: >)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+@define(up,use text,capitalized on, break off)
+@define(mac,use text, underline off, break off)
+@define(LISPmac,use text, underline alphanumerics, break off)
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "September 1981",
+ Line "Operating Note 59"
+ )
+@set(page=1)
+@newpage()
+@begin(titlepage)
+@begin(titlebox)
+@b(PictureRLISP)
+
+@center[A LISP-Based Graphics Language System
+with Flexible Syntax
+and Hierarchical Data Structure
+
+by
+
+Fuh-Meei Chen, Paul R. Stay and Martin L. Griss
+Computer Science Department
+University of Utah
+Salt Lake City, Utah 84112
+
+Last Revision: @value(date)]
+@end(titlebox)
+@begin(abstract)
+This report is a description and a users manual for PictureRLISP, a
+LISP based interactive graphics language. PictureRLISP has an
+ALGOL-like syntax, with primitives to create, manipulate and apply 3D
+transformations to hierachical data structures called "Models".
+PictureRLISP is entirely written in RLISP which is a high-level
+interface to Standard LISP.
+@end(Abstract)
+@begin(Researchcredit)
+Work supported in part by the National Science Foundation
+under Grant No. MCS80-07034.
+@end(Researchcredit)
+@end(titlepage)
+@pageheading(Left "PictureRLISP",Center "@value(date)",
+ Right "@value(Page)"
+ )
+@set(page=1)
+@newpage
+@section<Introduction>
+PictureRLISP is a graphic specification language in an interactive
+RLISP environment. PictureRLISP usage typically consists of creating,
+modifying, and requesting the display of graphical objects, called
+"Models". A model is a three dimensional representation of the
+spatial, topological and graphical features of an object. Models can
+contain any number of primitives, which can generally be in any order.
+
+The hierarchical structure and implementation of the PictureRLISP
+system are designed to support both the beginning and the expert user
+as well. The sophisticated PictureRLISP user can utilize low level
+primitive operations to support customized modeling, syntax or device
+environments; yet the beginner need not know how to use these
+features.
+
+PictureRLISP is a re-implementation of an earlier system,
+PICTUREBALM@cite[Goates80], with a number of additions. The major
+improvement is that the entire system is now written in RLISP, including
+the low-level clipping and transformation routines. RLISP is an ALGOL-like
+interface to LISP, found more convenient to use by many people. The
+extensible, table-driven RLISP parser itself is written in LISP, permitting
+rapid syntactice customization. The version of RLISP used for PictureRLISP
+is built upon PSL@cite[Griss81,Griss82b], an efficient, portable and
+interactive LISP system. PSL provides rich data structures, dynamic storage
+management, and an efficient LISP to machine code compiler@cite[Griss79b],
+which makes PSL-based PictureRLISP much more efficient than the previous
+PictureBALM system. A complete PSL currently runs on DECSystem-20,
+VAX-11/750 under UNIX. A preliminary PSL now runs on an Apollo DOMAIN (a
+Motorola MC68000-based personal machine with high-resolution graphics).
+
+PictureRLISP is capable of driving a number of different graphic output
+devices, and is fairly easy to extend to others. The current devices that
+built-in PictureRLISP drivers support include: Tektronix 4010 (and 'clones,
+such as ADM3a with retrographics board, Apollo Tektronix emulator,etc.);
+Hewlett-Packard HP2648a; Evans and Sutherland MPS-1; AED-512 color
+terminal; and "checkout" graphics on low-resolution devices such as 60 x 80
+Ann-Arbor Ambassador, or 24 x 80 Teleray-1061 or VT100.
+
+PictureRLISP has also been extended to run under EMODE@cite[Galway82], an
+interactive LISP-based, full-screen editor which is similar to EMACS. EMODE
+runs within the PSL environment, and permits the editing of PictureRLISP
+commands and procedures, and then immediate execution from within the
+editing window. One can also define graphics windows to display the models
+presented.
+
+@section(Basic concepts)
+@subsection(Models)
+PictureRLISP usage typically consists of creating, modifying, and
+requesting the display of graphical objects, called "Models". A Model
+is a three dimensional representation of the spatial, topological and
+graphical features of an object. Models can contain any number of
+primitives, which can generally be in any order. PictureRLISP Model
+primitives include: Point Sets, which might be interpreted as
+polygons, connected line segments, curve control points, etc.;
+transformations of objects or coordinate systems in three dimensional
+space; color or appearance attributes; Repeat Specifications, which
+cause sub-sections of the Model to be replicated; named references to
+other Models to be displayed as if they were part of the current
+Model; and procedure calls.
+
+
+ Allowing Models to contain references to other Models
+facilitates dynamic displays and allows the user to structure his data
+in Clusters in a meaningful manner. Sub-Models may be shared among a
+number of Models. Allowing procedure calls to be imbedded within
+Models provides the user with a mechanism which can easily effect
+arbitrary displays, transformations, parameterized models or other
+functions that may be required by a specific application; in some
+cases, it is essential to represent objects by algorithms or
+procedural models.
+@subsection<Coordinate systems, Viewport>
+
+ [ *** This section needs more work ****]
+
+Currently, each device supported by has its own "screen" coordinates,
+and the user has to think of his model sizes in a device specific
+fashion. This is a defect, and we are planning to change the basic system
+so that each device driver will normalize coordiates so that a square
+of side N world-coordinates (or M inches?) will map onto the physical
+screen, with a square aspect ratio. Clipping of objects outside this square
+(cube) and exact placement of the square will be controlled by default
+settings of the View Port and a Global transformation matrix.
+Since both view port and global transformation (for perspective and scaling)
+are adjustable, the idea will be to provide a more natural default.
+Perhaps two or three sets of defualts are desirable, selectable by the user:
+A device independant WORLD view, a semi-device independant PHYSICAL size
+and a very device specific SCREEN view.
+
+@subsection<Example of PictureRLISP>
+As a small example of the flavor of PictureRLISP, the following
+commands will display a set of BOX's of different sizes, after suitable
+device initialization:
+@begin(verbatim)
+BOX := {0,0}_{0,10}_{10,10}_{10,0}_{0,0};
+ % Assigns to BOX a set of connected points for 10*10 box
+SHOW BOX & BOX | ZROT(45) & BOX | SCALE(2);
+ % Display 3 boxes, the original, a rotated box, and
+ % a 20 * 20 box. The & collects a set of unconnected models
+ % and | attaches a transformation (matrix)
+@end(verbatim)
+
+@section(Specification of the PictureRLISP Language)
+PictureRLISP supports the creation and manipulation of Models both by
+means of built-in procedures for the various primitives (points,
+pointsets, and groups) and by means of syntactic extensions, i.e.
+operators which construct Models out of primitives. PictureRLISP
+contains five operators designed to make graphics programs easy to
+read and write. They are denoted by the following special characters:
+{, }, _, & and |, and map to an appropriate set of Lisp procedures.
+
+The following is the set of legal Model primitives:
+@begin(enumerate)
+
+@u(Point.) Points are constructed by using curly brackets, or by the
+function POINT(x,y,z,w), e.g. {x,y} [denotes the point (x, y, 0) in three
+dimensional space]. Points can be described by any one of four ways. A
+single value on the x axis, a two dimensional point, a three
+dimensional point or in homogeneous coordinate space.
+
+@u(Pointset.) The function POINTSET(p,q,..s) or the infix "_" operator is
+used to make Point Sets; e.g. it can be used to make polygons out of
+Points. For example, the usual graphical interpretation of the
+sequence A@ _@ B@ _@ C, where A, B, and C are Points, moves the
+display beam to the point represented by A, draws to B, and then draws
+to C.
+
+@u(Group) A Group is a set of Point Sets or Points and is formed by
+the infix operator & or the function GROUP(ps1,ps2,...psN). Thus models may be
+grouped together and formed into larger models for reference.
+
+@u(Point Set Modifiers.) Point Set Modifiers alter the interpretation
+of any Point Sets within their scope. The curved Point Set Modifier
+BEZIER() causes the points to be interpreted as the specification
+points for a BEZIER curve. The BEZIER curve has as its end points the
+endpoints of the control polygon. BSPLINE() does the same for a closed
+Bspline curve. If a control polygon is not closed then then algorithm
+will create a closed polygon by assuming there is a line segment
+between the endpoints. In order to get these curves a pointset acting
+as control points need to be given. Even though the control points may
+not be closed for a BSPLINE curve the system will close the polygon to
+form a closed BSPLINE curve. Another modifier is that of COLOR() where
+on color drawing systems different color values can be given to the
+model.
+
+@u(Transforms.)
+Transforms are the Model primitives which correspond to
+transformations of objects or coordinate systems in three dimensional
+space. PictureRLISP supports rotation, translation, scaling, perspective
+transformation and clipping. The Transform primitives are:
+@begin<enumerate>
+Translation: Move the specified amount along the
+ specified axis.
+@*XMOVE (deltaX) ; YMOVE (deltaY) ; ZMOVE (deltaZ)
+@*MOVE (deltaX, deltaY, deltaZ)
+@blankspace(1 line)
+These Transforms are implemented as procedures which return a transformation
+matrix as their value.
+
+Scale : Scale the Model SCALE (factor)
+@*XSCALE (factor) ; YSCALE (factor) ; ZSCALE (factor)
+@*SCALE1 (x.scale.factor, y.scale.factor, z.scale.factor)
+@*SCALE <Scale factor>. Scale along all axes.
+@blankspace(1 line)
+These Transforms are implemented as a transformation matrix which will scale
+Models by the specified factors, either uniformly or along only one dimension.
+
+Rotation: Rotate the Model
+@*ROT (degrees) ; ROT (degrees, point.specifying.axis)
+@*XROT (degrees) ; YROT (degrees) ; ZROT (degrees)
+@blankspace(1 line)
+These procedures return a matrix which will rotate Models about the axis
+specified. Currently rotation are limited to being about the three
+coordinate axes, though one would like to be able to specify an arbitrary
+rotation axis.
+
+WINDOW (z.eye,z.screen): The WINDOW primitive assumes that the viewer
+is located along the z axis looking in the positive z direction, and
+that the viewing window is to be centered on both the x and y axis.
+The window function is used to show perspective for models and the
+default window at initialization of the device is set with the eye at
+-300 and with the screen at 60. If one wish to use a right handed
+coordinate system then the eye is in the positive direction.
+
+VWPORT(leftclip,rightclip,topclip,bottomclip): The VWPORT, which specifies
+the region of the screen which is used for display. This is set to a
+convenient default at the time a device is initialized by the device
+drivers.
+@end<enumerate>
+
+@u(Repeat Specifications.)
+This primitive provides the user with a means of replicating a
+section of a Model any number of times as modified by an arbitrary
+Transform, e.g. in different positions.
+The primitive is called REPEATED (number.of.times, my.transform),
+where number.of.times is an integer.
+The section of the Model which is contained within the scope of the Repeat
+Specification is replicated.
+Note that REPEATED is intended to duplicate a sub-image in several different
+places on the screen; it was not designed for animation.
+
+@u(Identifiers of other Models.)
+When an identifier is encountered, the Model referenced is displayed
+as if it were part of the current Model. Allowing Models to contain
+identifiers of other Models greatly facilitates dynamic displays.
+
+@u(Calls to PictureRLISP Procedures.)
+This Model primitive allows procedure calls to be imbedded within
+Models. When the Model interpreter reaches the procedure identifier
+it calls it, passing it the portion of the Model below the procedure
+as an argument. The current transformation matrix and the current pen
+position are available to such procedures as the values of the global
+identifiers GLOBAL!.TRANSFORM and HEREPOINT. This primitive provides
+the user with a mechanism which can be used to easily effect arbitrary
+displays, transformations, functions or models required by a specific
+application. The value of the procedure upon its return is assumed to
+be a legal Model and is SHOW'n; PictureRLISP uses syntax to
+distinguish between calling a procedure at Model-building time and
+imbedding the procedure in the Model to be called at SHOW time; if
+normal procedure call syntax, i.e. proc.name@ (parameters), is used
+then the procedure is called at Model-building time, but if only the
+procedure's identifier is used then the procedure is imbedded in the
+Model.
+
+@u(Global Variables) There are a number of important global variables
+in PictureRLISP whose meaning should be aware of, and which should be
+avoided by the user, unless understood:
+
+@begin<description>
+
+@u<Globals>@\@u<Meaning>
+
+HEREPOINT@\Current cursor position as a 4-vector.
+
+HERE@\Current cursor position as a '(POINT x y z)
+
+ORIGIN@\The vector [0,0,0,1].
+
+GLOBAL!.TRANSFORM@\A global transform specified by the user,
+which is applied to everything as the "last" transformation.
+A default is set in the Device initializtion, but can be changed by
+user as convenient.
+
+MAT!*1@\Unit 4 x 4 transformation matrix.
+
+MAT!*0@\Zero 4 x 4 transformation matrix.
+
+DEV!.@\Name of the current device, for device dependent code.
+
+CURRENT!.TRANSFORM@\The current (cumulative) transformation matrix.
+All points are transformed by this before a move
+or draw. Initialized to GLOBAL!.TRANSFORM before each Display.
+
+CURRENT!.LINE@\The current Pointset modifier, can be 'BEZIER,
+'BSPLINE or the default straight line modifier 'LINE.
+
+!*EMODE@\Tells the system and or user if PictureRlisp is
+in EMODE status.
+@end(description)
+@end(enumerate)
+@newpage
+The following is a BNF-like description of the set of legal Models.
+The meta-symbols used are ::= for "is a" and | for "or".
+Capitalized tokens are non-terminal symbols of the grammar of Models,
+a usage that is adhered to in the text of this report.
+Upper case tokens are PictureRLISP reserved words, which have been defined
+as RLISP procedures, operators and/or macros.
+Lower case tokens can be either numbers or identifiers, but not
+quoted number identifiers,
+except for "string" which denotes either a RLISP item of type string
+or a string identifier.
+@begin(verbatim)
+<Model> ::= NIL
+ | <Simple Model>
+ | <Model> & <Model>
+
+<Simple Model> | <Model Object>
+ | ( <Model> )
+ | <Model> | <Model Modifier>
+ | <Model Identifier>
+ | '<Model Identifier>
+
+
+<Model Object> ::= NIL
+ | <Point Set>
+ | <Model Object Identifier>
+ | '<Model Object Identifier>
+
+<Model Modifier> ::= NIL
+ | <Transform>
+ | <Point Set Modifier>
+
+
+<Transform> ::= XROT (degrees)
+ | YROT (degrees) | ZROT (degrees)
+ | XMOVE (deltaX) | YMOVE (deltaY)
+ | ZMOVE (deltaZ)
+ | MOVE (xdelta, ydelta, zdelta)
+ | SCALE (factor) | XSCALE (factor)
+ | YSCALE (factor)| ZSCALE(factor)
+ | SCALE (x.factor, y.factor, z.factor)
+ | WINDOW (z.eye,z.screen)
+ | <Transform Identifier>
+ | ' <Transform Identifier>
+
+
+Repeat Specification ::= REPEATED (number!.of!.times, Transform)
+
+<Point Set Modifier> ::= | BEZIER()
+ | BSPLINE()
+ | CIRCLE(r)
+ | COLOR(value)
+
+<Point Set> ::= <Point>
+ | <Point> _ <Point Set>
+ | <Point Set Identifier>
+ | '<Point Set Identifier>
+
+<Point> ::= {x} | {x, y} | {x, y, z}
+ | {x,y,z,w}
+ | Point Identifier
+ | ' Point Identifier
+
+@end(verbatim)
+@section<Basic PictureRLISP Procedures>
+It should be emphasized that the typical user of the PictureRLISP
+language need never use some of these primitives directly, nor need he
+even know of their existence. They are called by the procedures which
+are written in RLISP which implement the standard PictureRLISP user
+functions. Nevertheless, they are available for the sophisticated
+user who can utilize them to implement a customized language
+environment. Also, they might serve as an example of the primitives
+that a PictureRLISP implementor would want to add to support other
+devices.
+@subsection(Common Functions)
+@begin<description>
+@b<ERASE()>@\Clears the screen and leaves the
+cursor at the origin.
+
+
+@b<SHOW (pict)>@\Takes a picture and display it on the screen
+
+@b<ESHOW (pict)>@\Erases the whole screen and display "pict"
+
+@b<HP!.INIT()>@\Initializes the operating system's (TOPS-20) view
+of the characteristics of HP2648A terminal.
+
+@b<TEK!.INIT()>@\Initializes the operating system's (TOPS-20) view
+of the characteristics of TEKTRONIX 4006-1 terminal and
+also ADM-3A with Retrographics board.
+
+@b<TEL!.INIT()>@\Initializes the operating system's (TOPS-20) view
+of the graphics characteristics of the Teleray 1061 terminal.
+This is rather crude graphics, on a 24*80 grid, using the character X.
+Nevertheless, it provides a reasonable preview.
+
+@b<MPS!.INIT()>@\Initializes the operating system's (UNIX) on the vax
+ to handle the MPS commands. (currently on the VAX).
+
+@b<ST!.INIT()>@\Initializes the operating system's view of the
+characteristics of the Apollo workstation (a 68000 based system hooked
+up to the DEC 20 or Vax), emulating a TekTronix 4006 and VT-52
+simultaneously in multiple windows.
+
+@b<AED!.INIT()>@\Initializes the operating system's view of the
+graphics color device AED-512 a 4006 tektronix color system.
+
+@end(Description)
+
+@subsection(Low Level Driver Functions)
+Most of these are "generic" names for the device specific procedures
+to do basic drawing, moving, erasing etc. The initialization routine for device XX,
+called XX!.INIT() above, copies the routines, usually called XX!.YYYY into
+the generic names YYYYY.
+@begin(description)
+
+@b<ERASES()>@\Erase the Graphics Screen
+
+@B<GRAPHON()>@\Called by SHOW, ESHOW and ERASE() to put the device into
+graphics mode. May have to turn off normal terminal ECHO, using ECHOOFF(),
+unless running under EMODE.
+
+@b<GRAPHOFF()>@\Called by SHOW, ESHOW and ERASE() to put the device back
+into text mode. May have to turn normal terminal ECHO back on, using ECHOON(),
+unless running under EMODE.
+
+
+@b<MOVES (x, y)>@\Moves the graphics cursor to the point (x, y) where
+x and y are specified in coordinates. These coordinates will be
+converted to absolute location on the screen allowing different
+devices to display the same models whether they have the same
+coordinate systems internaly or not.
+
+@b<DRAWS (x, y)>@\Draws a line from the current cursor position to the
+point specified in screen space.
+
+@end(description)
+@subsection(Low Level Matrix Operations)
+@begin(description)
+@b<MAT!*MAT (new!.transform, current!.transform)>@\This procedure is passed
+two transformation matrices. Each matrix is represented by a 16 element
+vector of floating point or interger numbers. They are concatenated via
+matrix multiplication and returned as the new value of current transform.
+
+@b<PNT!*PNT(point!.1,point!.2)>@\This procedure is passed two 4-vector
+matrices, a value is returned.
+
+@b<PNT!*MAT(point,transformation)>@\This is passed 4-vector and a 4 by
+4 matrix, and returns a new (transformed) point.
+@end<description>
+@section<Internal Representations of PictureRLISP Graphical Objects>
+In the LISP-like internal form, Points and Transforms are
+represented by 4 vectors (homogeneous coordinates, also assuming the model
+has been placed on w=1.0 plane) and 16 element vectors respectively.
+Other Model primitives are represented as operators in LISP S-expressions
+of the form "(operator arg1 arg2... argN)".
+Points and matrices can also be represented as S-expression operators, if
+this is desirable for increased flexibility.
+
+It will be helpful for the PictureRLISP user to know what the
+meaning of the interpreted form is in terms of the PictureRLISP
+parsed form. The operator is some meaningful token, such as POINT,
+TRANSFORM, POINTSET or GROUP; e.g. GROUP is the representation of the user
+level operator "&". The operator is used as a software interpreter
+label, which makes this implementation of a PictureRLISP interpreter
+easy to extend. Here is the table to show the external and corresponding
+internal forms for some basic PictureRLISP operators.
+
+@begin <verbatim>
+@u[Internal Form] @u[External Form] @u[Result on Draw]
+
+(POINT x y z ) {x,y,z} [x,y,z,w]
+
+(POINTSET a b c d) a_b_c_d move to a, then
+ connect b, c, and d.
+
+(GROUP (pointset a b a_b_c_d & e do each pointset in
+ c d) e) turn.
+
+(TRANSFORM f g) f | g apply the transform
+ g to the picture f.
+
+(TRANSFORM point point | draws a circle with
+ (CIRCLE radius)) CIRCLE(radius) radius specified about
+ the center "point".
+
+(TRANSFORM pict pict | draws Bezier curve for
+ (BEZIER) BEZIER() "pict".
+
+(TRANSFORM pict pict | same as (pict |BEZIER())
+ (BSPLINE) BSPLINE() but drawing Bspline curve.
+
+(TRANSFORM pict pict | REPEATED the "pict" is replicated
+ (REPEATED (count,trans) "count" times as modified
+ count trans )) by the specified transform
+ "trans".
+
+For example, the Model
+@end<verbatim>
+@begin(display)
+(A _ B _ C & {1,2} _ B) | XROT (30) | 'TRAN ;
+
+maps to the LISP form:
+
+ (TRANSFORM
+ (TRANSFORM
+ (GROUP (POINTSET A B C) (POINTSET (POINT 1 2) B))
+ (XROT 30))
+ (QUOTE TRAN))
+@end(display)
+
+These structures give a natural hierachical structure as well as
+scope rules to PictureRLISP.
+
+@section<How to run PictureRLISP>
+Models can be built using any number of primitives and transformations
+and assigned to model ID's. Once a model is defined and the device
+has been choosen then the object can be drawn on the graphics device
+by using the commands Show and Eshow, both of which will display the
+model or object on the graphics device and the difference being that
+Eshow will first erase the screen. To erase the screen one can issue
+the command Erase() and all models and object will be erased from the
+screen. Unfortunately one cannot erase individual objects from the
+display device. The following section will give an idea on other
+aspects of running PictureRLISP by example.
+
+@section<Examples of PictureRLISP Commands>
+In the following examples, anything following a % on the same line is
+a comment. Rlisp expressions (or commands) are terminated with a
+semicolon. It is suggested that you execute these examples while
+executing PictureRLISP at one of the terminals to see the correct
+response one would get. Most of these are located in the file
+<stay.pict>exp.red on the DecSystem 20 at Utah and is supplied with the
+release of PictureRLISP.
+
+@begin(verbatim)
+%
+% PictureRLISP Commands to SHOW lots of Cubes
+%
+% Outline is a Point Set defining the 20 by 20
+% square which will be part of the Cubeface
+%
+Outline := { 10, 10} _ {-10, 10} _
+ {-10,-10} _ { 10,-10} _ {10, 10};
+
+% Cubeface will also have an Arrow on it
+%
+Arrow := {0,-1} _ {0,2} & {-1,1} _ {0,2} _ {1,1};
+
+% We are ready for the Cubeface
+
+Cubeface := (Outline & Arrow) | 'Tranz;
+
+% Note the use of static clustering to keep objects
+% meaningful as well as the quoted Cluster
+% to the as yet undefined transformation Tranz,
+% which will result in its evaluation being
+% deferred until SHOW time
+
+% and now define the Cube
+
+Cube := Cubeface
+ & Cubeface | XROT (180) % 180 degrees
+ & Cubeface | YROT ( 90)
+ & Cubeface | YROT (-90)
+ & Cubeface | XROT ( 90)
+ & Cubeface | XROT (-90);
+% In order to have a more pleasant look at
+% the picture shown on the screen we magnify
+% cube by 5 times.
+BigCube := Cube | SCALE 5;
+
+% Set up initial Z Transform for each cube face
+%
+Tranz := ZMOVE (10); % 10 units out
+
+% Now draw cube
+%
+
+SHOW BigCube;
+@blankspace(4 inches)
+% Draw it again rotated and moved left
+%
+SHOW (BigCube | XROT 20 | YROT 30 | ZROT 10);
+@blankspace(4 inches)
+% Dynamically expand the faces out
+%
+Tranz := ZMOVE 12;
+%
+SHOW (BigCube | YROT 30 | ZROT 10);
+@blankspace(4inches)
+% Now show 5 cubes, each moved further right by 80
+%
+Tranz := ZMOVE 10;
+%
+SHOW (Cube | SCALE 2.5 | XMOVE (-240) | REPEATED(5, XMOVE 80));
+@blankspace(4 inches)
+%
+% Now try pointset modifier.
+% Given a pointset (polygon) as control points either a BEZIER or a
+% BSPLINE curve can be drawn.
+%
+Cpts := {0,0} _ {70,-60} _ {189,-69} _ {206,33} _ {145,130} _ {48,130}
+ _ {0,84} $
+%
+% Now draw Bezier curve
+% Show the polygon and the Bezier curve
+%
+SHOW (Cpts & Cpts | BEZIER());
+@blankspace(4 inches)
+% Now draw Bspline curve
+% Show the polygon and the Bspline curve
+%
+SHOW (Cpts & Cpts | BSPLINE());
+@blankspace(4inches)
+% Now work on the Circle
+% Given a center position and a radius a circle will be drawn
+%
+SHOW ( {10,10} | CIRCLE(50));
+@blankspace(3inches)
+
+% Define a procedure which returns a model of
+% a Cube when passed the face to be used
+%
+Symbolic Procedure Buildcube;
+ List 'Buildcube;
+
+% put the name onto the property list
+
+Put('buildcube, 'pbintrp, 'Dobuildcube);
+Symbolic Procedure Dobuildcube Face$
+ Face & Face | XROT(180)
+ & Face | YROT(90)
+ & Face | YROT(-90)
+ & Face | XROT(90)
+ & Face | XROT(-90) ;
+% just return the value of the one statement
+
+
+% Use this procedure to display 2 cubes, with and
+% without the Arrow - first do it by calling
+% Buildcube at time the Model is built
+%
+
+P := Cubeface | Buildcube() | XMOVE(-15) &
+ (Outline | 'Tranz) | Buildcube() | XMOVE 15;
+%
+
+SHOW (P | SCALE 5);
+@blankspace(4inches)
+% Now define a procedure which returns a Model of
+% a cube when passed the half size parameter
+
+Symbolic Procedure CubeModel;
+ List 'CubeModel;
+
+%put the name onto the property list
+
+Put('CubeModel,'Pbintrp, 'DoCubeModel);
+Symbolic Procedure DoCubeModel HSize;
+ << if idp HSize then HSize := eval HSize$
+ { HSize, HSize, HSize} _
+ {-HSize, HSize, HSize} _
+ {-HSize, -HSize, HSize} _
+ { HSize, -HSize, HSize} _
+ { HSize, HSize, HSize} _
+ { HSize, HSize, -HSize} _
+ {-HSize, HSize, -HSize} _
+ {-HSize, -HSize, -HSize} _
+ { HSize, -HSize, -HSize} _
+ { HSize, HSize, -HSize} &
+ {-HSize, HSize, -HSize} _
+ {-HSize, HSize, HSize} &
+ {-HSize, -HSize, -HSize} _
+ {-HSize, -HSize, HSize} &
+ { HSize, -HSize, -HSize} _
+ { HSize, -HSize, HSize} >>;
+
+
+% Imbed the parameterized cube in some Models
+%
+His!.cube := 'His!.size | CubeModel();
+Her!.cube := 'Her!.size | CubeModel();
+R := His!.cube | XMOVE (60) &
+ Her!.cube | XMOVE (-60) ;
+
+% Set up some sizes and SHOW them
+
+His!.size := 50;
+Her!.size := 30;
+%
+SHOW R ;
+@blankspace(4inches)
+%
+% Set up some different sizes and SHOW them again
+%
+His!.size := 35;
+Her!.size := 60;
+%
+SHOW R;
+@blankspace(4inches)
+@end<verbatim>
+
+@section<How to run PictureRLISP on the various devices>
+The current version of PictureRLISP runs on a number of devices at the
+University of Utah. PictureRLISP source is in PU:PRLISP.RED,
+and the device driver library is in the file
+PU:PRLISP-DRIVERS.RED. These files, compiled into the binary LOAD form
+are PRLISP-1.B and PRLISP-2.B. Both are automatically loaded if
+the user invokes LOAD PRLISP; from PSL:RLISP
+(see PSL documentation for implementation and usage of the loader). The
+following contains information concerning the generic form of a device
+driver, and the execution of PictureRLISP under PSL. PictureRLISP is such
+that device drivers can be written for what ever device you are using for a
+graphics display device.
+
+@subsection<Generic Device Driver>
+
+The following is an example of an xxx device driver and its associated
+routines. The main routines of the driver may be divided into three
+areas: low level I/O, basic graphics primitives (eg. move, draw,
+viewport etc.), and the setup routine.
+@begin(verbatim)
+ %***************************
+ % setup functions for *
+ % terminal devices *
+ %***************************
+
+% FNCOPY(NewName,OldName) is used to copy equivalent a
+% device specific function (e.g. xxx-Draws) into the generic
+% procedure name
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % xxx specific Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+% device low level routines to drive the escape sequences for
+% a graphics device. These output procedures will send the various
+% codes to the device to perform the desired generic function
+
+Procedure xxx!.OutChar x; %. RawTerminal I/o
+ Pbout x;
+
+Procedure xxx!.EraseS(); %. EraseS screen, Returns terminal
+ <<xxx!.OutChar Char ESC; %. to Alpha mode and places cursor.
+ xxx!.OutChar Char FF>>;
+% The following procedures are used to simulate the tektronix
+% interface for picturerlisp and are considered the graphics
+% primitives to emulate the system.
+
+
+Procedure xxx!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< xxx!.OutChar HIGHERY NormY YDEST$ %. information to the
+ xxx!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ xxx!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ xxx!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+
+Procedure HIGHERY YDEST$ %. convert Y to higher order Y.
+FIX(YDEST) / 32 + 32$
+
+Procedure LOWERY YDEST$ %. convert Y to lower order Y.
+ REMAINDER (FIX YDEST,32) + 96$
+
+
+Procedure HIGHERX XDEST$ %. convert X to higher order X.
+ FIX(XDEST) / 32 + 32$
+
+Procedure LOWERX XDEST$ %. convert X to lower order X.
+ REMAINDER (FIX XDEST,32) + 64$
+
+
+Procedure xxx!.MoveS(XDEST,YDEST)$
+ <<xxx!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ xxx!.4BYTES (XDEST,YDEST)$
+ xxx!.OutChar 31>> $ %. US: sets terminal to Alpha mode.
+
+Procedure xxx!.DrawS (XDEST,YDEST)$ %. Same as xxx!.MoveS but
+<< xxx!.OutChar 29$ %. draw the line.
+ xxx!.4BYTES (CAR2 HERE, CAR3 HERE)$
+ xxx!.4BYTES (XDEST, YDEST)$
+ xxx!.OutChar 31>> $
+
+Procedure xxx!.NormX DESTX$ %. absolute location along
+ DESTX + 512$ %. X axis.
+
+Procedure xxx!.NormY DESTY$ %. absolute location along
+ DESTY + 390$ %. Y axis.
+
+Procedure xxx!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-512,X1)$ %. the display device
+ X2CLIP := MIN2 (512,X2)$
+ Y1CLIP := MAX2 (-390,Y1)$
+ Y2CLIP := MIN2 (390,Y2) >>$
+
+Procedure xxx!.Delay(); %. some devices may need a
+ NIL; %. delay to flush the buffer output
+
+Procedure xxx!.GRAPHON(); %. set the device in graph mode
+If not !*emode then echooff();
+
+Procedure xxx!.GRAPHOFF(); %. Take the device out of graphics mode
+If not !*emode then echoon();
+
+Procedure xxx!.INIT$ %. Initialization of device specIfic
+Begin %. Procedures equivalent.
+ PRINT "XXX IS DEVICE"$
+ DEV!. := ' XXX;
+ FNCOPY( 'EraseS, 'xxx!.EraseS)$ % should be called as for
+ FNCOPY( 'NormX, 'xxx!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'xxx!.NormY)$ % xxx as the device
+ FNCOPY( 'MoveS, 'xxx!.MoveS)$
+ FNCOPY( 'DrawS, 'xxx!.DrawS)$
+ FNCOPY( 'VWPORT, 'xxx!.VWPORT)$
+ FNCOPY( 'Delay, 'xxx!.Delay)$
+ FNCOPY( 'GraphOn, 'xxx!.GraphOn)$
+ FNCOPY( 'GraphOff, 'xxx!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+@end(verbatim)
+
+The following is a sample session of PSL:Rlisp initializing the device xxx.
+@begin(verbatim)
+@@psl:rlisp
+*PSL 3.0 Rlisp, 9-May-1982
+*[1] load prlisp; % The system types the [1] prompt
+*[2] xxx.init();
+@end(verbatim)
+The system is now ready for pictureRlisp use, and one could then load
+in any other routines for their application.
+
+It should be noted that a number of devices can be loaded into the
+system but presently only one is the current display device at any
+given time.
+
+The following are specifics on each of the devices currently being
+used in PictureRlisp. The coordinate systems mentioned are device
+coordianates and should be transparent to the user.
+
+@subsection<Hp terminal 2648A>
+
+The screen of the HP terminal is 720 units long in the X direction,
+and 360 units high in the Y direction. The coordinate system used in
+HP terminal places the origin in approximately the center of the
+screen, and uses a domain of -360 to 360 and a range of -180 to 180.
+The procedure HP!.INIT() will load in the functions used for the HP
+terminal.
+
+@subsection<Tektronix terminal>
+Similarly, the screen of the TEKTRONIX 4006 and 4010 terminala are 1024
+units long in the X direction, and 780 units high in the Y direction.
+The same origin is used but the domain is -512 to 512 in the X
+direction and the range is -390 to 390 in the Y direction. TEK!.INIT()
+will initialize the tektronix device for displayable graphics.
+
+@subsection<Apollo work station>
+Currently the APOLLO DOMAIN can work station is being used as a terminal to
+the Decsystem 20, using the ST program on the Apollo. The screen is
+split into 2 windows, on of 24*80 lines, emulating a Teleray 1061,
+and the other a 400 * 700 tektronix likes graphics terminal.
+ST!.INIT() is used for initializing the commands for the apollo.
+
+@subsection<Teleray Terminal>
+The teleray terminal can only display characters on the screen. It
+can be used as a "rapid-checkout" device, by
+drawing all lines as a
+sequence of x's. To initialize the teleray the command TEL!.INIT()
+will setup the graphics device to be the teleray terminal.
+This gives a 24 * 80 resolution.
+
+@subsection<Ann Arbaor Ambassador Terminal>
+The teleray terminal can only display characters on the screen. It
+can be used as a "rapid-checkout" device, by
+drawing all lines as a
+sequence of x's. To initialize the teleray the command TEL!.INIT()
+will setup the graphics device to be the teleray terminal.
+This gives a 60 * 80 resolution.
+
+@subsection<Evans and Sutherland Multi Picture System>
+Currently, the MPS can be driven on the gr-vax at the University of
+Utah and is an example of a high level graphics device being driven by
+PictureRLISP. Thus it may be interesting to look at the device driver
+for the mps to get the feel for how PictureRLISP drives high level
+graphics devices. The initialization is done by calling the procedure
+MPS!.INIT().
+
+[???? add the other devices such as the AED, ADM3a+Retro ???]
+
+
+@section<Future Work>
+
+PictureRLISP currently uses a large number of vectors, regenerating points
+at the very lowest level. Since all Clipping and transformation is
+done in LISP, using vectors. This results in very frequent garbage collection,
+a time-consuming and expensive process. On the DEC-20, a grabage takes about 2.5 secs. On the VAX, GC is only 1 second, and happens much less frequently.
+It is planned to optimize this lower level.
+
+Perhaps this could be fixed by using a number of fluid point vectors
+as the only points which exist as vectors.
+
+
+Since all devices currently defined in PRLISP-DRIVERS.RED use a standard
+tektronix interface it becomes impossible under the current version to use
+some features that the devices have defined in hardware. For instance the
+MPS system has bult in clipping, viewport and windowing functions all
+defined in hardeware as well as 3-d display. At this point it is impossible
+for one to use the full features offered by the mps and it seems that it
+would be nice if one could use some of these features.
+
+@section(References)
+@bibliography()
ADDED psl-1983/3-1/help/prlisp2d.hlp
Index: psl-1983/3-1/help/prlisp2d.hlp
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/prlisp2d.hlp
@@ -0,0 +1,41 @@
+2D version of PictureRLISP MLG 4 Jan 1983
+------------------------------------------------------
+
+This is a brief guide to the 2D version of Picture RLISP. This is much
+faster than the full 3D version if only planar displays are required.
+It is the X-Y plane subset of PRLISP. PRLISP can now be run under PSL
+as well, though of course with no syntax.
+
+RLISP Use:
+
+LOAD PRLISP2D; % Load 2D version of PictureRLISP
+HP!.INIT(); % Select Driver, this is most common HP2648a version
+
+Line := {0,0} _ {10,10}; % Line from center towards upper-right
+Show Line; % Draw it
+Show Line | ZROT(25); % Draw rotated by 25 degrees
+Erase(); % Clear screen
+Show Line & (Line | scale 3 | zrot 20 ) | xmove 10;
+
+For more examples, see PU:PR2D-DEMO.RED, use IN "PU:PR2D-DEMO.RED"$
+
+PRLISP2D can also be loaded and run from PSL, but no syntax is
+available:
+
+(LOAD PRLISP2D)
+(HP!.INIT)
+
+(setq LINE (POINTSET (ONEPOINT 0 0) (ONEPOINT 10 10)))
+
+(SHOW LINE)
+(SHOW (TRANSFORM LINE (ZROT 25)))
+
+(ERASE)
+
+(SHOW (GROUP LINE (TRANSFORM
+ (TRANSFORM (TRANSFORM Line (SCALE 3))
+ (ZROT 20))
+ (XMOVE 10))))
+
+For more examples, see PU:PR2D-DEMO.SL, run with
+(LAPIN "PU:PR2D-DEMO.SL")
ADDED psl-1983/3-1/help/showflags.doc
Index: psl-1983/3-1/help/showflags.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/showflags.doc
@@ -0,0 +1,13 @@
+The Names and State of important Flags and Globals can be displayed
+by executing:
+
+ShowFlags(Flag-name-list) or ShowGlobals(Global-Name-List)
+
+If the List is NIL, some default set of Flags or Globals will be
+displayed. Each Flag or Global will have a short descriptive string
+associated with it, under the indicator 'FlagInfo or 'GlobalInfo.
+
+These are stored with
+ DefineFlag(Id,Info-String) % Note that ID does NOT include the !*
+and
+ DefineGlobal(Global,Info-string)
ADDED psl-1983/3-1/help/step.hlp
Index: psl-1983/3-1/help/step.hlp
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/step.hlp
@@ -0,0 +1,33 @@
+STEP(Form:any):any EXPR
+--------------------------------------------------------------------------
+Step is a loadable option (Load Step). Evaluates form,
+single-stepping. Form is printed, preceded by -> on entry, <-> for
+macro expansions. After evaluation, Form is printed preceded by <-
+and followed by the result of evaluation. A single character is read
+at each step to determine the action to be taken:
+
+Control-N (Next)
+ Step to the Next thing. The stepper continues until the next thing
+ to print out, and it accepts another command.
+Space Go to the next thing at this level. In other words, continue to
+ evaluate at this level, but don't step anything at lower levels.
+ This is a good way to skip over parts of the evaluation that don't
+ interest you.
+Control-U (Up)
+ Continue evaluating until we go up one level. This is like the
+ space command, only more so; it skips over anything on the current
+ level as well as lower levels.
+Control-X (eXit)
+ Exit; finish evaluating without any more stepping.
+Control-G, Control-P (Grind)
+ Grind (i.e. prettyprint) the current form.
+Control-R
+ Grind the form in Rlisp syntax.
+Control-E (Editor)
+ Invoke the structure editor on the current form.
+Control-B (Break)
+ Enter a break loop from which you can examine the values of
+ variables and other aspects of the current environment.
+Control-L
+ Redisplay the last 10 pending forms.
+? Display this help file.
ADDED psl-1983/3-1/help/tag-bits.doc
Index: psl-1983/3-1/help/tag-bits.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/tag-bits.doc
@@ -0,0 +1,28 @@
+PSL TAG BITS
+
+TAG TAG*2 Meaning
+ (octal)
+-------------------------------------
+ 0 00 01 Positive Integer
+ 1 02 03 Fixnum
+ 2 04 05 Bignum
+ 3 06 07 Float
+ 4 10 11 String
+ 5 12 13 Byte-Vector
+ 6 14 15 Halfword-Vector
+ 7 16 17 Word-Vector
+ 8 20 21 Vector
+ 9 22 23 Pair
+
+ 15 36 37 Code
+
+ 23 56 57 (Header) Bytes
+ 24 60 61 (Header) Halfwords
+ 25 62 63 (Header) Words
+ 26 64 65 (Header) Vector
+ 27 66 67 Forward
+ 28 70 71 BTR
+ 29 72 73 Unbound
+ 30 74 75 ID
+ 31 76 77 Negative Integer
+-------------------------------------
ADDED psl-1983/3-1/help/time-fnc.doc
Index: psl-1983/3-1/help/time-fnc.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/time-fnc.doc
@@ -0,0 +1,46 @@
+
+
+Time-fnc.sl : code to time function calls.
+
+
+
+Usage:
+
+ do
+ (timef function-name-1 function-name-2 ...)
+
+ Timef is a fexpr.
+ It will redefine the functions named so that timing information is
+ kept on these functions.
+ This information is kept on the property list of the function name.
+ The properties used are `time' and `number-of-calls'.
+
+ (get function-name 'time) gives you the total time in the function.
+ (not counting gc time).
+ Note, this is the time from entrance to exit.
+ The timef function redefines the function with an
+ unwind-protect, so calls that are interrupted
+ by *throws are counted.
+
+ (get function-name 'number-of-calls) gives you the number of times
+ the function is called.
+
+ To stop timing do :
+ (untimef function-name1 ..)
+ or do (untimef) for all functions.
+ (untimef) is a fexpr.
+
+ To print timing information do
+ (print-time-info function-name-1 function-name-2 ..)
+
+ or do (print-time-info) for timing information on all function names.
+
+ special variables used:
+ *timed-functions* : list of all functions currently being timed.
+ *all-timed-functions* : list of all functions ever timed in the
+ current session.
+
+ Comment: if tr is called on a called on a function that is already
+ being timed, and then untimef is called on the function, the
+ function will no longer be traced.
+
ADDED psl-1983/3-1/help/useful.doc
Index: psl-1983/3-1/help/useful.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/useful.doc
@@ -0,0 +1,553 @@
+A number of useful options can be defined by Loading Useful.
+Descriptions follow.
+
+BACKQUOTE and friends
+------------------
+
+(Note that the special symbols decribed here will only work in LISP
+syntax, not RLISP. In RLISP you may simply use the functions
+BACKQUOTE, UNQUOTE, UNQUOTEL, and UNQUOTED)
+
+The backquote symbol "`" is a read macro which introduces a quoted
+expression which may contain the unquote symbols comma "," and
+comma-atsign ",@". Any appropriate form consisting of the unquoted
+expression, calls to the function cons, and quoted expressions are
+produced so that the resulting expression looks like the quoted one
+except that the values of the unquote expressions are substitued in the
+appropriate place. ",@" splices in the value of the subsequent
+expression (i.e. strips off the outer layer of parentheses). Thus
+
+ `(a (b ,x) c d ,@x e f)
+
+is equivalent to
+
+ (cons 'a (cons (list 'b x) (append '(c d) (append x '(e f)))))
+
+In particular, if x is bound to (1 2 3) this will evaluate to
+
+ (a (b (1 2 3)) c d 1 2 3 e f)
+
+",." is like ",@", except it may use destructive operations on its
+argument.
+
+
+
+DESETQ
+------
+
+DESETQ is a destructuring setq. That is, the first argument is a piece
+of list structure whose atoms are all ids. Each is setq'd to the
+corresponding part of the second argument. For instance
+
+ (desetq (a (b) . c) '((1) (2) (3) 4))
+
+setq's a to (1), b to 2, and c to ((3) 4).
+
+
+
+DEFMACRO
+--------
+
+DEFMACRO is a useful tool for defining macros. A DEFMACRO form looks
+like
+
+ (defmacro <name> <pattern> <s1> <s2> ... <sN>)
+
+The <pattern> is an S-expression made of pairs and ids. It is matched
+against the arguments of the macro much like the first argument to
+desetq. All of the non-nil ids in <pattern> are local variables which
+may be used freely in the body (the <si>). When the macro is called
+the <si> are evaluated as in a progn with the local variables in
+<pattern> appropriately bound, and the value of <sN> is returned.
+DEFMACRO is often used with backquote.
+
+
+
+DEFLAMBDA
+---------
+
+Another macro defining macro similar to DEFMACRO is DEFLAMBDA. The
+arguments to DEFLAMBDA are identical to those for DE. The resulting
+macro is simply application of a lambda expression. Thus a function
+defined with DEFLAMBDA will have semantics identical to that of a
+function defined with DE, modulo the ability to dynamically redefine
+the function. This is a convenient way to cause functions to be open
+compiled.
+
+For example, if (NEW-FOO X Y) should return (LIST X Y (LIST X Y)) we do
+not want it to be a simple substitution style macro, in case one of the
+actual arguments has side effects, or is expensive to compute. If we
+define it by
+
+ (DEFLAMBDA NEW-FOO (X Y) (LIST X Y (LIST X Y)))
+
+then we will have the desired behaviour. In particular,
+
+ (NEW-FOO (BAR) (SETQ BAZ (BOOZE)))
+
+will expand to
+
+ ((LAMBDA (X Y)
+ (LIST X Y (LIST X Y)) )
+ (BAR)
+ (SETQ BAZ (BOOZE)) )
+
+
+
+
+
+PROG1
+-----
+
+PROG1 evaluates its arguments in order, like PROGN, but returns the
+value of the first.
+
+
+LET and LET*
+------------
+
+LET is a macro giving a more perspicuous form for writing lambda
+expressions. The basic form is
+
+ (let ((v1 i1) (v2 i2) ...(vN iN))
+ s1
+ s2
+ ...
+ sN)
+
+The i's are evaluated (in an unspecified order), and then the v's are
+bound to these values, the s's evaluated, and the value of the last
+is returned. Note that the i's are evaluated in the outer environment
+before the v's are bound.
+
+LET!* is just like LET, except that it makes the assignments
+sequentially. That is, the first binding is made before the value
+for the second one is computed.
+
+
+MACROEXPAND
+-----------
+
+MACROEXPAND is a useful tool for debugging macro definitions. If given
+one argument, MACROEXPAND will all expand all the macros in that form.
+Often we wish more control over this process. For example, if a macro
+expands into a let, we may not wish to see the LET itself expanded to a
+lambda expression. Therefor additional arguments may be given to
+MACROEXPAND. If these are supplied, only they should be macros, and
+only those specified will be expanded.
+
+
+
+PUSH and POP
+------------
+
+These are convenient macros for adding and deleting things from the
+head of a list. (push item stack) is equivalent to (setq stack (cons
+item stack)), and (pop stack) does (setq stack (cdr stack)) and
+returns the item popped off stack. An additional argument may be
+supplied to pop, in which case it is a variable which is setq'd to the
+popped value.
+
+
+
+INCR and DECR
+-------------
+
+These are convenient macros for incrementing and decrementing numeric
+variables. (incr i) is equivalent to (setq i (add1 i)) and (decr i) to
+(setq i (sub1 i)). Additional arguments may be supplied, which are
+summed and used as the amounts by to increment or decrement.
+
+
+
+DO, DO*, DO-LOOP, and DO-LOOP*
+------------------------------
+
+The DO macro is a general iteration construct similar to that of LISPM
+and friends. However, it does differ in some details; in particular it
+is not compatible with the "old style DO" of MACLISP (which is a crock
+anyway), nor does it support the "no end test means once only"
+convention (which was just an ugly kludge to get an initialized prog).
+DO has the form
+
+(do (i1 i2 ... iN)
+ (test r1 r2 ... rK)
+ s1
+ s2
+ ...
+ sM)
+
+where there may be zero or more i's, r's, and s's. In general the
+i's will have the form
+
+(var init step)
+
+On entry to the DO form, all the inits are evaluated, then the
+variables are bound to their respective inits. The test is evaluated,
+and if non-nil the form evaluates the r's and returns the value of the
+last one. If none are supplied it returns nil. If the test evaluates
+to nil the s's are evaluated, the variables are assigned the values of
+their respective steps in parallel, and the test evaluated again. This
+iteration continues until test evaluates to a non-nil value. Note that
+the inits are evaluated in the surrounding environment, while the steps
+are evaluated in the new environment. The body of the DO (the s's) is
+a prog, and may contain labels and GO's, though use of this is
+discouraged. It may be changed at a later date. RETURN used within a
+DO will return immediately without evaluating the test or exit forms
+(r's).
+
+There are alternative forms for the i's: If the step is omitted, the
+variable's value is left unchanged. If both the init and step are
+omitted or if the i is an id it is initialized to nil, and left
+unchanged. This is particularly useful for introducing dummy variables
+which will be setq'd inside the body.
+
+DO* is like DO, expcept the variable bindings and updatings are done
+sequentially instead of in parallel.
+
+DO-LOOP is like Do, except that it takes an additional argument, a
+prologue. The general form is
+
+(do-loop (i1 i2 ... iN)
+ (p1 p2 ... pJ)
+ (test r1 r2 ... rK)
+ s1
+ s2
+ ...
+ sM)
+
+This is executed just like the corresponding DO, except that after the
+bindings are established and initial values assigned, but before the
+test is first executed the pi's are evaluated, in order. Note that the
+pi's are all evaluated exactly once (assuming that none of the pi's err
+out, or otherwise throw to a surrounding context). DO-LOOP* does the
+variable bindings and undates sequentially instead of in parallel.
+
+
+
+IF, WHEN, and UNLESS for If and Only If Statements
+--------------------------------------------------
+
+IF is a macro to simplify the writing of a common form of COND where
+there are only two clauses and the antecedent of the second is t.
+
+ (if <test> <then-clause> <else1>...<elseN>)
+
+The <then-clause> is evaluated if and only if the test is non-nil,
+otherwise the elses are evaluated, and the last returned. There may be
+zero elses.
+
+Related macros for common COND forms are WHEN and UNLESS.
+
+ (when <test> s1 s2 ... sN)
+
+evaluates the si and returns the value of sN if and only if <test> is
+non-nil. Otherwise WHEN returns nil.
+
+ (unless <test> s1 s2 ... sN) <=> (when (not <test>) s1 s2 ... sN).
+
+
+
+
+PSETQ and PSETF
+---------------
+
+(psetq var1 val1 var2 val2 ... varN valN) setq's the vars to the
+corresponding vals. The vals are all evaluated before any assignments
+are made. That is, this is a parallel setq.
+
+PSETF is to SETF as PSETQ is to SETQ.
+
+
+
+
+
+SETF
+----
+
+USEFUL contains an expanded version of the standard SETF macro. The
+principal difference from the default is that it always returns the
+the thing assigned (i.e. the right hand side). For example,
+
+ (setf (cdr foo) '(x y z))
+
+returns '(x y z). In the default SETF the return value is
+indeterminate.
+
+USEFUL also makes several more functions known to SETF. All the c...r
+functions are included. LIST and CONS are also include, and are
+similar to desetq. For example,
+
+ (setf (list (cons a b) c (car d)) '((1 2) 3 4 5))
+
+sets a to 1, b to (2), c to 3, and rplaca's the car of d to 4. It
+returns ((1 2) 3 4 5).
+
+
+
+
+SHARP-SIGN MACROS
+------------------
+
+USEFUL defines several MACLISP style sharp sign read macros. Note that
+these only work with the LISP reader, not RLISP. Those currently
+included are
+
+ #' : this is like the quote mark ' but is for FUNCTION instead of
+ QUOTE.
+
+ #/ : this returns the numeric form of the following character
+ read without raising it. For example #/a is 97 while
+ #/A is 65.
+ #\ : This is a read macro for the CHAR macro, described in the PSL
+ manual. Not that the argument is raised, if *RAISE it non-nil.
+ For example, #\a = #\A = 65, while #\!a = #\(lower a) = 97.
+ Char has been redefined in USEFUL to be slightly
+ more table driven -- users can now add new "prefixes" such as
+ META or CONTROL: just hang the appropriate function (from integers
+ to integers) off the char-prefix-function property of the "prefix".
+ A LARGE number of additional alias for various characters have been
+ added, including all the "standard" ASCII names like NAK and DC1.
+
+ #. : this causes the following expression to be evaluated at read
+ time. For example, `(1 2 #.(plus 1 2) 4) reads as (1 2 3 4)
+
+ #+ : this reads two expressions, and passes them to the if_system
+ macro. That is, the first should be a system name, and if
+ that is the current system the second argument is returned by
+ the reader. If not, nil is returned. #- is similar, but
+ causes the second arg to be returned only if it is NOT the
+ current system. Note that this does NOT use splice macros,
+ since PSL doesn't have them (I don't really know why not -- at
+ the very least there ought to be a way to tell the reader
+ "ignore this", even if splice macros are thought to be a
+ kludge).
+
+
+
+
+
+FOR
+---
+
+FOR is a general iteration construct similar in many ways to the Lisp
+Machine LOOP construct, and the earlier InterLISP CLISP iteration
+construct. FOR, however, is considerably simpler, far more "lispy",
+and somewhat less powerful. FOR will only work in LISP syntax. In
+fact, loading FOR will, for the time being, "break" RLISP, as it
+redefines the FOR macro. It is hoped that eventually the RLISP parser
+will be modified to emit calls on this new FOR macro instead of the old
+one.
+
+The arguments to FOR are clauses; each clause is itself a list of a
+keyword and one or more arguments. The clauses may introduce local
+variables, specify return values, have side-effects, when the iteration
+should cease, and so on. Before going further, it is probably best to
+give an example. The following function will zip together three lists
+into a list of three element lists.
+
+(de zip3 (x y z) (for (in u x) (in v y) (in w z) (collect (list u v w))))
+
+The three IN clauses specify that their first argument should take
+successive elements of the respective lists, and the COLLECT clause specifies
+that the answer should be a list built out of its argument. For
+example, (zip3 '(1 2 3 4) '(a b c d) '(w x y z)) is
+((1 a w)(2 b x)(3 c y)(4 d z)).
+
+Following are described all the possible clauses. The first few
+introduce iteration variables. Most of these also give some means of
+indicating when iteration should cease. For example, when a list being
+mapped over by an IN clause is exhausted, iteration must cease. If
+several such clauses are given in FOR expression, iteration will cease
+whenever on of the clauses indicates it should, whether or not the
+other clauses indicate that it should cease.
+
+
+
+(in v1 v2) assigns the variable v1 successive elements of the list v2.
+
+This may take an additional, optional argument:
+a function to be applied to the extracted element or sublist before
+it is assigned to the variable. The following returns the sum of the
+lengths of all the elements of L. [rather a kludge -- not sure why this
+is here. Perhaps it should come out again.]
+
+ (de SumLengths (L) (for (in N L length) (sum N)))
+
+For example, (SumLengths '((1 2 3 4 5)(a b c)(x y))) is 10.
+
+
+
+(on v1 v2) assigns the varaible v1 successive cdrs of the list v2.
+
+
+
+(from var init final step) is a numeric clause. The variable is first
+assigned init, and then incremented by step until it is larger than
+final. Init, final, and step are optional. Init and step both default
+to 1, and if final is omitted the iteration will continue until
+stopped by some other means. To specify a step with init or final
+omitted, or a final with init omitted place nil (the constant -- it
+cannot be an expression) in the appropriate slot to be omitted.
+Final and step are only evaluated once.
+
+
+
+(for var init next) assigns the variable init first, and subsequently
+the value of the expression next. Init and next may be omitted. Note
+that this is identical to the behaviour of iterators in a DO.
+
+
+
+(with v1 v2 ... vN) introduces N locals, initialized to nil. In
+addition, each vi may also be of the form (var init), in which case it
+will be initialized to init.
+
+
+
+There are two clauses which allow arbitrary code to be executed before
+the first iteration, and after the last. (initially s1 s2 ... sN) will
+cause the si's to be evaluated in the new environment (i.e. with the
+iteration variables bound to their initial values) before the first
+iteration. (finally s1 s2 ... sN) causes the si's to be evaluated just
+before the function returns.
+
+
+
+(do s1 s2 ... sN) causes the si's to be evaluated at each iteration.
+
+
+
+The next few clauses build up return types. Except for the
+RETURNS/RETURNING clause, they may each take an additional argument
+which specifies that instead of returning the appropriate value, it is
+accumulated in the specified variable. For example, an unzipper might
+be defined as
+
+(de unzip3 (L)
+ (for (in u L) (with X Y Z)
+ (collect (car U) X)
+ (collect (cadr U) Y)
+ (collect (caddr U) Z)
+ (returns (list X Y Z))))
+
+This is essentially the opposite of zip3. Given a list of three element
+lists, it unzips them into three lists, and returns a list of those
+three lists. For example, (unzip '((1 a w)(2 b x)(3 c y)(4 d z)))
+is ((1 2 3 4)(a b c d)(w x y z)).
+
+
+
+(returns exp) causes the given expression to be the value of the FOR.
+Returning is synonymous with returns. It may be given additional
+arguments, in which case they are evaluated in order and the value of
+the last is returned (implicit PROGN).
+
+
+
+(collect exp) causes the succesive values of the expression to be
+collected into a list.
+
+
+
+(adjoin exp) is similar, but only adds an element to the list if it is
+not equal to anything already there.
+
+
+
+(adjoinq exp) is like adjoin, but uses eq instead of equal.
+
+
+
+(conc exp) causes the succesive values to be nconc'd together.
+
+
+
+(join exp) causes them to be appended.
+
+
+
+(union exp) forms the union of all the exp
+
+
+
+(unionq exp), (intersection exp), (intersectionq exp) are similar, but
+use the specified function instead of union.
+
+
+
+(count exp) returns the number of times exp was non-nil.
+
+
+
+(sum exp), (product exp), (maximize exp), and (minimize exp) do the obvious.
+Synonyms are summing, maximizing, and minimizing.
+
+
+
+(always exp) will return t if exp is non-nil on each iteration. If exp
+is ever nil, the loop will terminate immediately, no epilogue code,
+such as that introduced by finally will be run, and nil will be
+returned. (never exp) is equivlent to (always (not exp)).
+
+
+
+Explicit tests for the end of the loop may be given using (while exp).
+The loop will terminate if exp becomes nil at the beginning of an
+iteration. (until exp) is equivalent to (while (not exp)).
+Both while and until may be given additional arguments;
+(while e1 e2 ... eN) is equivalent to (while (and e1 e2 ... eN))
+and (until e1 e2 ... eN) is equivalent to (until (or e1 e2 ... eN)).
+
+
+
+
+(when exp) will cause a jump to the next iteration if exp is nil.
+(unless exp) is equivalent to (when (not exp)).
+
+
+
+Unlike MACLISP and clones' LOOP, FOR does all variable binding/updating
+in parallel. There is a similar macro, FOR*, which does it
+sequentially. All variable binding/updating still preceeds any tests
+or other code. Also note that all WHEN or UNLESS clauses apply to all
+action clauses, not just subsequent ones. This fixed order of
+evaluation makes FOR less powerful than LOOP, but also keeps it
+considerably simpler. The basic order of evaluation is
+
+ 1) bind variables to initial values (computed in the outer environment)
+ 2) execute prologue (i.e. INITIALLY clauses)
+ 3) while none of the termination conditions are satisfied:
+ 4) check conditionalization clauses (WHEN and UNLESS), and start next
+ iteration if all are not satisfied.
+ 5) perform body, collecting into variables as necessary
+ 6) next iteration
+ 7) (after a termination condition is satisfied) execute the epilogue (i. e.
+ FINALLY clauses)
+
+
+
+DEFSWITCH
+---------
+
+Defswitch provides a convenient machanism for declaring variables whose
+values need to be set in a disciplined manner. It is quite similar to
+T's DEFINE-SWITCH. The form of a defswitch expression is
+
+ (defswitch <name> <var> [<read-action> {<set-action>}])
+
+This declares <name> to be a function of no arguments for deterimining
+the value of the variable <var>. <var> is declared fluid. SETF
+will set the value of <var> when given a call on <name> as its first
+argument. When <name> is called <read-action> will be evaluated
+(after the value of the variable is looked up). When it is set the
+<set-action>s will be evaluated (before the value is set). <name> may
+be used as a "free" variable in the <read-action> and <set-action>s, in
+which case it will hold the current value and new value, respectively.
+If <var> is nil an uninterned id will be used for the variable.
+
+Suppose we wish to keep a list in a variable, FOO, but also want to
+always have it's length available in FOOLENGTH. We can do this by
+always accessing FOO by a function as follows:
+
+ (defswitch FOO nil nil (setq FOOLENGTH (length FOO)))
ADDED psl-1983/3-1/help/zbasic.doc
Index: psl-1983/3-1/help/zbasic.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/zbasic.doc
@@ -0,0 +1,602 @@
+
+ZBASIC contains 6 packages --
+ (1) YLSTS -- useful functions for lists.
+ (2) YNUMS -- useful functions for numbers.
+ (3) YSTRS -- useful functions for strings.
+ (4) YIO -- useful functions for user io.
+ (5) YCNTRL -- useful functions for program control.
+ (6) YRARE -- functions we use now, but may eliminate.
+
+ YLSTS -- BASIC LIST UTILITIES
+
+CCAR ( X:any ):any
+CCDR ( X:any ):any
+LAST ( X:list ):any
+NTH-CDR ( L:list N:number ):list
+NTH-ELT ( L:list N:number ):elt of list
+NTH-TAIL( L:list N:number ):list
+TAIL-P ( X:list Y:list ):extra-boolean
+NCONS ( X:any ): (CONS X NIL)
+KWOTE ( X:any ): '<eval of #X>
+MKQUOTE ( X:any ): '<eval of #X>
+RPLACW ( X:list Y:list ):list
+DREMOVE ( X:any L:list ):list
+REMOVE ( X:any L:list ):list
+DSUBST ( X:any Y:any Z:list ):list
+LSUBST ( NEW:list OLD:list X:any ):list
+COPY ( X:list ):list
+TCONC ( P:list X:any ): tconc-ptr
+LCONC ( P:list X:list ):list
+CVSET ( X:list ):set
+ENTER ( ELT:element SET:list ):set
+ABSTRACT( FN:function L:list ):list
+EACH ( L:list FN:function ):extra-boolean
+SOME ( L:list FN:function ):extra-boolean
+INTERSECTION ( SET1:list SET2:list ):extra-boolean
+SETDIFFERENCE ( SET1:list SET2:list ):extra-boolean
+SUBSET ( SET1:any SET2:list ):extra boolean
+UNION ( X:list Y:list ):list
+SEQUAL ( X:list Y:list ):extra boolean
+MAP2C ( X:list Y:list FN:function ):NIL
+MAP2 ( X:list Y:list FN:function ):NIL
+ATSOC ( ALST:list, KEY:atom ):any
+
+
+CCAR( X:any ):any
+ ----
+ Careful Car. Returns car of x if x is a list, else NIL.
+
+CCDR( X:any ):any
+ ----
+ Careful Cdr. Returns cdr of x if x is a list, else NIL.
+
+LAST( X:list ):any
+ ----
+ Returns the last cell in X.
+ E.g. (LAST '(A B C)) = (C), (LAST '(A B . C)) = C.
+
+NTH-CDR( L:list N:number ):list
+ -------
+ Returns the nth cdr of list--0 is the list, 1 the cdr ...
+
+NTH-ELT( L:list N:number ):list
+ -------
+ Returns the nth elt of list--1 is the car, 2 the cadr ...
+
+NTH-TAIL( L:list N:number ):list
+ -------
+ Returns the nth tail of list--1 is the list, 2 the cdr ...
+
+TAIL-P( X:list Y:list ):extra-boolean
+ ------
+ If X is a non-nil tail of Y (X eq cdr Y or cddr Y or...), return X.
+ Renamed to avoid a conflict with TAILP in compiler
+ NCONS( X:any ): (CONS X NIL)
+ -----
+ Returns (CONS X NIL)
+
+ KWOTE( X:any ): '<eval of #X>
+ MKQUOTE( X:any ): '<eval of #X>
+ -------
+ Returns the quoted value of its argument.
+
+RPLACW( X:list Y:list ):list
+ ------
+ Destructively replace the Whole list X by Y.
+
+DREMOVE( X:any L:list ):list
+ -------
+ Remove destructively all equal occurrances of X from L.
+
+REMOVE( X:any L:list ):list
+ ------
+ Return copy of L with all equal occurrences of X removed.
+
+COPY( X:list ):list
+ ----
+ Make a copy of X--EQUAL but not EQ (except for atoms).
+
+DSUBST( X:any Y:any Z:list ):list
+ ------
+ Destructively substitute copies(??) of X for Y in Z.
+
+LSUBST( NEW:list OLD:list X:any ):list
+ ------
+ Substitute elts of NEW (splicing) for the element old in X
+
+TCONC( P:list X:any ): tconc-ptr
+ -----
+ Pointer consists of (CONS LIST (LAST LIST)).
+ Returns (and alters) pointer consisting of (CONS LIST1 (LAST LIST1)),
+ where LIST1 = (NCONC1 LIST X).
+ Avoids searching down the list as nconc1 does, by pointing at last elt
+ of list for nconc1.
+ To use, setq ptr to (NCONS NIL), tconc elts, return car of ptr.
+
+LCONC( P:list X:list ):list
+ -----
+ Same as TCONC, but NCONCs instead of NCONC1s.
+
+CVSET( X:list ):list
+ --------------------
+ Converts list to set, i.e., removes redundant elements.
+
+ENTER( ELT:element SET:list ):list
+ -----
+ Returns (ELT . SET) if ELT is not member of SET, else SET.
+
+ABSTRACT( FN:function L:list ):list
+ --------
+ Returns list of elts of list satisfying FN.
+
+EACH( L:list FN:function ):extra boolean
+ ----
+ Returns L if each elt satisfies FN, else NIL.
+
+SOME( L:list FN:function ):extra boolean
+ ----
+ Returns the first tail of the list whose CAR satisfies function.
+
+INTERSECTION( #SET1:list #SET2:list ):extra boolean
+ ------------
+ Returns list of elts in SET1 which are also members of SET2
+
+SETDIFFERENCE( #SET1:list #SET2:list ):extra boolean
+ -------------
+ Returns all elts of SET1 not members of SET2.
+
+SUBSET( #SET1:any #SET2:list ):extra boolean
+ ------
+ Returns SET1 if each element of SET1 is a member of SET2.
+
+UNION( X:list Y:list ):list
+ -----
+ Returns the union of lists X, Y
+
+SEQUAL( X:list Y:list ):extra boolean
+ ------
+ Returns X if X and Y are set-equal: same length and X subset of Y.
+
+MAP2( X:list Y:list FN:function ):NIL
+ ------
+ Applies FN (of two arguments) to successive paired tails of X and Y.
+
+MAP2C( X:list Y:list FN:function ):NIL
+ ------
+ Applies FN (of two arguments) to successive paired elts of X and Y.
+
+ATSOC( ALST:list, KEY:atom ):any
+ -----
+ Like ASSOC, except uses an EQ check. Returns first element of
+ ALST whose CAR is KEY.
+
+ YNUMS -- BASIC NUMBER UTILITIES
+
+ADD1 ( number ):number EXPR
+SUB1 ( number ):number EXPR
+ZEROP ( any ):boolean EXPR
+MINUSP ( number ):boolean EXPR
+PLUSP ( number ):boolean EXPR
+POSITIVE( X:any ):extra-boolean EXPR
+NEGATIVE( X:any ):extra-boolean EXPR
+NUMERAL ( X:number/digit/any ):boolean EXPR
+GREAT1 ( X:number Y:number ):extra-boolean EXPR
+LESS1 ( X:number Y:number ):extra-boolean EXPR
+GEQ ( X:number Y:number ):extra-boolean EXPR
+LEQ ( X:number Y:number ):extra-boolean EXPR
+ODD ( X:integer ):boolean EXPR
+SIGMA ( L:list FN:function ):integer EXPR
+RAND16 ( ):integer EXPR
+IRAND ( N:integer ):integer EXPR
+
+
+The DEC compiler may optimize calls to PLUS2, DIFFERENCE, EQUAL,
+ LESSP, etc. by converting them to calls to ADD1, SUB1, ZEROP,
+ MINUSP, etc. This will create circular defintions in the
+ conditional defintions, about which the compiler will complain.
+ Such complaints can be ignored.
+
+ADD1( number ):number EXPR
+ ----
+ Note: DEC compiler optimizes (PLUS2 N 1) into (ADD1 N).
+
+SUB1( number ):number EXPR
+ ----
+ Note: DEC compiler optimizes (DIFFERENCE N 1) into (SUB1 N).
+
+ZEROP( X:any ):boolean EXPR
+ -----
+ Returns non-nil iff X equals 0.
+
+MINUSP( N:number ):boolean EXPR
+ ------
+ Returns non-nil iff N is less than 0.
+
+PLUSP( N:number ):boolean EXPR
+ -----
+ Returns non-nil iff N is greater than 0.
+
+ODD( X:integer ):boolean EXPR
+ ---
+ Returns T if x is odd, else NIL.
+ WARNING: EVENP is used by REDUCE to test if a list has even
+ length. ODD and EVENP are thus highly distinct.
+
+POSITIVE( X:any ):boolean EXPR
+ --------
+ Returns non-nil iff X is a positive number.
+
+NEGATIVE( X:any ):boolean EXPR
+ --------
+ Returns non-nil iff X is a negative number.
+
+NUMERAL( X:any ): boolean EXPR
+ -------
+ Returns true for both numbers and digits. Some dialects
+ had been treating the digits as numbers, and this fn is
+ included as a replacement for NUMBERP where NUMBERP might
+ really be checking for digits.
+ N.B.: Digits are characters and thus ID's
+
+GREAT1( X:number Y:number ):extra-boolean EXPR
+ ------
+ Returns X if it is strictly greater than Y, else NIL.
+ GREATERP is simpler if only T/NIL is needed.
+
+LESS1( X:number Y:number ):extra-boolean EXPR
+ -----
+ Returns X if it is strictly less than Y, else NIL
+ LESSP is simpler if only T/NIL is needed.
+
+GEQ( X:number Y:number ):extra-boolean EXPR
+ ---
+ Returns X if it is greater than or equal to Y, else NIL.
+
+LEQ( X:number Y:number ):extra-boolean EXPR
+ ---
+ Returns X if it is less than or equal to Y, else NIL.
+
+SIGMA( L:list, FN:function ):integer EXPR
+ -----
+ Returns sum of results of applying FN to each elt of LST.
+
+RAND16( ):integer EXPR
+ IRAND ( N:integer ):integer EXPR
+ ------
+ Linear-congruential random-number generator. To avoid dependence
+ upon the big number package, we are forced to use 16-bit numbers,
+ which means the generator will cycle after only 2^16.
+ The randomness obtained should be sufficient for selecting choices
+ in VOCAL, but not for monte-carlo experiments and other sensitive
+ stuff.
+ decimal 14933 = octal 35125, decimal 21749 = octal 52365
+
+Returns a new 16-bit unsigned random integer. Leftmost bits are
+ most random so you shouldn't use REMAINDER to scale this to range
+
+Scale new random number to range 0 to N-1 with approximately equal
+ probability. Uses times/quotient instead of remainder to make best
+ use of high-order bits which are most random
+
+ YSTRS -- BASIC STRING UTILITIES
+
+EXPLODEC ( X:any ):char-list EXPR
+EXPLODE2 ( X:any ):char-list EXPR
+FLATSIZE ( X:str ):integer EXPR
+FLATSIZE2( X:str ):integer EXPR
+NTHCHAR ( X:str N:number ):char-id EXPR
+ICOMPRESS( LST:lst ):<interned id> EXPR
+SUBSTR ( STR:str START:num LENGTH:num ):string EXPR
+CAT-DE ( L: list of strings ):string EXPR
+CAT-ID-DE( L: list of strings ):<uninterned id> EXPR
+SSEXPR ( S: string ):<interned id> EXPR
+
+
+EXPLODE2( X:any ):char-list EXPR
+ EXPLODEC( X:any ):char-list EXPR
+ --------
+ List of characters which would appear in PRIN2 of X. If either
+ is built into the interpreter, we will use that defintion for both.
+ Otherwise, the definition below should work, but inefficiently.
+ Note that this definition does not support vectors and lists.
+ (The DEC and IBM interpreters support EXPLODE and EXPLODE2 by using
+ the same internal algorithm that is used for PRIN1 (PRIN2), but put
+ the chars generated into a list instead of printing them.
+ Thus, they work on arbitrary s-expressions.)
+ If either EXPLODEC or EXPLODE2 is defined, the CDE does nothing.
+
+Note: According to the STANDARD LISP REPORT, EXPLODE and EXPLODE2
+ are only defined for atoms. If your interpreter does not support
+ extended EXPLODE and EXPLODE2, then change the second CDE's below
+ for FLATSIZE and FLATSIZE2 to get recursive versions of them.
+
+ FLATSIZE( X:any ):integer EXPR
+ --------
+ Number of chars in a PRIN1 of X.
+ Also equals length of list created by EXPLODE of X,
+ assuming that EXPLODE extends to arbitrary s-expressions.
+ DEC and IBM interpreters use the same internal algorithm that
+ is used for PRIN1, but count chars instead of printing them.
+
+If your EXPLODE only works for atoms, comment out the above
+ CDE and turn the CDE below into DE.
+
+ FLATSIZE2( X:any ):integer EXPR
+ ---------
+ Number of chars in a PRIN2 of X.
+ Also equals length of list created by EXPLODE2 of X,
+ assuming that EXPLODE2 extends to arbitrary s-expressions.
+ DEC and IBM interpreters use the same internal algorithm that
+ is used for PRIN2, but count chars instead of printing them.
+ FLATSIZE will often suffice for FLATSIZE2
+
+If your EXPLODE2 only works for atoms, comment out the CDE above
+ and turn the CDE below into DE.
+
+ NTHCHAR( X:any, N:number ):character-id EXPR
+ -------
+ Returns nth character of EXPLODE2 of X.
+
+ICOMPRESS( LST:list ):interned atom EXPR
+ ---------
+ Returns INTERN'ed atom made by COMPRESS.
+
+SUBSTR( STR:string START:number LENGTH:number ):string EXPR
+ ------
+ Returns a substring of the given LENGTH beginning with the
+ character at location START in the string.
+ NB: The first location of the string is 0.
+ If START or LENGTH is negative, 0 is assumed.
+ If the length given would exceed the end of the string, the
+ subtring returned quietly goes to end of string, no error.
+
+CAT-DE( L: list of expressions ):string EXPR
+ -------
+ Returns a string made from the concatenation of the prin2 names
+ of the expressions in the list. Usually called via CAT macro.
+
+CAT-ID-DE( L: list of any ):uninterned id EXPR
+ -------
+ Returns an id made from the concatenation of the prin2 names
+ of the expressions in the list. Usually called via CAT-ID macro.
+
+SSEXPR( S: string ): id EXPR
+ ------
+ Returns ID `read' from string. Not very robust.
+
+YIO -- simple I/O utilities. All EXPR's.
+
+CONFIRM (#QUEST: string ):boolean
+EATEOL ():NIL
+TTY-DE (#L: list ):NIL
+TTY-TX-DE (#L: list ):NIL
+TTY-XT-DE (#L: list ):NIL
+TTY-TT-DE (#L: list ):NIL
+TTY-ELT (#X: elt ):NIL
+PRINA (#X: any ):NIL
+PRIN1SQ (#X: any ):NIL
+PRIN2SQ (#X: any ):NIL
+PRINCS (#X: single-char-id ):NIL
+--queue-code--
+SEND ():NIL
+SEND-1 (#EE)
+ENQUEUE (#FN #ARG)
+Q-PRIN1 (#E: any ):NIL
+Q-PRINT (#E: any ):NIL
+Q-PRIN2 (#E: any ):NIL
+Q-TERPRI ()
+ONEARG-TERPRI (#E: any ):NIL
+Q-TYO (#N: ascii-code ):NIL
+Q-PRINC (#C: single-char-id ):NIL
+* Q-TTY-DE (#CMDS: list ):NIL
+* Q-TTY-XT-DE (#CMDS: list ):NIL
+* Q-TTY-TX-DE (#CMDS: list ):NIL
+* Q-TTY-TT-DE (#CMDS: list ):NIL
+
+ DE CONFIRM (!#QUEST) (PROG (!#ANS) LP0 (TTY!-XT !#QUEST) LP1 (SEND) (
+SETQ !#ANS (CAR (EXPLODEC (READ)))) (COND ((EQ !#ANS (QUOTE Y)) (PROGN (
+EATEOL) (RETURN T))) ((EQ !#ANS (QUOTE N)) (PROGN (EATEOL) (RETURN NIL))) ((
+EQ !#ANS (QUOTE !?)) (GO LP0)) (T (TTY!-XT Please type Y, N or ?.)) (GO
+LP1)))
+
+Eat (discard) text until $EOL$ or <ESC> seen.
+ <ESC> meaningful only on PDP-10 systems.
+ $EOL$ meaningful only on correctly-implemented Standard-LISP systems.
+ An idea whose time has not yet come...
+ DE TTY!-DE (EOLS!#BEFORE !#L EOLS!#AFTER) (PROG (OLD!#CHAN) (SETQ
+OLD!#CHAN (WRS NIL)) LP1 (COND ((ONEP EOLS!#BEFORE) (TTY!-ELT !$EOL!$)) ((
+ZEROP EOLS!#BEFORE) NIL) (T (PROGN (TTY!-ELT !$EOL!$) (SETQ EOLS!#BEFORE (
+SUB1 EOLS!#BEFORE)) (GO LP1)))) (MAPC !#L (FUNCTION TTY!-ELT)) LP1 (COND ((
+ONEP EOLS!#AFTER) (TTY!-ELT !$EOL!$)) ((ZEROP EOLS!#AFTER) NIL) (T (PROGN (
+TTY!-ELT !$EOL!$) (SETQ EOLS!#AFTER (SUB1 EOLS!#AFTER)) (GO LP2)))) (WRS
+OLD!#CHAN)))
+ So, for now at least, ...
+
+PRINA( X:any ): any
+ -----
+ Prin2s expression, after TERPRIing if it is too big for line, or spacing
+ if it is not at the beginning of a line. Returns the value of X.
+ Except for the space, this is just PRIN2 in the IBM interpreter.
+
+CHRCT (): <number>
+ -----
+ CHaRacter CounT left in line.
+ Also a CDE in YPP.LSP -- built into IMSSS DEC interpreter.
+
+BINARY (#X: boolean): old-value
+ ------
+ Stub for non-IMSSS interpreters.
+ In IMSSS interpreter, will put terminal into binary mode or
+ take it out, according to argument, and return old value.
+
+PRIN1SQ (#X: any)
+ -------
+ PRIN1, Safe, use apostrophe for Quoted expressions.
+ This is essentially a PRIN1 which tries not to exceed the right margin.
+ It exceeds it only in those cases where the pname of a single atom
+ exceeds the entire linelength. In such cases, <big> is printed at the
+ terminal as a warning.
+ (QUOTE xxx) structures are printed in 'xxx form to save space.
+ Again, this is a little superfluous for the IBM interpreter.
+
+
+PRIN2SQ (#X: any)
+ -------
+ PRIN2, Safe, use apostrophe for Quoted expressions.
+ Just like PRIN1SQ, but uses PRIN2 as a basis.
+
+
+PRINCS (#X: single-character-atom)
+ -------
+ PRINC Safe. Does a PRINC, but first worries about right margin.
+
+
+1980 Jul 24 -- New Queued-I/O routines.
+To interface other code to this new I/O method, the following changes
+must be made in other code:
+ PRIN2 --> TTY
+ TERPRI --> $EOL$ inside a TTY, which causes Q-TERPRI to be called
+ TYO --> Q-TYO
+ PRIN1, PRINT -- These are used only for debugging. Do a (SEND) just
+ before starting to print things in realtime, or use Q-PRIN1 etc.
+ TTY -- Ok, expands into TTY-DE which calls Q-PRIN2 and Q-TERPRI.
+ SAY -- I don't know what to do with this crock. It seems to be
+ a poor substitute for TTY. If so it can be changed to TTY
+ with the arguments fixed to be correct. <!GRAM>LPARSE.LSP
+
+
+When *BATCHOUT is NIL, output is done in realtime and *BATCHQUEUE
+ remains NIL. When *BATCHOUT is true, output is queued and SEND
+ executes&dequeues it later.
+ Initialize *BATCHQUEUE for TCONC operations.
+ Initialize *BATCHMAX and *BATCHCNT
+ These call PRIN2, so they would cause double-enqueuing.
+ DE Q!-TTY!-DE (!#CMDS) (COND BATCHOUT (ENQUEUE (QUOTE TTY!-DE) !#CMDS)) (
+1 (TTY!-DE !#CMDS))))
+ DE Q!-TTY!-XT!-DE (!#CMDS) (COND BATCHOUT (ENQUEUE (QUOTE TTY!-XT!-DE)
+!#CMDS)) (1 (TTY!-XT!-DE !#CMDS))))
+ DE Q!-TTY!-TX!-DE (!#CMDS) (COND BATCHOUT (ENQUEUE (QUOTE TTY!-TX!-DE)
+!#CMDS)) (1 (TTY!-TX!-DE !#CMDS))))
+ DE Q!-TTY!-TT!-DE (!#CMDS) (COND BATCHOUT (ENQUEUE (QUOTE TTY!-TT!-DE)
+!#CMDS)) (1 (TTY!-TT!-DE !#CMDS))))
+
+ YCNTRL -- ROUTINES INVOLVED WITH PROGRAM CONTROL STRUCTURES
+
+CATCH ( EXP:s-expression LABELS:id or idlist ):any EXPR
+THROW ( VALU:any LABEL:id ): error label EXPR
+ERRSET-DE ( #EXP #LBL ):any EXPR
+APPLY# ( ARG1: function ARG2: argument:list ):any EXPR
+BOUND ( X:any ):boolean EXPR
+MKPROG ( VARS:id-lst BODY:exp ):prog EXPR
+BUG-STOP (): any EXPR
+
+
+CATCH( EXP:s-expression LABELS:id or idlist ): any EXPR
+ -----
+ For use with throw. If no THROW occurs in expression, then
+ returns value of expression. If thrown label is MEMQ or EQ to
+ labels, then returns thrown value. OW, thrown label is passed
+ up higher. Expression should be quoted, as in ERRORSET.
+
+THROW( VALU:any LABEL:id ): error label EXPR
+ -----
+ Throws value with label up to enclosing CATCH having label.
+ If there is no such CATCH, causes error.
+
+ERRSET-DE ( EXP LBL ):any EXPR
+ Named errset. If error matches label, then acts like errorset.
+ Otherwise propagates error upward.
+ Matching: Every label stops errors NIL, $EOF$.
+ Label 'ERRORX stops any error.
+ Other labels stop errors whose first arg is EQ to them.
+ Usually called via ERRSET macro.
+
+APPLY#(ARG1: function ARG2: argument:list): any EXPR
+ ------
+ Like APPLY, but can use fexpr and macro functions.
+
+BOUND( X:any ): boolean EXPR
+ -----
+ Returns T if X is a bound id.
+
+MKPROG( VARS:id-lst BODY:exp ) EXPR
+ ------
+ Makes a prog around the body, binding the vars.
+
+BUGSTOP ():NIL EXPR
+ -------
+ Enter a read/eval/print loop, exit when OK is seen.
+
+ YRARE -- ROUTINES WHICH ARE USED, BUT OF DUBIOUS USEFULNESS
+ ?? DELETE THESE ??
+
+LOADV ( V:vector FN:function ):vector EXPR
+AMONG ( ALST KEY ITEM ) EXPR
+INSERT ( ITEM ALST KEY ) EXPR
+DCONS ( X:any Y:list ):list EXPR
+SUBLIST ( X:list P1:integer P2:integer ):list EXPR
+SUBLIST1( Y ) EXPR
+LDIFF ( X:list Y:list ):list EXPR used in editor/copy in ZEDIT
+MAPCAR# ( L:list FN:function ):any EXPR
+MAP# ( L:list FN:function ):any EXPR
+INITIALP( X:list Y:list ):boolean EXPR
+SUBLISTP( X:list Y:list ):list EXPR
+INITQ ( X:any Y:list R:fn ):boolean EXPR
+
+
+
+LOADV( V:vector FN:function ):vector EXPR
+ -----
+ Loads vector with values. Function should be 1-place numerical.
+ V[I] _ FN( I ).
+ If value of function is 'novalue, then doesn't change value. ??
+
+AMONG(ALST:association-list KEY:atom ITEM:atom):boolean EXPR
+ -----
+ Tests if item is found under key in association list.
+ Uses EQUAL tests.
+
+INSERT (ITEM:item ALST:association:list KEY:any):association list
+ ------
+ EXPR (destructive operation on ALST)
+ Inserts item in association list under key or if key not present
+ adds (KEY ITEM) to the ALST.
+
+DCONS( X:any Y:list ):list EXPR
+ -----
+ Destructively cons x to list.
+
+SUBLIST( X:list P1:integer P2:integer ):list EXPR
+ -------
+ Returns sublist from p1 to p2 positions, negatives counting from end.
+ I.e., (SUBLIST '(A B C D E) 2 -2) = (B C D)
+
+LDIFF( X:list Y:list ):list EXPR
+ -----
+ If X is a tail of Y, returns the list difference of X and Y,
+ a list of the elements of Y preceeding X.
+
+MAPCAR#( L:list FN:function ):any EXPR
+ -------
+ Extends mapcar to work on general s-expressions as well as lists.
+ The return is of same form, i.e.
+ (MAPCAR# 'ATOM '(A B C . D)) = (T T T . T)
+ Also, if for any member of list the variable SPLICE is set to
+ true by function, then for that member the return from the
+ function is spliced into the return.
+
+MAP#( L:list FN:function ):any EXPR
+ ----
+ Extends map to work on general s-expressions as well as lists.
+
+INITIALP( X:list Y:list ):boolean EXPR
+ --------
+ Returns T if X is EQUAL to some ldiff of Y.
+
+SUBLISTP( X:list Y:list ):list EXPR
+ --------
+ Returns a tail of Y (or T) if X is a sublist of Y.
+
+INITQ( X:any Y:list R:fn ):boolean EXPR
+ -----
+ Returns T if x is an initial portion of Y under the relation R.
ADDED psl-1983/3-1/help/zfiles.doc
Index: psl-1983/3-1/help/zfiles.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/zfiles.doc
@@ -0,0 +1,152 @@
+
+ZFILES contains 2 packages --
+ (1) YFILES -- useful functions for accessing files.
+ (2) YTOPCOM -- useful functions for compiling files.
+
+%%%% YFILES -- BASIC FILE ACCESSING UTILITIES
+File descriptor is a canonical FILE name, gets converted to file
+string:
+
+FILE or (FILE) -> "FILE.LSP"
+(FILE.EXT) -> "File.Ext"
+(DIR FILE) -> "<Dir>File.LSP"
+(DIR FILE EXT) -> "<dir>File.Ext"
+"xxx" -> "xxx"
+
+---------------------------------------------------------------
+
+FORM-FILE ( FILE:DSCR ): filename EXPR
+GRABBER ( SELECTION FILE:DSCR ): NIL EXPR
+DUMPER ( FILE:DSCR ): NIL EXPR
+DUMPFNS-DE ( SELECTION FILE:DSCR ): NIL EXPR
+DUMP-REMAINING ( SELECTION:list DUMPED:list ): NIL EXPR
+FCOPY ( IN:DSCR OUT:DSCR filedscrs ):boolean EXPR
+REFPRINT-FOR-GRAB-CTL( #X: any ):NIL EXPR
+
+G:CREFON Switched on by cross reference program CREF:FILE
+G:JUST:FNS Save only fn names in variable whose name is the first
+ field of filename if T, O/W save all exprs in that variable
+G:FILES List of files read into LISP
+G:SHOW:TRACE Turns backtrace in ERRORSET on if T
+G:SHOW:ERRORS Prints ERRORSET error messages if T
+
+
+
+GRAB( <file description> ) MACRO
+ ===> (GRABBER NIL '<file-dscr>)
+ Reads in entire file, whose system name is created using
+ conventions described in FORM-FILE. See ZMACROS.
+
+GRABFNS( <ids> . <file description> ) MACRO
+ ===> (GRABBER IDS <file-dscr>)
+ Like GRAB, but only reads in specified ids. See ZMACROS.
+
+FORM-FILE( FILE:DSCR ): filename EXPR
+ ---------
+ Takes a file dscr, possibly NIL, and returns a file name
+ corresponding to that dscr and suitable as an argument to OPEN.
+ F:OLD:FILE is set to this file name for future reference.
+ Meanwhile, F:FILE:ID is set to a lisp identifier, and the file
+ name is put on the OPEN:FILE:NAME property of that identifier.
+ The identifier can be used to hold info about the file.
+ E.g. its value may be a list of objects read from the file.
+
+ NB: FORM-FILE is at the lowest level of machine-independant code.
+ MAKE-OPEN-FILE-NAME is a system dependant routine that creates
+ file names specifically tailored to the version of SLISP in use.
+
+
+GRABBER( SELECTION:id-list FILE:DSCR ):T EXPR
+ -------
+ Opens the specified file, applies GRAB-EVAL-CTL to each
+ expression on it, and then closes it. Returns T.
+ See GRAB-EVAL-CTL for important side effects.
+
+GRAB-EVAL-CTL( #SELECTION EXPR#READ FILE#ID ) EXPR
+ -------------
+ Examines each expression read from file, and determines whether
+ to EVAL that expression. Also decides whether to append the
+ expression, or an id taken from it, or nothing at all, to the
+ value of the file id poined at by FILE#ID.
+ The file id is stored for use as an argument to DUMP or COMPILE,
+ for example.
+ Note: G:JUSTFNS suppresses the storage of comments from the file.
+ When reading LAP files, no list of fns is made.
+
+DUMPER( FILE:DSCR : file-dscr ): NIL EXPR
+ ------
+ Dumps file onto disk. Filename as in GRABBER.
+ Prettyprints the defined functions, set variables, and evaluated
+ expressions which are members of the value of the variable filename.
+ (For DEC versions:
+ If IBASE neq 10, puts (SETQ IBASE current:base) at head of file.)
+
+DUMPFNS-DE( FNS FILE:DSCR ): NIL EXPR
+ ----------
+ Like DUMPER. Copies old file, putting new definitions for specified
+ functions/variables.
+ E.g.: (DUMPFNS-DE '(A B) '(FOO)) will first copy verbatim all the
+ expressions on FOO.LSP which do not define A or B.
+ Then the core definitions of A and B are dumped onto the file.
+
+DUMP-REMAINING( SELECTION:list DUMPED:list ) EXPR
+ --------------
+ Taken out of DUMPFNS for ease of reading.
+ Dumps those properties of items in selection which have not
+ already been dumped.
+
+FCOPY( IN:DSCR filename, OUT:DSCR filename ):boolean EXPR
+ -----
+ Reformats file using the prettyprinter. Useful for removing
+ angle brackets or for tightening up function format.
+ Returns T on normal exit, NIL if error reading file.
+
+FCOPY-SQ ( IN:DSCR filename, OUT:DSCR filename ):boolean EXPR
+ -----
+ Reformats file using the compacting printer. Letterizes
+ and reports via '<big>' message long strings.
+ Returns T on normal exit, NIL if error reading file.
+
+ YTOPCOM -- Compiler Control functions
+
+(DF COMPILE-FILE (FILE:NAME)
+(DF COMPILE-IN-CORE (FILE:NAME)
+
+
+
+Commonly used globals. Declared in this file so each individual
+ file doesn't have to declare them.
+ "Other globals/fluids
+ "This flag is checked by COMPILE-FILE.
+
+PPLAP( MODE CODE ) EXPR
+ -----
+ Prints the lap code in some appropriate format.
+ Currently uses PRIN1SQ (PRIN1, Safe, use apostrophe to Quote
+ non-numeric expressions).
+
+COMPILE-FILE( FILE:DSCR ) FEXPR
+ ------------
+ Reads the given file, and creates a corresponding LAP file.
+ Each expression on the original file is mapped into an expression
+ on the LAP file.
+ Comments map into NIL.
+ Function definitions map into the corresponding LAP code.
+ These definitions are compiled, but NOT evaluated -- hence the
+ functions will not be loaded into this core image by this routine.
+ All other expressions are evaluated in an errorset then copied verbatim.
+ EXCEPTION: UNFLUID is evalutated, but converted into a comment
+ when printed, to avoid confusing loader.
+
+
+COMPILE-IN-CORE( FILE:DSCR ):NIL FEXPR
+ ---------------
+ Compiles all EXPRS and FEXPRS on a file and loads compiled code into
+ core. Creates a file FILE:NAME.cpl which is a compilation log
+ consisting of the names of functions compiled and the space used in
+ their loading.
+
+GCMSG( X:boolean ):any EXPR
+ -----
+ Pre-defined in both SLISP and new IBM intpreter, so this cde shouln't
+ do anything. GCMSG turns the garbage collection msgs on or off.
ADDED psl-1983/3-1/help/zmacro.doc
Index: psl-1983/3-1/help/zmacro.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/zmacro.doc
@@ -0,0 +1,285 @@
+
+ZMACRO contains two macro packages --
+ (1) YMACS -- basically useful macros and fexprs.
+ (2) YSAIMACS -- macros used to simulate many SAIL constructs.
+
+ YMACS -- USEFUL MACROS AND FEXPRS (see also YSAIMAC)
+
+* ( X:any ): NIL MACRO
+** ( X:list ) MACRO
+NEQ ( X:any Y:any ):boolean MACRO
+NEQN ( X:any Y:any ):boolean MACRO
+NEQUAL ( X:any Y:any ):boolean MACRO
+MAKE ( variable template ) MACRO
+SETQQ ( variable value ) MACRO
+EXTEND ( function series ) MACRO
+DREVERSE( list ):list MACRO
+APPENDL ( lists ) MACRO
+NCONCL ( lists ) MACRO
+NCONC1 ( lst exp1 ... expn ): any MACRO
+SELECTQ ( exp cases last-resort ) MACRO
+WHILE ( test body ) MACRO
+REPEAT ( body test ) MACRO
+FOREACH ( var in/of lst do/collect exp ) MACRO
+SAY ( test expressions ) MACRO
+DIVERT ( channel expressions ) MACRO
+CAT ( list of any ):string MACRO
+CAT-ID ( list of any ):<uninterned id> MACRO
+TTY ( L:list ):NIL MACRO
+TTY-TX ( L:list ):NIL MACRO
+TTY-XT ( L:list ):NIL MACRO
+TTY-TT ( L:list ):NIL MACRO
+ERRSET ( expression label ) MACRO
+GRAB ( file ) MACRO
+GRABFNS ( ids file-dscr ) MACRO
+DUMP ( file-dscr ) MACRO
+DUMPFNS ( ids file-dscr ) MACRO
+
+used to expand macros:
+XP#SELECTQ (#L#) EXPR
+XP#WHILE (#BOOL #BODY) EXPR
+XP#FOREACH (#VAR #MOD #LST #ACTION #BODY) EXPR
+XP#SAY1 ( expression ) EXPR
+
+
+
+*( X:any ): NIL MACRO
+ ===> NIL
+ For comments--doesn't evaluate anything. Returns NIL.
+ Note: expressions starting with * which are read by the
+ lisp scanner must obey all the normal syntax rules.
+
+**( X:list ) MACRO
+ ===> (PROGN <lists>)
+ For comments--all atoms are ignored, lists evaluated as in PROGN.
+
+NEQ( X:any Y:any ):boolean MACRO
+ ===> (NOT (EQ X Y))
+
+Changed to CDM because NEQ in PSL means NOT EQUAL. We hope to change
+that situation, however.
+
+NEQN( X:any Y:any ):boolean MACRO
+ ===> (NOT (EQN X Y))
+
+NEQUAL( X:any Y:any ):boolean MACRO
+ ===> (NOT (EQUAL X Y))
+
+MAKE( variable template ) MACRO
+ ===> (SETQ <var> <some form using var>)
+ To change the value of a variable depending upon template.
+ Uses similar format for template as editor MBD. There are 3 cases.
+
+ 1) template is numerical:
+ (MAKE VARIABLE 3)
+ = (SETQ VARIABLE (PLUS VARIABLE 3))
+
+ 2) Template is a series, whose first element is an atom:
+ (MAKE VARIABLE ASSOC ITEM)
+ = (SETQ VARIABLE (ASSOC ITEM VARIABLE))
+
+ 3) Otherwise, variable is substituted for occurrences of * in template.
+ (MAKE VARIABLE (ASSOC (CADR *) (CDDR *))
+ = (SETQ VARIABLE (ASSOC (CADR VARIABLE) (CDDR VARIABLE))
+
+SETQQ( variable value ) MACRO
+ ===> (SETQ VARIABLE 'VALUE)
+
+EXTEND( function series ) MACRO
+ ===> (FN ELT1 (FN ELT2 ... (FN ELTn-1 ELTn)))
+ Applies 2-place function to series, similarly to PLUS.
+ E.g.: (EXTEND SETQ A B C D 5) = (SETQ A (SETQ B (SETQ C (SETQ D 5))))
+
+DREVERSE( L: list ):list MACRO
+ ===> (REVERSIP L)
+ Synonym for REVERSIP.
+
+APPENDL( lists ) MACRO
+ ===> (APPEND LIST1 (APPEND LIST2 ....))
+ EXPAND's APPEND to a list of arguments instead of just 2.
+
+NCONCL( lists ) MACRO
+ ===> (NCONC LST1 (NCONC LST2 ....))
+ EXPAND's NCONC to a list of arguments instead of just 2.
+
+NCONC1( lst exp1 ... expn ): any MACRO
+ ===> (NCONC LST (LIST EXP1 ... EXPn))
+ Destructively add exp1 ... exp-n to the end of lst.
+
+SELECTQ( exp cases last-resort ) MACRO
+ ===> (COND ...)
+ Exp is a lisp expression to be evaluated.
+ Each case-i is of the form (key-i exp1 exp2...expm).
+ Last-resort is a lisp expression to be evaluated.
+
+ Generates a COND statement:
+ If key-i is an atom, case-i becomes the cond-pair:
+ ((EQUAL exp key-i) (PROGN exp1 exp2 ... expm))
+ If key-i is a list, case-i becomes the cond-pair:
+ ((MEMBER exp key-i) (PROGN exp1 exp2 ... expm))
+ Last-resort becomes the final cond-pair:
+ (T last-resort)
+
+ If exp is non-atomic, it should not be re-evaluated in each clause,
+ so a dummy variable (#SELECTQ) is set to the value of exp in the
+ first test and that dummy variable is used in all successive tests.
+
+ Note:
+ (1) A FEXPR version of SELECTQ would forbid use of RETURN and GO.
+ (2) The form created must NOT have a prog or lambda wrapped around
+ the cond expression, as this would also forbid RETURN and GO.
+ Since #SELECTQ can't be lambda-bound by any means whatsoever
+ and remain consistent with the standard-lisp report (if GO or
+ RETURN appears inside a consequent), there is no way we can make
+ SELECTQ re-entrant. If you go into a break with ^B or ^H and
+ execute another SELECTQ you will clobber the one and only
+ incarnation of #SELECTQ, and if it happened to be in the middle
+ of deciding which consequent to execute, then when you continue
+ the computation it won't work correctly.
+ Update -- IMSSS break pkg now tries to protect #SELECTQ.
+ Update -- uses XP#SELECTQ which can be compiled to speed up
+ macro expansion.
+
+
+WHILE( test body ) MACRO
+ ===> (PROG ...) <while loop>
+ While test is true do body.
+
+REPEAT( body test ) MACRO
+ ===> (PROG ...) <repeat loop>
+ Repeat body until test is true.
+ Jim found that this fn as we had it was causing compiler errors.
+ The BODY was (CDDR U) and the BOOL was (CADR U). Question:
+ Does the fact that Utah was unable to reproduce our compiler
+ errors lie in this fact. Does function until test becomes non-NIL.
+
+FOREACH( var in/of lst do/collect exp ) MACRO
+ ===> (MAPxx LST (FUNCTION (LAMBDA (VAR) EXP)))
+ Undocumented FOREACH supplied by Utah. Required by compiler.
+ Update: modified to call xp#foreach which can be compiled
+ to speed up macro expansion.
+
+SAY( test expressions ) MACRO
+ ===> (COND (<test> (PROGN (PRIN2 ...) (PRIN2 ...) ...)))
+ If test is true then evaluate and prin2 all expressions.
+ Exceptions: the value of printing functions, those flaged with
+ SAY:PRINT (including: PRINT PRIN1 PRIN2 PRINC TYO PPRINT TERPRI
+ POSN DOHOME DORIGH DOLEFT DOUP DODOWN DPYNCH DPYCHR SETCUR MOVECUR)
+ are just evaluated. E.g.: (In the example @ is used for quotes)
+ (SAY T @this @ (PRIN1 '!!AND!!) @ that@)
+ appears as:
+ this !!AND!! that
+
+DIVERT( channel expressions ) MACRO
+ ===> (PROG (ochan) <select given chan> <eval exps> <select ochan>)
+ Yields PROG that selects channel for output,
+ evaluates each expression, and then reselects prior channel.
+
+CAT( list of any ):string MACRO
+ ===> (CAT-DE (LIST <list>))
+ Evaluates all arguments given and forms a string from the
+ concatenation of their prin2 names.
+
+
+CAT-ID( list of any ):<uninterned id> MACRO
+ ===> (CAT-ID-DE (LIST <list>))
+ Evaluates all arguments given and forms an id from the
+ concatenation of their prin2 names.
+
+TTY ( L:list ):NIL MACRO
+ TTY-TX( L:list ):NIL MACRO
+ TTY-XT( L:list ):NIL MACRO
+ TTY-TT( L:list ):NIL MACRO
+ ===> (TTY-xx-DE (LIST <list>))
+
+ TTY is selected for output, then each elt of list is evaluated and
+ PRIN2'ed, except for $EOL$'s, which cause a TERPRI.
+ Then prior output channel is reselected.
+ TTY-TX adds leading TERPRI. TTY-XT adds trailing TERPRI.
+ TTY-TT adds leading and trailing TERPRI's.
+
+CDMs were making all of the following unloadable into existing
+ QDRIVER.SAV core image. I flushed the 'C' July 27
+
+TTY-DE now takes two extra arguments, for the number of TERPRIs
+ to preceed and follow the other printed material.
+
+ERRSET (expression label) MACRO
+ ===> (ERRSET-DE 'exp 'label)
+ Named errset. If error matches label, then acts like errorset.
+ Otherwise propagates error upward.
+ Matching: Every label stops errors NIL, $EOF$.
+ Label 'ERRORX stops any error.
+ Other labels stop errors whose first arg is EQ to them.
+
+GRAB( <file description> ) MACRO
+ ===> (GRABBER NIL '<file-dscr>)
+ Reads in entire file, whose system name is created using
+ conventions described in FORM-FILE.
+
+GRABFNS( <ids> . <file description> ) MACRO
+ ===> (GRABBER FNS <file-dscr>)
+ Like grab, but only reads in specified fns/vars.
+
+DUMP( <file description> ) MACRO
+ ===> (DUMPER '<file-dscr>)
+ Dumps file onto disk. Filename as in GRAB. Prettyprints.
+
+DUMPFNS( <ids> . <file dscr> ) MACRO
+ ===> (DUMPFNS-DE <fns> '<file-dscr>)
+ Like DUMP, but copies old file, inserting new defs for
+ specified fns/vars
+
+ We are currently defining these to be macros everywhere, but might
+ want them to be exprs while interpreted, in which case use the
+ following to get compile-time macros.
+ PUT (QUOTE NEQ) (QUOTE CMACRO) (QUOTE (LAMBDA (!#X !#Y) (NOT (EQ !#X !#Y))))
+)
+ PUT (QUOTE NEQN) (QUOTE CMACRO) (QUOTE (LAMBDA (!#X !#Y) (NOT (EQN !#X
+!#Y)))))
+ PUT (QUOTE NEQUAL) (QUOTE CMACRO) (QUOTE (LAMBDA (!#X !#Y) (NOT (EQUAL
+!#X !#Y)))))
+
+ YSAIMAC -- MACROS used to simulate SAIL constructs.
+
+macros:
+ DO-UNTIL SAI-IF SAI2-IF SAI-DONE SAI-CONTINUE SAI-WHILE SAI-FOREACH
+ SAI-FOR SAI-BEGIN PBEGIN PRETURN SAI-ASSIGN MSETQ SAI-COLLECT IFC
+ OUTSTR SAI-SAY SAI-& SAI-LENGTH CVSEST CVSEN CVS SUBSTRING-FOR
+ SUBSTRING-TO PUSHES PUSHVARS SLIST SAI-MAPC SAI-EQU
+
+auxiliary exprs used to expand macros:
+ XP#SAY-IF XP#SAI-WHILE XP#SAI-FOREACH XP#SAI-FOR XP#SUBSTRING-TO
+
+
+
+SAI-IF ( sailish if-expression ) MACRO
+ (IF test1 THEN exp1 [ ELSEIF testi THEN expi ] [ELSE expn])
+ ===> (COND (test1 exp1) ... (testi expi) ... (T expn))
+
+ Embedded expressions do not cause embedded COND's, (unlike ALGOL!).
+ Examples:
+ (IF (ATOM Y) THEN (CAR X))
+ (IF (ATOM Y) THEN (CAR X) ELSE (CADR X))
+ (IF (ATOM Y) THEN (CAR X) ELSEIF (ATOM Z) THEN (CADR X))
+
+SAI-WHILE ( sailish while-expression ) MACRO
+ (WHILE b DO e1 e2 ... en) does e1,..., en as long as b is non-nil.
+ ===> (PROG NIL CONTINUE:
+ (COND ((NULL b) (RETURN NIL)))
+ e1 ... en
+ (GO CONTINUE:))
+ N.B. (WHILE b DO ... (RETURN e)) has the RETURN relative to the PROG
+ in the expansion. As in SAIL, (CONTINUE) and DONE work as statements.
+ (They are also macros.)
+
+REM is planning on cleaning this up so it works in all cases...
+ The form that (SUBSTRING-TO stringexpr low high) should expand into is
+ ((LAMBDA (#STRING) (SUBSTR #STRING low high)) stringexpr)
+ except that low and high have been modified to replace INF by
+ explicit calls to (FLATSIZE2 #STRING). Thus things like
+ (SUBSTRING-TO (READ) 2 (SUB1 INF))
+ should work without requiring the user to type the same string twice.
+ Probably that inner (SUBSTR ...) should simply be
+ ((LAMBDA (INF) (SUBSTR #STRING low high)) (FLATSIZE2 #STRING))
+ where we don't have to internally modify low or high at all!
ADDED psl-1983/3-1/help/zpedit.doc
Index: psl-1983/3-1/help/zpedit.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/help/zpedit.doc
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/20-kernel-gen.ctl
Index: psl-1983/3-1/kernel/20/20-kernel-gen.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/20-kernel-gen.ctl
@@ -0,0 +1,4 @@
+
+@psl:psl
+*(lapin "p20:20-kernel-gen.sl")
+*(quit)
ADDED psl-1983/3-1/kernel/20/20-kernel-gen.sl
Index: psl-1983/3-1/kernel/20/20-kernel-gen.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/20-kernel-gen.sl
@@ -0,0 +1,77 @@
+%
+% 20-KERNEL-GEN.SL - Generate scripts for building Dec-20 PSL kernel
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 26 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 21-May-83 Modified to produce Extended-20 version.
+% Took out delete of .MAC files, as some hand patching is (unfortunately)
+% still necessary.
+% 01-Mar-83 Nancy Kendzierski
+% Changed script files to use PathIn, instead of In and DSK:.
+% Changed link file to explicitly use .REL files on P20:.
+% <PSL.20-INTERP>20-KERNEL-GEN.SL.15, 7-Jun-82 12:48:19, Edit by BENSON
+% Converted kernel-file-name* to all-kernel-script...
+% <PSL.20-INTERP>20-KERNEL-GEN.SL.14, 6-Jun-82 05:29:21, Edit by GRISS
+% Add kernel-file-name*
+
+
+(compiletime (load kernel))
+(compiletime (setq *EOLInStringOK T))
+(loadtime (imports '(kernel)))
+
+(setq command-file-name* "%w.ctl")
+
+(setq command-file-format*
+";Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20,pk:
+S:DEC20-CROSS.EXE
+ASMOut ""%w"";
+PathIn ""%w.build"";
+ASMEnd;
+quit;
+compile %w.mac, d%w.mac
+")
+
+(setq init-file-name* "psl.init")
+
+(setq init-file-format* "(lapin ""%w.init"")
+")
+
+(setq all-kernel-script-name* "all-kernel.ctl")
+
+(setq all-kernel-script-format* "submit %w.ctl
+")
+
+(setq code-object-file-name* "%w.rel")
+
+(setq data-object-file-name* "d%w.rel")
+
+(setq link-script-name* "psl-link.ctl")
+
+(setq link-script-format*
+";Modifications to this file may disappear, as this file is generated
+;automatically using information in P20E:20-KERNEL-GEN.SL.
+cd S:
+LINK
+/map
+p20:nil.rel
+/set:.low.:202
+p20:%e
+/save s:pbpsl.exe
+/go
+@get s:pbpsl.exe/u 1
+@save s:bpsl.exe
+")
+
+(setq script-file-name-separator* "
+p20:")
+
+(kernel '(types randm alloc arith debg error eval extra fasl io macro prop
+ symbl sysio tloop main heap))
ADDED psl-1983/3-1/kernel/20/20.sym
Index: psl-1983/3-1/kernel/20/20.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/20.sym
@@ -0,0 +1,1506 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE
+FEXPR)) (PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR)) (PUT (QUOTE !') (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADQUOTEDEXPRESSION)) (PUT (QUOTE !() (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADLISTORDOTTEDPAIR)) (PUT (QUOTE !)) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADRIGHTPAREN)) (PUT (QUOTE ![) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADVECTOR)) (PUT (MKID (CHAR EOF)) (
+QUOTE LISPREADMACRO) (FUNCTION CHANNELREADEOF)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (ID2INT NONIDERROR INT2ID TYPEERROR
+NONINTEGERERROR INT2SYS LISP2CHAR NONCHARACTERERROR INT2CODE SYS2INT GTFIXN
+ID2STRING STRING2VECTOR GTVECT NONSTRINGERROR VECTOR2STRING GTSTR
+NONVECTORERROR LIST2STRING LENGTH NONPAIRERROR STRING2LIST CONS LIST2VECTOR
+VECTOR2LIST GETV BLDMSG STDERROR INDEXERROR PUTV UPBV EVECTORP EGETV EPUTV
+EUPBV INDX RANGEERROR NONSEQUENCEERROR SETINDX SUB SUBSEQ GTWRDS GTHALFWORDS
+NCONS TCONC SETSUB SETSUBSEQ CONCAT APPEND SIZE CODEP EQ FLOATP BIGP IDP
+PAIRP STRINGP VECTORP CAR CDR RPLACA RPLACD FIXP DIGIT LITER EQN LISPEQUAL
+STRINGEQUAL EQSTR EQUAL CAAAAR CAAAR CAAADR CAADAR CAADR CAADDR CADAAR CADAR
+CADADR CADDAR CADDR CADDDR CDAAAR CDAAR CDAADR CDADAR CDADR CDADDR CDDAAR
+CDDAR CDDADR CDDDAR CDDDR CDDDDR CAAR CADR CDAR CDDR SAFECAR SAFECDR ATOM
+CONSTANTP NULL NUMBERP EXPT MKQUOTE LIST3 CONTINUABLEERROR GREATERP
+DIFFERENCE MINUSP TIMES2 ADD1 QUOTIENT PLUS2 LIST EVLIS QUOTE EXPR DE LIST2
+LIST4 PUTD FUNCTION LAMBDA FEXPR DF MACRO DM NEXPR DN SETQ EVAL SET PROG2
+PROGN EVPROGN AND EVAND OR EVOR COND EVCOND NOT ABS MINUS DIVIDE ZEROP
+REMAINDER XCONS MAX ROBUSTEXPAND MAX2 LESSP MIN MIN2 PLUS TIMES MAP
+FASTAPPLY MAPC MAPCAN NCONC MAPCON MAPCAR MAPLIST ASSOC SASSOC PAIR SUBLIS
+DEFLIST PUT DELETE MEMBER MEMQ REVERSE SUBST EXPAND CHANNELPRINT
+CHANNELPRIN1 CHANNELTERPRI PRINT OUT!* NEQ NE GEQ LEQ EQCAR EXPRP GETD
+MACROP FEXPRP NEXPRP COPYD RECIP FIRST SECOND THIRD FOURTH REST REVERSIP
+SUBSTIP DELETIP DELQ DEL DELQIP ATSOC ASS MEM RASSOC DELASC DELASCIP DELATQ
+DELATQIP SUBLA RPLACW LASTCAR LASTPAIR COPY NTH SUB1 PNTH ACONC LCONC MAP2
+MAPC2 CHANNELPRIN2T CHANNELPRIN2 PRIN2T CHANNELSPACES CHANNELWRITECHAR
+SPACES CHANNELTAB CHANNELPOSN TAB FILEP PUTC SPACES2 CHANNELSPACES2 LIST2SET
+LIST2SETQ ADJOIN ADJOINQ UNION UNIONQ XN XNQ INTERSECTION INTERSECTIONQ
+KNOWN!-FREE!-SPACE GTHEAP FATALERROR !%RECLAIM GC!-TRAP!-LEVEL
+SET!-GC!-TRAP!-LEVEL DELHEAP GTCONSTSTR GTBPS GTEVECT GTFLTN GTID RECLAIM
+DELBPS GTWARRAY DELWARRAY COPYSTRINGTOFROM COPYSTRING COPYWARRAY
+COPYVECTORTOFROM COPYVECTOR COPYWRDSTOFROM COPYWRDS TOTALCOPY MKVECT
+MKEVECTOR MKEVECT MKSTRING NONPOSITIVEINTEGERERROR MAKE!-BYTES
+MAKE!-HALFWORDS MAKE!-WORDS MAKE!-VECTOR STRING VECTOR LIST5 GCKNT!* GCTIME!*
+!*GC HEAP!-WARN!-LEVEL ERRORPRINTF TIMC UNMAP!-SPACE RETURNNIL
+RETURNFIRSTARG LAND LOR LXOR LSHIFT LSH LNOT FIX FLOAT ONEP DEBUG TR EVLOAD
+TRST QEDITFNS !*EXPERT !*VERBOSE EDITF EDIT YESP PROMPTSTRING!* FASTBIND
+TERPRI EDITORREADER!* EDITORPRINTER!* FASTUNBIND READ CL HELP BREAK EHELP PL
+UP OK DISPLAYHELPFILE EDITOR IGNOREDINBACKTRACE!* INTERPRETERFUNCTIONS!*
+INTERPBACKTRACE PRINTF BACKTRACE RETURNADDRESSP ADDR2ID VERBOSEBACKTRACE
+OPTIONS!* WRITECHAR CHANNELWRITEUNKNOWNITEM CODE!-ADDRESS!-TO!-SYMBOL PRIN1
+QUIT ERROR NO YES RDS ERROUT!* WRS ERRORSET CURSYM!* !*SEMICOL!* ERRORFORM!*
+!*CONTINUABLEERROR EMSG!* !*BREAK !*EMSGP MAXBREAKLEVEL!* BREAKLEVEL!*
+FLATSIZE USAGETYPEERROR NONNUMBERERROR NONWORDS NONIOCHANNELERROR !*BACKTRACE
+!*INNER!*BACKTRACE THROW !$ERROR!$ ERRSET CATCH CATCHSETUP THROWSIGNAL!*
+!%UNCATCH CHANNELNOTOPEN CHANNELERROR WRITEONLYCHANNEL READONLYCHANNEL
+ILLEGALSTANDARDCHANNELCLOSE IOERROR CODEAPPLY CODEEVALAPPLY BINDEVAL LBIND1
+COMPILEDCALLINGINTERPRETED BSTACKOVERFLOW RESTOREENVIRONMENT !*LAMBDALINK
+UNDEFINEDFUNCTION UNBINDN APPLY FUNBOUNDP FCODEP GETFCODEPOINTER GET
+VALUECELL GETFNTYPE !&!&VALUE!&!& THROWTAG!* CATCH!-ALL UNWIND!-ALL
+!&!&THROWN!&!& !$UNWIND!-PROTECT!$ !&!&TAG!&!& !%THROW UNWIND!-PROTECT
+!*CATCH !*THROW RESET CAPTUREENVIRONMENT !%CLEAR!-CATCH!-STACK PROGBODY!*
+PROGJUMPTABLE!* PROG PBIND1 !$PROG!$ GO RETURN SYSTEM_LIST!* DATE DUMPLISP
+BINARYOPENREAD DEC20OPEN BINARYOPENWRITE VALUECELLLOCATION !*WRITINGFASLFILE
+NEWBITTABLEENTRY!* FINDIDNUMBER MAKERELOCHALFWORD EXTRAREGLOCATION
+FUNCTIONCELLLOCATION FASLIN INTERN PUTENTRY LOADDIRECTORIES!*
+LOADEXTENSIONS!* !*VERBOSELOAD !*PRINTLOADNAMES LOAD LOAD1 RELOAD EVRELOAD
+!*USERMODE !*REDEFMSG !*INSIDELOAD !*LOWER PENDINGLOADS!* IMPORTS PP
+PRETTYPRINT DEFSTRUCT STEP MINI EMODE INVOKE RCREF CREFON COMPILER COMPD
+FASLOUT BUG EXEC MM TERMINALINPUTHANDLER COMPRESSREADCHAR DEC20WRITECHAR
+TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR !$EOL!$ CHANNELREADCHAR
+READCHAR IN!* CHANNELUNREADCHAR UNREADCHAR OPEN SYSTEMOPENFILEFORINPUT
+SYSTEMOPENFILEFOROUTPUT SYSTEMOPENFILESPECIAL SPECIALREADFUNCTION!*
+SPECIALWRITEFUNCTION!* SPECIALCLOSEFUNCTION!* SPECIAL OUTPUT INPUT CLOSE
+SYSTEMMARKASCLOSEDCHANNEL SPECIALRDSACTION!* STDIN!* SPECIALWRSACTION!*
+STDOUT!* CHANNELEJECT EJECT CHANNELLINELENGTH LINELENGTH POSN CHANNELLPOSN
+LPOSN CHANNELREADCH !*RAISE READCH PRINC CHANNELPRINC
+CURRENTREADMACROINDICATOR!* CHANNELREADTOKENWITHHOOKS CHANNELREADTOKEN
+TOKTYPE!* CURRENTSCANTABLE!* CHANNELREAD LISPSCANTABLE!* LISPREADMACRO
+MAKEINPUTAVAILABLE !*INSIDESTRUCTUREREAD CHANNELREADEOF !$EOF!$
+CHANNELREADQUOTEDEXPRESSION CHANNELREADLISTORDOTTEDPAIR
+CHANNELREADRIGHTPAREN CHANNELREADVECTOR !*COMPRESSING !*EOLINSTRINGOK NEWID
+MAKESTRINGINTOLISPINTEGER DIGITTONUMBER PACKAGE CURRENTPACKAGE!* GLOBAL
+RATOM READLINE CHANNELREADLINE OUTPUTBASE!* IDESCAPECHAR!*
+CHANNELWRITESTRING WRITESTRING CHANNELWRITESYSINTEGER CHANNELWRITEBITSTRAUX
+WRITESYSINTEGER CHANNELWRITEFIXNUM CHANNELWRITEINTEGER CHANNELWRITESYSFLOAT
+WRITEFLOAT CHANNELWRITEFLOAT CHANNELPRINTSTRING CHANNELWRITEID
+CHANNELWRITEUNBOUND CHANNELPRINTID CHANNELPRINTUNBOUND
+CHANNELWRITECODEPOINTER CHANNELWRITEBLANKOREOL CHANNELWRITEPAIR PRINLEVEL
+PRINLENGTH RECURSIVECHANNELPRIN2 CHANNELPRINTPAIR RECURSIVECHANNELPRIN1
+CHANNELWRITEVECTOR CHANNELPRINTVECTOR CHANNELWRITEEVECTOR
+OBJECT!-GET!-HANDLER!-QUIETLY CHANNELPRIN CHANNELPRINTEVECTOR
+CHANNELWRITEWORDS CHANNELWRITEHALFWORDS CHANNELWRITEBYTES PRIN2
+FORMATFORPRINTF!* PRIN2L ERRPRIN CHANNELPRINTF EXPLODEENDPOINTER!* EXPLODE
+EXPLODE2 FLATSIZE2 COMPRESSERROR COMPRESSLIST!* CLEARCOMPRESSCHANNEL
+COMPRESS IMPLODE CHANNELTYI CHANNELTYO TYI TYO COMMENTOUTCODE COMPILETIME
+BOTHTIMES LOADTIME STARTUPTIME CONTERROR OTHERWISE DEFAULT CASE RANGE SETF
+EXPANDSETF SETF!-EXPAND ASSIGN!-OP ONOFF!* MKFLAGVAR SIMPFG ON OFF !#ARG DS
+DEFCONST EVDEFCONST CONST STRINGGENSYM STRINGGENSYM!* FOREACH COLLECT JOIN
+CONC IN DO EXIT !$LOOP!$ NEXT WHILE REPEAT FOR GENSYM MK!*SQ SIMP BIN)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 752))
+(SETQ STRINGGENSYM!* (QUOTE "L3141"))
+(PUT (QUOTE TWOARGDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1341"))
+(PUT (QUOTE RELOAD) (QUOTE ENTRYPOINT) (QUOTE RELOAD))
+(PUT (QUOTE RELOAD) (QUOTE IDNUMBER) (QUOTE 568))
+(PUT (QUOTE TWOARGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1358"))
+(PUT (QUOTE COPYITEM1) (QUOTE ENTRYPOINT) (QUOTE "L1302"))
+(PUT (QUOTE INTLESSP) (QUOTE ENTRYPOINT) (QUOTE "L1488"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NEQ) (QUOTE ENTRYPOINT) (QUOTE NEQ))
+(PUT (QUOTE NEQ) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE LIST2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0061"))
+(PUT (QUOTE LIST2STRING) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE SPECIALRDSACTION!*) (QUOTE IDNUMBER) (QUOTE 615))
+(FLAG (QUOTE (SPECIALRDSACTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CLEARCOMPRESSCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L2914"))
+(PUT (QUOTE CLEARCOMPRESSCHANNEL) (QUOTE IDNUMBER) (QUOTE 703))
+(PUT (QUOTE DEFSTRUCT) (QUOTE ENTRYPOINT) (QUOTE "L2218"))
+(PUT (QUOTE DEFSTRUCT) (QUOTE IDNUMBER) (QUOTE 578))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE MAKERELOCHALFWORD) (QUOTE IDNUMBER) (QUOTE 556))
+(PUT (QUOTE BACKTRACE1) (QUOTE ENTRYPOINT) (QUOTE "L1677"))
+(PUT (QUOTE DO) (QUOTE IDNUMBER) (QUOTE 741))
+(PUT (QUOTE THROWSIGNAL!*) (QUOTE IDNUMBER) (QUOTE 500))
+(FLAG (QUOTE (THROWSIGNAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE PRINLEVEL) (QUOTE IDNUMBER) (QUOTE 678))
+(FLAG (QUOTE (PRINLEVEL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EJECT) (QUOTE ENTRYPOINT) (QUOTE EJECT))
+(PUT (QUOTE EJECT) (QUOTE IDNUMBER) (QUOTE 620))
+(PUT (QUOTE LISPREADMACRO) (QUOTE IDNUMBER) (QUOTE 638))
+(PUT (QUOTE STRING2LIST) (QUOTE ENTRYPOINT) (QUOTE "L0072"))
+(PUT (QUOTE STRING2LIST) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE EXIT) (QUOTE ENTRYPOINT) (QUOTE EXIT))
+(PUT (QUOTE EXIT) (QUOTE IDNUMBER) (QUOTE 742))
+(PUT (QUOTE ONEARGDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1370"))
+(PUT (QUOTE STRING2VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0042"))
+(PUT (QUOTE STRING2VECTOR) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1825"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE BACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1672"))
+(PUT (QUOTE BACKTRACE) (QUOTE IDNUMBER) (QUOTE 462))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1821"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 507))
+(PUT (QUOTE RETURNNIL) (QUOTE ENTRYPOINT) (QUOTE "L1395"))
+(PUT (QUOTE RETURNNIL) (QUOTE IDNUMBER) (QUOTE 421))
+(PUT (QUOTE CHANNELWRITESYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2564"))
+(PUT (QUOTE CHANNELWRITESYSINTEGER) (QUOTE IDNUMBER) (QUOTE 662))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1103"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE GENSYM) (QUOTE IDNUMBER) (QUOTE 748))
+(PUT (QUOTE ONEARGPREDICATEDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1383"))
+(PUT (QUOTE VERBOSEBACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1690"))
+(PUT (QUOTE VERBOSEBACKTRACE) (QUOTE IDNUMBER) (QUOTE 465))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 477))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 604))
+(PUT (QUOTE !*EMSGP) (QUOTE IDNUMBER) (QUOTE 485))
+(PUT (QUOTE !*EMSGP) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE TYI) (QUOTE ENTRYPOINT) (QUOTE TYI))
+(PUT (QUOTE TYI) (QUOTE IDNUMBER) (QUOTE 708))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 519))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L1706"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 745))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE SECOND) (QUOTE ENTRYPOINT) (QUOTE SECOND))
+(PUT (QUOTE SECOND) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 694))
+(PUT (QUOTE CURSYM!*) (QUOTE IDNUMBER) (QUOTE 479))
+(PUT (QUOTE CHANNELTYI) (QUOTE ENTRYPOINT) (QUOTE "L2920"))
+(PUT (QUOTE CHANNELTYI) (QUOTE IDNUMBER) (QUOTE 706))
+(PUT (QUOTE FLOATREMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1444"))
+(PUT (QUOTE SASSOC) (QUOTE ENTRYPOINT) (QUOTE SASSOC))
+(PUT (QUOTE SASSOC) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE OLDHEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE OLDHEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1087"))
+(PUT (QUOTE OLDHEAPTRAPBOUND) (QUOTE WVAR) (QUOTE OLDHEAPTRAPBOUND))
+(PUT (QUOTE ADDR2ID) (QUOTE IDNUMBER) (QUOTE 464))
+(PUT (QUOTE ROBUSTEXPAND) (QUOTE ENTRYPOINT) (QUOTE "L0805"))
+(PUT (QUOTE ROBUSTEXPAND) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE INTREMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1443"))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 444))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 8209))
+(PUT (QUOTE TWOARGDISPATCH1) (QUOTE ENTRYPOINT) (QUOTE "L1342"))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE CURRENTPACKAGE!*) (QUOTE IDNUMBER) (QUOTE 653))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE ENTRYPOINT) (QUOTE "L2022"))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 538))
+(PUT (QUOTE SETSUBSEQ) (QUOTE ENTRYPOINT) (QUOTE "L0262"))
+(PUT (QUOTE SETSUBSEQ) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE PNTH) (QUOTE ENTRYPOINT) (QUOTE PNTH))
+(PUT (QUOTE PNTH) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE PACKAGE) (QUOTE ENTRYPOINT) (QUOTE "L2551"))
+(PUT (QUOTE PACKAGE) (QUOTE IDNUMBER) (QUOTE 652))
+(PUT (QUOTE MAKEDS) (QUOTE ENTRYPOINT) (QUOTE MAKEDS))
+(PUT (QUOTE !*USERMODE) (QUOTE IDNUMBER) (QUOTE 570))
+(FLAG (QUOTE (!*USERMODE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !*REDEFMSG) (QUOTE IDNUMBER) (QUOTE 571))
+(FLAG (QUOTE (!*REDEFMSG)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SAVE!-INTO!-FILE) (QUOTE ENTRYPOINT) (QUOTE "L2087"))
+(PUT (QUOTE CHANNELPRINTID) (QUOTE ENTRYPOINT) (QUOTE "L2601"))
+(PUT (QUOTE CHANNELPRINTID) (QUOTE IDNUMBER) (QUOTE 673))
+(PUT (QUOTE BUG) (QUOTE ENTRYPOINT) (QUOTE BUG))
+(PUT (QUOTE BUG) (QUOTE IDNUMBER) (QUOTE 588))
+(PUT (QUOTE LPOSN) (QUOTE ENTRYPOINT) (QUOTE LPOSN))
+(PUT (QUOTE LPOSN) (QUOTE IDNUMBER) (QUOTE 625))
+(PUT (QUOTE IGNOREDINBACKTRACE!*) (QUOTE IDNUMBER) (QUOTE 458))
+(PUT (QUOTE IGNOREDINBACKTRACE!*) (QUOTE INITIALVALUE) (QUOTE (EVAL APPLY
+FASTAPPLY CODEAPPLY CODEEVALAPPLY CATCH ERRORSET EVPROGN TOPLOOP BREAKEVAL
+BINDEVAL BREAK MAIN)))
+(PUT (QUOTE DEFAULT) (QUOTE IDNUMBER) (QUOTE 717))
+(PUT (QUOTE DOPNTH) (QUOTE ENTRYPOINT) (QUOTE DOPNTH))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE STRINGGENSYM) (QUOTE ENTRYPOINT) (QUOTE "L3053"))
+(PUT (QUOTE STRINGGENSYM) (QUOTE IDNUMBER) (QUOTE 734))
+(PUT (QUOTE FLOATSUB1) (QUOTE ENTRYPOINT) (QUOTE "L1504"))
+(PUT (QUOTE TAB) (QUOTE ENTRYPOINT) (QUOTE TAB))
+(PUT (QUOTE TAB) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE COPYWRDSTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1152"))
+(PUT (QUOTE COPYWRDSTOFROM) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE MEMBER) (QUOTE ENTRYPOINT) (QUOTE MEMBER))
+(PUT (QUOTE MEMBER) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE EXPRP) (QUOTE ENTRYPOINT) (QUOTE EXPRP))
+(PUT (QUOTE EXPRP) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE LNOT) (QUOTE ENTRYPOINT) (QUOTE LNOT))
+(PUT (QUOTE LNOT) (QUOTE IDNUMBER) (QUOTE 428))
+(PUT (QUOTE ONEARGPREDICATEDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1382"))
+(PUT (QUOTE ACONC) (QUOTE ENTRYPOINT) (QUOTE ACONC))
+(PUT (QUOTE ACONC) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE PRETTYPRINT) (QUOTE ENTRYPOINT) (QUOTE "L2211"))
+(PUT (QUOTE PRETTYPRINT) (QUOTE IDNUMBER) (QUOTE 577))
+(PUT (QUOTE !$PROG!$) (QUOTE IDNUMBER) (QUOTE 543))
+(PUT (QUOTE ERRSET) (QUOTE ENTRYPOINT) (QUOTE ERRSET))
+(PUT (QUOTE ERRSET) (QUOTE IDNUMBER) (QUOTE 497))
+(PUT (QUOTE DIVIDE) (QUOTE ENTRYPOINT) (QUOTE DIVIDE))
+(PUT (QUOTE DIVIDE) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE DELETE) (QUOTE ENTRYPOINT) (QUOTE DELETE))
+(PUT (QUOTE DELETE) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE NONINTEGER2ERROR) (QUOTE ENTRYPOINT) (QUOTE "L1364"))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0372"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 612))
+(PUT (QUOTE PRINLENGTH) (QUOTE IDNUMBER) (QUOTE 679))
+(FLAG (QUOTE (PRINLENGTH)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE XNQ) (QUOTE ENTRYPOINT) (QUOTE XNQ))
+(PUT (QUOTE XNQ) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE TYO) (QUOTE ENTRYPOINT) (QUOTE TYO))
+(PUT (QUOTE TYO) (QUOTE IDNUMBER) (QUOTE 709))
+(PUT (QUOTE !*THROW) (QUOTE ENTRYPOINT) (QUOTE "L2010"))
+(PUT (QUOTE !*THROW) (QUOTE IDNUMBER) (QUOTE 535))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0676"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE ERRORFORM!*) (QUOTE IDNUMBER) (QUOTE 481))
+(FLAG (QUOTE (ERRORFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !*INSIDELOAD) (QUOTE IDNUMBER) (QUOTE 572))
+(FLAG (QUOTE (!*INSIDELOAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLOATMINUSP) (QUOTE ENTRYPOINT) (QUOTE "L1540"))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 511))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE MAP) (QUOTE ENTRYPOINT) (QUOTE MAP))
+(PUT (QUOTE MAP) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE FOURTH) (QUOTE ENTRYPOINT) (QUOTE FOURTH))
+(PUT (QUOTE FOURTH) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE LXOR) (QUOTE ENTRYPOINT) (QUOTE LXOR))
+(PUT (QUOTE LXOR) (QUOTE IDNUMBER) (QUOTE 425))
+(PUT (QUOTE COMPD) (QUOTE ENTRYPOINT) (QUOTE COMPD))
+(PUT (QUOTE COMPD) (QUOTE IDNUMBER) (QUOTE 586))
+(PUT (QUOTE CHANNELPRINTVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2701"))
+(PUT (QUOTE CHANNELPRINTVECTOR) (QUOTE IDNUMBER) (QUOTE 684))
+(PUT (QUOTE BOTHTIMES) (QUOTE ENTRYPOINT) (QUOTE "L2924"))
+(PUT (QUOTE BOTHTIMES) (QUOTE IDNUMBER) (QUOTE 712))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2253"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 521))
+(PUT (QUOTE VALUECELL) (QUOTE IDNUMBER) (QUOTE 523))
+(PUT (QUOTE CHANNELPRINTPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2662"))
+(PUT (QUOTE CHANNELPRINTPAIR) (QUOTE IDNUMBER) (QUOTE 681))
+(PUT (QUOTE WRITESYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2574"))
+(PUT (QUOTE WRITESYSINTEGER) (QUOTE IDNUMBER) (QUOTE 664))
+(PUT (QUOTE BACKTRACERANGE) (QUOTE ENTRYPOINT) (QUOTE "L1669"))
+(PUT (QUOTE KNOWN!-FREE!-SPACE) (QUOTE ENTRYPOINT) (QUOTE "L1089"))
+(PUT (QUOTE KNOWN!-FREE!-SPACE) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE DIGIT) (QUOTE ENTRYPOINT) (QUOTE DIGIT))
+(PUT (QUOTE DIGIT) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE FASLIN) (QUOTE ENTRYPOINT) (QUOTE FASLIN))
+(PUT (QUOTE FASLIN) (QUOTE IDNUMBER) (QUOTE 559))
+(PUT (QUOTE LIST2SETQ) (QUOTE ENTRYPOINT) (QUOTE "L1050"))
+(PUT (QUOTE LIST2SETQ) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE CHANNELWRITEINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2576"))
+(PUT (QUOTE CHANNELWRITEINTEGER) (QUOTE IDNUMBER) (QUOTE 666))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE PUTC) (QUOTE ENTRYPOINT) (QUOTE PUTC))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE DELASC) (QUOTE ENTRYPOINT) (QUOTE DELASC))
+(PUT (QUOTE DELASC) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE FOREACH) (QUOTE ENTRYPOINT) (QUOTE "L3073"))
+(PUT (QUOTE FOREACH) (QUOTE IDNUMBER) (QUOTE 736))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L1855"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 512))
+(PUT (QUOTE MM) (QUOTE ENTRYPOINT) (QUOTE MM))
+(PUT (QUOTE MM) (QUOTE IDNUMBER) (QUOTE 590))
+(PUT (QUOTE FLOATINTARG) (QUOTE ENTRYPOINT) (QUOTE "L1538"))
+(PUT (QUOTE MKEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1198"))
+(PUT (QUOTE MKEVECTOR) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE MAKEBUFINTOLISPINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2393"))
+(PUT (QUOTE DELASCIP) (QUOTE ENTRYPOINT) (QUOTE "L0947"))
+(PUT (QUOTE DELASCIP) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE ZEROP) (QUOTE ENTRYPOINT) (QUOTE ZEROP))
+(PUT (QUOTE ZEROP) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE FLOATGREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1484"))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE CHANNELREADVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2368"))
+(PUT (QUOTE CHANNELREADVECTOR) (QUOTE IDNUMBER) (QUOTE 646))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE DELASCIP1) (QUOTE ENTRYPOINT) (QUOTE "L0940"))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 600))
+(FLAG (QUOTE (IN!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE INTLSHIFT) (QUOTE ENTRYPOINT) (QUOTE "L1475"))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE MAPC2) (QUOTE ENTRYPOINT) (QUOTE MAPC2))
+(PUT (QUOTE MAPC2) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE EDITORPRINTER!*) (QUOTE IDNUMBER) (QUOTE 446))
+(FLAG (QUOTE (EDITORPRINTER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1081"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE CHANNELWRITEBYTES) (QUOTE ENTRYPOINT) (QUOTE "L2778"))
+(PUT (QUOTE CHANNELWRITEBYTES) (QUOTE IDNUMBER) (QUOTE 691))
+(PUT (QUOTE EXPLODE) (QUOTE ENTRYPOINT) (QUOTE "L2903"))
+(PUT (QUOTE EXPLODE) (QUOTE IDNUMBER) (QUOTE 698))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SPECIAL) (QUOTE IDNUMBER) (QUOTE 610))
+(PUT (QUOTE RCREF) (QUOTE IDNUMBER) (QUOTE 583))
+(PUT (QUOTE EVRELOAD) (QUOTE ENTRYPOINT) (QUOTE "L2172"))
+(PUT (QUOTE EVRELOAD) (QUOTE IDNUMBER) (QUOTE 569))
+(PUT (QUOTE INTERPRETERFUNCTIONS!*) (QUOTE IDNUMBER) (QUOTE 459))
+(PUT (QUOTE INTERPRETERFUNCTIONS!*) (QUOTE INITIALVALUE) (QUOTE (COND PROG
+AND OR PROGN SETQ)))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 634))
+(FLAG (QUOTE (TOKTYPE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYFROMBASE) (QUOTE ENTRYPOINT) (QUOTE "L1273"))
+(PUT (QUOTE INTSUB1) (QUOTE ENTRYPOINT) (QUOTE "L1503"))
+(PUT (QUOTE MIN) (QUOTE ENTRYPOINT) (QUOTE MIN))
+(PUT (QUOTE MIN) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE CHANNELWRITEEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2714"))
+(PUT (QUOTE CHANNELWRITEEVECTOR) (QUOTE IDNUMBER) (QUOTE 685))
+(PUT (QUOTE CHANNELPOSN) (QUOTE ENTRYPOINT) (QUOTE "L2330"))
+(PUT (QUOTE CHANNELPOSN) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 475))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1829"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 508))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE COPYFROMRANGE) (QUOTE ENTRYPOINT) (QUOTE "L1287"))
+(PUT (QUOTE REMAINDER) (QUOTE ENTRYPOINT) (QUOTE "L1442"))
+(PUT (QUOTE REMAINDER) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE !*VERBOSELOAD) (QUOTE IDNUMBER) (QUOTE 564))
+(FLAG (QUOTE (!*VERBOSELOAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYSTRINGTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1127"))
+(PUT (QUOTE COPYSTRINGTOFROM) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE ID2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0035"))
+(PUT (QUOTE ID2STRING) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L2893"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 695))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L1080"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L1110"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L2884"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 418))
+(PUT (QUOTE !*VERBOSE) (QUOTE IDNUMBER) (QUOTE 438))
+(FLAG (QUOTE (!*VERBOSE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EUPBV) (QUOTE ENTRYPOINT) (QUOTE EUPBV))
+(PUT (QUOTE EUPBV) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1082"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE NEWBITTABLEENTRY!*) (QUOTE IDNUMBER) (QUOTE 554))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE ENTRYPOINT) (QUOTE "L2558"))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 660))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0597"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE GETV) (QUOTE ENTRYPOINT) (QUOTE GETV))
+(PUT (QUOTE GETV) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE !*INSIDESTRUCTUREREAD) (QUOTE IDNUMBER) (QUOTE 640))
+(FLAG (QUOTE (!*INSIDESTRUCTUREREAD)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FLOATLESSP) (QUOTE ENTRYPOINT) (QUOTE "L1489"))
+(PUT (QUOTE CL) (QUOTE IDNUMBER) (QUOTE 449))
+(FLAG (QUOTE (CL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MACROP) (QUOTE ENTRYPOINT) (QUOTE MACROP))
+(PUT (QUOTE MACROP) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE CONTERROR) (QUOTE ENTRYPOINT) (QUOTE "L2932"))
+(PUT (QUOTE CONTERROR) (QUOTE IDNUMBER) (QUOTE 715))
+(PUT (QUOTE FLOATONEP) (QUOTE ENTRYPOINT) (QUOTE "L1549"))
+(PUT (QUOTE ONEP) (QUOTE ENTRYPOINT) (QUOTE ONEP))
+(PUT (QUOTE ONEP) (QUOTE IDNUMBER) (QUOTE 431))
+(PUT (QUOTE LOAD) (QUOTE ENTRYPOINT) (QUOTE LOAD))
+(PUT (QUOTE LOAD) (QUOTE IDNUMBER) (QUOTE 566))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE VECTOR) (QUOTE ENTRYPOINT) (QUOTE VECTOR))
+(PUT (QUOTE VECTOR) (QUOTE IDNUMBER) (QUOTE 412))
+(PUT (QUOTE GTHEAP1) (QUOTE ENTRYPOINT) (QUOTE "L1091"))
+(PUT (QUOTE GC!-TRAP!-LEVEL) (QUOTE ENTRYPOINT) (QUOTE "L1098"))
+(PUT (QUOTE GC!-TRAP!-LEVEL) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1836"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 509))
+(PUT (QUOTE LOADDIRECTORIES!*) (QUOTE IDNUMBER) (QUOTE 562))
+(PUT (QUOTE LOADDIRECTORIES!*) (QUOTE INITIALVALUE) (QUOTE ("" "pl:")))
+(PUT (QUOTE WRITENUMBER1) (QUOTE ENTRYPOINT) (QUOTE "L2568"))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE THIRD) (QUOTE ENTRYPOINT) (QUOTE THIRD))
+(PUT (QUOTE THIRD) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE SETF) (QUOTE ENTRYPOINT) (QUOTE SETF))
+(PUT (QUOTE SETF) (QUOTE IDNUMBER) (QUOTE 720))
+(PUT (QUOTE QEDNTH) (QUOTE ENTRYPOINT) (QUOTE QEDNTH))
+(PUT (QUOTE EXTRAREGLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2106"))
+(PUT (QUOTE EXTRAREGLOCATION) (QUOTE IDNUMBER) (QUOTE 557))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 692))
+(PUT (QUOTE LASTPAIR) (QUOTE ENTRYPOINT) (QUOTE "L0990"))
+(PUT (QUOTE LASTPAIR) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE ERRORSET) (QUOTE ENTRYPOINT) (QUOTE "L1805"))
+(PUT (QUOTE ERRORSET) (QUOTE IDNUMBER) (QUOTE 478))
+(PUT (QUOTE COMPILER) (QUOTE IDNUMBER) (QUOTE 585))
+(PUT (QUOTE VECTOR2LIST) (QUOTE ENTRYPOINT) (QUOTE "L0090"))
+(PUT (QUOTE VECTOR2LIST) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PUTV) (QUOTE ENTRYPOINT) (QUOTE PUTV))
+(PUT (QUOTE PUTV) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE YESP) (QUOTE ENTRYPOINT) (QUOTE YESP))
+(PUT (QUOTE YESP) (QUOTE IDNUMBER) (QUOTE 441))
+(PUT (QUOTE NCONC) (QUOTE ENTRYPOINT) (QUOTE NCONC))
+(PUT (QUOTE NCONC) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE RETURNADDRESSP) (QUOTE ENTRYPOINT) (QUOTE "L2072"))
+(PUT (QUOTE RETURNADDRESSP) (QUOTE IDNUMBER) (QUOTE 463))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L1105"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE HELP) (QUOTE ENTRYPOINT) (QUOTE HELP))
+(PUT (QUOTE HELP) (QUOTE IDNUMBER) (QUOTE 450))
+(PUT (QUOTE OUTPUTBASE!*) (QUOTE IDNUMBER) (QUOTE 658))
+(PUT (QUOTE OUTPUTBASE!*) (QUOTE INITIALVALUE) (QUOTE 10))
+(PUT (QUOTE LOADTIME) (QUOTE ENTRYPOINT) (QUOTE "L2925"))
+(PUT (QUOTE LOADTIME) (QUOTE IDNUMBER) (QUOTE 713))
+(PUT (QUOTE ID2INT) (QUOTE ENTRYPOINT) (QUOTE ID2INT))
+(PUT (QUOTE ID2INT) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE CHANNELREADTOKEN) (QUOTE ENTRYPOINT) (QUOTE "L2426"))
+(PUT (QUOTE CHANNELREADTOKEN) (QUOTE IDNUMBER) (QUOTE 633))
+(PUT (QUOTE THROWAUX) (QUOTE ENTRYPOINT) (QUOTE "L2026"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1086"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE !%THROW) (QUOTE ENTRYPOINT) (QUOTE !%THROW))
+(PUT (QUOTE !%THROW) (QUOTE IDNUMBER) (QUOTE 532))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0030"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 655))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 627))
+(PUT (QUOTE !*RAISE) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE NEXPRP) (QUOTE ENTRYPOINT) (QUOTE NEXPRP))
+(PUT (QUOTE NEXPRP) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE MKFLAGVAR) (QUOTE ENTRYPOINT) (QUOTE "L2988"))
+(PUT (QUOTE MKFLAGVAR) (QUOTE IDNUMBER) (QUOTE 725))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 442))
+(FLAG (QUOTE (PROMPTSTRING!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE STRINGEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0469"))
+(PUT (QUOTE STRINGEQUAL) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE NE) (QUOTE ENTRYPOINT) (QUOTE NE))
+(PUT (QUOTE NE) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2891"))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 594))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 613))
+(PUT (QUOTE FINDIDNUMBER) (QUOTE IDNUMBER) (QUOTE 555))
+(PUT (QUOTE TIMES) (QUOTE ENTRYPOINT) (QUOTE TIMES))
+(PUT (QUOTE TIMES) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE CHANNELREADRIGHTPAREN) (QUOTE ENTRYPOINT) (QUOTE "L2361"))
+(PUT (QUOTE CHANNELREADRIGHTPAREN) (QUOTE IDNUMBER) (QUOTE 645))
+(PUT (QUOTE FLOATMINUS) (QUOTE ENTRYPOINT) (QUOTE "L1521"))
+(PUT (QUOTE EXEC) (QUOTE ENTRYPOINT) (QUOTE EXEC))
+(PUT (QUOTE EXEC) (QUOTE IDNUMBER) (QUOTE 589))
+(PUT (QUOTE DELQIP1) (QUOTE ENTRYPOINT) (QUOTE "L0903"))
+(PUT (QUOTE EMODE) (QUOTE ENTRYPOINT) (QUOTE EMODE))
+(PUT (QUOTE EMODE) (QUOTE IDNUMBER) (QUOTE 581))
+(PUT (QUOTE READLINE) (QUOTE ENTRYPOINT) (QUOTE "L2544"))
+(PUT (QUOTE READLINE) (QUOTE IDNUMBER) (QUOTE 656))
+(PUT (QUOTE INTMINUS) (QUOTE ENTRYPOINT) (QUOTE "L1520"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1106"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE CHANNELWRITEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2683"))
+(PUT (QUOTE CHANNELWRITEVECTOR) (QUOTE IDNUMBER) (QUOTE 683))
+(PUT (QUOTE EVECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0127"))
+(PUT (QUOTE EVECTORP) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 597))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE OBJECT!-GET!-HANDLER!-QUIETLY) (QUOTE IDNUMBER) (QUOTE 686))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE CHANNELWRITEPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2638"))
+(PUT (QUOTE CHANNELWRITEPAIR) (QUOTE IDNUMBER) (QUOTE 677))
+(PUT (QUOTE !*LOWER) (QUOTE IDNUMBER) (QUOTE 573))
+(FLAG (QUOTE (!*LOWER)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DUMPLISP) (QUOTE ENTRYPOINT) (QUOTE "L2085"))
+(PUT (QUOTE DUMPLISP) (QUOTE IDNUMBER) (QUOTE 548))
+(PUT (QUOTE EVAND) (QUOTE ENTRYPOINT) (QUOTE EVAND))
+(PUT (QUOTE EVAND) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE ASSIGN!-OP) (QUOTE IDNUMBER) (QUOTE 723))
+(PUT (QUOTE PLUS) (QUOTE ENTRYPOINT) (QUOTE PLUS))
+(PUT (QUOTE PLUS) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 413))
+(PUT (QUOTE !$UNWIND!-PROTECT!$) (QUOTE IDNUMBER) (QUOTE 530))
+(PUT (QUOTE COMPRESS) (QUOTE ENTRYPOINT) (QUOTE "L2918"))
+(PUT (QUOTE COMPRESS) (QUOTE IDNUMBER) (QUOTE 704))
+(PUT (QUOTE MAPCON) (QUOTE ENTRYPOINT) (QUOTE MAPCON))
+(PUT (QUOTE MAPCON) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE MAPCAR) (QUOTE ENTRYPOINT) (QUOTE MAPCAR))
+(PUT (QUOTE MAPCAR) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L1711"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE SUBLIS) (QUOTE ENTRYPOINT) (QUOTE SUBLIS))
+(PUT (QUOTE SUBLIS) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE MAKEBUFINTOID) (QUOTE ENTRYPOINT) (QUOTE "L2387"))
+(PUT (QUOTE PROG) (QUOTE ENTRYPOINT) (QUOTE PROG))
+(PUT (QUOTE PROG) (QUOTE IDNUMBER) (QUOTE 541))
+(PUT (QUOTE CURRENTREADMACROINDICATOR!*) (QUOTE IDNUMBER) (QUOTE 631))
+(PUT (QUOTE CURRENTREADMACROINDICATOR!*) (QUOTE INITIALVALUE) (QUOTE
+LISPREADMACRO))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE CHANNELWRITEID) (QUOTE ENTRYPOINT) (QUOTE "L2590"))
+(PUT (QUOTE CHANNELWRITEID) (QUOTE IDNUMBER) (QUOTE 671))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE ASMSYMBOL) (QUOTE "L2260"))
+(PUT (QUOTE JFNOFCHANNEL) (QUOTE WARRAY) (QUOTE JFNOFCHANNEL))
+(PUT (QUOTE CHANNELLPOSN) (QUOTE ENTRYPOINT) (QUOTE "L2331"))
+(PUT (QUOTE CHANNELLPOSN) (QUOTE IDNUMBER) (QUOTE 624))
+(PUT (QUOTE STRINGGENSYM1) (QUOTE ENTRYPOINT) (QUOTE "L3054"))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE FLOAT) (QUOTE ENTRYPOINT) (QUOTE FLOAT))
+(PUT (QUOTE FLOAT) (QUOTE IDNUMBER) (QUOTE 430))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 8000))
+(PUT (QUOTE FLOATZEROP) (QUOTE ENTRYPOINT) (QUOTE "L1440"))
+(PUT (QUOTE INDX) (QUOTE ENTRYPOINT) (QUOTE INDX))
+(PUT (QUOTE INDX) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 515))
+(PUT (QUOTE INTZEROP) (QUOTE ENTRYPOINT) (QUOTE "L1544"))
+(PUT (QUOTE FLOATADD1) (QUOTE ENTRYPOINT) (QUOTE "L1494"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1772"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CHANNELWRITEFIXNUM) (QUOTE ENTRYPOINT) (QUOTE "L2575"))
+(PUT (QUOTE CHANNELWRITEFIXNUM) (QUOTE IDNUMBER) (QUOTE 665))
+(PUT (QUOTE EPUTV) (QUOTE ENTRYPOINT) (QUOTE EPUTV))
+(PUT (QUOTE EPUTV) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE LISPSCANTABLE!*) (QUOTE IDNUMBER) (QUOTE 637))
+(FLAG (QUOTE (LISPSCANTABLE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2281"))
+(PUT (QUOTE UNREADCHAR) (QUOTE IDNUMBER) (QUOTE 602))
+(PUT (QUOTE MAKE!-WORDS) (QUOTE ENTRYPOINT) (QUOTE "L1238"))
+(PUT (QUOTE MAKE!-WORDS) (QUOTE IDNUMBER) (QUOTE 409))
+(PUT (QUOTE FUNCTIONCELLLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2108"))
+(PUT (QUOTE FUNCTIONCELLLOCATION) (QUOTE IDNUMBER) (QUOTE 558))
+(PUT (QUOTE SIMPFG) (QUOTE IDNUMBER) (QUOTE 726))
+(PUT (QUOTE SPECIALREADFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 607))
+(FLAG (QUOTE (SPECIALREADFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CHANNELPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L2901"))
+(PUT (QUOTE CHANNELPRINTF) (QUOTE IDNUMBER) (QUOTE 696))
+(PUT (QUOTE OR) (QUOTE ENTRYPOINT) (QUOTE OR))
+(PUT (QUOTE OR) (QUOTE IDNUMBER) (QUOTE 268))
+(PUT (QUOTE MKQUOTE) (QUOTE ENTRYPOINT) (QUOTE "L0861"))
+(PUT (QUOTE MKQUOTE) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE !*PRINTLOADNAMES) (QUOTE IDNUMBER) (QUOTE 565))
+(FLAG (QUOTE (!*PRINTLOADNAMES)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 472))
+(PUT (QUOTE EDITORREADER!*) (QUOTE IDNUMBER) (QUOTE 445))
+(FLAG (QUOTE (EDITORREADER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SETF!-EXPAND) (QUOTE IDNUMBER) (QUOTE 722))
+(PUT (QUOTE SETSUB) (QUOTE ENTRYPOINT) (QUOTE SETSUB))
+(PUT (QUOTE SETSUB) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE SIZE) (QUOTE ENTRYPOINT) (QUOTE SIZE))
+(PUT (QUOTE SIZE) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 536))
+(PUT (QUOTE CHANNELREAD) (QUOTE ENTRYPOINT) (QUOTE "L2339"))
+(PUT (QUOTE CHANNELREAD) (QUOTE IDNUMBER) (QUOTE 636))
+(PUT (QUOTE !&!&VALUE!&!&) (QUOTE IDNUMBER) (QUOTE 525))
+(PUT (QUOTE CHANNELSPACES) (QUOTE ENTRYPOINT) (QUOTE "L1036"))
+(PUT (QUOTE CHANNELSPACES) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE PRINTF2) (QUOTE ENTRYPOINT) (QUOTE "L2853"))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L1844"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 510))
+(PUT (QUOTE LISPEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0429"))
+(PUT (QUOTE LISPEQUAL) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE UNION) (QUOTE ENTRYPOINT) (QUOTE UNION))
+(PUT (QUOTE UNION) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE DELQIP) (QUOTE ENTRYPOINT) (QUOTE DELQIP))
+(PUT (QUOTE DELQIP) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE CHANNELTAB) (QUOTE ENTRYPOINT) (QUOTE "L1040"))
+(PUT (QUOTE CHANNELTAB) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE BIGFLOATFIX) (QUOTE ENTRYPOINT) (QUOTE "L1394"))
+(PUT (QUOTE INTLNOT) (QUOTE ENTRYPOINT) (QUOTE "L1513"))
+(PUT (QUOTE MAX) (QUOTE ENTRYPOINT) (QUOTE MAX))
+(PUT (QUOTE MAX) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE INSTANTIATEINFORM) (QUOTE ENTRYPOINT) (QUOTE "L2994"))
+(PUT (QUOTE COPYWRDS) (QUOTE ENTRYPOINT) (QUOTE "L1158"))
+(PUT (QUOTE COPYWRDS) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L1177"))
+(PUT (QUOTE CHANNELPRINT) (QUOTE ENTRYPOINT) (QUOTE "L0812"))
+(PUT (QUOTE CHANNELPRINT) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE LOADEXTENSIONS!*) (QUOTE IDNUMBER) (QUOTE 563))
+(PUT (QUOTE LOADEXTENSIONS!*) (QUOTE INITIALVALUE) (QUOTE ((".b" . FASLIN) (
+".lap" . LAPIN))))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE FEXPRP) (QUOTE ENTRYPOINT) (QUOTE FEXPRP))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L2335"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE THROW) (QUOTE ENTRYPOINT) (QUOTE THROW))
+(PUT (QUOTE THROW) (QUOTE IDNUMBER) (QUOTE 495))
+(PUT (QUOTE FIX) (QUOTE ENTRYPOINT) (QUOTE FIX))
+(PUT (QUOTE FIX) (QUOTE IDNUMBER) (QUOTE 429))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0375"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE IDNUMBER) (QUOTE 417))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE INITIALVALUE) (QUOTE 1000))
+(PUT (QUOTE TCONC) (QUOTE ENTRYPOINT) (QUOTE TCONC))
+(PUT (QUOTE TCONC) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1122"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE EGETV) (QUOTE ENTRYPOINT) (QUOTE EGETV))
+(PUT (QUOTE EGETV) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE CONST) (QUOTE ENTRYPOINT) (QUOTE CONST))
+(PUT (QUOTE CONST) (QUOTE IDNUMBER) (QUOTE 733))
+(PUT (QUOTE UNDEFINEDFUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L1869"))
+(PUT (QUOTE UNDEFINEDFUNCTION) (QUOTE IDNUMBER) (QUOTE 516))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE DS) (QUOTE ENTRYPOINT) (QUOTE DS))
+(PUT (QUOTE DS) (QUOTE IDNUMBER) (QUOTE 730))
+(PUT (QUOTE OLDHEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE OLDHEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L1083"))
+(PUT (QUOTE OLDHEAPLAST) (QUOTE WVAR) (QUOTE OLDHEAPLAST))
+(PUT (QUOTE WORDSEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0426"))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1818"))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 506))
+(PUT (QUOTE COMPRESSLIST!*) (QUOTE IDNUMBER) (QUOTE 702))
+(FLAG (QUOTE (COMPRESSLIST!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYVECTORTOFROM) (QUOTE ENTRYPOINT) (QUOTE "L1142"))
+(PUT (QUOTE COPYVECTORTOFROM) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2902"))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 595))
+(PUT (QUOTE SPECIALWRSACTION!*) (QUOTE IDNUMBER) (QUOTE 617))
+(FLAG (QUOTE (SPECIALWRSACTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODE!-ADDRESS!-TO!-SYMBOL) (QUOTE IDNUMBER) (QUOTE 469))
+(PUT (QUOTE MAPLIST) (QUOTE ENTRYPOINT) (QUOTE "L0737"))
+(PUT (QUOTE MAPLIST) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1746"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE !*EXPERT) (QUOTE IDNUMBER) (QUOTE 437))
+(FLAG (QUOTE (!*EXPERT)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CONC) (QUOTE IDNUMBER) (QUOTE 739))
+(PUT (QUOTE CHANNELPRIN1) (QUOTE ENTRYPOINT) (QUOTE "L2814"))
+(PUT (QUOTE CHANNELPRIN1) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE PRINTF1) (QUOTE ENTRYPOINT) (QUOTE "L2852"))
+(PUT (QUOTE ABS) (QUOTE ENTRYPOINT) (QUOTE ABS))
+(PUT (QUOTE ABS) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1781"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 491))
+(PUT (QUOTE OTHERWISE) (QUOTE IDNUMBER) (QUOTE 716))
+(PUT (QUOTE FASLOUT) (QUOTE ENTRYPOINT) (QUOTE "L2243"))
+(PUT (QUOTE FASLOUT) (QUOTE IDNUMBER) (QUOTE 587))
+(PUT (QUOTE CHANNELWRITEHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L2760"))
+(PUT (QUOTE CHANNELWRITEHALFWORDS) (QUOTE IDNUMBER) (QUOTE 690))
+(PUT (QUOTE SUBSEQ) (QUOTE ENTRYPOINT) (QUOTE SUBSEQ))
+(PUT (QUOTE SUBSEQ) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE LSHIFT) (QUOTE ENTRYPOINT) (QUOTE LSHIFT))
+(PUT (QUOTE LSHIFT) (QUOTE IDNUMBER) (QUOTE 426))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L1754"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE XCHANGE) (QUOTE ENTRYPOINT) (QUOTE "L1610"))
+(PUT (QUOTE COMPRESSERROR) (QUOTE ENTRYPOINT) (QUOTE "L2917"))
+(PUT (QUOTE COMPRESSERROR) (QUOTE IDNUMBER) (QUOTE 701))
+(PUT (QUOTE READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2268"))
+(PUT (QUOTE READCHAR) (QUOTE IDNUMBER) (QUOTE 599))
+(PUT (QUOTE FLOATDIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1409"))
+(PUT (QUOTE CURRENTSCANTABLE!*) (QUOTE IDNUMBER) (QUOTE 635))
+(FLAG (QUOTE (CURRENTSCANTABLE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE CHANNELREADCH) (QUOTE ENTRYPOINT) (QUOTE "L2332"))
+(PUT (QUOTE CHANNELREADCH) (QUOTE IDNUMBER) (QUOTE 626))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE COPYVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1148"))
+(PUT (QUOTE COPYVECTOR) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 642))
+(FLAG (QUOTE (!$EOF!$)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DELQ) (QUOTE ENTRYPOINT) (QUOTE DELQ))
+(PUT (QUOTE DELQ) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1766"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1256"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE CREFON) (QUOTE ENTRYPOINT) (QUOTE CREFON))
+(PUT (QUOTE CREFON) (QUOTE IDNUMBER) (QUOTE 584))
+(PUT (QUOTE FOR) (QUOTE ENTRYPOINT) (QUOTE FOR))
+(PUT (QUOTE FOR) (QUOTE IDNUMBER) (QUOTE 747))
+(PUT (QUOTE BIN) (QUOTE IDNUMBER) (QUOTE 751))
+(PUT (QUOTE CHANNELREADTOKENWITHHOOKS) (QUOTE ENTRYPOINT) (QUOTE "L2336"))
+(PUT (QUOTE CHANNELREADTOKENWITHHOOKS) (QUOTE IDNUMBER) (QUOTE 632))
+(PUT (QUOTE INT2CODE) (QUOTE ENTRYPOINT) (QUOTE "L0026"))
+(PUT (QUOTE INT2CODE) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE BREAK) (QUOTE IDNUMBER) (QUOTE 451))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1865"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 614))
+(PUT (QUOTE INTADD1) (QUOTE ENTRYPOINT) (QUOTE "L1493"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2272"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 470))
+(PUT (QUOTE IN) (QUOTE IDNUMBER) (QUOTE 740))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE ASMSYMBOL) (QUOTE "L1088"))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE WVAR) (QUOTE HEAPTRAPPED))
+(PUT (QUOTE !*EOLINSTRINGOK) (QUOTE IDNUMBER) (QUOTE 648))
+(FLAG (QUOTE (!*EOLINSTRINGOK)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE MIN2) (QUOTE ENTRYPOINT) (QUOTE MIN2))
+(PUT (QUOTE MIN2) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE ASS) (QUOTE ENTRYPOINT) (QUOTE ASS))
+(PUT (QUOTE ASS) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE CHANNELUNREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2280"))
+(PUT (QUOTE CHANNELUNREADCHAR) (QUOTE IDNUMBER) (QUOTE 601))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE CHANNELWRITEUNKNOWNITEM) (QUOTE ENTRYPOINT) (QUOTE "L2620"))
+(PUT (QUOTE CHANNELWRITEUNKNOWNITEM) (QUOTE IDNUMBER) (QUOTE 468))
+(PUT (QUOTE EVDEFCONST) (QUOTE ENTRYPOINT) (QUOTE "L3048"))
+(PUT (QUOTE EVDEFCONST) (QUOTE IDNUMBER) (QUOTE 732))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE CASE) (QUOTE ENTRYPOINT) (QUOTE CASE))
+(PUT (QUOTE CASE) (QUOTE IDNUMBER) (QUOTE 718))
+(PUT (QUOTE SCANNERERROR) (QUOTE ENTRYPOINT) (QUOTE "L2455"))
+(PUT (QUOTE RETURNFIRSTARG) (QUOTE ENTRYPOINT) (QUOTE "L1396"))
+(PUT (QUOTE RETURNFIRSTARG) (QUOTE IDNUMBER) (QUOTE 422))
+(PUT (QUOTE COPYITEM) (QUOTE ENTRYPOINT) (QUOTE "L1290"))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0407"))
+(PUT (QUOTE MAKE!-HALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L1228"))
+(PUT (QUOTE MAKE!-HALFWORDS) (QUOTE IDNUMBER) (QUOTE 408))
+(PUT (QUOTE STRINGGENSYM!*) (QUOTE IDNUMBER) (QUOTE 735))
+(FLAG (QUOTE (STRINGGENSYM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNMAP!-SPACE) (QUOTE ENTRYPOINT) (QUOTE "L2088"))
+(PUT (QUOTE UNMAP!-SPACE) (QUOTE IDNUMBER) (QUOTE 420))
+(PUT (QUOTE !*CATCH) (QUOTE ENTRYPOINT) (QUOTE "L2009"))
+(PUT (QUOTE !*CATCH) (QUOTE IDNUMBER) (QUOTE 534))
+(PUT (QUOTE MINUSP) (QUOTE ENTRYPOINT) (QUOTE MINUSP))
+(PUT (QUOTE MINUSP) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE BPSSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BPSSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BPSSIZE) (QUOTE WCONST) (QUOTE 170000))
+(PUT (QUOTE IMPLODE) (QUOTE ENTRYPOINT) (QUOTE "L2919"))
+(PUT (QUOTE IMPLODE) (QUOTE IDNUMBER) (QUOTE 705))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1769"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 406))
+(PUT (QUOTE FASTBIND) (QUOTE IDNUMBER) (QUOTE 443))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1892"))
+(PUT (QUOTE CHANNELWRITEFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2579"))
+(PUT (QUOTE CHANNELWRITEFLOAT) (QUOTE IDNUMBER) (QUOTE 669))
+(PUT (QUOTE CHECKLINEFIT) (QUOTE ENTRYPOINT) (QUOTE "L2553"))
+(PUT (QUOTE !%UNCATCH) (QUOTE ENTRYPOINT) (QUOTE "L2021"))
+(PUT (QUOTE !%UNCATCH) (QUOTE IDNUMBER) (QUOTE 501))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L1778"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE COMPRESSEDBINARYRADIX) (QUOTE WCONST) (QUOTE 8))
+(PUT (QUOTE CHANNELPRINTUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L2613"))
+(PUT (QUOTE CHANNELPRINTUNBOUND) (QUOTE IDNUMBER) (QUOTE 674))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1482"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 271))
+(PUT (QUOTE MAPC) (QUOTE ENTRYPOINT) (QUOTE MAPC))
+(PUT (QUOTE MAPC) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1812"))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 504))
+(PUT (QUOTE SYSTEM_LIST!*) (QUOTE IDNUMBER) (QUOTE 546))
+(PUT (QUOTE SYSTEM_LIST!*) (QUOTE INITIALVALUE) (QUOTE (DEC20 PDP10 TOPS20
+KL10)))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE MAKESTRINGINTOBITSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2518"))
+(PUT (QUOTE UPBV) (QUOTE ENTRYPOINT) (QUOTE UPBV))
+(PUT (QUOTE UPBV) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE LCONC) (QUOTE ENTRYPOINT) (QUOTE LCONC))
+(PUT (QUOTE LCONC) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE EDCOPY) (QUOTE ENTRYPOINT) (QUOTE EDCOPY))
+(PUT (QUOTE FLOATFIX) (QUOTE ENTRYPOINT) (QUOTE "L1530"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1749"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 489))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 542))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE DEL) (QUOTE ENTRYPOINT) (QUOTE DEL))
+(PUT (QUOTE DEL) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE MAKE!-BYTES) (QUOTE ENTRYPOINT) (QUOTE "L1218"))
+(PUT (QUOTE MAKE!-BYTES) (QUOTE IDNUMBER) (QUOTE 407))
+(PUT (QUOTE !*GC) (QUOTE IDNUMBER) (QUOTE 416))
+(PUT (QUOTE !*GC) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE FIRST) (QUOTE ENTRYPOINT) (QUOTE FIRST))
+(PUT (QUOTE FIRST) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE DATE) (QUOTE ENTRYPOINT) (QUOTE DATE))
+(PUT (QUOTE DATE) (QUOTE IDNUMBER) (QUOTE 547))
+(PUT (QUOTE DOTCONTEXTERROR) (QUOTE ENTRYPOINT) (QUOTE "L2351"))
+(PUT (QUOTE SYSPOWEROF2P) (QUOTE ENTRYPOINT) (QUOTE "L2516"))
+(PUT (QUOTE LOAD1) (QUOTE ENTRYPOINT) (QUOTE LOAD1))
+(PUT (QUOTE LOAD1) (QUOTE IDNUMBER) (QUOTE 567))
+(PUT (QUOTE LISP2CHAR) (QUOTE ENTRYPOINT) (QUOTE "L0022"))
+(PUT (QUOTE LISP2CHAR) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE MEM) (QUOTE ENTRYPOINT) (QUOTE MEM))
+(PUT (QUOTE MEM) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE EHELP) (QUOTE ENTRYPOINT) (QUOTE EHELP))
+(PUT (QUOTE EHELP) (QUOTE IDNUMBER) (QUOTE 452))
+(PUT (QUOTE EDIT0) (QUOTE ENTRYPOINT) (QUOTE EDIT0))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE MAKEBUFINTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2390"))
+(PUT (QUOTE INTMINUSP) (QUOTE ENTRYPOINT) (QUOTE "L1539"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 606))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1775"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE INTERPBACKTRACE) (QUOTE ENTRYPOINT) (QUOTE "L1668"))
+(PUT (QUOTE INTERPBACKTRACE) (QUOTE IDNUMBER) (QUOTE 460))
+(PUT (QUOTE !$ERROR!$) (QUOTE IDNUMBER) (QUOTE 496))
+(PUT (QUOTE INTGREATERP) (QUOTE ENTRYPOINT) (QUOTE "L1483"))
+(PUT (QUOTE UNMAP!-PAGES) (QUOTE ENTRYPOINT) (QUOTE "L2090"))
+(PUT (QUOTE CHANNELLINELENGTH) (QUOTE ENTRYPOINT) (QUOTE "L2326"))
+(PUT (QUOTE CHANNELLINELENGTH) (QUOTE IDNUMBER) (QUOTE 621))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE SCANPOSSIBLEDIPHTHONG) (QUOTE ENTRYPOINT) (QUOTE "L2449"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 591))
+(PUT (QUOTE CHANNELREADQUOTEDEXPRESSION) (QUOTE ENTRYPOINT) (QUOTE "L2345"))
+(PUT (QUOTE CHANNELREADQUOTEDEXPRESSION) (QUOTE IDNUMBER) (QUOTE 643))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 311))
+(FLAG (QUOTE (OUT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EXPANDSETF) (QUOTE ENTRYPOINT) (QUOTE "L2968"))
+(PUT (QUOTE EXPANDSETF) (QUOTE IDNUMBER) (QUOTE 721))
+(PUT (QUOTE GO) (QUOTE ENTRYPOINT) (QUOTE GO))
+(PUT (QUOTE GO) (QUOTE IDNUMBER) (QUOTE 544))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 618))
+(FLAG (QUOTE (STDOUT!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE REST) (QUOTE ENTRYPOINT) (QUOTE REST))
+(PUT (QUOTE REST) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE SIMP) (QUOTE IDNUMBER) (QUOTE 750))
+(PUT (QUOTE INVOKE) (QUOTE ENTRYPOINT) (QUOTE INVOKE))
+(PUT (QUOTE INVOKE) (QUOTE IDNUMBER) (QUOTE 582))
+(PUT (QUOTE !*BACKTRACE) (QUOTE IDNUMBER) (QUOTE 493))
+(FLAG (QUOTE (!*BACKTRACE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE !&!&TAG!&!&) (QUOTE IDNUMBER) (QUOTE 531))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE TR) (QUOTE ENTRYPOINT) (QUOTE TR))
+(PUT (QUOTE TR) (QUOTE IDNUMBER) (QUOTE 433))
+(PUT (QUOTE UP) (QUOTE IDNUMBER) (QUOTE 454))
+(PUT (QUOTE EMSG!*) (QUOTE IDNUMBER) (QUOTE 483))
+(FLAG (QUOTE (EMSG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MAKE!-VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1248"))
+(PUT (QUOTE MAKE!-VECTOR) (QUOTE IDNUMBER) (QUOTE 410))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 461))
+(PUT (QUOTE FLATSIZE) (QUOTE ENTRYPOINT) (QUOTE "L2907"))
+(PUT (QUOTE FLATSIZE) (QUOTE IDNUMBER) (QUOTE 488))
+(PUT (QUOTE PROGBODY!*) (QUOTE IDNUMBER) (QUOTE 539))
+(FLAG (QUOTE (PROGBODY!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SPECIALWRITEFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 608))
+(FLAG (QUOTE (SPECIALWRITEFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE READINBUF) (QUOTE ENTRYPOINT) (QUOTE "L2384"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE ENTRYPOINT) (QUOTE "L2006"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE IDNUMBER) (QUOTE 533))
+(PUT (QUOTE SUBSTIP1) (QUOTE ENTRYPOINT) (QUOTE "L0873"))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0602"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE INTLXOR) (QUOTE ENTRYPOINT) (QUOTE "L1468"))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE UNIONQ) (QUOTE ENTRYPOINT) (QUOTE UNIONQ))
+(PUT (QUOTE UNIONQ) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE MAKESTRINGINTOSYSINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2392"))
+(PUT (QUOTE NTH) (QUOTE ENTRYPOINT) (QUOTE NTH))
+(PUT (QUOTE NTH) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE PL) (QUOTE IDNUMBER) (QUOTE 453))
+(PUT (QUOTE JOIN) (QUOTE IDNUMBER) (QUOTE 738))
+(PUT (QUOTE SUBSTIP) (QUOTE ENTRYPOINT) (QUOTE "L0878"))
+(PUT (QUOTE SUBSTIP) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE SPECIALCLOSEFUNCTION!*) (QUOTE IDNUMBER) (QUOTE 609))
+(FLAG (QUOTE (SPECIALCLOSEFUNCTION!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE STARTUPTIME) (QUOTE ENTRYPOINT) (QUOTE "L2925"))
+(PUT (QUOTE STARTUPTIME) (QUOTE IDNUMBER) (QUOTE 714))
+(PUT (QUOTE INTERSECTIONQ) (QUOTE ENTRYPOINT) (QUOTE XNQ))
+(PUT (QUOTE INTERSECTIONQ) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE EDITOR) (QUOTE IDNUMBER) (QUOTE 457))
+(PUT (QUOTE FLOATQUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1426"))
+(PUT (QUOTE BREAKLEVEL!*) (QUOTE IDNUMBER) (QUOTE 487))
+(FLAG (QUOTE (BREAKLEVEL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1737"))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE MAKEBUFINTOSYSNUMBER) (QUOTE ENTRYPOINT) (QUOTE "L2391"))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE CHANNELWRITECODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L2616"))
+(PUT (QUOTE CHANNELWRITECODEPOINTER) (QUOTE IDNUMBER) (QUOTE 675))
+(PUT (QUOTE BINARYOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L2097"))
+(PUT (QUOTE BINARYOPENREAD) (QUOTE IDNUMBER) (QUOTE 549))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2254"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE INT2SYS) (QUOTE ENTRYPOINT) (QUOTE "L0016"))
+(PUT (QUOTE INT2SYS) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 216))
+(PUT (QUOTE ON) (QUOTE ENTRYPOINT) (QUOTE ON))
+(PUT (QUOTE ON) (QUOTE IDNUMBER) (QUOTE 727))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1119"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE INTPLUS2) (QUOTE ENTRYPOINT) (QUOTE "L1399"))
+(PUT (QUOTE TIMC) (QUOTE ENTRYPOINT) (QUOTE TIMC))
+(PUT (QUOTE TIMC) (QUOTE IDNUMBER) (QUOTE 419))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 593))
+(PUT (QUOTE INTQUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1425"))
+(PUT (QUOTE PROG2) (QUOTE ENTRYPOINT) (QUOTE PROG2))
+(PUT (QUOTE PROG2) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE MK!*SQ) (QUOTE IDNUMBER) (QUOTE 749))
+(PUT (QUOTE LIST2SET) (QUOTE ENTRYPOINT) (QUOTE "L1044"))
+(PUT (QUOTE LIST2SET) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE YES) (QUOTE IDNUMBER) (QUOTE 474))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 514))
+(PUT (QUOTE !*WRITINGFASLFILE) (QUOTE IDNUMBER) (QUOTE 553))
+(PUT (QUOTE DELETIP1) (QUOTE ENTRYPOINT) (QUOTE "L0884"))
+(PUT (QUOTE OLDHEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE OLDHEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1085"))
+(PUT (QUOTE OLDHEAPUPPERBOUND) (QUOTE WVAR) (QUOTE OLDHEAPUPPERBOUND))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 518))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L1763"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 490))
+(PUT (QUOTE OFF) (QUOTE ENTRYPOINT) (QUOTE OFF))
+(PUT (QUOTE OFF) (QUOTE IDNUMBER) (QUOTE 728))
+(PUT (QUOTE QEDITFNS) (QUOTE IDNUMBER) (QUOTE 436))
+(FLAG (QUOTE (QEDITFNS)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CHANNELPRIN2T) (QUOTE ENTRYPOINT) (QUOTE "L1035"))
+(PUT (QUOTE CHANNELPRIN2T) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE COLLECT) (QUOTE IDNUMBER) (QUOTE 737))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 448))
+(PUT (QUOTE CHANNELWRITEBLANKOREOL) (QUOTE ENTRYPOINT) (QUOTE "L2621"))
+(PUT (QUOTE CHANNELWRITEBLANKOREOL) (QUOTE IDNUMBER) (QUOTE 676))
+(PUT (QUOTE !*INNER!*BACKTRACE) (QUOTE IDNUMBER) (QUOTE 494))
+(FLAG (QUOTE (!*INNER!*BACKTRACE)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE COPYSTRING) (QUOTE ENTRYPOINT) (QUOTE "L1134"))
+(PUT (QUOTE COPYSTRING) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 537))
+(PUT (QUOTE TOTALCOPY) (QUOTE ENTRYPOINT) (QUOTE "L1163"))
+(PUT (QUOTE TOTALCOPY) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE OPTIONS!*) (QUOTE IDNUMBER) (QUOTE 466))
+(FLAG (QUOTE (OPTIONS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 524))
+(PUT (QUOTE SET!-GC!-TRAP!-LEVEL) (QUOTE ENTRYPOINT) (QUOTE "L1101"))
+(PUT (QUOTE SET!-GC!-TRAP!-LEVEL) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE LINELENGTH) (QUOTE ENTRYPOINT) (QUOTE "L2329"))
+(PUT (QUOTE LINELENGTH) (QUOTE IDNUMBER) (QUOTE 622))
+(PUT (QUOTE CHANNELWRITEBITSTRAUX) (QUOTE ENTRYPOINT) (QUOTE "L2572"))
+(PUT (QUOTE CHANNELWRITEBITSTRAUX) (QUOTE IDNUMBER) (QUOTE 663))
+(PUT (QUOTE RANGE) (QUOTE IDNUMBER) (QUOTE 719))
+(PUT (QUOTE PUTENTRY) (QUOTE ENTRYPOINT) (QUOTE "L2164"))
+(PUT (QUOTE PUTENTRY) (QUOTE IDNUMBER) (QUOTE 561))
+(PUT (QUOTE CHANNELPRINTSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2583"))
+(PUT (QUOTE CHANNELPRINTSTRING) (QUOTE IDNUMBER) (QUOTE 670))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2906"))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 596))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE INT2ID) (QUOTE ENTRYPOINT) (QUOTE INT2ID))
+(PUT (QUOTE INT2ID) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE INTDIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1408"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 513))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE MAX2) (QUOTE ENTRYPOINT) (QUOTE MAX2))
+(PUT (QUOTE MAX2) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE VALUECELLLOCATION) (QUOTE ENTRYPOINT) (QUOTE "L2104"))
+(PUT (QUOTE VALUECELLLOCATION) (QUOTE IDNUMBER) (QUOTE 552))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE PRINC) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRINC) (QUOTE IDNUMBER) (QUOTE 629))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L2256"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE MINI) (QUOTE ENTRYPOINT) (QUOTE MINI))
+(PUT (QUOTE MINI) (QUOTE IDNUMBER) (QUOTE 580))
+(PUT (QUOTE EXPLODE2) (QUOTE ENTRYPOINT) (QUOTE "L2904"))
+(PUT (QUOTE EXPLODE2) (QUOTE IDNUMBER) (QUOTE 699))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L2257"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE PAIR) (QUOTE ENTRYPOINT) (QUOTE PAIR))
+(PUT (QUOTE PAIR) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE REVERSIP) (QUOTE ENTRYPOINT) (QUOTE "L0868"))
+(PUT (QUOTE REVERSIP) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE CHANNELWRITEUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L2597"))
+(PUT (QUOTE CHANNELWRITEUNBOUND) (QUOTE IDNUMBER) (QUOTE 672))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L2110"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 560))
+(PUT (QUOTE RANGEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1710"))
+(PUT (QUOTE RANGEERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PENDINGLOADS!*) (QUOTE IDNUMBER) (QUOTE 574))
+(FLAG (QUOTE (PENDINGLOADS!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE QUOTIENT) (QUOTE ENTRYPOINT) (QUOTE "L1424"))
+(PUT (QUOTE QUOTIENT) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE SPACES) (QUOTE ENTRYPOINT) (QUOTE SPACES))
+(PUT (QUOTE SPACES) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0032"))
+(PUT (QUOTE CHANNELPRINTEVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L2725"))
+(PUT (QUOTE CHANNELPRINTEVECTOR) (QUOTE IDNUMBER) (QUOTE 688))
+(PUT (QUOTE CATCH) (QUOTE ENTRYPOINT) (QUOTE CATCH))
+(PUT (QUOTE CATCH) (QUOTE IDNUMBER) (QUOTE 498))
+(PUT (QUOTE IDESCAPECHAR!*) (QUOTE IDNUMBER) (QUOTE 659))
+(PUT (QUOTE IDESCAPECHAR!*) (QUOTE INITIALVALUE) (QUOTE 33))
+(PUT (QUOTE CHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L1824"))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 503))
+(PUT (QUOTE WRITESTRING) (QUOTE ENTRYPOINT) (QUOTE "L2561"))
+(PUT (QUOTE WRITESTRING) (QUOTE IDNUMBER) (QUOTE 661))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE !%RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1265"))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE CHANNELREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2263"))
+(PUT (QUOTE CHANNELREADCHAR) (QUOTE IDNUMBER) (QUOTE 598))
+(PUT (QUOTE DELATQIP1) (QUOTE ENTRYPOINT) (QUOTE "L0962"))
+(PUT (QUOTE SPACES2) (QUOTE ENTRYPOINT) (QUOTE TAB))
+(PUT (QUOTE SPACES2) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE ASSOC) (QUOTE ENTRYPOINT) (QUOTE ASSOC))
+(PUT (QUOTE ASSOC) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE IMPORTS) (QUOTE ENTRYPOINT) (QUOTE "L2202"))
+(PUT (QUOTE IMPORTS) (QUOTE IDNUMBER) (QUOTE 575))
+(PUT (QUOTE EQN) (QUOTE ENTRYPOINT) (QUOTE EQN))
+(PUT (QUOTE EQN) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE DELETIP) (QUOTE ENTRYPOINT) (QUOTE "L0890"))
+(PUT (QUOTE DELETIP) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE FLOATTIMES2) (QUOTE ENTRYPOINT) (QUOTE "L1417"))
+(PUT (QUOTE REPEAT) (QUOTE ENTRYPOINT) (QUOTE REPEAT))
+(PUT (QUOTE REPEAT) (QUOTE IDNUMBER) (QUOTE 746))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE AND) (QUOTE ENTRYPOINT) (QUOTE AND))
+(PUT (QUOTE AND) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE EXPLODEENDPOINTER!*) (QUOTE IDNUMBER) (QUOTE 697))
+(FLAG (QUOTE (EXPLODEENDPOINTER!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE HEAPSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE HEAPSIZE) (QUOTE WCONST) (QUOTE 262000))
+(PUT (QUOTE !&!&THROWN!&!&) (QUOTE IDNUMBER) (QUOTE 529))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L2911"))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 592))
+(PUT (QUOTE RECIP) (QUOTE ENTRYPOINT) (QUOTE RECIP))
+(PUT (QUOTE RECIP) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE MAXBREAKLEVEL!*) (QUOTE IDNUMBER) (QUOTE 486))
+(FLAG (QUOTE (MAXBREAKLEVEL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 432))
+(PUT (QUOTE DELATQIP) (QUOTE ENTRYPOINT) (QUOTE "L0968"))
+(PUT (QUOTE DELATQIP) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE READCH) (QUOTE ENTRYPOINT) (QUOTE READCH))
+(PUT (QUOTE READCH) (QUOTE IDNUMBER) (QUOTE 628))
+(PUT (QUOTE LITER) (QUOTE ENTRYPOINT) (QUOTE LITER))
+(PUT (QUOTE LITER) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE NEXT) (QUOTE ENTRYPOINT) (QUOTE NEXT))
+(PUT (QUOTE NEXT) (QUOTE IDNUMBER) (QUOTE 744))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 476))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1254"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1982"))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE IDNUMBER) (QUOTE 528))
+(PUT (QUOTE XINS) (QUOTE ENTRYPOINT) (QUOTE XINS))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L1787"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 492))
+(PUT (QUOTE CHANNELWRITEWORDS) (QUOTE ENTRYPOINT) (QUOTE "L2742"))
+(PUT (QUOTE CHANNELWRITEWORDS) (QUOTE IDNUMBER) (QUOTE 689))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE STACKSIZE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKSIZE) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE STACKSIZE) (QUOTE WCONST) (QUOTE 10000))
+(PUT (QUOTE DEFLIST) (QUOTE ENTRYPOINT) (QUOTE "L0772"))
+(PUT (QUOTE DEFLIST) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CHANNELTYO) (QUOTE ENTRYPOINT) (QUOTE "L2921"))
+(PUT (QUOTE CHANNELTYO) (QUOTE IDNUMBER) (QUOTE 707))
+(PUT (QUOTE CHANNELREADLINE) (QUOTE ENTRYPOINT) (QUOTE "L2547"))
+(PUT (QUOTE CHANNELREADLINE) (QUOTE IDNUMBER) (QUOTE 657))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1877"))
+(PUT (QUOTE SUB) (QUOTE ENTRYPOINT) (QUOTE SUB))
+(PUT (QUOTE SUB) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L1858"))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE CHANNELSPACES2) (QUOTE ENTRYPOINT) (QUOTE "L1040"))
+(PUT (QUOTE CHANNELSPACES2) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE OLDHEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE OLDHEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1084"))
+(PUT (QUOTE OLDHEAPLOWERBOUND) (QUOTE WVAR) (QUOTE OLDHEAPLOWERBOUND))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L2259"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE VECTOR2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0052"))
+(PUT (QUOTE VECTOR2STRING) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE CHANNELREADEOF) (QUOTE ENTRYPOINT) (QUOTE "L2342"))
+(PUT (QUOTE CHANNELREADEOF) (QUOTE IDNUMBER) (QUOTE 641))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L1111"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE FIXP) (QUOTE ENTRYPOINT) (QUOTE FIXP))
+(PUT (QUOTE FIXP) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE ADJOIN) (QUOTE ENTRYPOINT) (QUOTE ADJOIN))
+(PUT (QUOTE ADJOIN) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE CHANNELREADLISTORDOTTEDPAIR) (QUOTE ENTRYPOINT) (QUOTE "L2348"))
+(PUT (QUOTE CHANNELREADLISTORDOTTEDPAIR) (QUOTE IDNUMBER) (QUOTE 644))
+(PUT (QUOTE EXPAND) (QUOTE ENTRYPOINT) (QUOTE EXPAND))
+(PUT (QUOTE EXPAND) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE HALFWORDSEQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0458"))
+(PUT (QUOTE HEAP2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAP2) (QUOTE ASMSYMBOL) (QUOTE HEAP2))
+(PUT (QUOTE HEAP2) (QUOTE WARRAY) (QUOTE HEAP2))
+(PUT (QUOTE MAKEFIXNUM) (QUOTE ENTRYPOINT) (QUOTE "L1391"))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L1208"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE CHANNELTERPRI) (QUOTE ENTRYPOINT) (QUOTE "L2334"))
+(PUT (QUOTE CHANNELTERPRI) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE LASTCAR) (QUOTE ENTRYPOINT) (QUOTE "L0986"))
+(PUT (QUOTE LASTCAR) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0625"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE !*BREAK) (QUOTE IDNUMBER) (QUOTE 484))
+(PUT (QUOTE !*BREAK) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE THROWTAG!*) (QUOTE IDNUMBER) (QUOTE 526))
+(FLAG (QUOTE (THROWTAG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE EXPT) (QUOTE ENTRYPOINT) (QUOTE EXPT))
+(PUT (QUOTE EXPT) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE EVOR) (QUOTE ENTRYPOINT) (QUOTE EVOR))
+(PUT (QUOTE EVOR) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE MAPCAN) (QUOTE ENTRYPOINT) (QUOTE MAPCAN))
+(PUT (QUOTE MAPCAN) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE LAND) (QUOTE ENTRYPOINT) (QUOTE LAND))
+(PUT (QUOTE LAND) (QUOTE IDNUMBER) (QUOTE 423))
+(PUT (QUOTE LSH) (QUOTE ENTRYPOINT) (QUOTE LSHIFT))
+(PUT (QUOTE LSH) (QUOTE IDNUMBER) (QUOTE 427))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE COMPILETIME) (QUOTE ENTRYPOINT) (QUOTE "L2923"))
+(PUT (QUOTE COMPILETIME) (QUOTE IDNUMBER) (QUOTE 711))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE STEP) (QUOTE ENTRYPOINT) (QUOTE STEP))
+(PUT (QUOTE STEP) (QUOTE IDNUMBER) (QUOTE 579))
+(PUT (QUOTE PAGEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE PAGEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L2258"))
+(PUT (QUOTE PAGEPOSITION) (QUOTE WARRAY) (QUOTE PAGEPOSITION))
+(PUT (QUOTE DEFCONST) (QUOTE ENTRYPOINT) (QUOTE "L3044"))
+(PUT (QUOTE DEFCONST) (QUOTE IDNUMBER) (QUOTE 731))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 522))
+(PUT (QUOTE GCTIME!*) (QUOTE IDNUMBER) (QUOTE 415))
+(PUT (QUOTE GCTIME!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 654))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L1407"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE BPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BPS) (QUOTE ASMSYMBOL) (QUOTE BPS))
+(PUT (QUOTE BPS) (QUOTE WARRAY) (QUOTE BPS))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L2279"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 467))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L1784"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE EQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0429"))
+(PUT (QUOTE EQUAL) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 649))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L2255"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE FINDCATCHMARKANDTHROW) (QUOTE ENTRYPOINT) (QUOTE "L2027"))
+(PUT (QUOTE NO) (QUOTE IDNUMBER) (QUOTE 473))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INTLAND) (QUOTE ENTRYPOINT) (QUOTE "L1455"))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE RPLACEALL) (QUOTE ENTRYPOINT) (QUOTE "L1611"))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1815"))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 505))
+(PUT (QUOTE CATCHSETUPAUX) (QUOTE ENTRYPOINT) (QUOTE "L2014"))
+(PUT (QUOTE GCKNT!*) (QUOTE IDNUMBER) (QUOTE 414))
+(PUT (QUOTE GCKNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE INTHISCASE) (QUOTE ENTRYPOINT) (QUOTE "L2951"))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE ENTRYPOINT) (QUOTE "L2922"))
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE IDNUMBER) (QUOTE 710))
+(PUT (QUOTE HEAP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAP) (QUOTE ASMSYMBOL) (QUOTE HEAP))
+(PUT (QUOTE HEAP) (QUOTE WARRAY) (QUOTE HEAP))
+(PUT (QUOTE COPYWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L1135"))
+(PUT (QUOTE COPYWARRAY) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE INTTIMES2) (QUOTE ENTRYPOINT) (QUOTE "L1416"))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE LIST2VECTOR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE LIST2VECTOR) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE SUBST) (QUOTE ENTRYPOINT) (QUOTE SUBST))
+(PUT (QUOTE SUBST) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 517))
+(PUT (QUOTE !*COMPRESSING) (QUOTE IDNUMBER) (QUOTE 647))
+(FLAG (QUOTE (!*COMPRESSING)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE XN) (QUOTE ENTRYPOINT) (QUOTE XN))
+(PUT (QUOTE XN) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE LOR) (QUOTE ENTRYPOINT) (QUOTE LOR))
+(PUT (QUOTE LOR) (QUOTE IDNUMBER) (QUOTE 424))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L1757"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0794"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE WRITEFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2848"))
+(PUT (QUOTE WRITEFLOAT) (QUOTE IDNUMBER) (QUOTE 668))
+(PUT (QUOTE ONOFF!*) (QUOTE ENTRYPOINT) (QUOTE "L2979"))
+(PUT (QUOTE ONOFF!*) (QUOTE IDNUMBER) (QUOTE 724))
+(PUT (QUOTE FLATSIZE2) (QUOTE ENTRYPOINT) (QUOTE "L2908"))
+(PUT (QUOTE FLATSIZE2) (QUOTE IDNUMBER) (QUOTE 700))
+(PUT (QUOTE PROGJUMPTABLE!*) (QUOTE IDNUMBER) (QUOTE 540))
+(FLAG (QUOTE (PROGJUMPTABLE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE NONINTEGER1ERROR) (QUOTE ENTRYPOINT) (QUOTE "L1367"))
+(PUT (QUOTE RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1260"))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0811"))
+(PUT (QUOTE FUNCTION) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE NUMBERP) (QUOTE ENTRYPOINT) (QUOTE "L0632"))
+(PUT (QUOTE NUMBERP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE PP) (QUOTE ENTRYPOINT) (QUOTE PP))
+(PUT (QUOTE PP) (QUOTE IDNUMBER) (QUOTE 576))
+(PUT (QUOTE CONCAT) (QUOTE ENTRYPOINT) (QUOTE CONCAT))
+(PUT (QUOTE CONCAT) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE SETMACROREFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L3006"))
+(PUT (QUOTE !*SEMICOL!*) (QUOTE IDNUMBER) (QUOTE 480))
+(PUT (QUOTE INTONEP) (QUOTE ENTRYPOINT) (QUOTE "L1548"))
+(PUT (QUOTE COPY) (QUOTE ENTRYPOINT) (QUOTE COPY))
+(PUT (QUOTE COPY) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE EDITF) (QUOTE ENTRYPOINT) (QUOTE EDITF))
+(PUT (QUOTE EDITF) (QUOTE IDNUMBER) (QUOTE 439))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L1760"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE CHANNELEJECT) (QUOTE ENTRYPOINT) (QUOTE "L2321"))
+(PUT (QUOTE CHANNELEJECT) (QUOTE IDNUMBER) (QUOTE 619))
+(PUT (QUOTE SUBLA) (QUOTE ENTRYPOINT) (QUOTE SUBLA))
+(PUT (QUOTE SUBLA) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 616))
+(FLAG (QUOTE (STDIN!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE FASTUNBIND) (QUOTE IDNUMBER) (QUOTE 447))
+(PUT (QUOTE RASSOC) (QUOTE ENTRYPOINT) (QUOTE RASSOC))
+(PUT (QUOTE RASSOC) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE STATICINTFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L1359"))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 611))
+(PUT (QUOTE EVLOAD) (QUOTE ENTRYPOINT) (QUOTE EVLOAD))
+(PUT (QUOTE EVLOAD) (QUOTE IDNUMBER) (QUOTE 434))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE CATCH!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1970"))
+(PUT (QUOTE CATCH!-ALL) (QUOTE IDNUMBER) (QUOTE 527))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE ENTRYPOINT) (QUOTE "L1809"))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 502))
+(PUT (QUOTE SETINDX) (QUOTE ENTRYPOINT) (QUOTE "L0186"))
+(PUT (QUOTE SETINDX) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 605))
+(PUT (QUOTE ADJOINQ) (QUOTE ENTRYPOINT) (QUOTE "L1056"))
+(PUT (QUOTE ADJOINQ) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE MAKEBUFINTOFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2398"))
+(PUT (QUOTE CATCHSETUP) (QUOTE ENTRYPOINT) (QUOTE "L2013"))
+(PUT (QUOTE CATCHSETUP) (QUOTE IDNUMBER) (QUOTE 499))
+(PUT (QUOTE FORMATFORPRINTF!*) (QUOTE IDNUMBER) (QUOTE 693))
+(FLAG (QUOTE (FORMATFORPRINTF!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE DIGITTONUMBER) (QUOTE ENTRYPOINT) (QUOTE "L2510"))
+(PUT (QUOTE DIGITTONUMBER) (QUOTE IDNUMBER) (QUOTE 651))
+(PUT (QUOTE MARKANDCOPYFROMID) (QUOTE ENTRYPOINT) (QUOTE "L1272"))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 520))
+(PUT (QUOTE CHANNELPRIN) (QUOTE IDNUMBER) (QUOTE 687))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE DISPLAYHELPFILE) (QUOTE IDNUMBER) (QUOTE 456))
+(PUT (QUOTE !$LOOP!$) (QUOTE IDNUMBER) (QUOTE 743))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1255"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE MAKESTRINGINTOLISPINTEGER) (QUOTE ENTRYPOINT) (QUOTE "L2512"))
+(PUT (QUOTE MAKESTRINGINTOLISPINTEGER) (QUOTE IDNUMBER) (QUOTE 650))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L2081"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 270))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 603))
+(PUT (QUOTE RETURN) (QUOTE ENTRYPOINT) (QUOTE RETURN))
+(PUT (QUOTE RETURN) (QUOTE IDNUMBER) (QUOTE 545))
+(PUT (QUOTE BINARYOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L2102"))
+(PUT (QUOTE BINARYOPENWRITE) (QUOTE IDNUMBER) (QUOTE 551))
+(PUT (QUOTE ONEARGDISPATCH) (QUOTE ENTRYPOINT) (QUOTE "L1369"))
+(PUT (QUOTE INTLOR) (QUOTE ENTRYPOINT) (QUOTE INTLOR))
+(PUT (QUOTE COPYFROMALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1267"))
+(PUT (QUOTE ONEARGERROR) (QUOTE ENTRYPOINT) (QUOTE "L1378"))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE ENTRYPOINT) (QUOTE "L1268"))
+(PUT (QUOTE CHANNELPRINC) (QUOTE ENTRYPOINT) (QUOTE "L2335"))
+(PUT (QUOTE CHANNELPRINC) (QUOTE IDNUMBER) (QUOTE 630))
+(PUT (QUOTE RECURSIVECHANNELPRIN1) (QUOTE ENTRYPOINT) (QUOTE "L2827"))
+(PUT (QUOTE RECURSIVECHANNELPRIN1) (QUOTE IDNUMBER) (QUOTE 682))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE !*CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 482))
+(FLAG (QUOTE (!*CONTINUABLEERROR)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE VECTOREQUAL) (QUOTE ENTRYPOINT) (QUOTE "L0446"))
+(PUT (QUOTE INTERSECTION) (QUOTE ENTRYPOINT) (QUOTE XN))
+(PUT (QUOTE INTERSECTION) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE MAKEINPUTAVAILABLE) (QUOTE ENTRYPOINT) (QUOTE "L2552"))
+(PUT (QUOTE MAKEINPUTAVAILABLE) (QUOTE IDNUMBER) (QUOTE 639))
+(PUT (QUOTE EVAND1) (QUOTE ENTRYPOINT) (QUOTE EVAND1))
+(PUT (QUOTE RPLACW) (QUOTE ENTRYPOINT) (QUOTE RPLACW))
+(PUT (QUOTE RPLACW) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE FINDFIRST) (QUOTE ENTRYPOINT) (QUOTE "L1613"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 550))
+(PUT (QUOTE MKEVECT) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE CHANNELWRITEBITSTRING) (QUOTE ENTRYPOINT) (QUOTE "L2566"))
+(PUT (QUOTE QUIT) (QUOTE ENTRYPOINT) (QUOTE QUIT))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 471))
+(PUT (QUOTE TRST) (QUOTE ENTRYPOINT) (QUOTE TRST))
+(PUT (QUOTE TRST) (QUOTE IDNUMBER) (QUOTE 435))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE FILEP) (QUOTE ENTRYPOINT) (QUOTE FILEP))
+(PUT (QUOTE FILEP) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE GCSTATS) (QUOTE ENTRYPOINT) (QUOTE "L1270"))
+(PUT (QUOTE FLOATPLUS2) (QUOTE ENTRYPOINT) (QUOTE "L1400"))
+(PUT (QUOTE CHANNELWRITESYSFLOAT) (QUOTE ENTRYPOINT) (QUOTE "L2578"))
+(PUT (QUOTE CHANNELWRITESYSFLOAT) (QUOTE IDNUMBER) (QUOTE 667))
+(PUT (QUOTE !#ARG) (QUOTE IDNUMBER) (QUOTE 729))
+(PUT (QUOTE MAP2) (QUOTE ENTRYPOINT) (QUOTE MAP2))
+(PUT (QUOTE MAP2) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE EDIT) (QUOTE ENTRYPOINT) (QUOTE EDIT))
+(PUT (QUOTE EDIT) (QUOTE IDNUMBER) (QUOTE 440))
+(PUT (QUOTE STRING) (QUOTE ENTRYPOINT) (QUOTE STRING))
+(PUT (QUOTE STRING) (QUOTE IDNUMBER) (QUOTE 411))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE RECURSIVECHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L2796"))
+(PUT (QUOTE RECURSIVECHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 680))
+(PUT (QUOTE OK) (QUOTE IDNUMBER) (QUOTE 455))
+(PUT (QUOTE POSN) (QUOTE ENTRYPOINT) (QUOTE POSN))
+(PUT (QUOTE POSN) (QUOTE IDNUMBER) (QUOTE 623))
ADDED psl-1983/3-1/kernel/20/all-kernel.ctl
Index: psl-1983/3-1/kernel/20/all-kernel.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/all-kernel.ctl
@@ -0,0 +1,16 @@
+submit types.ctl
+submit randm.ctl
+submit alloc.ctl
+submit arith.ctl
+submit debg.ctl
+submit error.ctl
+submit eval.ctl
+submit extra.ctl
+submit fasl.ctl
+submit io.ctl
+submit macro.ctl
+submit prop.ctl
+submit symbl.ctl
+submit sysio.ctl
+submit tloop.ctl
+submit heap.ctl
ADDED psl-1983/3-1/kernel/20/alloc.ctl
Index: psl-1983/3-1/kernel/20/alloc.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/alloc.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "alloc";
+PathIn "alloc.build";
+ASMEnd;
+quit;
+compile alloc.mac, dalloc.mac
ADDED psl-1983/3-1/kernel/20/alloc.init
Index: psl-1983/3-1/kernel/20/alloc.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/alloc.init
@@ -0,0 +1,3 @@
+(PUT (QUOTE STRING) (QUOTE TYPE) (QUOTE NEXPR))
+(PUT (QUOTE VECTOR) (QUOTE TYPE) (QUOTE NEXPR))
+(FLUID (QUOTE (!*GC GCKNT!* GCTIME!* HEAP!-WARN!-LEVEL)))
ADDED psl-1983/3-1/kernel/20/alloc.log
Index: psl-1983/3-1/kernel/20/alloc.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/alloc.log
@@ -0,0 +1,66 @@
+
+ 8-Jun-83 9:32:07
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job ALLOC Req #476 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:10:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 1733
+
+ Input from => PS:<PSL.KERNEL.20.EXT>ALLOC.CTL.3
+ Output to => PS:<PSL.KERNEL.20.EXT>ALLOC.LOG
+
+
+
+ 9:32:08 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+ 9:32:08 MONTR @SET TIME-LIMIT 600
+ 9:32:08 MONTR @@LOGIN KESSLER SMALL
+ 9:32:11 MONTR Job 12 on TTY224 8-Jun-83 09:32:11
+ 9:32:11 MONTR Previous login at 8-Jun-83 09:29:18
+ 9:32:11 MONTR There is 1 other job logged in as user KESSLER
+ 9:32:21 MONTR @
+ 9:32:21 MONTR [PS Mounted]
+ 9:32:21 MONTR
+ 9:32:21 MONTR [CONNECTED TO PS:<PSL.KERNEL.20.EXT>]
+ ;Modifications to this file may disappear, as this file is generated
+ ;automatically using information in P20:20-KERNEL-GEN.SL.
+ 9:32:21 MONTR def dsk: dsk:,p20e:,pk:,p20:
+ 9:32:22 MONTR @S:EX-DEC20-CROSS.EXE
+ 9:32:27 USER [17] ASMOut "alloc";
+ 9:32:28 USER ASMOUT: IN files; or type in expressions
+ 9:32:28 USER When all done execute ASMEND;
+ 9:32:33 USER [18] PathIn "alloc.build";
+ 9:32:33 USER %
+ 9:32:33 USER % ALLOC.BUILD - Files dealing with allocation of memory blocks
+ 9:32:33 USER %
+ 9:32:33 USER % Author: Eric Benson
+ 9:32:33 USER % Symbolic Computation Group
+ 9:32:33 USER % Computer Science Dept.
+ 9:32:33 USER % University of Utah
+ 9:32:34 USER % Date: 19 May 1982
+ 9:32:34 USER % Copyright (c) 1982 University of Utah
+ 9:32:35 USER %
+ 9:32:35 USER
+ 9:32:35 USER PathIn "allocators.red"$ % heap, symbol and code space alloc
+ 9:32:58 USER PathIn "copiers.red"$ % copying functions
+ 9:33:05 USER PathIn "cons-mkvect.red"$ % SL constructor functions
+ 9:33:15 USER PathIn "comp-support.red"$ % optimized CONS and LIST compilation
+ 9:33:16 USER PathIn "system-gc.red"$ % system-specific GC routines
+ 9:33:17 USER PathIn "gc.red"$ % the garbage collector
+ 9:33:42 USER [19] ASMEnd;
+ 9:33:44 USER *** Garbage collection starting
+ 9:33:49 USER *** GC 8: time 1768 ms, 205573 recovered, 244793 free
+ 9:34:00 USER 0
+ 9:34:00 USER [20] quit;
+ 9:34:00 MONTR @compile alloc.mac, dalloc.mac
+ 9:34:03 USER MACRO: .MAIN
+ 9:34:11 USER MACRO: .MAIN
+ 9:34:11 USER
+ 9:34:11 USER EXIT
+ 9:34:12 MONTR @
+ 9:34:13 MONTR Killed by OPERATOR, TTY 221
+ 9:34:13 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 224,
+ 9:34:13 MONTR at 8-Jun-83 09:34:13, Used 0:00:49 in 0:02:01
ADDED psl-1983/3-1/kernel/20/alloc.mac
Index: psl-1983/3-1/kernel/20/alloc.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/alloc.mac
@@ -0,0 +1,1585 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern BPS
+ extern HEAP
+ extern HEAP2
+ extern L1080
+ extern L1081
+ extern L1082
+ extern L1083
+ extern L1084
+ extern L1085
+ extern L1086
+ extern L1087
+ extern L1088
+ 0
+; (!*ENTRY KNOWN!-FREE!-SPACE EXPR 0)
+L1089: intern L1089
+ HRRZI 2,1
+ MOVE 1,L1082
+ SUB 1,L1080
+ IDIV 1,2
+ POPJ 15,0
+ 1
+; (!*ENTRY GTHEAP EXPR 1)
+GTHEAP: intern GTHEAP
+ CAME 1,0
+ JRST L1090
+ JRST SYMFNC+378
+L1090: MOVE 2,0
+ JRST L1091
+L1093: 19
+ byte(7)72,101,97,112,32,115,112,97,99,101,32,101,120,104,97,117,115,116,101,100,0
+; (!*ENTRY GTHEAP1 EXPR 2)
+L1091: intern L1091
+ ADJSP 15,3
+L1094: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 6,L1080
+ MOVEM 6,-2(15)
+ ADDM 1,L1080
+ MOVE 6,L1086
+ CAML 6,L1080
+ JRST L1095
+ MOVE 6,L1082
+ CAML 6,L1080
+ JRST L1096
+ MOVE 6,-2(15)
+ MOVEM 6,L1080
+ CAMN 2,0
+ JRST L1097
+ MOVE 1,L1092
+ PUSHJ 15,SYMFNC+380
+ JRST L1095
+L1097: PUSHJ 15,SYMFNC+381
+ MOVE 2,SYMVAL+84
+ MOVE 1,0(15)
+ JRST L1094
+L1096: CAME 0,L1088
+ JRST L1095
+ MOVE 6,SYMVAL+84
+ MOVEM 6,L1088
+ PUSHJ 15,SYMFNC+382
+L1095: MOVE 1,-2(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L1092: <4_30>+<1_18>+L1093
+ 0
+; (!*ENTRY GC!-TRAP!-LEVEL EXPR 0)
+L1098: intern L1098
+ HRRZI 2,1
+ MOVE 1,L1082
+ SUB 1,L1086
+ IDIV 1,2
+ POPJ 15,0
+ 1
+; (!*ENTRY SET!-GC!-TRAP!-LEVEL EXPR 1)
+L1101: intern L1101
+ PUSH 15,1
+ LDB 11,L1099
+ CAIG 11,0
+ JRST L1102
+ CAIN 11,63
+ JRST L1102
+ MOVE 2,L1100
+ PUSHJ 15,SYMFNC+133
+L1102: MOVE 1,L1082
+ SUB 1,0(15)
+ MOVEM 1,L1086
+ MOVE 1,SYMVAL+84
+ ADJSP 15,-1
+ POPJ 15,0
+L1099: point 6,1,5
+L1100: <30_30>+383
+ 2
+; (!*ENTRY DELHEAP EXPR 2)
+L1103: intern L1103
+ CAME 2,L1080
+ JRST L1104
+ MOVEM 1,L1080
+ POPJ 15,0
+L1104: MOVE 1,0
+ POPJ 15,0
+ 1
+; (!*ENTRY GTSTR EXPR 1)
+GTSTR: intern GTSTR
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZI 2,5
+ ADDI 1,6
+ IDIV 1,2
+ MOVEM 1,-2(15)
+ AOS 1
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ TLO 2,94208
+ MOVEM 2,0(1)
+ MOVE 4,-2(15)
+ ADDM 1,4
+ SETZM 0(4)
+ ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY GTCONSTSTR EXPR 1)
+L1105: intern L1105
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ HRRZI 2,5
+ ADDI 1,6
+ IDIV 1,2
+ MOVEM 1,-2(15)
+ AOS 1
+ PUSHJ 15,SYMFNC+386
+ MOVEM 1,-1(15)
+ MOVE 6,0(15)
+ MOVEM 6,0(1)
+ MOVE 3,-2(15)
+ ADDM 1,3
+ SETZM 0(3)
+ ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY GTHALFWORDS EXPR 1)
+L1106: intern L1106
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ LSH 1,-1
+ AOS 1
+ MOVEM 1,-2(15)
+ AOS 1
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ TLO 2,98304
+ MOVEM 2,0(1)
+ ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY GTVECT EXPR 1)
+GTVECT: intern GTVECT
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ ADDI 1,2
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ TLO 2,106496
+ MOVEM 2,0(1)
+ ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY GTWRDS EXPR 1)
+GTWRDS: intern GTWRDS
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ ADDI 1,2
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ TLO 2,102400
+ MOVEM 2,0(1)
+ ADJSP 15,-2
+ POPJ 15,0
+ 0
+; (!*ENTRY GTFIXN EXPR 0)
+GTFIXN: intern GTFIXN
+ ADJSP 15,1
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,0(15)
+ SETZM 2
+ TLZ 2,258048
+ TLO 2,102400
+ MOVEM 2,0(1)
+ ADJSP 15,-1
+ POPJ 15,0
+ 0
+; (!*ENTRY GTFLTN EXPR 0)
+GTFLTN: intern GTFLTN
+ ADJSP 15,1
+ HRRZI 1,3
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,0(15)
+ HRRZI 2,1
+ TLZ 2,258048
+ TLO 2,102400
+ MOVEM 2,0(1)
+ ADJSP 15,-1
+ POPJ 15,0
+L1108: 18
+ byte(7)82,97,110,32,111,117,116,32,111,102,32,73,68,32,115,112,97,99,101,0
+ 0
+; (!*ENTRY GTID EXPR 0)
+GTID: intern GTID
+ PUSH 15,0
+ SKIPE L0001
+ JRST L1109
+ PUSHJ 15,SYMFNC+390
+ SKIPE L0001
+ JRST L1109
+ MOVE 1,L1107
+ ADJSP 15,-1
+ JRST SYMFNC+380
+L1109: MOVE 6,L0001
+ MOVEM 6,0(15)
+ MOVE 6,0(15)
+ MOVE 6,SYMNAM(6)
+ MOVEM 6,L0001
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L1107: <4_30>+<1_18>+L1108
+ extern L1110
+ extern L1111
+L1113: 30
+ byte(7)82,97,110,32,111,117,116,32,111,102,32,98,105,110,97,114,121,32,112,114,111,103,114,97,109,32,115,112,97,99,101,0
+ 1
+; (!*ENTRY GTBPS EXPR 1)
+GTBPS: intern GTBPS
+ MOVE 4,1
+ MOVE 3,0
+ CAME 1,0
+ JRST L1114
+ HRRZI 2,1
+ MOVE 1,L1111
+ SUB 1,L1110
+ IDIV 1,2
+ POPJ 15,0
+L1114: MOVE 3,L1110
+ ADDM 1,L1110
+ MOVE 6,L1111
+ CAML 6,L1110
+ JRST L1115
+ MOVE 1,L1112
+ JRST SYMFNC+156
+L1115: MOVE 1,3
+ POPJ 15,0
+L1112: <4_30>+<1_18>+L1113
+ 2
+; (!*ENTRY DELBPS EXPR 2)
+DELBPS: intern DELBPS
+ CAME 2,L1110
+ JRST L1116
+ MOVEM 1,L1110
+ POPJ 15,0
+L1116: MOVE 1,0
+ POPJ 15,0
+L1118: 22
+ byte(7)82,97,110,32,111,117,116,32,111,102,32,87,65,114,114,97,121,32,115,112,97,99,101,0
+ 1
+; (!*ENTRY GTWARRAY EXPR 1)
+L1119: intern L1119
+ MOVE 4,1
+ MOVE 3,0
+ CAME 1,0
+ JRST L1120
+ HRRZI 2,1
+ MOVE 1,L1111
+ SUB 1,L1110
+ IDIV 1,2
+ POPJ 15,0
+L1120: MOVE 2,L1111
+ SUB 2,1
+ MOVE 3,2
+ CAML 2,L1110
+ JRST L1121
+ MOVE 1,L1117
+ JRST SYMFNC+156
+L1121: MOVE 1,2
+ MOVEM 1,L1111
+ POPJ 15,0
+L1117: <4_30>+<1_18>+L1118
+ 2
+; (!*ENTRY DELWARRAY EXPR 2)
+L1122: intern L1122
+ CAME 1,L1111
+ JRST L1123
+ MOVE 1,2
+ MOVEM 1,L1111
+ POPJ 15,0
+L1123: MOVE 1,0
+ POPJ 15,0
+ 2
+; (!*ENTRY COPYSTRINGTOFROM EXPR 2)
+L1127: intern L1127
+ ADJSP 15,6
+ MOVEM 1,-5(15)
+ MOVEM 2,-4(15)
+ MOVE 3,1
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-1(15)
+ MOVE 6,0(4)
+ LDB 5,L1124
+ TDNE 5,L1125
+ TDO 5,L1126
+ MOVEM 5,-3(15)
+ MOVE 6,0(3)
+ LDB 1,L1124
+ TDNE 1,L1125
+ TDO 1,L1126
+ CAML 1,5
+ JRST L1128
+ MOVEM 1,-3(15)
+L1128: HRRZI 2,5
+ HRRZI 1,6
+ ADD 1,-3(15)
+ IDIV 1,2
+ MOVEM 1,-3(15)
+ SETZM 0(15)
+L1129: MOVE 6,0(15)
+ CAMLE 6,-3(15)
+ JRST L1130
+ MOVE 2,0(15)
+ ADD 2,-2(15)
+ MOVE 3,0(15)
+ ADD 3,-1(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS 0(15)
+ JRST L1129
+L1130: MOVE 1,-5(15)
+ ADJSP 15,-6
+ POPJ 15,0
+L1124: point 30,6,35
+L1125: 536870912
+L1126: -536870912
+ 1
+; (!*ENTRY COPYSTRING EXPR 1)
+L1134: intern L1134
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L1131
+ TDNE 1,L1132
+ TDO 1,L1133
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC+394
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,16384
+ ADJSP 15,-2
+ POPJ 15,0
+L1131: point 30,6,35
+L1132: 536870912
+L1133: -536870912
+ 3
+; (!*ENTRY COPYWARRAY EXPR 3)
+L1135: intern L1135
+ ADJSP 15,2
+ MOVEM 1,-1(15)
+ MOVEM 2,0(15)
+ MOVE 5,3
+ SETZM 4
+L1136: CAMG 4,5
+ JRST L1137
+ SETZM 1
+ JRST L1138
+L1137: MOVE 2,4
+ ADD 2,-1(15)
+ MOVE 3,4
+ ADD 3,0(15)
+ MOVE 6,0(3)
+ MOVEM 6,0(2)
+ AOS 4
+ JRST L1136
+L1138: MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+ 2
+; (!*ENTRY COPYVECTORTOFROM EXPR 2)
+L1142: intern L1142
+ ADJSP 15,6
+ MOVEM 1,-5(15)
+ MOVEM 2,-4(15)
+ MOVE 3,1
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-1(15)
+ MOVE 6,0(4)
+ LDB 5,L1139
+ TDNE 5,L1140
+ TDO 5,L1141
+ MOVEM 5,-3(15)
+ SETZM 0(15)
+L1143: MOVE 6,0(15)
+ CAMLE 6,-3(15)
+ JRST L1144
+ MOVE 2,0(15)
+ ADD 2,-2(15)
+ MOVE 3,0(15)
+ ADD 3,-1(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS 0(15)
+ JRST L1143
+L1144: MOVE 1,-5(15)
+ ADJSP 15,-6
+ POPJ 15,0
+L1139: point 30,6,35
+L1140: 536870912
+L1141: -536870912
+ 1
+; (!*ENTRY COPYVECTOR EXPR 1)
+L1148: intern L1148
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L1145
+ TDNE 1,L1146
+ TDO 1,L1147
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC+397
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,32768
+ ADJSP 15,-2
+ POPJ 15,0
+L1145: point 30,6,35
+L1146: 536870912
+L1147: -536870912
+ 2
+; (!*ENTRY COPYWRDSTOFROM EXPR 2)
+L1152: intern L1152
+ ADJSP 15,6
+ MOVEM 1,-5(15)
+ MOVEM 2,-4(15)
+ MOVE 3,1
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-1(15)
+ MOVE 6,0(4)
+ LDB 5,L1149
+ TDNE 5,L1150
+ TDO 5,L1151
+ MOVEM 5,-3(15)
+ SETZM 0(15)
+L1153: MOVE 6,0(15)
+ CAMLE 6,-3(15)
+ JRST L1154
+ MOVE 2,0(15)
+ ADD 2,-2(15)
+ MOVE 3,0(15)
+ ADD 3,-1(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS 0(15)
+ JRST L1153
+L1154: MOVE 1,-5(15)
+ ADJSP 15,-6
+ POPJ 15,0
+L1149: point 30,6,35
+L1150: 536870912
+L1151: -536870912
+ 1
+; (!*ENTRY COPYWRDS EXPR 1)
+L1158: intern L1158
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L1155
+ TDNE 1,L1156
+ TDO 1,L1157
+ PUSHJ 15,SYMFNC+170
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC+399
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,28672
+ ADJSP 15,-2
+ POPJ 15,0
+L1155: point 30,6,35
+L1156: 536870912
+L1157: -536870912
+ 1
+; (!*ENTRY TOTALCOPY EXPR 1)
+L1163: intern L1163
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 1,L1159
+ CAIL 1,1
+ CAILE 1,9
+ JRST L1164
+ JRST @L1165-1(1)
+L1165: IFIW L1166
+ IFIW L1167
+ IFIW L1168
+ IFIW L1169
+ IFIW L1167
+ IFIW L1167
+ IFIW L1170
+ IFIW L1171
+ IFIW L1172
+L1164: JRST L1167
+L1172: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,L1163
+ MOVEM 1,-4(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,L1163
+ MOVE 2,-4(15)
+ ADJSP 15,-5
+ JRST SYMFNC+278
+L1169: MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+395
+L1171: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-3(15)
+ MOVE 6,0(2)
+ LDB 3,L1160
+ TDNE 3,L1161
+ TDO 3,L1162
+ MOVEM 3,-1(15)
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+142
+ MOVE 4,1
+ TLZ 4,258048
+ TLO 4,32768
+ MOVEM 4,-2(15)
+ MOVEM 0,-4(15)
+ SETZM -4(15)
+L1173: MOVE 6,-4(15)
+ CAMG 6,-1(15)
+ JRST L1174
+ SETZM 1
+ JRST L1175
+L1174: MOVE 1,0(15)
+ TLZ 1,258048
+ ADD 1,-4(15)
+ MOVE 1,1(1)
+ PUSHJ 15,L1163
+ MOVE 2,-2(15)
+ TLZ 2,258048
+ ADD 2,-4(15)
+ MOVEM 1,1(2)
+ AOS -4(15)
+ JRST L1173
+L1175: MOVE 1,-2(15)
+ JRST L1176
+L1170: MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+400
+L1166: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+400
+ TLZ 1,258048
+ TLZ 1,258048
+ TLO 1,4096
+ JRST L1176
+L1168: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+400
+ TLZ 1,258048
+ TLZ 1,258048
+ TLO 1,12288
+ JRST L1176
+L1167: MOVE 1,0(15)
+L1176: ADJSP 15,-5
+ POPJ 15,0
+L1159: point 6,1,5
+L1160: point 30,6,35
+L1161: 536870912
+L1162: -536870912
+; (!*ENTRY HARDCONS EXPR 2)
+L1177: intern L1177
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVNI 7,2
+ ADDM 7,L1080
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+379
+ MOVEM 1,-2(15)
+ MOVE 6,0(15)
+ MOVEM 6,0(1)
+ MOVE 6,-1(15)
+ MOVEM 6,1(1)
+ TLZ 1,258048
+ TLO 1,36864
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY CONS EXPR 2)
+CONS: intern CONS
+ MOVE 5,1
+ MOVE 4,2
+ MOVE 3,L1080
+ HRRZI 7,2
+ ADDM 7,L1080
+ MOVE 6,L1086
+ CAML 6,L1080
+ JRST L1178
+ JRST L1177
+L1178: MOVEM 1,0(3)
+ MOVEM 2,1(3)
+ MOVE 1,3
+ TLZ 1,258048
+ TLO 1,36864
+ POPJ 15,0
+ 2
+; (!*ENTRY XCONS EXPR 2)
+XCONS: intern XCONS
+ MOVE 5,1
+ MOVE 4,2
+ MOVE 3,L1080
+ HRRZI 7,2
+ ADDM 7,L1080
+ MOVE 6,L1086
+ CAML 6,L1080
+ JRST L1179
+ MOVE 2,1
+ MOVE 1,4
+ JRST L1177
+L1179: MOVEM 2,0(3)
+ MOVEM 1,1(3)
+ MOVE 1,3
+ TLZ 1,258048
+ TLO 1,36864
+ POPJ 15,0
+ 1
+; (!*ENTRY NCONS EXPR 1)
+NCONS: intern NCONS
+ MOVE 4,1
+ MOVE 3,L1080
+ HRRZI 7,2
+ ADDM 7,L1080
+ MOVE 6,L1086
+ CAML 6,L1080
+ JRST L1180
+ MOVE 2,0
+ JRST L1177
+L1180: MOVEM 1,0(3)
+ MOVE 2,0
+ MOVEM 2,1(3)
+ MOVE 1,3
+ TLZ 1,258048
+ TLO 1,36864
+ POPJ 15,0
+L1186: 57
+ byte(7)65,32,118,101,99,116,111,114,32,119,105,116,104,32,102,101,119,101,114,32,116,104,97,110,32,122,101,114,111,32,101,108,101,109,101,110,116,115,32,99,97,110,110,111,116,32,98,101,32,97,108,108,111,99,97,116,101,100,0
+ 1
+; (!*ENTRY MKVECT EXPR 1)
+MKVECT: intern MKVECT
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ LDB 11,L1182
+ CAIN 11,63
+ JRST L1181
+ CAILE 11,0
+ JRST L1187
+L1181: MOVEM 1,0(15)
+ CAML 1,L1183
+ JRST L1188
+ MOVE 1,L1184
+ ADJSP 15,-3
+ JRST SYMFNC+156
+L1188: MOVEM 0,-1(15)
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-1(15)
+ MOVEM 0,-2(15)
+ SETZM -2(15)
+L1189: MOVE 6,-2(15)
+ CAMLE 6,0(15)
+ JRST L1190
+ MOVE 2,-2(15)
+ ADD 2,-1(15)
+ MOVE 1,0
+ MOVEM 1,1(2)
+ AOS -2(15)
+ JRST L1189
+L1190: MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,32768
+ JRST L1191
+L1187: MOVE 2,L1185
+ ADJSP 15,-3
+ JRST SYMFNC+133
+L1191: ADJSP 15,-3
+ POPJ 15,0
+L1182: point 6,1,5
+L1183: -1
+L1185: <30_30>+402
+L1184: <4_30>+<1_18>+L1186
+L1197: 58
+ byte(7)65,110,32,32,69,118,101,99,116,32,119,105,116,104,32,102,101,119,101,114,32,116,104,97,110,32,122,101,114,111,32,101,108,101,109,101,110,116,115,32,99,97,110,110,111,116,32,98,101,32,97,108,108,111,99,97,116,101,100,0
+ 2
+; (!*ENTRY MKEVECTOR EXPR 2)
+L1198: intern L1198
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1193
+ CAIN 11,63
+ JRST L1192
+ CAILE 11,0
+ JRST L1199
+L1192: MOVEM 1,0(15)
+ CAML 1,L1194
+ JRST L1200
+ MOVE 1,L1195
+ ADJSP 15,-4
+ JRST SYMFNC+156
+L1200: MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+387
+ MOVEM 1,-2(15)
+ MOVE 6,-1(15)
+ MOVEM 6,1(1)
+ MOVEM 0,-3(15)
+ HRRZI 6,1
+ MOVEM 6,-3(15)
+L1201: MOVE 6,-3(15)
+ CAMLE 6,0(15)
+ JRST L1202
+ MOVE 2,-3(15)
+ ADD 2,-2(15)
+ MOVE 1,0
+ MOVEM 1,1(2)
+ AOS -3(15)
+ JRST L1201
+L1202: MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,40960
+ JRST L1203
+L1199: MOVE 2,L1196
+ ADJSP 15,-4
+ JRST SYMFNC+133
+L1203: ADJSP 15,-4
+ POPJ 15,0
+L1193: point 6,1,5
+L1194: -1
+L1196: <30_30>+404
+L1195: <4_30>+<1_18>+L1197
+ 2
+; (!*ENTRY MKSTRING EXPR 2)
+L1208: intern L1208
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L1205
+ CAIN 11,63
+ JRST L1204
+ CAILE 11,0
+ JRST L1209
+L1204: MOVEM 1,-2(15)
+ JRST L1210
+L1209: MOVE 2,L1206
+ ADJSP 15,-5
+ JRST SYMFNC+133
+L1210: MOVE 6,-2(15)
+ CAML 6,L1207
+ JRST L1211
+ MOVE 2,L1206
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+406
+L1211: MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L1212: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L1213
+ MOVE 3,-1(15)
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -4(15)
+ JRST L1212
+L1213: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,16384
+ ADJSP 15,-5
+ POPJ 15,0
+L1205: point 6,1,5
+L1207: -1
+L1206: <30_30>+405
+ 2
+; (!*ENTRY MAKE!-BYTES EXPR 2)
+L1218: intern L1218
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L1215
+ CAIN 11,63
+ JRST L1214
+ CAILE 11,0
+ JRST L1219
+L1214: MOVEM 1,-2(15)
+ JRST L1220
+L1219: MOVE 2,L1216
+ ADJSP 15,-5
+ JRST SYMFNC+133
+L1220: MOVE 6,-2(15)
+ CAML 6,L1217
+ JRST L1221
+ MOVE 2,L1216
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+406
+L1221: MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L1222: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L1223
+ MOVE 3,-1(15)
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -4(15)
+ JRST L1222
+L1223: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,20480
+ ADJSP 15,-5
+ POPJ 15,0
+L1215: point 6,1,5
+L1217: -1
+L1216: <30_30>+407
+ 2
+; (!*ENTRY MAKE!-HALFWORDS EXPR 2)
+L1228: intern L1228
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L1225
+ CAIN 11,63
+ JRST L1224
+ CAILE 11,0
+ JRST L1229
+L1224: MOVEM 1,-2(15)
+ JRST L1230
+L1229: MOVE 2,L1226
+ ADJSP 15,-5
+ JRST SYMFNC+133
+L1230: MOVE 6,-2(15)
+ CAML 6,L1227
+ JRST L1231
+ MOVE 2,L1226
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+406
+L1231: MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+171
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L1232: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L1233
+ MOVE 3,-1(15)
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ AOS -4(15)
+ JRST L1232
+L1233: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,24576
+ ADJSP 15,-5
+ POPJ 15,0
+L1225: point 6,1,5
+L1227: -1
+L1226: <30_30>+408
+ 2
+; (!*ENTRY MAKE!-WORDS EXPR 2)
+L1238: intern L1238
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L1235
+ CAIN 11,63
+ JRST L1234
+ CAILE 11,0
+ JRST L1239
+L1234: MOVEM 1,-2(15)
+ JRST L1240
+L1239: MOVE 2,L1236
+ ADJSP 15,-5
+ JRST SYMFNC+133
+L1240: MOVE 6,-2(15)
+ CAML 6,L1237
+ JRST L1241
+ MOVE 2,L1236
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+406
+L1241: MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+170
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L1242: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L1243
+ MOVE 2,-4(15)
+ ADD 2,-3(15)
+ MOVE 6,-1(15)
+ MOVEM 6,1(2)
+ AOS -4(15)
+ JRST L1242
+L1243: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,28672
+ ADJSP 15,-5
+ POPJ 15,0
+L1235: point 6,1,5
+L1237: -1
+L1236: <30_30>+409
+ 2
+; (!*ENTRY MAKE!-VECTOR EXPR 2)
+L1248: intern L1248
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L1245
+ CAIN 11,63
+ JRST L1244
+ CAILE 11,0
+ JRST L1249
+L1244: MOVEM 1,-2(15)
+ JRST L1250
+L1249: MOVE 2,L1246
+ ADJSP 15,-5
+ JRST SYMFNC+133
+L1250: MOVE 6,-2(15)
+ CAML 6,L1247
+ JRST L1251
+ MOVE 2,L1246
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+406
+L1251: MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L1252: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L1253
+ MOVE 2,-4(15)
+ ADD 2,-3(15)
+ MOVE 6,-1(15)
+ MOVEM 6,1(2)
+ AOS -4(15)
+ JRST L1252
+L1253: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,32768
+ ADJSP 15,-5
+ POPJ 15,0
+L1245: point 6,1,5
+L1247: -1
+L1246: <30_30>+410
+ 1
+; (!*ENTRY STRING NEXPR 1)
+STRING: intern STRING
+ JRST SYMFNC+147
+ 1
+; (!*ENTRY VECTOR NEXPR 1)
+VECTOR: intern VECTOR
+ JRST SYMFNC+152
+ 5
+; (!*ENTRY LIST5 EXPR 5)
+LIST5: intern LIST5
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVE 4,5
+ MOVE 3,-3(15)
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+250
+ MOVE 2,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+278
+ 4
+; (!*ENTRY LIST4 EXPR 4)
+LIST4: intern LIST4
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 3,4
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+ 3
+; (!*ENTRY LIST3 EXPR 3)
+LIST3: intern LIST3
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 2,3
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+ 2
+; (!*ENTRY LIST2 EXPR 2)
+LIST2: intern LIST2
+ PUSH 15,1
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+278
+ extern L1254
+ extern L1255
+ extern L1256
+ extern L1257
+ extern L1258
+ extern L1259
+ 0
+; (!*ENTRY RECLAIM EXPR 0)
+L1260: intern L1260
+ JRST SYMFNC+381
+L1263: 13
+ byte(7)72,101,97,112,32,115,112,97,99,101,32,108,111,119,0
+L1264: 30
+ byte(7)42,42,42,32,71,97,114,98,97,103,101,32,99,111,108,108,101,99,116,105,111,110,32,115,116,97,114,116,105,110,103,0
+ 0
+; (!*ENTRY !%RECLAIM EXPR 0)
+L1265: intern L1265
+ ADJSP 15,2
+ CAMN 0,SYMVAL+416
+ JRST L1266
+ MOVE 1,L1261
+ PUSHJ 15,SYMFNC+418
+L1266: HRRZI 1,2
+ MOVNS 1
+ MOVE 2,1
+ MOVE 1,15
+ ADJSP 1,0(2)
+ HRRZ 1,1
+ IOR 1,[262144]
+ MOVEM 1,L1257
+ PUSHJ 15,SYMFNC+419
+ MOVEM 1,L1258
+ MOVE 2,L1080
+ SUB 2,L1081
+ MOVEM 2,L1259
+ AOS SYMVAL+414
+ MOVE 6,L1080
+ MOVEM 6,L1083
+ MOVE 6,L1084
+ MOVEM 6,L1080
+ MOVE 6,L1081
+ MOVEM 6,0(15)
+ MOVE 6,L1082
+ MOVEM 6,-1(15)
+ MOVE 6,L1084
+ MOVEM 6,L1081
+ MOVE 6,L1085
+ MOVEM 6,L1082
+ MOVE 6,0(15)
+ MOVEM 6,L1084
+ MOVE 6,-1(15)
+ MOVEM 6,L1085
+ MOVE 6,L1086
+ MOVEM 6,0(15)
+ MOVE 6,L1087
+ MOVEM 6,L1086
+ MOVE 6,0(15)
+ MOVEM 6,L1087
+ PUSHJ 15,L1267
+ PUSHJ 15,L1268
+ MOVE 2,L1083
+ ADDI 2,1023
+ MOVE 1,L1084
+ AOS 1
+ PUSHJ 15,SYMFNC+420
+ PUSHJ 15,SYMFNC+419
+ SUB 1,L1258
+ MOVEM 1,L1258
+ ADDM 1,SYMVAL+415
+ CAMN 0,SYMVAL+416
+ JRST L1269
+ PUSHJ 15,L1270
+L1269: MOVE 1,0
+ MOVEM 1,L1088
+ PUSHJ 15,SYMFNC+378
+ CAML 1,SYMVAL+417
+ JRST L1271
+ MOVE 3,0
+ MOVE 2,L1262
+ HRRZI 1,99
+ PUSHJ 15,SYMFNC+236
+L1271: MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L1262: <4_30>+<1_18>+L1263
+L1261: <4_30>+<1_18>+L1264
+; (!*ENTRY MARKANDCOPYFROMID EXPR 1)
+L1272: intern L1272
+ PUSH 15,1
+ ADDI 1,SYMNAM
+ PUSHJ 15,L1273
+ MOVE 7,0(15)
+ XMOVEI 6,SYMNAM(7)
+ TLO 6,155648
+ HRRZI 7,27
+ DPB 7,6
+ XMOVEI 1,SYMPRP
+ ADD 1,0(15)
+ PUSHJ 15,L1273
+ XMOVEI 1,SYMVAL
+ ADD 1,0(15)
+ ADJSP 15,-1
+ JRST L1273
+; (!*ENTRY COPYFROMALLBASES EXPR 0)
+L1267: intern L1267
+ ADJSP 15,3
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ HRRZI 1,128
+ PUSHJ 15,L1272
+ SETZM -2(15)
+L1276: MOVE 6,-2(15)
+ CAILE 6,127
+ JRST L1277
+ MOVE 7,-2(15)
+ LDB 1,L1274
+ CAIN 1,27
+ JRST L1278
+ MOVE 1,-2(15)
+ PUSHJ 15,L1272
+L1278: AOS -2(15)
+ JRST L1276
+L1277: SETZM -2(15)
+L1279: MOVE 6,-2(15)
+ CAILE 6,8209
+ JRST L1280
+ MOVE 2,-2(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-1(15)
+ JUMPLE 1,L1281
+ LDB 2,L1275
+ CAIN 2,27
+ JRST L1281
+ PUSHJ 15,L1272
+L1281: AOS -2(15)
+ JRST L1279
+L1280: MOVE 6,L1255
+ MOVEM 6,-1(15)
+L1282: HRRZI 7,2
+ ADDM 7,-1(15)
+ MOVE 1,SYMVAL+84
+ MOVE 6,-1(15)
+ CAMG 6,L1256
+ JRST L1283
+ MOVE 1,0
+L1283: CAMN 1,0
+ JRST L1284
+ MOVE 1,-1(15)
+ PUSHJ 15,L1273
+ JRST L1282
+L1284: MOVE 6,L1254
+ MOVEM 6,-2(15)
+L1285: MOVE 6,-2(15)
+ CAMLE 6,L1257
+ JRST L1286
+ MOVE 1,-2(15)
+ PUSHJ 15,L1273
+ AOS -2(15)
+ JRST L1285
+L1286: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L1274: point 6,SYMNAM(7),5
+L1275: point 6,SYMNAM(1),5
+; (!*ENTRY COPYFROMRANGE EXPR 2)
+L1287: intern L1287
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 1,-2(15)
+ SETZM -3(15)
+L1288: MOVE 6,-2(15)
+ CAMLE 6,-1(15)
+ JRST L1289
+ MOVE 1,-2(15)
+ PUSHJ 15,L1273
+ AOS -3(15)
+ MOVE 1,-3(15)
+ ADD 1,0(15)
+ ADDI 1,0
+ MOVEM 1,-2(15)
+ JRST L1288
+L1289: MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+; (!*ENTRY COPYFROMBASE EXPR 1)
+L1273: intern L1273
+ JRST L1290
+; (!*ENTRY COPYITEM EXPR 1)
+L1290: intern L1290
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 6,0(1)
+ MOVEM 6,-4(15)
+ LDB 2,L1291
+ MOVEM 2,-1(15)
+ JUMPLE 2,L1295
+ CAIGE 2,15
+ JRST L1296
+L1295: CAIE 2,30
+ JRST L1297
+ CAMN 0,-4(15)
+ JRST L1297
+ MOVE 3,-4(15)
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ LDB 4,L1292
+ CAIN 4,27
+ JRST L1297
+ MOVE 1,3
+ PUSHJ 15,L1272
+L1297: MOVE 1,-4(15)
+ MOVE 7,0(15)
+ MOVEM 1,0(7)
+ JRST L1298
+L1296: MOVE 3,-4(15)
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ CAMGE 3,L1084
+ JRST L1299
+ CAMG 3,L1083
+ JRST L1300
+L1299: MOVE 1,-4(15)
+ JRST L1298
+L1300: MOVE 6,0(3)
+ MOVEM 6,-3(15)
+ LDB 4,L1293
+ CAIE 4,27
+ JRST L1301
+ MOVE 5,-3(15)
+ TLZ 5,258048
+ DPB 2,L1294
+ MOVEM 5,0(1)
+ MOVE 1,5
+ JRST L1298
+L1301: ADJSP 15,-5
+ JRST L1302
+L1298: ADJSP 15,-5
+ POPJ 15,0
+L1291: point 6,-4(15),5
+L1292: point 6,SYMNAM(3),5
+L1293: point 6,-3(15),5
+L1294: point 6,5,5
+L1309: 54
+ byte(7)85,110,101,120,112,101,99,116,101,100,32,116,97,103,32,37,119,32,102,111,117,110,100,32,97,116,32,37,119,32,100,117,114,105,110,103,32,103,97,114,98,97,103,101,32,99,111,108,108,101,99,116,105,111,110,0
+; (!*ENTRY COPYITEM1 EXPR 1)
+L1302: intern L1302
+ ADJSP 15,7
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 6,0(1)
+ MOVEM 6,-5(15)
+ LDB 1,L1303
+ CAIL 1,1
+ CAILE 1,10
+ JRST L1310
+ JRST @L1311-1(1)
+L1311: IFIW L1312
+ IFIW L1312
+ IFIW L1312
+ IFIW L1313
+ IFIW L1314
+ IFIW L1314
+ IFIW L1312
+ IFIW L1315
+ IFIW L1316
+ IFIW L1317
+L1310: JRST L1314
+L1316: MOVE 2,-5(15)
+ MOVE 2,0(2)
+ MOVEM 2,-3(15)
+ HRRZI 1,2
+ PUSHJ 15,SYMFNC+379
+ MOVE 3,1
+ MOVEM 3,-1(15)
+ TLZ 3,258048
+ TLO 3,110592
+ MOVE 7,-5(15)
+ MOVEM 3,0(7)
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ TLO 2,36864
+ MOVE 7,0(15)
+ MOVEM 2,0(7)
+ MOVE 7,-1(15)
+ MOVE 6,-3(15)
+ MOVEM 6,0(7)
+ MOVE 4,-5(15)
+ MOVE 4,1(4)
+ MOVE 7,-1(15)
+ MOVEM 4,1(7)
+ SETZM 1
+ ADD 1,-1(15)
+ PUSHJ 15,L1290
+ HRRZI 1,1
+ ADD 1,-1(15)
+ ADJSP 15,-7
+ JRST L1290
+L1313: MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+395
+ MOVE 3,-5(15)
+ TLZ 3,258048
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ TLZ 2,258048
+ TLO 2,110592
+ MOVEM 2,0(3)
+ MOVE 1,-1(15)
+ MOVE 7,0(15)
+ MOVEM 1,0(7)
+ JRST L1318
+L1315: MOVE 2,-5(15)
+ TLZ 2,258048
+ MOVEM 2,-4(15)
+ MOVE 6,0(2)
+ LDB 3,L1304
+ TDNE 3,L1305
+ TDO 3,L1306
+ MOVEM 3,-2(15)
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+142
+ MOVE 2,1
+ MOVEM 2,-3(15)
+ TLZ 2,258048
+ TLO 2,110592
+ MOVE 7,-4(15)
+ MOVEM 2,0(7)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L1319: MOVE 6,-6(15)
+ CAMG 6,-2(15)
+ JRST L1320
+ SETZM 1
+ JRST L1321
+L1320: MOVE 2,-6(15)
+ ADD 2,-3(15)
+ MOVE 3,-6(15)
+ ADD 3,-4(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ HRRZI 1,1
+ ADDM 2,1
+ PUSHJ 15,L1290
+ AOS -6(15)
+ JRST L1319
+L1321: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,32768
+ MOVE 7,0(15)
+ MOVEM 1,0(7)
+ JRST L1318
+L1317: MOVE 2,-5(15)
+ TLZ 2,258048
+ MOVEM 2,-4(15)
+ MOVE 6,0(2)
+ LDB 3,L1304
+ TDNE 3,L1305
+ TDO 3,L1306
+ MOVEM 3,-2(15)
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+142
+ MOVE 2,1
+ MOVEM 2,-3(15)
+ TLZ 2,258048
+ TLO 2,110592
+ MOVE 7,-4(15)
+ MOVEM 2,0(7)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L1322: MOVE 6,-6(15)
+ CAMG 6,-2(15)
+ JRST L1323
+ SETZM 1
+ JRST L1324
+L1323: MOVE 2,-6(15)
+ ADD 2,-3(15)
+ MOVE 3,-6(15)
+ ADD 3,-4(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ HRRZI 1,1
+ ADDM 2,1
+ PUSHJ 15,L1290
+ AOS -6(15)
+ JRST L1322
+L1324: MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,40960
+ MOVE 7,0(15)
+ MOVEM 1,0(7)
+ JRST L1318
+L1312: MOVEM 1,-3(15)
+ MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+400
+ MOVE 3,-5(15)
+ TLZ 3,258048
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ TLZ 2,258048
+ TLO 2,110592
+ MOVEM 2,0(3)
+ MOVE 1,-1(15)
+ MOVE 6,-3(15)
+ DPB 6,L1307
+ MOVE 7,0(15)
+ MOVEM 1,0(7)
+ JRST L1318
+L1314: MOVE 3,-5(15)
+ TLZ 3,258048
+ MOVE 2,1
+ MOVE 1,L1308
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-7
+ JRST SYMFNC+380
+L1318: ADJSP 15,-7
+ POPJ 15,0
+L1303: point 6,-5(15),5
+L1304: point 30,6,35
+L1305: 536870912
+L1306: -536870912
+L1307: point 6,1,5
+L1308: <4_30>+<1_18>+L1309
+; (!*ENTRY MAKEIDFREELIST EXPR 0)
+L1268: intern L1268
+ MOVE 3,0
+ SETZM 2
+L1327: CAILE 2,128
+ JRST L1328
+ XMOVEI 6,SYMNAM(2)
+ TLO 6,155648
+ HRRZI 7,4
+ DPB 7,6
+ AOS 2
+ JRST L1327
+L1328: HRRZI 3,129
+L1329: LDB 1,L1325
+ CAIE 1,27
+ JRST L1330
+ CAILE 3,8000
+ JRST L1330
+ XMOVEI 6,SYMNAM(3)
+ TLO 6,155648
+ HRRZI 7,4
+ DPB 7,6
+ AOS 3
+ JRST L1329
+L1330: CAIGE 3,8000
+ JRST L1331
+ SETZM L0001
+ JRST L1332
+L1331: MOVEM 3,L0001
+L1332: MOVE 1,3
+ AOS 1
+ MOVE 2,1
+L1333: CAILE 2,8000
+ JRST L1334
+ LDB 1,L1326
+ CAIE 1,27
+ JRST L1335
+ XMOVEI 6,SYMNAM(2)
+ TLO 6,155648
+ HRRZI 7,4
+ DPB 7,6
+ JRST L1336
+L1335: MOVEM 2,SYMNAM(3)
+ MOVE 3,2
+L1336: AOS 2
+ JRST L1333
+L1334: SETZM SYMNAM(3)
+ MOVE 1,0
+ POPJ 15,0
+L1325: point 6,SYMNAM(3),5
+L1326: point 6,SYMNAM(2),5
+L1338: 43
+ byte(7)42,42,42,32,71,67,32,37,119,58,32,116,105,109,101,32,37,100,32,109,115,44,32,37,100,32,114,101,99,111,118,101,114,101,100,44,32,37,100,32,102,114,101,101,0
+; (!*ENTRY GCSTATS EXPR 0)
+L1270: intern L1270
+ ADJSP 15,1
+ HRRZI 2,1
+ MOVE 1,L1259
+ ADD 1,L1081
+ SUB 1,L1080
+ IDIV 1,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+378
+ MOVE 5,1
+ MOVE 4,0(15)
+ MOVE 3,L1258
+ MOVE 2,SYMVAL+414
+ MOVE 1,L1337
+ ADJSP 15,-1
+ JRST SYMFNC+418
+L1337: <4_30>+<1_18>+L1338
+ end
ADDED psl-1983/3-1/kernel/20/alloc.rel
Index: psl-1983/3-1/kernel/20/alloc.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/alloc.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/allocators.red
Index: psl-1983/3-1/kernel/20/allocators.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/allocators.red
@@ -0,0 +1,194 @@
+%
+% ALLOCATORS.RED - Low level storage management
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <SWANSON.TEST>ALLOCATORS.UPD.2, 3-Apr-83 09:57:03, Edit by SWANSON
+% Added changes required to fit Ext-20 model
+% <PSL.KERNEL>ALLOCATORS.RED.7, 23-Mar-83 11:35:37, Edit by KESSLER
+% Added OldHeapTrapBound to exported WVars, so we can update the heap trap
+
+% bound upon switch.
+% Edit by Cris Perdue, 16 Feb 1983 1834-PST
+% Pre-GC trap, known-free-space fns
+% <PSL.KERNEL>ALLOCATORS.RED.4, 10-Jan-83 15:50:50, Edit by PERDUE
+% Added GtEVect
+
+on SysLisp;
+
+external WArray BPS, Heap, Heap2;
+
+CommentOutCode << % For the compacting GC
+exported WVar HeapLast = &Heap[0], % pointer to next free slot in heap
+
+ HeapLowerBound = &Heap[0], % bottom of heap
+ HeapUpperBound = &Heap[HeapSize],
+ HeapTrapBound = &Heap[HeapSize]; % Value of HeapLast for trap
+
+>>;
+exported WVar HeapLast = &Heap[0], % pointer to next free slot in heap
+
+ HeapLowerBound = &Heap[0], % bottom of heap
+ HeapUpperBound = &Heap[HeapSize], % end of active heap
+ OldHeapLast,
+ OldHeapLowerBound = &Heap2[0],
+ OldHeapUpperBound = &Heap2[HeapSize],
+ HeapTrapBound = &Heap[HeapSize], % Value of HeapLast for trap
+
+ OldHeapTrapBound = &Heap2[HeapSize];
+>>);
+exported WVar HeapTrapped = NIL; % Boolean: trap since last GC?
+
+
+compiletime flag('(GtHeap1), 'InternalFunction);
+
+syslsp procedure Known!-Free!-Space;
+MkInt((HeapUpperBound - HeapLast)/AddressingUnitsPerItem);
+
+syslsp procedure GtHEAP N; %. get heap block of N words
+if null N then known!-free!-space() else
+ GtHeap1(N, NIL);
+
+syslsp procedure GtHeap1(N, LastTryP);
+begin scalar PrevLast;
+ PrevLast := HeapLast;
+ HeapLast := HeapLast + N*AddressingUnitsPerItem;
+ if HeapLast > HeapTrapBound then
+ if HeapLast > HeapUpperBound then
+ << HeapLast := PrevLast;
+ if LastTryP then FatalError "Heap space exhausted"
+ else
+ << !%Reclaim();
+ return GtHeap1(N, T) >> >>
+ else
+ %% From one GC to the next there can be at most 1 GC trap,
+ %% done the first time space gets "low". %Reclaim resets
+ %% HeapTrapped to NIL.
+ if HeapTrapped = NIL then
+ << HeapTrapped := T;
+ GC!-Trap!-Level() >>;
+ return PrevLast
+end;
+
+syslsp procedure GC!-Trap!-Level;
+MkInt (HeapUpperBound - HeapTrapBound)/AddressingUnitsPerItem;
+
+syslsp procedure Set!-GC!-Trap!-Level N;
+<< if not IntP(N) then NonIntegerError(N, 'Set!-GC!-Trap!-Level);
+ N := IntInf N;
+ HeapTrapBound := HeapUpperBound - N*AddressingUnitsPerItem;
+ T >>;
+
+syslsp procedure DelHeap(LowPointer, HighPointer);
+ if HighPointer eq HeapLast then HeapLast := LowPointer;
+
+syslsp procedure GtSTR N; %. Allocate space for a string N chars
+begin scalar S, NW;
+ S := GtHEAP((NW := STRPack N) + 1);
+ @S := MkItem(HBytes, N);
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtConstSTR N; %. allocate un-collected string for print name
+begin scalar S, NW; % same as GtSTR, but uses BPS, not heap
+ S := GtBPS((NW := STRPack N) + 1);
+ @S := N;
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtHalfWords N; %. Allocate space for N halfwords
+begin scalar S, NW;
+ S := GtHEAP((NW := HalfWordPack N) + 1);
+ @S := MkItem(HHalfWords, N);
+ return S;
+end;
+
+syslsp procedure GtVECT N; %. Allocate space for a vector N items
+begin scalar V;
+ V := GtHEAP(VECTPack N + 1);
+ @V := MkItem(HVECT, N);
+ return V;
+end;
+
+Putd('GtEvect,'expr,cdr getd 'GtVect);
+
+syslsp procedure GtWRDS N; %. Allocate space for N untraced words
+begin scalar W;
+ W := GtHEAP(WRDPack N + 1);
+ @W := MkItem(HWRDS, N);
+ return W;
+end;
+
+
+syslsp procedure GtFIXN(); %. allocate space for a fixnum
+begin scalar W;
+ W := GtHEAP(WRDPack 0 + 1);
+ @W := MkItem(HWRDS, 0);
+ return W;
+end;
+
+syslsp procedure GtFLTN(); %. allocate space for a float
+begin scalar W;
+ W := GtHEAP(WRDPack 1 + 1);
+ @W := MkItem(HWRDS, 1);
+ return W;
+end;
+
+% NextSymbol and SymbolTableSize are globally declared
+
+syslsp procedure GtID(); %. Allocate a new ID
+%
+% IDs are allocated as a linked free list through the SymNam cell,
+% with a 0 to indicate the end of the list.
+%
+begin scalar U;
+ if NextSymbol = 0 then
+ << Reclaim();
+ if NextSymbol = 0 then
+ return FatalError "Ran out of ID space" >>;
+ U := NextSymbol;
+ NextSymbol := SymNam U;
+ return U;
+end;
+
+external WVar NextBPS,
+ LastBPS;
+
+syslsp procedure GtBPS N; %. Allocate N words for binary code
+begin scalar B;
+ if null N then return((LastBPS - NextBPS)/AddressingUnitsPerItem);
+ % GTBPS NIL returns # left
+ B := NextBPS;
+ NextBPS := NextBPS + N*AddressingUnitsPerItem;
+ return if NextBPS > LastBPS then
+ StdError '"Ran out of binary program space"
+ else B;
+end;
+
+syslsp procedure DelBPS(Bottom, Top); %. Return space to BPS
+ if NextBPS eq Top then NextBPS := Bottom;
+
+syslsp procedure GtWArray N; %. Allocate N words for WVar/WArray/WString
+begin scalar B;
+ if null N then return((LastBPS - NextBPS)/AddressingUnitsPerItem);
+ % GtWArray NIL returns # left
+ B := LastBPS - N*AddressingUnitsPerItem;
+ return if NextBPS > B then
+ StdError '"Ran out of WArray space"
+ else
+ LastBPS := B;
+end;
+
+syslsp procedure DelWArray(Bottom, Top); %. Return space for WArray
+ if LastBPS eq Bottom then LastBPS := Top;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/apply-lap.red
Index: psl-1983/3-1/kernel/20/apply-lap.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/apply-lap.red
@@ -0,0 +1,355 @@
+%
+% APPLY-LAP.RED - LAP support for EVAL and APPLY
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 25-May-1983 Mark R. Swanson
+% Changes to support extended addressing; mostly clearing instruction field
+% of entries from SYMFNC table
+% <PSL.NEW>APPLY-LAP.RED.2, 9-Dec-82 18:13:02, Edit by PERDUE
+% Modified UndefinedFunction to make it continuable
+
+CompileTime flag('(FastLambdaApply), 'InternalFunction);
+
+on SysLisp;
+
+external WVar BndStkPtr, BndStkUpperBound;
+
+% TAG( CodeApply )
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure CodeApply(CodePtr, ArgList);
+% begin scalar N;
+% N := 0;
+% while PairP ArgList do
+% << N := N + 1;
+% ArgumentRegister[N] := car ArgList;
+% ArgList := cdr ArgList >>;
+% (jump to address of code pointer)
+% end;
+
+lap '((!*entry CodeApply expr 2) %. CodeApply(CodePointer, ArgList)
+%
+% r1 is code pointer, r2 is list of arguments
+%
+ (!*field (reg t1) (reg 1) 12 24) % make it a local address
+ (!*MOVE (reg 2) (reg t2))
+ (!*MOVE (WConst 1) (reg t3))
+Loop
+ (!*JUMPNOTTYPE
+ (MEMORY (REG T1) (WConst 0))
+ (reg t2) PAIR)
+ % jump to code if list is exhauseted
+ (!*MOVE (CAR (reg t2)) (reg t4))
+ (!*MOVE (reg t4) (MEMORY (reg t3) 0)) % load argument register
+ (!*MOVE (CDR (reg t2)) (reg t2))
+ (!*WPLUS2 (reg t3) (WConst 1)) % increment register pointer
+ (cain (reg t3) (plus2 (WConst MaxRealRegs) 1)) % skip if neq MaxRegs+1
+ (!*MOVE (WConst ArgumentBlock) (reg t3)) % else switch to extra args
+ (!*JUMPWLEQ (Label Loop)
+ (reg t3)
+ (WConst (plus2 9 (WConst ArgumentBlock))))
+ (!*MOVE (QUOTE "Too many arguments to function") (reg 1))
+ (!*JCALL StdError)
+);
+
+% TAG( CodeEvalApply )
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure CodeEvalApply(CodePtr, ArgList);
+% begin scalar N;
+% N := 0;
+% while PairP ArgList do
+% << N := N + 1;
+% ArgumentRegister[N] := Eval car ArgList;
+% ArgList := cdr ArgList >>;
+% (jump to address of code pointer)
+% end;
+
+lap '((!*entry CodeEvalApply expr 2) %. CodeApply(CodePointer, EvLis Args)
+%
+% r1 is code pointer, r2 is list of arguments to be evaled
+%
+ (!*PUSH (reg 1)) % code pointer goes on the bottom
+ (!*PUSH (WConst 0)) % then arg count
+Loop % if it's not a pair, then we're done
+ (!*JUMPNOTTYPE (Label Done) (reg 2) PAIR)
+ (!*JUMPWLESSP (Label ArgOverflow) (frame 1) (WConst -15))
+ (!*MOVE (CAR (reg 2)) (reg 1))
+ (!*MOVE (CDR (reg 2)) (reg 2))
+ (!*PUSH (reg 2)) % save the cdr
+ (!*CALL Eval) % eval the car
+ (!*POP (reg 2)) % grab the list in r2 again
+ (!*POP (reg 3)) % get count in r3
+ (!*WDIFFERENCE (reg 3) (WConst 1)) % decrement count
+ (!*PUSH (reg 1)) % push the evaled arg
+ (!*PUSH (reg 3)) % and the decremented count
+ (!*JUMP (Label Loop))
+Done
+ (!*POP (reg 3)) % count in r3, == -no. of args to pop
+ (!*JUMP (MEMORY (reg 3) (Label ZeroArgs))) % indexed jump
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 9)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 8)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 7)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 6)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 5)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 4)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 3)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 2)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 1)) (WConst 0)))
+ (!*POP (MEMORY (WConst (plus2 (WArray ArgumentBlock) 0)) (WConst 0)))
+ (!*POP (reg 5))
+ (!*POP (reg 4))
+ (!*POP (reg 3))
+ (!*POP (reg 2))
+ (!*POP (reg 1))
+ZeroArgs
+ (!*POP (reg t1)) % code pointer in (reg t1)
+ (!*field (reg t1) (reg t1) 12 24) % isolate just local addr bits
+ (!*JUMP (MEMORY (reg t1) (WConst 0))) % jump to address
+ArgOverflow
+ (!*MOVE (QUOTE "Too many arguments to function") (reg 1))
+ (!*JCALL StdError)
+);
+
+% TAG( BindEval )
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure BindEval(Formals, Args);
+% begin scalar N;
+% N := 0;
+% while PairP Args and PairP Formals do
+% << N := N + 1;
+% Push Eval car ArgList;
+% Push car Formals;
+% ArgList := cdr ArgList >>;
+% if PairP Args or PairP Formals then return -1;
+% for I := 1 step 1 until N do
+% LBind1(Pop(), Pop());
+% return N;
+% end;
+
+lap '((!*entry BindEval expr 2) %. BindEval(FormalsList, ArgsToBeEvaledList);
+%
+% r1 is list of formals, r2 is list of arguments to be evaled
+%
+ (!*PUSH (WConst 0)) % count on the bottom
+ (!*MOVE (WConst 0) (reg 4))
+ (!*MOVE (reg 1) (reg 3)) % shift arg1 to r3
+EvalLoop % if it's not a pair, then we're done
+ (!*JUMPNOTTYPE (Label DoneEval) (reg 2) PAIR)
+ (!*MOVE (CAR (reg 2)) (reg 1))
+ (!*MOVE (CDR (reg 2)) (reg 2))
+ (!*PUSH (reg 3)) % save the formals
+ (!*PUSH (reg 2)) % save the rest of args
+ (!*CALL Eval) % eval the car
+ (!*POP (reg 2)) % save then rest of arglist
+ (!*POP (reg 3)) % and the rest of formals
+ (!*POP (reg 4)) % and the count
+ (!*JUMPNOTTYPE (Label ReturnError) (reg 3) PAIR)
+ % if it's not a pair, then error
+ (!*WPLUS2 (reg 4) (WConst 1)) % increment the count
+ (!*MOVE (CAR (reg 3)) (reg 5))
+ (!*MOVE (CDR (reg 3)) (reg 3))
+ (!*PUSH (reg 1)) % push the evaluated argument
+ (!*PUSH (reg 5)) % and next formal
+ (!*PUSH (reg 4)) % and new count
+ (!*JUMP (Label EvalLoop))
+ReturnError
+ (!*WSHIFT (reg 4) (WConst 1)) % multiply count by 2
+ (hrl (reg 4) (reg 4)) % in both halves
+ (sub (reg st) (reg 4)) % move the stack ptr back
+ (!*MOVE (WConst -1) (reg 1)) % return -1 as error indicator
+ (!*EXIT 0)
+DoneEval
+ (!*DEALLOC 1) % removed saved values at top of stack
+ (!*JUMPTYPE (Label ReturnError) (reg 3) PAIR) % if more formals, error
+ (!*MOVE (reg 4) (reg 3)) % r3 gets decremented, r4 saved for return
+BindLoop
+ (!*JUMPEQ (Label NormalReturn) (reg 3) (WConst 0))
+ % if count is zero, then return
+ (!*POP (reg 1)) % pop ID to bind
+ (!*POP (reg 2)) % and value
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 4))
+ (!*CALL LBind1)
+ (!*POP (reg 4))
+ (!*POP (reg 3))
+ (soja (reg 3) BindLoop)
+NormalReturn
+ (!*MOVE (reg 4) (reg 1)) % return count
+ (!*EXIT 0)
+);
+
+% TAG( CompiledCallingInterpreted )
+
+% This is pretty gross, but it is essentially the same as LambdaApply, taking
+% values from the argument registers instead of a list.
+
+% if this could be written in Syslisp, it would look something like this:
+
+% syslsp procedure CompiledCallingInterpreted IDOfFunction;
+% begin scalar LForm, LArgs, N, Result;
+% LForm := get(IDOfFunction, '!*LambdaLink);
+% LArgs := cadr LForm;
+% LForm := cddr LForm;
+% N := 1;
+% while PairP LArgs do
+% << LBind1(car LArgs, ArgumentRegister[N];
+% LArgs := cdr LArgs;
+% N := N + 1 >>;
+% Result := EvProgN LForm;
+% UnBindN(N - 1);
+% return Result;
+% end;
+
+lap '((!*entry CompiledCallingInterpreted expr 0) %. link for lambda
+%
+% called by JSP T5, from function cell
+%
+ (!*MOVE (reg t5) (reg t1))
+ (!*WDIFFERENCE (reg t1) (WConst (plus2 (WConst SymFnc) 1)))
+ (!*MKITEM (reg t1) (WConst BtrTag))
+ (!*PUSH (reg t1)) % make stack mark for btrace
+ (hrrz (reg t1)(reg t1)) % discard extraneous left half
+ (!*MOVE (MEMORY (reg t1) (WConst SymPrp)) (reg t1)) % load prop list
+LoopFindProp
+ (!*JUMPNOTTYPE (Label PropNotFound) (reg t1) PAIR)
+ (!*MOVE (CAR (reg t1)) (reg t2)) % get car of prop list
+ (!*MOVE (CDR (reg t1)) (reg t1)) % cdr down
+ (!*JUMPNOTTYPE (Label LoopFindProp) (reg t2) PAIR)
+ (!*MOVE (CAR (reg t2)) (reg t3)) % its a pair, look at car
+ (!*JUMPNOTEQ (Label LoopFindProp) (reg t3) '!*LambdaLink)
+ (!*MOVE (CDR (reg t2)) (reg t2)) % yes, get lambda form
+ (!*entry FastLambdaApply expr 0) % called from FastApply
+ (!*MOVE (CDR (reg t2)) (reg t2)) % get cdr of lambda form
+ (!*MOVE (CDR (reg t2)) (reg t1)) % save cddr in (reg t1)
+ (!*MOVE (CAR (reg t2)) (reg t2)) % cadr of lambda == arg list
+ (!*MOVE (WConst 1) (reg t3)) % pointer to arg register in t3
+ (!*MOVE (WVar BndStkPtr) (reg t4)) % binding stack pointer in t4
+ (!*PUSH (reg t4)) % save it on the stack
+LoopBindingFormals
+ (!*JUMPNOTTYPE (Label DoneBindingFormals) (reg t2) PAIR)
+ (!*WPLUS2 (reg t4) (WConst 2)) % adjust binding stack pointer up 2
+ (caml (reg t4) (WVar BndStkUpperBound)) % if overflow occured
+ (!*JCALL BStackOverflow) % then error
+ (!*MOVE (CAR (reg t2)) (reg t5)) % get formal in t5
+ (hrrzm (reg t5) (Indexed (reg t4) -1)) % store ID number in BndStk
+ (!*MOVE (MEMORY (reg t5) (WArray SymVal)) (reg t6)) % get old value
+ (!*MOVE (reg t6) (MEMORY (reg t4) (WConst 0))) % store value in BndStk
+ (!*MOVE (MEMORY (reg t3) (WConst 0)) (reg t6)) % get reg value in t6
+ (!*MOVE (reg t6) (MEMORY (reg t5) (WConst SymVal))) % put in value cell
+ (!*MOVE (CDR (reg t2)) (reg t2)) % cdr down argument list
+ (!*WPLUS2 (reg t3) (WConst 1)) % increment register pointer
+ (cain (reg t3) (plus2 (WConst MaxRealRegs) 1)) % Go to extra args?
+ (movei (reg t3) (WArray ArgumentBlock)) % Yes
+ (!*JUMP (Label LoopBindingFormals)) % No
+DoneBindingFormals
+ (!*MOVE (reg t4) (WVar BndStkPtr)) % store binding stack
+ (!*MOVE (reg t1) (reg 1)) % get cddr of lambda form to eval
+ (!*CALL EvProgN) % implicit progn
+ (exch (reg 1) (Indexed (reg st) 0)) % save result, get old bind stk ptr
+ (!*CALL RestoreEnvironment)
+ (!*POP (reg 1)) % restore old bindings and pickup value
+ (!*EXIT 1) % throw away backtrace mark and return
+PropNotFound
+ (!*MOVE (QUOTE
+"Internal error in function calling mechanism; consult a wizard") (reg 1))
+ (!*JCALL StdError)
+);
+
+
+% TAG( FastApply )
+
+lap '((!*entry FastApply expr 0) %. Apply with arguments loaded
+%
+% Called with arguments in the registers and functional form in (reg t1)
+%
+ (!*FIELD (reg t2) (reg t1)
+ (WConst TagStartingBit)
+ (WConst TagBitLength))
+ (!*FIELD (reg t1) (reg t1) 12 24) % make it a local address
+ (!*JUMPEQ (MEMORY (reg t1) (WConst SymFnc)) (reg t2) (WConst ID))
+ (!*JUMPEQ (MEMORY (reg t1) (WConst 0)) (reg t2) (WConst CODE))
+ (!*JUMPNOTEQ (Label IllegalFunctionalForm) (reg t2) (WConst PAIR))
+ (!*MOVE (CAR (reg t1)) (reg t2))
+ (!*JUMPNOTEQ IllegalFunctionalForm (reg t2) (QUOTE LAMBDA))
+ (!*MOVE (reg t1) (reg t2)) % put lambda form in (reg t2)
+ (!*PUSH '()) % align stack
+ (!*JCALL FastLambdaApply)
+IllegalFunctionalForm
+ (!*MOVE (QUOTE "Illegal functional form %r in Apply") (reg 1))
+ (!*MOVE (reg t1) (reg 2))
+ (!*CALL BldMsg)
+ (!*JCALL StdError)
+);
+
+% TAG( UndefinedFunction )
+
+lap '((!*entry UndefinedFunction expr 0) %. Error Handler for non code
+%
+% also called by JSP T5,
+%
+ (!*WDIFFERENCE (reg t5) (wconst 1))
+ % T5 now points to the function entry slot of the atom that
+ % is undefined as a function.
+ % We will push the entry address onto the stack and transfer
+ % to it by a POPJ at the end of this routine.
+ (!*PUSH (reg t5))
+ (!*PUSH (reg 1)) % Save all the regs (including fakes) (args)
+ (!*PUSH (reg 2))
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 4))
+ (!*PUSH (reg 5))
+ (!*PUSH (reg 6))
+ (!*PUSH (reg 7))
+ (!*PUSH (reg 8))
+ (!*PUSH (reg 9))
+ (!*PUSH (reg 10))
+ (!*PUSH (reg 11))
+ (!*PUSH (reg 12))
+ (!*PUSH (reg 13))
+ (!*PUSH (reg 14))
+ (!*PUSH (reg 15))
+
+ (!*WDIFFERENCE (reg t5) (WConst SymFnc))
+ (!*MKITEM (reg t5) (WConst ID))
+ (!*MOVE (reg t5) (reg 2))
+ (!*MOVE (QUOTE "Undefined function %r called from compiled code")
+ (reg 1))
+ (!*CALL BldMsg)
+ (!*MOVE (reg 1) (reg 2))
+ (!*MOVE (WConst 0) (reg 1))
+ (!*MOVE (reg NIL) (reg 3))
+ (!*CALL ContinuableError)
+
+ (!*POP (reg 15)) % Restore all those possible arguments
+ (!*POP (reg 14))
+ (!*POP (reg 13))
+ (!*POP (reg 12))
+ (!*POP (reg 11))
+ (!*POP (reg 10))
+ (!*POP (reg 9))
+ (!*POP (reg 8))
+ (!*POP (reg 7))
+ (!*POP (reg 6))
+ (!*POP (reg 5))
+ (!*POP (reg 4))
+ (!*POP (reg 3))
+ (!*POP (reg 2))
+ (!*POP (reg 1))
+ (!*EXIT 0)
+);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/arith.ctl
Index: psl-1983/3-1/kernel/20/arith.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/arith.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "arith";
+PathIn "arith.build";
+ASMEnd;
+quit;
+compile arith.mac, darith.mac
ADDED psl-1983/3-1/kernel/20/arith.init
Index: psl-1983/3-1/kernel/20/arith.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/arith.init
ADDED psl-1983/3-1/kernel/20/arith.log
Index: psl-1983/3-1/kernel/20/arith.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/arith.log
@@ -0,0 +1,61 @@
+
+ 8-Jun-83 9:34:15
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job ARITH Req #477 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:10:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 1734
+
+ Input from => PS:<PSL.KERNEL.20.EXT>ARITH.CTL.3
+ Output to => PS:<PSL.KERNEL.20.EXT>ARITH.LOG
+
+
+
+ 9:34:16 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+ 9:34:16 MONTR @SET TIME-LIMIT 600
+ 9:34:16 MONTR @LOGIN KESSLER SMALL
+ 9:34:19 MONTR Job 12 on TTY224 8-Jun-83 09:34:19
+ 9:34:19 MONTR Previous login at 8-Jun-83 09:32:11
+ 9:34:20 MONTR There is 1 other job logged in as user KESSLER
+ 9:34:29 MONTR @
+ 9:34:29 MONTR [PS Mounted]
+ 9:34:29 MONTR
+ 9:34:29 MONTR [CONNECTED TO PS:<PSL.KERNEL.20.EXT>]
+ ;Modifications to this file may disappear, as this file is generated
+ ;automatically using information in P20:20-KERNEL-GEN.SL.
+ 9:34:29 MONTR def dsk: dsk:,p20e:,pk:,p20:
+ 9:34:30 MONTR @S:EX-DEC20-CROSS.EXE
+ 9:34:32 USER [20] ASMOut "arith";
+ 9:34:34 USER ASMOUT: IN files; or type in expressions
+ 9:34:34 USER When all done execute ASMEND;
+ 9:34:36 USER [21] PathIn "arith.build";
+ 9:34:37 USER %
+ 9:34:37 USER % ARITH.BUILD - Files dealing with arithmetic
+ 9:34:37 USER %
+ 9:34:37 USER % Author: Eric Benson
+ 9:34:37 USER % Symbolic Computation Group
+ 9:34:37 USER % Computer Science Dept.
+ 9:34:37 USER % University of Utah
+ 9:34:38 USER % Date: 19 May 1982
+ 9:34:38 USER % Copyright (c) 1982 University of Utah
+ 9:34:38 USER %
+ 9:34:38 USER
+ 9:34:38 USER PathIn "arithmetic.red"$ % Lisp arithmetic functions
+ 9:35:10 USER [22] ASMEnd;
+ 9:35:10 USER *** Garbage collection starting
+ 9:35:12 USER *** GC 9: time 1574 ms, 106103 recovered, 243208 free
+ 9:35:20 USER 0
+ 9:35:20 USER [23] quit;
+ 9:35:20 MONTR @compile arith.mac, darith.mac
+ 9:35:23 USER MACRO: .MAIN
+ 9:35:28 USER MACRO: .MAIN
+ 9:35:29 USER
+ 9:35:29 USER EXIT
+ 9:35:29 MONTR @
+ 9:35:30 MONTR Killed by OPERATOR, TTY 221
+ 9:35:30 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 224,
+ 9:35:30 MONTR at 8-Jun-83 09:35:30, Used 0:00:34 in 0:01:10
ADDED psl-1983/3-1/kernel/20/arith.mac
Index: psl-1983/3-1/kernel/20/arith.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/arith.mac
@@ -0,0 +1,1062 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+; (!*ENTRY TWOARGDISPATCH EXPR 2)
+L1341: intern L1341
+ LDB 4,L1339
+ LDB 3,L1340
+ JRST L1342
+L1339: point 6,2,5
+L1340: point 6,1,5
+; (!*ENTRY TWOARGDISPATCH1 EXPR 4)
+L1342: intern L1342
+ CAIE 3,63
+ JRST L1343
+ SETZM 3
+L1343: CAIE 4,63
+ JRST L1344
+ SETZM 4
+L1344: CAILE 3,3
+ JRST L1345
+ CAILE 4,3
+ JRST L1345
+ LSH 3,2
+ ADDM 3,4
+ POP 15,3
+ CAIL 4,0
+ CAILE 4,15
+ JRST L1346
+ JRST @L1347-0(4)
+L1347: IFIW L1348
+ IFIW L1349
+ IFIW L1350
+ IFIW L1351
+ IFIW L1352
+ IFIW L1353
+ IFIW L1350
+ IFIW L1354
+ IFIW L1350
+ IFIW L1350
+ IFIW L1350
+ IFIW L1350
+ IFIW L1355
+ IFIW L1356
+ IFIW L1350
+ IFIW L1357
+L1346:L1350: JRST L1358
+L1352: TLZ 1,258048
+ MOVE 1,1(1)
+ MOVE 6,0(3)
+ JRST 0(6)
+L1353: TLZ 1,258048
+ MOVE 1,1(1)
+L1349: TLZ 2,258048
+ MOVE 2,1(2)
+L1348: MOVE 6,0(3)
+ JRST 0(6)
+L1354: TLZ 1,258048
+ MOVE 1,1(1)
+L1351: PUSH 15,3
+ PUSH 15,2
+ PUSHJ 15,L1359
+ POP 15,2
+ POP 15,3
+ MOVE 6,1(3)
+ JRST 0(6)
+L1356: TLZ 2,258048
+ MOVE 2,1(2)
+L1355: PUSH 15,3
+ PUSH 15,1
+ MOVE 1,2
+ PUSHJ 15,L1359
+ MOVE 2,1
+ POP 15,1
+ POP 15,3
+ MOVE 6,1(3)
+ JRST 0(6)
+L1357: MOVE 6,1(3)
+ JRST 0(6)
+L1345: POP 15,3
+ JRST L1358
+L1361: 33
+ byte(7)78,111,110,45,110,117,109,101,114,105,99,32,97,114,103,117,109,101,110,116,32,105,110,32,97,114,105,116,104,109,101,116,105,99,0
+; (!*ENTRY TWOARGERROR EXPR 3)
+L1358: intern L1358
+ PUSH 15,3
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,2(1)
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1360
+ HRRZI 1,99
+ ADJSP 15,-1
+ JRST SYMFNC+236
+L1360: <4_30>+<1_18>+L1361
+L1363: 33
+ byte(7)78,111,110,45,105,110,116,101,103,101,114,32,97,114,103,117,109,101,110,116,32,105,110,32,97,114,105,116,104,109,101,116,105,99,0
+; (!*ENTRY NONINTEGER2ERROR EXPR 3)
+L1364: intern L1364
+ PUSH 15,3
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,2(1)
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1362
+ HRRZI 1,99
+ ADJSP 15,-1
+ JRST SYMFNC+236
+L1362: <4_30>+<1_18>+L1363
+L1366: 33
+ byte(7)78,111,110,45,105,110,116,101,103,101,114,32,97,114,103,117,109,101,110,116,32,105,110,32,97,114,105,116,104,109,101,116,105,99,0
+; (!*ENTRY NONINTEGER1ERROR EXPR 2)
+L1367: intern L1367
+ PUSH 15,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,2(1)
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,L1365
+ HRRZI 1,99
+ ADJSP 15,-1
+ JRST SYMFNC+236
+L1365: <4_30>+<1_18>+L1366
+; (!*ENTRY ONEARGDISPATCH EXPR 1)
+L1369: intern L1369
+ LDB 2,L1368
+ JRST L1370
+L1368: point 6,1,5
+; (!*ENTRY ONEARGDISPATCH1 EXPR 2)
+L1370: intern L1370
+ CAIE 2,63
+ JRST L1371
+ SETZM 2
+L1371: POP 15,3
+ CAIL 2,0
+ CAILE 2,3
+ JRST L1372
+ JRST @L1373-0(2)
+L1373: IFIW L1374
+ IFIW L1375
+ IFIW L1376
+ IFIW L1377
+L1372:L1376: JRST L1378
+L1375: TLZ 1,258048
+ MOVE 1,1(1)
+L1374: MOVE 6,0(3)
+ JRST 0(6)
+L1377: MOVE 6,1(3)
+ JRST 0(6)
+L1380: 33
+ byte(7)78,111,110,45,110,117,109,101,114,105,99,32,97,114,103,117,109,101,110,116,32,105,110,32,97,114,105,116,104,109,101,116,105,99,0
+; (!*ENTRY ONEARGERROR EXPR 3)
+L1378: intern L1378
+ MOVE 2,1
+ MOVE 1,2(3)
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,L1379
+ HRRZI 1,99
+ JRST SYMFNC+236
+L1379: <4_30>+<1_18>+L1380
+; (!*ENTRY ONEARGPREDICATEDISPATCH EXPR 1)
+L1382: intern L1382
+ LDB 2,L1381
+ JRST L1383
+L1381: point 6,1,5
+; (!*ENTRY ONEARGPREDICATEDISPATCH1 EXPR 2)
+L1383: intern L1383
+ CAIE 2,63
+ JRST L1384
+ SETZM 2
+L1384: POP 15,3
+ CAIL 2,0
+ CAILE 2,3
+ JRST L1385
+ JRST @L1386-0(2)
+L1386: IFIW L1387
+ IFIW L1388
+ IFIW L1389
+ IFIW L1390
+L1385:L1389: MOVE 1,0
+ POPJ 15,0
+L1388: TLZ 1,258048
+ MOVE 1,1(1)
+L1387: MOVE 6,0(3)
+ JRST 0(6)
+L1390: MOVE 6,1(3)
+ JRST 0(6)
+; (!*ENTRY MAKEFIXNUM EXPR 1)
+L1391: intern L1391
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+139
+ MOVEM 1,-1(15)
+ MOVE 6,0(15)
+ MOVEM 6,1(1)
+ TLZ 1,258048
+ TLO 1,4096
+ ADJSP 15,-2
+ POPJ 15,0
+L1393: 24
+ byte(7)66,105,103,110,117,109,115,32,110,111,116,32,121,101,116,32,115,117,112,112,111,114,116,101,100,0
+; (!*ENTRY BIGFLOATFIX EXPR 1)
+L1394: intern L1394
+ MOVE 1,L1392
+ JRST SYMFNC+156
+L1392: <4_30>+<1_18>+L1393
+ 0
+; (!*ENTRY RETURNNIL EXPR 0)
+L1395: intern L1395
+ MOVE 1,0
+ POPJ 15,0
+ 1
+; (!*ENTRY RETURNFIRSTARG EXPR 1)
+L1396: intern L1396
+ POPJ 15,0
+ extern L1397
+ extern L1398
+; (!*ENTRY STATICINTFLOAT EXPR 1)
+L1359: intern L1359
+ MOVE 2,1
+ SETZM 1
+ ADDI 1,1+L1397
+ FLTR 2,2
+ MOVEM 2,0(1)
+ SETZM 1(1)
+ MOVE 1,L1398
+ POPJ 15,0
+ 2
+; (!*ENTRY PLUS2 EXPR 2)
+PLUS2: intern PLUS2
+ PUSHJ 15,L1341
+ L1399
+ L1400
+ <30_30>+243
+; (!*ENTRY INTPLUS2 EXPR 2)
+L1399: intern L1399
+ MOVE 4,1
+ ADDM 2,4
+ MOVE 1,4
+ MOVE 3,1
+ MOVE 6,1
+ LDB 1,L1401
+ TDNE 1,L1402
+ TDO 1,L1403
+ CAMN 1,3
+ JRST L1404
+ MOVE 1,0
+ JRST L1405
+L1404: MOVE 1,SYMVAL+84
+L1405: CAMN 1,0
+ JRST L1406
+ MOVE 1,4
+ POPJ 15,0
+L1406: MOVE 1,4
+ JRST L1391
+L1401: point 31,6,35
+L1402: 1073741824
+L1403: -1073741824
+; (!*ENTRY FLOATPLUS2 EXPR 2)
+L1400: intern L1400
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ PUSHJ 15,SYMFNC+388
+ MOVEM 1,-2(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ AOS 3
+ MOVE 2,0(15)
+ TLZ 2,258048
+ AOS 2
+ AOS 1
+ DMOVE 3,0(3)
+ DFAD 3,0(2)
+ DMOVEM 3,0(1)
+ MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY DIFFERENCE EXPR 2)
+L1407: intern L1407
+ PUSHJ 15,L1341
+ L1408
+ L1409
+ <30_30>+238
+; (!*ENTRY INTDIFFERENCE EXPR 2)
+L1408: intern L1408
+ MOVE 4,1
+ MOVN 1,2
+ ADDM 1,4
+ MOVE 1,4
+ MOVE 3,1
+ MOVE 6,1
+ LDB 1,L1410
+ TDNE 1,L1411
+ TDO 1,L1412
+ CAMN 1,3
+ JRST L1413
+ MOVE 1,0
+ JRST L1414
+L1413: MOVE 1,SYMVAL+84
+L1414: CAMN 1,0
+ JRST L1415
+ MOVE 1,4
+ POPJ 15,0
+L1415: MOVE 1,4
+ JRST L1391
+L1410: point 31,6,35
+L1411: 1073741824
+L1412: -1073741824
+; (!*ENTRY FLOATDIFFERENCE EXPR 2)
+L1409: intern L1409
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ PUSHJ 15,SYMFNC+388
+ MOVEM 1,-2(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ AOS 3
+ MOVE 2,0(15)
+ TLZ 2,258048
+ AOS 2
+ AOS 1
+ DMOVE 4,0(2)
+ DFSB 4,0(3)
+ DMOVEM 4,0(1)
+ MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY TIMES2 EXPR 2)
+TIMES2: intern TIMES2
+ PUSHJ 15,L1341
+ L1416
+ L1417
+ <30_30>+240
+; (!*ENTRY INTTIMES2 EXPR 2)
+L1416: intern L1416
+ ADJSP 15,2
+ MOVEM 1,-1(15)
+ MOVEM 2,0(15)
+ MOVE 3,1
+ IMUL 3,2
+ MOVE 5,3
+ MOVE 1,3
+ MOVE 4,1
+ MOVE 6,1
+ LDB 1,L1418
+ TDNE 1,L1419
+ TDO 1,L1420
+ CAMN 1,4
+ JRST L1421
+ MOVE 1,0
+ JRST L1422
+L1421: MOVE 1,SYMVAL+84
+L1422: CAME 1,0
+ JRST L1423
+ MOVE 1,3
+ ADJSP 15,-2
+ JRST L1391
+L1423: MOVE 1,3
+ ADJSP 15,-2
+ POPJ 15,0
+L1418: point 31,6,35
+L1419: 1073741824
+L1420: -1073741824
+; (!*ENTRY FLOATTIMES2 EXPR 2)
+L1417: intern L1417
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ PUSHJ 15,SYMFNC+388
+ MOVEM 1,-2(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ AOS 3
+ MOVE 2,0(15)
+ TLZ 2,258048
+ AOS 2
+ AOS 1
+ DMOVE 3,0(3)
+ DFMP 3,0(2)
+ DMOVEM 3,0(1)
+ MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY QUOTIENT EXPR 2)
+L1424: intern L1424
+ PUSHJ 15,L1341
+ L1425
+ L1426
+ <30_30>+242
+L1432: 36
+ byte(7)65,116,116,101,109,112,116,32,116,111,32,100,105,118,105,100,101,32,98,121,32,122,101,114,111,32,105,110,32,81,117,111,116,105,101,110,116,0
+; (!*ENTRY INTQUOTIENT EXPR 2)
+L1425: intern L1425
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ JUMPN 2,L1433
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L1427
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1428
+ HRRZI 1,99
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L1433: IDIV 1,2
+ MOVEM 1,-2(15)
+ MOVEM 1,-3(15)
+ MOVE 6,1
+ LDB 1,L1429
+ TDNE 1,L1430
+ TDO 1,L1431
+ CAMN 1,-3(15)
+ JRST L1434
+ MOVE 1,0
+ JRST L1435
+L1434: MOVE 1,SYMVAL+84
+L1435: CAME 1,0
+ JRST L1436
+ MOVE 1,-2(15)
+ ADJSP 15,-4
+ JRST L1391
+L1436: MOVE 1,-2(15)
+ ADJSP 15,-4
+ POPJ 15,0
+L1429: point 31,6,35
+L1430: 1073741824
+L1431: -1073741824
+L1428: <4_30>+<1_18>+L1432
+L1427: <30_30>+242
+L1439: 36
+ byte(7)65,116,116,101,109,112,116,32,116,111,32,100,105,118,105,100,101,32,98,121,32,122,101,114,111,32,105,110,32,81,117,111,116,105,101,110,116,0
+; (!*ENTRY FLOATQUOTIENT EXPR 2)
+L1426: intern L1426
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVE 1,2
+ PUSHJ 15,L1440
+ CAMN 1,0
+ JRST L1441
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L1437
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1438
+ HRRZI 1,99
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L1441: PUSHJ 15,SYMFNC+388
+ MOVEM 1,-2(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ AOS 3
+ MOVE 2,0(15)
+ TLZ 2,258048
+ AOS 2
+ AOS 1
+ DMOVE 4,0(2)
+ DFDV 4,0(3)
+ DMOVEM 4,0(1)
+ MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-4
+ POPJ 15,0
+L1438: <4_30>+<1_18>+L1439
+L1437: <30_30>+242
+ 2
+; (!*ENTRY REMAINDER EXPR 2)
+L1442: intern L1442
+ PUSHJ 15,L1341
+ L1443
+ L1444
+ <30_30>+277
+L1450: 37
+ byte(7)65,116,116,101,109,112,116,32,116,111,32,100,105,118,105,100,101,32,98,121,32,122,101,114,111,32,105,110,32,82,101,109,97,105,110,100,101,114,0
+; (!*ENTRY INTREMAINDER EXPR 2)
+L1443: intern L1443
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ JUMPN 2,L1451
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L1445
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1446
+ HRRZI 1,99
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L1451: IDIV 1,2
+ MOVE 1,2
+ MOVEM 1,-2(15)
+ MOVEM 1,-3(15)
+ MOVE 6,1
+ LDB 1,L1447
+ TDNE 1,L1448
+ TDO 1,L1449
+ CAMN 1,-3(15)
+ JRST L1452
+ MOVE 1,0
+ JRST L1453
+L1452: MOVE 1,SYMVAL+84
+L1453: CAME 1,0
+ JRST L1454
+ MOVE 1,-2(15)
+ ADJSP 15,-4
+ JRST L1391
+L1454: MOVE 1,-2(15)
+ ADJSP 15,-4
+ POPJ 15,0
+L1447: point 31,6,35
+L1448: 1073741824
+L1449: -1073741824
+L1446: <4_30>+<1_18>+L1450
+L1445: <30_30>+277
+; (!*ENTRY FLOATREMAINDER EXPR 2)
+L1444: intern L1444
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ PUSHJ 15,SYMFNC+388
+ MOVEM 1,-2(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ AOS 3
+ MOVE 2,0(15)
+ TLZ 2,258048
+ AOS 2
+ AOS 1
+ DMOVE 4,0(2)
+ DFDV 4,0(3)
+ DMOVEM 4,0(1)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ AOS 3
+ MOVE 2,-2(15)
+ AOS 2
+ MOVE 1,2
+ DMOVE 3,0(3)
+ DFMP 3,0(2)
+ DMOVEM 3,0(1)
+ MOVE 3,-2(15)
+ AOS 3
+ MOVE 2,0(15)
+ TLZ 2,258048
+ AOS 2
+ MOVE 1,3
+ DMOVE 4,0(2)
+ DFSB 4,0(3)
+ DMOVEM 4,0(1)
+ MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY LAND EXPR 2)
+LAND: intern LAND
+ PUSHJ 15,L1341
+ L1455
+ L1364
+ <30_30>+423
+; (!*ENTRY INTLAND EXPR 2)
+L1455: intern L1455
+ AND 1,2
+ MOVE 4,1
+ MOVE 3,1
+ MOVE 6,1
+ LDB 1,L1456
+ TDNE 1,L1457
+ TDO 1,L1458
+ CAMN 1,3
+ JRST L1459
+ MOVE 1,0
+ JRST L1460
+L1459: MOVE 1,SYMVAL+84
+L1460: CAMN 1,0
+ JRST L1461
+ MOVE 1,4
+ POPJ 15,0
+L1461: MOVE 1,4
+ JRST L1391
+L1456: point 31,6,35
+L1457: 1073741824
+L1458: -1073741824
+ 2
+; (!*ENTRY LOR EXPR 2)
+LOR: intern LOR
+ PUSHJ 15,L1341
+ INTLOR
+ L1364
+ <30_30>+424
+; (!*ENTRY INTLOR EXPR 2)
+INTLOR: intern INTLOR
+ IOR 1,2
+ MOVE 4,1
+ MOVE 3,1
+ MOVE 6,1
+ LDB 1,L1462
+ TDNE 1,L1463
+ TDO 1,L1464
+ CAMN 1,3
+ JRST L1465
+ MOVE 1,0
+ JRST L1466
+L1465: MOVE 1,SYMVAL+84
+L1466: CAMN 1,0
+ JRST L1467
+ MOVE 1,4
+ POPJ 15,0
+L1467: MOVE 1,4
+ JRST L1391
+L1462: point 31,6,35
+L1463: 1073741824
+L1464: -1073741824
+ 2
+; (!*ENTRY LXOR EXPR 2)
+LXOR: intern LXOR
+ PUSHJ 15,L1341
+ L1468
+ L1364
+ <30_30>+425
+; (!*ENTRY INTLXOR EXPR 2)
+L1468: intern L1468
+ XOR 1,2
+ MOVE 4,1
+ MOVE 3,1
+ MOVE 6,1
+ LDB 1,L1469
+ TDNE 1,L1470
+ TDO 1,L1471
+ CAMN 1,3
+ JRST L1472
+ MOVE 1,0
+ JRST L1473
+L1472: MOVE 1,SYMVAL+84
+L1473: CAMN 1,0
+ JRST L1474
+ MOVE 1,4
+ POPJ 15,0
+L1474: MOVE 1,4
+ JRST L1391
+L1469: point 31,6,35
+L1470: 1073741824
+L1471: -1073741824
+ 2
+; (!*ENTRY LSHIFT EXPR 2)
+LSHIFT: intern LSHIFT
+ PUSHJ 15,L1341
+ L1475
+ L1364
+ <30_30>+426
+; (!*ENTRY INTLSHIFT EXPR 2)
+L1475: intern L1475
+ ADJSP 15,2
+ MOVEM 1,-1(15)
+ MOVEM 2,0(15)
+ MOVE 3,1
+ LSH 3,0(2)
+ MOVE 5,3
+ MOVE 1,3
+ MOVE 4,1
+ MOVE 6,1
+ LDB 1,L1476
+ TDNE 1,L1477
+ TDO 1,L1478
+ CAMN 1,4
+ JRST L1479
+ MOVE 1,0
+ JRST L1480
+L1479: MOVE 1,SYMVAL+84
+L1480: CAME 1,0
+ JRST L1481
+ MOVE 1,3
+ ADJSP 15,-2
+ JRST L1391
+L1481: MOVE 1,3
+ ADJSP 15,-2
+ POPJ 15,0
+L1476: point 31,6,35
+L1477: 1073741824
+L1478: -1073741824
+ 2
+; (!*ENTRY GREATERP EXPR 2)
+L1482: intern L1482
+ PUSHJ 15,L1341
+ L1483
+ L1484
+ <30_30>+237
+; (!*ENTRY INTGREATERP EXPR 2)
+L1483: intern L1483
+ CAMLE 1,2
+ JRST L1485
+ MOVE 1,0
+ POPJ 15,0
+L1485: MOVE 1,SYMVAL+84
+ POPJ 15,0
+; (!*ENTRY FLOATGREATERP EXPR 2)
+L1484: intern L1484
+ TLZ 2,258048
+ AOS 2
+ TLZ 1,258048
+ AOS 1
+ DMOVE 3,0(2)
+ CAMGE 3,0(1)
+ JRST L1486
+ CAMN 3,0(1)
+ CAML 4,1(1)
+ MOVE 1,0
+L1486: CAMN 1,0
+ JRST L1487
+ MOVE 1,SYMVAL+84
+L1487: POPJ 15,0
+ 2
+; (!*ENTRY LESSP EXPR 2)
+LESSP: intern LESSP
+ PUSHJ 15,L1341
+ L1488
+ L1489
+ <30_30>+282
+; (!*ENTRY INTLESSP EXPR 2)
+L1488: intern L1488
+ CAMGE 1,2
+ JRST L1490
+ MOVE 1,0
+ POPJ 15,0
+L1490: MOVE 1,SYMVAL+84
+ POPJ 15,0
+; (!*ENTRY FLOATLESSP EXPR 2)
+L1489: intern L1489
+ TLZ 2,258048
+ AOS 2
+ TLZ 1,258048
+ AOS 1
+ DMOVE 3,0(2)
+ CAMLE 3,0(1)
+ JRST L1491
+ CAMN 3,0(1)
+ CAMG 4,1(1)
+ MOVE 1,0
+L1491: CAMN 1,0
+ JRST L1492
+ MOVE 1,SYMVAL+84
+L1492: POPJ 15,0
+ 1
+; (!*ENTRY ADD1 EXPR 1)
+ADD1: intern ADD1
+ PUSHJ 15,L1369
+ L1493
+ L1494
+ <30_30>+241
+; (!*ENTRY INTADD1 EXPR 1)
+L1493: intern L1493
+ MOVE 3,1
+ AOS 3
+ MOVE 1,3
+ MOVE 2,1
+ MOVE 6,1
+ LDB 1,L1495
+ TDNE 1,L1496
+ TDO 1,L1497
+ CAMN 1,2
+ JRST L1498
+ MOVE 1,0
+ JRST L1499
+L1498: MOVE 1,SYMVAL+84
+L1499: CAMN 1,0
+ JRST L1500
+ MOVE 1,3
+ POPJ 15,0
+L1500: MOVE 1,3
+ JRST L1391
+L1495: point 31,6,35
+L1496: 1073741824
+L1497: -1073741824
+L1502: 1
+ 1.0
+ 0
+; (!*ENTRY FLOATADD1 EXPR 1)
+L1494: intern L1494
+ MOVE 2,L1501
+ JRST L1400
+L1501: <3_30>+<1_18>+L1502
+ 1
+; (!*ENTRY SUB1 EXPR 1)
+SUB1: intern SUB1
+ PUSHJ 15,L1369
+ L1503
+ L1504
+ <30_30>+349
+; (!*ENTRY INTSUB1 EXPR 1)
+L1503: intern L1503
+ MOVE 3,1
+ SOS 3
+ MOVE 1,3
+ MOVE 2,1
+ MOVE 6,1
+ LDB 1,L1505
+ TDNE 1,L1506
+ TDO 1,L1507
+ CAMN 1,2
+ JRST L1508
+ MOVE 1,0
+ JRST L1509
+L1508: MOVE 1,SYMVAL+84
+L1509: CAMN 1,0
+ JRST L1510
+ MOVE 1,3
+ POPJ 15,0
+L1510: MOVE 1,3
+ JRST L1391
+L1505: point 31,6,35
+L1506: 1073741824
+L1507: -1073741824
+L1512: 1
+ 1.0
+ 0
+; (!*ENTRY FLOATSUB1 EXPR 1)
+L1504: intern L1504
+ MOVE 2,L1511
+ JRST L1409
+L1511: <3_30>+<1_18>+L1512
+ 1
+; (!*ENTRY LNOT EXPR 1)
+LNOT: intern LNOT
+ PUSHJ 15,L1369
+ L1513
+ L1367
+ <30_30>+428
+; (!*ENTRY INTLNOT EXPR 1)
+L1513: intern L1513
+ SETCMM 1
+ MOVE 3,1
+ MOVE 2,1
+ MOVE 6,1
+ LDB 1,L1514
+ TDNE 1,L1515
+ TDO 1,L1516
+ CAMN 1,2
+ JRST L1517
+ MOVE 1,0
+ JRST L1518
+L1517: MOVE 1,SYMVAL+84
+L1518: CAMN 1,0
+ JRST L1519
+ MOVE 1,3
+ POPJ 15,0
+L1519: MOVE 1,3
+ JRST L1391
+L1514: point 31,6,35
+L1515: 1073741824
+L1516: -1073741824
+ 1
+; (!*ENTRY MINUS EXPR 1)
+MINUS: intern MINUS
+ PUSHJ 15,L1369
+ L1520
+ L1521
+ <30_30>+274
+; (!*ENTRY INTMINUS EXPR 1)
+L1520: intern L1520
+ MOVNS 1
+ MOVE 3,1
+ MOVE 2,1
+ MOVE 6,1
+ LDB 1,L1522
+ TDNE 1,L1523
+ TDO 1,L1524
+ CAMN 1,2
+ JRST L1525
+ MOVE 1,0
+ JRST L1526
+L1525: MOVE 1,SYMVAL+84
+L1526: CAMN 1,0
+ JRST L1527
+ MOVE 1,3
+ POPJ 15,0
+L1527: MOVE 1,3
+ JRST L1391
+L1522: point 31,6,35
+L1523: 1073741824
+L1524: -1073741824
+L1529: 1
+ 0.0
+ 0
+; (!*ENTRY FLOATMINUS EXPR 1)
+L1521: intern L1521
+ MOVE 2,1
+ MOVE 1,L1528
+ JRST L1409
+L1528: <3_30>+<1_18>+L1529
+ 1
+; (!*ENTRY FIX EXPR 1)
+FIX: intern FIX
+ PUSHJ 15,L1369
+ L1396
+ L1530
+ <30_30>+429
+; (!*ENTRY FLOATFIX EXPR 1)
+L1530: intern L1530
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ TLZ 1,258048
+ AOS 1
+ FIX 1,0(1)
+ MOVEM 1,-1(15)
+ MOVEM 1,-2(15)
+ MOVE 6,1
+ LDB 1,L1531
+ TDNE 1,L1532
+ TDO 1,L1533
+ CAMN 1,-2(15)
+ JRST L1534
+ MOVE 1,0
+ JRST L1535
+L1534: MOVE 1,SYMVAL+84
+L1535: CAMN 1,0
+ JRST L1536
+ MOVE 1,-1(15)
+ JRST L1537
+L1536: MOVE 1,-1(15)
+ ADJSP 15,-3
+ JRST L1391
+L1537: ADJSP 15,-3
+ POPJ 15,0
+L1531: point 31,6,35
+L1532: 1073741824
+L1533: -1073741824
+ 1
+; (!*ENTRY FLOAT EXPR 1)
+FLOAT: intern FLOAT
+ PUSHJ 15,L1369
+ L1538
+ L1396
+ <30_30>+430
+; (!*ENTRY FLOATINTARG EXPR 1)
+L1538: intern L1538
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+388
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ AOS 1
+ FLTR 2,2
+ MOVEM 2,0(1)
+ SETZM 1(1)
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY MINUSP EXPR 1)
+MINUSP: intern MINUSP
+ PUSHJ 15,L1382
+ L1539
+ L1540
+ <30_30>+239
+; (!*ENTRY INTMINUSP EXPR 1)
+L1539: intern L1539
+ JUMPL 1,L1541
+ MOVE 1,0
+ POPJ 15,0
+L1541: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L1543: 1
+ 0.0
+ 0
+; (!*ENTRY FLOATMINUSP EXPR 1)
+L1540: intern L1540
+ MOVE 2,L1542
+ JRST L1489
+L1542: <3_30>+<1_18>+L1543
+ 1
+; (!*ENTRY ZEROP EXPR 1)
+ZEROP: intern ZEROP
+ PUSHJ 15,L1382
+ L1544
+ L1440
+ <30_30>+276
+; (!*ENTRY INTZEROP EXPR 1)
+L1544: intern L1544
+ JUMPE 1,L1545
+ MOVE 1,0
+ POPJ 15,0
+L1545: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L1547: 1
+ 0.0
+ 0
+; (!*ENTRY FLOATZEROP EXPR 1)
+L1440: intern L1440
+ MOVE 2,L1546
+ JRST SYMFNC+194
+L1546: <3_30>+<1_18>+L1547
+ 1
+; (!*ENTRY ONEP EXPR 1)
+ONEP: intern ONEP
+ PUSHJ 15,L1382
+ L1548
+ L1549
+ <30_30>+431
+; (!*ENTRY INTONEP EXPR 1)
+L1548: intern L1548
+ CAIN 1,1
+ JRST L1550
+ MOVE 1,0
+ POPJ 15,0
+L1550: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L1552: 1
+ 1.0
+ 0
+; (!*ENTRY FLOATONEP EXPR 1)
+L1549: intern L1549
+ MOVE 2,L1551
+ JRST SYMFNC+194
+L1551: <3_30>+<1_18>+L1552
+ end
ADDED psl-1983/3-1/kernel/20/arith.rel
Index: psl-1983/3-1/kernel/20/arith.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/arith.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/bare-psl.sym
Index: psl-1983/3-1/kernel/20/bare-psl.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/bare-psl.sym
@@ -0,0 +1,4 @@
+(setq OrderedIDList!* (NCons NIL))
+(setq UncompiledExpressions!* (NCons NIL))
+(setq ToBeCompiledExpressions!* (NCons NIL))
+(setq NextIDNumber!* 129)
ADDED psl-1983/3-1/kernel/20/copiers.red
Index: psl-1983/3-1/kernel/20/copiers.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/copiers.red
@@ -0,0 +1,112 @@
+
+% COPIERS.RED - Functions for copying various data types
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 6-May-83 Mark Swanson
+% Changed CopyStringToFrom to copy strings as words, not bytes, taking
+% advantage of fact that they are always allocated in word multiples
+% and starting on word boundaries; definite efficiency winner.
+% <PSL.KERNEL>COPIERS.RED.2, 28-Sep-82 10:21:15, Edit by PERDUE
+% Made CopyStringToFrom safe and to not bother clearing the
+% terminating byte.
+
+on SysLisp;
+
+syslsp procedure CopyStringToFrom(New, Old); %. Copy all chars in Old to New
+begin scalar SLen, StripNew, StripOld;
+ StripNew := StrInf New;
+ StripOld := StrInf Old;
+ SLen := StrLen StripOld;
+ if StrLen StripNew < SLen then SLen := StrLen StripNew;
+ SLen := StrPack SLen;
+ for I := 0 step 1 until SLen do
+ VecItm(StripNew, I) := VecItm(StripOld, I);
+ return New;
+end;
+
+syslsp procedure CopyString S; %. copy to new heap string
+begin scalar S1;
+ S1 := GtSTR StrLen StrInf S;
+ CopyStringToFrom(S1, StrInf S);
+ return MkSTR S1;
+end;
+
+syslsp procedure CopyWArray(New, Old, UpLim); %. copy UpLim + 1 words
+<< for I := 0 step 1 until UpLim do
+ New[I] := Old[I];
+ New >>;
+
+syslsp procedure CopyVectorToFrom(New, Old); %. Move elements, don't recurse
+begin scalar SLen, StripNew, StripOld;
+ StripNew := VecInf New;
+ StripOld := VecInf Old;
+ SLen := VecLen StripOld; % assumes VecLen New has been set
+ for I := 0 step 1 until SLen do
+ VecItm(StripNew, I) := VecItm(StripOld, I);
+ return New;
+end;
+
+syslsp procedure CopyVector S; %. Copy to new vector in heap
+begin scalar S1;
+ S1 := GtVECT VecLen VecInf S;
+ CopyVectorToFrom(S1, VecInf S);
+ return MkVEC S1;
+end;
+
+syslsp procedure CopyWRDSToFrom(New, Old); %. Like CopyWArray in heap
+begin scalar SLen, StripNew, StripOld;
+ StripNew := WrdInf New;
+ StripOld := WrdInf Old;
+ SLen := WrdLen StripOld; % assumes WrdLen New has been set
+ for I := 0 step 1 until SLen do
+ WrdItm(StripNew, I) := WrdItm(StripOld, I);
+ return New;
+end;
+
+syslsp procedure CopyWRDS S; %. Allocate new WRDS array in heap
+begin scalar S1;
+ S1 := GtWRDS WrdLen WrdInf S;
+ CopyWRDSToFrom(S1, WrdInf S);
+ return MkWRDS S1;
+end;
+
+% CopyPairToFrom is RplacW, found in EASY-NON-SL.RED
+% CopyPair is: car S . cdr S;
+
+% Usual Lisp definition of Copy only copies pairs, is found in EASY-NON-SL.RED
+
+syslsp procedure TotalCopy S; %. Unique copy of entire structure
+begin scalar Len, Ptr, StripS; % blows up on circular structures
+ return case Tag S of
+ PAIR:
+ TotalCopy car S . TotalCopy cdr S;
+ STR:
+ CopyString S;
+ VECT:
+ << StripS := VecInf S;
+ Len := VecLen StripS;
+ Ptr := MkVEC GtVECT Len;
+ for I := 0 step 1 until Len do
+ VecItm(VecInf Ptr, I) := TotalCopy VecItm(VecInf S, I);
+ Ptr >>;
+ WRDS:
+ CopyWRDS S;
+ FIXN:
+ MkFIXN Inf CopyWRDS S;
+ FLTN:
+ MkFLTN Inf CopyWRDS S;
+ default:
+ S
+ end;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/dalloc.mac
Index: psl-1983/3-1/kernel/20/dalloc.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dalloc.mac
@@ -0,0 +1,41 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern BPS
+ extern HEAP
+ extern HEAP2
+L1080: HEAP+0
+ intern L1080
+L1081: HEAP+0
+ intern L1081
+L1082: HEAP+262000
+ intern L1082
+L1083: 0
+ intern L1083
+L1084: HEAP2+0
+ intern L1084
+L1085: HEAP2+262000
+ intern L1085
+L1086: HEAP+262000
+ intern L1086
+L1087: HEAP2+262000
+ intern L1087
+L1088: 0
+ intern L1088
+ extern L1110
+ extern L1111
+ extern L1254
+ extern L1255
+ extern L1256
+L1257: 0
+ intern L1257
+L1258: 0
+ intern L1258
+L1259: 0
+ intern L1259
+ end
ADDED psl-1983/3-1/kernel/20/dalloc.rel
Index: psl-1983/3-1/kernel/20/dalloc.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dalloc.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/darith.mac
Index: psl-1983/3-1/kernel/20/darith.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/darith.mac
@@ -0,0 +1,15 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+L1397: 1
+ 0
+ 0
+ intern L1397
+L1398: <3_30>+<1_18>+L1397
+ intern L1398
+ end
ADDED psl-1983/3-1/kernel/20/darith.rel
Index: psl-1983/3-1/kernel/20/darith.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/darith.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/ddebg.mac
Index: psl-1983/3-1/kernel/20/ddebg.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/ddebg.mac
@@ -0,0 +1,11 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L1254
+ extern L1082
+ end
ADDED psl-1983/3-1/kernel/20/ddebg.rel
Index: psl-1983/3-1/kernel/20/ddebg.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/ddebg.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/debg.ctl
Index: psl-1983/3-1/kernel/20/debg.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/debg.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "debg";
+PathIn "debg.build";
+ASMEnd;
+quit;
+compile debg.mac, ddebg.mac
ADDED psl-1983/3-1/kernel/20/debg.init
Index: psl-1983/3-1/kernel/20/debg.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/debg.init
@@ -0,0 +1,9 @@
+(PUT (QUOTE TR) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE TRST) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (QEDITFNS !*EXPERT !*VERBOSE PROMPTSTRING!* EDITORREADER!*
+EDITORPRINTER!* CL)))
+(UNFLUID (QUOTE (CL)))
+(PUT (QUOTE EDIT) (QUOTE HELPFUNCTION) (QUOTE EHELP))
+(PUT (QUOTE EDITF) (QUOTE HELPFUNCTION) (QUOTE EHELP))
+(PUT (QUOTE EDITOR) (QUOTE HELPFUNCTION) (QUOTE EHELP))
+(FLUID (QUOTE (IGNOREDINBACKTRACE!* OPTIONS!* INTERPRETERFUNCTIONS!*)))
ADDED psl-1983/3-1/kernel/20/debg.log
Index: psl-1983/3-1/kernel/20/debg.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/debg.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/debg.mac
Index: psl-1983/3-1/kernel/20/debg.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/debg.mac
@@ -0,0 +1,782 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+L1555: <30_30>+432
+ <30_30>+128
+ 1
+; (!*ENTRY TR MACRO 1)
+TR: intern TR
+ PUSH 15,1
+ MOVE 1,L1553
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L1554
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L1554: <30_30>+433
+L1553: <9_30>+<1_18>+L1555
+L1558: <30_30>+432
+ <30_30>+128
+ 1
+; (!*ENTRY TRST MACRO 1)
+TRST: intern TRST
+ PUSH 15,1
+ MOVE 1,L1556
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L1557
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L1557: <30_30>+435
+L1556: <9_30>+<1_18>+L1558
+L1563: 17
+ byte(7)67,104,97,110,103,101,32,68,101,102,105,110,105,116,105,111,110,63,0
+L1564: 29
+ byte(7)37,114,32,105,115,32,110,111,116,32,97,110,32,101,100,105,116,97,98,108,101,32,102,117,110,99,116,105,111,110,0
+ 1
+; (!*ENTRY EDITF EXPR 1)
+EDITF: intern EDITF
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-4(15)
+ PUSHJ 15,SYMFNC+318
+ MOVEM 1,-2(15)
+ LDB 11,L1559
+ CAIE 11,9
+ JRST L1565
+ LDB 11,L1560
+ CAIE 11,15
+ JRST L1566
+L1565: MOVE 2,0(15)
+ MOVE 1,L1561
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+L1566: MOVE 1,-2(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+347
+ MOVEM 1,-3(15)
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+440
+ MOVE 1,L1562
+ PUSHJ 15,SYMFNC+441
+ CAME 1,0
+ JRST L1567
+ MOVE 2,-3(15)
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+344
+ MOVE 1,0
+ JRST L1568
+L1567: MOVE 2,SYMVAL+436
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+302
+ CAME 1,0
+ JRST L1569
+ MOVE 2,SYMVAL+436
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,SYMVAL+436
+L1569: MOVE 1,0(15)
+L1568: ADJSP 15,-5
+ POPJ 15,0
+L1559: point 6,1,5
+L1560: point 6,1(1),5
+L1562: <4_30>+<1_18>+L1563
+L1561: <4_30>+<1_18>+L1564
+L1574: 36
+ byte(7)84,121,112,101,32,72,69,76,80,60,67,82,62,32,102,111,114,32,97,32,108,105,115,116,32,111,102,32,99,111,109,109,97,110,100,115,46,0
+L1575: 5
+ byte(7)101,100,105,116,62,32,0
+ 1
+; (!*ENTRY EDIT EXPR 1)
+EDIT: intern EDIT
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,442
+ MOVE 6,L1570
+ MOVEM 6,SYMVAL+442
+ PUSHJ 15,SYMFNC+444
+ CAME 0,SYMVAL+437
+ JRST L1576
+ MOVE 1,L1571
+ PUSHJ 15,SYMFNC+357
+L1576: MOVE 1,SYMVAL+445
+ CAME 1,0
+ JRST L1577
+ MOVE 1,L1572
+L1577: MOVEM 1,-1(15)
+ MOVE 1,SYMVAL+446
+ CAME 1,0
+ JRST L1578
+ MOVE 1,L1573
+L1578: MOVE 3,1
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,EDIT0
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-2
+ POPJ 15,0
+L1573: <30_30>+310
+L1572: <30_30>+448
+L1571: <4_30>+<1_18>+L1574
+L1570: <4_30>+<1_18>+L1575
+L1597: 14
+ byte(7)73,108,108,101,103,97,108,32,99,111,109,109,97,110,100,0
+L1598: 9
+ byte(7)76,105,115,116,32,101,109,112,116,121,0
+L1599: 31
+ byte(7)89,111,117,32,97,114,101,32,97,108,114,101,97,100,121,32,97,116,32,116,104,101,32,116,111,112,32,108,101,118,101,108,0
+L1600: <30_30>+450
+ <9_30>+<1_18>+L1602
+L1601: 8
+ byte(7)78,79,84,32,70,79,85,78,68,0
+L1602: <30_30>+63
+ <30_30>+128
+; (!*ENTRY EDIT0 EXPR 3)
+EDIT0: intern EDIT0
+ ADJSP 15,10
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-7(15)
+ MOVEM 0,-9(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,449
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-6(15)
+ HRRZI 6,3
+ MOVEM 6,-5(15)
+L1603: MOVE 6,-6(15)
+ MOVEM 6,-4(15)
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-3(15)
+ MOVE 2,-6(15)
+ MOVE 2,0(2)
+ MOVEM 2,SYMVAL+449
+L1604: CAMN 0,SYMVAL+438
+ JRST L1605
+ MOVE 2,-5(15)
+ MOVE 1,SYMVAL+449
+ PUSHJ 15,EDCOPY
+ MOVE 2,-2(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+L1605: MOVE 1,-1(15)
+ MOVE 6,1
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,-8(15)
+ LDB 11,L1579
+ CAIE 11,9
+ JRST L1606
+ LDB 11,L1581
+ CAIN 11,63
+ JRST L1580
+ CAILE 11,3
+ JRST L1607
+L1580: SKIPN 0(1)
+ JRST L1608
+ SETZM 2
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L1609
+ MOVE 1,-8(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+349
+ MOVE 2,SYMVAL+449
+ PUSHJ 15,QEDNTH
+ MOVE 4,-8(15)
+ MOVE 4,0(4)
+ MOVE 3,-8(15)
+ MOVE 3,1(3)
+ MOVE 2,-4(15)
+ PUSHJ 15,L1610
+ JRST L1604
+L1609: MOVE 1,-8(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+241
+ PUSHJ 15,SYMFNC+274
+ MOVE 2,SYMVAL+449
+ PUSHJ 15,QEDNTH
+ MOVE 4,-8(15)
+ MOVE 4,0(4)
+ MOVE 3,-8(15)
+ MOVE 3,1(3)
+ MOVE 2,-4(15)
+ PUSHJ 15,XINS
+ JRST L1604
+L1607: MOVE 6,L1582
+ CAME 6,0(1)
+ JRST L1608
+ MOVE 3,SYMVAL+449
+ MOVE 2,1(1)
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,L1611
+ JRST L1604
+L1612: MOVE 1,-1(15)
+ MOVE 6,1
+ PUSHJ 15,SYMFNC+288
+ MOVE 3,-3(15)
+ MOVE 2,SYMVAL+449
+ PUSHJ 15,L1613
+ MOVEM 1,-7(15)
+ CAME 1,0
+ JRST L1614
+ MOVE 1,L1583
+ PUSHJ 15,SYMFNC+357
+ JRST L1604
+L1614: MOVE 2,0(1)
+ MOVEM 2,SYMVAL+449
+ MOVE 3,1(1)
+ MOVEM 3,-3(15)
+ MOVE 4,0(3)
+ MOVEM 4,-4(15)
+ JRST L1604
+L1606: LDB 11,L1585
+ CAIN 11,63
+ JRST L1584
+ CAILE 11,3
+ JRST L1615
+L1584: SKIPE -8(15)
+ JRST L1616
+ MOVE 1,-4(15)
+ MOVE 1,0(1)
+ MOVEM 1,SYMVAL+449
+ JRST L1604
+L1615: MOVE 6,-8(15)
+ CAME 6,L1586
+ JRST L1617
+ MOVE 1,SYMVAL+438
+ CAME 1,0
+ JRST L1604
+ MOVE 2,-5(15)
+ MOVE 1,SYMVAL+449
+ PUSHJ 15,EDCOPY
+ MOVE 2,-2(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ JRST L1604
+L1617: MOVE 6,-8(15)
+ CAME 6,L1587
+ JRST L1618
+ MOVE 1,-6(15)
+ MOVE 1,0(1)
+ JRST L1619
+L1618: MOVE 6,-8(15)
+ CAMN 6,L1588
+ JRST L1620
+ MOVE 6,-8(15)
+ CAME 6,L1589
+ JRST L1621
+ PUSHJ 15,SYMFNC+451
+ JRST L1604
+L1621: MOVE 6,-8(15)
+ CAMN 6,L1590
+ JRST L1612
+ MOVE 6,-8(15)
+ CAME 6,L1591
+ JRST L1622
+ MOVE 1,-1(15)
+ MOVE 6,1
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,-5(15)
+ JRST L1604
+L1622: MOVE 2,L1592
+ MOVE 1,-8(15)
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L1623
+ PUSHJ 15,SYMFNC+452
+ JRST L1604
+L1623: MOVE 6,-8(15)
+ CAME 6,L1593
+ JRST L1624
+ MOVE 1,-1(15)
+ MOVE 6,1
+ PUSHJ 15,SYMFNC+288
+ PUSHJ 15,SYMFNC+261
+ MOVE 2,-2(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ JRST L1604
+L1624: MOVE 6,-8(15)
+ CAME 6,SYMVAL+84
+ JRST L1608
+ JRST L1603
+L1620: MOVE 7,-3(15)
+ CAME 0,1(7)
+ JRST L1625
+ MOVE 1,L1594
+ PUSHJ 15,SYMFNC+357
+ JRST L1604
+L1625: MOVE 1,-3(15)
+ MOVE 1,1(1)
+ MOVEM 1,-3(15)
+ MOVE 2,0(1)
+ MOVEM 2,-4(15)
+ MOVE 3,0(2)
+ MOVEM 3,SYMVAL+449
+ JRST L1604
+L1616: MOVE 6,-8(15)
+ MOVEM 6,-9(15)
+ MOVE 1,-8(15)
+ PUSHJ 15,SYMFNC+273
+ MOVE 2,SYMVAL+449
+ PUSHJ 15,QEDNTH
+ MOVEM 1,-8(15)
+ CAME 1,0
+ JRST L1626
+ MOVE 1,L1595
+ PUSHJ 15,SYMFNC+357
+ JRST L1604
+L1626: SETZM 2
+ MOVE 1,-9(15)
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L1627
+ MOVE 2,-8(15)
+ MOVE 2,0(2)
+ MOVEM 2,SYMVAL+449
+L1627: MOVE 6,-8(15)
+ MOVEM 6,-4(15)
+ MOVE 2,-3(15)
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-3(15)
+ JRST L1604
+L1608: MOVE 1,L1596
+ PUSHJ 15,SYMFNC+357
+ JRST L1604
+L1619: JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-10
+ POPJ 15,0
+L1579: point 6,1,5
+L1581: point 6,0(1),5
+L1585: point 6,-8(15),5
+L1596: <4_30>+<1_18>+L1597
+L1595: <4_30>+<1_18>+L1598
+L1594: <4_30>+<1_18>+L1599
+L1593: <30_30>+69
+L1592: <9_30>+<1_18>+L1600
+L1591: <30_30>+453
+L1590: <30_30>+70
+L1589: <30_30>+66
+L1588: <30_30>+454
+L1587: <30_30>+455
+L1586: <30_30>+80
+L1583: <4_30>+<1_18>+L1601
+L1582: <30_30>+82
+; (!*ENTRY QEDNTH EXPR 2)
+QEDNTH: intern QEDNTH
+ ADJSP 15,2
+L1629: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1628
+ CAIN 11,9
+ JRST L1630
+ MOVE 1,0
+ JRST L1631
+L1630: HRRZI 2,1
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L1632
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+349
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ JRST L1629
+L1632: MOVE 1,-1(15)
+L1631: ADJSP 15,-2
+ POPJ 15,0
+L1628: point 6,2,5
+L1635: 2
+ byte(7)42,42,42,0
+; (!*ENTRY EDCOPY EXPR 2)
+EDCOPY: intern EDCOPY
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1633
+ CAIE 11,9
+ JRST L1636
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+239
+ CAMN 1,0
+ JRST L1637
+ MOVE 1,L1634
+ JRST L1636
+L1637: MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+349
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,EDCOPY
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,EDCOPY
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L1636: ADJSP 15,-3
+ POPJ 15,0
+L1633: point 6,1,5
+L1634: <4_30>+<1_18>+L1635
+; (!*ENTRY RPLACEALL EXPR 3)
+L1611: intern L1611
+ ADJSP 15,3
+L1639: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L1638
+ CAIN 11,9
+ JRST L1640
+ MOVE 1,0
+ JRST L1641
+L1640: MOVE 2,1
+ MOVE 1,0(3)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L1642
+ MOVE 3,-2(15)
+ MOVE 6,-1(15)
+ MOVEM 6,0(3)
+ MOVE 3,1(3)
+ JRST L1643
+L1642: MOVE 3,-2(15)
+ MOVE 3,0(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,L1611
+ MOVE 3,-2(15)
+ MOVE 3,1(3)
+L1643: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ JRST L1639
+L1641: ADJSP 15,-3
+ POPJ 15,0
+L1638: point 6,3,5
+; (!*ENTRY FINDFIRST EXPR 3)
+L1613: intern L1613
+ ADJSP 15,4
+L1645: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L1644
+ CAIN 11,9
+ JRST L1646
+ MOVE 1,0
+ JRST L1647
+L1646: PUSHJ 15,SYMFNC+302
+ CAMN 1,0
+ JRST L1648
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ ADJSP 15,-4
+ JRST SYMFNC+151
+L1648: MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+151
+ MOVE 3,1
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,L1613
+ CAME 1,0
+ JRST L1647
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L1645
+L1647: ADJSP 15,-4
+ POPJ 15,0
+L1644: point 6,2,5
+L1651: 9
+ byte(7)76,105,115,116,32,101,109,112,116,121,0
+; (!*ENTRY XCHANGE EXPR 4)
+L1610: intern L1610
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L1649
+ CAIN 11,9
+ JRST L1652
+ MOVE 1,L1650
+ PUSHJ 15,SYMFNC+357
+ MOVE 1,0
+ JRST L1653
+L1652: CAIE 4,1
+ JRST L1654
+ MOVE 2,1(1)
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+291
+ MOVE 7,-1(15)
+ MOVEM 1,0(7)
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ MOVEM 1,SYMVAL+449
+ JRST L1653
+L1654: MOVE 7,1(1)
+ CAMN 0,1(7)
+ JRST L1655
+ MOVE 1,1(1)
+ MOVE 1,1(1)
+ JRST L1656
+L1655: MOVE 1,0
+L1656: MOVE 2,1
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+291
+ MOVE 7,0(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+L1653: ADJSP 15,-2
+ POPJ 15,0
+L1649: point 6,1,5
+L1650: <4_30>+<1_18>+L1651
+L1659: 9
+ byte(7)76,105,115,116,32,101,109,112,116,121,0
+; (!*ENTRY XINS EXPR 4)
+XINS: intern XINS
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L1657
+ CAIN 11,9
+ JRST L1660
+ MOVE 1,L1658
+ PUSHJ 15,SYMFNC+357
+ MOVE 1,0
+ JRST L1661
+L1660: CAIE 4,1
+ JRST L1662
+ MOVE 2,1
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+291
+ MOVE 7,-1(15)
+ MOVEM 1,0(7)
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ MOVEM 1,SYMVAL+449
+ JRST L1661
+L1662: MOVE 2,1(1)
+ MOVE 1,3
+ PUSHJ 15,SYMFNC+291
+ MOVE 7,0(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+L1661: ADJSP 15,-2
+ POPJ 15,0
+L1657: point 6,1,5
+L1658: <4_30>+<1_18>+L1659
+L1665: <30_30>+450
+ <30_30>+128
+ 0
+; (!*ENTRY EHELP EXPR 0)
+EHELP: intern EHELP
+ MOVE 1,L1663
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L1664
+ JRST SYMFNC+456
+L1664: <30_30>+457
+L1663: <9_30>+<1_18>+L1665
+ extern L1254
+ extern L1082
+L1667: 63
+ byte(7)66,97,99,107,116,114,97,99,101,44,32,105,110,99,108,117,100,105,110,103,32,105,110,116,101,114,112,114,101,116,101,114,32,102,117,110,99,116,105,111,110,115,44,32,102,114,111,109,32,116,111,112,32,111,102,32,115,116,97,99,107,58,37,110,0
+ 0
+; (!*ENTRY INTERPBACKTRACE EXPR 0)
+L1668: intern L1668
+ PUSH 15,0
+ XMOVEI 1,0(15)
+ MOVEM 1,0(15)
+ MOVE 1,L1666
+ PUSHJ 15,SYMFNC+461
+ HRRZI 3,1
+ MOVE 2,L1254
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST L1669
+L1666: <4_30>+<1_18>+L1667
+L1671: 29
+ byte(7)66,97,99,107,116,114,97,99,101,32,102,114,111,109,32,116,111,112,32,111,102,32,115,116,97,99,107,58,37,110,0
+ 0
+; (!*ENTRY BACKTRACE EXPR 0)
+L1672: intern L1672
+ PUSH 15,0
+ PUSH 15,0
+ XMOVEI 1,0(15)
+ MOVEM 1,0(15)
+ MOVE 1,L1670
+ PUSHJ 15,SYMFNC+461
+ SETZM 3
+ MOVE 2,L1254
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST L1669
+L1670: <4_30>+<1_18>+L1671
+; (!*ENTRY BACKTRACERANGE EXPR 3)
+L1669: intern L1669
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 1,-4(15)
+L1674: MOVE 6,-4(15)
+ CAMGE 6,-1(15)
+ JRST L1675
+ MOVE 7,-4(15)
+ LDB 1,L1673
+ CAIE 1,28
+ JRST L1676
+ MOVE 2,-2(15)
+ MOVE 7,-4(15)
+ MOVE 1,0(7)
+ TLZ 1,258048
+ HRLI 1,122880
+ PUSHJ 15,L1677
+ JRST L1678
+L1676: MOVE 1,-4(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+463
+ MOVE 2,1
+ MOVEM 2,-3(15)
+ CAMN 2,0
+ JRST L1678
+ MOVE 2,-2(15)
+ MOVE 1,-3(15)
+ PUSHJ 15,L1677
+L1678: SOS -4(15)
+ JRST L1674
+L1675: ADJSP 15,-5
+ JRST SYMFNC+444
+L1673: point 6,0(7),5
+L1686: 4
+ byte(7)9,37,112,37,110,0
+L1687: 10
+ byte(7)37,112,32,45,62,32,37,112,58,37,110,0
+L1688: 4
+ byte(7)9,37,114,37,110,0
+L1689: <30_30>+464
+ <30_30>+128
+ 0
+; (!*ENTRY VERBOSEBACKTRACE EXPR 0)
+L1690: intern L1690
+ ADJSP 15,3
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ MOVE 2,SYMVAL+466
+ MOVE 1,L1679
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L1691
+ MOVE 1,L1680
+ PUSHJ 15,SYMFNC+434
+L1691: XMOVEI 1,0(15)
+ MOVEM 1,0(15)
+ MOVEM 1,-2(15)
+L1692: MOVE 6,-2(15)
+ CAMGE 6,L1254
+ JRST L1693
+ MOVE 6,-2(15)
+ LDB 11,L1681
+ CAIE 11,15
+ JRST L1694
+ MOVE 7,-2(15)
+ MOVE 1,0(7)
+ TLZ 1,258048
+ CAMG 1,L1082
+ JRST L1694
+ HRRZI 1,9
+ PUSHJ 15,SYMFNC+467
+ MOVE 2,-2(15)
+ MOVE 2,0(2)
+ MOVE 1,SYMVAL+311
+ PUSHJ 15,SYMFNC+468
+ PUSHJ 15,SYMFNC+444
+ JRST L1695
+L1694: MOVE 7,-2(15)
+ LDB 1,L1682
+ CAIE 1,28
+ JRST L1696
+ MOVE 7,-2(15)
+ MOVE 2,0(7)
+ TLZ 2,258048
+ HRLI 2,122880
+ MOVE 1,L1683
+ JRST L1697
+L1696: MOVE 1,-2(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+463
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ CAMN 2,0
+ JRST L1698
+ MOVE 7,-2(15)
+ MOVE 1,0(7)
+ TLZ 1,258048
+ PUSHJ 15,SYMFNC+469
+ MOVE 3,-1(15)
+ MOVE 2,1
+ MOVE 1,L1684
+ PUSHJ 15,SYMFNC+461
+ JRST L1695
+L1698: MOVE 2,-2(15)
+ MOVE 2,0(2)
+ MOVE 1,L1685
+L1697: PUSHJ 15,SYMFNC+461
+L1695: SOS -2(15)
+ JRST L1692
+L1693: ADJSP 15,-3
+ JRST SYMFNC+444
+L1681: point 6,0(6),5
+L1682: point 6,0(7),5
+L1685: <4_30>+<1_18>+L1686
+L1684: <4_30>+<1_18>+L1687
+L1683: <4_30>+<1_18>+L1688
+L1680: <9_30>+<1_18>+L1689
+L1679: <30_30>+464
+; (!*ENTRY BACKTRACE1 EXPR 2)
+L1677: intern L1677
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 2,SYMVAL+458
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L1699
+ SKIPE -1(15)
+ JRST L1700
+ MOVE 2,SYMVAL+459
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L1701
+L1700: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+470
+ HRRZI 1,32
+ PUSHJ 15,SYMFNC+467
+ JRST L1702
+L1701: MOVE 1,0
+L1702: JRST L1703
+L1699: MOVE 1,0
+L1703: ADJSP 15,-2
+ POPJ 15,0
+ end
ADDED psl-1983/3-1/kernel/20/debg.rel
Index: psl-1983/3-1/kernel/20/debg.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/debg.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/derror.mac
Index: psl-1983/3-1/kernel/20/derror.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/derror.mac
@@ -0,0 +1,9 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ end
ADDED psl-1983/3-1/kernel/20/derror.rel
Index: psl-1983/3-1/kernel/20/derror.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/derror.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/deval.mac
Index: psl-1983/3-1/kernel/20/deval.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/deval.mac
@@ -0,0 +1,15 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L1256
+ extern L1825
+L2011: block 1601
+ intern L2011
+L2012: L2011+0
+ intern L2012
+ end
ADDED psl-1983/3-1/kernel/20/deval.rel
Index: psl-1983/3-1/kernel/20/deval.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/deval.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dextra.mac
Index: psl-1983/3-1/kernel/20/dextra.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dextra.mac
@@ -0,0 +1,14 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L1080
+ extern L1082
+ extern L1110
+ extern L1111
+ extern L2081
+ end
ADDED psl-1983/3-1/kernel/20/dextra.rel
Index: psl-1983/3-1/kernel/20/dextra.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dextra.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dfasl.mac
Index: psl-1983/3-1/kernel/20/dfasl.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dfasl.mac
@@ -0,0 +1,12 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L2110
+L2111: 0
+ intern L2111
+ end
ADDED psl-1983/3-1/kernel/20/dfasl.rel
Index: psl-1983/3-1/kernel/20/dfasl.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dfasl.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dheap.mac
Index: psl-1983/3-1/kernel/20/dheap.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dheap.mac
@@ -0,0 +1,15 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+BPS: block 170001
+ intern BPS
+L1110: <BPS+0>+262144
+ intern L1110
+L1111: <BPS+170000>+262144
+ intern L1111
+ end
ADDED psl-1983/3-1/kernel/20/dheap.rel
Index: psl-1983/3-1/kernel/20/dheap.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dheap.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dio.mac
Index: psl-1983/3-1/kernel/20/dio.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dio.mac
@@ -0,0 +1,281 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+L2110: block 1001
+ intern L2110
+L2253: <30_30>+591
+ <30_30>+504
+ <30_30>+504
+ <30_30>+592
+ <30_30>+504
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ intern L2253
+L2254: <30_30>+505
+ <30_30>+593
+ <30_30>+594
+ <30_30>+595
+ <30_30>+596
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ intern L2254
+L2255: <30_30>+506
+ <30_30>+506
+ <30_30>+506
+ <30_30>+506
+ <30_30>+506
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ <30_30>+502
+ intern L2255
+L2256: 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ intern L2256
+L2257: 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ intern L2257
+L2258: block 32
+ intern L2258
+L2259: 0
+ 80
+ 80
+ 10000
+ 10000
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ intern L2259
+L2260: 64
+ 65
+ -1
+ -1
+ -1
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ intern L2260
+TOKCH: 0
+ intern TOKCH
+L2373: 0
+ intern L2373
+L2374: 0
+ intern L2374
+L2375: 0
+ intern L2375
+L2376: 0
+ intern L2376
+L2377: 0
+ intern L2377
+L2378: 0
+ intern L2378
+L2379: 0
+ intern L2379
+L2380: 0
+ intern L2380
+L2381: 0
+ intern L2381
+L2394: block 2
+ intern L2394
+L2395: block 2
+ intern L2395
+L2396: block 2
+ intern L2396
+L2397: block 2
+ intern L2397
+L2562: 35
+ byte(7)48,49,50,51,52,53,54,55,56,57,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,0
+ intern L2562
+L2563: block 9
+ intern L2563
+L2905: 0
+ intern L2905
+L2909: 0
+ intern L2909
+ end
ADDED psl-1983/3-1/kernel/20/dio.rel
Index: psl-1983/3-1/kernel/20/dio.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dio.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dmacro.mac
Index: psl-1983/3-1/kernel/20/dmacro.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dmacro.mac
@@ -0,0 +1,9 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ end
ADDED psl-1983/3-1/kernel/20/dmacro.rel
Index: psl-1983/3-1/kernel/20/dmacro.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dmacro.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dmain.mac
Index: psl-1983/3-1/kernel/20/dmain.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dmain.mac
@@ -0,0 +1,12002 @@
+ radix 10
+STACK: block 4001
+ intern STACK
+L1254: <STACK+0>+262144
+ intern L1254
+L2081: <STACK+4000>+262144
+ intern L2081
+L0002: block 10
+ intern L0002
+L0003: block 4105
+ intern L0003
+ intern HEAP
+ HEAP=2,,0
+ intern HEAP2
+ HEAP2=4,,0
+SYMVAL: intern SYMVAL
+ <29_30>+0
+ <29_30>+1
+ <29_30>+2
+ <29_30>+3
+ <29_30>+4
+ <29_30>+5
+ <29_30>+6
+ <29_30>+7
+ <29_30>+8
+ <29_30>+9
+ <29_30>+10
+ <29_30>+11
+ <29_30>+12
+ <29_30>+13
+ <29_30>+14
+ <29_30>+15
+ <29_30>+16
+ <29_30>+17
+ <29_30>+18
+ <29_30>+19
+ <29_30>+20
+ <29_30>+21
+ <29_30>+22
+ <29_30>+23
+ <29_30>+24
+ <29_30>+25
+ <29_30>+26
+ <29_30>+27
+ <29_30>+28
+ <29_30>+29
+ <29_30>+30
+ <29_30>+31
+ <29_30>+32
+ <29_30>+33
+ <29_30>+34
+ <29_30>+35
+ <29_30>+36
+ <29_30>+37
+ <29_30>+38
+ <29_30>+39
+ <29_30>+40
+ <29_30>+41
+ <29_30>+42
+ <29_30>+43
+ <29_30>+44
+ <29_30>+45
+ <29_30>+46
+ <29_30>+47
+ <29_30>+48
+ <29_30>+49
+ <29_30>+50
+ <29_30>+51
+ <29_30>+52
+ <29_30>+53
+ <29_30>+54
+ <29_30>+55
+ <29_30>+56
+ <29_30>+57
+ <29_30>+58
+ <29_30>+59
+ <29_30>+60
+ <29_30>+61
+ <29_30>+62
+ <29_30>+63
+ <29_30>+64
+ <29_30>+65
+ <29_30>+66
+ <29_30>+67
+ <29_30>+68
+ <29_30>+69
+ <29_30>+70
+ <29_30>+71
+ <29_30>+72
+ <29_30>+73
+ <29_30>+74
+ <29_30>+75
+ <29_30>+76
+ <29_30>+77
+ <29_30>+78
+ <29_30>+79
+ <29_30>+80
+ <29_30>+81
+ <29_30>+82
+ <29_30>+83
+ <30_30>+84
+ <29_30>+85
+ <29_30>+86
+ <29_30>+87
+ <29_30>+88
+ <29_30>+89
+ <29_30>+90
+ <29_30>+91
+ <29_30>+92
+ <29_30>+93
+ <29_30>+94
+ <29_30>+95
+ <29_30>+96
+ <29_30>+97
+ <29_30>+98
+ <29_30>+99
+ <29_30>+100
+ <29_30>+101
+ <29_30>+102
+ <29_30>+103
+ <29_30>+104
+ <29_30>+105
+ <29_30>+106
+ <29_30>+107
+ <29_30>+108
+ <29_30>+109
+ <29_30>+110
+ <29_30>+111
+ <29_30>+112
+ <29_30>+113
+ <29_30>+114
+ <29_30>+115
+ <29_30>+116
+ <29_30>+117
+ <29_30>+118
+ <29_30>+119
+ <29_30>+120
+ <29_30>+121
+ <29_30>+122
+ <29_30>+123
+ <29_30>+124
+ <29_30>+125
+ <29_30>+126
+ <29_30>+127
+ <30_30>+128
+ <29_30>+129
+ <29_30>+130
+ <29_30>+131
+ <29_30>+132
+ <29_30>+133
+ <29_30>+134
+ <29_30>+135
+ <29_30>+136
+ <29_30>+137
+ <29_30>+138
+ <29_30>+139
+ <29_30>+140
+ <29_30>+141
+ <29_30>+142
+ <29_30>+143
+ <29_30>+144
+ <29_30>+145
+ <29_30>+146
+ <29_30>+147
+ <29_30>+148
+ <29_30>+149
+ <29_30>+150
+ <29_30>+151
+ <29_30>+152
+ <29_30>+153
+ <29_30>+154
+ <29_30>+155
+ <29_30>+156
+ <29_30>+157
+ <29_30>+158
+ <29_30>+159
+ <29_30>+160
+ <29_30>+161
+ <29_30>+162
+ <29_30>+163
+ <29_30>+164
+ <29_30>+165
+ <29_30>+166
+ <29_30>+167
+ <29_30>+168
+ <29_30>+169
+ <29_30>+170
+ <29_30>+171
+ <29_30>+172
+ <29_30>+173
+ <29_30>+174
+ <29_30>+175
+ <29_30>+176
+ <29_30>+177
+ <29_30>+178
+ <29_30>+179
+ <29_30>+180
+ <29_30>+181
+ <29_30>+182
+ <29_30>+183
+ <29_30>+184
+ <29_30>+185
+ <29_30>+186
+ <29_30>+187
+ <29_30>+188
+ <29_30>+189
+ <29_30>+190
+ <29_30>+191
+ <29_30>+192
+ <29_30>+193
+ <29_30>+194
+ <29_30>+195
+ <29_30>+196
+ <29_30>+197
+ <29_30>+198
+ <29_30>+199
+ <29_30>+200
+ <29_30>+201
+ <29_30>+202
+ <29_30>+203
+ <29_30>+204
+ <29_30>+205
+ <29_30>+206
+ <29_30>+207
+ <29_30>+208
+ <29_30>+209
+ <29_30>+210
+ <29_30>+211
+ <29_30>+212
+ <29_30>+213
+ <29_30>+214
+ <29_30>+215
+ <29_30>+216
+ <29_30>+217
+ <29_30>+218
+ <29_30>+219
+ <29_30>+220
+ <29_30>+221
+ <29_30>+222
+ <29_30>+223
+ <29_30>+224
+ <29_30>+225
+ <29_30>+226
+ <29_30>+227
+ <29_30>+228
+ <29_30>+229
+ <29_30>+230
+ <29_30>+231
+ <29_30>+232
+ <29_30>+233
+ <29_30>+234
+ <29_30>+235
+ <29_30>+236
+ <29_30>+237
+ <29_30>+238
+ <29_30>+239
+ <29_30>+240
+ <29_30>+241
+ <29_30>+242
+ <29_30>+243
+ <29_30>+244
+ <29_30>+245
+ <29_30>+246
+ <29_30>+247
+ <29_30>+248
+ <29_30>+249
+ <29_30>+250
+ <29_30>+251
+ <29_30>+252
+ <29_30>+253
+ <29_30>+254
+ <29_30>+255
+ <29_30>+256
+ <29_30>+257
+ <29_30>+258
+ <29_30>+259
+ <29_30>+260
+ <29_30>+261
+ <29_30>+262
+ <29_30>+263
+ <29_30>+264
+ <29_30>+265
+ <29_30>+266
+ <29_30>+267
+ <29_30>+268
+ <29_30>+269
+ <29_30>+270
+ <29_30>+271
+ <29_30>+272
+ <29_30>+273
+ <29_30>+274
+ <29_30>+275
+ <29_30>+276
+ <29_30>+277
+ <29_30>+278
+ <29_30>+279
+ <29_30>+280
+ <29_30>+281
+ <29_30>+282
+ <29_30>+283
+ <29_30>+284
+ <29_30>+285
+ <29_30>+286
+ <29_30>+287
+ <29_30>+288
+ <29_30>+289
+ <29_30>+290
+ <29_30>+291
+ <29_30>+292
+ <29_30>+293
+ <29_30>+294
+ <29_30>+295
+ <29_30>+296
+ <29_30>+297
+ <29_30>+298
+ <29_30>+299
+ <29_30>+300
+ <29_30>+301
+ <29_30>+302
+ <29_30>+303
+ <29_30>+304
+ <29_30>+305
+ <29_30>+306
+ <29_30>+307
+ <29_30>+308
+ <29_30>+309
+ <29_30>+310
+ 1
+ <29_30>+312
+ <29_30>+313
+ <29_30>+314
+ <29_30>+315
+ <29_30>+316
+ <29_30>+317
+ <29_30>+318
+ <29_30>+319
+ <29_30>+320
+ <29_30>+321
+ <29_30>+322
+ <29_30>+323
+ <29_30>+324
+ <29_30>+325
+ <29_30>+326
+ <29_30>+327
+ <29_30>+328
+ <29_30>+329
+ <29_30>+330
+ <29_30>+331
+ <29_30>+332
+ <29_30>+333
+ <29_30>+334
+ <29_30>+335
+ <29_30>+336
+ <29_30>+337
+ <29_30>+338
+ <29_30>+339
+ <29_30>+340
+ <29_30>+341
+ <29_30>+342
+ <29_30>+343
+ <29_30>+344
+ <29_30>+345
+ <29_30>+346
+ <29_30>+347
+ <29_30>+348
+ <29_30>+349
+ <29_30>+350
+ <29_30>+351
+ <29_30>+352
+ <29_30>+353
+ <29_30>+354
+ <29_30>+355
+ <29_30>+356
+ <29_30>+357
+ <29_30>+358
+ <29_30>+359
+ <29_30>+360
+ <29_30>+361
+ <29_30>+362
+ <29_30>+363
+ <29_30>+364
+ <29_30>+365
+ <29_30>+366
+ <29_30>+367
+ <29_30>+368
+ <29_30>+369
+ <29_30>+370
+ <29_30>+371
+ <29_30>+372
+ <29_30>+373
+ <29_30>+374
+ <29_30>+375
+ <29_30>+376
+ <29_30>+377
+ <29_30>+378
+ <29_30>+379
+ <29_30>+380
+ <29_30>+381
+ <29_30>+382
+ <29_30>+383
+ <29_30>+384
+ <29_30>+385
+ <29_30>+386
+ <29_30>+387
+ <29_30>+388
+ <29_30>+389
+ <29_30>+390
+ <29_30>+391
+ <29_30>+392
+ <29_30>+393
+ <29_30>+394
+ <29_30>+395
+ <29_30>+396
+ <29_30>+397
+ <29_30>+398
+ <29_30>+399
+ <29_30>+400
+ <29_30>+401
+ <29_30>+402
+ <29_30>+403
+ <29_30>+404
+ <29_30>+405
+ <29_30>+406
+ <29_30>+407
+ <29_30>+408
+ <29_30>+409
+ <29_30>+410
+ <29_30>+411
+ <29_30>+412
+ <29_30>+413
+ 0
+ 0
+ <30_30>+84
+ 1000
+ <29_30>+418
+ <29_30>+419
+ <29_30>+420
+ <29_30>+421
+ <29_30>+422
+ <29_30>+423
+ <29_30>+424
+ <29_30>+425
+ <29_30>+426
+ <29_30>+427
+ <29_30>+428
+ <29_30>+429
+ <29_30>+430
+ <29_30>+431
+ <29_30>+432
+ <29_30>+433
+ <29_30>+434
+ <29_30>+435
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <29_30>+439
+ <29_30>+440
+ <29_30>+441
+ <30_30>+128
+ <29_30>+443
+ <29_30>+444
+ <30_30>+128
+ <30_30>+128
+ <29_30>+447
+ <29_30>+448
+ <30_30>+128
+ <29_30>+450
+ <29_30>+451
+ <29_30>+452
+ <29_30>+453
+ <29_30>+454
+ <29_30>+455
+ <29_30>+456
+ <29_30>+457
+ extern L3722
+ <9_30>+<1_18>+L3722
+ extern L3735
+ <9_30>+<1_18>+L3735
+ <29_30>+460
+ <29_30>+461
+ <29_30>+462
+ <29_30>+463
+ <29_30>+464
+ <29_30>+465
+ <30_30>+128
+ <29_30>+467
+ <29_30>+468
+ <29_30>+469
+ <29_30>+470
+ <29_30>+471
+ <29_30>+472
+ <29_30>+473
+ <29_30>+474
+ <29_30>+475
+ 1
+ <29_30>+477
+ <29_30>+478
+ <29_30>+479
+ <29_30>+480
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+84
+ <30_30>+84
+ 5
+ 0
+ <29_30>+488
+ <29_30>+489
+ <29_30>+490
+ <29_30>+491
+ <29_30>+492
+ <30_30>+128
+ <30_30>+128
+ <29_30>+495
+ <29_30>+496
+ <29_30>+497
+ <29_30>+498
+ <29_30>+499
+ <30_30>+128
+ <29_30>+501
+ <29_30>+502
+ <29_30>+503
+ <29_30>+504
+ <29_30>+505
+ <29_30>+506
+ <29_30>+507
+ <29_30>+508
+ <29_30>+509
+ <29_30>+510
+ <29_30>+511
+ <29_30>+512
+ <29_30>+513
+ <29_30>+514
+ <29_30>+515
+ <29_30>+516
+ <29_30>+517
+ <29_30>+518
+ <29_30>+519
+ <29_30>+520
+ <29_30>+521
+ <29_30>+522
+ <29_30>+523
+ <29_30>+524
+ <29_30>+525
+ <30_30>+128
+ <29_30>+527
+ <29_30>+528
+ <29_30>+529
+ <29_30>+530
+ <29_30>+531
+ <29_30>+532
+ <29_30>+533
+ <29_30>+534
+ <29_30>+535
+ <29_30>+536
+ <29_30>+537
+ <29_30>+538
+ <30_30>+128
+ <30_30>+128
+ <29_30>+541
+ <29_30>+542
+ <29_30>+543
+ <29_30>+544
+ <29_30>+545
+ extern L3741
+ <9_30>+<1_18>+L3741
+ <29_30>+547
+ <29_30>+548
+ <29_30>+549
+ <29_30>+550
+ <29_30>+551
+ <29_30>+552
+ <29_30>+553
+ <29_30>+554
+ <29_30>+555
+ <29_30>+556
+ <29_30>+557
+ <29_30>+558
+ <29_30>+559
+ <29_30>+560
+ <29_30>+561
+ extern L3745
+ <9_30>+<1_18>+L3745
+ extern L3749
+ <9_30>+<1_18>+L3749
+ <30_30>+128
+ <30_30>+128
+ <29_30>+566
+ <29_30>+567
+ <29_30>+568
+ <29_30>+569
+ <30_30>+128
+ <30_30>+84
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <29_30>+575
+ <29_30>+576
+ <29_30>+577
+ <29_30>+578
+ <29_30>+579
+ <29_30>+580
+ <29_30>+581
+ <29_30>+582
+ <29_30>+583
+ <29_30>+584
+ <29_30>+585
+ <29_30>+586
+ <29_30>+587
+ <29_30>+588
+ <29_30>+589
+ <29_30>+590
+ <29_30>+591
+ <29_30>+592
+ <29_30>+593
+ <29_30>+594
+ <29_30>+595
+ <29_30>+596
+ <30_30>+10
+ <29_30>+598
+ <29_30>+599
+ 0
+ <29_30>+601
+ <29_30>+602
+ <29_30>+603
+ <29_30>+604
+ <29_30>+605
+ <29_30>+606
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <29_30>+610
+ <29_30>+611
+ <29_30>+612
+ <29_30>+613
+ <29_30>+614
+ <30_30>+128
+ 0
+ <30_30>+128
+ 1
+ <29_30>+619
+ <29_30>+620
+ <29_30>+621
+ <29_30>+622
+ <29_30>+623
+ <29_30>+624
+ <29_30>+625
+ <29_30>+626
+ <30_30>+84
+ <29_30>+628
+ <29_30>+629
+ <29_30>+630
+ <30_30>+638
+ <29_30>+632
+ <29_30>+633
+ <30_30>+128
+ extern L3755
+ <8_30>+<1_18>+L3755
+ <29_30>+636
+ extern L3756
+ <8_30>+<1_18>+L3756
+ <29_30>+638
+ <29_30>+639
+ <30_30>+128
+ <29_30>+641
+ <30_30>+26
+ <29_30>+643
+ <29_30>+644
+ <29_30>+645
+ <29_30>+646
+ <30_30>+128
+ <30_30>+128
+ <29_30>+649
+ <29_30>+650
+ <29_30>+651
+ <29_30>+652
+ <29_30>+653
+ <29_30>+654
+ <29_30>+655
+ <29_30>+656
+ <29_30>+657
+ 10
+ 33
+ <29_30>+660
+ <29_30>+661
+ <29_30>+662
+ <29_30>+663
+ <29_30>+664
+ <29_30>+665
+ <29_30>+666
+ <29_30>+667
+ <29_30>+668
+ <29_30>+669
+ <29_30>+670
+ <29_30>+671
+ <29_30>+672
+ <29_30>+673
+ <29_30>+674
+ <29_30>+675
+ <29_30>+676
+ <29_30>+677
+ <30_30>+128
+ <30_30>+128
+ <29_30>+680
+ <29_30>+681
+ <29_30>+682
+ <29_30>+683
+ <29_30>+684
+ <29_30>+685
+ <29_30>+686
+ <29_30>+687
+ <29_30>+688
+ <29_30>+689
+ <29_30>+690
+ <29_30>+691
+ <29_30>+692
+ <30_30>+128
+ <29_30>+694
+ <29_30>+695
+ <29_30>+696
+ <30_30>+128
+ <29_30>+698
+ <29_30>+699
+ <29_30>+700
+ <29_30>+701
+ <30_30>+128
+ <29_30>+703
+ <29_30>+704
+ <29_30>+705
+ <29_30>+706
+ <29_30>+707
+ <29_30>+708
+ <29_30>+709
+ <29_30>+710
+ <29_30>+711
+ <29_30>+712
+ <29_30>+713
+ <29_30>+714
+ <29_30>+715
+ <29_30>+716
+ <29_30>+717
+ <29_30>+718
+ <29_30>+719
+ <29_30>+720
+ <29_30>+721
+ <29_30>+722
+ <29_30>+723
+ <29_30>+724
+ <29_30>+725
+ <29_30>+726
+ <29_30>+727
+ <29_30>+728
+ <29_30>+729
+ <29_30>+730
+ <29_30>+731
+ <29_30>+732
+ <29_30>+733
+ <29_30>+734
+ <30_30>+128
+ <29_30>+736
+ <29_30>+737
+ <29_30>+738
+ <29_30>+739
+ <29_30>+740
+ <29_30>+741
+ <29_30>+742
+ <29_30>+743
+ <29_30>+744
+ <29_30>+745
+ <29_30>+746
+ <29_30>+747
+ <29_30>+748
+ <29_30>+749
+ <29_30>+750
+ <29_30>+751
+ <29_30>+752
+ <29_30>+753
+ <29_30>+754
+ <29_30>+755
+ <29_30>+756
+ <29_30>+757
+ <29_30>+758
+ <29_30>+759
+ <29_30>+760
+ <29_30>+761
+ <29_30>+762
+ <29_30>+763
+ <29_30>+764
+ <29_30>+765
+ <29_30>+766
+ <29_30>+767
+ <29_30>+768
+ <29_30>+769
+ <29_30>+770
+ <29_30>+771
+ <29_30>+772
+ <29_30>+773
+ <29_30>+774
+ <29_30>+775
+ <30_30>+128
+ <29_30>+777
+ <29_30>+778
+ <29_30>+779
+ <29_30>+780
+ <29_30>+781
+ <29_30>+782
+ <29_30>+783
+ <29_30>+784
+ <29_30>+785
+ <29_30>+786
+ <29_30>+787
+ <29_30>+788
+ <29_30>+789
+ <29_30>+790
+ <29_30>+791
+ <29_30>+792
+ <30_30>+128
+ <29_30>+794
+ <29_30>+795
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <29_30>+807
+ <29_30>+808
+ <29_30>+809
+ <29_30>+810
+ <29_30>+811
+ <29_30>+812
+ <29_30>+813
+ <29_30>+814
+ <29_30>+815
+ <29_30>+816
+ -1
+ 0
+ extern L3757
+ <4_30>+<1_18>+L3757
+ <30_30>+84
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <29_30>+824
+ <30_30>+128
+ <29_30>+826
+ <30_30>+128
+ <29_30>+828
+ <29_30>+829
+ <29_30>+830
+ <29_30>+831
+ <29_30>+832
+ <29_30>+833
+ <29_30>+834
+ <29_30>+835
+ <29_30>+836
+ <30_30>+128
+ <29_30>+838
+ <29_30>+839
+ <29_30>+840
+ <29_30>+841
+ <29_30>+842
+ <29_30>+843
+ <29_30>+844
+ <29_30>+845
+ <29_30>+846
+ <29_30>+847
+ <29_30>+848
+ <29_30>+849
+ <29_30>+850
+ <29_30>+851
+ <29_30>+852
+ block 7148
+SYMPRP: intern SYMPRP
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ <30_30>+128
+ block 7148
+SYMNAM: intern SYMNAM
+ extern L3758
+ <4_30>+<1_18>+L3758
+ extern L3759
+ <4_30>+<1_18>+L3759
+ extern L3760
+ <4_30>+<1_18>+L3760
+ extern L3761
+ <4_30>+<1_18>+L3761
+ extern L3762
+ <4_30>+<1_18>+L3762
+ extern L3763
+ <4_30>+<1_18>+L3763
+ extern L3764
+ <4_30>+<1_18>+L3764
+ extern L3765
+ <4_30>+<1_18>+L3765
+ extern L3766
+ <4_30>+<1_18>+L3766
+ extern L3767
+ <4_30>+<1_18>+L3767
+ extern L3768
+ <4_30>+<1_18>+L3768
+ extern L3769
+ <4_30>+<1_18>+L3769
+ extern L3770
+ <4_30>+<1_18>+L3770
+ extern L3771
+ <4_30>+<1_18>+L3771
+ extern L3772
+ <4_30>+<1_18>+L3772
+ extern L3773
+ <4_30>+<1_18>+L3773
+ extern L3774
+ <4_30>+<1_18>+L3774
+ extern L3775
+ <4_30>+<1_18>+L3775
+ extern L3776
+ <4_30>+<1_18>+L3776
+ extern L3777
+ <4_30>+<1_18>+L3777
+ extern L3778
+ <4_30>+<1_18>+L3778
+ extern L3779
+ <4_30>+<1_18>+L3779
+ extern L3780
+ <4_30>+<1_18>+L3780
+ extern L3781
+ <4_30>+<1_18>+L3781
+ extern L3782
+ <4_30>+<1_18>+L3782
+ extern L3783
+ <4_30>+<1_18>+L3783
+ extern L3784
+ <4_30>+<1_18>+L3784
+ extern L3785
+ <4_30>+<1_18>+L3785
+ extern L3786
+ <4_30>+<1_18>+L3786
+ extern L3787
+ <4_30>+<1_18>+L3787
+ extern L3788
+ <4_30>+<1_18>+L3788
+ extern L3789
+ <4_30>+<1_18>+L3789
+ extern L3790
+ <4_30>+<1_18>+L3790
+ extern L3791
+ <4_30>+<1_18>+L3791
+ extern L3792
+ <4_30>+<1_18>+L3792
+ extern L3793
+ <4_30>+<1_18>+L3793
+ extern L3794
+ <4_30>+<1_18>+L3794
+ extern L3795
+ <4_30>+<1_18>+L3795
+ extern L3796
+ <4_30>+<1_18>+L3796
+ extern L3797
+ <4_30>+<1_18>+L3797
+ extern L3798
+ <4_30>+<1_18>+L3798
+ extern L3799
+ <4_30>+<1_18>+L3799
+ extern L3800
+ <4_30>+<1_18>+L3800
+ extern L3801
+ <4_30>+<1_18>+L3801
+ extern L3802
+ <4_30>+<1_18>+L3802
+ extern L3803
+ <4_30>+<1_18>+L3803
+ extern L3804
+ <4_30>+<1_18>+L3804
+ extern L3805
+ <4_30>+<1_18>+L3805
+ extern L3806
+ <4_30>+<1_18>+L3806
+ extern L3807
+ <4_30>+<1_18>+L3807
+ extern L3808
+ <4_30>+<1_18>+L3808
+ extern L3809
+ <4_30>+<1_18>+L3809
+ extern L3810
+ <4_30>+<1_18>+L3810
+ extern L3811
+ <4_30>+<1_18>+L3811
+ extern L3812
+ <4_30>+<1_18>+L3812
+ extern L3813
+ <4_30>+<1_18>+L3813
+ extern L3814
+ <4_30>+<1_18>+L3814
+ extern L3815
+ <4_30>+<1_18>+L3815
+ extern L3816
+ <4_30>+<1_18>+L3816
+ extern L3817
+ <4_30>+<1_18>+L3817
+ extern L3818
+ <4_30>+<1_18>+L3818
+ extern L3819
+ <4_30>+<1_18>+L3819
+ extern L3820
+ <4_30>+<1_18>+L3820
+ extern L3821
+ <4_30>+<1_18>+L3821
+ extern L3822
+ <4_30>+<1_18>+L3822
+ extern L3823
+ <4_30>+<1_18>+L3823
+ extern L3824
+ <4_30>+<1_18>+L3824
+ extern L3825
+ <4_30>+<1_18>+L3825
+ extern L3826
+ <4_30>+<1_18>+L3826
+ extern L3827
+ <4_30>+<1_18>+L3827
+ extern L3828
+ <4_30>+<1_18>+L3828
+ extern L3829
+ <4_30>+<1_18>+L3829
+ extern L3830
+ <4_30>+<1_18>+L3830
+ extern L3831
+ <4_30>+<1_18>+L3831
+ extern L3832
+ <4_30>+<1_18>+L3832
+ extern L3833
+ <4_30>+<1_18>+L3833
+ extern L3834
+ <4_30>+<1_18>+L3834
+ extern L3835
+ <4_30>+<1_18>+L3835
+ extern L3836
+ <4_30>+<1_18>+L3836
+ extern L3837
+ <4_30>+<1_18>+L3837
+ extern L3838
+ <4_30>+<1_18>+L3838
+ extern L3839
+ <4_30>+<1_18>+L3839
+ extern L3840
+ <4_30>+<1_18>+L3840
+ extern L3841
+ <4_30>+<1_18>+L3841
+ extern L3842
+ <4_30>+<1_18>+L3842
+ extern L3843
+ <4_30>+<1_18>+L3843
+ extern L3844
+ <4_30>+<1_18>+L3844
+ extern L3845
+ <4_30>+<1_18>+L3845
+ extern L3846
+ <4_30>+<1_18>+L3846
+ extern L3847
+ <4_30>+<1_18>+L3847
+ extern L3848
+ <4_30>+<1_18>+L3848
+ extern L3849
+ <4_30>+<1_18>+L3849
+ extern L3850
+ <4_30>+<1_18>+L3850
+ extern L3851
+ <4_30>+<1_18>+L3851
+ extern L3852
+ <4_30>+<1_18>+L3852
+ extern L3853
+ <4_30>+<1_18>+L3853
+ extern L3854
+ <4_30>+<1_18>+L3854
+ extern L3855
+ <4_30>+<1_18>+L3855
+ extern L3856
+ <4_30>+<1_18>+L3856
+ extern L3857
+ <4_30>+<1_18>+L3857
+ extern L3858
+ <4_30>+<1_18>+L3858
+ extern L3859
+ <4_30>+<1_18>+L3859
+ extern L3860
+ <4_30>+<1_18>+L3860
+ extern L3861
+ <4_30>+<1_18>+L3861
+ extern L3862
+ <4_30>+<1_18>+L3862
+ extern L3863
+ <4_30>+<1_18>+L3863
+ extern L3864
+ <4_30>+<1_18>+L3864
+ extern L3865
+ <4_30>+<1_18>+L3865
+ extern L3866
+ <4_30>+<1_18>+L3866
+ extern L3867
+ <4_30>+<1_18>+L3867
+ extern L3868
+ <4_30>+<1_18>+L3868
+ extern L3869
+ <4_30>+<1_18>+L3869
+ extern L3870
+ <4_30>+<1_18>+L3870
+ extern L3871
+ <4_30>+<1_18>+L3871
+ extern L3872
+ <4_30>+<1_18>+L3872
+ extern L3873
+ <4_30>+<1_18>+L3873
+ extern L3874
+ <4_30>+<1_18>+L3874
+ extern L3875
+ <4_30>+<1_18>+L3875
+ extern L3876
+ <4_30>+<1_18>+L3876
+ extern L3877
+ <4_30>+<1_18>+L3877
+ extern L3878
+ <4_30>+<1_18>+L3878
+ extern L3879
+ <4_30>+<1_18>+L3879
+ extern L3880
+ <4_30>+<1_18>+L3880
+ extern L3881
+ <4_30>+<1_18>+L3881
+ extern L3882
+ <4_30>+<1_18>+L3882
+ extern L3883
+ <4_30>+<1_18>+L3883
+ extern L3884
+ <4_30>+<1_18>+L3884
+ extern L3885
+ <4_30>+<1_18>+L3885
+ extern L3886
+ <4_30>+<1_18>+L3886
+ extern L3887
+ <4_30>+<1_18>+L3887
+ extern L3888
+ <4_30>+<1_18>+L3888
+ extern L3889
+ <4_30>+<1_18>+L3889
+ extern L3890
+ <4_30>+<1_18>+L3890
+ extern L3891
+ <4_30>+<1_18>+L3891
+ extern L3892
+ <4_30>+<1_18>+L3892
+ extern L3893
+ <4_30>+<1_18>+L3893
+ extern L3894
+ <4_30>+<1_18>+L3894
+ extern L3895
+ <4_30>+<1_18>+L3895
+ extern L3896
+ <4_30>+<1_18>+L3896
+ extern L3897
+ <4_30>+<1_18>+L3897
+ extern L3898
+ <4_30>+<1_18>+L3898
+ extern L3899
+ <4_30>+<1_18>+L3899
+ extern L3900
+ <4_30>+<1_18>+L3900
+ extern L3901
+ <4_30>+<1_18>+L3901
+ extern L3902
+ <4_30>+<1_18>+L3902
+ extern L3903
+ <4_30>+<1_18>+L3903
+ extern L3904
+ <4_30>+<1_18>+L3904
+ extern L3905
+ <4_30>+<1_18>+L3905
+ extern L3906
+ <4_30>+<1_18>+L3906
+ extern L3907
+ <4_30>+<1_18>+L3907
+ extern L3908
+ <4_30>+<1_18>+L3908
+ extern L3909
+ <4_30>+<1_18>+L3909
+ extern L3910
+ <4_30>+<1_18>+L3910
+ extern L3911
+ <4_30>+<1_18>+L3911
+ extern L3912
+ <4_30>+<1_18>+L3912
+ extern L3913
+ <4_30>+<1_18>+L3913
+ extern L3914
+ <4_30>+<1_18>+L3914
+ extern L3915
+ <4_30>+<1_18>+L3915
+ extern L3916
+ <4_30>+<1_18>+L3916
+ extern L3917
+ <4_30>+<1_18>+L3917
+ extern L3918
+ <4_30>+<1_18>+L3918
+ extern L3919
+ <4_30>+<1_18>+L3919
+ extern L3920
+ <4_30>+<1_18>+L3920
+ extern L3921
+ <4_30>+<1_18>+L3921
+ extern L3922
+ <4_30>+<1_18>+L3922
+ extern L3923
+ <4_30>+<1_18>+L3923
+ extern L3924
+ <4_30>+<1_18>+L3924
+ extern L3925
+ <4_30>+<1_18>+L3925
+ extern L3926
+ <4_30>+<1_18>+L3926
+ extern L3927
+ <4_30>+<1_18>+L3927
+ extern L3928
+ <4_30>+<1_18>+L3928
+ extern L3929
+ <4_30>+<1_18>+L3929
+ extern L3930
+ <4_30>+<1_18>+L3930
+ extern L3931
+ <4_30>+<1_18>+L3931
+ extern L3932
+ <4_30>+<1_18>+L3932
+ extern L3933
+ <4_30>+<1_18>+L3933
+ extern L3934
+ <4_30>+<1_18>+L3934
+ extern L3935
+ <4_30>+<1_18>+L3935
+ extern L3936
+ <4_30>+<1_18>+L3936
+ extern L3937
+ <4_30>+<1_18>+L3937
+ extern L3938
+ <4_30>+<1_18>+L3938
+ extern L3939
+ <4_30>+<1_18>+L3939
+ extern L3940
+ <4_30>+<1_18>+L3940
+ extern L3941
+ <4_30>+<1_18>+L3941
+ extern L3942
+ <4_30>+<1_18>+L3942
+ extern L3943
+ <4_30>+<1_18>+L3943
+ extern L3944
+ <4_30>+<1_18>+L3944
+ extern L3945
+ <4_30>+<1_18>+L3945
+ extern L3946
+ <4_30>+<1_18>+L3946
+ extern L3947
+ <4_30>+<1_18>+L3947
+ extern L3948
+ <4_30>+<1_18>+L3948
+ extern L3949
+ <4_30>+<1_18>+L3949
+ extern L3950
+ <4_30>+<1_18>+L3950
+ extern L3951
+ <4_30>+<1_18>+L3951
+ extern L3952
+ <4_30>+<1_18>+L3952
+ extern L3953
+ <4_30>+<1_18>+L3953
+ extern L3954
+ <4_30>+<1_18>+L3954
+ extern L3955
+ <4_30>+<1_18>+L3955
+ extern L3956
+ <4_30>+<1_18>+L3956
+ extern L3957
+ <4_30>+<1_18>+L3957
+ extern L3958
+ <4_30>+<1_18>+L3958
+ extern L3959
+ <4_30>+<1_18>+L3959
+ extern L3960
+ <4_30>+<1_18>+L3960
+ extern L3961
+ <4_30>+<1_18>+L3961
+ extern L3962
+ <4_30>+<1_18>+L3962
+ extern L3963
+ <4_30>+<1_18>+L3963
+ extern L3964
+ <4_30>+<1_18>+L3964
+ extern L3965
+ <4_30>+<1_18>+L3965
+ extern L3966
+ <4_30>+<1_18>+L3966
+ extern L3967
+ <4_30>+<1_18>+L3967
+ extern L3968
+ <4_30>+<1_18>+L3968
+ extern L3969
+ <4_30>+<1_18>+L3969
+ extern L3970
+ <4_30>+<1_18>+L3970
+ extern L3971
+ <4_30>+<1_18>+L3971
+ extern L3972
+ <4_30>+<1_18>+L3972
+ extern L3973
+ <4_30>+<1_18>+L3973
+ extern L3974
+ <4_30>+<1_18>+L3974
+ extern L3975
+ <4_30>+<1_18>+L3975
+ extern L3976
+ <4_30>+<1_18>+L3976
+ extern L3977
+ <4_30>+<1_18>+L3977
+ extern L3978
+ <4_30>+<1_18>+L3978
+ extern L3979
+ <4_30>+<1_18>+L3979
+ extern L3980
+ <4_30>+<1_18>+L3980
+ extern L3981
+ <4_30>+<1_18>+L3981
+ extern L3982
+ <4_30>+<1_18>+L3982
+ extern L3983
+ <4_30>+<1_18>+L3983
+ extern L3984
+ <4_30>+<1_18>+L3984
+ extern L3985
+ <4_30>+<1_18>+L3985
+ extern L3986
+ <4_30>+<1_18>+L3986
+ extern L3987
+ <4_30>+<1_18>+L3987
+ extern L3988
+ <4_30>+<1_18>+L3988
+ extern L3989
+ <4_30>+<1_18>+L3989
+ extern L3990
+ <4_30>+<1_18>+L3990
+ extern L3991
+ <4_30>+<1_18>+L3991
+ extern L3992
+ <4_30>+<1_18>+L3992
+ extern L3993
+ <4_30>+<1_18>+L3993
+ extern L3994
+ <4_30>+<1_18>+L3994
+ extern L3995
+ <4_30>+<1_18>+L3995
+ extern L3996
+ <4_30>+<1_18>+L3996
+ extern L3997
+ <4_30>+<1_18>+L3997
+ extern L3998
+ <4_30>+<1_18>+L3998
+ extern L3999
+ <4_30>+<1_18>+L3999
+ extern L4000
+ <4_30>+<1_18>+L4000
+ extern L4001
+ <4_30>+<1_18>+L4001
+ extern L4002
+ <4_30>+<1_18>+L4002
+ extern L4003
+ <4_30>+<1_18>+L4003
+ extern L4004
+ <4_30>+<1_18>+L4004
+ extern L4005
+ <4_30>+<1_18>+L4005
+ extern L4006
+ <4_30>+<1_18>+L4006
+ extern L4007
+ <4_30>+<1_18>+L4007
+ extern L4008
+ <4_30>+<1_18>+L4008
+ extern L4009
+ <4_30>+<1_18>+L4009
+ extern L4010
+ <4_30>+<1_18>+L4010
+ extern L4011
+ <4_30>+<1_18>+L4011
+ extern L4012
+ <4_30>+<1_18>+L4012
+ extern L4013
+ <4_30>+<1_18>+L4013
+ extern L4014
+ <4_30>+<1_18>+L4014
+ extern L4015
+ <4_30>+<1_18>+L4015
+ extern L4016
+ <4_30>+<1_18>+L4016
+ extern L4017
+ <4_30>+<1_18>+L4017
+ extern L4018
+ <4_30>+<1_18>+L4018
+ extern L4019
+ <4_30>+<1_18>+L4019
+ extern L4020
+ <4_30>+<1_18>+L4020
+ extern L4021
+ <4_30>+<1_18>+L4021
+ extern L4022
+ <4_30>+<1_18>+L4022
+ extern L4023
+ <4_30>+<1_18>+L4023
+ extern L4024
+ <4_30>+<1_18>+L4024
+ extern L4025
+ <4_30>+<1_18>+L4025
+ extern L4026
+ <4_30>+<1_18>+L4026
+ extern L4027
+ <4_30>+<1_18>+L4027
+ extern L4028
+ <4_30>+<1_18>+L4028
+ extern L4029
+ <4_30>+<1_18>+L4029
+ extern L4030
+ <4_30>+<1_18>+L4030
+ extern L4031
+ <4_30>+<1_18>+L4031
+ extern L4032
+ <4_30>+<1_18>+L4032
+ extern L4033
+ <4_30>+<1_18>+L4033
+ extern L4034
+ <4_30>+<1_18>+L4034
+ extern L4035
+ <4_30>+<1_18>+L4035
+ extern L4036
+ <4_30>+<1_18>+L4036
+ extern L4037
+ <4_30>+<1_18>+L4037
+ extern L4038
+ <4_30>+<1_18>+L4038
+ extern L4039
+ <4_30>+<1_18>+L4039
+ extern L4040
+ <4_30>+<1_18>+L4040
+ extern L4041
+ <4_30>+<1_18>+L4041
+ extern L4042
+ <4_30>+<1_18>+L4042
+ extern L4043
+ <4_30>+<1_18>+L4043
+ extern L4044
+ <4_30>+<1_18>+L4044
+ extern L4045
+ <4_30>+<1_18>+L4045
+ extern L4046
+ <4_30>+<1_18>+L4046
+ extern L4047
+ <4_30>+<1_18>+L4047
+ extern L4048
+ <4_30>+<1_18>+L4048
+ extern L4049
+ <4_30>+<1_18>+L4049
+ extern L4050
+ <4_30>+<1_18>+L4050
+ extern L4051
+ <4_30>+<1_18>+L4051
+ extern L4052
+ <4_30>+<1_18>+L4052
+ extern L4053
+ <4_30>+<1_18>+L4053
+ extern L4054
+ <4_30>+<1_18>+L4054
+ extern L4055
+ <4_30>+<1_18>+L4055
+ extern L4056
+ <4_30>+<1_18>+L4056
+ extern L4057
+ <4_30>+<1_18>+L4057
+ extern L4058
+ <4_30>+<1_18>+L4058
+ extern L4059
+ <4_30>+<1_18>+L4059
+ extern L4060
+ <4_30>+<1_18>+L4060
+ extern L4061
+ <4_30>+<1_18>+L4061
+ extern L4062
+ <4_30>+<1_18>+L4062
+ extern L4063
+ <4_30>+<1_18>+L4063
+ extern L4064
+ <4_30>+<1_18>+L4064
+ extern L4065
+ <4_30>+<1_18>+L4065
+ extern L4066
+ <4_30>+<1_18>+L4066
+ extern L4067
+ <4_30>+<1_18>+L4067
+ extern L4068
+ <4_30>+<1_18>+L4068
+ extern L4069
+ <4_30>+<1_18>+L4069
+ extern L4070
+ <4_30>+<1_18>+L4070
+ extern L4071
+ <4_30>+<1_18>+L4071
+ extern L4072
+ <4_30>+<1_18>+L4072
+ extern L4073
+ <4_30>+<1_18>+L4073
+ extern L4074
+ <4_30>+<1_18>+L4074
+ extern L4075
+ <4_30>+<1_18>+L4075
+ extern L4076
+ <4_30>+<1_18>+L4076
+ extern L4077
+ <4_30>+<1_18>+L4077
+ extern L4078
+ <4_30>+<1_18>+L4078
+ extern L4079
+ <4_30>+<1_18>+L4079
+ extern L4080
+ <4_30>+<1_18>+L4080
+ extern L4081
+ <4_30>+<1_18>+L4081
+ extern L4082
+ <4_30>+<1_18>+L4082
+ extern L4083
+ <4_30>+<1_18>+L4083
+ extern L4084
+ <4_30>+<1_18>+L4084
+ extern L4085
+ <4_30>+<1_18>+L4085
+ extern L4086
+ <4_30>+<1_18>+L4086
+ extern L4087
+ <4_30>+<1_18>+L4087
+ extern L4088
+ <4_30>+<1_18>+L4088
+ extern L4089
+ <4_30>+<1_18>+L4089
+ extern L4090
+ <4_30>+<1_18>+L4090
+ extern L4091
+ <4_30>+<1_18>+L4091
+ extern L4092
+ <4_30>+<1_18>+L4092
+ extern L4093
+ <4_30>+<1_18>+L4093
+ extern L4094
+ <4_30>+<1_18>+L4094
+ extern L4095
+ <4_30>+<1_18>+L4095
+ extern L4096
+ <4_30>+<1_18>+L4096
+ extern L4097
+ <4_30>+<1_18>+L4097
+ extern L4098
+ <4_30>+<1_18>+L4098
+ extern L4099
+ <4_30>+<1_18>+L4099
+ extern L4100
+ <4_30>+<1_18>+L4100
+ extern L4101
+ <4_30>+<1_18>+L4101
+ extern L4102
+ <4_30>+<1_18>+L4102
+ extern L4103
+ <4_30>+<1_18>+L4103
+ extern L4104
+ <4_30>+<1_18>+L4104
+ extern L4105
+ <4_30>+<1_18>+L4105
+ extern L4106
+ <4_30>+<1_18>+L4106
+ extern L4107
+ <4_30>+<1_18>+L4107
+ extern L4108
+ <4_30>+<1_18>+L4108
+ extern L4109
+ <4_30>+<1_18>+L4109
+ extern L4110
+ <4_30>+<1_18>+L4110
+ extern L4111
+ <4_30>+<1_18>+L4111
+ extern L4112
+ <4_30>+<1_18>+L4112
+ extern L4113
+ <4_30>+<1_18>+L4113
+ extern L4114
+ <4_30>+<1_18>+L4114
+ extern L4115
+ <4_30>+<1_18>+L4115
+ extern L4116
+ <4_30>+<1_18>+L4116
+ extern L4117
+ <4_30>+<1_18>+L4117
+ extern L4118
+ <4_30>+<1_18>+L4118
+ extern L4119
+ <4_30>+<1_18>+L4119
+ extern L4120
+ <4_30>+<1_18>+L4120
+ extern L4121
+ <4_30>+<1_18>+L4121
+ extern L4122
+ <4_30>+<1_18>+L4122
+ extern L4123
+ <4_30>+<1_18>+L4123
+ extern L4124
+ <4_30>+<1_18>+L4124
+ extern L4125
+ <4_30>+<1_18>+L4125
+ extern L4126
+ <4_30>+<1_18>+L4126
+ extern L4127
+ <4_30>+<1_18>+L4127
+ extern L4128
+ <4_30>+<1_18>+L4128
+ extern L4129
+ <4_30>+<1_18>+L4129
+ extern L4130
+ <4_30>+<1_18>+L4130
+ extern L4131
+ <4_30>+<1_18>+L4131
+ extern L4132
+ <4_30>+<1_18>+L4132
+ extern L4133
+ <4_30>+<1_18>+L4133
+ extern L4134
+ <4_30>+<1_18>+L4134
+ extern L4135
+ <4_30>+<1_18>+L4135
+ extern L4136
+ <4_30>+<1_18>+L4136
+ extern L4137
+ <4_30>+<1_18>+L4137
+ extern L4138
+ <4_30>+<1_18>+L4138
+ extern L4139
+ <4_30>+<1_18>+L4139
+ extern L4140
+ <4_30>+<1_18>+L4140
+ extern L4141
+ <4_30>+<1_18>+L4141
+ extern L4142
+ <4_30>+<1_18>+L4142
+ extern L4143
+ <4_30>+<1_18>+L4143
+ extern L4144
+ <4_30>+<1_18>+L4144
+ extern L4145
+ <4_30>+<1_18>+L4145
+ extern L4146
+ <4_30>+<1_18>+L4146
+ extern L4147
+ <4_30>+<1_18>+L4147
+ extern L4148
+ <4_30>+<1_18>+L4148
+ extern L4149
+ <4_30>+<1_18>+L4149
+ extern L4150
+ <4_30>+<1_18>+L4150
+ extern L4151
+ <4_30>+<1_18>+L4151
+ extern L4152
+ <4_30>+<1_18>+L4152
+ extern L4153
+ <4_30>+<1_18>+L4153
+ extern L4154
+ <4_30>+<1_18>+L4154
+ extern L4155
+ <4_30>+<1_18>+L4155
+ extern L4156
+ <4_30>+<1_18>+L4156
+ extern L4157
+ <4_30>+<1_18>+L4157
+ extern L4158
+ <4_30>+<1_18>+L4158
+ extern L4159
+ <4_30>+<1_18>+L4159
+ extern L4160
+ <4_30>+<1_18>+L4160
+ extern L4161
+ <4_30>+<1_18>+L4161
+ extern L4162
+ <4_30>+<1_18>+L4162
+ extern L4163
+ <4_30>+<1_18>+L4163
+ extern L4164
+ <4_30>+<1_18>+L4164
+ extern L4165
+ <4_30>+<1_18>+L4165
+ extern L4166
+ <4_30>+<1_18>+L4166
+ extern L4167
+ <4_30>+<1_18>+L4167
+ extern L4168
+ <4_30>+<1_18>+L4168
+ extern L4169
+ <4_30>+<1_18>+L4169
+ extern L4170
+ <4_30>+<1_18>+L4170
+ extern L4171
+ <4_30>+<1_18>+L4171
+ extern L4172
+ <4_30>+<1_18>+L4172
+ extern L4173
+ <4_30>+<1_18>+L4173
+ extern L4174
+ <4_30>+<1_18>+L4174
+ extern L4175
+ <4_30>+<1_18>+L4175
+ extern L4176
+ <4_30>+<1_18>+L4176
+ extern L4177
+ <4_30>+<1_18>+L4177
+ extern L4178
+ <4_30>+<1_18>+L4178
+ extern L4179
+ <4_30>+<1_18>+L4179
+ extern L4180
+ <4_30>+<1_18>+L4180
+ extern L4181
+ <4_30>+<1_18>+L4181
+ extern L4182
+ <4_30>+<1_18>+L4182
+ extern L4183
+ <4_30>+<1_18>+L4183
+ extern L4184
+ <4_30>+<1_18>+L4184
+ extern L4185
+ <4_30>+<1_18>+L4185
+ extern L4186
+ <4_30>+<1_18>+L4186
+ extern L4187
+ <4_30>+<1_18>+L4187
+ extern L4188
+ <4_30>+<1_18>+L4188
+ extern L4189
+ <4_30>+<1_18>+L4189
+ extern L4190
+ <4_30>+<1_18>+L4190
+ extern L4191
+ <4_30>+<1_18>+L4191
+ extern L4192
+ <4_30>+<1_18>+L4192
+ extern L4193
+ <4_30>+<1_18>+L4193
+ extern L4194
+ <4_30>+<1_18>+L4194
+ extern L4195
+ <4_30>+<1_18>+L4195
+ extern L4196
+ <4_30>+<1_18>+L4196
+ extern L4197
+ <4_30>+<1_18>+L4197
+ extern L4198
+ <4_30>+<1_18>+L4198
+ extern L4199
+ <4_30>+<1_18>+L4199
+ extern L4200
+ <4_30>+<1_18>+L4200
+ extern L4201
+ <4_30>+<1_18>+L4201
+ extern L4202
+ <4_30>+<1_18>+L4202
+ extern L4203
+ <4_30>+<1_18>+L4203
+ extern L4204
+ <4_30>+<1_18>+L4204
+ extern L4205
+ <4_30>+<1_18>+L4205
+ extern L4206
+ <4_30>+<1_18>+L4206
+ extern L4207
+ <4_30>+<1_18>+L4207
+ extern L4208
+ <4_30>+<1_18>+L4208
+ extern L4209
+ <4_30>+<1_18>+L4209
+ extern L4210
+ <4_30>+<1_18>+L4210
+ extern L4211
+ <4_30>+<1_18>+L4211
+ extern L4212
+ <4_30>+<1_18>+L4212
+ extern L4213
+ <4_30>+<1_18>+L4213
+ extern L4214
+ <4_30>+<1_18>+L4214
+ extern L4215
+ <4_30>+<1_18>+L4215
+ extern L4216
+ <4_30>+<1_18>+L4216
+ extern L4217
+ <4_30>+<1_18>+L4217
+ extern L4218
+ <4_30>+<1_18>+L4218
+ extern L4219
+ <4_30>+<1_18>+L4219
+ extern L4220
+ <4_30>+<1_18>+L4220
+ extern L4221
+ <4_30>+<1_18>+L4221
+ extern L4222
+ <4_30>+<1_18>+L4222
+ extern L4223
+ <4_30>+<1_18>+L4223
+ extern L4224
+ <4_30>+<1_18>+L4224
+ extern L4225
+ <4_30>+<1_18>+L4225
+ extern L4226
+ <4_30>+<1_18>+L4226
+ extern L4227
+ <4_30>+<1_18>+L4227
+ extern L4228
+ <4_30>+<1_18>+L4228
+ extern L4229
+ <4_30>+<1_18>+L4229
+ extern L4230
+ <4_30>+<1_18>+L4230
+ extern L4231
+ <4_30>+<1_18>+L4231
+ extern L4232
+ <4_30>+<1_18>+L4232
+ extern L4233
+ <4_30>+<1_18>+L4233
+ extern L4234
+ <4_30>+<1_18>+L4234
+ extern L4235
+ <4_30>+<1_18>+L4235
+ extern L4236
+ <4_30>+<1_18>+L4236
+ extern L4237
+ <4_30>+<1_18>+L4237
+ extern L4238
+ <4_30>+<1_18>+L4238
+ extern L4239
+ <4_30>+<1_18>+L4239
+ extern L4240
+ <4_30>+<1_18>+L4240
+ extern L4241
+ <4_30>+<1_18>+L4241
+ extern L4242
+ <4_30>+<1_18>+L4242
+ extern L4243
+ <4_30>+<1_18>+L4243
+ extern L4244
+ <4_30>+<1_18>+L4244
+ extern L4245
+ <4_30>+<1_18>+L4245
+ extern L4246
+ <4_30>+<1_18>+L4246
+ extern L4247
+ <4_30>+<1_18>+L4247
+ extern L4248
+ <4_30>+<1_18>+L4248
+ extern L4249
+ <4_30>+<1_18>+L4249
+ extern L4250
+ <4_30>+<1_18>+L4250
+ extern L4251
+ <4_30>+<1_18>+L4251
+ extern L4252
+ <4_30>+<1_18>+L4252
+ extern L4253
+ <4_30>+<1_18>+L4253
+ extern L4254
+ <4_30>+<1_18>+L4254
+ extern L4255
+ <4_30>+<1_18>+L4255
+ extern L4256
+ <4_30>+<1_18>+L4256
+ extern L4257
+ <4_30>+<1_18>+L4257
+ extern L4258
+ <4_30>+<1_18>+L4258
+ extern L4259
+ <4_30>+<1_18>+L4259
+ extern L4260
+ <4_30>+<1_18>+L4260
+ extern L4261
+ <4_30>+<1_18>+L4261
+ extern L4262
+ <4_30>+<1_18>+L4262
+ extern L4263
+ <4_30>+<1_18>+L4263
+ extern L4264
+ <4_30>+<1_18>+L4264
+ extern L4265
+ <4_30>+<1_18>+L4265
+ extern L4266
+ <4_30>+<1_18>+L4266
+ extern L4267
+ <4_30>+<1_18>+L4267
+ extern L4268
+ <4_30>+<1_18>+L4268
+ extern L4269
+ <4_30>+<1_18>+L4269
+ extern L4270
+ <4_30>+<1_18>+L4270
+ extern L4271
+ <4_30>+<1_18>+L4271
+ extern L4272
+ <4_30>+<1_18>+L4272
+ extern L4273
+ <4_30>+<1_18>+L4273
+ extern L4274
+ <4_30>+<1_18>+L4274
+ extern L4275
+ <4_30>+<1_18>+L4275
+ extern L4276
+ <4_30>+<1_18>+L4276
+ extern L4277
+ <4_30>+<1_18>+L4277
+ extern L4278
+ <4_30>+<1_18>+L4278
+ extern L4279
+ <4_30>+<1_18>+L4279
+ extern L4280
+ <4_30>+<1_18>+L4280
+ extern L4281
+ <4_30>+<1_18>+L4281
+ extern L4282
+ <4_30>+<1_18>+L4282
+ extern L4283
+ <4_30>+<1_18>+L4283
+ extern L4284
+ <4_30>+<1_18>+L4284
+ extern L4285
+ <4_30>+<1_18>+L4285
+ extern L4286
+ <4_30>+<1_18>+L4286
+ extern L4287
+ <4_30>+<1_18>+L4287
+ extern L4288
+ <4_30>+<1_18>+L4288
+ extern L4289
+ <4_30>+<1_18>+L4289
+ extern L4290
+ <4_30>+<1_18>+L4290
+ extern L4291
+ <4_30>+<1_18>+L4291
+ extern L4292
+ <4_30>+<1_18>+L4292
+ extern L4293
+ <4_30>+<1_18>+L4293
+ extern L4294
+ <4_30>+<1_18>+L4294
+ extern L4295
+ <4_30>+<1_18>+L4295
+ extern L4296
+ <4_30>+<1_18>+L4296
+ extern L4297
+ <4_30>+<1_18>+L4297
+ extern L4298
+ <4_30>+<1_18>+L4298
+ extern L4299
+ <4_30>+<1_18>+L4299
+ extern L4300
+ <4_30>+<1_18>+L4300
+ extern L4301
+ <4_30>+<1_18>+L4301
+ extern L4302
+ <4_30>+<1_18>+L4302
+ extern L4303
+ <4_30>+<1_18>+L4303
+ extern L4304
+ <4_30>+<1_18>+L4304
+ extern L4305
+ <4_30>+<1_18>+L4305
+ extern L4306
+ <4_30>+<1_18>+L4306
+ extern L4307
+ <4_30>+<1_18>+L4307
+ extern L4308
+ <4_30>+<1_18>+L4308
+ extern L4309
+ <4_30>+<1_18>+L4309
+ extern L4310
+ <4_30>+<1_18>+L4310
+ extern L4311
+ <4_30>+<1_18>+L4311
+ extern L4312
+ <4_30>+<1_18>+L4312
+ extern L4313
+ <4_30>+<1_18>+L4313
+ extern L4314
+ <4_30>+<1_18>+L4314
+ extern L4315
+ <4_30>+<1_18>+L4315
+ extern L4316
+ <4_30>+<1_18>+L4316
+ extern L4317
+ <4_30>+<1_18>+L4317
+ extern L4318
+ <4_30>+<1_18>+L4318
+ extern L4319
+ <4_30>+<1_18>+L4319
+ extern L4320
+ <4_30>+<1_18>+L4320
+ extern L4321
+ <4_30>+<1_18>+L4321
+ extern L4322
+ <4_30>+<1_18>+L4322
+ extern L4323
+ <4_30>+<1_18>+L4323
+ extern L4324
+ <4_30>+<1_18>+L4324
+ extern L4325
+ <4_30>+<1_18>+L4325
+ extern L4326
+ <4_30>+<1_18>+L4326
+ extern L4327
+ <4_30>+<1_18>+L4327
+ extern L4328
+ <4_30>+<1_18>+L4328
+ extern L4329
+ <4_30>+<1_18>+L4329
+ extern L4330
+ <4_30>+<1_18>+L4330
+ extern L4331
+ <4_30>+<1_18>+L4331
+ extern L4332
+ <4_30>+<1_18>+L4332
+ extern L4333
+ <4_30>+<1_18>+L4333
+ extern L4334
+ <4_30>+<1_18>+L4334
+ extern L4335
+ <4_30>+<1_18>+L4335
+ extern L4336
+ <4_30>+<1_18>+L4336
+ extern L4337
+ <4_30>+<1_18>+L4337
+ extern L4338
+ <4_30>+<1_18>+L4338
+ extern L4339
+ <4_30>+<1_18>+L4339
+ extern L4340
+ <4_30>+<1_18>+L4340
+ extern L4341
+ <4_30>+<1_18>+L4341
+ extern L4342
+ <4_30>+<1_18>+L4342
+ extern L4343
+ <4_30>+<1_18>+L4343
+ extern L4344
+ <4_30>+<1_18>+L4344
+ extern L4345
+ <4_30>+<1_18>+L4345
+ extern L4346
+ <4_30>+<1_18>+L4346
+ extern L4347
+ <4_30>+<1_18>+L4347
+ extern L4348
+ <4_30>+<1_18>+L4348
+ extern L4349
+ <4_30>+<1_18>+L4349
+ extern L4350
+ <4_30>+<1_18>+L4350
+ extern L4351
+ <4_30>+<1_18>+L4351
+ extern L4352
+ <4_30>+<1_18>+L4352
+ extern L4353
+ <4_30>+<1_18>+L4353
+ extern L4354
+ <4_30>+<1_18>+L4354
+ extern L4355
+ <4_30>+<1_18>+L4355
+ extern L4356
+ <4_30>+<1_18>+L4356
+ extern L4357
+ <4_30>+<1_18>+L4357
+ extern L4358
+ <4_30>+<1_18>+L4358
+ extern L4359
+ <4_30>+<1_18>+L4359
+ extern L4360
+ <4_30>+<1_18>+L4360
+ extern L4361
+ <4_30>+<1_18>+L4361
+ extern L4362
+ <4_30>+<1_18>+L4362
+ extern L4363
+ <4_30>+<1_18>+L4363
+ extern L4364
+ <4_30>+<1_18>+L4364
+ extern L4365
+ <4_30>+<1_18>+L4365
+ extern L4366
+ <4_30>+<1_18>+L4366
+ extern L4367
+ <4_30>+<1_18>+L4367
+ extern L4368
+ <4_30>+<1_18>+L4368
+ extern L4369
+ <4_30>+<1_18>+L4369
+ extern L4370
+ <4_30>+<1_18>+L4370
+ extern L4371
+ <4_30>+<1_18>+L4371
+ extern L4372
+ <4_30>+<1_18>+L4372
+ extern L4373
+ <4_30>+<1_18>+L4373
+ extern L4374
+ <4_30>+<1_18>+L4374
+ extern L4375
+ <4_30>+<1_18>+L4375
+ extern L4376
+ <4_30>+<1_18>+L4376
+ extern L4377
+ <4_30>+<1_18>+L4377
+ extern L4378
+ <4_30>+<1_18>+L4378
+ extern L4379
+ <4_30>+<1_18>+L4379
+ extern L4380
+ <4_30>+<1_18>+L4380
+ extern L4381
+ <4_30>+<1_18>+L4381
+ extern L4382
+ <4_30>+<1_18>+L4382
+ extern L4383
+ <4_30>+<1_18>+L4383
+ extern L4384
+ <4_30>+<1_18>+L4384
+ extern L4385
+ <4_30>+<1_18>+L4385
+ extern L4386
+ <4_30>+<1_18>+L4386
+ extern L4387
+ <4_30>+<1_18>+L4387
+ extern L4388
+ <4_30>+<1_18>+L4388
+ extern L4389
+ <4_30>+<1_18>+L4389
+ extern L4390
+ <4_30>+<1_18>+L4390
+ extern L4391
+ <4_30>+<1_18>+L4391
+ extern L4392
+ <4_30>+<1_18>+L4392
+ extern L4393
+ <4_30>+<1_18>+L4393
+ extern L4394
+ <4_30>+<1_18>+L4394
+ extern L4395
+ <4_30>+<1_18>+L4395
+ extern L4396
+ <4_30>+<1_18>+L4396
+ extern L4397
+ <4_30>+<1_18>+L4397
+ extern L4398
+ <4_30>+<1_18>+L4398
+ extern L4399
+ <4_30>+<1_18>+L4399
+ extern L4400
+ <4_30>+<1_18>+L4400
+ extern L4401
+ <4_30>+<1_18>+L4401
+ extern L4402
+ <4_30>+<1_18>+L4402
+ extern L4403
+ <4_30>+<1_18>+L4403
+ extern L4404
+ <4_30>+<1_18>+L4404
+ extern L4405
+ <4_30>+<1_18>+L4405
+ extern L4406
+ <4_30>+<1_18>+L4406
+ extern L4407
+ <4_30>+<1_18>+L4407
+ extern L4408
+ <4_30>+<1_18>+L4408
+ extern L4409
+ <4_30>+<1_18>+L4409
+ extern L4410
+ <4_30>+<1_18>+L4410
+ extern L4411
+ <4_30>+<1_18>+L4411
+ extern L4412
+ <4_30>+<1_18>+L4412
+ extern L4413
+ <4_30>+<1_18>+L4413
+ extern L4414
+ <4_30>+<1_18>+L4414
+ extern L4415
+ <4_30>+<1_18>+L4415
+ extern L4416
+ <4_30>+<1_18>+L4416
+ extern L4417
+ <4_30>+<1_18>+L4417
+ extern L4418
+ <4_30>+<1_18>+L4418
+ extern L4419
+ <4_30>+<1_18>+L4419
+ extern L4420
+ <4_30>+<1_18>+L4420
+ extern L4421
+ <4_30>+<1_18>+L4421
+ extern L4422
+ <4_30>+<1_18>+L4422
+ extern L4423
+ <4_30>+<1_18>+L4423
+ extern L4424
+ <4_30>+<1_18>+L4424
+ extern L4425
+ <4_30>+<1_18>+L4425
+ extern L4426
+ <4_30>+<1_18>+L4426
+ extern L4427
+ <4_30>+<1_18>+L4427
+ extern L4428
+ <4_30>+<1_18>+L4428
+ extern L4429
+ <4_30>+<1_18>+L4429
+ extern L4430
+ <4_30>+<1_18>+L4430
+ extern L4431
+ <4_30>+<1_18>+L4431
+ extern L4432
+ <4_30>+<1_18>+L4432
+ extern L4433
+ <4_30>+<1_18>+L4433
+ extern L4434
+ <4_30>+<1_18>+L4434
+ extern L4435
+ <4_30>+<1_18>+L4435
+ extern L4436
+ <4_30>+<1_18>+L4436
+ extern L4437
+ <4_30>+<1_18>+L4437
+ extern L4438
+ <4_30>+<1_18>+L4438
+ extern L4439
+ <4_30>+<1_18>+L4439
+ extern L4440
+ <4_30>+<1_18>+L4440
+ extern L4441
+ <4_30>+<1_18>+L4441
+ extern L4442
+ <4_30>+<1_18>+L4442
+ extern L4443
+ <4_30>+<1_18>+L4443
+ extern L4444
+ <4_30>+<1_18>+L4444
+ extern L4445
+ <4_30>+<1_18>+L4445
+ extern L4446
+ <4_30>+<1_18>+L4446
+ extern L4447
+ <4_30>+<1_18>+L4447
+ extern L4448
+ <4_30>+<1_18>+L4448
+ extern L4449
+ <4_30>+<1_18>+L4449
+ extern L4450
+ <4_30>+<1_18>+L4450
+ extern L4451
+ <4_30>+<1_18>+L4451
+ extern L4452
+ <4_30>+<1_18>+L4452
+ extern L4453
+ <4_30>+<1_18>+L4453
+ extern L4454
+ <4_30>+<1_18>+L4454
+ extern L4455
+ <4_30>+<1_18>+L4455
+ extern L4456
+ <4_30>+<1_18>+L4456
+ extern L4457
+ <4_30>+<1_18>+L4457
+ extern L4458
+ <4_30>+<1_18>+L4458
+ extern L4459
+ <4_30>+<1_18>+L4459
+ extern L4460
+ <4_30>+<1_18>+L4460
+ extern L4461
+ <4_30>+<1_18>+L4461
+ extern L4462
+ <4_30>+<1_18>+L4462
+ extern L4463
+ <4_30>+<1_18>+L4463
+ extern L4464
+ <4_30>+<1_18>+L4464
+ extern L4465
+ <4_30>+<1_18>+L4465
+ extern L4466
+ <4_30>+<1_18>+L4466
+ extern L4467
+ <4_30>+<1_18>+L4467
+ extern L4468
+ <4_30>+<1_18>+L4468
+ extern L4469
+ <4_30>+<1_18>+L4469
+ extern L4470
+ <4_30>+<1_18>+L4470
+ extern L4471
+ <4_30>+<1_18>+L4471
+ extern L4472
+ <4_30>+<1_18>+L4472
+ extern L4473
+ <4_30>+<1_18>+L4473
+ extern L4474
+ <4_30>+<1_18>+L4474
+ extern L4475
+ <4_30>+<1_18>+L4475
+ extern L4476
+ <4_30>+<1_18>+L4476
+ extern L4477
+ <4_30>+<1_18>+L4477
+ extern L4478
+ <4_30>+<1_18>+L4478
+ extern L4479
+ <4_30>+<1_18>+L4479
+ extern L4480
+ <4_30>+<1_18>+L4480
+ extern L4481
+ <4_30>+<1_18>+L4481
+ extern L4482
+ <4_30>+<1_18>+L4482
+ extern L4483
+ <4_30>+<1_18>+L4483
+ extern L4484
+ <4_30>+<1_18>+L4484
+ extern L4485
+ <4_30>+<1_18>+L4485
+ extern L4486
+ <4_30>+<1_18>+L4486
+ extern L4487
+ <4_30>+<1_18>+L4487
+ extern L4488
+ <4_30>+<1_18>+L4488
+ extern L4489
+ <4_30>+<1_18>+L4489
+ extern L4490
+ <4_30>+<1_18>+L4490
+ extern L4491
+ <4_30>+<1_18>+L4491
+ extern L4492
+ <4_30>+<1_18>+L4492
+ extern L4493
+ <4_30>+<1_18>+L4493
+ extern L4494
+ <4_30>+<1_18>+L4494
+ extern L4495
+ <4_30>+<1_18>+L4495
+ extern L4496
+ <4_30>+<1_18>+L4496
+ extern L4497
+ <4_30>+<1_18>+L4497
+ extern L4498
+ <4_30>+<1_18>+L4498
+ extern L4499
+ <4_30>+<1_18>+L4499
+ extern L4500
+ <4_30>+<1_18>+L4500
+ extern L4501
+ <4_30>+<1_18>+L4501
+ extern L4502
+ <4_30>+<1_18>+L4502
+ extern L4503
+ <4_30>+<1_18>+L4503
+ extern L4504
+ <4_30>+<1_18>+L4504
+ extern L4505
+ <4_30>+<1_18>+L4505
+ extern L4506
+ <4_30>+<1_18>+L4506
+ extern L4507
+ <4_30>+<1_18>+L4507
+ extern L4508
+ <4_30>+<1_18>+L4508
+ extern L4509
+ <4_30>+<1_18>+L4509
+ extern L4510
+ <4_30>+<1_18>+L4510
+ extern L4511
+ <4_30>+<1_18>+L4511
+ extern L4512
+ <4_30>+<1_18>+L4512
+ extern L4513
+ <4_30>+<1_18>+L4513
+ extern L4514
+ <4_30>+<1_18>+L4514
+ extern L4515
+ <4_30>+<1_18>+L4515
+ extern L4516
+ <4_30>+<1_18>+L4516
+ extern L4517
+ <4_30>+<1_18>+L4517
+ extern L4518
+ <4_30>+<1_18>+L4518
+ extern L4519
+ <4_30>+<1_18>+L4519
+ extern L4520
+ <4_30>+<1_18>+L4520
+ extern L4521
+ <4_30>+<1_18>+L4521
+ extern L4522
+ <4_30>+<1_18>+L4522
+ extern L4523
+ <4_30>+<1_18>+L4523
+ extern L4524
+ <4_30>+<1_18>+L4524
+ extern L4525
+ <4_30>+<1_18>+L4525
+ extern L4526
+ <4_30>+<1_18>+L4526
+ extern L4527
+ <4_30>+<1_18>+L4527
+ extern L4528
+ <4_30>+<1_18>+L4528
+ extern L4529
+ <4_30>+<1_18>+L4529
+ extern L4530
+ <4_30>+<1_18>+L4530
+ extern L4531
+ <4_30>+<1_18>+L4531
+ extern L4532
+ <4_30>+<1_18>+L4532
+ extern L4533
+ <4_30>+<1_18>+L4533
+ extern L4534
+ <4_30>+<1_18>+L4534
+ extern L4535
+ <4_30>+<1_18>+L4535
+ extern L4536
+ <4_30>+<1_18>+L4536
+ extern L4537
+ <4_30>+<1_18>+L4537
+ extern L4538
+ <4_30>+<1_18>+L4538
+ extern L4539
+ <4_30>+<1_18>+L4539
+ extern L4540
+ <4_30>+<1_18>+L4540
+ extern L4541
+ <4_30>+<1_18>+L4541
+ extern L4542
+ <4_30>+<1_18>+L4542
+ extern L4543
+ <4_30>+<1_18>+L4543
+ extern L4544
+ <4_30>+<1_18>+L4544
+ extern L4545
+ <4_30>+<1_18>+L4545
+ extern L4546
+ <4_30>+<1_18>+L4546
+ extern L4547
+ <4_30>+<1_18>+L4547
+ extern L4548
+ <4_30>+<1_18>+L4548
+ extern L4549
+ <4_30>+<1_18>+L4549
+ extern L4550
+ <4_30>+<1_18>+L4550
+ extern L4551
+ <4_30>+<1_18>+L4551
+ extern L4552
+ <4_30>+<1_18>+L4552
+ extern L4553
+ <4_30>+<1_18>+L4553
+ extern L4554
+ <4_30>+<1_18>+L4554
+ extern L4555
+ <4_30>+<1_18>+L4555
+ extern L4556
+ <4_30>+<1_18>+L4556
+ extern L4557
+ <4_30>+<1_18>+L4557
+ extern L4558
+ <4_30>+<1_18>+L4558
+ extern L4559
+ <4_30>+<1_18>+L4559
+ extern L4560
+ <4_30>+<1_18>+L4560
+ extern L4561
+ <4_30>+<1_18>+L4561
+ extern L4562
+ <4_30>+<1_18>+L4562
+ extern L4563
+ <4_30>+<1_18>+L4563
+ extern L4564
+ <4_30>+<1_18>+L4564
+ extern L4565
+ <4_30>+<1_18>+L4565
+ extern L4566
+ <4_30>+<1_18>+L4566
+ extern L4567
+ <4_30>+<1_18>+L4567
+ extern L4568
+ <4_30>+<1_18>+L4568
+ extern L4569
+ <4_30>+<1_18>+L4569
+ extern L4570
+ <4_30>+<1_18>+L4570
+ extern L4571
+ <4_30>+<1_18>+L4571
+ extern L4572
+ <4_30>+<1_18>+L4572
+ extern L4573
+ <4_30>+<1_18>+L4573
+ extern L4574
+ <4_30>+<1_18>+L4574
+ extern L4575
+ <4_30>+<1_18>+L4575
+ extern L4576
+ <4_30>+<1_18>+L4576
+ extern L4577
+ <4_30>+<1_18>+L4577
+ extern L4578
+ <4_30>+<1_18>+L4578
+ extern L4579
+ <4_30>+<1_18>+L4579
+ extern L4580
+ <4_30>+<1_18>+L4580
+ extern L4581
+ <4_30>+<1_18>+L4581
+ extern L4582
+ <4_30>+<1_18>+L4582
+ extern L4583
+ <4_30>+<1_18>+L4583
+ extern L4584
+ <4_30>+<1_18>+L4584
+ extern L4585
+ <4_30>+<1_18>+L4585
+ extern L4586
+ <4_30>+<1_18>+L4586
+ extern L4587
+ <4_30>+<1_18>+L4587
+ extern L4588
+ <4_30>+<1_18>+L4588
+ extern L4589
+ <4_30>+<1_18>+L4589
+ extern L4590
+ <4_30>+<1_18>+L4590
+ extern L4591
+ <4_30>+<1_18>+L4591
+ extern L4592
+ <4_30>+<1_18>+L4592
+ extern L4593
+ <4_30>+<1_18>+L4593
+ extern L4594
+ <4_30>+<1_18>+L4594
+ extern L4595
+ <4_30>+<1_18>+L4595
+ extern L4596
+ <4_30>+<1_18>+L4596
+ extern L4597
+ <4_30>+<1_18>+L4597
+ extern L4598
+ <4_30>+<1_18>+L4598
+ extern L4599
+ <4_30>+<1_18>+L4599
+ extern L4600
+ <4_30>+<1_18>+L4600
+ extern L4601
+ <4_30>+<1_18>+L4601
+ extern L4602
+ <4_30>+<1_18>+L4602
+ extern L4603
+ <4_30>+<1_18>+L4603
+ extern L4604
+ <4_30>+<1_18>+L4604
+ extern L4605
+ <4_30>+<1_18>+L4605
+ extern L4606
+ <4_30>+<1_18>+L4606
+ extern L4607
+ <4_30>+<1_18>+L4607
+ extern L4608
+ <4_30>+<1_18>+L4608
+ extern L4609
+ <4_30>+<1_18>+L4609
+ extern L4610
+ <4_30>+<1_18>+L4610
+ 854
+ 855
+ 856
+ 857
+ 858
+ 859
+ 860
+ 861
+ 862
+ 863
+ 864
+ 865
+ 866
+ 867
+ 868
+ 869
+ 870
+ 871
+ 872
+ 873
+ 874
+ 875
+ 876
+ 877
+ 878
+ 879
+ 880
+ 881
+ 882
+ 883
+ 884
+ 885
+ 886
+ 887
+ 888
+ 889
+ 890
+ 891
+ 892
+ 893
+ 894
+ 895
+ 896
+ 897
+ 898
+ 899
+ 900
+ 901
+ 902
+ 903
+ 904
+ 905
+ 906
+ 907
+ 908
+ 909
+ 910
+ 911
+ 912
+ 913
+ 914
+ 915
+ 916
+ 917
+ 918
+ 919
+ 920
+ 921
+ 922
+ 923
+ 924
+ 925
+ 926
+ 927
+ 928
+ 929
+ 930
+ 931
+ 932
+ 933
+ 934
+ 935
+ 936
+ 937
+ 938
+ 939
+ 940
+ 941
+ 942
+ 943
+ 944
+ 945
+ 946
+ 947
+ 948
+ 949
+ 950
+ 951
+ 952
+ 953
+ 954
+ 955
+ 956
+ 957
+ 958
+ 959
+ 960
+ 961
+ 962
+ 963
+ 964
+ 965
+ 966
+ 967
+ 968
+ 969
+ 970
+ 971
+ 972
+ 973
+ 974
+ 975
+ 976
+ 977
+ 978
+ 979
+ 980
+ 981
+ 982
+ 983
+ 984
+ 985
+ 986
+ 987
+ 988
+ 989
+ 990
+ 991
+ 992
+ 993
+ 994
+ 995
+ 996
+ 997
+ 998
+ 999
+ 1000
+ 1001
+ 1002
+ 1003
+ 1004
+ 1005
+ 1006
+ 1007
+ 1008
+ 1009
+ 1010
+ 1011
+ 1012
+ 1013
+ 1014
+ 1015
+ 1016
+ 1017
+ 1018
+ 1019
+ 1020
+ 1021
+ 1022
+ 1023
+ 1024
+ 1025
+ 1026
+ 1027
+ 1028
+ 1029
+ 1030
+ 1031
+ 1032
+ 1033
+ 1034
+ 1035
+ 1036
+ 1037
+ 1038
+ 1039
+ 1040
+ 1041
+ 1042
+ 1043
+ 1044
+ 1045
+ 1046
+ 1047
+ 1048
+ 1049
+ 1050
+ 1051
+ 1052
+ 1053
+ 1054
+ 1055
+ 1056
+ 1057
+ 1058
+ 1059
+ 1060
+ 1061
+ 1062
+ 1063
+ 1064
+ 1065
+ 1066
+ 1067
+ 1068
+ 1069
+ 1070
+ 1071
+ 1072
+ 1073
+ 1074
+ 1075
+ 1076
+ 1077
+ 1078
+ 1079
+ 1080
+ 1081
+ 1082
+ 1083
+ 1084
+ 1085
+ 1086
+ 1087
+ 1088
+ 1089
+ 1090
+ 1091
+ 1092
+ 1093
+ 1094
+ 1095
+ 1096
+ 1097
+ 1098
+ 1099
+ 1100
+ 1101
+ 1102
+ 1103
+ 1104
+ 1105
+ 1106
+ 1107
+ 1108
+ 1109
+ 1110
+ 1111
+ 1112
+ 1113
+ 1114
+ 1115
+ 1116
+ 1117
+ 1118
+ 1119
+ 1120
+ 1121
+ 1122
+ 1123
+ 1124
+ 1125
+ 1126
+ 1127
+ 1128
+ 1129
+ 1130
+ 1131
+ 1132
+ 1133
+ 1134
+ 1135
+ 1136
+ 1137
+ 1138
+ 1139
+ 1140
+ 1141
+ 1142
+ 1143
+ 1144
+ 1145
+ 1146
+ 1147
+ 1148
+ 1149
+ 1150
+ 1151
+ 1152
+ 1153
+ 1154
+ 1155
+ 1156
+ 1157
+ 1158
+ 1159
+ 1160
+ 1161
+ 1162
+ 1163
+ 1164
+ 1165
+ 1166
+ 1167
+ 1168
+ 1169
+ 1170
+ 1171
+ 1172
+ 1173
+ 1174
+ 1175
+ 1176
+ 1177
+ 1178
+ 1179
+ 1180
+ 1181
+ 1182
+ 1183
+ 1184
+ 1185
+ 1186
+ 1187
+ 1188
+ 1189
+ 1190
+ 1191
+ 1192
+ 1193
+ 1194
+ 1195
+ 1196
+ 1197
+ 1198
+ 1199
+ 1200
+ 1201
+ 1202
+ 1203
+ 1204
+ 1205
+ 1206
+ 1207
+ 1208
+ 1209
+ 1210
+ 1211
+ 1212
+ 1213
+ 1214
+ 1215
+ 1216
+ 1217
+ 1218
+ 1219
+ 1220
+ 1221
+ 1222
+ 1223
+ 1224
+ 1225
+ 1226
+ 1227
+ 1228
+ 1229
+ 1230
+ 1231
+ 1232
+ 1233
+ 1234
+ 1235
+ 1236
+ 1237
+ 1238
+ 1239
+ 1240
+ 1241
+ 1242
+ 1243
+ 1244
+ 1245
+ 1246
+ 1247
+ 1248
+ 1249
+ 1250
+ 1251
+ 1252
+ 1253
+ 1254
+ 1255
+ 1256
+ 1257
+ 1258
+ 1259
+ 1260
+ 1261
+ 1262
+ 1263
+ 1264
+ 1265
+ 1266
+ 1267
+ 1268
+ 1269
+ 1270
+ 1271
+ 1272
+ 1273
+ 1274
+ 1275
+ 1276
+ 1277
+ 1278
+ 1279
+ 1280
+ 1281
+ 1282
+ 1283
+ 1284
+ 1285
+ 1286
+ 1287
+ 1288
+ 1289
+ 1290
+ 1291
+ 1292
+ 1293
+ 1294
+ 1295
+ 1296
+ 1297
+ 1298
+ 1299
+ 1300
+ 1301
+ 1302
+ 1303
+ 1304
+ 1305
+ 1306
+ 1307
+ 1308
+ 1309
+ 1310
+ 1311
+ 1312
+ 1313
+ 1314
+ 1315
+ 1316
+ 1317
+ 1318
+ 1319
+ 1320
+ 1321
+ 1322
+ 1323
+ 1324
+ 1325
+ 1326
+ 1327
+ 1328
+ 1329
+ 1330
+ 1331
+ 1332
+ 1333
+ 1334
+ 1335
+ 1336
+ 1337
+ 1338
+ 1339
+ 1340
+ 1341
+ 1342
+ 1343
+ 1344
+ 1345
+ 1346
+ 1347
+ 1348
+ 1349
+ 1350
+ 1351
+ 1352
+ 1353
+ 1354
+ 1355
+ 1356
+ 1357
+ 1358
+ 1359
+ 1360
+ 1361
+ 1362
+ 1363
+ 1364
+ 1365
+ 1366
+ 1367
+ 1368
+ 1369
+ 1370
+ 1371
+ 1372
+ 1373
+ 1374
+ 1375
+ 1376
+ 1377
+ 1378
+ 1379
+ 1380
+ 1381
+ 1382
+ 1383
+ 1384
+ 1385
+ 1386
+ 1387
+ 1388
+ 1389
+ 1390
+ 1391
+ 1392
+ 1393
+ 1394
+ 1395
+ 1396
+ 1397
+ 1398
+ 1399
+ 1400
+ 1401
+ 1402
+ 1403
+ 1404
+ 1405
+ 1406
+ 1407
+ 1408
+ 1409
+ 1410
+ 1411
+ 1412
+ 1413
+ 1414
+ 1415
+ 1416
+ 1417
+ 1418
+ 1419
+ 1420
+ 1421
+ 1422
+ 1423
+ 1424
+ 1425
+ 1426
+ 1427
+ 1428
+ 1429
+ 1430
+ 1431
+ 1432
+ 1433
+ 1434
+ 1435
+ 1436
+ 1437
+ 1438
+ 1439
+ 1440
+ 1441
+ 1442
+ 1443
+ 1444
+ 1445
+ 1446
+ 1447
+ 1448
+ 1449
+ 1450
+ 1451
+ 1452
+ 1453
+ 1454
+ 1455
+ 1456
+ 1457
+ 1458
+ 1459
+ 1460
+ 1461
+ 1462
+ 1463
+ 1464
+ 1465
+ 1466
+ 1467
+ 1468
+ 1469
+ 1470
+ 1471
+ 1472
+ 1473
+ 1474
+ 1475
+ 1476
+ 1477
+ 1478
+ 1479
+ 1480
+ 1481
+ 1482
+ 1483
+ 1484
+ 1485
+ 1486
+ 1487
+ 1488
+ 1489
+ 1490
+ 1491
+ 1492
+ 1493
+ 1494
+ 1495
+ 1496
+ 1497
+ 1498
+ 1499
+ 1500
+ 1501
+ 1502
+ 1503
+ 1504
+ 1505
+ 1506
+ 1507
+ 1508
+ 1509
+ 1510
+ 1511
+ 1512
+ 1513
+ 1514
+ 1515
+ 1516
+ 1517
+ 1518
+ 1519
+ 1520
+ 1521
+ 1522
+ 1523
+ 1524
+ 1525
+ 1526
+ 1527
+ 1528
+ 1529
+ 1530
+ 1531
+ 1532
+ 1533
+ 1534
+ 1535
+ 1536
+ 1537
+ 1538
+ 1539
+ 1540
+ 1541
+ 1542
+ 1543
+ 1544
+ 1545
+ 1546
+ 1547
+ 1548
+ 1549
+ 1550
+ 1551
+ 1552
+ 1553
+ 1554
+ 1555
+ 1556
+ 1557
+ 1558
+ 1559
+ 1560
+ 1561
+ 1562
+ 1563
+ 1564
+ 1565
+ 1566
+ 1567
+ 1568
+ 1569
+ 1570
+ 1571
+ 1572
+ 1573
+ 1574
+ 1575
+ 1576
+ 1577
+ 1578
+ 1579
+ 1580
+ 1581
+ 1582
+ 1583
+ 1584
+ 1585
+ 1586
+ 1587
+ 1588
+ 1589
+ 1590
+ 1591
+ 1592
+ 1593
+ 1594
+ 1595
+ 1596
+ 1597
+ 1598
+ 1599
+ 1600
+ 1601
+ 1602
+ 1603
+ 1604
+ 1605
+ 1606
+ 1607
+ 1608
+ 1609
+ 1610
+ 1611
+ 1612
+ 1613
+ 1614
+ 1615
+ 1616
+ 1617
+ 1618
+ 1619
+ 1620
+ 1621
+ 1622
+ 1623
+ 1624
+ 1625
+ 1626
+ 1627
+ 1628
+ 1629
+ 1630
+ 1631
+ 1632
+ 1633
+ 1634
+ 1635
+ 1636
+ 1637
+ 1638
+ 1639
+ 1640
+ 1641
+ 1642
+ 1643
+ 1644
+ 1645
+ 1646
+ 1647
+ 1648
+ 1649
+ 1650
+ 1651
+ 1652
+ 1653
+ 1654
+ 1655
+ 1656
+ 1657
+ 1658
+ 1659
+ 1660
+ 1661
+ 1662
+ 1663
+ 1664
+ 1665
+ 1666
+ 1667
+ 1668
+ 1669
+ 1670
+ 1671
+ 1672
+ 1673
+ 1674
+ 1675
+ 1676
+ 1677
+ 1678
+ 1679
+ 1680
+ 1681
+ 1682
+ 1683
+ 1684
+ 1685
+ 1686
+ 1687
+ 1688
+ 1689
+ 1690
+ 1691
+ 1692
+ 1693
+ 1694
+ 1695
+ 1696
+ 1697
+ 1698
+ 1699
+ 1700
+ 1701
+ 1702
+ 1703
+ 1704
+ 1705
+ 1706
+ 1707
+ 1708
+ 1709
+ 1710
+ 1711
+ 1712
+ 1713
+ 1714
+ 1715
+ 1716
+ 1717
+ 1718
+ 1719
+ 1720
+ 1721
+ 1722
+ 1723
+ 1724
+ 1725
+ 1726
+ 1727
+ 1728
+ 1729
+ 1730
+ 1731
+ 1732
+ 1733
+ 1734
+ 1735
+ 1736
+ 1737
+ 1738
+ 1739
+ 1740
+ 1741
+ 1742
+ 1743
+ 1744
+ 1745
+ 1746
+ 1747
+ 1748
+ 1749
+ 1750
+ 1751
+ 1752
+ 1753
+ 1754
+ 1755
+ 1756
+ 1757
+ 1758
+ 1759
+ 1760
+ 1761
+ 1762
+ 1763
+ 1764
+ 1765
+ 1766
+ 1767
+ 1768
+ 1769
+ 1770
+ 1771
+ 1772
+ 1773
+ 1774
+ 1775
+ 1776
+ 1777
+ 1778
+ 1779
+ 1780
+ 1781
+ 1782
+ 1783
+ 1784
+ 1785
+ 1786
+ 1787
+ 1788
+ 1789
+ 1790
+ 1791
+ 1792
+ 1793
+ 1794
+ 1795
+ 1796
+ 1797
+ 1798
+ 1799
+ 1800
+ 1801
+ 1802
+ 1803
+ 1804
+ 1805
+ 1806
+ 1807
+ 1808
+ 1809
+ 1810
+ 1811
+ 1812
+ 1813
+ 1814
+ 1815
+ 1816
+ 1817
+ 1818
+ 1819
+ 1820
+ 1821
+ 1822
+ 1823
+ 1824
+ 1825
+ 1826
+ 1827
+ 1828
+ 1829
+ 1830
+ 1831
+ 1832
+ 1833
+ 1834
+ 1835
+ 1836
+ 1837
+ 1838
+ 1839
+ 1840
+ 1841
+ 1842
+ 1843
+ 1844
+ 1845
+ 1846
+ 1847
+ 1848
+ 1849
+ 1850
+ 1851
+ 1852
+ 1853
+ 1854
+ 1855
+ 1856
+ 1857
+ 1858
+ 1859
+ 1860
+ 1861
+ 1862
+ 1863
+ 1864
+ 1865
+ 1866
+ 1867
+ 1868
+ 1869
+ 1870
+ 1871
+ 1872
+ 1873
+ 1874
+ 1875
+ 1876
+ 1877
+ 1878
+ 1879
+ 1880
+ 1881
+ 1882
+ 1883
+ 1884
+ 1885
+ 1886
+ 1887
+ 1888
+ 1889
+ 1890
+ 1891
+ 1892
+ 1893
+ 1894
+ 1895
+ 1896
+ 1897
+ 1898
+ 1899
+ 1900
+ 1901
+ 1902
+ 1903
+ 1904
+ 1905
+ 1906
+ 1907
+ 1908
+ 1909
+ 1910
+ 1911
+ 1912
+ 1913
+ 1914
+ 1915
+ 1916
+ 1917
+ 1918
+ 1919
+ 1920
+ 1921
+ 1922
+ 1923
+ 1924
+ 1925
+ 1926
+ 1927
+ 1928
+ 1929
+ 1930
+ 1931
+ 1932
+ 1933
+ 1934
+ 1935
+ 1936
+ 1937
+ 1938
+ 1939
+ 1940
+ 1941
+ 1942
+ 1943
+ 1944
+ 1945
+ 1946
+ 1947
+ 1948
+ 1949
+ 1950
+ 1951
+ 1952
+ 1953
+ 1954
+ 1955
+ 1956
+ 1957
+ 1958
+ 1959
+ 1960
+ 1961
+ 1962
+ 1963
+ 1964
+ 1965
+ 1966
+ 1967
+ 1968
+ 1969
+ 1970
+ 1971
+ 1972
+ 1973
+ 1974
+ 1975
+ 1976
+ 1977
+ 1978
+ 1979
+ 1980
+ 1981
+ 1982
+ 1983
+ 1984
+ 1985
+ 1986
+ 1987
+ 1988
+ 1989
+ 1990
+ 1991
+ 1992
+ 1993
+ 1994
+ 1995
+ 1996
+ 1997
+ 1998
+ 1999
+ 2000
+ 2001
+ 2002
+ 2003
+ 2004
+ 2005
+ 2006
+ 2007
+ 2008
+ 2009
+ 2010
+ 2011
+ 2012
+ 2013
+ 2014
+ 2015
+ 2016
+ 2017
+ 2018
+ 2019
+ 2020
+ 2021
+ 2022
+ 2023
+ 2024
+ 2025
+ 2026
+ 2027
+ 2028
+ 2029
+ 2030
+ 2031
+ 2032
+ 2033
+ 2034
+ 2035
+ 2036
+ 2037
+ 2038
+ 2039
+ 2040
+ 2041
+ 2042
+ 2043
+ 2044
+ 2045
+ 2046
+ 2047
+ 2048
+ 2049
+ 2050
+ 2051
+ 2052
+ 2053
+ 2054
+ 2055
+ 2056
+ 2057
+ 2058
+ 2059
+ 2060
+ 2061
+ 2062
+ 2063
+ 2064
+ 2065
+ 2066
+ 2067
+ 2068
+ 2069
+ 2070
+ 2071
+ 2072
+ 2073
+ 2074
+ 2075
+ 2076
+ 2077
+ 2078
+ 2079
+ 2080
+ 2081
+ 2082
+ 2083
+ 2084
+ 2085
+ 2086
+ 2087
+ 2088
+ 2089
+ 2090
+ 2091
+ 2092
+ 2093
+ 2094
+ 2095
+ 2096
+ 2097
+ 2098
+ 2099
+ 2100
+ 2101
+ 2102
+ 2103
+ 2104
+ 2105
+ 2106
+ 2107
+ 2108
+ 2109
+ 2110
+ 2111
+ 2112
+ 2113
+ 2114
+ 2115
+ 2116
+ 2117
+ 2118
+ 2119
+ 2120
+ 2121
+ 2122
+ 2123
+ 2124
+ 2125
+ 2126
+ 2127
+ 2128
+ 2129
+ 2130
+ 2131
+ 2132
+ 2133
+ 2134
+ 2135
+ 2136
+ 2137
+ 2138
+ 2139
+ 2140
+ 2141
+ 2142
+ 2143
+ 2144
+ 2145
+ 2146
+ 2147
+ 2148
+ 2149
+ 2150
+ 2151
+ 2152
+ 2153
+ 2154
+ 2155
+ 2156
+ 2157
+ 2158
+ 2159
+ 2160
+ 2161
+ 2162
+ 2163
+ 2164
+ 2165
+ 2166
+ 2167
+ 2168
+ 2169
+ 2170
+ 2171
+ 2172
+ 2173
+ 2174
+ 2175
+ 2176
+ 2177
+ 2178
+ 2179
+ 2180
+ 2181
+ 2182
+ 2183
+ 2184
+ 2185
+ 2186
+ 2187
+ 2188
+ 2189
+ 2190
+ 2191
+ 2192
+ 2193
+ 2194
+ 2195
+ 2196
+ 2197
+ 2198
+ 2199
+ 2200
+ 2201
+ 2202
+ 2203
+ 2204
+ 2205
+ 2206
+ 2207
+ 2208
+ 2209
+ 2210
+ 2211
+ 2212
+ 2213
+ 2214
+ 2215
+ 2216
+ 2217
+ 2218
+ 2219
+ 2220
+ 2221
+ 2222
+ 2223
+ 2224
+ 2225
+ 2226
+ 2227
+ 2228
+ 2229
+ 2230
+ 2231
+ 2232
+ 2233
+ 2234
+ 2235
+ 2236
+ 2237
+ 2238
+ 2239
+ 2240
+ 2241
+ 2242
+ 2243
+ 2244
+ 2245
+ 2246
+ 2247
+ 2248
+ 2249
+ 2250
+ 2251
+ 2252
+ 2253
+ 2254
+ 2255
+ 2256
+ 2257
+ 2258
+ 2259
+ 2260
+ 2261
+ 2262
+ 2263
+ 2264
+ 2265
+ 2266
+ 2267
+ 2268
+ 2269
+ 2270
+ 2271
+ 2272
+ 2273
+ 2274
+ 2275
+ 2276
+ 2277
+ 2278
+ 2279
+ 2280
+ 2281
+ 2282
+ 2283
+ 2284
+ 2285
+ 2286
+ 2287
+ 2288
+ 2289
+ 2290
+ 2291
+ 2292
+ 2293
+ 2294
+ 2295
+ 2296
+ 2297
+ 2298
+ 2299
+ 2300
+ 2301
+ 2302
+ 2303
+ 2304
+ 2305
+ 2306
+ 2307
+ 2308
+ 2309
+ 2310
+ 2311
+ 2312
+ 2313
+ 2314
+ 2315
+ 2316
+ 2317
+ 2318
+ 2319
+ 2320
+ 2321
+ 2322
+ 2323
+ 2324
+ 2325
+ 2326
+ 2327
+ 2328
+ 2329
+ 2330
+ 2331
+ 2332
+ 2333
+ 2334
+ 2335
+ 2336
+ 2337
+ 2338
+ 2339
+ 2340
+ 2341
+ 2342
+ 2343
+ 2344
+ 2345
+ 2346
+ 2347
+ 2348
+ 2349
+ 2350
+ 2351
+ 2352
+ 2353
+ 2354
+ 2355
+ 2356
+ 2357
+ 2358
+ 2359
+ 2360
+ 2361
+ 2362
+ 2363
+ 2364
+ 2365
+ 2366
+ 2367
+ 2368
+ 2369
+ 2370
+ 2371
+ 2372
+ 2373
+ 2374
+ 2375
+ 2376
+ 2377
+ 2378
+ 2379
+ 2380
+ 2381
+ 2382
+ 2383
+ 2384
+ 2385
+ 2386
+ 2387
+ 2388
+ 2389
+ 2390
+ 2391
+ 2392
+ 2393
+ 2394
+ 2395
+ 2396
+ 2397
+ 2398
+ 2399
+ 2400
+ 2401
+ 2402
+ 2403
+ 2404
+ 2405
+ 2406
+ 2407
+ 2408
+ 2409
+ 2410
+ 2411
+ 2412
+ 2413
+ 2414
+ 2415
+ 2416
+ 2417
+ 2418
+ 2419
+ 2420
+ 2421
+ 2422
+ 2423
+ 2424
+ 2425
+ 2426
+ 2427
+ 2428
+ 2429
+ 2430
+ 2431
+ 2432
+ 2433
+ 2434
+ 2435
+ 2436
+ 2437
+ 2438
+ 2439
+ 2440
+ 2441
+ 2442
+ 2443
+ 2444
+ 2445
+ 2446
+ 2447
+ 2448
+ 2449
+ 2450
+ 2451
+ 2452
+ 2453
+ 2454
+ 2455
+ 2456
+ 2457
+ 2458
+ 2459
+ 2460
+ 2461
+ 2462
+ 2463
+ 2464
+ 2465
+ 2466
+ 2467
+ 2468
+ 2469
+ 2470
+ 2471
+ 2472
+ 2473
+ 2474
+ 2475
+ 2476
+ 2477
+ 2478
+ 2479
+ 2480
+ 2481
+ 2482
+ 2483
+ 2484
+ 2485
+ 2486
+ 2487
+ 2488
+ 2489
+ 2490
+ 2491
+ 2492
+ 2493
+ 2494
+ 2495
+ 2496
+ 2497
+ 2498
+ 2499
+ 2500
+ 2501
+ 2502
+ 2503
+ 2504
+ 2505
+ 2506
+ 2507
+ 2508
+ 2509
+ 2510
+ 2511
+ 2512
+ 2513
+ 2514
+ 2515
+ 2516
+ 2517
+ 2518
+ 2519
+ 2520
+ 2521
+ 2522
+ 2523
+ 2524
+ 2525
+ 2526
+ 2527
+ 2528
+ 2529
+ 2530
+ 2531
+ 2532
+ 2533
+ 2534
+ 2535
+ 2536
+ 2537
+ 2538
+ 2539
+ 2540
+ 2541
+ 2542
+ 2543
+ 2544
+ 2545
+ 2546
+ 2547
+ 2548
+ 2549
+ 2550
+ 2551
+ 2552
+ 2553
+ 2554
+ 2555
+ 2556
+ 2557
+ 2558
+ 2559
+ 2560
+ 2561
+ 2562
+ 2563
+ 2564
+ 2565
+ 2566
+ 2567
+ 2568
+ 2569
+ 2570
+ 2571
+ 2572
+ 2573
+ 2574
+ 2575
+ 2576
+ 2577
+ 2578
+ 2579
+ 2580
+ 2581
+ 2582
+ 2583
+ 2584
+ 2585
+ 2586
+ 2587
+ 2588
+ 2589
+ 2590
+ 2591
+ 2592
+ 2593
+ 2594
+ 2595
+ 2596
+ 2597
+ 2598
+ 2599
+ 2600
+ 2601
+ 2602
+ 2603
+ 2604
+ 2605
+ 2606
+ 2607
+ 2608
+ 2609
+ 2610
+ 2611
+ 2612
+ 2613
+ 2614
+ 2615
+ 2616
+ 2617
+ 2618
+ 2619
+ 2620
+ 2621
+ 2622
+ 2623
+ 2624
+ 2625
+ 2626
+ 2627
+ 2628
+ 2629
+ 2630
+ 2631
+ 2632
+ 2633
+ 2634
+ 2635
+ 2636
+ 2637
+ 2638
+ 2639
+ 2640
+ 2641
+ 2642
+ 2643
+ 2644
+ 2645
+ 2646
+ 2647
+ 2648
+ 2649
+ 2650
+ 2651
+ 2652
+ 2653
+ 2654
+ 2655
+ 2656
+ 2657
+ 2658
+ 2659
+ 2660
+ 2661
+ 2662
+ 2663
+ 2664
+ 2665
+ 2666
+ 2667
+ 2668
+ 2669
+ 2670
+ 2671
+ 2672
+ 2673
+ 2674
+ 2675
+ 2676
+ 2677
+ 2678
+ 2679
+ 2680
+ 2681
+ 2682
+ 2683
+ 2684
+ 2685
+ 2686
+ 2687
+ 2688
+ 2689
+ 2690
+ 2691
+ 2692
+ 2693
+ 2694
+ 2695
+ 2696
+ 2697
+ 2698
+ 2699
+ 2700
+ 2701
+ 2702
+ 2703
+ 2704
+ 2705
+ 2706
+ 2707
+ 2708
+ 2709
+ 2710
+ 2711
+ 2712
+ 2713
+ 2714
+ 2715
+ 2716
+ 2717
+ 2718
+ 2719
+ 2720
+ 2721
+ 2722
+ 2723
+ 2724
+ 2725
+ 2726
+ 2727
+ 2728
+ 2729
+ 2730
+ 2731
+ 2732
+ 2733
+ 2734
+ 2735
+ 2736
+ 2737
+ 2738
+ 2739
+ 2740
+ 2741
+ 2742
+ 2743
+ 2744
+ 2745
+ 2746
+ 2747
+ 2748
+ 2749
+ 2750
+ 2751
+ 2752
+ 2753
+ 2754
+ 2755
+ 2756
+ 2757
+ 2758
+ 2759
+ 2760
+ 2761
+ 2762
+ 2763
+ 2764
+ 2765
+ 2766
+ 2767
+ 2768
+ 2769
+ 2770
+ 2771
+ 2772
+ 2773
+ 2774
+ 2775
+ 2776
+ 2777
+ 2778
+ 2779
+ 2780
+ 2781
+ 2782
+ 2783
+ 2784
+ 2785
+ 2786
+ 2787
+ 2788
+ 2789
+ 2790
+ 2791
+ 2792
+ 2793
+ 2794
+ 2795
+ 2796
+ 2797
+ 2798
+ 2799
+ 2800
+ 2801
+ 2802
+ 2803
+ 2804
+ 2805
+ 2806
+ 2807
+ 2808
+ 2809
+ 2810
+ 2811
+ 2812
+ 2813
+ 2814
+ 2815
+ 2816
+ 2817
+ 2818
+ 2819
+ 2820
+ 2821
+ 2822
+ 2823
+ 2824
+ 2825
+ 2826
+ 2827
+ 2828
+ 2829
+ 2830
+ 2831
+ 2832
+ 2833
+ 2834
+ 2835
+ 2836
+ 2837
+ 2838
+ 2839
+ 2840
+ 2841
+ 2842
+ 2843
+ 2844
+ 2845
+ 2846
+ 2847
+ 2848
+ 2849
+ 2850
+ 2851
+ 2852
+ 2853
+ 2854
+ 2855
+ 2856
+ 2857
+ 2858
+ 2859
+ 2860
+ 2861
+ 2862
+ 2863
+ 2864
+ 2865
+ 2866
+ 2867
+ 2868
+ 2869
+ 2870
+ 2871
+ 2872
+ 2873
+ 2874
+ 2875
+ 2876
+ 2877
+ 2878
+ 2879
+ 2880
+ 2881
+ 2882
+ 2883
+ 2884
+ 2885
+ 2886
+ 2887
+ 2888
+ 2889
+ 2890
+ 2891
+ 2892
+ 2893
+ 2894
+ 2895
+ 2896
+ 2897
+ 2898
+ 2899
+ 2900
+ 2901
+ 2902
+ 2903
+ 2904
+ 2905
+ 2906
+ 2907
+ 2908
+ 2909
+ 2910
+ 2911
+ 2912
+ 2913
+ 2914
+ 2915
+ 2916
+ 2917
+ 2918
+ 2919
+ 2920
+ 2921
+ 2922
+ 2923
+ 2924
+ 2925
+ 2926
+ 2927
+ 2928
+ 2929
+ 2930
+ 2931
+ 2932
+ 2933
+ 2934
+ 2935
+ 2936
+ 2937
+ 2938
+ 2939
+ 2940
+ 2941
+ 2942
+ 2943
+ 2944
+ 2945
+ 2946
+ 2947
+ 2948
+ 2949
+ 2950
+ 2951
+ 2952
+ 2953
+ 2954
+ 2955
+ 2956
+ 2957
+ 2958
+ 2959
+ 2960
+ 2961
+ 2962
+ 2963
+ 2964
+ 2965
+ 2966
+ 2967
+ 2968
+ 2969
+ 2970
+ 2971
+ 2972
+ 2973
+ 2974
+ 2975
+ 2976
+ 2977
+ 2978
+ 2979
+ 2980
+ 2981
+ 2982
+ 2983
+ 2984
+ 2985
+ 2986
+ 2987
+ 2988
+ 2989
+ 2990
+ 2991
+ 2992
+ 2993
+ 2994
+ 2995
+ 2996
+ 2997
+ 2998
+ 2999
+ 3000
+ 3001
+ 3002
+ 3003
+ 3004
+ 3005
+ 3006
+ 3007
+ 3008
+ 3009
+ 3010
+ 3011
+ 3012
+ 3013
+ 3014
+ 3015
+ 3016
+ 3017
+ 3018
+ 3019
+ 3020
+ 3021
+ 3022
+ 3023
+ 3024
+ 3025
+ 3026
+ 3027
+ 3028
+ 3029
+ 3030
+ 3031
+ 3032
+ 3033
+ 3034
+ 3035
+ 3036
+ 3037
+ 3038
+ 3039
+ 3040
+ 3041
+ 3042
+ 3043
+ 3044
+ 3045
+ 3046
+ 3047
+ 3048
+ 3049
+ 3050
+ 3051
+ 3052
+ 3053
+ 3054
+ 3055
+ 3056
+ 3057
+ 3058
+ 3059
+ 3060
+ 3061
+ 3062
+ 3063
+ 3064
+ 3065
+ 3066
+ 3067
+ 3068
+ 3069
+ 3070
+ 3071
+ 3072
+ 3073
+ 3074
+ 3075
+ 3076
+ 3077
+ 3078
+ 3079
+ 3080
+ 3081
+ 3082
+ 3083
+ 3084
+ 3085
+ 3086
+ 3087
+ 3088
+ 3089
+ 3090
+ 3091
+ 3092
+ 3093
+ 3094
+ 3095
+ 3096
+ 3097
+ 3098
+ 3099
+ 3100
+ 3101
+ 3102
+ 3103
+ 3104
+ 3105
+ 3106
+ 3107
+ 3108
+ 3109
+ 3110
+ 3111
+ 3112
+ 3113
+ 3114
+ 3115
+ 3116
+ 3117
+ 3118
+ 3119
+ 3120
+ 3121
+ 3122
+ 3123
+ 3124
+ 3125
+ 3126
+ 3127
+ 3128
+ 3129
+ 3130
+ 3131
+ 3132
+ 3133
+ 3134
+ 3135
+ 3136
+ 3137
+ 3138
+ 3139
+ 3140
+ 3141
+ 3142
+ 3143
+ 3144
+ 3145
+ 3146
+ 3147
+ 3148
+ 3149
+ 3150
+ 3151
+ 3152
+ 3153
+ 3154
+ 3155
+ 3156
+ 3157
+ 3158
+ 3159
+ 3160
+ 3161
+ 3162
+ 3163
+ 3164
+ 3165
+ 3166
+ 3167
+ 3168
+ 3169
+ 3170
+ 3171
+ 3172
+ 3173
+ 3174
+ 3175
+ 3176
+ 3177
+ 3178
+ 3179
+ 3180
+ 3181
+ 3182
+ 3183
+ 3184
+ 3185
+ 3186
+ 3187
+ 3188
+ 3189
+ 3190
+ 3191
+ 3192
+ 3193
+ 3194
+ 3195
+ 3196
+ 3197
+ 3198
+ 3199
+ 3200
+ 3201
+ 3202
+ 3203
+ 3204
+ 3205
+ 3206
+ 3207
+ 3208
+ 3209
+ 3210
+ 3211
+ 3212
+ 3213
+ 3214
+ 3215
+ 3216
+ 3217
+ 3218
+ 3219
+ 3220
+ 3221
+ 3222
+ 3223
+ 3224
+ 3225
+ 3226
+ 3227
+ 3228
+ 3229
+ 3230
+ 3231
+ 3232
+ 3233
+ 3234
+ 3235
+ 3236
+ 3237
+ 3238
+ 3239
+ 3240
+ 3241
+ 3242
+ 3243
+ 3244
+ 3245
+ 3246
+ 3247
+ 3248
+ 3249
+ 3250
+ 3251
+ 3252
+ 3253
+ 3254
+ 3255
+ 3256
+ 3257
+ 3258
+ 3259
+ 3260
+ 3261
+ 3262
+ 3263
+ 3264
+ 3265
+ 3266
+ 3267
+ 3268
+ 3269
+ 3270
+ 3271
+ 3272
+ 3273
+ 3274
+ 3275
+ 3276
+ 3277
+ 3278
+ 3279
+ 3280
+ 3281
+ 3282
+ 3283
+ 3284
+ 3285
+ 3286
+ 3287
+ 3288
+ 3289
+ 3290
+ 3291
+ 3292
+ 3293
+ 3294
+ 3295
+ 3296
+ 3297
+ 3298
+ 3299
+ 3300
+ 3301
+ 3302
+ 3303
+ 3304
+ 3305
+ 3306
+ 3307
+ 3308
+ 3309
+ 3310
+ 3311
+ 3312
+ 3313
+ 3314
+ 3315
+ 3316
+ 3317
+ 3318
+ 3319
+ 3320
+ 3321
+ 3322
+ 3323
+ 3324
+ 3325
+ 3326
+ 3327
+ 3328
+ 3329
+ 3330
+ 3331
+ 3332
+ 3333
+ 3334
+ 3335
+ 3336
+ 3337
+ 3338
+ 3339
+ 3340
+ 3341
+ 3342
+ 3343
+ 3344
+ 3345
+ 3346
+ 3347
+ 3348
+ 3349
+ 3350
+ 3351
+ 3352
+ 3353
+ 3354
+ 3355
+ 3356
+ 3357
+ 3358
+ 3359
+ 3360
+ 3361
+ 3362
+ 3363
+ 3364
+ 3365
+ 3366
+ 3367
+ 3368
+ 3369
+ 3370
+ 3371
+ 3372
+ 3373
+ 3374
+ 3375
+ 3376
+ 3377
+ 3378
+ 3379
+ 3380
+ 3381
+ 3382
+ 3383
+ 3384
+ 3385
+ 3386
+ 3387
+ 3388
+ 3389
+ 3390
+ 3391
+ 3392
+ 3393
+ 3394
+ 3395
+ 3396
+ 3397
+ 3398
+ 3399
+ 3400
+ 3401
+ 3402
+ 3403
+ 3404
+ 3405
+ 3406
+ 3407
+ 3408
+ 3409
+ 3410
+ 3411
+ 3412
+ 3413
+ 3414
+ 3415
+ 3416
+ 3417
+ 3418
+ 3419
+ 3420
+ 3421
+ 3422
+ 3423
+ 3424
+ 3425
+ 3426
+ 3427
+ 3428
+ 3429
+ 3430
+ 3431
+ 3432
+ 3433
+ 3434
+ 3435
+ 3436
+ 3437
+ 3438
+ 3439
+ 3440
+ 3441
+ 3442
+ 3443
+ 3444
+ 3445
+ 3446
+ 3447
+ 3448
+ 3449
+ 3450
+ 3451
+ 3452
+ 3453
+ 3454
+ 3455
+ 3456
+ 3457
+ 3458
+ 3459
+ 3460
+ 3461
+ 3462
+ 3463
+ 3464
+ 3465
+ 3466
+ 3467
+ 3468
+ 3469
+ 3470
+ 3471
+ 3472
+ 3473
+ 3474
+ 3475
+ 3476
+ 3477
+ 3478
+ 3479
+ 3480
+ 3481
+ 3482
+ 3483
+ 3484
+ 3485
+ 3486
+ 3487
+ 3488
+ 3489
+ 3490
+ 3491
+ 3492
+ 3493
+ 3494
+ 3495
+ 3496
+ 3497
+ 3498
+ 3499
+ 3500
+ 3501
+ 3502
+ 3503
+ 3504
+ 3505
+ 3506
+ 3507
+ 3508
+ 3509
+ 3510
+ 3511
+ 3512
+ 3513
+ 3514
+ 3515
+ 3516
+ 3517
+ 3518
+ 3519
+ 3520
+ 3521
+ 3522
+ 3523
+ 3524
+ 3525
+ 3526
+ 3527
+ 3528
+ 3529
+ 3530
+ 3531
+ 3532
+ 3533
+ 3534
+ 3535
+ 3536
+ 3537
+ 3538
+ 3539
+ 3540
+ 3541
+ 3542
+ 3543
+ 3544
+ 3545
+ 3546
+ 3547
+ 3548
+ 3549
+ 3550
+ 3551
+ 3552
+ 3553
+ 3554
+ 3555
+ 3556
+ 3557
+ 3558
+ 3559
+ 3560
+ 3561
+ 3562
+ 3563
+ 3564
+ 3565
+ 3566
+ 3567
+ 3568
+ 3569
+ 3570
+ 3571
+ 3572
+ 3573
+ 3574
+ 3575
+ 3576
+ 3577
+ 3578
+ 3579
+ 3580
+ 3581
+ 3582
+ 3583
+ 3584
+ 3585
+ 3586
+ 3587
+ 3588
+ 3589
+ 3590
+ 3591
+ 3592
+ 3593
+ 3594
+ 3595
+ 3596
+ 3597
+ 3598
+ 3599
+ 3600
+ 3601
+ 3602
+ 3603
+ 3604
+ 3605
+ 3606
+ 3607
+ 3608
+ 3609
+ 3610
+ 3611
+ 3612
+ 3613
+ 3614
+ 3615
+ 3616
+ 3617
+ 3618
+ 3619
+ 3620
+ 3621
+ 3622
+ 3623
+ 3624
+ 3625
+ 3626
+ 3627
+ 3628
+ 3629
+ 3630
+ 3631
+ 3632
+ 3633
+ 3634
+ 3635
+ 3636
+ 3637
+ 3638
+ 3639
+ 3640
+ 3641
+ 3642
+ 3643
+ 3644
+ 3645
+ 3646
+ 3647
+ 3648
+ 3649
+ 3650
+ 3651
+ 3652
+ 3653
+ 3654
+ 3655
+ 3656
+ 3657
+ 3658
+ 3659
+ 3660
+ 3661
+ 3662
+ 3663
+ 3664
+ 3665
+ 3666
+ 3667
+ 3668
+ 3669
+ 3670
+ 3671
+ 3672
+ 3673
+ 3674
+ 3675
+ 3676
+ 3677
+ 3678
+ 3679
+ 3680
+ 3681
+ 3682
+ 3683
+ 3684
+ 3685
+ 3686
+ 3687
+ 3688
+ 3689
+ 3690
+ 3691
+ 3692
+ 3693
+ 3694
+ 3695
+ 3696
+ 3697
+ 3698
+ 3699
+ 3700
+ 3701
+ 3702
+ 3703
+ 3704
+ 3705
+ 3706
+ 3707
+ 3708
+ 3709
+ 3710
+ 3711
+ 3712
+ 3713
+ 3714
+ 3715
+ 3716
+ 3717
+ 3718
+ 3719
+ 3720
+ 3721
+ 3722
+ 3723
+ 3724
+ 3725
+ 3726
+ 3727
+ 3728
+ 3729
+ 3730
+ 3731
+ 3732
+ 3733
+ 3734
+ 3735
+ 3736
+ 3737
+ 3738
+ 3739
+ 3740
+ 3741
+ 3742
+ 3743
+ 3744
+ 3745
+ 3746
+ 3747
+ 3748
+ 3749
+ 3750
+ 3751
+ 3752
+ 3753
+ 3754
+ 3755
+ 3756
+ 3757
+ 3758
+ 3759
+ 3760
+ 3761
+ 3762
+ 3763
+ 3764
+ 3765
+ 3766
+ 3767
+ 3768
+ 3769
+ 3770
+ 3771
+ 3772
+ 3773
+ 3774
+ 3775
+ 3776
+ 3777
+ 3778
+ 3779
+ 3780
+ 3781
+ 3782
+ 3783
+ 3784
+ 3785
+ 3786
+ 3787
+ 3788
+ 3789
+ 3790
+ 3791
+ 3792
+ 3793
+ 3794
+ 3795
+ 3796
+ 3797
+ 3798
+ 3799
+ 3800
+ 3801
+ 3802
+ 3803
+ 3804
+ 3805
+ 3806
+ 3807
+ 3808
+ 3809
+ 3810
+ 3811
+ 3812
+ 3813
+ 3814
+ 3815
+ 3816
+ 3817
+ 3818
+ 3819
+ 3820
+ 3821
+ 3822
+ 3823
+ 3824
+ 3825
+ 3826
+ 3827
+ 3828
+ 3829
+ 3830
+ 3831
+ 3832
+ 3833
+ 3834
+ 3835
+ 3836
+ 3837
+ 3838
+ 3839
+ 3840
+ 3841
+ 3842
+ 3843
+ 3844
+ 3845
+ 3846
+ 3847
+ 3848
+ 3849
+ 3850
+ 3851
+ 3852
+ 3853
+ 3854
+ 3855
+ 3856
+ 3857
+ 3858
+ 3859
+ 3860
+ 3861
+ 3862
+ 3863
+ 3864
+ 3865
+ 3866
+ 3867
+ 3868
+ 3869
+ 3870
+ 3871
+ 3872
+ 3873
+ 3874
+ 3875
+ 3876
+ 3877
+ 3878
+ 3879
+ 3880
+ 3881
+ 3882
+ 3883
+ 3884
+ 3885
+ 3886
+ 3887
+ 3888
+ 3889
+ 3890
+ 3891
+ 3892
+ 3893
+ 3894
+ 3895
+ 3896
+ 3897
+ 3898
+ 3899
+ 3900
+ 3901
+ 3902
+ 3903
+ 3904
+ 3905
+ 3906
+ 3907
+ 3908
+ 3909
+ 3910
+ 3911
+ 3912
+ 3913
+ 3914
+ 3915
+ 3916
+ 3917
+ 3918
+ 3919
+ 3920
+ 3921
+ 3922
+ 3923
+ 3924
+ 3925
+ 3926
+ 3927
+ 3928
+ 3929
+ 3930
+ 3931
+ 3932
+ 3933
+ 3934
+ 3935
+ 3936
+ 3937
+ 3938
+ 3939
+ 3940
+ 3941
+ 3942
+ 3943
+ 3944
+ 3945
+ 3946
+ 3947
+ 3948
+ 3949
+ 3950
+ 3951
+ 3952
+ 3953
+ 3954
+ 3955
+ 3956
+ 3957
+ 3958
+ 3959
+ 3960
+ 3961
+ 3962
+ 3963
+ 3964
+ 3965
+ 3966
+ 3967
+ 3968
+ 3969
+ 3970
+ 3971
+ 3972
+ 3973
+ 3974
+ 3975
+ 3976
+ 3977
+ 3978
+ 3979
+ 3980
+ 3981
+ 3982
+ 3983
+ 3984
+ 3985
+ 3986
+ 3987
+ 3988
+ 3989
+ 3990
+ 3991
+ 3992
+ 3993
+ 3994
+ 3995
+ 3996
+ 3997
+ 3998
+ 3999
+ 4000
+ 4001
+ 4002
+ 4003
+ 4004
+ 4005
+ 4006
+ 4007
+ 4008
+ 4009
+ 4010
+ 4011
+ 4012
+ 4013
+ 4014
+ 4015
+ 4016
+ 4017
+ 4018
+ 4019
+ 4020
+ 4021
+ 4022
+ 4023
+ 4024
+ 4025
+ 4026
+ 4027
+ 4028
+ 4029
+ 4030
+ 4031
+ 4032
+ 4033
+ 4034
+ 4035
+ 4036
+ 4037
+ 4038
+ 4039
+ 4040
+ 4041
+ 4042
+ 4043
+ 4044
+ 4045
+ 4046
+ 4047
+ 4048
+ 4049
+ 4050
+ 4051
+ 4052
+ 4053
+ 4054
+ 4055
+ 4056
+ 4057
+ 4058
+ 4059
+ 4060
+ 4061
+ 4062
+ 4063
+ 4064
+ 4065
+ 4066
+ 4067
+ 4068
+ 4069
+ 4070
+ 4071
+ 4072
+ 4073
+ 4074
+ 4075
+ 4076
+ 4077
+ 4078
+ 4079
+ 4080
+ 4081
+ 4082
+ 4083
+ 4084
+ 4085
+ 4086
+ 4087
+ 4088
+ 4089
+ 4090
+ 4091
+ 4092
+ 4093
+ 4094
+ 4095
+ 4096
+ 4097
+ 4098
+ 4099
+ 4100
+ 4101
+ 4102
+ 4103
+ 4104
+ 4105
+ 4106
+ 4107
+ 4108
+ 4109
+ 4110
+ 4111
+ 4112
+ 4113
+ 4114
+ 4115
+ 4116
+ 4117
+ 4118
+ 4119
+ 4120
+ 4121
+ 4122
+ 4123
+ 4124
+ 4125
+ 4126
+ 4127
+ 4128
+ 4129
+ 4130
+ 4131
+ 4132
+ 4133
+ 4134
+ 4135
+ 4136
+ 4137
+ 4138
+ 4139
+ 4140
+ 4141
+ 4142
+ 4143
+ 4144
+ 4145
+ 4146
+ 4147
+ 4148
+ 4149
+ 4150
+ 4151
+ 4152
+ 4153
+ 4154
+ 4155
+ 4156
+ 4157
+ 4158
+ 4159
+ 4160
+ 4161
+ 4162
+ 4163
+ 4164
+ 4165
+ 4166
+ 4167
+ 4168
+ 4169
+ 4170
+ 4171
+ 4172
+ 4173
+ 4174
+ 4175
+ 4176
+ 4177
+ 4178
+ 4179
+ 4180
+ 4181
+ 4182
+ 4183
+ 4184
+ 4185
+ 4186
+ 4187
+ 4188
+ 4189
+ 4190
+ 4191
+ 4192
+ 4193
+ 4194
+ 4195
+ 4196
+ 4197
+ 4198
+ 4199
+ 4200
+ 4201
+ 4202
+ 4203
+ 4204
+ 4205
+ 4206
+ 4207
+ 4208
+ 4209
+ 4210
+ 4211
+ 4212
+ 4213
+ 4214
+ 4215
+ 4216
+ 4217
+ 4218
+ 4219
+ 4220
+ 4221
+ 4222
+ 4223
+ 4224
+ 4225
+ 4226
+ 4227
+ 4228
+ 4229
+ 4230
+ 4231
+ 4232
+ 4233
+ 4234
+ 4235
+ 4236
+ 4237
+ 4238
+ 4239
+ 4240
+ 4241
+ 4242
+ 4243
+ 4244
+ 4245
+ 4246
+ 4247
+ 4248
+ 4249
+ 4250
+ 4251
+ 4252
+ 4253
+ 4254
+ 4255
+ 4256
+ 4257
+ 4258
+ 4259
+ 4260
+ 4261
+ 4262
+ 4263
+ 4264
+ 4265
+ 4266
+ 4267
+ 4268
+ 4269
+ 4270
+ 4271
+ 4272
+ 4273
+ 4274
+ 4275
+ 4276
+ 4277
+ 4278
+ 4279
+ 4280
+ 4281
+ 4282
+ 4283
+ 4284
+ 4285
+ 4286
+ 4287
+ 4288
+ 4289
+ 4290
+ 4291
+ 4292
+ 4293
+ 4294
+ 4295
+ 4296
+ 4297
+ 4298
+ 4299
+ 4300
+ 4301
+ 4302
+ 4303
+ 4304
+ 4305
+ 4306
+ 4307
+ 4308
+ 4309
+ 4310
+ 4311
+ 4312
+ 4313
+ 4314
+ 4315
+ 4316
+ 4317
+ 4318
+ 4319
+ 4320
+ 4321
+ 4322
+ 4323
+ 4324
+ 4325
+ 4326
+ 4327
+ 4328
+ 4329
+ 4330
+ 4331
+ 4332
+ 4333
+ 4334
+ 4335
+ 4336
+ 4337
+ 4338
+ 4339
+ 4340
+ 4341
+ 4342
+ 4343
+ 4344
+ 4345
+ 4346
+ 4347
+ 4348
+ 4349
+ 4350
+ 4351
+ 4352
+ 4353
+ 4354
+ 4355
+ 4356
+ 4357
+ 4358
+ 4359
+ 4360
+ 4361
+ 4362
+ 4363
+ 4364
+ 4365
+ 4366
+ 4367
+ 4368
+ 4369
+ 4370
+ 4371
+ 4372
+ 4373
+ 4374
+ 4375
+ 4376
+ 4377
+ 4378
+ 4379
+ 4380
+ 4381
+ 4382
+ 4383
+ 4384
+ 4385
+ 4386
+ 4387
+ 4388
+ 4389
+ 4390
+ 4391
+ 4392
+ 4393
+ 4394
+ 4395
+ 4396
+ 4397
+ 4398
+ 4399
+ 4400
+ 4401
+ 4402
+ 4403
+ 4404
+ 4405
+ 4406
+ 4407
+ 4408
+ 4409
+ 4410
+ 4411
+ 4412
+ 4413
+ 4414
+ 4415
+ 4416
+ 4417
+ 4418
+ 4419
+ 4420
+ 4421
+ 4422
+ 4423
+ 4424
+ 4425
+ 4426
+ 4427
+ 4428
+ 4429
+ 4430
+ 4431
+ 4432
+ 4433
+ 4434
+ 4435
+ 4436
+ 4437
+ 4438
+ 4439
+ 4440
+ 4441
+ 4442
+ 4443
+ 4444
+ 4445
+ 4446
+ 4447
+ 4448
+ 4449
+ 4450
+ 4451
+ 4452
+ 4453
+ 4454
+ 4455
+ 4456
+ 4457
+ 4458
+ 4459
+ 4460
+ 4461
+ 4462
+ 4463
+ 4464
+ 4465
+ 4466
+ 4467
+ 4468
+ 4469
+ 4470
+ 4471
+ 4472
+ 4473
+ 4474
+ 4475
+ 4476
+ 4477
+ 4478
+ 4479
+ 4480
+ 4481
+ 4482
+ 4483
+ 4484
+ 4485
+ 4486
+ 4487
+ 4488
+ 4489
+ 4490
+ 4491
+ 4492
+ 4493
+ 4494
+ 4495
+ 4496
+ 4497
+ 4498
+ 4499
+ 4500
+ 4501
+ 4502
+ 4503
+ 4504
+ 4505
+ 4506
+ 4507
+ 4508
+ 4509
+ 4510
+ 4511
+ 4512
+ 4513
+ 4514
+ 4515
+ 4516
+ 4517
+ 4518
+ 4519
+ 4520
+ 4521
+ 4522
+ 4523
+ 4524
+ 4525
+ 4526
+ 4527
+ 4528
+ 4529
+ 4530
+ 4531
+ 4532
+ 4533
+ 4534
+ 4535
+ 4536
+ 4537
+ 4538
+ 4539
+ 4540
+ 4541
+ 4542
+ 4543
+ 4544
+ 4545
+ 4546
+ 4547
+ 4548
+ 4549
+ 4550
+ 4551
+ 4552
+ 4553
+ 4554
+ 4555
+ 4556
+ 4557
+ 4558
+ 4559
+ 4560
+ 4561
+ 4562
+ 4563
+ 4564
+ 4565
+ 4566
+ 4567
+ 4568
+ 4569
+ 4570
+ 4571
+ 4572
+ 4573
+ 4574
+ 4575
+ 4576
+ 4577
+ 4578
+ 4579
+ 4580
+ 4581
+ 4582
+ 4583
+ 4584
+ 4585
+ 4586
+ 4587
+ 4588
+ 4589
+ 4590
+ 4591
+ 4592
+ 4593
+ 4594
+ 4595
+ 4596
+ 4597
+ 4598
+ 4599
+ 4600
+ 4601
+ 4602
+ 4603
+ 4604
+ 4605
+ 4606
+ 4607
+ 4608
+ 4609
+ 4610
+ 4611
+ 4612
+ 4613
+ 4614
+ 4615
+ 4616
+ 4617
+ 4618
+ 4619
+ 4620
+ 4621
+ 4622
+ 4623
+ 4624
+ 4625
+ 4626
+ 4627
+ 4628
+ 4629
+ 4630
+ 4631
+ 4632
+ 4633
+ 4634
+ 4635
+ 4636
+ 4637
+ 4638
+ 4639
+ 4640
+ 4641
+ 4642
+ 4643
+ 4644
+ 4645
+ 4646
+ 4647
+ 4648
+ 4649
+ 4650
+ 4651
+ 4652
+ 4653
+ 4654
+ 4655
+ 4656
+ 4657
+ 4658
+ 4659
+ 4660
+ 4661
+ 4662
+ 4663
+ 4664
+ 4665
+ 4666
+ 4667
+ 4668
+ 4669
+ 4670
+ 4671
+ 4672
+ 4673
+ 4674
+ 4675
+ 4676
+ 4677
+ 4678
+ 4679
+ 4680
+ 4681
+ 4682
+ 4683
+ 4684
+ 4685
+ 4686
+ 4687
+ 4688
+ 4689
+ 4690
+ 4691
+ 4692
+ 4693
+ 4694
+ 4695
+ 4696
+ 4697
+ 4698
+ 4699
+ 4700
+ 4701
+ 4702
+ 4703
+ 4704
+ 4705
+ 4706
+ 4707
+ 4708
+ 4709
+ 4710
+ 4711
+ 4712
+ 4713
+ 4714
+ 4715
+ 4716
+ 4717
+ 4718
+ 4719
+ 4720
+ 4721
+ 4722
+ 4723
+ 4724
+ 4725
+ 4726
+ 4727
+ 4728
+ 4729
+ 4730
+ 4731
+ 4732
+ 4733
+ 4734
+ 4735
+ 4736
+ 4737
+ 4738
+ 4739
+ 4740
+ 4741
+ 4742
+ 4743
+ 4744
+ 4745
+ 4746
+ 4747
+ 4748
+ 4749
+ 4750
+ 4751
+ 4752
+ 4753
+ 4754
+ 4755
+ 4756
+ 4757
+ 4758
+ 4759
+ 4760
+ 4761
+ 4762
+ 4763
+ 4764
+ 4765
+ 4766
+ 4767
+ 4768
+ 4769
+ 4770
+ 4771
+ 4772
+ 4773
+ 4774
+ 4775
+ 4776
+ 4777
+ 4778
+ 4779
+ 4780
+ 4781
+ 4782
+ 4783
+ 4784
+ 4785
+ 4786
+ 4787
+ 4788
+ 4789
+ 4790
+ 4791
+ 4792
+ 4793
+ 4794
+ 4795
+ 4796
+ 4797
+ 4798
+ 4799
+ 4800
+ 4801
+ 4802
+ 4803
+ 4804
+ 4805
+ 4806
+ 4807
+ 4808
+ 4809
+ 4810
+ 4811
+ 4812
+ 4813
+ 4814
+ 4815
+ 4816
+ 4817
+ 4818
+ 4819
+ 4820
+ 4821
+ 4822
+ 4823
+ 4824
+ 4825
+ 4826
+ 4827
+ 4828
+ 4829
+ 4830
+ 4831
+ 4832
+ 4833
+ 4834
+ 4835
+ 4836
+ 4837
+ 4838
+ 4839
+ 4840
+ 4841
+ 4842
+ 4843
+ 4844
+ 4845
+ 4846
+ 4847
+ 4848
+ 4849
+ 4850
+ 4851
+ 4852
+ 4853
+ 4854
+ 4855
+ 4856
+ 4857
+ 4858
+ 4859
+ 4860
+ 4861
+ 4862
+ 4863
+ 4864
+ 4865
+ 4866
+ 4867
+ 4868
+ 4869
+ 4870
+ 4871
+ 4872
+ 4873
+ 4874
+ 4875
+ 4876
+ 4877
+ 4878
+ 4879
+ 4880
+ 4881
+ 4882
+ 4883
+ 4884
+ 4885
+ 4886
+ 4887
+ 4888
+ 4889
+ 4890
+ 4891
+ 4892
+ 4893
+ 4894
+ 4895
+ 4896
+ 4897
+ 4898
+ 4899
+ 4900
+ 4901
+ 4902
+ 4903
+ 4904
+ 4905
+ 4906
+ 4907
+ 4908
+ 4909
+ 4910
+ 4911
+ 4912
+ 4913
+ 4914
+ 4915
+ 4916
+ 4917
+ 4918
+ 4919
+ 4920
+ 4921
+ 4922
+ 4923
+ 4924
+ 4925
+ 4926
+ 4927
+ 4928
+ 4929
+ 4930
+ 4931
+ 4932
+ 4933
+ 4934
+ 4935
+ 4936
+ 4937
+ 4938
+ 4939
+ 4940
+ 4941
+ 4942
+ 4943
+ 4944
+ 4945
+ 4946
+ 4947
+ 4948
+ 4949
+ 4950
+ 4951
+ 4952
+ 4953
+ 4954
+ 4955
+ 4956
+ 4957
+ 4958
+ 4959
+ 4960
+ 4961
+ 4962
+ 4963
+ 4964
+ 4965
+ 4966
+ 4967
+ 4968
+ 4969
+ 4970
+ 4971
+ 4972
+ 4973
+ 4974
+ 4975
+ 4976
+ 4977
+ 4978
+ 4979
+ 4980
+ 4981
+ 4982
+ 4983
+ 4984
+ 4985
+ 4986
+ 4987
+ 4988
+ 4989
+ 4990
+ 4991
+ 4992
+ 4993
+ 4994
+ 4995
+ 4996
+ 4997
+ 4998
+ 4999
+ 5000
+ 5001
+ 5002
+ 5003
+ 5004
+ 5005
+ 5006
+ 5007
+ 5008
+ 5009
+ 5010
+ 5011
+ 5012
+ 5013
+ 5014
+ 5015
+ 5016
+ 5017
+ 5018
+ 5019
+ 5020
+ 5021
+ 5022
+ 5023
+ 5024
+ 5025
+ 5026
+ 5027
+ 5028
+ 5029
+ 5030
+ 5031
+ 5032
+ 5033
+ 5034
+ 5035
+ 5036
+ 5037
+ 5038
+ 5039
+ 5040
+ 5041
+ 5042
+ 5043
+ 5044
+ 5045
+ 5046
+ 5047
+ 5048
+ 5049
+ 5050
+ 5051
+ 5052
+ 5053
+ 5054
+ 5055
+ 5056
+ 5057
+ 5058
+ 5059
+ 5060
+ 5061
+ 5062
+ 5063
+ 5064
+ 5065
+ 5066
+ 5067
+ 5068
+ 5069
+ 5070
+ 5071
+ 5072
+ 5073
+ 5074
+ 5075
+ 5076
+ 5077
+ 5078
+ 5079
+ 5080
+ 5081
+ 5082
+ 5083
+ 5084
+ 5085
+ 5086
+ 5087
+ 5088
+ 5089
+ 5090
+ 5091
+ 5092
+ 5093
+ 5094
+ 5095
+ 5096
+ 5097
+ 5098
+ 5099
+ 5100
+ 5101
+ 5102
+ 5103
+ 5104
+ 5105
+ 5106
+ 5107
+ 5108
+ 5109
+ 5110
+ 5111
+ 5112
+ 5113
+ 5114
+ 5115
+ 5116
+ 5117
+ 5118
+ 5119
+ 5120
+ 5121
+ 5122
+ 5123
+ 5124
+ 5125
+ 5126
+ 5127
+ 5128
+ 5129
+ 5130
+ 5131
+ 5132
+ 5133
+ 5134
+ 5135
+ 5136
+ 5137
+ 5138
+ 5139
+ 5140
+ 5141
+ 5142
+ 5143
+ 5144
+ 5145
+ 5146
+ 5147
+ 5148
+ 5149
+ 5150
+ 5151
+ 5152
+ 5153
+ 5154
+ 5155
+ 5156
+ 5157
+ 5158
+ 5159
+ 5160
+ 5161
+ 5162
+ 5163
+ 5164
+ 5165
+ 5166
+ 5167
+ 5168
+ 5169
+ 5170
+ 5171
+ 5172
+ 5173
+ 5174
+ 5175
+ 5176
+ 5177
+ 5178
+ 5179
+ 5180
+ 5181
+ 5182
+ 5183
+ 5184
+ 5185
+ 5186
+ 5187
+ 5188
+ 5189
+ 5190
+ 5191
+ 5192
+ 5193
+ 5194
+ 5195
+ 5196
+ 5197
+ 5198
+ 5199
+ 5200
+ 5201
+ 5202
+ 5203
+ 5204
+ 5205
+ 5206
+ 5207
+ 5208
+ 5209
+ 5210
+ 5211
+ 5212
+ 5213
+ 5214
+ 5215
+ 5216
+ 5217
+ 5218
+ 5219
+ 5220
+ 5221
+ 5222
+ 5223
+ 5224
+ 5225
+ 5226
+ 5227
+ 5228
+ 5229
+ 5230
+ 5231
+ 5232
+ 5233
+ 5234
+ 5235
+ 5236
+ 5237
+ 5238
+ 5239
+ 5240
+ 5241
+ 5242
+ 5243
+ 5244
+ 5245
+ 5246
+ 5247
+ 5248
+ 5249
+ 5250
+ 5251
+ 5252
+ 5253
+ 5254
+ 5255
+ 5256
+ 5257
+ 5258
+ 5259
+ 5260
+ 5261
+ 5262
+ 5263
+ 5264
+ 5265
+ 5266
+ 5267
+ 5268
+ 5269
+ 5270
+ 5271
+ 5272
+ 5273
+ 5274
+ 5275
+ 5276
+ 5277
+ 5278
+ 5279
+ 5280
+ 5281
+ 5282
+ 5283
+ 5284
+ 5285
+ 5286
+ 5287
+ 5288
+ 5289
+ 5290
+ 5291
+ 5292
+ 5293
+ 5294
+ 5295
+ 5296
+ 5297
+ 5298
+ 5299
+ 5300
+ 5301
+ 5302
+ 5303
+ 5304
+ 5305
+ 5306
+ 5307
+ 5308
+ 5309
+ 5310
+ 5311
+ 5312
+ 5313
+ 5314
+ 5315
+ 5316
+ 5317
+ 5318
+ 5319
+ 5320
+ 5321
+ 5322
+ 5323
+ 5324
+ 5325
+ 5326
+ 5327
+ 5328
+ 5329
+ 5330
+ 5331
+ 5332
+ 5333
+ 5334
+ 5335
+ 5336
+ 5337
+ 5338
+ 5339
+ 5340
+ 5341
+ 5342
+ 5343
+ 5344
+ 5345
+ 5346
+ 5347
+ 5348
+ 5349
+ 5350
+ 5351
+ 5352
+ 5353
+ 5354
+ 5355
+ 5356
+ 5357
+ 5358
+ 5359
+ 5360
+ 5361
+ 5362
+ 5363
+ 5364
+ 5365
+ 5366
+ 5367
+ 5368
+ 5369
+ 5370
+ 5371
+ 5372
+ 5373
+ 5374
+ 5375
+ 5376
+ 5377
+ 5378
+ 5379
+ 5380
+ 5381
+ 5382
+ 5383
+ 5384
+ 5385
+ 5386
+ 5387
+ 5388
+ 5389
+ 5390
+ 5391
+ 5392
+ 5393
+ 5394
+ 5395
+ 5396
+ 5397
+ 5398
+ 5399
+ 5400
+ 5401
+ 5402
+ 5403
+ 5404
+ 5405
+ 5406
+ 5407
+ 5408
+ 5409
+ 5410
+ 5411
+ 5412
+ 5413
+ 5414
+ 5415
+ 5416
+ 5417
+ 5418
+ 5419
+ 5420
+ 5421
+ 5422
+ 5423
+ 5424
+ 5425
+ 5426
+ 5427
+ 5428
+ 5429
+ 5430
+ 5431
+ 5432
+ 5433
+ 5434
+ 5435
+ 5436
+ 5437
+ 5438
+ 5439
+ 5440
+ 5441
+ 5442
+ 5443
+ 5444
+ 5445
+ 5446
+ 5447
+ 5448
+ 5449
+ 5450
+ 5451
+ 5452
+ 5453
+ 5454
+ 5455
+ 5456
+ 5457
+ 5458
+ 5459
+ 5460
+ 5461
+ 5462
+ 5463
+ 5464
+ 5465
+ 5466
+ 5467
+ 5468
+ 5469
+ 5470
+ 5471
+ 5472
+ 5473
+ 5474
+ 5475
+ 5476
+ 5477
+ 5478
+ 5479
+ 5480
+ 5481
+ 5482
+ 5483
+ 5484
+ 5485
+ 5486
+ 5487
+ 5488
+ 5489
+ 5490
+ 5491
+ 5492
+ 5493
+ 5494
+ 5495
+ 5496
+ 5497
+ 5498
+ 5499
+ 5500
+ 5501
+ 5502
+ 5503
+ 5504
+ 5505
+ 5506
+ 5507
+ 5508
+ 5509
+ 5510
+ 5511
+ 5512
+ 5513
+ 5514
+ 5515
+ 5516
+ 5517
+ 5518
+ 5519
+ 5520
+ 5521
+ 5522
+ 5523
+ 5524
+ 5525
+ 5526
+ 5527
+ 5528
+ 5529
+ 5530
+ 5531
+ 5532
+ 5533
+ 5534
+ 5535
+ 5536
+ 5537
+ 5538
+ 5539
+ 5540
+ 5541
+ 5542
+ 5543
+ 5544
+ 5545
+ 5546
+ 5547
+ 5548
+ 5549
+ 5550
+ 5551
+ 5552
+ 5553
+ 5554
+ 5555
+ 5556
+ 5557
+ 5558
+ 5559
+ 5560
+ 5561
+ 5562
+ 5563
+ 5564
+ 5565
+ 5566
+ 5567
+ 5568
+ 5569
+ 5570
+ 5571
+ 5572
+ 5573
+ 5574
+ 5575
+ 5576
+ 5577
+ 5578
+ 5579
+ 5580
+ 5581
+ 5582
+ 5583
+ 5584
+ 5585
+ 5586
+ 5587
+ 5588
+ 5589
+ 5590
+ 5591
+ 5592
+ 5593
+ 5594
+ 5595
+ 5596
+ 5597
+ 5598
+ 5599
+ 5600
+ 5601
+ 5602
+ 5603
+ 5604
+ 5605
+ 5606
+ 5607
+ 5608
+ 5609
+ 5610
+ 5611
+ 5612
+ 5613
+ 5614
+ 5615
+ 5616
+ 5617
+ 5618
+ 5619
+ 5620
+ 5621
+ 5622
+ 5623
+ 5624
+ 5625
+ 5626
+ 5627
+ 5628
+ 5629
+ 5630
+ 5631
+ 5632
+ 5633
+ 5634
+ 5635
+ 5636
+ 5637
+ 5638
+ 5639
+ 5640
+ 5641
+ 5642
+ 5643
+ 5644
+ 5645
+ 5646
+ 5647
+ 5648
+ 5649
+ 5650
+ 5651
+ 5652
+ 5653
+ 5654
+ 5655
+ 5656
+ 5657
+ 5658
+ 5659
+ 5660
+ 5661
+ 5662
+ 5663
+ 5664
+ 5665
+ 5666
+ 5667
+ 5668
+ 5669
+ 5670
+ 5671
+ 5672
+ 5673
+ 5674
+ 5675
+ 5676
+ 5677
+ 5678
+ 5679
+ 5680
+ 5681
+ 5682
+ 5683
+ 5684
+ 5685
+ 5686
+ 5687
+ 5688
+ 5689
+ 5690
+ 5691
+ 5692
+ 5693
+ 5694
+ 5695
+ 5696
+ 5697
+ 5698
+ 5699
+ 5700
+ 5701
+ 5702
+ 5703
+ 5704
+ 5705
+ 5706
+ 5707
+ 5708
+ 5709
+ 5710
+ 5711
+ 5712
+ 5713
+ 5714
+ 5715
+ 5716
+ 5717
+ 5718
+ 5719
+ 5720
+ 5721
+ 5722
+ 5723
+ 5724
+ 5725
+ 5726
+ 5727
+ 5728
+ 5729
+ 5730
+ 5731
+ 5732
+ 5733
+ 5734
+ 5735
+ 5736
+ 5737
+ 5738
+ 5739
+ 5740
+ 5741
+ 5742
+ 5743
+ 5744
+ 5745
+ 5746
+ 5747
+ 5748
+ 5749
+ 5750
+ 5751
+ 5752
+ 5753
+ 5754
+ 5755
+ 5756
+ 5757
+ 5758
+ 5759
+ 5760
+ 5761
+ 5762
+ 5763
+ 5764
+ 5765
+ 5766
+ 5767
+ 5768
+ 5769
+ 5770
+ 5771
+ 5772
+ 5773
+ 5774
+ 5775
+ 5776
+ 5777
+ 5778
+ 5779
+ 5780
+ 5781
+ 5782
+ 5783
+ 5784
+ 5785
+ 5786
+ 5787
+ 5788
+ 5789
+ 5790
+ 5791
+ 5792
+ 5793
+ 5794
+ 5795
+ 5796
+ 5797
+ 5798
+ 5799
+ 5800
+ 5801
+ 5802
+ 5803
+ 5804
+ 5805
+ 5806
+ 5807
+ 5808
+ 5809
+ 5810
+ 5811
+ 5812
+ 5813
+ 5814
+ 5815
+ 5816
+ 5817
+ 5818
+ 5819
+ 5820
+ 5821
+ 5822
+ 5823
+ 5824
+ 5825
+ 5826
+ 5827
+ 5828
+ 5829
+ 5830
+ 5831
+ 5832
+ 5833
+ 5834
+ 5835
+ 5836
+ 5837
+ 5838
+ 5839
+ 5840
+ 5841
+ 5842
+ 5843
+ 5844
+ 5845
+ 5846
+ 5847
+ 5848
+ 5849
+ 5850
+ 5851
+ 5852
+ 5853
+ 5854
+ 5855
+ 5856
+ 5857
+ 5858
+ 5859
+ 5860
+ 5861
+ 5862
+ 5863
+ 5864
+ 5865
+ 5866
+ 5867
+ 5868
+ 5869
+ 5870
+ 5871
+ 5872
+ 5873
+ 5874
+ 5875
+ 5876
+ 5877
+ 5878
+ 5879
+ 5880
+ 5881
+ 5882
+ 5883
+ 5884
+ 5885
+ 5886
+ 5887
+ 5888
+ 5889
+ 5890
+ 5891
+ 5892
+ 5893
+ 5894
+ 5895
+ 5896
+ 5897
+ 5898
+ 5899
+ 5900
+ 5901
+ 5902
+ 5903
+ 5904
+ 5905
+ 5906
+ 5907
+ 5908
+ 5909
+ 5910
+ 5911
+ 5912
+ 5913
+ 5914
+ 5915
+ 5916
+ 5917
+ 5918
+ 5919
+ 5920
+ 5921
+ 5922
+ 5923
+ 5924
+ 5925
+ 5926
+ 5927
+ 5928
+ 5929
+ 5930
+ 5931
+ 5932
+ 5933
+ 5934
+ 5935
+ 5936
+ 5937
+ 5938
+ 5939
+ 5940
+ 5941
+ 5942
+ 5943
+ 5944
+ 5945
+ 5946
+ 5947
+ 5948
+ 5949
+ 5950
+ 5951
+ 5952
+ 5953
+ 5954
+ 5955
+ 5956
+ 5957
+ 5958
+ 5959
+ 5960
+ 5961
+ 5962
+ 5963
+ 5964
+ 5965
+ 5966
+ 5967
+ 5968
+ 5969
+ 5970
+ 5971
+ 5972
+ 5973
+ 5974
+ 5975
+ 5976
+ 5977
+ 5978
+ 5979
+ 5980
+ 5981
+ 5982
+ 5983
+ 5984
+ 5985
+ 5986
+ 5987
+ 5988
+ 5989
+ 5990
+ 5991
+ 5992
+ 5993
+ 5994
+ 5995
+ 5996
+ 5997
+ 5998
+ 5999
+ 6000
+ 6001
+ 6002
+ 6003
+ 6004
+ 6005
+ 6006
+ 6007
+ 6008
+ 6009
+ 6010
+ 6011
+ 6012
+ 6013
+ 6014
+ 6015
+ 6016
+ 6017
+ 6018
+ 6019
+ 6020
+ 6021
+ 6022
+ 6023
+ 6024
+ 6025
+ 6026
+ 6027
+ 6028
+ 6029
+ 6030
+ 6031
+ 6032
+ 6033
+ 6034
+ 6035
+ 6036
+ 6037
+ 6038
+ 6039
+ 6040
+ 6041
+ 6042
+ 6043
+ 6044
+ 6045
+ 6046
+ 6047
+ 6048
+ 6049
+ 6050
+ 6051
+ 6052
+ 6053
+ 6054
+ 6055
+ 6056
+ 6057
+ 6058
+ 6059
+ 6060
+ 6061
+ 6062
+ 6063
+ 6064
+ 6065
+ 6066
+ 6067
+ 6068
+ 6069
+ 6070
+ 6071
+ 6072
+ 6073
+ 6074
+ 6075
+ 6076
+ 6077
+ 6078
+ 6079
+ 6080
+ 6081
+ 6082
+ 6083
+ 6084
+ 6085
+ 6086
+ 6087
+ 6088
+ 6089
+ 6090
+ 6091
+ 6092
+ 6093
+ 6094
+ 6095
+ 6096
+ 6097
+ 6098
+ 6099
+ 6100
+ 6101
+ 6102
+ 6103
+ 6104
+ 6105
+ 6106
+ 6107
+ 6108
+ 6109
+ 6110
+ 6111
+ 6112
+ 6113
+ 6114
+ 6115
+ 6116
+ 6117
+ 6118
+ 6119
+ 6120
+ 6121
+ 6122
+ 6123
+ 6124
+ 6125
+ 6126
+ 6127
+ 6128
+ 6129
+ 6130
+ 6131
+ 6132
+ 6133
+ 6134
+ 6135
+ 6136
+ 6137
+ 6138
+ 6139
+ 6140
+ 6141
+ 6142
+ 6143
+ 6144
+ 6145
+ 6146
+ 6147
+ 6148
+ 6149
+ 6150
+ 6151
+ 6152
+ 6153
+ 6154
+ 6155
+ 6156
+ 6157
+ 6158
+ 6159
+ 6160
+ 6161
+ 6162
+ 6163
+ 6164
+ 6165
+ 6166
+ 6167
+ 6168
+ 6169
+ 6170
+ 6171
+ 6172
+ 6173
+ 6174
+ 6175
+ 6176
+ 6177
+ 6178
+ 6179
+ 6180
+ 6181
+ 6182
+ 6183
+ 6184
+ 6185
+ 6186
+ 6187
+ 6188
+ 6189
+ 6190
+ 6191
+ 6192
+ 6193
+ 6194
+ 6195
+ 6196
+ 6197
+ 6198
+ 6199
+ 6200
+ 6201
+ 6202
+ 6203
+ 6204
+ 6205
+ 6206
+ 6207
+ 6208
+ 6209
+ 6210
+ 6211
+ 6212
+ 6213
+ 6214
+ 6215
+ 6216
+ 6217
+ 6218
+ 6219
+ 6220
+ 6221
+ 6222
+ 6223
+ 6224
+ 6225
+ 6226
+ 6227
+ 6228
+ 6229
+ 6230
+ 6231
+ 6232
+ 6233
+ 6234
+ 6235
+ 6236
+ 6237
+ 6238
+ 6239
+ 6240
+ 6241
+ 6242
+ 6243
+ 6244
+ 6245
+ 6246
+ 6247
+ 6248
+ 6249
+ 6250
+ 6251
+ 6252
+ 6253
+ 6254
+ 6255
+ 6256
+ 6257
+ 6258
+ 6259
+ 6260
+ 6261
+ 6262
+ 6263
+ 6264
+ 6265
+ 6266
+ 6267
+ 6268
+ 6269
+ 6270
+ 6271
+ 6272
+ 6273
+ 6274
+ 6275
+ 6276
+ 6277
+ 6278
+ 6279
+ 6280
+ 6281
+ 6282
+ 6283
+ 6284
+ 6285
+ 6286
+ 6287
+ 6288
+ 6289
+ 6290
+ 6291
+ 6292
+ 6293
+ 6294
+ 6295
+ 6296
+ 6297
+ 6298
+ 6299
+ 6300
+ 6301
+ 6302
+ 6303
+ 6304
+ 6305
+ 6306
+ 6307
+ 6308
+ 6309
+ 6310
+ 6311
+ 6312
+ 6313
+ 6314
+ 6315
+ 6316
+ 6317
+ 6318
+ 6319
+ 6320
+ 6321
+ 6322
+ 6323
+ 6324
+ 6325
+ 6326
+ 6327
+ 6328
+ 6329
+ 6330
+ 6331
+ 6332
+ 6333
+ 6334
+ 6335
+ 6336
+ 6337
+ 6338
+ 6339
+ 6340
+ 6341
+ 6342
+ 6343
+ 6344
+ 6345
+ 6346
+ 6347
+ 6348
+ 6349
+ 6350
+ 6351
+ 6352
+ 6353
+ 6354
+ 6355
+ 6356
+ 6357
+ 6358
+ 6359
+ 6360
+ 6361
+ 6362
+ 6363
+ 6364
+ 6365
+ 6366
+ 6367
+ 6368
+ 6369
+ 6370
+ 6371
+ 6372
+ 6373
+ 6374
+ 6375
+ 6376
+ 6377
+ 6378
+ 6379
+ 6380
+ 6381
+ 6382
+ 6383
+ 6384
+ 6385
+ 6386
+ 6387
+ 6388
+ 6389
+ 6390
+ 6391
+ 6392
+ 6393
+ 6394
+ 6395
+ 6396
+ 6397
+ 6398
+ 6399
+ 6400
+ 6401
+ 6402
+ 6403
+ 6404
+ 6405
+ 6406
+ 6407
+ 6408
+ 6409
+ 6410
+ 6411
+ 6412
+ 6413
+ 6414
+ 6415
+ 6416
+ 6417
+ 6418
+ 6419
+ 6420
+ 6421
+ 6422
+ 6423
+ 6424
+ 6425
+ 6426
+ 6427
+ 6428
+ 6429
+ 6430
+ 6431
+ 6432
+ 6433
+ 6434
+ 6435
+ 6436
+ 6437
+ 6438
+ 6439
+ 6440
+ 6441
+ 6442
+ 6443
+ 6444
+ 6445
+ 6446
+ 6447
+ 6448
+ 6449
+ 6450
+ 6451
+ 6452
+ 6453
+ 6454
+ 6455
+ 6456
+ 6457
+ 6458
+ 6459
+ 6460
+ 6461
+ 6462
+ 6463
+ 6464
+ 6465
+ 6466
+ 6467
+ 6468
+ 6469
+ 6470
+ 6471
+ 6472
+ 6473
+ 6474
+ 6475
+ 6476
+ 6477
+ 6478
+ 6479
+ 6480
+ 6481
+ 6482
+ 6483
+ 6484
+ 6485
+ 6486
+ 6487
+ 6488
+ 6489
+ 6490
+ 6491
+ 6492
+ 6493
+ 6494
+ 6495
+ 6496
+ 6497
+ 6498
+ 6499
+ 6500
+ 6501
+ 6502
+ 6503
+ 6504
+ 6505
+ 6506
+ 6507
+ 6508
+ 6509
+ 6510
+ 6511
+ 6512
+ 6513
+ 6514
+ 6515
+ 6516
+ 6517
+ 6518
+ 6519
+ 6520
+ 6521
+ 6522
+ 6523
+ 6524
+ 6525
+ 6526
+ 6527
+ 6528
+ 6529
+ 6530
+ 6531
+ 6532
+ 6533
+ 6534
+ 6535
+ 6536
+ 6537
+ 6538
+ 6539
+ 6540
+ 6541
+ 6542
+ 6543
+ 6544
+ 6545
+ 6546
+ 6547
+ 6548
+ 6549
+ 6550
+ 6551
+ 6552
+ 6553
+ 6554
+ 6555
+ 6556
+ 6557
+ 6558
+ 6559
+ 6560
+ 6561
+ 6562
+ 6563
+ 6564
+ 6565
+ 6566
+ 6567
+ 6568
+ 6569
+ 6570
+ 6571
+ 6572
+ 6573
+ 6574
+ 6575
+ 6576
+ 6577
+ 6578
+ 6579
+ 6580
+ 6581
+ 6582
+ 6583
+ 6584
+ 6585
+ 6586
+ 6587
+ 6588
+ 6589
+ 6590
+ 6591
+ 6592
+ 6593
+ 6594
+ 6595
+ 6596
+ 6597
+ 6598
+ 6599
+ 6600
+ 6601
+ 6602
+ 6603
+ 6604
+ 6605
+ 6606
+ 6607
+ 6608
+ 6609
+ 6610
+ 6611
+ 6612
+ 6613
+ 6614
+ 6615
+ 6616
+ 6617
+ 6618
+ 6619
+ 6620
+ 6621
+ 6622
+ 6623
+ 6624
+ 6625
+ 6626
+ 6627
+ 6628
+ 6629
+ 6630
+ 6631
+ 6632
+ 6633
+ 6634
+ 6635
+ 6636
+ 6637
+ 6638
+ 6639
+ 6640
+ 6641
+ 6642
+ 6643
+ 6644
+ 6645
+ 6646
+ 6647
+ 6648
+ 6649
+ 6650
+ 6651
+ 6652
+ 6653
+ 6654
+ 6655
+ 6656
+ 6657
+ 6658
+ 6659
+ 6660
+ 6661
+ 6662
+ 6663
+ 6664
+ 6665
+ 6666
+ 6667
+ 6668
+ 6669
+ 6670
+ 6671
+ 6672
+ 6673
+ 6674
+ 6675
+ 6676
+ 6677
+ 6678
+ 6679
+ 6680
+ 6681
+ 6682
+ 6683
+ 6684
+ 6685
+ 6686
+ 6687
+ 6688
+ 6689
+ 6690
+ 6691
+ 6692
+ 6693
+ 6694
+ 6695
+ 6696
+ 6697
+ 6698
+ 6699
+ 6700
+ 6701
+ 6702
+ 6703
+ 6704
+ 6705
+ 6706
+ 6707
+ 6708
+ 6709
+ 6710
+ 6711
+ 6712
+ 6713
+ 6714
+ 6715
+ 6716
+ 6717
+ 6718
+ 6719
+ 6720
+ 6721
+ 6722
+ 6723
+ 6724
+ 6725
+ 6726
+ 6727
+ 6728
+ 6729
+ 6730
+ 6731
+ 6732
+ 6733
+ 6734
+ 6735
+ 6736
+ 6737
+ 6738
+ 6739
+ 6740
+ 6741
+ 6742
+ 6743
+ 6744
+ 6745
+ 6746
+ 6747
+ 6748
+ 6749
+ 6750
+ 6751
+ 6752
+ 6753
+ 6754
+ 6755
+ 6756
+ 6757
+ 6758
+ 6759
+ 6760
+ 6761
+ 6762
+ 6763
+ 6764
+ 6765
+ 6766
+ 6767
+ 6768
+ 6769
+ 6770
+ 6771
+ 6772
+ 6773
+ 6774
+ 6775
+ 6776
+ 6777
+ 6778
+ 6779
+ 6780
+ 6781
+ 6782
+ 6783
+ 6784
+ 6785
+ 6786
+ 6787
+ 6788
+ 6789
+ 6790
+ 6791
+ 6792
+ 6793
+ 6794
+ 6795
+ 6796
+ 6797
+ 6798
+ 6799
+ 6800
+ 6801
+ 6802
+ 6803
+ 6804
+ 6805
+ 6806
+ 6807
+ 6808
+ 6809
+ 6810
+ 6811
+ 6812
+ 6813
+ 6814
+ 6815
+ 6816
+ 6817
+ 6818
+ 6819
+ 6820
+ 6821
+ 6822
+ 6823
+ 6824
+ 6825
+ 6826
+ 6827
+ 6828
+ 6829
+ 6830
+ 6831
+ 6832
+ 6833
+ 6834
+ 6835
+ 6836
+ 6837
+ 6838
+ 6839
+ 6840
+ 6841
+ 6842
+ 6843
+ 6844
+ 6845
+ 6846
+ 6847
+ 6848
+ 6849
+ 6850
+ 6851
+ 6852
+ 6853
+ 6854
+ 6855
+ 6856
+ 6857
+ 6858
+ 6859
+ 6860
+ 6861
+ 6862
+ 6863
+ 6864
+ 6865
+ 6866
+ 6867
+ 6868
+ 6869
+ 6870
+ 6871
+ 6872
+ 6873
+ 6874
+ 6875
+ 6876
+ 6877
+ 6878
+ 6879
+ 6880
+ 6881
+ 6882
+ 6883
+ 6884
+ 6885
+ 6886
+ 6887
+ 6888
+ 6889
+ 6890
+ 6891
+ 6892
+ 6893
+ 6894
+ 6895
+ 6896
+ 6897
+ 6898
+ 6899
+ 6900
+ 6901
+ 6902
+ 6903
+ 6904
+ 6905
+ 6906
+ 6907
+ 6908
+ 6909
+ 6910
+ 6911
+ 6912
+ 6913
+ 6914
+ 6915
+ 6916
+ 6917
+ 6918
+ 6919
+ 6920
+ 6921
+ 6922
+ 6923
+ 6924
+ 6925
+ 6926
+ 6927
+ 6928
+ 6929
+ 6930
+ 6931
+ 6932
+ 6933
+ 6934
+ 6935
+ 6936
+ 6937
+ 6938
+ 6939
+ 6940
+ 6941
+ 6942
+ 6943
+ 6944
+ 6945
+ 6946
+ 6947
+ 6948
+ 6949
+ 6950
+ 6951
+ 6952
+ 6953
+ 6954
+ 6955
+ 6956
+ 6957
+ 6958
+ 6959
+ 6960
+ 6961
+ 6962
+ 6963
+ 6964
+ 6965
+ 6966
+ 6967
+ 6968
+ 6969
+ 6970
+ 6971
+ 6972
+ 6973
+ 6974
+ 6975
+ 6976
+ 6977
+ 6978
+ 6979
+ 6980
+ 6981
+ 6982
+ 6983
+ 6984
+ 6985
+ 6986
+ 6987
+ 6988
+ 6989
+ 6990
+ 6991
+ 6992
+ 6993
+ 6994
+ 6995
+ 6996
+ 6997
+ 6998
+ 6999
+ 7000
+ 7001
+ 7002
+ 7003
+ 7004
+ 7005
+ 7006
+ 7007
+ 7008
+ 7009
+ 7010
+ 7011
+ 7012
+ 7013
+ 7014
+ 7015
+ 7016
+ 7017
+ 7018
+ 7019
+ 7020
+ 7021
+ 7022
+ 7023
+ 7024
+ 7025
+ 7026
+ 7027
+ 7028
+ 7029
+ 7030
+ 7031
+ 7032
+ 7033
+ 7034
+ 7035
+ 7036
+ 7037
+ 7038
+ 7039
+ 7040
+ 7041
+ 7042
+ 7043
+ 7044
+ 7045
+ 7046
+ 7047
+ 7048
+ 7049
+ 7050
+ 7051
+ 7052
+ 7053
+ 7054
+ 7055
+ 7056
+ 7057
+ 7058
+ 7059
+ 7060
+ 7061
+ 7062
+ 7063
+ 7064
+ 7065
+ 7066
+ 7067
+ 7068
+ 7069
+ 7070
+ 7071
+ 7072
+ 7073
+ 7074
+ 7075
+ 7076
+ 7077
+ 7078
+ 7079
+ 7080
+ 7081
+ 7082
+ 7083
+ 7084
+ 7085
+ 7086
+ 7087
+ 7088
+ 7089
+ 7090
+ 7091
+ 7092
+ 7093
+ 7094
+ 7095
+ 7096
+ 7097
+ 7098
+ 7099
+ 7100
+ 7101
+ 7102
+ 7103
+ 7104
+ 7105
+ 7106
+ 7107
+ 7108
+ 7109
+ 7110
+ 7111
+ 7112
+ 7113
+ 7114
+ 7115
+ 7116
+ 7117
+ 7118
+ 7119
+ 7120
+ 7121
+ 7122
+ 7123
+ 7124
+ 7125
+ 7126
+ 7127
+ 7128
+ 7129
+ 7130
+ 7131
+ 7132
+ 7133
+ 7134
+ 7135
+ 7136
+ 7137
+ 7138
+ 7139
+ 7140
+ 7141
+ 7142
+ 7143
+ 7144
+ 7145
+ 7146
+ 7147
+ 7148
+ 7149
+ 7150
+ 7151
+ 7152
+ 7153
+ 7154
+ 7155
+ 7156
+ 7157
+ 7158
+ 7159
+ 7160
+ 7161
+ 7162
+ 7163
+ 7164
+ 7165
+ 7166
+ 7167
+ 7168
+ 7169
+ 7170
+ 7171
+ 7172
+ 7173
+ 7174
+ 7175
+ 7176
+ 7177
+ 7178
+ 7179
+ 7180
+ 7181
+ 7182
+ 7183
+ 7184
+ 7185
+ 7186
+ 7187
+ 7188
+ 7189
+ 7190
+ 7191
+ 7192
+ 7193
+ 7194
+ 7195
+ 7196
+ 7197
+ 7198
+ 7199
+ 7200
+ 7201
+ 7202
+ 7203
+ 7204
+ 7205
+ 7206
+ 7207
+ 7208
+ 7209
+ 7210
+ 7211
+ 7212
+ 7213
+ 7214
+ 7215
+ 7216
+ 7217
+ 7218
+ 7219
+ 7220
+ 7221
+ 7222
+ 7223
+ 7224
+ 7225
+ 7226
+ 7227
+ 7228
+ 7229
+ 7230
+ 7231
+ 7232
+ 7233
+ 7234
+ 7235
+ 7236
+ 7237
+ 7238
+ 7239
+ 7240
+ 7241
+ 7242
+ 7243
+ 7244
+ 7245
+ 7246
+ 7247
+ 7248
+ 7249
+ 7250
+ 7251
+ 7252
+ 7253
+ 7254
+ 7255
+ 7256
+ 7257
+ 7258
+ 7259
+ 7260
+ 7261
+ 7262
+ 7263
+ 7264
+ 7265
+ 7266
+ 7267
+ 7268
+ 7269
+ 7270
+ 7271
+ 7272
+ 7273
+ 7274
+ 7275
+ 7276
+ 7277
+ 7278
+ 7279
+ 7280
+ 7281
+ 7282
+ 7283
+ 7284
+ 7285
+ 7286
+ 7287
+ 7288
+ 7289
+ 7290
+ 7291
+ 7292
+ 7293
+ 7294
+ 7295
+ 7296
+ 7297
+ 7298
+ 7299
+ 7300
+ 7301
+ 7302
+ 7303
+ 7304
+ 7305
+ 7306
+ 7307
+ 7308
+ 7309
+ 7310
+ 7311
+ 7312
+ 7313
+ 7314
+ 7315
+ 7316
+ 7317
+ 7318
+ 7319
+ 7320
+ 7321
+ 7322
+ 7323
+ 7324
+ 7325
+ 7326
+ 7327
+ 7328
+ 7329
+ 7330
+ 7331
+ 7332
+ 7333
+ 7334
+ 7335
+ 7336
+ 7337
+ 7338
+ 7339
+ 7340
+ 7341
+ 7342
+ 7343
+ 7344
+ 7345
+ 7346
+ 7347
+ 7348
+ 7349
+ 7350
+ 7351
+ 7352
+ 7353
+ 7354
+ 7355
+ 7356
+ 7357
+ 7358
+ 7359
+ 7360
+ 7361
+ 7362
+ 7363
+ 7364
+ 7365
+ 7366
+ 7367
+ 7368
+ 7369
+ 7370
+ 7371
+ 7372
+ 7373
+ 7374
+ 7375
+ 7376
+ 7377
+ 7378
+ 7379
+ 7380
+ 7381
+ 7382
+ 7383
+ 7384
+ 7385
+ 7386
+ 7387
+ 7388
+ 7389
+ 7390
+ 7391
+ 7392
+ 7393
+ 7394
+ 7395
+ 7396
+ 7397
+ 7398
+ 7399
+ 7400
+ 7401
+ 7402
+ 7403
+ 7404
+ 7405
+ 7406
+ 7407
+ 7408
+ 7409
+ 7410
+ 7411
+ 7412
+ 7413
+ 7414
+ 7415
+ 7416
+ 7417
+ 7418
+ 7419
+ 7420
+ 7421
+ 7422
+ 7423
+ 7424
+ 7425
+ 7426
+ 7427
+ 7428
+ 7429
+ 7430
+ 7431
+ 7432
+ 7433
+ 7434
+ 7435
+ 7436
+ 7437
+ 7438
+ 7439
+ 7440
+ 7441
+ 7442
+ 7443
+ 7444
+ 7445
+ 7446
+ 7447
+ 7448
+ 7449
+ 7450
+ 7451
+ 7452
+ 7453
+ 7454
+ 7455
+ 7456
+ 7457
+ 7458
+ 7459
+ 7460
+ 7461
+ 7462
+ 7463
+ 7464
+ 7465
+ 7466
+ 7467
+ 7468
+ 7469
+ 7470
+ 7471
+ 7472
+ 7473
+ 7474
+ 7475
+ 7476
+ 7477
+ 7478
+ 7479
+ 7480
+ 7481
+ 7482
+ 7483
+ 7484
+ 7485
+ 7486
+ 7487
+ 7488
+ 7489
+ 7490
+ 7491
+ 7492
+ 7493
+ 7494
+ 7495
+ 7496
+ 7497
+ 7498
+ 7499
+ 7500
+ 7501
+ 7502
+ 7503
+ 7504
+ 7505
+ 7506
+ 7507
+ 7508
+ 7509
+ 7510
+ 7511
+ 7512
+ 7513
+ 7514
+ 7515
+ 7516
+ 7517
+ 7518
+ 7519
+ 7520
+ 7521
+ 7522
+ 7523
+ 7524
+ 7525
+ 7526
+ 7527
+ 7528
+ 7529
+ 7530
+ 7531
+ 7532
+ 7533
+ 7534
+ 7535
+ 7536
+ 7537
+ 7538
+ 7539
+ 7540
+ 7541
+ 7542
+ 7543
+ 7544
+ 7545
+ 7546
+ 7547
+ 7548
+ 7549
+ 7550
+ 7551
+ 7552
+ 7553
+ 7554
+ 7555
+ 7556
+ 7557
+ 7558
+ 7559
+ 7560
+ 7561
+ 7562
+ 7563
+ 7564
+ 7565
+ 7566
+ 7567
+ 7568
+ 7569
+ 7570
+ 7571
+ 7572
+ 7573
+ 7574
+ 7575
+ 7576
+ 7577
+ 7578
+ 7579
+ 7580
+ 7581
+ 7582
+ 7583
+ 7584
+ 7585
+ 7586
+ 7587
+ 7588
+ 7589
+ 7590
+ 7591
+ 7592
+ 7593
+ 7594
+ 7595
+ 7596
+ 7597
+ 7598
+ 7599
+ 7600
+ 7601
+ 7602
+ 7603
+ 7604
+ 7605
+ 7606
+ 7607
+ 7608
+ 7609
+ 7610
+ 7611
+ 7612
+ 7613
+ 7614
+ 7615
+ 7616
+ 7617
+ 7618
+ 7619
+ 7620
+ 7621
+ 7622
+ 7623
+ 7624
+ 7625
+ 7626
+ 7627
+ 7628
+ 7629
+ 7630
+ 7631
+ 7632
+ 7633
+ 7634
+ 7635
+ 7636
+ 7637
+ 7638
+ 7639
+ 7640
+ 7641
+ 7642
+ 7643
+ 7644
+ 7645
+ 7646
+ 7647
+ 7648
+ 7649
+ 7650
+ 7651
+ 7652
+ 7653
+ 7654
+ 7655
+ 7656
+ 7657
+ 7658
+ 7659
+ 7660
+ 7661
+ 7662
+ 7663
+ 7664
+ 7665
+ 7666
+ 7667
+ 7668
+ 7669
+ 7670
+ 7671
+ 7672
+ 7673
+ 7674
+ 7675
+ 7676
+ 7677
+ 7678
+ 7679
+ 7680
+ 7681
+ 7682
+ 7683
+ 7684
+ 7685
+ 7686
+ 7687
+ 7688
+ 7689
+ 7690
+ 7691
+ 7692
+ 7693
+ 7694
+ 7695
+ 7696
+ 7697
+ 7698
+ 7699
+ 7700
+ 7701
+ 7702
+ 7703
+ 7704
+ 7705
+ 7706
+ 7707
+ 7708
+ 7709
+ 7710
+ 7711
+ 7712
+ 7713
+ 7714
+ 7715
+ 7716
+ 7717
+ 7718
+ 7719
+ 7720
+ 7721
+ 7722
+ 7723
+ 7724
+ 7725
+ 7726
+ 7727
+ 7728
+ 7729
+ 7730
+ 7731
+ 7732
+ 7733
+ 7734
+ 7735
+ 7736
+ 7737
+ 7738
+ 7739
+ 7740
+ 7741
+ 7742
+ 7743
+ 7744
+ 7745
+ 7746
+ 7747
+ 7748
+ 7749
+ 7750
+ 7751
+ 7752
+ 7753
+ 7754
+ 7755
+ 7756
+ 7757
+ 7758
+ 7759
+ 7760
+ 7761
+ 7762
+ 7763
+ 7764
+ 7765
+ 7766
+ 7767
+ 7768
+ 7769
+ 7770
+ 7771
+ 7772
+ 7773
+ 7774
+ 7775
+ 7776
+ 7777
+ 7778
+ 7779
+ 7780
+ 7781
+ 7782
+ 7783
+ 7784
+ 7785
+ 7786
+ 7787
+ 7788
+ 7789
+ 7790
+ 7791
+ 7792
+ 7793
+ 7794
+ 7795
+ 7796
+ 7797
+ 7798
+ 7799
+ 7800
+ 7801
+ 7802
+ 7803
+ 7804
+ 7805
+ 7806
+ 7807
+ 7808
+ 7809
+ 7810
+ 7811
+ 7812
+ 7813
+ 7814
+ 7815
+ 7816
+ 7817
+ 7818
+ 7819
+ 7820
+ 7821
+ 7822
+ 7823
+ 7824
+ 7825
+ 7826
+ 7827
+ 7828
+ 7829
+ 7830
+ 7831
+ 7832
+ 7833
+ 7834
+ 7835
+ 7836
+ 7837
+ 7838
+ 7839
+ 7840
+ 7841
+ 7842
+ 7843
+ 7844
+ 7845
+ 7846
+ 7847
+ 7848
+ 7849
+ 7850
+ 7851
+ 7852
+ 7853
+ 7854
+ 7855
+ 7856
+ 7857
+ 7858
+ 7859
+ 7860
+ 7861
+ 7862
+ 7863
+ 7864
+ 7865
+ 7866
+ 7867
+ 7868
+ 7869
+ 7870
+ 7871
+ 7872
+ 7873
+ 7874
+ 7875
+ 7876
+ 7877
+ 7878
+ 7879
+ 7880
+ 7881
+ 7882
+ 7883
+ 7884
+ 7885
+ 7886
+ 7887
+ 7888
+ 7889
+ 7890
+ 7891
+ 7892
+ 7893
+ 7894
+ 7895
+ 7896
+ 7897
+ 7898
+ 7899
+ 7900
+ 7901
+ 7902
+ 7903
+ 7904
+ 7905
+ 7906
+ 7907
+ 7908
+ 7909
+ 7910
+ 7911
+ 7912
+ 7913
+ 7914
+ 7915
+ 7916
+ 7917
+ 7918
+ 7919
+ 7920
+ 7921
+ 7922
+ 7923
+ 7924
+ 7925
+ 7926
+ 7927
+ 7928
+ 7929
+ 7930
+ 7931
+ 7932
+ 7933
+ 7934
+ 7935
+ 7936
+ 7937
+ 7938
+ 7939
+ 7940
+ 7941
+ 7942
+ 7943
+ 7944
+ 7945
+ 7946
+ 7947
+ 7948
+ 7949
+ 7950
+ 7951
+ 7952
+ 7953
+ 7954
+ 7955
+ 7956
+ 7957
+ 7958
+ 7959
+ 7960
+ 7961
+ 7962
+ 7963
+ 7964
+ 7965
+ 7966
+ 7967
+ 7968
+ 7969
+ 7970
+ 7971
+ 7972
+ 7973
+ 7974
+ 7975
+ 7976
+ 7977
+ 7978
+ 7979
+ 7980
+ 7981
+ 7982
+ 7983
+ 7984
+ 7985
+ 7986
+ 7987
+ 7988
+ 7989
+ 7990
+ 7991
+ 7992
+ 7993
+ 7994
+ 7995
+ 7996
+ 7997
+ 7998
+ 7999
+ 8000
+ 0
+SYMFNC: intern SYMFNC
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern ID2INT
+ jrst ID2INT##
+ extern L1760
+ jrst L1760##
+ extern INT2ID
+ jrst INT2ID##
+ extern L1746
+ jrst L1746##
+ extern L1766
+ jrst L1766##
+ extern L0016
+ jrst L0016##
+ extern L0022
+ jrst L0022##
+ extern L1772
+ jrst L1772##
+ extern L0026
+ jrst L0026##
+ extern L0030
+ jrst L0030##
+ extern GTFIXN
+ jrst GTFIXN##
+ extern L0035
+ jrst L0035##
+ extern L0042
+ jrst L0042##
+ extern GTVECT
+ jrst GTVECT##
+ extern L1775
+ jrst L1775##
+ extern L0052
+ jrst L0052##
+ extern GTSTR
+ jrst GTSTR##
+ extern L1778
+ jrst L1778##
+ extern L0061
+ jrst L0061##
+ extern LENGTH
+ jrst LENGTH##
+ extern L1757
+ jrst L1757##
+ extern L0072
+ jrst L0072##
+ extern CONS
+ jrst CONS##
+ extern L0079
+ jrst L0079##
+ extern L0090
+ jrst L0090##
+ extern GETV
+ jrst GETV##
+ extern BLDMSG
+ jrst BLDMSG##
+ extern L1711
+ jrst L1711##
+ extern L1754
+ jrst L1754##
+ extern PUTV
+ jrst PUTV##
+ extern UPBV
+ jrst UPBV##
+ extern L0127
+ jrst L0127##
+ extern EGETV
+ jrst EGETV##
+ extern EPUTV
+ jrst EPUTV##
+ extern EUPBV
+ jrst EUPBV##
+ extern INDX
+ jrst INDX##
+ extern L1710
+ jrst L1710##
+ extern L1784
+ jrst L1784##
+ extern L0186
+ jrst L0186##
+ extern SUB
+ jrst SUB##
+ extern SUBSEQ
+ jrst SUBSEQ##
+ extern GTWRDS
+ jrst GTWRDS##
+ extern L1106
+ jrst L1106##
+ extern NCONS
+ jrst NCONS##
+ extern TCONC
+ jrst TCONC##
+ extern SETSUB
+ jrst SETSUB##
+ extern L0262
+ jrst L0262##
+ extern CONCAT
+ jrst CONCAT##
+ extern APPEND
+ jrst APPEND##
+ extern SIZE
+ jrst SIZE##
+ extern CODEP
+ jrst CODEP##
+ extern EQ
+ jrst EQ##
+ extern FLOATP
+ jrst FLOATP##
+ extern BIGP
+ jrst BIGP##
+ extern IDP
+ jrst IDP##
+ extern PAIRP
+ jrst PAIRP##
+ extern L0372
+ jrst L0372##
+ extern L0375
+ jrst L0375##
+ extern CAR
+ jrst CAR##
+ extern CDR
+ jrst CDR##
+ extern RPLACA
+ jrst RPLACA##
+ extern RPLACD
+ jrst RPLACD##
+ extern FIXP
+ jrst FIXP##
+ extern DIGIT
+ jrst DIGIT##
+ extern LITER
+ jrst LITER##
+ extern EQN
+ jrst EQN##
+ extern L0429
+ jrst L0429##
+ extern L0469
+ jrst L0469##
+ extern EQSTR
+ jrst EQSTR##
+ jrst L0429##
+ extern CAAAAR
+ jrst CAAAAR##
+ extern CAAAR
+ jrst CAAAR##
+ extern CAAADR
+ jrst CAAADR##
+ extern CAADAR
+ jrst CAADAR##
+ extern CAADR
+ jrst CAADR##
+ extern CAADDR
+ jrst CAADDR##
+ extern CADAAR
+ jrst CADAAR##
+ extern CADAR
+ jrst CADAR##
+ extern CADADR
+ jrst CADADR##
+ extern CADDAR
+ jrst CADDAR##
+ extern CADDR
+ jrst CADDR##
+ extern CADDDR
+ jrst CADDDR##
+ extern CDAAAR
+ jrst CDAAAR##
+ extern CDAAR
+ jrst CDAAR##
+ extern CDAADR
+ jrst CDAADR##
+ extern CDADAR
+ jrst CDADAR##
+ extern CDADR
+ jrst CDADR##
+ extern CDADDR
+ jrst CDADDR##
+ extern CDDAAR
+ jrst CDDAAR##
+ extern CDDAR
+ jrst CDDAR##
+ extern CDDADR
+ jrst CDDADR##
+ extern CDDDAR
+ jrst CDDDAR##
+ extern CDDDR
+ jrst CDDDR##
+ extern CDDDDR
+ jrst CDDDDR##
+ extern CAAR
+ jrst CAAR##
+ extern CADR
+ jrst CADR##
+ extern CDAR
+ jrst CDAR##
+ extern CDDR
+ jrst CDDR##
+ extern L0597
+ jrst L0597##
+ extern L0602
+ jrst L0602##
+ extern ATOM
+ jrst ATOM##
+ extern L0625
+ jrst L0625##
+ extern NULL
+ jrst NULL##
+ extern L0632
+ jrst L0632##
+ extern EXPT
+ jrst EXPT##
+ extern L0861
+ jrst L0861##
+ extern LIST3
+ jrst LIST3##
+ extern L1737
+ jrst L1737##
+ extern L1482
+ jrst L1482##
+ extern L1407
+ jrst L1407##
+ extern MINUSP
+ jrst MINUSP##
+ extern TIMES2
+ jrst TIMES2##
+ extern ADD1
+ jrst ADD1##
+ extern L1424
+ jrst L1424##
+ extern PLUS2
+ jrst PLUS2##
+ extern LIST
+ jrst LIST##
+ extern EVLIS
+ jrst EVLIS##
+ extern QUOTE
+ jrst QUOTE##
+ JSP 10,SYMFNC+516
+ extern DE
+ jrst DE##
+ extern LIST2
+ jrst LIST2##
+ extern LIST4
+ jrst LIST4##
+ extern PUTD
+ jrst PUTD##
+ extern L0811
+ jrst L0811##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern DF
+ jrst DF##
+ JSP 10,SYMFNC+516
+ extern DM
+ jrst DM##
+ JSP 10,SYMFNC+516
+ extern DN
+ jrst DN##
+ extern SETQ
+ jrst SETQ##
+ extern EVAL
+ jrst EVAL##
+ extern SET
+ jrst SET##
+ extern PROG2
+ jrst PROG2##
+ extern PROGN
+ jrst PROGN##
+ extern L0676
+ jrst L0676##
+ extern AND
+ jrst AND##
+ extern EVAND
+ jrst EVAND##
+ extern OR
+ jrst OR##
+ extern EVOR
+ jrst EVOR##
+ extern COND
+ jrst COND##
+ extern EVCOND
+ jrst EVCOND##
+ extern NOT
+ jrst NOT##
+ extern ABS
+ jrst ABS##
+ extern MINUS
+ jrst MINUS##
+ extern DIVIDE
+ jrst DIVIDE##
+ extern ZEROP
+ jrst ZEROP##
+ extern L1442
+ jrst L1442##
+ extern XCONS
+ jrst XCONS##
+ extern MAX
+ jrst MAX##
+ extern L0805
+ jrst L0805##
+ extern MAX2
+ jrst MAX2##
+ extern LESSP
+ jrst LESSP##
+ extern MIN
+ jrst MIN##
+ extern MIN2
+ jrst MIN2##
+ extern PLUS
+ jrst PLUS##
+ extern TIMES
+ jrst TIMES##
+ extern MAP
+ jrst MAP##
+ extern L1865
+ jrst L1865##
+ extern MAPC
+ jrst MAPC##
+ extern MAPCAN
+ jrst MAPCAN##
+ extern NCONC
+ jrst NCONC##
+ extern MAPCON
+ jrst MAPCON##
+ extern MAPCAR
+ jrst MAPCAR##
+ extern L0737
+ jrst L0737##
+ extern ASSOC
+ jrst ASSOC##
+ extern SASSOC
+ jrst SASSOC##
+ extern PAIR
+ jrst PAIR##
+ extern SUBLIS
+ jrst SUBLIS##
+ extern L0772
+ jrst L0772##
+ extern PUT
+ jrst PUT##
+ extern DELETE
+ jrst DELETE##
+ extern MEMBER
+ jrst MEMBER##
+ extern MEMQ
+ jrst MEMQ##
+ extern L0794
+ jrst L0794##
+ extern SUBST
+ jrst SUBST##
+ extern EXPAND
+ jrst EXPAND##
+ extern L0812
+ jrst L0812##
+ extern L2814
+ jrst L2814##
+ extern L2334
+ jrst L2334##
+ extern PRINT
+ jrst PRINT##
+ JSP 10,SYMFNC+516
+ extern NEQ
+ jrst NEQ##
+ extern NE
+ jrst NE##
+ extern GEQ
+ jrst GEQ##
+ extern LEQ
+ jrst LEQ##
+ extern EQCAR
+ jrst EQCAR##
+ extern EXPRP
+ jrst EXPRP##
+ extern GETD
+ jrst GETD##
+ extern MACROP
+ jrst MACROP##
+ extern FEXPRP
+ jrst FEXPRP##
+ extern NEXPRP
+ jrst NEXPRP##
+ extern COPYD
+ jrst COPYD##
+ extern RECIP
+ jrst RECIP##
+ extern FIRST
+ jrst FIRST##
+ extern SECOND
+ jrst SECOND##
+ extern THIRD
+ jrst THIRD##
+ extern FOURTH
+ jrst FOURTH##
+ extern REST
+ jrst REST##
+ extern L0868
+ jrst L0868##
+ extern L0878
+ jrst L0878##
+ extern L0890
+ jrst L0890##
+ extern DELQ
+ jrst DELQ##
+ extern DEL
+ jrst DEL##
+ extern DELQIP
+ jrst DELQIP##
+ extern ATSOC
+ jrst ATSOC##
+ extern ASS
+ jrst ASS##
+ extern MEM
+ jrst MEM##
+ extern RASSOC
+ jrst RASSOC##
+ extern DELASC
+ jrst DELASC##
+ extern L0947
+ jrst L0947##
+ extern DELATQ
+ jrst DELATQ##
+ extern L0968
+ jrst L0968##
+ extern SUBLA
+ jrst SUBLA##
+ extern RPLACW
+ jrst RPLACW##
+ extern L0986
+ jrst L0986##
+ extern L0990
+ jrst L0990##
+ extern COPY
+ jrst COPY##
+ extern NTH
+ jrst NTH##
+ extern SUB1
+ jrst SUB1##
+ extern PNTH
+ jrst PNTH##
+ extern ACONC
+ jrst ACONC##
+ extern LCONC
+ jrst LCONC##
+ extern MAP2
+ jrst MAP2##
+ extern MAPC2
+ jrst MAPC2##
+ extern L1035
+ jrst L1035##
+ extern L2335
+ jrst L2335##
+ extern PRIN2T
+ jrst PRIN2T##
+ extern L1036
+ jrst L1036##
+ extern L2272
+ jrst L2272##
+ extern SPACES
+ jrst SPACES##
+ extern L1040
+ jrst L1040##
+ extern L2330
+ jrst L2330##
+ extern TAB
+ jrst TAB##
+ extern FILEP
+ jrst FILEP##
+ extern PUTC
+ jrst PUTC##
+ jrst TAB##
+ jrst L1040##
+ extern L1044
+ jrst L1044##
+ extern L1050
+ jrst L1050##
+ extern ADJOIN
+ jrst ADJOIN##
+ extern L1056
+ jrst L1056##
+ extern UNION
+ jrst UNION##
+ extern UNIONQ
+ jrst UNIONQ##
+ extern XN
+ jrst XN##
+ extern XNQ
+ jrst XNQ##
+ jrst XN##
+ jrst XNQ##
+ extern L1089
+ jrst L1089##
+ extern GTHEAP
+ jrst GTHEAP##
+ extern L1706
+ jrst L1706##
+ extern L1265
+ jrst L1265##
+ extern L1098
+ jrst L1098##
+ extern L1101
+ jrst L1101##
+ extern L1103
+ jrst L1103##
+ extern L1105
+ jrst L1105##
+ extern GTBPS
+ jrst GTBPS##
+ jrst GTVECT##
+ extern GTFLTN
+ jrst GTFLTN##
+ extern GTID
+ jrst GTID##
+ extern L1260
+ jrst L1260##
+ extern DELBPS
+ jrst DELBPS##
+ extern L1119
+ jrst L1119##
+ extern L1122
+ jrst L1122##
+ extern L1127
+ jrst L1127##
+ extern L1134
+ jrst L1134##
+ extern L1135
+ jrst L1135##
+ extern L1142
+ jrst L1142##
+ extern L1148
+ jrst L1148##
+ extern L1152
+ jrst L1152##
+ extern L1158
+ jrst L1158##
+ extern L1163
+ jrst L1163##
+ extern MKVECT
+ jrst MKVECT##
+ extern L1198
+ jrst L1198##
+ JSP 10,SYMFNC+516
+ extern L1208
+ jrst L1208##
+ extern L1769
+ jrst L1769##
+ extern L1218
+ jrst L1218##
+ extern L1228
+ jrst L1228##
+ extern L1238
+ jrst L1238##
+ extern L1248
+ jrst L1248##
+ extern STRING
+ jrst STRING##
+ extern VECTOR
+ jrst VECTOR##
+ extern LIST5
+ jrst LIST5##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2884
+ jrst L2884##
+ extern TIMC
+ jrst TIMC##
+ extern L2088
+ jrst L2088##
+ extern L1395
+ jrst L1395##
+ extern L1396
+ jrst L1396##
+ extern LAND
+ jrst LAND##
+ extern LOR
+ jrst LOR##
+ extern LXOR
+ jrst LXOR##
+ extern LSHIFT
+ jrst LSHIFT##
+ jrst LSHIFT##
+ extern LNOT
+ jrst LNOT##
+ extern FIX
+ jrst FIX##
+ extern FLOAT
+ jrst FLOAT##
+ extern ONEP
+ jrst ONEP##
+ JSP 10,SYMFNC+516
+ extern TR
+ jrst TR##
+ extern EVLOAD
+ jrst EVLOAD##
+ extern TRST
+ jrst TRST##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern EDITF
+ jrst EDITF##
+ extern EDIT
+ jrst EDIT##
+ extern YESP
+ jrst YESP##
+ JSP 10,SYMFNC+516
+ extern L3369
+ jrst L3369##
+ extern TERPRI
+ jrst TERPRI##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3372
+ jrst L3372##
+ extern READ
+ jrst READ##
+ JSP 10,SYMFNC+516
+ extern HELP
+ jrst HELP##
+ extern BREAK
+ jrst BREAK##
+ extern EHELP
+ jrst EHELP##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L1668
+ jrst L1668##
+ extern PRINTF
+ jrst PRINTF##
+ extern L1672
+ jrst L1672##
+ extern L2072
+ jrst L2072##
+ JSP 10,SYMFNC+516
+ extern L1690
+ jrst L1690##
+ JSP 10,SYMFNC+516
+ extern L2279
+ jrst L2279##
+ extern L2620
+ jrst L2620##
+ JSP 10,SYMFNC+516
+ extern PRIN1
+ jrst PRIN1##
+ extern QUIT
+ jrst QUIT##
+ extern ERROR
+ jrst ERROR##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern RDS
+ jrst RDS##
+ JSP 10,SYMFNC+516
+ extern WRS
+ jrst WRS##
+ extern L1805
+ jrst L1805##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2907
+ jrst L2907##
+ extern L1749
+ jrst L1749##
+ extern L1763
+ jrst L1763##
+ extern L1781
+ jrst L1781##
+ extern L1787
+ jrst L1787##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern THROW
+ jrst THROW##
+ JSP 10,SYMFNC+516
+ extern ERRSET
+ jrst ERRSET##
+ extern CATCH
+ jrst CATCH##
+ extern L2013
+ jrst L2013##
+ JSP 10,SYMFNC+516
+ extern L2021
+ jrst L2021##
+ extern L1809
+ jrst L1809##
+ extern L1824
+ jrst L1824##
+ extern L1812
+ jrst L1812##
+ extern L1815
+ jrst L1815##
+ extern L1818
+ jrst L1818##
+ extern L1821
+ jrst L1821##
+ extern L1829
+ jrst L1829##
+ extern L1836
+ jrst L1836##
+ extern L1844
+ jrst L1844##
+ extern LBIND1
+ jrst LBIND1##
+ extern L1855
+ jrst L1855##
+ extern L3350
+ jrst L3350##
+ extern L3355
+ jrst L3355##
+ JSP 10,SYMFNC+516
+ extern L1869
+ jrst L1869##
+ extern L3359
+ jrst L3359##
+ extern APPLY
+ jrst APPLY##
+ extern L3144
+ jrst L3144##
+ extern FCODEP
+ jrst FCODEP##
+ extern L3174
+ jrst L3174##
+ extern GET
+ jrst GET##
+ extern L3390
+ jrst L3390##
+ extern L3194
+ jrst L3194##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L1970
+ jrst L1970##
+ extern L1982
+ jrst L1982##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern %THROW
+ jrst %THROW##
+ extern L2006
+ jrst L2006##
+ extern L2009
+ jrst L2009##
+ extern L2010
+ jrst L2010##
+ extern RESET
+ jrst RESET##
+ extern L3354
+ jrst L3354##
+ extern L2022
+ jrst L2022##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern PROG
+ jrst PROG##
+ extern PBIND1
+ jrst PBIND1##
+ JSP 10,SYMFNC+516
+ extern GO
+ jrst GO##
+ extern RETURN
+ jrst RETURN##
+ JSP 10,SYMFNC+516
+ extern DATE
+ jrst DATE##
+ extern L2085
+ jrst L2085##
+ extern L2097
+ jrst L2097##
+ extern L3539
+ jrst L3539##
+ extern L2102
+ jrst L2102##
+ extern L2104
+ jrst L2104##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2106
+ jrst L2106##
+ extern L2108
+ jrst L2108##
+ extern FASLIN
+ jrst FASLIN##
+ extern INTERN
+ jrst INTERN##
+ extern L2164
+ jrst L2164##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern LOAD
+ jrst LOAD##
+ extern LOAD1
+ jrst LOAD1##
+ extern RELOAD
+ jrst RELOAD##
+ extern L2172
+ jrst L2172##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2202
+ jrst L2202##
+ extern PP
+ jrst PP##
+ extern L2211
+ jrst L2211##
+ extern L2218
+ jrst L2218##
+ extern STEP
+ jrst STEP##
+ extern MINI
+ jrst MINI##
+ extern EMODE
+ jrst EMODE##
+ extern INVOKE
+ jrst INVOKE##
+ JSP 10,SYMFNC+516
+ extern CREFON
+ jrst CREFON##
+ JSP 10,SYMFNC+516
+ extern COMPD
+ jrst COMPD##
+ extern L2243
+ jrst L2243##
+ extern BUG
+ jrst BUG##
+ extern EXEC
+ jrst EXEC##
+ extern MM
+ jrst MM##
+ extern L3517
+ jrst L3517##
+ extern L2911
+ jrst L2911##
+ extern L3502
+ jrst L3502##
+ extern L2891
+ jrst L2891##
+ extern L2902
+ jrst L2902##
+ extern L2906
+ jrst L2906##
+ JSP 10,SYMFNC+516
+ extern L2263
+ jrst L2263##
+ extern L2268
+ jrst L2268##
+ JSP 10,SYMFNC+516
+ extern L2280
+ jrst L2280##
+ extern L2281
+ jrst L2281##
+ extern OPEN
+ jrst OPEN##
+ extern L3538
+ jrst L3538##
+ extern L3545
+ jrst L3545##
+ extern L3534
+ jrst L3534##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern CLOSE
+ jrst CLOSE##
+ extern L3529
+ jrst L3529##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2321
+ jrst L2321##
+ extern EJECT
+ jrst EJECT##
+ extern L2326
+ jrst L2326##
+ extern L2329
+ jrst L2329##
+ extern POSN
+ jrst POSN##
+ extern L2331
+ jrst L2331##
+ extern LPOSN
+ jrst LPOSN##
+ extern L2332
+ jrst L2332##
+ JSP 10,SYMFNC+516
+ extern READCH
+ jrst READCH##
+ extern PRIN2
+ jrst PRIN2##
+ jrst L2335##
+ JSP 10,SYMFNC+516
+ extern L2336
+ jrst L2336##
+ extern L2426
+ jrst L2426##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2339
+ jrst L2339##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2552
+ jrst L2552##
+ JSP 10,SYMFNC+516
+ extern L2342
+ jrst L2342##
+ JSP 10,SYMFNC+516
+ extern L2345
+ jrst L2345##
+ extern L2348
+ jrst L2348##
+ extern L2361
+ jrst L2361##
+ extern L2368
+ jrst L2368##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern NEWID
+ jrst NEWID##
+ extern L2512
+ jrst L2512##
+ extern L2510
+ jrst L2510##
+ extern L2551
+ jrst L2551##
+ JSP 10,SYMFNC+516
+ extern GLOBAL
+ jrst GLOBAL##
+ extern RATOM
+ jrst RATOM##
+ extern L2544
+ jrst L2544##
+ extern L2547
+ jrst L2547##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2558
+ jrst L2558##
+ extern L2561
+ jrst L2561##
+ extern L2564
+ jrst L2564##
+ extern L2572
+ jrst L2572##
+ extern L2574
+ jrst L2574##
+ extern L2575
+ jrst L2575##
+ extern L2576
+ jrst L2576##
+ extern L2578
+ jrst L2578##
+ extern L2848
+ jrst L2848##
+ extern L2579
+ jrst L2579##
+ extern L2583
+ jrst L2583##
+ extern L2590
+ jrst L2590##
+ extern L2597
+ jrst L2597##
+ extern L2601
+ jrst L2601##
+ extern L2613
+ jrst L2613##
+ extern L2616
+ jrst L2616##
+ extern L2621
+ jrst L2621##
+ extern L2638
+ jrst L2638##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2796
+ jrst L2796##
+ extern L2662
+ jrst L2662##
+ extern L2827
+ jrst L2827##
+ extern L2683
+ jrst L2683##
+ extern L2701
+ jrst L2701##
+ extern L2714
+ jrst L2714##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2725
+ jrst L2725##
+ extern L2742
+ jrst L2742##
+ extern L2760
+ jrst L2760##
+ extern L2778
+ jrst L2778##
+ jrst PRIN2##
+ JSP 10,SYMFNC+516
+ extern PRIN2L
+ jrst PRIN2L##
+ extern L2893
+ jrst L2893##
+ extern L2901
+ jrst L2901##
+ JSP 10,SYMFNC+516
+ extern L2903
+ jrst L2903##
+ extern L2904
+ jrst L2904##
+ extern L2908
+ jrst L2908##
+ extern L2917
+ jrst L2917##
+ JSP 10,SYMFNC+516
+ extern L2914
+ jrst L2914##
+ extern L2918
+ jrst L2918##
+ extern L2919
+ jrst L2919##
+ extern L2920
+ jrst L2920##
+ extern L2921
+ jrst L2921##
+ extern TYI
+ jrst TYI##
+ extern TYO
+ jrst TYO##
+ extern L2922
+ jrst L2922##
+ extern L2923
+ jrst L2923##
+ extern L2924
+ jrst L2924##
+ extern L2925
+ jrst L2925##
+ jrst L2925##
+ extern L2932
+ jrst L2932##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern CASE
+ jrst CASE##
+ JSP 10,SYMFNC+516
+ extern SETF
+ jrst SETF##
+ extern L2968
+ jrst L2968##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L2979
+ jrst L2979##
+ extern L2988
+ jrst L2988##
+ JSP 10,SYMFNC+516
+ extern ON
+ jrst ON##
+ extern OFF
+ jrst OFF##
+ JSP 10,SYMFNC+516
+ extern DS
+ jrst DS##
+ extern L3044
+ jrst L3044##
+ extern L3048
+ jrst L3048##
+ extern CONST
+ jrst CONST##
+ extern L3053
+ jrst L3053##
+ JSP 10,SYMFNC+516
+ extern L3073
+ jrst L3073##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern EXIT
+ jrst EXIT##
+ JSP 10,SYMFNC+516
+ extern NEXT
+ jrst NEXT##
+ extern WHILE
+ jrst WHILE##
+ extern REPEAT
+ jrst REPEAT##
+ extern FOR
+ jrst FOR##
+ extern GENSYM
+ jrst GENSYM##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3149
+ jrst L3149##
+ extern L3160
+ jrst L3160##
+ extern L3164
+ jrst L3164##
+ extern L3169
+ jrst L3169##
+ extern PROP
+ jrst PROP##
+ extern L3181
+ jrst L3181##
+ extern FLAGP
+ jrst FLAGP##
+ JSP 10,SYMFNC+516
+ extern FLAG
+ jrst FLAG##
+ extern FLAG1
+ jrst FLAG1##
+ extern L3220
+ jrst L3220##
+ extern L3227
+ jrst L3227##
+ extern L3238
+ jrst L3238##
+ extern L3244
+ jrst L3244##
+ extern L3378
+ jrst L3378##
+ JSP 10,SYMFNC+516
+ extern FLUID
+ jrst FLUID##
+ extern FLUID1
+ jrst FLUID1##
+ extern FLUIDP
+ jrst FLUIDP##
+ extern L3270
+ jrst L3270##
+ extern L3273
+ jrst L3273##
+ extern L3276
+ jrst L3276##
+ extern L3281
+ jrst L3281##
+ extern REMD
+ jrst REMD##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3345
+ jrst L3345##
+ extern L3353
+ jrst L3353##
+ extern L3358
+ jrst L3358##
+ extern L3383
+ jrst L3383##
+ extern L3425
+ jrst L3425##
+ extern REMOB
+ jrst REMOB##
+ extern L3457
+ jrst L3457##
+ extern L3470
+ jrst L3470##
+ extern MAPOBL
+ jrst MAPOBL##
+ extern L3482
+ jrst L3482##
+ extern L3488
+ jrst L3488##
+ extern L3490
+ jrst L3490##
+ extern L3493
+ jrst L3493##
+ extern L3498
+ jrst L3498##
+ JSP 10,SYMFNC+516
+ extern L3507
+ jrst L3507##
+ extern L3532
+ jrst L3532##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern L3609
+ jrst L3609##
+ JSP 10,SYMFNC+516
+ extern L3571
+ jrst L3571##
+ JSP 10,SYMFNC+516
+ extern L3574
+ jrst L3574##
+ extern L3575
+ jrst L3575##
+ extern L3579
+ jrst L3579##
+ extern L3584
+ jrst L3584##
+ extern L3587
+ jrst L3587##
+ extern L3591
+ jrst L3591##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern TIME
+ jrst TIME##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ extern INP
+ jrst INP##
+ extern REDO
+ jrst REDO##
+ extern ANS
+ jrst ANS##
+ extern HIST
+ jrst HIST##
+ JSP 10,SYMFNC+516
+ extern L3655
+ jrst L3655##
+ extern L3658
+ jrst L3658##
+ extern L3661
+ jrst L3661##
+ JSP 10,SYMFNC+516
+ extern L3663
+ jrst L3663##
+ extern DSKIN
+ jrst DSKIN##
+ extern L3684
+ jrst L3684##
+ extern LAPIN
+ jrst LAPIN##
+ extern MAIN.
+ jrst MAIN.##
+ extern L3702
+ jrst L3702##
+ extern MAIN
+ jrst MAIN##
+ extern L3721
+ jrst L3721##
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ JSP 10,SYMFNC+516
+ block 7148
+L0001: intern L0001
+ 853
+ end
ADDED psl-1983/3-1/kernel/20/dmain.rel
Index: psl-1983/3-1/kernel/20/dmain.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dmain.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dprop.mac
Index: psl-1983/3-1/kernel/20/dprop.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dprop.mac
@@ -0,0 +1,13 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+UNDEFN: <24377294848+<SYMFNC+0>>+516
+ intern UNDEFN
+LAMLNK: <24377294848+<SYMFNC+0>>+512
+ intern LAMLNK
+ end
ADDED psl-1983/3-1/kernel/20/dprop.rel
Index: psl-1983/3-1/kernel/20/dprop.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dprop.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/drandm.mac
Index: psl-1983/3-1/kernel/20/drandm.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/drandm.mac
@@ -0,0 +1,9 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ end
ADDED psl-1983/3-1/kernel/20/drandm.rel
Index: psl-1983/3-1/kernel/20/drandm.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/drandm.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dsymbl.mac
Index: psl-1983/3-1/kernel/20/dsymbl.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dsymbl.mac
@@ -0,0 +1,22 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+BNDSTK: block 2001
+ intern BNDSTK
+L1255: BNDSTK+0
+ intern L1255
+L1825: BNDSTK+1999
+ intern L1825
+L1256: BNDSTK+0
+ intern L1256
+L3465: 4
+ byte(7)71,48,48,48,48,0
+ intern L3465
+L3479: 0
+ intern L3479
+ end
ADDED psl-1983/3-1/kernel/20/dsymbl.rel
Index: psl-1983/3-1/kernel/20/dsymbl.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dsymbl.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dsysio.mac
Index: psl-1983/3-1/kernel/20/dsysio.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dsysio.mac
@@ -0,0 +1,17 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L2260
+ extern L2253
+ extern L2254
+ extern L2255
+L3504: 1
+ intern L3504
+L3505: block 41
+ intern L3505
+ end
ADDED psl-1983/3-1/kernel/20/dsysio.rel
Index: psl-1983/3-1/kernel/20/dsysio.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dsysio.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dtloop.mac
Index: psl-1983/3-1/kernel/20/dtloop.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dtloop.mac
@@ -0,0 +1,9 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ end
ADDED psl-1983/3-1/kernel/20/dtloop.rel
Index: psl-1983/3-1/kernel/20/dtloop.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dtloop.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dtypes.mac
Index: psl-1983/3-1/kernel/20/dtypes.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dtypes.mac
@@ -0,0 +1,9 @@
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ end
ADDED psl-1983/3-1/kernel/20/dtypes.rel
Index: psl-1983/3-1/kernel/20/dtypes.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dtypes.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/dumplisp.red
Index: psl-1983/3-1/kernel/20/dumplisp.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/dumplisp.red
@@ -0,0 +1,82 @@
+%
+% DUMPLISP.RED - Dump running Lisp into a file
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 25 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 27-May-83 Mark R. Swanson
+% Changes for extended addressing
+% <PSL.KERNEL-20>DUMPLISP.RED.2, 5-Oct-82 10:57:34, Edit by BENSON
+% Removed DumpFileName!* added filename arg to Dumplisp
+% <PSL.20-INTERP>DUMPLISP.RED.7, 3-Sep-82 10:22:46, Edit by BENSON
+% Fixed page boundary bug when unmapping stack
+
+CompileTime <<
+
+flag('(unmap!-pages save!-into!-file), 'InternalFunction);
+
+>>;
+
+on Syslisp;
+
+external WVar ST, HeapLast, HeapUpperBound, NextBPS, LastBPS, StackUpperBound;
+
+syslsp procedure DumpLisp Filename;
+<< if not StringP Filename then
+ StdError "Dumplisp requires a filename argument";
+ Reclaim;
+ unmap!-space(HeapLast, HeapUpperBound);
+ unmap!-space(NextBPS, LastBPS);
+ %% Add some slack to the end of the stack fo the call to unmap-space!
+ unmap!-space(MakeAddressFromStackPointer ST + 10, StackUpperBound);
+ save!-into!-file Filename >>;
+
+syslsp procedure unmap!-space(Lo, Hi);
+begin scalar LoPage, HiPage;
+ LoPage := LSH(Lo + 8#777, -9);
+ HiPage := LSH(Hi - 8#1000, -9);
+ return if not (LoPage >= HiPage) then
+ unmap!-pages(LoPage, HiPage - LoPage);
+end;
+
+lap '((!*entry unmap!-pages expr 2)
+ (hrlzi 3 2#100000000000000000) % pm%cnt in AC3
+ (hrr 3 2) % page count in rh AC3
+ (hrlzi 2 8#400000) % .fhslf in lh AC2
+ (hrr 2 1) % starting page in rh AC2
+ (!*MOVE (WConst -1) (REG 1)) % -1 in AC1
+ (pmap) % do it
+ (!*EXIT 0)
+);
+
+lap '((!*entry save!-into!-file expr 1)
+ (!*MOVE (reg 1) (reg 5)) % save in 5
+ (move 2 1) % file name in 2
+ (!*MkItem (reg 2) 8#66) % make a byte pointer
+ (hrlzi 1 2#100000000000000001) % gj%fou + gj%sht
+ (gtjfn)
+ (jrst CouldntOpen)
+ (hrli 1 8#400000) % .fhslf
+ (hrrzi 2 2#101011000000000000) % ss%cpy, ss%rd, ss%exe, ss%e??,all pages
+% (hrli 2 -8#1000) % for Release 4 and before, 1000 pages
+%/ Change previous line to following line for extended addressing
+ (tlo 2 8#400000) % large negative number
+ (!*MOVE (WConst 8#1000) (REG 3))
+ (ssave)
+ (!*MOVE (WConst 0) (REG 1))
+ (!*EXIT 0)
+CouldntOpen
+ (!*MOVE '"Couldn't GTJFN `%w' for Dumplisp" (reg 1))
+ (!*MOVE (reg 5) (reg 2))
+ (!*CALL BldMsg)
+ (!*JCALL StdError)
+);
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/easy-non-sl.red
Index: psl-1983/3-1/kernel/20/easy-non-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/easy-non-sl.red
@@ -0,0 +1,396 @@
+%
+% EASY-NON-SL.RED - Commonly used Non-Standard Lisp functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>EASY-NON-SL.RED.2, 17-Sep-82 16:10:18, Edit by BENSON
+% Added ChannelPrin2T, ChannelSpaces, ChannelTab, ChannelSpaces2
+% <PSL.INTERP>EASY-NON-SL.RED.7, 9-Jul-82 12:46:43, Edit by BENSON
+% Changed NTH to improve error reporting, using DoPNTH
+% <PSL.INTERP>EASY-NON-SL.RED.2, 19-Apr-82 23:05:35, Edit by BENSON
+% Changed order of tests in PNTH
+% <PSL.INTERP>EASY-NON-SL.RED.20, 23-Feb-82 21:36:36, Edit by BENSON
+% Added NE (not eq)
+% <PSL.INTERP>EASY-NON-SL.RED.19, 16-Feb-82 22:30:33, Edit by BENSON
+% made NEQ GEQ and LEQ back into EXPRs
+% <PSL.INTERP>EASY-NON-SL.RED.16, 15-Feb-82 18:01:14, Edit by BENSON
+% Made NEQ GEQ and LEQ into macros
+% <PSL.INTERP>EASY-NON-SL.RED.12, 18-Jan-82 12:28:13, Edit by BENSON
+% Added NexprP
+
+CompileTime flag('(DelqIP1 DeletIP1 SubstIP1 DelAscIP1 DelAtQIP1 DoPNTH),
+ 'InternalFunction);
+
+% predicates
+
+expr procedure NEQ(U, V); %. not EQUAL (should be changed to not EQ)
+ not(U = V);
+
+expr procedure NE(U, V); %. not EQ
+ not(U eq V);
+
+expr procedure GEQ(U, V); %. greater than or equal to
+ not(U < V);
+
+expr procedure LEQ(U, V); %. less than or equal to
+ not(U > V);
+
+lisp procedure EqCar(U, V); %. car U eq V
+ PairP U and car U eq V;
+
+lisp procedure ExprP U; %. Is U an EXPR?
+ EqCar(U, 'LAMBDA) or CodeP U or EqCar(GetD U, 'EXPR);
+
+lisp procedure MacroP U; %. Is U a MACRO?
+ EqCar(GetD U, 'MACRO);
+
+lisp procedure FexprP U; %. Is U an FEXPR?
+ EqCar(GetD U, 'FEXPR);
+
+lisp procedure NexprP U; %. Is U an NEXPR?
+ EqCar(GetD U, 'NEXPR);
+
+% Function definition
+
+lisp procedure CopyD(New, Old); %. FunDef New := FunDef Old;
+%
+% CopyD(New:id, Old:id):id
+% -----------------------
+% Type: EVAL, SPREAD
+% The function body and type for New become the same as Old. If no
+% definition exists for Old, the error
+%
+% ***** `Old' has no definition in CopyD
+%
+% occurs. New is returned.
+%
+begin scalar OldDef;
+ OldDef := GetD Old;
+ if PairP OldDef then
+ PutD(New, car OldDef, cdr OldDef)
+ else
+ StdError BldMsg("%r has no definition in CopyD", Old);
+ return New;
+end;
+
+% Numerical functions
+
+lisp procedure Recip N; %. Floating point reciprocal
+ 1.0 / N;
+
+% Commonly used constructors
+
+lisp procedure MkQuote U; %. Eval MkQuote U eq U
+ list('QUOTE, U);
+
+
+% Nicer names to access parts of a list
+
+macro procedure First U; %. First element of a list
+ 'CAR . cdr U;
+
+macro procedure Second U; %. Second element of a list
+ 'CADR . cdr U;
+
+macro procedure Third U; %. Third element of a list
+ 'CADDR . cdr U;
+
+macro procedure Fourth U; %. Fourth element of a list
+ 'CADDDR . cdr U;
+
+macro procedure Rest U; %. Tail of a list
+ 'CDR . cdr U;
+
+
+% Destructive and EQ versions of Standard Lisp functions
+
+lisp procedure ReversIP U; %. Destructive REVERSE (REVERSe In Place)
+begin scalar X,Y;
+ while PairP U do
+ << X := cdr U;
+ Y := RplacD(U, Y);
+ U := X >>;
+ return Y
+end;
+
+lisp procedure SubstIP1(A, X, L); % Auxiliary function for SubstIP
+<< if X = car L then RplacA(L, A)
+ else if PairP car L then SubstIP(A, X, car L);
+ if PairP cdr L then SubstIP(A, X, cdr L) >>;
+
+lisp procedure SubstIP(A, X, L); %. Destructive version of Subst
+ if null L then NIL
+ else if X = L then A
+ else if not PairP L then L
+ else
+ << SubstIP1(A, X, L);
+ L >>;
+
+lisp procedure DeletIP1(U, V); % Auxiliary function for DeletIP
+ if PairP cdr V then
+ if U = cadr V then RplacD(V, cddr V)
+ else DeletIP1(U, cdr V);
+
+lisp procedure DeletIP(U, V); %. Destructive DELETE
+ if not PairP V then V
+ else if U = car V then cdr V
+ else
+ << DeletIP1(U, V);
+ V >>;
+
+lisp procedure DelQ(U, V); %. EQ version of DELETE
+ if not PairP V then V
+ else if car V eq U then cdr V
+ else car V . DelQ(U, cdr V);
+
+lisp procedure Del(F, U, V); %. Generalized Delete, F is comparison function
+ if not PairP V then V
+ else if Apply(F, list(car V, U)) then cdr V
+ else car V . Del(F, U, cdr V);
+
+lisp procedure DelqIP1(U, V); % Auxiliary function for DelqIP
+ if PairP cdr V then
+ if U eq cadr V then RplacD(V, cddr V)
+ else DelqIP1(U, cdr V);
+
+lisp procedure DelqIP(U, V); %. Destructive DELQ
+ if not PairP V then V
+ else if U eq car V then cdr V
+ else
+ << DelqIP1(U, V);
+ V >>;
+
+lisp procedure Atsoc(U, V); %. EQ version of ASSOC
+ if not PairP V then NIL
+ else if PairP car V and U eq caar V then car V
+ else Atsoc(U, cdr V);
+
+lisp procedure Ass(F, U, V); %. Generalized Assoc, F is comparison function
+%
+% Not to be confused with Elbow
+%
+ if not PairP V then NIL
+ else if PairP car V and Apply(F, list(U, caar V)) then car V
+ else Ass(F, U, cdr V);
+
+lisp procedure Mem(F, U, V); %. Generalized Member, F is comparison function
+ if not PairP V then NIL
+ else if Apply(F, list(U, car V)) then V
+ else Mem(F, U, cdr V);
+
+lisp procedure RAssoc(U, V); %. Reverse Assoc, compare with cdr of entry
+ if not PairP V then NIL
+ else if PairP car V and U = cdar V then car V
+ else RAssoc(U, cdr V);
+
+lisp procedure DelAsc(U, V); %. Remove first (U . xxx) from V
+ if not PairP V then NIL
+ else if PairP car V and U = caar V then cdr V
+ else car V . DelAsc(U, cdr V);
+
+lisp procedure DelAscIP1(U, V); % Auxiliary function for DelAscIP
+ if PairP cdr V then
+ if PairP cadr V and U = caadr V then
+ RplacD(V, cddr V)
+ else DelAscIP1(U, cdr V);
+
+lisp procedure DelAscIP(U, V); %. Destructive DelAsc
+ if not PairP V then NIL
+ else if PairP car V and U = caar V then cdr V
+ else
+ << DelAscIP1(U, V);
+ V >>;
+
+lisp procedure DelAtQ(U, V); %. EQ version of DELASC
+ if not PairP V then NIL
+ else if EqCar(car V, U) then cdr V
+ else car V . DelAtQ(U, cdr V);
+
+lisp procedure DelAtQIP1(U, V); % Auxiliary function for DelAtQIP
+ if PairP cdr V then
+ if PairP cadr V and U eq caadr V then
+ RplacD(V, cddr V)
+ else DelAtQIP1(U, cdr V);
+
+lisp procedure DelAtQIP(U, V); %. Destructive DelAtQ
+ if not PairP V then NIL
+ else if PairP car V and U eq caar V then cdr V
+ else
+ << DelAtQIP1(U, V);
+ V >>;
+
+lisp procedure SublA(U,V); %. EQ version of SubLis, replaces atoms only
+begin scalar X;
+ return if not PairP U or null V then V
+ else if atom V then
+ if (X := Atsoc(V, U)) then cdr X else V
+ else SublA(U, car V) . SublA(U, cdr V)
+end;
+
+
+lisp procedure RplacW(A, B); %. RePLACe Whole pair
+ if PairP A then
+ if PairP B then
+ RplacA(RplacD(A,
+ cdr B),
+ car B)
+ else
+ NonPairError(B, 'RplacW)
+ else
+ NonPairError(A, 'RPlacW);
+
+lisp procedure LastCar X; %. last element of list
+ if atom X then X else car LastPair X;
+
+lisp procedure LastPair X; %. last pair of list
+ if atom X or atom cdr X then X else LastPair cdr X;
+
+lisp procedure Copy U; %. copy all pairs in S-Expr
+%
+% See also TotalCopy in COPIERS.RED
+%
+ if PairP U then Copy car U . Copy cdr U else U; % blows up if circular
+
+
+lisp procedure NTH(U, N); %. N-th element of list
+(lambda(X);
+ if PairP X then car X else RangeError(U, N, 'NTH))(DoPNTH(U, N));
+
+lisp procedure DoPNTH(U, N);
+ if N = 1 or not PairP U then U
+ else DoPNTH(cdr U, N - 1);
+
+lisp procedure PNTH(U, N); %. Pointer to N-th element of list
+ if N = 1 then U
+ else if not PairP U then
+ RangeError(U, N, 'PNTH)
+ else PNTH(cdr U, N - 1);
+
+lisp procedure AConc(U, V); %. destructively add element V to the tail of U
+ NConc(U, list V);
+
+lisp procedure TConc(Ptr, Elem); %. AConc maintaining pointer to end
+%
+% ACONC with pointer to end of list
+% Ptr is (list . last CDR of list)
+% returns updated Ptr
+% Ptr should be initialized to (NIL . NIL) before calling the first time
+%
+<< Elem := list Elem;
+ if not PairP Ptr then % if PTR not initialized, return starting ptr
+ Elem . Elem
+ else if null cdr Ptr then % Nothing in the list yet
+ RplacA(RplacD(Ptr, Elem), Elem)
+ else
+ << RplacD(cdr Ptr, Elem);
+ RplacD(Ptr, Elem) >> >>;
+
+lisp procedure LConc(Ptr, Lst); %. NConc maintaining pointer to end
+%
+% NCONC with pointer to end of list
+% Ptr is (list . last CDR of list)
+% returns updated Ptr
+% Ptr should be initialized to NIL . NIL before calling the first time
+%
+ if null Lst then Ptr
+ else if atom Ptr then % if PTR not initialized, return starting ptr
+ Lst . LastPair Lst
+ else if null cdr Ptr then % Nothing in the list yet
+ RplacA(RplacD(Ptr, LastPair Lst), Lst)
+ else
+ << RplacD(cdr Ptr, Lst);
+ RplacD(Ptr, LastPair Lst) >>;
+
+
+% MAP functions of 2 arguments
+
+lisp procedure Map2(L, M, Fn); %. for each X, Y on L, M do Fn(X, Y);
+<< while PairP L and PairP M do
+ << Apply(Fn, list(L, M));
+ L := cdr L;
+ M := cdr M >>;
+ if PairP L or PairP M then
+ StdError "Different length lists in MAP2"
+ else NIL >>;
+
+lisp procedure MapC2(L, M, Fn); %. for each X, Y in L, M do Fn(X, Y);
+<< while PairP L and PairP M do
+ << Apply(Fn, list(car L, car M));
+ L := cdr L;
+ M := cdr M >>;
+ if PairP L or PairP M then
+ StdError "Different length lists in MAPC2"
+ else NIL >>;
+
+% Printing functions
+
+lisp procedure ChannelPrin2T(C, U); %. Prin2 and TerPri
+<< ChannelPrin2(C, U);
+ ChannelTerPri C;
+ U >>;
+
+lisp procedure Prin2T U; %. Prin2 and TerPri
+ ChannelPrin2T(OUT!*, U);
+
+lisp procedure ChannelSpaces(C, N); %. Prin2 N spaces
+ for I := 1 step 1 until N do ChannelWriteChar(C, char BLANK);
+
+lisp procedure Spaces N; %. Prin2 N spaces
+ ChannelSpaces(OUT!*, N);
+
+lisp procedure ChannelTAB(Chn, N); %. Spaces to column N
+begin scalar M;
+ M := ChannelPosn Chn;
+ if N < M then
+ << ChannelTerPri Chn;
+ M := 0 >>;
+ ChannelSpaces(Chn, N - M);
+end;
+
+lisp procedure TAB N; %. Spaces to column N
+ ChannelTAB(OUT!*, N);
+
+if_system(Dec20, <<
+lap '((!*entry FileP expr 1)
+ (!*MOVE (REG 1) (REG 2))
+ (!*MkItem (reg 2) 8#66) % make a byte pointer
+ (hrlzi 1 2#001000000000000001) % gj%old + gj%sht
+ (gtjfn)
+ (jrst NotFile)
+ (rljfn) % release it
+ (jfcl)
+ (!*MOVE (QUOTE T) (REG 1))
+ (!*EXIT 0)
+NotFile
+ (!*MOVE (QUOTE NIL) (REG 1))
+ (!*EXIT 0)
+); >>, <<
+lisp procedure FileP F; %. is F an existing file?
+%
+% This could be done more efficiently in a much more system-dependent way,
+% but efficiency probably doesn't matter too much here.
+%
+ if PairP(F := ErrorSet(list('OPEN, MkQuote F, '(QUOTE INPUT)), NIL, NIL))
+ then
+ << Close car F;
+ T >>
+ else NIL; >>);
+
+% This doesn't belong anywhere and will be eliminated soon
+
+lisp procedure PutC(Name, Ind, Exp); %. Used by RLISP to define SMACROs
+<< put(Name, Ind, Exp);
+ Name >>;
+
+LoadTime <<
+ PutD('Spaces2, 'EXPR, cdr GetD 'TAB); % For compatibility
+ PutD('ChannelSpaces2, 'EXPR, cdr GetD 'ChannelTAB);
+>>;
+
+END;
ADDED psl-1983/3-1/kernel/20/error.ctl
Index: psl-1983/3-1/kernel/20/error.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/error.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:EX-DEC20-CROSS.EXE
+ASMOut "error";
+PathIn "error.build";
+ASMEnd;
+quit;
+compile error.mac, derror.mac
ADDED psl-1983/3-1/kernel/20/error.init
Index: psl-1983/3-1/kernel/20/error.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/error.init
@@ -0,0 +1,7 @@
+(FLUID (QUOTE (!*CONTINUABLEERROR ERRORFORM!* BREAKLEVEL!* MAXBREAKLEVEL!*
+!*EMSGP)))
+(GLOBAL (QUOTE (EMSG!*)))
+(GLOBAL (QUOTE (EMSG!*)))
+(FLUID (QUOTE (!*BACKTRACE !*INNER!*BACKTRACE !*EMSGP !*BREAK BREAKLEVEL!*
+MAXBREAKLEVEL!* !*CONTINUABLEERROR)))
+(PUT (QUOTE ERRSET) (QUOTE TYPE) (QUOTE MACRO))
ADDED psl-1983/3-1/kernel/20/error.log
Index: psl-1983/3-1/kernel/20/error.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/error.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/error.mac
Index: psl-1983/3-1/kernel/20/error.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/error.mac
@@ -0,0 +1,460 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+L1705: 20
+ byte(7)42,42,42,42,42,32,70,97,116,97,108,32,101,114,114,111,114,58,32,37,115,0
+ 1
+; (!*ENTRY FATALERROR EXPR 1)
+L1706: intern L1706
+ PUSH 15,1
+ MOVE 2,1
+ MOVE 1,L1704
+ PUSHJ 15,SYMFNC+418
+L1707: PUSHJ 15,SYMFNC+471
+ JRST L1707
+L1704: <4_30>+<1_18>+L1705
+L1709: 33
+ byte(7)73,110,100,101,120,32,37,114,32,111,117,116,32,111,102,32,114,97,110,103,101,32,102,111,114,32,37,112,32,105,110,32,37,112,0
+ 3
+; (!*ENTRY RANGEERROR EXPR 3)
+L1710: intern L1710
+ MOVE 4,3
+ MOVE 3,1
+ MOVE 1,L1708
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L1708: <4_30>+<1_18>+L1709
+ 1
+; (!*ENTRY STDERROR EXPR 1)
+L1711: intern L1711
+ MOVE 2,1
+ HRRZI 1,99
+ JRST SYMFNC+472
+L1718: <30_30>+451
+ <30_30>+128
+L1719: <30_30>+78
+ <9_30>+<1_18>+L1722
+L1720: <30_30>+89
+ <9_30>+<1_18>+L1723
+L1721: 12
+ byte(7)63,37,108,32,40,89,32,111,114,32,78,41,32,0
+L1722: <30_30>+473
+ <30_30>+128
+L1723: <30_30>+474
+ <30_30>+128
+ 1
+; (!*ENTRY YESP EXPR 1)
+YESP: intern YESP
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,442
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+475
+ MOVEM 1,-5(15)
+ MOVE 1,SYMVAL+476
+ PUSHJ 15,SYMFNC+477
+ MOVEM 1,-4(15)
+ MOVE 2,0(15)
+ MOVE 1,L1712
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,SYMVAL+442
+L1724: PUSHJ 15,SYMFNC+448
+ MOVEM 1,-2(15)
+ MOVE 2,L1713
+ PUSHJ 15,SYMFNC+303
+ MOVE 2,1
+ MOVEM 2,-3(15)
+ CAME 2,0
+ JRST L1725
+ MOVE 2,L1714
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L1725
+ MOVE 6,-2(15)
+ CAME 6,L1715
+ JRST L1726
+ MOVE 3,0
+ MOVE 2,0
+ MOVE 1,L1716
+ PUSHJ 15,SYMFNC+478
+L1726: MOVE 6,SYMVAL+84
+ MOVEM 6,-1(15)
+ JRST L1724
+L1725: MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+477
+ MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+475
+ MOVE 6,L1717
+ MOVEM 6,SYMVAL+479
+ MOVE 1,-3(15)
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-6
+ POPJ 15,0
+L1717: <30_30>+480
+L1716: <9_30>+<1_18>+L1718
+L1715: <30_30>+66
+L1714: <9_30>+<1_18>+L1719
+L1713: <9_30>+<1_18>+L1720
+L1712: <4_30>+<1_18>+L1721
+L1732: 1
+ byte(7)37,112,0
+L1733: 38
+ byte(7)42,42,42,42,42,32,67,111,110,116,105,110,117,97,98,108,101,32,101,114,114,111,114,44,32,114,101,116,114,121,32,102,111,114,109,32,105,115,58,0
+L1734: 40
+ byte(7)42,42,42,42,42,32,67,111,110,116,105,110,117,97,98,108,101,32,101,114,114,111,114,58,32,114,101,116,114,121,32,102,111,114,109,32,105,115,32,37,114,0
+L1735: 23
+ byte(7)42,42,42,42,42,32,67,111,110,116,105,110,117,97,98,108,101,32,101,114,114,111,114,46,0
+L1736: 7
+ byte(7)42,42,42,42,42,32,37,108,0
+ 3
+; (!*ENTRY CONTINUABLEERROR EXPR 3)
+L1737: intern L1737
+ PUSH 15,2
+ PUSH 15,1
+ JSP 10,SYMFNC+443
+ byte(18)3,481
+ JSP 10,SYMFNC+443
+ byte(18)0,482
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+482
+ MOVEM 2,SYMVAL+483
+ CAMN 0,SYMVAL+484
+ JRST L1738
+ CAMN 0,SYMVAL+485
+ JRST L1738
+ MOVE 2,SYMVAL+486
+ MOVE 1,SYMVAL+487
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L1738
+ MOVE 2,-1(15)
+ MOVE 1,L1727
+ PUSHJ 15,SYMFNC+418
+ CAME 0,SYMVAL+481
+ JRST L1739
+ MOVE 1,L1728
+ PUSHJ 15,SYMFNC+418
+ JRST L1740
+L1739: MOVE 1,SYMVAL+481
+ PUSHJ 15,SYMFNC+488
+ HRRZI 2,40
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L1741
+ MOVE 2,SYMVAL+481
+ MOVE 1,L1729
+ JRST L1742
+L1741: MOVE 1,L1730
+ PUSHJ 15,SYMFNC+418
+ MOVE 2,SYMVAL+481
+ MOVE 1,L1731
+L1742: PUSHJ 15,SYMFNC+418
+L1740: PUSHJ 15,SYMFNC+451
+ JRST L1743
+L1738: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+472
+L1743: JSP 10,SYMFNC+447
+ 1
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-2
+ POPJ 15,0
+L1731: <4_30>+<1_18>+L1732
+L1730: <4_30>+<1_18>+L1733
+L1729: <4_30>+<1_18>+L1734
+L1728: <4_30>+<1_18>+L1735
+L1727: <4_30>+<1_18>+L1736
+L1745: 50
+ byte(7)65,110,32,97,116,116,101,109,112,116,32,119,97,115,32,109,97,100,101,32,116,111,32,100,111,32,37,112,32,111,110,32,37,114,44,32,119,104,105,99,104,32,105,115,32,110,111,116,32,37,119,0
+ 3
+; (!*ENTRY TYPEERROR EXPR 3)
+L1746: intern L1746
+ MOVE 4,3
+ MOVE 3,1
+ MOVE 1,L1744
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L1744: <4_30>+<1_18>+L1745
+L1748: 60
+ byte(7)65,110,32,97,116,116,101,109,112,116,32,119,97,115,32,109,97,100,101,32,116,111,32,117,115,101,32,37,114,32,97,115,32,37,119,32,105,110,32,37,112,44,32,119,104,101,114,101,32,37,119,32,105,115,32,110,101,101,100,101,100,0
+ 4
+; (!*ENTRY USAGETYPEERROR EXPR 4)
+L1749: intern L1749
+ PUSH 15,4
+ MOVE 5,3
+ MOVE 4,2
+ MOVE 3,0(15)
+ MOVE 2,1
+ MOVE 1,L1747
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-1
+ JRST SYMFNC+156
+L1747: <4_30>+<1_18>+L1748
+L1752: 9
+ byte(7)97,110,32,105,110,116,101,103,101,114,0
+L1753: 7
+ byte(7)97,110,32,105,110,100,101,120,0
+ 2
+; (!*ENTRY INDEXERROR EXPR 2)
+L1754: intern L1754
+ MOVE 4,L1750
+ MOVE 3,L1751
+ JRST SYMFNC+489
+L1751: <4_30>+<1_18>+L1752
+L1750: <4_30>+<1_18>+L1753
+L1756: 5
+ byte(7)97,32,112,97,105,114,0
+ 2
+; (!*ENTRY NONPAIRERROR EXPR 2)
+L1757: intern L1757
+ MOVE 3,L1755
+ JRST SYMFNC+132
+L1755: <4_30>+<1_18>+L1756
+L1759: 12
+ byte(7)97,110,32,105,100,101,110,116,105,102,105,101,114,0
+ 2
+; (!*ENTRY NONIDERROR EXPR 2)
+L1760: intern L1760
+ MOVE 3,L1758
+ JRST SYMFNC+132
+L1758: <4_30>+<1_18>+L1759
+L1762: 7
+ byte(7)97,32,110,117,109,98,101,114,0
+ 2
+; (!*ENTRY NONNUMBERERROR EXPR 2)
+L1763: intern L1763
+ MOVE 3,L1761
+ JRST SYMFNC+132
+L1761: <4_30>+<1_18>+L1762
+L1765: 9
+ byte(7)97,110,32,105,110,116,101,103,101,114,0
+ 2
+; (!*ENTRY NONINTEGERERROR EXPR 2)
+L1766: intern L1766
+ MOVE 3,L1764
+ JRST SYMFNC+132
+L1764: <4_30>+<1_18>+L1765
+L1768: 21
+ byte(7)97,32,110,111,110,45,110,101,103,97,116,105,118,101,32,105,110,116,101,103,101,114,0
+ 2
+; (!*ENTRY NONPOSITIVEINTEGERERROR EXPR 2)
+L1769: intern L1769
+ MOVE 3,L1767
+ JRST SYMFNC+132
+L1767: <4_30>+<1_18>+L1768
+L1771: 10
+ byte(7)97,32,99,104,97,114,97,99,116,101,114,0
+ 2
+; (!*ENTRY NONCHARACTERERROR EXPR 2)
+L1772: intern L1772
+ MOVE 3,L1770
+ JRST SYMFNC+132
+L1770: <4_30>+<1_18>+L1771
+L1774: 7
+ byte(7)97,32,115,116,114,105,110,103,0
+ 2
+; (!*ENTRY NONSTRINGERROR EXPR 2)
+L1775: intern L1775
+ MOVE 3,L1773
+ JRST SYMFNC+132
+L1773: <4_30>+<1_18>+L1774
+L1777: 7
+ byte(7)97,32,118,101,99,116,111,114,0
+ 2
+; (!*ENTRY NONVECTORERROR EXPR 2)
+L1778: intern L1778
+ MOVE 3,L1776
+ JRST SYMFNC+132
+L1776: <4_30>+<1_18>+L1777
+L1780: 13
+ byte(7)97,32,119,111,114,100,115,32,118,101,99,116,111,114,0
+ 2
+; (!*ENTRY NONWORDS EXPR 2)
+L1781: intern L1781
+ MOVE 3,L1779
+ JRST SYMFNC+132
+L1779: <4_30>+<1_18>+L1780
+L1783: 9
+ byte(7)97,32,115,101,113,117,101,110,99,101,0
+ 2
+; (!*ENTRY NONSEQUENCEERROR EXPR 2)
+L1784: intern L1784
+ MOVE 3,L1782
+ JRST SYMFNC+132
+L1782: <4_30>+<1_18>+L1783
+L1786: 18
+ byte(7)97,32,108,101,103,97,108,32,73,47,79,32,99,104,97,110,110,101,108,0
+ 2
+; (!*ENTRY NONIOCHANNELERROR EXPR 2)
+L1787: intern L1787
+ MOVE 3,L1785
+ JRST SYMFNC+132
+L1785: <4_30>+<1_18>+L1786
+L1790: 7
+ byte(7)42,42,42,42,42,32,37,108,0
+ 2
+; (!*ENTRY ERROR EXPR 2)
+ERROR: intern ERROR
+ PUSH 15,2
+ PUSH 15,1
+ JSP 10,SYMFNC+443
+ byte(18)0,482
+ MOVEM 2,SYMVAL+483
+ CAMN 0,SYMVAL+485
+ JRST L1791
+ MOVE 1,L1788
+ PUSHJ 15,SYMFNC+418
+ CAMN 0,SYMVAL+484
+ JRST L1791
+ MOVE 2,SYMVAL+486
+ MOVE 1,SYMVAL+487
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L1791
+ PUSHJ 15,SYMFNC+451
+ JRST L1792
+L1791: CAMN 0,SYMVAL+494
+ JRST L1793
+ PUSHJ 15,SYMFNC+462
+L1793: MOVE 2,0(15)
+ MOVE 1,L1789
+ PUSHJ 15,SYMFNC+495
+L1792: JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-2
+ POPJ 15,0
+L1789: <30_30>+496
+L1788: <4_30>+<1_18>+L1790
+L1799: <30_30>+485
+ <30_30>+128
+L1800: <30_30>+246
+ <9_30>+<1_18>+L1801
+L1801: <30_30>+496
+ <30_30>+128
+ 1
+; (!*ENTRY ERRSET MACRO 1)
+ERRSET: intern ERRSET
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 7,1(1)
+ CAME 0,1(7)
+ JRST L1802
+ MOVE 1,SYMVAL+84
+ JRST L1803
+L1802: MOVE 1,1(1)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+L1803: MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ MOVEM 2,-1(15)
+ MOVE 2,1
+ MOVE 1,L1794
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,L1795
+ MOVE 1,L1796
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1797
+ MOVE 1,L1798
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+249
+L1798: <30_30>+253
+L1797: <9_30>+<1_18>+L1799
+L1796: <30_30>+498
+L1795: <9_30>+<1_18>+L1800
+L1794: <30_30>+172
+ 3
+; (!*ENTRY ERRORSET EXPR 3)
+L1805: intern L1805
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ JSP 10,SYMFNC+443
+ byte(18)3,494
+ byte(18)2,485
+ MOVE 1,L1804
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,-1(15)
+ CAME 0,SYMVAL+500
+ JRST L1806
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+261
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+501
+ MOVE 1,-2(15)
+L1806: JSP 10,SYMFNC+447
+ 2
+ ADJSP 15,-3
+ POPJ 15,0
+L1804: <30_30>+496
+L1808: 15
+ byte(7)67,104,97,110,110,101,108,32,110,111,116,32,111,112,101,110,0
+ 2
+; (!*ENTRY CHANNELNOTOPEN EXPR 2)
+L1809: intern L1809
+ MOVE 2,L1807
+ JRST SYMFNC+503
+L1807: <4_30>+<1_18>+L1808
+L1811: 26
+ byte(7)67,104,97,110,110,101,108,32,111,112,101,110,32,102,111,114,32,119,114,105,116,101,32,111,110,108,121,0
+ 1
+; (!*ENTRY WRITEONLYCHANNEL EXPR 1)
+L1812: intern L1812
+ MOVE 2,L1810
+ JRST SYMFNC+503
+L1810: <4_30>+<1_18>+L1811
+L1814: 25
+ byte(7)67,104,97,110,110,101,108,32,111,112,101,110,32,102,111,114,32,114,101,97,100,32,111,110,108,121,0
+ 2
+; (!*ENTRY READONLYCHANNEL EXPR 2)
+L1815: intern L1815
+ MOVE 2,L1813
+ JRST SYMFNC+503
+L1813: <4_30>+<1_18>+L1814
+L1817: 32
+ byte(7)73,108,108,101,103,97,108,32,116,111,32,99,108,111,115,101,32,115,116,97,110,100,97,114,100,32,99,104,97,110,110,101,108,0
+ 1
+; (!*ENTRY ILLEGALSTANDARDCHANNELCLOSE EXPR 1)
+L1818: intern L1818
+ MOVE 2,L1816
+ JRST SYMFNC+503
+L1816: <4_30>+<1_18>+L1817
+L1820: 12
+ byte(7)73,47,79,32,69,114,114,111,114,58,32,37,115,0
+ 1
+; (!*ENTRY IOERROR EXPR 1)
+L1821: intern L1821
+ MOVE 2,1
+ MOVE 1,L1819
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L1819: <4_30>+<1_18>+L1820
+L1823: 26
+ byte(7)73,47,79,32,69,114,114,111,114,32,111,110,32,99,104,97,110,110,101,108,32,37,100,58,32,37,115,0
+ 2
+; (!*ENTRY CHANNELERROR EXPR 2)
+L1824: intern L1824
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,L1822
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L1822: <4_30>+<1_18>+L1823
+ end
ADDED psl-1983/3-1/kernel/20/error.rel
Index: psl-1983/3-1/kernel/20/error.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/error.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/eval.ctl
Index: psl-1983/3-1/kernel/20/eval.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/eval.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "eval";
+PathIn "eval.build";
+ASMEnd;
+quit;
+compile eval.mac, deval.mac
ADDED psl-1983/3-1/kernel/20/eval.init
Index: psl-1983/3-1/kernel/20/eval.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/eval.init
@@ -0,0 +1,10 @@
+(FLUID (QUOTE (THROWSIGNAL!* THROWTAG!*)))
+(GLOBAL (QUOTE (EMSG!*)))
+(PUT (QUOTE CATCH!-ALL) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE CATCH) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE !*CATCH) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (PROGJUMPTABLE!* PROGBODY!*)))
+(PUT (QUOTE PROG) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE GO) (QUOTE TYPE) (QUOTE FEXPR))
ADDED psl-1983/3-1/kernel/20/eval.log
Index: psl-1983/3-1/kernel/20/eval.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/eval.log
@@ -0,0 +1,69 @@
+
+ 8-Jun-83 9:37:41
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job EVAL Req #480 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:10:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 1737
+
+ Input from => PS:<PSL.KERNEL.20.EXT>EVAL.CTL.3
+ Output to => PS:<PSL.KERNEL.20.EXT>EVAL.LOG
+
+
+
+ 9:37:41 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+ 9:37:41 MONTR @SET TIME-LIMIT 600
+ 9:37:41 MONTR @LOGIN KESSLER SMALL
+ 9:37:44 MONTR Job 12 on TTY224 8-Jun-83 09:37:44
+ 9:37:44 MONTR Previous login at 8-Jun-83 09:36:52
+ 9:37:44 MONTR There is 1 other job logged in as user KESSLER
+ 9:37:52 MONTR @
+ 9:37:52 MONTR [PS Mounted]
+ 9:37:52 MONTR
+ 9:37:52 MONTR [CONNECTED TO PS:<PSL.KERNEL.20.EXT>]
+ ;Modifications to this file may disappear, as this file is generated
+ ;automatically using information in P20:20-KERNEL-GEN.SL.
+ 9:37:52 MONTR def dsk: dsk:,p20e:,pk:,p20:
+ 9:37:53 MONTR @S:EX-DEC20-CROSS.EXE
+ 9:37:55 USER [29] ASMOut "eval";
+ 9:37:56 USER ASMOUT: IN files; or type in expressions
+ 9:37:56 USER When all done execute ASMEND;
+ 9:37:58 USER [30] PathIn "eval.build";
+ 9:37:59 USER %
+ 9:37:59 USER % EVAL.BUILD - Files with Eval and Apply in the interpreter
+ 9:37:59 USER %
+ 9:37:59 USER % Author: Eric Benson
+ 9:37:59 USER % Symbolic Computation Group
+ 9:37:59 USER % Computer Science Dept.
+ 9:37:59 USER % University of Utah
+ 9:37:59 USER % Date: 19 May 1982
+ 9:37:59 USER % Copyright (c) 1982 University of Utah
+ 9:37:59 USER %
+ 9:37:59 USER
+ 9:37:59 USER PathIn "apply-lap.red"$ % low-level function linkage, in LAP
+ 9:38:08 USER PathIn "eval-apply.red"$ % interpreter functions
+ 9:38:20 USER PathIn "catch-throw.red"$
+ 9:38:20 USER *** Function `CATCH!-ALL' has been redefined
+ 9:38:21 USER *** Function `UNWIND!-ALL' has been redefined
+ 9:38:22 USER *** Function `UNWIND!-PROTECT' has been redefined
+ 9:38:23 USER *** Function `!*CATCH' has been redefined
+ 9:38:28 USER % non-local GOTO mechanism
+ 9:38:28 USER PathIn "prog-and-friends.red"$ % Prog, Go and Return
+ 9:38:32 USER [31] ASMEnd;
+ 9:38:33 USER *** Garbage collection starting
+ 9:38:36 USER *** GC 12: time 1916 ms, 146295 recovered, 239467 free
+ 9:38:43 USER 0
+ 9:38:43 USER [32] quit;
+ 9:38:43 MONTR @compile eval.mac, deval.mac
+ 9:38:46 USER MACRO: .MAIN
+ 9:38:53 USER MACRO: .MAIN
+ 9:38:54 USER
+ 9:38:54 USER EXIT
+ 9:38:54 MONTR @
+ 9:38:55 MONTR Killed by OPERATOR, TTY 221
+ 9:38:55 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 224,
+ 9:38:56 MONTR at 8-Jun-83 09:38:55, Used 0:00:41 in 0:01:11
ADDED psl-1983/3-1/kernel/20/eval.mac
Index: psl-1983/3-1/kernel/20/eval.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/eval.mac
@@ -0,0 +1,1301 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L1256
+ extern L1825
+L1828: 29
+ byte(7)84,111,111,32,109,97,110,121,32,97,114,103,117,109,101,110,116,115,32,116,111,32,102,117,110,99,116,105,111,110,0
+ 2
+; (!*ENTRY CODEAPPLY EXPR 2)
+L1829: intern L1829
+ MOVE 6,1
+ TLZ 6,262080
+ MOVE 7,2
+ HRRZI 8,1
+L1830: LDB 11,L1826
+ CAIE 11,9
+ JRST 0(6)
+ MOVE 9,0(7)
+ MOVEM 9,0(8)
+ MOVE 7,1(7)
+ AOS 8
+ CAIN 8,6
+ XMOVEI 8,L0002
+ CAIG 8,9+L0002
+ JRST L1830
+ MOVE 1,L1827
+ JRST SYMFNC+156
+L1826: point 6,7,5
+L1827: <4_30>+<1_18>+L1828
+L1835: 29
+ byte(7)84,111,111,32,109,97,110,121,32,97,114,103,117,109,101,110,116,115,32,116,111,32,102,117,110,99,116,105,111,110,0
+ 2
+; (!*ENTRY CODEEVALAPPLY EXPR 2)
+L1836: intern L1836
+ PUSH 15,1
+ PUSH 15,L1831
+L1837: LDB 11,L1832
+ CAIE 11,9
+ JRST L1838
+ MOVE 6,0(15)
+ CAMGE 6,L1833
+ JRST L1839
+ MOVE 1,0(2)
+ MOVE 2,1(2)
+ PUSH 15,2
+ PUSHJ 15,SYMFNC+261
+ POP 15,2
+ POP 15,3
+ SOS 3
+ PUSH 15,1
+ PUSH 15,3
+ JRST L1837
+L1838: POP 15,3
+ JRST L1840(3)
+ POP 15,L0002+9
+ POP 15,L0002+8
+ POP 15,L0002+7
+ POP 15,L0002+6
+ POP 15,L0002+5
+ POP 15,L0002+4
+ POP 15,L0002+3
+ POP 15,L0002+2
+ POP 15,L0002+1
+ POP 15,L0002+0
+ POP 15,5
+ POP 15,4
+ POP 15,3
+ POP 15,2
+ POP 15,1
+L1840: POP 15,6
+ TLZ 6,262080
+ JRST 0(6)
+L1839: MOVE 1,L1834
+ JRST SYMFNC+156
+L1831: 0
+L1832: point 6,2,5
+L1833: -15
+L1834: <4_30>+<1_18>+L1835
+ 2
+; (!*ENTRY BINDEVAL EXPR 2)
+L1844: intern L1844
+ PUSH 15,L1841
+ SETZM 4
+ MOVE 3,1
+L1845: LDB 11,L1842
+ CAIE 11,9
+ JRST L1846
+ MOVE 1,0(2)
+ MOVE 2,1(2)
+ PUSH 15,3
+ PUSH 15,2
+ PUSHJ 15,SYMFNC+261
+ POP 15,2
+ POP 15,3
+ POP 15,4
+ LDB 11,L1843
+ CAIE 11,9
+ JRST L1847
+ AOS 4
+ MOVE 5,0(3)
+ MOVE 3,1(3)
+ PUSH 15,1
+ PUSH 15,5
+ PUSH 15,4
+ JRST L1845
+L1847: LSH 4,1
+ HRL 4,4
+ SUB 15,4
+ SETOM 1
+ POPJ 15,0
+L1846: ADJSP 15,-1
+ LDB 11,L1843
+ CAIN 11,9
+ JRST L1847
+ MOVE 3,4
+L1848: JUMPE 3,L1849
+ POP 15,1
+ POP 15,2
+ PUSH 15,3
+ PUSH 15,4
+ PUSHJ 15,SYMFNC+511
+ POP 15,4
+ POP 15,3
+ SOJA 3,L1848
+L1849: MOVE 1,4
+ POPJ 15,0
+L1841: 0
+L1842: point 6,2,5
+L1843: point 6,3,5
+L1854: 61
+ byte(7)73,110,116,101,114,110,97,108,32,101,114,114,111,114,32,105,110,32,102,117,110,99,116,105,111,110,32,99,97,108,108,105,110,103,32,109,101,99,104,97,110,105,115,109,59,32,99,111,110,115,117,108,116,32,97,32,119,105,122,97,114,100,0
+ 0
+; (!*ENTRY COMPILEDCALLINGINTERPRETED EXPR 0)
+L1855: intern L1855
+ MOVE 6,10
+ SUBI 6,SYMFNC+1
+ TLZ 6,258048
+ TLO 6,114688
+ PUSH 15,6
+ HRRZ 6,6
+ MOVE 6,SYMPRP(6)
+L1856: LDB 11,L1850
+ CAIE 11,9
+ JRST L1857
+ MOVE 7,0(6)
+ MOVE 6,1(6)
+ LDB 11,L1851
+ CAIE 11,9
+ JRST L1856
+ MOVE 8,0(7)
+ CAME 8,L1852
+ JRST L1856
+ MOVE 7,1(7)
+; (!*ENTRY FASTLAMBDAAPPLY EXPR 0)
+L1858: intern L1858
+ MOVE 7,1(7)
+ MOVE 6,1(7)
+ MOVE 7,0(7)
+ HRRZI 8,1
+ MOVE 9,L1256
+ PUSH 15,9
+L1859: LDB 11,L1851
+ CAIE 11,9
+ JRST L1860
+ ADDI 9,2
+ CAML 9,L1825
+ JRST SYMFNC+513
+ MOVE 10,0(7)
+ HRRZM 10,-1(9)
+ MOVE 11,SYMVAL(10)
+ MOVEM 11,0(9)
+ MOVE 11,0(8)
+ MOVEM 11,SYMVAL(10)
+ MOVE 7,1(7)
+ AOS 8
+ CAIN 8,6
+ MOVEI 8,L0002
+ JRST L1859
+L1860: MOVEM 9,L1256
+ MOVE 1,6
+ PUSHJ 15,SYMFNC+265
+ EXCH 1,0(15)
+ PUSHJ 15,SYMFNC+514
+ POP 15,1
+ ADJSP 15,-1
+ POPJ 15,0
+L1857: MOVE 1,L1853
+ JRST SYMFNC+156
+L1850: point 6,6,5
+L1851: point 6,7,5
+L1853: <4_30>+<1_18>+L1854
+L1852: <30_30>+515
+L1864: 34
+ byte(7)73,108,108,101,103,97,108,32,102,117,110,99,116,105,111,110,97,108,32,102,111,114,109,32,37,114,32,105,110,32,65,112,112,108,121,0
+ 0
+; (!*ENTRY FASTAPPLY EXPR 0)
+L1865: intern L1865
+ LDB 7,L1861
+ TLZ 6,262080
+ CAIN 7,30
+ JRST SYMFNC(6)
+ CAIN 7,15
+ JRST 0(6)
+ CAIE 7,9
+ JRST L1866
+ MOVE 7,0(6)
+ CAME 7,L1862
+ JRST L1866
+ MOVE 7,6
+ PUSH 15,0
+ JRST L1858
+L1866: MOVE 1,L1863
+ MOVE 2,6
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L1861: point 6,6,5
+L1863: <4_30>+<1_18>+L1864
+L1862: <30_30>+253
+L1868: 46
+ byte(7)85,110,100,101,102,105,110,101,100,32,102,117,110,99,116,105,111,110,32,37,114,32,99,97,108,108,101,100,32,102,114,111,109,32,99,111,109,112,105,108,101,100,32,99,111,100,101,0
+ 0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+L1869: intern L1869
+ SOS 10
+ PUSH 15,10
+ PUSH 15,1
+ PUSH 15,2
+ PUSH 15,3
+ PUSH 15,4
+ PUSH 15,5
+ PUSH 15,L0002+0
+ PUSH 15,L0002+1
+ PUSH 15,L0002+2
+ PUSH 15,L0002+3
+ PUSH 15,L0002+4
+ PUSH 15,L0002+5
+ PUSH 15,L0002+6
+ PUSH 15,L0002+7
+ PUSH 15,L0002+8
+ PUSH 15,L0002+9
+ SUBI 10,SYMFNC
+ HRLI 10,122880
+ MOVE 2,10
+ MOVE 1,L1867
+ PUSHJ 15,SYMFNC+155
+ MOVE 2,1
+ SETZM 1
+ MOVE 3,0
+ PUSHJ 15,SYMFNC+236
+ POP 15,L0002+9
+ POP 15,L0002+8
+ POP 15,L0002+7
+ POP 15,L0002+6
+ POP 15,L0002+5
+ POP 15,L0002+4
+ POP 15,L0002+3
+ POP 15,L0002+2
+ POP 15,L0002+1
+ POP 15,L0002+0
+ POP 15,5
+ POP 15,4
+ POP 15,3
+ POP 15,2
+ POP 15,1
+ POPJ 15,0
+L1867: <4_30>+<1_18>+L1868
+L1875: 23
+ byte(7)65,114,103,117,109,101,110,116,32,110,117,109,98,101,114,32,109,105,115,109,97,116,99,104,0
+L1876: 29
+ byte(7)73,108,108,45,102,111,114,109,101,100,32,102,117,110,99,116,105,111,110,32,101,120,112,114,101,115,115,105,111,110,0
+; (!*ENTRY LAMBDAEVALAPPLY EXPR 2)
+L1877: intern L1877
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1870
+ CAIE 11,9
+ JRST L1878
+ MOVE 6,L1871
+ CAMN 6,0(1)
+ JRST L1879
+L1878: PUSHJ 15,SYMFNC+151
+ MOVE 3,1
+ MOVE 2,L1872
+ HRRZI 1,1103
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L1879: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+510
+ MOVEM 1,-2(15)
+ CAME 1,L1873
+ JRST L1880
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+151
+ MOVE 3,1
+ MOVE 2,L1874
+ HRRZI 1,1203
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L1880: MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+265
+ MOVEM 1,-3(15)
+ SKIPN -2(15)
+ JRST L1881
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+517
+L1881: MOVE 1,-3(15)
+ ADJSP 15,-4
+ POPJ 15,0
+L1870: point 6,1,5
+L1873: -1
+L1874: <4_30>+<1_18>+L1875
+L1872: <4_30>+<1_18>+L1876
+L1871: <30_30>+253
+L1890: 23
+ byte(7)65,114,103,117,109,101,110,116,32,110,117,109,98,101,114,32,109,105,115,109,97,116,99,104,0
+L1891: 29
+ byte(7)73,108,108,45,102,111,114,109,101,100,32,102,117,110,99,116,105,111,110,32,101,120,112,114,101,115,115,105,111,110,0
+; (!*ENTRY LAMBDAAPPLY EXPR 2)
+L1892: intern L1892
+ ADJSP 15,9
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1882
+ CAIE 11,9
+ JRST L1893
+ MOVE 6,L1883
+ CAMN 6,0(1)
+ JRST L1894
+L1893: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 2,-2(15)
+ LDB 11,L1884
+ CAIN 11,9
+ JRST L1895
+ MOVE 1,0
+ JRST L1896
+L1895: MOVE 1,0(2)
+ MOVEM 1,-5(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 3,1
+ MOVEM 3,-4(15)
+ MOVEM 3,-3(15)
+L1897: MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ LDB 11,L1882
+ CAIN 11,9
+ JRST L1898
+ MOVE 1,-3(15)
+ JRST L1896
+L1898: MOVE 1,0(1)
+ MOVEM 1,-5(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-4(15)
+ MOVEM 1,1(7)
+ MOVE 2,-4(15)
+ MOVE 2,1(2)
+ MOVEM 2,-4(15)
+ JRST L1897
+L1896: MOVE 2,0(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 3,1
+ MOVE 2,L1885
+ HRRZI 1,1104
+ ADJSP 15,-9
+ JRST SYMFNC+236
+L1894: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 3,1(1)
+ MOVE 3,0(3)
+ MOVEM 3,-2(15)
+ SETZM -3(15)
+L1899: LDB 11,L1886
+ CAIE 11,9
+ JRST L1900
+ LDB 11,L1887
+ CAIE 11,9
+ JRST L1900
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,-2(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+511
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVEM 2,-1(15)
+ AOS -3(15)
+ JRST L1899
+L1900: LDB 11,L1886
+ CAIN 11,9
+ JRST L1901
+ LDB 11,L1887
+ CAIE 11,9
+ JRST L1902
+L1901: MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ MOVEM 0,-7(15)
+ MOVE 6,-1(15)
+ MOVEM 6,-5(15)
+ LDB 11,L1888
+ CAIN 11,9
+ JRST L1903
+ MOVE 1,0
+ JRST L1904
+L1903: MOVE 1,-5(15)
+ MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-7(15)
+ MOVEM 1,-6(15)
+L1905: MOVE 1,-5(15)
+ MOVE 1,1(1)
+ MOVEM 1,-5(15)
+ LDB 11,L1882
+ CAIN 11,9
+ JRST L1906
+ MOVE 1,-6(15)
+ JRST L1904
+L1906: MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-7(15)
+ MOVEM 1,1(7)
+ MOVE 2,-7(15)
+ MOVE 2,1(2)
+ MOVEM 2,-7(15)
+ JRST L1905
+L1904: MOVE 2,0(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 3,1
+ MOVE 2,L1889
+ HRRZI 1,1204
+ ADJSP 15,-9
+ JRST SYMFNC+236
+L1902: MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+265
+ MOVEM 1,-4(15)
+ SKIPN -3(15)
+ JRST L1907
+ MOVE 1,-3(15)
+ PUSHJ 15,SYMFNC+517
+L1907: MOVE 1,-4(15)
+ ADJSP 15,-9
+ POPJ 15,0
+L1882: point 6,1,5
+L1884: point 6,2,5
+L1886: point 6,-2(15),5
+L1887: point 6,-1(15),5
+L1888: point 6,-5(15),5
+L1889: <4_30>+<1_18>+L1890
+L1885: <4_30>+<1_18>+L1891
+L1883: <30_30>+253
+L1915: 29
+ byte(7)73,108,108,45,102,111,114,109,101,100,32,102,117,110,99,116,105,111,110,32,101,120,112,114,101,115,115,105,111,110,0
+L1916: 26
+ byte(7)37,114,32,105,115,32,97,110,32,117,110,100,101,102,105,110,101,100,32,102,117,110,99,116,105,111,110,0
+ 2
+; (!*ENTRY APPLY EXPR 2)
+APPLY: intern APPLY
+ ADJSP 15,9
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1908
+ CAIE 11,30
+ JRST L1917
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ PUSHJ 15,SYMFNC+519
+ CAMN 1,0
+ JRST L1918
+ MOVE 2,0(15)
+ MOVE 1,L1909
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-4(15)
+ MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ MOVEM 0,-7(15)
+ MOVE 6,-1(15)
+ MOVEM 6,-5(15)
+ LDB 11,L1910
+ CAIN 11,9
+ JRST L1919
+ MOVE 1,0
+ JRST L1920
+L1919: MOVE 1,-5(15)
+ MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVEM 2,-7(15)
+ MOVEM 2,-6(15)
+L1921: MOVE 1,-5(15)
+ MOVE 1,1(1)
+ MOVEM 1,-5(15)
+ LDB 11,L1908
+ CAIN 11,9
+ JRST L1922
+ MOVE 1,-6(15)
+ JRST L1920
+L1922: MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-7(15)
+ MOVEM 1,1(7)
+ MOVE 2,-7(15)
+ MOVE 2,1(2)
+ MOVEM 2,-7(15)
+ JRST L1921
+L1920: MOVE 2,0(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 3,1
+ MOVE 2,-4(15)
+ HRRZI 1,1002
+ JRST L1923
+L1918: MOVE 2,0(15)
+ TLZ 2,258048
+ TLZ 2,258048
+ TLO 2,114688
+ MOVEM 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+520
+ CAMN 1,0
+ JRST L1924
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+521
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+508
+ JRST L1925
+L1924: MOVE 2,L1911
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+522
+ MOVE 2,-1(15)
+ PUSHJ 15,L1892
+L1925: MOVEM 1,-3(15)
+ JRST L1926
+L1917: LDB 11,L1908
+ CAIE 11,15
+ JRST L1927
+ ADJSP 15,-9
+ JRST SYMFNC+508
+L1927: LDB 11,L1908
+ CAIE 11,9
+ JRST L1928
+ MOVE 6,L1912
+ CAME 6,0(1)
+ JRST L1928
+ ADJSP 15,-9
+ JRST L1892
+L1928: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 2,-2(15)
+ LDB 11,L1913
+ CAIN 11,9
+ JRST L1929
+ MOVE 1,0
+ JRST L1930
+L1929: MOVE 1,0(2)
+ MOVEM 1,-5(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 3,1
+ MOVEM 3,-4(15)
+ MOVEM 3,-3(15)
+L1931: MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ LDB 11,L1908
+ CAIN 11,9
+ JRST L1932
+ MOVE 1,-3(15)
+ JRST L1930
+L1932: MOVE 1,0(1)
+ MOVEM 1,-5(15)
+ PUSHJ 15,SYMFNC+234
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-4(15)
+ MOVEM 1,1(7)
+ MOVE 2,-4(15)
+ MOVE 2,1(2)
+ MOVEM 2,-4(15)
+ JRST L1931
+L1930: MOVE 2,0(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 3,1
+ MOVE 2,L1914
+ HRRZI 1,1102
+L1923: ADJSP 15,-9
+ JRST SYMFNC+236
+L1926: ADJSP 15,-9
+ POPJ 15,0
+L1908: point 6,1,5
+L1910: point 6,-5(15),5
+L1913: point 6,2,5
+L1914: <4_30>+<1_18>+L1915
+L1912: <30_30>+253
+L1911: <30_30>+515
+L1909: <4_30>+<1_18>+L1916
+L1943: 31
+ byte(7)73,108,108,45,102,111,114,109,101,100,32,101,120,112,114,101,115,115,105,111,110,32,105,110,32,69,118,97,108,32,37,114,0
+L1944: 23
+ byte(7)85,110,107,110,111,119,110,32,102,117,110,99,116,105,111,110,32,116,121,112,101,32,37,114,0
+L1945: 26
+ byte(7)37,114,32,105,115,32,97,110,32,117,110,100,101,102,105,110,101,100,32,102,117,110,99,116,105,111,110,0
+ 1
+; (!*ENTRY EVAL EXPR 1)
+EVAL: intern EVAL
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ LDB 11,L1933
+ CAIN 11,9
+ JRST L1946
+ LDB 11,L1933
+ CAIE 11,30
+ JRST L1947
+ ADJSP 15,-5
+ JRST SYMFNC+523
+L1946: MOVEM 0,-1(15)
+ MOVE 2,0(1)
+ MOVEM 2,-1(15)
+ LDB 11,L1934
+ CAIE 11,30
+ JRST L1948
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+519
+ CAMN 1,0
+ JRST L1949
+ MOVE 2,-1(15)
+ MOVE 1,L1935
+ PUSHJ 15,SYMFNC+155
+ MOVE 3,0(15)
+ MOVE 2,1
+ HRRZI 1,1300
+ ADJSP 15,-5
+ JRST SYMFNC+236
+L1949: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+524
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ TLZ 2,258048
+ TLO 2,114688
+ MOVEM 2,-3(15)
+ CAME 1,0
+ JRST L1950
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+520
+ CAMN 1,0
+ JRST L1951
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+521
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ PUSHJ 15,SYMFNC+509
+ JRST L1952
+L1951: MOVE 2,L1936
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+522
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ PUSHJ 15,L1877
+ JRST L1952
+L1950: CAME 1,L1937
+ JRST L1953
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC(2)
+ JRST L1952
+L1953: CAME 1,L1938
+ JRST L1954
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+245
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC(2)
+ JRST L1952
+L1954: CAME 1,L1939
+ JRST L1955
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC(2)
+ PUSHJ 15,EVAL
+ JRST L1952
+L1955: MOVE 2,1
+ MOVE 1,L1940
+ PUSHJ 15,SYMFNC+155
+ MOVE 3,0(15)
+ MOVE 2,1
+ HRRZI 1,1301
+ PUSHJ 15,SYMFNC+236
+L1952: MOVEM 1,-4(15)
+ JRST L1947
+L1948: LDB 11,L1934
+ CAIE 11,15
+ JRST L1956
+ MOVE 2,1(1)
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST SYMFNC+509
+L1956: LDB 11,L1934
+ CAIE 11,9
+ JRST L1957
+ MOVE 6,L1941
+ CAME 6,0(2)
+ JRST L1957
+ MOVE 2,1(1)
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST L1877
+L1957: MOVE 2,1
+ MOVE 1,L1942
+ PUSHJ 15,SYMFNC+155
+ MOVE 3,0(15)
+ MOVE 2,1
+ HRRZI 1,1302
+ ADJSP 15,-5
+ JRST SYMFNC+236
+L1947: ADJSP 15,-5
+ POPJ 15,0
+L1933: point 6,1,5
+L1934: point 6,2,5
+L1942: <4_30>+<1_18>+L1943
+L1941: <30_30>+253
+L1940: <4_30>+<1_18>+L1944
+L1939: <30_30>+256
+L1938: <30_30>+258
+L1937: <30_30>+254
+L1936: <30_30>+515
+L1935: <4_30>+<1_18>+L1945
+L1966: <30_30>+525
+ <30_30>+128
+L1967: <30_30>+84
+ <9_30>+<1_18>+L1966
+L1968: <30_30>+244
+ <9_30>+<1_18>+L1969
+L1969: <30_30>+526
+ <9_30>+<1_18>+L1966
+ 1
+; (!*ENTRY CATCH!-ALL MACRO 1)
+L1970: intern L1970
+ ADJSP 15,2
+ MOVE 2,1(1)
+ MOVE 2,1(2)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ MOVEM 2,0(15)
+ MOVE 3,L1958
+ MOVE 2,1
+ MOVE 1,L1959
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,1
+ MOVE 1,L1960
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,L1961
+ MOVE 2,1
+ MOVE 1,L1962
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1963
+ MOVE 1,L1964
+ PUSHJ 15,SYMFNC+235
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,L1965
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,1
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+249
+L1965: <30_30>+498
+L1964: <30_30>+253
+L1963: <9_30>+<1_18>+L1966
+L1962: <30_30>+270
+L1961: <9_30>+<1_18>+L1967
+L1960: <30_30>+500
+L1959: <30_30>+518
+L1958: <9_30>+<1_18>+L1968
+L1976: <30_30>+525
+ <30_30>+128
+L1977: <30_30>+244
+ <9_30>+<1_18>+L1978
+L1978: <9_30>+<1_18>+L1979
+ <9_30>+<1_18>+L1976
+L1979: <30_30>+266
+ <9_30>+<1_18>+L1980
+L1980: <30_30>+500
+ <9_30>+<1_18>+L1981
+L1981: <30_30>+526
+ <30_30>+128
+ 1
+; (!*ENTRY UNWIND!-ALL MACRO 1)
+L1982: intern L1982
+ ADJSP 15,2
+ MOVE 2,1(1)
+ MOVE 2,1(2)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ MOVEM 2,0(15)
+ MOVE 3,L1971
+ MOVE 2,1
+ MOVE 1,L1972
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L1973
+ MOVE 1,L1974
+ PUSHJ 15,SYMFNC+235
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,L1975
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,1
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+249
+L1975: <30_30>+498
+L1974: <30_30>+253
+L1973: <9_30>+<1_18>+L1976
+L1972: <30_30>+518
+L1971: <9_30>+<1_18>+L1977
+L1991: <30_30>+246
+ <9_30>+<1_18>+L1996
+L1992: <30_30>+525
+ <30_30>+128
+L1993: <30_30>+500
+ <9_30>+<1_18>+L1997
+L1994: <30_30>+529
+ <9_30>+<1_18>+L1998
+L1995: <30_30>+270
+ <9_30>+<1_18>+L1999
+L1996: <30_30>+530
+ <30_30>+128
+L1997: <30_30>+526
+ <30_30>+128
+L1998: <30_30>+531
+ <30_30>+128
+L1999: <9_30>+<1_18>+L2000
+ <9_30>+<1_18>+L2001
+L2000: <30_30>+529
+ <9_30>+<1_18>+L2002
+L2001: <9_30>+<1_18>+L2003
+ <30_30>+128
+L2002: <9_30>+<1_18>+L2004
+ <30_30>+128
+L2003: <30_30>+84
+ <9_30>+<1_18>+L1992
+L2004: <30_30>+532
+ <9_30>+<1_18>+L2005
+L2005: <30_30>+531
+ <9_30>+<1_18>+L1992
+ 1
+; (!*ENTRY UNWIND!-PROTECT MACRO 1)
+L2006: intern L2006
+ ADJSP 15,2
+ MOVE 2,1(1)
+ MOVE 2,1(2)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ MOVEM 1,0(15)
+ MOVE 1,L1983
+ PUSHJ 15,SYMFNC+151
+ MOVE 4,L1984
+ MOVE 3,1
+ MOVE 2,L1985
+ MOVE 1,L1986
+ PUSHJ 15,SYMFNC+250
+ MOVE 2,L1987
+ PUSHJ 15,SYMFNC+151
+ MOVE 3,1
+ MOVE 2,L1988
+ MOVE 1,L1986
+ PUSHJ 15,SYMFNC+235
+ MOVEM 1,-1(15)
+ MOVE 3,0(15)
+ MOVE 2,L1989
+ MOVE 1,L1990
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,1
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+249
+L1990: <30_30>+498
+L1989: <9_30>+<1_18>+L1991
+L1988: <9_30>+<1_18>+L1992
+L1987: <9_30>+<1_18>+L1993
+L1986: <30_30>+253
+L1985: <9_30>+<1_18>+L1994
+L1984: <9_30>+<1_18>+L1995
+L1983: <30_30>+264
+ 1
+; (!*ENTRY CATCH FEXPR 1)
+CATCH: intern CATCH
+ ADJSP 15,3
+ MOVE 2,1(1)
+ MOVE 1,0(1)
+ MOVEM 2,0(15)
+ PUSHJ 15,SYMFNC+261
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,-1(15)
+ CAME 0,SYMVAL+500
+ JRST L2007
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+265
+ MOVEM 1,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+501
+ MOVE 1,-2(15)
+L2007: ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY !*CATCH MACRO 1)
+L2009: intern L2009
+ MOVE 2,1(1)
+ MOVE 1,L2008
+ JRST SYMFNC+151
+L2008: <30_30>+498
+ 2
+; (!*ENTRY !*THROW EXPR 2)
+L2010: intern L2010
+ JRST SYMFNC+495
+ extern L2011
+ extern L2012
+ 1
+; (!*ENTRY CATCHSETUP EXPR 1)
+L2013: intern L2013
+ MOVE 2,0(15)
+ MOVE 3,15
+ JRST L2014
+L2017: 19
+ byte(7)67,97,116,99,104,32,115,116,97,99,107,32,111,118,101,114,102,108,111,119,0
+L2018: 35
+ byte(7)67,97,116,99,104,45,116,104,114,111,119,32,115,116,97,99,107,32,111,118,101,114,102,108,111,119,32,40,119,97,114,110,105,110,103,41,0
+; (!*ENTRY CATCHSETUPAUX EXPR 3)
+L2014: intern L2014
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 6,L2012
+ MOVEM 6,-3(15)
+ HRRZI 7,4
+ ADDM 7,L2012
+ SETZM 4
+ ADDI 4,1580+L2011
+ CAMLE 4,L2012
+ JRST L2019
+ CAME 4,L2012
+ JRST L2020
+ MOVE 3,0
+ MOVE 2,L2015
+ HRRZI 1,99
+ PUSHJ 15,SYMFNC+236
+L2020: SETZM 1
+ ADDI 1,1600+L2011
+ CAMLE 1,L2012
+ JRST L2019
+ MOVE 6,L2016
+ MOVEM 6,SYMVAL+483
+ PUSHJ 15,SYMFNC+536
+L2019: MOVE 7,L2012
+ MOVE 6,0(15)
+ MOVEM 6,0(7)
+ MOVE 2,L2012
+ MOVE 6,-1(15)
+ MOVEM 6,1(2)
+ MOVE 6,-2(15)
+ MOVEM 6,2(2)
+ PUSHJ 15,SYMFNC+537
+ MOVE 3,L2012
+ MOVEM 1,3(3)
+ MOVE 2,0
+ MOVEM 2,SYMVAL+500
+ MOVE 1,-3(15)
+ ADJSP 15,-4
+ POPJ 15,0
+L2016: <4_30>+<1_18>+L2017
+L2015: <4_30>+<1_18>+L2018
+ 1
+; (!*ENTRY !%UNCATCH EXPR 1)
+L2021: intern L2021
+ MOVEM 1,L2012
+ MOVE 1,0
+ MOVEM 1,SYMVAL+500
+ POPJ 15,0
+ 0
+; (!*ENTRY !%CLEAR!-CATCH!-STACK EXPR 0)
+L2022: intern L2022
+ SETZM 1
+ ADDI 1,L2011
+ MOVEM 1,L2012
+ POPJ 15,0
+ 2
+; (!*ENTRY !%THROW EXPR 2)
+%THROW: intern %THROW
+ ADJSP 15,5
+L2024: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 6,L2012
+ MOVE 6,0(6)
+ MOVEM 6,-2(15)
+ CAMN 0,-2(15)
+ JRST L2025
+ MOVE 6,-2(15)
+ CAMN 6,L2023
+ JRST L2025
+ CAMN 1,-2(15)
+ JRST L2025
+ MOVNI 7,4
+ ADDM 7,L2012
+ JRST L2024
+L2025: MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 4,L2012
+ MOVE 6,1(4)
+ MOVEM 6,-3(15)
+ MOVE 6,2(4)
+ MOVEM 6,-4(15)
+ MOVE 1,3(4)
+ PUSHJ 15,SYMFNC+514
+ MOVNI 7,4
+ ADDM 7,L2012
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+500
+ MOVE 6,0(15)
+ MOVEM 6,SYMVAL+526
+ MOVE 3,-4(15)
+ MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST L2026
+L2023: <30_30>+530
+; (!*ENTRY THROWAUX EXPR 3)
+L2026: intern L2026
+ MOVE 15,3
+ MOVEM 2,0(15)
+ POPJ 15,0
+ 2
+; (!*ENTRY THROW EXPR 2)
+THROW: intern THROW
+ MOVE 3,L2012
+ JRST L2027
+L2032: 24
+ byte(7)69,114,114,111,114,32,110,111,116,32,119,105,116,104,105,110,32,69,114,114,111,114,83,101,116,0
+L2033: 30
+ byte(7)67,97,116,99,104,32,116,97,103,32,37,114,32,110,111,116,32,102,111,117,110,100,32,105,110,32,84,104,114,111,119,0
+; (!*ENTRY FINDCATCHMARKANDTHROW EXPR 3)
+L2027: intern L2027
+ ADJSP 15,4
+L2034: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ SETZM 4
+ ADDI 4,L2011
+ CAME 3,4
+ JRST L2035
+ CAMN 1,L2028
+ JRST L2036
+ MOVE 2,1
+ MOVE 1,L2029
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L2030
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,-2(15)
+ HRRZI 1,99
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L2036: MOVE 1,L2031
+ ADJSP 15,-4
+ JRST SYMFNC+380
+L2035: CAMN 0,0(3)
+ JRST L2037
+ CAME 1,0(3)
+ JRST L2038
+L2037: ADJSP 15,-4
+ JRST SYMFNC+532
+L2038: SUBI 3,4
+ JRST L2034
+L2031: <4_30>+<1_18>+L2032
+L2030: <30_30>+495
+L2029: <4_30>+<1_18>+L2033
+L2028: <30_30>+496
+ 1
+; (!*ENTRY PROG FEXPR 1)
+PROG: intern PROG
+ ADJSP 15,4
+ JSP 10,SYMFNC+443
+ byte(18)1,539
+ MOVEM 0,0(15)
+ MOVEM 0,-1(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,540
+ LDB 11,L2039
+ CAIN 11,9
+ JRST L2044
+ MOVE 1,0
+ JRST L2045
+L2044: SETZM 0(15)
+ MOVE 2,SYMVAL+539
+ MOVE 2,0(2)
+ MOVEM 2,-2(15)
+L2046: LDB 11,L2040
+ CAIE 11,9
+ JRST L2047
+ MOVE 1,-2(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+542
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+241
+ MOVEM 1,0(15)
+ MOVE 2,-2(15)
+ MOVE 2,1(2)
+ MOVEM 2,-2(15)
+ JRST L2046
+L2047: MOVE 1,SYMVAL+539
+ MOVE 1,1(1)
+ MOVEM 1,SYMVAL+539
+ MOVEM 1,-2(15)
+L2048: LDB 11,L2040
+ CAIE 11,9
+ JRST L2049
+ MOVE 1,-2(15)
+ LDB 11,L2041
+ CAIE 11,30
+ JRST L2050
+ MOVE 2,SYMVAL+540
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,SYMVAL+540
+L2050: MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ JRST L2048
+L2049: LDB 11,L2039
+ CAIE 11,9
+ JRST L2051
+ MOVE 6,SYMVAL+539
+ LDB 11,L2042
+ CAIN 11,30
+ JRST L2052
+L2051: MOVE 1,0
+ JRST L2053
+L2052: MOVE 1,SYMVAL+539
+ MOVE 1,1(1)
+ MOVEM 1,SYMVAL+539
+ JRST L2049
+L2053: MOVE 1,SYMVAL+84
+ LDB 11,L2039
+ CAIN 11,9
+ JRST L2054
+ MOVE 1,0
+L2054: CAMN 1,0
+ JRST L2055
+ MOVE 1,L2043
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,-2(15)
+ CAME 0,SYMVAL+500
+ JRST L2056
+ MOVE 1,SYMVAL+539
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ MOVEM 1,-3(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+501
+ MOVE 1,-3(15)
+L2056: MOVEM 1,-1(15)
+ CAME 0,SYMVAL+500
+ JRST L2049
+ MOVE 1,0
+ MOVEM 1,-1(15)
+ MOVE 2,SYMVAL+539
+ MOVE 2,1(2)
+ MOVEM 2,SYMVAL+539
+ JRST L2049
+L2055: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+517
+ MOVE 1,-1(15)
+L2045: JSP 10,SYMFNC+447
+ 1
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-4
+ POPJ 15,0
+L2039: point 6,<SYMVAL+539>,5
+L2040: point 6,-2(15),5
+L2041: point 6,0(1),5
+L2042: point 6,0(6),5
+L2043: <30_30>+543
+L2061: 39
+ byte(7)71,79,32,97,116,116,101,109,112,116,101,100,32,111,117,116,115,105,100,101,32,116,104,101,32,115,99,111,112,101,32,111,102,32,97,32,80,82,79,71,0
+L2062: 41
+ byte(7)37,114,32,105,115,32,110,111,116,32,97,32,108,97,98,101,108,32,119,105,116,104,105,110,32,116,104,101,32,99,117,114,114,101,110,116,32,115,99,111,112,101,0
+ 1
+; (!*ENTRY GO FEXPR 1)
+GO: intern GO
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ CAMN 0,SYMVAL+539
+ JRST L2063
+ MOVE 2,SYMVAL+540
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+335
+ MOVEM 1,-1(15)
+ CAME 1,0
+ JRST L2064
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ MOVE 1,L2057
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-2(15)
+ MOVE 2,0(15)
+ MOVE 1,L2058
+ PUSHJ 15,SYMFNC+151
+ MOVE 3,1
+ MOVE 2,-2(15)
+ HRRZI 1,3001
+ ADJSP 15,-3
+ JRST SYMFNC+236
+L2064: MOVEM 1,SYMVAL+539
+ MOVE 2,0
+ MOVE 1,L2059
+ ADJSP 15,-3
+ JRST SYMFNC+535
+L2063: MOVE 2,L2058
+ PUSHJ 15,SYMFNC+278
+ MOVE 3,1
+ MOVE 2,L2060
+ HRRZI 1,3101
+ ADJSP 15,-3
+ JRST SYMFNC+236
+L2060: <4_30>+<1_18>+L2061
+L2059: <30_30>+543
+L2058: <30_30>+544
+L2057: <4_30>+<1_18>+L2062
+L2068: 43
+ byte(7)82,69,84,85,82,78,32,97,116,116,101,109,112,116,101,100,32,111,117,116,115,105,100,101,32,116,104,101,32,115,99,111,112,101,32,111,102,32,97,32,80,82,79,71,0
+ 1
+; (!*ENTRY RETURN EXPR 1)
+RETURN: intern RETURN
+ CAMN 0,SYMVAL+539
+ JRST L2069
+ MOVE 2,0
+ MOVEM 2,SYMVAL+539
+ MOVE 2,1
+ MOVE 1,L2065
+ JRST SYMFNC+535
+L2069: PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L2066
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,L2067
+ HRRZI 1,3102
+ JRST SYMFNC+236
+L2067: <4_30>+<1_18>+L2068
+L2066: <30_30>+545
+L2065: <30_30>+543
+ end
ADDED psl-1983/3-1/kernel/20/eval.rel
Index: psl-1983/3-1/kernel/20/eval.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/eval.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/extra.ctl
Index: psl-1983/3-1/kernel/20/extra.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/extra.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "extra";
+PathIn "extra.build";
+ASMEnd;
+quit;
+compile extra.mac, dextra.mac
ADDED psl-1983/3-1/kernel/20/extra.init
Index: psl-1983/3-1/kernel/20/extra.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/extra.init
@@ -0,0 +1,2 @@
+(FLUID (QUOTE (SYSTEM_LIST!*)))
+(COPYD (QUOTE EXITLISP) (QUOTE QUIT))
ADDED psl-1983/3-1/kernel/20/extra.log
Index: psl-1983/3-1/kernel/20/extra.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/extra.log
@@ -0,0 +1,64 @@
+
+ 8-Jun-83 9:38:56
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job EXTRA Req #481 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:10:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 1738
+
+ Input from => PS:<PSL.KERNEL.20.EXT>EXTRA.CTL.3
+ Output to => PS:<PSL.KERNEL.20.EXT>EXTRA.LOG
+
+
+
+ 9:38:57 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+ 9:38:57 MONTR @SET TIME-LIMIT 600
+ 9:38:57 MONTR @LOGIN KESSLER SMALL
+ 9:39:00 MONTR Job 12 on TTY224 8-Jun-83 09:39:00
+ 9:39:00 MONTR Previous login at 8-Jun-83 09:37:44
+ 9:39:00 MONTR There is 1 other job logged in as user KESSLER
+ 9:39:07 MONTR @
+ 9:39:07 MONTR [PS Mounted]
+ 9:39:07 MONTR
+ 9:39:07 MONTR [CONNECTED TO PS:<PSL.KERNEL.20.EXT>]
+ ;Modifications to this file may disappear, as this file is generated
+ ;automatically using information in P20:20-KERNEL-GEN.SL.
+ 9:39:07 MONTR def dsk: dsk:,p20e:,pk:,p20:
+ 9:39:08 MONTR @S:EX-DEC20-CROSS.EXE
+ 9:39:10 USER [32] ASMOut "extra";
+ 9:39:11 USER ASMOUT: IN files; or type in expressions
+ 9:39:11 USER When all done execute ASMEND;
+ 9:39:15 USER [33] PathIn "extra.build";
+ 9:39:15 USER %
+ 9:39:15 USER % EXTRA.BUILD - System-dependent extras
+ 9:39:15 USER %
+ 9:39:15 USER % Author: Eric Benson
+ 9:39:15 USER % Symbolic Computation Group
+ 9:39:15 USER % Computer Science Dept.
+ 9:39:15 USER % University of Utah
+ 9:39:15 USER % Date: 19 May 1982
+ 9:39:17 USER % Copyright (c) 1982 University of Utah
+ 9:39:17 USER %
+ 9:39:17 USER
+ 9:39:17 USER PathIn "timc.red"$ % System time routine
+ 9:39:19 USER PathIn "system-extras.red"$ % Random system-specific routines
+ 9:39:22 USER PathIn "trap.red"$ % Interrupt handler
+ 9:39:22 USER PathIn "dumplisp.red"$ % Core saver
+ 9:39:25 USER [34] ASMEnd;
+ 9:39:25 USER *** Garbage collection starting
+ 9:39:29 USER *** GC 13: time 2196 ms, 16480 recovered, 239324 free
+ 9:39:34 USER 0
+ 9:39:34 USER [35] quit;
+ 9:39:35 MONTR @compile extra.mac, dextra.mac
+ 9:39:37 USER MACRO: .MAIN
+ 9:39:42 USER MACRO: .MAIN
+ 9:39:43 USER
+ 9:39:43 USER EXIT
+ 9:39:43 MONTR @
+ 9:39:44 MONTR Killed by OPERATOR, TTY 221
+ 9:39:44 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 224,
+ 9:39:44 MONTR at 8-Jun-83 09:39:44, Used 0:00:19 in 0:00:43
ADDED psl-1983/3-1/kernel/20/extra.mac
Index: psl-1983/3-1/kernel/20/extra.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/extra.mac
@@ -0,0 +1,170 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ MOVNI 1,5
+ RUNTM
+ POPJ 15,0
+L2071: 8
+ byte(7)67,111,110,116,105,110,117,101,100,0
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ HALTF
+ MOVE 1,L2070
+ POPJ 15,0
+L2070: <4_30>+<1_18>+L2071
+ 0
+; (!*ENTRY DATE EXPR 0)
+DATE: intern DATE
+ HRRZI 1,8
+ PUSHJ 15,SYMFNC+145
+ MOVE 4,1
+ AOS 1
+ TLO 1,200704
+ SETOM 2
+ HRLZI 3,1
+ ODTIM
+ MOVE 1,4
+ TLZ 1,258048
+ TLO 1,16384
+ POPJ 15,0
+ 1
+; (!*ENTRY RETURNADDRESSP EXPR 1)
+L2072: intern L2072
+ MOVE 5,1
+ XMOVEI 2,SYMFNC
+ HRRZ 2,2
+ MOVE 3,2
+ HLRZ 1,1
+ CAIN 1,102400
+ JRST L2073
+ MOVE 1,0
+ JRST L2074
+L2073: MOVE 1,SYMVAL+84
+L2074: CAMN 1,0
+ JRST L2075
+ HLRZ 1,-1(5)
+ CAIN 1,90592
+ JRST L2076
+ MOVE 1,0
+ JRST L2077
+L2076: MOVE 1,SYMVAL+84
+L2077: CAMN 1,0
+ JRST L2075
+ HRRZ 1,-1(5)
+ SUB 1,2
+ MOVE 4,1
+ JUMPG 1,L2078
+ MOVE 1,0
+ JRST L2079
+L2078: MOVE 1,SYMVAL+84
+L2079: CAMN 1,0
+ JRST L2075
+ MOVE 1,SYMVAL+84
+ CAIGE 4,8000
+ JRST L2080
+ MOVE 1,0
+L2080: CAMN 1,0
+ JRST L2075
+ MOVE 1,4
+ HRLI 1,122880
+L2075: POPJ 15,0
+ extern L1080
+ extern L1082
+ extern L1110
+ extern L1111
+ extern L2081
+L2084: 36
+ byte(7)68,117,109,112,108,105,115,112,32,114,101,113,117,105,114,101,115,32,97,32,102,105,108,101,110,97,109,101,32,97,114,103,117,109,101,110,116,0
+ 1
+; (!*ENTRY DUMPLISP EXPR 1)
+L2085: intern L2085
+ PUSH 15,1
+ LDB 11,L2082
+ CAIN 11,4
+ JRST L2086
+ MOVE 1,L2083
+ PUSHJ 15,SYMFNC+156
+L2086: PUSHJ 15,SYMFNC+390
+ MOVE 2,L1082
+ MOVE 1,L1080
+ PUSHJ 15,SYMFNC+420
+ MOVE 2,L1111
+ MOVE 1,L1110
+ PUSHJ 15,SYMFNC+420
+ MOVE 2,L2081
+ HRRZ 1,15
+ IOR 1,[262144]
+ ADDI 1,10
+ PUSHJ 15,SYMFNC+420
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST L2087
+L2082: point 6,1,5
+L2083: <4_30>+<1_18>+L2084
+ 2
+; (!*ENTRY UNMAP!-SPACE EXPR 2)
+L2088: intern L2088
+ ADJSP 15,3
+ MOVEM 1,-2(15)
+ MOVEM 2,-1(15)
+ MOVE 3,1
+ ADDI 3,511
+ LSH 3,-9
+ MOVEM 3,0(15)
+ MOVE 4,2
+ SUBI 4,512
+ LSH 4,-9
+ MOVE 5,4
+ CAML 3,4
+ JRST L2089
+ MOVE 2,4
+ SUB 2,3
+ MOVE 1,3
+ ADJSP 15,-3
+ JRST L2090
+L2089: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY UNMAP!-PAGES EXPR 2)
+L2090: intern L2090
+ HRLZI 3,131072
+ HRR 3,2
+ HRLZI 2,131072
+ HRR 2,1
+ SETOM 1
+ PMAP
+ POPJ 15,0
+L2092: 31
+ byte(7)67,111,117,108,100,110,39,116,32,71,84,74,70,78,32,96,37,119,39,32,102,111,114,32,68,117,109,112,108,105,115,112,0
+; (!*ENTRY SAVE!-INTO!-FILE EXPR 1)
+L2087: intern L2087
+ MOVE 5,1
+ MOVE 2,1
+ TLZ 2,258048
+ TLO 2,221184
+ HRLZI 1,131073
+ GTJFN
+ JRST L2093
+ HRLI 1,131072
+ HRRZI 2,176128
+ TLO 2,131072
+ HRRZI 3,512
+ SSAVE
+ SETZM 1
+ POPJ 15,0
+L2093: MOVE 1,L2091
+ MOVE 2,5
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L2091: <4_30>+<1_18>+L2092
+ end
ADDED psl-1983/3-1/kernel/20/extra.rel
Index: psl-1983/3-1/kernel/20/extra.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/extra.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/fasl.ctl
Index: psl-1983/3-1/kernel/20/fasl.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fasl.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "fasl";
+PathIn "fasl.build";
+ASMEnd;
+quit;
+compile fasl.mac, dfasl.mac
ADDED psl-1983/3-1/kernel/20/fasl.init
Index: psl-1983/3-1/kernel/20/fasl.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fasl.init
@@ -0,0 +1,9 @@
+(FLUID (QUOTE (LOADDIRECTORIES!* LOADEXTENSIONS!* PENDINGLOADS!* !*LOWER
+!*REDEFMSG !*USERMODE !*INSIDELOAD !*VERBOSELOAD !*PRINTLOADNAMES OPTIONS!*)))
+(PUT (QUOTE LOAD) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE RELOAD) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE PP) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DEFSTRUCT) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE HELP) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE CREF) (QUOTE SIMPFG) (QUOTE ((T (CREFON)) (NIL (CREFOFF)))))
+(PUT (QUOTE SYSLISP) (QUOTE SIMPFG) (QUOTE ((T (LOAD SYSLISP)))))
ADDED psl-1983/3-1/kernel/20/fasl.log
Index: psl-1983/3-1/kernel/20/fasl.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fasl.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/fasl.mac
Index: psl-1983/3-1/kernel/20/fasl.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fasl.mac
@@ -0,0 +1,884 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+L2096: 34
+ byte(7)67,111,117,108,100,110,39,116,32,111,112,101,110,32,98,105,110,97,114,121,32,102,105,108,101,32,102,111,114,32,105,110,112,117,116,0
+ 1
+; (!*ENTRY BINARYOPENREAD EXPR 1)
+L2097: intern L2097
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 3,[-30064705536]
+ MOVE 2,[8590196736]
+ PUSHJ 15,SYMFNC+550
+ MOVEM 1,-1(15)
+ JUMPN 1,L2098
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L2094
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,L2095
+ HRRZI 1,99
+ ADJSP 15,-2
+ JRST SYMFNC+236
+L2098: ADJSP 15,-2
+ POPJ 15,0
+L2095: <4_30>+<1_18>+L2096
+L2094: <30_30>+549
+L2101: 35
+ byte(7)67,111,117,108,100,110,39,116,32,111,112,101,110,32,98,105,110,97,114,121,32,102,105,108,101,32,102,111,114,32,111,117,116,112,117,116,0
+ 1
+; (!*ENTRY BINARYOPENWRITE EXPR 1)
+L2102: intern L2102
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 3,[-30064738304]
+ MOVE 2,[-17179607040]
+ PUSHJ 15,SYMFNC+550
+ MOVEM 1,-1(15)
+ JUMPN 1,L2103
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L2099
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,L2100
+ HRRZI 1,99
+ ADJSP 15,-2
+ JRST SYMFNC+236
+L2103: ADJSP 15,-2
+ POPJ 15,0
+L2100: <4_30>+<1_18>+L2101
+L2099: <30_30>+551
+ 1
+; (!*ENTRY VALUECELLLOCATION EXPR 1)
+L2104: intern L2104
+ CAME 0,SYMVAL+553
+ JRST L2105
+ TLZ 1,258048
+ ADDI 1,SYMVAL
+ POPJ 15,0
+L2105: HRRZI 6,2
+ MOVEM 6,SYMVAL+554
+ PUSHJ 15,SYMFNC+555
+ MOVE 2,1
+ HRRZI 1,2
+ JRST SYMFNC+556
+ 1
+; (!*ENTRY EXTRAREGLOCATION EXPR 1)
+L2106: intern L2106
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ CAME 0,SYMVAL+553
+ JRST L2107
+ ADDI 1,-6+L0002
+ POPJ 15,0
+L2107: HRRZI 6,2
+ MOVEM 6,SYMVAL+554
+ MOVE 2,1
+ ADDI 2,8150
+ HRRZI 1,2
+ JRST SYMFNC+556
+ 1
+; (!*ENTRY FUNCTIONCELLLOCATION EXPR 1)
+L2108: intern L2108
+ CAME 0,SYMVAL+553
+ JRST L2109
+ TLZ 1,258048
+ ADDI 1,SYMFNC
+ POPJ 15,0
+L2109: HRRZI 6,2
+ MOVEM 6,SYMVAL+554
+ PUSHJ 15,SYMFNC+555
+ MOVE 2,1
+ HRRZI 1,3
+ JRST SYMFNC+556
+ extern L2110
+ extern L2111
+L2121: 27
+ byte(7)37,114,32,105,115,32,110,111,116,32,97,32,102,97,115,108,32,102,111,114,109,97,116,32,102,105,108,101,0
+ 1
+; (!*ENTRY FASLIN EXPR 1)
+FASLIN: intern FASLIN
+ ADJSP 15,16
+ MOVEM 1,0(15)
+ MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ MOVEM 0,-7(15)
+ MOVEM 0,-8(15)
+ MOVEM 0,-9(15)
+ MOVEM 0,-10(15)
+ MOVEM 0,-11(15)
+ MOVEM 0,-12(15)
+ MOVEM 0,-14(15)
+ PUSHJ 15,SYMFNC+549
+ MOVEM 1,-1(15)
+ BIN
+ MOVE 1,2
+ MOVEM 1,-2(15)
+ CAIN 1,2099
+ JRST L2122
+ MOVE 2,0(15)
+ MOVE 1,L2112
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-15(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L2113
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,-15(15)
+ HRRZI 1,99
+ PUSHJ 15,SYMFNC+236
+L2122: MOVE 1,-1(15)
+ BIN
+ MOVE 1,2
+ MOVEM 1,-3(15)
+ SETZM 1
+ PUSHJ 15,SYMFNC+392
+ MOVEM 1,-13(15)
+ MOVE 1,-3(15)
+ AOS 1
+ PUSHJ 15,SYMFNC+392
+ MOVEM 1,-4(15)
+ SETZM -15(15)
+L2123: MOVE 6,-15(15)
+ CAMLE 6,-3(15)
+ JRST L2124
+ MOVE 1,-1(15)
+ BIN
+ MOVE 1,2
+ MOVEM 1,L2110
+ HRRZI 2,5
+ MOVE 1,L2110
+ ADDI 1,6
+ IDIV 1,2
+ MOVE 3,1
+ SETZM 2
+ ADDI 2,1+L2110
+ MOVE 1,-1(15)
+ HRLI 2,149760
+ MOVNS 3
+ SIN
+ XMOVEI 1,L2110
+ TLZ 1,258048
+ TLO 1,16384
+ PUSHJ 15,SYMFNC+560
+ MOVE 2,-15(15)
+ ADD 2,-4(15)
+ TLZ 1,258048
+ MOVEM 1,0(2)
+ AOS -15(15)
+ JRST L2123
+L2124: MOVE 1,-1(15)
+ BIN
+ MOVE 1,2
+ MOVEM 1,-5(15)
+ MOVE 6,L2111
+ MOVEM 6,-6(15)
+ PUSHJ 15,SYMFNC+386
+ MOVEM 1,L2111
+ SETZM 1
+ PUSHJ 15,SYMFNC+386
+ MOVEM 1,-14(15)
+ MOVE 1,-1(15)
+ BIN
+ MOVE 1,2
+ MOVE 2,1
+ ADD 2,L2111
+ MOVEM 2,-7(15)
+ MOVE 3,-5(15)
+ MOVE 2,L2111
+ MOVE 1,-1(15)
+ HRLI 2,149760
+ MOVNS 3
+ SIN
+ MOVE 1,-1(15)
+ BIN
+ MOVE 1,2
+ MOVEM 1,-2(15)
+ PUSHJ 15,SYMFNC+392
+ MOVEM 1,-8(15)
+ MOVE 3,-2(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ HRLI 2,149760
+ MOVNS 3
+ SIN
+ MOVE 1,-1(15)
+ CLOSF
+ JFCL
+ SOS -5(15)
+ SETZM -15(15)
+L2125: MOVE 6,-15(15)
+ CAMLE 6,-5(15)
+ JRST L2126
+ MOVE 2,-15(15)
+ MOVE 1,-8(15)
+ ADJBP 2,L2114
+ LDB 1,2
+ MOVEM 1,-9(15)
+ MOVE 2,-15(15)
+ ADD 2,L2111
+ MOVEM 2,-12(15)
+ CAIN 1,1
+ JRST L2127
+ CAIN 1,2
+ JRST L2128
+ CAIN 1,3
+ JRST L2129
+ JRST L2130
+L2127: LDB 3,L2115
+ MOVEM 3,-10(15)
+ LDB 4,L2116
+ MOVEM 4,-11(15)
+ MOVE 1,3
+ CAIL 1,0
+ CAILE 1,3
+ JRST L2131
+ JRST @L2132-0(1)
+L2132: IFIW L2133
+ IFIW L2134
+ IFIW L2135
+ IFIW L2136
+L2131: JRST L2130
+L2133: MOVE 5,4
+ ADD 5,L2111
+ MOVEM 5,0(2)
+ JRST L2130
+L2135: CAIGE 4,8150
+ JRST L2137
+ XMOVEI 7,-8156+L0002
+ ADDM 7,-11(15)
+ JRST L2138
+L2137: CAIGE 4,2048
+ JRST L2139
+ MOVE 5,4
+ ADD 5,-4(15)
+ XMOVEI 4,SYMVAL
+ ADD 4,-2048(5)
+ MOVEM 4,-11(15)
+ JRST L2138
+L2139: XMOVEI 7,SYMVAL
+ ADDM 7,-11(15)
+L2138: MOVE 6,-11(15)
+ MOVEM 6,0(2)
+ JRST L2130
+L2136: CAIGE 4,2048
+ JRST L2140
+ MOVE 5,4
+ ADD 5,-4(15)
+ MOVE 6,-2048(5)
+ MOVEM 6,-11(15)
+L2140: MOVE 5,-11(15)
+ ADDI 5,SYMFNC
+ MOVEM 5,0(2)
+ JRST L2130
+L2134: CAIGE 4,2048
+ JRST L2141
+ MOVE 5,4
+ ADD 5,-4(15)
+ MOVE 6,-2048(5)
+ MOVEM 6,-11(15)
+L2141: MOVE 6,-11(15)
+ MOVEM 6,0(2)
+ JRST L2130
+L2128: LDB 3,L2117
+ MOVEM 3,-10(15)
+ LDB 4,L2118
+ MOVEM 4,-11(15)
+ MOVE 1,3
+ CAIL 1,0
+ CAILE 1,3
+ JRST L2142
+ JRST @L2143-0(1)
+L2143: IFIW L2144
+ IFIW L2145
+ IFIW L2146
+ IFIW L2147
+L2142: JRST L2130
+L2144: MOVE 5,4
+ ADD 5,L2111
+ MOVE 7,0(2)
+ MOVE 6,5
+ DPB 6,L2119
+ MOVEM 7,0(2)
+ JRST L2130
+L2146: CAIGE 4,8150
+ JRST L2148
+ XMOVEI 7,-8156+L0002
+ ADDM 7,-11(15)
+ JRST L2149
+L2148: CAIGE 4,2048
+ JRST L2150
+ MOVE 5,4
+ ADD 5,-4(15)
+ XMOVEI 4,SYMVAL
+ ADD 4,-2048(5)
+ MOVEM 4,-11(15)
+ JRST L2149
+L2150: XMOVEI 7,SYMVAL
+ ADDM 7,-11(15)
+L2149: MOVE 7,0(2)
+ MOVE 6,-11(15)
+ DPB 6,L2119
+ MOVEM 7,0(2)
+ JRST L2130
+L2147: CAIGE 4,2048
+ JRST L2151
+ MOVE 5,4
+ ADD 5,-4(15)
+ MOVE 6,-2048(5)
+ MOVEM 6,-11(15)
+L2151: MOVE 5,-11(15)
+ ADDI 5,SYMFNC
+ MOVE 7,0(2)
+ MOVE 6,5
+ DPB 6,L2119
+ MOVEM 7,0(2)
+ JRST L2130
+L2145: CAIGE 4,2048
+ JRST L2152
+ MOVE 5,4
+ ADD 5,-4(15)
+ MOVE 6,-2048(5)
+ MOVEM 6,-11(15)
+L2152: MOVE 7,0(2)
+ MOVE 6,-11(15)
+ DPB 6,L2119
+ MOVEM 7,0(2)
+ JRST L2130
+L2129: LDB 3,L2117
+ MOVEM 3,-10(15)
+ LDB 4,L2118
+ MOVEM 4,-11(15)
+ MOVE 1,3
+ CAIL 1,0
+ CAILE 1,3
+ JRST L2153
+ JRST @L2154-0(1)
+L2154: IFIW L2155
+ IFIW L2156
+ IFIW L2157
+ IFIW L2158
+L2153: JRST L2130
+L2155: MOVE 5,4
+ ADD 5,L2111
+ MOVE 7,0(2)
+ MOVE 6,5
+ DPB 6,L2120
+ MOVEM 7,0(2)
+ JRST L2130
+L2157: CAIGE 4,8150
+ JRST L2159
+ XMOVEI 7,-8156+L0002
+ ADDM 7,-11(15)
+ JRST L2160
+L2159: CAIGE 4,2048
+ JRST L2161
+ MOVE 5,4
+ ADD 5,-4(15)
+ XMOVEI 4,SYMVAL
+ ADD 4,-2048(5)
+ MOVEM 4,-11(15)
+ JRST L2160
+L2161: XMOVEI 7,SYMVAL
+ ADDM 7,-11(15)
+L2160: MOVE 7,0(2)
+ MOVE 6,-11(15)
+ DPB 6,L2120
+ MOVEM 7,0(2)
+ JRST L2130
+L2158: CAIGE 4,2048
+ JRST L2162
+ MOVE 5,4
+ ADD 5,-4(15)
+ MOVE 6,-2048(5)
+ MOVEM 6,-11(15)
+L2162: MOVE 5,-11(15)
+ ADDI 5,SYMFNC
+ MOVE 7,0(2)
+ MOVE 6,5
+ DPB 6,L2120
+ MOVEM 7,0(2)
+ JRST L2130
+L2156: CAIGE 4,2048
+ JRST L2163
+ MOVE 5,4
+ ADD 5,-4(15)
+ MOVE 6,-2048(5)
+ MOVEM 6,-11(15)
+L2163: MOVE 7,0(2)
+ MOVE 6,-11(15)
+ DPB 6,L2120
+ MOVEM 7,0(2)
+L2130: AOS -15(15)
+ JRST L2125
+L2126: MOVE 2,-13(15)
+ MOVE 1,-8(15)
+ PUSHJ 15,SYMFNC+393
+ MOVE 1,-7(15)
+ PUSHJ 15,0(1)
+ MOVE 6,-6(15)
+ MOVEM 6,L2111
+ MOVE 2,-14(15)
+ MOVE 1,-7(15)
+ PUSHJ 15,SYMFNC+391
+ MOVE 1,0
+ ADJSP 15,-16
+ POPJ 15,0
+L2114: point 2,0(1),1
+L2115: point 2,0(2),1
+L2116: point 34,0(2),35
+L2117: point 2,0(2),19
+L2118: point 16,0(2),35
+L2119: point 18,7,35
+L2120: point 30,7,35
+L2113: <30_30>+559
+L2112: <4_30>+<1_18>+L2121
+ 3
+; (!*ENTRY PUTENTRY EXPR 3)
+L2164: intern L2164
+ ADD 3,L2111
+ TLZ 3,258048
+ TLO 3,61440
+ JRST SYMFNC+251
+ 1
+; (!*ENTRY LOAD MACRO 1)
+LOAD: intern LOAD
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L2165
+ JRST SYMFNC+249
+L2165: <30_30>+434
+ 1
+; (!*ENTRY EVLOAD EXPR 1)
+EVLOAD: intern EVLOAD
+ PUSH 15,1
+ PUSH 15,1
+L2167: LDB 11,L2166
+ CAIN 11,9
+ JRST L2168
+ MOVE 1,0
+ JRST L2169
+L2168: MOVE 1,-1(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+567
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ JRST L2167
+L2169: ADJSP 15,-2
+ POPJ 15,0
+L2166: point 6,-1(15),5
+ 1
+; (!*ENTRY RELOAD MACRO 1)
+RELOAD: intern RELOAD
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L2170
+ JRST SYMFNC+249
+L2170: <30_30>+569
+ 1
+; (!*ENTRY EVRELOAD EXPR 1)
+L2172: intern L2172
+ PUSH 15,1
+ PUSH 15,1
+L2173: LDB 11,L2171
+ CAIN 11,9
+ JRST L2174
+ MOVE 1,0
+ JRST L2175
+L2174: MOVE 1,-1(15)
+ MOVE 1,0(1)
+ MOVE 2,SYMVAL+466
+ PUSHJ 15,SYMFNC+301
+ MOVEM 1,SYMVAL+466
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVEM 2,-1(15)
+ JRST L2173
+L2175: MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+434
+L2171: point 6,-1(15),5
+L2180: 15
+ byte(7)42,42,42,32,108,111,97,100,105,110,103,32,37,119,37,110,0
+L2181: 23
+ byte(7)37,114,32,108,111,97,100,32,109,111,100,117,108,101,32,110,111,116,32,102,111,117,110,100,0
+L2182: 5
+ byte(7)37,119,37,119,37,119,0
+L2183: 20
+ byte(7)42,42,42,32,37,119,32,97,108,114,101,97,100,121,32,108,111,97,100,101,100,0
+ 1
+; (!*ENTRY LOAD1 EXPR 1)
+LOAD1: intern LOAD1
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,570
+ byte(18)0,571
+ CAMN 0,SYMVAL+564
+ JRST L2184
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+571
+L2184: MOVE 2,SYMVAL+466
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L2185
+ CAMN 0,SYMVAL+564
+ JRST L2186
+ MOVE 2,0(15)
+ MOVE 1,L2176
+ PUSHJ 15,SYMFNC+418
+ JRST L2187
+L2186: MOVE 1,0
+ JRST L2187
+L2185: MOVE 1,SYMVAL+84
+ JSP 10,SYMFNC+443
+ byte(18)1,572
+ MOVE 6,SYMVAL+562
+ MOVEM 6,-1(15)
+ MOVE 1,SYMVAL+84
+ JSP 10,SYMFNC+443
+ byte(18)1,573
+L2188: CAMN 0,-1(15)
+ JRST L2189
+ CAMN 0,-4(15)
+ JRST L2190
+L2189: MOVE 1,0
+ JRST L2191
+L2190: MOVE 6,SYMVAL+563
+ MOVEM 6,-2(15)
+L2192: CAMN 0,-2(15)
+ JRST L2193
+ CAME 0,-4(15)
+ JRST L2193
+ MOVE 4,-2(15)
+ MOVE 4,0(4)
+ MOVE 4,0(4)
+ MOVE 3,0(15)
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,L2177
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-3(15)
+ PUSHJ 15,SYMFNC+364
+ CAMN 1,0
+ JRST L2194
+ MOVE 2,-2(15)
+ MOVE 2,0(2)
+ MOVE 2,1(2)
+ MOVEM 2,-4(15)
+L2194: MOVE 2,-2(15)
+ MOVE 2,1(2)
+ MOVEM 2,-2(15)
+ JRST L2192
+L2193: MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ JRST L2188
+L2191: JSP 10,SYMFNC+447
+ 1
+ CAME 0,-4(15)
+ JRST L2195
+ MOVE 2,0(15)
+ MOVE 1,L2178
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+ JRST L2196
+L2195: MOVE 2,SYMVAL+466
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,SYMVAL+466
+ CAME 0,SYMVAL+564
+ JRST L2197
+ CAMN 0,SYMVAL+565
+ JRST L2198
+L2197: MOVE 2,-3(15)
+ MOVE 1,L2179
+ PUSHJ 15,SYMFNC+418
+L2198: MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+L2199: CAME 0,SYMVAL+574
+ JRST L2200
+ MOVE 1,0
+ JRST L2196
+L2200: MOVE 1,SYMVAL+574
+ MOVE 1,0(1)
+ MOVEM 1,-4(15)
+ MOVE 2,SYMVAL+574
+ MOVE 2,1(2)
+ MOVEM 2,SYMVAL+574
+ PUSHJ 15,LOAD1
+ JRST L2199
+L2196: JSP 10,SYMFNC+447
+ 1
+L2187: JSP 10,SYMFNC+447
+ 2
+ ADJSP 15,-5
+ POPJ 15,0
+L2179: <4_30>+<1_18>+L2180
+L2178: <4_30>+<1_18>+L2181
+L2177: <4_30>+<1_18>+L2182
+L2176: <4_30>+<1_18>+L2183
+ 1
+; (!*ENTRY IMPORTS EXPR 1)
+L2202: intern L2202
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ CAMN 0,SYMVAL+572
+ JRST L2203
+ MOVEM 0,-1(15)
+ MOVEM 1,-1(15)
+L2204: LDB 11,L2201
+ CAIN 11,9
+ JRST L2205
+ MOVE 1,0
+ JRST L2206
+L2205: MOVE 1,-1(15)
+ MOVE 1,0(1)
+ MOVEM 1,-2(15)
+ MOVE 2,SYMVAL+466
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L2207
+ MOVE 2,SYMVAL+574
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L2207
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVE 1,SYMVAL+574
+ PUSHJ 15,SYMFNC+177
+ MOVEM 1,SYMVAL+574
+L2207: MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ JRST L2204
+L2203: ADJSP 15,-3
+ JRST SYMFNC+434
+L2206: ADJSP 15,-3
+ POPJ 15,0
+L2201: point 6,-1(15),5
+L2210: <30_30>+576
+ <30_30>+128
+ 1
+; (!*ENTRY PRETTYPRINT EXPR 1)
+L2211: intern L2211
+ PUSH 15,1
+ MOVE 1,L2208
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2209
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2209: <30_30>+577
+L2208: <9_30>+<1_18>+L2210
+L2214: <30_30>+576
+ <30_30>+128
+ 1
+; (!*ENTRY PP FEXPR 1)
+PP: intern PP
+ PUSH 15,1
+ MOVE 1,L2212
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2213
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2213: <30_30>+576
+L2212: <9_30>+<1_18>+L2214
+L2217: <30_30>+578
+ <30_30>+128
+ 1
+; (!*ENTRY DEFSTRUCT FEXPR 1)
+L2218: intern L2218
+ PUSH 15,1
+ MOVE 1,L2215
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2216
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2216: <30_30>+578
+L2215: <9_30>+<1_18>+L2217
+L2221: <30_30>+579
+ <30_30>+128
+ 1
+; (!*ENTRY STEP EXPR 1)
+STEP: intern STEP
+ PUSH 15,1
+ MOVE 1,L2219
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2220
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2220: <30_30>+579
+L2219: <9_30>+<1_18>+L2221
+L2224: <30_30>+580
+ <30_30>+128
+ 1
+; (!*ENTRY MINI EXPR 1)
+MINI: intern MINI
+ PUSH 15,1
+ MOVE 1,L2222
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2223
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2223: <30_30>+580
+L2222: <9_30>+<1_18>+L2224
+L2227: <30_30>+450
+ <30_30>+128
+ 1
+; (!*ENTRY HELP FEXPR 1)
+HELP: intern HELP
+ PUSH 15,1
+ MOVE 1,L2225
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2226
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2226: <30_30>+450
+L2225: <9_30>+<1_18>+L2227
+L2230: <30_30>+581
+ <30_30>+128
+ 0
+; (!*ENTRY EMODE EXPR 0)
+EMODE: intern EMODE
+ MOVE 1,L2228
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L2229
+ MOVE 6,1
+ JRST SYMFNC+288
+L2229: <30_30>+581
+L2228: <9_30>+<1_18>+L2230
+L2233: <30_30>+580
+ <30_30>+128
+ 1
+; (!*ENTRY INVOKE EXPR 1)
+INVOKE: intern INVOKE
+ PUSH 15,1
+ MOVE 1,L2231
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2232
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2232: <30_30>+582
+L2231: <9_30>+<1_18>+L2233
+L2236: <30_30>+583
+ <30_30>+128
+ 0
+; (!*ENTRY CREFON EXPR 0)
+CREFON: intern CREFON
+ MOVE 1,L2234
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L2235
+ MOVE 6,1
+ JRST SYMFNC+288
+L2235: <30_30>+584
+L2234: <9_30>+<1_18>+L2236
+L2239: <30_30>+585
+ <30_30>+128
+ 3
+; (!*ENTRY COMPD EXPR 3)
+COMPD: intern COMPD
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 1,L2237
+ PUSHJ 15,SYMFNC+434
+ MOVE 4,L2238
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 6,4
+ ADJSP 15,-3
+ JRST SYMFNC+288
+L2238: <30_30>+586
+L2237: <9_30>+<1_18>+L2239
+L2242: <30_30>+585
+ <30_30>+128
+ 1
+; (!*ENTRY FASLOUT EXPR 1)
+L2243: intern L2243
+ PUSH 15,1
+ MOVE 1,L2240
+ PUSHJ 15,SYMFNC+434
+ MOVE 2,L2241
+ MOVE 1,0(15)
+ MOVE 6,2
+ ADJSP 15,-1
+ JRST SYMFNC+288
+L2241: <30_30>+587
+L2240: <9_30>+<1_18>+L2242
+L2246: <30_30>+588
+ <30_30>+128
+ 0
+; (!*ENTRY BUG EXPR 0)
+BUG: intern BUG
+ MOVE 1,L2244
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L2245
+ MOVE 6,1
+ JRST SYMFNC+288
+L2245: <30_30>+588
+L2244: <9_30>+<1_18>+L2246
+L2249: <30_30>+589
+ <30_30>+128
+ 0
+; (!*ENTRY MM EXPR 0)
+MM: intern MM
+ MOVE 1,L2247
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L2248
+ MOVE 6,1
+ JRST SYMFNC+288
+L2248: <30_30>+590
+L2247: <9_30>+<1_18>+L2249
+L2252: <30_30>+589
+ <30_30>+128
+ 0
+; (!*ENTRY EXEC EXPR 0)
+EXEC: intern EXEC
+ MOVE 1,L2250
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L2251
+ MOVE 6,1
+ JRST SYMFNC+288
+L2251: <30_30>+589
+L2250: <9_30>+<1_18>+L2252
+ end
ADDED psl-1983/3-1/kernel/20/fasl.rel
Index: psl-1983/3-1/kernel/20/fasl.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fasl.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/faslin.red
Index: psl-1983/3-1/kernel/20/faslin.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/faslin.red
@@ -0,0 +1,145 @@
+% 25-May-1983 Mark R. Swanson
+% Changed magic number to differentiate extended-20 fasl files from old ones
+
+on SysLisp;
+
+external WString TokenBuffer;
+external WArray ArgumentBlock;
+
+internal WConst CODE_OFFSET = 0,
+ RELOC_ID_NUMBER = 1,
+ RELOC_VALUE_CELL = 2,
+ RELOC_FUNCTION_CELL = 3;
+
+internal WConst RELOC_WORD = 1,
+ RELOC_RIGHT_HALF = 2,
+ RELOC_INF = 3;
+
+internal WConst FASLMAGIC = 2099;
+
+CompileTime <<
+
+smacro procedure LocalIDNumberP U;
+ U >= 2048;
+
+smacro procedure LocalToGlobalID U;
+ IDTable[U - 2048];
+
+smacro procedure ExtraArgumentP U;
+ U >= 8150; % Something enough less than 8192
+
+smacro procedure MakeExtraArgument U;
+ U - (8150 + (MaxRealRegs + 1));
+>>;
+
+internal WVar CodeBase;
+
+syslsp procedure FaslIN File;
+begin scalar F, N, M, IDTable, CodeSize, OldCodeBase,
+ E, BT, R, RT, RI, BI, Top, BTop;
+ F := BinaryOpenRead File;
+ N := BinaryRead F; % First word is magic number
+ if N neq FASLMAGIC then ContError(99,
+ "%r is not a fasl format file",
+ File,
+ FaslIN File);
+ M := BinaryRead F; % Number of local IDs
+ Top := GtWArray 0; % pointer to top of space
+ IDTable := GtWArray(M + 1); % Allocate space for table
+ for I := 0 step 1 until M do
+ << TokenBuffer[0] := BinaryRead F; % word is length of ID name
+ BinaryReadBlock(F, &TokenBuffer[1], StrPack TokenBuffer[0]);
+ IDTable[I] := IDInf Intern MkSTR TokenBuffer >>;
+ CodeSize := BinaryRead F; % Size of code segment in words
+ OldCodeBase := CodeBase; % So FASLIN is reentrant
+ CodeBase := GtBPS CodeSize; % Allocate space in BPS
+ BTop := GTBPS 0; % pointer to top
+ E := CodeBase + BinaryRead F; % Next word is offset of init function
+ % Will be called after code is read
+ BinaryReadBlock(F, CodeBase, CodeSize); % Put the next N words there
+ N := BinaryRead F; % Next word is size of bit table in words
+ BT := GtWArray N; % Allocate space for bit table
+ BinaryReadBlock(F, BT, N); % read bit table
+ BinaryClose F; % close the file
+ CodeSize := CodeSize*AddressingUnitsPerItem - 1;
+ for I := 0 step 1 until CodeSize do
+ << R := BitTable(BT, I);
+ BI := CodeBase + I;
+ case R of
+ RELOC_WORD:
+ << RT := RelocWordTag @BI;
+ RI := RelocWordInf @BI;
+ case RT of
+ CODE_OFFSET:
+ @BI := CodeBase + RI;
+ RELOC_VALUE_CELL:
+ << if ExtraArgumentP RI then
+ RI := &ArgumentBlock[MakeExtraArgument RI]
+ else if LocalIDNumberP RI then
+ RI := &SymVal LocalToGlobalID RI
+ else RI := &SymVal RI;
+ @BI := RI >>;
+ RELOC_FUNCTION_CELL:
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ @BI :=
+ SymFnc + AddressingUnitsPerFunctionCell*RI >>;
+ RELOC_ID_NUMBER: % Must be a local ID number
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ @BI := RI >>;
+ end >>;
+ RELOC_RIGHT_HALF:
+ << RT := RelocRightHalfTag @BI;
+ RI := RelocRightHalfInf @BI;
+ case RT of
+ CODE_OFFSET:
+ RightHalf @BI := CodeBase + RI;
+ RELOC_VALUE_CELL:
+ << if ExtraArgumentP RI then
+ RI := &ArgumentBlock[MakeExtraArgument RI]
+ else if LocalIDNumberP RI then
+ RI := &SymVal LocalToGlobalID RI
+ else RI := &SymVal RI;
+ RightHalf @BI := RI >>;
+ RELOC_FUNCTION_CELL:
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ RightHalf @BI :=
+ SymFnc + AddressingUnitsPerFunctionCell*RI >>;
+ RELOC_ID_NUMBER: % Must be a local ID number
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ RightHalf @BI := RI >>;
+ end >>;
+ RELOC_INF:
+ << RT := RelocInfTag @BI;
+ RI := RelocInfInf @BI;
+ case RT of
+ CODE_OFFSET:
+ Inf @BI := CodeBase + RI;
+ RELOC_VALUE_CELL:
+ << if ExtraArgumentP RI then
+ RI := &ArgumentBlock[MakeExtraArgument RI]
+ else if LocalIDNumberP RI then
+ RI := &SymVal LocalToGlobalID RI
+ else RI := &SymVal RI;
+ Inf @BI := RI >>;
+ RELOC_FUNCTION_CELL:
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ Inf @BI :=
+ SymFnc + AddressingUnitsPerFunctionCell*RI >>;
+ RELOC_ID_NUMBER: % Must be a local ID number
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ Inf @BI := RI >>;
+ end >>;
+ end >>;
+ DelWArray(BT, Top);
+ % return the space used by tables
+ AddressApply0 E; % Call the init routine
+ CodeBase := OldCodeBase; % restore previous value for CodeBase
+ DelBPS(E, BTop); % deallocate space of init routine
+end;
+
+syslsp procedure PutEntry(Name, Type, Offset);
+ PutD(Name, Type, MkCODE(CodeBase + Offset));
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/fast-binder.red
Index: psl-1983/3-1/kernel/20/fast-binder.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fast-binder.red
@@ -0,0 +1,86 @@
+%
+% FAST-BINDER.RED - Fast binding and unbinding routines in LAP for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 12 July 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 25-May-1983 Mark R. Swanson
+% Changed FastBind to zero out left half of a symbol table index (for extended
+% addressing 20).
+
+on SysLisp;
+
+external WVar BndStkPtr, % The binding stack pointer
+ BndStkLowerBound, % Bottom of the binding stack
+ BndStkUpperBound; % Top of the binding stack
+
+% TAG( FastBind )
+
+lap '((!*Entry FastBind expr 0) % Bind IDs to values in registers
+%
+% FastBind is called with JSP T5, followed by
+% regnum,,idnum
+% ...
+%
+ (!*MOVE (WVar BndStkPtr) (reg t2)) % load binding stack pointer
+Loop
+ (!*MOVE (Indexed (reg t5) (WConst 0)) (reg t1)) % get next entry
+ (tlnn (reg t1) 8#777000) % if it's not an instruction
+ (!*JUMP (Label MoreLeft)) % keep binding
+ (!*MOVE (reg t2) (WVar BndStkPtr)) % Otherwise store bind stack pointer
+ (!*JUMP (MEMORY (reg t5) (WConst 0))) % and return
+MoreLeft
+ (!*WPLUS2 (reg t2) (WConst 2)) % add 2 to binding stack pointer
+ (caml (reg t2) (WVar BndStkUpperBound)) % if overflow occured
+ (!*JCALL BStackOverflow) % then error
+ (hlrz (reg t3) (reg t1)) % stick register number in t3
+ (caile (reg t3) (WConst MaxRealRegs)) % is it a real register?
+ (!*WPLUS2 (reg t3) % no, move to arg block
+ (WConst (difference (WArray ArgumentBlock)
+ (plus (WConst MaxRealRegs) 1))))
+
+ (hrrzm (reg t1) (Indexed (reg t2) (WConst -1)))
+ % store ID number in BndStk
+ (hrrz (reg t1) (reg t1)) % zero out left half of reg t1 for
+ % extended memory
+ (!*MOVE (MEMORY (reg t1) (WConst SymVal)) (reg t4))
+ % get old value for ID in t4
+ (!*MOVE (reg t4) (MEMORY (reg t2) (WConst 0))) % store value in BndStk
+ (!*MOVE (MEMORY (reg t3) (WConst 0)) (reg t3)) % get reg value in t3
+ (!*MOVE (reg t3) (MEMORY (reg t1) (WConst SymVal)))
+ % store in ID value cell
+ (aoja (reg t5) Loop) % try again
+);
+
+% TAG( FastUnBind )
+
+lap '((!*Entry FastUnBind expr 0) % Unbind last N entries in bind stack
+%
+% FastUnBind is called with JSP T5, followed by word containing count to
+% unbind.
+%
+ (!*MOVE (WVar BndStkPtr) (reg t1)) % get binding stack pointer in t1
+ (!*MOVE (MEMORY (reg t5) (WConst 0)) (reg t2)) % count in t2
+Loop
+ (!*JUMPWGREATERP (Label MoreLeft) (reg t2) (WConst 0))
+ % continue if count is > zero
+ (!*MOVE (reg t1) (WVar BndStkPtr)) % otherwise store bind stack pointer
+ (!*JUMP (MEMORY (reg t5) (WConst 1))) % and return
+MoreLeft
+ (camge (reg t1) (WVar BndStkLowerBound)) % check for underflow
+ (!*JCALL BStackUnderflow)
+ (dmove (reg t3) (Indexed (reg t1) -1)) % get ID # in t3, value in t4
+ (!*MOVE (reg t4) (MEMORY (reg t3) (WConst SymVal)))
+ % restore to value cell
+ (!*WDIFFERENCE (reg t1) (WConst 2)) % adjust binding stack pointer -2
+ (soja (reg t2) Loop) % and count down by 1, then try again
+);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/fresh-kernel.ctl
Index: psl-1983/3-1/kernel/20/fresh-kernel.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/fresh-kernel.ctl
@@ -0,0 +1,5 @@
+rename 20.SYM PREVIOUS-20.SYM
+copy PC:BARE-PSL.SYM 20.SYM
+; To regenerate the .CTL files:
+; PSL:PSL
+; (dskin "20-kernel-gen.sl")
ADDED psl-1983/3-1/kernel/20/function-primitives.red
Index: psl-1983/3-1/kernel/20/function-primitives.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/function-primitives.red
@@ -0,0 +1,92 @@
+%
+% FUNCTION-PRIMITIVES.RED - primitives used by PUTD/GETD and EVAL/APPLY
+% P20: version
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 22-May-83 Mark R. Swanson
+% Changes to support extended addressing on -20: essentially making
+% references to SYMFNC explicit array refences.
+
+% Every ID has a "function cell". It does not necessarily contain a legal
+% Lisp item, and therefore should not be accessed directly by Lisp functions.
+% In this implementation the function cell contains an instruction to be
+% executed. There are 3 possibilites for this instruction, for which the
+% following predicates and updating functions exist:
+%
+% FUnBoundP(ID) -- the function is not defined
+% FLambdaLinkP(ID) -- the function is interpreted
+% FCodeP(ID) -- the function is compiled
+%
+% MakeFUnBound(ID) -- undefine the function
+% MakeFLambdaLink(ID) -- specify that the function is interpreted
+% MakeFCode(ID, CodePtr) -- specify that the function is compiled,
+% and that the code resides at the address
+% associated with CodePtr
+%
+% GetFCodePointer(ID) -- returns the contents of the function cell as a
+% code pointer
+
+% These functions currently check that they have proper arguments, but this may
+% change since they are only used by functions that have checked them already.
+
+% Note that MakeFCode is necessarily machine-dependent -- this file currently
+% contains the PDP-10 version. This function should be moved to a file of
+% system-dependent routines. Of course, other things in this file will
+% probably have to change for a different machine as well.
+
+on SysLisp;
+internal WConst SymfncJsp = 8#265500000000 + &SymFnc[0];
+internal WVar UnDefn = SymFncJsp + IDLoc UndefinedFunction;
+internal WVar LamLnk = SymFncJsp + IDLoc CompiledCallingInterpreted;
+
+% currently the WVars UnDefn and LamLnk contain the instructions which will
+% be found in the function cells of undefined and interpreted functions.
+
+syslsp procedure FUnBoundP U; %. does U not have a function defn?
+ if IDP U then SymFnc[Inf U] eq Undefn
+ else NonIDError(U, 'FUnBoundP);
+
+syslsp procedure FLambdaLinkP U; %. is U an interpreted function?
+ if IDP U then SymFnc [Inf U] eq LamLnk
+ else NonIDError(U, 'FLambdaLinkP);
+
+syslsp procedure FCodeP U; %. is U a compiled function?
+ if IDP U then SymFnc[Inf U] neq UnDefn
+ and SymFnc[Inf U] neq LamLnk
+ else NonIDError(U, 'FCodeP);
+
+syslsp procedure MakeFUnBound U; %. Make U an undefined function
+ if IDP U then
+ << SymFnc[Inf U] := UnDefn;
+ NIL >>
+ else NonIDError(U, 'MakeFUnBound);
+
+syslsp procedure MakeFLambdaLink U; %. Make U an interpreted function
+ if IDP U then
+ << SymFnc[Inf U] := LamLnk;
+ NIL >>
+ else NonIDError(U, 'MakeFLambdaLink);
+
+
+syslsp procedure MakeFCode(U, CodePtr); %. Make U a compiled function
+ if IDP U then
+ if CodeP CodePtr then
+ << SymFnc[Inf U] := Field(CodePtr, 18, 18) + 8#254000000000;
+% PutField(SymFnc U, 0, 9, 8#254); % JRST
+ NIL >>
+ else NonIDError(U, 'MakeFCode);
+
+syslsp procedure GetFCodePointer U; %. Get code pointer for U
+ if IDP U then MkCODE Field(SymFnc[Inf U], 12, 24)
+ else NonIDError(U, 'GetFCodePointer);
+
+off SysLisp;
+
+END;
+
ADDED psl-1983/3-1/kernel/20/gc.red
Index: psl-1983/3-1/kernel/20/gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/gc.red
@@ -0,0 +1,252 @@
+
+%
+% GC.RED - Copying 2-space garbage collector for PSL
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 30 November 1981
+% Copyright (c) 1981 Eric Benson
+%
+
+% Edit by Mark Swanson, 3 April 1983 0949-MST
+% Made COPYITEM1 tail-recursive so that long lists can be copied without
+% stack overflow -- both COPYITEM and COPYITEM1 are now called exclusively
+% for their side effects--return values should be ignored.
+
+% Edit by Cris Perdue, 25 Mar 1983 1711-PST
+% Occurrence of heap-warn-level in initialization no longer flagged
+% with "LispVar". Didn't work.
+% <PSL.KERNEL>COPYING-GC.RED.2, 23-Mar-83 11:35:37, Edit by KESSLER
+% Add HeadTrapBound Guys, so we can update the heap trap bound upon switch
+
+% Edit by Cris Perdue, 15 Mar 1983 0937-PST
+% Added missing comma as noted by Kessler.
+% Edit by Cris Perdue, 16 Feb 1983 1409-PST
+% Removed external declaration of HeapPreviousLast (the only occurrence)
+
+% Now using "known-free-space" function and heap-warn-level
+% Sets HeapTrapped to NIL now.
+% Added check of Heap!-Warn!-Level after %Reclaim.
+% <PSL.KERNEL>COPYING-GC.RED.6, 4-Oct-82 17:56:49, Edit by BENSON
+% Added GCTime!*
+
+fluid '(!*GC GCKnt!* GCTime!* Heap!-Warn!-Level);
+
+LoadTime
+<< GCKnt!* := 0;
+ GCTime!* := 0;
+ !*GC := T;
+ Heap!-Warn!-Level := 1000
+>>;
+
+on SysLisp;
+
+CompileTime <<
+syslsp smacro procedure PointerTagP X;
+ X > PosInt and X < Code;
+
+syslsp smacro procedure WithinOldHeapPointer X;
+ X >= !%chipmunk!-kludge OldHeapLowerBound
+ and X <= !%chipmunk!-kludge OldHeapLast;
+
+syslsp smacro procedure Mark X;
+ MkItem(Forward, X);
+
+syslsp smacro procedure Marked X;
+ Tag X eq Forward;
+
+syslsp smacro procedure MarkID X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := Forward;
+
+syslsp smacro procedure MarkedID X;
+ Tag SymNam X eq Forward;
+
+syslsp smacro procedure ClearIDMark X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := STR;
+
+flag('(CopyFromAllBases CopyFromRange CopyFromBase CopyItem CopyItem1
+ MarkAndCopyFromID MakeIDFreeList GCStats),
+ 'InternalFunction);
+>>;
+
+external WVar ST, StackLowerBound,
+ BndStkLowerBound, BndStkPtr,
+ HeapLast, HeapLowerBound, HeapUpperBound,
+ OldHeapLast, OldHeapLowerBound, OldHeapUpperBound,
+ HeapTrapBound, OldHeapTrapBound, HeapTrapped;
+
+internal WVar StackLast, OldTime, OldSize;
+
+syslsp procedure Reclaim();
+ !%Reclaim();
+
+syslsp procedure !%Reclaim();
+begin scalar Tmp1, Tmp2;
+ if LispVar !*GC then ErrorPrintF "*** Garbage collection starting";
+ BeforeGCSystemHook();
+ StackLast := MakeAddressFromStackPointer AdjustStackPointer(ST,
+ -FrameSize());
+ OldTime := TimC();
+ OldSize := HeapLast - HeapLowerBound;
+ LispVar GCKnt!* := LispVar GCKnt!* + 1;
+ OldHeapLast := HeapLast;
+ HeapLast := OldHeapLowerBound;
+ Tmp1 := HeapLowerBound;
+ Tmp2 := HeapUpperBound;
+ HeapLowerBound := OldHeapLowerBound;
+ HeapUpperBound := OldHeapUpperBound;
+ OldHeapLowerBound := Tmp1;
+ OldHeapUpperBound := Tmp2;
+ Tmp1 := HeapTrapBound;
+ HeapTrapBound := OldHeapTrapBound;
+ OldHeapTrapBound := Tmp1;
+ CopyFromAllBases();
+ MakeIDFreeList();
+ AfterGCSystemHook();
+ OldTime := TimC() - OldTime;
+ LispVar GCTime!* := Plus2(LispVar GCTime!*, OldTime);
+ if LispVar !*GC then GCStats();
+ HeapTrapped := NIL;
+ if IntInf Known!-Free!-Space() < IntInf (LispVar Heap!-Warn!-Level) then
+
+ ContinuableError(99, "Heap space low", NIL)
+>>;
+
+syslsp procedure MarkAndCopyFromID X;
+% SymNam has to be copied before marking, since the mark destroys the tag
+% No problem since it's only a string, can't reference itself.
+<< CopyFromBase &SymNam X;
+ MarkID X;
+ CopyFromBase &SymPrp X;
+ CopyFromBase &SymVal X >>;
+
+syslsp procedure CopyFromAllBases();
+begin scalar LastSymbol, B;
+ MarkAndCopyFromID 128; % Mark NIL first
+ for I := 0 step 1 until 127 do
+ if not MarkedID I then MarkAndCopyFromID I;
+ for I := 0 step 1 until MaxObArray do
+ << B := ObArray I;
+ if B > 0 and not MarkedID B then MarkAndCopyFromID B >>;
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+ CopyFromBase B;
+ for I := StackLowerBound step StackDirection*AddressingUnitsPerItem
+ until StackLast do
+ CopyFromBase I;
+end;
+
+syslsp procedure CopyFromRange(Lo, Hi);
+begin scalar X, I;
+ X := Lo;
+ I := 0;
+ while X <= Hi do
+ << CopyFromBase X;
+ I := I + 1;
+ X := &Lo[I] >>;
+end;
+
+syslsp procedure CopyFromBase P;
+ % P is an "address"
+ CopyItem P;
+
+syslsp procedure CopyItem P;
+
+% COPYITEM is executed for SIDE-EFFECT--its return value is not likely to
+% be meaningful and should be ignored!
+
+begin scalar Typ, Info, Hdr, X;
+ X := @P;
+ Typ := Tag X;
+ if not PointerTagP Typ then return @P :=
+ << if Typ = ID and not null X then % don't follow NIL, for speed
+ << Info := IDInf X;
+ if not MarkedID Info then MarkAndCopyFromID Info >>;
+ X >>;
+ % else it is a PointerType
+ Info := Inf X;
+ if not WithinOldHeapPointer Info then return X;
+ Hdr := @Info;
+ if Marked Hdr then
+ return @P := MkItem(Typ, Inf Hdr);
+ return CopyItem1 P;
+end;
+
+syslsp procedure CopyItem1 P; % Copier for GC
+
+% COPYITEM1 is executed for SIDE-EFFECT--its return value is not likely to
+% be meaningful and should be ignored!
+
+begin scalar NewS, Len, Ptr, StripS, S;
+ S := @P;
+ return case Tag S of
+ PAIR:
+ << Ptr := car S; % Save car which is about to be
+ % replaced by MARK and new address
+ Rplaca(S, Mark(NewS := GtHeap PairPack()));
+ @P := MkPAIR NewS;
+ NewS[0] := Ptr;
+ NewS[1] := cdr S;
+ CopyItem &NewS[0];
+ return CopyItem &NewS[1] >>;
+ STR:
+ << @StrInf S := Mark(NewS := CopyString S);
+ return @P := NewS >>;
+ VECT:
+ << StripS := VecInf S;
+ Len := VecLen StripS;
+ @StripS := Mark(Ptr := GtVECT Len);
+ for I := 0 step 1 until Len do <<
+ VecItm(Ptr, I) := VecItm(StripS, I);
+ CopyItem &VecItm(Ptr, I) >>;
+ return @P := MkVEC Ptr >>;
+ EVECT:
+ << StripS := VecInf S;
+ Len := VecLen StripS;
+ @StripS := Mark(Ptr := GtVECT Len);
+ for I := 0 step 1 until Len do <<
+ VecItm(Ptr, I) := VecItm(StripS, I);
+ CopyItem &VecItm(Ptr, I) >>;
+ return @P := MkItem(EVECT, Ptr) >>;
+ WRDS, FIXN, FLTN, BIGN:
+ << Ptr := Tag S;
+ @Inf S := Mark(NewS := CopyWRDS S);
+ return @P := MkItem(Ptr, NewS) >>;
+ default:
+ FatalError
+ BldMsg("Unexpected tag %w found at %w during garbage collection",
+ MkInt Tag S,MkInt Inf S);
+ end;
+end;
+
+syslsp procedure MakeIDFreeList();
+begin scalar Previous;
+ for I := 0 step 1 until 128 do
+ ClearIDMark I;
+ Previous := 129;
+ while MarkedID Previous and Previous <= MaxSymbols do
+ << ClearIDMark Previous;
+ Previous := Previous + 1 >>;
+ if Previous >= MaxSymbols then
+ NextSymbol := 0
+ else
+ NextSymbol := Previous; % free list starts here
+ for I := Previous + 1 step 1 until MaxSymbols do
+ if MarkedID I then ClearIDMark I
+ else
+ << SymNam Previous := I;
+ Previous := I >>;
+ SymNam Previous := 0; % end of free list
+end;
+
+syslsp procedure GCStats();
+<< ErrorPrintF("*** GC %w: time %d ms, %d recovered, %d free",
+ LispVar GCKnt!*, OldTime,
+ (OldSize - (HeapLast - HeapLowerBound))/AddressingUnitsPerItem,
+ Known!-Free!-Space() ) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/global-data.red
Index: psl-1983/3-1/kernel/20/global-data.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/global-data.red
@@ -0,0 +1,35 @@
+%
+% GLOBAL-DATA.RED - Data used by everyone
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 1 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+on SysLisp;
+
+exported WConst MaxSymbols = 8000,
+ HeapSize = 262000,
+ MaxObArray = 8209, % first prime above 8192
+ StackSize = 10000,
+ BPSSize = 170000;
+
+exported WConst CompressedBinaryRadix = 8;
+
+external WArray SymNam, SymVal, SymFnc, SymPrp;
+
+external WVar NextSymbol;
+
+exported WConst MaxRealRegs = 5,
+ MaxArgs = 15;
+
+external WArray ArgumentBlock;
+
+external WArray HashTable;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/heap.build
Index: psl-1983/3-1/kernel/20/heap.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/heap.build
@@ -0,0 +1,23 @@
+%
+% HEAP.BUILD - Declaration of the heap and BPS
+%
+% Author: Mark Swanson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 4 March 1983
+% Copyright (c) 1983 University of Utah
+%
+
+on Syslisp;
+
+internal WArray BPS[BPSSize];
+
+exported WVar NextBPS = &BPS[0] + 8#1000000,
+ LastBPS = &BPS[BPSSize] + 8#1000000;
+
+exported WConst Heap = 8#2000000;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/heap.ctl
Index: psl-1983/3-1/kernel/20/heap.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/heap.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "heap";
+PathIn "heap.build";
+ASMEnd;
+quit;
+compile heap.mac, dheap.mac
ADDED psl-1983/3-1/kernel/20/heap.init
Index: psl-1983/3-1/kernel/20/heap.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/heap.init
ADDED psl-1983/3-1/kernel/20/heap.log
Index: psl-1983/3-1/kernel/20/heap.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/heap.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/heap.mac
Index: psl-1983/3-1/kernel/20/heap.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/heap.mac
@@ -0,0 +1,13 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern BPS
+ extern L1110
+ extern L1111
+ end
ADDED psl-1983/3-1/kernel/20/heap.rel
Index: psl-1983/3-1/kernel/20/heap.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/heap.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/io-data.red
Index: psl-1983/3-1/kernel/20/io-data.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/io-data.red
@@ -0,0 +1,138 @@
+%
+% IO-DATA.RED - Data structures used by input and output
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 01-Mar-83 Nancy Kendzierski
+% Added initialization of UnReadBuffer and LinePosition.
+% <PSL.KERNEL-20>IO-DATA.RED.2, 29-Dec-82 12:19:36, Edit by PERDUE
+% Added PagePosition array to support LPOSN
+
+on SysLisp;
+
+internal WConst MaxTokenSize = 5000;
+
+exported WString TokenBuffer[MaxTokenSize];
+
+exported WConst MaxChannels = 31;
+
+% All need (MaxChannels + 1) initial values.
+exported WArray ReadFunction = ['TerminalInputHandler,
+ 'WriteOnlyChannel,
+ 'WriteOnlyChannel,
+ 'CompressReadChar,
+ 'WriteOnlyChannel,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ WriteFunction = ['ReadOnlyChannel,
+ 'Dec20WriteChar,
+ 'ToStringWriteChar,
+ 'ExplodeWriteChar,
+ 'FlatSizeWriteChar,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ CloseFunction = ['IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ UnReadBuffer = [0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0,
+ 0,0,0,0,0, 0,0,0,0,0, 0,0],
+ LinePosition = [0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0,
+ 0,0,0,0,0, 0,0,0,0,0, 0,0],
+ PagePosition[MaxChannels],
+ MaxLine = [0,80,80,10000,10000, 0,0,0,0,0, 0,0,0,0,0,
+ 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0, 0,0],
+ JFNOfChannel = [8#100,8#101,-1,-1,-1, 0,0,0,0,0, 0,0,0,0,0,
+ 0,0,0,0,0, 0,0,0,0,0, 0,0,0,0,0, 0,0];
+
+off SysLisp;
+
+global '(!$EOL!$);
+LoadTime(!$EOL!$ := '!
+);
+
+END;
ADDED psl-1983/3-1/kernel/20/io.ctl
Index: psl-1983/3-1/kernel/20/io.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/io.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "io";
+PathIn "io.build";
+ASMEnd;
+quit;
+compile io.mac, dio.mac
ADDED psl-1983/3-1/kernel/20/io.init
Index: psl-1983/3-1/kernel/20/io.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/io.init
@@ -0,0 +1,17 @@
+(GLOBAL (QUOTE (!$EOL!$)))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (SPECIALREADFUNCTION!* SPECIALWRITEFUNCTION!*
+SPECIALCLOSEFUNCTION!*)))
+(GLOBAL (QUOTE (SPECIALRDSACTION!* SPECIALWRSACTION!* IN!* OUT!*)))
+(FLUID (QUOTE (STDIN!* STDOUT!*)))
+(GLOBAL (QUOTE (OUT!*)))
+(FLUID (QUOTE (!*RAISE)))
+(FLUID (QUOTE (CURRENTREADMACROINDICATOR!* CURRENTSCANTABLE!* LISPSCANTABLE!*
+!*INSIDESTRUCTUREREAD)))
+(GLOBAL (QUOTE (TOKTYPE!* IN!* !$EOF!$)))
+(FLUID (QUOTE (CURRENTSCANTABLE!* !*RAISE !*COMPRESSING !*EOLINSTRINGOK)))
+(FLUID (QUOTE (OUTPUTBASE!* PRINLENGTH PRINLEVEL CURRENTSCANTABLE!*
+LISPSCANTABLE!* IDESCAPECHAR!* !*LOWER)))
+(FLUID (QUOTE (FORMATFORPRINTF!*)))
+(FLUID (QUOTE (EXPLODEENDPOINTER!* COMPRESSLIST!* !*COMPRESSING)))
+(GLOBAL (QUOTE (IN!* OUT!*)))
ADDED psl-1983/3-1/kernel/20/io.log
Index: psl-1983/3-1/kernel/20/io.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/io.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/io.mac
Index: psl-1983/3-1/kernel/20/io.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/io.mac
@@ -0,0 +1,3971 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L2110
+ extern L2253
+ extern L2254
+ extern L2255
+ extern L2256
+ extern L2257
+ extern L2258
+ extern L2259
+ extern L2260
+L2262: 14
+ byte(7)67,104,97,110,110,101,108,82,101,97,100,67,104,97,114,0
+ 1
+; (!*ENTRY CHANNELREADCHAR EXPR 1)
+L2263: intern L2263
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 1,-2(15)
+ JUMPL 1,L2264
+ CAIG 1,31
+ JRST L2265
+L2264: MOVE 2,L2261
+ PUSHJ 15,SYMFNC+492
+L2265: MOVE 1,-2(15)
+ MOVE 1,L2256(1)
+ MOVEM 1,-1(15)
+ JUMPE 1,L2266
+ MOVE 7,-2(15)
+ SETZM L2256(7)
+ JRST L2267
+L2266: MOVE 2,-2(15)
+ MOVE 2,L2253(2)
+ MOVE 1,-2(15)
+ ADJSP 15,-3
+ TLZ 2,258048
+ JRST SYMFNC(2)
+L2267: ADJSP 15,-3
+ POPJ 15,0
+L2261: <4_30>+<1_18>+L2262
+ 0
+; (!*ENTRY READCHAR EXPR 0)
+L2268: intern L2268
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+598
+L2271: 15
+ byte(7)67,104,97,110,110,101,108,87,114,105,116,101,67,104,97,114,0
+ 2
+; (!*ENTRY CHANNELWRITECHAR EXPR 2)
+L2272: intern L2272
+ PUSH 15,1
+ PUSH 15,2
+ JUMPL 1,L2273
+ CAIG 1,31
+ JRST L2274
+L2273: MOVE 2,L2269
+ PUSHJ 15,SYMFNC+492
+L2274: MOVE 6,0(15)
+ CAIE 6,10
+ JRST L2275
+ MOVE 7,-1(15)
+ SETZM L2257(7)
+ MOVE 6,-1(15)
+ AOS L2258(6)
+ JRST L2276
+L2275: MOVE 6,0(15)
+ CAIE 6,9
+ JRST L2277
+ MOVE 1,-1(15)
+ MOVE 1,L2257(1)
+ ADDI 1,8
+ AND 1,L2270
+ MOVE 7,-1(15)
+ MOVEM 1,L2257(7)
+ JRST L2276
+L2277: MOVE 6,0(15)
+ CAIE 6,12
+ JRST L2278
+ MOVE 7,-1(15)
+ SETZM L2258(7)
+ MOVE 7,-1(15)
+ SETZM L2257(7)
+ JRST L2276
+L2278: MOVE 6,-1(15)
+ AOS L2257(6)
+L2276: MOVE 3,-1(15)
+ MOVE 3,L2254(3)
+ MOVE 2,0(15)
+ MOVE 1,-1(15)
+ TLZ 3,258048
+ PUSHJ 15,SYMFNC(3)
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L2270: -8
+L2269: <4_30>+<1_18>+L2271
+ 1
+; (!*ENTRY WRITECHAR EXPR 1)
+L2279: intern L2279
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+359
+ 2
+; (!*ENTRY CHANNELUNREADCHAR EXPR 2)
+L2280: intern L2280
+ MOVEM 2,L2256(1)
+ MOVE 1,2
+ POPJ 15,0
+ 1
+; (!*ENTRY UNREADCHAR EXPR 1)
+L2281: intern L2281
+ MOVE 2,1
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+601
+L2292: 18
+ byte(7)85,110,107,110,111,119,110,32,97,99,99,101,115,115,32,116,121,112,101,0
+L2293: 37
+ byte(7)73,109,112,114,111,112,101,114,108,121,32,115,101,116,45,117,112,32,115,112,101,99,105,97,108,32,73,79,32,111,112,101,110,32,99,97,108,108,0
+ 2
+; (!*ENTRY OPEN EXPR 2)
+OPEN: intern OPEN
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ CAME 2,L2282
+ JRST L2294
+ PUSHJ 15,SYMFNC+604
+ MOVEM 1,-2(15)
+ SETZM L2256(1)
+ MOVE 6,L2283
+ MOVEM 6,L2254(1)
+ JRST L2295
+L2294: CAME 2,L2284
+ JRST L2296
+ PUSHJ 15,SYMFNC+605
+ MOVEM 1,-2(15)
+ SETZM L2257(1)
+ HRRZI 6,80
+ MOVEM 6,L2259(1)
+ MOVE 6,L2285
+ MOVEM 6,L2253(1)
+ JRST L2295
+L2296: CAME 2,L2286
+ JRST L2297
+ LDB 11,L2287
+ CAIE 11,30
+ JRST L2298
+ LDB 11,L2288
+ CAIE 11,30
+ JRST L2298
+ LDB 11,L2289
+ CAIE 11,30
+ JRST L2298
+ PUSHJ 15,SYMFNC+606
+ MOVEM 1,-2(15)
+ SETZM L2257(1)
+ HRRZI 6,80
+ MOVEM 6,L2259(1)
+ SETZM L2256(1)
+ MOVE 2,SYMVAL+607
+ TLZ 2,258048
+ MOVEM 2,L2253(1)
+ MOVE 3,SYMVAL+608
+ TLZ 3,258048
+ MOVEM 3,L2254(1)
+ MOVE 4,SYMVAL+609
+ TLZ 4,258048
+ MOVEM 4,L2255(1)
+ JRST L2295
+L2298: MOVE 1,L2290
+ JRST L2299
+L2297: MOVE 1,L2291
+L2299: PUSHJ 15,SYMFNC+507
+L2295: MOVE 1,-2(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L2287: point 6,<SYMVAL+607>,5
+L2288: point 6,<SYMVAL+608>,5
+L2289: point 6,<SYMVAL+609>,5
+L2291: <4_30>+<1_18>+L2292
+L2290: <4_30>+<1_18>+L2293
+L2286: <30_30>+610
+L2285: <30_30>+504
+L2284: <30_30>+611
+L2283: <30_30>+505
+L2282: <30_30>+612
+L2302: 4
+ byte(7)67,108,111,115,101,0
+ 1
+; (!*ENTRY CLOSE EXPR 1)
+CLOSE: intern CLOSE
+ PUSH 15,1
+ PUSH 15,1
+ JUMPL 1,L2303
+ CAIG 1,31
+ JRST L2304
+L2303: MOVE 2,L2300
+ PUSHJ 15,SYMFNC+492
+L2304: MOVE 2,-1(15)
+ MOVE 2,L2255(2)
+ MOVE 1,-1(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+614
+ MOVE 7,-1(15)
+ MOVE 6,L2301
+ MOVEM 6,L2253(7)
+ MOVE 7,-1(15)
+ MOVE 6,L2301
+ MOVEM 6,L2254(7)
+ MOVE 7,-1(15)
+ MOVE 6,L2301
+ MOVEM 6,L2255(7)
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L2301: <30_30>+502
+L2300: <4_30>+<1_18>+L2302
+L2308: 32
+ byte(7)67,104,97,110,110,101,108,32,110,111,116,32,111,112,101,110,32,102,111,114,32,105,110,112,117,116,32,105,110,32,82,68,83,0
+ 1
+; (!*ENTRY RDS EXPR 1)
+RDS: intern RDS
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ CAMN 0,SYMVAL+615
+ JRST L2309
+ MOVE 3,SYMVAL+615
+ MOVE 2,1
+ MOVE 1,SYMVAL+600
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+L2309: MOVE 6,SYMVAL+600
+ MOVEM 6,-1(15)
+ CAME 0,0(15)
+ JRST L2310
+ MOVE 6,SYMVAL+616
+ MOVEM 6,0(15)
+L2310: MOVE 6,0(15)
+ MOVE 6,L2253(6)
+ MOVEM 6,-2(15)
+ MOVE 6,-2(15)
+ CAMN 6,L2305
+ JRST L2311
+ MOVE 6,-2(15)
+ CAME 6,L2306
+ JRST L2312
+L2311: MOVE 2,L2307
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+503
+L2312: MOVE 6,0(15)
+ MOVEM 6,SYMVAL+600
+ MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L2307: <4_30>+<1_18>+L2308
+L2306: <30_30>+504
+L2305: <30_30>+502
+L2316: 33
+ byte(7)67,104,97,110,110,101,108,32,110,111,116,32,111,112,101,110,32,102,111,114,32,111,117,116,112,117,116,32,105,110,32,87,82,83,0
+ 1
+; (!*ENTRY WRS EXPR 1)
+WRS: intern WRS
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ CAMN 0,SYMVAL+617
+ JRST L2317
+ MOVE 3,SYMVAL+617
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+L2317: MOVE 6,SYMVAL+311
+ MOVEM 6,-1(15)
+ CAME 0,0(15)
+ JRST L2318
+ MOVE 6,SYMVAL+618
+ MOVEM 6,0(15)
+L2318: MOVE 6,0(15)
+ MOVE 6,L2254(6)
+ MOVEM 6,-2(15)
+ MOVE 6,-2(15)
+ CAMN 6,L2313
+ JRST L2319
+ MOVE 6,-2(15)
+ CAME 6,L2314
+ JRST L2320
+L2319: MOVE 2,L2315
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+503
+L2320: MOVE 6,0(15)
+ MOVEM 6,SYMVAL+311
+ MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L2315: <4_30>+<1_18>+L2316
+L2314: <30_30>+505
+L2313: <30_30>+502
+ 1
+; (!*ENTRY CHANNELEJECT EXPR 1)
+L2321: intern L2321
+ HRRZI 2,12
+ PUSHJ 15,SYMFNC+359
+ MOVE 1,0
+ POPJ 15,0
+ 0
+; (!*ENTRY EJECT EXPR 0)
+EJECT: intern EJECT
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+619
+L2325: 27
+ byte(7)37,114,32,105,115,32,97,110,32,105,110,118,97,108,105,100,32,108,105,110,101,32,108,101,110,103,116,104,0
+ 2
+; (!*ENTRY CHANNELLINELENGTH EXPR 2)
+L2326: intern L2326
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ MOVE 6,L2259(1)
+ MOVEM 6,-2(15)
+ CAMN 2,0
+ JRST L2327
+ LDB 11,L2323
+ CAIN 11,63
+ JRST L2322
+ CAILE 11,0
+ JRST L2328
+L2322: JUMPL 2,L2328
+ MOVEM 2,L2259(1)
+ JRST L2327
+L2328: MOVE 1,L2324
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+L2327: MOVE 1,-2(15)
+ ADJSP 15,-4
+ POPJ 15,0
+L2323: point 6,2,5
+L2324: <4_30>+<1_18>+L2325
+ 1
+; (!*ENTRY LINELENGTH EXPR 1)
+L2329: intern L2329
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+621
+ 1
+; (!*ENTRY CHANNELPOSN EXPR 1)
+L2330: intern L2330
+ MOVE 1,L2257(1)
+ POPJ 15,0
+ 0
+; (!*ENTRY POSN EXPR 0)
+POSN: intern POSN
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+362
+ 1
+; (!*ENTRY CHANNELLPOSN EXPR 1)
+L2331: intern L2331
+ MOVE 1,L2258(1)
+ POPJ 15,0
+ 0
+; (!*ENTRY LPOSN EXPR 0)
+LPOSN: intern LPOSN
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+624
+ 1
+; (!*ENTRY CHANNELREADCH EXPR 1)
+L2332: intern L2332
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,-1(15)
+ CAMN 0,SYMVAL+627
+ JRST L2333
+ CAIGE 1,97
+ JRST L2333
+ CAILE 1,122
+ JRST L2333
+ MOVNI 7,32
+ ADDM 7,-1(15)
+L2333: MOVE 1,-1(15)
+ HRLI 1,122880
+ ADJSP 15,-2
+ POPJ 15,0
+ 0
+; (!*ENTRY READCH EXPR 0)
+READCH: intern READCH
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+626
+ 1
+; (!*ENTRY CHANNELTERPRI EXPR 1)
+L2334: intern L2334
+ HRRZI 2,10
+ PUSHJ 15,SYMFNC+359
+ MOVE 1,0
+ POPJ 15,0
+ 0
+; (!*ENTRY TERPRI EXPR 0)
+TERPRI: intern TERPRI
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+309
+ 1
+; (!*ENTRY CHANNELREADTOKENWITHHOOKS EXPR 1)
+L2336: intern L2336
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+633
+ MOVEM 1,-1(15)
+ MOVE 7,SYMVAL+634
+ CAIE 7,3
+ JRST L2337
+ MOVE 2,SYMVAL+631
+ PUSHJ 15,SYMFNC+522
+ MOVE 2,1
+ MOVEM 2,-2(15)
+ CAMN 2,0
+ JRST L2337
+ MOVE 3,2
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ TLZ 3,258048
+ JRST SYMFNC(3)
+L2337: MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY CHANNELREAD EXPR 1)
+L2339: intern L2339
+ PUSH 15,1
+ JSP 10,SYMFNC+443
+ byte(18)0,631
+ byte(18)0,635
+ MOVE 6,SYMVAL+637
+ MOVEM 6,SYMVAL+635
+ MOVE 6,L2338
+ MOVEM 6,SYMVAL+631
+ PUSHJ 15,SYMFNC+632
+ JSP 10,SYMFNC+447
+ 2
+ ADJSP 15,-1
+ POPJ 15,0
+L2338: <30_30>+638
+ 0
+; (!*ENTRY READ EXPR 0)
+READ: intern READ
+ PUSHJ 15,SYMFNC+639
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+636
+L2341: 41
+ byte(7)85,110,101,120,112,101,99,116,101,100,32,69,79,70,32,119,104,105,108,101,32,114,101,97,100,105,110,103,32,111,110,32,99,104,97,110,110,101,108,32,37,114,0
+ 2
+; (!*ENTRY CHANNELREADEOF EXPR 2)
+L2342: intern L2342
+ PUSH 15,2
+ PUSH 15,1
+ CAMN 0,SYMVAL+640
+ JRST L2343
+ JSP 10,SYMFNC+443
+ byte(18)0,640
+ MOVE 2,1
+ MOVE 1,L2340
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+ JSP 10,SYMFNC+447
+ 1
+ JRST L2344
+L2343: MOVE 1,SYMVAL+642
+L2344: ADJSP 15,-2
+ POPJ 15,0
+L2340: <4_30>+<1_18>+L2341
+ 2
+; (!*ENTRY CHANNELREADQUOTEDEXPRESSION EXPR 2)
+L2345: intern L2345
+ PUSHJ 15,SYMFNC+632
+ JRST SYMFNC+234
+ 2
+; (!*ENTRY CHANNELREADLISTORDOTTEDPAIR EXPR 2)
+L2348: intern L2348
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,640
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+640
+ PUSHJ 15,SYMFNC+632
+ MOVEM 1,-2(15)
+ MOVE 7,SYMVAL+634
+ CAIE 7,3
+ JRST L2349
+ CAME 1,L2346
+ JRST L2350
+ PUSHJ 15,L2351
+ JRST L2352
+L2350: CAME 1,L2347
+ JRST L2349
+ MOVE 1,0
+ JRST L2352
+L2349: PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVEM 2,-4(15)
+ MOVEM 2,-3(15)
+L2353: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+632
+ MOVEM 1,-2(15)
+ MOVE 7,SYMVAL+634
+ CAIE 7,3
+ JRST L2354
+ CAME 1,L2347
+ JRST L2355
+ MOVE 1,-3(15)
+ JRST L2352
+L2355: CAME 1,L2346
+ JRST L2354
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+632
+ MOVEM 1,-2(15)
+ MOVE 7,SYMVAL+634
+ CAIE 7,3
+ JRST L2356
+ CAMN 1,L2347
+ JRST L2357
+ CAME 1,L2346
+ JRST L2356
+L2357: PUSHJ 15,L2351
+ JRST L2352
+L2356: MOVE 7,-4(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+632
+ MOVEM 1,-2(15)
+ MOVE 7,SYMVAL+634
+ CAIE 7,3
+ JRST L2358
+ CAME 1,L2347
+ JRST L2358
+ MOVE 1,-3(15)
+ JRST L2352
+L2358: PUSHJ 15,L2351
+ JRST L2352
+L2354: MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-4(15)
+ MOVEM 1,1(7)
+ MOVE 2,-4(15)
+ MOVE 2,1(2)
+ MOVEM 2,-4(15)
+ JRST L2353
+L2352: JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-5
+ POPJ 15,0
+L2347: <30_30>+41
+L2346: <30_30>+46
+L2360: 30
+ byte(7)42,42,42,32,85,110,109,97,116,99,104,101,100,32,114,105,103,104,116,32,112,97,114,101,110,116,104,101,115,105,115,0
+ 2
+; (!*ENTRY CHANNELREADRIGHTPAREN EXPR 2)
+L2361: intern L2361
+ PUSH 15,1
+ CAMN 0,SYMVAL+640
+ JRST L2362
+ MOVE 1,2
+ JRST L2363
+L2362: CAMN 1,SYMVAL+616
+ JRST L2364
+ MOVE 1,L2359
+ PUSHJ 15,SYMFNC+418
+L2364: MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+632
+L2363: ADJSP 15,-1
+ POPJ 15,0
+L2359: <4_30>+<1_18>+L2360
+L2366: 16
+ byte(7)68,111,116,32,99,111,110,116,101,120,116,32,101,114,114,111,114,0
+; (!*ENTRY DOTCONTEXTERROR EXPR 0)
+L2351: intern L2351
+ MOVE 1,L2365
+ JRST SYMFNC+507
+L2365: <4_30>+<1_18>+L2366
+ 1
+; (!*ENTRY CHANNELREADVECTOR EXPR 1)
+L2368: intern L2368
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,640
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+640
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVEM 2,-3(15)
+ MOVEM 2,-2(15)
+L2369: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+632
+ MOVEM 1,-1(15)
+ MOVE 2,SYMVAL+634
+ MOVE 1,SYMVAL+84
+ CAIE 2,3
+ JRST L2370
+ MOVE 1,0
+L2370: CAME 1,0
+ JRST L2371
+ MOVE 1,SYMVAL+84
+ MOVE 6,-1(15)
+ CAME 6,L2367
+ JRST L2371
+ MOVE 1,0
+L2371: CAMN 1,0
+ JRST L2372
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-3(15)
+ MOVEM 1,1(7)
+ MOVE 2,-3(15)
+ MOVE 2,1(2)
+ MOVEM 2,-3(15)
+ JRST L2369
+L2372: MOVE 1,-2(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+152
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-4
+ POPJ 15,0
+L2367: <30_30>+93
+ extern TOKCH
+ extern L2373
+ extern L2374
+ extern L2375
+ extern L2376
+ extern L2377
+ extern L2378
+ extern L2379
+ extern L2380
+ extern L2381
+L2383: 37
+ byte(7)42,42,42,42,42,32,82,69,65,68,32,66,117,102,102,101,114,32,111,118,101,114,102,108,111,119,44,32,84,114,117,110,99,97,116,105,110,103,0
+; (!*ENTRY READINBUF EXPR 0)
+L2384: intern L2384
+ MOVE 1,L2373
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,TOKCH
+ MOVE 3,1
+ MOVE 2,L2375
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 2,SYMVAL+635
+ TLZ 2,258048
+ ADDM 3,2
+ MOVE 6,1(2)
+ MOVEM 6,L2374
+ MOVE 7,L2375
+ CAIL 7,5000
+ JRST L2385
+ AOS L2375
+ MOVE 1,L2375
+ POPJ 15,0
+L2385: MOVE 7,L2375
+ CAIE 7,5000
+ JRST L2386
+ MOVE 1,L2382
+ PUSHJ 15,SYMFNC+418
+L2386: HRRZI 1,5001
+ MOVEM 1,L2375
+ POPJ 15,0
+L2382: <4_30>+<1_18>+L2383
+; (!*ENTRY MAKEBUFINTOID EXPR 0)
+L2387: intern L2387
+ SETZM SYMVAL+634
+ MOVE 7,L2375
+ CAIE 7,1
+ JRST L2388
+ SETZM 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ HRLI 1,122880
+ POPJ 15,0
+L2388: SETZM 3
+ MOVE 2,L2375
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,L2375
+ SOS 1
+ MOVEM 1,L2110
+ CAMN 0,SYMVAL+647
+ JRST L2389
+ XMOVEI 1,L2110
+ PUSHJ 15,SYMFNC+395
+ JRST SYMFNC+649
+L2389: XMOVEI 1,L2110
+ TLZ 1,258048
+ TLO 1,16384
+ JRST SYMFNC+560
+; (!*ENTRY MAKEBUFINTOSTRING EXPR 0)
+L2390: intern L2390
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+634
+ SETZM 3
+ MOVE 2,L2375
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,L2375
+ SOS 1
+ MOVEM 1,L2110
+ XMOVEI 1,L2110
+ JRST SYMFNC+395
+; (!*ENTRY MAKEBUFINTOSYSNUMBER EXPR 2)
+L2391: intern L2391
+ MOVE 5,1
+ MOVE 4,2
+ SETZM 3
+ MOVE 2,L2375
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,L2375
+ SOS 1
+ MOVEM 1,L2110
+ MOVE 3,4
+ MOVE 2,5
+ XMOVEI 1,L2110
+ JRST L2392
+; (!*ENTRY MAKEBUFINTOLISPINTEGER EXPR 2)
+L2393: intern L2393
+ MOVE 5,1
+ MOVE 4,2
+ HRRZI 6,2
+ MOVEM 6,SYMVAL+634
+ SETZM 3
+ MOVE 2,L2375
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,L2375
+ SOS 1
+ MOVEM 1,L2110
+ MOVE 3,4
+ MOVE 2,5
+ XMOVEI 1,L2110
+ TLZ 1,258048
+ TLO 1,16384
+ JRST SYMFNC+650
+ extern L2394
+ extern L2395
+ extern L2396
+ extern L2397
+; (!*ENTRY MAKEBUFINTOFLOAT EXPR 2)
+L2398: intern L2398
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ HRRZI 2,10
+ XMOVEI 1,L2396
+ FLTR 2,2
+ MOVEM 2,0(1)
+ SETZM 1(1)
+ SETZM 2
+ XMOVEI 1,L2394
+ FLTR 2,2
+ MOVEM 2,0(1)
+ SETZM 1(1)
+ SETZM 2
+ XMOVEI 1,L2397
+ FLTR 2,2
+ MOVEM 2,0(1)
+ SETZM 1(1)
+ MOVE 1,L2375
+ SOS 1
+ MOVEM 1,-3(15)
+ SETZM -4(15)
+L2399: MOVE 6,-4(15)
+ CAMLE 6,-3(15)
+ JRST L2400
+ MOVE 2,-4(15)
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ PUSHJ 15,SYMFNC+651
+ MOVE 2,1
+ XMOVEI 1,L2395
+ FLTR 2,2
+ MOVEM 2,0(1)
+ SETZM 1(1)
+ XMOVEI 3,L2396
+ XMOVEI 2,L2394
+ XMOVEI 1,L2394
+ DMOVE 3,0(3)
+ DFMP 3,0(2)
+ DMOVEM 3,0(1)
+ XMOVEI 3,L2395
+ XMOVEI 2,L2394
+ XMOVEI 1,L2394
+ DMOVE 3,0(3)
+ DFAD 3,0(2)
+ DMOVEM 3,0(1)
+ AOS -4(15)
+ JRST L2399
+L2400: SKIPG 0(15)
+ JRST L2401
+ MOVEM 0,-4(15)
+ HRRZI 6,1
+ MOVEM 6,-4(15)
+L2402: MOVE 6,-4(15)
+ CAMLE 6,0(15)
+ JRST L2403
+ XMOVEI 3,L2396
+ XMOVEI 2,L2394
+ XMOVEI 1,L2394
+ DMOVE 3,0(3)
+ DFMP 3,0(2)
+ DMOVEM 3,0(1)
+ AOS -4(15)
+ JRST L2402
+L2401: SKIPL 0(15)
+ JRST L2403
+ MOVN 1,0(15)
+ MOVEM 1,0(15)
+ MOVEM 0,-4(15)
+ HRRZI 6,1
+ MOVEM 6,-4(15)
+L2404: MOVE 6,-4(15)
+ CAMLE 6,0(15)
+ JRST L2403
+ XMOVEI 3,L2396
+ XMOVEI 2,L2394
+ XMOVEI 1,L2394
+ DMOVE 4,0(2)
+ DFDV 4,0(3)
+ DMOVEM 4,0(1)
+ AOS -4(15)
+ JRST L2404
+L2403: CAMN 0,-1(15)
+ JRST L2405
+ XMOVEI 3,L2394
+ XMOVEI 2,L2397
+ XMOVEI 1,L2394
+ DMOVE 4,0(2)
+ DFSB 4,0(3)
+ DMOVEM 4,0(1)
+L2405: HRRZI 6,2
+ MOVEM 6,SYMVAL+634
+ PUSHJ 15,SYMFNC+388
+ MOVEM 1,-2(15)
+ XMOVEI 2,L2394
+ AOS 1
+ DMOVE 2,0(2)
+ DMOVEM 2,0(1)
+ MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,12288
+ ADJSP 15,-5
+ POPJ 15,0
+L2417: 24
+ byte(7)77,105,115,115,105,110,103,32,101,120,112,111,110,101,110,116,32,105,110,32,102,108,111,97,116,0
+L2418: 17
+ byte(7)68,105,103,105,116,32,111,117,116,32,111,102,32,114,97,110,103,101,0
+L2419: 17
+ byte(7)82,97,100,105,120,32,111,117,116,32,111,102,32,114,97,110,103,101,0
+L2420: 27
+ byte(7)69,79,70,32,101,110,99,111,117,110,116,101,114,101,100,32,105,110,115,105,100,101,32,97,110,32,73,68,0
+L2421: 30
+ byte(7)69,79,70,32,101,110,99,111,117,110,116,101,114,101,100,32,105,110,115,105,100,101,32,97,32,115,116,114,105,110,103,0
+L2422: 36
+ byte(7)42,42,42,32,83,116,114,105,110,103,32,99,111,110,116,105,110,117,101,100,32,111,118,101,114,32,101,110,100,45,111,102,45,108,105,110,101,0
+L2423: 46
+ byte(7)73,108,108,101,103,97,108,32,116,111,32,102,111,108,108,111,119,32,112,97,99,107,97,103,101,32,105,110,100,105,99,97,116,111,114,32,119,105,116,104,32,110,111,110,32,73,68,0
+L2424: 17
+ byte(7)85,110,107,110,111,119,110,32,116,111,107,101,110,32,116,121,112,101,0
+L2425: 32
+ byte(7)73,110,116,101,114,110,97,108,32,101,114,114,111,114,32,45,32,99,111,110,115,117,108,116,32,97,32,119,105,122,97,114,100,0
+ 1
+; (!*ENTRY CHANNELREADTOKEN EXPR 1)
+L2426: intern L2426
+ PUSH 15,1
+ MOVEM 1,L2373
+ SETZM L2376
+ SETZM L2375
+L2427: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,TOKCH
+ MOVE 3,SYMVAL+635
+ TLZ 3,258048
+ ADDM 1,3
+ MOVE 6,1(3)
+ MOVEM 6,L2374
+ MOVE 7,L2374
+ CAIN 7,17
+ JRST L2427
+ MOVE 3,1
+ MOVE 2,L2375
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS L2375
+ MOVE 1,L2374
+ JUMPL 1,L2428
+ CAIG 1,9
+ JRST L2429
+L2428: CAIL 1,10
+ CAILE 1,21
+ JRST L2430
+ JRST @L2431-10(1)
+L2431: IFIW L2432
+ IFIW L2433
+ IFIW L2434
+ IFIW L2435
+ IFIW L2436
+ IFIW L2437
+ IFIW L2438
+ IFIW L2439
+ IFIW L2440
+ IFIW L2441
+ IFIW L2442
+ IFIW L2443
+L2430: JRST L2444
+L2429: HRRZI 6,1
+ MOVEM 6,L2378
+ JRST L2445
+L2432: CAMN 0,SYMVAL+627
+ JRST L2446
+ CAIGE 3,97
+ JRST L2447
+ CAILE 3,122
+ JRST L2447
+ SUBI 3,32
+ MOVE 2,L2375
+ SOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ JRST L2447
+L2433: HRRZI 6,3
+ MOVEM 6,SYMVAL+634
+ MOVE 1,3
+ HRLI 1,122880
+ JRST L2448
+L2435: MOVE 2,3
+ HRLI 2,122880
+ MOVE 1,L2373
+ ADJSP 15,-1
+ JRST L2449
+L2436: CAME 0,SYMVAL+627
+ JRST L2450
+ JRST L2451
+L2437: SOS L2375
+ JRST L2452
+L2438: SETZM L2375
+ HRRZI 6,1
+ MOVEM 6,L2376
+ MOVE 1,L2406
+ PUSHJ 15,SYMFNC+652
+ CAME 0,SYMVAL+627
+ JRST L2453
+ JRST L2454
+L2439: MOVE 1,L2407
+ PUSHJ 15,L2455
+ JRST L2451
+L2440: SETOM L2378
+ JRST L2456
+L2441: HRRZI 6,1
+ MOVEM 6,L2378
+ JRST L2456
+L2442: SETZM L2375
+ PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2457
+ MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ MOVE 2,L2408
+ MOVE 1,L2373
+ ADJSP 15,-1
+ JRST L2449
+L2457: HRRZI 6,1
+ MOVEM 6,L2378
+ JRST L2458
+L2443: SOS L2375
+ JRST L2459
+L2444: MOVE 1,L2409
+ ADJSP 15,-1
+ JRST L2455
+L2451: SOS L2375
+ PUSHJ 15,L2384
+L2446: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIG 7,10
+ JRST L2446
+ MOVE 7,L2374
+ CAIN 7,19
+ JRST L2446
+ MOVE 7,L2374
+ CAIN 7,18
+ JRST L2446
+ MOVE 7,L2374
+ CAIN 7,14
+ JRST L2451
+ MOVE 7,L2374
+ CAIE 7,16
+ JRST L2460
+ SOS L2375
+ HRRZI 6,1
+ MOVEM 6,L2376
+ PUSHJ 15,L2387
+ PUSHJ 15,SYMFNC+652
+ SETZM L2375
+ JRST L2454
+L2460: MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ SKIPN L2376
+ JRST L2461
+ MOVE 1,SYMVAL+653
+ PUSHJ 15,SYMFNC+652
+L2461: ADJSP 15,-1
+ JRST L2387
+L2454: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIN 7,10
+ JRST L2446
+ MOVE 7,L2374
+ CAIN 7,14
+ JRST L2451
+ MOVE 1,L2410
+ PUSHJ 15,L2455
+L2450: SOS L2375
+ PUSHJ 15,L2384
+L2447: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2447
+ MOVE 7,L2374
+ CAIN 7,19
+ JRST L2447
+ MOVE 7,L2374
+ CAIN 7,18
+ JRST L2447
+ MOVE 7,L2374
+ CAIE 7,10
+ JRST L2462
+ MOVE 7,TOKCH
+ CAIGE 7,97
+ JRST L2447
+ MOVE 7,TOKCH
+ CAILE 7,122
+ JRST L2447
+ MOVE 3,TOKCH
+ SUBI 3,32
+ MOVE 2,L2375
+ SOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ JRST L2447
+L2462: MOVE 7,L2374
+ CAIN 7,14
+ JRST L2450
+ MOVE 7,L2374
+ CAIE 7,16
+ JRST L2463
+ SOS L2375
+ HRRZI 6,1
+ MOVEM 6,L2376
+ PUSHJ 15,L2387
+ PUSHJ 15,SYMFNC+652
+ SETZM L2375
+ JRST L2453
+L2463: MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ SKIPN L2376
+ JRST L2464
+ MOVE 1,SYMVAL+653
+ PUSHJ 15,SYMFNC+652
+L2464: ADJSP 15,-1
+ JRST L2387
+L2453: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIE 7,10
+ JRST L2465
+ MOVE 7,TOKCH
+ CAIGE 7,97
+ JRST L2447
+ MOVE 7,TOKCH
+ CAILE 7,122
+ JRST L2447
+ MOVE 3,TOKCH
+ SUBI 3,32
+ MOVE 2,L2375
+ SOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ JRST L2447
+L2465: MOVE 7,L2374
+ CAIN 7,14
+ JRST L2450
+ MOVE 1,L2410
+ PUSHJ 15,L2455
+L2452: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIE 7,15
+ JRST L2466
+ SOS L2375
+ PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIN 7,15
+ JRST L2452
+ MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ ADJSP 15,-1
+ JRST L2390
+L2466: MOVE 7,TOKCH
+ CAIE 7,10
+ JRST L2467
+ CAME 0,SYMVAL+648
+ JRST L2467
+ MOVE 1,L2411
+ PUSHJ 15,SYMFNC+418
+ JRST L2452
+L2467: MOVE 7,TOKCH
+ CAIE 7,26
+ JRST L2452
+ MOVE 1,L2412
+ PUSHJ 15,L2455
+ JRST L2452
+L2459: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIE 7,21
+ JRST L2468
+ SOS L2375
+ ADJSP 15,-1
+ JRST L2387
+L2468: MOVE 7,L2374
+ CAIE 7,14
+ JRST L2469
+ SOS L2375
+ PUSHJ 15,L2384
+ JRST L2459
+L2469: MOVE 7,TOKCH
+ CAIE 7,26
+ JRST L2459
+ MOVE 1,L2413
+ PUSHJ 15,L2455
+ JRST L2459
+L2456: SETZM L2375
+ PUSHJ 15,L2384
+ MOVE 7,TOKCH
+ CAIE 7,46
+ JRST L2470
+ HRRZI 3,48
+ SETZM 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ HRRZI 6,2
+ MOVEM 6,L2375
+ JRST L2471
+L2470: MOVE 7,L2374
+ CAIN 7,10
+ JRST L2472
+ MOVE 7,L2374
+ CAIN 7,18
+ JRST L2472
+ MOVE 7,L2374
+ CAIE 7,19
+ JRST L2473
+L2472: SETZM L2375
+ SKIPL L2378
+ JRST L2474
+ HRRZI 1,45
+ JRST L2475
+L2474: HRRZI 1,43
+L2475: MOVE 3,1
+ SETZM 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 3,TOKCH
+ HRRZI 2,1
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ HRRZI 6,2
+ MOVEM 6,L2375
+ CAMN 0,SYMVAL+627
+ JRST L2446
+ CAIGE 3,97
+ JRST L2447
+ CAILE 3,122
+ JRST L2447
+ SUBI 3,32
+ MOVE 2,L2375
+ SOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ JRST L2447
+L2473: MOVE 7,L2374
+ CAIE 7,14
+ JRST L2476
+ SETZM L2375
+ SKIPL L2378
+ JRST L2477
+ HRRZI 1,45
+ JRST L2478
+L2477: HRRZI 1,43
+L2478: MOVE 3,1
+ SETZM 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ HRRZI 6,1
+ MOVEM 6,L2375
+ CAMN 0,SYMVAL+627
+ JRST L2451
+ JRST L2450
+L2476: MOVE 7,L2374
+ CAIG 7,9
+ JRST L2445
+ MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SKIPL L2378
+ JRST L2479
+ HRRZI 1,45
+ JRST L2480
+L2479: HRRZI 1,43
+L2480: MOVE 2,1
+ HRLI 2,122880
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST L2449
+L2445: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2445
+ MOVE 7,TOKCH
+ CAIE 7,35
+ JRST L2481
+ SOS L2375
+ HRRZI 2,1
+ HRRZI 1,10
+ PUSHJ 15,L2391
+ MOVEM 1,L2377
+ SETZM L2375
+ CAIGE 1,2
+ JRST L2482
+ CAIG 1,36
+ JRST L2483
+L2482: MOVE 1,L2414
+ ADJSP 15,-1
+ JRST L2455
+L2483: CAILE 1,10
+ JRST L2484
+ JRST L2485
+L2481: MOVE 7,TOKCH
+ CAIN 7,46
+ JRST L2471
+ MOVE 7,TOKCH
+ CAIN 7,66
+ JRST L2486
+ MOVE 7,TOKCH
+ CAIE 7,98
+ JRST L2487
+L2486: SOS L2375
+ MOVE 2,L2378
+ HRRZI 1,8
+ ADJSP 15,-1
+ JRST L2393
+L2487: MOVE 7,TOKCH
+ CAIN 7,69
+ JRST L2488
+ MOVE 7,TOKCH
+ CAIE 7,101
+ JRST L2489
+L2488: SETZM L2379
+ JRST L2490
+L2489: MOVE 7,L2374
+ CAIN 7,10
+ JRST L2491
+ MOVE 7,L2374
+ CAIN 7,18
+ JRST L2491
+ MOVE 7,L2374
+ CAIE 7,19
+ JRST L2492
+L2491: CAMN 0,SYMVAL+627
+ JRST L2446
+ MOVE 7,TOKCH
+ CAIGE 7,97
+ JRST L2447
+ MOVE 7,TOKCH
+ CAILE 7,122
+ JRST L2447
+ MOVE 3,TOKCH
+ SUBI 3,32
+ MOVE 2,L2375
+ SOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ JRST L2447
+L2492: MOVE 7,L2374
+ CAIE 7,14
+ JRST L2493
+ CAMN 0,SYMVAL+627
+ JRST L2451
+ JRST L2450
+L2493: MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ MOVE 2,L2378
+ HRRZI 1,10
+ ADJSP 15,-1
+ JRST L2393
+L2485: PUSHJ 15,L2384
+ MOVE 6,L2377
+ CAMLE 6,L2374
+ JRST L2485
+ MOVE 7,L2374
+ CAIL 7,10
+ JRST L2494
+ MOVE 1,L2415
+ ADJSP 15,-1
+ JRST L2455
+L2494: MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ MOVE 2,L2378
+ MOVE 1,L2377
+ ADJSP 15,-1
+ JRST L2393
+L2484: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2484
+ MOVE 7,L2374
+ CAILE 7,10
+ JRST L2494
+ MOVE 7,TOKCH
+ CAIGE 7,97
+ JRST L2495
+ MOVE 7,TOKCH
+ CAILE 7,122
+ JRST L2495
+ MOVNI 7,32
+ ADDM 7,TOKCH
+ MOVE 3,TOKCH
+ MOVE 2,L2375
+ SOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+L2495: MOVE 1,L2377
+ ADDI 1,55
+ CAMLE 1,TOKCH
+ JRST L2484
+ JRST L2494
+L2471: SOS L2375
+ PUSHJ 15,L2384
+ MOVE 7,TOKCH
+ CAIN 7,69
+ JRST L2496
+ MOVE 7,TOKCH
+ CAIE 7,101
+ JRST L2497
+L2496: SETZM L2379
+ JRST L2490
+L2497: MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2458
+ MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ MOVE 1,L2378
+ MOVE 2,SYMVAL+84
+ JUMPL 1,L2498
+ MOVE 2,0
+L2498: SETZM 1
+ ADJSP 15,-1
+ JRST L2398
+L2458: HRRZI 6,1
+ MOVEM 6,L2379
+L2499: PUSHJ 15,L2384
+ MOVE 7,L2374
+ CAIL 7,10
+ JRST L2500
+ MOVE 7,L2379
+ CAIL 7,9
+ JRST L2501
+ AOS L2379
+ JRST L2499
+L2501: SOS L2375
+ JRST L2499
+L2500: MOVE 7,TOKCH
+ CAIN 7,69
+ JRST L2490
+ MOVE 7,TOKCH
+ CAIN 7,101
+ JRST L2490
+ MOVE 2,TOKCH
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ SOS L2375
+ MOVE 1,L2378
+ MOVE 2,SYMVAL+84
+ JUMPL 1,L2502
+ MOVE 2,0
+L2502: MOVN 1,L2379
+ ADJSP 15,-1
+ JRST L2398
+L2490: SOS L2375
+ HRRZI 6,1
+ MOVEM 6,L2380
+ SETZM L2381
+ MOVE 1,L2373
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,TOKCH
+ MOVE 3,SYMVAL+635
+ TLZ 3,258048
+ ADDM 1,3
+ MOVE 6,1(3)
+ MOVEM 6,L2374
+ MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2503
+ CAIE 1,45
+ JRST L2504
+ SETOM L2380
+ JRST L2505
+L2504: CAIN 1,43
+ JRST L2505
+ MOVE 1,L2416
+ ADJSP 15,-1
+ JRST L2455
+L2505: MOVE 1,L2373
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,TOKCH
+ MOVE 3,SYMVAL+635
+ TLZ 3,258048
+ ADDM 1,3
+ MOVE 6,1(3)
+ MOVEM 6,L2374
+ MOVE 7,L2374
+ CAIGE 7,10
+ JRST L2503
+ MOVE 1,L2416
+ ADJSP 15,-1
+ JRST L2455
+L2503: MOVE 6,L2374
+ MOVEM 6,L2381
+L2506: MOVE 1,L2373
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,TOKCH
+ MOVE 3,SYMVAL+635
+ TLZ 3,258048
+ ADDM 1,3
+ MOVE 6,1(3)
+ MOVEM 6,L2374
+ MOVE 7,L2374
+ CAIL 7,10
+ JRST L2507
+ MOVE 2,L2381
+ IMULI 2,10
+ ADD 2,L2374
+ MOVEM 2,L2381
+ JRST L2506
+L2507: MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ MOVE 1,L2378
+ MOVE 2,SYMVAL+84
+ JUMPL 1,L2508
+ MOVE 2,0
+L2508: MOVE 1,L2380
+ IMUL 1,L2381
+ SUB 1,L2379
+ ADJSP 15,-1
+ JRST L2398
+L2434: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,TOKCH
+ CAIE 1,10
+ JRST L2509
+ SETZM L2375
+ JRST L2427
+L2509: CAIE 1,26
+ JRST L2434
+ MOVE 1,SYMVAL+642
+L2448: ADJSP 15,-1
+ POPJ 15,0
+L2416: <4_30>+<1_18>+L2417
+L2415: <4_30>+<1_18>+L2418
+L2414: <4_30>+<1_18>+L2419
+L2413: <4_30>+<1_18>+L2420
+L2412: <4_30>+<1_18>+L2421
+L2411: <4_30>+<1_18>+L2422
+L2410: <4_30>+<1_18>+L2423
+L2409: <4_30>+<1_18>+L2424
+L2408: <30_30>+46
+L2407: <4_30>+<1_18>+L2425
+L2406: <30_30>+654
+ 0
+; (!*ENTRY RATOM EXPR 0)
+RATOM: intern RATOM
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+633
+ 1
+; (!*ENTRY DIGITTONUMBER EXPR 1)
+L2510: intern L2510
+ CAIGE 1,48
+ JRST L2511
+ CAILE 1,57
+ JRST L2511
+ SUBI 1,48
+ POPJ 15,0
+L2511: SUBI 1,55
+ POPJ 15,0
+ 3
+; (!*ENTRY MAKESTRINGINTOLISPINTEGER EXPR 3)
+L2512: intern L2512
+ PUSHJ 15,L2392
+ JRST SYMFNC+138
+; (!*ENTRY MAKESTRINGINTOSYSINTEGER EXPR 3)
+L2392: intern L2392
+ ADJSP 15,7
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 1,2
+ PUSHJ 15,L2516
+ MOVE 4,1
+ MOVEM 4,-5(15)
+ CAMN 4,0
+ JRST L2517
+ MOVE 4,-2(15)
+ MOVE 3,-5(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-7
+ JRST L2518
+L2517: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,0(15)
+ MOVE 6,0(2)
+ LDB 3,L2513
+ TDNE 3,L2514
+ TDO 3,L2515
+ MOVEM 3,-3(15)
+ SETZM -4(15)
+ SETZM -6(15)
+L2519: MOVE 6,-6(15)
+ CAMLE 6,-3(15)
+ JRST L2520
+ MOVE 2,-6(15)
+ MOVE 1,0(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ PUSHJ 15,SYMFNC+651
+ MOVE 2,-4(15)
+ IMUL 2,-1(15)
+ ADDM 2,1
+ MOVEM 1,-4(15)
+ AOS -6(15)
+ JRST L2519
+L2520: SKIPL -2(15)
+ JRST L2521
+ MOVN 1,-4(15)
+ JRST L2522
+L2521: MOVE 1,-4(15)
+L2522: ADJSP 15,-7
+ POPJ 15,0
+L2513: point 30,6,35
+L2514: 536870912
+L2515: -536870912
+; (!*ENTRY MAKESTRINGINTOBITSTRING EXPR 4)
+L2518: intern L2518
+ ADJSP 15,7
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ TLZ 1,258048
+ MOVEM 1,0(15)
+ MOVE 6,0(1)
+ LDB 5,L2523
+ TDNE 5,L2524
+ TDO 5,L2525
+ MOVEM 5,-4(15)
+ SETZM -5(15)
+ SETZM -6(15)
+L2526: MOVE 6,-6(15)
+ CAMLE 6,-4(15)
+ JRST L2527
+ MOVE 1,-5(15)
+ MOVE 7,-2(15)
+ LSH 1,0(7)
+ MOVEM 1,-5(15)
+ MOVE 2,-6(15)
+ MOVE 1,0(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ PUSHJ 15,SYMFNC+651
+ IOR 1,-5(15)
+ MOVEM 1,-5(15)
+ AOS -6(15)
+ JRST L2526
+L2527: SKIPL -3(15)
+ JRST L2528
+ MOVN 1,-5(15)
+ JRST L2529
+L2528: MOVE 1,-5(15)
+L2529: ADJSP 15,-7
+ POPJ 15,0
+L2523: point 30,6,35
+L2524: 536870912
+L2525: -536870912
+; (!*ENTRY SYSPOWEROF2P EXPR 1)
+L2516: intern L2516
+ CAIL 1,1
+ CAILE 1,8
+ JRST L2530
+ JRST @L2531-1(1)
+L2531: IFIW L2532
+ IFIW L2533
+ IFIW L2534
+ IFIW L2535
+ IFIW L2534
+ IFIW L2534
+ IFIW L2534
+ IFIW L2536
+L2530: CAIN 1,16
+ JRST L2537
+ CAIN 1,32
+ JRST L2538
+ JRST L2534
+L2532: SETZM 1
+ POPJ 15,0
+L2533: HRRZI 1,1
+ POPJ 15,0
+L2535: HRRZI 1,2
+ POPJ 15,0
+L2536: HRRZI 1,3
+ POPJ 15,0
+L2537: HRRZI 1,4
+ POPJ 15,0
+L2538: HRRZI 1,5
+ POPJ 15,0
+L2534: MOVE 1,0
+ POPJ 15,0
+L2540: 31
+ byte(7)42,42,42,42,42,32,69,114,114,111,114,32,105,110,32,116,111,107,101,110,32,115,99,97,110,110,101,114,58,32,37,115,0
+; (!*ENTRY SCANNERERROR EXPR 1)
+L2455: intern L2455
+ MOVE 2,1
+ MOVE 1,L2539
+ PUSHJ 15,SYMFNC+155
+ JRST SYMFNC+156
+L2539: <4_30>+<1_18>+L2540
+; (!*ENTRY SCANPOSSIBLEDIPHTHONG EXPR 2)
+L2449: intern L2449
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ HRRZI 6,3
+ MOVEM 6,SYMVAL+634
+ MOVE 2,SYMVAL+635
+ TLZ 2,258048
+ MOVE 2,129(2)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+522
+ MOVE 3,1
+ MOVEM 3,-2(15)
+ CAME 3,0
+ JRST L2541
+ MOVE 1,-1(15)
+ JRST L2542
+L2541: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+598
+ MOVE 2,-2(15)
+ HRLI 1,122880
+ MOVEM 1,-4(15)
+ PUSHJ 15,SYMFNC+335
+ MOVE 2,1
+ MOVEM 2,-3(15)
+ CAME 2,0
+ JRST L2543
+ MOVE 2,-4(15)
+ TLZ 2,258048
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+601
+ MOVE 1,-1(15)
+ JRST L2542
+L2543: MOVE 1,1(2)
+L2542: ADJSP 15,-5
+ POPJ 15,0
+ 0
+; (!*ENTRY READLINE EXPR 0)
+L2544: intern L2544
+ PUSHJ 15,SYMFNC+639
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+657
+L2546: -1
+ byte(7)0
+ 1
+; (!*ENTRY CHANNELREADLINE EXPR 1)
+L2547: intern L2547
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ SETOM L2110
+L2548: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+598
+ MOVEM 1,-1(15)
+ CAIN 1,10
+ JRST L2549
+ CAIN 1,26
+ JRST L2549
+ AOS L2110
+ MOVE 3,1
+ MOVE 2,L2110
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ JRST L2548
+L2549: SKIPGE L2110
+ JRST L2550
+ SETZM 3
+ MOVE 2,L2110
+ AOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ XMOVEI 1,L2110
+ TLZ 1,258048
+ TLO 1,16384
+ ADJSP 15,-2
+ JRST SYMFNC+395
+L2550: MOVE 1,L2545
+ ADJSP 15,-2
+ POPJ 15,0
+L2545: <4_30>+<1_18>+L2546
+ 1
+; (!*ENTRY PACKAGE EXPR 1)
+L2551: intern L2551
+ MOVE 1,0
+ POPJ 15,0
+ 0
+; (!*ENTRY MAKEINPUTAVAILABLE EXPR 0)
+L2552: intern L2552
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY CHECKLINEFIT EXPR 4)
+L2553: intern L2553
+ ADJSP 15,3
+ MOVEM 2,0(15)
+ MOVEM 3,-1(15)
+ MOVEM 4,-2(15)
+ MOVE 5,1
+ ADD 5,L2257(2)
+ CAMG 5,L2259(2)
+ JRST L2554
+ SKIPG L2259(2)
+ JRST L2554
+ HRRZI 2,10
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2554: MOVE 3,-1(15)
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ TLZ 3,258048
+ JRST SYMFNC(3)
+ 2
+; (!*ENTRY CHANNELWRITESTRING EXPR 2)
+L2558: intern L2558
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVE 6,0(4)
+ LDB 3,L2555
+ TDNE 3,L2556
+ TDO 3,L2557
+ MOVEM 3,-2(15)
+ SETZM -3(15)
+L2559: MOVE 6,-3(15)
+ CAMLE 6,-2(15)
+ JRST L2560
+ MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ AOS -3(15)
+ JRST L2559
+L2560: MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L2555: point 30,6,35
+L2556: 536870912
+L2557: -536870912
+ 1
+; (!*ENTRY WRITESTRING EXPR 1)
+L2561: intern L2561
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+660
+ extern L2562
+ extern L2563
+ 3
+; (!*ENTRY CHANNELWRITESYSINTEGER EXPR 3)
+L2564: intern L2564
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-4(15)
+ MOVE 1,3
+ PUSHJ 15,L2516
+ MOVE 4,1
+ MOVEM 4,-3(15)
+ CAMN 4,0
+ JRST L2565
+ MOVE 3,-2(15)
+ SOS 3
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST L2566
+L2565: SKIPL -1(15)
+ JRST L2567
+ HRRZI 2,45
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ IDIV 1,2
+ MOVE 3,-2(15)
+ MOVN 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,L2568
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ IDIV 1,2
+ MOVE 1,2
+ MOVN 2,1
+ XMOVEI 1,1+L2562
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+359
+L2567: SKIPE -1(15)
+ JRST L2569
+ HRRZI 2,48
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+359
+L2569: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST L2568
+; (!*ENTRY WRITENUMBER1 EXPR 3)
+L2568: intern L2568
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ JUMPE 2,L2570
+ MOVE 2,3
+ MOVE 1,-1(15)
+ IDIV 1,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,L2568
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ IDIV 1,2
+ MOVE 1,2
+ MOVE 2,1
+ XMOVEI 1,1+L2562
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+359
+L2570: ADJSP 15,-3
+ POPJ 15,0
+; (!*ENTRY CHANNELWRITEBITSTRING EXPR 4)
+L2566: intern L2566
+ JUMPN 2,L2571
+ HRRZI 2,48
+ JRST SYMFNC+359
+L2571: JRST SYMFNC+663
+ 4
+; (!*ENTRY CHANNELWRITEBITSTRAUX EXPR 4)
+L2572: intern L2572
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ JUMPE 2,L2573
+ MOVN 5,4
+ LSH 2,0(5)
+ PUSHJ 15,L2572
+ MOVE 2,-1(15)
+ AND 2,-2(15)
+ XMOVEI 1,1+L2562
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+359
+L2573: ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY WRITESYSINTEGER EXPR 2)
+L2574: intern L2574
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+662
+ 2
+; (!*ENTRY CHANNELWRITEFIXNUM EXPR 2)
+L2575: intern L2575
+ TLZ 2,258048
+ MOVE 2,1(2)
+ JRST SYMFNC+666
+ 2
+; (!*ENTRY CHANNELWRITEINTEGER EXPR 2)
+L2576: intern L2576
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 3,SYMVAL+658
+ MOVEM 3,-2(15)
+ CAIN 3,10
+ JRST L2577
+ HRRZI 3,10
+ MOVE 2,-2(15)
+ PUSHJ 15,SYMFNC+662
+ HRRZI 2,35
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2577: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+662
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY CHANNELWRITESYSFLOAT EXPR 2)
+L2578: intern L2578
+ PUSH 15,1
+ XMOVEI 1,L2563
+ PUSHJ 15,SYMFNC+668
+ XMOVEI 2,L2563
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+660
+ MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+ 2
+; (!*ENTRY CHANNELWRITEFLOAT EXPR 2)
+L2579: intern L2579
+ TLZ 2,258048
+ AOS 2
+ JRST SYMFNC+667
+ 2
+; (!*ENTRY CHANNELPRINTSTRING EXPR 2)
+L2583: intern L2583
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ HRRZI 2,34
+ PUSHJ 15,SYMFNC+359
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L2580
+ TDNE 1,L2581
+ TDO 1,L2582
+ MOVEM 1,-2(15)
+ SETZM -4(15)
+L2584: MOVE 6,-4(15)
+ CAMLE 6,-2(15)
+ JRST L2585
+ MOVE 2,-4(15)
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-3(15)
+ CAIE 1,34
+ JRST L2586
+ HRRZI 2,34
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2586: MOVE 2,-3(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ AOS -4(15)
+ JRST L2584
+L2585: HRRZI 2,34
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L2580: point 30,6,35
+L2581: 536870912
+L2582: -536870912
+ 2
+; (!*ENTRY CHANNELWRITEID EXPR 2)
+L2590: intern L2590
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ CAME 0,SYMVAL+573
+ JRST L2591
+ TLZ 2,258048
+ MOVE 2,SYMNAM(2)
+ ADJSP 15,-5
+ JRST SYMFNC+660
+L2591: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 3,2
+ TLZ 3,258048
+ MOVE 2,SYMNAM(3)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVE 6,0(2)
+ LDB 4,L2587
+ TDNE 4,L2588
+ TDO 4,L2589
+ MOVEM 4,-3(15)
+ MOVEM 0,-4(15)
+ SETZM -4(15)
+L2592: MOVE 6,-4(15)
+ CAMLE 6,-3(15)
+ JRST L2593
+ MOVE 2,-4(15)
+ MOVE 1,-1(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-2(15)
+ CAIGE 1,65
+ JRST L2594
+ CAILE 1,90
+ JRST L2594
+ HRRZI 7,32
+ ADDM 7,-2(15)
+L2594: MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ AOS -4(15)
+ JRST L2592
+L2593: MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L2587: point 30,6,35
+L2588: 536870912
+L2589: -536870912
+L2596: 9
+ byte(7)35,60,85,110,98,111,117,110,100,58,0
+ 2
+; (!*ENTRY CHANNELWRITEUNBOUND EXPR 2)
+L2597: intern L2597
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 2,L2595
+ PUSHJ 15,SYMFNC+660
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+671
+ HRRZI 2,62
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+359
+L2595: <4_30>+<1_18>+L2596
+ 2
+; (!*ENTRY CHANNELPRINTID EXPR 2)
+L2601: intern L2601
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ MOVEM 0,-4(15)
+ MOVE 3,2
+ TLZ 3,258048
+ MOVE 2,SYMNAM(3)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVE 6,0(2)
+ LDB 4,L2598
+ TDNE 4,L2599
+ TDO 4,L2600
+ MOVEM 4,-2(15)
+ SETZM 2
+ MOVE 1,-1(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-3(15)
+ MOVE 5,SYMVAL+635
+ TLZ 5,258048
+ ADDM 1,5
+ MOVE 7,1(5)
+ CAIN 7,10
+ JRST L2602
+ MOVE 2,SYMVAL+659
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2602: CAME 0,SYMVAL+573
+ JRST L2603
+ MOVE 2,-3(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ MOVEM 0,-5(15)
+ HRRZI 6,1
+ MOVEM 6,-5(15)
+L2604: MOVE 6,-5(15)
+ CAMLE 6,-2(15)
+ JRST L2605
+ MOVE 2,-5(15)
+ MOVE 1,-1(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-3(15)
+ MOVE 3,SYMVAL+635
+ TLZ 3,258048
+ ADDM 1,3
+ MOVE 6,1(3)
+ MOVEM 6,-4(15)
+ MOVE 6,-4(15)
+ CAIG 6,10
+ JRST L2606
+ MOVE 6,-4(15)
+ CAIN 6,19
+ JRST L2606
+ MOVE 6,-4(15)
+ CAIN 6,18
+ JRST L2606
+ MOVE 2,SYMVAL+659
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2606: MOVE 2,-3(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ AOS -5(15)
+ JRST L2604
+L2603: MOVE 6,-3(15)
+ CAIGE 6,65
+ JRST L2607
+ MOVE 6,-3(15)
+ CAILE 6,90
+ JRST L2607
+ HRRZI 7,32
+ ADDM 7,-3(15)
+L2607: MOVE 2,-3(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ MOVEM 0,-5(15)
+ HRRZI 6,1
+ MOVEM 6,-5(15)
+L2608: MOVE 6,-5(15)
+ CAMLE 6,-2(15)
+ JRST L2605
+ MOVE 2,-5(15)
+ MOVE 1,-1(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-3(15)
+ MOVE 3,SYMVAL+635
+ TLZ 3,258048
+ ADDM 1,3
+ MOVE 6,1(3)
+ MOVEM 6,-4(15)
+ MOVE 6,-4(15)
+ CAIG 6,10
+ JRST L2609
+ MOVE 6,-4(15)
+ CAIN 6,19
+ JRST L2609
+ MOVE 6,-4(15)
+ CAIN 6,18
+ JRST L2609
+ MOVE 2,SYMVAL+659
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2609: MOVE 6,-3(15)
+ CAIGE 6,65
+ JRST L2610
+ MOVE 6,-3(15)
+ CAILE 6,90
+ JRST L2610
+ HRRZI 7,32
+ ADDM 7,-3(15)
+L2610: MOVE 2,-3(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ AOS -5(15)
+ JRST L2608
+L2605: MOVE 1,0
+ ADJSP 15,-6
+ POPJ 15,0
+L2598: point 30,6,35
+L2599: 536870912
+L2600: -536870912
+L2612: 9
+ byte(7)35,60,85,110,98,111,117,110,100,32,0
+ 2
+; (!*ENTRY CHANNELPRINTUNBOUND EXPR 2)
+L2613: intern L2613
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 2,L2611
+ PUSHJ 15,SYMFNC+660
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+673
+ HRRZI 2,62
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+359
+L2611: <4_30>+<1_18>+L2612
+L2615: 6
+ byte(7)35,60,67,111,100,101,32,0
+ 2
+; (!*ENTRY CHANNELWRITECODEPOINTER EXPR 2)
+L2616: intern L2616
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVE 2,L2614
+ PUSHJ 15,SYMFNC+660
+ MOVE 6,-1(15)
+ MOVE 6,-1(6)
+ MOVEM 6,-2(15)
+ SKIPGE -2(15)
+ JRST L2617
+ MOVE 6,-2(15)
+ CAILE 6,15
+ JRST L2617
+ HRRZI 3,10
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+662
+ HRRZI 2,32
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+L2617: HRRZI 3,8
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+662
+ HRRZI 2,62
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L2614: <4_30>+<1_18>+L2615
+L2619: 9
+ byte(7)35,60,85,110,107,110,111,119,110,32,0
+ 2
+; (!*ENTRY CHANNELWRITEUNKNOWNITEM EXPR 2)
+L2620: intern L2620
+ PUSH 15,2
+ PUSH 15,1
+ MOVE 2,L2618
+ PUSHJ 15,SYMFNC+660
+ HRRZI 3,8
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+662
+ HRRZI 2,62
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+359
+L2618: <4_30>+<1_18>+L2619
+ 1
+; (!*ENTRY CHANNELWRITEBLANKOREOL EXPR 1)
+L2621: intern L2621
+ MOVE 2,L2257(1)
+ AOS 2
+ CAMGE 2,L2259(1)
+ JRST L2622
+ SKIPG L2259(1)
+ JRST L2622
+ HRRZI 2,10
+ JRST L2623
+L2622: HRRZI 2,32
+L2623: JRST SYMFNC+359
+L2635: 2
+ byte(7)46,46,46,0
+L2636: 2
+ byte(7)32,46,32,0
+L2637: 3
+ byte(7)32,46,46,46,0
+ 3
+; (!*ENTRY CHANNELWRITEPAIR EXPR 3)
+L2638: intern L2638
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L2625
+ CAIN 11,63
+ JRST L2624
+ CAILE 11,0
+ JRST L2639
+L2624: CAMGE 3,SYMVAL+678
+ JRST L2639
+ HRRZI 2,35
+ ADJSP 15,-4
+ JRST SYMFNC+359
+L2639: MOVEM 0,-3(15)
+ AOS -2(15)
+ HRRZI 4,40
+ MOVE 3,L2626
+ MOVE 2,1
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ LDB 11,L2628
+ CAIN 11,63
+ JRST L2627
+ CAILE 11,0
+ JRST L2640
+L2627: SKIPG SYMVAL+679
+ JRST L2641
+L2640: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+680
+ HRRZI 6,2
+ MOVEM 6,-3(15)
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+L2642: LDB 11,L2629
+ CAIE 11,9
+ JRST L2643
+ LDB 11,L2628
+ CAIN 11,63
+ JRST L2630
+ CAILE 11,0
+ JRST L2644
+L2630: MOVE 6,-3(15)
+ CAMLE 6,SYMVAL+679
+ JRST L2643
+L2644: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+680
+ AOS -3(15)
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ JRST L2642
+L2643: LDB 11,L2629
+ CAIE 11,9
+ JRST L2645
+ MOVE 4,L2631
+ JRST L2646
+L2645: CAMN 0,-1(15)
+ JRST L2647
+ MOVE 4,L2632
+ MOVE 3,L2633
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+680
+ JRST L2647
+L2641: MOVE 4,L2634
+L2646: MOVE 3,L2633
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2647: HRRZI 4,41
+ MOVE 3,L2626
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L2625: point 6,<SYMVAL+678>,5
+L2628: point 6,<SYMVAL+679>,5
+L2629: point 6,-1(15),5
+L2634: <4_30>+<1_18>+L2635
+L2633: <30_30>+660
+L2632: <4_30>+<1_18>+L2636
+L2631: <4_30>+<1_18>+L2637
+L2626: <30_30>+359
+L2659: 2
+ byte(7)46,46,46,0
+L2660: 2
+ byte(7)32,46,32,0
+L2661: 3
+ byte(7)32,46,46,46,0
+ 3
+; (!*ENTRY CHANNELPRINTPAIR EXPR 3)
+L2662: intern L2662
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L2649
+ CAIN 11,63
+ JRST L2648
+ CAILE 11,0
+ JRST L2663
+L2648: CAMGE 3,SYMVAL+678
+ JRST L2663
+ HRRZI 2,35
+ ADJSP 15,-4
+ JRST SYMFNC+359
+L2663: MOVEM 0,-3(15)
+ AOS -2(15)
+ HRRZI 4,40
+ MOVE 3,L2650
+ MOVE 2,1
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ LDB 11,L2652
+ CAIN 11,63
+ JRST L2651
+ CAILE 11,0
+ JRST L2664
+L2651: SKIPG SYMVAL+679
+ JRST L2665
+L2664: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+682
+ HRRZI 6,2
+ MOVEM 6,-3(15)
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+L2666: LDB 11,L2653
+ CAIE 11,9
+ JRST L2667
+ LDB 11,L2652
+ CAIN 11,63
+ JRST L2654
+ CAILE 11,0
+ JRST L2668
+L2654: MOVE 6,-3(15)
+ CAMLE 6,SYMVAL+679
+ JRST L2667
+L2668: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+682
+ AOS -3(15)
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ JRST L2666
+L2667: LDB 11,L2653
+ CAIE 11,9
+ JRST L2669
+ MOVE 4,L2655
+ JRST L2670
+L2669: CAMN 0,-1(15)
+ JRST L2671
+ MOVE 4,L2656
+ MOVE 3,L2657
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+682
+ JRST L2671
+L2665: MOVE 4,L2658
+L2670: MOVE 3,L2657
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2671: HRRZI 4,41
+ MOVE 3,L2650
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L2649: point 6,<SYMVAL+678>,5
+L2652: point 6,<SYMVAL+679>,5
+L2653: point 6,-1(15),5
+L2658: <4_30>+<1_18>+L2659
+L2657: <30_30>+660
+L2656: <4_30>+<1_18>+L2660
+L2655: <4_30>+<1_18>+L2661
+L2650: <30_30>+359
+L2682: 2
+ byte(7)46,46,46,0
+ 3
+; (!*ENTRY CHANNELWRITEVECTOR EXPR 3)
+L2683: intern L2683
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L2673
+ CAIN 11,63
+ JRST L2672
+ CAILE 11,0
+ JRST L2684
+L2672: CAMGE 3,SYMVAL+678
+ JRST L2684
+ HRRZI 2,35
+ ADJSP 15,-5
+ JRST SYMFNC+359
+L2684: MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ AOS -2(15)
+ HRRZI 4,91
+ MOVE 3,L2674
+ MOVE 2,1
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L2675
+ TDNE 1,L2676
+ TDO 1,L2677
+ MOVEM 1,-3(15)
+ JUMPGE 1,L2685
+ HRRZI 4,93
+ MOVE 3,L2674
+ MOVE 2,0(15)
+ HRRZI 1,1
+ ADJSP 15,-5
+ JRST L2553
+L2685: SETZM -4(15)
+L2686: LDB 11,L2679
+ CAIN 11,63
+ JRST L2678
+ CAILE 11,0
+ JRST L2687
+L2678: MOVE 6,-4(15)
+ CAML 6,SYMVAL+679
+ JRST L2688
+L2687: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ ADD 2,-4(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+680
+ AOS -4(15)
+ MOVE 6,-4(15)
+ CAMLE 6,-3(15)
+ JRST L2689
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ JRST L2686
+L2688: MOVE 4,L2680
+ MOVE 3,L2681
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2689: HRRZI 4,93
+ MOVE 3,L2674
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L2673: point 6,<SYMVAL+678>,5
+L2675: point 30,6,35
+L2676: 536870912
+L2677: -536870912
+L2679: point 6,<SYMVAL+679>,5
+L2681: <30_30>+660
+L2680: <4_30>+<1_18>+L2682
+L2674: <30_30>+359
+L2700: 2
+ byte(7)46,46,46,0
+ 3
+; (!*ENTRY CHANNELPRINTVECTOR EXPR 3)
+L2701: intern L2701
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L2691
+ CAIN 11,63
+ JRST L2690
+ CAILE 11,0
+ JRST L2702
+L2690: CAMGE 3,SYMVAL+678
+ JRST L2702
+ HRRZI 2,35
+ ADJSP 15,-5
+ JRST SYMFNC+359
+L2702: MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ AOS -2(15)
+ HRRZI 4,91
+ MOVE 3,L2692
+ MOVE 2,1
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L2693
+ TDNE 1,L2694
+ TDO 1,L2695
+ MOVEM 1,-3(15)
+ JUMPGE 1,L2703
+ HRRZI 4,93
+ MOVE 3,L2692
+ MOVE 2,0(15)
+ HRRZI 1,1
+ ADJSP 15,-5
+ JRST L2553
+L2703: SETZM -4(15)
+L2704: LDB 11,L2697
+ CAIN 11,63
+ JRST L2696
+ CAILE 11,0
+ JRST L2705
+L2696: MOVE 6,-4(15)
+ CAML 6,SYMVAL+679
+ JRST L2706
+L2705: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ ADD 2,-4(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+682
+ AOS -4(15)
+ MOVE 6,-4(15)
+ CAMLE 6,-3(15)
+ JRST L2707
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ JRST L2704
+L2706: MOVE 4,L2698
+ MOVE 3,L2699
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2707: HRRZI 4,93
+ MOVE 3,L2692
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L2691: point 6,<SYMVAL+678>,5
+L2693: point 30,6,35
+L2694: 536870912
+L2695: -536870912
+L2697: point 6,<SYMVAL+679>,5
+L2699: <30_30>+660
+L2698: <4_30>+<1_18>+L2700
+L2692: <30_30>+359
+L2713: 9
+ byte(7)35,60,69,86,101,99,116,111,114,32,0
+ 3
+; (!*ENTRY CHANNELWRITEEVECTOR EXPR 3)
+L2714: intern L2714
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L2709
+ CAIN 11,63
+ JRST L2708
+ CAILE 11,0
+ JRST L2715
+L2708: CAMGE 3,SYMVAL+678
+ JRST L2715
+ HRRZI 2,35
+ JRST L2716
+L2715: MOVE 1,L2710
+ PUSHJ 15,SYMFNC+318
+ CAMN 1,0
+ JRST L2717
+ MOVE 2,L2711
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+686
+ MOVE 2,1
+ CAMN 2,0
+ JRST L2717
+ MOVE 5,2
+ MOVE 4,0
+ MOVE 3,-2(15)
+ MOVE 2,0(15)
+ MOVE 1,-1(15)
+ MOVE 6,5
+ PUSHJ 15,SYMFNC+288
+ JRST L2718
+L2717: MOVE 2,L2712
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+660
+ HRRZI 3,8
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+662
+ HRRZI 2,62
+ MOVE 1,0(15)
+L2716: PUSHJ 15,SYMFNC+359
+L2718: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L2709: point 6,<SYMVAL+678>,5
+L2712: <4_30>+<1_18>+L2713
+L2711: <30_30>+687
+L2710: <30_30>+686
+L2724: 9
+ byte(7)35,60,69,86,101,99,116,111,114,32,0
+ 3
+; (!*ENTRY CHANNELPRINTEVECTOR EXPR 3)
+L2725: intern L2725
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L2720
+ CAIN 11,63
+ JRST L2719
+ CAILE 11,0
+ JRST L2726
+L2719: CAMGE 3,SYMVAL+678
+ JRST L2726
+ HRRZI 2,35
+ JRST L2727
+L2726: MOVE 1,L2721
+ PUSHJ 15,SYMFNC+318
+ CAMN 1,0
+ JRST L2728
+ MOVE 2,L2722
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+686
+ MOVE 2,1
+ CAMN 2,0
+ JRST L2728
+ MOVE 5,2
+ MOVE 4,SYMVAL+84
+ MOVE 3,-2(15)
+ MOVE 2,0(15)
+ MOVE 1,-1(15)
+ MOVE 6,5
+ PUSHJ 15,SYMFNC+288
+ JRST L2729
+L2728: MOVE 2,L2723
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+660
+ HRRZI 3,8
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+662
+ HRRZI 2,62
+ MOVE 1,0(15)
+L2727: PUSHJ 15,SYMFNC+359
+L2729: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L2720: point 6,<SYMVAL+678>,5
+L2723: <4_30>+<1_18>+L2724
+L2722: <30_30>+687
+L2721: <30_30>+686
+L2740: 2
+ byte(7)46,46,46,0
+L2741: 7
+ byte(7)35,60,87,111,114,100,115,58,0
+ 2
+; (!*ENTRY CHANNELWRITEWORDS EXPR 2)
+L2742: intern L2742
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ MOVE 2,L2730
+ PUSHJ 15,SYMFNC+660
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L2731
+ TDNE 1,L2732
+ TDO 1,L2733
+ MOVEM 1,-2(15)
+ JUMPGE 1,L2743
+ HRRZI 4,62
+ MOVE 3,L2734
+ MOVE 2,0(15)
+ HRRZI 1,1
+ ADJSP 15,-4
+ JRST L2553
+L2743: SETZM -3(15)
+L2744: LDB 11,L2736
+ CAIN 11,63
+ JRST L2735
+ CAILE 11,0
+ JRST L2745
+L2735: MOVE 6,-3(15)
+ CAML 6,SYMVAL+679
+ JRST L2746
+L2745: MOVE 4,-1(15)
+ TLZ 4,258048
+ ADD 4,-3(15)
+ MOVE 4,1(4)
+ MOVE 3,L2737
+ MOVE 2,0(15)
+ HRRZI 1,10
+ PUSHJ 15,L2553
+ AOS -3(15)
+ MOVE 6,-3(15)
+ CAMLE 6,-2(15)
+ JRST L2747
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ JRST L2744
+L2746: MOVE 4,L2738
+ MOVE 3,L2739
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2747: HRRZI 4,62
+ MOVE 3,L2734
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L2731: point 30,6,35
+L2732: 536870912
+L2733: -536870912
+L2736: point 6,<SYMVAL+679>,5
+L2739: <30_30>+660
+L2738: <4_30>+<1_18>+L2740
+L2737: <30_30>+666
+L2734: <30_30>+359
+L2730: <4_30>+<1_18>+L2741
+L2758: 2
+ byte(7)46,46,46,0
+L2759: 11
+ byte(7)35,60,72,97,108,102,119,111,114,100,115,58,0
+ 2
+; (!*ENTRY CHANNELWRITEHALFWORDS EXPR 2)
+L2760: intern L2760
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ MOVE 2,L2748
+ PUSHJ 15,SYMFNC+660
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L2749
+ TDNE 1,L2750
+ TDO 1,L2751
+ MOVEM 1,-2(15)
+ JUMPGE 1,L2761
+ HRRZI 4,62
+ MOVE 3,L2752
+ MOVE 2,0(15)
+ HRRZI 1,1
+ ADJSP 15,-4
+ JRST L2553
+L2761: SETZM -3(15)
+L2762: LDB 11,L2754
+ CAIN 11,63
+ JRST L2753
+ CAILE 11,0
+ JRST L2763
+L2753: MOVE 6,-3(15)
+ CAML 6,SYMVAL+679
+ JRST L2764
+L2763: MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 4,1
+ MOVE 3,L2755
+ MOVE 2,0(15)
+ HRRZI 1,10
+ PUSHJ 15,L2553
+ AOS -3(15)
+ MOVE 6,-3(15)
+ CAMLE 6,-2(15)
+ JRST L2765
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ JRST L2762
+L2764: MOVE 4,L2756
+ MOVE 3,L2757
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2765: HRRZI 4,62
+ MOVE 3,L2752
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L2749: point 30,6,35
+L2750: 536870912
+L2751: -536870912
+L2754: point 6,<SYMVAL+679>,5
+L2757: <30_30>+660
+L2756: <4_30>+<1_18>+L2758
+L2755: <30_30>+666
+L2752: <30_30>+359
+L2748: <4_30>+<1_18>+L2759
+L2776: 2
+ byte(7)46,46,46,0
+L2777: 7
+ byte(7)35,60,66,121,116,101,115,58,0
+ 2
+; (!*ENTRY CHANNELWRITEBYTES EXPR 2)
+L2778: intern L2778
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-3(15)
+ MOVE 2,L2766
+ PUSHJ 15,SYMFNC+660
+ MOVE 2,-1(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L2767
+ TDNE 1,L2768
+ TDO 1,L2769
+ MOVEM 1,-2(15)
+ JUMPGE 1,L2779
+ HRRZI 4,62
+ MOVE 3,L2770
+ MOVE 2,0(15)
+ HRRZI 1,1
+ ADJSP 15,-4
+ JRST L2553
+L2779: SETZM -3(15)
+L2780: LDB 11,L2772
+ CAIN 11,63
+ JRST L2771
+ CAILE 11,0
+ JRST L2781
+L2771: MOVE 6,-3(15)
+ CAML 6,SYMVAL+679
+ JRST L2782
+L2781: MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 4,1
+ MOVE 3,L2773
+ MOVE 2,0(15)
+ HRRZI 1,10
+ PUSHJ 15,L2553
+ AOS -3(15)
+ MOVE 6,-3(15)
+ CAMLE 6,-2(15)
+ JRST L2783
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+676
+ JRST L2780
+L2782: MOVE 4,L2774
+ MOVE 3,L2775
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,L2553
+L2783: HRRZI 4,62
+ MOVE 3,L2770
+ MOVE 2,0(15)
+ HRRZI 1,1
+ PUSHJ 15,L2553
+ MOVE 1,0
+ ADJSP 15,-4
+ POPJ 15,0
+L2767: point 30,6,35
+L2768: 536870912
+L2769: -536870912
+L2772: point 6,<SYMVAL+679>,5
+L2775: <30_30>+660
+L2774: <4_30>+<1_18>+L2776
+L2773: <30_30>+666
+L2770: <30_30>+359
+L2766: <4_30>+<1_18>+L2777
+ 2
+; (!*ENTRY CHANNELPRIN2 EXPR 2)
+L2335: intern L2335
+ SETZM 3
+ JRST SYMFNC+680
+ 3
+; (!*ENTRY RECURSIVECHANNELPRIN2 EXPR 3)
+L2796: intern L2796
+ PUSH 15,2
+ PUSH 15,1
+ LDB 1,L2784
+ CAIL 1,0
+ CAILE 1,10
+ JRST L2797
+ JRST @L2798-0(1)
+L2798: IFIW L2799
+ IFIW L2800
+ IFIW L2801
+ IFIW L2802
+ IFIW L2803
+ IFIW L2804
+ IFIW L2805
+ IFIW L2806
+ IFIW L2807
+ IFIW L2808
+ IFIW L2809
+L2797: CAIN 1,15
+ JRST L2810
+ CAIN 1,29
+ JRST L2811
+ CAIN 1,30
+ JRST L2812
+ CAIE 1,63
+ JRST L2801
+L2799: MOVE 4,2
+ MOVE 3,L2785
+ MOVE 2,0(15)
+ HRRZI 1,10
+ PUSHJ 15,L2553
+ JRST L2813
+L2812: MOVE 4,2
+ MOVE 3,L2786
+ MOVE 2,0(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVE 5,SYMNAM(1)
+ TLZ 5,258048
+ MOVE 6,0(5)
+ LDB 1,L2787
+ TDNE 1,L2788
+ TDO 1,L2789
+ AOS 1
+ PUSHJ 15,L2553
+ JRST L2813
+L2811: MOVE 4,2
+ MOVE 3,L2790
+ MOVE 2,0(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVE 5,SYMNAM(1)
+ TLZ 5,258048
+ MOVE 6,0(5)
+ LDB 1,L2787
+ TDNE 1,L2788
+ TDO 1,L2789
+ ADDI 1,12
+ PUSHJ 15,L2553
+ JRST L2813
+L2803: MOVE 4,2
+ MOVE 3,L2791
+ MOVE 2,0(15)
+ MOVE 5,4
+ TLZ 5,258048
+ MOVE 6,0(5)
+ LDB 1,L2787
+ TDNE 1,L2788
+ TDO 1,L2789
+ AOS 1
+ PUSHJ 15,L2553
+ JRST L2813
+L2810: MOVE 4,2
+ MOVE 3,L2792
+ MOVE 2,0(15)
+ HRRZI 1,14
+ PUSHJ 15,L2553
+ JRST L2813
+L2800: MOVE 4,2
+ MOVE 3,L2793
+ MOVE 2,0(15)
+ HRRZI 1,20
+ PUSHJ 15,L2553
+ JRST L2813
+L2802: MOVE 4,2
+ MOVE 3,L2794
+ MOVE 2,0(15)
+ HRRZI 1,30
+ PUSHJ 15,L2553
+ JRST L2813
+L2806: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+689
+ JRST L2813
+L2805: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+690
+ JRST L2813
+L2804: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+691
+ JRST L2813
+L2808: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+677
+ JRST L2813
+L2807: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+683
+ JRST L2813
+L2809: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+685
+ JRST L2813
+L2801: MOVE 4,2
+ MOVE 3,L2795
+ MOVE 2,0(15)
+ HRRZI 1,20
+ PUSHJ 15,L2553
+L2813: MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L2784: point 6,2,5
+L2787: point 30,6,35
+L2788: 536870912
+L2789: -536870912
+L2795: <30_30>+468
+L2794: <30_30>+669
+L2793: <30_30>+665
+L2792: <30_30>+675
+L2791: <30_30>+660
+L2790: <30_30>+672
+L2786: <30_30>+671
+L2785: <30_30>+666
+ 1
+; (!*ENTRY PRIN2 EXPR 1)
+PRIN2: intern PRIN2
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+356
+ 2
+; (!*ENTRY CHANNELPRIN1 EXPR 2)
+L2814: intern L2814
+ SETZM 3
+ JRST SYMFNC+682
+ 3
+; (!*ENTRY RECURSIVECHANNELPRIN1 EXPR 3)
+L2827: intern L2827
+ PUSH 15,2
+ PUSH 15,1
+ LDB 1,L2815
+ CAIL 1,0
+ CAILE 1,10
+ JRST L2828
+ JRST @L2829-0(1)
+L2829: IFIW L2830
+ IFIW L2831
+ IFIW L2832
+ IFIW L2833
+ IFIW L2834
+ IFIW L2835
+ IFIW L2836
+ IFIW L2837
+ IFIW L2838
+ IFIW L2839
+ IFIW L2840
+L2828: CAIN 1,15
+ JRST L2841
+ CAIN 1,29
+ JRST L2842
+ CAIN 1,30
+ JRST L2843
+ CAIE 1,63
+ JRST L2832
+L2830: MOVE 4,2
+ MOVE 3,L2816
+ MOVE 2,0(15)
+ HRRZI 1,10
+ PUSHJ 15,L2553
+ JRST L2844
+L2843: MOVE 4,2
+ MOVE 3,L2817
+ MOVE 2,0(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVE 5,SYMNAM(1)
+ TLZ 5,258048
+ MOVE 6,0(5)
+ LDB 1,L2818
+ TDNE 1,L2819
+ TDO 1,L2820
+ ADDI 1,5
+ PUSHJ 15,L2553
+ JRST L2844
+L2842: MOVE 4,2
+ MOVE 3,L2821
+ MOVE 2,0(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVE 5,SYMNAM(1)
+ TLZ 5,258048
+ MOVE 6,0(5)
+ LDB 1,L2818
+ TDNE 1,L2819
+ TDO 1,L2820
+ ADDI 1,16
+ PUSHJ 15,L2553
+ JRST L2844
+L2834: MOVE 4,2
+ MOVE 3,L2822
+ MOVE 2,0(15)
+ MOVE 5,4
+ TLZ 5,258048
+ MOVE 6,0(5)
+ LDB 1,L2818
+ TDNE 1,L2819
+ TDO 1,L2820
+ ADDI 1,4
+ PUSHJ 15,L2553
+ JRST L2844
+L2841: MOVE 4,2
+ MOVE 3,L2823
+ MOVE 2,0(15)
+ HRRZI 1,14
+ PUSHJ 15,L2553
+ JRST L2844
+L2831: MOVE 4,2
+ MOVE 3,L2824
+ MOVE 2,0(15)
+ HRRZI 1,20
+ PUSHJ 15,L2553
+ JRST L2844
+L2833: MOVE 4,2
+ MOVE 3,L2825
+ MOVE 2,0(15)
+ HRRZI 1,20
+ PUSHJ 15,L2553
+ JRST L2844
+L2837: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+689
+ JRST L2844
+L2836: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+690
+ JRST L2844
+L2835: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+691
+ JRST L2844
+L2839: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+681
+ JRST L2844
+L2838: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+684
+ JRST L2844
+L2840: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+688
+ JRST L2844
+L2832: MOVE 4,2
+ MOVE 3,L2826
+ MOVE 2,0(15)
+ HRRZI 1,20
+ PUSHJ 15,L2553
+L2844: MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L2815: point 6,2,5
+L2818: point 30,6,35
+L2819: 536870912
+L2820: -536870912
+L2826: <30_30>+468
+L2825: <30_30>+669
+L2824: <30_30>+665
+L2823: <30_30>+675
+L2822: <30_30>+670
+L2821: <30_30>+674
+L2817: <30_30>+673
+L2816: <30_30>+666
+ 1
+; (!*ENTRY PRIN1 EXPR 1)
+PRIN1: intern PRIN1
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+308
+L2847: 19
+ byte(7)67,111,117,108,100,110,39,116,32,112,114,105,110,116,32,102,108,111,97,116,0
+ 2
+; (!*ENTRY WRITEFLOAT EXPR 2)
+L2848: intern L2848
+ MOVE 6,1
+ AOS 1
+ HRLI 1,147904
+ MOVE 7,1
+ MOVE 3,1(2)
+ MOVE 2,0(2)
+ MOVE 4,L2845
+ DFOUT
+ JRST L2849
+ SETOM 4
+L2850: CAMN 1,7
+ JRST L2851
+ IBP 7
+ AOJA 4,L2850
+L2851: MOVEM 4,0(6)
+ SETZM 2
+ IDPB 4,1
+ POPJ 15,0
+L2849: MOVE 1,L2846
+ JRST SYMFNC+507
+L2845: 2686452736
+L2846: <4_30>+<1_18>+L2847
+ 15
+; (!*ENTRY PRINTF EXPR 15)
+PRINTF: intern PRINTF
+ JSP 10,SYMFNC+443
+ byte(18)1,693
+ MOVE 1,SYMVAL+693
+ PUSHJ 15,L2852
+ JSP 10,SYMFNC+447
+ 1
+ POPJ 15,0
+; (!*ENTRY PRINTF1 EXPR 15)
+L2852: intern L2852
+ PUSH 15,2
+ XMOVEI 1,0(15)
+ PUSH 15,3
+ PUSH 15,4
+ PUSH 15,5
+ PUSH 15,L0002+0
+ PUSH 15,L0002+1
+ PUSH 15,L0002+2
+ PUSH 15,L0002+3
+ PUSH 15,L0002+4
+ PUSH 15,L0002+5
+ PUSH 15,L0002+6
+ PUSH 15,L0002+7
+ PUSH 15,L0002+8
+ PUSH 15,L0002+9
+ PUSHJ 15,L2853
+ ADJSP 15,-14
+ POPJ 15,0
+L2858: 36
+ byte(7)85,110,107,110,111,119,110,32,99,104,97,114,97,99,116,101,114,32,99,111,100,101,32,102,111,114,32,80,114,105,110,116,70,58,32,37,114,0
+; (!*ENTRY PRINTF2 EXPR 1)
+L2853: intern L2853
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 3,SYMVAL+693
+ TLZ 3,258048
+ MOVE 6,0(3)
+ LDB 2,L2854
+ TDNE 2,L2855
+ TDO 2,L2856
+ MOVEM 2,-1(15)
+ SETZM -2(15)
+L2859: MOVE 6,-2(15)
+ CAMLE 6,-1(15)
+ JRST L2860
+ MOVE 2,-2(15)
+ MOVE 1,SYMVAL+693
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-3(15)
+ CAIN 1,37
+ JRST L2861
+ PUSHJ 15,SYMFNC+467
+ JRST L2862
+L2861: AOS -2(15)
+ MOVE 2,-2(15)
+ MOVE 1,SYMVAL+693
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-3(15)
+ CAIGE 1,97
+ JRST L2863
+ CAILE 1,122
+ JRST L2863
+ SUBI 1,32
+L2863: MOVEM 1,-4(15)
+ CAIN 1,37
+ JRST L2864
+ CAIL 1,66
+ CAILE 1,70
+ JRST L2865
+ JRST @L2866-66(1)
+L2866: IFIW L2867
+ IFIW L2868
+ IFIW L2869
+ IFIW L2870
+ IFIW L2871
+L2865: CAIL 1,76
+ CAILE 1,88
+ JRST L2872
+ JRST @L2873-76(1)
+L2873: IFIW L2874
+ IFIW L2875
+ IFIW L2876
+ IFIW L2877
+ IFIW L2878
+ IFIW L2875
+ IFIW L2879
+ IFIW L2880
+ IFIW L2881
+ IFIW L2875
+ IFIW L2875
+ IFIW L2882
+ IFIW L2883
+L2872: JRST L2875
+L2867: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+360
+ AOS 0(15)
+ JRST L2862
+L2868: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+467
+ AOS 0(15)
+ JRST L2862
+L2869: HRRZI 2,10
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+664
+ AOS 0(15)
+ JRST L2862
+L2870: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ AOS 0(15)
+ JRST L2862
+L2871: PUSHJ 15,SYMFNC+623
+ JUMPLE 1,L2862
+ HRRZI 1,10
+ PUSHJ 15,SYMFNC+467
+ JRST L2862
+L2874: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+694
+ AOS 0(15)
+ JRST L2862
+L2876: HRRZI 1,10
+ PUSHJ 15,SYMFNC+467
+ JRST L2862
+L2877: HRRZI 2,8
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+664
+ AOS 0(15)
+ JRST L2862
+L2883: HRRZI 2,16
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+664
+ AOS 0(15)
+ JRST L2862
+L2878: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+470
+ AOS 0(15)
+ JRST L2862
+L2879: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+695
+ AOS 0(15)
+ JRST L2862
+L2880: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+661
+ AOS 0(15)
+ JRST L2862
+L2881: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+363
+ AOS 0(15)
+ JRST L2862
+L2882: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+692
+ AOS 0(15)
+ JRST L2862
+L2864: HRRZI 1,37
+ PUSHJ 15,SYMFNC+467
+ JRST L2862
+L2875: MOVE 2,-3(15)
+ HRLI 2,122880
+ MOVE 1,L2857
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+L2862: AOS -2(15)
+ JRST L2859
+L2860: MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L2854: point 30,6,35
+L2855: 536870912
+L2856: -536870912
+L2857: <4_30>+<1_18>+L2858
+ 5
+; (!*ENTRY ERRORPRINTF EXPR 5)
+L2884: intern L2884
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVEM 5,-4(15)
+ MOVE 1,SYMVAL+476
+ PUSHJ 15,SYMFNC+477
+ MOVEM 1,-5(15)
+ MOVE 3,SYMVAL+476
+ SKIPG L2257(3)
+ JRST L2885
+ PUSHJ 15,SYMFNC+444
+L2885: MOVE 5,-4(15)
+ MOVE 4,-3(15)
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+461
+ MOVE 2,SYMVAL+476
+ SKIPG L2257(2)
+ JRST L2886
+ PUSHJ 15,SYMFNC+444
+L2886: MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+477
+ MOVE 1,0
+ ADJSP 15,-6
+ POPJ 15,0
+L2889: 48
+ byte(7)66,117,102,102,101,114,32,111,118,101,114,102,108,111,119,32,119,104,105,108,101,32,99,111,110,115,116,114,117,99,116,105,110,103,32,101,114,114,111,114,32,109,101,115,115,97,103,101,58,0
+L2890: 24
+ byte(7)84,104,101,32,116,114,117,110,99,97,116,101,100,32,114,101,115,117,108,116,32,119,97,115,58,0
+ 2
+; (!*ENTRY TOSTRINGWRITECHAR EXPR 2)
+L2891: intern L2891
+ MOVE 7,L2110
+ CAIGE 7,4999
+ JRST L2892
+ HRRZI 6,80
+ MOVEM 6,L2110
+ SETZM 3
+ HRRZI 2,80
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ XMOVEI 1,L2110
+ TLZ 1,258048
+ TLO 1,16384
+ PUSHJ 15,SYMFNC+395
+ MOVE 4,1
+ MOVE 3,L2887
+ MOVE 2,SYMVAL+693
+ MOVE 1,L2888
+ PUSHJ 15,SYMFNC+250
+ JRST SYMFNC+156
+L2892: AOS L2110
+ MOVE 3,2
+ MOVE 2,L2110
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ POPJ 15,0
+L2888: <4_30>+<1_18>+L2889
+L2887: <4_30>+<1_18>+L2890
+ 5
+; (!*ENTRY BLDMSG EXPR 5)
+BLDMSG: intern BLDMSG
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVEM 5,-4(15)
+ SETZM 2+L2257
+ SETOM L2110
+ MOVE 6,SYMVAL+311
+ MOVEM 6,-5(15)
+ HRRZI 6,2
+ MOVEM 6,SYMVAL+311
+ PUSHJ 15,SYMFNC+461
+ SETZM 3
+ MOVE 2,L2110
+ AOS 2
+ XMOVEI 1,1+L2110
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 6,-5(15)
+ MOVEM 6,SYMVAL+311
+ XMOVEI 1,L2110
+ ADJSP 15,-6
+ JRST SYMFNC+395
+ 1
+; (!*ENTRY ERRPRIN EXPR 1)
+L2893: intern L2893
+ PUSH 15,1
+ HRRZI 1,96
+ PUSHJ 15,SYMFNC+467
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+470
+ HRRZI 1,39
+ ADJSP 15,-1
+ JRST SYMFNC+467
+ 1
+; (!*ENTRY PRIN2L EXPR 1)
+PRIN2L: intern PRIN2L
+ PUSH 15,1
+ CAMN 1,0
+ JRST L2895
+ LDB 11,L2894
+ CAIN 11,9
+ JRST L2896
+ ADJSP 15,-1
+ JRST SYMFNC+692
+L2896: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+692
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ LDB 11,L2894
+ CAIN 11,9
+ JRST L2897
+ MOVE 1,0
+ JRST L2898
+L2897: MOVE 1,SYMVAL+84
+L2898: CAME 1,0
+ JRST L2899
+ MOVE 1,0
+ JRST L2900
+L2899: MOVE 1,SYMVAL+311
+ PUSHJ 15,SYMFNC+676
+ JRST L2896
+L2900: CAMN 0,0(15)
+ JRST L2895
+ MOVE 1,SYMVAL+311
+ PUSHJ 15,SYMFNC+676
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+692
+L2895: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+L2894: point 6,1,5
+ 15
+; (!*ENTRY CHANNELPRINTF EXPR 15)
+L2901: intern L2901
+ ADJSP 15,13
+ MOVEM 2,0(15)
+ MOVEM 3,-1(15)
+ MOVEM 4,-2(15)
+ MOVEM 5,-3(15)
+ XMOVEI 6,L0002+0
+ MOVEM 6,-4(15)
+ XMOVEI 6,L0002+1
+ MOVEM 6,-5(15)
+ XMOVEI 6,L0002+2
+ MOVEM 6,-6(15)
+ XMOVEI 6,L0002+3
+ MOVEM 6,-7(15)
+ XMOVEI 6,L0002+4
+ MOVEM 6,-8(15)
+ XMOVEI 6,L0002+5
+ MOVEM 6,-9(15)
+ XMOVEI 6,L0002+6
+ MOVEM 6,-10(15)
+ XMOVEI 6,L0002+7
+ MOVEM 6,-11(15)
+ XMOVEI 6,L0002+8
+ MOVEM 6,-12(15)
+ JSP 10,SYMFNC+443
+ byte(18)1,311
+ XMOVEI 6,L0002+9
+ MOVEM 6,L0002+8
+ MOVE 6,-12(15)
+ MOVEM 6,L0002+7
+ MOVE 6,-11(15)
+ MOVEM 6,L0002+6
+ MOVE 6,-10(15)
+ MOVEM 6,L0002+5
+ MOVE 6,-9(15)
+ MOVEM 6,L0002+4
+ MOVE 6,-8(15)
+ MOVEM 6,L0002+3
+ MOVE 6,-7(15)
+ MOVEM 6,L0002+2
+ MOVE 6,-6(15)
+ MOVEM 6,L0002+1
+ MOVE 6,-5(15)
+ MOVEM 6,L0002+0
+ MOVE 5,-4(15)
+ MOVE 4,-3(15)
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+461
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-13
+ POPJ 15,0
+ 2
+; (!*ENTRY EXPLODEWRITECHAR EXPR 2)
+L2902: intern L2902
+ MOVE 1,2
+ HRLI 1,122880
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,SYMVAL+697
+ MOVEM 1,1(7)
+ MOVEM 1,SYMVAL+697
+ POPJ 15,0
+ 1
+; (!*ENTRY EXPLODE EXPR 1)
+L2903: intern L2903
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVEM 2,SYMVAL+697
+ MOVEM 2,-1(15)
+ SETZM 3+L2257
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,SYMFNC+308
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY EXPLODE2 EXPR 1)
+L2904: intern L2904
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVEM 2,SYMVAL+697
+ MOVEM 2,-1(15)
+ SETZM 3+L2257
+ MOVE 2,0(15)
+ HRRZI 1,3
+ PUSHJ 15,SYMFNC+356
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ ADJSP 15,-2
+ POPJ 15,0
+ extern L2905
+ 2
+; (!*ENTRY FLATSIZEWRITECHAR EXPR 2)
+L2906: intern L2906
+ AOS L2905
+ MOVE 1,L2905
+ POPJ 15,0
+ 1
+; (!*ENTRY FLATSIZE EXPR 1)
+L2907: intern L2907
+ SETZM L2905
+ SETZM 4+L2257
+ MOVE 2,1
+ HRRZI 1,4
+ PUSHJ 15,SYMFNC+308
+ MOVE 1,L2905
+ POPJ 15,0
+ 1
+; (!*ENTRY FLATSIZE2 EXPR 1)
+L2908: intern L2908
+ SETZM L2905
+ SETZM 4+L2257
+ MOVE 2,1
+ HRRZI 1,4
+ PUSHJ 15,SYMFNC+356
+ MOVE 1,L2905
+ POPJ 15,0
+ extern L2909
+ 1
+; (!*ENTRY COMPRESSREADCHAR EXPR 1)
+L2911: intern L2911
+ MOVE 5,1
+ MOVE 4,0
+ CAMN 0,L2909
+ JRST L2912
+ JRST SYMFNC+701
+L2912: LDB 11,L2910
+ CAIN 11,9
+ JRST L2913
+ MOVE 6,SYMVAL+84
+ MOVEM 6,L2909
+ HRRZI 1,32
+ POPJ 15,0
+L2913: MOVE 2,SYMVAL+702
+ MOVE 2,0(2)
+ MOVE 4,2
+ MOVE 3,SYMVAL+702
+ MOVE 3,1(3)
+ MOVEM 3,SYMVAL+702
+ MOVE 1,2
+ JRST SYMFNC+135
+L2910: point 6,<SYMVAL+702>,5
+ 0
+; (!*ENTRY CLEARCOMPRESSCHANNEL EXPR 0)
+L2914: intern L2914
+ SETZM 3+L2256
+ MOVE 1,0
+ MOVEM 1,L2909
+ POPJ 15,0
+L2916: 37
+ byte(7)80,111,111,114,108,121,32,102,111,114,109,101,100,32,83,45,101,120,112,114,101,115,115,105,111,110,32,105,110,32,67,79,77,80,82,69,83,83,0
+ 0
+; (!*ENTRY COMPRESSERROR EXPR 0)
+L2917: intern L2917
+ MOVE 1,L2915
+ JRST SYMFNC+156
+L2915: <4_30>+<1_18>+L2916
+ 1
+; (!*ENTRY COMPRESS EXPR 1)
+L2918: intern L2918
+ JSP 10,SYMFNC+443
+ byte(18)1,702
+ JSP 10,SYMFNC+443
+ byte(18)0,647
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+647
+ PUSHJ 15,SYMFNC+703
+ HRRZI 1,3
+ PUSHJ 15,SYMFNC+636
+ JSP 10,SYMFNC+447
+ 1
+ JSP 10,SYMFNC+447
+ 1
+ POPJ 15,0
+ 1
+; (!*ENTRY IMPLODE EXPR 1)
+L2919: intern L2919
+ JSP 10,SYMFNC+443
+ byte(18)1,702
+ PUSHJ 15,SYMFNC+703
+ HRRZI 1,3
+ PUSHJ 15,SYMFNC+636
+ JSP 10,SYMFNC+447
+ 1
+ POPJ 15,0
+ 1
+; (!*ENTRY CHANNELTYI EXPR 1)
+L2920: intern L2920
+ JRST SYMFNC+598
+ 2
+; (!*ENTRY CHANNELTYO EXPR 2)
+L2921: intern L2921
+ PUSH 15,1
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+135
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+359
+ 0
+; (!*ENTRY TYI EXPR 0)
+TYI: intern TYI
+ MOVE 1,SYMVAL+600
+ JRST SYMFNC+706
+ 1
+; (!*ENTRY TYO EXPR 1)
+TYO: intern TYO
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+707
+ end
ADDED psl-1983/3-1/kernel/20/io.rel
Index: psl-1983/3-1/kernel/20/io.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/io.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/macro.ctl
Index: psl-1983/3-1/kernel/20/macro.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/macro.ctl
@@ -0,0 +1,18 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+@def dsk: dsk:,p20:,pk:
+@S:DEC20-CROSS.EXE
+*!*symwrite := T;
+*!*symsave := nil;
+*ASMOut "macro";
+*PathIn "macro.build";
+*ASMEnd;
+*quit;
+@reset .
+@S:DEC20-CROSS.EXE
+*!*symread := T;
+*readsymfile();
+*!*symread := nil;
+*writesavefile();
+*quit;
+@compile macro.mac, dmacro.mac
ADDED psl-1983/3-1/kernel/20/macro.init
Index: psl-1983/3-1/kernel/20/macro.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/macro.init
@@ -0,0 +1,26 @@
+(PUT (QUOTE COMMENTOUTCODE) (QUOTE TYPE) (QUOTE MACRO))
+(FLAG (QUOTE (COMMENTOUTCODE COMPILETIME)) (QUOTE IGNORE))
+(FLAG (QUOTE (BOTHTIMES)) (QUOTE EVAL))
+(REMFLAG (QUOTE (LOADTIME)) (QUOTE IGNORE))
+(REMFLAG (QUOTE (LOADTIME)) (QUOTE EVAL))
+(PUT (QUOTE CONTERROR) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE CASE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE SETF) (QUOTE TYPE) (QUOTE MACRO))
+(DEFLIST (QUOTE ((GETV PUTV) (CAR RPLACA) (CDR RPLACD) (INDX SETINDX) (SUB
+SETSUB) (NTH (LAMBDA (L I X) (RPLACA (PNTH L I) X) X)) (EVAL SET) (VALUE SET)))
+(QUOTE ASSIGN!-OP))
+(PUT (QUOTE ON) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE OFF) (QUOTE TYPE) (QUOTE MACRO))
+(FLAG (QUOTE (ON OFF)) (QUOTE IGNORE))
+(PUT (QUOTE DS) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DEFCONST) (QUOTE TYPE) (QUOTE MACRO))
+(FLAG (QUOTE (DEFCONST)) (QUOTE EVAL))
+(PUT (QUOTE CONST) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (STRINGGENSYM!*)))
+(SETQ STRINGGENSYM!* (COPYSTRING "L0000"))
+(PUT (QUOTE FOREACH) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE EXIT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE NEXT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE WHILE) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE REPEAT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE FOR) (QUOTE TYPE) (QUOTE MACRO))
ADDED psl-1983/3-1/kernel/20/macro.log
Index: psl-1983/3-1/kernel/20/macro.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/macro.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/macro.mac
Index: psl-1983/3-1/kernel/20/macro.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/macro.mac
@@ -0,0 +1,1155 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ 1
+; (!*ENTRY COMMENTOUTCODE MACRO 1)
+L2922: intern L2922
+ MOVE 1,0
+ POPJ 15,0
+ 1
+; (!*ENTRY COMPILETIME EXPR 1)
+L2923: intern L2923
+ POPJ 15,0
+ 1
+; (!*ENTRY BOTHTIMES EXPR 1)
+L2924: intern L2924
+ POPJ 15,0
+ 1
+; (!*ENTRY LOADTIME EXPR 1)
+L2925: intern L2925
+ POPJ 15,0
+ 1
+; (!*ENTRY CONTERROR MACRO 1)
+L2932: intern L2932
+ ADJSP 15,9
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 1,1(1)
+ MOVE 2,0(1)
+ MOVEM 2,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ MOVE 7,1(1)
+ CAME 0,1(7)
+ JRST L2933
+ MOVE 3,0(1)
+ MOVEM 3,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L2934
+L2933: MOVE 7,0(15)
+ CAMN 0,1(7)
+ JRST L2935
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+351
+ MOVEM 1,-2(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+ JRST L2933
+L2935: MOVE 2,-2(15)
+ MOVE 1,L2926
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-2(15)
+L2934: MOVE 1,0(15)
+ MOVE 1,0(1)
+ MOVEM 1,-3(15)
+ LDB 11,L2927
+ CAIN 11,9
+ JRST L2936
+ MOVE 2,1
+ MOVE 1,L2928
+ PUSHJ 15,SYMFNC+249
+ JRST L2937
+L2936: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-4(15)
+ MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ MOVEM 0,-7(15)
+ MOVE 2,-3(15)
+ MOVE 2,1(2)
+ MOVEM 2,-5(15)
+ LDB 11,L2929
+ CAIN 11,9
+ JRST L2938
+ MOVE 1,0
+ JRST L2939
+L2938: MOVE 1,0(2)
+ MOVEM 1,-8(15)
+ MOVE 2,1
+ MOVE 1,L2928
+ PUSHJ 15,SYMFNC+249
+ PUSHJ 15,SYMFNC+172
+ MOVE 3,1
+ MOVEM 3,-7(15)
+ MOVEM 3,-6(15)
+L2940: MOVE 1,-5(15)
+ MOVE 1,1(1)
+ MOVEM 1,-5(15)
+ LDB 11,L2927
+ CAIN 11,9
+ JRST L2941
+ MOVE 1,-6(15)
+ JRST L2939
+L2941: MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ MOVE 2,1
+ MOVE 1,L2928
+ PUSHJ 15,SYMFNC+249
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-7(15)
+ MOVEM 1,1(7)
+ MOVE 2,-7(15)
+ MOVE 2,1(2)
+ MOVEM 2,-7(15)
+ JRST L2940
+L2939: MOVE 2,-4(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L2930
+ PUSHJ 15,SYMFNC+278
+L2937: MOVEM 1,-3(15)
+ MOVE 4,1
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,L2931
+ ADJSP 15,-9
+ JRST SYMFNC+250
+L2927: point 6,1,5
+L2929: point 6,2,5
+L2931: <30_30>+236
+L2930: <30_30>+244
+L2928: <30_30>+234
+L2926: <30_30>+155
+L2945: <30_30>+716
+ <9_30>+<1_18>+L2946
+L2946: <30_30>+717
+ <30_30>+128
+ 1
+; (!*ENTRY CASE FEXPR 1)
+CASE: intern CASE
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ MOVEM 1,-1(15)
+L2947: MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ LDB 11,L2942
+ CAIN 11,9
+ JRST L2948
+ MOVE 1,-2(15)
+ ADJSP 15,-5
+ JRST SYMFNC+261
+L2948: MOVE 2,0(1)
+ MOVE 2,0(2)
+ MOVEM 2,-3(15)
+ MOVE 3,0(1)
+ MOVE 3,1(3)
+ MOVE 3,0(3)
+ MOVEM 3,-4(15)
+ LDB 11,L2943
+ CAIE 11,9
+ JRST L2949
+ MOVE 2,L2944
+ MOVE 1,-3(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L2950
+L2949: MOVE 6,-4(15)
+ MOVEM 6,-2(15)
+ JRST L2947
+L2950: MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,L2951
+ CAMN 1,0
+ JRST L2947
+ MOVE 1,-4(15)
+ ADJSP 15,-5
+ JRST SYMFNC+261
+L2942: point 6,1,5
+L2943: point 6,2,5
+L2944: <9_30>+<1_18>+L2945
+; (!*ENTRY INTHISCASE EXPR 2)
+L2951: intern L2951
+ ADJSP 15,2
+L2955: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L2952
+ CAIN 11,9
+ JRST L2956
+ MOVE 1,0
+ JRST L2957
+L2956: LDB 11,L2953
+ CAIE 11,9
+ JRST L2958
+ MOVE 7,0(2)
+ MOVE 6,L2954
+ CAME 6,0(7)
+ JRST L2958
+ MOVE 2,0(2)
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+282
+ CAME 1,0
+ JRST L2958
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+208
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+237
+ CAME 1,0
+ JRST L2958
+ MOVE 1,SYMVAL+84
+ JRST L2957
+L2958: MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L2959
+ MOVE 1,SYMVAL+84
+ JRST L2957
+L2959: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L2955
+L2957: ADJSP 15,-2
+ POPJ 15,0
+L2952: point 6,2,5
+L2953: point 6,0(2),5
+L2954: <30_30>+719
+ 1
+; (!*ENTRY SETF MACRO 1)
+SETF: intern SETF
+ MOVE 2,1(1)
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ JRST SYMFNC+721
+L2967: 36
+ byte(7)37,114,32,105,115,32,110,111,116,32,97,32,107,110,111,119,110,32,102,111,114,109,32,102,111,114,32,97,115,115,105,103,110,109,101,110,116,0
+ 2
+; (!*ENTRY EXPANDSETF EXPR 2)
+L2968: intern L2968
+ ADJSP 15,3
+L2969: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ LDB 11,L2960
+ CAIN 11,9
+ JRST L2970
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,L2961
+ ADJSP 15,-3
+ JRST SYMFNC+235
+L2970: MOVE 2,L2962
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+522
+ MOVE 3,1
+ MOVEM 3,-2(15)
+ CAMN 3,0
+ JRST L2971
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+177
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L2971: MOVE 2,L2963
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+522
+ MOVE 2,1
+ MOVEM 2,-2(15)
+ CAMN 2,0
+ JRST L2972
+ MOVE 3,2
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 6,3
+ ADJSP 15,-3
+ JRST SYMFNC+288
+L2972: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+318
+ MOVE 3,1
+ MOVEM 3,-2(15)
+ CAMN 3,0
+ JRST L2973
+ MOVE 6,L2964
+ CAME 6,0(3)
+ JRST L2973
+ MOVE 2,1(3)
+ MOVE 1,0(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVE 2,-1(15)
+ JRST L2969
+L2973: MOVE 3,-1(15)
+ MOVE 2,0(15)
+ MOVE 1,L2965
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,1
+ MOVE 1,L2966
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-3
+ JRST SYMFNC+156
+L2960: point 6,1,5
+L2966: <4_30>+<1_18>+L2967
+L2965: <30_30>+720
+L2964: <30_30>+256
+L2963: <30_30>+722
+L2962: <30_30>+723
+L2961: <30_30>+260
+ 2
+; (!*ENTRY ONOFF!* EXPR 2)
+L2979: intern L2979
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 1,-3(15)
+L2980: LDB 11,L2974
+ CAIE 11,9
+ JRST L2981
+ MOVE 1,-3(15)
+ MOVE 1,0(1)
+ MOVEM 1,-4(15)
+ LDB 11,L2975
+ CAIN 11,30
+ JRST L2982
+ CAME 0,-1(15)
+ JRST L2983
+ MOVE 1,L2976
+ JRST L2984
+L2983: MOVE 1,L2977
+L2984: MOVE 2,1
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+130
+ JRST L2985
+L2982: PUSHJ 15,SYMFNC+725
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+262
+ MOVE 2,L2978
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+522
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+335
+ MOVEM 1,-2(15)
+ CAMN 1,0
+ JRST L2985
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+L2985: MOVE 1,-3(15)
+ MOVE 1,1(1)
+ MOVEM 1,-3(15)
+ JRST L2980
+L2981: MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L2974: point 6,-3(15),5
+L2975: point 6,1,5
+L2978: <30_30>+726
+L2977: <30_30>+727
+L2976: <30_30>+728
+L2987: 0
+ byte(7)42,0
+ 1
+; (!*ENTRY MKFLAGVAR EXPR 1)
+L2988: intern L2988
+ PUSHJ 15,SYMFNC+140
+ MOVE 2,1
+ MOVE 1,L2986
+ PUSHJ 15,SYMFNC+176
+ JRST SYMFNC+560
+L2986: <4_30>+<1_18>+L2987
+ 1
+; (!*ENTRY ON MACRO 1)
+ON: intern ON
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,SYMVAL+84
+ MOVE 2,1
+ MOVE 1,L2989
+ JRST SYMFNC+235
+L2989: <30_30>+724
+ 1
+; (!*ENTRY OFF MACRO 1)
+OFF: intern OFF
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,0
+ MOVE 2,1
+ MOVE 1,L2990
+ JRST SYMFNC+235
+L2990: <30_30>+724
+; (!*ENTRY INSTANTIATEINFORM EXPR 2)
+L2994: intern L2994
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L2991
+ CAIN 11,9
+ JRST L2995
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L2996
+ MOVE 1,-1(15)
+ JRST L2997
+L2996: MOVE 1,-1(15)
+ ADJSP 15,-6
+ JRST SYMFNC+234
+L2995: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 2,-2(15)
+ LDB 11,L2991
+ CAIN 11,9
+ JRST L2998
+ MOVE 1,0
+ JRST L2999
+L2998: MOVE 1,0(2)
+ MOVEM 1,-5(15)
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,L2994
+ PUSHJ 15,SYMFNC+172
+ MOVE 3,1
+ MOVEM 3,-4(15)
+ MOVEM 3,-3(15)
+L3000: MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ LDB 11,L2992
+ CAIN 11,9
+ JRST L3001
+ MOVE 1,-3(15)
+ JRST L2999
+L3001: MOVE 1,0(1)
+ MOVEM 1,-5(15)
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,L2994
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-4(15)
+ MOVEM 1,1(7)
+ MOVE 2,-4(15)
+ MOVE 2,1(2)
+ MOVEM 2,-4(15)
+ JRST L3000
+L2999: MOVE 2,L2993
+ ADJSP 15,-6
+ JRST SYMFNC+278
+L2997: ADJSP 15,-6
+ POPJ 15,0
+L2991: point 6,2,5
+L2992: point 6,1,5
+L2993: <30_30>+244
+L3004: <30_30>+187
+ <9_30>+<1_18>+L3005
+L3005: <30_30>+729
+ <30_30>+128
+; (!*ENTRY SETMACROREFERENCE EXPR 1)
+L3006: intern L3006
+ MOVE 3,L3002
+ MOVE 2,1
+ MOVE 1,L3003
+ JRST SYMFNC+235
+L3003: <30_30>+260
+L3002: <9_30>+<1_18>+L3004
+ 1
+; (!*ENTRY DS MACRO 1)
+DS: intern DS
+ MOVE 3,1(1)
+ MOVE 3,1(3)
+ MOVE 3,1(3)
+ MOVE 2,1(1)
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ JRST MAKEDS
+L3017: <30_30>+729
+ <30_30>+128
+L3018: <30_30>+246
+ <9_30>+<1_18>+L3021
+L3019: <30_30>+270
+ <9_30>+<1_18>+L3022
+L3020: <30_30>+260
+ <9_30>+<1_18>+L3023
+L3021: <30_30>+264
+ <30_30>+128
+L3022: <9_30>+<1_18>+L3024
+ <30_30>+128
+L3023: <30_30>+729
+ <9_30>+<1_18>+L3025
+L3024: <9_30>+<1_18>+L3026
+ <9_30>+<1_18>+L3027
+L3025: <9_30>+<1_18>+L3028
+ <30_30>+128
+L3026: <30_30>+184
+ <9_30>+<1_18>+L3029
+L3027: <9_30>+<1_18>+L3030
+ <30_30>+128
+L3028: <30_30>+228
+ <9_30>+<1_18>+L3017
+L3029: <9_30>+<1_18>+L3031
+ <30_30>+128
+L3030: <30_30>+156
+ <9_30>+<1_18>+L3032
+L3031: <30_30>+188
+ <9_30>+<1_18>+L3017
+L3032: <4_30>+<1_18>+L3033
+ <30_30>+128
+L3033: 36
+ byte(7)65,114,103,117,109,101,110,116,32,109,105,115,109,97,116,99,104,32,105,110,32,83,77,97,99,114,111,32,101,120,112,97,110,115,105,111,110,0
+; (!*ENTRY MAKEDS EXPR 3)
+MAKEDS: intern MAKEDS
+ ADJSP 15,9
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-4(15)
+ MOVE 1,L3007
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+278
+ MOVEM 1,-3(15)
+ MOVE 6,-1(15)
+ MOVEM 6,-5(15)
+L3034: LDB 11,L3008
+ CAIE 11,9
+ JRST L3035
+ MOVE 1,-5(15)
+ MOVE 1,0(1)
+ MOVEM 1,-6(15)
+ MOVE 2,-3(15)
+ MOVE 1,L3009
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-3(15)
+ MOVE 1,-6(15)
+ PUSHJ 15,L3006
+ MOVE 2,-3(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-3(15)
+ MOVE 2,-5(15)
+ MOVE 2,1(2)
+ MOVEM 2,-5(15)
+ JRST L3034
+L3035: MOVE 2,-3(15)
+ MOVE 1,L3010
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-3(15)
+ MOVE 7,-2(15)
+ CAME 0,1(7)
+ JRST L3036
+ MOVE 2,-2(15)
+ MOVE 2,0(2)
+ MOVE 1,-1(15)
+ PUSHJ 15,L2994
+ JRST L3037
+L3036: MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ MOVEM 0,-7(15)
+ MOVE 6,-2(15)
+ MOVEM 6,-5(15)
+ LDB 11,L3008
+ CAIN 11,9
+ JRST L3038
+ MOVE 1,0
+ JRST L3039
+L3038: MOVE 1,-5(15)
+ MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,L2994
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVEM 2,-7(15)
+ MOVEM 2,-6(15)
+L3040: MOVE 1,-5(15)
+ MOVE 1,1(1)
+ MOVEM 1,-5(15)
+ LDB 11,L3011
+ CAIN 11,9
+ JRST L3041
+ MOVE 1,-6(15)
+ JRST L3039
+L3041: MOVE 1,0(1)
+ MOVEM 1,-8(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,L2994
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-7(15)
+ MOVEM 1,1(7)
+ MOVE 2,-7(15)
+ MOVE 2,1(2)
+ MOVEM 2,-7(15)
+ JRST L3040
+L3039: MOVE 2,L3012
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3013
+ PUSHJ 15,SYMFNC+278
+L3037: MOVE 2,1
+ MOVE 1,L3014
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,-3(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-3(15)
+ PUSHJ 15,SYMFNC+329
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,L3015
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,0(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3016
+ ADJSP 15,-9
+ JRST SYMFNC+278
+L3008: point 6,-5(15),5
+L3011: point 6,1,5
+L3016: <30_30>+257
+L3015: <9_30>+<1_18>+L3017
+L3014: <30_30>+545
+L3013: <30_30>+244
+L3012: <9_30>+<1_18>+L3018
+L3010: <9_30>+<1_18>+L3019
+L3009: <9_30>+<1_18>+L3020
+L3007: <30_30>+541
+ 1
+; (!*ENTRY DEFCONST MACRO 1)
+L3044: intern L3044
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVE 1,L3042
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+L3045: CAMN 0,0(15)
+ JRST L3046
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-2(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-2(15)
+ MOVE 1,L3043
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+ JRST L3045
+L3046: MOVE 1,-1(15)
+ ADJSP 15,-3
+ JRST SYMFNC+329
+L3043: <30_30>+732
+L3042: <30_30>+264
+ 2
+; (!*ENTRY EVDEFCONST EXPR 2)
+L3048: intern L3048
+ MOVE 3,2
+ MOVE 2,L3047
+ JRST SYMFNC+300
+L3047: <30_30>+733
+L3051: 20
+ byte(7)85,110,107,110,111,119,110,32,99,111,110,115,116,32,102,111,114,109,32,37,114,0
+ 1
+; (!*ENTRY CONST MACRO 1)
+CONST: intern CONST
+ PUSH 15,1
+ MOVE 2,L3049
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+522
+ CAME 1,0
+ JRST L3052
+ MOVE 2,0(15)
+ MOVE 1,L3050
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-1
+ JRST SYMFNC+156
+L3052: ADJSP 15,-1
+ POPJ 15,0
+L3050: <4_30>+<1_18>+L3051
+L3049: <30_30>+733
+ 0
+; (!*ENTRY STRINGGENSYM EXPR 0)
+L3053: intern L3053
+ HRRZI 1,4
+ JRST L3054
+; (!*ENTRY STRINGGENSYM1 EXPR 1)
+L3054: intern L3054
+ ADJSP 15,2
+L3055: MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ SETZM 2
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L3056
+ MOVE 2,0(15)
+ MOVE 1,SYMVAL+735
+ PUSHJ 15,SYMFNC+164
+ HRRZI 2,57
+ MOVEM 1,-1(15)
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L3057
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+241
+ MOVE 3,1
+ MOVE 2,0(15)
+ MOVE 1,SYMVAL+735
+ PUSHJ 15,SYMFNC+167
+ MOVE 1,SYMVAL+735
+ ADJSP 15,-2
+ JRST SYMFNC+401
+L3057: HRRZI 3,48
+ MOVE 2,0(15)
+ MOVE 1,SYMVAL+735
+ PUSHJ 15,SYMFNC+167
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+349
+ JRST L3055
+L3056: SETZM 2
+ MOVE 1,SYMVAL+735
+ PUSHJ 15,SYMFNC+164
+ PUSHJ 15,SYMFNC+241
+ MOVE 3,1
+ SETZM 2
+ MOVE 1,SYMVAL+735
+ PUSHJ 15,SYMFNC+167
+ ADJSP 15,-2
+ JRST SYMFNC+734
+L3072: 33
+ byte(7)37,114,32,105,115,32,97,110,32,105,108,108,101,103,97,108,32,97,99,116,105,111,110,32,105,110,32,70,111,114,69,97,99,104,0
+ 1
+; (!*ENTRY FOREACH MACRO 1)
+L3073: intern L3073
+ ADJSP 15,7
+ MOVE 2,1(1)
+ MOVE 2,0(2)
+ MOVEM 2,-6(15)
+ MOVE 1,1(1)
+ MOVE 1,1(1)
+ MOVE 3,0(1)
+ MOVEM 3,-5(15)
+ MOVE 1,1(1)
+ MOVE 4,0(1)
+ MOVEM 4,-4(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ MOVE 5,0(1)
+ MOVEM 5,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ CAME 5,L3058
+ JRST L3074
+ CAME 3,L3059
+ JRST L3075
+ MOVE 1,L3060
+ JRST L3076
+L3075: MOVE 1,L3061
+ JRST L3076
+L3074: CAMN 5,L3062
+ JRST L3077
+ CAME 5,L3063
+ JRST L3078
+L3077: CAME 3,L3059
+ JRST L3079
+ MOVE 1,L3064
+ JRST L3076
+L3079: MOVE 1,L3065
+ JRST L3076
+L3078: CAME 5,L3066
+ JRST L3080
+ CAME 3,L3059
+ JRST L3081
+ MOVE 1,L3067
+ JRST L3076
+L3081: MOVE 1,L3068
+ JRST L3076
+L3080: MOVE 2,5
+ MOVE 1,L3069
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+L3076: MOVEM 1,-3(15)
+ MOVE 1,-6(15)
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,-2(15)
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,L3070
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,1
+ MOVE 1,L3071
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ ADJSP 15,-7
+ JRST SYMFNC+235
+L3071: <30_30>+252
+L3070: <30_30>+253
+L3069: <4_30>+<1_18>+L3072
+L3068: <30_30>+294
+L3067: <30_30>+293
+L3066: <30_30>+737
+L3065: <30_30>+292
+L3064: <30_30>+290
+L3063: <30_30>+738
+L3062: <30_30>+739
+L3061: <30_30>+287
+L3060: <30_30>+289
+L3059: <30_30>+740
+L3058: <30_30>+741
+L3085: <30_30>+545
+ <9_30>+<1_18>+L3086
+L3086: <30_30>+128
+ <30_30>+128
+ 1
+; (!*ENTRY EXIT MACRO 1)
+EXIT: intern EXIT
+ CAME 0,1(1)
+ JRST L3087
+ MOVE 1,L3082
+ POPJ 15,0
+L3087: MOVE 7,1(1)
+ CAMN 0,1(7)
+ JRST L3088
+ MOVE 2,1(1)
+ MOVE 1,L3083
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,L3084
+ JRST SYMFNC+249
+L3088: MOVE 2,1(1)
+ MOVE 1,L3084
+ JRST SYMFNC+151
+L3084: <30_30>+545
+L3083: <30_30>+264
+L3082: <9_30>+<1_18>+L3085
+L3090: <30_30>+544
+ <9_30>+<1_18>+L3091
+L3091: <30_30>+743
+ <30_30>+128
+ 1
+; (!*ENTRY NEXT MACRO 1)
+NEXT: intern NEXT
+ MOVE 1,L3089
+ POPJ 15,0
+L3089: <9_30>+<1_18>+L3090
+L3098: <9_30>+<1_18>+L3100
+ <30_30>+128
+L3099: <30_30>+545
+ <9_30>+<1_18>+L3101
+L3100: <30_30>+544
+ <9_30>+<1_18>+L3102
+L3101: <30_30>+128
+ <30_30>+128
+L3102: <30_30>+743
+ <30_30>+128
+ 1
+; (!*ENTRY WHILE MACRO 1)
+WHILE: intern WHILE
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 2,1(1)
+ MOVE 2,0(2)
+ MOVE 1,L3092
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,L3093
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,1
+ MOVE 1,L3094
+ PUSHJ 15,SYMFNC+249
+ MOVEM 1,-1(15)
+ MOVE 2,L3095
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+177
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3096
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,0
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3097
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L3097: <30_30>+541
+L3096: <30_30>+743
+L3095: <9_30>+<1_18>+L3098
+L3094: <30_30>+270
+L3093: <9_30>+<1_18>+L3099
+L3092: <30_30>+272
+L3110: <30_30>+544
+ <9_30>+<1_18>+L3111
+L3111: <30_30>+743
+ <30_30>+128
+ 1
+; (!*ENTRY REPEAT MACRO 1)
+REPEAT: intern REPEAT
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 2,1(1)
+ MOVEM 2,-1(15)
+ LDB 11,L3103
+ CAIN 11,9
+ JRST L3112
+ MOVE 1,0
+ JRST L3113
+L3112: MOVE 1,2
+ CAME 0,1(1)
+ JRST L3114
+ MOVE 2,0(1)
+ MOVE 1,L3104
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,L3105
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,1
+ MOVE 1,L3106
+ PUSHJ 15,SYMFNC+249
+ JRST L3115
+L3114: MOVE 1,0(1)
+L3115: PUSHJ 15,SYMFNC+172
+ MOVE 3,1
+ MOVEM 3,-3(15)
+ MOVEM 3,-2(15)
+L3116: MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ LDB 11,L3107
+ CAIN 11,9
+ JRST L3117
+ MOVE 1,-2(15)
+ JRST L3113
+L3117: CAME 0,1(1)
+ JRST L3118
+ MOVE 2,0(1)
+ MOVE 1,L3104
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,L3105
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,1
+ MOVE 1,L3106
+ PUSHJ 15,SYMFNC+249
+ JRST L3119
+L3118: MOVE 1,0(1)
+L3119: PUSHJ 15,SYMFNC+172
+ MOVE 7,-3(15)
+ MOVEM 1,1(7)
+ MOVE 2,-3(15)
+ MOVE 2,1(2)
+ MOVEM 2,-3(15)
+ JRST L3116
+L3113: MOVE 2,L3108
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,0
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3109
+ ADJSP 15,-4
+ JRST SYMFNC+278
+L3103: point 6,2,5
+L3107: point 6,1,5
+L3109: <30_30>+541
+L3108: <30_30>+743
+L3106: <30_30>+270
+L3105: <9_30>+<1_18>+L3110
+L3104: <30_30>+272
+L3135: <9_30>+<1_18>+L3137
+ <30_30>+128
+L3136: <30_30>+545
+ <9_30>+<1_18>+L3138
+L3137: <30_30>+544
+ <9_30>+<1_18>+L3139
+L3138: <30_30>+128
+ <30_30>+128
+L3139: <30_30>+743
+ <30_30>+128
+ 1
+; (!*ENTRY FOR MACRO 1)
+FOR: intern FOR
+ ADJSP 15,11
+ MOVEM 1,0(15)
+ MOVEM 0,-3(15)
+ MOVE 2,1(1)
+ MOVE 2,0(2)
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ MOVEM 2,-7(15)
+ MOVE 3,1(1)
+ MOVE 3,0(3)
+ MOVE 3,1(3)
+ MOVE 3,1(3)
+ MOVEM 3,-4(15)
+ MOVE 4,1(1)
+ MOVE 4,1(4)
+ MOVE 4,0(4)
+ MOVE 4,0(4)
+ MOVEM 4,-1(15)
+ MOVE 5,1(1)
+ MOVE 5,1(5)
+ MOVE 5,0(5)
+ MOVE 5,1(5)
+ MOVE 5,0(5)
+ MOVEM 5,-2(15)
+ MOVE 3,0(3)
+ MOVE 1,L3120
+ PUSHJ 15,SYMFNC+235
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-5(15)
+ MOVE 2,-4(15)
+ MOVE 2,1(2)
+ MOVEM 2,-4(15)
+ MOVE 3,-7(15)
+ MOVE 2,0(2)
+ MOVE 1,L3121
+ PUSHJ 15,SYMFNC+235
+ MOVEM 1,-8(15)
+ MOVE 7,-4(15)
+ MOVE 7,1(7)
+ MOVE 7,0(7)
+ CAIN 7,1
+ JRST L3140
+ MOVE 3,1
+ MOVE 2,-4(15)
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ MOVE 1,L3122
+ PUSHJ 15,SYMFNC+235
+ MOVEM 1,-8(15)
+L3140: MOVE 6,L3123
+ MOVEM 6,-6(15)
+ MOVE 6,-1(15)
+ CAMN 6,L3124
+ JRST L3141
+ MOVE 2,L3125
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+522
+ MOVEM 1,-1(15)
+ PUSHJ 15,SYMFNC+748
+ MOVEM 1,-3(15)
+ MOVE 2,-2(15)
+ MOVE 1,L3126
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,-3(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L3120
+ PUSHJ 15,SYMFNC+235
+ MOVEM 1,-2(15)
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L3120
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,-5(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-5(15)
+ MOVE 2,-3(15)
+ MOVE 1,L3127
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,1
+ MOVE 1,L3128
+ PUSHJ 15,SYMFNC+249
+ MOVEM 1,-6(15)
+ MOVE 1,-3(15)
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-3(15)
+L3141: MOVE 2,-3(15)
+ MOVE 1,-7(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-9(15)
+ MOVE 2,-8(15)
+ MOVE 1,L3129
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,-6(15)
+ PUSHJ 15,SYMFNC+249
+ MOVE 2,1
+ MOVE 1,L3130
+ PUSHJ 15,SYMFNC+249
+ MOVEM 1,-10(15)
+ MOVE 3,-4(15)
+ MOVE 3,1(3)
+ MOVE 3,0(3)
+ MOVE 2,-7(15)
+ MOVE 1,L3131
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,-7(15)
+ MOVE 1,L3120
+ PUSHJ 15,SYMFNC+235
+ MOVE 2,L3132
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,-2(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,-10(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3133
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,1
+ MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+291
+ MOVE 2,-9(15)
+ PUSHJ 15,SYMFNC+278
+ MOVE 2,L3134
+ ADJSP 15,-11
+ JRST SYMFNC+278
+L3134: <30_30>+541
+L3133: <30_30>+743
+L3132: <9_30>+<1_18>+L3135
+L3131: <30_30>+243
+L3130: <30_30>+270
+L3129: <30_30>+239
+L3128: <30_30>+545
+L3127: <30_30>+749
+L3126: <30_30>+750
+L3125: <30_30>+751
+L3124: <30_30>+741
+L3123: <9_30>+<1_18>+L3136
+L3122: <30_30>+286
+L3121: <30_30>+238
+L3120: <30_30>+260
+ end
ADDED psl-1983/3-1/kernel/20/macro.rel
Index: psl-1983/3-1/kernel/20/macro.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/macro.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/main-start.red
Index: psl-1983/3-1/kernel/20/main-start.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/main-start.red
@@ -0,0 +1,65 @@
+%
+% MAIN-START.RED - First routine called on startup
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 15 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 26-May-1983 Mark R. Swanson
+% Cahnges to support extended addressing
+% <PSL.KERNEL-20>MAIN-START.RED.4, 5-Oct-82 10:42:14, Edit by BENSON
+% Added call to EvalInitForms in MAIN!.
+
+on SysLisp;
+
+internal WConst StackSize = 4000;
+
+internal WArray Stack[StackSize];
+
+exported WVar StackLowerBound = &Stack[0] + 8#1000000,
+ StackUpperBound = &Stack[StackSize] + 8#1000000;
+
+external WVar ST;
+
+internal WConst MaxArgBlock = (MaxArgs - MaxRealRegs) - 1;
+
+% 0..MaxArgBlock are arguments (MaxRealRegs + 1)..MaxArgs
+
+exported WArray ArgumentBlock[MaxArgBlock];
+
+exported WArray HashTable[MaxObArray/2];
+
+lap '((!*entry Main!. expr 0)
+Forever
+ (move (reg st) (lit (halfword (minus (WConst StackSize))
+ (difference (WConst Stack) 1))))
+ (move (reg nil) (fluid nil))
+ (!*CALL pre!-main)
+ (jrst Forever)
+);
+
+syslsp procedure Reset();
+ Throw('Reset, 'Reset);
+
+syslsp procedure pre!-main();
+<< ClearBindings();
+ ClearIO();
+ EvalInitForms();
+ if Catch('Reset, Main()) = 'Reset then pre!-main() >>;
+
+syslsp procedure Main(); %. initialization function
+%
+% A new system can be created by redefining this function to call whatever
+% top loop is desired.
+%
+<< InitCode(); % special code accumulated in compiler
+ SymFnc[IDLoc Main] := SymFnc[IDLoc StandardLisp]; % don't do it again
+ StandardLisp() >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/main.ctl
Index: psl-1983/3-1/kernel/20/main.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/main.ctl
@@ -0,0 +1,10 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+@def dsk: dsk:,p20:,pk:
+@S:DEC20-CROSS.EXE
+*!*main:=T;
+*ASMOut "main";
+*PathIn "main.build";
+*ASMEnd;
+*quit;
+@compile main.mac, dmain.mac
ADDED psl-1983/3-1/kernel/20/main.init
Index: psl-1983/3-1/kernel/20/main.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/main.init
ADDED psl-1983/3-1/kernel/20/main.log
Index: psl-1983/3-1/kernel/20/main.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/main.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/main.mac
Index: psl-1983/3-1/kernel/20/main.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/main.mac
@@ -0,0 +1,3013 @@
+ search monsym,macsym
+ radix 10
+ extern STACK
+ extern L1254
+ extern L2081
+ extern L0002
+ extern L0003
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: reset%
+ setzm 1
+ move 2,[.fhslf,,2]
+ move 3,[140000,,3]
+smap.: smap%
+ move 1,[jfcl]
+ movem 1,smap.
+L3699: MOVE 15,L3698
+ MOVE 0,SYMVAL+128
+ PUSHJ 15,SYMFNC+843
+ JRST L3699
+L3698: byte(18)-4000,STACK-1
+ 0
+; (!*ENTRY RESET EXPR 0)
+RESET: intern RESET
+ MOVE 2,L3700
+ MOVE 1,L3700
+ JRST SYMFNC+495
+L3700: <30_30>+536
+ 0
+; (!*ENTRY PRE!-MAIN EXPR 0)
+L3702: intern L3702
+ ADJSP 15,2
+L3703: PUSHJ 15,SYMFNC+781
+ PUSHJ 15,SYMFNC+794
+ PUSHJ 15,SYMFNC+838
+ MOVE 1,L3701
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,0(15)
+ CAME 0,SYMVAL+500
+ JRST L3704
+ PUSHJ 15,SYMFNC+844
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+501
+ MOVE 1,-1(15)
+L3704: CAMN 1,L3701
+ JRST L3703
+ MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+L3701: <30_30>+536
+ 0
+; (!*ENTRY MAIN EXPR 0)
+MAIN: intern MAIN
+ PUSHJ 15,SYMFNC+845
+ MOVE 6,834+SYMFNC
+ MOVEM 6,844+SYMFNC
+ JRST SYMFNC+834
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L3721: intern L3721
+ MOVE 3,L3705
+ MOVE 2,L3706
+ MOVE 1,L3707
+ PUSHJ 15,SYMFNC+300
+ MOVE 3,L3705
+ MOVE 2,L3706
+ MOVE 1,L3708
+ PUSHJ 15,SYMFNC+300
+ MOVE 3,L3709
+ MOVE 2,L3710
+ MOVE 1,L3711
+ PUSHJ 15,SYMFNC+300
+ MOVE 3,L3712
+ MOVE 2,L3710
+ MOVE 1,L3713
+ PUSHJ 15,SYMFNC+300
+ MOVE 3,L3714
+ MOVE 2,L3710
+ MOVE 1,L3715
+ PUSHJ 15,SYMFNC+300
+ MOVE 3,L3716
+ MOVE 2,L3710
+ MOVE 1,L3717
+ PUSHJ 15,SYMFNC+300
+ MOVE 3,L3718
+ MOVE 2,L3710
+ HRRZI 1,26
+ HRLI 1,122880
+ PUSHJ 15,SYMFNC+300
+ PUSHJ 15,SYMFNC+791
+ HRRZI 3,26
+ MOVE 2,L3719
+ MOVE 1,L3720
+ JRST SYMFNC+300
+L3720: <30_30>+846
+L3719: <30_30>+847
+L3718: <30_30>+641
+L3717: <30_30>+91
+L3716: <30_30>+646
+L3715: <30_30>+41
+L3714: <30_30>+645
+L3713: <30_30>+40
+L3712: <30_30>+644
+L3711: <30_30>+39
+L3710: <30_30>+638
+L3709: <30_30>+643
+L3708: <30_30>+246
+L3707: <30_30>+264
+L3706: <30_30>+759
+L3705: <30_30>+254
+ extern SYMVAL
+L3722: <30_30>+261
+ <9_30>+<1_18>+L3723
+L3723: <30_30>+518
+ <9_30>+<1_18>+L3724
+L3724: <30_30>+288
+ <9_30>+<1_18>+L3725
+L3725: <30_30>+508
+ <9_30>+<1_18>+L3726
+L3726: <30_30>+509
+ <9_30>+<1_18>+L3727
+L3727: <30_30>+498
+ <9_30>+<1_18>+L3728
+L3728: <30_30>+478
+ <9_30>+<1_18>+L3729
+L3729: <30_30>+265
+ <9_30>+<1_18>+L3730
+L3730: <30_30>+807
+ <9_30>+<1_18>+L3731
+L3731: <30_30>+809
+ <9_30>+<1_18>+L3732
+L3732: <30_30>+510
+ <9_30>+<1_18>+L3733
+L3733: <30_30>+451
+ <9_30>+<1_18>+L3734
+L3734: <30_30>+844
+ <30_30>+128
+ intern L3722
+L3735: <30_30>+270
+ <9_30>+<1_18>+L3736
+L3736: <30_30>+541
+ <9_30>+<1_18>+L3737
+L3737: <30_30>+266
+ <9_30>+<1_18>+L3738
+L3738: <30_30>+268
+ <9_30>+<1_18>+L3739
+L3739: <30_30>+264
+ <9_30>+<1_18>+L3740
+L3740: <30_30>+260
+ <30_30>+128
+ intern L3735
+L3741: <30_30>+848
+ <9_30>+<1_18>+L3742
+L3742: <30_30>+849
+ <9_30>+<1_18>+L3743
+L3743: <30_30>+850
+ <9_30>+<1_18>+L3744
+L3744: <30_30>+851
+ <30_30>+128
+ intern L3741
+L3745: <4_30>+<1_18>+L3746
+ <9_30>+<1_18>+L3747
+L3746: -1
+ byte(7)0
+L3747: <4_30>+<1_18>+L3748
+ <30_30>+128
+L3748: 2
+ byte(7)112,108,58,0
+ intern L3745
+L3749: <9_30>+<1_18>+L3750
+ <9_30>+<1_18>+L3751
+L3750: <4_30>+<1_18>+L3752
+ <30_30>+559
+L3751: <9_30>+<1_18>+L3753
+ <30_30>+128
+L3752: 1
+ byte(7)46,98,0
+L3753: <4_30>+<1_18>+L3754
+ <30_30>+841
+L3754: 3
+ byte(7)46,108,97,112,0
+ intern L3749
+L3755: 128
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 17
+ 10
+ 17
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 14
+ 15
+ 10
+ 10
+ 12
+ 10
+ 11
+ 11
+ 11
+ 10
+ 19
+ 10
+ 18
+ 20
+ 10
+ 0
+ 1
+ 2
+ 3
+ 4
+ 5
+ 6
+ 7
+ 8
+ 9
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 16
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ <30_30>+852
+ intern L3755
+L3756: 128
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 17
+ 10
+ 17
+ 17
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 17
+ 14
+ 15
+ 10
+ 10
+ 12
+ 10
+ 11
+ 11
+ 11
+ 10
+ 19
+ 10
+ 18
+ 20
+ 10
+ 0
+ 1
+ 2
+ 3
+ 4
+ 5
+ 6
+ 7
+ 8
+ 9
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 11
+ 16
+ 11
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ 10
+ <30_30>+852
+ intern L3756
+L3757: 21
+ byte(7)80,111,114,116,97,98,108,101,32,83,116,97,110,100,97,114,100,32,76,73,83,80,0
+ intern L3757
+ extern SYMPRP
+ extern SYMNAM
+L3758: 0
+ byte(7)0,0
+ intern L3758
+L3759: 0
+ byte(7)1,0
+ intern L3759
+L3760: 0
+ byte(7)2,0
+ intern L3760
+L3761: 0
+ byte(7)3,0
+ intern L3761
+L3762: 0
+ byte(7)4,0
+ intern L3762
+L3763: 0
+ byte(7)5,0
+ intern L3763
+L3764: 0
+ byte(7)6,0
+ intern L3764
+L3765: 0
+ byte(7)7,0
+ intern L3765
+L3766: 0
+ byte(7)8,0
+ intern L3766
+L3767: 0
+ byte(7)9,0
+ intern L3767
+L3768: 0
+ byte(7)10,0
+ intern L3768
+L3769: 0
+ byte(7)11,0
+ intern L3769
+L3770: 0
+ byte(7)12,0
+ intern L3770
+L3771: 0
+ byte(7)13,0
+ intern L3771
+L3772: 0
+ byte(7)14,0
+ intern L3772
+L3773: 0
+ byte(7)15,0
+ intern L3773
+L3774: 0
+ byte(7)16,0
+ intern L3774
+L3775: 0
+ byte(7)17,0
+ intern L3775
+L3776: 0
+ byte(7)18,0
+ intern L3776
+L3777: 0
+ byte(7)19,0
+ intern L3777
+L3778: 0
+ byte(7)20,0
+ intern L3778
+L3779: 0
+ byte(7)21,0
+ intern L3779
+L3780: 0
+ byte(7)22,0
+ intern L3780
+L3781: 0
+ byte(7)23,0
+ intern L3781
+L3782: 0
+ byte(7)24,0
+ intern L3782
+L3783: 0
+ byte(7)25,0
+ intern L3783
+L3784: 0
+ byte(7)26,0
+ intern L3784
+L3785: 0
+ byte(7)27,0
+ intern L3785
+L3786: 0
+ byte(7)28,0
+ intern L3786
+L3787: 0
+ byte(7)29,0
+ intern L3787
+L3788: 0
+ byte(7)30,0
+ intern L3788
+L3789: 0
+ byte(7)31,0
+ intern L3789
+L3790: 0
+ byte(7)32,0
+ intern L3790
+L3791: 0
+ byte(7)33,0
+ intern L3791
+L3792: 0
+ byte(7)34,0
+ intern L3792
+L3793: 0
+ byte(7)35,0
+ intern L3793
+L3794: 0
+ byte(7)36,0
+ intern L3794
+L3795: 0
+ byte(7)37,0
+ intern L3795
+L3796: 0
+ byte(7)38,0
+ intern L3796
+L3797: 0
+ byte(7)39,0
+ intern L3797
+L3798: 0
+ byte(7)40,0
+ intern L3798
+L3799: 0
+ byte(7)41,0
+ intern L3799
+L3800: 0
+ byte(7)42,0
+ intern L3800
+L3801: 0
+ byte(7)43,0
+ intern L3801
+L3802: 0
+ byte(7)44,0
+ intern L3802
+L3803: 0
+ byte(7)45,0
+ intern L3803
+L3804: 0
+ byte(7)46,0
+ intern L3804
+L3805: 0
+ byte(7)47,0
+ intern L3805
+L3806: 0
+ byte(7)48,0
+ intern L3806
+L3807: 0
+ byte(7)49,0
+ intern L3807
+L3808: 0
+ byte(7)50,0
+ intern L3808
+L3809: 0
+ byte(7)51,0
+ intern L3809
+L3810: 0
+ byte(7)52,0
+ intern L3810
+L3811: 0
+ byte(7)53,0
+ intern L3811
+L3812: 0
+ byte(7)54,0
+ intern L3812
+L3813: 0
+ byte(7)55,0
+ intern L3813
+L3814: 0
+ byte(7)56,0
+ intern L3814
+L3815: 0
+ byte(7)57,0
+ intern L3815
+L3816: 0
+ byte(7)58,0
+ intern L3816
+L3817: 0
+ byte(7)59,0
+ intern L3817
+L3818: 0
+ byte(7)60,0
+ intern L3818
+L3819: 0
+ byte(7)61,0
+ intern L3819
+L3820: 0
+ byte(7)62,0
+ intern L3820
+L3821: 0
+ byte(7)63,0
+ intern L3821
+L3822: 0
+ byte(7)64,0
+ intern L3822
+L3823: 0
+ byte(7)65,0
+ intern L3823
+L3824: 0
+ byte(7)66,0
+ intern L3824
+L3825: 0
+ byte(7)67,0
+ intern L3825
+L3826: 0
+ byte(7)68,0
+ intern L3826
+L3827: 0
+ byte(7)69,0
+ intern L3827
+L3828: 0
+ byte(7)70,0
+ intern L3828
+L3829: 0
+ byte(7)71,0
+ intern L3829
+L3830: 0
+ byte(7)72,0
+ intern L3830
+L3831: 0
+ byte(7)73,0
+ intern L3831
+L3832: 0
+ byte(7)74,0
+ intern L3832
+L3833: 0
+ byte(7)75,0
+ intern L3833
+L3834: 0
+ byte(7)76,0
+ intern L3834
+L3835: 0
+ byte(7)77,0
+ intern L3835
+L3836: 0
+ byte(7)78,0
+ intern L3836
+L3837: 0
+ byte(7)79,0
+ intern L3837
+L3838: 0
+ byte(7)80,0
+ intern L3838
+L3839: 0
+ byte(7)81,0
+ intern L3839
+L3840: 0
+ byte(7)82,0
+ intern L3840
+L3841: 0
+ byte(7)83,0
+ intern L3841
+L3842: 0
+ byte(7)84,0
+ intern L3842
+L3843: 0
+ byte(7)85,0
+ intern L3843
+L3844: 0
+ byte(7)86,0
+ intern L3844
+L3845: 0
+ byte(7)87,0
+ intern L3845
+L3846: 0
+ byte(7)88,0
+ intern L3846
+L3847: 0
+ byte(7)89,0
+ intern L3847
+L3848: 0
+ byte(7)90,0
+ intern L3848
+L3849: 0
+ byte(7)91,0
+ intern L3849
+L3850: 0
+ byte(7)92,0
+ intern L3850
+L3851: 0
+ byte(7)93,0
+ intern L3851
+L3852: 0
+ byte(7)94,0
+ intern L3852
+L3853: 0
+ byte(7)95,0
+ intern L3853
+L3854: 0
+ byte(7)96,0
+ intern L3854
+L3855: 0
+ byte(7)97,0
+ intern L3855
+L3856: 0
+ byte(7)98,0
+ intern L3856
+L3857: 0
+ byte(7)99,0
+ intern L3857
+L3858: 0
+ byte(7)100,0
+ intern L3858
+L3859: 0
+ byte(7)101,0
+ intern L3859
+L3860: 0
+ byte(7)102,0
+ intern L3860
+L3861: 0
+ byte(7)103,0
+ intern L3861
+L3862: 0
+ byte(7)104,0
+ intern L3862
+L3863: 0
+ byte(7)105,0
+ intern L3863
+L3864: 0
+ byte(7)106,0
+ intern L3864
+L3865: 0
+ byte(7)107,0
+ intern L3865
+L3866: 0
+ byte(7)108,0
+ intern L3866
+L3867: 0
+ byte(7)109,0
+ intern L3867
+L3868: 0
+ byte(7)110,0
+ intern L3868
+L3869: 0
+ byte(7)111,0
+ intern L3869
+L3870: 0
+ byte(7)112,0
+ intern L3870
+L3871: 0
+ byte(7)113,0
+ intern L3871
+L3872: 0
+ byte(7)114,0
+ intern L3872
+L3873: 0
+ byte(7)115,0
+ intern L3873
+L3874: 0
+ byte(7)116,0
+ intern L3874
+L3875: 0
+ byte(7)117,0
+ intern L3875
+L3876: 0
+ byte(7)118,0
+ intern L3876
+L3877: 0
+ byte(7)119,0
+ intern L3877
+L3878: 0
+ byte(7)120,0
+ intern L3878
+L3879: 0
+ byte(7)121,0
+ intern L3879
+L3880: 0
+ byte(7)122,0
+ intern L3880
+L3881: 0
+ byte(7)123,0
+ intern L3881
+L3882: 0
+ byte(7)124,0
+ intern L3882
+L3883: 0
+ byte(7)125,0
+ intern L3883
+L3884: 0
+ byte(7)126,0
+ intern L3884
+L3885: 0
+ byte(7)127,0
+ intern L3885
+L3886: 2
+ byte(7)78,73,76,0
+ intern L3886
+L3887: 5
+ byte(7)73,68,50,73,78,84,0
+ intern L3887
+L3888: 9
+ byte(7)78,79,78,73,68,69,82,82,79,82,0
+ intern L3888
+L3889: 5
+ byte(7)73,78,84,50,73,68,0
+ intern L3889
+L3890: 8
+ byte(7)84,89,80,69,69,82,82,79,82,0
+ intern L3890
+L3891: 14
+ byte(7)78,79,78,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L3891
+L3892: 6
+ byte(7)73,78,84,50,83,89,83,0
+ intern L3892
+L3893: 8
+ byte(7)76,73,83,80,50,67,72,65,82,0
+ intern L3893
+L3894: 16
+ byte(7)78,79,78,67,72,65,82,65,67,84,69,82,69,82,82,79,82,0
+ intern L3894
+L3895: 7
+ byte(7)73,78,84,50,67,79,68,69,0
+ intern L3895
+L3896: 6
+ byte(7)83,89,83,50,73,78,84,0
+ intern L3896
+L3897: 5
+ byte(7)71,84,70,73,88,78,0
+ intern L3897
+L3898: 8
+ byte(7)73,68,50,83,84,82,73,78,71,0
+ intern L3898
+L3899: 12
+ byte(7)83,84,82,73,78,71,50,86,69,67,84,79,82,0
+ intern L3899
+L3900: 5
+ byte(7)71,84,86,69,67,84,0
+ intern L3900
+L3901: 13
+ byte(7)78,79,78,83,84,82,73,78,71,69,82,82,79,82,0
+ intern L3901
+L3902: 12
+ byte(7)86,69,67,84,79,82,50,83,84,82,73,78,71,0
+ intern L3902
+L3903: 4
+ byte(7)71,84,83,84,82,0
+ intern L3903
+L3904: 13
+ byte(7)78,79,78,86,69,67,84,79,82,69,82,82,79,82,0
+ intern L3904
+L3905: 10
+ byte(7)76,73,83,84,50,83,84,82,73,78,71,0
+ intern L3905
+L3906: 5
+ byte(7)76,69,78,71,84,72,0
+ intern L3906
+L3907: 11
+ byte(7)78,79,78,80,65,73,82,69,82,82,79,82,0
+ intern L3907
+L3908: 10
+ byte(7)83,84,82,73,78,71,50,76,73,83,84,0
+ intern L3908
+L3909: 3
+ byte(7)67,79,78,83,0
+ intern L3909
+L3910: 10
+ byte(7)76,73,83,84,50,86,69,67,84,79,82,0
+ intern L3910
+L3911: 10
+ byte(7)86,69,67,84,79,82,50,76,73,83,84,0
+ intern L3911
+L3912: 3
+ byte(7)71,69,84,86,0
+ intern L3912
+L3913: 5
+ byte(7)66,76,68,77,83,71,0
+ intern L3913
+L3914: 7
+ byte(7)83,84,68,69,82,82,79,82,0
+ intern L3914
+L3915: 9
+ byte(7)73,78,68,69,88,69,82,82,79,82,0
+ intern L3915
+L3916: 3
+ byte(7)80,85,84,86,0
+ intern L3916
+L3917: 3
+ byte(7)85,80,66,86,0
+ intern L3917
+L3918: 7
+ byte(7)69,86,69,67,84,79,82,80,0
+ intern L3918
+L3919: 4
+ byte(7)69,71,69,84,86,0
+ intern L3919
+L3920: 4
+ byte(7)69,80,85,84,86,0
+ intern L3920
+L3921: 4
+ byte(7)69,85,80,66,86,0
+ intern L3921
+L3922: 3
+ byte(7)73,78,68,88,0
+ intern L3922
+L3923: 9
+ byte(7)82,65,78,71,69,69,82,82,79,82,0
+ intern L3923
+L3924: 15
+ byte(7)78,79,78,83,69,81,85,69,78,67,69,69,82,82,79,82,0
+ intern L3924
+L3925: 6
+ byte(7)83,69,84,73,78,68,88,0
+ intern L3925
+L3926: 2
+ byte(7)83,85,66,0
+ intern L3926
+L3927: 5
+ byte(7)83,85,66,83,69,81,0
+ intern L3927
+L3928: 5
+ byte(7)71,84,87,82,68,83,0
+ intern L3928
+L3929: 10
+ byte(7)71,84,72,65,76,70,87,79,82,68,83,0
+ intern L3929
+L3930: 4
+ byte(7)78,67,79,78,83,0
+ intern L3930
+L3931: 4
+ byte(7)84,67,79,78,67,0
+ intern L3931
+L3932: 5
+ byte(7)83,69,84,83,85,66,0
+ intern L3932
+L3933: 8
+ byte(7)83,69,84,83,85,66,83,69,81,0
+ intern L3933
+L3934: 5
+ byte(7)67,79,78,67,65,84,0
+ intern L3934
+L3935: 5
+ byte(7)65,80,80,69,78,68,0
+ intern L3935
+L3936: 3
+ byte(7)83,73,90,69,0
+ intern L3936
+L3937: 4
+ byte(7)67,79,68,69,80,0
+ intern L3937
+L3938: 1
+ byte(7)69,81,0
+ intern L3938
+L3939: 5
+ byte(7)70,76,79,65,84,80,0
+ intern L3939
+L3940: 3
+ byte(7)66,73,71,80,0
+ intern L3940
+L3941: 2
+ byte(7)73,68,80,0
+ intern L3941
+L3942: 4
+ byte(7)80,65,73,82,80,0
+ intern L3942
+L3943: 6
+ byte(7)83,84,82,73,78,71,80,0
+ intern L3943
+L3944: 6
+ byte(7)86,69,67,84,79,82,80,0
+ intern L3944
+L3945: 2
+ byte(7)67,65,82,0
+ intern L3945
+L3946: 2
+ byte(7)67,68,82,0
+ intern L3946
+L3947: 5
+ byte(7)82,80,76,65,67,65,0
+ intern L3947
+L3948: 5
+ byte(7)82,80,76,65,67,68,0
+ intern L3948
+L3949: 3
+ byte(7)70,73,88,80,0
+ intern L3949
+L3950: 4
+ byte(7)68,73,71,73,84,0
+ intern L3950
+L3951: 4
+ byte(7)76,73,84,69,82,0
+ intern L3951
+L3952: 2
+ byte(7)69,81,78,0
+ intern L3952
+L3953: 8
+ byte(7)76,73,83,80,69,81,85,65,76,0
+ intern L3953
+L3954: 10
+ byte(7)83,84,82,73,78,71,69,81,85,65,76,0
+ intern L3954
+L3955: 4
+ byte(7)69,81,83,84,82,0
+ intern L3955
+L3956: 4
+ byte(7)69,81,85,65,76,0
+ intern L3956
+L3957: 5
+ byte(7)67,65,65,65,65,82,0
+ intern L3957
+L3958: 4
+ byte(7)67,65,65,65,82,0
+ intern L3958
+L3959: 5
+ byte(7)67,65,65,65,68,82,0
+ intern L3959
+L3960: 5
+ byte(7)67,65,65,68,65,82,0
+ intern L3960
+L3961: 4
+ byte(7)67,65,65,68,82,0
+ intern L3961
+L3962: 5
+ byte(7)67,65,65,68,68,82,0
+ intern L3962
+L3963: 5
+ byte(7)67,65,68,65,65,82,0
+ intern L3963
+L3964: 4
+ byte(7)67,65,68,65,82,0
+ intern L3964
+L3965: 5
+ byte(7)67,65,68,65,68,82,0
+ intern L3965
+L3966: 5
+ byte(7)67,65,68,68,65,82,0
+ intern L3966
+L3967: 4
+ byte(7)67,65,68,68,82,0
+ intern L3967
+L3968: 5
+ byte(7)67,65,68,68,68,82,0
+ intern L3968
+L3969: 5
+ byte(7)67,68,65,65,65,82,0
+ intern L3969
+L3970: 4
+ byte(7)67,68,65,65,82,0
+ intern L3970
+L3971: 5
+ byte(7)67,68,65,65,68,82,0
+ intern L3971
+L3972: 5
+ byte(7)67,68,65,68,65,82,0
+ intern L3972
+L3973: 4
+ byte(7)67,68,65,68,82,0
+ intern L3973
+L3974: 5
+ byte(7)67,68,65,68,68,82,0
+ intern L3974
+L3975: 5
+ byte(7)67,68,68,65,65,82,0
+ intern L3975
+L3976: 4
+ byte(7)67,68,68,65,82,0
+ intern L3976
+L3977: 5
+ byte(7)67,68,68,65,68,82,0
+ intern L3977
+L3978: 5
+ byte(7)67,68,68,68,65,82,0
+ intern L3978
+L3979: 4
+ byte(7)67,68,68,68,82,0
+ intern L3979
+L3980: 5
+ byte(7)67,68,68,68,68,82,0
+ intern L3980
+L3981: 3
+ byte(7)67,65,65,82,0
+ intern L3981
+L3982: 3
+ byte(7)67,65,68,82,0
+ intern L3982
+L3983: 3
+ byte(7)67,68,65,82,0
+ intern L3983
+L3984: 3
+ byte(7)67,68,68,82,0
+ intern L3984
+L3985: 6
+ byte(7)83,65,70,69,67,65,82,0
+ intern L3985
+L3986: 6
+ byte(7)83,65,70,69,67,68,82,0
+ intern L3986
+L3987: 3
+ byte(7)65,84,79,77,0
+ intern L3987
+L3988: 8
+ byte(7)67,79,78,83,84,65,78,84,80,0
+ intern L3988
+L3989: 3
+ byte(7)78,85,76,76,0
+ intern L3989
+L3990: 6
+ byte(7)78,85,77,66,69,82,80,0
+ intern L3990
+L3991: 3
+ byte(7)69,88,80,84,0
+ intern L3991
+L3992: 6
+ byte(7)77,75,81,85,79,84,69,0
+ intern L3992
+L3993: 4
+ byte(7)76,73,83,84,51,0
+ intern L3993
+L3994: 15
+ byte(7)67,79,78,84,73,78,85,65,66,76,69,69,82,82,79,82,0
+ intern L3994
+L3995: 7
+ byte(7)71,82,69,65,84,69,82,80,0
+ intern L3995
+L3996: 9
+ byte(7)68,73,70,70,69,82,69,78,67,69,0
+ intern L3996
+L3997: 5
+ byte(7)77,73,78,85,83,80,0
+ intern L3997
+L3998: 5
+ byte(7)84,73,77,69,83,50,0
+ intern L3998
+L3999: 3
+ byte(7)65,68,68,49,0
+ intern L3999
+L4000: 7
+ byte(7)81,85,79,84,73,69,78,84,0
+ intern L4000
+L4001: 4
+ byte(7)80,76,85,83,50,0
+ intern L4001
+L4002: 3
+ byte(7)76,73,83,84,0
+ intern L4002
+L4003: 4
+ byte(7)69,86,76,73,83,0
+ intern L4003
+L4004: 4
+ byte(7)81,85,79,84,69,0
+ intern L4004
+L4005: 3
+ byte(7)69,88,80,82,0
+ intern L4005
+L4006: 1
+ byte(7)68,69,0
+ intern L4006
+L4007: 4
+ byte(7)76,73,83,84,50,0
+ intern L4007
+L4008: 4
+ byte(7)76,73,83,84,52,0
+ intern L4008
+L4009: 3
+ byte(7)80,85,84,68,0
+ intern L4009
+L4010: 7
+ byte(7)70,85,78,67,84,73,79,78,0
+ intern L4010
+L4011: 5
+ byte(7)76,65,77,66,68,65,0
+ intern L4011
+L4012: 4
+ byte(7)70,69,88,80,82,0
+ intern L4012
+L4013: 1
+ byte(7)68,70,0
+ intern L4013
+L4014: 4
+ byte(7)77,65,67,82,79,0
+ intern L4014
+L4015: 1
+ byte(7)68,77,0
+ intern L4015
+L4016: 4
+ byte(7)78,69,88,80,82,0
+ intern L4016
+L4017: 1
+ byte(7)68,78,0
+ intern L4017
+L4018: 3
+ byte(7)83,69,84,81,0
+ intern L4018
+L4019: 3
+ byte(7)69,86,65,76,0
+ intern L4019
+L4020: 2
+ byte(7)83,69,84,0
+ intern L4020
+L4021: 4
+ byte(7)80,82,79,71,50,0
+ intern L4021
+L4022: 4
+ byte(7)80,82,79,71,78,0
+ intern L4022
+L4023: 6
+ byte(7)69,86,80,82,79,71,78,0
+ intern L4023
+L4024: 2
+ byte(7)65,78,68,0
+ intern L4024
+L4025: 4
+ byte(7)69,86,65,78,68,0
+ intern L4025
+L4026: 1
+ byte(7)79,82,0
+ intern L4026
+L4027: 3
+ byte(7)69,86,79,82,0
+ intern L4027
+L4028: 3
+ byte(7)67,79,78,68,0
+ intern L4028
+L4029: 5
+ byte(7)69,86,67,79,78,68,0
+ intern L4029
+L4030: 2
+ byte(7)78,79,84,0
+ intern L4030
+L4031: 2
+ byte(7)65,66,83,0
+ intern L4031
+L4032: 4
+ byte(7)77,73,78,85,83,0
+ intern L4032
+L4033: 5
+ byte(7)68,73,86,73,68,69,0
+ intern L4033
+L4034: 4
+ byte(7)90,69,82,79,80,0
+ intern L4034
+L4035: 8
+ byte(7)82,69,77,65,73,78,68,69,82,0
+ intern L4035
+L4036: 4
+ byte(7)88,67,79,78,83,0
+ intern L4036
+L4037: 2
+ byte(7)77,65,88,0
+ intern L4037
+L4038: 11
+ byte(7)82,79,66,85,83,84,69,88,80,65,78,68,0
+ intern L4038
+L4039: 3
+ byte(7)77,65,88,50,0
+ intern L4039
+L4040: 4
+ byte(7)76,69,83,83,80,0
+ intern L4040
+L4041: 2
+ byte(7)77,73,78,0
+ intern L4041
+L4042: 3
+ byte(7)77,73,78,50,0
+ intern L4042
+L4043: 3
+ byte(7)80,76,85,83,0
+ intern L4043
+L4044: 4
+ byte(7)84,73,77,69,83,0
+ intern L4044
+L4045: 2
+ byte(7)77,65,80,0
+ intern L4045
+L4046: 8
+ byte(7)70,65,83,84,65,80,80,76,89,0
+ intern L4046
+L4047: 3
+ byte(7)77,65,80,67,0
+ intern L4047
+L4048: 5
+ byte(7)77,65,80,67,65,78,0
+ intern L4048
+L4049: 4
+ byte(7)78,67,79,78,67,0
+ intern L4049
+L4050: 5
+ byte(7)77,65,80,67,79,78,0
+ intern L4050
+L4051: 5
+ byte(7)77,65,80,67,65,82,0
+ intern L4051
+L4052: 6
+ byte(7)77,65,80,76,73,83,84,0
+ intern L4052
+L4053: 4
+ byte(7)65,83,83,79,67,0
+ intern L4053
+L4054: 5
+ byte(7)83,65,83,83,79,67,0
+ intern L4054
+L4055: 3
+ byte(7)80,65,73,82,0
+ intern L4055
+L4056: 5
+ byte(7)83,85,66,76,73,83,0
+ intern L4056
+L4057: 6
+ byte(7)68,69,70,76,73,83,84,0
+ intern L4057
+L4058: 2
+ byte(7)80,85,84,0
+ intern L4058
+L4059: 5
+ byte(7)68,69,76,69,84,69,0
+ intern L4059
+L4060: 5
+ byte(7)77,69,77,66,69,82,0
+ intern L4060
+L4061: 3
+ byte(7)77,69,77,81,0
+ intern L4061
+L4062: 6
+ byte(7)82,69,86,69,82,83,69,0
+ intern L4062
+L4063: 4
+ byte(7)83,85,66,83,84,0
+ intern L4063
+L4064: 5
+ byte(7)69,88,80,65,78,68,0
+ intern L4064
+L4065: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,0
+ intern L4065
+L4066: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,49,0
+ intern L4066
+L4067: 12
+ byte(7)67,72,65,78,78,69,76,84,69,82,80,82,73,0
+ intern L4067
+L4068: 4
+ byte(7)80,82,73,78,84,0
+ intern L4068
+L4069: 3
+ byte(7)79,85,84,42,0
+ intern L4069
+L4070: 2
+ byte(7)78,69,81,0
+ intern L4070
+L4071: 1
+ byte(7)78,69,0
+ intern L4071
+L4072: 2
+ byte(7)71,69,81,0
+ intern L4072
+L4073: 2
+ byte(7)76,69,81,0
+ intern L4073
+L4074: 4
+ byte(7)69,81,67,65,82,0
+ intern L4074
+L4075: 4
+ byte(7)69,88,80,82,80,0
+ intern L4075
+L4076: 3
+ byte(7)71,69,84,68,0
+ intern L4076
+L4077: 5
+ byte(7)77,65,67,82,79,80,0
+ intern L4077
+L4078: 5
+ byte(7)70,69,88,80,82,80,0
+ intern L4078
+L4079: 5
+ byte(7)78,69,88,80,82,80,0
+ intern L4079
+L4080: 4
+ byte(7)67,79,80,89,68,0
+ intern L4080
+L4081: 4
+ byte(7)82,69,67,73,80,0
+ intern L4081
+L4082: 4
+ byte(7)70,73,82,83,84,0
+ intern L4082
+L4083: 5
+ byte(7)83,69,67,79,78,68,0
+ intern L4083
+L4084: 4
+ byte(7)84,72,73,82,68,0
+ intern L4084
+L4085: 5
+ byte(7)70,79,85,82,84,72,0
+ intern L4085
+L4086: 3
+ byte(7)82,69,83,84,0
+ intern L4086
+L4087: 7
+ byte(7)82,69,86,69,82,83,73,80,0
+ intern L4087
+L4088: 6
+ byte(7)83,85,66,83,84,73,80,0
+ intern L4088
+L4089: 6
+ byte(7)68,69,76,69,84,73,80,0
+ intern L4089
+L4090: 3
+ byte(7)68,69,76,81,0
+ intern L4090
+L4091: 2
+ byte(7)68,69,76,0
+ intern L4091
+L4092: 5
+ byte(7)68,69,76,81,73,80,0
+ intern L4092
+L4093: 4
+ byte(7)65,84,83,79,67,0
+ intern L4093
+L4094: 2
+ byte(7)65,83,83,0
+ intern L4094
+L4095: 2
+ byte(7)77,69,77,0
+ intern L4095
+L4096: 5
+ byte(7)82,65,83,83,79,67,0
+ intern L4096
+L4097: 5
+ byte(7)68,69,76,65,83,67,0
+ intern L4097
+L4098: 7
+ byte(7)68,69,76,65,83,67,73,80,0
+ intern L4098
+L4099: 5
+ byte(7)68,69,76,65,84,81,0
+ intern L4099
+L4100: 7
+ byte(7)68,69,76,65,84,81,73,80,0
+ intern L4100
+L4101: 4
+ byte(7)83,85,66,76,65,0
+ intern L4101
+L4102: 5
+ byte(7)82,80,76,65,67,87,0
+ intern L4102
+L4103: 6
+ byte(7)76,65,83,84,67,65,82,0
+ intern L4103
+L4104: 7
+ byte(7)76,65,83,84,80,65,73,82,0
+ intern L4104
+L4105: 3
+ byte(7)67,79,80,89,0
+ intern L4105
+L4106: 2
+ byte(7)78,84,72,0
+ intern L4106
+L4107: 3
+ byte(7)83,85,66,49,0
+ intern L4107
+L4108: 3
+ byte(7)80,78,84,72,0
+ intern L4108
+L4109: 4
+ byte(7)65,67,79,78,67,0
+ intern L4109
+L4110: 4
+ byte(7)76,67,79,78,67,0
+ intern L4110
+L4111: 3
+ byte(7)77,65,80,50,0
+ intern L4111
+L4112: 4
+ byte(7)77,65,80,67,50,0
+ intern L4112
+L4113: 12
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,84,0
+ intern L4113
+L4114: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L4114
+L4115: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L4115
+L4116: 12
+ byte(7)67,72,65,78,78,69,76,83,80,65,67,69,83,0
+ intern L4116
+L4117: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,72,65,82,0
+ intern L4117
+L4118: 5
+ byte(7)83,80,65,67,69,83,0
+ intern L4118
+L4119: 9
+ byte(7)67,72,65,78,78,69,76,84,65,66,0
+ intern L4119
+L4120: 10
+ byte(7)67,72,65,78,78,69,76,80,79,83,78,0
+ intern L4120
+L4121: 2
+ byte(7)84,65,66,0
+ intern L4121
+L4122: 4
+ byte(7)70,73,76,69,80,0
+ intern L4122
+L4123: 3
+ byte(7)80,85,84,67,0
+ intern L4123
+L4124: 6
+ byte(7)83,80,65,67,69,83,50,0
+ intern L4124
+L4125: 13
+ byte(7)67,72,65,78,78,69,76,83,80,65,67,69,83,50,0
+ intern L4125
+L4126: 7
+ byte(7)76,73,83,84,50,83,69,84,0
+ intern L4126
+L4127: 8
+ byte(7)76,73,83,84,50,83,69,84,81,0
+ intern L4127
+L4128: 5
+ byte(7)65,68,74,79,73,78,0
+ intern L4128
+L4129: 6
+ byte(7)65,68,74,79,73,78,81,0
+ intern L4129
+L4130: 4
+ byte(7)85,78,73,79,78,0
+ intern L4130
+L4131: 5
+ byte(7)85,78,73,79,78,81,0
+ intern L4131
+L4132: 1
+ byte(7)88,78,0
+ intern L4132
+L4133: 2
+ byte(7)88,78,81,0
+ intern L4133
+L4134: 11
+ byte(7)73,78,84,69,82,83,69,67,84,73,79,78,0
+ intern L4134
+L4135: 12
+ byte(7)73,78,84,69,82,83,69,67,84,73,79,78,81,0
+ intern L4135
+L4136: 15
+ byte(7)75,78,79,87,78,45,70,82,69,69,45,83,80,65,67,69,0
+ intern L4136
+L4137: 5
+ byte(7)71,84,72,69,65,80,0
+ intern L4137
+L4138: 9
+ byte(7)70,65,84,65,76,69,82,82,79,82,0
+ intern L4138
+L4139: 7
+ byte(7)37,82,69,67,76,65,73,77,0
+ intern L4139
+L4140: 12
+ byte(7)71,67,45,84,82,65,80,45,76,69,86,69,76,0
+ intern L4140
+L4141: 16
+ byte(7)83,69,84,45,71,67,45,84,82,65,80,45,76,69,86,69,76,0
+ intern L4141
+L4142: 6
+ byte(7)68,69,76,72,69,65,80,0
+ intern L4142
+L4143: 9
+ byte(7)71,84,67,79,78,83,84,83,84,82,0
+ intern L4143
+L4144: 4
+ byte(7)71,84,66,80,83,0
+ intern L4144
+L4145: 6
+ byte(7)71,84,69,86,69,67,84,0
+ intern L4145
+L4146: 5
+ byte(7)71,84,70,76,84,78,0
+ intern L4146
+L4147: 3
+ byte(7)71,84,73,68,0
+ intern L4147
+L4148: 6
+ byte(7)82,69,67,76,65,73,77,0
+ intern L4148
+L4149: 5
+ byte(7)68,69,76,66,80,83,0
+ intern L4149
+L4150: 7
+ byte(7)71,84,87,65,82,82,65,89,0
+ intern L4150
+L4151: 8
+ byte(7)68,69,76,87,65,82,82,65,89,0
+ intern L4151
+L4152: 15
+ byte(7)67,79,80,89,83,84,82,73,78,71,84,79,70,82,79,77,0
+ intern L4152
+L4153: 9
+ byte(7)67,79,80,89,83,84,82,73,78,71,0
+ intern L4153
+L4154: 9
+ byte(7)67,79,80,89,87,65,82,82,65,89,0
+ intern L4154
+L4155: 15
+ byte(7)67,79,80,89,86,69,67,84,79,82,84,79,70,82,79,77,0
+ intern L4155
+L4156: 9
+ byte(7)67,79,80,89,86,69,67,84,79,82,0
+ intern L4156
+L4157: 13
+ byte(7)67,79,80,89,87,82,68,83,84,79,70,82,79,77,0
+ intern L4157
+L4158: 7
+ byte(7)67,79,80,89,87,82,68,83,0
+ intern L4158
+L4159: 8
+ byte(7)84,79,84,65,76,67,79,80,89,0
+ intern L4159
+L4160: 5
+ byte(7)77,75,86,69,67,84,0
+ intern L4160
+L4161: 8
+ byte(7)77,75,69,86,69,67,84,79,82,0
+ intern L4161
+L4162: 6
+ byte(7)77,75,69,86,69,67,84,0
+ intern L4162
+L4163: 7
+ byte(7)77,75,83,84,82,73,78,71,0
+ intern L4163
+L4164: 22
+ byte(7)78,79,78,80,79,83,73,84,73,86,69,73,78,84,69,71,69,82,69,82,82,79,82,0
+ intern L4164
+L4165: 9
+ byte(7)77,65,75,69,45,66,89,84,69,83,0
+ intern L4165
+L4166: 13
+ byte(7)77,65,75,69,45,72,65,76,70,87,79,82,68,83,0
+ intern L4166
+L4167: 9
+ byte(7)77,65,75,69,45,87,79,82,68,83,0
+ intern L4167
+L4168: 10
+ byte(7)77,65,75,69,45,86,69,67,84,79,82,0
+ intern L4168
+L4169: 5
+ byte(7)83,84,82,73,78,71,0
+ intern L4169
+L4170: 5
+ byte(7)86,69,67,84,79,82,0
+ intern L4170
+L4171: 4
+ byte(7)76,73,83,84,53,0
+ intern L4171
+L4172: 5
+ byte(7)71,67,75,78,84,42,0
+ intern L4172
+L4173: 6
+ byte(7)71,67,84,73,77,69,42,0
+ intern L4173
+L4174: 2
+ byte(7)42,71,67,0
+ intern L4174
+L4175: 14
+ byte(7)72,69,65,80,45,87,65,82,78,45,76,69,86,69,76,0
+ intern L4175
+L4176: 10
+ byte(7)69,82,82,79,82,80,82,73,78,84,70,0
+ intern L4176
+L4177: 3
+ byte(7)84,73,77,67,0
+ intern L4177
+L4178: 10
+ byte(7)85,78,77,65,80,45,83,80,65,67,69,0
+ intern L4178
+L4179: 8
+ byte(7)82,69,84,85,82,78,78,73,76,0
+ intern L4179
+L4180: 13
+ byte(7)82,69,84,85,82,78,70,73,82,83,84,65,82,71,0
+ intern L4180
+L4181: 3
+ byte(7)76,65,78,68,0
+ intern L4181
+L4182: 2
+ byte(7)76,79,82,0
+ intern L4182
+L4183: 3
+ byte(7)76,88,79,82,0
+ intern L4183
+L4184: 5
+ byte(7)76,83,72,73,70,84,0
+ intern L4184
+L4185: 2
+ byte(7)76,83,72,0
+ intern L4185
+L4186: 3
+ byte(7)76,78,79,84,0
+ intern L4186
+L4187: 2
+ byte(7)70,73,88,0
+ intern L4187
+L4188: 4
+ byte(7)70,76,79,65,84,0
+ intern L4188
+L4189: 3
+ byte(7)79,78,69,80,0
+ intern L4189
+L4190: 4
+ byte(7)68,69,66,85,71,0
+ intern L4190
+L4191: 1
+ byte(7)84,82,0
+ intern L4191
+L4192: 5
+ byte(7)69,86,76,79,65,68,0
+ intern L4192
+L4193: 3
+ byte(7)84,82,83,84,0
+ intern L4193
+L4194: 7
+ byte(7)81,69,68,73,84,70,78,83,0
+ intern L4194
+L4195: 6
+ byte(7)42,69,88,80,69,82,84,0
+ intern L4195
+L4196: 7
+ byte(7)42,86,69,82,66,79,83,69,0
+ intern L4196
+L4197: 4
+ byte(7)69,68,73,84,70,0
+ intern L4197
+L4198: 3
+ byte(7)69,68,73,84,0
+ intern L4198
+L4199: 3
+ byte(7)89,69,83,80,0
+ intern L4199
+L4200: 12
+ byte(7)80,82,79,77,80,84,83,84,82,73,78,71,42,0
+ intern L4200
+L4201: 7
+ byte(7)70,65,83,84,66,73,78,68,0
+ intern L4201
+L4202: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L4202
+L4203: 12
+ byte(7)69,68,73,84,79,82,82,69,65,68,69,82,42,0
+ intern L4203
+L4204: 13
+ byte(7)69,68,73,84,79,82,80,82,73,78,84,69,82,42,0
+ intern L4204
+L4205: 9
+ byte(7)70,65,83,84,85,78,66,73,78,68,0
+ intern L4205
+L4206: 3
+ byte(7)82,69,65,68,0
+ intern L4206
+L4207: 1
+ byte(7)67,76,0
+ intern L4207
+L4208: 3
+ byte(7)72,69,76,80,0
+ intern L4208
+L4209: 4
+ byte(7)66,82,69,65,75,0
+ intern L4209
+L4210: 4
+ byte(7)69,72,69,76,80,0
+ intern L4210
+L4211: 1
+ byte(7)80,76,0
+ intern L4211
+L4212: 1
+ byte(7)85,80,0
+ intern L4212
+L4213: 1
+ byte(7)79,75,0
+ intern L4213
+L4214: 14
+ byte(7)68,73,83,80,76,65,89,72,69,76,80,70,73,76,69,0
+ intern L4214
+L4215: 5
+ byte(7)69,68,73,84,79,82,0
+ intern L4215
+L4216: 18
+ byte(7)73,71,78,79,82,69,68,73,78,66,65,67,75,84,82,65,67,69,42,0
+ intern L4216
+L4217: 20
+ byte(7)73,78,84,69,82,80,82,69,84,69,82,70,85,78,67,84,73,79,78,83,42,0
+ intern L4217
+L4218: 14
+ byte(7)73,78,84,69,82,80,66,65,67,75,84,82,65,67,69,0
+ intern L4218
+L4219: 5
+ byte(7)80,82,73,78,84,70,0
+ intern L4219
+L4220: 8
+ byte(7)66,65,67,75,84,82,65,67,69,0
+ intern L4220
+L4221: 13
+ byte(7)82,69,84,85,82,78,65,68,68,82,69,83,83,80,0
+ intern L4221
+L4222: 6
+ byte(7)65,68,68,82,50,73,68,0
+ intern L4222
+L4223: 15
+ byte(7)86,69,82,66,79,83,69,66,65,67,75,84,82,65,67,69,0
+ intern L4223
+L4224: 7
+ byte(7)79,80,84,73,79,78,83,42,0
+ intern L4224
+L4225: 8
+ byte(7)87,82,73,84,69,67,72,65,82,0
+ intern L4225
+L4226: 22
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,85,78,75,78,79,87,78,73,84,69,77,0
+ intern L4226
+L4227: 21
+ byte(7)67,79,68,69,45,65,68,68,82,69,83,83,45,84,79,45,83,89,77,66,79,76,0
+ intern L4227
+L4228: 4
+ byte(7)80,82,73,78,49,0
+ intern L4228
+L4229: 3
+ byte(7)81,85,73,84,0
+ intern L4229
+L4230: 4
+ byte(7)69,82,82,79,82,0
+ intern L4230
+L4231: 1
+ byte(7)78,79,0
+ intern L4231
+L4232: 2
+ byte(7)89,69,83,0
+ intern L4232
+L4233: 2
+ byte(7)82,68,83,0
+ intern L4233
+L4234: 6
+ byte(7)69,82,82,79,85,84,42,0
+ intern L4234
+L4235: 2
+ byte(7)87,82,83,0
+ intern L4235
+L4236: 7
+ byte(7)69,82,82,79,82,83,69,84,0
+ intern L4236
+L4237: 6
+ byte(7)67,85,82,83,89,77,42,0
+ intern L4237
+L4238: 8
+ byte(7)42,83,69,77,73,67,79,76,42,0
+ intern L4238
+L4239: 9
+ byte(7)69,82,82,79,82,70,79,82,77,42,0
+ intern L4239
+L4240: 16
+ byte(7)42,67,79,78,84,73,78,85,65,66,76,69,69,82,82,79,82,0
+ intern L4240
+L4241: 4
+ byte(7)69,77,83,71,42,0
+ intern L4241
+L4242: 5
+ byte(7)42,66,82,69,65,75,0
+ intern L4242
+L4243: 5
+ byte(7)42,69,77,83,71,80,0
+ intern L4243
+L4244: 13
+ byte(7)77,65,88,66,82,69,65,75,76,69,86,69,76,42,0
+ intern L4244
+L4245: 10
+ byte(7)66,82,69,65,75,76,69,86,69,76,42,0
+ intern L4245
+L4246: 7
+ byte(7)70,76,65,84,83,73,90,69,0
+ intern L4246
+L4247: 13
+ byte(7)85,83,65,71,69,84,89,80,69,69,82,82,79,82,0
+ intern L4247
+L4248: 13
+ byte(7)78,79,78,78,85,77,66,69,82,69,82,82,79,82,0
+ intern L4248
+L4249: 7
+ byte(7)78,79,78,87,79,82,68,83,0
+ intern L4249
+L4250: 16
+ byte(7)78,79,78,73,79,67,72,65,78,78,69,76,69,82,82,79,82,0
+ intern L4250
+L4251: 9
+ byte(7)42,66,65,67,75,84,82,65,67,69,0
+ intern L4251
+L4252: 15
+ byte(7)42,73,78,78,69,82,42,66,65,67,75,84,82,65,67,69,0
+ intern L4252
+L4253: 4
+ byte(7)84,72,82,79,87,0
+ intern L4253
+L4254: 6
+ byte(7)36,69,82,82,79,82,36,0
+ intern L4254
+L4255: 5
+ byte(7)69,82,82,83,69,84,0
+ intern L4255
+L4256: 4
+ byte(7)67,65,84,67,72,0
+ intern L4256
+L4257: 9
+ byte(7)67,65,84,67,72,83,69,84,85,80,0
+ intern L4257
+L4258: 11
+ byte(7)84,72,82,79,87,83,73,71,78,65,76,42,0
+ intern L4258
+L4259: 7
+ byte(7)37,85,78,67,65,84,67,72,0
+ intern L4259
+L4260: 13
+ byte(7)67,72,65,78,78,69,76,78,79,84,79,80,69,78,0
+ intern L4260
+L4261: 11
+ byte(7)67,72,65,78,78,69,76,69,82,82,79,82,0
+ intern L4261
+L4262: 15
+ byte(7)87,82,73,84,69,79,78,76,89,67,72,65,78,78,69,76,0
+ intern L4262
+L4263: 14
+ byte(7)82,69,65,68,79,78,76,89,67,72,65,78,78,69,76,0
+ intern L4263
+L4264: 26
+ byte(7)73,76,76,69,71,65,76,83,84,65,78,68,65,82,68,67,72,65,78,78,69,76,67,76,79,83,69,0
+ intern L4264
+L4265: 6
+ byte(7)73,79,69,82,82,79,82,0
+ intern L4265
+L4266: 8
+ byte(7)67,79,68,69,65,80,80,76,89,0
+ intern L4266
+L4267: 12
+ byte(7)67,79,68,69,69,86,65,76,65,80,80,76,89,0
+ intern L4267
+L4268: 7
+ byte(7)66,73,78,68,69,86,65,76,0
+ intern L4268
+L4269: 5
+ byte(7)76,66,73,78,68,49,0
+ intern L4269
+L4270: 25
+ byte(7)67,79,77,80,73,76,69,68,67,65,76,76,73,78,71,73,78,84,69,82,80,82,69,84,69,68,0
+ intern L4270
+L4271: 13
+ byte(7)66,83,84,65,67,75,79,86,69,82,70,76,79,87,0
+ intern L4271
+L4272: 17
+ byte(7)82,69,83,84,79,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L4272
+L4273: 10
+ byte(7)42,76,65,77,66,68,65,76,73,78,75,0
+ intern L4273
+L4274: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L4274
+L4275: 6
+ byte(7)85,78,66,73,78,68,78,0
+ intern L4275
+L4276: 4
+ byte(7)65,80,80,76,89,0
+ intern L4276
+L4277: 8
+ byte(7)70,85,78,66,79,85,78,68,80,0
+ intern L4277
+L4278: 5
+ byte(7)70,67,79,68,69,80,0
+ intern L4278
+L4279: 14
+ byte(7)71,69,84,70,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L4279
+L4280: 2
+ byte(7)71,69,84,0
+ intern L4280
+L4281: 8
+ byte(7)86,65,76,85,69,67,69,76,76,0
+ intern L4281
+L4282: 8
+ byte(7)71,69,84,70,78,84,89,80,69,0
+ intern L4282
+L4283: 8
+ byte(7)38,38,86,65,76,85,69,38,38,0
+ intern L4283
+L4284: 8
+ byte(7)84,72,82,79,87,84,65,71,42,0
+ intern L4284
+L4285: 8
+ byte(7)67,65,84,67,72,45,65,76,76,0
+ intern L4285
+L4286: 9
+ byte(7)85,78,87,73,78,68,45,65,76,76,0
+ intern L4286
+L4287: 9
+ byte(7)38,38,84,72,82,79,87,78,38,38,0
+ intern L4287
+L4288: 15
+ byte(7)36,85,78,87,73,78,68,45,80,82,79,84,69,67,84,36,0
+ intern L4288
+L4289: 6
+ byte(7)38,38,84,65,71,38,38,0
+ intern L4289
+L4290: 5
+ byte(7)37,84,72,82,79,87,0
+ intern L4290
+L4291: 13
+ byte(7)85,78,87,73,78,68,45,80,82,79,84,69,67,84,0
+ intern L4291
+L4292: 5
+ byte(7)42,67,65,84,67,72,0
+ intern L4292
+L4293: 5
+ byte(7)42,84,72,82,79,87,0
+ intern L4293
+L4294: 4
+ byte(7)82,69,83,69,84,0
+ intern L4294
+L4295: 17
+ byte(7)67,65,80,84,85,82,69,69,78,86,73,82,79,78,77,69,78,84,0
+ intern L4295
+L4296: 17
+ byte(7)37,67,76,69,65,82,45,67,65,84,67,72,45,83,84,65,67,75,0
+ intern L4296
+L4297: 8
+ byte(7)80,82,79,71,66,79,68,89,42,0
+ intern L4297
+L4298: 13
+ byte(7)80,82,79,71,74,85,77,80,84,65,66,76,69,42,0
+ intern L4298
+L4299: 3
+ byte(7)80,82,79,71,0
+ intern L4299
+L4300: 5
+ byte(7)80,66,73,78,68,49,0
+ intern L4300
+L4301: 5
+ byte(7)36,80,82,79,71,36,0
+ intern L4301
+L4302: 1
+ byte(7)71,79,0
+ intern L4302
+L4303: 5
+ byte(7)82,69,84,85,82,78,0
+ intern L4303
+L4304: 11
+ byte(7)83,89,83,84,69,77,95,76,73,83,84,42,0
+ intern L4304
+L4305: 3
+ byte(7)68,65,84,69,0
+ intern L4305
+L4306: 7
+ byte(7)68,85,77,80,76,73,83,80,0
+ intern L4306
+L4307: 13
+ byte(7)66,73,78,65,82,89,79,80,69,78,82,69,65,68,0
+ intern L4307
+L4308: 8
+ byte(7)68,69,67,50,48,79,80,69,78,0
+ intern L4308
+L4309: 14
+ byte(7)66,73,78,65,82,89,79,80,69,78,87,82,73,84,69,0
+ intern L4309
+L4310: 16
+ byte(7)86,65,76,85,69,67,69,76,76,76,79,67,65,84,73,79,78,0
+ intern L4310
+L4311: 15
+ byte(7)42,87,82,73,84,73,78,71,70,65,83,76,70,73,76,69,0
+ intern L4311
+L4312: 16
+ byte(7)78,69,87,66,73,84,84,65,66,76,69,69,78,84,82,89,42,0
+ intern L4312
+L4313: 11
+ byte(7)70,73,78,68,73,68,78,85,77,66,69,82,0
+ intern L4313
+L4314: 16
+ byte(7)77,65,75,69,82,69,76,79,67,72,65,76,70,87,79,82,68,0
+ intern L4314
+L4315: 15
+ byte(7)69,88,84,82,65,82,69,71,76,79,67,65,84,73,79,78,0
+ intern L4315
+L4316: 19
+ byte(7)70,85,78,67,84,73,79,78,67,69,76,76,76,79,67,65,84,73,79,78,0
+ intern L4316
+L4317: 5
+ byte(7)70,65,83,76,73,78,0
+ intern L4317
+L4318: 5
+ byte(7)73,78,84,69,82,78,0
+ intern L4318
+L4319: 7
+ byte(7)80,85,84,69,78,84,82,89,0
+ intern L4319
+L4320: 15
+ byte(7)76,79,65,68,68,73,82,69,67,84,79,82,73,69,83,42,0
+ intern L4320
+L4321: 14
+ byte(7)76,79,65,68,69,88,84,69,78,83,73,79,78,83,42,0
+ intern L4321
+L4322: 11
+ byte(7)42,86,69,82,66,79,83,69,76,79,65,68,0
+ intern L4322
+L4323: 14
+ byte(7)42,80,82,73,78,84,76,79,65,68,78,65,77,69,83,0
+ intern L4323
+L4324: 3
+ byte(7)76,79,65,68,0
+ intern L4324
+L4325: 4
+ byte(7)76,79,65,68,49,0
+ intern L4325
+L4326: 5
+ byte(7)82,69,76,79,65,68,0
+ intern L4326
+L4327: 7
+ byte(7)69,86,82,69,76,79,65,68,0
+ intern L4327
+L4328: 8
+ byte(7)42,85,83,69,82,77,79,68,69,0
+ intern L4328
+L4329: 8
+ byte(7)42,82,69,68,69,70,77,83,71,0
+ intern L4329
+L4330: 10
+ byte(7)42,73,78,83,73,68,69,76,79,65,68,0
+ intern L4330
+L4331: 5
+ byte(7)42,76,79,87,69,82,0
+ intern L4331
+L4332: 12
+ byte(7)80,69,78,68,73,78,71,76,79,65,68,83,42,0
+ intern L4332
+L4333: 6
+ byte(7)73,77,80,79,82,84,83,0
+ intern L4333
+L4334: 1
+ byte(7)80,80,0
+ intern L4334
+L4335: 10
+ byte(7)80,82,69,84,84,89,80,82,73,78,84,0
+ intern L4335
+L4336: 8
+ byte(7)68,69,70,83,84,82,85,67,84,0
+ intern L4336
+L4337: 3
+ byte(7)83,84,69,80,0
+ intern L4337
+L4338: 3
+ byte(7)77,73,78,73,0
+ intern L4338
+L4339: 4
+ byte(7)69,77,79,68,69,0
+ intern L4339
+L4340: 5
+ byte(7)73,78,86,79,75,69,0
+ intern L4340
+L4341: 4
+ byte(7)82,67,82,69,70,0
+ intern L4341
+L4342: 5
+ byte(7)67,82,69,70,79,78,0
+ intern L4342
+L4343: 7
+ byte(7)67,79,77,80,73,76,69,82,0
+ intern L4343
+L4344: 4
+ byte(7)67,79,77,80,68,0
+ intern L4344
+L4345: 6
+ byte(7)70,65,83,76,79,85,84,0
+ intern L4345
+L4346: 2
+ byte(7)66,85,71,0
+ intern L4346
+L4347: 3
+ byte(7)69,88,69,67,0
+ intern L4347
+L4348: 1
+ byte(7)77,77,0
+ intern L4348
+L4349: 19
+ byte(7)84,69,82,77,73,78,65,76,73,78,80,85,84,72,65,78,68,76,69,82,0
+ intern L4349
+L4350: 15
+ byte(7)67,79,77,80,82,69,83,83,82,69,65,68,67,72,65,82,0
+ intern L4350
+L4351: 13
+ byte(7)68,69,67,50,48,87,82,73,84,69,67,72,65,82,0
+ intern L4351
+L4352: 16
+ byte(7)84,79,83,84,82,73,78,71,87,82,73,84,69,67,72,65,82,0
+ intern L4352
+L4353: 15
+ byte(7)69,88,80,76,79,68,69,87,82,73,84,69,67,72,65,82,0
+ intern L4353
+L4354: 16
+ byte(7)70,76,65,84,83,73,90,69,87,82,73,84,69,67,72,65,82,0
+ intern L4354
+L4355: 4
+ byte(7)36,69,79,76,36,0
+ intern L4355
+L4356: 14
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,67,72,65,82,0
+ intern L4356
+L4357: 7
+ byte(7)82,69,65,68,67,72,65,82,0
+ intern L4357
+L4358: 2
+ byte(7)73,78,42,0
+ intern L4358
+L4359: 16
+ byte(7)67,72,65,78,78,69,76,85,78,82,69,65,68,67,72,65,82,0
+ intern L4359
+L4360: 9
+ byte(7)85,78,82,69,65,68,67,72,65,82,0
+ intern L4360
+L4361: 3
+ byte(7)79,80,69,78,0
+ intern L4361
+L4362: 21
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,70,79,82,73,78,80,85,84,0
+ intern L4362
+L4363: 22
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,70,79,82,79,85,84,80,85,84,0
+ intern L4363
+L4364: 20
+ byte(7)83,89,83,84,69,77,79,80,69,78,70,73,76,69,83,80,69,67,73,65,76,0
+ intern L4364
+L4365: 19
+ byte(7)83,80,69,67,73,65,76,82,69,65,68,70,85,78,67,84,73,79,78,42,0
+ intern L4365
+L4366: 20
+ byte(7)83,80,69,67,73,65,76,87,82,73,84,69,70,85,78,67,84,73,79,78,42,0
+ intern L4366
+L4367: 20
+ byte(7)83,80,69,67,73,65,76,67,76,79,83,69,70,85,78,67,84,73,79,78,42,0
+ intern L4367
+L4368: 6
+ byte(7)83,80,69,67,73,65,76,0
+ intern L4368
+L4369: 5
+ byte(7)79,85,84,80,85,84,0
+ intern L4369
+L4370: 4
+ byte(7)73,78,80,85,84,0
+ intern L4370
+L4371: 4
+ byte(7)67,76,79,83,69,0
+ intern L4371
+L4372: 24
+ byte(7)83,89,83,84,69,77,77,65,82,75,65,83,67,76,79,83,69,68,67,72,65,78,78,69,76,0
+ intern L4372
+L4373: 16
+ byte(7)83,80,69,67,73,65,76,82,68,83,65,67,84,73,79,78,42,0
+ intern L4373
+L4374: 5
+ byte(7)83,84,68,73,78,42,0
+ intern L4374
+L4375: 16
+ byte(7)83,80,69,67,73,65,76,87,82,83,65,67,84,73,79,78,42,0
+ intern L4375
+L4376: 6
+ byte(7)83,84,68,79,85,84,42,0
+ intern L4376
+L4377: 11
+ byte(7)67,72,65,78,78,69,76,69,74,69,67,84,0
+ intern L4377
+L4378: 4
+ byte(7)69,74,69,67,84,0
+ intern L4378
+L4379: 16
+ byte(7)67,72,65,78,78,69,76,76,73,78,69,76,69,78,71,84,72,0
+ intern L4379
+L4380: 9
+ byte(7)76,73,78,69,76,69,78,71,84,72,0
+ intern L4380
+L4381: 3
+ byte(7)80,79,83,78,0
+ intern L4381
+L4382: 11
+ byte(7)67,72,65,78,78,69,76,76,80,79,83,78,0
+ intern L4382
+L4383: 4
+ byte(7)76,80,79,83,78,0
+ intern L4383
+L4384: 12
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,67,72,0
+ intern L4384
+L4385: 5
+ byte(7)42,82,65,73,83,69,0
+ intern L4385
+L4386: 5
+ byte(7)82,69,65,68,67,72,0
+ intern L4386
+L4387: 4
+ byte(7)80,82,73,78,67,0
+ intern L4387
+L4388: 11
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,67,0
+ intern L4388
+L4389: 25
+ byte(7)67,85,82,82,69,78,84,82,69,65,68,77,65,67,82,79,73,78,68,73,67,65,84,79,82,42,0
+ intern L4389
+L4390: 24
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,84,79,75,69,78,87,73,84,72,72,79,79,75,83,0
+ intern L4390
+L4391: 15
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,84,79,75,69,78,0
+ intern L4391
+L4392: 7
+ byte(7)84,79,75,84,89,80,69,42,0
+ intern L4392
+L4393: 16
+ byte(7)67,85,82,82,69,78,84,83,67,65,78,84,65,66,76,69,42,0
+ intern L4393
+L4394: 10
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,0
+ intern L4394
+L4395: 13
+ byte(7)76,73,83,80,83,67,65,78,84,65,66,76,69,42,0
+ intern L4395
+L4396: 12
+ byte(7)76,73,83,80,82,69,65,68,77,65,67,82,79,0
+ intern L4396
+L4397: 17
+ byte(7)77,65,75,69,73,78,80,85,84,65,86,65,73,76,65,66,76,69,0
+ intern L4397
+L4398: 19
+ byte(7)42,73,78,83,73,68,69,83,84,82,85,67,84,85,82,69,82,69,65,68,0
+ intern L4398
+L4399: 13
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,69,79,70,0
+ intern L4399
+L4400: 4
+ byte(7)36,69,79,70,36,0
+ intern L4400
+L4401: 26
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,81,85,79,84,69,68,69,88,80,82,69,83,83,73,79,78,0
+ intern L4401
+L4402: 26
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,76,73,83,84,79,82,68,79,84,84,69,68,80,65,73,82,0
+ intern L4402
+L4403: 20
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,82,73,71,72,84,80,65,82,69,78,0
+ intern L4403
+L4404: 16
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,86,69,67,84,79,82,0
+ intern L4404
+L4405: 11
+ byte(7)42,67,79,77,80,82,69,83,83,73,78,71,0
+ intern L4405
+L4406: 13
+ byte(7)42,69,79,76,73,78,83,84,82,73,78,71,79,75,0
+ intern L4406
+L4407: 4
+ byte(7)78,69,87,73,68,0
+ intern L4407
+L4408: 24
+ byte(7)77,65,75,69,83,84,82,73,78,71,73,78,84,79,76,73,83,80,73,78,84,69,71,69,82,0
+ intern L4408
+L4409: 12
+ byte(7)68,73,71,73,84,84,79,78,85,77,66,69,82,0
+ intern L4409
+L4410: 6
+ byte(7)80,65,67,75,65,71,69,0
+ intern L4410
+L4411: 14
+ byte(7)67,85,82,82,69,78,84,80,65,67,75,65,71,69,42,0
+ intern L4411
+L4412: 5
+ byte(7)71,76,79,66,65,76,0
+ intern L4412
+L4413: 4
+ byte(7)82,65,84,79,77,0
+ intern L4413
+L4414: 7
+ byte(7)82,69,65,68,76,73,78,69,0
+ intern L4414
+L4415: 14
+ byte(7)67,72,65,78,78,69,76,82,69,65,68,76,73,78,69,0
+ intern L4415
+L4416: 10
+ byte(7)79,85,84,80,85,84,66,65,83,69,42,0
+ intern L4416
+L4417: 12
+ byte(7)73,68,69,83,67,65,80,69,67,72,65,82,42,0
+ intern L4417
+L4418: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,84,82,73,78,71,0
+ intern L4418
+L4419: 10
+ byte(7)87,82,73,84,69,83,84,82,73,78,71,0
+ intern L4419
+L4420: 21
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,89,83,73,78,84,69,71,69,82,0
+ intern L4420
+L4421: 20
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,66,73,84,83,84,82,65,85,88,0
+ intern L4421
+L4422: 14
+ byte(7)87,82,73,84,69,83,89,83,73,78,84,69,71,69,82,0
+ intern L4422
+L4423: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,70,73,88,78,85,77,0
+ intern L4423
+L4424: 18
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,73,78,84,69,71,69,82,0
+ intern L4424
+L4425: 19
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,83,89,83,70,76,79,65,84,0
+ intern L4425
+L4426: 9
+ byte(7)87,82,73,84,69,70,76,79,65,84,0
+ intern L4426
+L4427: 16
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,70,76,79,65,84,0
+ intern L4427
+L4428: 17
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,83,84,82,73,78,71,0
+ intern L4428
+L4429: 13
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,73,68,0
+ intern L4429
+L4430: 18
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,85,78,66,79,85,78,68,0
+ intern L4430
+L4431: 13
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,73,68,0
+ intern L4431
+L4432: 18
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,85,78,66,79,85,78,68,0
+ intern L4432
+L4433: 22
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,67,79,68,69,80,79,73,78,84,69,82,0
+ intern L4433
+L4434: 21
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,66,76,65,78,75,79,82,69,79,76,0
+ intern L4434
+L4435: 15
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,80,65,73,82,0
+ intern L4435
+L4436: 8
+ byte(7)80,82,73,78,76,69,86,69,76,0
+ intern L4436
+L4437: 9
+ byte(7)80,82,73,78,76,69,78,71,84,72,0
+ intern L4437
+L4438: 20
+ byte(7)82,69,67,85,82,83,73,86,69,67,72,65,78,78,69,76,80,82,73,78,50,0
+ intern L4438
+L4439: 15
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,80,65,73,82,0
+ intern L4439
+L4440: 20
+ byte(7)82,69,67,85,82,83,73,86,69,67,72,65,78,78,69,76,80,82,73,78,49,0
+ intern L4440
+L4441: 17
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,86,69,67,84,79,82,0
+ intern L4441
+L4442: 17
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,86,69,67,84,79,82,0
+ intern L4442
+L4443: 18
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,69,86,69,67,84,79,82,0
+ intern L4443
+L4444: 25
+ byte(7)79,66,74,69,67,84,45,71,69,84,45,72,65,78,68,76,69,82,45,81,85,73,69,84,76,89,0
+ intern L4444
+L4445: 10
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,0
+ intern L4445
+L4446: 18
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,69,86,69,67,84,79,82,0
+ intern L4446
+L4447: 16
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,87,79,82,68,83,0
+ intern L4447
+L4448: 20
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,72,65,76,70,87,79,82,68,83,0
+ intern L4448
+L4449: 16
+ byte(7)67,72,65,78,78,69,76,87,82,73,84,69,66,89,84,69,83,0
+ intern L4449
+L4450: 4
+ byte(7)80,82,73,78,50,0
+ intern L4450
+L4451: 15
+ byte(7)70,79,82,77,65,84,70,79,82,80,82,73,78,84,70,42,0
+ intern L4451
+L4452: 5
+ byte(7)80,82,73,78,50,76,0
+ intern L4452
+L4453: 6
+ byte(7)69,82,82,80,82,73,78,0
+ intern L4453
+L4454: 12
+ byte(7)67,72,65,78,78,69,76,80,82,73,78,84,70,0
+ intern L4454
+L4455: 17
+ byte(7)69,88,80,76,79,68,69,69,78,68,80,79,73,78,84,69,82,42,0
+ intern L4455
+L4456: 6
+ byte(7)69,88,80,76,79,68,69,0
+ intern L4456
+L4457: 7
+ byte(7)69,88,80,76,79,68,69,50,0
+ intern L4457
+L4458: 8
+ byte(7)70,76,65,84,83,73,90,69,50,0
+ intern L4458
+L4459: 12
+ byte(7)67,79,77,80,82,69,83,83,69,82,82,79,82,0
+ intern L4459
+L4460: 12
+ byte(7)67,79,77,80,82,69,83,83,76,73,83,84,42,0
+ intern L4460
+L4461: 19
+ byte(7)67,76,69,65,82,67,79,77,80,82,69,83,83,67,72,65,78,78,69,76,0
+ intern L4461
+L4462: 7
+ byte(7)67,79,77,80,82,69,83,83,0
+ intern L4462
+L4463: 6
+ byte(7)73,77,80,76,79,68,69,0
+ intern L4463
+L4464: 9
+ byte(7)67,72,65,78,78,69,76,84,89,73,0
+ intern L4464
+L4465: 9
+ byte(7)67,72,65,78,78,69,76,84,89,79,0
+ intern L4465
+L4466: 2
+ byte(7)84,89,73,0
+ intern L4466
+L4467: 2
+ byte(7)84,89,79,0
+ intern L4467
+L4468: 13
+ byte(7)67,79,77,77,69,78,84,79,85,84,67,79,68,69,0
+ intern L4468
+L4469: 10
+ byte(7)67,79,77,80,73,76,69,84,73,77,69,0
+ intern L4469
+L4470: 8
+ byte(7)66,79,84,72,84,73,77,69,83,0
+ intern L4470
+L4471: 7
+ byte(7)76,79,65,68,84,73,77,69,0
+ intern L4471
+L4472: 10
+ byte(7)83,84,65,82,84,85,80,84,73,77,69,0
+ intern L4472
+L4473: 8
+ byte(7)67,79,78,84,69,82,82,79,82,0
+ intern L4473
+L4474: 8
+ byte(7)79,84,72,69,82,87,73,83,69,0
+ intern L4474
+L4475: 6
+ byte(7)68,69,70,65,85,76,84,0
+ intern L4475
+L4476: 3
+ byte(7)67,65,83,69,0
+ intern L4476
+L4477: 4
+ byte(7)82,65,78,71,69,0
+ intern L4477
+L4478: 3
+ byte(7)83,69,84,70,0
+ intern L4478
+L4479: 9
+ byte(7)69,88,80,65,78,68,83,69,84,70,0
+ intern L4479
+L4480: 10
+ byte(7)83,69,84,70,45,69,88,80,65,78,68,0
+ intern L4480
+L4481: 8
+ byte(7)65,83,83,73,71,78,45,79,80,0
+ intern L4481
+L4482: 5
+ byte(7)79,78,79,70,70,42,0
+ intern L4482
+L4483: 8
+ byte(7)77,75,70,76,65,71,86,65,82,0
+ intern L4483
+L4484: 5
+ byte(7)83,73,77,80,70,71,0
+ intern L4484
+L4485: 1
+ byte(7)79,78,0
+ intern L4485
+L4486: 2
+ byte(7)79,70,70,0
+ intern L4486
+L4487: 3
+ byte(7)35,65,82,71,0
+ intern L4487
+L4488: 1
+ byte(7)68,83,0
+ intern L4488
+L4489: 7
+ byte(7)68,69,70,67,79,78,83,84,0
+ intern L4489
+L4490: 9
+ byte(7)69,86,68,69,70,67,79,78,83,84,0
+ intern L4490
+L4491: 4
+ byte(7)67,79,78,83,84,0
+ intern L4491
+L4492: 11
+ byte(7)83,84,82,73,78,71,71,69,78,83,89,77,0
+ intern L4492
+L4493: 12
+ byte(7)83,84,82,73,78,71,71,69,78,83,89,77,42,0
+ intern L4493
+L4494: 6
+ byte(7)70,79,82,69,65,67,72,0
+ intern L4494
+L4495: 6
+ byte(7)67,79,76,76,69,67,84,0
+ intern L4495
+L4496: 3
+ byte(7)74,79,73,78,0
+ intern L4496
+L4497: 3
+ byte(7)67,79,78,67,0
+ intern L4497
+L4498: 1
+ byte(7)73,78,0
+ intern L4498
+L4499: 1
+ byte(7)68,79,0
+ intern L4499
+L4500: 3
+ byte(7)69,88,73,84,0
+ intern L4500
+L4501: 5
+ byte(7)36,76,79,79,80,36,0
+ intern L4501
+L4502: 3
+ byte(7)78,69,88,84,0
+ intern L4502
+L4503: 4
+ byte(7)87,72,73,76,69,0
+ intern L4503
+L4504: 5
+ byte(7)82,69,80,69,65,84,0
+ intern L4504
+L4505: 2
+ byte(7)70,79,82,0
+ intern L4505
+L4506: 5
+ byte(7)71,69,78,83,89,77,0
+ intern L4506
+L4507: 4
+ byte(7)77,75,42,83,81,0
+ intern L4507
+L4508: 3
+ byte(7)83,73,77,80,0
+ intern L4508
+L4509: 2
+ byte(7)66,73,78,0
+ intern L4509
+L4510: 11
+ byte(7)70,76,65,77,66,68,65,76,73,78,75,80,0
+ intern L4510
+L4511: 11
+ byte(7)77,65,75,69,70,85,78,66,79,85,78,68,0
+ intern L4511
+L4512: 14
+ byte(7)77,65,75,69,70,76,65,77,66,68,65,76,73,78,75,0
+ intern L4512
+L4513: 8
+ byte(7)77,65,75,69,70,67,79,68,69,0
+ intern L4513
+L4514: 3
+ byte(7)80,82,79,80,0
+ intern L4514
+L4515: 6
+ byte(7)83,69,84,80,82,79,80,0
+ intern L4515
+L4516: 4
+ byte(7)70,76,65,71,80,0
+ intern L4516
+L4517: 3
+ byte(7)84,89,80,69,0
+ intern L4517
+L4518: 3
+ byte(7)70,76,65,71,0
+ intern L4518
+L4519: 4
+ byte(7)70,76,65,71,49,0
+ intern L4519
+L4520: 6
+ byte(7)82,69,77,70,76,65,71,0
+ intern L4520
+L4521: 7
+ byte(7)82,69,77,70,76,65,71,49,0
+ intern L4521
+L4522: 6
+ byte(7)82,69,77,80,82,79,80,0
+ intern L4522
+L4523: 7
+ byte(7)82,69,77,80,82,79,80,76,0
+ intern L4523
+L4524: 7
+ byte(7)85,78,66,79,85,78,68,80,0
+ intern L4524
+L4525: 6
+ byte(7)86,65,82,84,89,80,69,0
+ intern L4525
+L4526: 4
+ byte(7)70,76,85,73,68,0
+ intern L4526
+L4527: 5
+ byte(7)70,76,85,73,68,49,0
+ intern L4527
+L4528: 5
+ byte(7)70,76,85,73,68,80,0
+ intern L4528
+L4529: 6
+ byte(7)71,76,79,66,65,76,49,0
+ intern L4529
+L4530: 6
+ byte(7)71,76,79,66,65,76,80,0
+ intern L4530
+L4531: 6
+ byte(7)85,78,70,76,85,73,68,0
+ intern L4531
+L4532: 7
+ byte(7)85,78,70,76,85,73,68,49,0
+ intern L4532
+L4533: 3
+ byte(7)82,69,77,68,0
+ intern L4533
+L4534: 4
+ byte(7)42,67,79,77,80,0
+ intern L4534
+L4535: 3
+ byte(7)85,83,69,82,0
+ intern L4535
+L4536: 3
+ byte(7)76,79,83,69,0
+ intern L4536
+L4537: 23
+ byte(7)67,79,68,69,45,78,85,77,66,69,82,45,79,70,45,65,82,71,85,77,69,78,84,83,0
+ intern L4537
+L4538: 14
+ byte(7)66,83,84,65,67,75,85,78,68,69,82,70,76,79,87,0
+ intern L4538
+L4539: 12
+ byte(7)67,76,69,65,82,66,73,78,68,73,78,71,83,0
+ intern L4539
+L4540: 10
+ byte(7)77,65,75,69,85,78,66,79,85,78,68,0
+ intern L4540
+L4541: 11
+ byte(7)72,65,83,72,70,85,78,67,84,73,79,78,0
+ intern L4541
+L4542: 4
+ byte(7)82,69,77,79,66,0
+ intern L4542
+L4543: 6
+ byte(7)73,78,84,69,82,78,80,0
+ intern L4543
+L4544: 11
+ byte(7)73,78,84,69,82,78,71,69,78,83,89,77,0
+ intern L4544
+L4545: 5
+ byte(7)77,65,80,79,66,76,0
+ intern L4545
+L4546: 11
+ byte(7)71,76,79,66,65,76,76,79,79,75,85,80,0
+ intern L4546
+L4547: 12
+ byte(7)71,76,79,66,65,76,73,78,83,84,65,76,76,0
+ intern L4547
+L4548: 11
+ byte(7)71,76,79,66,65,76,82,69,77,79,86,69,0
+ intern L4548
+L4549: 9
+ byte(7)73,78,73,84,79,66,76,73,83,84,0
+ intern L4549
+L4550: 12
+ byte(7)68,69,67,50,48,82,69,65,68,67,72,65,82,0
+ intern L4550
+L4551: 4
+ byte(7)42,69,67,72,79,0
+ intern L4551
+L4552: 6
+ byte(7)67,76,69,65,82,73,79,0
+ intern L4552
+L4553: 16
+ byte(7)68,69,67,50,48,67,76,79,83,69,67,72,65,78,78,69,76,0
+ intern L4553
+L4554: 4
+ byte(7)42,68,69,70,78,0
+ intern L4554
+L4555: 10
+ byte(7)66,82,69,65,75,86,65,76,85,69,42,0
+ intern L4555
+L4556: 9
+ byte(7)42,81,85,73,84,66,82,69,65,75,0
+ intern L4556
+L4557: 7
+ byte(7)66,82,69,65,75,73,78,42,0
+ intern L4557
+L4558: 8
+ byte(7)66,82,69,65,75,79,85,84,42,0
+ intern L4558
+L4559: 11
+ byte(7)84,79,80,76,79,79,80,78,65,77,69,42,0
+ intern L4559
+L4560: 11
+ byte(7)84,79,80,76,79,79,80,69,86,65,76,42,0
+ intern L4560
+L4561: 9
+ byte(7)66,82,69,65,75,69,86,65,76,42,0
+ intern L4561
+L4562: 9
+ byte(7)66,82,69,65,75,78,65,77,69,42,0
+ intern L4562
+L4563: 12
+ byte(7)84,79,80,76,79,79,80,80,82,73,78,84,42,0
+ intern L4563
+L4564: 11
+ byte(7)84,79,80,76,79,79,80,82,69,65,68,42,0
+ intern L4564
+L4565: 6
+ byte(7)84,79,80,76,79,79,80,0
+ intern L4565
+L4566: 6
+ byte(7)36,66,82,69,65,75,36,0
+ intern L4566
+L4567: 8
+ byte(7)66,82,69,65,75,69,86,65,76,0
+ intern L4567
+L4568: 12
+ byte(7)66,82,69,65,75,70,85,78,67,84,73,79,78,0
+ intern L4568
+L4569: 8
+ byte(7)66,82,69,65,75,81,85,73,84,0
+ intern L4569
+L4570: 12
+ byte(7)66,82,69,65,75,67,79,78,84,73,78,85,69,0
+ intern L4570
+L4571: 9
+ byte(7)66,82,69,65,75,82,69,84,82,89,0
+ intern L4571
+L4572: 8
+ byte(7)72,69,76,80,66,82,69,65,75,0
+ intern L4572
+L4573: 10
+ byte(7)66,82,69,65,75,69,82,82,77,83,71,0
+ intern L4573
+L4574: 8
+ byte(7)66,82,69,65,75,69,68,73,84,0
+ intern L4574
+L4575: 12
+ byte(7)84,79,80,76,79,79,80,76,69,86,69,76,42,0
+ intern L4575
+L4576: 12
+ byte(7)72,73,83,84,79,82,89,67,79,85,78,84,42,0
+ intern L4576
+L4577: 10
+ byte(7)76,73,83,80,66,65,78,78,69,82,42,0
+ intern L4577
+L4578: 6
+ byte(7)42,79,85,84,80,85,84,0
+ intern L4578
+L4579: 5
+ byte(7)83,69,77,73,67,42,0
+ intern L4579
+L4580: 11
+ byte(7)72,73,83,84,79,82,89,76,73,83,84,42,0
+ intern L4580
+L4581: 4
+ byte(7)42,84,73,77,69,0
+ intern L4581
+L4582: 3
+ byte(7)84,73,77,69,0
+ intern L4582
+L4583: 5
+ byte(7)42,78,79,78,73,76,0
+ intern L4583
+L4584: 12
+ byte(7)36,69,88,73,84,84,79,80,76,79,79,80,36,0
+ intern L4584
+L4585: 7
+ byte(7)68,70,80,82,73,78,84,42,0
+ intern L4585
+L4586: 5
+ byte(7)73,71,78,79,82,69,0
+ intern L4586
+L4587: 2
+ byte(7)73,78,80,0
+ intern L4587
+L4588: 3
+ byte(7)82,69,68,79,0
+ intern L4588
+L4589: 2
+ byte(7)65,78,83,0
+ intern L4589
+L4590: 3
+ byte(7)72,73,83,84,0
+ intern L4590
+L4591: 4
+ byte(7)67,76,69,65,82,0
+ intern L4591
+L4592: 11
+ byte(7)83,84,65,78,68,65,82,68,76,73,83,80,0
+ intern L4592
+L4593: 17
+ byte(7)80,82,73,78,84,87,73,84,72,70,82,69,83,72,76,73,78,69,0
+ intern L4593
+L4594: 9
+ byte(7)83,65,86,69,83,89,83,84,69,77,0
+ intern L4594
+L4595: 9
+ byte(7)73,78,73,84,70,79,82,77,83,42,0
+ intern L4595
+L4596: 12
+ byte(7)69,86,65,76,73,78,73,84,70,79,82,77,83,0
+ intern L4596
+L4597: 4
+ byte(7)68,83,75,73,78,0
+ intern L4597
+L4598: 8
+ byte(7)68,83,75,73,78,69,86,65,76,0
+ intern L4598
+L4599: 4
+ byte(7)76,65,80,73,78,0
+ intern L4599
+L4600: 4
+ byte(7)77,65,73,78,46,0
+ intern L4600
+L4601: 7
+ byte(7)80,82,69,45,77,65,73,78,0
+ intern L4601
+L4602: 3
+ byte(7)77,65,73,78,0
+ intern L4602
+L4603: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L4603
+L4604: 2
+ byte(7)69,79,70,0
+ intern L4604
+L4605: 8
+ byte(7)67,72,65,82,67,79,78,83,84,0
+ intern L4605
+L4606: 4
+ byte(7)68,69,67,50,48,0
+ intern L4606
+L4607: 4
+ byte(7)80,68,80,49,48,0
+ intern L4607
+L4608: 5
+ byte(7)84,79,80,83,50,48,0
+ intern L4608
+L4609: 3
+ byte(7)75,76,49,48,0
+ intern L4609
+L4610: 12
+ byte(7)76,73,83,80,68,73,80,72,84,72,79,78,71,0
+ intern L4610
+ extern SYMFNC
+ extern L0001
+ end MAIN.
ADDED psl-1983/3-1/kernel/20/main.rel
Index: psl-1983/3-1/kernel/20/main.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/main.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/mini-trace.red
Index: psl-1983/3-1/kernel/20/mini-trace.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/mini-trace.red
@@ -0,0 +1,2 @@
+PathIn "autoload-trace.red"$
+END;
ADDED psl-1983/3-1/kernel/20/nil.mac
Index: psl-1983/3-1/kernel/20/nil.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/nil.mac
@@ -0,0 +1,5 @@
+ radix 10
+ loc 128
+ <30_30>+128
+ <30_30>+128
+ end
ADDED psl-1983/3-1/kernel/20/nil.rel
Index: psl-1983/3-1/kernel/20/nil.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/nil.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/prop.ctl
Index: psl-1983/3-1/kernel/20/prop.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/prop.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "prop";
+PathIn "prop.build";
+ASMEnd;
+quit;
+compile prop.mac, dprop.mac
ADDED psl-1983/3-1/kernel/20/prop.init
Index: psl-1983/3-1/kernel/20/prop.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/prop.init
@@ -0,0 +1,2 @@
+(FLUID (QUOTE (!*REDEFMSG !*USERMODE)))
+(FLUID (QUOTE (!*COMP PROMPTSTRING!*)))
ADDED psl-1983/3-1/kernel/20/prop.log
Index: psl-1983/3-1/kernel/20/prop.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/prop.log
@@ -0,0 +1,64 @@
+
+ 8-Jun-83 9:47:15
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job PROP Req #485 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:10:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 1742
+
+ Input from => PS:<PSL.KERNEL.20.EXT>PROP.CTL.3
+ Output to => PS:<PSL.KERNEL.20.EXT>PROP.LOG
+
+
+
+ 9:47:16 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+ 9:47:16 MONTR @SET TIME-LIMIT 600
+ 9:47:16 MONTR @LOGIN KESSLER SMALL
+ 9:47:19 MONTR Job 12 on TTY224 8-Jun-83 09:47:19
+ 9:47:19 MONTR Previous login at 8-Jun-83 09:44:40
+ 9:47:20 MONTR There is 1 other job logged in as user KESSLER
+ 9:47:27 MONTR @
+ 9:47:27 MONTR [PS Mounted]
+ 9:47:27 MONTR
+ 9:47:27 MONTR [CONNECTED TO PS:<PSL.KERNEL.20.EXT>]
+ ;Modifications to this file may disappear, as this file is generated
+ ;automatically using information in P20:20-KERNEL-GEN.SL.
+ 9:47:27 MONTR def dsk: dsk:,p20e:,pk:,p20:
+ 9:47:28 MONTR @S:EX-DEC20-CROSS.EXE
+ 9:47:30 USER [45] ASMOut "prop";
+ 9:47:31 USER ASMOUT: IN files; or type in expressions
+ 9:47:31 USER When all done execute ASMEND;
+ 9:47:34 USER [46] PathIn "prop.build";
+ 9:47:34 USER %
+ 9:47:34 USER % PROP.BUILD - Files with functions for property lists and function definition
+ 9:47:34 USER %
+ 9:47:34 USER % Author: Eric Benson
+ 9:47:34 USER % Symbolic Computation Group
+ 9:47:34 USER % Computer Science Dept.
+ 9:47:34 USER % University of Utah
+ 9:47:34 USER % Date: 19 May 1982
+ 9:47:34 USER % Copyright (c) 1982 University of Utah
+ 9:47:35 USER %
+ 9:47:35 USER
+ 9:47:35 USER PathIn "function-primitives.red"$ % used by PutD, GetD and Eval
+ 9:47:41 USER PathIn "property-list.red"$ % PUT and FLAG and friends
+ 9:47:51 USER PathIn "fluid-global.red"$ % variable declarations
+ 9:47:54 USER PathIn "putd-getd.red"$ % function defining functions
+ 9:48:05 USER [47] ASMEnd;
+ 9:48:06 USER *** Garbage collection starting
+ 9:48:11 USER *** GC 19: time 2795 ms, 118806 recovered, 230743 free
+ 9:48:21 USER 0
+ 9:48:21 USER [48] quit;
+ 9:48:21 MONTR @compile prop.mac, dprop.mac
+ 9:48:24 USER MACRO: .MAIN
+ 9:48:31 USER MACRO: .MAIN
+ 9:48:32 USER
+ 9:48:32 USER EXIT
+ 9:48:32 MONTR @
+ 9:48:33 MONTR Killed by OPERATOR, TTY 221
+ 9:48:33 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 224,
+ 9:48:33 MONTR at 8-Jun-83 09:48:33, Used 0:00:37 in 0:01:13
ADDED psl-1983/3-1/kernel/20/prop.mac
Index: psl-1983/3-1/kernel/20/prop.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/prop.mac
@@ -0,0 +1,1001 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern UNDEFN
+ extern LAMLNK
+ 1
+; (!*ENTRY FUNBOUNDP EXPR 1)
+L3144: intern L3144
+ LDB 11,L3142
+ CAIE 11,30
+ JRST L3145
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 3,SYMFNC(2)
+ MOVE 1,SYMVAL+84
+ CAMN 3,UNDEFN
+ JRST L3146
+ MOVE 1,0
+ POPJ 15,0
+L3145: MOVE 2,L3143
+ JRST SYMFNC+130
+L3146: POPJ 15,0
+L3142: point 6,1,5
+L3143: <30_30>+519
+ 1
+; (!*ENTRY FLAMBDALINKP EXPR 1)
+L3149: intern L3149
+ LDB 11,L3147
+ CAIE 11,30
+ JRST L3150
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 3,SYMFNC(2)
+ MOVE 1,SYMVAL+84
+ CAMN 3,LAMLNK
+ JRST L3151
+ MOVE 1,0
+ POPJ 15,0
+L3150: MOVE 2,L3148
+ JRST SYMFNC+130
+L3151: POPJ 15,0
+L3147: point 6,1,5
+L3148: <30_30>+752
+ 1
+; (!*ENTRY FCODEP EXPR 1)
+FCODEP: intern FCODEP
+ LDB 11,L3152
+ CAIE 11,30
+ JRST L3154
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 3,SYMFNC(2)
+ MOVE 1,SYMVAL+84
+ CAME 3,UNDEFN
+ JRST L3155
+ MOVE 1,0
+L3155: CAMN 1,0
+ JRST L3156
+ MOVE 1,SYMFNC(2)
+ CAME 1,LAMLNK
+ JRST L3157
+ MOVE 1,0
+ POPJ 15,0
+L3157: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L3154: MOVE 2,L3153
+ JRST SYMFNC+130
+L3156: POPJ 15,0
+L3152: point 6,1,5
+L3153: <30_30>+520
+ 1
+; (!*ENTRY MAKEFUNBOUND EXPR 1)
+L3160: intern L3160
+ LDB 11,L3158
+ CAIE 11,30
+ JRST L3161
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 6,UNDEFN
+ MOVEM 6,SYMFNC(3)
+ MOVE 1,0
+ POPJ 15,0
+L3161: MOVE 2,L3159
+ JRST SYMFNC+130
+L3158: point 6,1,5
+L3159: <30_30>+753
+ 1
+; (!*ENTRY MAKEFLAMBDALINK EXPR 1)
+L3164: intern L3164
+ LDB 11,L3162
+ CAIE 11,30
+ JRST L3165
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 6,LAMLNK
+ MOVEM 6,SYMFNC(3)
+ MOVE 1,0
+ POPJ 15,0
+L3165: MOVE 2,L3163
+ JRST SYMFNC+130
+L3162: point 6,1,5
+L3163: <30_30>+754
+ 2
+; (!*ENTRY MAKEFCODE EXPR 2)
+L3169: intern L3169
+ LDB 11,L3166
+ CAIE 11,30
+ JRST L3170
+ LDB 11,L3167
+ CAIE 11,15
+ JRST L3171
+ MOVE 4,1
+ TLZ 4,258048
+ HRRZ 3,2
+ ADD 3,[23085449216]
+ MOVEM 3,SYMFNC(4)
+ JRST L3170
+L3171: MOVE 2,L3168
+ JRST SYMFNC+130
+L3170: MOVE 1,0
+ POPJ 15,0
+L3166: point 6,1,5
+L3167: point 6,2,5
+L3168: <30_30>+755
+ 1
+; (!*ENTRY GETFCODEPOINTER EXPR 1)
+L3174: intern L3174
+ LDB 11,L3172
+ CAIE 11,30
+ JRST L3175
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 1,SYMFNC(2)
+ TLZ 1,262080
+ TLZ 1,258048
+ TLO 1,61440
+ POPJ 15,0
+L3175: MOVE 2,L3173
+ JRST SYMFNC+130
+L3172: point 6,1,5
+L3173: <30_30>+521
+ 1
+; (!*ENTRY PROP EXPR 1)
+PROP: intern PROP
+ LDB 11,L3176
+ CAIE 11,30
+ JRST L3178
+ TLZ 1,258048
+ MOVE 1,SYMPRP(1)
+ POPJ 15,0
+L3178: MOVE 2,L3177
+ JRST SYMFNC+130
+L3176: point 6,1,5
+L3177: <30_30>+756
+ 2
+; (!*ENTRY SETPROP EXPR 2)
+L3181: intern L3181
+ LDB 11,L3179
+ CAIE 11,30
+ JRST L3182
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 1,2
+ MOVEM 1,SYMPRP(3)
+ POPJ 15,0
+L3182: MOVE 2,L3180
+ JRST SYMFNC+130
+L3179: point 6,1,5
+L3180: <30_30>+757
+ 2
+; (!*ENTRY FLAGP EXPR 2)
+FLAGP: intern FLAGP
+ ADJSP 15,3
+ MOVEM 1,-2(15)
+ MOVEM 2,-1(15)
+ LDB 11,L3183
+ CAIE 11,30
+ JRST L3185
+ LDB 11,L3184
+ CAIN 11,30
+ JRST L3186
+L3185: MOVE 1,0
+ JRST L3187
+L3186: MOVEM 0,0(15)
+ MOVE 5,0
+ MOVE 4,1
+ TLZ 4,258048
+ MOVE 6,SYMPRP(4)
+ MOVEM 6,0(15)
+ CAME 0,0(15)
+ JRST L3188
+ MOVE 1,0
+ JRST L3187
+L3188: MOVE 7,0(15)
+ CAME 2,0(7)
+ JRST L3189
+ MOVE 1,SYMVAL+84
+ JRST L3187
+L3189: MOVE 5,0(15)
+ MOVE 3,0(15)
+ MOVE 3,1(3)
+ MOVEM 3,0(15)
+L3190: CAME 0,0(15)
+ JRST L3191
+ MOVE 1,0
+ JRST L3187
+L3191: MOVE 7,0(15)
+ MOVE 6,-1(15)
+ CAME 6,0(7)
+ JRST L3192
+ MOVE 7,0(15)
+ MOVE 6,0(5)
+ MOVEM 6,0(7)
+ MOVE 6,-1(15)
+ MOVEM 6,0(5)
+ MOVE 1,SYMVAL+84
+ JRST L3187
+L3192: MOVE 5,0(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L3190
+L3187: ADJSP 15,-3
+ POPJ 15,0
+L3183: point 6,1,5
+L3184: point 6,2,5
+ 1
+; (!*ENTRY GETFNTYPE EXPR 1)
+L3194: intern L3194
+ MOVE 2,L3193
+ JRST GET
+L3193: <30_30>+759
+ 2
+; (!*ENTRY GET EXPR 2)
+GET: intern GET
+ ADJSP 15,5
+ MOVEM 1,-4(15)
+ MOVEM 2,-3(15)
+ LDB 11,L3195
+ CAIE 11,30
+ JRST L3198
+ LDB 11,L3196
+ CAIN 11,30
+ JRST L3199
+L3198: MOVE 1,0
+ JRST L3200
+L3199: MOVEM 0,-2(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,0(15)
+ MOVE 4,1
+ TLZ 4,258048
+ MOVE 6,SYMPRP(4)
+ MOVEM 6,-2(15)
+ CAME 0,-2(15)
+ JRST L3201
+ MOVE 1,0
+ JRST L3200
+L3201: MOVE 3,-2(15)
+ MOVE 3,0(3)
+ MOVEM 3,-1(15)
+ LDB 11,L3197
+ CAIE 11,9
+ JRST L3202
+ CAME 2,0(3)
+ JRST L3202
+ MOVE 1,1(3)
+ JRST L3200
+L3202: MOVE 6,-2(15)
+ MOVEM 6,0(15)
+ MOVE 5,-2(15)
+ MOVE 5,1(5)
+ MOVEM 5,-2(15)
+L3203: CAME 0,-2(15)
+ JRST L3204
+ MOVE 1,0
+ JRST L3200
+L3204: MOVE 1,-2(15)
+ MOVE 1,0(1)
+ MOVEM 1,-1(15)
+ LDB 11,L3195
+ CAIE 11,9
+ JRST L3205
+ MOVE 6,-3(15)
+ CAME 6,0(1)
+ JRST L3205
+ MOVE 7,-2(15)
+ MOVE 6,0(15)
+ MOVE 6,0(6)
+ MOVEM 6,0(7)
+ MOVE 7,0(15)
+ MOVEM 1,0(7)
+ MOVE 1,1(1)
+ JRST L3200
+L3205: MOVE 6,-2(15)
+ MOVEM 6,0(15)
+ MOVE 2,-2(15)
+ MOVE 2,1(2)
+ MOVEM 2,-2(15)
+ JRST L3203
+L3200: ADJSP 15,-5
+ POPJ 15,0
+L3195: point 6,1,5
+L3196: point 6,2,5
+L3197: point 6,3,5
+ 2
+; (!*ENTRY FLAG EXPR 2)
+FLAG: intern FLAG
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L3206
+ CAIN 11,30
+ JRST L3209
+ MOVE 2,L3207
+ MOVE 1,-1(15)
+ ADJSP 15,-4
+ JRST SYMFNC+130
+L3209: MOVEM 0,-2(15)
+ MOVEM 1,-2(15)
+L3210: LDB 11,L3208
+ CAIN 11,9
+ JRST L3211
+ MOVE 1,0
+ JRST L3212
+L3211: MOVE 1,-2(15)
+ MOVE 1,0(1)
+ MOVEM 1,-3(15)
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+761
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ JRST L3210
+L3212: ADJSP 15,-4
+ POPJ 15,0
+L3206: point 6,2,5
+L3208: point 6,-2(15),5
+L3207: <30_30>+760
+ 2
+; (!*ENTRY FLAG1 EXPR 2)
+FLAG1: intern FLAG1
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L3213
+ CAIN 11,30
+ JRST L3215
+ MOVE 2,L3214
+ ADJSP 15,-3
+ JRST SYMFNC+130
+L3215: MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+756
+ MOVEM 1,-2(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L3216
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+757
+L3216: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L3213: point 6,1,5
+L3214: <30_30>+760
+ 2
+; (!*ENTRY REMFLAG EXPR 2)
+L3220: intern L3220
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L3217
+ CAIN 11,30
+ JRST L3221
+ MOVE 2,L3218
+ MOVE 1,-1(15)
+ ADJSP 15,-4
+ JRST SYMFNC+130
+L3221: MOVEM 0,-2(15)
+ MOVEM 1,-2(15)
+L3222: LDB 11,L3219
+ CAIN 11,9
+ JRST L3223
+ MOVE 1,0
+ JRST L3224
+L3223: MOVE 1,-2(15)
+ MOVE 1,0(1)
+ MOVEM 1,-3(15)
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+763
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ JRST L3222
+L3224: ADJSP 15,-4
+ POPJ 15,0
+L3217: point 6,2,5
+L3219: point 6,-2(15),5
+L3218: <30_30>+762
+ 2
+; (!*ENTRY REMFLAG1 EXPR 2)
+L3227: intern L3227
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L3225
+ CAIN 11,30
+ JRST L3228
+ MOVE 2,L3226
+ ADJSP 15,-2
+ JRST SYMFNC+130
+L3228: PUSHJ 15,SYMFNC+756
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+334
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+757
+L3225: point 6,1,5
+L3226: <30_30>+762
+ 3
+; (!*ENTRY PUT EXPR 3)
+PUT: intern PUT
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L3229
+ CAIN 11,30
+ JRST L3232
+ MOVE 2,L3230
+ ADJSP 15,-5
+ JRST SYMFNC+130
+L3232: LDB 11,L3231
+ CAIN 11,30
+ JRST L3233
+ MOVE 2,L3230
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST SYMFNC+130
+L3233: MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ PUSHJ 15,SYMFNC+756
+ MOVEM 1,-3(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+335
+ MOVE 2,1
+ MOVEM 2,-4(15)
+ CAME 2,0
+ JRST L3234
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,-3(15)
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+757
+ JRST L3235
+L3234: MOVE 6,-2(15)
+ MOVEM 6,1(2)
+L3235: MOVE 1,-2(15)
+ ADJSP 15,-5
+ POPJ 15,0
+L3229: point 6,1,5
+L3231: point 6,2,5
+L3230: <30_30>+300
+ 2
+; (!*ENTRY REMPROP EXPR 2)
+L3238: intern L3238
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L3236
+ CAIE 11,30
+ JRST L3239
+ LDB 11,L3237
+ CAIN 11,30
+ JRST L3240
+L3239: MOVE 1,0
+ JRST L3241
+L3240: MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+522
+ MOVE 3,1
+ MOVEM 3,-2(15)
+ CAMN 3,0
+ JRST L3242
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+756
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+342
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+757
+L3242: MOVE 1,-2(15)
+L3241: ADJSP 15,-3
+ POPJ 15,0
+L3236: point 6,1,5
+L3237: point 6,2,5
+ 2
+; (!*ENTRY REMPROPL EXPR 2)
+L3244: intern L3244
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 1,-2(15)
+L3245: LDB 11,L3243
+ CAIN 11,9
+ JRST L3246
+ MOVE 1,0
+ JRST L3247
+L3246: MOVE 1,-2(15)
+ MOVE 1,0(1)
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+764
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ JRST L3245
+L3247: ADJSP 15,-3
+ POPJ 15,0
+L3243: point 6,-2(15),5
+; (!*ENTRY DECLAREFLUIDORGLOBAL EXPR 2)
+L3249: intern L3249
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 1,-2(15)
+L3250: LDB 11,L3248
+ CAIN 11,9
+ JRST L3251
+ MOVE 1,0
+ JRST L3252
+L3251: MOVE 1,-2(15)
+ MOVE 1,0(1)
+ MOVE 2,-1(15)
+ PUSHJ 15,L3253
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ JRST L3250
+L3252: ADJSP 15,-3
+ POPJ 15,0
+L3248: point 6,-2(15),5
+L3257: 25
+ byte(7)42,42,42,32,37,112,32,37,114,32,99,97,110,110,111,116,32,98,101,99,111,109,101,32,37,112,0
+; (!*ENTRY DECLAREFLUIDORGLOBAL1 EXPR 2)
+L3253: intern L3253
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L3254
+ CAIN 11,30
+ JRST L3258
+ MOVE 1,0
+ JRST L3259
+L3258: MOVEM 0,-2(15)
+ MOVE 2,L3255
+ PUSHJ 15,SYMFNC+522
+ MOVEM 1,-2(15)
+ CAME 1,0
+ JRST L3260
+ MOVE 3,-1(15)
+ MOVE 2,L3255
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+300
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+766
+ CAMN 1,0
+ JRST L3261
+ MOVE 2,0
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+262
+L3261: MOVE 1,0
+ JRST L3259
+L3260: CAME 1,-1(15)
+ JRST L3262
+ MOVE 1,0
+ JRST L3259
+L3262: MOVE 4,-1(15)
+ MOVE 3,0(15)
+ MOVE 2,1
+ MOVE 1,L3256
+ ADJSP 15,-3
+ JRST SYMFNC+418
+L3259: ADJSP 15,-3
+ POPJ 15,0
+L3254: point 6,1,5
+L3256: <4_30>+<1_18>+L3257
+L3255: <30_30>+767
+ 1
+; (!*ENTRY FLUID EXPR 1)
+FLUID: intern FLUID
+ MOVE 2,L3263
+ JRST L3249
+L3263: <30_30>+768
+ 1
+; (!*ENTRY FLUID1 EXPR 1)
+FLUID1: intern FLUID1
+ MOVE 2,L3264
+ JRST L3253
+L3264: <30_30>+768
+ 1
+; (!*ENTRY FLUIDP EXPR 1)
+FLUIDP: intern FLUIDP
+ MOVE 2,L3265
+ PUSHJ 15,SYMFNC+522
+ CAMN 1,L3266
+ JRST L3267
+ MOVE 1,0
+ POPJ 15,0
+L3267: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L3266: <30_30>+768
+L3265: <30_30>+767
+ 1
+; (!*ENTRY GLOBAL EXPR 1)
+GLOBAL: intern GLOBAL
+ MOVE 2,L3268
+ JRST L3249
+L3268: <30_30>+654
+ 1
+; (!*ENTRY GLOBAL1 EXPR 1)
+L3270: intern L3270
+ MOVE 2,L3269
+ JRST L3253
+L3269: <30_30>+654
+ 1
+; (!*ENTRY GLOBALP EXPR 1)
+L3273: intern L3273
+ MOVE 2,L3271
+ PUSHJ 15,SYMFNC+522
+ CAMN 1,L3272
+ JRST L3274
+ MOVE 1,0
+ POPJ 15,0
+L3274: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L3272: <30_30>+654
+L3271: <30_30>+767
+ 1
+; (!*ENTRY UNFLUID EXPR 1)
+L3276: intern L3276
+ PUSH 15,1
+ PUSH 15,1
+L3277: LDB 11,L3275
+ CAIN 11,9
+ JRST L3278
+ MOVE 1,0
+ JRST L3279
+L3278: MOVE 1,-1(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+774
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,-1(15)
+ JRST L3277
+L3279: ADJSP 15,-2
+ POPJ 15,0
+L3275: point 6,-1(15),5
+ 1
+; (!*ENTRY UNFLUID1 EXPR 1)
+L3281: intern L3281
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+770
+ CAMN 1,0
+ JRST L3282
+ MOVE 2,L3280
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+764
+L3282: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+L3280: <30_30>+767
+ 1
+; (!*ENTRY GETD EXPR 1)
+GETD: intern GETD
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ LDB 11,L3283
+ CAIN 11,30
+ JRST L3287
+ MOVE 1,0
+ JRST L3288
+L3287: MOVE 1,SYMVAL+84
+L3288: CAMN 1,0
+ JRST L3289
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+519
+ CAMN 1,0
+ JRST L3290
+ MOVE 1,0
+ JRST L3291
+L3290: MOVE 1,SYMVAL+84
+L3291: CAMN 1,0
+ JRST L3289
+ MOVE 2,L3284
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+522
+ CAME 1,0
+ JRST L3292
+ MOVE 1,L3285
+L3292: MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+752
+ CAMN 1,0
+ JRST L3293
+ MOVE 2,L3286
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+522
+ JRST L3294
+L3293: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+521
+L3294: MOVE 2,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L3289: ADJSP 15,-2
+ POPJ 15,0
+L3283: point 6,1,5
+L3286: <30_30>+515
+L3285: <30_30>+247
+L3284: <30_30>+759
+ 1
+; (!*ENTRY REMD EXPR 1)
+REMD: intern REMD
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+318
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ CAMN 2,0
+ JRST L3297
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+753
+ MOVE 2,L3295
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+764
+ MOVE 2,L3296
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+764
+L3297: MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L3296: <30_30>+515
+L3295: <30_30>+759
+L3313: 33
+ byte(7)42,42,42,32,70,117,110,99,116,105,111,110,32,37,114,32,104,97,115,32,98,101,101,110,32,114,101,100,101,102,105,110,101,100,0
+L3314: 37
+ byte(7)73,108,108,45,102,111,114,109,101,100,32,102,117,110,99,116,105,111,110,32,101,120,112,114,101,115,115,105,111,110,32,105,110,32,80,117,116,68,0
+L3315: 53
+ byte(7)68,111,32,121,111,117,32,114,101,97,108,108,121,32,119,97,110,116,32,116,111,32,114,101,100,101,102,105,110,101,32,116,104,101,32,115,121,115,116,101,109,32,102,117,110,99,116,105,111,110,32,37,114,63,0
+L3316: 54
+ byte(7)42,42,42,32,37,114,32,104,97,115,32,110,111,116,32,98,101,101,110,32,100,101,102,105,110,101,100,44,32,98,101,99,97,117,115,101,32,105,116,32,105,115,32,102,108,97,103,103,101,100,32,76,79,83,69,0
+L3317: 30
+ byte(7)37,114,32,105,115,32,110,111,116,32,97,32,108,101,103,97,108,32,102,117,110,99,116,105,111,110,32,116,121,112,101,0
+L3318: <30_30>+247
+ <9_30>+<1_18>+L3319
+L3319: <30_30>+254
+ <9_30>+<1_18>+L3320
+L3320: <30_30>+256
+ <9_30>+<1_18>+L3321
+L3321: <30_30>+258
+ <30_30>+128
+ 3
+; (!*ENTRY PUTD EXPR 3)
+PUTD: intern PUTD
+ ADJSP 15,9
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L3298
+ CAIN 11,30
+ JRST L3322
+ MOVE 2,L3299
+ PUSHJ 15,SYMFNC+130
+ JRST L3323
+L3322: MOVE 2,L3300
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+303
+ CAME 1,0
+ JRST L3324
+ MOVE 2,-1(15)
+ MOVE 1,L3301
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-3(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-4(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-5(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 4,1
+ MOVE 3,-5(15)
+ MOVE 2,-4(15)
+ MOVE 1,L3299
+ PUSHJ 15,SYMFNC+250
+ MOVE 3,1
+ MOVE 2,-3(15)
+ HRRZI 1,1305
+ PUSHJ 15,SYMFNC+236
+ JRST L3323
+L3324: MOVE 2,L3302
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+758
+ CAMN 1,0
+ JRST L3325
+ MOVE 2,0(15)
+ MOVE 1,L3303
+ PUSHJ 15,SYMFNC+418
+ MOVE 1,0
+ JRST L3323
+L3325: MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,442
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+519
+ CAME 1,0
+ JRST L3326
+ CAMN 0,SYMVAL+571
+ JRST L3327
+ MOVE 6,SYMVAL+84
+ MOVEM 6,-4(15)
+L3327: CAMN 0,SYMVAL+570
+ JRST L3326
+ MOVE 2,L3304
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+758
+ CAME 1,0
+ JRST L3326
+ MOVE 2,0(15)
+ MOVE 1,L3305
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+441
+ CAME 1,0
+ JRST L3328
+ MOVE 1,0
+ JRST L3329
+L3328: MOVE 2,L3304
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+761
+L3326: LDB 11,L3306
+ CAIE 11,15
+ JRST L3330
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+755
+ MOVE 2,L3307
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+764
+ JRST L3331
+L3330: LDB 11,L3306
+ CAIE 11,30
+ JRST L3332
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+519
+ CAME 1,0
+ JRST L3332
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+318
+ MOVE 3,1(1)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,PUTD
+ JRST L3329
+L3332: CAMN 0,SYMVAL+776
+ JRST L3333
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+586
+ JRST L3329
+L3333: MOVE 1,-2(15)
+ MOVEM 1,-7(15)
+ LDB 11,L3298
+ CAIN 11,9
+ JRST L3334
+ MOVE 1,0
+ JRST L3335
+L3334: MOVE 1,SYMVAL+84
+L3335: CAMN 1,0
+ JRST L3336
+ MOVE 1,-7(15)
+ MOVE 1,0(1)
+ CAMN 1,L3308
+ JRST L3337
+ MOVE 1,0
+ JRST L3336
+L3337: MOVE 1,SYMVAL+84
+L3336: CAMN 1,0
+ JRST L3338
+ MOVE 3,-2(15)
+ MOVE 2,L3307
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+300
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+754
+ JRST L3331
+L3338: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-7(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-8(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 4,1
+ MOVE 3,-8(15)
+ MOVE 2,-7(15)
+ MOVE 1,L3299
+ PUSHJ 15,SYMFNC+250
+ MOVE 3,1
+ MOVE 2,L3309
+ HRRZI 1,1105
+ PUSHJ 15,SYMFNC+236
+ JRST L3329
+L3331: MOVE 6,-1(15)
+ CAMN 6,L3310
+ JRST L3339
+ MOVE 3,-1(15)
+ MOVE 2,L3311
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+300
+ JRST L3340
+L3339: MOVE 2,L3311
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+764
+L3340: CAMN 0,SYMVAL+570
+ JRST L3341
+ MOVE 2,L3304
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+761
+ JRST L3342
+L3341: MOVE 2,L3304
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+763
+L3342: CAMN 0,-4(15)
+ JRST L3343
+ MOVE 2,0(15)
+ MOVE 1,L3312
+ PUSHJ 15,SYMFNC+418
+L3343: MOVE 1,0(15)
+L3329: JSP 10,SYMFNC+447
+ 1
+L3323: ADJSP 15,-9
+ POPJ 15,0
+L3298: point 6,1,5
+L3306: point 6,-2(15),5
+L3312: <4_30>+<1_18>+L3313
+L3311: <30_30>+759
+L3310: <30_30>+247
+L3309: <4_30>+<1_18>+L3314
+L3308: <30_30>+253
+L3307: <30_30>+515
+L3305: <4_30>+<1_18>+L3315
+L3304: <30_30>+777
+L3303: <4_30>+<1_18>+L3316
+L3302: <30_30>+778
+L3301: <4_30>+<1_18>+L3317
+L3300: <9_30>+<1_18>+L3318
+L3299: <30_30>+251
+ 1
+; (!*ENTRY CODE!-NUMBER!-OF!-ARGUMENTS EXPR 1)
+L3345: intern L3345
+ MOVE 5,1
+ MOVE 4,0
+ LDB 11,L3344
+ CAIE 11,15
+ JRST L3346
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 4,-1(3)
+ JUMPL 4,L3347
+ CAILE 4,15
+ JRST L3347
+ MOVE 1,4
+ POPJ 15,0
+L3347: MOVE 1,0
+ POPJ 15,0
+L3346: MOVE 1,0
+ POPJ 15,0
+L3344: point 6,1,5
+ end
ADDED psl-1983/3-1/kernel/20/prop.rel
Index: psl-1983/3-1/kernel/20/prop.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/prop.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/psl-link.ctl
Index: psl-1983/3-1/kernel/20/psl-link.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/psl-link.ctl
@@ -0,0 +1,46 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in p2e:20-KERNEL-GEN.SL.
+def p2e: p20e:,dmp:
+cd S:
+LINK
+/map
+p2e:nil.rel
+/set:.low.:202
+p2e:types.rel
+p2e:randm.rel
+p2e:alloc.rel
+p2e:arith.rel
+p2e:debg.rel
+p2e:error.rel
+p2e:eval.rel
+p2e:extra.rel
+p2e:fasl.rel
+p2e:io.rel
+p2e:macro.rel
+p2e:prop.rel
+p2e:symbl.rel
+p2e:sysio.rel
+p2e:tloop.rel
+p2e:main.rel
+p2e:heap.rel
+p2e:dtypes.rel
+p2e:drandm.rel
+p2e:dalloc.rel
+p2e:darith.rel
+p2e:ddebg.rel
+p2e:derror.rel
+p2e:deval.rel
+p2e:dextra.rel
+p2e:dfasl.rel
+p2e:dio.rel
+p2e:dmacro.rel
+p2e:dprop.rel
+p2e:dsymbl.rel
+p2e:dsysio.rel
+p2e:dtloop.rel
+p2e:dmain.rel
+p2e:dheap.rel
+/save s:pbpsl.exe
+/go
+@get s:pbpsl.exe/u 1
+@save s:bpsl.exe
ADDED psl-1983/3-1/kernel/20/psl-link.log
Index: psl-1983/3-1/kernel/20/psl-link.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/psl-link.log
@@ -0,0 +1,58 @@
+
+LINK FROM KESSLER, TTY 101
+
+[DO: Execution of PS:<PSL.KERNEL.20.EXT>PSL-LINK.CTL.9 started at 15-Jun-83 13:01:38]
+
+ TOPS-20 Command processor 5(712)-1
+@;Modifications to this file may disappear, as this file is generated
+;automatically using information in p2e:20-KERNEL-GEN.SL.
+def p2e: p20e:,dmp:
+@cd S:
+@LINK
+*/map
+*p2e:nil.rel
+*/set:.low.:202
+*p2e:types.rel
+*p2e:randm.rel
+*p2e:alloc.rel
+*p2e:arith.rel
+*p2e:debg.rel
+*p2e:error.rel
+*p2e:eval.rel
+*p2e:extra.rel
+*p2e:fasl.rel
+*p2e:io.rel
+*p2e:macro.rel
+*p2e:prop.rel
+%LNKMDS Multiply-defined global symbol GET
+ Detected in module .MAIN from file P2E:PROP.REL
+ Defined value = 41052, this value = 104000000200
+*p2e:symbl.rel
+*p2e:sysio.rel
+*p2e:tloop.rel
+*p2e:main.rel
+*p2e:heap.rel
+*p2e:dtypes.rel
+*p2e:drandm.rel
+*p2e:dalloc.rel
+*p2e:darith.rel
+*p2e:ddebg.rel
+*p2e:derror.rel
+*p2e:deval.rel
+*p2e:dextra.rel
+*p2e:dfasl.rel
+*p2e:dio.rel
+*p2e:dmacro.rel
+*p2e:dprop.rel
+*p2e:dsymbl.rel
+*p2e:dsysio.rel
+*p2e:dtloop.rel
+*p2e:dmain.rel
+*p2e:dheap.rel
+*/save s:prebpsl.exe
+*/go
+@get s:prebpsl.exe/u 1
+?File not found - "s:prebpsl.exe"
+@
+[DO: End of control file while searching for %ERR::]
+[DO: Execution aborted at 15-Jun-83 13:03:43]
ADDED psl-1983/3-1/kernel/20/psl.init
Index: psl-1983/3-1/kernel/20/psl.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/psl.init
@@ -0,0 +1,17 @@
+(lapin "types.init")
+(lapin "randm.init")
+(lapin "alloc.init")
+(lapin "arith.init")
+(lapin "debg.init")
+(lapin "error.init")
+(lapin "eval.init")
+(lapin "extra.init")
+(lapin "fasl.init")
+(lapin "io.init")
+(lapin "macro.init")
+(lapin "prop.init")
+(lapin "symbl.init")
+(lapin "sysio.init")
+(lapin "tloop.init")
+(lapin "main.init")
+(lapin "heap.init")
ADDED psl-1983/3-1/kernel/20/randm.ctl
Index: psl-1983/3-1/kernel/20/randm.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/randm.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "randm";
+PathIn "randm.build";
+ASMEnd;
+quit;
+compile randm.mac, drandm.mac
ADDED psl-1983/3-1/kernel/20/randm.init
Index: psl-1983/3-1/kernel/20/randm.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/randm.init
@@ -0,0 +1,21 @@
+(PUT (QUOTE LIST) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DE) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DF) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DM) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE DN) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE SETQ) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE AND) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE OR) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE COND) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE MAX) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE MIN) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE PLUS) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE TIMES) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE FUNCTION) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE FIRST) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE SECOND) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE THIRD) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE FOURTH) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE REST) (QUOTE TYPE) (QUOTE MACRO))
ADDED psl-1983/3-1/kernel/20/randm.log
Index: psl-1983/3-1/kernel/20/randm.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/randm.log
@@ -0,0 +1,84 @@
+
+ 8-Jun-83 9:29:14
+
+BATCON Version 104(4133) GLXLIB Version 1(527)
+
+ Job RANDM Req #475 for KESSLER in Stream 0
+
+ OUTPUT: Nolog TIME-LIMIT: 0:10:00
+ UNIQUE: Yes BATCH-LOG: Supersede
+ RESTART: No ASSISTANCE: Yes
+ SEQUENCE: 1732
+
+ Input from => PS:<PSL.KERNEL.20.EXT>RANDM.CTL.3
+ Output to => PS:<PSL.KERNEL.20.EXT>RANDM.LOG
+
+
+
+ 9:29:14 MONTR Univ of Utah Computer Science KL-20, TOPS-20AN Monitor 5.3(1500)
+ 9:29:14 MONTR @SET TIME-LIMIT 600
+ 9:29:14 MONTR @LOGIN KESSLER SMALL
+ 9:29:18 MONTR Job 12 on TTY224 8-Jun-83 09:29:18
+ 9:29:18 MONTR Previous login at 8-Jun-83 09:27:22
+ 9:29:18 MONTR There is 1 other job logged in as user KESSLER
+ 9:29:25 MONTR @
+ 9:29:25 MONTR [PS Mounted]
+ 9:29:25 MONTR
+ 9:29:25 MONTR [CONNECTED TO PS:<PSL.KERNEL.20.EXT>]
+ ;Modifications to this file may disappear, as this file is generated
+ ;automatically using information in P20:20-KERNEL-GEN.SL.
+ 9:29:25 MONTR def dsk: dsk:,p20e:,pk:,p20:
+ 9:29:27 MONTR @S:EX-DEC20-CROSS.EXE
+ 9:29:28 USER [14] ASMOut "randm";
+ 9:29:29 USER ASMOUT: IN files; or type in expressions
+ 9:29:29 USER When all done execute ASMEND;
+ 9:29:32 USER [15] PathIn "randm.build";
+ 9:29:32 USER %
+ 9:29:32 USER % RANDM.BUILD - Miscellaneous interpreter files
+ 9:29:32 USER %
+ 9:29:32 USER % Author: Eric Benson
+ 9:29:32 USER % Symbolic Computation Group
+ 9:29:32 USER % Computer Science Dept.
+ 9:29:32 USER % University of Utah
+ 9:29:32 USER % Date: 19 May 1982
+ 9:29:32 USER % Copyright (c) 1982 University of Utah
+ 9:29:32 USER %
+ 9:29:32 USER
+ 9:29:32 USER PathIn "known-to-comp-sl.red"$ % SL functions performed inline in code
+ 9:29:37 USER PathIn "others-sl.red"$ % DIGIT, LITER and LENGTH
+ 9:29:46 USER PathIn "equal.red"$ % equality predicates
+ 9:30:00 USER PathIn "carcdr.red"$ % CDDDDR, etc.
+ 9:30:13 USER PathIn "easy-sl.red"$
+ 9:30:17 USER *** Function `DE' has been redefined
+ 9:30:18 USER *** Function `DF' has been redefined
+ 9:30:18 USER *** Function `DM' has been redefined
+ 9:30:19 USER *** Function `DN' has been redefined
+ 9:30:24 USER *** Function `MAX' has been redefined
+ 9:30:24 USER *** Function `MIN' has been redefined
+ 9:30:25 USER *** Function `PLUS' has been redefined
+ 9:30:25 USER *** Function `TIMES' has been redefined
+ 9:30:34 USER *** Garbage collection starting
+ 9:30:37 USER *** GC 6: time 1395 ms, 248337 recovered, 248337 free
+ 9:30:40 USER % highly portable SL function defns
+ 9:30:41 USER PathIn "easy-non-sl.red"$
+ 9:30:45 USER *** Function `FIRST' has been redefined
+ 9:30:45 USER *** Function `SECOND' has been redefined
+ 9:30:46 USER *** Function `THIRD' has been redefined
+ 9:30:46 USER *** Function `FOURTH' has been redefined
+ 9:30:46 USER *** Function `REST' has been redefined
+ 9:31:04 USER % simple, ubiquitous SL extensions
+ 9:31:04 USER PathIn "sets.red"$ % Set manipulation functions
+ 9:31:08 USER [16] ASMEnd;
+ 9:31:09 USER *** Garbage collection starting
+ 9:31:18 USER *** GC 7: time 1626 ms, 171323 recovered, 247010 free
+ 9:31:38 USER 0
+ 9:31:38 USER [17] quit;
+ 9:31:39 MONTR @compile randm.mac, drandm.mac
+ 9:31:43 USER MACRO: .MAIN
+ 9:32:04 USER MACRO: .MAIN
+ 9:32:04 USER
+ 9:32:04 USER EXIT
+ 9:32:04 MONTR @
+ 9:32:06 MONTR Killed by OPERATOR, TTY 221
+ 9:32:06 MONTR Killed Job 12, User KESSLER, Account SMALL, TTY 224,
+ 9:32:06 MONTR at 8-Jun-83 09:32:06, Used 0:01:23 in 0:02:48
ADDED psl-1983/3-1/kernel/20/randm.mac
Index: psl-1983/3-1/kernel/20/randm.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/randm.mac
@@ -0,0 +1,3793 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ 1
+; (!*ENTRY CODEP EXPR 1)
+CODEP: intern CODEP
+ LDB 11,L0360
+ CAIN 11,15
+ JRST L0361
+ MOVE 1,0
+ POPJ 15,0
+L0361: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0360: point 6,1,5
+ 2
+; (!*ENTRY EQ EXPR 2)
+EQ: intern EQ
+ CAMN 1,2
+ JRST L0362
+ MOVE 1,0
+ POPJ 15,0
+L0362: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 1
+; (!*ENTRY FLOATP EXPR 1)
+FLOATP: intern FLOATP
+ LDB 11,L0363
+ CAIN 11,3
+ JRST L0364
+ MOVE 1,0
+ POPJ 15,0
+L0364: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0363: point 6,1,5
+ 1
+; (!*ENTRY BIGP EXPR 1)
+BIGP: intern BIGP
+ LDB 11,L0365
+ CAIN 11,2
+ JRST L0366
+ MOVE 1,0
+ POPJ 15,0
+L0366: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0365: point 6,1,5
+ 1
+; (!*ENTRY IDP EXPR 1)
+IDP: intern IDP
+ LDB 11,L0367
+ CAIN 11,30
+ JRST L0368
+ MOVE 1,0
+ POPJ 15,0
+L0368: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0367: point 6,1,5
+ 1
+; (!*ENTRY PAIRP EXPR 1)
+PAIRP: intern PAIRP
+ LDB 11,L0369
+ CAIN 11,9
+ JRST L0370
+ MOVE 1,0
+ POPJ 15,0
+L0370: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0369: point 6,1,5
+ 1
+; (!*ENTRY STRINGP EXPR 1)
+L0372: intern L0372
+ LDB 11,L0371
+ CAIN 11,4
+ JRST L0373
+ MOVE 1,0
+ POPJ 15,0
+L0373: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0371: point 6,1,5
+ 1
+; (!*ENTRY VECTORP EXPR 1)
+L0375: intern L0375
+ LDB 11,L0374
+ CAIN 11,8
+ JRST L0376
+ MOVE 1,0
+ POPJ 15,0
+L0376: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0374: point 6,1,5
+ 1
+; (!*ENTRY CAR EXPR 1)
+CAR: intern CAR
+ CAME 1,0
+ JRST L0379
+ MOVE 1,0
+ POPJ 15,0
+L0379: LDB 11,L0377
+ CAIE 11,9
+ JRST L0380
+ MOVE 1,0(1)
+ POPJ 15,0
+L0380: MOVE 2,L0378
+ JRST SYMFNC+149
+L0377: point 6,1,5
+L0378: <30_30>+187
+ 1
+; (!*ENTRY CDR EXPR 1)
+CDR: intern CDR
+ CAME 1,0
+ JRST L0383
+ MOVE 1,0
+ POPJ 15,0
+L0383: LDB 11,L0381
+ CAIE 11,9
+ JRST L0384
+ MOVE 1,1(1)
+ POPJ 15,0
+L0384: MOVE 2,L0382
+ JRST SYMFNC+149
+L0381: point 6,1,5
+L0382: <30_30>+188
+ 2
+; (!*ENTRY RPLACA EXPR 2)
+RPLACA: intern RPLACA
+ LDB 11,L0385
+ CAIE 11,9
+ JRST L0387
+ MOVEM 2,0(1)
+ POPJ 15,0
+L0387: MOVE 2,L0386
+ JRST SYMFNC+149
+L0385: point 6,1,5
+L0386: <30_30>+189
+ 2
+; (!*ENTRY RPLACD EXPR 2)
+RPLACD: intern RPLACD
+ LDB 11,L0388
+ CAIE 11,9
+ JRST L0390
+ MOVEM 2,1(1)
+ POPJ 15,0
+L0390: MOVE 2,L0389
+ JRST SYMFNC+149
+L0388: point 6,1,5
+L0389: <30_30>+190
+ 1
+; (!*ENTRY FIXP EXPR 1)
+FIXP: intern FIXP
+ LDB 11,L0391
+ CAIG 11,2
+ JRST L0392
+ CAIN 11,63
+ JRST L0392
+ MOVE 1,0
+ POPJ 15,0
+L0392: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0391: point 6,1,5
+ 1
+; (!*ENTRY DIGIT EXPR 1)
+DIGIT: intern DIGIT
+ MOVE 2,1
+ LDB 11,L0393
+ CAIN 11,30
+ JRST L0394
+ MOVE 1,0
+ JRST L0395
+L0394: MOVE 1,SYMVAL+84
+L0395: CAMN 1,0
+ JRST L0396
+ MOVE 1,2
+ TLZ 1,258048
+ MOVE 2,1
+ CAIL 1,48
+ JRST L0397
+ MOVE 1,0
+ JRST L0398
+L0397: MOVE 1,SYMVAL+84
+L0398: CAMN 1,0
+ JRST L0396
+ MOVE 1,SYMVAL+84
+ CAIG 2,57
+ JRST L0396
+ MOVE 1,0
+L0396: POPJ 15,0
+L0393: point 6,1,5
+ 1
+; (!*ENTRY LITER EXPR 1)
+LITER: intern LITER
+ MOVE 2,1
+ LDB 11,L0399
+ CAIN 11,30
+ JRST L0400
+ MOVE 1,0
+ JRST L0401
+L0400: MOVE 1,SYMVAL+84
+L0401: CAMN 1,0
+ JRST L0402
+ MOVE 1,2
+ TLZ 1,258048
+ MOVE 2,1
+ CAIL 1,65
+ JRST L0403
+ MOVE 1,0
+ JRST L0404
+L0403: MOVE 1,SYMVAL+84
+L0404: CAMN 1,0
+ JRST L0405
+ MOVE 1,SYMVAL+84
+ CAIG 2,90
+ JRST L0405
+ MOVE 1,0
+L0405: CAME 1,0
+ JRST L0402
+ MOVE 1,SYMVAL+84
+ CAIL 2,97
+ JRST L0406
+ MOVE 1,0
+L0406: CAMN 1,0
+ JRST L0402
+ MOVE 1,SYMVAL+84
+ CAIG 2,122
+ JRST L0402
+ MOVE 1,0
+L0402: POPJ 15,0
+L0399: point 6,1,5
+ 1
+; (!*ENTRY LENGTH EXPR 1)
+LENGTH: intern LENGTH
+ SETZM 2
+ JRST L0407
+; (!*ENTRY LENGTH1 EXPR 2)
+L0407: intern L0407
+L0409: LDB 11,L0408
+ CAIE 11,9
+ JRST L0410
+ AOS 2
+ MOVE 1,1(1)
+ JRST L0409
+L0410: MOVE 1,2
+ POPJ 15,0
+L0408: point 6,1,5
+ 2
+; (!*ENTRY EQN EXPR 2)
+EQN: intern EQN
+ MOVE 5,1
+ CAMN 1,2
+ JRST L0413
+ MOVE 1,0
+ JRST L0414
+L0413: MOVE 1,SYMVAL+84
+L0414: CAME 1,0
+ JRST L0415
+ LDB 1,L0411
+ CAIN 1,1
+ JRST L0416
+ CAIN 1,2
+ JRST L0417
+ CAIE 1,3
+ JRST L0418
+ MOVE 1,SYMVAL+84
+ LDB 11,L0412
+ CAIN 11,3
+ JRST L0419
+ MOVE 1,0
+L0419: CAMN 1,0
+ JRST L0415
+ MOVE 3,5
+ TLZ 3,258048
+ MOVE 4,2
+ TLZ 4,258048
+ MOVE 1,1(3)
+ CAMN 1,1(4)
+ JRST L0420
+ MOVE 1,0
+ JRST L0421
+L0420: MOVE 1,SYMVAL+84
+L0421: CAMN 1,0
+ JRST L0415
+ MOVE 1,2(3)
+ CAMN 1,2(4)
+ JRST L0422
+ MOVE 1,0
+ POPJ 15,0
+L0422: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0416: MOVE 1,SYMVAL+84
+ LDB 11,L0412
+ CAIN 11,1
+ JRST L0423
+ MOVE 1,0
+L0423: CAMN 1,0
+ JRST L0415
+ MOVE 3,5
+ TLZ 3,258048
+ MOVE 4,2
+ TLZ 4,258048
+ MOVE 1,1(3)
+ CAMN 1,1(4)
+ JRST L0424
+ MOVE 1,0
+ POPJ 15,0
+L0424: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0417: MOVE 1,SYMVAL+84
+ LDB 11,L0412
+ CAIN 11,2
+ JRST L0425
+ MOVE 1,0
+L0425: CAMN 1,0
+ JRST L0415
+ MOVE 1,5
+ JRST L0426
+L0418: MOVE 1,0
+L0415: POPJ 15,0
+L0411: point 6,5,5
+L0412: point 6,2,5
+ 2
+; (!*ENTRY LISPEQUAL EXPR 2)
+L0429: intern L0429
+ ADJSP 15,2
+L0430: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ CAMN 1,2
+ JRST L0431
+ MOVE 1,0
+ JRST L0432
+L0431: MOVE 1,SYMVAL+84
+L0432: CAME 1,0
+ JRST L0433
+ LDB 1,L0427
+ CAIL 1,1
+ CAILE 1,9
+ JRST L0434
+ JRST @L0435-1(1)
+L0435: IFIW L0436
+ IFIW L0437
+ IFIW L0438
+ IFIW L0439
+ IFIW L0439
+ IFIW L0440
+ IFIW L0441
+ IFIW L0442
+ IFIW L0443
+L0434: JRST L0444
+L0442: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,8
+ JRST L0445
+ MOVE 1,0
+L0445: CAMN 1,0
+ JRST L0433
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST L0446
+L0439: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,4
+ JRST L0447
+ MOVE 1,0
+L0447: CAMN 1,0
+ JRST L0433
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+196
+L0443: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,9
+ JRST L0448
+ MOVE 1,0
+L0448: CAMN 1,0
+ JRST L0433
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,L0429
+ CAMN 1,0
+ JRST L0433
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L0430
+L0438: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,3
+ JRST L0449
+ MOVE 1,0
+L0449: CAMN 1,0
+ JRST L0433
+ MOVE 3,0(15)
+ TLZ 3,258048
+ MOVE 4,2
+ TLZ 4,258048
+ MOVE 1,1(3)
+ CAMN 1,1(4)
+ JRST L0450
+ MOVE 1,0
+ JRST L0451
+L0450: MOVE 1,SYMVAL+84
+L0451: CAMN 1,0
+ JRST L0433
+ MOVE 1,2(3)
+ CAMN 1,2(4)
+ JRST L0452
+ MOVE 1,0
+ JRST L0433
+L0452: MOVE 1,SYMVAL+84
+ JRST L0433
+L0436: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,1
+ JRST L0453
+ MOVE 1,0
+L0453: CAMN 1,0
+ JRST L0433
+ MOVE 3,0(15)
+ TLZ 3,258048
+ MOVE 4,2
+ TLZ 4,258048
+ MOVE 1,1(3)
+ CAMN 1,1(4)
+ JRST L0454
+ MOVE 1,0
+ JRST L0433
+L0454: MOVE 1,SYMVAL+84
+ JRST L0433
+L0437: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,2
+ JRST L0455
+ MOVE 1,0
+L0455: CAMN 1,0
+ JRST L0433
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST L0426
+L0441: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,7
+ JRST L0456
+ MOVE 1,0
+L0456: CAMN 1,0
+ JRST L0433
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST L0426
+L0440: MOVE 1,SYMVAL+84
+ LDB 11,L0428
+ CAIN 11,6
+ JRST L0457
+ MOVE 1,0
+L0457: CAMN 1,0
+ JRST L0433
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST L0458
+L0444: MOVE 1,0
+L0433: ADJSP 15,-2
+ POPJ 15,0
+L0427: point 6,0(15),5
+L0428: point 6,2,5
+ 2
+; (!*ENTRY EQSTR EXPR 2)
+EQSTR: intern EQSTR
+ MOVE 3,1
+ CAMN 1,2
+ JRST L0461
+ MOVE 1,0
+ JRST L0462
+L0461: MOVE 1,SYMVAL+84
+L0462: CAME 1,0
+ JRST L0463
+ MOVE 1,SYMVAL+84
+ LDB 11,L0459
+ CAIN 11,4
+ JRST L0464
+ MOVE 1,0
+L0464: CAMN 1,0
+ JRST L0463
+ MOVE 1,SYMVAL+84
+ LDB 11,L0460
+ CAIN 11,4
+ JRST L0465
+ MOVE 1,0
+L0465: CAMN 1,0
+ JRST L0463
+ MOVE 1,3
+ JRST SYMFNC+196
+L0463: POPJ 15,0
+L0459: point 6,3,5
+L0460: point 6,2,5
+ 2
+; (!*ENTRY STRINGEQUAL EXPR 2)
+L0469: intern L0469
+ ADJSP 15,4
+ MOVEM 0,0(15)
+ TLZ 1,258048
+ MOVEM 1,-3(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVE 6,0(1)
+ LDB 3,L0466
+ TDNE 3,L0467
+ TDO 3,L0468
+ MOVEM 3,-1(15)
+ MOVE 6,0(2)
+ LDB 4,L0466
+ TDNE 4,L0467
+ TDO 4,L0468
+ CAMN 3,4
+ JRST L0470
+ MOVE 1,0
+ JRST L0471
+L0470: SETZM 0(15)
+L0472: MOVE 6,0(15)
+ CAMG 6,-1(15)
+ JRST L0473
+ MOVE 1,SYMVAL+84
+ JRST L0471
+L0473: MOVE 2,0(15)
+ MOVE 1,-3(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 5,1
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ CAMN 5,1
+ JRST L0474
+ MOVE 1,0
+ JRST L0471
+L0474: AOS 0(15)
+ JRST L0472
+L0471: ADJSP 15,-4
+ POPJ 15,0
+L0466: point 30,6,35
+L0467: 536870912
+L0468: -536870912
+; (!*ENTRY WORDSEQUAL EXPR 2)
+L0426: intern L0426
+ ADJSP 15,3
+ MOVE 5,0
+ TLZ 1,258048
+ MOVEM 1,-2(15)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVE 6,0(1)
+ LDB 3,L0475
+ TDNE 3,L0476
+ TDO 3,L0477
+ MOVEM 3,0(15)
+ MOVE 6,0(2)
+ LDB 4,L0475
+ TDNE 4,L0476
+ TDO 4,L0477
+ CAMN 3,4
+ JRST L0478
+ MOVE 1,0
+ JRST L0479
+L0478: SETZM 5
+L0480: CAME 5,0(15)
+ JRST L0481
+ MOVE 1,SYMVAL+84
+ JRST L0479
+L0481: MOVE 2,5
+ ADD 2,-2(15)
+ MOVE 3,5
+ ADD 3,-1(15)
+ MOVE 6,1(3)
+ CAMN 6,1(2)
+ JRST L0482
+ MOVE 1,0
+ JRST L0479
+L0482: AOS 5
+ JRST L0480
+L0479: ADJSP 15,-3
+ POPJ 15,0
+L0475: point 30,6,35
+L0476: 536870912
+L0477: -536870912
+; (!*ENTRY HALFWORDSEQUAL EXPR 2)
+L0458: intern L0458
+ ADJSP 15,4
+ MOVEM 0,0(15)
+ TLZ 1,258048
+ MOVEM 1,-3(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVE 6,0(1)
+ LDB 3,L0483
+ TDNE 3,L0484
+ TDO 3,L0485
+ MOVEM 3,-1(15)
+ MOVE 6,0(2)
+ LDB 4,L0483
+ TDNE 4,L0484
+ TDO 4,L0485
+ CAMN 3,4
+ JRST L0486
+ MOVE 1,0
+ JRST L0487
+L0486: SETZM 0(15)
+L0488: MOVE 6,0(15)
+ CAME 6,-1(15)
+ JRST L0489
+ MOVE 1,SYMVAL+84
+ JRST L0487
+L0489: MOVE 2,0(15)
+ MOVE 1,-3(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 5,1
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ CAMN 5,1
+ JRST L0490
+ MOVE 1,0
+ JRST L0487
+L0490: AOS 0(15)
+ JRST L0488
+L0487: ADJSP 15,-4
+ POPJ 15,0
+L0483: point 30,6,35
+L0484: 536870912
+L0485: -536870912
+; (!*ENTRY VECTOREQUAL EXPR 2)
+L0446: intern L0446
+ ADJSP 15,4
+ MOVEM 0,-3(15)
+ TLZ 1,258048
+ MOVEM 1,0(15)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVE 6,0(1)
+ LDB 3,L0491
+ TDNE 3,L0492
+ TDO 3,L0493
+ MOVEM 3,-2(15)
+ MOVE 6,0(2)
+ LDB 4,L0491
+ TDNE 4,L0492
+ TDO 4,L0493
+ CAMN 3,4
+ JRST L0494
+ MOVE 1,0
+ JRST L0495
+L0494: SETZM -3(15)
+L0496: MOVE 6,-3(15)
+ CAMG 6,-2(15)
+ JRST L0497
+ MOVE 1,SYMVAL+84
+ JRST L0495
+L0497: MOVE 2,-3(15)
+ ADD 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,-3(15)
+ ADD 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+195
+ CAME 1,0
+ JRST L0498
+ MOVE 1,0
+ JRST L0495
+L0498: AOS -3(15)
+ JRST L0496
+L0495: ADJSP 15,-4
+ POPJ 15,0
+L0491: point 30,6,35
+L0492: 536870912
+L0493: -536870912
+ 1
+; (!*ENTRY CAAAAR EXPR 1)
+CAAAAR: intern CAAAAR
+ CAME 1,0
+ JRST L0501
+ MOVE 1,0
+ POPJ 15,0
+L0501: LDB 11,L0499
+ CAIE 11,9
+ JRST L0502
+ MOVE 1,0(1)
+ JRST SYMFNC+200
+L0502: MOVE 2,L0500
+ JRST SYMFNC+149
+L0499: point 6,1,5
+L0500: <30_30>+199
+ 1
+; (!*ENTRY CAAADR EXPR 1)
+CAAADR: intern CAAADR
+ CAME 1,0
+ JRST L0505
+ MOVE 1,0
+ POPJ 15,0
+L0505: LDB 11,L0503
+ CAIE 11,9
+ JRST L0506
+ MOVE 1,1(1)
+ JRST SYMFNC+200
+L0506: MOVE 2,L0504
+ JRST SYMFNC+149
+L0503: point 6,1,5
+L0504: <30_30>+201
+ 1
+; (!*ENTRY CAADAR EXPR 1)
+CAADAR: intern CAADAR
+ CAME 1,0
+ JRST L0509
+ MOVE 1,0
+ POPJ 15,0
+L0509: LDB 11,L0507
+ CAIE 11,9
+ JRST L0510
+ MOVE 1,0(1)
+ JRST SYMFNC+203
+L0510: MOVE 2,L0508
+ JRST SYMFNC+149
+L0507: point 6,1,5
+L0508: <30_30>+202
+ 1
+; (!*ENTRY CAADDR EXPR 1)
+CAADDR: intern CAADDR
+ CAME 1,0
+ JRST L0513
+ MOVE 1,0
+ POPJ 15,0
+L0513: LDB 11,L0511
+ CAIE 11,9
+ JRST L0514
+ MOVE 1,1(1)
+ JRST SYMFNC+203
+L0514: MOVE 2,L0512
+ JRST SYMFNC+149
+L0511: point 6,1,5
+L0512: <30_30>+204
+ 1
+; (!*ENTRY CADAAR EXPR 1)
+CADAAR: intern CADAAR
+ CAME 1,0
+ JRST L0517
+ MOVE 1,0
+ POPJ 15,0
+L0517: LDB 11,L0515
+ CAIE 11,9
+ JRST L0518
+ MOVE 1,0(1)
+ JRST SYMFNC+206
+L0518: MOVE 2,L0516
+ JRST SYMFNC+149
+L0515: point 6,1,5
+L0516: <30_30>+205
+ 1
+; (!*ENTRY CADADR EXPR 1)
+CADADR: intern CADADR
+ CAME 1,0
+ JRST L0521
+ MOVE 1,0
+ POPJ 15,0
+L0521: LDB 11,L0519
+ CAIE 11,9
+ JRST L0522
+ MOVE 1,1(1)
+ JRST SYMFNC+206
+L0522: MOVE 2,L0520
+ JRST SYMFNC+149
+L0519: point 6,1,5
+L0520: <30_30>+207
+ 1
+; (!*ENTRY CADDAR EXPR 1)
+CADDAR: intern CADDAR
+ CAME 1,0
+ JRST L0525
+ MOVE 1,0
+ POPJ 15,0
+L0525: LDB 11,L0523
+ CAIE 11,9
+ JRST L0526
+ MOVE 1,0(1)
+ JRST SYMFNC+209
+L0526: MOVE 2,L0524
+ JRST SYMFNC+149
+L0523: point 6,1,5
+L0524: <30_30>+208
+ 1
+; (!*ENTRY CADDDR EXPR 1)
+CADDDR: intern CADDDR
+ CAME 1,0
+ JRST L0529
+ MOVE 1,0
+ POPJ 15,0
+L0529: LDB 11,L0527
+ CAIE 11,9
+ JRST L0530
+ MOVE 1,1(1)
+ JRST SYMFNC+209
+L0530: MOVE 2,L0528
+ JRST SYMFNC+149
+L0527: point 6,1,5
+L0528: <30_30>+210
+ 1
+; (!*ENTRY CDAAAR EXPR 1)
+CDAAAR: intern CDAAAR
+ CAME 1,0
+ JRST L0533
+ MOVE 1,0
+ POPJ 15,0
+L0533: LDB 11,L0531
+ CAIE 11,9
+ JRST L0534
+ MOVE 1,0(1)
+ JRST SYMFNC+212
+L0534: MOVE 2,L0532
+ JRST SYMFNC+149
+L0531: point 6,1,5
+L0532: <30_30>+211
+ 1
+; (!*ENTRY CDAADR EXPR 1)
+CDAADR: intern CDAADR
+ CAME 1,0
+ JRST L0537
+ MOVE 1,0
+ POPJ 15,0
+L0537: LDB 11,L0535
+ CAIE 11,9
+ JRST L0538
+ MOVE 1,1(1)
+ JRST SYMFNC+212
+L0538: MOVE 2,L0536
+ JRST SYMFNC+149
+L0535: point 6,1,5
+L0536: <30_30>+213
+ 1
+; (!*ENTRY CDADAR EXPR 1)
+CDADAR: intern CDADAR
+ CAME 1,0
+ JRST L0541
+ MOVE 1,0
+ POPJ 15,0
+L0541: LDB 11,L0539
+ CAIE 11,9
+ JRST L0542
+ MOVE 1,0(1)
+ JRST SYMFNC+215
+L0542: MOVE 2,L0540
+ JRST SYMFNC+149
+L0539: point 6,1,5
+L0540: <30_30>+214
+ 1
+; (!*ENTRY CDADDR EXPR 1)
+CDADDR: intern CDADDR
+ CAME 1,0
+ JRST L0545
+ MOVE 1,0
+ POPJ 15,0
+L0545: LDB 11,L0543
+ CAIE 11,9
+ JRST L0546
+ MOVE 1,1(1)
+ JRST SYMFNC+215
+L0546: MOVE 2,L0544
+ JRST SYMFNC+149
+L0543: point 6,1,5
+L0544: <30_30>+216
+ 1
+; (!*ENTRY CDDAAR EXPR 1)
+CDDAAR: intern CDDAAR
+ CAME 1,0
+ JRST L0549
+ MOVE 1,0
+ POPJ 15,0
+L0549: LDB 11,L0547
+ CAIE 11,9
+ JRST L0550
+ MOVE 1,0(1)
+ JRST SYMFNC+218
+L0550: MOVE 2,L0548
+ JRST SYMFNC+149
+L0547: point 6,1,5
+L0548: <30_30>+217
+ 1
+; (!*ENTRY CDDADR EXPR 1)
+CDDADR: intern CDDADR
+ CAME 1,0
+ JRST L0553
+ MOVE 1,0
+ POPJ 15,0
+L0553: LDB 11,L0551
+ CAIE 11,9
+ JRST L0554
+ MOVE 1,1(1)
+ JRST SYMFNC+218
+L0554: MOVE 2,L0552
+ JRST SYMFNC+149
+L0551: point 6,1,5
+L0552: <30_30>+219
+ 1
+; (!*ENTRY CDDDAR EXPR 1)
+CDDDAR: intern CDDDAR
+ CAME 1,0
+ JRST L0557
+ MOVE 1,0
+ POPJ 15,0
+L0557: LDB 11,L0555
+ CAIE 11,9
+ JRST L0558
+ MOVE 1,0(1)
+ JRST SYMFNC+221
+L0558: MOVE 2,L0556
+ JRST SYMFNC+149
+L0555: point 6,1,5
+L0556: <30_30>+220
+ 1
+; (!*ENTRY CDDDDR EXPR 1)
+CDDDDR: intern CDDDDR
+ CAME 1,0
+ JRST L0561
+ MOVE 1,0
+ POPJ 15,0
+L0561: LDB 11,L0559
+ CAIE 11,9
+ JRST L0562
+ MOVE 1,1(1)
+ JRST SYMFNC+221
+L0562: MOVE 2,L0560
+ JRST SYMFNC+149
+L0559: point 6,1,5
+L0560: <30_30>+222
+ 1
+; (!*ENTRY CAAAR EXPR 1)
+CAAAR: intern CAAAR
+ CAME 1,0
+ JRST L0565
+ MOVE 1,0
+ POPJ 15,0
+L0565: LDB 11,L0563
+ CAIE 11,9
+ JRST L0566
+ MOVE 1,0(1)
+ JRST SYMFNC+223
+L0566: MOVE 2,L0564
+ JRST SYMFNC+149
+L0563: point 6,1,5
+L0564: <30_30>+200
+ 1
+; (!*ENTRY CAADR EXPR 1)
+CAADR: intern CAADR
+ CAME 1,0
+ JRST L0569
+ MOVE 1,0
+ POPJ 15,0
+L0569: LDB 11,L0567
+ CAIE 11,9
+ JRST L0570
+ MOVE 1,1(1)
+ JRST SYMFNC+223
+L0570: MOVE 2,L0568
+ JRST SYMFNC+149
+L0567: point 6,1,5
+L0568: <30_30>+203
+ 1
+; (!*ENTRY CADAR EXPR 1)
+CADAR: intern CADAR
+ CAME 1,0
+ JRST L0573
+ MOVE 1,0
+ POPJ 15,0
+L0573: LDB 11,L0571
+ CAIE 11,9
+ JRST L0574
+ MOVE 1,0(1)
+ JRST SYMFNC+224
+L0574: MOVE 2,L0572
+ JRST SYMFNC+149
+L0571: point 6,1,5
+L0572: <30_30>+206
+ 1
+; (!*ENTRY CADDR EXPR 1)
+CADDR: intern CADDR
+ CAME 1,0
+ JRST L0577
+ MOVE 1,0
+ POPJ 15,0
+L0577: LDB 11,L0575
+ CAIE 11,9
+ JRST L0578
+ MOVE 1,1(1)
+ JRST SYMFNC+224
+L0578: MOVE 2,L0576
+ JRST SYMFNC+149
+L0575: point 6,1,5
+L0576: <30_30>+209
+ 1
+; (!*ENTRY CDAAR EXPR 1)
+CDAAR: intern CDAAR
+ CAME 1,0
+ JRST L0581
+ MOVE 1,0
+ POPJ 15,0
+L0581: LDB 11,L0579
+ CAIE 11,9
+ JRST L0582
+ MOVE 1,0(1)
+ JRST SYMFNC+225
+L0582: MOVE 2,L0580
+ JRST SYMFNC+149
+L0579: point 6,1,5
+L0580: <30_30>+212
+ 1
+; (!*ENTRY CDADR EXPR 1)
+CDADR: intern CDADR
+ CAME 1,0
+ JRST L0585
+ MOVE 1,0
+ POPJ 15,0
+L0585: LDB 11,L0583
+ CAIE 11,9
+ JRST L0586
+ MOVE 1,1(1)
+ JRST SYMFNC+225
+L0586: MOVE 2,L0584
+ JRST SYMFNC+149
+L0583: point 6,1,5
+L0584: <30_30>+215
+ 1
+; (!*ENTRY CDDAR EXPR 1)
+CDDAR: intern CDDAR
+ CAME 1,0
+ JRST L0589
+ MOVE 1,0
+ POPJ 15,0
+L0589: LDB 11,L0587
+ CAIE 11,9
+ JRST L0590
+ MOVE 1,0(1)
+ JRST SYMFNC+226
+L0590: MOVE 2,L0588
+ JRST SYMFNC+149
+L0587: point 6,1,5
+L0588: <30_30>+218
+ 1
+; (!*ENTRY CDDDR EXPR 1)
+CDDDR: intern CDDDR
+ CAME 1,0
+ JRST L0593
+ MOVE 1,0
+ POPJ 15,0
+L0593: LDB 11,L0591
+ CAIE 11,9
+ JRST L0594
+ MOVE 1,1(1)
+ JRST SYMFNC+226
+L0594: MOVE 2,L0592
+ JRST SYMFNC+149
+L0591: point 6,1,5
+L0592: <30_30>+221
+ 1
+; (!*ENTRY SAFECAR EXPR 1)
+L0597: intern L0597
+ CAME 1,0
+ JRST L0598
+ MOVE 1,0
+ POPJ 15,0
+L0598: LDB 11,L0595
+ CAIE 11,9
+ JRST L0599
+ MOVE 1,0(1)
+ POPJ 15,0
+L0599: MOVE 2,L0596
+ JRST SYMFNC+149
+L0595: point 6,1,5
+L0596: <30_30>+187
+ 1
+; (!*ENTRY SAFECDR EXPR 1)
+L0602: intern L0602
+ CAME 1,0
+ JRST L0603
+ MOVE 1,0
+ POPJ 15,0
+L0603: LDB 11,L0600
+ CAIE 11,9
+ JRST L0604
+ MOVE 1,1(1)
+ POPJ 15,0
+L0604: MOVE 2,L0601
+ JRST SYMFNC+149
+L0600: point 6,1,5
+L0601: <30_30>+188
+ 1
+; (!*ENTRY CAAR EXPR 1)
+CAAR: intern CAAR
+ CAME 1,0
+ JRST L0607
+ MOVE 1,0
+ POPJ 15,0
+L0607: LDB 11,L0605
+ CAIE 11,9
+ JRST L0608
+ MOVE 1,0(1)
+ JRST SYMFNC+227
+L0608: MOVE 2,L0606
+ JRST SYMFNC+149
+L0605: point 6,1,5
+L0606: <30_30>+223
+ 1
+; (!*ENTRY CADR EXPR 1)
+CADR: intern CADR
+ CAME 1,0
+ JRST L0611
+ MOVE 1,0
+ POPJ 15,0
+L0611: LDB 11,L0609
+ CAIE 11,9
+ JRST L0612
+ MOVE 1,1(1)
+ JRST SYMFNC+227
+L0612: MOVE 2,L0610
+ JRST SYMFNC+149
+L0609: point 6,1,5
+L0610: <30_30>+224
+ 1
+; (!*ENTRY CDAR EXPR 1)
+CDAR: intern CDAR
+ CAME 1,0
+ JRST L0615
+ MOVE 1,0
+ POPJ 15,0
+L0615: LDB 11,L0613
+ CAIE 11,9
+ JRST L0616
+ MOVE 1,0(1)
+ JRST SYMFNC+228
+L0616: MOVE 2,L0614
+ JRST SYMFNC+149
+L0613: point 6,1,5
+L0614: <30_30>+225
+ 1
+; (!*ENTRY CDDR EXPR 1)
+CDDR: intern CDDR
+ CAME 1,0
+ JRST L0619
+ MOVE 1,0
+ POPJ 15,0
+L0619: LDB 11,L0617
+ CAIE 11,9
+ JRST L0620
+ MOVE 1,1(1)
+ JRST SYMFNC+228
+L0620: MOVE 2,L0618
+ JRST SYMFNC+149
+L0617: point 6,1,5
+L0618: <30_30>+226
+ 1
+; (!*ENTRY ATOM EXPR 1)
+ATOM: intern ATOM
+ LDB 11,L0621
+ CAIE 11,9
+ JRST L0622
+ MOVE 1,0
+ POPJ 15,0
+L0622: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0621: point 6,1,5
+ 1
+; (!*ENTRY CONSTANTP EXPR 1)
+L0625: intern L0625
+ MOVE 2,1
+ LDB 11,L0623
+ CAIE 11,9
+ JRST L0626
+ MOVE 1,0
+ JRST L0627
+L0626: MOVE 1,SYMVAL+84
+L0627: CAMN 1,0
+ JRST L0628
+ MOVE 1,SYMVAL+84
+ LDB 11,L0624
+ CAIE 11,30
+ JRST L0628
+ MOVE 1,0
+L0628: POPJ 15,0
+L0623: point 6,1,5
+L0624: point 6,2,5
+ 1
+; (!*ENTRY NULL EXPR 1)
+NULL: intern NULL
+ CAMN 1,0
+ JRST L0629
+ MOVE 1,0
+ POPJ 15,0
+L0629: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 1
+; (!*ENTRY NUMBERP EXPR 1)
+L0632: intern L0632
+ MOVE 2,1
+ LDB 11,L0630
+ CAIG 11,2
+ JRST L0633
+ CAIN 11,63
+ JRST L0633
+ MOVE 1,0
+ JRST L0634
+L0633: MOVE 1,SYMVAL+84
+L0634: CAME 1,0
+ JRST L0635
+ MOVE 1,SYMVAL+84
+ LDB 11,L0631
+ CAIN 11,3
+ JRST L0635
+ MOVE 1,0
+L0635: POPJ 15,0
+L0630: point 6,1,5
+L0631: point 6,2,5
+L0641: 24
+ byte(7)73,108,108,101,103,97,108,32,97,114,103,117,109,101,110,116,115,32,116,111,32,69,120,112,116,0
+ 2
+; (!*ENTRY EXPT EXPR 2)
+EXPT: intern EXPT
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ LDB 11,L0637
+ CAIN 11,63
+ JRST L0636
+ CAILE 11,0
+ JRST L0642
+L0636: LDB 11,L0638
+ CAIG 11,3
+ JRST L0643
+ CAIN 11,63
+ JRST L0643
+L0642: PUSHJ 15,SYMFNC+234
+ MOVEM 1,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,L0639
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L0640
+ HRRZI 1,99
+ ADJSP 15,-4
+ JRST SYMFNC+236
+L0643: HRRZI 6,1
+ MOVEM 6,-2(15)
+ SETZM 2
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L0644
+ MOVEM 0,-3(15)
+ HRRZI 6,1
+ MOVEM 6,-3(15)
+L0645: MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+238
+ PUSHJ 15,SYMFNC+239
+ CAME 1,0
+ JRST L0646
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+240
+ MOVEM 1,-2(15)
+ MOVE 1,-3(15)
+ PUSHJ 15,SYMFNC+241
+ MOVEM 1,-3(15)
+ JRST L0645
+L0644: MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+239
+ CAMN 1,0
+ JRST L0646
+ MOVEM 0,-3(15)
+ SETOM -3(15)
+L0647: MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+238
+ MOVE 2,1
+ SETOM 1
+ PUSHJ 15,SYMFNC+240
+ PUSHJ 15,SYMFNC+239
+ CAME 1,0
+ JRST L0646
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+242
+ MOVEM 1,-2(15)
+ SETOM 2
+ MOVE 1,-3(15)
+ PUSHJ 15,SYMFNC+243
+ MOVEM 1,-3(15)
+ JRST L0647
+L0646: MOVE 1,-2(15)
+ ADJSP 15,-4
+ POPJ 15,0
+L0637: point 6,2,5
+L0638: point 6,1,5
+L0640: <4_30>+<1_18>+L0641
+L0639: <30_30>+233
+ 1
+; (!*ENTRY LIST FEXPR 1)
+LIST: intern LIST
+ JRST SYMFNC+245
+L0652: <30_30>+246
+ <9_30>+<1_18>+L0653
+L0653: <30_30>+247
+ <30_30>+128
+ 1
+; (!*ENTRY DE MACRO 1)
+DE: intern DE
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVE 2,1(2)
+ MOVE 1,L0648
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,L0649
+ PUSHJ 15,SYMFNC+249
+ MOVE 4,1
+ MOVE 3,L0650
+ MOVE 2,-1(15)
+ MOVE 1,L0651
+ ADJSP 15,-2
+ JRST SYMFNC+250
+L0651: <30_30>+251
+L0650: <9_30>+<1_18>+L0652
+L0649: <30_30>+252
+L0648: <30_30>+253
+L0658: <30_30>+246
+ <9_30>+<1_18>+L0659
+L0659: <30_30>+254
+ <30_30>+128
+ 1
+; (!*ENTRY DF MACRO 1)
+DF: intern DF
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVE 2,1(2)
+ MOVE 1,L0654
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,L0655
+ PUSHJ 15,SYMFNC+249
+ MOVE 4,1
+ MOVE 3,L0656
+ MOVE 2,-1(15)
+ MOVE 1,L0657
+ ADJSP 15,-2
+ JRST SYMFNC+250
+L0657: <30_30>+251
+L0656: <9_30>+<1_18>+L0658
+L0655: <30_30>+252
+L0654: <30_30>+253
+L0664: <30_30>+246
+ <9_30>+<1_18>+L0665
+L0665: <30_30>+256
+ <30_30>+128
+ 1
+; (!*ENTRY DM MACRO 1)
+DM: intern DM
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVE 2,1(2)
+ MOVE 1,L0660
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,L0661
+ PUSHJ 15,SYMFNC+249
+ MOVE 4,1
+ MOVE 3,L0662
+ MOVE 2,-1(15)
+ MOVE 1,L0663
+ ADJSP 15,-2
+ JRST SYMFNC+250
+L0663: <30_30>+251
+L0662: <9_30>+<1_18>+L0664
+L0661: <30_30>+252
+L0660: <30_30>+253
+L0670: <30_30>+246
+ <9_30>+<1_18>+L0671
+L0671: <30_30>+258
+ <30_30>+128
+ 1
+; (!*ENTRY DN MACRO 1)
+DN: intern DN
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVE 2,1(2)
+ MOVE 1,L0666
+ PUSHJ 15,SYMFNC+151
+ MOVE 2,1
+ MOVE 1,L0667
+ PUSHJ 15,SYMFNC+249
+ MOVE 4,1
+ MOVE 3,L0668
+ MOVE 2,-1(15)
+ MOVE 1,L0669
+ ADJSP 15,-2
+ JRST SYMFNC+250
+L0669: <30_30>+251
+L0668: <9_30>+<1_18>+L0670
+L0667: <30_30>+252
+L0666: <30_30>+253
+ 1
+; (!*ENTRY SETQ FEXPR 1)
+SETQ: intern SETQ
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+L0672: CAMN 0,0(15)
+ JRST L0673
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,-2(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+262
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0672
+L0673: MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+ 2
+; (!*ENTRY PROG2 EXPR 2)
+PROG2: intern PROG2
+ MOVE 1,2
+ POPJ 15,0
+ 1
+; (!*ENTRY PROGN FEXPR 1)
+PROGN: intern PROGN
+ JRST SYMFNC+265
+ 1
+; (!*ENTRY EVPROGN EXPR 1)
+L0676: intern L0676
+ PUSH 15,1
+ LDB 11,L0674
+ CAIE 11,9
+ JRST L0677
+L0678: MOVE 6,0(15)
+ LDB 11,L0675
+ CAIN 11,9
+ JRST L0679
+ MOVE 1,0
+ JRST L0680
+L0679: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0678
+L0680: MOVE 1,0(15)
+ MOVE 1,0(1)
+ ADJSP 15,-1
+ JRST SYMFNC+261
+L0677: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+L0674: point 6,1,5
+L0675: point 6,1(6),5
+ 1
+; (!*ENTRY AND FEXPR 1)
+AND: intern AND
+ JRST SYMFNC+267
+ 1
+; (!*ENTRY EVAND EXPR 1)
+EVAND: intern EVAND
+ LDB 11,L0681
+ CAIN 11,9
+ JRST L0682
+ MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0682: JRST EVAND1
+L0681: point 6,1,5
+; (!*ENTRY EVAND1 EXPR 1)
+EVAND1: intern EVAND1
+ ADJSP 15,1
+L0684: MOVEM 1,0(15)
+ LDB 11,L0683
+ CAIN 11,9
+ JRST L0685
+ MOVE 1,0(1)
+ ADJSP 15,-1
+ JRST SYMFNC+261
+L0685: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ CAME 1,0
+ JRST L0686
+ MOVE 1,0
+ JRST L0687
+L0686: MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L0684
+L0687: ADJSP 15,-1
+ POPJ 15,0
+L0683: point 6,1(1),5
+ 1
+; (!*ENTRY OR FEXPR 1)
+OR: intern OR
+ JRST SYMFNC+269
+ 1
+; (!*ENTRY EVOR EXPR 1)
+EVOR: intern EVOR
+ ADJSP 15,1
+L0689: MOVEM 1,0(15)
+ LDB 11,L0688
+ CAIN 11,9
+ JRST L0690
+ MOVE 1,0
+ JRST L0691
+L0690: MOVE 1,SYMVAL+84
+L0691: CAMN 1,0
+ JRST L0692
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ CAME 1,0
+ JRST L0692
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L0689
+L0692: ADJSP 15,-1
+ POPJ 15,0
+L0688: point 6,1,5
+ 1
+; (!*ENTRY COND FEXPR 1)
+COND: intern COND
+ JRST SYMFNC+271
+ 1
+; (!*ENTRY EVCOND EXPR 1)
+EVCOND: intern EVCOND
+ ADJSP 15,4
+L0697: MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L0693
+ CAIN 11,9
+ JRST L0698
+ MOVE 1,0
+ JRST L0699
+L0698: MOVE 2,0(1)
+ MOVEM 2,-1(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ LDB 11,L0694
+ CAIE 11,9
+ JRST L0700
+ MOVE 1,0(2)
+ JRST L0701
+L0700: MOVE 1,2
+L0701: MOVEM 1,-2(15)
+ PUSHJ 15,SYMFNC+261
+ MOVE 3,1
+ MOVEM 3,-3(15)
+ CAME 3,0
+ JRST L0702
+ MOVE 1,0(15)
+ JRST L0697
+L0702: LDB 11,L0695
+ CAIE 11,9
+ JRST L0703
+ MOVE 6,-1(15)
+ LDB 11,L0696
+ CAIN 11,9
+ JRST L0704
+L0703: MOVE 1,3
+ JRST L0699
+L0704: MOVE 1,-1(15)
+ MOVE 1,1(1)
+ ADJSP 15,-4
+ JRST SYMFNC+265
+L0699: ADJSP 15,-4
+ POPJ 15,0
+L0693: point 6,1,5
+L0694: point 6,2,5
+L0695: point 6,-1(15),5
+L0696: point 6,1(6),5
+ 1
+; (!*ENTRY NOT EXPR 1)
+NOT: intern NOT
+ CAMN 1,0
+ JRST L0705
+ MOVE 1,0
+ POPJ 15,0
+L0705: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 1
+; (!*ENTRY ABS EXPR 1)
+ABS: intern ABS
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+239
+ CAMN 1,0
+ JRST L0706
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+274
+L0706: MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L0709: 31
+ byte(7)65,116,116,101,109,112,116,32,116,111,32,100,105,118,105,100,101,32,98,121,32,48,32,105,110,32,68,73,86,73,68,69,0
+ 2
+; (!*ENTRY DIVIDE EXPR 2)
+DIVIDE: intern DIVIDE
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+276
+ CAMN 1,0
+ JRST L0710
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-2(15)
+ MOVE 1,L0707
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,L0708
+ HRRZI 1,99
+ ADJSP 15,-3
+ JRST SYMFNC+236
+L0710: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+242
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+277
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0708: <4_30>+<1_18>+L0709
+L0707: <30_30>+275
+ 1
+; (!*ENTRY MAX MACRO 1)
+MAX: intern MAX
+ SETZM 3
+ MOVE 2,L0711
+ MOVE 1,1(1)
+ JRST SYMFNC+280
+L0711: <30_30>+281
+ 2
+; (!*ENTRY MAX2 EXPR 2)
+MAX2: intern MAX2
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L0712
+ MOVE 1,-1(15)
+ JRST L0713
+L0712: MOVE 1,0(15)
+L0713: ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY MIN MACRO 1)
+MIN: intern MIN
+ SETZM 3
+ MOVE 2,L0714
+ MOVE 1,1(1)
+ JRST SYMFNC+280
+L0714: <30_30>+284
+ 2
+; (!*ENTRY MIN2 EXPR 2)
+MIN2: intern MIN2
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L0715
+ MOVE 1,-1(15)
+ JRST L0716
+L0715: MOVE 1,0(15)
+L0716: ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY PLUS MACRO 1)
+PLUS: intern PLUS
+ SETZM 3
+ MOVE 2,L0717
+ MOVE 1,1(1)
+ JRST SYMFNC+280
+L0717: <30_30>+243
+ 1
+; (!*ENTRY TIMES MACRO 1)
+TIMES: intern TIMES
+ HRRZI 3,1
+ MOVE 2,L0718
+ MOVE 1,1(1)
+ JRST SYMFNC+280
+L0718: <30_30>+240
+ 2
+; (!*ENTRY MAP EXPR 2)
+MAP: intern MAP
+ PUSH 15,2
+ PUSH 15,1
+L0720: LDB 11,L0719
+ CAIN 11,9
+ JRST L0721
+ MOVE 1,0
+ JRST L0722
+L0721: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0720
+L0722: ADJSP 15,-2
+ POPJ 15,0
+L0719: point 6,0(15),5
+ 2
+; (!*ENTRY MAPC EXPR 2)
+MAPC: intern MAPC
+ PUSH 15,2
+ PUSH 15,1
+L0724: LDB 11,L0723
+ CAIN 11,9
+ JRST L0725
+ MOVE 1,0
+ JRST L0726
+L0725: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0724
+L0726: ADJSP 15,-2
+ POPJ 15,0
+L0723: point 6,0(15),5
+ 2
+; (!*ENTRY MAPCAN EXPR 2)
+MAPCAN: intern MAPCAN
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0727
+ CAIN 11,9
+ JRST L0728
+ MOVE 1,0
+ JRST L0729
+L0728: MOVE 1,0(1)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,MAPCAN
+ MOVE 2,1
+ MOVE 1,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+291
+L0729: ADJSP 15,-3
+ POPJ 15,0
+L0727: point 6,1,5
+ 2
+; (!*ENTRY MAPCON EXPR 2)
+MAPCON: intern MAPCON
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0730
+ CAIN 11,9
+ JRST L0731
+ MOVE 1,0
+ JRST L0732
+L0731: MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,MAPCON
+ MOVE 2,1
+ MOVE 1,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+291
+L0732: ADJSP 15,-3
+ POPJ 15,0
+L0730: point 6,1,5
+ 2
+; (!*ENTRY MAPCAR EXPR 2)
+MAPCAR: intern MAPCAR
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0733
+ CAIN 11,9
+ JRST L0734
+ MOVE 1,0
+ JRST L0735
+L0734: MOVE 1,0(1)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,MAPCAR
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0735: ADJSP 15,-3
+ POPJ 15,0
+L0733: point 6,1,5
+ 2
+; (!*ENTRY MAPLIST EXPR 2)
+L0737: intern L0737
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0736
+ CAIN 11,9
+ JRST L0738
+ MOVE 1,0
+ JRST L0739
+L0738: MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,L0737
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0739: ADJSP 15,-3
+ POPJ 15,0
+L0736: point 6,1,5
+ 2
+; (!*ENTRY APPEND EXPR 2)
+APPEND: intern APPEND
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0740
+ CAIN 11,9
+ JRST L0742
+ MOVE 1,2
+ JRST L0743
+L0742: MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+172
+ MOVE 3,1
+ MOVEM 3,-3(15)
+ MOVEM 3,-2(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+L0744: LDB 11,L0741
+ CAIE 11,9
+ JRST L0745
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+172
+ MOVE 7,-3(15)
+ MOVEM 1,1(7)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+ MOVE 3,-3(15)
+ MOVE 3,1(3)
+ MOVEM 3,-3(15)
+ JRST L0744
+L0745: MOVE 7,-3(15)
+ MOVE 6,-1(15)
+ MOVEM 6,1(7)
+ MOVE 1,-2(15)
+L0743: ADJSP 15,-4
+ POPJ 15,0
+L0740: point 6,1,5
+L0741: point 6,0(15),5
+ 2
+; (!*ENTRY ASSOC EXPR 2)
+ASSOC: intern ASSOC
+ ADJSP 15,2
+L0748: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0746
+ CAIN 11,9
+ JRST L0749
+ MOVE 1,0
+ JRST L0750
+L0749: LDB 11,L0747
+ CAIE 11,9
+ JRST L0751
+ MOVE 2,0(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0751
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ JRST L0750
+L0751: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L0748
+L0750: ADJSP 15,-2
+ POPJ 15,0
+L0746: point 6,2,5
+L0747: point 6,0(2),5
+ 3
+; (!*ENTRY SASSOC EXPR 3)
+SASSOC: intern SASSOC
+ ADJSP 15,3
+L0754: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L0752
+ CAIN 11,9
+ JRST L0755
+ MOVE 1,3
+ MOVE 6,1
+ ADJSP 15,-3
+ JRST SYMFNC+288
+L0755: LDB 11,L0753
+ CAIE 11,9
+ JRST L0756
+ MOVE 2,0(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0756
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ JRST L0757
+L0756: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L0754
+L0757: ADJSP 15,-3
+ POPJ 15,0
+L0752: point 6,2,5
+L0753: point 6,0(2),5
+L0761: 29
+ byte(7)68,105,102,102,101,114,101,110,116,32,108,101,110,103,116,104,32,108,105,115,116,115,32,105,110,32,80,65,73,82,0
+ 2
+; (!*ENTRY PAIR EXPR 2)
+PAIR: intern PAIR
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0758
+ CAIE 11,9
+ JRST L0762
+ LDB 11,L0759
+ CAIE 11,9
+ JRST L0762
+ MOVE 2,0(2)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,PAIR
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0762: LDB 11,L0758
+ CAIN 11,9
+ JRST L0763
+ LDB 11,L0759
+ CAIE 11,9
+ JRST L0764
+L0763: MOVE 1,L0760
+ ADJSP 15,-3
+ JRST SYMFNC+156
+L0764: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L0758: point 6,1,5
+L0759: point 6,2,5
+L0760: <4_30>+<1_18>+L0761
+ 2
+; (!*ENTRY SUBLIS EXPR 2)
+SUBLIS: intern SUBLIS
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0765
+ CAIN 11,9
+ JRST L0767
+ MOVE 1,2
+ JRST L0768
+L0767: MOVEM 0,-2(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+295
+ MOVEM 1,-2(15)
+ LDB 11,L0765
+ CAIE 11,9
+ JRST L0769
+ MOVE 1,1(1)
+ JRST L0768
+L0769: LDB 11,L0766
+ CAIN 11,9
+ JRST L0770
+ MOVE 1,-1(15)
+ JRST L0768
+L0770: MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SUBLIS
+ MOVEM 1,-3(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SUBLIS
+ MOVE 2,-3(15)
+ ADJSP 15,-4
+ JRST SYMFNC+278
+L0768: ADJSP 15,-4
+ POPJ 15,0
+L0765: point 6,1,5
+L0766: point 6,-1(15),5
+ 2
+; (!*ENTRY DEFLIST EXPR 2)
+L0772: intern L0772
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0771
+ CAIN 11,9
+ JRST L0773
+ MOVE 1,0
+ JRST L0774
+L0773: MOVE 3,0(1)
+ MOVE 3,1(3)
+ MOVE 3,0(3)
+ MOVE 1,0(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+300
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ MOVE 1,0(1)
+ MOVEM 1,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,L0772
+ MOVE 2,-2(15)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0774: ADJSP 15,-3
+ POPJ 15,0
+L0771: point 6,1,5
+ 2
+; (!*ENTRY DELETE EXPR 2)
+DELETE: intern DELETE
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L0775
+ CAIN 11,9
+ JRST L0776
+ MOVE 1,2
+ JRST L0777
+L0776: MOVE 2,1
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0778
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ JRST L0777
+L0778: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,DELETE
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L0777: ADJSP 15,-2
+ POPJ 15,0
+L0775: point 6,2,5
+ 2
+; (!*ENTRY MEMBER EXPR 2)
+MEMBER: intern MEMBER
+ ADJSP 15,2
+L0780: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0779
+ CAIN 11,9
+ JRST L0781
+ MOVE 1,0
+ JRST L0782
+L0781: MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0783
+ MOVE 1,-1(15)
+ JRST L0782
+L0783: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L0780
+L0782: ADJSP 15,-2
+ POPJ 15,0
+L0779: point 6,2,5
+ 2
+; (!*ENTRY MEMQ EXPR 2)
+MEMQ: intern MEMQ
+L0785: LDB 11,L0784
+ CAIN 11,9
+ JRST L0786
+ MOVE 1,0
+ POPJ 15,0
+L0786: CAME 1,0(2)
+ JRST L0787
+ MOVE 1,2
+ POPJ 15,0
+L0787: MOVE 2,1(2)
+ JRST L0785
+L0784: point 6,2,5
+ 2
+; (!*ENTRY NCONC EXPR 2)
+NCONC: intern NCONC
+ MOVE 5,1
+ MOVE 4,2
+ MOVE 3,0
+ LDB 11,L0788
+ CAIN 11,9
+ JRST L0790
+ MOVE 1,2
+ POPJ 15,0
+L0790: MOVE 3,1
+L0791: LDB 11,L0789
+ CAIE 11,9
+ JRST L0792
+ MOVE 1,1(3)
+ MOVE 3,1
+ JRST L0791
+L0792: MOVEM 4,1(3)
+ MOVE 1,5
+ POPJ 15,0
+L0788: point 6,1,5
+L0789: point 6,1(3),5
+ 1
+; (!*ENTRY REVERSE EXPR 1)
+L0794: intern L0794
+ PUSH 15,0
+ PUSH 15,1
+L0795: LDB 11,L0793
+ CAIE 11,9
+ JRST L0796
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+ JRST L0795
+L0796: MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L0793: point 6,0(15),5
+ 3
+; (!*ENTRY SUBST EXPR 3)
+SUBST: intern SUBST
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ CAME 3,0
+ JRST L0798
+ MOVE 1,0
+ JRST L0799
+L0798: MOVE 2,3
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0800
+ MOVE 1,0(15)
+ JRST L0799
+L0800: LDB 11,L0797
+ CAIN 11,9
+ JRST L0801
+ MOVE 1,-2(15)
+ JRST L0799
+L0801: MOVE 3,-2(15)
+ MOVE 3,0(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SUBST
+ MOVEM 1,-3(15)
+ MOVE 3,-2(15)
+ MOVE 3,1(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SUBST
+ MOVE 2,-3(15)
+ ADJSP 15,-4
+ JRST SYMFNC+278
+L0799: ADJSP 15,-4
+ POPJ 15,0
+L0797: point 6,-2(15),5
+ 1
+; (!*ENTRY EVLIS EXPR 1)
+EVLIS: intern EVLIS
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ LDB 11,L0802
+ CAIN 11,9
+ JRST L0803
+ MOVE 1,0
+ JRST L0804
+L0803: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,EVLIS
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L0804: ADJSP 15,-2
+ POPJ 15,0
+L0802: point 6,1,5
+ 3
+; (!*ENTRY ROBUSTEXPAND EXPR 3)
+L0805: intern L0805
+ CAME 1,0
+ JRST L0806
+ MOVE 1,3
+ POPJ 15,0
+L0806: JRST SYMFNC+306
+ 2
+; (!*ENTRY EXPAND EXPR 2)
+EXPAND: intern EXPAND
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L0807
+ CAIE 11,9
+ JRST L0809
+ LDB 11,L0808
+ CAIN 11,9
+ JRST L0810
+ MOVE 1,0(1)
+ JRST L0809
+L0810: MOVE 1,1(1)
+ PUSHJ 15,EXPAND
+ MOVE 3,1
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+235
+L0809: ADJSP 15,-2
+ POPJ 15,0
+L0807: point 6,1,5
+L0808: point 6,1(1),5
+ 1
+; (!*ENTRY QUOTE FEXPR 1)
+QUOTE: intern QUOTE
+ MOVE 1,0(1)
+ POPJ 15,0
+ 1
+; (!*ENTRY FUNCTION FEXPR 1)
+L0811: intern L0811
+ MOVE 1,0(1)
+ POPJ 15,0
+ 2
+; (!*ENTRY CHANNELPRINT EXPR 2)
+L0812: intern L0812
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+308
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+309
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY PRINT EXPR 1)
+PRINT: intern PRINT
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+307
+ 2
+; (!*ENTRY NEQ EXPR 2)
+NEQ: intern NEQ
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0813
+ MOVE 1,0
+ POPJ 15,0
+L0813: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 2
+; (!*ENTRY NE EXPR 2)
+NE: intern NE
+ CAME 1,2
+ JRST L0814
+ MOVE 1,0
+ POPJ 15,0
+L0814: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 2
+; (!*ENTRY GEQ EXPR 2)
+GEQ: intern GEQ
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L0815
+ MOVE 1,0
+ POPJ 15,0
+L0815: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 2
+; (!*ENTRY LEQ EXPR 2)
+LEQ: intern LEQ
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L0816
+ MOVE 1,0
+ POPJ 15,0
+L0816: MOVE 1,SYMVAL+84
+ POPJ 15,0
+ 2
+; (!*ENTRY EQCAR EXPR 2)
+EQCAR: intern EQCAR
+ MOVE 3,1
+ LDB 11,L0817
+ CAIN 11,9
+ JRST L0818
+ MOVE 1,0
+ JRST L0819
+L0818: MOVE 1,SYMVAL+84
+L0819: CAMN 1,0
+ JRST L0820
+ MOVE 1,0(3)
+ CAMN 1,2
+ JRST L0821
+ MOVE 1,0
+ POPJ 15,0
+L0821: MOVE 1,SYMVAL+84
+L0820: POPJ 15,0
+L0817: point 6,1,5
+ 1
+; (!*ENTRY EXPRP EXPR 1)
+EXPRP: intern EXPRP
+ PUSH 15,1
+ PUSH 15,1
+ LDB 11,L0822
+ CAIN 11,9
+ JRST L0826
+ MOVE 1,0
+ JRST L0827
+L0826: MOVE 1,SYMVAL+84
+L0827: CAMN 1,0
+ JRST L0828
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ CAMN 1,L0823
+ JRST L0829
+ MOVE 1,0
+ JRST L0828
+L0829: MOVE 1,SYMVAL+84
+L0828: CAME 1,0
+ JRST L0830
+ MOVE 1,SYMVAL+84
+ LDB 11,L0824
+ CAIN 11,15
+ JRST L0831
+ MOVE 1,0
+L0831: CAME 1,0
+ JRST L0830
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+318
+ MOVEM 1,-1(15)
+ LDB 11,L0822
+ CAIN 11,9
+ JRST L0832
+ MOVE 1,0
+ JRST L0833
+L0832: MOVE 1,SYMVAL+84
+L0833: CAMN 1,0
+ JRST L0830
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ CAMN 1,L0825
+ JRST L0834
+ MOVE 1,0
+ JRST L0830
+L0834: MOVE 1,SYMVAL+84
+L0830: ADJSP 15,-2
+ POPJ 15,0
+L0822: point 6,1,5
+L0824: point 6,0(15),5
+L0825: <30_30>+247
+L0823: <30_30>+253
+ 1
+; (!*ENTRY MACROP EXPR 1)
+MACROP: intern MACROP
+ ADJSP 15,1
+ PUSHJ 15,SYMFNC+318
+ MOVEM 1,0(15)
+ LDB 11,L0835
+ CAIN 11,9
+ JRST L0837
+ MOVE 1,0
+ JRST L0838
+L0837: MOVE 1,SYMVAL+84
+L0838: CAMN 1,0
+ JRST L0839
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ CAMN 1,L0836
+ JRST L0840
+ MOVE 1,0
+ JRST L0839
+L0840: MOVE 1,SYMVAL+84
+L0839: ADJSP 15,-1
+ POPJ 15,0
+L0835: point 6,1,5
+L0836: <30_30>+256
+ 1
+; (!*ENTRY FEXPRP EXPR 1)
+FEXPRP: intern FEXPRP
+ ADJSP 15,1
+ PUSHJ 15,SYMFNC+318
+ MOVEM 1,0(15)
+ LDB 11,L0841
+ CAIN 11,9
+ JRST L0843
+ MOVE 1,0
+ JRST L0844
+L0843: MOVE 1,SYMVAL+84
+L0844: CAMN 1,0
+ JRST L0845
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ CAMN 1,L0842
+ JRST L0846
+ MOVE 1,0
+ JRST L0845
+L0846: MOVE 1,SYMVAL+84
+L0845: ADJSP 15,-1
+ POPJ 15,0
+L0841: point 6,1,5
+L0842: <30_30>+254
+ 1
+; (!*ENTRY NEXPRP EXPR 1)
+NEXPRP: intern NEXPRP
+ ADJSP 15,1
+ PUSHJ 15,SYMFNC+318
+ MOVEM 1,0(15)
+ LDB 11,L0847
+ CAIN 11,9
+ JRST L0849
+ MOVE 1,0
+ JRST L0850
+L0849: MOVE 1,SYMVAL+84
+L0850: CAMN 1,0
+ JRST L0851
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ CAMN 1,L0848
+ JRST L0852
+ MOVE 1,0
+ JRST L0851
+L0852: MOVE 1,SYMVAL+84
+L0851: ADJSP 15,-1
+ POPJ 15,0
+L0847: point 6,1,5
+L0848: <30_30>+258
+L0855: 28
+ byte(7)37,114,32,104,97,115,32,110,111,32,100,101,102,105,110,105,116,105,111,110,32,105,110,32,67,111,112,121,68,0
+ 2
+; (!*ENTRY COPYD EXPR 2)
+COPYD: intern COPYD
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+318
+ MOVEM 1,-2(15)
+ LDB 11,L0853
+ CAIE 11,9
+ JRST L0856
+ MOVE 3,1(1)
+ MOVE 2,0(1)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+251
+ JRST L0857
+L0856: MOVE 2,-1(15)
+ MOVE 1,L0854
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+L0857: MOVE 1,0(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L0853: point 6,1,5
+L0854: <4_30>+<1_18>+L0855
+L0859: 1
+ 1.0
+ 0
+ 1
+; (!*ENTRY RECIP EXPR 1)
+RECIP: intern RECIP
+ MOVE 2,1
+ MOVE 1,L0858
+ JRST SYMFNC+242
+L0858: <3_30>+<1_18>+L0859
+ 1
+; (!*ENTRY MKQUOTE EXPR 1)
+L0861: intern L0861
+ MOVE 2,1
+ MOVE 1,L0860
+ JRST SYMFNC+249
+L0860: <30_30>+246
+ 1
+; (!*ENTRY FIRST MACRO 1)
+FIRST: intern FIRST
+ MOVE 2,1(1)
+ MOVE 1,L0862
+ JRST SYMFNC+151
+L0862: <30_30>+187
+ 1
+; (!*ENTRY SECOND MACRO 1)
+SECOND: intern SECOND
+ MOVE 2,1(1)
+ MOVE 1,L0863
+ JRST SYMFNC+151
+L0863: <30_30>+224
+ 1
+; (!*ENTRY THIRD MACRO 1)
+THIRD: intern THIRD
+ MOVE 2,1(1)
+ MOVE 1,L0864
+ JRST SYMFNC+151
+L0864: <30_30>+209
+ 1
+; (!*ENTRY FOURTH MACRO 1)
+FOURTH: intern FOURTH
+ MOVE 2,1(1)
+ MOVE 1,L0865
+ JRST SYMFNC+151
+L0865: <30_30>+210
+ 1
+; (!*ENTRY REST MACRO 1)
+REST: intern REST
+ MOVE 2,1(1)
+ MOVE 1,L0866
+ JRST SYMFNC+151
+L0866: <30_30>+188
+ 1
+; (!*ENTRY REVERSIP EXPR 1)
+L0868: intern L0868
+ MOVE 5,1
+ MOVE 4,0
+ MOVE 3,0
+L0869: LDB 11,L0867
+ CAIE 11,9
+ JRST L0870
+ MOVE 1,1(5)
+ MOVE 4,1
+ MOVE 2,5
+ MOVEM 3,1(2)
+ MOVE 3,2
+ MOVE 5,1
+ JRST L0869
+L0870: MOVE 1,3
+ POPJ 15,0
+L0867: point 6,5,5
+; (!*ENTRY SUBSTIP1 EXPR 3)
+L0873: intern L0873
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 2,0(3)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0874
+ MOVE 7,-2(15)
+ MOVE 6,0(15)
+ MOVEM 6,0(7)
+ JRST L0875
+L0874: MOVE 6,-2(15)
+ LDB 11,L0871
+ CAIE 11,9
+ JRST L0875
+ MOVE 3,-2(15)
+ MOVE 3,0(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+330
+L0875: MOVE 6,-2(15)
+ LDB 11,L0872
+ CAIE 11,9
+ JRST L0876
+ MOVE 3,-2(15)
+ MOVE 3,1(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST SYMFNC+330
+L0876: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L0871: point 6,0(6),5
+L0872: point 6,1(6),5
+ 3
+; (!*ENTRY SUBSTIP EXPR 3)
+L0878: intern L0878
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ CAME 3,0
+ JRST L0879
+ MOVE 1,0
+ JRST L0880
+L0879: MOVE 2,3
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0881
+ MOVE 1,0(15)
+ JRST L0880
+L0881: LDB 11,L0877
+ CAIE 11,9
+ JRST L0882
+ MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,L0873
+L0882: MOVE 1,-2(15)
+L0880: ADJSP 15,-3
+ POPJ 15,0
+L0877: point 6,-2(15),5
+; (!*ENTRY DELETIP1 EXPR 2)
+L0884: intern L0884
+ ADJSP 15,2
+L0885: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0883
+ CAIE 11,9
+ JRST L0886
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0887
+ MOVE 1,-1(15)
+ MOVE 6,1(1)
+ MOVE 6,1(6)
+ MOVEM 6,1(1)
+ JRST L0888
+L0887: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L0885
+L0886: MOVE 1,0
+L0888: ADJSP 15,-2
+ POPJ 15,0
+L0883: point 6,1(2),5
+ 2
+; (!*ENTRY DELETIP EXPR 2)
+L0890: intern L0890
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L0889
+ CAIN 11,9
+ JRST L0891
+ MOVE 1,2
+ JRST L0892
+L0891: MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0893
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ JRST L0892
+L0893: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,L0884
+ MOVE 1,-1(15)
+L0892: ADJSP 15,-2
+ POPJ 15,0
+L0889: point 6,2,5
+ 2
+; (!*ENTRY DELQ EXPR 2)
+DELQ: intern DELQ
+ PUSH 15,2
+ LDB 11,L0894
+ CAIN 11,9
+ JRST L0895
+ MOVE 1,2
+ JRST L0896
+L0895: CAME 1,0(2)
+ JRST L0897
+ MOVE 1,1(2)
+ JRST L0896
+L0897: MOVE 2,1(2)
+ PUSHJ 15,DELQ
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ ADJSP 15,-1
+ JRST SYMFNC+278
+L0896: ADJSP 15,-1
+ POPJ 15,0
+L0894: point 6,2,5
+ 3
+; (!*ENTRY DEL EXPR 3)
+DEL: intern DEL
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L0898
+ CAIN 11,9
+ JRST L0899
+ MOVE 1,3
+ JRST L0900
+L0899: MOVE 3,1
+ MOVE 1,-2(15)
+ MOVE 1,0(1)
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+ CAMN 1,0
+ JRST L0901
+ MOVE 1,-2(15)
+ MOVE 1,1(1)
+ JRST L0900
+L0901: MOVE 3,-2(15)
+ MOVE 3,1(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,DEL
+ MOVE 2,-2(15)
+ MOVE 2,0(2)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0900: ADJSP 15,-3
+ POPJ 15,0
+L0898: point 6,3,5
+; (!*ENTRY DELQIP1 EXPR 2)
+L0903: intern L0903
+L0904: LDB 11,L0902
+ CAIE 11,9
+ JRST L0905
+ MOVE 7,1(2)
+ CAME 1,0(7)
+ JRST L0906
+ MOVE 1,2
+ MOVE 6,1(1)
+ MOVE 6,1(6)
+ MOVEM 6,1(1)
+ POPJ 15,0
+L0906: MOVE 2,1(2)
+ JRST L0904
+L0905: MOVE 1,0
+ POPJ 15,0
+L0902: point 6,1(2),5
+ 2
+; (!*ENTRY DELQIP EXPR 2)
+DELQIP: intern DELQIP
+ PUSH 15,2
+ LDB 11,L0907
+ CAIN 11,9
+ JRST L0908
+ MOVE 1,2
+ JRST L0909
+L0908: CAME 1,0(2)
+ JRST L0910
+ MOVE 1,1(2)
+ JRST L0909
+L0910: PUSHJ 15,L0903
+ MOVE 1,0(15)
+L0909: ADJSP 15,-1
+ POPJ 15,0
+L0907: point 6,2,5
+ 2
+; (!*ENTRY ATSOC EXPR 2)
+ATSOC: intern ATSOC
+L0913: LDB 11,L0911
+ CAIN 11,9
+ JRST L0914
+ MOVE 1,0
+ POPJ 15,0
+L0914: LDB 11,L0912
+ CAIE 11,9
+ JRST L0915
+ MOVE 7,0(2)
+ CAME 1,0(7)
+ JRST L0915
+ MOVE 1,0(2)
+ POPJ 15,0
+L0915: MOVE 2,1(2)
+ JRST L0913
+L0911: point 6,2,5
+L0912: point 6,0(2),5
+ 3
+; (!*ENTRY ASS EXPR 3)
+ASS: intern ASS
+ ADJSP 15,3
+L0918: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L0916
+ CAIN 11,9
+ JRST L0919
+ MOVE 1,0
+ JRST L0920
+L0919: LDB 11,L0917
+ CAIE 11,9
+ JRST L0921
+ MOVE 3,1
+ MOVE 2,-2(15)
+ MOVE 2,0(2)
+ MOVE 2,0(2)
+ MOVE 1,-1(15)
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+ CAMN 1,0
+ JRST L0921
+ MOVE 1,-2(15)
+ MOVE 1,0(1)
+ JRST L0920
+L0921: MOVE 3,-2(15)
+ MOVE 3,1(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ JRST L0918
+L0920: ADJSP 15,-3
+ POPJ 15,0
+L0916: point 6,3,5
+L0917: point 6,0(3),5
+ 3
+; (!*ENTRY MEM EXPR 3)
+MEM: intern MEM
+ ADJSP 15,3
+L0923: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ LDB 11,L0922
+ CAIN 11,9
+ JRST L0924
+ MOVE 1,0
+ JRST L0925
+L0924: MOVE 3,1
+ MOVE 2,-2(15)
+ MOVE 2,0(2)
+ MOVE 1,-1(15)
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+ CAMN 1,0
+ JRST L0926
+ MOVE 1,-2(15)
+ JRST L0925
+L0926: MOVE 3,-2(15)
+ MOVE 3,1(3)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ JRST L0923
+L0925: ADJSP 15,-3
+ POPJ 15,0
+L0922: point 6,3,5
+ 2
+; (!*ENTRY RASSOC EXPR 2)
+RASSOC: intern RASSOC
+ ADJSP 15,2
+L0929: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0927
+ CAIN 11,9
+ JRST L0930
+ MOVE 1,0
+ JRST L0931
+L0930: LDB 11,L0928
+ CAIE 11,9
+ JRST L0932
+ MOVE 2,0(2)
+ MOVE 2,1(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0932
+ MOVE 1,-1(15)
+ MOVE 1,0(1)
+ JRST L0931
+L0932: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L0929
+L0931: ADJSP 15,-2
+ POPJ 15,0
+L0927: point 6,2,5
+L0928: point 6,0(2),5
+ 2
+; (!*ENTRY DELASC EXPR 2)
+DELASC: intern DELASC
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L0933
+ CAIN 11,9
+ JRST L0935
+ MOVE 1,0
+ JRST L0936
+L0935: LDB 11,L0934
+ CAIE 11,9
+ JRST L0937
+ MOVE 2,0(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0937
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ JRST L0936
+L0937: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,DELASC
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L0936: ADJSP 15,-2
+ POPJ 15,0
+L0933: point 6,2,5
+L0934: point 6,0(2),5
+; (!*ENTRY DELASCIP1 EXPR 2)
+L0940: intern L0940
+ ADJSP 15,2
+L0941: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0938
+ CAIE 11,9
+ JRST L0942
+ MOVE 6,1(2)
+ LDB 11,L0939
+ CAIE 11,9
+ JRST L0943
+ MOVE 2,1(2)
+ MOVE 2,0(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0943
+ MOVE 1,-1(15)
+ MOVE 6,1(1)
+ MOVE 6,1(6)
+ MOVEM 6,1(1)
+ JRST L0944
+L0943: MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ JRST L0941
+L0942: MOVE 1,0
+L0944: ADJSP 15,-2
+ POPJ 15,0
+L0938: point 6,1(2),5
+L0939: point 6,0(6),5
+ 2
+; (!*ENTRY DELASCIP EXPR 2)
+L0947: intern L0947
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L0945
+ CAIN 11,9
+ JRST L0948
+ MOVE 1,0
+ JRST L0949
+L0948: LDB 11,L0946
+ CAIE 11,9
+ JRST L0950
+ MOVE 2,0(2)
+ MOVE 2,0(2)
+ PUSHJ 15,SYMFNC+198
+ CAMN 1,0
+ JRST L0950
+ MOVE 1,-1(15)
+ MOVE 1,1(1)
+ JRST L0949
+L0950: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,L0940
+ MOVE 1,-1(15)
+L0949: ADJSP 15,-2
+ POPJ 15,0
+L0945: point 6,2,5
+L0946: point 6,0(2),5
+ 2
+; (!*ENTRY DELATQ EXPR 2)
+DELATQ: intern DELATQ
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L0951
+ CAIN 11,9
+ JRST L0953
+ MOVE 1,0
+ JRST L0954
+L0953: MOVE 1,0(2)
+ MOVEM 1,-2(15)
+ LDB 11,L0952
+ CAIN 11,9
+ JRST L0955
+ MOVE 1,0
+ JRST L0956
+L0955: MOVE 1,SYMVAL+84
+L0956: CAMN 1,0
+ JRST L0957
+ MOVE 1,-2(15)
+ MOVE 1,0(1)
+ CAMN 1,0(15)
+ JRST L0958
+ MOVE 1,0
+ JRST L0957
+L0958: MOVE 1,SYMVAL+84
+L0957: CAMN 1,0
+ JRST L0959
+ MOVE 1,1(2)
+ JRST L0954
+L0959: MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,DELATQ
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ ADJSP 15,-3
+ JRST SYMFNC+278
+L0954: ADJSP 15,-3
+ POPJ 15,0
+L0951: point 6,2,5
+L0952: point 6,1,5
+; (!*ENTRY DELATQIP1 EXPR 2)
+L0962: intern L0962
+L0963: LDB 11,L0960
+ CAIE 11,9
+ JRST L0964
+ MOVE 6,1(2)
+ LDB 11,L0961
+ CAIE 11,9
+ JRST L0965
+ MOVE 7,1(2)
+ MOVE 7,0(7)
+ CAME 1,0(7)
+ JRST L0965
+ MOVE 1,2
+ MOVE 6,1(1)
+ MOVE 6,1(6)
+ MOVEM 6,1(1)
+ POPJ 15,0
+L0965: MOVE 2,1(2)
+ JRST L0963
+L0964: MOVE 1,0
+ POPJ 15,0
+L0960: point 6,1(2),5
+L0961: point 6,0(6),5
+ 2
+; (!*ENTRY DELATQIP EXPR 2)
+L0968: intern L0968
+ PUSH 15,2
+ LDB 11,L0966
+ CAIN 11,9
+ JRST L0969
+ MOVE 1,0
+ JRST L0970
+L0969: LDB 11,L0967
+ CAIE 11,9
+ JRST L0971
+ MOVE 7,0(2)
+ CAME 1,0(7)
+ JRST L0971
+ MOVE 1,1(2)
+ JRST L0970
+L0971: PUSHJ 15,L0962
+ MOVE 1,0(15)
+L0970: ADJSP 15,-1
+ POPJ 15,0
+L0966: point 6,2,5
+L0967: point 6,0(2),5
+ 2
+; (!*ENTRY SUBLA EXPR 2)
+SUBLA: intern SUBLA
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ LDB 11,L0972
+ CAIE 11,9
+ JRST L0974
+ CAME 2,0
+ JRST L0975
+L0974: MOVE 1,2
+ JRST L0976
+L0975: LDB 11,L0973
+ CAIN 11,9
+ JRST L0977
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+335
+ MOVE 3,1
+ MOVEM 3,-2(15)
+ CAMN 3,0
+ JRST L0978
+ MOVE 1,1(3)
+ JRST L0976
+L0978: MOVE 1,-1(15)
+ JRST L0976
+L0977: MOVE 2,0(2)
+ PUSHJ 15,SUBLA
+ MOVEM 1,-3(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVE 1,0(15)
+ PUSHJ 15,SUBLA
+ MOVE 2,-3(15)
+ ADJSP 15,-4
+ JRST SYMFNC+278
+L0976: ADJSP 15,-4
+ POPJ 15,0
+L0972: point 6,1,5
+L0973: point 6,2,5
+ 2
+; (!*ENTRY RPLACW EXPR 2)
+RPLACW: intern RPLACW
+ MOVE 3,2
+ LDB 11,L0979
+ CAIE 11,9
+ JRST L0982
+ LDB 11,L0980
+ CAIE 11,9
+ JRST L0983
+ MOVE 6,1(2)
+ MOVEM 6,1(1)
+ MOVE 6,0(2)
+ MOVEM 6,0(1)
+ POPJ 15,0
+L0983: MOVE 2,L0981
+ MOVE 1,3
+ JRST L0984
+L0982: MOVE 2,L0981
+L0984: JRST SYMFNC+149
+L0979: point 6,1,5
+L0980: point 6,2,5
+L0981: <30_30>+344
+ 1
+; (!*ENTRY LASTCAR EXPR 1)
+L0986: intern L0986
+ LDB 11,L0985
+ CAIE 11,9
+ JRST L0987
+ PUSHJ 15,SYMFNC+346
+ MOVE 1,0(1)
+L0987: POPJ 15,0
+L0985: point 6,1,5
+ 1
+; (!*ENTRY LASTPAIR EXPR 1)
+L0990: intern L0990
+L0991: LDB 11,L0988
+ CAIE 11,9
+ JRST L0992
+ LDB 11,L0989
+ CAIE 11,9
+ JRST L0992
+ MOVE 1,1(1)
+ JRST L0991
+L0992: POPJ 15,0
+L0988: point 6,1,5
+L0989: point 6,1(1),5
+ 1
+; (!*ENTRY COPY EXPR 1)
+COPY: intern COPY
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ LDB 11,L0993
+ CAIE 11,9
+ JRST L0994
+ MOVE 1,0(1)
+ PUSHJ 15,COPY
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,COPY
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L0994: ADJSP 15,-2
+ POPJ 15,0
+L0993: point 6,1,5
+ 2
+; (!*ENTRY NTH EXPR 2)
+NTH: intern NTH
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,DOPNTH
+ LDB 11,L0995
+ CAIE 11,9
+ JRST L0997
+ MOVE 1,0(1)
+ JRST L0998
+L0997: MOVE 3,L0996
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+165
+L0998: ADJSP 15,-2
+ POPJ 15,0
+L0995: point 6,1,5
+L0996: <30_30>+348
+; (!*ENTRY DOPNTH EXPR 2)
+DOPNTH: intern DOPNTH
+ ADJSP 15,1
+L1000: MOVEM 1,0(15)
+ CAIN 2,1
+ JRST L1001
+ LDB 11,L0999
+ CAIE 11,9
+ JRST L1001
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+349
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L1000
+L1001: ADJSP 15,-1
+ POPJ 15,0
+L0999: point 6,1,5
+ 2
+; (!*ENTRY PNTH EXPR 2)
+PNTH: intern PNTH
+ ADJSP 15,1
+L1004: MOVEM 1,0(15)
+ CAIN 2,1
+ JRST L1005
+ LDB 11,L1002
+ CAIN 11,9
+ JRST L1006
+ MOVE 3,L1003
+ ADJSP 15,-1
+ JRST SYMFNC+165
+L1006: MOVE 1,2
+ PUSHJ 15,SYMFNC+349
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L1004
+L1005: ADJSP 15,-1
+ POPJ 15,0
+L1002: point 6,1,5
+L1003: <30_30>+350
+ 2
+; (!*ENTRY ACONC EXPR 2)
+ACONC: intern ACONC
+ PUSH 15,1
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+291
+ 2
+; (!*ENTRY TCONC EXPR 2)
+TCONC: intern TCONC
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-1(15)
+ LDB 11,L1007
+ CAIN 11,9
+ JRST L1008
+ MOVE 2,1
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L1008: MOVE 7,0(15)
+ CAME 0,1(7)
+ JRST L1009
+ MOVE 7,0(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+ MOVE 6,-1(15)
+ MOVEM 6,0(1)
+ JRST L1010
+L1009: MOVE 7,0(15)
+ MOVE 7,1(7)
+ MOVEM 1,1(7)
+ MOVE 7,0(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+L1010: ADJSP 15,-2
+ POPJ 15,0
+L1007: point 6,0(15),5
+ 2
+; (!*ENTRY LCONC EXPR 2)
+LCONC: intern LCONC
+ PUSH 15,2
+ PUSH 15,1
+ CAMN 2,0
+ JRST L1012
+ LDB 11,L1011
+ CAIN 11,9
+ JRST L1013
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+346
+ MOVE 2,-1(15)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L1013: CAME 0,1(1)
+ JRST L1014
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+346
+ MOVE 7,0(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+ MOVE 6,-1(15)
+ MOVEM 6,0(1)
+ JRST L1012
+L1014: MOVE 7,1(1)
+ MOVEM 2,1(7)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+346
+ MOVE 7,0(15)
+ MOVEM 1,1(7)
+ MOVE 1,0(15)
+L1012: ADJSP 15,-2
+ POPJ 15,0
+L1011: point 6,1,5
+L1018: 29
+ byte(7)68,105,102,102,101,114,101,110,116,32,108,101,110,103,116,104,32,108,105,115,116,115,32,105,110,32,77,65,80,50,0
+ 3
+; (!*ENTRY MAP2 EXPR 3)
+MAP2: intern MAP2
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+L1019: LDB 11,L1015
+ CAIE 11,9
+ JRST L1020
+ LDB 11,L1016
+ CAIN 11,9
+ JRST L1021
+L1020: MOVE 1,0
+ JRST L1022
+L1021: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVEM 2,-1(15)
+ JRST L1019
+L1022: LDB 11,L1015
+ CAIN 11,9
+ JRST L1023
+ LDB 11,L1016
+ CAIE 11,9
+ JRST L1024
+L1023: MOVE 1,L1017
+ ADJSP 15,-3
+ JRST SYMFNC+156
+L1024: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L1015: point 6,0(15),5
+L1016: point 6,-1(15),5
+L1017: <4_30>+<1_18>+L1018
+L1028: 30
+ byte(7)68,105,102,102,101,114,101,110,116,32,108,101,110,103,116,104,32,108,105,115,116,115,32,105,110,32,77,65,80,67,50,0
+ 3
+; (!*ENTRY MAPC2 EXPR 3)
+MAPC2: intern MAPC2
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+L1029: LDB 11,L1025
+ CAIE 11,9
+ JRST L1030
+ LDB 11,L1026
+ CAIN 11,9
+ JRST L1031
+L1030: MOVE 1,0
+ JRST L1032
+L1031: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ MOVE 2,0(2)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ MOVE 6,3
+ PUSHJ 15,SYMFNC+288
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ MOVE 2,-1(15)
+ MOVE 2,1(2)
+ MOVEM 2,-1(15)
+ JRST L1029
+L1032: LDB 11,L1025
+ CAIN 11,9
+ JRST L1033
+ LDB 11,L1026
+ CAIE 11,9
+ JRST L1034
+L1033: MOVE 1,L1027
+ ADJSP 15,-3
+ JRST SYMFNC+156
+L1034: MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+L1025: point 6,0(15),5
+L1026: point 6,-1(15),5
+L1027: <4_30>+<1_18>+L1028
+ 2
+; (!*ENTRY CHANNELPRIN2T EXPR 2)
+L1035: intern L1035
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+356
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+309
+ MOVE 1,-1(15)
+ ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY PRIN2T EXPR 1)
+PRIN2T: intern PRIN2T
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+355
+ 2
+; (!*ENTRY CHANNELSPACES EXPR 2)
+L1036: intern L1036
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ HRRZI 6,1
+ MOVEM 6,-2(15)
+L1037: MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+238
+ PUSHJ 15,SYMFNC+239
+ CAMN 1,0
+ JRST L1038
+ MOVE 1,0
+ JRST L1039
+L1038: HRRZI 2,32
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+359
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+241
+ MOVEM 1,-2(15)
+ JRST L1037
+L1039: ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY SPACES EXPR 1)
+SPACES: intern SPACES
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+358
+ 2
+; (!*ENTRY CHANNELTAB EXPR 2)
+L1040: intern L1040
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ PUSHJ 15,SYMFNC+362
+ MOVEM 1,-2(15)
+ MOVE 2,1
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+282
+ CAMN 1,0
+ JRST L1041
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+309
+ SETZM -2(15)
+L1041: MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+238
+ MOVE 2,1
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+358
+ MOVE 1,0
+ ADJSP 15,-3
+ POPJ 15,0
+ 1
+; (!*ENTRY TAB EXPR 1)
+TAB: intern TAB
+ MOVE 2,1
+ MOVE 1,SYMVAL+311
+ JRST SYMFNC+361
+ 1
+; (!*ENTRY FILEP EXPR 1)
+FILEP: intern FILEP
+ MOVE 2,1
+ TLZ 2,258048
+ TLO 2,221184
+ HRLZI 1,32769
+ GTJFN
+ JRST L1042
+ RLJFN
+ JFCL
+ MOVE 1,SYMVAL+84
+ POPJ 15,0
+L1042: MOVE 1,0
+ POPJ 15,0
+ 3
+; (!*ENTRY PUTC EXPR 3)
+PUTC: intern PUTC
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+300
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+ 1
+; (!*ENTRY LIST2SET EXPR 1)
+L1044: intern L1044
+ ADJSP 15,1
+L1045: MOVEM 1,0(15)
+ LDB 11,L1043
+ CAIN 11,9
+ JRST L1046
+ MOVE 1,0
+ JRST L1047
+L1046: MOVE 2,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+302
+ CAMN 1,0
+ JRST L1048
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L1045
+L1048: MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,L1044
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ ADJSP 15,-1
+ JRST SYMFNC+278
+L1047: ADJSP 15,-1
+ POPJ 15,0
+L1043: point 6,1,5
+ 1
+; (!*ENTRY LIST2SETQ EXPR 1)
+L1050: intern L1050
+ PUSH 15,1
+ LDB 11,L1049
+ CAIN 11,9
+ JRST L1051
+ MOVE 1,0
+ JRST L1052
+L1051: MOVE 2,1(1)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L1053
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ ADJSP 15,-1
+ JRST SYMFNC+368
+L1053: MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+368
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ ADJSP 15,-1
+ JRST SYMFNC+278
+L1052: ADJSP 15,-1
+ POPJ 15,0
+L1049: point 6,1,5
+ 2
+; (!*ENTRY ADJOIN EXPR 2)
+ADJOIN: intern ADJOIN
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+302
+ CAMN 1,0
+ JRST L1054
+ MOVE 1,-1(15)
+ JRST L1055
+L1054: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+151
+L1055: ADJSP 15,-2
+ POPJ 15,0
+ 2
+; (!*ENTRY ADJOINQ EXPR 2)
+L1056: intern L1056
+ PUSH 15,2
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L1057
+ MOVE 1,-1(15)
+ JRST L1058
+L1057: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ ADJSP 15,-2
+ JRST SYMFNC+151
+L1058: ADJSP 15,-2
+ POPJ 15,0
+ 2
+; (!*ENTRY UNION EXPR 2)
+UNION: intern UNION
+ ADJSP 15,2
+L1060: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1059
+ CAIN 11,9
+ JRST L1061
+ MOVE 1,2
+ JRST L1062
+L1061: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+302
+ CAMN 1,0
+ JRST L1063
+ MOVE 1,-1(15)
+ JRST L1064
+L1063: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+151
+L1064: MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L1060
+L1062: ADJSP 15,-2
+ POPJ 15,0
+L1059: point 6,1,5
+ 2
+; (!*ENTRY UNIONQ EXPR 2)
+UNIONQ: intern UNIONQ
+ ADJSP 15,2
+L1066: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1065
+ CAIN 11,9
+ JRST L1067
+ MOVE 1,2
+ JRST L1068
+L1067: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L1069
+ MOVE 1,-1(15)
+ JRST L1070
+L1069: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+151
+L1070: MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L1066
+L1068: ADJSP 15,-2
+ POPJ 15,0
+L1065: point 6,1,5
+ 2
+; (!*ENTRY XN EXPR 2)
+XN: intern XN
+ ADJSP 15,2
+L1072: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ LDB 11,L1071
+ CAIN 11,9
+ JRST L1073
+ MOVE 1,0
+ JRST L1074
+L1073: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+302
+ CAMN 1,0
+ JRST L1075
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+301
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,XN
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L1075: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ JRST L1072
+L1074: ADJSP 15,-2
+ POPJ 15,0
+L1071: point 6,1,5
+ 2
+; (!*ENTRY XNQ EXPR 2)
+XNQ: intern XNQ
+ PUSH 15,2
+ PUSH 15,1
+ LDB 11,L1076
+ CAIN 11,9
+ JRST L1077
+ MOVE 1,0
+ JRST L1078
+L1077: MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+303
+ CAMN 1,0
+ JRST L1079
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+332
+ MOVE 2,1
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+374
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ ADJSP 15,-2
+ JRST SYMFNC+278
+L1079: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ ADJSP 15,-2
+ JRST SYMFNC+374
+L1078: ADJSP 15,-2
+ POPJ 15,0
+L1076: point 6,1,5
+ end
ADDED psl-1983/3-1/kernel/20/randm.rel
Index: psl-1983/3-1/kernel/20/randm.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/randm.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/scan-table.red
Index: psl-1983/3-1/kernel/20/scan-table.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/scan-table.red
@@ -0,0 +1,34 @@
+%
+% SCAN-TABLE.RED - Lisp character table for DEC-20
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 November 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL-20>SCAN-TABLE.RED.6, 10-Feb-83 16:12:38, Edit by PERDUE
+% Changed the "put EOF" to be a STARTUPTIME form
+% Edit by Cris Perdue, 28 Jan 1983 2039-PST
+% LispDipthong -> LispDiphthong
+
+fluid '(LispScanTable!* CurrentScanTable!*);
+
+LispScanTable!* := '
+[17 10 10 10 10 10 10 10 10 17 17 10 17 17 10 10 10 10 10 10 10 10 10 10
+10 10 11 10 10 10 10 10 17 14 15 10 10 12 10 11 11 11 10 19 10 18 20 10
+0 1 2 3 4 5 6 7 8 9 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 LispDiphthong];
+
+CurrentScanTable!* := LispScanTable!*;
+
+% Done as "startuptime" because "char" is available at compile
+% time but not necessarily init time /csp
+startuptime
+ put('EOF, 'CharConst, char cntrl Z);
+
+END;
ADDED psl-1983/3-1/kernel/20/symbl.ctl
Index: psl-1983/3-1/kernel/20/symbl.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/symbl.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "symbl";
+PathIn "symbl.build";
+ASMEnd;
+quit;
+compile symbl.mac, dsymbl.mac
ADDED psl-1983/3-1/kernel/20/symbl.init
Index: psl-1983/3-1/kernel/20/symbl.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/symbl.init
ADDED psl-1983/3-1/kernel/20/symbl.log
Index: psl-1983/3-1/kernel/20/symbl.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/symbl.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/symbl.mac
Index: psl-1983/3-1/kernel/20/symbl.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/symbl.mac
@@ -0,0 +1,878 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern BNDSTK
+ extern L1255
+ extern L1825
+ extern L1256
+L3349: 42
+ byte(7)42,42,42,42,42,32,66,105,110,100,105,110,103,32,115,116,97,99,107,32,111,118,101,114,102,108,111,119,44,32,114,101,115,116,97,114,116,105,110,103,46,46,46,0
+ 0
+; (!*ENTRY BSTACKOVERFLOW EXPR 0)
+L3350: intern L3350
+ MOVE 2,L3348
+ MOVE 1,SYMVAL+476
+ PUSHJ 15,SYMFNC+356
+ HRRZI 2,10
+ MOVE 1,SYMVAL+476
+ PUSHJ 15,SYMFNC+359
+ JRST SYMFNC+536
+L3348: <4_30>+<1_18>+L3349
+L3352: 43
+ byte(7)42,42,42,42,42,32,66,105,110,100,105,110,103,32,115,116,97,99,107,32,117,110,100,101,114,102,108,111,119,44,32,114,101,115,116,97,114,116,105,110,103,46,46,46,0
+ 0
+; (!*ENTRY BSTACKUNDERFLOW EXPR 0)
+L3353: intern L3353
+ MOVE 2,L3351
+ MOVE 1,SYMVAL+476
+ PUSHJ 15,SYMFNC+356
+ HRRZI 2,10
+ MOVE 1,SYMVAL+476
+ PUSHJ 15,SYMFNC+359
+ JRST SYMFNC+536
+L3351: <4_30>+<1_18>+L3352
+ 0
+; (!*ENTRY CAPTUREENVIRONMENT EXPR 0)
+L3354: intern L3354
+ MOVE 1,L1256
+ POPJ 15,0
+ 1
+; (!*ENTRY RESTOREENVIRONMENT EXPR 1)
+L3355: intern L3355
+ MOVE 3,1
+ CAML 1,L1255
+ JRST L3356
+ JRST SYMFNC+780
+L3356: CAMGE 3,L1256
+ JRST L3357
+ MOVE 1,0
+ POPJ 15,0
+L3357: MOVE 1,L1256
+ MOVE 2,-1(1)
+ MOVE 6,0(1)
+ MOVEM 6,SYMVAL(2)
+ MOVNI 7,2
+ ADDM 7,L1256
+ JRST L3356
+ 0
+; (!*ENTRY CLEARBINDINGS EXPR 0)
+L3358: intern L3358
+ MOVE 1,L1255
+ PUSHJ 15,SYMFNC+514
+ JRST SYMFNC+538
+ 1
+; (!*ENTRY UNBINDN EXPR 1)
+L3359: intern L3359
+ MOVNS 1
+ LSH 1,1
+ ADD 1,L1256
+ JRST SYMFNC+514
+L3363: 26
+ byte(7)84,32,97,110,100,32,78,73,76,32,99,97,110,110,111,116,32,98,101,32,114,101,98,111,117,110,100,0
+L3364: 6
+ byte(7)98,105,110,100,105,110,103,0
+ 2
+; (!*ENTRY LBIND1 EXPR 2)
+LBIND1: intern LBIND1
+ LDB 11,L3360
+ CAIN 11,30
+ JRST L3365
+ MOVE 2,L3361
+ JRST SYMFNC+130
+L3365: CAMN 1,0
+ JRST L3366
+ CAME 1,SYMVAL+84
+ JRST L3367
+L3366: MOVE 1,L3362
+ JRST SYMFNC+156
+L3367: HRRZI 7,2
+ ADDM 7,L1256
+ MOVE 6,L1825
+ CAML 6,L1256
+ JRST L3368
+ JRST SYMFNC+513
+L3368: TLZ 1,258048
+ MOVE 4,L1256
+ MOVEM 1,-1(4)
+ MOVE 6,SYMVAL(1)
+ MOVEM 6,0(4)
+ MOVEM 2,SYMVAL(1)
+ MOVE 1,2
+ POPJ 15,0
+L3360: point 6,1,5
+L3362: <4_30>+<1_18>+L3363
+L3361: <4_30>+<1_18>+L3364
+ 1
+; (!*ENTRY PBIND1 EXPR 1)
+PBIND1: intern PBIND1
+ MOVE 2,0
+ JRST SYMFNC+511
+ 0
+; (!*ENTRY FASTBIND EXPR 0)
+L3369: intern L3369
+ MOVE 7,L1256
+L3370: MOVE 6,0(10)
+ TLNN 6,261632
+ JRST L3371
+ MOVEM 7,L1256
+ JRST 0(10)
+L3371: ADDI 7,2
+ CAML 7,L1825
+ JRST SYMFNC+513
+ HLRZ 8,6
+ CAILE 8,5
+ ADDI 8,L0002-6
+ HRRZM 6,-1(7)
+ HRRZ 6,6
+ MOVE 9,SYMVAL(6)
+ MOVEM 9,0(7)
+ MOVE 8,0(8)
+ MOVEM 8,SYMVAL(6)
+ AOJA 10,L3370
+ 0
+; (!*ENTRY FASTUNBIND EXPR 0)
+L3372: intern L3372
+ MOVE 6,L1256
+ MOVE 7,0(10)
+L3373: JUMPG 7,L3374
+ MOVEM 6,L1256
+ JRST 1(10)
+L3374: CAMGE 6,L1255
+ JRST SYMFNC+780
+ DMOVE 8,-1(6)
+ MOVEM 9,SYMVAL(8)
+ SUBI 6,2
+ SOJA 7,L3373
+ 1
+; (!*ENTRY UNBOUNDP EXPR 1)
+L3378: intern L3378
+ LDB 11,L3375
+ CAIE 11,30
+ JRST L3379
+ MOVE 3,1
+ TLZ 3,258048
+ LDB 2,L3376
+ CAIE 2,29
+ JRST L3380
+ MOVE 1,SYMVAL+84
+ POPJ 15,0
+L3380: MOVE 1,0
+ POPJ 15,0
+L3379: MOVE 2,L3377
+ JRST SYMFNC+130
+L3375: point 6,1,5
+L3376: point 6,SYMVAL(3),5
+L3377: <30_30>+766
+ 1
+; (!*ENTRY MAKEUNBOUND EXPR 1)
+L3383: intern L3383
+ LDB 11,L3381
+ CAIE 11,30
+ JRST L3384
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 1,2
+ TLZ 1,258048
+ TLO 1,118784
+ MOVEM 1,SYMVAL(2)
+ POPJ 15,0
+L3384: MOVE 2,L3382
+ JRST SYMFNC+130
+L3381: point 6,1,5
+L3382: <30_30>+782
+L3389: 18
+ byte(7)37,114,32,105,115,32,97,110,32,117,110,98,111,117,110,100,32,73,68,0
+ 1
+; (!*ENTRY VALUECELL EXPR 1)
+L3390: intern L3390
+ PUSH 15,0
+ PUSH 15,1
+ LDB 11,L3385
+ CAIE 11,30
+ JRST L3391
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 6,SYMVAL(3)
+ MOVEM 6,-1(15)
+ LDB 2,L3386
+ CAIE 2,29
+ JRST L3392
+ MOVE 2,1
+ MOVE 1,L3387
+ PUSHJ 15,SYMFNC+155
+ MOVE 3,0(15)
+ MOVE 2,1
+ HRRZI 1,99
+ ADJSP 15,-2
+ JRST SYMFNC+236
+L3392: MOVE 1,-1(15)
+ JRST L3393
+L3391: MOVE 2,L3388
+ ADJSP 15,-2
+ JRST SYMFNC+130
+L3393: ADJSP 15,-2
+ POPJ 15,0
+L3385: point 6,1,5
+L3386: point 6,-1(15),5
+L3388: <30_30>+523
+L3387: <4_30>+<1_18>+L3389
+L3397: 22
+ byte(7)84,32,97,110,100,32,78,73,76,32,99,97,110,110,111,116,32,98,101,32,83,69,84,0
+ 2
+; (!*ENTRY SET EXPR 2)
+SET: intern SET
+ LDB 11,L3394
+ CAIE 11,30
+ JRST L3398
+ CAMN 1,0
+ JRST L3399
+ CAMN 1,SYMVAL+84
+ JRST L3399
+ MOVE 4,1
+ TLZ 4,258048
+ MOVEM 2,SYMVAL(4)
+ MOVE 1,2
+ POPJ 15,0
+L3399: MOVE 1,L3395
+ JRST SYMFNC+156
+L3398: MOVE 2,L3396
+ JRST SYMFNC+130
+L3394: point 6,1,5
+L3396: <30_30>+262
+L3395: <4_30>+<1_18>+L3397
+L3404: 33
+ byte(7)84,104,101,32,110,117,108,108,32,115,116,114,105,110,103,32,99,97,110,110,111,116,32,98,101,32,105,110,116,101,114,110,101,100,0
+; (!*ENTRY ADDTOOBLIST EXPR 1)
+L3405: intern L3405
+ ADJSP 15,5
+ MOVEM 0,-1(15)
+ MOVEM 0,-3(15)
+ MOVE 2,1
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVE 1,SYMNAM(2)
+ TLZ 1,258048
+ MOVEM 1,0(15)
+ MOVE 6,0(1)
+ LDB 3,L3400
+ TDNE 3,L3401
+ TDO 3,L3402
+ MOVEM 3,-4(15)
+ JUMPGE 3,L3406
+ MOVE 1,L3403
+ ADJSP 15,-5
+ JRST SYMFNC+156
+L3406: JUMPN 3,L3407
+ SETZM 2
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ HRLI 1,122880
+ JRST L3408
+L3407: PUSHJ 15,L3409
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ SETZM 2
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L3410
+ MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ HRLI 1,122880
+ JRST L3408
+L3410: MOVE 3,-2(15)
+ MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+385
+ MOVEM 1,-3(15)
+ MOVE 2,0(15)
+ PUSHJ 15,SYMFNC+394
+ MOVE 1,-3(15)
+ TLZ 1,258048
+ TLO 1,16384
+ MOVE 7,-2(15)
+ MOVEM 1,SYMNAM(7)
+ MOVE 1,-2(15)
+ HRLI 1,122880
+L3408: ADJSP 15,-5
+ POPJ 15,0
+L3400: point 30,6,35
+L3401: 536870912
+L3402: -536870912
+L3403: <4_30>+<1_18>+L3404
+L3415: 33
+ byte(7)84,104,101,32,110,117,108,108,32,115,116,114,105,110,103,32,99,97,110,110,111,116,32,98,101,32,105,110,116,101,114,110,101,100,0
+; (!*ENTRY LOOKUPORADDTOOBLIST EXPR 1)
+L3416: intern L3416
+ ADJSP 15,5
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ TLZ 1,258048
+ MOVEM 1,0(15)
+ MOVE 6,0(1)
+ LDB 2,L3411
+ TDNE 2,L3412
+ TDO 2,L3413
+ MOVEM 2,-4(15)
+ JUMPGE 2,L3417
+ MOVE 1,L3414
+ ADJSP 15,-5
+ JRST SYMFNC+156
+L3417: JUMPN 2,L3418
+ SETZM 2
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ HRLI 1,122880
+ JRST L3419
+L3418: PUSHJ 15,L3409
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ SETZM 2
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L3420
+ MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ HRLI 1,122880
+ JRST L3419
+L3420: PUSHJ 15,SYMFNC+389
+ MOVEM 1,-2(15)
+ MOVE 3,1
+ MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+385
+ MOVEM 1,-3(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC+394
+ MOVE 2,-3(15)
+ TLZ 2,258048
+ TLO 2,16384
+ MOVE 1,-2(15)
+ ADJSP 15,-5
+ JRST L3421
+L3419: ADJSP 15,-5
+ POPJ 15,0
+L3411: point 30,6,35
+L3412: 536870912
+L3413: -536870912
+L3414: <4_30>+<1_18>+L3415
+ 1
+; (!*ENTRY NEWID EXPR 1)
+NEWID: intern NEWID
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+389
+ MOVE 2,0(15)
+ ADJSP 15,-1
+ JRST L3421
+; (!*ENTRY INITNEWID EXPR 2)
+L3421: intern L3421
+ ADJSP 15,1
+ MOVEM 2,SYMNAM(1)
+ HRLI 1,122880
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+782
+ MOVE 2,0
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+757
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+753
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+ 1
+; (!*ENTRY HASHFUNCTION EXPR 1)
+L3425: intern L3425
+ ADJSP 15,1
+ TLZ 1,258048
+ MOVEM 1,0(15)
+ SETZM 4
+ MOVE 6,0(1)
+ LDB 2,L3422
+ TDNE 2,L3423
+ TDO 2,L3424
+ MOVE 5,2
+ CAIG 2,28
+ JRST L3426
+ HRRZI 5,28
+L3426: SETZM 3
+L3427: CAMLE 3,5
+ JRST L3428
+ MOVE 2,3
+ MOVE 1,0(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ HRRZI 2,28
+ SUB 2,3
+ LSH 1,0(2)
+ XOR 1,4
+ MOVE 4,1
+ AOS 3
+ JRST L3427
+L3428: HRRZI 2,8209
+ MOVE 1,4
+ ADJSP 15,-1
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+L3422: point 30,6,35
+L3423: 536870912
+L3424: -536870912
+L3431: 14
+ byte(7)79,98,108,105,115,116,32,111,118,101,114,102,108,111,119,0
+; (!*ENTRY INOBLIST EXPR 1)
+L3409: intern L3409
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+783
+ MOVEM 1,-1(15)
+ MOVEM 1,-3(15)
+ SETOM -2(15)
+L3432: MOVE 2,-3(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ JUMPN 1,L3433
+ MOVE 6,-2(15)
+ CAMN 6,L3429
+ JRST L3434
+ MOVE 1,-2(15)
+ JRST L3435
+L3434: MOVE 1,-3(15)
+ JRST L3435
+L3433: MOVE 2,-3(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ CAME 1,L3429
+ JRST L3436
+ MOVE 6,-2(15)
+ CAME 6,L3429
+ JRST L3436
+ MOVE 6,-3(15)
+ MOVEM 6,-2(15)
+ JRST L3437
+L3436: MOVE 2,-3(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,0(15)
+ MOVE 1,SYMNAM(1)
+ PUSHJ 15,SYMFNC+196
+ CAMN 1,0
+ JRST L3437
+ MOVE 1,-3(15)
+ JRST L3435
+L3437: MOVE 6,-3(15)
+ CAIE 6,8209
+ JRST L3438
+ SETZM 1
+ JRST L3439
+L3438: MOVE 1,-3(15)
+ AOS 1
+L3439: MOVEM 1,-3(15)
+ CAME 1,-1(15)
+ JRST L3432
+ MOVE 1,L3430
+ PUSHJ 15,SYMFNC+380
+ JRST L3432
+L3435: ADJSP 15,-4
+ POPJ 15,0
+L3429: -1
+L3430: <4_30>+<1_18>+L3431
+L3443: 11
+ byte(7)73,68,32,111,114,32,115,116,114,105,110,103,0
+ 1
+; (!*ENTRY INTERN EXPR 1)
+INTERN: intern INTERN
+ LDB 11,L3440
+ CAIE 11,30
+ JRST L3444
+ JRST L3405
+L3444: LDB 11,L3440
+ CAIE 11,4
+ JRST L3445
+ JRST L3416
+L3445: MOVE 3,L3441
+ MOVE 2,L3442
+ JRST SYMFNC+132
+L3440: point 6,1,5
+L3442: <30_30>+560
+L3441: <4_30>+<1_18>+L3443
+L3449: 7
+ byte(7)110,111,110,45,99,104,97,114,0
+ 1
+; (!*ENTRY REMOB EXPR 1)
+REMOB: intern REMOB
+ PUSH 15,0
+ PUSH 15,1
+ LDB 11,L3446
+ CAIN 11,30
+ JRST L3450
+ MOVE 2,L3447
+ ADJSP 15,-2
+ JRST SYMFNC+130
+L3450: MOVE 2,1
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ CAIL 2,128
+ JRST L3451
+ MOVE 3,L3448
+ MOVE 2,L3447
+ ADJSP 15,-2
+ JRST SYMFNC+132
+L3451: MOVE 6,SYMNAM(2)
+ MOVEM 6,-1(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,L3409
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ SETZM 2
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L3452
+ SETOM 3
+ MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+L3452: MOVE 1,0(15)
+ ADJSP 15,-2
+ POPJ 15,0
+L3446: point 6,1,5
+L3448: <4_30>+<1_18>+L3449
+L3447: <30_30>+784
+ 1
+; (!*ENTRY INTERNP EXPR 1)
+L3457: intern L3457
+ PUSH 15,1
+ LDB 11,L3453
+ CAIE 11,30
+ JRST L3458
+ TLZ 1,258048
+ MOVEM 1,0(15)
+ CAIGE 1,128
+ JRST L3459
+ MOVE 1,0
+ JRST L3460
+L3459: MOVE 1,SYMVAL+84
+L3460: CAME 1,0
+ JRST L3461
+ MOVE 1,0(15)
+ MOVE 1,SYMNAM(1)
+ PUSHJ 15,L3409
+ MOVE 2,1
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ CAME 1,0(15)
+ JRST L3462
+ MOVE 1,SYMVAL+84
+ JRST L3461
+L3458: LDB 11,L3453
+ CAIE 11,4
+ JRST L3462
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L3454
+ TDNE 1,L3455
+ TDO 1,L3456
+ JUMPE 1,L3463
+ MOVE 1,0
+ JRST L3464
+L3463: MOVE 1,SYMVAL+84
+L3464: CAME 1,0
+ JRST L3461
+ MOVE 1,0(15)
+ PUSHJ 15,L3409
+ MOVE 2,1
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ SETZM 2
+ ADJSP 15,-1
+ JRST SYMFNC+237
+L3462: MOVE 1,0
+L3461: ADJSP 15,-1
+ POPJ 15,0
+L3453: point 6,1,5
+L3454: point 30,6,35
+L3455: 536870912
+L3456: -536870912
+ extern L3465
+ 0
+; (!*ENTRY GENSYM EXPR 0)
+GENSYM: intern GENSYM
+ HRRZI 1,4
+ PUSHJ 15,L3466
+ XMOVEI 1,L3465
+ PUSHJ 15,SYMFNC+395
+ JRST SYMFNC+649
+; (!*ENTRY GENSYM1 EXPR 1)
+L3466: intern L3466
+L3467: MOVE 5,1
+ MOVE 4,0
+ JUMPLE 1,L3468
+ MOVE 2,1
+ XMOVEI 1,1+L3465
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,1
+ MOVE 4,2
+ CAIL 2,57
+ JRST L3469
+ MOVE 3,2
+ AOS 3
+ MOVE 2,5
+ XMOVEI 1,1+L3465
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ POPJ 15,0
+L3469: HRRZI 3,48
+ MOVE 2,5
+ XMOVEI 1,1+L3465
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,5
+ SOS 1
+ JRST L3467
+L3468: SETZM 2
+ XMOVEI 1,1+L3465
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ AOS 3
+ SETZM 2
+ XMOVEI 1,1+L3465
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ HRRZI 1,4
+ JRST L3467
+ 0
+; (!*ENTRY INTERNGENSYM EXPR 0)
+L3470: intern L3470
+ HRRZI 1,4
+ PUSHJ 15,L3466
+ XMOVEI 1,L3465
+ TLZ 1,258048
+ TLO 1,16384
+ JRST SYMFNC+560
+ 1
+; (!*ENTRY MAPOBL EXPR 1)
+MAPOBL: intern MAPOBL
+ PUSH 15,L3471
+ PUSH 15,1
+L3472: MOVE 6,-1(15)
+ CAIG 6,127
+ JRST L3473
+ SETZM 1
+ JRST L3474
+L3473: MOVE 2,0(15)
+ MOVE 1,-1(15)
+ HRLI 1,122880
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ AOS -1(15)
+ JRST L3472
+L3474: SETZM -1(15)
+L3475: MOVE 6,-1(15)
+ CAIG 6,8209
+ JRST L3476
+ SETZM 1
+ JRST L3477
+L3476: MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ SETZM 2
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L3478
+ MOVE 2,-1(15)
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,0(15)
+ HRLI 1,122880
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+L3478: AOS -1(15)
+ JRST L3475
+L3477: ADJSP 15,-2
+ POPJ 15,0
+L3471: 0
+ extern L3479
+ 1
+; (!*ENTRY GLOBALLOOKUP EXPR 1)
+L3482: intern L3482
+ LDB 11,L3480
+ CAIN 11,4
+ JRST L3483
+ MOVE 2,L3481
+ JRST SYMFNC+143
+L3483: PUSHJ 15,L3409
+ MOVE 2,1
+ MOVEM 2,L3479
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ SETZM 2
+ PUSHJ 15,SYMFNC+237
+ CAMN 1,0
+ JRST L3484
+ MOVE 2,L3479
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ HRLI 1,122880
+ POPJ 15,0
+L3484: SETZM 1
+ POPJ 15,0
+L3480: point 6,1,5
+L3481: <30_30>+788
+ 1
+; (!*ENTRY GLOBALINSTALL EXPR 1)
+L3488: intern L3488
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+788
+ MOVEM 1,-1(15)
+ JUMPN 1,L3489
+ PUSHJ 15,SYMFNC+389
+ MOVEM 1,-1(15)
+ MOVE 3,1
+ MOVE 2,L3479
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L3485
+ TDNE 1,L3486
+ TDO 1,L3487
+ PUSHJ 15,SYMFNC+385
+ MOVEM 1,-2(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ PUSHJ 15,SYMFNC+394
+ MOVE 2,-2(15)
+ TLZ 2,258048
+ TLO 2,16384
+ MOVE 1,-1(15)
+ ADJSP 15,-3
+ JRST L3421
+L3489: ADJSP 15,-3
+ POPJ 15,0
+L3485: point 30,6,35
+L3486: 536870912
+L3487: -536870912
+ 1
+; (!*ENTRY GLOBALREMOVE EXPR 1)
+L3490: intern L3490
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+788
+ MOVEM 1,-1(15)
+ JUMPN 1,L3491
+ SETZM 1
+ JRST L3492
+L3491: MOVE 2,L3479
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-1(15)
+ SETOM 3
+ MOVE 2,L3479
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,-1(15)
+ HRLI 1,122880
+L3492: ADJSP 15,-2
+ POPJ 15,0
+ 0
+; (!*ENTRY INITOBLIST EXPR 0)
+L3493: intern L3493
+ ADJSP 15,2
+ MOVE 1,L0001
+ SOS 1
+ MOVEM 1,0(15)
+ HRRZI 6,128
+ MOVEM 6,-1(15)
+L3494: MOVE 6,-1(15)
+ CAMLE 6,0(15)
+ JRST L3495
+ MOVE 1,-1(15)
+ MOVE 1,SYMNAM(1)
+ PUSHJ 15,L3409
+ MOVE 3,-1(15)
+ MOVE 2,1
+ XMOVEI 1,L0003
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ AOS -1(15)
+ JRST L3494
+L3495: MOVE 1,0
+ ADJSP 15,-2
+ POPJ 15,0
+ end
ADDED psl-1983/3-1/kernel/20/symbl.rel
Index: psl-1983/3-1/kernel/20/symbl.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/symbl.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/sys-io.red
Index: psl-1983/3-1/kernel/20/sys-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/sys-io.red
@@ -0,0 +1,299 @@
+%
+% SYSTEM-IO.RED - System dependent IO routines for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 16 September 1981
+% Copyright (c) 1981 University of Utah
+%
+% 21-May-1983 Mark R. Swanson
+% Replace local byte pointers with one-word global byte pointers
+
+global '(IN!* OUT!*);
+LoadTime <<
+IN!* := 0;
+OUT!* := 1;
+>>;
+
+fluid '(StdIN!* StdOUT!* ErrOUT!* !*Echo);
+LoadTime <<
+StdIN!* := 0;
+StdOUT!* := 1;
+ErrOUT!* := 1;
+>>;
+
+CompileTime flag('(RDTTY FindFreeChannel Dec20Open ContOpenError ClearIO1),
+ 'InternalFunction);
+
+on SysLisp;
+
+external WArray JFNOfChannel, ReadFunction, WriteFunction, CLoseFunction;
+Internal WString Chn1Buf[100];
+Internal WString Chn2Buf[100];
+Internal WString Chn3Buf[100];
+Internal WString Chn4Buf[100];
+Internal WString Chn5Buf[100];
+Internal WString Chn6Buf[100];
+Internal WString Chn7Buf[100];
+Internal WString Chn8Buf[100];
+Internal WString Chn9Buf[100];
+Internal WString Chn10Buf[100];
+Internal Warray buffer-pointer[MaxChannels],
+ in-buffer = [Chn1Buf, Chn2Buf, Chn3Buf, Chn4Buf,
+ Chn5Buf, Chn6Buf, Chn7Buf, Chn8Buf, Chn9Buf, Chn10Buf];
+
+
+if_system(Tops20,
+lap '((!*entry Dec20ReadChar expr 1)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+Loop % get JFN for channel
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+ (!*PUSH (reg 1)) % yes, save char
+ (!*CALL WriteChar) % and write it
+ (!*POP (reg 1)) % restore it
+ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+));
+
+if_system(Tenex,
+lap '((!*entry Dec20ReadChar expr 1)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+Loop % get JFN for channel
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (cain (reg 2) (WConst 8#37)) % TENEX EOL
+ (!*MOVE (WConst 8#12) (reg 2)) % replace it with a linefeed
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+ (!*PUSH (reg 1)) % yes, save char
+ (!*CALL WriteChar) % and write it
+ (!*POP (reg 1)) % restore it
+ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+));
+
+lap '((!*entry Dec20WriteChar expr 2)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+ % get JFN for channel
+ (!*JUMPEQ (Label CRLF) (reg 2) (WConst 8#12)) % if LF, echo CRLF
+ (bout) % no, just echo char
+ (!*EXIT 0) % return
+CRLF
+ (!*MOVE (WConst 8#15) (reg 2)) % write carriage-return
+ (bout)
+ (!*MOVE (WConst 8#12) (reg 2)) % write linefeed
+ (bout)
+ (!*EXIT 0) % return
+);
+
+internal WConst MaxTerminalBuffer = 200;
+internal WVar NextTerminalChar = 1;
+internal WString TerminalInputBuffer[MaxTerminalBuffer];
+
+lap '((!*entry ClearIO1 expr 0)
+%
+% ^C from RDTTY and restart causes trouble, but we don't want a full RESET
+% (don't want to close files or kill forks), so we'll just do the
+% part of RESET that we want, for terminal input
+%
+ (!*MOVE (WConst 8#100) (reg 1)) % .priin
+ (rfmod)
+ (tro 2 2#001111100001000000) % tt%wak + tt%eco + .ttasi, like RESET
+ (sfmod)
+ (!*EXIT 0)
+);
+
+syslsp procedure ClearIO();
+<< ClearIO1();
+ TerminalInputBuffer[0] := -1;
+ NextTerminalChar := 0;
+ LispVar IN!* := LispVar STDIN!*;
+ LispVar OUT!* := LispVar STDOUT!* >>;
+
+if_system(Tops20,
+lap '((!*entry RDTTY expr 3)
+ (dmove (reg t1) (reg 1))
+ (!*MOVE (WConst 8#101) (reg 1)) % .priou
+ (rfmod) % read mode word
+ (tlze (reg 2) 2#100000000000000000) % if tt%osp is 0, then skip
+ (sfmod) % otherwise turn on output
+ (dmove (reg 1) (reg t1))
+ (!*MOVE (reg 2) (reg 4)) % save original count in r4
+ (!*WPLUS2 (reg 1) (WConst 1)) % make input buffer into byte pointer
+ (!*MkItem (reg 1) 8#61) % (globalize it)
+ (!*WPLUS2 (reg 3) (WConst 1)) % make prompt string into byte pointer
+ (!*MkItem (reg 3) 8#61) % (globalize it)
+ (!*MOVE (reg 1) (reg 5)) % print it once
+ (!*MOVE (reg 3) (reg 1))
+ (psout)
+ (!*MOVE (reg 5) (reg 1))
+ (hrli (reg 2) 2#000110000000000000) % rd%bel + rd%crf
+ (jsys 8#523) % RDTTY
+ (!*JUMP (Label CantRDTTY))
+ (!*MOVE (reg 4) (reg 1)) % move original count to r1
+ (hrrzs (reg 2)) % clear flag bits in r2
+ (!*WDIFFERENCE (reg 1) (reg 2)) % return # chars read, not # available
+ (!*EXIT 0)
+CantRDTTY
+ (!*MOVE (QUOTE "Can't read from terminal") (reg 1))
+ (!*JCALL IOError)
+));
+
+if_system(Tenex,
+lap '((!*entry RDTTY expr 3)
+ (move (reg t1) (reg 1))
+ (move (reg t2) (reg 2))
+ (!*MOVE (WConst 8#101) (reg 1)) % .priou
+ (rfmod) % read mode word
+ (tlze (reg 2) 2#100000000000000000) % if tt%osp is 0, then skip
+ (sfmod) % otherwise turn on output
+ (move (reg 1) (reg t1))
+ (move (reg 2) (reg t2))
+ (!*MOVE (reg 2) (reg 4)) % save original count in r4
+ (!*WPLUS2 (reg 1) (WConst 1)) % make input buffer into byte pointer
+ (hrli (reg 1) 8#440700)
+ (!*WPLUS2 (reg 3) (WConst 1)) % make prompt string into byte pointer
+ (hrli (reg 3) 8#440700)
+ (!*MOVE (reg 1) (reg 5)) % print it once
+ (!*MOVE (reg 3) (reg 1))
+ (psout)
+ (!*MOVE (reg 5) (reg 1))
+% (hrli (reg 2) 2#000110000000000000) % rd%bel + rd%crf
+% (jsys 8#523) % RDTTY
+% (!*JUMP (Label CantRDTTY))
+ (!*MOVE (WConst MaxTerminalBuffer) (reg 2)) % # of chars
+ (setz 3 0) % clear 3
+ (jsys 8#611) % PSTIN, IMSSS JSYS
+ (!*MOVE (WConst 8#12) (reg 3)) % put linefeed at end of buffer
+ (dpb (reg 3) (reg 1)) % 1 points to end of what's been read
+ (!*MOVE (reg 4) (reg 1)) % move original count to r1
+ (hrrzs (reg 2)) % clear flag bits in r2
+ (!*WDIFFERENCE (reg 1) (reg 2)) % return # chars read, not # available
+ (!*EXIT 0)
+));
+
+syslsp procedure TerminalInputHandler Chn;
+begin scalar Ch;
+ while NextTerminalChar >= StrLen TerminalInputBuffer do
+ << NextTerminalChar := 0;
+ TerminalInputBuffer[0] := RDTTY(TerminalInputBuffer,
+ MaxTerminalBuffer,
+ if StringP LispVar PromptString!*
+ then LispVar PromptString!*
+ else ">") >>;
+ Ch := StrByt(TerminalInputBuffer, NextTerminalChar);
+ NextTerminalChar := NextTerminalChar + 1;
+ return Ch;
+end;
+
+syslsp procedure FindFreeChannel();
+begin scalar Chn;
+ Chn := 0;
+ while JfnOfChannel[Chn] neq 0 do
+ << if Chn >= MaxChannels then IOError("No free channels left");
+ Chn := Chn + 1 >>;
+ return Chn;
+end;
+
+syslsp procedure SystemMarkAsClosedChannel FileDes;
+ JFNOfChannel[IntInf FileDes] := 0;
+
+lap '((!*entry Dec20CloseChannel expr 1)
+ (!*MOVE (reg 1) (reg 2)) % save in case of error
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+ (closf)
+ (!*JUMP (Label CloseError))
+ (!*EXIT 0)
+CloseError
+ (!*MOVE (QUOTE "Channel could not be closed") (reg 1))
+ (!*JCALL ChannelError)
+);
+
+syslsp procedure SystemOpenFileSpecial FileName;
+<< JFNOfChannel[FileName := FindFreeChannel()] := -1;
+ FileName >>;
+
+syslsp procedure SystemOpenFileForInput FileName;
+begin scalar Chn, JFN;
+ Chn := FindFreeChannel();
+ JFN := Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 7*of%bsz of%rd
+ 2#000111000000000000010000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'INPUT);
+ JFNOfChannel[Chn] := JFN;
+ ReadFunction[Chn] := 'Dec20ReadChar;
+ CloseFunction[Chn] := 'Dec20CloseChannel;
+ return Chn;
+end;
+
+syslsp procedure SystemOpenFileForOutput FileName;
+begin scalar Chn, JFN;
+ Chn := FindFreeChannel();
+ JFN := Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 7*of%bsz of%wr
+ 2#000111000000000000001000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'OUTPUT);
+ JFNOfChannel[Chn] := JFN;
+ WriteFunction[Chn] := 'Dec20WriteChar;
+ CloseFunction[Chn] := 'Dec20CloseChannel;
+ return Chn;
+end;
+
+lap '((!*entry Dec20Open expr 3)
+%
+% Dec20Open(Filename string, GTJFN bits, OPENF bits)
+%
+ (!*WPLUS2 (reg 1) (WConst 1)) % increment r1 to point to characters
+ (!*MkItem (reg 1) 8#61) % (globalize it)
+ (!*MOVE (reg 1) (reg 4)) % save filename string in r4
+ (!*MOVE (reg 2) (reg 1)) % GTJFN flag bits in r1
+ (!*MOVE (reg 4) (reg 2)) % string in r2
+ (gtjfn)
+ (!*JUMP (Label CantOpen))
+ (!*MOVE (reg 3) (reg 2)) % OPENF bits in r2, JFN in r1
+ (openf)
+CantOpen
+ (!*MOVE (WConst 0) (reg 1)) % return 0 on error
+ (!*EXIT 0) % else return the JFN
+);
+
+off SysLisp;
+
+lisp procedure ContOpenError(FileName, AccessMode);
+ ContinuableError(99,
+ BldMsg("`%s' cannot be open for %w",
+ FileName, AccessMode),
+ list('OPEN, MkSTR FileName, MkQuote AccessMode));
+
+END;
ADDED psl-1983/3-1/kernel/20/sysio.ctl
Index: psl-1983/3-1/kernel/20/sysio.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/sysio.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "sysio";
+PathIn "sysio.build";
+ASMEnd;
+quit;
+compile sysio.mac, dsysio.mac
ADDED psl-1983/3-1/kernel/20/sysio.init
Index: psl-1983/3-1/kernel/20/sysio.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/sysio.init
@@ -0,0 +1,3 @@
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (STDIN!* STDOUT!* ERROUT!* !*ECHO)))
+(FLUID (QUOTE (LISPSCANTABLE!* CURRENTSCANTABLE!*)))
ADDED psl-1983/3-1/kernel/20/sysio.log
Index: psl-1983/3-1/kernel/20/sysio.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/sysio.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/sysio.mac
Index: psl-1983/3-1/kernel/20/sysio.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/sysio.mac
@@ -0,0 +1,294 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ extern L2260
+ extern L2253
+ extern L2254
+ extern L2255
+L3497: 31
+ byte(7)65,116,116,101,109,112,116,32,116,111,32,114,101,97,100,32,102,114,111,109,32,102,105,108,101,32,102,97,105,108,101,100,0
+ 1
+; (!*ENTRY DEC20READCHAR EXPR 1)
+L3498: intern L3498
+ MOVE 1,L2260(1)
+L3499: BIN
+ ERJMP L3500
+ JUMPE 2,L3499
+ CAIN 2,13
+ JRST L3499
+ MOVE 1,2
+ CAMN 0,SYMVAL+793
+ POPJ 15,0
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+467
+ POP 15,1
+ POPJ 15,0
+L3500: GTSTS
+ TLNN 2,512
+ JRST L3501
+ HRRZI 1,26
+ POPJ 15,0
+L3501: MOVE 1,L3496
+ JRST SYMFNC+507
+L3496: <4_30>+<1_18>+L3497
+ 2
+; (!*ENTRY DEC20WRITECHAR EXPR 2)
+L3502: intern L3502
+ MOVE 1,L2260(1)
+ CAIN 2,10
+ JRST L3503
+ BOUT
+ POPJ 15,0
+L3503: HRRZI 2,13
+ BOUT
+ HRRZI 2,10
+ BOUT
+ POPJ 15,0
+ extern L3504
+ extern L3505
+; (!*ENTRY CLEARIO1 EXPR 0)
+L3506: intern L3506
+ HRRZI 1,64
+ RFMOD
+ TRO 2,63552
+ SFMOD
+ POPJ 15,0
+ 0
+; (!*ENTRY CLEARIO EXPR 0)
+L3507: intern L3507
+ PUSHJ 15,L3506
+ SETOM L3505
+ SETZM L3504
+ MOVE 6,SYMVAL+616
+ MOVEM 6,SYMVAL+600
+ MOVE 1,SYMVAL+618
+ MOVEM 1,SYMVAL+311
+ POPJ 15,0
+L3509: 23
+ byte(7)67,97,110,39,116,32,114,101,97,100,32,102,114,111,109,32,116,101,114,109,105,110,97,108,0
+; (!*ENTRY RDTTY EXPR 3)
+RDTTY: intern RDTTY
+ DMOVE 6,1
+ HRRZI 1,65
+ RFMOD
+ TLZE 2,131072
+ SFMOD
+ DMOVE 1,6
+ MOVE 4,2
+ AOS 1
+ TLZ 1,258048
+ TLO 1,200704
+ AOS 3
+ TLZ 3,258048
+ TLO 3,200704
+ MOVE 5,1
+ MOVE 1,3
+ PSOUT
+ MOVE 1,5
+ HRLI 2,24576
+ JSYS 339
+ JRST L3510
+ MOVE 1,4
+ HRRZS 2
+ SUB 1,2
+ POPJ 15,0
+L3510: MOVE 1,L3508
+ JRST SYMFNC+507
+L3508: <4_30>+<1_18>+L3509
+L3516: 0
+ byte(7)62,0
+ 1
+; (!*ENTRY TERMINALINPUTHANDLER EXPR 1)
+L3517: intern L3517
+ PUSH 15,0
+ PUSH 15,1
+L3518: MOVE 6,L3505
+ LDB 1,L3511
+ TDNE 1,L3512
+ TDO 1,L3513
+ CAMLE 1,L3504
+ JRST L3519
+ SETZM L3504
+ LDB 11,L3514
+ CAIE 11,4
+ JRST L3520
+ MOVE 1,SYMVAL+442
+ JRST L3521
+L3520: MOVE 1,L3515
+L3521: MOVE 3,1
+ HRRZI 2,200
+ XMOVEI 1,L3505
+ PUSHJ 15,RDTTY
+ MOVEM 1,L3505
+ JRST L3518
+L3519: MOVE 2,L3504
+ XMOVEI 1,1+L3505
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVEM 1,-1(15)
+ AOS L3504
+ ADJSP 15,-2
+ POPJ 15,0
+L3511: point 30,6,35
+L3512: 536870912
+L3513: -536870912
+L3514: point 6,<SYMVAL+442>,5
+L3515: <4_30>+<1_18>+L3516
+L3524: 20
+ byte(7)78,111,32,102,114,101,101,32,99,104,97,110,110,101,108,115,32,108,101,102,116,0
+; (!*ENTRY FINDFREECHANNEL EXPR 0)
+L3525: intern L3525
+ PUSH 15,L3522
+L3526: MOVE 7,0(15)
+ SKIPN L2260(7)
+ JRST L3527
+ MOVE 6,0(15)
+ CAIGE 6,31
+ JRST L3528
+ MOVE 1,L3523
+ PUSHJ 15,SYMFNC+507
+L3528: AOS 0(15)
+ JRST L3526
+L3527: MOVE 1,0(15)
+ ADJSP 15,-1
+ POPJ 15,0
+L3522: 0
+L3523: <4_30>+<1_18>+L3524
+ 1
+; (!*ENTRY SYSTEMMARKASCLOSEDCHANNEL EXPR 1)
+L3529: intern L3529
+ SETZM L2260(1)
+ SETZM 1
+ POPJ 15,0
+L3531: 26
+ byte(7)67,104,97,110,110,101,108,32,99,111,117,108,100,32,110,111,116,32,98,101,32,99,108,111,115,101,100,0
+ 1
+; (!*ENTRY DEC20CLOSECHANNEL EXPR 1)
+L3532: intern L3532
+ MOVE 2,1
+ MOVE 1,L2260(1)
+ CLOSF
+ JRST L3533
+ POPJ 15,0
+L3533: MOVE 1,L3530
+ JRST SYMFNC+503
+L3530: <4_30>+<1_18>+L3531
+ 1
+; (!*ENTRY SYSTEMOPENFILESPECIAL EXPR 1)
+L3534: intern L3534
+ PUSHJ 15,L3525
+ MOVE 3,1
+ SETOM L2260(3)
+ MOVE 1,3
+ POPJ 15,0
+ 1
+; (!*ENTRY SYSTEMOPENFILEFORINPUT EXPR 1)
+L3538: intern L3538
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ PUSHJ 15,L3525
+ MOVEM 1,-1(15)
+ MOVE 3,[7516258304]
+ MOVE 2,[8590196736]
+ MOVE 1,0(15)
+ PUSHJ 15,L3539
+ MOVEM 1,-2(15)
+ JUMPN 1,L3540
+ MOVE 2,L3535
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST L3541
+L3540: MOVE 7,-1(15)
+ MOVEM 1,L2260(7)
+ MOVE 7,-1(15)
+ MOVE 6,L3536
+ MOVEM 6,L2253(7)
+ MOVE 7,-1(15)
+ MOVE 6,L3537
+ MOVEM 6,L2255(7)
+ MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L3537: <30_30>+795
+L3536: <30_30>+792
+L3535: <30_30>+612
+ 1
+; (!*ENTRY SYSTEMOPENFILEFOROUTPUT EXPR 1)
+L3545: intern L3545
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ PUSHJ 15,L3525
+ MOVEM 1,-1(15)
+ MOVE 3,[7516225536]
+ MOVE 2,[-17179607040]
+ MOVE 1,0(15)
+ PUSHJ 15,L3539
+ MOVEM 1,-2(15)
+ JUMPN 1,L3546
+ MOVE 2,L3542
+ MOVE 1,0(15)
+ ADJSP 15,-3
+ JRST L3541
+L3546: MOVE 7,-1(15)
+ MOVEM 1,L2260(7)
+ MOVE 7,-1(15)
+ MOVE 6,L3543
+ MOVEM 6,L2254(7)
+ MOVE 7,-1(15)
+ MOVE 6,L3544
+ MOVEM 6,L2255(7)
+ MOVE 1,-1(15)
+ ADJSP 15,-3
+ POPJ 15,0
+L3544: <30_30>+795
+L3543: <30_30>+593
+L3542: <30_30>+611
+; (!*ENTRY DEC20OPEN EXPR 3)
+L3539: intern L3539
+ AOS 1
+ TLZ 1,258048
+ TLO 1,200704
+ MOVE 4,1
+ MOVE 1,2
+ MOVE 2,4
+ GTJFN
+ JRST L3547
+ MOVE 2,3
+ OPENF
+L3547: SETZM 1
+ POPJ 15,0
+L3550: 25
+ byte(7)96,37,115,39,32,99,97,110,110,111,116,32,98,101,32,111,112,101,110,32,102,111,114,32,37,119,0
+; (!*ENTRY CONTOPENERROR EXPR 2)
+L3541: intern L3541
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVE 3,2
+ MOVE 2,1
+ MOVE 1,L3548
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-2(15)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,0(15)
+ TLZ 2,258048
+ TLO 2,16384
+ MOVE 1,L3549
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,1
+ MOVE 2,-2(15)
+ HRRZI 1,99
+ ADJSP 15,-3
+ JRST SYMFNC+236
+L3549: <30_30>+603
+L3548: <4_30>+<1_18>+L3550
+ end
ADDED psl-1983/3-1/kernel/20/sysio.rel
Index: psl-1983/3-1/kernel/20/sysio.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/sysio.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/system-extras.red
Index: psl-1983/3-1/kernel/20/system-extras.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/system-extras.red
@@ -0,0 +1,69 @@
+%
+% 20-EXTRAS.RED - System-specific functions for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 4 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 21-May-83 Mark R. Swanson
+% Made local byte pointer into global byte pointer in DATE; changed
+% ReturnAddressP to use only low halfword of value in SYMFNC table.
+% <PSL.KERNEL-20>SYSTEM-EXTRAS.RED.3, 5-Jan-83 16:46:34, Edit by PERDUE
+% Added ExitLISP, for the DEC-20 a synonym of QUIT
+
+fluid '(system_list!*);
+
+if_system(Tenex,
+ if_system(KL10,
+ system_list!* := '(Dec20 PDP10 Tenex KL10),
+ system_list!* := '(Dec20 PDP10 Tenex)),
+ system_list!* := '(Dec20 PDP10 Tops20 KL10));
+
+lap '((!*entry Quit expr 0)
+ (haltf)
+ (!*MOVE '"Continued" (reg 1))
+ (!*EXIT 0)
+);
+
+CopyD('ExitLISP, 'Quit);
+
+lap '((!*entry Date expr 0)
+ (!*MOVE (WConst 8) (reg 1)) % allocate a 9 character string
+ (!*CALL GtStr)
+ (!*MOVE (reg 1) (reg 4)) % save it in 4
+ (!*WPLUS2 (reg 1) (WConst 1))
+ (tlo 1 8#610000) % create a byte pointer to it
+ (!*MOVE (WConst -1) (reg 2)) % current date
+ (hrlzi (reg 3) 2#0000000001) % ot%ntm, don't output time
+ (odtim)
+ (!*MOVE (reg 4) (reg 1))
+ (!*MKITEM (reg 1) (WConst STR)) % tag it as a string
+ (!*EXIT 0)
+);
+
+if_system(KL10, NIL,
+lap '((!*Entry StackOverflow expr 0)
+ (sub (reg ST) (lit (halfword 1000 1000))) % back up stack
+ (!*MOVE '"Stack overflow" (reg 1))
+ (!*JCALL StdError)
+));
+
+on SysLisp;
+
+syslsp procedure ReturnAddressP X;
+begin scalar Y, Z;
+ Z := Field(&SymFnc, 18, 18); % don't want any opcode bits in Z
+ % may someday want to use 23 bits, though.
+ return Field(X, 0, 18) = 2#011001000000000000 % PC flags
+ and Field(@(X - 1), 0, 18) = 8#260740 % pushj 17,
+ and (Y := Field(@(X - 1), 18, 18) - Z) > 0 and Y < MaxSymbols
+ and MkID Y;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/system-faslin.red
Index: psl-1983/3-1/kernel/20/system-faslin.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/system-faslin.red
@@ -0,0 +1,71 @@
+%
+% 20-FASLIN.RED - Functions needed by faslin
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 21-May-83 Mark R. Swanson
+% Changed reference to &SYMFNC in FunctionCellLocation to be an explicit
+% array reference.
+% <PSL.KERNEL-20>SYSTEM-FASLIN.RED.4, 7-Oct-82 13:37:56, Edit by BENSON
+% Changed 0 byte size to 36 byte size, for Tenex compatibility
+
+on Syslisp;
+
+syslsp procedure BinaryOpenRead FileName;
+begin scalar F;
+ F := Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 36*of%bsz of%rd
+ 2#100100000000000000010000000000000000);
+ return if F eq 0 then
+ ContError(99, "Couldn't open binary file for input",
+ BinaryOpenRead FileName)
+ else F;
+end;
+
+syslsp procedure BinaryOpenWrite FileName;
+begin scalar F;
+ F := Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 36*of%bsz of%wr
+ 2#100100000000000000001000000000000000);
+ return if F eq 0 then
+ ContError(99, "Couldn't open binary file for output",
+ BinaryOpenWrite FileName)
+ else F;
+end;
+
+syslsp procedure ValueCellLocation X;
+ if not LispVar !*WritingFaslFile then
+ &SymVal IDInf X
+ else
+ << LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
+ MakeRelocHalfWord(const RELOC_VALUE_CELL, FindIDNumber X) >>;
+
+syslsp procedure ExtraRegLocation X;
+<< X := second X;
+ if not LispVar !*WritingFaslFile then
+ &ArgumentBlock[X - (MaxRealRegs + 1)]
+ else
+ << LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
+ MakeRelocHalfWord(const RELOC_VALUE_CELL, X + 8150) >> >>;
+
+syslsp procedure FunctionCellLocation X;
+ if not LispVar !*WritingFaslFile then
+ &SymFnc[IDInf X] % different from VALUECELLLOCATION because of
+ % strange interaction with SymFnc as a function?
+ else
+ << LispVar NewBitTableEntry!* := const RELOC_HALFWORD;
+ MakeRelocHalfWord(const RELOC_FUNCTION_CELL, FindIDNumber X) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/system-faslout.red
Index: psl-1983/3-1/kernel/20/system-faslout.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/system-faslout.red
@@ -0,0 +1,73 @@
+%
+% 20-FASLOUT.RED - 20-specific stuff for FASL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 February 1982
+% Copyright (c) 1982 University of Utah
+%
+% 21-May-1983 Mark R. Swanson
+% Changed FASL_MAGIC_NUMBER to 2099 to differentiate Extended-20 fasl
+% files from one-section fasl files.
+
+CompileTime DefConst(AddressingUnitsPerItem, 1,
+ BitTableEntriesPerWord, 18,
+ FASL_MAGIC_NUMBER, 2099,
+ RELOC_ID_NUMBER, 1,
+ RELOC_VALUE_CELL, 2,
+ RELOC_FUNCTION_CELL, 3,
+ RELOC_WORD, 1,
+ RELOC_HALFWORD, 2,
+ RELOC_INF, 3);
+
+on SysLisp;
+
+CompileTime <<
+smacro procedure RelocRightHalfTag X;
+ Field(X, 18, 2);
+
+smacro procedure RelocRightHalfInf X;
+ Field(X, 20, 16);
+
+smacro procedure RelocInfTag X;
+ Field(X, 18, 2);
+
+smacro procedure RelocInfInf X;
+ Field(X, 20, 16);
+
+smacro procedure RelocWordTag X;
+ Field(X, 0, 2);
+
+smacro procedure RelocWordInf X;
+ Field(X, 2, 34);
+
+smacro procedure PutRightHalf(Where, What);
+ PutField(Where, 18, 18, What);
+
+put('RightHalf, 'Assign!-Op, 'PutRightHalf);
+>>;
+
+CompileTime DefList('((BinaryWrite ((bout)))
+ (BinaryRead ((bin) (move (reg 1) (reg 2))))
+ (BinaryClose ((closf) (jfcl)))
+ (BinaryWriteBlock
+% ((hrli (reg 2) 8#740000) % point 18,
+% (movns (reg 3))
+% (lsh 3,1) % times 2
+% for extended addressing, the following code should only work if it and
+% the input buffer are in the same section, otherwise, something like the
+% above must be implemented, i.e., a global byte pointer would be needed.
+%
+ ((hrli (reg 2) 8#444400) % point 36,
+ (movns (reg 3))
+ (sout)))
+ (BinaryReadBlock
+ ((hrli (reg 2) 8#444400) % point 36,
+ (movns (reg 3))
+ (sin)))), 'OpenCode);
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/system-gc.red
Index: psl-1983/3-1/kernel/20/system-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/system-gc.red
@@ -0,0 +1,36 @@
+%
+% SYSTEM-GC.RED - System dependent before and after GC hooks
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 March 1982
+% Copyright (c) 1982 University of Utah
+%
+% 21-May-1983 Mark R. Swanson
+% Unmap old heap space after copying GC has been called, so we don't
+% occupy as much swapping space.
+
+on Syslisp;
+
+CompileTime <<
+
+external WVar
+ OldHeapLast, OldHeapLowerBound, OldHeapUpperBound;
+
+syslsp smacro procedure BeforeGCSystemHook();
+ NIL;
+
+syslsp smacro procedure AfterGCSystemHook();
+% Unmap all of old heap except first page, which is assumed to be the first
+% page in a section; else after a savesystem, sections with no pages will
+% not exist (and we don't want to re-create them).
+
+ unmap!-space( OldHeapLowerBound + 1,OldHeapLast+8#1777);
+
+>>;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/20/system-io.red
Index: psl-1983/3-1/kernel/20/system-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/system-io.red
@@ -0,0 +1,285 @@
+%
+% SYSTEM-IO.RED - System dependent IO routines for Dec-20 PSL
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 16 September 1981
+% Copyright (c) 1981 University of Utah
+%
+% 21-May-1983 Mark R. Swanson
+% Replace local byte pointers with one-word global byte pointers
+
+global '(IN!* OUT!*);
+LoadTime <<
+IN!* := 0;
+OUT!* := 1;
+>>;
+
+fluid '(StdIN!* StdOUT!* ErrOUT!* !*Echo);
+LoadTime <<
+StdIN!* := 0;
+StdOUT!* := 1;
+ErrOUT!* := 1;
+>>;
+
+CompileTime flag('(RDTTY FindFreeChannel Dec20Open ContOpenError ClearIO1),
+ 'InternalFunction);
+
+on SysLisp;
+
+external WArray JFNOfChannel, ReadFunction, WriteFunction, CLoseFunction;
+
+if_system(Tops20,
+lap '((!*entry Dec20ReadChar expr 1)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+Loop % get JFN for channel
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+ (!*PUSH (reg 1)) % yes, save char
+ (!*CALL WriteChar) % and write it
+ (!*POP (reg 1)) % restore it
+ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+));
+
+if_system(Tenex,
+lap '((!*entry Dec20ReadChar expr 1)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+Loop % get JFN for channel
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (cain (reg 2) (WConst 8#37)) % TENEX EOL
+ (!*MOVE (WConst 8#12) (reg 2)) % replace it with a linefeed
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+ (!*PUSH (reg 1)) % yes, save char
+ (!*CALL WriteChar) % and write it
+ (!*POP (reg 1)) % restore it
+ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+));
+
+lap '((!*entry Dec20WriteChar expr 2)
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+ % get JFN for channel
+ (!*JUMPEQ (Label CRLF) (reg 2) (WConst 8#12)) % if LF, echo CRLF
+ (bout) % no, just echo char
+ (!*EXIT 0) % return
+CRLF
+ (!*MOVE (WConst 8#15) (reg 2)) % write carriage-return
+ (bout)
+ (!*MOVE (WConst 8#12) (reg 2)) % write linefeed
+ (bout)
+ (!*EXIT 0) % return
+);
+
+internal WConst MaxTerminalBuffer = 200;
+internal WVar NextTerminalChar = 1;
+internal WString TerminalInputBuffer[MaxTerminalBuffer];
+
+lap '((!*entry ClearIO1 expr 0)
+%
+% ^C from RDTTY and restart causes trouble, but we don't want a full RESET
+% (don't want to close files or kill forks), so we'll just do the
+% part of RESET that we want, for terminal input
+%
+ (!*MOVE (WConst 8#100) (reg 1)) % .priin
+ (rfmod)
+ (tro 2 2#001111100001000000) % tt%wak + tt%eco + .ttasi, like RESET
+ (sfmod)
+ (!*EXIT 0)
+);
+
+syslsp procedure ClearIO();
+<< ClearIO1();
+ TerminalInputBuffer[0] := -1;
+ NextTerminalChar := 0;
+ LispVar IN!* := LispVar STDIN!*;
+ LispVar OUT!* := LispVar STDOUT!* >>;
+
+if_system(Tops20,
+lap '((!*entry RDTTY expr 3)
+ (dmove (reg t1) (reg 1))
+ (!*MOVE (WConst 8#101) (reg 1)) % .priou
+ (rfmod) % read mode word
+ (tlze (reg 2) 2#100000000000000000) % if tt%osp is 0, then skip
+ (sfmod) % otherwise turn on output
+ (dmove (reg 1) (reg t1))
+ (!*MOVE (reg 2) (reg 4)) % save original count in r4
+ (!*WPLUS2 (reg 1) (WConst 1)) % make input buffer into byte pointer
+ (!*MkItem (reg 1) 8#61) % (globalize it)
+ (!*WPLUS2 (reg 3) (WConst 1)) % make prompt string into byte pointer
+ (!*MkItem (reg 3) 8#61) % (globalize it)
+ (!*MOVE (reg 1) (reg 5)) % print it once
+ (!*MOVE (reg 3) (reg 1))
+ (psout)
+ (!*MOVE (reg 5) (reg 1))
+ (hrli (reg 2) 2#000110000000000000) % rd%bel + rd%crf
+ (jsys 8#523) % RDTTY
+ (!*JUMP (Label CantRDTTY))
+ (!*MOVE (reg 4) (reg 1)) % move original count to r1
+ (hrrzs (reg 2)) % clear flag bits in r2
+ (!*WDIFFERENCE (reg 1) (reg 2)) % return # chars read, not # available
+ (!*EXIT 0)
+CantRDTTY
+ (!*MOVE (QUOTE "Can't read from terminal") (reg 1))
+ (!*JCALL IOError)
+));
+
+if_system(Tenex,
+lap '((!*entry RDTTY expr 3)
+ (move (reg t1) (reg 1))
+ (move (reg t2) (reg 2))
+ (!*MOVE (WConst 8#101) (reg 1)) % .priou
+ (rfmod) % read mode word
+ (tlze (reg 2) 2#100000000000000000) % if tt%osp is 0, then skip
+ (sfmod) % otherwise turn on output
+ (move (reg 1) (reg t1))
+ (move (reg 2) (reg t2))
+ (!*MOVE (reg 2) (reg 4)) % save original count in r4
+ (!*WPLUS2 (reg 1) (WConst 1)) % make input buffer into byte pointer
+ (hrli (reg 1) 8#440700)
+ (!*WPLUS2 (reg 3) (WConst 1)) % make prompt string into byte pointer
+ (hrli (reg 3) 8#440700)
+ (!*MOVE (reg 1) (reg 5)) % print it once
+ (!*MOVE (reg 3) (reg 1))
+ (psout)
+ (!*MOVE (reg 5) (reg 1))
+% (hrli (reg 2) 2#000110000000000000) % rd%bel + rd%crf
+% (jsys 8#523) % RDTTY
+% (!*JUMP (Label CantRDTTY))
+ (!*MOVE (WConst MaxTerminalBuffer) (reg 2)) % # of chars
+ (setz 3 0) % clear 3
+ (jsys 8#611) % PSTIN, IMSSS JSYS
+ (!*MOVE (WConst 8#12) (reg 3)) % put linefeed at end of buffer
+ (dpb (reg 3) (reg 1)) % 1 points to end of what's been read
+ (!*MOVE (reg 4) (reg 1)) % move original count to r1
+ (hrrzs (reg 2)) % clear flag bits in r2
+ (!*WDIFFERENCE (reg 1) (reg 2)) % return # chars read, not # available
+ (!*EXIT 0)
+));
+
+syslsp procedure TerminalInputHandler Chn;
+begin scalar Ch;
+ while NextTerminalChar >= StrLen TerminalInputBuffer do
+ << NextTerminalChar := 0;
+ TerminalInputBuffer[0] := RDTTY(TerminalInputBuffer,
+ MaxTerminalBuffer,
+ if StringP LispVar PromptString!*
+ then LispVar PromptString!*
+ else ">") >>;
+ Ch := StrByt(TerminalInputBuffer, NextTerminalChar);
+ NextTerminalChar := NextTerminalChar + 1;
+ return Ch;
+end;
+
+syslsp procedure FindFreeChannel();
+begin scalar Chn;
+ Chn := 0;
+ while JfnOfChannel[Chn] neq 0 do
+ << if Chn >= MaxChannels then IOError("No free channels left");
+ Chn := Chn + 1 >>;
+ return Chn;
+end;
+
+syslsp procedure SystemMarkAsClosedChannel FileDes;
+ JFNOfChannel[IntInf FileDes] := 0;
+
+lap '((!*entry Dec20CloseChannel expr 1)
+ (!*MOVE (reg 1) (reg 2)) % save in case of error
+ (!*MOVE (MEMORY (reg 1) (WConst JFNOfChannel)) (reg 1))
+ (closf)
+ (!*JUMP (Label CloseError))
+ (!*EXIT 0)
+CloseError
+ (!*MOVE (QUOTE "Channel could not be closed") (reg 1))
+ (!*JCALL ChannelError)
+);
+
+syslsp procedure SystemOpenFileSpecial FileName;
+<< JFNOfChannel[FileName := FindFreeChannel()] := -1;
+ FileName >>;
+
+syslsp procedure SystemOpenFileForInput FileName;
+begin scalar Chn, JFN;
+ Chn := FindFreeChannel();
+ JFN := Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 7*of%bsz of%rd
+ 2#000111000000000000010000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'INPUT);
+ JFNOfChannel[Chn] := JFN;
+ ReadFunction[Chn] := 'Dec20ReadChar;
+ CloseFunction[Chn] := 'Dec20CloseChannel;
+ return Chn;
+end;
+
+syslsp procedure SystemOpenFileForOutput FileName;
+begin scalar Chn, JFN;
+ Chn := FindFreeChannel();
+ JFN := Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 7*of%bsz of%wr
+ 2#000111000000000000001000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'OUTPUT);
+ JFNOfChannel[Chn] := JFN;
+ WriteFunction[Chn] := 'Dec20WriteChar;
+ CloseFunction[Chn] := 'Dec20CloseChannel;
+ return Chn;
+end;
+
+lap '((!*entry Dec20Open expr 3)
+%
+% Dec20Open(Filename string, GTJFN bits, OPENF bits)
+%
+ (!*WPLUS2 (reg 1) (WConst 1)) % increment r1 to point to characters
+ (!*MkItem (reg 1) 8#61) % (globalize it)
+ (!*MOVE (reg 1) (reg 4)) % save filename string in r4
+ (!*MOVE (reg 2) (reg 1)) % GTJFN flag bits in r1
+ (!*MOVE (reg 4) (reg 2)) % string in r2
+ (gtjfn)
+ (!*JUMP (Label CantOpen))
+ (!*MOVE (reg 3) (reg 2)) % OPENF bits in r2, JFN in r1
+ (openf)
+CantOpen
+ (!*MOVE (WConst 0) (reg 1)) % return 0 on error
+ (!*EXIT 0) % else return the JFN
+);
+
+off SysLisp;
+
+lisp procedure ContOpenError(FileName, AccessMode);
+ ContinuableError(99,
+ BldMsg("`%s' cannot be open for %w",
+ FileName, AccessMode),
+ list('OPEN, MkSTR FileName, MkQuote AccessMode));
+
+END;
ADDED psl-1983/3-1/kernel/20/test-psl-link.ctl
Index: psl-1983/3-1/kernel/20/test-psl-link.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/test-psl-link.ctl
@@ -0,0 +1,42 @@
+cd S:
+define DSK:, DSK:, P20:
+LINK
+/nosymbol
+nil.rel
+/set:.low.:202
+types.rel
+randm.rel
+alloc.rel
+arith.rel
+debg.rel
+error.rel
+eval.rel
+extra.rel
+fasl.rel
+io.rel
+macro.rel
+prop.rel
+symbl.rel
+sysio.rel
+tloop.rel
+main.rel
+heap.rel
+dtypes.rel
+drandm.rel
+dalloc.rel
+darith.rel
+ddebg.rel
+derror.rel
+deval.rel
+dextra.rel
+dfasl.rel
+dio.rel
+dmacro.rel
+dprop.rel
+dsymbl.rel
+dsysio.rel
+dtloop.rel
+dmain.rel
+dheap.rel
+/save s:bpsl.exe
+/go
ADDED psl-1983/3-1/kernel/20/timc.red
Index: psl-1983/3-1/kernel/20/timc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/timc.red
@@ -0,0 +1,18 @@
+%
+% TIMC.RED - get run time in milliseconds
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 1 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+lap '((!*entry TimC expr 0)
+ (!*MOVE (WConst -5) (reg 1))
+ (runtm)
+ (!*EXIT 0)
+);
+
+end;
ADDED psl-1983/3-1/kernel/20/tloop.ctl
Index: psl-1983/3-1/kernel/20/tloop.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/tloop.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "tloop";
+PathIn "tloop.build";
+ASMEnd;
+quit;
+compile tloop.mac, dtloop.mac
ADDED psl-1983/3-1/kernel/20/tloop.init
Index: psl-1983/3-1/kernel/20/tloop.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/tloop.init
@@ -0,0 +1,14 @@
+(FLUID (QUOTE (!*BREAK !*QUITBREAK BREAKEVAL!* BREAKNAME!* BREAKVALUE!*
+ERRORFORM!* BREAKLEVEL!* MAXBREAKLEVEL!* TOPLOOPNAME!* TOPLOOPEVAL!*
+TOPLOOPREAD!* TOPLOOPPRINT!* !*DEFN BREAKIN!* BREAKOUT!*)))
+(DEFLIST (QUOTE ((Q BREAKQUIT) (!? HELPBREAK) (A RESET) (M BREAKERRMSG) (E
+BREAKEDIT) (C BREAKCONTINUE) (R BREAKRETRY) (I INTERPBACKTRACE) (V
+VERBOSEBACKTRACE) (T BACKTRACE))) (QUOTE BREAKFUNCTION))
+(FLUID (QUOTE (TOPLOOPREAD!* TOPLOOPPRINT!* TOPLOOPEVAL!* TOPLOOPNAME!*
+TOPLOOPLEVEL!* HISTORYCOUNT!* HISTORYLIST!* PROMPTSTRING!* LISPBANNER!*
+!*EMSGP !*BACKTRACE !*TIME GCTIME!* !*DEFN DFPRINT!* !*OUTPUT SEMIC!* !*NONIL
+INITFORMS!* LISPSCANTABLE!*)))
+(FLUID (QUOTE (!*BREAK)))
+(PUT (QUOTE HIST) (QUOTE TYPE) (QUOTE NEXPR))
+(FLAG (QUOTE (DSKIN)) (QUOTE IGNORE))
+(FLUID (QUOTE (!*REDEFMSG !*ECHO)))
ADDED psl-1983/3-1/kernel/20/tloop.log
Index: psl-1983/3-1/kernel/20/tloop.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/tloop.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/tloop.mac
Index: psl-1983/3-1/kernel/20/tloop.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/tloop.mac
@@ -0,0 +1,859 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+L3560: 15
+ byte(7)69,120,105,116,32,116,111,32,69,114,114,111,114,83,101,116,0
+L3561: 9
+ byte(7)108,105,115,112,32,98,114,101,97,107,0
+L3562: 9
+ byte(7)66,114,101,97,107,32,108,111,111,112,0
+L3563: 5
+ byte(7)32,98,114,101,97,107,0
+ 0
+; (!*ENTRY BREAK EXPR 0)
+BREAK: intern BREAK
+ ADJSP 15,4
+ MOVE 1,SYMVAL+487
+ PUSHJ 15,SYMFNC+241
+ JSP 10,SYMFNC+443
+ byte(18)1,487
+ JSP 10,SYMFNC+443
+ byte(18)0,796
+ byte(18)0,797
+ byte(18)0,798
+ MOVE 1,SYMVAL+799
+ PUSHJ 15,SYMFNC+475
+ MOVEM 1,0(15)
+ MOVE 1,SYMVAL+800
+ PUSHJ 15,SYMFNC+477
+ MOVEM 1,-1(15)
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+798
+ CAMN 0,SYMVAL+801
+ JRST L3564
+ MOVE 6,L3551
+ CAMN 6,SYMVAL+802
+ JRST L3565
+ MOVE 6,SYMVAL+802
+ MOVEM 6,SYMVAL+803
+ MOVE 2,L3552
+ MOVE 1,SYMVAL+801
+ PUSHJ 15,SYMFNC+176
+ MOVEM 1,SYMVAL+804
+L3565: MOVE 1,L3553
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,-2(15)
+ CAME 0,SYMVAL+500
+ JRST L3566
+ MOVE 5,L3554
+ MOVE 4,SYMVAL+804
+ MOVE 3,L3551
+ MOVE 2,SYMVAL+805
+ MOVE 1,SYMVAL+806
+ PUSHJ 15,SYMFNC+807
+ MOVEM 1,-3(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+501
+ JRST L3566
+L3564: MOVE 6,L3555
+ MOVEM 6,SYMVAL+803
+ MOVE 6,L3556
+ MOVEM 6,SYMVAL+804
+ MOVE 1,L3553
+ PUSHJ 15,SYMFNC+499
+ MOVEM 1,-2(15)
+ CAME 0,SYMVAL+500
+ JRST L3566
+ MOVE 5,L3554
+ MOVE 4,SYMVAL+804
+ MOVE 3,L3551
+ MOVE 2,L3557
+ MOVE 1,L3558
+ PUSHJ 15,SYMFNC+807
+ MOVEM 1,-3(15)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+501
+L3566: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+475
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+477
+ CAMN 0,SYMVAL+798
+ JRST L3567
+ JSP 10,SYMFNC+443
+ byte(18)0,485
+ byte(18)0,484
+ MOVE 1,L3559
+ PUSHJ 15,SYMFNC+156
+ JSP 10,SYMFNC+447
+ 2
+ JRST L3568
+L3567: MOVE 1,SYMVAL+481
+ PUSHJ 15,SYMFNC+261
+L3568: JSP 10,SYMFNC+447
+ 3
+ JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-4
+ POPJ 15,0
+L3559: <4_30>+<1_18>+L3560
+L3558: <30_30>+448
+L3557: <30_30>+310
+L3556: <4_30>+<1_18>+L3561
+L3555: <30_30>+261
+L3554: <4_30>+<1_18>+L3562
+L3553: <30_30>+808
+L3552: <4_30>+<1_18>+L3563
+L3551: <30_30>+809
+ 1
+; (!*ENTRY BREAKEVAL EXPR 1)
+L3571: intern L3571
+ PUSH 15,0
+ PUSH 15,1
+ LDB 11,L3569
+ CAIE 11,30
+ JRST L3572
+ MOVE 2,L3570
+ PUSHJ 15,SYMFNC+522
+ MOVE 2,1
+ MOVEM 2,-1(15)
+ CAMN 2,0
+ JRST L3572
+ MOVE 1,2
+ MOVE 6,1
+ ADJSP 15,-2
+ JRST SYMFNC+288
+L3572: MOVE 2,SYMVAL+803
+ MOVE 1,0(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ MOVEM 1,SYMVAL+797
+ ADJSP 15,-2
+ POPJ 15,0
+L3569: point 6,1,5
+L3570: <30_30>+810
+ 0
+; (!*ENTRY BREAKQUIT EXPR 0)
+L3574: intern L3574
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+798
+ MOVE 2,0
+ MOVE 1,L3573
+ JRST SYMFNC+495
+L3573: <30_30>+808
+ 0
+; (!*ENTRY BREAKCONTINUE EXPR 0)
+L3575: intern L3575
+ MOVE 1,SYMVAL+797
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,SYMVAL+481
+ JRST SYMFNC+813
+L3578: 68
+ byte(7)67,97,110,32,111,110,108,121,32,99,111,110,116,105,110,117,101,32,102,114,111,109,32,97,32,99,111,110,116,105,110,117,97,98,108,101,32,101,114,114,111,114,59,32,117,115,101,32,81,32,40,66,114,101,97,107,81,117,105,116,41,32,116,111,32,113,117,105,116,0
+ 0
+; (!*ENTRY BREAKRETRY EXPR 0)
+L3579: intern L3579
+ CAMN 0,SYMVAL+482
+ JRST L3580
+ MOVE 1,0
+ MOVEM 1,SYMVAL+798
+ MOVE 2,0
+ MOVE 1,L3576
+ JRST SYMFNC+495
+L3580: MOVE 1,L3577
+ PUSHJ 15,SYMFNC+357
+ JRST SYMFNC+444
+L3577: <4_30>+<1_18>+L3578
+L3576: <30_30>+808
+L3583: <30_30>+450
+ <30_30>+128
+ 0
+; (!*ENTRY HELPBREAK EXPR 0)
+L3584: intern L3584
+ MOVE 1,L3581
+ PUSHJ 15,SYMFNC+434
+ MOVE 1,L3582
+ JRST SYMFNC+456
+L3582: <30_30>+451
+L3581: <9_30>+<1_18>+L3583
+L3586: 18
+ byte(7)69,114,114,111,114,70,111,114,109,33,42,32,58,32,37,114,32,37,110,0
+ 0
+; (!*ENTRY BREAKERRMSG EXPR 0)
+L3587: intern L3587
+ MOVE 2,SYMVAL+481
+ MOVE 1,L3585
+ JRST SYMFNC+461
+L3585: <4_30>+<1_18>+L3586
+L3590: 20
+ byte(7)42,42,42,32,69,100,105,116,111,114,32,110,111,116,32,108,111,97,100,101,100,0
+ 0
+; (!*ENTRY BREAKEDIT EXPR 0)
+L3591: intern L3591
+ MOVE 1,L3588
+ PUSHJ 15,SYMFNC+318
+ CAMN 1,0
+ JRST L3592
+ MOVE 1,SYMVAL+481
+ PUSHJ 15,SYMFNC+440
+ MOVEM 1,SYMVAL+481
+ POPJ 15,0
+L3592: MOVE 1,L3589
+ JRST SYMFNC+418
+L3589: <4_30>+<1_18>+L3590
+L3588: <30_30>+440
+L3602: 11
+ byte(7)69,120,105,116,105,110,103,32,37,119,37,110,0
+L3603: 32
+ byte(7)67,112,117,32,116,105,109,101,58,32,37,119,32,109,115,44,32,71,67,32,116,105,109,101,58,32,37,119,32,109,115,37,110,0
+L3604: 16
+ byte(7)67,112,117,32,116,105,109,101,58,32,37,119,32,109,115,37,110,0
+L3605: <30_30>+518
+ <9_30>+<1_18>+L3607
+L3606: 7
+ byte(7)37,119,32,37,119,37,119,32,0
+L3607: <30_30>+806
+ <9_30>+<1_18>+L3608
+L3608: <30_30>+128
+ <30_30>+128
+ 5
+; (!*ENTRY TOPLOOP EXPR 5)
+L3609: intern L3609
+ ADJSP 15,7
+ MOVEM 5,0(15)
+ JSP 10,SYMFNC+443
+ byte(18)4,801
+ byte(18)3,802
+ byte(18)2,805
+ byte(18)1,806
+ MOVEM 0,-4(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,821
+ byte(18)0,442
+ MOVE 6,L3593
+ MOVEM 6,SYMVAL+821
+ MOVE 1,SYMVAL+817
+ AOS 1
+ JSP 10,SYMFNC+443
+ byte(18)1,817
+ SETZM -5(15)
+ MOVE 6,SYMVAL+415
+ MOVEM 6,-2(15)
+ HRRZI 2,62
+ MOVE 1,SYMVAL+817
+ PUSHJ 15,SYMFNC+405
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+357
+L3610: AOS SYMVAL+818
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+172
+ MOVE 2,SYMVAL+822
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,SYMVAL+822
+ MOVE 4,-1(15)
+ MOVE 3,SYMVAL+801
+ MOVE 2,SYMVAL+818
+ MOVE 1,L3594
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,SYMVAL+442
+ MOVE 3,SYMVAL+493
+ MOVE 2,SYMVAL+84
+ MOVE 1,L3595
+ PUSHJ 15,SYMFNC+478
+ MOVEM 1,-3(15)
+ CAMN 1,L3596
+ JRST L3611
+ LDB 11,L3597
+ CAIE 11,9
+ JRST L3610
+ MOVE 1,0(1)
+ MOVEM 1,-3(15)
+ CAMN 1,L3596
+ JRST L3611
+ CAMN 1,SYMVAL+642
+ JRST L3611
+ MOVE 7,SYMVAL+822
+ MOVE 7,0(7)
+ MOVEM 1,0(7)
+ CAMN 0,SYMVAL+823
+ JRST L3612
+ PUSHJ 15,SYMFNC+824
+ MOVEM 1,-5(15)
+ MOVE 6,SYMVAL+415
+ MOVEM 6,-2(15)
+L3612: CAMN 0,SYMVAL+796
+ JRST L3613
+ MOVE 1,-3(15)
+ PUSHJ 15,L3614
+ JRST L3615
+L3613: MOVE 1,SYMVAL+802
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-6(15)
+ MOVE 1,-3(15)
+ PUSHJ 15,SYMFNC+172
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-6(15)
+ MOVE 1,L3598
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,SYMVAL+493
+ MOVE 2,SYMVAL+84
+ PUSHJ 15,SYMFNC+478
+L3615: MOVEM 1,-4(15)
+ LDB 11,L3597
+ CAIE 11,9
+ JRST L3610
+ MOVE 1,0(1)
+ MOVEM 1,-4(15)
+ CAMN 0,SYMVAL+823
+ JRST L3616
+ PUSHJ 15,SYMFNC+824
+ MOVE 2,-5(15)
+ PUSHJ 15,SYMFNC+238
+ MOVEM 1,-5(15)
+ MOVE 2,-2(15)
+ MOVE 1,SYMVAL+415
+ PUSHJ 15,SYMFNC+238
+ MOVEM 1,-2(15)
+L3616: MOVE 7,SYMVAL+822
+ MOVE 7,0(7)
+ MOVE 6,-4(15)
+ MOVEM 6,1(7)
+ CAMN 0,SYMVAL+820
+ JRST L3617
+ MOVE 6,L3593
+ CAME 6,SYMVAL+821
+ JRST L3617
+ CAMN 0,SYMVAL+825
+ JRST L3618
+ CAMN 0,-4(15)
+ JRST L3617
+L3618: MOVE 1,SYMVAL+805
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-6(15)
+ MOVE 1,-4(15)
+ PUSHJ 15,SYMFNC+172
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-6(15)
+ MOVE 1,L3598
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,SYMVAL+493
+ MOVE 2,SYMVAL+84
+ PUSHJ 15,SYMFNC+478
+L3617: CAMN 0,SYMVAL+823
+ JRST L3610
+ SKIPE -2(15)
+ JRST L3619
+ MOVE 2,-5(15)
+ MOVE 1,L3599
+ PUSHJ 15,SYMFNC+461
+ JRST L3610
+L3619: MOVE 2,-2(15)
+ MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+238
+ MOVE 3,-2(15)
+ MOVE 2,1
+ MOVE 1,L3600
+ PUSHJ 15,SYMFNC+461
+ JRST L3610
+L3611: MOVE 2,SYMVAL+801
+ MOVE 1,L3601
+ PUSHJ 15,SYMFNC+461
+ JSP 10,SYMFNC+447
+ 1
+ MOVE 1,0
+ JSP 10,SYMFNC+447
+ 2
+ JSP 10,SYMFNC+447
+ 4
+ ADJSP 15,-7
+ POPJ 15,0
+L3597: point 6,1,5
+L3601: <4_30>+<1_18>+L3602
+L3600: <4_30>+<1_18>+L3603
+L3599: <4_30>+<1_18>+L3604
+L3598: <30_30>+518
+L3596: <30_30>+826
+L3595: <9_30>+<1_18>+L3605
+L3594: <4_30>+<1_18>+L3606
+L3593: <30_30>+59
+; (!*ENTRY DEFNPRINT EXPR 1)
+L3614: intern L3614
+ PUSH 15,1
+ LDB 11,L3620
+ CAIE 11,9
+ JRST L3624
+ MOVE 2,L3621
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+758
+ CAMN 1,0
+ JRST L3624
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST L3625
+L3624: CAMN 0,SYMVAL+827
+ JRST L3626
+ MOVE 2,SYMVAL+827
+ MOVE 1,0(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ JRST L3627
+L3626: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+577
+L3627: LDB 11,L3622
+ CAIE 11,9
+ JRST L3628
+ MOVE 2,L3623
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+758
+ CAMN 1,0
+ JRST L3628
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST L3625
+L3628: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+L3620: point 6,1,5
+L3622: point 6,0(15),5
+L3623: <30_30>+261
+L3621: <30_30>+828
+; (!*ENTRY DEFNPRINT1 EXPR 1)
+L3625: intern L3625
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ MOVE 1,SYMVAL+802
+ PUSHJ 15,SYMFNC+234
+ MOVEM 1,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+172
+ PUSHJ 15,SYMFNC+234
+ MOVE 3,1
+ MOVE 2,-1(15)
+ MOVE 1,L3629
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,SYMVAL+493
+ MOVE 2,SYMVAL+84
+ ADJSP 15,-2
+ JRST SYMFNC+478
+L3629: <30_30>+518
+L3631: 18
+ byte(7)78,111,32,104,105,115,116,111,114,121,32,101,110,116,114,121,32,37,114,0
+; (!*ENTRY NTHENTRY EXPR 1)
+L3632: intern L3632
+ PUSH 15,1
+ JSP 10,SYMFNC+443
+ byte(18)0,484
+ CAMGE 1,SYMVAL+818
+ JRST L3633
+ MOVE 2,1
+ MOVE 1,L3630
+ PUSHJ 15,SYMFNC+155
+ PUSHJ 15,SYMFNC+156
+ JRST L3634
+L3633: MOVE 2,SYMVAL+818
+ SUB 2,1
+ MOVE 1,SYMVAL+822
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+350
+ MOVE 1,0(1)
+L3634: JSP 10,SYMFNC+447
+ 1
+ ADJSP 15,-1
+ POPJ 15,0
+L3630: <4_30>+<1_18>+L3631
+ 1
+; (!*ENTRY INP EXPR 1)
+INP: intern INP
+ PUSHJ 15,L3632
+ MOVE 1,0(1)
+ POPJ 15,0
+ 1
+; (!*ENTRY REDO EXPR 1)
+REDO: intern REDO
+ PUSHJ 15,L3632
+ MOVE 2,SYMVAL+802
+ MOVE 1,0(1)
+ MOVE 6,2
+ JRST SYMFNC+288
+ 1
+; (!*ENTRY ANS EXPR 1)
+ANS: intern ANS
+ PUSHJ 15,L3632
+ MOVE 1,1(1)
+ POPJ 15,0
+ 1
+; (!*ENTRY HIST NEXPR 1)
+HIST: intern HIST
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 7,SYMVAL+818
+ CAIL 7,2
+ JRST L3638
+ MOVE 1,0
+ JRST L3639
+L3638: HRRZI 6,1
+ MOVEM 6,-1(15)
+ MOVE 2,SYMVAL+818
+ SOS 2
+ MOVEM 2,-2(15)
+ LDB 11,L3635
+ CAIE 11,9
+ JRST L3640
+ MOVE 6,L3636
+ CAME 6,0(1)
+ JRST L3641
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+818
+ MOVE 1,0
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,SYMVAL+822
+ MOVE 1,0
+ JRST L3639
+L3641: SKIPL 0(1)
+ JRST L3642
+ MOVE 3,0(1)
+ MOVNS 3
+ MOVE 1,SYMVAL+822
+ MOVE 1,1(1)
+ ADJSP 15,-4
+ JRST L3643
+L3642: MOVE 2,0(1)
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+281
+ MOVEM 1,-1(15)
+ MOVE 2,0(15)
+ MOVE 2,1(2)
+ MOVEM 2,0(15)
+L3640: LDB 11,L3637
+ CAIE 11,9
+ JRST L3644
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+284
+ MOVEM 1,-2(15)
+L3644: MOVE 2,SYMVAL+818
+ SUB 2,-2(15)
+ MOVE 1,SYMVAL+822
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+350
+ MOVE 3,-2(15)
+ SUB 3,-1(15)
+ AOS 3
+ MOVE 2,-2(15)
+ ADJSP 15,-4
+ JRST L3643
+L3639: ADJSP 15,-4
+ POPJ 15,0
+L3635: point 6,1,5
+L3637: point 6,0(15),5
+L3636: <30_30>+833
+L3646: 21
+ byte(7)37,119,9,73,110,112,58,32,37,112,37,110,9,65,110,115,58,32,37,112,37,110,0
+; (!*ENTRY HISTPRINT EXPR 3)
+L3643: intern L3643
+ PUSH 15,2
+ PUSH 15,1
+ JUMPN 3,L3647
+ MOVE 1,0
+ JRST L3648
+L3647: SOS 3
+ SOS 2
+ MOVE 1,1(1)
+ PUSHJ 15,L3643
+ MOVE 4,0(15)
+ MOVE 4,0(4)
+ MOVE 4,1(4)
+ MOVE 3,0(15)
+ MOVE 3,0(3)
+ MOVE 3,0(3)
+ MOVE 2,-1(15)
+ MOVE 1,L3645
+ ADJSP 15,-2
+ JRST SYMFNC+461
+L3648: ADJSP 15,-2
+ POPJ 15,0
+L3645: <4_30>+<1_18>+L3646
+ 0
+; (!*ENTRY TIME EXPR 0)
+TIME: intern TIME
+ PUSHJ 15,SYMFNC+419
+ JRST SYMFNC+138
+L3654: 3
+ byte(7)108,105,115,112,0
+ 0
+; (!*ENTRY STANDARDLISP EXPR 0)
+L3655: intern L3655
+ MOVE 2,SYMVAL+637
+ MOVE 1,L3649
+ JSP 10,SYMFNC+443
+ byte(18)2,635
+ byte(18)1,631
+ MOVE 5,SYMVAL+819
+ MOVE 4,L3650
+ MOVE 3,L3651
+ MOVE 2,L3652
+ MOVE 1,L3653
+ PUSHJ 15,SYMFNC+807
+ JSP 10,SYMFNC+447
+ 2
+ POPJ 15,0
+L3653: <30_30>+448
+L3652: <30_30>+835
+L3651: <30_30>+261
+L3650: <4_30>+<1_18>+L3654
+L3649: <30_30>+638
+L3657: 5
+ byte(7)37,102,37,112,37,110,0
+ 1
+; (!*ENTRY PRINTWITHFRESHLINE EXPR 1)
+L3658: intern L3658
+ MOVE 2,1
+ MOVE 1,L3656
+ JRST SYMFNC+461
+L3656: <4_30>+<1_18>+L3657
+L3660: 5
+ byte(7)37,119,44,32,37,119,0
+ 3
+; (!*ENTRY SAVESYSTEM EXPR 3)
+L3661: intern L3661
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVE 6,SYMVAL+818
+ MOVEM 6,-4(15)
+ MOVE 6,SYMVAL+822
+ MOVEM 6,-3(15)
+ MOVE 4,0
+ MOVEM 4,SYMVAL+822
+ SETZM SYMVAL+818
+ PUSHJ 15,SYMFNC+547
+ MOVE 3,1
+ MOVE 2,0(15)
+ MOVE 1,L3659
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,SYMVAL+819
+ MOVE 6,SYMVAL+84
+ MOVEM 6,SYMVAL+570
+ MOVE 6,-2(15)
+ MOVEM 6,SYMVAL+837
+ MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+548
+ MOVE 1,0
+ MOVEM 1,SYMVAL+837
+ MOVE 6,-4(15)
+ MOVEM 6,SYMVAL+818
+ MOVE 6,-3(15)
+ MOVEM 6,SYMVAL+822
+ MOVE 1,0
+ ADJSP 15,-5
+ POPJ 15,0
+L3659: <4_30>+<1_18>+L3660
+ 0
+; (!*ENTRY EVALINITFORMS EXPR 0)
+L3663: intern L3663
+ PUSH 15,SYMVAL+837
+L3664: LDB 11,L3662
+ CAIN 11,9
+ JRST L3665
+ MOVE 1,0
+ JRST L3666
+L3665: MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+261
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L3664
+L3666: MOVE 1,0
+ MOVEM 1,SYMVAL+837
+ ADJSP 15,-1
+ POPJ 15,0
+L3662: point 6,0(15),5
+L3676: 5
+ byte(7)37,102,37,112,37,110,0
+L3677: <30_30>+448
+ <30_30>+128
+L3678: 22
+ byte(7)67,111,117,108,100,110,39,116,32,111,112,101,110,32,102,105,108,101,32,96,37,119,39,0
+L3679: <30_30>+246
+ <9_30>+<1_18>+L3680
+L3680: <30_30>+612
+ <30_30>+128
+ 1
+; (!*ENTRY DSKIN EXPR 1)
+DSKIN: intern DSKIN
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-4(15)
+ MOVE 3,L3667
+ MOVE 2,1
+ MOVE 1,L3668
+ PUSHJ 15,SYMFNC+235
+ MOVE 3,0
+ MOVE 2,0
+ PUSHJ 15,SYMFNC+478
+ MOVEM 1,-3(15)
+ LDB 11,L3669
+ CAIN 11,9
+ JRST L3681
+ MOVE 2,0(15)
+ MOVE 1,L3670
+ PUSHJ 15,SYMFNC+155
+ MOVEM 1,-5(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L3671
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,1
+ MOVE 2,-5(15)
+ HRRZI 1,99
+ ADJSP 15,-6
+ JRST SYMFNC+236
+L3681: MOVE 2,0(1)
+ MOVEM 2,-2(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+475
+ MOVEM 1,-1(15)
+L3682: MOVE 3,SYMVAL+493
+ MOVE 2,SYMVAL+84
+ MOVE 1,L3672
+ PUSHJ 15,SYMFNC+478
+ MOVEM 1,-4(15)
+ LDB 11,L3669
+ CAIE 11,9
+ JRST L3683
+ MOVE 6,SYMVAL+642
+ CAMN 6,0(1)
+ JRST L3683
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+234
+ MOVE 2,1
+ MOVE 1,L3673
+ PUSHJ 15,SYMFNC+249
+ MOVE 3,SYMVAL+493
+ MOVE 2,SYMVAL+84
+ PUSHJ 15,SYMFNC+478
+ MOVE 2,1
+ MOVEM 2,-4(15)
+ LDB 11,L3674
+ CAIE 11,9
+ JRST L3683
+ CAME 0,SYMVAL+796
+ JRST L3682
+ MOVE 2,0(2)
+ MOVE 1,L3675
+ PUSHJ 15,SYMFNC+461
+ JRST L3682
+L3683: MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+475
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+613
+ MOVE 1,0
+ ADJSP 15,-6
+ POPJ 15,0
+L3669: point 6,1,5
+L3674: point 6,2,5
+L3675: <4_30>+<1_18>+L3676
+L3673: <30_30>+840
+L3672: <9_30>+<1_18>+L3677
+L3671: <30_30>+839
+L3670: <4_30>+<1_18>+L3678
+L3668: <30_30>+603
+L3667: <9_30>+<1_18>+L3679
+ 1
+; (!*ENTRY DSKINEVAL EXPR 1)
+L3684: intern L3684
+ CAME 0,SYMVAL+796
+ JRST L3685
+ JRST SYMFNC+261
+L3685: JRST L3686
+; (!*ENTRY DSKINDEFNPRINT EXPR 1)
+L3686: intern L3686
+ PUSH 15,1
+ LDB 11,L3687
+ CAIE 11,9
+ JRST L3691
+ MOVE 2,L3688
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+758
+ CAMN 1,0
+ JRST L3691
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+261
+L3691: CAMN 0,SYMVAL+827
+ JRST L3692
+ MOVE 2,SYMVAL+827
+ MOVE 1,0(15)
+ MOVE 6,2
+ PUSHJ 15,SYMFNC+288
+ JRST L3693
+L3692: MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+577
+L3693: LDB 11,L3689
+ CAIE 11,9
+ JRST L3694
+ MOVE 2,L3690
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+758
+ CAMN 1,0
+ JRST L3694
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ JRST SYMFNC+261
+L3694: MOVE 1,0
+ ADJSP 15,-1
+ POPJ 15,0
+L3687: point 6,1,5
+L3689: point 6,0(15),5
+L3690: <30_30>+261
+L3688: <30_30>+828
+ 1
+; (!*ENTRY LAPIN EXPR 1)
+LAPIN: intern LAPIN
+ ADJSP 15,3
+ MOVEM 1,0(15)
+ JSP 10,SYMFNC+443
+ byte(18)0,793
+ byte(18)0,571
+ MOVE 2,L3695
+ PUSHJ 15,SYMFNC+603
+ PUSHJ 15,SYMFNC+475
+ MOVEM 1,-1(15)
+L3696: PUSHJ 15,SYMFNC+448
+ MOVE 2,SYMVAL+642
+ MOVEM 1,-2(15)
+ PUSHJ 15,SYMFNC+198
+ CAME 1,0
+ JRST L3697
+ MOVE 1,-2(15)
+ PUSHJ 15,SYMFNC+261
+ JRST L3696
+L3697: MOVE 1,-1(15)
+ PUSHJ 15,SYMFNC+475
+ PUSHJ 15,SYMFNC+613
+ MOVE 1,0
+ JSP 10,SYMFNC+447
+ 2
+ ADJSP 15,-3
+ POPJ 15,0
+L3695: <30_30>+612
+ end
ADDED psl-1983/3-1/kernel/20/tloop.rel
Index: psl-1983/3-1/kernel/20/tloop.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/tloop.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/trap.red
Index: psl-1983/3-1/kernel/20/trap.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/trap.red
@@ -0,0 +1,1 @@
+end;
ADDED psl-1983/3-1/kernel/20/types.ctl
Index: psl-1983/3-1/kernel/20/types.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/types.ctl
@@ -0,0 +1,9 @@
+;Modifications to this file may disappear, as this file is generated
+;automatically using information in P20:20-KERNEL-GEN.SL.
+def dsk: dsk:,p20:,pk:
+S:DEC20-CROSS.EXE
+ASMOut "types";
+PathIn "types.build";
+ASMEnd;
+quit;
+compile types.mac, dtypes.mac
ADDED psl-1983/3-1/kernel/20/types.init
Index: psl-1983/3-1/kernel/20/types.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/types.init
ADDED psl-1983/3-1/kernel/20/types.log
Index: psl-1983/3-1/kernel/20/types.log
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/types.log
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/types.mac
Index: psl-1983/3-1/kernel/20/types.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/types.mac
@@ -0,0 +1,2045 @@
+ search monsym,macsym
+ radix 10
+ extern SYMNAM
+ extern SYMVAL
+ extern SYMFNC
+ extern SYMPRP
+ extern L0001
+ extern L0002
+ extern L0003
+ 1
+; (!*ENTRY ID2INT EXPR 1)
+ID2INT: intern ID2INT
+ LDB 11,L0004
+ CAIE 11,30
+ JRST L0006
+ TLZ 1,258048
+ POPJ 15,0
+L0006: MOVE 2,L0005
+ JRST SYMFNC+130
+L0004: point 6,1,5
+L0005: <30_30>+129
+L0011: 15
+ byte(7)112,111,115,105,116,105,118,101,32,105,110,116,101,103,101,114,0
+ 1
+; (!*ENTRY INT2ID EXPR 1)
+INT2ID: intern INT2ID
+ MOVE 5,1
+ MOVE 4,0
+ LDB 11,L0008
+ CAIN 11,63
+ JRST L0007
+ CAILE 11,0
+ JRST L0012
+L0007: MOVE 4,1
+ JUMPL 1,L0013
+ HRLI 1,122880
+ POPJ 15,0
+L0013: MOVE 3,L0009
+ MOVE 2,L0010
+ JRST SYMFNC+132
+L0012: MOVE 2,L0010
+ JRST SYMFNC+133
+L0008: point 6,1,5
+L0010: <30_30>+131
+L0009: <4_30>+<1_18>+L0011
+ 1
+; (!*ENTRY INT2SYS EXPR 1)
+L0016: intern L0016
+ LDB 11,L0014
+ CAIG 11,0
+ JRST L0017
+ CAIN 11,63
+ JRST L0017
+ LDB 11,L0014
+ CAIE 11,1
+ JRST L0018
+ TLZ 1,258048
+ MOVE 1,1(1)
+ POPJ 15,0
+L0018: MOVE 2,L0015
+ JRST SYMFNC+133
+L0017: POPJ 15,0
+L0014: point 6,1,5
+L0015: <30_30>+134
+ 1
+; (!*ENTRY LISP2CHAR EXPR 1)
+L0022: intern L0022
+ MOVE 5,1
+ MOVE 4,0
+ LDB 11,L0020
+ CAIN 11,63
+ JRST L0019
+ CAILE 11,0
+ JRST L0023
+L0019: MOVE 2,1
+ MOVE 4,2
+ JUMPL 2,L0023
+ CAILE 2,127
+ JRST L0023
+ MOVE 1,2
+ POPJ 15,0
+L0023: LDB 11,L0020
+ CAIE 11,30
+ JRST L0024
+ SETZM 2
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 1,SYMNAM(3)
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ POPJ 15,0
+L0024: LDB 11,L0020
+ CAIE 11,4
+ JRST L0025
+ SETZM 2
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ POPJ 15,0
+L0025: MOVE 2,L0021
+ JRST SYMFNC+136
+L0020: point 6,1,5
+L0021: <30_30>+135
+ 1
+; (!*ENTRY INT2CODE EXPR 1)
+L0026: intern L0026
+ TLZ 1,258048
+ TLO 1,61440
+ POPJ 15,0
+ 1
+; (!*ENTRY SYS2INT EXPR 1)
+L0030: intern L0030
+ MOVE 6,1
+ LDB 2,L0027
+ TDNE 2,L0028
+ TDO 2,L0029
+ CAMN 2,1
+ JRST L0031
+ JRST L0032
+L0031: POPJ 15,0
+L0027: point 31,6,35
+L0028: 1073741824
+L0029: -1073741824
+; (!*ENTRY SYS2FIXN EXPR 1)
+L0032: intern L0032
+ ADJSP 15,2
+ MOVEM 1,0(15)
+ PUSHJ 15,SYMFNC+139
+ MOVEM 1,-1(15)
+ MOVE 6,0(15)
+ MOVEM 6,1(1)
+ TLZ 1,258048
+ TLO 1,4096
+ ADJSP 15,-2
+ POPJ 15,0
+ 1
+; (!*ENTRY ID2STRING EXPR 1)
+L0035: intern L0035
+ LDB 11,L0033
+ CAIE 11,30
+ JRST L0036
+ TLZ 1,258048
+ MOVE 1,SYMNAM(1)
+ POPJ 15,0
+L0036: MOVE 2,L0034
+ JRST SYMFNC+130
+L0033: point 6,1,5
+L0034: <30_30>+140
+ 1
+; (!*ENTRY STRING2VECTOR EXPR 1)
+L0042: intern L0042
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ LDB 11,L0037
+ CAIE 11,4
+ JRST L0043
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 6,0(3)
+ LDB 2,L0038
+ TDNE 2,L0039
+ TDO 2,L0040
+ MOVEM 2,-3(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-2(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVEM 0,-4(15)
+ SETZM -4(15)
+L0044: MOVE 6,-4(15)
+ CAMLE 6,-3(15)
+ JRST L0045
+ MOVE 2,-4(15)
+ MOVE 1,-1(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,-4(15)
+ ADD 2,-2(15)
+ MOVEM 1,1(2)
+ AOS -4(15)
+ JRST L0044
+L0045: MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,32768
+ JRST L0046
+L0043: MOVE 2,L0041
+ ADJSP 15,-5
+ JRST SYMFNC+143
+L0046: ADJSP 15,-5
+ POPJ 15,0
+L0037: point 6,1,5
+L0038: point 30,6,35
+L0039: 536870912
+L0040: -536870912
+L0041: <30_30>+141
+ 1
+; (!*ENTRY VECTOR2STRING EXPR 1)
+L0052: intern L0052
+ ADJSP 15,6
+ MOVEM 1,0(15)
+ LDB 11,L0047
+ CAIE 11,8
+ JRST L0053
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVE 3,1
+ TLZ 3,258048
+ MOVE 6,0(3)
+ LDB 2,L0048
+ TDNE 2,L0049
+ TDO 2,L0050
+ MOVEM 2,-3(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-2(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-1(15)
+ MOVEM 0,-5(15)
+ SETZM -5(15)
+L0054: MOVE 6,-5(15)
+ CAMLE 6,-3(15)
+ JRST L0055
+ MOVE 1,-5(15)
+ ADD 1,-1(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+135
+ MOVE 3,1
+ MOVE 2,-5(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -5(15)
+ JRST L0054
+L0055: MOVE 1,-2(15)
+ TLZ 1,258048
+ TLO 1,16384
+ JRST L0056
+L0053: MOVE 2,L0051
+ ADJSP 15,-6
+ JRST SYMFNC+146
+L0056: ADJSP 15,-6
+ POPJ 15,0
+L0047: point 6,1,5
+L0048: point 30,6,35
+L0049: 536870912
+L0050: -536870912
+L0051: <30_30>+144
+L0060: -1
+ byte(7)0
+ 1
+; (!*ENTRY LIST2STRING EXPR 1)
+L0061: intern L0061
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ CAME 1,0
+ JRST L0062
+ MOVE 1,L0057
+ JRST L0063
+L0062: LDB 11,L0058
+ CAIE 11,9
+ JRST L0064
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+148
+ MOVE 2,1
+ SOS 2
+ MOVEM 2,-2(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-1(15)
+ MOVEM 0,-3(15)
+ SETZM -3(15)
+L0065: MOVE 6,-3(15)
+ CAMLE 6,-2(15)
+ JRST L0066
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ PUSHJ 15,SYMFNC+135
+ MOVE 3,1
+ MOVE 2,-3(15)
+ MOVE 1,-1(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ AOS -3(15)
+ JRST L0065
+L0066: MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,16384
+ JRST L0063
+L0064: MOVE 2,L0059
+ ADJSP 15,-4
+ JRST SYMFNC+149
+L0063: ADJSP 15,-4
+ POPJ 15,0
+L0058: point 6,1,5
+L0059: <30_30>+147
+L0057: <4_30>+<1_18>+L0060
+ 1
+; (!*ENTRY STRING2LIST EXPR 1)
+L0072: intern L0072
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ LDB 11,L0067
+ CAIE 11,4
+ JRST L0073
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVE 2,0
+ MOVEM 2,-1(15)
+ MOVE 4,1
+ TLZ 4,258048
+ MOVE 6,0(4)
+ LDB 3,L0068
+ TDNE 3,L0069
+ TDO 3,L0070
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 3,-3(15)
+L0074: SKIPGE -3(15)
+ JRST L0075
+ MOVE 2,-3(15)
+ MOVE 1,0(15)
+ TLZ 1,258048
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-1(15)
+ SOS -3(15)
+ JRST L0074
+L0075: MOVE 1,-1(15)
+ JRST L0076
+L0073: MOVE 2,L0071
+ ADJSP 15,-4
+ JRST SYMFNC+143
+L0076: ADJSP 15,-4
+ POPJ 15,0
+L0067: point 6,1,5
+L0068: point 30,6,35
+L0069: 536870912
+L0070: -536870912
+L0071: <30_30>+150
+ 1
+; (!*ENTRY LIST2VECTOR EXPR 1)
+L0079: intern L0079
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ LDB 11,L0077
+ CAIN 11,9
+ JRST L0080
+ CAME 1,0
+ JRST L0081
+L0080: MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ PUSHJ 15,SYMFNC+148
+ MOVE 2,1
+ SOS 2
+ MOVEM 2,-2(15)
+ MOVE 1,2
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-1(15)
+ MOVEM 0,-3(15)
+ SETZM -3(15)
+L0082: MOVE 6,-3(15)
+ CAMLE 6,-2(15)
+ JRST L0083
+ MOVE 2,-3(15)
+ ADD 2,-1(15)
+ MOVE 1,0(15)
+ MOVE 1,0(1)
+ MOVEM 1,1(2)
+ MOVE 3,0(15)
+ MOVE 3,1(3)
+ MOVEM 3,0(15)
+ AOS -3(15)
+ JRST L0082
+L0083: MOVE 1,-1(15)
+ TLZ 1,258048
+ TLO 1,32768
+ JRST L0084
+L0081: MOVE 2,L0078
+ ADJSP 15,-4
+ JRST SYMFNC+149
+L0084: ADJSP 15,-4
+ POPJ 15,0
+L0077: point 6,1,5
+L0078: <30_30>+152
+ 1
+; (!*ENTRY VECTOR2LIST EXPR 1)
+L0090: intern L0090
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ LDB 11,L0085
+ CAIE 11,8
+ JRST L0091
+ MOVEM 0,-1(15)
+ MOVEM 0,-2(15)
+ MOVE 2,0
+ MOVEM 2,-1(15)
+ MOVE 4,1
+ TLZ 4,258048
+ MOVE 6,0(4)
+ LDB 3,L0086
+ TDNE 3,L0087
+ TDO 3,L0088
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 3,-3(15)
+L0092: SKIPGE -3(15)
+ JRST L0093
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ TLZ 1,258048
+ ADD 1,-3(15)
+ MOVE 1,1(1)
+ PUSHJ 15,SYMFNC+151
+ MOVEM 1,-1(15)
+ SOS -3(15)
+ JRST L0092
+L0093: MOVE 1,-1(15)
+ JRST L0094
+L0091: MOVE 2,L0089
+ ADJSP 15,-4
+ JRST SYMFNC+146
+L0094: ADJSP 15,-4
+ POPJ 15,0
+L0085: point 6,1,5
+L0086: point 30,6,35
+L0087: 536870912
+L0088: -536870912
+L0089: <30_30>+153
+L0103: 35
+ byte(7)83,117,98,115,99,114,105,112,116,32,37,114,32,105,110,32,71,101,116,86,32,105,115,32,111,117,116,32,111,102,32,114,97,110,103,101,0
+ 2
+; (!*ENTRY GETV EXPR 2)
+GETV: intern GETV
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ LDB 11,L0095
+ CAIE 11,8
+ JRST L0104
+ LDB 11,L0097
+ CAIN 11,63
+ JRST L0096
+ CAILE 11,0
+ JRST L0105
+L0096: MOVE 3,1
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ MOVEM 2,-3(15)
+ JUMPL 2,L0106
+ MOVE 6,0(3)
+ LDB 4,L0098
+ TDNE 4,L0099
+ TDO 4,L0100
+ CAMLE 2,4
+ JRST L0106
+ MOVE 1,2
+ ADDM 3,1
+ MOVE 1,1(1)
+ JRST L0107
+L0106: MOVE 1,L0101
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-4
+ JRST SYMFNC+156
+L0105: MOVE 2,L0102
+ MOVE 1,-1(15)
+ ADJSP 15,-4
+ JRST SYMFNC+157
+L0104: MOVE 2,L0102
+ ADJSP 15,-4
+ JRST SYMFNC+146
+L0107: ADJSP 15,-4
+ POPJ 15,0
+L0095: point 6,1,5
+L0097: point 6,2,5
+L0098: point 30,6,35
+L0099: 536870912
+L0100: -536870912
+L0102: <30_30>+154
+L0101: <4_30>+<1_18>+L0103
+L0116: 35
+ byte(7)83,117,98,115,99,114,105,112,116,32,37,114,32,105,110,32,80,117,116,86,32,105,115,32,111,117,116,32,111,102,32,114,97,110,103,101,0
+ 3
+; (!*ENTRY PUTV EXPR 3)
+PUTV: intern PUTV
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ LDB 11,L0108
+ CAIE 11,8
+ JRST L0117
+ LDB 11,L0110
+ CAIN 11,63
+ JRST L0109
+ CAILE 11,0
+ JRST L0118
+L0109: MOVE 4,1
+ TLZ 4,258048
+ MOVEM 4,-3(15)
+ MOVEM 2,-4(15)
+ JUMPL 2,L0119
+ MOVE 6,0(4)
+ LDB 5,L0111
+ TDNE 5,L0112
+ TDO 5,L0113
+ CAMLE 2,5
+ JRST L0119
+ ADDM 4,2
+ MOVE 1,3
+ MOVEM 1,1(2)
+ JRST L0120
+L0119: MOVE 1,L0114
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-5
+ JRST SYMFNC+156
+L0118: MOVE 2,L0115
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST SYMFNC+157
+L0117: MOVE 2,L0115
+ ADJSP 15,-5
+ JRST SYMFNC+146
+L0120: ADJSP 15,-5
+ POPJ 15,0
+L0108: point 6,1,5
+L0110: point 6,2,5
+L0111: point 30,6,35
+L0112: 536870912
+L0113: -536870912
+L0115: <30_30>+158
+L0114: <4_30>+<1_18>+L0116
+ 1
+; (!*ENTRY UPBV EXPR 1)
+UPBV: intern UPBV
+ LDB 11,L0121
+ CAIE 11,8
+ JRST L0125
+ MOVE 2,1
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0122
+ TDNE 1,L0123
+ TDO 1,L0124
+ POPJ 15,0
+L0125: MOVE 1,0
+ POPJ 15,0
+L0121: point 6,1,5
+L0122: point 30,6,35
+L0123: 536870912
+L0124: -536870912
+ 1
+; (!*ENTRY EVECTORP EXPR 1)
+L0127: intern L0127
+ LDB 1,L0126
+ CAIN 1,10
+ JRST L0128
+ MOVE 1,0
+ POPJ 15,0
+L0128: MOVE 1,SYMVAL+84
+ POPJ 15,0
+L0126: point 6,1,5
+L0136: 36
+ byte(7)83,117,98,115,99,114,105,112,116,32,37,114,32,105,110,32,69,71,69,84,86,32,105,115,32,111,117,116,32,111,102,32,114,97,110,103,101,0
+ 2
+; (!*ENTRY EGETV EXPR 2)
+EGETV: intern EGETV
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ PUSHJ 15,SYMFNC+160
+ CAMN 1,0
+ JRST L0137
+ LDB 11,L0130
+ CAIN 11,63
+ JRST L0129
+ CAILE 11,0
+ JRST L0138
+L0129: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVE 6,-1(15)
+ MOVEM 6,-3(15)
+ SKIPGE -3(15)
+ JRST L0139
+ MOVE 6,0(2)
+ LDB 3,L0131
+ TDNE 3,L0132
+ TDO 3,L0133
+ CAMGE 3,-3(15)
+ JRST L0139
+ MOVE 1,-3(15)
+ ADDM 2,1
+ MOVE 1,1(1)
+ JRST L0140
+L0139: MOVE 2,-1(15)
+ MOVE 1,L0134
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-4
+ JRST SYMFNC+156
+L0138: MOVE 2,L0135
+ MOVE 1,-1(15)
+ ADJSP 15,-4
+ JRST SYMFNC+157
+L0137: MOVE 2,L0135
+ MOVE 1,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+146
+L0140: ADJSP 15,-4
+ POPJ 15,0
+L0130: point 6,-1(15),5
+L0131: point 30,6,35
+L0132: 536870912
+L0133: -536870912
+L0135: <30_30>+161
+L0134: <4_30>+<1_18>+L0136
+L0148: 36
+ byte(7)83,117,98,115,99,114,105,112,116,32,37,114,32,105,110,32,69,112,117,116,118,32,105,115,32,111,117,116,32,111,102,32,114,97,110,103,101,0
+ 3
+; (!*ENTRY EPUTV EXPR 3)
+EPUTV: intern EPUTV
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ PUSHJ 15,SYMFNC+160
+ CAMN 1,0
+ JRST L0149
+ LDB 11,L0142
+ CAIN 11,63
+ JRST L0141
+ CAILE 11,0
+ JRST L0150
+L0141: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-3(15)
+ MOVE 6,-1(15)
+ MOVEM 6,-4(15)
+ SKIPGE -4(15)
+ JRST L0151
+ MOVE 6,0(2)
+ LDB 3,L0143
+ TDNE 3,L0144
+ TDO 3,L0145
+ CAMGE 3,-4(15)
+ JRST L0151
+ MOVE 4,-4(15)
+ ADDM 2,4
+ MOVE 1,-2(15)
+ MOVEM 1,1(4)
+ JRST L0152
+L0151: MOVE 2,-1(15)
+ MOVE 1,L0146
+ PUSHJ 15,SYMFNC+155
+ ADJSP 15,-5
+ JRST SYMFNC+156
+L0150: MOVE 2,L0147
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST SYMFNC+157
+L0149: MOVE 2,L0147
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+146
+L0152: ADJSP 15,-5
+ POPJ 15,0
+L0142: point 6,-1(15),5
+L0143: point 30,6,35
+L0144: 536870912
+L0145: -536870912
+L0147: <30_30>+162
+L0146: <4_30>+<1_18>+L0148
+ 1
+; (!*ENTRY EUPBV EXPR 1)
+EUPBV: intern EUPBV
+ PUSH 15,1
+ PUSHJ 15,SYMFNC+160
+ CAMN 1,0
+ JRST L0156
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0153
+ TDNE 1,L0154
+ TDO 1,L0155
+ JRST L0157
+L0156: MOVE 1,0
+L0157: ADJSP 15,-1
+ POPJ 15,0
+L0153: point 30,6,35
+L0154: 536870912
+L0155: -536870912
+ 2
+; (!*ENTRY INDX EXPR 2)
+INDX: intern INDX
+ ADJSP 15,4
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ TLNN 2,258048
+ JRST L0163
+ MOVE 2,L0158
+ MOVE 1,-1(15)
+ ADJSP 15,-4
+ JRST SYMFNC+157
+L0163: MOVE 3,1
+ TLZ 3,258048
+ MOVEM 3,-2(15)
+ LDB 4,L0159
+ MOVEM 4,-3(15)
+ MOVE 1,4
+ CAIL 1,4
+ CAILE 1,9
+ JRST L0164
+ JRST @L0165-4(1)
+L0165: IFIW L0166
+ IFIW L0166
+ IFIW L0167
+ IFIW L0168
+ IFIW L0169
+ IFIW L0170
+L0164: JRST L0171
+L0166: MOVE 6,0(3)
+ LDB 5,L0160
+ TDNE 5,L0161
+ TDO 5,L0162
+ CAMG 2,5
+ JRST L0172
+ MOVE 3,L0158
+ MOVE 1,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+165
+L0172: MOVE 1,3
+ AOS 1
+ ADJSP 15,-4
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ POPJ 15,0
+L0169: MOVE 6,0(3)
+ LDB 5,L0160
+ TDNE 5,L0161
+ TDO 5,L0162
+ CAMG 2,5
+ JRST L0173
+ MOVE 3,L0158
+ MOVE 1,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+165
+L0173: MOVE 1,2
+ ADDM 3,1
+ MOVE 1,1(1)
+ JRST L0174
+L0168: MOVE 6,0(3)
+ LDB 5,L0160
+ TDNE 5,L0161
+ TDO 5,L0162
+ CAMG 2,5
+ JRST L0175
+ MOVE 3,L0158
+ MOVE 1,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+165
+L0175: MOVE 1,2
+ ADDM 3,1
+ MOVE 1,1(1)
+ JRST L0174
+L0167: MOVE 6,0(3)
+ LDB 5,L0160
+ TDNE 5,L0161
+ TDO 5,L0162
+ CAMG 2,5
+ JRST L0176
+ MOVE 3,L0158
+ MOVE 1,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+165
+L0176: MOVE 1,3
+ AOS 1
+ ADJSP 15,-4
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ POPJ 15,0
+L0170: MOVEM 2,-3(15)
+L0177: SKIPLE -3(15)
+ JRST L0178
+ MOVE 1,0
+ JRST L0179
+L0178: MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ LDB 11,L0159
+ CAIN 11,9
+ JRST L0180
+ MOVE 3,L0158
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+165
+L0180: SOS -3(15)
+ JRST L0177
+L0179: MOVE 1,0(15)
+ MOVE 1,0(1)
+ JRST L0174
+L0171: MOVE 2,L0158
+ MOVE 1,0(15)
+ ADJSP 15,-4
+ JRST SYMFNC+166
+L0174: ADJSP 15,-4
+ POPJ 15,0
+L0159: point 6,1,5
+L0160: point 30,6,35
+L0161: 536870912
+L0162: -536870912
+L0158: <30_30>+164
+ 3
+; (!*ENTRY SETINDX EXPR 3)
+L0186: intern L0186
+ ADJSP 15,5
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ TLNN 2,258048
+ JRST L0187
+ MOVE 2,L0181
+ MOVE 1,-1(15)
+ ADJSP 15,-5
+ JRST SYMFNC+157
+L0187: MOVE 4,1
+ TLZ 4,258048
+ MOVEM 4,-3(15)
+ LDB 5,L0182
+ MOVEM 5,-4(15)
+ MOVE 1,5
+ CAIL 1,4
+ CAILE 1,9
+ JRST L0188
+ JRST @L0189-4(1)
+L0189: IFIW L0190
+ IFIW L0190
+ IFIW L0191
+ IFIW L0192
+ IFIW L0193
+ IFIW L0194
+L0188: JRST L0195
+L0190: MOVE 6,0(4)
+ LDB 1,L0183
+ TDNE 1,L0184
+ TDO 1,L0185
+ CAMG 2,1
+ JRST L0196
+ MOVE 3,L0181
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+165
+L0196: MOVE 1,4
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,3
+ JRST L0197
+L0193: MOVE 6,0(4)
+ LDB 1,L0183
+ TDNE 1,L0184
+ TDO 1,L0185
+ CAMG 2,1
+ JRST L0198
+ MOVE 3,L0181
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+165
+L0198: ADDM 4,2
+ MOVEM 3,1(2)
+ MOVE 1,3
+ JRST L0197
+L0192: MOVE 6,0(4)
+ LDB 1,L0183
+ TDNE 1,L0184
+ TDO 1,L0185
+ CAMG 2,1
+ JRST L0199
+ MOVE 3,L0181
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+165
+L0199: ADDM 4,2
+ MOVEM 3,1(2)
+ MOVE 1,3
+ JRST L0197
+L0191: MOVE 6,0(4)
+ LDB 1,L0183
+ TDNE 1,L0184
+ TDO 1,L0185
+ CAMG 2,1
+ JRST L0200
+ MOVE 3,L0181
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+165
+L0200: MOVE 1,4
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ MOVE 1,3
+ JRST L0197
+L0194: MOVEM 2,-4(15)
+L0201: SKIPLE -4(15)
+ JRST L0202
+ MOVE 1,0
+ JRST L0203
+L0202: MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ LDB 11,L0182
+ CAIN 11,9
+ JRST L0204
+ MOVE 3,L0181
+ MOVE 2,-1(15)
+ PUSHJ 15,SYMFNC+165
+L0204: SOS -4(15)
+ JRST L0201
+L0203: MOVE 7,0(15)
+ MOVE 6,-2(15)
+ MOVEM 6,0(7)
+ MOVE 1,-2(15)
+ JRST L0197
+L0195: MOVE 2,L0181
+ MOVE 1,0(15)
+ ADJSP 15,-5
+ JRST SYMFNC+166
+L0197: ADJSP 15,-5
+ POPJ 15,0
+L0182: point 6,1,5
+L0183: point 30,6,35
+L0184: 536870912
+L0185: -536870912
+L0181: <30_30>+167
+ 3
+; (!*ENTRY SUB EXPR 3)
+SUB: intern SUB
+ ADDM 2,3
+ AOS 3
+ JRST SYMFNC+169
+ 3
+; (!*ENTRY SUBSEQ EXPR 3)
+SUBSEQ: intern SUBSEQ
+ ADJSP 15,7
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 0,-5(15)
+ TLNN 2,258048
+ JRST L0212
+ MOVE 2,L0205
+ MOVE 1,-1(15)
+ ADJSP 15,-7
+ JRST SYMFNC+157
+L0212: TLNN 3,258048
+ JRST L0213
+ MOVE 2,L0205
+ MOVE 1,3
+ ADJSP 15,-7
+ JRST SYMFNC+157
+L0213: MOVE 4,3
+ SUB 4,2
+ SOS 4
+ MOVEM 4,-3(15)
+ CAML 4,L0206
+ JRST L0214
+ MOVE 3,L0205
+ MOVE 2,-2(15)
+ ADJSP 15,-7
+ JRST SYMFNC+165
+L0214: LDB 1,L0207
+ CAIL 1,4
+ CAILE 1,9
+ JRST L0215
+ JRST @L0216-4(1)
+L0216: IFIW L0217
+ IFIW L0217
+ IFIW L0218
+ IFIW L0219
+ IFIW L0220
+ IFIW L0221
+L0215: JRST L0222
+L0217: MOVE 1,0(15)
+ TLZ 1,258048
+ MOVE 6,0(1)
+ LDB 5,L0208
+ TDNE 5,L0209
+ TDO 5,L0210
+ MOVEM 5,-4(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,5
+ JRST L0223
+ MOVE 3,L0205
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ ADJSP 15,-7
+ JRST SYMFNC+165
+L0223: MOVE 1,4
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-5(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L0224: MOVE 6,-6(15)
+ CAMG 6,-3(15)
+ JRST L0225
+ SETZM 1
+ JRST L0226
+L0225: MOVE 2,-6(15)
+ ADD 2,-1(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-6(15)
+ MOVE 1,-5(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -6(15)
+ JRST L0224
+L0226: LDB 1,L0211
+ CAIN 1,4
+ JRST L0227
+ CAIN 1,5
+ JRST L0228
+ JRST L0229
+L0227: MOVE 1,-5(15)
+ TLZ 1,258048
+ TLO 1,16384
+ JRST L0230
+L0228: MOVE 1,-5(15)
+ TLZ 1,258048
+ TLO 1,20480
+ JRST L0230
+L0229: MOVE 1,0
+ JRST L0230
+L0220: MOVE 1,0(15)
+ TLZ 1,258048
+ MOVE 6,0(1)
+ LDB 5,L0208
+ TDNE 5,L0209
+ TDO 5,L0210
+ MOVEM 5,-4(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,5
+ JRST L0231
+ MOVE 3,L0205
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ ADJSP 15,-7
+ JRST SYMFNC+165
+L0231: MOVE 1,4
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-5(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L0232: MOVE 6,-6(15)
+ CAMG 6,-3(15)
+ JRST L0233
+ SETZM 1
+ JRST L0234
+L0233: MOVE 2,-6(15)
+ ADD 2,-5(15)
+ MOVE 3,-6(15)
+ ADD 3,-1(15)
+ ADD 3,-2(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS -6(15)
+ JRST L0232
+L0234: MOVE 1,-5(15)
+ TLZ 1,258048
+ TLO 1,32768
+ JRST L0230
+L0219: MOVE 1,0(15)
+ TLZ 1,258048
+ MOVE 6,0(1)
+ LDB 5,L0208
+ TDNE 5,L0209
+ TDO 5,L0210
+ MOVEM 5,-4(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,5
+ JRST L0235
+ MOVE 3,L0205
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ ADJSP 15,-7
+ JRST SYMFNC+165
+L0235: MOVE 1,4
+ PUSHJ 15,SYMFNC+170
+ MOVEM 1,-5(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L0236: MOVE 6,-6(15)
+ CAMG 6,-3(15)
+ JRST L0237
+ SETZM 1
+ JRST L0238
+L0237: MOVE 2,-6(15)
+ ADD 2,-5(15)
+ MOVE 3,-6(15)
+ ADD 3,-1(15)
+ ADD 3,-2(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS -6(15)
+ JRST L0236
+L0238: MOVE 1,-5(15)
+ TLZ 1,258048
+ TLO 1,28672
+ JRST L0230
+L0218: MOVE 1,0(15)
+ TLZ 1,258048
+ MOVE 6,0(1)
+ LDB 5,L0208
+ TDNE 5,L0209
+ TDO 5,L0210
+ MOVEM 5,-4(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,5
+ JRST L0239
+ MOVE 3,L0205
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ ADJSP 15,-7
+ JRST SYMFNC+165
+L0239: MOVE 1,4
+ PUSHJ 15,SYMFNC+171
+ MOVEM 1,-5(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-2(15)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L0240: MOVE 6,-6(15)
+ CAMG 6,-3(15)
+ JRST L0241
+ SETZM 1
+ JRST L0242
+L0241: MOVE 2,-6(15)
+ ADD 2,-1(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-6(15)
+ MOVE 1,-5(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ AOS -6(15)
+ JRST L0240
+L0242: MOVE 1,-5(15)
+ TLZ 1,258048
+ TLO 1,24576
+ JRST L0230
+L0221: MOVEM 0,-6(15)
+ HRRZI 6,1
+ MOVEM 6,-6(15)
+L0243: MOVE 6,-6(15)
+ CAMG 6,-1(15)
+ JRST L0244
+ SETZM 1
+ JRST L0245
+L0244: LDB 11,L0211
+ CAIE 11,9
+ JRST L0246
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0247
+L0246: MOVE 3,L0205
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+L0247: AOS -6(15)
+ JRST L0243
+L0245: MOVE 1,0
+ PUSHJ 15,SYMFNC+172
+ MOVEM 1,-5(15)
+ MOVEM 0,-6(15)
+ SETZM -6(15)
+L0248: MOVE 6,-6(15)
+ CAMG 6,-3(15)
+ JRST L0249
+ SETZM 1
+ JRST L0250
+L0249: LDB 11,L0211
+ CAIE 11,9
+ JRST L0251
+ MOVE 2,0(15)
+ MOVE 2,0(2)
+ MOVE 1,-5(15)
+ PUSHJ 15,SYMFNC+173
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0252
+L0251: MOVE 3,L0205
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+L0252: AOS -6(15)
+ JRST L0248
+L0250: MOVE 1,-5(15)
+ MOVE 1,0(1)
+ JRST L0230
+L0222: MOVE 2,L0205
+ MOVE 1,0(15)
+ ADJSP 15,-7
+ JRST SYMFNC+166
+L0230: ADJSP 15,-7
+ POPJ 15,0
+L0206: -1
+L0207: point 6,1,5
+L0208: point 30,6,35
+L0209: 536870912
+L0210: -536870912
+L0211: point 6,0(15),5
+L0205: <30_30>+169
+ 4
+; (!*ENTRY SETSUB EXPR 4)
+SETSUB: intern SETSUB
+ ADDM 2,3
+ AOS 3
+ JRST SYMFNC+175
+ 4
+; (!*ENTRY SETSUBSEQ EXPR 4)
+L0262: intern L0262
+ ADJSP 15,9
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ MOVEM 4,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ MOVEM 0,-7(15)
+ TLNN 2,258048
+ JRST L0263
+ MOVE 2,L0253
+ MOVE 1,-1(15)
+ ADJSP 15,-9
+ JRST SYMFNC+157
+L0263: TLNN 3,258048
+ JRST L0264
+ MOVE 2,L0253
+ MOVE 1,3
+ ADJSP 15,-9
+ JRST SYMFNC+157
+L0264: MOVE 5,3
+ SUB 5,2
+ SOS 5
+ MOVEM 5,-4(15)
+ CAML 5,L0254
+ JRST L0265
+ MOVE 3,L0253
+ MOVE 2,-2(15)
+ ADJSP 15,-9
+ JRST SYMFNC+165
+L0265: LDB 1,L0255
+ CAIL 1,4
+ CAILE 1,9
+ JRST L0266
+ JRST @L0267-4(1)
+L0267: IFIW L0268
+ IFIW L0268
+ IFIW L0269
+ IFIW L0270
+ IFIW L0271
+ IFIW L0272
+L0266: JRST L0273
+L0268: LDB 11,L0256
+ CAIN 11,4
+ JRST L0274
+ LDB 11,L0256
+ CAIN 11,5
+ JRST L0274
+ MOVE 2,L0253
+ MOVE 1,4
+ ADJSP 15,-9
+ JRST SYMFNC+143
+L0274: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-5(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVEM 1,-7(15)
+ MOVE 6,0(1)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-6(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,-5(15)
+ JRST L0275
+ MOVE 3,L0253
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0275: CAMN 5,-6(15)
+ JRST L0277
+ MOVE 3,L0253
+ MOVE 2,5
+ MOVE 1,4
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0277: MOVEM 2,-2(15)
+ MOVEM 0,-8(15)
+ SETZM -8(15)
+L0278: MOVE 6,-8(15)
+ CAMLE 6,-4(15)
+ JRST L0276
+ MOVE 2,-8(15)
+ MOVE 1,-7(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-8(15)
+ ADD 2,-1(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -8(15)
+ JRST L0278
+L0271: LDB 11,L0256
+ CAIN 11,8
+ JRST L0279
+ MOVE 2,L0253
+ MOVE 1,4
+ ADJSP 15,-9
+ JRST SYMFNC+146
+L0279: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-5(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVEM 1,-7(15)
+ MOVE 6,0(1)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-6(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,-5(15)
+ JRST L0280
+ MOVE 3,L0253
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0280: CAMN 5,-6(15)
+ JRST L0281
+ MOVE 3,L0253
+ MOVE 2,5
+ MOVE 1,4
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0281: MOVEM 2,-2(15)
+ MOVEM 0,-8(15)
+ SETZM -8(15)
+L0282: MOVE 6,-8(15)
+ CAMLE 6,-4(15)
+ JRST L0276
+ MOVE 2,-8(15)
+ ADD 2,-1(15)
+ ADD 2,-2(15)
+ MOVE 3,-8(15)
+ ADD 3,-7(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS -8(15)
+ JRST L0282
+L0270: LDB 11,L0256
+ CAIN 11,7
+ JRST L0283
+ MOVE 2,L0253
+ MOVE 1,4
+ ADJSP 15,-9
+ JRST SYMFNC+146
+L0283: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-5(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVEM 1,-7(15)
+ MOVE 6,0(1)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-6(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,-5(15)
+ JRST L0284
+ MOVE 3,L0253
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0284: CAMN 5,-6(15)
+ JRST L0285
+ MOVE 3,L0253
+ MOVE 2,5
+ MOVE 1,4
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0285: MOVEM 2,-2(15)
+ MOVEM 0,-8(15)
+ SETZM -8(15)
+L0286: MOVE 6,-8(15)
+ CAMLE 6,-4(15)
+ JRST L0276
+ MOVE 2,-8(15)
+ ADD 2,-1(15)
+ ADD 2,-2(15)
+ MOVE 3,-8(15)
+ ADD 3,-7(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS -8(15)
+ JRST L0286
+L0269: LDB 11,L0256
+ CAIN 11,6
+ JRST L0287
+ MOVE 2,L0253
+ MOVE 1,4
+ ADJSP 15,-9
+ JRST SYMFNC+146
+L0287: MOVE 2,0(15)
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-5(15)
+ MOVE 1,4
+ TLZ 1,258048
+ MOVEM 1,-7(15)
+ MOVE 6,0(1)
+ LDB 1,L0257
+ TDNE 1,L0258
+ TDO 1,L0259
+ MOVEM 1,-6(15)
+ MOVE 1,3
+ SOS 1
+ CAMG 1,-5(15)
+ JRST L0288
+ MOVE 3,L0253
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0288: CAMN 5,-6(15)
+ JRST L0289
+ MOVE 3,L0253
+ MOVE 2,5
+ MOVE 1,4
+ PUSHJ 15,SYMFNC+165
+ JRST L0276
+L0289: MOVEM 2,-2(15)
+ MOVEM 0,-8(15)
+ SETZM -8(15)
+L0290: MOVE 6,-8(15)
+ CAMLE 6,-4(15)
+ JRST L0276
+ MOVE 2,-8(15)
+ MOVE 1,-7(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-8(15)
+ ADD 2,-1(15)
+ MOVE 1,-2(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ AOS -8(15)
+ JRST L0290
+L0272: LDB 11,L0256
+ CAIN 11,9
+ JRST L0291
+ CAMN 4,0
+ JRST L0291
+ MOVE 2,L0253
+ MOVE 1,4
+ ADJSP 15,-9
+ JRST SYMFNC+149
+L0291: MOVEM 0,-8(15)
+ HRRZI 6,1
+ MOVEM 6,-8(15)
+L0292: MOVE 6,-8(15)
+ CAMLE 6,-1(15)
+ JRST L0293
+ LDB 11,L0260
+ CAIE 11,9
+ JRST L0294
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ JRST L0295
+L0294: MOVE 3,L0253
+ MOVE 2,-1(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+L0295: AOS -8(15)
+ JRST L0292
+L0293: MOVE 6,-3(15)
+ MOVEM 6,-7(15)
+ MOVEM 0,-8(15)
+ SETZM -8(15)
+L0296: MOVE 6,-8(15)
+ CAMLE 6,-4(15)
+ JRST L0276
+ LDB 11,L0260
+ CAIE 11,9
+ JRST L0297
+ LDB 11,L0261
+ CAIE 11,9
+ JRST L0297
+ MOVE 7,0(15)
+ MOVE 6,-7(15)
+ MOVE 6,0(6)
+ MOVEM 6,0(7)
+ MOVE 1,0(15)
+ MOVE 1,1(1)
+ MOVEM 1,0(15)
+ MOVE 2,-7(15)
+ MOVE 2,1(2)
+ MOVEM 2,-7(15)
+ JRST L0298
+L0297: MOVE 3,L0253
+ MOVE 2,-2(15)
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+165
+L0298: AOS -8(15)
+ JRST L0296
+L0273: MOVE 2,L0253
+ MOVE 1,0(15)
+ PUSHJ 15,SYMFNC+166
+L0276: MOVE 1,-3(15)
+ ADJSP 15,-9
+ POPJ 15,0
+L0254: -1
+L0255: point 6,1,5
+L0256: point 6,4,5
+L0257: point 30,6,35
+L0258: 536870912
+L0259: -536870912
+L0260: point 6,0(15),5
+L0261: point 6,-7(15),5
+L0253: <30_30>+175
+ 2
+; (!*ENTRY CONCAT EXPR 2)
+CONCAT: intern CONCAT
+ ADJSP 15,8
+ MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 0,-2(15)
+ MOVEM 0,-3(15)
+ MOVEM 0,-4(15)
+ MOVEM 0,-5(15)
+ MOVEM 0,-6(15)
+ LDB 1,L0299
+ CAIL 1,4
+ CAILE 1,9
+ JRST L0306
+ JRST @L0307-4(1)
+L0307: IFIW L0308
+ IFIW L0308
+ IFIW L0309
+ IFIW L0310
+ IFIW L0311
+ IFIW L0312
+L0306: CAIN 1,30
+ JRST L0312
+ JRST L0313
+L0308: LDB 11,L0300
+ CAIN 11,4
+ JRST L0314
+ LDB 11,L0300
+ CAIN 11,5
+ JRST L0314
+ MOVE 2,L0301
+ MOVE 1,-1(15)
+ ADJSP 15,-8
+ JRST SYMFNC+143
+L0314: MOVE 3,0(15)
+ TLZ 3,258048
+ MOVEM 3,-4(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-5(15)
+ MOVE 6,0(3)
+ LDB 5,L0302
+ TDNE 5,L0303
+ TDO 5,L0304
+ MOVEM 5,-2(15)
+ MOVE 6,0(4)
+ LDB 1,L0302
+ TDNE 1,L0303
+ TDO 1,L0304
+ MOVEM 1,-3(15)
+ ADDM 5,1
+ AOS 1
+ PUSHJ 15,SYMFNC+145
+ MOVEM 1,-6(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-4(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ MOVEM 3,-5(15)
+ MOVEM 0,-7(15)
+ SETZM -7(15)
+L0315: MOVE 6,-7(15)
+ CAMG 6,-2(15)
+ JRST L0316
+ SETZM 1
+ JRST L0317
+L0316: MOVE 2,-7(15)
+ MOVE 1,-4(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-7(15)
+ MOVE 1,-6(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -7(15)
+ JRST L0315
+L0317: MOVEM 0,-7(15)
+ SETZM -7(15)
+L0318: MOVE 6,-7(15)
+ CAMG 6,-3(15)
+ JRST L0319
+ SETZM 1
+ JRST L0320
+L0319: MOVE 2,-7(15)
+ MOVE 1,-5(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-7(15)
+ ADD 2,-2(15)
+ AOS 2
+ MOVE 1,-6(15)
+ AOS 1
+ TLO 1,204800
+ ADJBP 2,1
+ DPB 3,2
+ AOS -7(15)
+ JRST L0318
+L0320: LDB 11,L0305
+ CAIE 11,4
+ JRST L0321
+ MOVE 1,-6(15)
+ TLZ 1,258048
+ TLO 1,16384
+ JRST L0322
+L0321: MOVE 1,-6(15)
+ TLZ 1,258048
+ TLO 1,20480
+ JRST L0322
+L0311: LDB 11,L0300
+ CAIN 11,8
+ JRST L0323
+ MOVE 2,L0301
+ MOVE 1,-1(15)
+ ADJSP 15,-8
+ JRST SYMFNC+146
+L0323: MOVE 3,0(15)
+ TLZ 3,258048
+ MOVEM 3,-4(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-5(15)
+ MOVE 6,0(3)
+ LDB 5,L0302
+ TDNE 5,L0303
+ TDO 5,L0304
+ MOVEM 5,-2(15)
+ MOVE 6,0(4)
+ LDB 1,L0302
+ TDNE 1,L0303
+ TDO 1,L0304
+ MOVEM 1,-3(15)
+ ADDM 5,1
+ AOS 1
+ PUSHJ 15,SYMFNC+142
+ MOVEM 1,-6(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-4(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ MOVEM 3,-5(15)
+ MOVEM 0,-7(15)
+ SETZM -7(15)
+L0324: MOVE 6,-7(15)
+ CAMG 6,-2(15)
+ JRST L0325
+ SETZM 1
+ JRST L0326
+L0325: MOVE 2,-7(15)
+ ADD 2,-6(15)
+ MOVE 3,-7(15)
+ ADD 3,-4(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS -7(15)
+ JRST L0324
+L0326: MOVEM 0,-7(15)
+ SETZM -7(15)
+L0327: MOVE 6,-7(15)
+ CAMG 6,-3(15)
+ JRST L0328
+ SETZM 1
+ JRST L0329
+L0328: MOVE 2,-7(15)
+ ADD 2,-2(15)
+ ADD 2,-6(15)
+ MOVE 3,-7(15)
+ ADD 3,-5(15)
+ MOVE 6,1(3)
+ MOVEM 6,2(2)
+ AOS -7(15)
+ JRST L0327
+L0329: MOVE 1,-6(15)
+ TLZ 1,258048
+ TLO 1,32768
+ JRST L0322
+L0310: LDB 11,L0300
+ CAIN 11,7
+ JRST L0330
+ MOVE 2,L0301
+ MOVE 1,-1(15)
+ ADJSP 15,-8
+ JRST SYMFNC+146
+L0330: MOVE 3,0(15)
+ TLZ 3,258048
+ MOVEM 3,-4(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-5(15)
+ MOVE 6,0(3)
+ LDB 5,L0302
+ TDNE 5,L0303
+ TDO 5,L0304
+ MOVEM 5,-2(15)
+ MOVE 6,0(4)
+ LDB 1,L0302
+ TDNE 1,L0303
+ TDO 1,L0304
+ MOVEM 1,-3(15)
+ ADDM 5,1
+ AOS 1
+ PUSHJ 15,SYMFNC+170
+ MOVEM 1,-6(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-4(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ MOVEM 3,-5(15)
+ MOVEM 0,-7(15)
+ SETZM -7(15)
+L0331: MOVE 6,-7(15)
+ CAMG 6,-2(15)
+ JRST L0332
+ SETZM 1
+ JRST L0333
+L0332: MOVE 2,-7(15)
+ ADD 2,-6(15)
+ MOVE 3,-7(15)
+ ADD 3,-4(15)
+ MOVE 6,1(3)
+ MOVEM 6,1(2)
+ AOS -7(15)
+ JRST L0331
+L0333: MOVEM 0,-7(15)
+ SETZM -7(15)
+L0334: MOVE 6,-7(15)
+ CAMG 6,-3(15)
+ JRST L0335
+ SETZM 1
+ JRST L0336
+L0335: MOVE 2,-7(15)
+ ADD 2,-2(15)
+ ADD 2,-6(15)
+ MOVE 3,-7(15)
+ ADD 3,-5(15)
+ MOVE 6,1(3)
+ MOVEM 6,2(2)
+ AOS -7(15)
+ JRST L0334
+L0336: MOVE 1,-6(15)
+ TLZ 1,258048
+ TLO 1,28672
+ JRST L0322
+L0309: LDB 11,L0300
+ CAIN 11,6
+ JRST L0337
+ MOVE 2,L0301
+ MOVE 1,-1(15)
+ ADJSP 15,-8
+ JRST SYMFNC+146
+L0337: MOVE 3,0(15)
+ TLZ 3,258048
+ MOVEM 3,-4(15)
+ MOVE 4,2
+ TLZ 4,258048
+ MOVEM 4,-5(15)
+ MOVE 6,0(3)
+ LDB 5,L0302
+ TDNE 5,L0303
+ TDO 5,L0304
+ MOVEM 5,-2(15)
+ MOVE 6,0(4)
+ LDB 1,L0302
+ TDNE 1,L0303
+ TDO 1,L0304
+ MOVEM 1,-3(15)
+ ADDM 5,1
+ AOS 1
+ PUSHJ 15,SYMFNC+171
+ MOVEM 1,-6(15)
+ MOVE 2,0(15)
+ TLZ 2,258048
+ MOVEM 2,-4(15)
+ MOVE 3,-1(15)
+ TLZ 3,258048
+ MOVEM 3,-5(15)
+ MOVEM 0,-7(15)
+ SETZM -7(15)
+L0338: MOVE 6,-7(15)
+ CAMG 6,-2(15)
+ JRST L0339
+ SETZM 1
+ JRST L0340
+L0339: MOVE 2,-7(15)
+ MOVE 1,-4(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-7(15)
+ MOVE 1,-6(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ AOS -7(15)
+ JRST L0338
+L0340: MOVEM 0,-7(15)
+ SETZM -7(15)
+L0341: MOVE 6,-7(15)
+ CAMG 6,-3(15)
+ JRST L0342
+ SETZM 1
+ JRST L0343
+L0342: MOVE 2,-7(15)
+ MOVE 1,-5(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ LDB 1,2
+ MOVE 3,1
+ MOVE 2,-7(15)
+ ADD 2,-2(15)
+ AOS 2
+ MOVE 1,-6(15)
+ AOS 1
+ TLO 1,245760
+ ADJBP 2,1
+ DPB 3,2
+ AOS -7(15)
+ JRST L0341
+L0343: MOVE 1,-6(15)
+ TLZ 1,258048
+ TLO 1,24576
+ JRST L0322
+L0312: CAMN 0,0(15)
+ JRST L0344
+ LDB 11,L0305
+ CAIE 11,9
+ JRST L0345
+L0344: MOVE 1,0(15)
+ ADJSP 15,-8
+ JRST SYMFNC+177
+L0345: MOVE 1,0
+ JRST L0322
+L0313: MOVE 2,L0301
+ MOVE 1,0(15)
+ ADJSP 15,-8
+ JRST SYMFNC+166
+L0322: ADJSP 15,-8
+ POPJ 15,0
+L0299: point 6,1,5
+L0300: point 6,2,5
+L0302: point 30,6,35
+L0303: 536870912
+L0304: -536870912
+L0305: point 6,0(15),5
+L0301: <30_30>+176
+ 1
+; (!*ENTRY SIZE EXPR 1)
+SIZE: intern SIZE
+ MOVE 4,1
+ LDB 1,L0346
+ CAIL 1,4
+ CAILE 1,9
+ JRST L0352
+ JRST @L0353-4(1)
+L0353: IFIW L0354
+ IFIW L0354
+ IFIW L0354
+ IFIW L0354
+ IFIW L0354
+ IFIW L0355
+L0352: CAIN 1,30
+ JRST L0356
+ JRST L0357
+L0354: MOVE 2,4
+ TLZ 2,258048
+ MOVE 6,0(2)
+ LDB 1,L0347
+ TDNE 1,L0348
+ TDO 1,L0349
+ POPJ 15,0
+L0356: SETOM 1
+ POPJ 15,0
+L0355: MOVE 3,0
+ SETOM 3
+L0358: LDB 11,L0350
+ CAIE 11,9
+ JRST L0359
+ AOS 3
+ MOVE 1,1(4)
+ MOVE 4,1
+ JRST L0358
+L0359: MOVE 1,3
+ POPJ 15,0
+L0357: MOVE 2,L0351
+ MOVE 1,4
+ JRST SYMFNC+166
+L0346: point 6,1,5
+L0347: point 30,6,35
+L0348: 536870912
+L0349: -536870912
+L0350: point 6,4,5
+L0351: <30_30>+178
+ end
ADDED psl-1983/3-1/kernel/20/types.rel
Index: psl-1983/3-1/kernel/20/types.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/types.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/kernel/20/write-float.red
Index: psl-1983/3-1/kernel/20/write-float.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/20/write-float.red
@@ -0,0 +1,45 @@
+%
+% WRITE-FLOAT.RED - format a floating point number into a string
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 26 November 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL-20>WRITE-FLOAT.RED.3, 28-Sep-82 15:44:53, Edit by BENSON
+% Changed DMOVE to 2 moves, so this will run on a KI10 Tenex
+
+lap '((!*entry WriteFloat expr 2) % convert float to string
+%
+% r1 is string pointer, r2 is pointer to 2 word float
+% puts characters in string buffer with terminating null char and count
+%
+ (!*MOVE (reg 1) (reg t1)) % save pointer to string count
+ (!*WPLUS2 (reg 1) (WConst 1)) % move to chars
+ (hrli (reg 1) 8#440700) % make r1 a byte pointer
+ (!*MOVE (reg 1) (reg t2)) % save starting byte pointer
+ (move (reg 3) (Indexed (reg 2) 1)) % load r2 and r3 with the number
+ (move (reg 2) (Indexed (reg 2) 0))
+ (move (reg 4) (lit (fullword 2#000010100000001000000000010000000000)))
+ % fl%one + fl%pnt + 16 fl%rnd
+ (dfout)
+ (!*JUMP (Label Error))
+ (!*MOVE (WConst -1) (reg 4)) % count := -1
+Count
+ (!*JUMPEQ (Label DoneCounting) (reg 1) (reg t2)) % byte pointers equal?
+ (ibp (reg t2))
+ (aoja (reg 4) Count) % Count := Count + 1
+DoneCounting
+ (!*MOVE (reg 4) (MEMORY (reg t1) (WConst 0))) % deposit count
+ (!*MOVE (WConst 0) (reg 2))
+ (idpb (reg 4) (reg 1)) % deposit null byte
+ (!*EXIT 0)
+Error
+ (!*MOVE (QUOTE "Couldn't print float") (reg 1))
+ (!*JCALL IOError)
+);
+
+END;
ADDED psl-1983/3-1/kernel/alloc.build
Index: psl-1983/3-1/kernel/alloc.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/alloc.build
@@ -0,0 +1,17 @@
+%
+% ALLOC.BUILD - Files dealing with allocation of memory blocks
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "allocators.red"$ % heap, symbol and code space alloc
+PathIn "copiers.red"$ % copying functions
+PathIn "cons-mkvect.red"$ % SL constructor functions
+PathIn "comp-support.red"$ % optimized CONS and LIST compilation
+PathIn "system-gc.red"$ % system-specific GC routines
+PathIn "gc.red"$ % the garbage collector
ADDED psl-1983/3-1/kernel/allocators.red
Index: psl-1983/3-1/kernel/allocators.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/allocators.red
@@ -0,0 +1,187 @@
+%
+% ALLOCATORS.RED - Low level storage management
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>ALLOCATORS.RED.7, 23-Mar-83 11:35:37, Edit by KESSLER
+% Added OldHeapTrapBound to exported WVars, so we can update the heap trap
+% bound upon switch.
+% Edit by Cris Perdue, 16 Feb 1983 1834-PST
+% Pre-GC trap, known-free-space fns
+% <PSL.KERNEL>ALLOCATORS.RED.4, 10-Jan-83 15:50:50, Edit by PERDUE
+% Added GtEVect
+
+on SysLisp;
+
+external WArray BPS, Heap;
+
+if_system(PDP10, << % For the compacting GC
+exported WVar HeapLast = &Heap[0], % pointer to next free slot in heap
+ HeapLowerBound = &Heap[0], % bottom of heap
+ HeapUpperBound = &Heap[HeapSize],
+ HeapTrapBound = &Heap[HeapSize]; % Value of HeapLast for trap
+>>, <<
+exported WVar HeapLast = &Heap[0], % pointer to next free slot in heap
+ HeapLowerBound = &Heap[0], % bottom of heap
+ HeapUpperBound = &Heap[HeapSize/2], % end of active heap
+ OldHeapLast,
+ OldHeapLowerBound = &Heap[HeapSize/2 + 1],
+ OldHeapUpperBound = &Heap[HeapSize],
+ HeapTrapBound = &Heap[HeapSize/2], % Value of HeapLast for trap
+ OldHeapTrapBound = &Heap[HeapSize];
+>>);
+exported WVar HeapTrapped = NIL; % Boolean: trap since last GC?
+
+
+compiletime flag('(GtHeap1), 'InternalFunction);
+
+syslsp procedure Known!-Free!-Space;
+MkInt((HeapUpperBound - HeapLast)/AddressingUnitsPerItem);
+
+syslsp procedure GtHEAP N; %. get heap block of N words
+if null N then known!-free!-space() else
+ GtHeap1(N, NIL);
+
+syslsp procedure GtHeap1(N, LastTryP);
+begin scalar PrevLast;
+ PrevLast := HeapLast;
+ HeapLast := HeapLast + N*AddressingUnitsPerItem;
+ if HeapLast > HeapTrapBound then
+ if HeapLast > HeapUpperBound then
+ << HeapLast := PrevLast;
+ if LastTryP then FatalError "Heap space exhausted"
+ else
+ << !%Reclaim();
+ return GtHeap1(N, T) >> >>
+ else
+ %% From one GC to the next there can be at most 1 GC trap,
+ %% done the first time space gets "low". %Reclaim resets
+ %% HeapTrapped to NIL.
+ if HeapTrapped = NIL then
+ << HeapTrapped := T;
+ GC!-Trap() >>;
+ return PrevLast
+end;
+
+syslsp procedure GC!-Trap!-Level;
+MkInt (HeapUpperBound - HeapTrapBound)/AddressingUnitsPerItem;
+
+syslsp procedure Set!-GC!-Trap!-Level N;
+<< if not IntP(N) then NonIntegerError(N, 'Set!-GC!-Trap!-Level);
+ N := IntInf N;
+ HeapTrapBound := HeapUpperBound - N*AddressingUnitsPerItem;
+ T >>;
+
+syslsp procedure DelHeap(LowPointer, HighPointer);
+ if HighPointer eq HeapLast then HeapLast := LowPointer;
+
+syslsp procedure GtSTR N; %. Allocate space for a string N chars
+begin scalar S, NW;
+ S := GtHEAP((NW := STRPack N) + 1);
+ @S := MkItem(HBytes, N);
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtConstSTR N; %. allocate un-collected string for print name
+begin scalar S, NW; % same as GtSTR, but uses BPS, not heap
+ S := GtBPS((NW := STRPack N) + 1);
+ @S := N;
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtHalfWords N; %. Allocate space for N halfwords
+begin scalar S, NW;
+ S := GtHEAP((NW := HalfWordPack N) + 1);
+ @S := MkItem(HHalfWords, N);
+ return S;
+end;
+
+syslsp procedure GtVECT N; %. Allocate space for a vector N items
+begin scalar V;
+ V := GtHEAP(VECTPack N + 1);
+ @V := MkItem(HVECT, N);
+ return V;
+end;
+
+Putd('GtEvect,'expr,cdr getd 'GtVect);
+
+syslsp procedure GtWRDS N; %. Allocate space for N untraced words
+begin scalar W;
+ W := GtHEAP(WRDPack N + 1);
+ @W := MkItem(HWRDS, N);
+ return W;
+end;
+
+
+syslsp procedure GtFIXN(); %. allocate space for a fixnum
+begin scalar W;
+ W := GtHEAP(WRDPack 0 + 1);
+ @W := MkItem(HWRDS, 0);
+ return W;
+end;
+
+syslsp procedure GtFLTN(); %. allocate space for a float
+begin scalar W;
+ W := GtHEAP(WRDPack 1 + 1);
+ @W := MkItem(HWRDS, 1);
+ return W;
+end;
+
+% NextSymbol and SymbolTableSize are globally declared
+
+syslsp procedure GtID(); %. Allocate a new ID
+%
+% IDs are allocated as a linked free list through the SymNam cell,
+% with a 0 to indicate the end of the list.
+%
+begin scalar U;
+ if NextSymbol = 0 then
+ << Reclaim();
+ if NextSymbol = 0 then
+ return FatalError "Ran out of ID space" >>;
+ U := NextSymbol;
+ NextSymbol := SymNam U;
+ return U;
+end;
+
+exported WVar NextBPS = &BPS[0],
+ LastBPS = &BPS[BPSSize];
+
+syslsp procedure GtBPS N; %. Allocate N words for binary code
+begin scalar B;
+ if null N then return((LastBPS - NextBPS)/AddressingUnitsPerItem);
+ % GTBPS NIL returns # left
+ B := NextBPS;
+ NextBPS := NextBPS + N*AddressingUnitsPerItem;
+ return if NextBPS > LastBPS then
+ StdError '"Ran out of binary program space"
+ else B;
+end;
+
+syslsp procedure DelBPS(Bottom, Top); %. Return space to BPS
+ if NextBPS eq Top then NextBPS := Bottom;
+
+syslsp procedure GtWArray N; %. Allocate N words for WVar/WArray/WString
+begin scalar B;
+ if null N then return((LastBPS - NextBPS)/AddressingUnitsPerItem);
+ % GtWArray NIL returns # left
+ B := LastBPS - N*AddressingUnitsPerItem;
+ return if NextBPS > B then
+ StdError '"Ran out of WArray space"
+ else
+ LastBPS := B;
+end;
+
+syslsp procedure DelWArray(Bottom, Top); %. Return space for WArray
+ if LastBPS eq Bottom then LastBPS := Top;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/arith.build
Index: psl-1983/3-1/kernel/arith.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/arith.build
@@ -0,0 +1,12 @@
+%
+% ARITH.BUILD - Files dealing with arithmetic
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "arithmetic.red"$ % Lisp arithmetic functions
ADDED psl-1983/3-1/kernel/arithmetic.red
Index: psl-1983/3-1/kernel/arithmetic.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/arithmetic.red
@@ -0,0 +1,504 @@
+%
+% ARITHMETIC.RED - Arithmetic routines for PSL with new integer tags
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+CompileTime flag('(TwoArgDispatch TwoArgDispatch1 TwoArgError
+ OneArgDispatch OneArgDispatch1
+ OneArgPredicateDispatch OneArgPredicateDispatch1
+ OneArgError IntAdd1 IntSub1 IntPlus2 IntTimes2
+ IntDifference
+ IntQuotient IntRemainder IntLShift IntLAnd IntLOr
+ IntLXOr IntGreaterP IntLessP IntMinus IntMinusP
+ IntZeroP IntOneP IntLNot FloatIntArg
+ FloatAdd1 FloatSub1 FloatPlus2 FloatTimes2
+ FloatQuotient FloatRemainder FloatDifference
+ FloatGreaterP FloatLessP FloatMinus FloatMinusP
+ FloatZeroP FloatOneP StaticIntFloat FloatFix
+ NonInteger1Error NonInteger2Error
+ MakeFixnum BigFloatFix),
+ 'InternalFunction);
+
+on SysLisp;
+
+CompileTime <<
+syslsp macro procedure IsInum U;
+ list('(lambda (X) (eq (SignedField X
+ (ISub1 (WConst InfStartingBit))
+ (IAdd1 (WConst InfBitLength)))
+ X)),
+ second U);
+
+>>;
+
+internal WConst IntFunctionEntry = 0,
+ FloatFunctionEntry = 1,
+ FunctionNameEntry = 2;
+
+syslsp procedure TwoArgDispatch(FirstArg, SecondArg);
+ TwoArgDispatch1(FirstArg, SecondArg, Tag FirstArg, Tag SecondArg);
+
+lap '((!*entry TwoArgDispatch1 expr 4)
+ (!*JUMPNOTEQ (Label NotNeg1) (reg 3) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 3))
+NotNeg1
+ (!*JUMPNOTEQ (Label NotNeg2) (reg 4) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 4))
+NotNeg2
+ (!*JUMPWGREATERP (Label NonNumeric) (reg 3) (WConst FltN))
+ (!*JUMPWGREATERP (Label NonNumeric) (reg 4) (WConst FltN))
+ (!*WSHIFT (reg 3) (WConst 2))
+ (!*WPLUS2 (reg 4) (reg 3))
+ (!*POP (reg 3))
+ (!*JUMPON (reg 4) 0 15 ((Label IntInt)
+ (Label IntFix)
+ (Label TemporaryNonEntry)
+ (Label IntFloat)
+ (Label FixInt)
+ (Label FixFix)
+ (Label TemporaryNonEntry)
+ (Label FixFloat)
+ (Label TemporaryNonEntry)
+ (Label TemporaryNonEntry)
+ (Label TemporaryNonEntry)
+ (Label TemporaryNonEntry)
+ (Label FloatInt)
+ (Label FloatFix)
+ (Label TemporaryNonEntry)
+ (Label FloatFloat)))
+TemporaryNonEntry
+ (!*JCALL TwoArgError)
+FixInt
+ (!*FIELD (reg 1) (reg 1) % grab the value for the fixnum
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+ (!*JUMP (MEMORY (MEMORY (reg 3) (WConst 0)) (WConst 0)))
+FixFix
+ (!*FIELD (reg 1) (reg 1) % grab the value for the fixnum
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+IntFix
+ (!*FIELD (reg 2) (reg 2)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 2) (WConst AddressingUnitsPerItem)) (reg 2))
+IntInt
+ (!*JUMP (MEMORY (MEMORY (reg 3) (WConst 0)) (WConst 0)))
+FixFloat
+ (!*FIELD (reg 1) (reg 1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+IntFloat
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 2))
+ (!*CALL StaticIntFloat)
+ (!*POP (reg 2))
+ (!*POP (reg 3))
+ (!*JUMP (MEMORY (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (WConst 0)))
+FloatFix
+ (!*FIELD (reg 2) (reg 2)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 2) (WConst AddressingUnitsPerItem)) (reg 2))
+FloatInt
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL StaticIntFloat)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (!*POP (reg 3))
+ (!*JUMP (MEMORY (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (WConst 0)))
+FloatFloat
+ (!*JUMP (MEMORY (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (WConst 0)))
+NonNumeric
+ (!*POP (reg 3))
+ (!*JCALL TwoArgError)
+);
+
+syslsp procedure TwoArgError(FirstArg, SecondArg, DispatchTable);
+ ContinuableError('99,
+ '"Non-numeric argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ FirstArg,
+ SecondArg));
+
+syslsp procedure NonInteger2Error(FirstArg, SecondArg, DispatchTable);
+ ContinuableError('99,
+ '"Non-integer argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ FirstArg,
+ SecondArg));
+
+syslsp procedure NonInteger1Error(Arg, DispatchTable);
+ ContinuableError('99,
+ '"Non-integer argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ Arg));
+
+syslsp procedure OneArgDispatch FirstArg;
+ OneArgDispatch1(FirstArg, Tag FirstArg);
+
+lap '((!*entry OneArgDispatch1 expr 2)
+ (!*JUMPNOTEQ (Label NotNeg1) (reg 2) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 2))
+NotNeg1
+ (!*POP (reg 3))
+ (!*JUMPON (reg 2) 0 3 ((Label OneInt)
+ (Label OneFix)
+ (Label TemporaryNonEntry)
+ (Label OneFloat)))
+TemporaryNonEntry
+ (!*JCALL OneArgError)
+OneFix
+ (!*FIELD (reg 1) (reg 1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+OneInt
+ (!*JUMP (MEMORY (MEMORY (reg 3) (WConst 0)) (WConst 0)))
+OneFloat
+ (!*JUMP (MEMORY (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (WConst 0)))
+);
+
+syslsp procedure OneArgError(FirstArg, Dummy, DispatchTable);
+ ContinuableError('99,
+ '"Non-numeric argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ FirstArg));
+
+syslsp procedure OneArgPredicateDispatch FirstArg;
+ OneArgPredicateDispatch1(FirstArg, Tag FirstArg);
+
+lap '((!*entry OneArgPredicateDispatch1 expr 2)
+ (!*JUMPNOTEQ (Label NotNeg1) (reg 2) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 2))
+NotNeg1
+ (!*POP (reg 3))
+ (!*JUMPON (reg 2) 0 3 ((Label OneInt)
+ (Label OneFix)
+ (Label TemporaryNonEntry)
+ (Label OneFloat)))
+TemporaryNonEntry
+ (!*MOVE (QUOTE NIL) (reg 1))
+ (!*EXIT 0)
+OneFix
+ (!*FIELD (reg 1) (reg 1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+OneInt
+ (!*JUMP (MEMORY (MEMORY (reg 3) (WConst 0)) (WConst 0)))
+OneFloat
+ (!*JUMP (MEMORY (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (WConst 0)))
+);
+
+syslsp procedure MakeFixnum N;
+begin scalar F;
+ F := GtFIXN();
+ FixVal F := N;
+ return MkFIXN F;
+end;
+
+syslsp procedure BigFloatFix N;
+ StdError '"Bignums not yet supported";
+
+syslsp procedure ReturnNIL();
+ NIL;
+
+syslsp procedure ReturnFirstArg Arg;
+ Arg;
+
+internal WArray StaticFloatBuffer = [1, 0, 0];
+
+internal WVar StaticFloatItem = MkItem(FLTN, StaticFloatBuffer);
+
+syslsp procedure StaticIntFloat Arg;
+<< !*WFloat(&StaticFloatBuffer[1], Arg);
+ StaticFloatItem >>;
+
+off SysLisp;
+
+CompileTime <<
+macro procedure DefArith2Entry U;
+ DefArithEntry(2 . 'TwoArgDispatch . StupidParserFix cdr U);
+
+macro procedure DefArith1Entry U;
+ DefArithEntry(1 . 'OneArgDispatch . StupidParserFix cdr U);
+
+macro procedure DefArith1PredicateEntry U;
+ DefArithEntry(1 . 'OneArgPredicateDispatch . StupidParserFix cdr U);
+
+lisp procedure StupidParserFix X;
+% Goddamn Rlisp parser won't let me just give "Difference" as the parameter
+% to a macro
+ if null X then X
+ else RemQuote car X . StupidParserFix cdr X;
+
+lisp procedure RemQuote X;
+ if EqCar(X, 'QUOTE) then cadr X else X;
+
+lisp procedure DefArithEntry L;
+ SublA(Pair('(NumberOfArguments
+ DispatchRoutine
+ NameOfFunction
+ IntFunction
+ BigFunction
+ FloatFunction),
+ L),
+ quote(lap '((!*entry NameOfFunction expr NumberOfArguments)
+ (!*Call DispatchRoutine)
+ (fullword (InternalEntry IntFunction))
+% (fullword (InternalEntry BigFunction))
+ (fullword (InternalEntry FloatFunction))
+ (fullword (MkItem (WConst ID)
+ (IDLoc NameOfFunction))))));
+>>;
+
+DefArith2Entry(Plus2, IntPlus2, BigPlus2, FloatPlus2);
+
+syslsp procedure IntPlus2(FirstArg, SecondArg);
+ if IsInum(FirstArg := WPlus2(FirstArg, SecondArg)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+syslsp procedure FloatPlus2(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FPlus2(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry('Difference, IntDifference, BigDifference, FloatDifference);
+
+syslsp procedure IntDifference(FirstArg, SecondArg);
+ if IsInum(FirstArg := WDifference(FirstArg, SecondArg)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+syslsp procedure FloatDifference(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FDifference(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry(Times2, IntTimes2, BigTimes2, FloatTimes2);
+
+% What about overflow?
+
+syslsp procedure IntTimes2(FirstArg, SecondArg);
+begin scalar Result;
+ Result := WTimes2(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+syslsp procedure FloatTimes2(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FTimes2(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry('Quotient, IntQuotient, BigQuotient, FloatQuotient);
+
+syslsp procedure IntQuotient(FirstArg, SecondArg);
+begin scalar Result;
+ if SecondArg eq 0 then return
+ ContError(99,
+ "Attempt to divide by zero in Quotient",
+ Quotient(FirstArg, SecondArg));
+ Result := WQuotient(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+syslsp procedure FloatQuotient(FirstArg, SecondArg);
+begin scalar F;
+ if FloatZeroP SecondArg then return
+ ContError(99,
+ "Attempt to divide by zero in Quotient",
+ Quotient(FirstArg, SecondArg));
+ F := GtFLTN();
+ !*FQuotient(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry(Remainder, IntRemainder, BigRemainder, FloatRemainder);
+
+syslsp procedure IntRemainder(FirstArg, SecondArg);
+begin scalar Result;
+ if SecondArg eq 0 then return
+ ContError(99,
+ "Attempt to divide by zero in Remainder",
+ Remainder(FirstArg, SecondArg));
+ Result := WRemainder(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+syslsp procedure FloatRemainder(FirstArg, SecondArg);
+begin scalar F; % This is pretty silly
+ F := GtFLTN(); % might be better to signal an error
+ !*FQuotient(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+ !*FTimes2(FloatBase F, FloatBase F, FloatBase FltInf SecondArg);
+ !*FDifference(FloatBase F, FloatBase FltInf FirstArg, FloatBase F);
+ return MkFLTN F;
+end;
+
+DefArith2Entry(LAnd, IntLAnd, BigLAnd, NonInteger2Error);
+
+syslsp procedure IntLAnd(FirstArg, SecondArg);
+ if IsInum(FirstArg := WAnd(FirstArg, SecondArg)) then
+ FirstArg
+ else MakeFixnum FirstArg;
+
+DefArith2Entry(LOr, IntLOr, BigLOr, NonInteger2Error);
+
+syslsp procedure IntLOr(FirstArg, SecondArg);
+ if IsInum(FirstArg := WOr(FirstArg, SecondArg)) then
+ FirstArg
+ else MakeFixnum FirstArg;
+
+DefArith2Entry(LXOr, IntLXOr, BigLXOr, NonInteger2Error);
+
+syslsp procedure IntLXOr(FirstArg, SecondArg);
+ if IsInum(FirstArg := WXOr(FirstArg, SecondArg)) then
+ FirstArg
+ else MakeFixnum FirstArg;
+
+DefArith2Entry(LShift, IntLShift, BigLShift, NonInteger2Error);
+
+PutD('LSH, 'EXPR, cdr GetD 'LShift);
+
+syslsp procedure IntLShift(FirstArg, SecondArg);
+begin scalar Result;
+ Result := WShift(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+DefArith2Entry('GreaterP, IntGreaterP, BigGreaterP, FloatGreaterP);
+
+syslsp procedure IntGreaterP(FirstArg, SecondArg);
+ WGreaterP(FirstArg, SecondArg);
+
+syslsp procedure FloatGreaterP(FirstArg, SecondArg);
+ !*FGreaterP(FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg) and T;
+
+DefArith2Entry('LessP, IntLessP, BigLessP, FloatLessP);
+
+syslsp procedure IntLessP(FirstArg, SecondArg);
+ WLessP(FirstArg, SecondArg);
+
+syslsp procedure FloatLessP(FirstArg, SecondArg);
+ !*FLessP(FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg) and T;
+
+DefArith1Entry(Add1, IntAdd1, BigAdd1, FloatAdd1);
+
+syslsp procedure IntAdd1 FirstArg;
+ if IsInum(FirstArg := WPlus2(FirstArg, 1)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+lisp procedure FloatAdd1 FirstArg;
+ FloatPlus2(FirstArg, 1.0);
+
+DefArith1Entry(Sub1, IntSub1, BigSub1, FloatSub1);
+
+lisp procedure IntSub1 FirstArg;
+ if IsInum(FirstArg := WDifference(FirstArg, 1)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+lisp procedure FloatSub1 FirstArg;
+ FloatDifference(FirstArg, 1.0);
+
+DefArith1Entry(LNot, IntLNot, BigLNot, NonInteger1Error);
+
+lisp procedure IntLNot X;
+ if IsInum(X := WNot X) then X else MakeFixnum X;
+
+DefArith1Entry('Minus, IntMinus, BigMinus, FloatMinus);
+
+lisp procedure IntMinus FirstArg;
+ if IsInum(FirstArg := WMinus FirstArg) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+lisp procedure FloatMinus FirstArg;
+ FloatDifference(0.0, FirstArg);
+
+DefArith1Entry(Fix, ReturnFirstArg, ReturnFirstArg, FloatFix);
+
+syslsp procedure FloatFix Arg;
+begin scalar R;
+ return if IsInum(R :=!*WFix FloatBase FltInf Arg) then R
+ else MakeFixnum R;
+end;
+
+DefArith1Entry(Float, FloatIntArg, FloatBigArg, ReturnFirstArg);
+
+syslsp procedure FloatIntArg Arg;
+begin scalar F;
+ F := GtFLTN();
+ !*WFloat(FloatBase F, Arg);
+ return MkFLTN F;
+end;
+
+
+DefArith1PredicateEntry(MinusP, IntMinusP, BigMinusP, FloatMinusP);
+
+syslsp procedure IntMinusP FirstArg;
+ WLessP(FirstArg, 0);
+
+lisp procedure FloatMinusP FirstArg;
+ FloatLessP(FirstArg, 0.0);
+
+DefArith1PredicateEntry(ZeroP, IntZeroP, ReturnNIL, FloatZeroP);
+
+lisp procedure IntZeroP FirstArg;
+ FirstArg = 0;
+
+lisp procedure FloatZeroP FirstArg;
+ EQN(FirstArg, 0.0);
+
+DefArith1PredicateEntry(OneP, IntOneP, ReturnNIL, FloatOneP);
+
+lisp procedure IntOneP FirstArg;
+ FirstArg = 1;
+
+lisp procedure FloatOneP FirstArg;
+ EQN(FirstArg, 1.0);
+
+END;
ADDED psl-1983/3-1/kernel/autoload-trace.red
Index: psl-1983/3-1/kernel/autoload-trace.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/autoload-trace.red
@@ -0,0 +1,23 @@
+%
+% AUTOLOAD-TRACE.RED - Autoloading stubs for DEBUG
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 24 September 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% This file is used instead of MINI-TRACE.RED for those systems which
+% can load files
+
+lisp macro procedure TR U;
+<< load Debug;
+ Apply('TR, list U) >>;
+
+lisp macro procedure TRST U;
+<< load Debug;
+ Apply('TRST, list U) >>;
+
+END;
ADDED psl-1983/3-1/kernel/autoload.red
Index: psl-1983/3-1/kernel/autoload.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/autoload.red
@@ -0,0 +1,97 @@
+%
+% AUTOLOAD.RED - Autoloading entry stubs
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 25 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 07-Mar-83 Nancy Kendzierski
+% Changed PrettyPrint to use PP, not PrettyPrint.
+% Added PP as an autoloaded function.
+% <PSL.KERNEL>AUTOLOAD.RED.3, 17-Sep-82 16:35:02, Edit by BENSON
+% Changed PrettyPrint to use PrettyPrint, not Pretty
+
+CompileTime <<
+
+macro procedure DefAutoload U;
+%
+% (DefAutoload name), (DefAutoload name loadname),
+% (DefAutoload name loadname fntype), or
+% (DefAutoload name loadname fntype numargs)
+%
+% Default is 1 Arg EXPR in module of same name
+%
+begin scalar Name, NumArgs, LoadName, FnType;
+ U := rest U;
+ Name := first U;
+ U := rest U;
+ if not null U then
+ << LoadName := first U;
+ U :=rest U >>
+ else LoadName := Name;
+ if EqCar(Name, 'QUOTE) then Name := second Name;
+ if EqCar(LoadName, 'QUOTE) then LoadName := second LoadName;
+ if not null U then
+ << FnType := first U;
+ U := rest U >>
+ else FnType := 'EXPR;
+ if not null U then
+ NumArgs := first U
+ else NumArgs := 1;
+ NumArgs := MakeArgList NumArgs;
+ return list('PutD, MkQuote Name,
+ MkQuote FnType,
+ list('function, list('lambda, NumArgs,
+ list('load, LoadName),
+ list('Apply, MkQuote Name,
+ 'list . NumArgs))));
+end;
+
+lisp procedure MakeArgList N;
+ GetV('[() (X1) (X1 X2) (X1 X2 X3) (X1 X2 X3 X4) (X1 X2 X3 X4 X5)],
+ N);
+
+>>;
+
+DefAutoload(PrettyPrint, PP);
+DefAutoload(PP, PP, FEXPR);
+
+DefAutoload(DefStruct, DefStruct, FEXPR);
+
+DefAutoload(Step);
+
+DefAutoload Mini;
+
+DefAutoload('Help, 'Help, FEXPR);
+
+DefAutoload(Emode, Emode, EXPR, 0);
+
+DefAutoload(Invoke, Mini);
+
+PUT('CREF ,'SIMPFG ,'((T (CREFON)) (NIL (CREFOFF))));
+
+DefAutoload(CrefOn, RCref, EXPR, 0);
+
+put('Syslisp,
+ 'SimpFg,
+ '((T (load Syslisp))));
+
+DefAutoload(CompD, Compiler, EXPR, 3);
+
+DefAutoload(FaslOUT, Compiler);
+
+if_system(Tops20, <<
+
+DefAutoload(Bug, Bug, EXPR, 0);
+
+DefAutoload(MM, Exec, EXPR, 0);
+
+DefAutoload(Exec, Exec, EXPR, 0);
+
+>>);
+
+END;
ADDED psl-1983/3-1/kernel/backtrace.red
Index: psl-1983/3-1/kernel/backtrace.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/backtrace.red
@@ -0,0 +1,73 @@
+% <PSL.KERNEL>BACKTRACE.RED.3, 20-Sep-82 10:21:41, Edit by BENSON
+% Attempt to make output easier to read
+
+CompileTime flag('(Backtrace1 BacktraceRange), 'InternalFunction);
+
+fluid '(IgnoredInBacktrace!* Options!* InterpreterFunctions!*);
+
+IgnoredInBacktrace!* := '(Eval Apply FastApply CodeApply CodeEvalApply
+ Catch ErrorSet EvProgN TopLoop BreakEval
+ BindEval
+ Break Main);
+
+InterpreterFunctions!* := '(Cond Prog And Or ProgN SetQ);
+
+on SysLisp;
+
+external WVar StackLowerBound, HeapUpperBound;
+
+syslsp procedure InterpBacktrace();
+begin scalar Here;
+ Here := &Here;
+ PrintF "Backtrace, including interpreter functions, from top of stack:%n";
+ return BacktraceRange(Here, StackLowerBound, 1);
+end;
+
+syslsp procedure Backtrace();
+begin scalar Here, X;
+ Here := &Here;
+ PrintF "Backtrace from top of stack:%n";
+ return BacktraceRange(Here, StackLowerBound, 0);
+end;
+
+syslsp procedure BacktraceRange(Starting, Ending, InterpFlag);
+begin scalar X;
+ for I := Starting step -(AddressingUnitsPerItem*StackDirection)
+ until Ending do
+ if Tag @I eq BtrTag then
+ Backtrace1(MkID Inf @I, InterpFlag)
+ else if (X := ReturnAddressP @I) then
+ Backtrace1(X, InterpFlag);
+ return TerPri();
+end;
+
+syslsp procedure VerboseBacktrace();
+begin scalar Here, X;
+ if not 'addr2id member options!* then load addr2id;
+ Here := &Here; % start a little before here
+ for I := Here step -(AddressingUnitsPerItem*StackDirection)
+ until StackLowerBound do
+ if CodeP @I and Inf @I > HeapUpperBound then
+ << WriteChar char TAB;
+ ChannelWriteUnknownItem(LispVar OUT!*, @I);
+ TerPri() >>
+ else if Tag @I eq BtrTag then
+ PrintF(" %r%n", MkID Inf @I)
+ else if (X := ReturnAddressP @I) then
+ PrintF("%p -> %p:%n", code!-address!-to!-symbol Inf @I, X)
+ else PrintF(" %p%n", @I);
+ return TerPri();
+end;
+
+off SysLisp;
+
+lisp procedure Backtrace1(Item, Code);
+%
+% Code is 1 if Interpreter functions should be printed, 0 if not.
+%
+ if not (Item memq IgnoredInBacktrace!*) then
+ if not (Code = 0 and Item memq InterpreterFunctions!*) then
+ << Prin1 Item;
+ WriteChar char BLANK >>;
+
+END;
ADDED psl-1983/3-1/kernel/binding.red
Index: psl-1983/3-1/kernel/binding.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/binding.red
@@ -0,0 +1,82 @@
+%
+% BINDING.RED - Primitives to support Lambda binding
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>BINDING.RED.2, 21-Dec-82 15:57:06, Edit by BENSON
+% Added call to %clear-catch-stack in ClearBindings
+
+% Support for binding in compiled code is in FAST-BINDER.RED
+
+on SysLisp;
+
+internal WConst BndStkSize = 2000;
+
+internal WArray BndStk[BndStkSize];
+
+% Only these WVars, which contain addresses rather than indexes, will be
+% used to access the binding stack
+
+exported WVar BndStkLowerBound = &BndStk[0],
+ BndStkUpperBound = &BndStk[BndStkSize-1],
+ BndStkPtr = &BndStk[0];
+
+% Only the macros BndStkID, BndStkVal and AdjustBndStkPtr will be used
+% to access or modify the binding stack and pointer.
+
+syslsp procedure BStackOverflow();
+<< ChannelPrin2(LispVar ErrOUT!*,
+ "***** Binding stack overflow, restarting...");
+ ChannelWriteChar(LispVar ErrOUT!*,
+ char EOL);
+ Reset() >>;
+
+syslsp procedure BStackUnderflow();
+<< ChannelPrin2(LispVar ErrOUT!*,
+ "***** Binding stack underflow, restarting...");
+ ChannelWriteChar(LispVar ErrOUT!*,
+ char EOL);
+ Reset() >>;
+
+syslsp procedure CaptureEnvironment(); %. Save bindings to be restored
+ BndStkPtr;
+
+syslsp procedure RestoreEnvironment Ptr; %. Restore old bindings
+<< if Ptr < BndStkLowerBound then BStackUnderflow()
+ else while BndStkPtr > Ptr do
+ << SymVal BndStkID BndStkPtr := BndStkVal BndStkPtr;
+ BndStkPtr := AdjustBndStkPtr(BndStkPtr, -1) >> >>;
+
+syslsp procedure ClearBindings(); %. Restore bindings to top level
+<< RestoreEnvironment BndStkLowerBound;
+ !%clear!-catch!-stack() >>;
+
+syslsp procedure UnBindN N; %. Support for Lambda and Prog interp
+ RestoreEnvironment AdjustBndStkPtr(BndStkPtr, -IntInf N);
+
+syslsp procedure LBind1(IDName, ValueToBind); %. Support for Lambda
+ if not IDP IDName then
+ NonIDError(IDName, "binding")
+ else if null IDName or IDName eq 'T then
+ StdError '"T and NIL cannot be rebound"
+ else
+ << BndStkPtr := AdjustBndStkPtr(BndStkPtr, 1);
+ if BndStkPtr > BndStkUpperBound then BStackOverflow()
+ else
+ << IDName := IDInf IDName;
+ BndStkID BndStkPtr := IDName;
+ BndStkVal BndStkPtr := SymVal IDName;
+ SymVal IDName := ValueToBind >> >>;
+
+syslsp procedure PBind1 IDName; %. Support for PROG
+ LBind1(IDName, NIL);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/break.red
Index: psl-1983/3-1/kernel/break.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/break.red
@@ -0,0 +1,109 @@
+%
+% BREAK.RED - Break using new top loop
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>BREAK.RED.2, 11-Oct-82 17:52:13, Edit by BENSON
+% Changed CATCH/THROW to new definition
+% <PSL.INTERP>BREAK.RED.6, 28-Jul-82 14:29:59, Edit by BENSON
+% Added A for abort-to-top-level
+% <PSL.INTERP>BREAK.RED.3, 30-Apr-82 14:34:33, Edit by BENSON
+% Added binding of !*DEFN to NIL
+
+fluid '(!*Break !*QuitBreak BreakEval!* BreakName!* BreakValue!*
+ ErrorForm!*
+ BreakLevel!* MaxBreakLevel!*
+ TopLoopName!* TopLoopEval!* TopLoopRead!* TopLoopPrint!*
+ !*DEFN % break binds !*DEFN to NIL
+ BreakIn!* BreakOut!*);
+
+LoadTime <<
+BreakLevel!* := 0;
+MaxBreakLevel!* := 5;
+>>;
+
+lisp procedure Break(); %. Enter top loop within evaluation
+(lambda(BreakLevel!*);
+begin scalar OldIn, OldOut, !*QuitBreak,BreakValue!*, !*Defn;
+ OldIn := RDS BreakIn!*;
+ OldOut := WRS BreakOut!*;
+ !*QuitBreak := T;
+ if TopLoopName!* then
+ << if TopLoopEval!* neq 'BreakEval then
+ << BreakEval!* := TopLoopEval!*;
+ BreakName!* := ConCat(TopLoopName!*, " break") >>;
+ Catch('!$Break!$, TopLoop(TopLoopRead!*,
+ TopLoopPrint!*,
+ 'BreakEval,
+ BreakName!*,
+ "Break loop")) >>
+ else
+ << BreakEval!* := 'Eval;
+ BreakName!* := "lisp break";
+ Catch('!$Break!$, TopLoop('Read,
+ 'Print,
+ 'BreakEval,
+ BreakName!*,
+ "Break loop")) >>;
+ RDS OldIn;
+ WRS OldOut;
+ return if !*QuitBreak then begin scalar !*Break, !*EmsgP;
+ return StdError "Exit to ErrorSet";
+ end else
+ Eval ErrorForm!*;
+end)(BreakLevel!* + 1);
+
+lisp procedure BreakEval U;
+begin scalar F;
+ return if IDP U and (F := get(U, 'BreakFunction)) then
+ Apply(F, NIL)
+ else BreakValue!*:=Apply(BreakEval!*, list U);
+end;
+
+lisp procedure BreakQuit();
+<< !*QuitBreak := T;
+ Throw('!$Break!$, NIL) >>;
+
+lisp procedure BreakContinue();
+<< ErrorForm!* := MkQuote BreakValue!*;
+ BreakRetry() >>;
+
+lisp procedure BreakRetry();
+ if !*ContinuableError then
+ << !*QuitBreak := NIL;
+ Throw('!$Break!$, NIL) >>
+ else
+ << Prin2T
+"Can only continue from a continuable error; use Q (BreakQuit) to quit";
+ TerPri() >>;
+
+lisp procedure HelpBreak();
+<< EvLoad '(HELP);
+ DisplayHelpFile 'Break >>;
+
+lisp procedure BreakErrMsg();
+ PrintF("ErrorForm!* : %r %n", ErrorForm!*);
+
+lisp procedure BreakEdit();
+ if GetD 'Edit then ErrorForm!* := Edit ErrorForm!*
+ else ErrorPrintF("*** Editor not loaded");
+
+LoadTime DefList('((Q BreakQuit)
+ (!? HelpBreak)
+ (A Reset) % Abort to top level
+ (M BreakErrMsg)
+ (E BreakEdit)
+ (C BreakContinue)
+ (R BreakRetry)
+ (I InterpBackTrace)
+ (V VerboseBackTrace)
+ (T BackTrace)),
+ 'BreakFunction);
+
+END;
ADDED psl-1983/3-1/kernel/carcdr.red
Index: psl-1983/3-1/kernel/carcdr.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/carcdr.red
@@ -0,0 +1,176 @@
+%
+% CARCDR.RED - Composites of CAR and CDR, up to 4 levels
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>CARCDR.RED.3, 4-Jul-82 13:29:21, Edit by BENSON
+% CAR and CDR of NIL are legal == NIL
+
+CompileTime for each X in '( % remove all compiler optimizations
+CAAAAR CAAAR CAAR % for CAR and CDR composites
+CAAADR CAADR CADR
+CAADAR CADAR CDAR
+CAADDR CADDR CDDR
+CADAAR CDAAR
+CADADR CDADR
+CADDAR CDDAR
+CADDDR CDDDR
+CDAAAR
+CDAADR
+CDADAR
+CDADDR
+CDDAAR
+CDDADR
+CDDDAR
+CDDDDR
+) do Put(X, 'SaveCMACRO, RemProp(X, 'CMACRO));
+
+lisp procedure CAAAAR U; %.
+ if null U then NIL
+ else if PairP U then CAAAR CAR U else NonPairError(U, 'CAAAAR);
+
+lisp procedure CAAADR U; %.
+ if null U then NIL
+ else if PairP U then CAAAR CDR U else NonPairError(U, 'CAAADR);
+
+lisp procedure CAADAR U; %.
+ if null U then NIL
+ else if PairP U then CAADR CAR U else NonPairError(U, 'CAADAR);
+
+lisp procedure CAADDR U; %.
+ if null U then NIL
+ else if PairP U then CAADR CDR U else NonPairError(U, 'CAADDR);
+
+lisp procedure CADAAR U; %.
+ if null U then NIL
+ else if PairP U then CADAR CAR U else NonPairError(U, 'CADAAR);
+
+lisp procedure CADADR U; %.
+ if null U then NIL
+ else if PairP U then CADAR CDR U else NonPairError(U, 'CADADR);
+
+lisp procedure CADDAR U; %.
+ if null U then NIL
+ else if PairP U then CADDR CAR U else NonPairError(U, 'CADDAR);
+
+lisp procedure CADDDR U; %.
+ if null U then NIL
+ else if PairP U then CADDR CDR U else NonPairError(U, 'CADDDR);
+
+lisp procedure CDAAAR U; %.
+ if null U then NIL
+ else if PairP U then CDAAR CAR U else NonPairError(U, 'CDAAAR);
+
+lisp procedure CDAADR U; %.
+ if null U then NIL
+ else if PairP U then CDAAR CDR U else NonPairError(U, 'CDAADR);
+
+lisp procedure CDADAR U; %.
+ if null U then NIL
+ else if PairP U then CDADR CAR U else NonPairError(U, 'CDADAR);
+
+lisp procedure CDADDR U; %.
+ if null U then NIL
+ else if PairP U then CDADR CDR U else NonPairError(U, 'CDADDR);
+
+lisp procedure CDDAAR U; %.
+ if null U then NIL
+ else if PairP U then CDDAR CAR U else NonPairError(U, 'CDDAAR);
+
+lisp procedure CDDADR U; %.
+ if null U then NIL
+ else if PairP U then CDDAR CDR U else NonPairError(U, 'CDDADR);
+
+lisp procedure CDDDAR U; %.
+ if null U then NIL
+ else if PairP U then CDDDR CAR U else NonPairError(U, 'CDDDAR);
+
+lisp procedure CDDDDR U; %.
+ if null U then NIL
+ else if PairP U then CDDDR CDR U else NonPairError(U, 'CDDDDR);
+
+
+lisp procedure CAAAR U; %.
+ if null U then NIL
+ else if PairP U then CAAR CAR U else NonPairError(U, 'CAAAR);
+
+lisp procedure CAADR U; %.
+ if null U then NIL
+ else if PairP U then CAAR CDR U else NonPairError(U, 'CAADR);
+
+lisp procedure CADAR U; %.
+ if null U then NIL
+ else if PairP U then CADR CAR U else NonPairError(U, 'CADAR);
+
+lisp procedure CADDR U; %.
+ if null U then NIL
+ else if PairP U then CADR CDR U else NonPairError(U, 'CADDR);
+
+lisp procedure CDAAR U; %.
+ if null U then NIL
+ else if PairP U then CDAR CAR U else NonPairError(U, 'CDAAR);
+
+lisp procedure CDADR U; %.
+ if null U then NIL
+ else if PairP U then CDAR CDR U else NonPairError(U, 'CDADR);
+
+lisp procedure CDDAR U; %.
+ if null U then NIL
+ else if PairP U then CDDR CAR U else NonPairError(U, 'CDDAR);
+
+lisp procedure CDDDR U; %.
+ if null U then NIL
+ else if PairP U then CDDR CDR U else NonPairError(U, 'CDDDR);
+
+
+lisp procedure SafeCAR U;
+ if null U then NIL
+ else if PairP U then CAR U else NonPairError(U, 'CAR);
+
+lisp procedure SafeCDR U;
+ if null U then NIL
+ else if PairP U then CDR U else NonPairError(U, 'CDR);
+
+
+lisp procedure CAAR U; %.
+ if null U then NIL
+ else if PairP U then SafeCAR CAR U else NonPairError(U, 'CAAR);
+
+lisp procedure CADR U; %.
+ if null U then NIL
+ else if PairP U then SafeCAR CDR U else NonPairError(U, 'CADR);
+
+lisp procedure CDAR U; %.
+ if null U then NIL
+ else if PairP U then SafeCDR CAR U else NonPairError(U, 'CDAR);
+
+lisp procedure CDDR U; %.
+ if null U then NIL
+ else if PairP U then SafeCDR CDR U else NonPairError(U, 'CDDR);
+
+CompileTime for each X in '( % restore compiler optimizations
+CAAAAR CAAAR CAAR % for CAR and CDR composites
+CAAADR CAADR CADR
+CAADAR CADAR CDAR
+CAADDR CADDR CDDR
+CADAAR CDAAR
+CADADR CDADR
+CADDAR CDDAR
+CADDDR CDDDR
+CDAAAR
+CDAADR
+CDADAR
+CDADDR
+CDDAAR
+CDDADR
+CDDDAR
+CDDDDR
+) do Put(X, 'CMACRO, RemProp(X, 'SaveCMACRO));
+
+END;
ADDED psl-1983/3-1/kernel/catch-throw.red
Index: psl-1983/3-1/kernel/catch-throw.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/catch-throw.red
@@ -0,0 +1,204 @@
+%
+% CATCH-THROW.RED - Common Lisp dynamic non-local exits
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 12 October 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% 03-Mar-83 Nancy Kendzierski
+% Changed declaration of EMSG!* from fluid to global.
+% Edit by Cris Perdue, 23 Feb 1983 1624-PST
+% Modified the stack overflow warning message
+% Edit by Cris Perdue, 16 Feb 1983 1032-PST
+% Changed catch stack overflow checking to give a continuable error
+% when stack gets low, Reset when all out.
+% Edit by Cris Perdue, 4 Feb 1983 1209-PST
+% Moved ERRSET to ERROR-ERRORSET from here.
+% Edit by Cris Perdue, 3 Feb 1983 1520-PST
+% Changed catch stack overflow to talk about the CATCH stack. (!)
+% Deleted definition of "errset".
+% <PSL.KERNEL>CATCH-THROW.RED.13, 21-Dec-82 15:55:26, Edit by BENSON
+% Added %clear-catch-stack
+% <PSL.KERNEL>CATCH-THROW.RED.13, 16-Dec-82 09:58:59, Edit by BENSON
+% Error not within ErrorSet now causes fatal error, not infinite loop
+
+
+fluid '(ThrowSignal!*
+ ThrowTag!*);
+
+global '(EMSG!*);
+
+macro procedure catch!-all u;
+(lambda(fn, forms);
+ list(list('lambda, '(!&!&Value!&!&),
+ list('cond, list('ThrowSignal!*,
+ list('Apply,
+ fn,
+ '(list ThrowTag!* !&!&Value!&!&))),
+ '(t !&!&Value!&!&))),
+ 'catch . nil . forms))(cadr U, cddr U);
+
+macro procedure unwind!-all u;
+(lambda(fn, forms);
+ list(list('lambda, '(!&!&Value!&!&),
+ list('Apply,
+ fn,
+ '(list (and ThrowSignal!* ThrowTag!*)
+ !&!&Value!&!&))),
+ 'catch . nil . forms))(cadr U, cddr U);
+
+macro procedure unwind!-protect u;
+(lambda(protected_form, cleanup_forms);
+ list(list('lambda, '(!&!&Value!&!&),
+ list('lambda, '(!&!&Thrown!&!& !&!&Tag!&!&),
+ 'progn . cleanup_forms,
+ '(cond (!&!&Thrown!&!&
+ (!%Throw !&!&Tag!&!& !&!&Value!&!&))
+ (t !&!&Value!&!&)))
+ . '(ThrowSignal!* ThrowTag!*)),
+ list('catch, ''!$unwind!-protect!$, protected_form)))(cadr U,cddr U);
+
+off R2I;
+
+% This funny definition is due to a PA1FN for CATCH
+
+fexpr procedure Catch U;
+(lambda(Tag, Forms);
+ Catch(Eval Tag, EvProgN Forms))(car U, cdr U);
+
+on R2I;
+
+% Temporary compatibility package.
+
+macro procedure !*Catch U;
+ 'Catch . cdr U;
+
+expr procedure !*Throw(x,y);
+ throw(x,y);
+
+on Syslisp;
+
+% Size is in terms of number of frames
+internal WConst CatchStackSize = 400;
+
+internal WArray CatchStack[CatchStackSize*4];
+
+internal WVar CatchStackPtr = &CatchStack[0];
+
+CompileTime <<
+
+smacro procedure CatchPop();
+ CatchStackPtr := &CatchStackPtr[-4];
+
+smacro procedure CatchStackDecrement X;
+ &X[-4];
+
+% Rather large for a smacro, used only from CatchSetupAux /csp
+% Tests structured for fast usual execution /csp
+% Random constant 5 for "reserve" catch stack frames /csp
+smacro procedure CatchPush(Tag, PC, SP, Env);
+<< CatchStackPtr := &CatchStackPtr[4];
+ if CatchStackPtr >= &CatchStack[(CatchStackSize-5)*4] then
+ << if CatchStackPtr = &CatchStack[(CatchStackSize-5)*4] then
+ ContinuableError(99,"Catch-throw stack overflow (warning)", NIL);
+ if CatchStackPtr >= &CatchStack[CatchStackSize*4] then
+ << (LispVar EMSG!*) := "Catch stack overflow";
+ reset() >> >>;
+ CatchStackPtr[0] := Tag;
+ CatchStackPtr[1] := PC;
+ CatchStackPtr[2] := SP;
+ CatchStackPtr[3] := Env >>;
+
+smacro procedure CatchTopTag();
+ CatchStackPtr[0];
+
+smacro procedure CatchTagAt X;
+ X[0];
+
+smacro procedure CatchTopPC();
+ CatchStackPtr[1];
+
+smacro procedure CatchTopSP();
+ CatchStackPtr[2];
+
+smacro procedure CatchTopEnv();
+ CatchStackPtr[3];
+
+flag('(CatchSetupAux ThrowAux FindCatchMarkAndThrow), 'InternalFunction);
+
+>>;
+
+% CatchSetup puts the return address in reg 2, the stack pointer in reg 3
+% and calls CatchSetupAux
+
+lap '((!*entry CatchSetup expr 1) %. CatchSetup(Tag)
+ (!*MOVE (MEMORY (reg st) (WConst 0)) (reg 2))
+ (!*MOVE (reg st) (reg 3))
+ (!*JCALL CatchSetupAux)
+);
+
+syslsp procedure CatchSetupAux(Tag, PC, SP);
+begin scalar Previous;
+ Previous := CatchStackPtr;
+ CatchPush(Tag, PC, SP, CaptureEnvironment());
+ LispVar ThrowSignal!* := NIL;
+ return Previous;
+end;
+
+syslsp procedure !%UnCatch Previous;
+<< CatchStackPtr := Previous;
+ LispVar ThrowSignal!* := NIL >>;
+
+syslsp procedure !%clear!-catch!-stack();
+ CatchStackPtr := &CatchStack[0];
+
+syslsp procedure !%Throw(Tag, Value);
+begin scalar TopTag;
+ TopTag := CatchTopTag();
+ return if not (null TopTag
+ or TopTag eq '!$unwind!-protect!$
+ or Tag eq TopTag) then
+ << CatchPop();
+ !%Throw(Tag, Value) >>
+ else begin scalar PC, SP;
+ PC := CatchTopPC();
+ SP := CatchTopSP();
+ RestoreEnvironment CatchTopEnv();
+ CatchPop();
+ LispVar ThrowSignal!* := T;
+ LispVar ThrowTag!* := Tag;
+ return ThrowAux(Value, PC, SP);
+ end;
+end;
+
+lap '((!*entry ThrowAux expr 3)
+ (!*MOVE (reg 3) (reg st))
+ (!*MOVE (reg 2) (MEMORY (reg st) (WConst 0)))
+ (!*EXIT 0)
+);
+
+syslsp procedure Throw(Tag, Value);
+ FindCatchMarkAndThrow(Tag, Value, CatchStackPtr);
+
+% Throw to $Error$ that doesn't have a catch can't cause a normal error
+% else an infinite loop will result. Changed to use FatalError instead.
+
+syslsp procedure FindCatchMarkAndThrow(Tag, Value, P);
+ if P = &CatchStack[0] then
+ if not (Tag eq '!$Error!$) then
+ ContError(99,
+ "Catch tag %r not found in Throw",
+ Tag,
+ Throw(Tag, Value))
+ else FatalError "Error not within ErrorSet"
+ else if null CatchTagAt P or Tag eq CatchTagAt P then
+ !%Throw(Tag, Value)
+ else FindCatchMarkAndThrow(Tag, Value, CatchStackDecrement P);
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/char-io.red
Index: psl-1983/3-1/kernel/char-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/char-io.red
@@ -0,0 +1,87 @@
+%
+% CHAR-IO.RED - Bottom level character IO primitives
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 27 Jan 1983 1652-PST
+% ChannelReadChar and ChannelWriteChar now check the FileDes argument
+% <PERDUE.PSL>CHAR-IO.RED.2, 29-Dec-82 12:21:51, Edit by PERDUE
+% Added code to ChannelWriteChar to maintain PagePosition for LPOSN
+
+global '(IN!* % The current input channel
+ OUT!*); % The current output channel
+
+on SysLisp;
+
+external WArray ReadFunction, % Indexed by channel # to read char
+ WriteFunction, % Indexed by channel # to write char
+ UnReadBuffer, % For input backup
+ LinePosition, % For Posn()
+ PagePosition; % For LPosn()
+
+syslsp procedure ChannelReadChar FileDes; %. Read one char from channel
+%
+% All channel input must pass through this function. When a channel is
+% open, its read function must be set up.
+%
+begin scalar Ch, FD;
+ FD := IntInf FileDes; %/ Heuristic: don't do Int type test
+ if not (0 <= FD and FD <= MaxChannels) then
+ NonIOChannelError(FileDes, "ChannelReadChar");
+ return if (Ch := UnReadBuffer[FD]) neq char NULL then
+ << UnReadBuffer[FD] := char NULL;
+ Ch >>
+ else
+ IDApply1(FD, ReadFunction[FD]);
+end;
+
+syslsp procedure ReadChar(); %. Read single char from current input
+ ChannelReadChar LispVar IN!*;
+
+syslsp procedure ChannelWriteChar(FileDes, Ch); %. Write one char to channel
+%
+% All channel output must pass through this function. When a channel is
+% open, its write function must be set up, and line position set to zero.
+%
+begin scalar FD;
+ FD := IntInf FileDes;
+ if not (0 <= FD and FD <= MaxChannels) then
+ NonIOChannelError(FileDes, "ChannelWriteChar");
+ if Ch eq char EOL then
+ << LinePosition[FD] := 0;
+ PagePosition[FD] := PagePosition[FD] + 1 >>
+ else if Ch eq char TAB then % LPos := (LPos + 8) - ((LPos + 8) MOD 8)
+ LinePosition[FD] := LAND(LinePosition[FD] + 8, LNOT 7)
+ else if Ch eq char FF then
+ << PagePosition[FD] := 0;
+ LinePosition[FD] := 0 >>
+ else
+ LinePosition[FD] := LinePosition[FD] + 1;
+ IDApply2(FD, Ch, WriteFunction[FD]);
+end;
+
+syslsp procedure WriteChar Ch; %. Write single char to current output
+ ChannelWriteChar(LispVar OUT!*, Ch);
+
+syslsp procedure ChannelUnReadChar(Channel, Ch); %. Input backup function
+%
+% Any channel input backup must pass through this function. The following
+% restrictions are made on input backup:
+% 1. Backing up without first doing input should cause an error, but
+% will probably cause unpredictable results.
+% 2. Only one character backup is supported.
+%
+ UnReadBuffer[IntInf Channel] := Ch;
+
+syslsp procedure UnReadChar Ch; %. Backup on current input channel
+ ChannelUnReadChar(LispVar IN!*, Ch);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/char-macro.sl
Index: psl-1983/3-1/kernel/char-macro.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/char-macro.sl
@@ -0,0 +1,65 @@
+%
+% CHAR-MACRO.SL - Character constant macro
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 1 Feb 1983 1355-PST
+% pk:char.red merged with the version in USEFUL. Some symbolic names
+% for characters removed (not needed, I hope).
+
+(dm Char (U) %. Character constant macro
+ (DoChar (cadr U)))
+
+% Table driven char macro expander
+(de DoChar (u)
+ (cond
+ ((idp u) (or
+ (get u 'CharConst)
+ ((lambda (n) (cond ((lessp n 128) n))) (id2int u))
+ (CharError u)))
+ ((pairp u) % Here's the real change -- let users add "functions"
+ ((lambda (fn)
+ (cond
+ (fn (apply fn (list (dochar (cadr u)))))
+ (t (CharError u))))
+ (cond ((idp (car u)) (get (car u) 'char-prefix-function)))))
+ ((and (fixp u) (geq u 0) (leq u 9)) (plus u (char 0)))
+ (t (CharError u))))
+
+(deflist
+ (list
+ (list 'lower (function (lambda(x) (lor x 2#100000))))
+ (list 'quote (function (lambda(x) x)))
+ (list 'control (function (lambda(x) (land x 2#11111))))
+ (list 'cntrl (function (lambda(x) (land x 2#11111))))
+ (list 'meta (function (lambda(x) (lor x 2#10000000)))))
+ 'char-prefix-function)
+
+(de CharError (u)
+ (ErrorPrintF "*** Unknown character constant: %r" u)
+ 0)
+
+(DefList '((NULL 0)
+ (BELL 7)
+ (BACKSPACE 8)
+ (TAB 8#11)
+ (LF 8#12)
+ % (RETURN 8#12) % RETURN is LF: it's end-of-line. Out! /csp
+ (EOL 8#12)
+ (FF 8#14)
+ (CR 8#15)
+ (ESC 27)
+ (ESCAPE 27)
+ (BLANK 32)
+ (SPACE 32)
+ (RUB 8#177)
+ (RUBOUT 8#177)
+ (DEL 8#177)
+ (DELETE 8#177)
+ ) 'CharConst)
ADDED psl-1983/3-1/kernel/comp-support.red
Index: psl-1983/3-1/kernel/comp-support.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/comp-support.red
@@ -0,0 +1,36 @@
+%
+% COMP-SUPPORT.RED - Run-time support for optimized Cons and List compilation
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+CommentOutCode << % defined in CONS-MKVECT.RED
+CompileTime(SavedCompFn := RemProp('Cons, 'CompFn)); % else can't compile
+
+lisp procedure NCons U; %. U . NIL, or 1-argument EXPR for LIST
+ U . NIL;
+
+lisp procedure XCons(U, V); %. V . U
+ V . U;
+
+CompileTime put('Cons, 'CompFn, SavedCompFn);
+>>;
+
+lisp procedure List5(U, V, W, X, Y); %. 5-argument EXPR for LIST
+ U . List4(V, W, X, Y);
+
+lisp procedure List4(U, V, W, X); %. 4-argument EXPR for LIST
+ U . List3(V, W, X);
+
+lisp procedure List3(U, V, W); %. 3-argument EXPR for LIST
+ U . List2(V, W);
+
+lisp procedure List2(U, V); %. 2-argument EXPR for LIST
+ U . NCons V;
+
+END;
ADDED psl-1983/3-1/kernel/compacting-gc.red
Index: psl-1983/3-1/kernel/compacting-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/compacting-gc.red
@@ -0,0 +1,472 @@
+%
+% GC.RED - Compacting garbage collector for PSL
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% WARNING! This file has not been parameterized using
+% AddressingUnitsPerItem. It will not work on machines that
+% address bytes. /csp 3-1-83
+
+% All data types have either explicit header tag in first item,
+% or are assumed to be 1st element of pair.
+
+% Revision History:
+% Edit by Cris Perdue, 16 Feb 1983 1407-PST
+% Fixed GtHeap and collector(s) to use only HeapLast, not HeapPreviousLast
+% Sets HeapTrapped to NIL now.
+% Using known-free-space function
+% Added check of Heap-Warn-Level after %Reclaim
+% Defined and used known-free-space function
+% <PSL.KERNEL>COMPACTING-GC.RED.9, 4-Oct-82 17:59:55, Edit by BENSON
+% Added GCTime!*
+% <PSL.KERNEL>COMPACTING-GC.RED.3, 21-Sep-82 10:43:21, Edit by BENSON
+% Flagged most functions internal
+% (M.L. Griss, March, 1977).
+% (Update to speed up, July 1978)
+% Converted to Syslisp July 1980
+% En-STRUCT-ed, Eric Benson April 1981
+% Added EVECT tag, M. Griss, 3 July 1982
+fluid '(!*GC % Controls printing of statistics
+ GCTime!* % Total amount of time spent in GC
+ GCKnt!* % count of # of GC's since system build
+ heap!-warn!-level); % Continuable error if this much not
+ % free after %Reclaim.
+
+LoadTime <<
+ !*GC := T; % Do print GC messages (SL Rep says no)
+ GCTime!* := 0;
+ GCKnt!* := 0; % Initialize to zero
+ Heap!-Warn!-Level := 1000;
+>>;
+
+on Syslisp;
+
+
+% Predicates for whether to follow pointers
+
+external WVar HeapLowerBound, % Bottom of heap
+ HeapUpperBound, % Top of heap
+ HeapLast, % Last item allocated
+ HeapTrapped; % Boolean: has trap occurred since GC?
+
+CompileTime <<
+
+flag('(MarkFromAllBases BuildRelocationFields UpdateAllBases CompactHeap
+ MarkFromOneSymbol MakeIDFreeList
+ GCMessage MarkFromSymbols MarkFromRange MarkFromBase MarkFromVector
+ GCError UpdateSymbols UpdateRegion UpdateItem UpdateHeap),
+ 'InternalFunction);
+
+syslsp smacro procedure PointerTagP X;
+ X > PosInt and X < Code;
+
+syslsp smacro procedure WithinHeapPointer X;
+ X >= HeapLowerBound and X <= HeapLast;
+
+>>;
+
+% Marking primitives
+
+internal WConst GCMarkValue = 8#777,
+ HSkip = Forward;
+
+CompileTime <<
+syslsp smacro procedure Mark X; % Get GC mark bits in item X points to
+ GCField @X;
+
+syslsp smacro procedure SetMark X; % Set GC mark bits in item X points to
+ GCField @X := GCMarkValue;
+
+syslsp smacro procedure ClearMark X; % Clear GC mark bits in item X points to
+ GCField @X := if NegIntP @X then -1 else 0;
+
+syslsp smacro procedure Marked X; % Is item pointed to by X marked?
+ Mark X eq GCMarkValue;
+
+
+syslsp smacro procedure MarkID X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := Forward;
+
+syslsp smacro procedure MarkedID X;
+ Tag SymNam X eq Forward;
+
+syslsp smacro procedure ClearIDMark X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := STR;
+
+
+% Relocation primitives
+
+syslsp smacro procedure SkipLength X; % Stored in heap header
+ Inf @X;
+
+syslsp smacro procedure PutSkipLength(X, L); % Store in heap header
+ Inf @X := L;
+
+put('SkipLength, 'Assign!-Op, 'PutSkipLength);
+>>;
+
+internal WConst BitsInSegment = 13,
+ SegmentLength = LShift(1, BitsInSegment),
+ SegmentMask = SegmentLength - 1;
+
+internal WConst GCArraySize = LShift(HeapSize, -BitsInSegment) + 1;
+
+internal WArray GCArray[GCArraySize];
+
+
+CompileTime <<
+syslsp smacro procedure SegmentNumber X; % Get segment part of pointer
+ LShift(X - HeapLowerBound, -BitsInSegment);
+
+syslsp smacro procedure OffsetInSegment X; % Get offset part of pointer
+ LAnd(X - HeapLowerBound, SegmentMask);
+
+syslsp smacro procedure MovementWithinSegment X; % Reloc field in item
+ GCField @X;
+
+syslsp smacro procedure PutMovementWithinSegment(X, M); % Store reloc field
+ GCField @X := M;
+
+syslsp smacro procedure ClearMovementWithinSegment X; % Clear reloc field
+ GCField @X := if NegIntP @X then -1 else 0;
+
+put('MovementWithinSegment, 'Assign!-Op, 'PutMovementWithinSegment);
+
+syslsp smacro procedure SegmentMovement X; % Segment table
+ GCArray[X];
+
+syslsp smacro procedure PutSegmentMovement(X, M); % Store in seg table
+ GCArray[X] := M;
+
+put('SegmentMovement, 'Assign!-Op, 'PutSegmentMovement);
+
+syslsp smacro procedure Reloc X; % Compute pointer adjustment
+ X - (SegmentMovement SegmentNumber X + MovementWithinSegment X);
+>>;
+
+external WVar ST, % stack pointer
+ StackLowerBound; % bottom of stack
+
+% Base registers marked from by collector
+
+% SymNam, SymPrp and SymVal are declared for all
+
+external WVar NextSymbol; % next ID number to be allocated
+
+external WVar BndStkLowerBound, % Bottom of binding stack
+ BndStkPtr; % Binding stack pointer
+
+internal WVar StackEnd, % Holds address of bottom of stack
+ StackStart, % Holds address of top of stack
+ MarkTag, % Used by MarkFromBase only
+ Hole, % First location moved in heap
+ HeapShrink, % Total amount reclaimed
+ StartingRealTime;
+
+syslsp procedure Reclaim(); %. User call to garbage collector
+<< !%Reclaim();
+ NIL >>;
+
+syslsp procedure !%Reclaim(); % Garbage collector
+<< StackEnd := MakeAddressFromStackPointer ST - FrameSize();
+ StackStart := StackLowerBound;
+ if LispVar !*GC then ErrorPrintF "*** Garbage collection starting";
+ StartingRealTime := TimC();
+ LispVar GCKnt!* := LispVar GCKnt!* + 1; % must be INUM > 0, so needn't chk
+ MarkFromAllBases();
+ MakeIDFreeList();
+ BuildRelocationFields();
+ UpdateAllBases();
+ CompactHeap();
+ HeapLast := HeapLast - HeapShrink;
+ StartingRealTime := TimC() - StartingRealTime;
+ LispVar GCTime!* := Plus2(LispVar GCTime!*, StartingRealTime);
+ if LispVar !*GC then GCMessage();
+ HeapTrapped := NIL;
+ if IntInf known!-free!-space() < IntInf (LispVar Heap!-Warn!-Level) then
+ ContinuableError(99, "Heap space low", NIL);
+>>;
+
+syslsp procedure MarkFromAllBases();
+begin scalar B;
+ MarkFromSymbols();
+ MarkFromRange(StackStart, StackEnd);
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+ MarkFromBase @B;
+end;
+
+syslsp procedure MarkFromSymbols();
+begin scalar B;
+ MarkFromOneSymbol 128; % mark NIL first
+ for I := 0 step 1 until 127 do
+ if not MarkedID I then MarkFromOneSymbol I;
+ for I := 0 step 1 until MaxObArray do
+ << B := ObArray I;
+ if B > 0 and not MarkedID B then MarkFromOneSymbol B >>;
+end;
+
+syslsp procedure MarkFromOneSymbol X;
+% SymNam has to be marked from before marking ID, since the mark uses its tag
+% No problem since it's only a string, can't reference itself.
+<< MarkFromBase SymNam X;
+ MarkID X;
+ MarkFromBase SymPrp X;
+ MarkFromBase SymVal X >>;
+
+syslsp procedure MarkFromRange(Low, High);
+ for Ptr := Low step 1 until High do MarkFromBase @Ptr;
+
+syslsp procedure MarkFromBase Base;
+begin scalar MarkInfo;
+ MarkTag := Tag Base;
+ if not PointerTagP MarkTag then return
+ << if MarkTag = ID and not null Base then
+ << MarkInfo := IDInf Base;
+ if not MarkedID MarkInfo then MarkFromOneSymbol MarkInfo >> >>;
+ MarkInfo := Inf Base;
+ if not WithinHeapPointer MarkInfo
+ or Marked MarkInfo then return;
+ SetMark MarkInfo;
+CommentOutCode CheckAndSetMark MarkInfo;
+ return if MarkTag eq VECT or MarkTag eq EVECT then
+ MarkFromVector MarkInfo
+ else if MarkTag eq PAIR then
+ << MarkFromBase car Base;
+ MarkFromBase cdr Base >>;
+end;
+
+CommentOutCode <<
+syslsp procedure CheckAndSetMark P;
+begin scalar HeadAtP;
+ HeadAtP := Tag @P;
+ case MarkTag of
+ STR:
+ if HeadAtP eq HBYTES then SetMark P;
+ FIXN, FLTN, BIGN, WRDS:
+ if HeadAtP eq HWRDS then SetMark P;
+ VECT, EVECT:
+ if HeadAtP eq HVECT then SetMark P;
+ PAIR:
+ SetMark P;
+ default:
+ GCError("Internal error in marking phase, at %o", P)
+ end;
+end;
+>>;
+
+syslsp procedure MarkFromVector Info;
+begin scalar Uplim;
+CommentOutCode if Tag @Info neq HVECT then return;
+ Uplim := &VecItm(Info, VecLen Info);
+ for Ptr := &VecItm(Info, 0) step 1 until Uplim do
+ MarkFromBase @Ptr;
+end;
+
+syslsp procedure MakeIDFreeList();
+begin scalar Previous;
+ for I := 0 step 1 until 128 do
+ ClearIDMark I;
+ Previous := 129;
+ while MarkedID Previous and Previous <= MaxSymbols do
+ << ClearIDMark Previous;
+ Previous := Previous + 1 >>;
+ if Previous >= MaxSymbols then
+ NextSymbol := 0
+ else
+ NextSymbol := Previous; % free list starts here
+ for I := Previous + 1 step 1 until MaxSymbols do
+ if MarkedID I then ClearIDMark I
+ else
+ << SymNam Previous := I;
+ Previous := I >>;
+ SymNam Previous := 0; % end of free list
+end;
+
+syslsp procedure BuildRelocationFields();
+%
+% Pass 2 - Turn off GC marks and Build SEGKNTs
+%
+begin scalar CurrentItem, SGCurrent, IGCurrent, TmpIG, DCount, SegLen;
+ SGCurrent := IGCurrent := 0;
+ SegmentMovement SGCurrent := 0; % Dummy
+ Hole := HeapLowerBound - 1; % will be first hole
+ DCount := HeapShrink := 0; % holes in current segment, total holes
+ CurrentItem := HeapLowerBound;
+ while CurrentItem < HeapLast do
+ begin scalar Incr;
+ SegLen := case Tag @CurrentItem of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND,
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ 2; % must be first of pair
+ HBYTES:
+ 1 + StrPack StrLen CurrentItem;
+ HHalfwords:
+ 1 + HalfWordPack StrLen CurrentItem;
+ HWRDS:
+ 1 + WrdPack WrdLen CurrentItem;
+ HVECT:
+ 1 + VectPack VecLen CurrentItem;
+ HSKIP:
+ SkipLength CurrentItem;
+ default:
+ GCError("Illegal item in heap at %o", CurrentItem)
+ end; % case
+ if Marked CurrentItem then % a hole
+ if HeapShrink = 0 then
+ ClearMark CurrentItem
+ else % segment also clears mark
+ << MovementWithinSegment CurrentItem := DCount; % incremental shift
+ Incr := 0 >> % no shift
+ else
+ << @CurrentItem := MkItem(HSKIP, SegLen); % a skip mark
+ Incr := 1; % more shift
+ if Hole < HeapLowerBound then Hole := CurrentItem >>;
+ TmpIG := IGCurrent + SegLen; % set SEG size
+ CurrentItem := CurrentItem + SegLen;
+ while TmpIG >= SegmentLength do
+ begin scalar Tmp;
+ Tmp := SegmentLength - IGCurrent; % Expand to next SEGMENT
+ SegLen := SegLen - Tmp;
+ if Incr eq 1 then HeapShrink := HeapShrink + Tmp;
+ DCount := IGCurrent := 0;
+ SGCurrent := SGCurrent + 1;
+ SegmentMovement SGCurrent := HeapShrink; % Store Next Base
+ TmpIG := TmpIG - SegmentLength;
+ end;
+ IGCurrent := TmpIG;
+ if Incr eq 1 then
+ << HeapShrink := HeapShrink + SegLen;
+ DCount := DCount + SegLen >>; % Add in Hole Size
+ end;
+ SegmentMovement(SGCurrent + 1) := HeapShrink;
+end;
+
+syslsp procedure UpdateAllBases();
+begin scalar B;
+ UpdateSymbols();
+ UpdateRegion(StackStart, StackEnd);
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+ UpdateItem B;
+ UpdateHeap() >>;
+
+syslsp procedure UpdateSymbols();
+ for I := 0 step 1 until MaxSymbols do
+ begin scalar NameLoc;
+ NameLoc := &SymNam I;
+ if StringP @NameLoc then
+ << UpdateItem NameLoc;
+ UpdateItem &SymVal I;
+ UpdateItem &SymPrp I >>;
+ end;
+
+syslsp procedure UpdateRegion(Low, High);
+ for Ptr := Low step 1 until High do UpdateItem Ptr;
+
+syslsp procedure UpdateHeap();
+begin scalar CurrentItem;
+ CurrentItem := HeapLowerBound;
+ while CurrentItem < HeapLast do
+ begin
+ case Tag @CurrentItem of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND:
+ CurrentItem := CurrentItem + 1;
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ << if Inf @CurrentItem >= Hole and Inf @CurrentItem <= HeapLast then
+ Inf @CurrentItem := Reloc Inf @CurrentItem;
+ CurrentItem := CurrentItem + 1 >>;
+ HBYTES:
+ CurrentItem := CurrentItem + 1 + StrPack StrLen CurrentItem;
+ HHalfwords:
+ CurrentItem := CurrentItem + 1 + HalfwordPack StrLen CurrentItem;
+ HWRDS:
+ CurrentItem := CurrentItem + 1 + WrdPack WrdLen CurrentItem;
+ HVECT:
+ begin scalar Tmp;
+ Tmp := VecLen CurrentItem;
+ CurrentItem := CurrentItem + 1; % Move over header
+ for I := 0 step 1 until Tmp do % VecLen + 1 items
+ begin scalar Tmp2, Tmp3;
+ Tmp2 := @CurrentItem;
+ Tmp3 := Tag Tmp2;
+ if PointerTagP Tmp3
+ and Inf Tmp2 >= Hole and Inf Tmp2 <= HeapLast then
+ Inf @CurrentItem := Reloc Inf Tmp2;
+ CurrentItem := CurrentItem + 1;
+ end;
+ end;
+ HSKIP:
+ CurrentItem := CurrentItem + SkipLength CurrentItem;
+ default:
+ GCError("Internal error in updating phase at %o", CurrentItem)
+ end; % case
+ end
+end;
+
+syslsp procedure UpdateItem Ptr;
+begin scalar Tg, Info;
+ Tg := Tag @Ptr;
+ if not PointerTagP Tg then return;
+ Info := INF @Ptr;
+ if Info < Hole or Info > HeapLast then return;
+ Inf @Ptr := Reloc Info;
+end;
+
+syslsp procedure CompactHeap();
+begin scalar OldItemPtr, NewItemPtr, SegLen;
+ if Hole < HeapLowerBound then return;
+ NewItemPtr := OldItemPtr := Hole;
+ while OldItemPtr < HeapLast do
+ begin;
+ case Tag @OldItemPtr of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND,
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ SegLen := PairPack OldItemPtr;
+ HBYTES:
+ SegLen := 1 + StrPack StrLen OldItemPtr;
+ HHalfwords:
+ SegLen := 1 + HalfWordPack HalfwordLen OldItemPtr;
+ HWRDS:
+ SegLen := 1 + WrdPack WrdLen OldItemPtr;
+ HVECT:
+ SegLen := 1 + VectPack VecLen OldItemPtr;
+ HSKIP:
+ << OldItemPtr := OldItemPtr + SkipLength OldItemPtr;
+ goto WhileNext >>;
+ default:
+ GCError("Internal error in compaction at %o", OldItemPtr)
+ end; % case
+ ClearMovementWithinSegment OldItemPtr;
+ for I := 1 step 1 until SegLen do
+ << @NewItemPtr := @OldItemPtr;
+ NewItemPtr := NewItemPtr + 1;
+ OldItemPtr := OldItemPtr + 1 >>;
+ WhileNext:
+ end;
+end;
+
+syslsp procedure GCError(Message, P);
+<< ErrorPrintF("***** Fatal error during garbage collection");
+ ErrorPrintF(Message, P);
+ while T do Quit; >>;
+
+syslsp procedure GCMessage();
+<< ErrorPrintF("*** GC %w: time %d ms",
+ LispVar GCKnt!*, StartingRealTime);
+ ErrorPrintF("*** %d recovered, %d stable, %d active, %d free",
+ HeapShrink, Hole - HeapLowerBound,
+ HeapLast - Hole,
+ intinf known!-free!-space() ) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/cons-mkvect.red
Index: psl-1983/3-1/kernel/cons-mkvect.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/cons-mkvect.red
@@ -0,0 +1,169 @@
+%
+% CONS-MKVECT.RED - Standard Lisp constructor functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>CONS-MKVECT.RED.4, 28-Feb-83 11:41:46, Edit by PERDUE
+% Moved Make-Words, Make-Halfwords, etc. here from SEQUENCE.RED
+% Also moved STRING and VECTOR here from there.
+% Edit by Cris Perdue, 23 Feb 1983 1045-PST
+% Changed occurrences of HeapUpperbound to HeapTrapBound in optimized
+% allocators to supported pre-GC traps.
+% <PSL.KERNEL>CONS-MKVECT.RED.2, 10-Jan-83 15:50:08, Edit by PERDUE
+% Added MkEVect
+% Edit by GRISS: (?)
+% Optimized CONS, XCONS and NCONS
+% <PSL.INTERP>CONS-MKVECT.RED.5, 9-Feb-82 06:25:51, Edit by GRISS
+% Added HardCons
+
+CompileTime flag('(HardCons), 'InternalFunction);
+
+on SysLisp;
+
+external WVar HeapLast, HeapTrapBound;
+
+syslsp procedure HardCons(U, V); % Basic CONS with car U and cdr V
+begin scalar P;
+ HeapLast := HeapLast - AddressingUnitsPerItem*PairPack();
+ P := GtHeap PairPack();
+ P[0] := U;
+ P[1] := V;
+ return MkPAIR P;
+end;
+
+syslsp procedure Cons(U, V); %. Construct pair with car U and cdr V
+begin scalar HP;
+return
+<< HP := HeapLast;
+ if (HeapLast := HeapLast + AddressingUnitsPerItem*PairPack())
+ > HeapTrapBound then
+ HardCons(U, V)
+ else
+ << HP[0] := U;
+ HP[1] := V;
+ MkPAIR HP >> >>;
+end;
+
+syslsp procedure XCons(U, V); %. eXchanged Cons
+begin scalar HP;
+return
+<< HP := HeapLast;
+ if (HeapLast := HeapLast + AddressingUnitsPerItem*PairPack())
+ > HeapTrapBound then
+ HardCons(V, U)
+ else
+ << HP[0] := V;
+ HP[1] := U;
+ MkPAIR HP >> >>;
+end;
+
+syslsp procedure NCons U; %. U . NIL
+begin scalar HP;
+return
+<< HP := HeapLast;
+ if (HeapLast := HeapLast + AddressingUnitsPerItem*PairPack())
+ > HeapTrapBound then
+ HardCons(U, NIL)
+ else
+ << HP[0] := U;
+ HP[1] := NIL;
+ MkPAIR HP >> >>;
+end;
+
+syslsp procedure MkVect N; %. Allocate vector, init all to NIL
+ if IntP N then
+ << N := IntInf N;
+ if N < (-1) then
+ StdError
+ '"A vector with fewer than zero elements cannot be allocated"
+ else begin scalar V;
+ V := GtVect N;
+ for I := 0 step 1 until N do VecItm(V, I) := NIL;
+ return MkVEC V; % Tag it
+ end >>
+ else NonIntegerError(N, 'MkVect);
+
+syslsp procedure MkEVECTOR(N,ETAG); %. Allocate Evect, init all to NIL
+ if IntP N then
+ << N := IntInf N;
+ if N < (-1) then
+ StdError
+ '"An Evect with fewer than zero elements cannot be allocated"
+ else begin scalar V;
+ V := GtEVect N;
+ EVecItm(V,0):=ETAG;
+ for I := 1 step 1 until N do VecItm(V, I) := NIL;
+ return MkEVECT V; % Tag it
+ end >>
+ else NonIntegerError(N, 'MkEVECT);
+
+syslsp procedure MkString(L, C); %. Make str with upb L, all chars C
+begin scalar L1, S;
+ if IntP L then L1 := IntInf L else return NonIntegerError(L, 'MkString);
+ if L1 < -1 then return NonPositiveIntegerError(L, 'MkString);
+ S := GtStr L1;
+ for I := 0 step 1 until L1 do
+ StrByt(S, I) := C;
+ return MkSTR S;
+end;
+
+syslsp procedure Make!-Bytes(L, C); %. Make byte vector with upb L, all items C
+begin scalar L1, S;
+ if IntP L then L1 := IntInf L else return NonIntegerError(L, 'Make!-Bytes);
+ if L1 < -1 then return NonPositiveIntegerError(L, 'Make!-Bytes);
+ S := GtStr L1;
+ for I := 0 step 1 until L1 do
+ StrByt(S, I) := C;
+ return MkBytes S;
+end;
+
+syslsp procedure Make!-HalfWords(L, C); %. Make h vect with upb L, all items C
+begin scalar L1, S;
+ if IntP L then L1 := IntInf L else
+ return NonIntegerError(L, 'Make!-HalfWords);
+ if L1 < -1 then return NonPositiveIntegerError(L, 'Make!-HalfWords);
+ S := GtHalfWords L1;
+ for I := 0 step 1 until L1 do
+ HalfWordItm(S, I) := C;
+ return MkHalfWords S;
+end;
+
+syslsp procedure Make!-Words(L, C); %. Make w vect with upb L, all items C
+begin scalar L1, S;
+ if IntP L then L1 := IntInf L else return NonIntegerError(L, 'Make!-Words);
+ if L1 < -1 then return NonPositiveIntegerError(L, 'Make!-Words);
+ S := GtWrds L1;
+ for I := 0 step 1 until L1 do
+ WrdItm(S, I) := C;
+ return MkWrds S;
+end;
+
+syslsp procedure Make!-Vector(L, C); %. Make vect with upb L, all items C
+begin scalar L1, S;
+ if IntP L then L1 := IntInf L else return
+ NonIntegerError(L, 'Make!-Vector);
+ if L1 < -1 then return NonPositiveIntegerError(L, 'Make!-Vector);
+ S := GtVECT L1;
+ for I := 0 step 1 until L1 do
+ VecItm(S, I) := C;
+ return MkVEC S;
+end;
+
+% Maybe we want to support efficient compilation of these, as with LIST,
+% by functions String2, String3, Vector2, Vector3, etc.
+
+nexpr procedure String U; %. Analogous to LIST, string constructor
+ List2String U;
+
+nexpr procedure Vector U; %. Analogous to LIST, vector constructor
+ List2Vector U;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/cont-error.red
Index: psl-1983/3-1/kernel/cont-error.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/cont-error.red
@@ -0,0 +1,47 @@
+%
+% CONT-ERROR.RED - Nice macro to set up arguments for ContinuableError
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>CONT-ERROR.RED.3, 2-Sep-82 09:10:04, Edit by BENSON
+% Made handling of ReEvalForm more robust
+
+% format is:
+% ContError(ErrorNumber, FormatString, {arguments to PrintF}, ReEvalForm)
+
+% ReEvalForm is something like
+% Foo(X, Y)
+% which becomes
+% list('Foo, MkQuote X, MkQuote Y)
+
+macro procedure ContError U; %. Set up for ContinuableError
+begin scalar ErrorNumber, Message, ReEvalForm;
+ U := cdr U;
+ ErrorNumber := car U;
+ U := cdr U;
+ if null cddr U then % if it's just a string, don't
+ << Message := car U; % generate call to BldMsg
+ U := cdr U >>
+ else
+ << while cdr U do
+ << Message := AConc(Message, car U);
+ U := cdr U >>;
+ Message := 'BldMsg . Message >>;
+ ReEvalForm := car U;
+ ReEvalForm := if not PairP ReEvalForm then list('MkQuote, ReEvalForm)
+ else 'list
+ . MkQuote car ReEvalForm
+ . for each X in cdr ReEvalForm collect list('MkQuote, X);
+ return list('ContinuableError,
+ ErrorNumber,
+ Message,
+ ReEvalForm);
+end;
+
+END;
ADDED psl-1983/3-1/kernel/copiers.red
Index: psl-1983/3-1/kernel/copiers.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/copiers.red
@@ -0,0 +1,106 @@
+% COPIERS.RED - Functions for copying various data types
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>COPIERS.RED.2, 28-Sep-82 10:21:15, Edit by PERDUE
+% Made CopyStringToFrom safe and to not bother clearing the
+% terminating byte.
+
+on SysLisp;
+
+syslsp procedure CopyStringToFrom(New, Old); %. Copy all chars in Old to New
+begin scalar SLen, StripNew, StripOld;
+ StripNew := StrInf New;
+ StripOld := StrInf Old;
+ SLen := StrLen StripOld;
+ if StrLen StripNew < SLen then SLen := StrLen StripNew;
+ for I := 0 step 1 until SLen do
+ StrByt(StripNew, I) := StrByt(StripOld, I);
+ return New;
+end;
+
+syslsp procedure CopyString S; %. copy to new heap string
+begin scalar S1;
+ S1 := GtSTR StrLen StrInf S;
+ CopyStringToFrom(S1, StrInf S);
+ return MkSTR S1;
+end;
+
+syslsp procedure CopyWArray(New, Old, UpLim); %. copy UpLim + 1 words
+<< for I := 0 step 1 until UpLim do
+ New[I] := Old[I];
+ New >>;
+
+syslsp procedure CopyVectorToFrom(New, Old); %. Move elements, don't recurse
+begin scalar SLen, StripNew, StripOld;
+ StripNew := VecInf New;
+ StripOld := VecInf Old;
+ SLen := VecLen StripOld; % assumes VecLen New has been set
+ for I := 0 step 1 until SLen do
+ VecItm(StripNew, I) := VecItm(StripOld, I);
+ return New;
+end;
+
+syslsp procedure CopyVector S; %. Copy to new vector in heap
+begin scalar S1;
+ S1 := GtVECT VecLen VecInf S;
+ CopyVectorToFrom(S1, VecInf S);
+ return MkVEC S1;
+end;
+
+syslsp procedure CopyWRDSToFrom(New, Old); %. Like CopyWArray in heap
+begin scalar SLen, StripNew, StripOld;
+ StripNew := WrdInf New;
+ StripOld := WrdInf Old;
+ SLen := WrdLen StripOld; % assumes WrdLen New has been set
+ for I := 0 step 1 until SLen do
+ WrdItm(StripNew, I) := WrdItm(StripOld, I);
+ return New;
+end;
+
+syslsp procedure CopyWRDS S; %. Allocate new WRDS array in heap
+begin scalar S1;
+ S1 := GtWRDS WrdLen WrdInf S;
+ CopyWRDSToFrom(S1, WrdInf S);
+ return MkWRDS S1;
+end;
+
+% CopyPairToFrom is RplacW, found in EASY-NON-SL.RED
+% CopyPair is: car S . cdr S;
+
+% Usual Lisp definition of Copy only copies pairs, is found in EASY-NON-SL.RED
+
+syslsp procedure TotalCopy S; %. Unique copy of entire structure
+begin scalar Len, Ptr, StripS; % blows up on circular structures
+ return case Tag S of
+ PAIR:
+ TotalCopy car S . TotalCopy cdr S;
+ STR:
+ CopyString S;
+ VECT:
+ << StripS := VecInf S;
+ Len := VecLen StripS;
+ Ptr := MkVEC GtVECT Len;
+ for I := 0 step 1 until Len do
+ VecItm(VecInf Ptr, I) := TotalCopy VecItm(VecInf S, I);
+ Ptr >>;
+ WRDS:
+ CopyWRDS S;
+ FIXN:
+ MkFIXN Inf CopyWRDS S;
+ FLTN:
+ MkFLTN Inf CopyWRDS S;
+ default:
+ S
+ end;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/copying-gc.red
Index: psl-1983/3-1/kernel/copying-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/copying-gc.red
@@ -0,0 +1,220 @@
+%
+% GC.RED - Copying 2-space garbage collector for PSL
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 30 November 1981
+% Copyright (c) 1981 Eric Benson
+%
+
+% <PSL.KERNEL>COPYING-GC.RED.2, 23-Mar-83 11:35:37, Edit by KESSLER
+% Add HeadTrapBound Guys, so we can update the heap trap bound upon switch
+% Edit by Cris Perdue, 15 Mar 1983 0937-PST
+% Added missing comma as noted by Kessler.
+% Edit by Cris Perdue, 16 Feb 1983 1409-PST
+% Removed external declaration of HeapPreviousLast (the only occurrence)
+% Now using "known-free-space" function and heap-warn-level
+% Sets HeapTrapped to NIL now.
+% Added check of Heap!-Warn!-Level after %Reclaim.
+% <PSL.KERNEL>COPYING-GC.RED.6, 4-Oct-82 17:56:49, Edit by BENSON
+% Added GCTime!*
+
+fluid '(!*GC GCKnt!* GCTime!* Heap!-Warn!-Level);
+
+LoadTime
+<< GCKnt!* := 0;
+ GCTime!* := 0;
+ !*GC := T;
+ LispVar Heap!-Warn!-Level := 1000
+>>;
+
+on SysLisp;
+
+CompileTime <<
+syslsp smacro procedure PointerTagP X;
+ X > PosInt and X < Code;
+
+syslsp smacro procedure WithinOldHeapPointer X;
+ X >= !%chipmunk!-kludge OldHeapLowerBound
+ and X <= !%chipmunk!-kludge OldHeapLast;
+
+syslsp smacro procedure Mark X;
+ MkItem(Forward, X);
+
+syslsp smacro procedure Marked X;
+ Tag X eq Forward;
+
+syslsp smacro procedure MarkID X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := Forward;
+
+syslsp smacro procedure MarkedID X;
+ Tag SymNam X eq Forward;
+
+syslsp smacro procedure ClearIDMark X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := STR;
+
+flag('(CopyFromAllBases CopyFromRange CopyFromBase CopyItem CopyItem1
+ MarkAndCopyFromID MakeIDFreeList GCStats),
+ 'InternalFunction);
+>>;
+
+external WVar ST, StackLowerBound,
+ BndStkLowerBound, BndStkPtr,
+ HeapLast, HeapLowerBound, HeapUpperBound,
+ OldHeapLast, OldHeapLowerBound, OldHeapUpperBound,
+ HeapTrapBound, OldHeapTrapBound, HeapTrapped;
+
+internal WVar StackLast, OldTime, OldSize;
+
+syslsp procedure Reclaim();
+ !%Reclaim();
+
+syslsp procedure !%Reclaim();
+begin scalar Tmp1, Tmp2;
+ if LispVar !*GC then ErrorPrintF "*** Garbage collection starting";
+ BeforeGCSystemHook();
+ StackLast := MakeAddressFromStackPointer AdjustStackPointer(ST,
+ -FrameSize());
+ OldTime := TimC();
+ OldSize := HeapLast - HeapLowerBound;
+ LispVar GCKnt!* := LispVar GCKnt!* + 1;
+ OldHeapLast := HeapLast;
+ HeapLast := OldHeapLowerBound;
+ Tmp1 := HeapLowerBound;
+ Tmp2 := HeapUpperBound;
+ HeapLowerBound := OldHeapLowerBound;
+ HeapUpperBound := OldHeapUpperBound;
+ OldHeapLowerBound := Tmp1;
+ OldHeapUpperBound := Tmp2;
+ Tmp1 := HeapTrapBound;
+ HeapTrapBound := OldHeapTrapBound;
+ OldHeapTrapBound := Tmp1;
+ CopyFromAllBases();
+ MakeIDFreeList();
+ AfterGCSystemHook();
+ OldTime := TimC() - OldTime;
+ LispVar GCTime!* := Plus2(LispVar GCTime!*, OldTime);
+ if LispVar !*GC then GCStats();
+ HeapTrapped := NIL;
+ if IntInf Known!-Free!-Space() < IntInf (LispVar Heap!-Warning!-Level) then
+ ContinuableError(99, "Heap space low", NIL)
+>>;
+
+syslsp procedure MarkAndCopyFromID X;
+% SymNam has to be copied before marking, since the mark destroys the tag
+% No problem since it's only a string, can't reference itself.
+<< CopyFromBase &SymNam X;
+ MarkID X;
+ CopyFromBase &SymPrp X;
+ CopyFromBase &SymVal X >>;
+
+syslsp procedure CopyFromAllBases();
+begin scalar LastSymbol, B;
+ MarkAndCopyFromID 128; % Mark NIL first
+ for I := 0 step 1 until 127 do
+ if not MarkedID I then MarkAndCopyFromID I;
+ for I := 0 step 1 until MaxObArray do
+ << B := ObArray I;
+ if B > 0 and not MarkedID B then MarkAndCopyFromID B >>;
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+ CopyFromBase B;
+ for I := StackLowerBound step StackDirection*AddressingUnitsPerItem
+ until StackLast do
+ CopyFromBase I;
+end;
+
+syslsp procedure CopyFromRange(Lo, Hi);
+begin scalar X, I;
+ X := Lo;
+ I := 0;
+ while X <= Hi do
+ << CopyFromBase X;
+ I := I + 1;
+ X := &Lo[I] >>;
+end;
+
+syslsp procedure CopyFromBase P;
+ @P := CopyItem @P;
+
+syslsp procedure CopyItem X;
+begin scalar Typ, Info, Hdr;
+ Typ := Tag X;
+ if not PointerTagP Typ then return
+ << if Typ = ID and not null X then % don't follow NIL, for speed
+ << Info := IDInf X;
+ if not MarkedID Info then MarkAndCopyFromID Info >>;
+ X >>;
+ Info := Inf X;
+ if not WithinOldHeapPointer Info then return X;
+ Hdr := @Info;
+ if Marked Hdr then return MkItem(Typ, Inf Hdr);
+ return CopyItem1 X;
+end;
+
+syslsp procedure CopyItem1 S; % Copier for GC
+begin scalar NewS, Len, Ptr, StripS;
+ return case Tag S of
+ PAIR:
+ << Ptr := car S;
+ Rplaca(S, Mark(NewS := GtHeap PairPack()));
+ NewS[1] := CopyItem cdr S;
+ NewS[0] := CopyItem Ptr;
+ MkPAIR NewS >>;
+ STR:
+ << @StrInf S := Mark(NewS := CopyString S);
+ NewS >>;
+ VECT:
+ << StripS := VecInf S;
+ Len := VecLen StripS;
+ @StripS := Mark(Ptr := GtVECT Len);
+ for I := 0 step 1 until Len do
+ VecItm(Ptr, I) := CopyItem VecItm(StripS, I);
+ MkVEC Ptr >>;
+ EVECT:
+ << StripS := VecInf S;
+ Len := VecLen StripS;
+ @StripS := Mark(Ptr := GtVECT Len);
+ for I := 0 step 1 until Len do
+ VecItm(Ptr, I) := CopyItem VecItm(StripS, I);
+ MkItem(EVECT, Ptr) >>;
+ WRDS, FIXN, FLTN, BIGN:
+ << Ptr := Tag S;
+ @Inf S := Mark(NewS := CopyWRDS S);
+ MkItem(Ptr, NewS) >>;
+ default:
+ FatalError "Unexpected tag found during garbage collection";
+ end;
+end;
+
+syslsp procedure MakeIDFreeList();
+begin scalar Previous;
+ for I := 0 step 1 until 128 do
+ ClearIDMark I;
+ Previous := 129;
+ while MarkedID Previous and Previous <= MaxSymbols do
+ << ClearIDMark Previous;
+ Previous := Previous + 1 >>;
+ if Previous >= MaxSymbols then
+ NextSymbol := 0
+ else
+ NextSymbol := Previous; % free list starts here
+ for I := Previous + 1 step 1 until MaxSymbols do
+ if MarkedID I then ClearIDMark I
+ else
+ << SymNam Previous := I;
+ Previous := I >>;
+ SymNam Previous := 0; % end of free list
+end;
+
+syslsp procedure GCStats();
+<< ErrorPrintF("*** GC %w: time %d ms, %d recovered, %d free",
+ LispVar GCKnt!*, OldTime,
+ (OldSize - (HeapLast - HeapLowerBound))/AddressingUnitsPerItem,
+ Known!-Free!-Space() ) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/debg.build
Index: psl-1983/3-1/kernel/debg.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/debg.build
@@ -0,0 +1,14 @@
+%
+% DEBG.BUILD - Minor debugging tools in the interpreter
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "mini-trace.red"$ % simple function tracing
+PathIn "mini-editor.red"$
+PathIn "backtrace.red"$ % Stack backtrace
ADDED psl-1983/3-1/kernel/defconst.red
Index: psl-1983/3-1/kernel/defconst.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/defconst.red
@@ -0,0 +1,33 @@
+%
+% DEFCONST.RED - Definition and use of symbolic constants
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 8 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% DefConst is used to define a value for a name, to be used in const(Name)
+
+macro procedure DefConst Form; %. DefConst(Name, Value, ...);
+begin scalar ResultForm;
+ ResultForm := list 'ProgN;
+ Form := cdr Form;
+ while not null Form do
+ << ResultForm := list('EvDefConst, MkQuote car Form, MkQuote cadr Form)
+ . ResultForm;
+ Form := cddr Form >>;
+ return ReversIP ResultForm;
+end;
+
+flag('(DefConst), 'Eval);
+
+lisp procedure EvDefConst(ConstName, ConstValue);
+ put(ConstName, 'Const, ConstValue);
+
+macro procedure Const Form;
+ get(cadr Form, 'Const) or StdError BldMsg("Unknown const form %r", Form);
+
+END;
ADDED psl-1983/3-1/kernel/define-smacro.red
Index: psl-1983/3-1/kernel/define-smacro.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/define-smacro.red
@@ -0,0 +1,71 @@
+%
+% DEFINE-SMACRO.RED - Convert SMacros to Lisp macros
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>DEFINE-SMACRO.RED.3, 21-Sep-82 10:48:10, Edit by BENSON
+% Flagged internal functions
+
+% The functions SafeCDR and StdError are required for run-time support
+% of the code generated by DS
+
+CompileTime flag('(InstantiateInForm MakeDS SetMacroReference),
+ 'InternalFunction);
+
+lisp procedure InstantiateInForm(Formals, Form);
+ if Atom Form then
+ if Form memq Formals then Form else MkQuote Form
+ else 'List . for each X in Form collect InstantiateInForm(Formals, X);
+
+lisp procedure SetMacroReference U;
+ list('SetQ, U, '(car !#Arg));
+
+macro procedure DS Form; %. Define Smacro
+%
+% DS(FNAME:id, PARAMS:id-list, FN:any):id
+% ---------------------------------------
+% Type: MACRO
+% A convenient syntax for a simple macro definition, known as an SMACRO.
+% The syntax of DS is similar to DE, except that a MACRO is defined instead
+% of an EXPR, e.g.
+% (DS FOO (A B) (BAR A B))
+% is equivalent to:
+% (DM FOO (U) (LIST 'BAR (CADR U) (CADDR U))).
+% The "implicit ProgN" is allowed when using Lisp syntax. DS is invoked
+% with Rlisp syntax as the procedure type SMACRO, e.g.
+% SMACRO PROCEDURE FOO(A, B); BAR(A, B);
+% produces the above Lisp form.
+%
+MakeDS(cadr Form, caddr Form, cdddr Form);
+
+lisp procedure MakeDS(MacroName, Formals, Form);
+begin scalar NewForm, I;
+ NewForm := list 'PROG;
+ NewForm := Formals . NewForm;
+ for each X in Formals do
+ << NewForm := '(SetQ !#Arg (SafeCDR !#Arg)) . NewForm;
+ NewForm := SetMacroReference X . NewForm >>;
+ NewForm := '(cond ((PairP (cdr !#Arg))
+ (StdError "Argument mismatch in SMacro expansion")))
+ . NewForm;
+ NewForm := list('Return, if null cdr Form then
+ InstantiateInForm(Formals, car Form)
+ else 'list . '(quote ProgN)
+ . for each X in Form collect
+ InstantiateInForm(Formals, X)) . NewForm;
+ return 'dm . MacroName . '(!#Arg) . list ReversIP NewForm;
+end;
+
+%lisp procedure PutC(Name, Type, Body);
+% if Type eq 'SMACRO then Eval MakeDS(Name, cadr Body, cddr Body)
+% else
+% << put(Name, Type, Body);
+% Name >>;
+
+END;
ADDED psl-1983/3-1/kernel/dskin.red
Index: psl-1983/3-1/kernel/dskin.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/dskin.red
@@ -0,0 +1,75 @@
+%
+% DSKIN.RED - Read/Eval/Print from files
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 24 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>DSKIN.RED.2, 5-Oct-82 11:32:28, Edit by BENSON
+% Changed DSKIN from FEXPR to 1 argument EXPR
+% <PSL.INTERP>DSKIN.RED.11, 7-May-82 06:14:27, Edit by GRISS
+% Added XPRINT in loop to handle levels of output
+% <PSL.INTERP>DSKIN.RED.6, 30-Apr-82 12:49:59, Edit by BENSON
+% Made !*DEFN call DfPrint instead of own processing
+% <PSL.INTERP>DSKIN.RED.3, 29-Apr-82 04:23:49, Edit by GRISS
+% Added !*DEFN flag, cf TOPLOOP
+
+CompileTime <<
+
+flag('(DskInDefnPrint), 'InternalFunction);
+
+>>;
+
+expr procedure DskIN F; %. Read a file (dskin "file")
+%
+% This is reasonably standard Standard Lisp, except for file name format
+% knowledge.
+%
+begin scalar OldIN, NewIN, TestOpen, Exp;
+ TestOpen := ErrorSet(list('OPEN, F, '(QUOTE INPUT)), NIL, NIL);
+ if not PairP TestOpen then return
+ ContError(99, "Couldn't open file `%w'", F, DskIN F);
+ NewIN := car TestOpen;
+ OldIN := RDS NewIN;
+ while PairP(Exp := ErrorSet(quote Read(), T, !*Backtrace))
+ and not (car Exp eq !$EOF!$)
+ and PairP(Exp := ErrorSet(list('DskInEval, MkQuote car Exp),
+ T,
+ !*Backtrace)) do
+ if not !*Defn then PrintF("%f%p%n", car Exp);
+ %/ no error protection for printing, maybe should be
+ RDS OldIN;
+ Close NewIN;
+end;
+
+lisp procedure DskInEval U;
+ if not !*DEFN then Eval U else DskInDefnPrint U;
+
+lisp procedure DskInDefnPrint U; % handle case of !*Defn:=T
+%
+% Looks for special action on a form, otherwise prettyprints it;
+% Adapted from DFPRINT
+%
+ if PairP U and FlagP(car U,'Ignore) then Eval U
+ else % So 'IGNORE is EVALED, not output
+ << if DfPrint!* then Apply(DfPrint!*, list U)
+ else PrettyPrint U; % So 'EVAL gets EVALED and Output
+ if PairP U and FlagP(Car U,'EVAL) then Eval U >>;
+
+flag('(DskIn), 'IGNORE);
+
+fluid '(!*RedefMSG !*Echo);
+
+SYMBOLIC PROCEDURE LAPIN FIL;
+BEGIN SCALAR OLDIN, EXP, !*REDEFMSG, !*ECHO;
+ OLDIN := RDS OPEN(FIL,'INPUT);
+ WHILE (EXP := READ()) NEQ !$EOF!$
+ DO EVAL EXP;
+ CLOSE RDS OLDIN;
+END;
+
+END;
ADDED psl-1983/3-1/kernel/easy-non-sl.red
Index: psl-1983/3-1/kernel/easy-non-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/easy-non-sl.red
@@ -0,0 +1,396 @@
+%
+% EASY-NON-SL.RED - Commonly used Non-Standard Lisp functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>EASY-NON-SL.RED.2, 17-Sep-82 16:10:18, Edit by BENSON
+% Added ChannelPrin2T, ChannelSpaces, ChannelTab, ChannelSpaces2
+% <PSL.INTERP>EASY-NON-SL.RED.7, 9-Jul-82 12:46:43, Edit by BENSON
+% Changed NTH to improve error reporting, using DoPNTH
+% <PSL.INTERP>EASY-NON-SL.RED.2, 19-Apr-82 23:05:35, Edit by BENSON
+% Changed order of tests in PNTH
+% <PSL.INTERP>EASY-NON-SL.RED.20, 23-Feb-82 21:36:36, Edit by BENSON
+% Added NE (not eq)
+% <PSL.INTERP>EASY-NON-SL.RED.19, 16-Feb-82 22:30:33, Edit by BENSON
+% made NEQ GEQ and LEQ back into EXPRs
+% <PSL.INTERP>EASY-NON-SL.RED.16, 15-Feb-82 18:01:14, Edit by BENSON
+% Made NEQ GEQ and LEQ into macros
+% <PSL.INTERP>EASY-NON-SL.RED.12, 18-Jan-82 12:28:13, Edit by BENSON
+% Added NexprP
+
+CompileTime flag('(DelqIP1 DeletIP1 SubstIP1 DelAscIP1 DelAtQIP1 DoPNTH),
+ 'InternalFunction);
+
+% predicates
+
+expr procedure NEQ(U, V); %. not EQUAL (should be changed to not EQ)
+ not(U = V);
+
+expr procedure NE(U, V); %. not EQ
+ not(U eq V);
+
+expr procedure GEQ(U, V); %. greater than or equal to
+ not(U < V);
+
+expr procedure LEQ(U, V); %. less than or equal to
+ not(U > V);
+
+lisp procedure EqCar(U, V); %. car U eq V
+ PairP U and car U eq V;
+
+lisp procedure ExprP U; %. Is U an EXPR?
+ EqCar(U, 'LAMBDA) or CodeP U or EqCar(GetD U, 'EXPR);
+
+lisp procedure MacroP U; %. Is U a MACRO?
+ EqCar(GetD U, 'MACRO);
+
+lisp procedure FexprP U; %. Is U an FEXPR?
+ EqCar(GetD U, 'FEXPR);
+
+lisp procedure NexprP U; %. Is U an NEXPR?
+ EqCar(GetD U, 'NEXPR);
+
+% Function definition
+
+lisp procedure CopyD(New, Old); %. FunDef New := FunDef Old;
+%
+% CopyD(New:id, Old:id):id
+% -----------------------
+% Type: EVAL, SPREAD
+% The function body and type for New become the same as Old. If no
+% definition exists for Old, the error
+%
+% ***** `Old' has no definition in CopyD
+%
+% occurs. New is returned.
+%
+begin scalar OldDef;
+ OldDef := GetD Old;
+ if PairP OldDef then
+ PutD(New, car OldDef, cdr OldDef)
+ else
+ StdError BldMsg("%r has no definition in CopyD", Old);
+ return New;
+end;
+
+% Numerical functions
+
+lisp procedure Recip N; %. Floating point reciprocal
+ 1.0 / N;
+
+% Commonly used constructors
+
+lisp procedure MkQuote U; %. Eval MkQuote U eq U
+ list('QUOTE, U);
+
+
+% Nicer names to access parts of a list
+
+macro procedure First U; %. First element of a list
+ 'CAR . cdr U;
+
+macro procedure Second U; %. Second element of a list
+ 'CADR . cdr U;
+
+macro procedure Third U; %. Third element of a list
+ 'CADDR . cdr U;
+
+macro procedure Fourth U; %. Fourth element of a list
+ 'CADDDR . cdr U;
+
+macro procedure Rest U; %. Tail of a list
+ 'CDR . cdr U;
+
+
+% Destructive and EQ versions of Standard Lisp functions
+
+lisp procedure ReversIP U; %. Destructive REVERSE (REVERSe In Place)
+begin scalar X,Y;
+ while PairP U do
+ << X := cdr U;
+ Y := RplacD(U, Y);
+ U := X >>;
+ return Y
+end;
+
+lisp procedure SubstIP1(A, X, L); % Auxiliary function for SubstIP
+<< if X = car L then RplacA(L, A)
+ else if PairP car L then SubstIP(A, X, car L);
+ if PairP cdr L then SubstIP(A, X, cdr L) >>;
+
+lisp procedure SubstIP(A, X, L); %. Destructive version of Subst
+ if null L then NIL
+ else if X = L then A
+ else if not PairP L then L
+ else
+ << SubstIP1(A, X, L);
+ L >>;
+
+lisp procedure DeletIP1(U, V); % Auxiliary function for DeletIP
+ if PairP cdr V then
+ if U = cadr V then RplacD(V, cddr V)
+ else DeletIP1(U, cdr V);
+
+lisp procedure DeletIP(U, V); %. Destructive DELETE
+ if not PairP V then V
+ else if U = car V then cdr V
+ else
+ << DeletIP1(U, V);
+ V >>;
+
+lisp procedure DelQ(U, V); %. EQ version of DELETE
+ if not PairP V then V
+ else if car V eq U then cdr V
+ else car V . DelQ(U, cdr V);
+
+lisp procedure Del(F, U, V); %. Generalized Delete, F is comparison function
+ if not PairP V then V
+ else if Apply(F, list(car V, U)) then cdr V
+ else car V . Del(F, U, cdr V);
+
+lisp procedure DelqIP1(U, V); % Auxiliary function for DelqIP
+ if PairP cdr V then
+ if U eq cadr V then RplacD(V, cddr V)
+ else DelqIP1(U, cdr V);
+
+lisp procedure DelqIP(U, V); %. Destructive DELQ
+ if not PairP V then V
+ else if U eq car V then cdr V
+ else
+ << DelqIP1(U, V);
+ V >>;
+
+lisp procedure Atsoc(U, V); %. EQ version of ASSOC
+ if not PairP V then NIL
+ else if PairP car V and U eq caar V then car V
+ else Atsoc(U, cdr V);
+
+lisp procedure Ass(F, U, V); %. Generalized Assoc, F is comparison function
+%
+% Not to be confused with Elbow
+%
+ if not PairP V then NIL
+ else if PairP car V and Apply(F, list(U, caar V)) then car V
+ else Ass(F, U, cdr V);
+
+lisp procedure Mem(F, U, V); %. Generalized Member, F is comparison function
+ if not PairP V then NIL
+ else if Apply(F, list(U, car V)) then V
+ else Mem(F, U, cdr V);
+
+lisp procedure RAssoc(U, V); %. Reverse Assoc, compare with cdr of entry
+ if not PairP V then NIL
+ else if PairP car V and U = cdar V then car V
+ else RAssoc(U, cdr V);
+
+lisp procedure DelAsc(U, V); %. Remove first (U . xxx) from V
+ if not PairP V then NIL
+ else if PairP car V and U = caar V then cdr V
+ else car V . DelAsc(U, cdr V);
+
+lisp procedure DelAscIP1(U, V); % Auxiliary function for DelAscIP
+ if PairP cdr V then
+ if PairP cadr V and U = caadr V then
+ RplacD(V, cddr V)
+ else DelAscIP1(U, cdr V);
+
+lisp procedure DelAscIP(U, V); %. Destructive DelAsc
+ if not PairP V then NIL
+ else if PairP car V and U = caar V then cdr V
+ else
+ << DelAscIP1(U, V);
+ V >>;
+
+lisp procedure DelAtQ(U, V); %. EQ version of DELASC
+ if not PairP V then NIL
+ else if EqCar(car V, U) then cdr V
+ else car V . DelAtQ(U, cdr V);
+
+lisp procedure DelAtQIP1(U, V); % Auxiliary function for DelAtQIP
+ if PairP cdr V then
+ if PairP cadr V and U eq caadr V then
+ RplacD(V, cddr V)
+ else DelAtQIP1(U, cdr V);
+
+lisp procedure DelAtQIP(U, V); %. Destructive DelAtQ
+ if not PairP V then NIL
+ else if PairP car V and U eq caar V then cdr V
+ else
+ << DelAtQIP1(U, V);
+ V >>;
+
+lisp procedure SublA(U,V); %. EQ version of SubLis, replaces atoms only
+begin scalar X;
+ return if not PairP U or null V then V
+ else if atom V then
+ if (X := Atsoc(V, U)) then cdr X else V
+ else SublA(U, car V) . SublA(U, cdr V)
+end;
+
+
+lisp procedure RplacW(A, B); %. RePLACe Whole pair
+ if PairP A then
+ if PairP B then
+ RplacA(RplacD(A,
+ cdr B),
+ car B)
+ else
+ NonPairError(B, 'RplacW)
+ else
+ NonPairError(A, 'RPlacW);
+
+lisp procedure LastCar X; %. last element of list
+ if atom X then X else car LastPair X;
+
+lisp procedure LastPair X; %. last pair of list
+ if atom X or atom cdr X then X else LastPair cdr X;
+
+lisp procedure Copy U; %. copy all pairs in S-Expr
+%
+% See also TotalCopy in COPIERS.RED
+%
+ if PairP U then Copy car U . Copy cdr U else U; % blows up if circular
+
+
+lisp procedure NTH(U, N); %. N-th element of list
+(lambda(X);
+ if PairP X then car X else RangeError(U, N, 'NTH))(DoPNTH(U, N));
+
+lisp procedure DoPNTH(U, N);
+ if N = 1 or not PairP U then U
+ else DoPNTH(cdr U, N - 1);
+
+lisp procedure PNTH(U, N); %. Pointer to N-th element of list
+ if N = 1 then U
+ else if not PairP U then
+ RangeError(U, N, 'PNTH)
+ else PNTH(cdr U, N - 1);
+
+lisp procedure AConc(U, V); %. destructively add element V to the tail of U
+ NConc(U, list V);
+
+lisp procedure TConc(Ptr, Elem); %. AConc maintaining pointer to end
+%
+% ACONC with pointer to end of list
+% Ptr is (list . last CDR of list)
+% returns updated Ptr
+% Ptr should be initialized to (NIL . NIL) before calling the first time
+%
+<< Elem := list Elem;
+ if not PairP Ptr then % if PTR not initialized, return starting ptr
+ Elem . Elem
+ else if null cdr Ptr then % Nothing in the list yet
+ RplacA(RplacD(Ptr, Elem), Elem)
+ else
+ << RplacD(cdr Ptr, Elem);
+ RplacD(Ptr, Elem) >> >>;
+
+lisp procedure LConc(Ptr, Lst); %. NConc maintaining pointer to end
+%
+% NCONC with pointer to end of list
+% Ptr is (list . last CDR of list)
+% returns updated Ptr
+% Ptr should be initialized to NIL . NIL before calling the first time
+%
+ if null Lst then Ptr
+ else if atom Ptr then % if PTR not initialized, return starting ptr
+ Lst . LastPair Lst
+ else if null cdr Ptr then % Nothing in the list yet
+ RplacA(RplacD(Ptr, LastPair Lst), Lst)
+ else
+ << RplacD(cdr Ptr, Lst);
+ RplacD(Ptr, LastPair Lst) >>;
+
+
+% MAP functions of 2 arguments
+
+lisp procedure Map2(L, M, Fn); %. for each X, Y on L, M do Fn(X, Y);
+<< while PairP L and PairP M do
+ << Apply(Fn, list(L, M));
+ L := cdr L;
+ M := cdr M >>;
+ if PairP L or PairP M then
+ StdError "Different length lists in MAP2"
+ else NIL >>;
+
+lisp procedure MapC2(L, M, Fn); %. for each X, Y in L, M do Fn(X, Y);
+<< while PairP L and PairP M do
+ << Apply(Fn, list(car L, car M));
+ L := cdr L;
+ M := cdr M >>;
+ if PairP L or PairP M then
+ StdError "Different length lists in MAPC2"
+ else NIL >>;
+
+% Printing functions
+
+lisp procedure ChannelPrin2T(C, U); %. Prin2 and TerPri
+<< ChannelPrin2(C, U);
+ ChannelTerPri C;
+ U >>;
+
+lisp procedure Prin2T U; %. Prin2 and TerPri
+ ChannelPrin2T(OUT!*, U);
+
+lisp procedure ChannelSpaces(C, N); %. Prin2 N spaces
+ for I := 1 step 1 until N do ChannelWriteChar(C, char BLANK);
+
+lisp procedure Spaces N; %. Prin2 N spaces
+ ChannelSpaces(OUT!*, N);
+
+lisp procedure ChannelTAB(Chn, N); %. Spaces to column N
+begin scalar M;
+ M := ChannelPosn Chn;
+ if N < M then
+ << ChannelTerPri Chn;
+ M := 0 >>;
+ ChannelSpaces(Chn, N - M);
+end;
+
+lisp procedure TAB N; %. Spaces to column N
+ ChannelTAB(OUT!*, N);
+
+if_system(Dec20, <<
+lap '((!*entry FileP expr 1)
+ (!*MOVE (REG 1) (REG 2))
+ (hrli 2 8#010700) % make a byte pointer
+ (hrlzi 1 2#001000000000000001) % gj%old + gj%sht
+ (gtjfn)
+ (jrst NotFile)
+ (rljfn) % release it
+ (jfcl)
+ (!*MOVE (QUOTE T) (REG 1))
+ (!*EXIT 0)
+NotFile
+ (!*MOVE (QUOTE NIL) (REG 1))
+ (!*EXIT 0)
+); >>, <<
+lisp procedure FileP F; %. is F an existing file?
+%
+% This could be done more efficiently in a much more system-dependent way,
+% but efficiency probably doesn't matter too much here.
+%
+ if PairP(F := ErrorSet(list('OPEN, MkQuote F, '(QUOTE INPUT)), NIL, NIL))
+ then
+ << Close car F;
+ T >>
+ else NIL; >>);
+
+% This doesn't belong anywhere and will be eliminated soon
+
+lisp procedure PutC(Name, Ind, Exp); %. Used by RLISP to define SMACROs
+<< put(Name, Ind, Exp);
+ Name >>;
+
+LoadTime <<
+ PutD('Spaces2, 'EXPR, cdr GetD 'TAB); % For compatibility
+ PutD('ChannelSpaces2, 'EXPR, cdr GetD 'ChannelTAB);
+>>;
+
+END;
ADDED psl-1983/3-1/kernel/easy-sl.red
Index: psl-1983/3-1/kernel/easy-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/easy-sl.red
@@ -0,0 +1,353 @@
+%
+% EASY-SL.RED - Standard Lisp functions with easy Standard Lisp definitions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>EASY-SL.RED.3, 17-Sep-82 16:16:58, Edit by BENSON
+% Added ChannelPrint
+% <PSL.INTERP>EASY-SL.RED.4, 13-Aug-82 14:14:49, Edit by BENSON
+% Changed nice recursive Append to ugly iterative definition
+% <PSL.INTERP>EASY-SL.RED.13, 8-Feb-82 17:43:07, Edit by BENSON
+% Made SetQ take multiple arguments
+% <PSL.INTERP>EASY-SL.RED.7, 18-Jan-82 17:30:14, Edit by BENSON
+% Added Max2 and Min2
+% <PSL.INTERP>EASY-SL.RED.6, 15-Jan-82 14:54:36, Edit by BENSON
+% Changed DE, DF, DM, DN from Fexprs to Macros
+
+% This file contains only functions found in the Standard Lisp report which
+% can be easily and efficiently defined in terms of other Standard Lisp
+% functions. It does not include primitive functions which are handled
+% specially by the compiler, such as EQ.
+
+% Many NULL tests in these functions have been replaced with not PairP tests,
+% so that they will be safer.
+
+CompileTime flag('(EvAnd1), 'InternalFunction);
+
+% Section 3.1 -- Elementary predicates
+
+lisp procedure Atom U; %. is U a non pair?
+ not PairP U;
+
+lisp procedure ConstantP U; %. is Eval U eq U by definition?
+ not PairP U and not IDP U;
+
+lisp procedure Null U; %. is U eq NIL?
+ U eq NIL;
+
+lisp procedure NumberP U; %. is U a number of any kind?
+ FixP U or FloatP U;
+
+lisp procedure Expt(X, N);
+begin scalar Result;
+ if not IntP N or not NumberP X then return
+ ContError(99, "Illegal arguments to Expt", X ** N);
+ Result := 1;
+ if N > 0 then
+ for I := 1 step 1 until N do Result := Result * X
+ else if N < 0 then
+ for I := -1 step -1 until N do Result := Result / X;
+ return Result;
+end;
+
+% MinusP, OneP and ZeroP are in ARITHMETIC.RED
+% FixP is defined in OTHERS-SL.RED
+
+% Section 3.2 -- Functions on Dotted-Pairs
+
+% composites of CAR and CDR are found in CARCDR.RED
+
+fexpr procedure List U; %. construct list of arguments
+ EvLis U;
+
+
+% section 3.5 -- Function definition
+
+macro procedure DE U; %. Terse syntax for PutD call for EXPR
+ list('PutD, MkQuote cadr U,
+ '(QUOTE EXPR),
+ list('FUNCTION, ('LAMBDA . cddr U)));
+
+macro procedure DF U; %. Terse syntax for PutD call for FEXPR
+ list('PutD, MkQuote cadr U,
+ '(QUOTE FEXPR),
+ list('FUNCTION, ('LAMBDA . cddr U)));
+
+macro procedure DM U; %. Terse syntax for PutD call for MACRO
+ list('PutD, MkQuote cadr U,
+ '(QUOTE MACRO),
+ list('FUNCTION, ('LAMBDA . cddr U)));
+
+macro procedure DN U; %. Terse syntax for PutD call for NEXPR
+ list('PutD, MkQuote cadr U,
+ '(QUOTE NEXPR),
+ list('FUNCTION, ('LAMBDA . cddr U)));
+
+
+% Section 3.6 -- Variables and bindings
+
+fexpr procedure SetQ U; %. Standard named variable assignment
+%
+% Extended from SL Report to be Common Lisp compatible
+% (setq foo 1 bar 2 ...) is permitted
+%
+begin scalar V, W;
+ while U do
+ << W := cdr U;
+ Set(car U, V := Eval car W);
+ U := cdr W >>;
+ return V;
+end;
+
+% Section 3.7 -- Program feature functions
+
+lisp procedure Prog2(U, V); %. Return second argument
+ V;
+
+fexpr procedure ProgN U; %. Sequential evaluation, return last
+ EvProgN U;
+
+StartupTime put('PROGN, 'TYPE, 'FEXPR);
+
+lisp procedure EvProgN U; %. EXPR support for ProgN, Eval, Cond
+ if PairP U then
+ << while PairP cdr U do
+ << Eval car U;
+ U := cdr U >>;
+ Eval car U >>
+ else NIL;
+
+% Section 3.10 -- Boolean functions and conditionals
+
+fexpr procedure And U; %. Sequentially evaluate until NIL
+ EvAnd U;
+
+lisp procedure EvAnd U; %. EXPR support for And
+ if not PairP U then T else EvAnd1 U;
+
+lisp procedure EvAnd1 U; % Auxiliary function for EvAnd
+ if not PairP cdr U then Eval car U
+ else if not Eval car U then NIL
+ else EvAnd1 cdr U;
+
+fexpr procedure OR U; %. sequentially evaluate until non-NIL
+ EvOr U;
+
+lisp procedure EvOr U; %. EXPR support for Or
+ PairP U and (Eval car U or EvOr cdr U);
+
+fexpr procedure Cond U; %. Conditional evaluation construct
+ EvCond U;
+
+lisp procedure EvCond U; %. EXPR support for Cond
+%
+% Extended from Standard Lisp definition to allow no consequent (antecedent is
+% returned), or multiple consequent (implicit progn).
+%
+begin scalar CondForm, Antecedent, Result;
+ return if not PairP U then NIL
+ else
+ << CondForm := car U;
+ U := cdr U;
+ Antecedent := if PairP CondForm then car CondForm else CondForm;
+ if not (Result := Eval Antecedent) then
+ EvCond U
+ else if not PairP CondForm or not PairP cdr CondForm then
+ Result
+ else
+ EvProgN cdr CondForm >>;
+end;
+
+lisp procedure Not U; %. Equivalent to NULL
+ null U;
+
+
+% Section 3.11 -- Arithmetic functions
+
+lisp procedure Abs U; %. Absolute value of number
+ if MinusP U then -U else U;
+
+lisp procedure Divide(U, V); %. dotted pair remainder and quotient
+ if ZeroP V then
+ ContError(99, "Attempt to divide by 0 in DIVIDE", Divide(U, V))
+ else
+ Quotient(U, V) . Remainder(U, V);
+
+macro procedure Max U; %. numeric maximum of several arguments
+ RobustExpand(cdr U, 'Max2, 0); % should probably be -infinity
+
+lisp procedure Max2(U, V); %. maximum of 2 arguments
+ if U < V then V else U;
+
+macro procedure Min U; %. numeric minimum of several arguments
+ RobustExpand(cdr U, 'Min2, 0); % should probably be +infinity
+
+lisp procedure Min2(U, V); %. minimum of 2 arguments
+ if U > V then V else U;
+
+macro procedure Plus U; %. addition of several arguments
+ RobustExpand(cdr U, 'Plus2, 0);
+
+macro procedure Times U; %. multiplication of several arguments
+ RobustExpand(cdr U, 'Times2, 1);
+
+
+% Section 3.12 -- MAP Composite functions
+
+lisp procedure Map(L, Fn); %. for each X on L do Fn(X);
+ while PairP L do
+ << Apply(Fn, list L);
+ L := cdr L >>;
+
+lisp procedure MapC(L, Fn); %. for each X in L do Fn(X);
+ while PairP L do
+ << Apply(Fn, list car L);
+ L := cdr L >>;
+
+lisp procedure MapCan(L, Fn); %. for each X in L conc Fn(X);
+ if not PairP L then NIL
+ else NConc(Apply(Fn, list car L), MapCan(cdr L, Fn));
+
+lisp procedure MapCon(L, Fn); %. for each X on L conc Fn(X);
+ if not PairP L then NIL
+ else NConc(Apply(Fn, list L), MapCon(cdr L, Fn));
+
+lisp procedure MapCar(L, Fn); %. for each X in L collect Fn(X);
+ if not PairP L then NIL
+ else Apply(Fn, list car L) . MapCar(cdr L, Fn);
+
+lisp procedure MapList(L, Fn); %. for each X on L collect Fn(X);
+ if not PairP L then NIL
+ else Apply(Fn, list L) . MapList(cdr L, Fn);
+
+
+% Section 3.13 -- Composite functions
+
+lisp procedure Append(U, V); %. Combine 2 lists
+ if not PairP U then V else begin scalar U1, U2;
+ U1 := U2 := car U . NIL;
+ U := cdr U;
+ while PairP U do
+ << RplacD(U2, car U . NIL);
+ U := cdr U;
+ U2 := cdr U2 >>;
+ RplacD(U2, V);
+ return U1;
+ end;
+
+%
+% These A-list functions differ from the Standard Lisp Report in that
+% poorly formed A-lists (non-pair entries) are not signalled as an error,
+% rather the entries are ignored. This is because some data structures
+% (such as property lists) use atom entries for other purposes.
+%
+
+lisp procedure Assoc(U, V); %. Return first (U . xxx) in V, or NIL
+ if not PairP V then NIL
+ else if PairP car V and U = caar V then car V
+ else Assoc(U, cdr V);
+
+lisp procedure Sassoc(U, V, Fn); %. Return first (U . xxx) in V, or Fn()
+ if not PairP V then Apply(Fn, NIL)
+ else if PairP car V and U = caar V then car V
+ else Sassoc(U, cdr V, Fn);
+
+lisp procedure Pair(U, V); %. For each X,Y in U,V collect (X . Y)
+ if PairP U and PairP V then (car U . car V) . Pair(cdr U, cdr V)
+ else if PairP U or PairP V then
+ StdError "Different length lists in PAIR"
+ else NIL;
+
+lisp procedure SubLis(X, Y); %. Substitution in Y by A-list X
+ if not PairP X then Y
+ else begin scalar U;
+ U := Assoc(Y, X);
+ return if PairP U then cdr U
+ else if not PairP Y then Y
+ else SubLis(X, car Y) . SubLis(X, cdr Y);
+ end;
+
+
+lisp procedure DefList(DList, Indicator); %. PUT many IDs, same indicator
+ if not PairP DList then NIL else
+ << put(caar DList, Indicator, cadar DList);
+ caar DList >> . DefList(cdr DList, Indicator);
+
+lisp procedure Delete(U, V); %. Remove first top-level U in V
+ if not PairP V then V
+ else if car V = U then cdr V
+ else car V . Delete(U, cdr V);
+
+% DIGIT, LENGTH and LITER are optimized, don't use SL Report version
+
+lisp procedure Member(U, V); %. Find U in V
+ if not PairP V then NIL
+ else if U = car V then V
+ else U Member cdr V;
+
+lisp procedure MemQ(U, V); % EQ version of Member
+ if not PairP V then NIL
+ else if U eq car V then V
+ else U MemQ cdr V;
+
+lisp procedure NConc(U, V); %. Destructive version of Append
+begin scalar W;
+ if not PairP U then return V;
+ W := U;
+ while PairP cdr W do W := cdr W;
+ RplacD(W, V);
+ return U;
+end;
+
+lisp procedure Reverse U; %. Top-level reverse of list
+begin scalar V;
+ while PairP U do
+ << V := car U . V;
+ U := cdr U >>;
+ return V;
+end;
+
+lisp procedure Subst(A, X, L); %. Replace every X in L with A
+ if null L then NIL
+ else if X = L then A
+ else if null PairP L then L
+ else Subst(A, X, car L) . Subst(A, X, cdr L);
+
+lisp procedure EvLis U; %. For each X in U collect Eval X
+ if not PairP U then NIL
+ else Eval car U . EvLis cdr U;
+
+lisp procedure RobustExpand(L, Fn, EmptyCase); %. Expand + arg for empty list
+ if null L then EmptyCase else Expand(L, Fn);
+
+lisp procedure Expand(L, Fn); %. L = (a b c) --> (Fn a (Fn b c))
+ if not PairP L then L
+ else if not PairP cdr L then car L
+ else list(Fn, car L, Expand(cdr L, Fn));
+
+fexpr procedure Quote U; %. Return unevaluated argument
+ car U;
+
+StartupTime put('QUOTE, 'TYPE, 'FEXPR); % needed to run from scratch
+
+fexpr procedure Function U; %. Same as Quote in this version
+ car U;
+
+
+% Section 3.15 -- Input and Output
+
+lisp procedure ChannelPrint(C, U); %. Display U and terminate line
+<< ChannelPrin1(C, U);
+ ChannelTerPri C;
+ U >>;
+
+lisp procedure Print U; %. Display U and terminate line
+ ChannelPrint(OUT!*, U);
+
+End;
ADDED psl-1983/3-1/kernel/equal.red
Index: psl-1983/3-1/kernel/equal.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/equal.red
@@ -0,0 +1,123 @@
+%
+% EQUAL.RED - EQUAL, EQN and friends
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>EQUAL.RED.2, 21-Sep-82 10:38:28, Edit by BENSON
+% Made HalfWordsEqual, etc. internal
+
+% EQ is handled by the compiler and is in KNOWN-TO-COMP-SL.RED
+
+CompileTime flag('(HalfWordsEqual VectorEqual WordsEqual), 'InternalFunction);
+
+on SysLisp;
+
+syslsp procedure Eqn(U, V); %. Eq or numeric equality
+ U eq V or case Tag U of % add bignums later
+ FLTN:
+ FloatP V and
+ FloatHighOrder FltInf U eq FloatHighOrder FltInf V
+ and FloatLowOrder FltInf U eq FloatLowOrder FltInf V;
+ FIXN:
+ FixNP V and FixVal FixInf U eq FixVal FixInf V;
+ BIGN:
+ BigP V and WordsEqual(U, V);
+ default:
+ NIL
+ end;
+
+% Called LispEqual instead of Equal, to avoid name change due to Syslisp parser
+
+syslsp procedure LispEqual(U, V); %. Structural equality
+ U eq V or case Tag U of
+ VECT:
+ VectorP V and VectorEqual(U, V);
+ STR, BYTES:
+ StringP V and StringEqual(U, V);
+ PAIR:
+ PairP V and
+ LispEqual(car U, car V) and LispEqual(cdr U, cdr V);
+ FLTN:
+ FloatP V and
+ FloatHighOrder FltInf U eq FloatHighOrder FltInf V
+ and FloatLowOrder FltInf U eq FloatLowOrder FltInf V;
+ FIXN:
+ FixNP V and FixVal FixInf U eq FixVal FixInf V;
+ BIGN:
+ BigP V and WordsEqual(U, V);
+ WRDS:
+ WrdsP V and WordsEqual(U, V);
+ HalfWords:
+ HalfWordsP V and HalfWordsEqual(U, V);
+ default:
+ NIL
+ end;
+
+syslsp procedure EqStr(U, V); %. Eq or string equality
+ U eq V or StringP U and StringP V and StringEqual(U, V);
+
+syslsp procedure StringEqual(U, V); % EqStr without typechecking or eq
+begin scalar Len, I;
+ U := StrInf U;
+ V := StrInf V;
+ Len := StrLen U;
+ if Len neq StrLen V then return NIL;
+ I := 0;
+Loop:
+ if I > Len then return T;
+ if StrByt(U, I) neq StrByt(V, I) then return NIL;
+ I := I + 1;
+ goto Loop;
+end;
+
+syslsp procedure WordsEqual(U, V);
+begin scalar S1, I;
+ U := WrdInf U;
+ V := WrdInf V;
+ if not ((S1 := WrdLen U) eq WrdLen V) then return NIL;
+ I := 0;
+Loop:
+ if I eq S1 then return T;
+ if not (WrdItm(U, I) eq WrdItm(V, I)) then return NIL;
+ I := I + 1;
+ goto Loop;
+end;
+
+syslsp procedure HalfWordsEqual(U, V);
+begin scalar S1, I;
+ U := HalfWordInf U;
+ V := HalfWordInf V;
+ if not ((S1 := HalfWordLen U) eq HalfWordLen V) then return NIL;
+ I := 0;
+Loop:
+ if I eq S1 then return T;
+ if not (HalfWordItm(U, I) eq HalfWordItm(V, I)) then return NIL;
+ I := I + 1;
+ goto Loop;
+end;
+
+syslsp procedure VectorEqual(U, V); % Vector equality without type check
+begin scalar Len, I;
+ U := VecInf U;
+ V := VecInf V;
+ Len := VecLen U;
+ if Len neq VecLen V then return NIL;
+ I := 0;
+Loop:
+ if I > Len then return T;
+ if not LispEqual(VecItm(U, I), VecItm(V, I)) then return NIL;
+ I := I + 1;
+ goto Loop;
+end;
+
+off SysLisp;
+
+LoadTime PutD('Equal, 'EXPR, cdr GetD 'LispEqual);
+
+END;
ADDED psl-1983/3-1/kernel/error-errorset.red
Index: psl-1983/3-1/kernel/error-errorset.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/error-errorset.red
@@ -0,0 +1,61 @@
+%
+% ERROR-ERRORSET.RED - The most basic ERROR and ERRORSET
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 4 Feb 1983 1208-PST
+% Moved ERRSET here from CATCH-THROW.RED.
+% Edit by Cris Perdue, 3 Feb 1983 1526-PST
+% Tidied up definition of ERRORSET.
+% <PSL.KERNEL>ERROR-ERRORSET.RED.3, 11-Oct-82 17:57:30, Edit by BENSON
+% Changed CATCH/THROW to new definition
+% <PSL.KERNEL>ERROR-ERRORSET.RED.2, 20-Sep-82 11:31:23, Edit by BENSON
+% Removed printing of error number in ERROR
+% <PSL.INTERP>ERROR-ERRORSET.RED.7, 26-Feb-82 23:44:01, Edit by BENSON
+% Added BreakLevel!* check
+% <PSL.INTERP>ERROR-ERRORSET.RED.5, 28-Dec-81 17:07:18, Edit by BENSON
+% Changed 3rd formal in ErrorSet to !*Inner!*Backtrace
+
+global '(EMsg!*); % gets current error message
+fluid '(!*BackTrace % controls backtrace printing (actual)
+ !*Inner!*Backtrace % controls backtrace printing (formal)
+ !*EMsgP % controls message printing
+ !*Break % controls breaking
+ BreakLevel!* % nesting level of breaks
+ MaxBreakLevel!* % maximum permitted ...
+ !*ContinuableError); % if T, inside a continuable error
+
+LoadTime
+<< !*EmsgP := T;
+ !*BackTrace := NIL;
+ !*Break := T >>;
+
+lisp procedure Error(Number, Message); %. Throw to ErrorSet
+begin scalar !*ContinuableError;
+ EMsg!* := Message;
+ if !*EMsgP then
+ << ErrorPrintF("***** %l", Message); % Error number is not printed
+ if !*Break and BreakLevel!* < MaxBreakLevel!* then
+ return Break() >>;
+ return
+ << if !*Inner!*BackTrace then BackTrace();
+ Throw('!$Error!$, Number) >>;
+end;
+
+% More useful version of ERRORSET
+macro procedure errset u;
+(lambda(form, flag);
+ list(list('lambda, '(!*Emsgp),
+ list('catch, ''!$error!$, list('ncons, form))),
+ flag))(cadr u, if null cddr u then t else caddr u);
+
+lisp procedure ErrorSet(Form, !*EMsgP, !*Inner!*BackTrace); %. Protected Eval
+ Catch('!$Error!$, list(Eval Form)); % eval form
+
+END;
ADDED psl-1983/3-1/kernel/error-handlers.red
Index: psl-1983/3-1/kernel/error-handlers.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/error-handlers.red
@@ -0,0 +1,88 @@
+%
+% ERROR-HANDLERS.RED - Low level error handlers
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PERDUE.PSL>ERROR-HANDLERS.RED.2, 9-Dec-82 18:16:42, Edit by PERDUE
+% Changed continuable error message; also allows for no (NIL) retry form
+% <PSL.KERNEL>ERROR-HANDLERS.RED.2, 20-Sep-82 14:55:56, Edit by BENSON
+% Error number isn't printed
+% <PSL.INTERP>ERROR-HANDLERS.RED.11, 26-Feb-82 23:43:16, Edit by BENSON
+% Added BreakLevel!* check
+% <PSL.INTERP>ERROR-HANDLERS.RED.8, 28-Dec-81 17:02:43, Edit by BENSON
+% Compressed output in ContinuableError
+% MLG 7:18am Tuesday, 24 November 1981 - To print ErrorForm!* on ErrorOut!*
+
+fluid '(!*ContinuableError % if true, inside continuable error
+ ErrorForm!*
+ BreakLevel!* % nesting level of break loops
+ MaxBreakLevel!* % maximum permitted ...
+ !*EMsgP); % value of 2nd arg to previous errorset
+global '(EMsg!*); % gets message from most recent error
+
+on SysLisp;
+
+syslsp procedure FatalError S;
+<< ErrorPrintF("***** Fatal error: %s", S);
+ while T do Quit; >>;
+
+off SysLisp;
+
+lisp procedure RangeError(Object, Index, Fn);
+ StdError BldMsg("Index %r out of range for %p in %p", Index, Object, Fn);
+
+lisp procedure StdError Message; %. Error without number
+ Error(99, Message);
+
+SYMBOLIC PROCEDURE YESP U;
+ BEGIN SCALAR BOOL,X,Y, OLDOUT, OLDIN, PROMPTSTRING!*;
+ OLDIN := RDS NIL;
+ OLDOUT := WRS ERROUT!*;
+% TERPRI();
+% PRIN2L U;
+% TERPRI();
+% TERPRI();
+ if_system(Tops20, % ? in col 1, so batch jobs get killed
+ PROMPTSTRING!* := BldMsg("?%l (Y or N) ", U),
+ PROMPTSTRING!* := BldMsg("%l (Y or N) ", U));
+ A: X := READ();
+ IF (Y := (X MEMQ '(Y YES))) OR X MEMQ '(N NO) THEN GO TO B;
+% IF NULL BOOL THEN PRIN2T "TYPE Y OR N";
+ if X = 'B then ErrorSet('(Break), NIL, NIL);
+ if_system(Unix, % If read EOF, croak so shell scripts terminate
+ if X eq !$EOF!$ then return (lambda(!*Break);
+ StdError "End-of-file read in YesP")(NIL));
+ BOOL := T;
+ GO TO A;
+ B: WRS OLDOUT;
+ RDS OLDIN;
+ CURSYM!* := '!*SEMICOL!*;
+ RETURN Y
+ END;
+
+lisp procedure ContinuableError(ErrNum, Message, ErrorForm!*); %. maybe fix
+begin scalar !*ContinuableError;
+ !*ContinuableError := T;
+ EMsg!* := Message;
+ return if !*Break and !*EMsgP and BreakLevel!* < MaxBreakLevel!* then
+ << ErrorPrintF("***** %l", Message); % Don't print number
+ if null ErrorForm!* then
+ ErrorPrintF("***** Continuable error.")
+ else
+ if FlatSize ErrorForm!* < 40 then
+ ErrorPrintF("***** Continuable error: retry form is %r",
+ ErrorForm!*)
+ else
+ << ErrorPrintF("***** Continuable error, retry form is:");
+ ErrorPrintF("%p", ErrorForm!*) >>;
+ Break() >>
+ else Error(ErrNum, Message);
+end;
+
+END;
ADDED psl-1983/3-1/kernel/error.build
Index: psl-1983/3-1/kernel/error.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/error.build
@@ -0,0 +1,15 @@
+%
+% ERROR.BUILD - Files with error handling functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "error-handlers.red"$ % low level error handlers
+PathIn "type-errors.red"$ % type mismatch error calls
+PathIn "error-errorset.red"$ % most basic error handling
+PathIn "io-errors.red"$ % I/O error handlers
ADDED psl-1983/3-1/kernel/eval-apply.red
Index: psl-1983/3-1/kernel/eval-apply.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/eval-apply.red
@@ -0,0 +1,147 @@
+%
+% EVAL-APPLY.RED - Function calling mechanism
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>EVAL-APPLY.RED.2, 20-Sep-82 10:36:28, Edit by BENSON
+% CAR of a form is never evaluated
+% <PSL.INTERP>EVAL-APPLY.RED.5, 6-Jan-82 19:22:46, Edit by GRISS
+% Add NEXPR
+
+% FUnBoundP and other function cell primitives found in FUNCTION-PRIMITIVES
+% Eval and Apply could have been defined using only GetD rather than these
+% primitves. They are used instead to avoid the CONS in GETD.
+
+% ValueCell is found in SYMBOL-VALUES.RED
+
+% IDApply, CodeApply, IDEvalApply and CodeEvalApply are written in LAP
+% due to register usage and to make them faster. They are found in
+% APPLY-LAP.RED. IDApply1 is handled by the compiler
+
+% uses EvProgN, found in EASY-SL.RED, expr for PROGN
+
+% Error numbers:
+% 1000 - undefined function
+% 1100 - ill-formed function expression
+% 1200 - argument number mismatch
+% 1300 - unknown function type
+% +3 in LambdaEvalApply
+% +4 in LambdaApply
+% +2 in Apply
+% +1 in Eval
+
+CompileTime flag('(LambdaEvalApply LambdaApply), 'InternalFunction);
+
+on SysLisp;
+
+% the only reason these 2 are in Syslisp is to speed up arithmetic (N := N + 1)
+
+syslsp procedure LambdaEvalApply(Fn, Args); %. Fn is Lambda, Args to be Evaled
+ if not (PairP Fn and car Fn = 'LAMBDA) then
+ ContinuableError('1103,
+ '"Ill-formed function expression",
+ Fn . Args)
+ else begin scalar N, Result;
+ N := BindEval(cadr Fn, Args); % hand-coded, bind formals to evlis args
+ if N = -1 then return
+ ContinuableError('1203,
+ '"Argument number mismatch",
+ Fn . Args);
+ Result := EvProgN cddr Fn;
+ if N neq 0 then UnBindN N;
+ return Result;
+ end;
+
+syslsp procedure LambdaApply(Fn, Args); %. Fn is Lambda, unevaled Args
+ if not (PairP Fn and car Fn = 'LAMBDA) then
+ ContinuableError('1104,
+ '"Ill-formed function expression",
+ Fn . for each X in Args collect MkQuote X)
+ else begin scalar Formals, N, Result;
+ Formals := cadr Fn;
+ N := 0;
+ while PairP Formals and PairP Args do
+ << LBind1(car Formals, car Args);
+ Formals := cdr Formals;
+ Args := cdr Args;
+ N := N + 1 >>;
+ if PairP Formals or PairP Args then return
+ ContinuableError('1204,
+ '"Argument number mismatch",
+ Fn . for each X in Args collect MkQuote X);
+ Result := EvProgN cddr Fn;
+ if N neq 0 then UnBindN N;
+ return Result;
+ end;
+
+off SysLisp;
+
+% Apply differs from the Standard Lisp Report in that functions other
+% than EXPRs are allowed to be applied, the effect being the same as
+% Apply(cdr GetD Fn, Args)
+
+lisp procedure Apply(Fn, Args); %. Indirect function call
+ if IDP Fn then begin scalar StackMarkForBacktrace, Result;
+ if FUnBoundP Fn then return
+ ContinuableError(1002,
+ BldMsg("%r is an undefined function", Fn),
+ Fn . for each X in Args collect MkQuote X);
+ StackMarkForBacktrace := MkBTR Inf Fn;
+ Result := if FCodeP Fn then CodeApply(GetFCodePointer Fn, Args)
+ else LambdaApply(get(Fn, '!*LambdaLink), Args);
+ return Result;
+ end
+ else if CodeP Fn then CodeApply(Fn, Args)
+ else if PairP Fn and car Fn = 'LAMBDA then
+ LambdaApply(Fn, Args)
+ else
+ ContinuableError(1102,
+ "Ill-formed function expression",
+ Fn . for each X in Args collect MkQuote X);
+
+lisp procedure Eval U; %. Interpret S-Expression as program
+ if not PairP U then
+ if not IDP U then U else ValueCell U
+ else begin scalar Fn;
+ Fn := car U;
+ return if IDP Fn then
+ if FUnBoundP Fn then
+ ContinuableError(1300,
+ BldMsg("%r is an undefined function", Fn),
+ U)
+ else begin scalar FnType, StackMarkForBacktrace, Result;
+ FnType := GetFnType Fn;
+ StackMarkForBacktrace := MkBTR Inf Fn;
+ Result := if null FnType then % must be an EXPR
+ if FCodeP Fn then
+ CodeEvalApply(GetFCodePointer Fn, cdr U)
+ else LambdaEvalApply(get(Fn, '!*LambdaLink),
+ cdr U)
+ else if FnType = 'FEXPR then
+ IDApply1(cdr U, Fn)
+ else if FnType = 'NEXPR then
+ IDApply1(EvLis cdr U, Fn)
+ else if FnType = 'MACRO then
+ Eval IDApply1(U, Fn)
+ else
+ ContinuableError(1301,
+ BldMsg("Unknown function type %r",
+ FnType),
+ U);
+ return Result;
+ end
+ else if CodeP Fn then CodeEvalApply(Fn, cdr U)
+ else if PairP Fn and car Fn = 'LAMBDA then
+ LambdaEvalApply(Fn, cdr U)
+ else ContinuableError(1302,
+ BldMsg("Ill-formed expression in Eval %r", U),
+ U);
+ end;
+
+END;
ADDED psl-1983/3-1/kernel/eval-when.red
Index: psl-1983/3-1/kernel/eval-when.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/eval-when.red
@@ -0,0 +1,41 @@
+%
+% EVAL-WHEN.RED - Funny business to make things happen at different times
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 30 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Functions flagged IGNORE are evaluated immediately when invoked at the top
+% level while compiling to a file. Those flagged EVAL are evaled immediately
+% and also passed to the file. These functions are defined to make those
+% actions more visible and mnemonic.
+
+macro procedure CommentOutCode U; %. Comment out a single expression
+ NIL;
+
+lisp procedure CompileTime U; %. Evaluate at compile time only
+ U; % just return the already evaluated argument
+
+flag('(CommentOutCode CompileTime), 'IGNORE);
+
+% The functions above need only be present at compile time. Those below must
+% be present at both compile and load time to be effective.
+
+lisp procedure BothTimes U; %. Evaluate at compile and load time
+ U;
+
+flag('(BothTimes), 'EVAL);
+
+lisp procedure LoadTime U; %. Evaluate at load time only
+ U;
+
+PutD('StartupTime, 'EXPR, cdr GetD 'LoadTime);
+ % StartupTime is kernel hack
+RemFlag('(LoadTime), 'IGNORE); % just to be sure it doesn't
+RemFlag('(LoadTime), 'EVAL); % happen until load time
+
+END;
ADDED psl-1983/3-1/kernel/eval.build
Index: psl-1983/3-1/kernel/eval.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/eval.build
@@ -0,0 +1,15 @@
+%
+% EVAL.BUILD - Files with Eval and Apply in the interpreter
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "apply-lap.red"$ % low-level function linkage, in LAP
+PathIn "eval-apply.red"$ % interpreter functions
+PathIn "catch-throw.red"$ % non-local GOTO mechanism
+PathIn "prog-and-friends.red"$ % Prog, Go and Return
ADDED psl-1983/3-1/kernel/explode-compress.red
Index: psl-1983/3-1/kernel/explode-compress.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/explode-compress.red
@@ -0,0 +1,94 @@
+%
+% EXPLODE-COMPRESS.RED - Write to/read from a list; includes FlatSize
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 24 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>EXPLODE-COMPRESS.RED.3, 12-Oct-82 16:49:54, Edit by BENSON
+% Changed CompressReadChar to use Lisp2Char, so ASCII characters are OK,
+% but digits 0..9 as !0..!9 are not.
+
+fluid '(ExplodeEndPointer!* % pointer used to RplacD new chars onto
+ CompressList!* % list being compressed
+ !*Compressing); % if T, don't intern IDs when read
+
+external WArray LinePosition,UnReadBuffer;
+
+on SysLisp;
+
+syslsp procedure ExplodeWriteChar(Channel, Ch);
+<< RplacD(LispVar ExplodeEndPointer!*, list MkID Ch);
+ LispVar ExplodeEndPointer!* := cdr LispVar ExplodeEndPointer!* >>;
+
+syslsp procedure Explode U; %. S-expr --> char-list
+begin scalar Result;
+ Result := LispVar ExplodeEndPointer!* := NIL . NIL;
+ LinePosition[3] := 0;
+ ChannelPrin1('3, U);
+ return cdr Result;
+end;
+
+syslsp procedure Explode2 U; %. Prin2 version of Explode
+begin scalar Result;
+ Result := LispVar ExplodeEndPointer!* := NIL . NIL;
+ LinePosition[3] := 0;
+ ChannelPrin2('3, U);
+ return cdr Result;
+end;
+
+internal WVar FlatSizeAccumulator;
+
+syslsp procedure FlatSizeWriteChar(Channel, Ch);
+ FlatSizeAccumulator := FlatSizeAccumulator + 1;
+
+syslsp procedure FlatSize U; %. character length of S-expression
+<< FlatSizeAccumulator := 0;
+ LinePosition[4] := 0;
+ ChannelPrin1('4, U);
+ MkINT FlatSizeAccumulator >>;
+
+lisp procedure FlatSize2 U; %. Prin2 version of FlatSize
+<< FlatSizeAccumulator := 0;
+ LinePosition[4] := 0;
+ ChannelPrin2('4, U);
+ MkINT FlatSizeAccumulator >>;
+
+internal WVar AtEndOfList;
+
+syslsp procedure CompressReadChar Channel;
+begin scalar NextEntry;
+ if AtEndOfList then return CompressError();
+ if not PairP LispVar CompressList!* then
+ << AtEndOfList := 'T;
+ return char BLANK >>;
+ NextEntry := car LispVar CompressList!*;
+ LispVar CompressList!* := cdr LispVar CompressList!*;
+ return Lisp2Char NextEntry;
+end;
+
+syslsp procedure ClearCompressChannel();
+<< UnReadBuffer[3] := char NULL;
+ AtEndOfList := 'NIL >>;
+
+off SysLisp;
+
+lisp procedure CompressError();
+ StdError "Poorly formed S-expression in COMPRESS";
+
+lisp procedure Compress CompressList!*; %. Char-list --> S-expr
+begin scalar !*Compressing;
+ !*Compressing := T;
+ ClearCompressChannel();
+ return ChannelRead 3;
+end;
+
+lisp procedure Implode CompressList!*; %. Compress with IDs interned
+<< ClearCompressChannel();
+ ChannelRead 3 >>;
+
+END;
ADDED psl-1983/3-1/kernel/extra.build
Index: psl-1983/3-1/kernel/extra.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/extra.build
@@ -0,0 +1,15 @@
+%
+% EXTRA.BUILD - System-dependent extras
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "timc.red"$ % System time routine
+PathIn "system-extras.red"$ % Random system-specific routines
+PathIn "trap.red"$ % Interrupt handler
+PathIn "dumplisp.red"$ % Core saver
ADDED psl-1983/3-1/kernel/fasl-include.red
Index: psl-1983/3-1/kernel/fasl-include.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/fasl-include.red
@@ -0,0 +1,47 @@
+%
+% FASL-INCLUDE.RED - data declarations for FASL at compile time
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 20 February 1982
+% Copyright (c) 1982 Eric Benson
+%
+
+on SysLisp;
+
+CompileTime <<
+
+DefConst(FASL_MAGIC_NUMBER, 99);
+
+DefConst(RELOC_ID_NUMBER, 1,
+ RELOC_VALUE_CELL, 2,
+ RELOC_FUNCTION_CELL, 3);
+
+DefConst(RELOC_WORD, 1,
+ RELOC_HALFWORD, 2,
+ RELOC_INF, 3);
+
+smacro procedure RelocRightHalfTag X;
+ Field(X, BitsPerWord/2, 2);
+
+smacro procedure RelocRightHalfInf X;
+ Field(X, BitsPerWord/2+2, BitsPerWord/2-2);
+
+smacro procedure RelocInfTag X;
+ Field(X, InfStartingBit, 2);
+
+smacro procedure RelocInfInf X;
+ Field(X, InfStartingBit+2, InfBitLength-2);
+
+smacro procedure RelocWordTag X;
+ Field(X, 0, 2);
+
+smacro procedure RelocWordInf X;
+ Field(X, 2, BitsPerWord-2);
+
+>>;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/fasl.build
Index: psl-1983/3-1/kernel/fasl.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/fasl.build
@@ -0,0 +1,16 @@
+%
+% FASL.BUILD - Files used for Fasl in the interpreter
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "system-faslout.red"$
+PathIn "system-faslin.red"$
+PathIn "faslin.red"$
+PathIn "load.red"$ % Standard module FASL loader
+PathIn "autoload.red"$ % stubs to load modules
ADDED psl-1983/3-1/kernel/faslin.red
Index: psl-1983/3-1/kernel/faslin.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/faslin.red
@@ -0,0 +1,142 @@
+on SysLisp;
+
+external WString TokenBuffer;
+external WArray ArgumentBlock;
+
+internal WConst CODE_OFFSET = 0,
+ RELOC_ID_NUMBER = 1,
+ RELOC_VALUE_CELL = 2,
+ RELOC_FUNCTION_CELL = 3;
+
+internal WConst RELOC_WORD = 1,
+ RELOC_RIGHT_HALF = 2,
+ RELOC_INF = 3;
+
+internal WConst FASLMAGIC = 99;
+
+CompileTime <<
+
+smacro procedure LocalIDNumberP U;
+ U >= 2048;
+
+smacro procedure LocalToGlobalID U;
+ IDTable[U - 2048];
+
+smacro procedure ExtraArgumentP U;
+ U >= 8150; % Something enough less than 8192
+
+smacro procedure MakeExtraArgument U;
+ U - (8150 + (MaxRealRegs + 1));
+>>;
+
+internal WVar CodeBase;
+
+syslsp procedure FaslIN File;
+begin scalar F, N, M, IDTable, CodeSize, OldCodeBase,
+ E, BT, R, RT, RI, BI, Top, BTop;
+ F := BinaryOpenRead File;
+ N := BinaryRead F; % First word is magic number
+ if N neq FASLMAGIC then ContError(99,
+ "%r is not a fasl format file",
+ File,
+ FaslIN File);
+ M := BinaryRead F; % Number of local IDs
+ Top := GtWArray 0; % pointer to top of space
+ IDTable := GtWArray(M + 1); % Allocate space for table
+ for I := 0 step 1 until M do
+ << TokenBuffer[0] := BinaryRead F; % word is length of ID name
+ BinaryReadBlock(F, &TokenBuffer[1], StrPack TokenBuffer[0]);
+ IDTable[I] := IDInf Intern MkSTR TokenBuffer >>;
+ CodeSize := BinaryRead F; % Size of code segment in words
+ OldCodeBase := CodeBase; % So FASLIN is reentrant
+ CodeBase := GtBPS CodeSize; % Allocate space in BPS
+ BTop := GTBPS 0; % pointer to top
+ E := CodeBase + BinaryRead F; % Next word is offset of init function
+ % Will be called after code is read
+ BinaryReadBlock(F, CodeBase, CodeSize); % Put the next N words there
+ N := BinaryRead F; % Next word is size of bit table in words
+ BT := GtWArray N; % Allocate space for bit table
+ BinaryReadBlock(F, BT, N); % read bit table
+ BinaryClose F; % close the file
+ CodeSize := CodeSize*AddressingUnitsPerItem - 1;
+ for I := 0 step 1 until CodeSize do
+ << R := BitTable(BT, I);
+ BI := CodeBase + I;
+ case R of
+ RELOC_WORD:
+ << RT := RelocWordTag @BI;
+ RI := RelocWordInf @BI;
+ case RT of
+ CODE_OFFSET:
+ @BI := CodeBase + RI;
+ RELOC_VALUE_CELL:
+ << if ExtraArgumentP RI then
+ RI := &ArgumentBlock[MakeExtraArgument RI]
+ else if LocalIDNumberP RI then
+ RI := &SymVal LocalToGlobalID RI
+ else RI := &SymVal RI;
+ @BI := RI >>;
+ RELOC_FUNCTION_CELL:
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ @BI :=
+ SymFnc + AddressingUnitsPerFunctionCell*RI >>;
+ RELOC_ID_NUMBER: % Must be a local ID number
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ @BI := RI >>;
+ end >>;
+ RELOC_RIGHT_HALF:
+ << RT := RelocRightHalfTag @BI;
+ RI := RelocRightHalfInf @BI;
+ case RT of
+ CODE_OFFSET:
+ RightHalf @BI := CodeBase + RI;
+ RELOC_VALUE_CELL:
+ << if ExtraArgumentP RI then
+ RI := &ArgumentBlock[MakeExtraArgument RI]
+ else if LocalIDNumberP RI then
+ RI := &SymVal LocalToGlobalID RI
+ else RI := &SymVal RI;
+ RightHalf @BI := RI >>;
+ RELOC_FUNCTION_CELL:
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ RightHalf @BI :=
+ SymFnc + AddressingUnitsPerFunctionCell*RI >>;
+ RELOC_ID_NUMBER: % Must be a local ID number
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ RightHalf @BI := RI >>;
+ end >>;
+ RELOC_INF:
+ << RT := RelocInfTag @BI;
+ RI := RelocInfInf @BI;
+ case RT of
+ CODE_OFFSET:
+ Inf @BI := CodeBase + RI;
+ RELOC_VALUE_CELL:
+ << if ExtraArgumentP RI then
+ RI := &ArgumentBlock[MakeExtraArgument RI]
+ else if LocalIDNumberP RI then
+ RI := &SymVal LocalToGlobalID RI
+ else RI := &SymVal RI;
+ Inf @BI := RI >>;
+ RELOC_FUNCTION_CELL:
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ Inf @BI :=
+ SymFnc + AddressingUnitsPerFunctionCell*RI >>;
+ RELOC_ID_NUMBER: % Must be a local ID number
+ << if LocalIDNumberP RI then RI := LocalToGlobalID RI;
+ Inf @BI := RI >>;
+ end >>;
+ end >>;
+ DelWArray(BT, Top);
+ % return the space used by tables
+ AddressApply0 E; % Call the init routine
+ CodeBase := OldCodeBase; % restore previous value for CodeBase
+ DelBPS(E, BTop); % deallocate space of init routine
+end;
+
+syslsp procedure PutEntry(Name, Type, Offset);
+ PutD(Name, Type, MkCODE(CodeBase + Offset));
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/fast-binder.red
Index: psl-1983/3-1/kernel/fast-binder.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/fast-binder.red
@@ -0,0 +1,40 @@
+%
+% P-FAST-BINDER.RED - Portable version of binding from compiled code
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 6 August 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% This file is for use with *LAMBIND and *PROGBIND in P-LAMBIND
+
+StartupTime <<
+
+LambindArgs!* := GtWArray 15;
+
+>>;
+
+on Syslisp;
+
+syslsp procedure LamBind V; % V is vector of IDs
+begin scalar N;
+ V := VecInf V;
+ N := VecLen V;
+ for I := 0 step 1 until N do
+ LBind1(VecItm(V, I), (LispVar LambindArgs!*)[I]);
+end;
+
+syslsp procedure ProgBind V;
+begin scalar N;
+ V := VecInf V;
+ N := VecLen V;
+ for I := 0 step 1 until N do
+ PBind1 VecItm(V, I);
+end;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/fluid-global.red
Index: psl-1983/3-1/kernel/fluid-global.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/fluid-global.red
@@ -0,0 +1,67 @@
+%
+% FLUID-GLOBAL.RED - Fluid and Global declarations
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>FLUID-GLOBAL.RED.3, 10-Sep-82 09:18:04, Edit by BENSON
+% Uses indicator VARTYPE instead of TYPE
+
+% <PSL.INTERP>FLUID-GLOBAL.RED.3, 22-Jan-82 12:35:25, Edit by BENSON
+% GlobalP now only checks for variables, not functions
+
+% The functions dealing with FLUID and GLOBAL declarations use the property
+% list indicator TYPE, which is also used by PUTD and GETD.
+% Not true anymore!
+
+% Non-Standard Lisp functions used:
+% ErrorPrintF -- in IO.RED
+
+CompileTime flag('(DeclareFluidOrGlobal DeclareFluidOrGlobal1),
+ 'InternalFunction);
+
+lisp procedure DeclareFluidOrGlobal(IDList, FG);
+ for each U in IDList do DeclareFluidOrGlobal1(U, FG);
+
+lisp procedure DeclareFluidOrGlobal1(U, FG);
+ if not IDP U then NIL else
+ begin scalar X;
+ X := get(U, 'VARTYPE);
+ return if null X then
+ << put(U, 'VARTYPE, FG);
+ if UnBoundP U then Set(U, NIL) >>
+ else if X eq FG then NIL
+ else ErrorPrintF("*** %p %r cannot become %p",
+ X, U, FG);
+ end;
+
+lisp procedure Fluid IDList; %. Declare all in IDList as fluid vars
+ DeclareFluidOrGlobal(IDList, 'FLUID);
+
+lisp procedure Fluid1 U; %. Declare U fluid
+ DeclareFluidOrGlobal1(U, 'FLUID);
+
+lisp procedure FluidP U; %. Is U a fluid variable?
+ get(U, 'VARTYPE) = 'FLUID;
+
+lisp procedure Global IDList; %. Declare all in IDList as global vars
+ DeclareFluidOrGlobal(IDList, 'GLOBAL);
+
+lisp procedure Global1 U; %. Declare U global
+ DeclareFluidOrGlobal1(U, 'GLOBAL);
+
+lisp procedure GlobalP U; %. Is U a global variable
+ get(U, 'VARTYPE) = 'GLOBAL;
+
+lisp procedure UnFluid IDList; %. Undeclare all in IDList as fluid
+ for each U in IDList do UnFluid1 U;
+
+lisp procedure UnFluid1 U;
+ if FluidP U then RemProp(U, 'VARTYPE);
+
+END;
ADDED psl-1983/3-1/kernel/io-errors.red
Index: psl-1983/3-1/kernel/io-errors.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/io-errors.red
@@ -0,0 +1,34 @@
+%
+% IO-ERRORS.RED - Error handlers for input and output
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+on SysLisp;
+
+syslsp procedure ChannelNotOpen(Chn, Ch);
+ ChannelError(Chn, "Channel not open");
+
+syslsp procedure WriteOnlyChannel Chn;
+ ChannelError(Chn, "Channel open for write only");
+
+syslsp procedure ReadOnlyChannel(Chn, Ch);
+ ChannelError(Chn, "Channel open for read only");
+
+syslsp procedure IllegalStandardChannelClose Chn;
+ ChannelError(Chn, "Illegal to close standard channel");
+
+syslsp procedure IOError(Message);
+ StdError BldMsg("I/O Error: %s", Message);
+
+syslsp procedure ChannelError(Channel, Message);
+ StdError BldMsg("I/O Error on channel %d: %s", IntInf Channel, Message);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/io-extensions.red
Index: psl-1983/3-1/kernel/io-extensions.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/io-extensions.red
@@ -0,0 +1,30 @@
+%
+% IO-EXTENSIONS.RED - Random, possibly useful functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 22 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+on SysLisp;
+
+syslsp procedure ChannelTYI Chn; %. Read one char ASCII value
+ MkINT ChannelReadChar Chn;
+
+syslsp procedure ChannelTYO(Chn, Ch); %. Write one char ASCII value
+ ChannelWriteChar(Chn, Lisp2Char Ch);
+
+off SysLisp;
+
+global '(IN!* OUT!*);
+
+lisp procedure TYI(); %. Read ASCII value from curent input
+ ChannelTYI IN!*;
+
+lisp procedure TYO Ch; %. Write ASCII value to current output
+ ChannelTYO(OUT!*, Ch);
+
+END;
ADDED psl-1983/3-1/kernel/io.build
Index: psl-1983/3-1/kernel/io.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/io.build
@@ -0,0 +1,23 @@
+%
+% IO.BUILD - System-independent input and output files
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "io-data.red"$ % Data structures used by IO
+PathIn "char-io.red"$ % bottom level IO primitives
+PathIn "open-close.red"$ % file primitives
+PathIn "rds-wrs.red"$ % IO channel switching functions
+PathIn "other-io.red"$ % random SL IO functions
+PathIn "read.red"$ % S-expression parser
+PathIn "token-scanner.red"$ % table-driven token scanner
+PathIn "printers.red"$ % Printing functions
+PathIn "write-float.red"$ % Floating point printer
+PathIn "printf.red"$ % formatted print routines
+PathIn "explode-compress.red"$ % Access to characters of atoms
+PathIn "io-extensions.red"$ % Random non-SL IO functions
ADDED psl-1983/3-1/kernel/known-to-comp-sl.red
Index: psl-1983/3-1/kernel/known-to-comp-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/known-to-comp-sl.red
@@ -0,0 +1,65 @@
+%
+% KNOWN-TO-COMPILER.RED - Standard Lisp functions which are handled entirely
+% by the compiler
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>KNOWN-TO-COMP-SL.RED.4, 4-Jul-82 13:30:59, Edit by BENSON
+% CAR and CDR of NIL are legal == NIL
+
+off R2I; % can't do recursion removal, will get infinte recursion
+
+% Section 3.1 -- Elementary predicates
+
+lisp procedure CodeP U; %. Is U a code pointer?
+ CodeP U;
+
+lisp procedure Eq(U, V); %. Are U and V identical?
+ U eq V;
+
+lisp procedure FloatP U; %. Is U a floating point number?
+ FloatP U;
+
+lisp procedure BigP U; %. Is U a bignum?
+ BigP U;
+
+lisp procedure IDP U; %. Is U an ID?
+ IDP U;
+
+lisp procedure PairP U; %. Is U a pair?
+ PairP U;
+
+lisp procedure StringP U; %. Is U a string?
+ StringP U;
+
+lisp procedure VectorP U; %. Is U a vector?
+ VectorP U;
+
+
+% Section 3.2 -- Functions on Dotted-Pairs
+
+% NonPairError found in TYPE-ERRORS.RED
+
+lisp procedure Car U; %. left subtree of pair
+ if null U then NIL
+ else if PairP U then car U else NonPairError(U, 'CAR);
+
+lisp procedure Cdr U; %. right subtree of pair
+ if null U then NIL
+ else if PairP U then cdr U else NonPairError(U, 'CDR);
+
+lisp procedure RplacA(U, V); %. RePLAce CAr of pair
+ if PairP U then RplacA(U, V) else NonPairError(U, 'RPLACA);
+
+lisp procedure RplacD(U, V); %. RePLACe CDr of pair
+ if PairP U then RplacD(U, V) else NonPairError(U, 'RPLACD);
+
+on R2I; % Turn recursion removal back on
+
+END;
ADDED psl-1983/3-1/kernel/lisp-macros.red
Index: psl-1983/3-1/kernel/lisp-macros.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/lisp-macros.red
@@ -0,0 +1,70 @@
+%
+% LISP-MACROS.RED - Various macros to make pure Lisp more tolerable
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>LISP-MACROS.RED.4, 22-Jul-82 10:51:11, Edit by BENSON
+% Added CASE, removed IF
+% still to come: Do, Let
+% <PSL.INTERP>LISP-MACROS.RED.5, 28-Dec-81 14:43:39, Edit by BENSON
+% Added SetF
+
+CompileTime flag('(InThisCase), 'InternalFunction);
+
+% Not a macro, but it belongs with these
+
+SYMBOLIC FEXPR PROCEDURE CASE U;
+%U is of form (CASE <integer exp> (<case-1> <exp-1>) . . .(<case-n> <exp-n>)).
+% If <case-i> is NIL it is default,
+% else is list of INT or (RANGE int int)
+ BEGIN SCALAR CaseExpr,DEF,CaseLst,BOD;
+ CaseExpr:=EVAL CAR U;
+ L: IF NOT PAIRP(U:=CDR U) THEN RETURN EVAL DEF;
+ CaseLst:=CAAR U; BOD:=CADAR U;
+ IF NOT PAIRP CaseLst
+ OR CAR CaseLst MEMQ '(OTHERWISE DEFAULT) THEN
+ <<DEF:=BOD; GOTO L>>;
+ IF InThisCase(CaseExpr,CaseLst) THEN RETURN EVAL BOD;
+ GOTO L
+ END;
+
+SYMBOLIC PROCEDURE InThisCase(CaseExpr,Cases);
+ IF NOT PAIRP Cases Then NIL
+ ELSE IF PAIRP Car Cases and Caar Cases EQ 'RANGE
+ and CaseExpr>=Cadar Cases and CaseExpr<=Caddar Cases then T
+ ELSE IF CaseExpr = Car Cases then T
+ ELSE InThisCase(CaseExpr,Cdr Cases);
+
+
+macro procedure SetF U; %. General assignment macro
+ ExpandSetF(cadr U, caddr U);
+
+lisp procedure ExpandSetF(LHS, RHS);
+begin scalar LHSOp;
+ return if atom LHS then list('setq, LHS, RHS)
+ else if (LHSOp := get(car LHS, 'Assign!-Op)) then
+ LHSOp . Append(cdr LHS, list RHS) % simple substitution case
+ else if (LHSOp := get(car LHS, 'SetF!-Expand)) then
+ Apply(LHSOp, list(LHS, RHS)) % more complex transformation
+ else if (LHSOp := GetD car LHS) and car LHSOp = 'MACRO then
+ ExpandSetF(Apply(cdr LHSOp, list LHS), RHS)
+ else StdError BldMsg("%r is not a known form for assignment",
+ list('SetF, LHS, RHS));
+end;
+
+LoadTime DefList('((GetV PutV)
+ (car RplacA)
+ (cdr RplacD)
+ (Indx SetIndx)
+ (Sub SetSub)
+ (Nth (lambda (L I X) (rplaca (PNTH L I) X) X))
+ (Eval Set)
+ (Value Set)), 'Assign!-Op);
+
+END;
ADDED psl-1983/3-1/kernel/load.red
Index: psl-1983/3-1/kernel/load.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/load.red
@@ -0,0 +1,119 @@
+%
+% LOAD.RED - New version of LOAD function, with search path
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 2 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.KERNEL>LOAD.RED.17, 23-Mar-83 11:44:39, Edit by KESSLER
+% Change Apollo Load directory
+% Edit by Cris Perdue, 21 Mar 1983 1440-PST
+% Put "" back in loaddirectories*. Fun, huh?
+% Edit by Cris Perdue, 7 Mar 1983 1527-PST
+% Removed ".sl" from loadextensions* and "" from loaddirectories*.
+% Edit by MLG, 6 March 1983.
+% Corrected bug in fix to Imports -- "else" was matched with incorrect "then".
+% Edit by Cris Perdue, 17 Feb 1983 1201-PST
+% Corrected use of *verboseload in top of load1
+% MLG, 15 Feb 1983
+% Added !*VERBOSELOAD and !*PRINTLOADNAMES
+% M. Griss, 9 Feb 1983
+% Changed LoadDirectories!* for the VAX to refer to "$pl/"
+% <PSL.NEW>-SOURCE-CHANGES.LOG.15, 15-Dec-82 15:45:55, Edit by PERDUE
+% LOAD will now handle ".sl" extension
+% <PSL.KERNEL>LOAD.RED.7, 1-Dec-82 16:07:38, Edit by BENSON
+% Added if_system(HP9836, ...)
+% EDIT by GRISS 28 Oct 1982: Added EvLoad to Imports
+% <PSL.KERNEL>LOAD.RED.4, 4-Oct-82 09:46:54, Edit by BENSON
+% Moved addition of U to Options!* to avoid double load
+% <PSL.KERNEL>LOAD.RED.3, 30-Sep-82 11:57:03, Edit by BENSON
+% Removed "FOO already loaded" message
+% <PSL.KERNEL>LOAD.RED.2, 22-Sep-82 15:38:48, Edit by BENSON
+% Added ReLoad, changed VAX search path
+
+fluid '(LoadDirectories!* % list of strings to append to front
+ LoadExtensions!* % a-list of (str . fn) to append to end
+ % and apply
+ PendingLoads!* % created by Imports, aux loads
+ !*Lower % print IDs in lowercase, for building
+ % filename for Unix
+ !*RedefMSG % controls printing of redefined
+ % function message
+ !*UserMode % Controls query of user for redefining
+ % system functions
+ !*InsideLoad % Controls "already loaded" message
+ !*VerboseLoad % Print REDEFs and LOAD file names
+ !*PrintLoadNames % Print Names of files loading
+ Options!*); % list of modules already loaded
+
+if_system(Apollo,
+ LoadDirectories!* := '("" "~p/l/"));
+if_system(Tops20,
+ LoadDirectories!* := '("" "pl:"));
+if_system(Unix,
+ LoadDirectories!* := '("" "$pll/" "$pl/"));
+if_system(HP9836,
+ LoadDirectories!* := '("" "pl:"));
+if_system(Wicat,
+ LoadDirectories!* := '("" "PSL.LAP/"));
+
+LoadExtensions!* := '((".b" . FaslIN) (".lap" . LapIN));
+!*VerboseLoad :=NIL;
+!*PrintLoadNames := NIL;
+
+macro procedure Load U;
+ list('EvLoad, MkQuote cdr U);
+
+lisp procedure EvLoad U;
+ for each X in U do Load1 X;
+
+macro procedure ReLoad U;
+ list('EvReLoad, MkQuote cdr U);
+
+lisp procedure EvReLoad U;
+<< for each X in U do Options!* := Delete(X, Options!*);
+ EvLoad U >>;
+
+lisp procedure Load1 U;
+begin scalar !*RedefMSG, !*UserMode, LD, LE, F, Found;
+ If !*VerBoseLoad then !*RedefMSG := T;
+ return if U memq Options!* then
+ if !*VerboseLoad then
+ ErrorPrintF("*** %w already loaded", U)
+ else NIL
+ else
+(lambda(!*InsideLoad);
+<< LD := LoadDirectories!*;
+ (lambda (!*Lower);
+ while not null LD and not Found do
+ << LE := LoadExtensions!*;
+ while not null LE and not Found do
+ << if FileP(F := BldMsg("%w%w%w", first LD, U, car first LE)) then
+ Found := cdr first LE; % Found is function to apply
+ LE := rest LE >>;
+ LD := rest LD >>)(T);
+ if not Found then
+ StdError BldMsg("%r load module not found", U)
+ else
+ << Options!* := U . Options!*;
+ If !*VerboseLoad or !*PrintLoadNames
+ then ErrorPrintf("*** loading %w%n",F);
+ Apply(Found, list F);
+ while not null PendingLoads!* do
+ << Found := car PendingLoads!*;
+ PendingLoads!* := cdr PendingLoads!*;
+ Load1 Found >> >> >>)(T);
+end;
+
+lisp procedure Imports L;
+ if !*InsideLoad then
+ <<for each X in L do
+ if not (X memq Options!* or X memq PendingLoads!*) then
+ PendingLoads!* := Append(PendingLoads!*, list X)>>
+ else EvLoad L;
+
+END;
ADDED psl-1983/3-1/kernel/loop-macros.red
Index: psl-1983/3-1/kernel/loop-macros.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/loop-macros.red
@@ -0,0 +1,121 @@
+%
+% LOOP-MACROS.RED - Various macros to make pure Lisp more tolerable
+%
+% Author: Eric Benson and M. Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by MLG,9:35am Tuesday, 29 December 1981
+% Add EXIT, NEXT, REPEAT, add 'Join, improve FOR
+
+macro procedure ForEach U; %. Macro for MAP functions
+%
+% From RLISP
+%
+% Possible forms are:
+% (foreach x in u do (foo x)) --> (mapc u (function (lambda (x) (foo x))))
+% (foreach x in u collect (foo x)) --> (mapcar u ...)
+% (foreach x in u conc (foo x)) --> (mapcan u ...)
+% (foreach x in u join (foo x)) --> (mapcan u ...)
+% (foreach x on u do (foo x)) --> (map u ...)
+% (foreach x on u collect (foo u)) --> (maplist u ...)
+% (foreach x on u conc (foo x)) --> (mapcon u ...)
+% (foreach x on u join (foo x)) --> (mapcon u ...)
+%
+begin scalar Action, Body, Fn, Lst, Mod, Var;
+ Var := cadr U;
+ U := cddr U;
+ Mod := car U;
+ U := cdr U;
+ Lst := car U;
+ U := cdr U;
+ Action := car U;
+ Body := cdr U;
+ Fn := if Action eq 'DO then
+ if Mod eq 'IN then 'MAPC else 'MAP
+ else if Action eq 'CONC or Action eq 'JOIN then
+ if Mod eq 'IN then 'MAPCAN else 'MAPCON
+ else if Action eq 'COLLECT then
+ if Mod eq 'IN then 'MAPCAR else 'MAPLIST
+ else StdError BldMsg("%r is an illegal action in ForEach", Action);
+ return list(Fn, Lst,
+ list('FUNCTION, 'LAMBDA . list Var . Body))
+end;
+
+macro procedure Exit U; %. To leave current Iteration
+ if null cdr U then
+ '(return NIL)
+ else if cddr U then
+ list('return, 'progn . cdr U)
+ else
+ 'return . cdr U;
+
+macro procedure Next U; %. Continue Loop
+ '(go !$Loop!$); % no named DO's yet (no DO at all)
+
+macro procedure While U; %. Iteration macro
+%
+% From RLISP
+%
+% Form is (while bool exp1 ... expN)
+%
+ 'prog . '()
+ . '!$Loop!$
+ . list('Cond, list(list('not, cadr U),
+ '(return NIL)))
+ . Append(cddr U, '((go !$Loop!$)));
+
+macro procedure Repeat U;
+%
+% From RLISP
+% Form is (repeat exp1 ... expN bool)
+% Repeat until bool is true, similar to Pascal, etc.
+%
+ 'prog . '() .
+ '!$Loop!$.
+ for each X on cdr U collect
+ if null cdr X then
+ list('Cond, list(list('not, car X),'(go !$Loop!$)))
+ else car X;
+
+MACRO PROCEDURE FOR U;
+%
+% From RLISP
+%
+% Form is (FOR (FROM var init final step) (key form))
+%/ Limited right now to key=DO
+ BEGIN SCALAR ACTION,BODY,EXP,INCR,RESULT,TAIL,VAR,X;
+ VAR := second second U;
+ INCR := cddr second U; %(init final step)
+ ACTION := first third U;
+ BODY := second third U;
+ RESULT := LIST LIST('SETQ,VAR,CAR INCR);
+ INCR := CDR INCR;
+ X := LIST('DIFFERENCE,first INCR,VAR);
+ IF second INCR NEQ 1 THEN X := LIST('TIMES,second INCR,X);
+ TAIL :='(RETURN NIL);
+ IF NOT ACTION EQ 'DO
+ THEN <<ACTION := GET(ACTION,'BIN);
+ EXP := GENSYM();
+ BODY := LIST('SETQ,EXP,
+ LIST(CAR ACTION,LIST('SIMP,BODY),EXP));
+ RESULT := LIST('SETQ,EXP,MKQUOTE CDR ACTION) . RESULT;
+ TAIL := LIST('RETURN, LIST('MK!*SQ,EXP));
+ EXP := LIST EXP>>;
+ RETURN ('PROG .
+ (VAR . EXP) .
+ NCONC(RESULT,
+ '!$LOOP!$ .
+ LIST('COND,LIST(LIST('MINUSP,X), TAIL)) .
+ BODY .
+ LIST('SETQ,VAR,LIST('PLUS2,VAR,second INCR)) .
+ '((GO !$LOOP!$))
+ ));
+ END;
+
+
+END;
ADDED psl-1983/3-1/kernel/macro.build
Index: psl-1983/3-1/kernel/macro.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/macro.build
@@ -0,0 +1,22 @@
+%
+% MACRO.BUILD - Files of macros defined in the interpreter
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.KERNEL>MACRO.BUILD.2, 2-Feb-83 15:36:40, Edit by PERDUE
+% Removed char.red. It is now pnk:char-macro.red
+
+PathIn "eval-when.red"$ % control evaluation time
+PathIn "cont-error.red"$ % macro for ContinuableError
+PathIn "lisp-macros.red"$ % Various macros for readability
+PathIn "onoff.red"$ % (on xxx yyy) and (off xxx yyy)
+PathIn "define-smacro.red"$
+PathIn "defconst.red"$
+PathIn "string-gensym.red"$
+PathIn "loop-macros.red"$ % Various macros for readability
ADDED psl-1983/3-1/kernel/main.build
Index: psl-1983/3-1/kernel/main.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/main.build
@@ -0,0 +1,12 @@
+%
+% MAIN.BUILD - Definition of entry point routine and symbol table init
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "main-start.red"$
ADDED psl-1983/3-1/kernel/mini-editor.red
Index: psl-1983/3-1/kernel/mini-editor.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/mini-editor.red
@@ -0,0 +1,148 @@
+% <PSL.KERNEL>MINI-EDITOR.RED.3, 21-Sep-82 11:14:10, Edit by BENSON
+% Flagged internal functions
+
+%. PSL Structure Editor Module;
+%. Adapted By D. Morrison for PSL V1.
+%. Based on Nordstroms trimmed InterLISP editor
+%. Cleaned Up and commented by M. L. Griss,
+%. 8:57pm Monday, 2 November 1981
+
+%. See PH:Editor.Hlp for guide
+
+CompileTime flag('(EDIT0 QEDNTH EDCOPY RPLACEALL FINDFIRST XCHANGE XINS),
+ 'InternalFunction);
+
+FLUID '(QEDITFNS %. Keep track of which changed
+ !*EXPERT %. Do not print "help" if NIL
+ !*VERBOSE %. Dont do implicit "P" if NIL
+ PROMPTSTRING!* %. For "nicer" interface
+ EditorReader!* %. Use RLISP etc Syntax, ala Break
+ EditorPrinter!*
+ CL
+);
+
+QEDITFNS:=NIL;
+!*Expert := NIL;
+!*Verbose := NIL;
+
+lisp procedure EDITF(FN); %. Edit a Copy of Function Body
+Begin scalar BRFL,X,SAVE,TRFL;
+ %/ Capture !*BREAK, reset to NIL?
+ X := GETD FN;
+ If ATOM X OR CODEP CDR X then
+ StdError BldMsg("%r is not an editable function", Fn);
+ SAVE:=COPY CDR X;
+ EDIT CDR X;
+ If YESP "Change Definition?" then GO TO YES;
+ RPLACW(CDR X,SAVE); %/ Why not Just PUTD again?
+ RETURN NIL;
+YES: If NULL (FN MEMBER QEDITFNS) then
+ QEDITFNS:=FN.QEDITFNS;
+ RETURN FN;
+ END;
+
+lisp procedure EDIT S; %. Edit a Structure, S
+begin scalar PROMPTSTRING!*;
+ PROMPTSTRING!* := "edit> ";
+ TERPRI();
+ If NOT !*EXPERT then
+ PRIN2T "Type HELP<CR> for a list of commands.";
+ %/ Savea copy for UNDO?
+ RETURN EDIT0(S,EDITORREADER!* OR 'READ,EDITORPRINTER!* OR 'PRINT)
+END;
+
+lisp procedure EDIT0(S,READER,PRINTER);
+ Begin scalar CL,CTLS,CTL,PLEVEL,TOP,TEMP,X,NNN;
+ TOP:=LIST S;
+ PLEVEL:=3;
+B: CTL:=TOP; CTLS:=LIST CTL; CL:=CAR TOP;
+NEXT: If !*VERBOSE then APPLY(PRINTER,LIST EDCOPY(CL,PLEVEL));
+ X:=APPLY(READER,NIL);
+ If ATOM X then GO TO ATOMX else
+ If NUMBERP CAR X then
+ If CAR X = 0 then GO TO ILLG else
+ If CAR X > 0 then XCHANGE(QEDNTH(CAR X - 1,CL),CTL,CDR X,CAR X)
+ else XINS(QEDNTH(-(CAR X + 1),CL),CTL,CDR X,CAR X) else
+ If CAR X = 'R then RPLACEALL(CADR X,CADDR X,CL) else GO TO ILLG;
+ GO TO NEXT;
+F: TEMP:=FINDFIRST(APPLY(READER,NIL),CL,CTLS);
+ If NULL TEMP
+ then <<PRIN2T "NOT FOUND"; GO TO NEXT>>;
+ CL:=CAR TEMP;
+ CTLS:=CDR TEMP;
+ CTL:=CAR CTLS;
+ GO TO NEXT;
+ ATOMX: If NUMBERP X then If X = 0 then CL:=CAR CTL else GO TO NUMBX
+ else
+ If X = 'P then !*VERBOSE OR APPLY(PRINTER,LIST EDCOPY(CL,PLEVEL)) else
+ If X = 'OK then RETURN CAR TOP else
+ If X = 'UP then GO TO UP else
+ If X = 'B then BREAK() else
+ If X = 'F then GO TO F else
+ If X = 'PL then PLEVEL:=APPLY(READER,NIL) else
+ If X MEMQ '(HELP !?) then EHELP() else
+ If X EQ 'E then Apply(PRINTER,LIST EVAL Apply(READER,NIL)) else
+ If X = 'T then GO TO B else GO TO ILLG;
+ GO TO NEXT;
+UP: If CDR CTLS then GO TO UP1;
+ PRIN2T "You are already at the top level";
+ GO TO NEXT;
+UP1: CTLS:=CDR CTLS;
+ CTL:=CAR CTLS;
+ CL:=CAR CTL;
+ GO TO NEXT;
+NUMBX: NNN := X;
+ X:=QEDNTH(ABS(X),CL);
+ If NULL X then <<
+ PRIN2T "List empty";
+ GO TO NEXT >>;
+ If NNN > 0 then
+ CL:=CAR X;
+ CTL:=X;
+ CTLS:=CTL.CTLS;
+ GO TO NEXT;
+ILLG: PRIN2T "Illegal command";
+ GO TO NEXT
+END;
+
+lisp procedure QEDNTH(N,L);
+ If ATOM L then NIL else If N > 1 then QEDNTH(N-1,CDR L) else L;
+
+lisp procedure EDCOPY(L,N);
+If ATOM L then L else If N < 0 then
+ "***" else EDCOPY(CAR L,N-1).EDCOPY(CDR L,N);
+
+lisp procedure RPLACEALL(A,NEW,S);
+If ATOM S then NIL else If CAR S = A then
+RPLACEALL(A,NEW,CDR RPLACA(S,NEW)) else
+ <<RPLACEALL(A,NEW,CAR S); RPLACEALL(A,NEW,CDR S)>>;
+
+lisp procedure FINDFIRST(A,S,TRC); %. FIND Occurance of A in S
+ Begin scalar RES;
+ If ATOM S then RETURN NIL;
+ If A MEMBER S then RETURN S. TRC;
+ RETURN(FINDFIRST(A,CAR S,S.TRC) or FINDFIRST(A,CDR S,TRC));
+ %/ Add a PMAT here
+ END;
+
+lisp procedure XCHANGE(S,CTL,NEW,N);
+ If ATOM S then <<PRIN2T "List empty"; NIL>> else
+ If N = 1 then <<RPLACA(CTL,NCONC(NEW,CDR S)); CL:=CAR CTL>> else
+ RPLACD(S,NCONC(NEW,If CDDR S then CDDR S else NIL));
+
+lisp procedure XINS(S,CTL,NEW,N);
+ If ATOM S then <<PRIN2T "List empty"; NIL>> else
+ If N = 1 then <<RPLACA(CTL,NCONC(NEW,S)); CL:=CAR CTL>> else
+ RPLACD(S,NCONC(NEW,CDR S));
+
+UNFLUID '(CL);
+
+lisp procedure EHELP;
+<< EvLoad '(Help);
+ DisplayHelpFile 'Editor >>;
+
+PUT('EDIT, 'HelpFunction, 'EHELP);
+PUT('EDITF, 'HelpFunction, 'EHELP);
+PUT('EDITOR, 'HelpFunction, 'EHELP);
+
+END;
ADDED psl-1983/3-1/kernel/mini-trace.red
Index: psl-1983/3-1/kernel/mini-trace.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/mini-trace.red
@@ -0,0 +1,209 @@
+%
+% MINI-TRACE.RED - Simple trace and BreakFn package
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>MINI-TRACE.RED.4, 3-May-82 11:26:12, Edit by BENSON
+% Bug fix in BR.PRC, changed VV to MkQuote VV
+% Non-Standard Lisp functions used:
+% PrintF, ErrorPrintF, BldMsg, EqCar, Atsoc, MkQuote, SubSeq
+
+% -------- Simple TRACE package -----------
+
+fluid '(ArgLst!* % Default names for args in traced code
+ TrSpace!* % Number spaces to indent
+ !*NoTrArgs % Control arg-trace
+);
+
+CompileTime flag('(TrMakeArgList), 'InternalFunction);
+
+lisp procedure Tr!.Prc(PN, B, A); % Called in place of Traced code
+%
+% Called by TRACE for proc nam PN, body B, args A;
+%
+begin scalar K, SvArgs, VV, Numb;
+ TrSpace!* := TrSpace!* + 1;
+ Numb := Min(TrSpace!*, 15);
+ Tab Numb;
+ PrintF("%p %w:", PN, TrSpace!*);
+ if not !*NoTrArgs then
+ << SvArgs := A;
+ K := 1;
+ while SvArgs do
+ << PrintF(" Arg%w:=%p, ", K, car SvArgs);
+ SvArgs := cdr SvArgs;
+ K := K + 1 >> >>;
+ TerPri();
+ VV := Apply(B, A);
+ Tab Numb;
+ PrintF("%p %w:=%p%n", PN, TrSpace!*, VV);
+ TrSpace!* := TrSpace!* - 1;
+ return VV
+end;
+
+fluid '(!*Comp !*RedefMSG PromptString!*);
+
+lisp procedure Tr!.1 Nam; % Called To Trace a single function
+begin scalar PN, X, Y, Bod, Args, N, OldIn, OldPrompt, !*Comp, !*RedefMSG;
+ if not (Y:=GetD Nam) then
+ << ErrorPrintF("*** %r is not a defined function and cannot be traced",
+ Nam);
+ return >>;
+ PN := GenSym();
+ PutD(PN, car Y, cdr Y);
+ put(Nam, 'OldCod, Y . get(Nam, 'OldCod));
+ if EqCar(cdr Y, 'LAMBDA) then Args := cadr cdr Y else
+ << OldPrompt := PromptString!*;
+ PromptString!* := BldMsg("How many arguments for %r?", Nam);
+ OldIn := RDS NIL;
+ while not NumberP(N := Read()) or N < 0 or N > 15 do ;
+ PromptString!* := OldPrompt;
+ RDS OldIn;
+ Args := TrMakeArgList N >>;
+ Bod:= list('LAMBDA, Args,
+ list('Tr!.prc, MkQuote Nam,
+ MkQuote PN, 'LIST . Args));
+ PutD(Nam, car Y, Bod);
+ put(Nam, 'TraceCode, cdr GetD Nam);
+end;
+
+lisp procedure UnTr!.1 Nam;
+begin scalar X, Y, !*Comp;
+ if not IDP Nam or not PairP(X := get(Nam, 'OldCod))
+ or not PairP(Y := GetD Nam)
+ or not (cdr Y eq get(Nam, 'TraceCode)) then
+ << ErrorPrintF("*** %r cannot be untraced", Nam);
+ return >>;
+ PutD(Nam, caar X, cdar X);
+ put(Nam, 'OldCod, cdr X)
+end;
+
+macro procedure TR L; %. Trace functions in L
+ list('EvTR, MkQuote cdr L);
+
+expr procedure EvTR L;
+ for each X in L do Tr!.1 X;
+
+macro procedure UnTr L; %. Untrace Function in L
+ list('EvUnTr, MkQuote cdr L);
+
+expr procedure EvUnTr L;
+ for each X in L do UnTr!.1 X;
+
+lisp procedure TrMakeArgList N; % Get Arglist for N args
+ cdr Assoc(N, ArgLst!*);
+
+lisp procedure TrClr(); %. Called to setup or fix trace
+<< TrSpace!* := 0;
+ !*NoTrArgs := NIL >>;
+
+LoadTime
+<< ArgLst!* := '((0 . ())
+ (1 . (X1))
+ (2 . (X1 X2))
+ (3 . (X1 X2 X3))
+ (4 . (X1 X2 X3 X4))
+ (5 . (X1 X2 X3 X4 X5))
+ (6 . (X1 X2 X3 X4 X5 X6))
+ (7 . (X1 X2 X3 X4 X5 X6 X7))
+ (8 . (X1 X2 X3 X4 X5 X6 X7 X8))
+ (9 . (X1 X2 X3 X4 X5 X6 X7 X8 X9))
+ (10 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10))
+ (11 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11))
+ (12 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12))
+ (13 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13))
+ (14 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14))
+ (15 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15)));
+ TrSpace!* := 0;
+ !*NoTrArgs := NIL >>;
+
+Fluid '(ErrorForm!* !*ContinuableError);
+
+lisp procedure Br!.Prc(PN, B, A); % Called in place of "Broken" code
+%
+% Called by BREAKFN for proc nam PN, body B, args A;
+%
+begin scalar K, SvArgs, VV, Numb;
+ TrSpace!* := TrSpace!* + 1;
+ Numb := Min(TrSpace!*, 15);
+ Tab Numb;
+ PrintF("%p %w:", PN, TrSpace!*);
+ if not !*NoTrArgs then
+ << SvArgs := A;
+ K := 1;
+ while SvArgs do
+ << PrintF(" Arg%w:=%p, ", K, car SvArgs);
+ SvArgs := cdr SvArgs;
+ K := K + 1 >> >>;
+ TerPri();
+ ErrorForm!* := NIL;
+ PrintF(" BREAK before entering %r%n",PN);
+ !*ContinuableError:=T;
+ Break();
+ VV := Apply(B, A);
+ PrintF(" BREAK after call %r, value %r%n",PN,VV);
+ ErrorForm!* := MkQuote VV;
+ !*ContinuableError:=T;
+ Break();
+ Tab Numb;
+ PrintF("%p %w:=%p%n", PN, TrSpace!*, ErrorForm!*);
+ TrSpace!* := TrSpace!* - 1;
+ return ErrorForm!*
+end;
+
+fluid '(!*Comp PromptString!*);
+
+lisp procedure Br!.1 Nam; % Called To Trace a single function
+begin scalar PN, X, Y, Bod, Args, N, OldIn, OldPrompt, !*Comp;
+ if not (Y:=GetD Nam) then
+ << ErrorPrintF("*** %r is not a defined function and cannot be BROKEN",
+ Nam);
+ return >>;
+ PN := GenSym();
+ PutD(PN, car Y, cdr Y);
+ put(Nam, 'OldCod, Y . get(Nam, 'OldCod));
+ if EqCar(cdr Y, 'LAMBDA) then Args := cadr cdr Y else
+ << OldPrompt := PromptString!*;
+ PromptString!* := BldMsg("How many arguments for %r?", Nam);
+ OldIn := RDS NIL;
+ while not NumberP(N := Read()) or N < 0 or N > 15 do ;
+ PromptString!* := OldPrompt;
+ RDS OldIn;
+ Args := TrMakeArgList N >>;
+ Bod:= list('LAMBDA, Args,
+ list('Br!.prc, MkQuote Nam,
+ MkQuote PN, 'LIST . Args));
+ PutD(Nam, car Y, Bod);
+ put(Nam, 'BreakCode, cdr GetD Nam);
+end;
+
+lisp procedure UnBr!.1 Nam;
+begin scalar X, Y, !*Comp;
+ if not IDP Nam or not PairP(X := get(Nam, 'OldCod))
+ or not PairP(Y := GetD Nam)
+ or not (cdr Y eq get(Nam, 'BreakCode)) then
+ << ErrorPrintF("*** %r cannot be unbroken", Nam);
+ return >>;
+ PutD(Nam, caar X, cdar X);
+ put(Nam, 'OldCod, cdr X)
+end;
+
+macro procedure Br L; %. Break functions in L
+ list('EvBr, MkQuote cdr L);
+
+expr procedure EvBr L;
+ for each X in L do Br!.1 X;
+
+macro procedure UnBr L; %. Unbreak functions in L
+ list('EvUnBr, MkQuote cdr L);
+
+expr procedure EvUnBr L;
+ for each X in L do UnBr!.1 X;
+
+END;
ADDED psl-1983/3-1/kernel/nonrec-gc.red
Index: psl-1983/3-1/kernel/nonrec-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/nonrec-gc.red
@@ -0,0 +1,245 @@
+%
+% NONREC-GC.RED - Non-recursive copying 2-space garbage collector for PSL
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 30 November 1981
+% Copyright (c) 1981 Eric Benson
+%
+
+% Edit by Cris Perdue, 29 Mar 1983 1256-PST
+% Removed "LispVar" from initialization of heap-warn-level,
+% added code in !%Reclaim to swap old and new trap bounds.
+% Edit by Cris Perdue, 1 Mar 1983
+% Removed external declaration of HeapPreviousLast (the only occurrence)
+% Now using "known-free-space" function and heap-warn-level
+% Sets HeapTrapped to NIL now. (Value is T iff pre-GC trap has
+% occurred since last GC.)
+% <PSL.KERNEL>COPYING-GC.RED.6, 4-Oct-82 17:56:49, Edit by BENSON
+% Added GCTime!*
+
+fluid '(!*GC
+ GCKnt!*
+ GCTime!*
+ Heap!-Warn!-Level % Error if not this many items free after GC
+ );
+
+LoadTime
+<< GCKnt!* := 0;
+ GCTime!* := 0;
+ !*GC := T;
+ Heap!-Warn!-Level := 1000
+>>;
+
+on SysLisp;
+
+CompileTime <<
+syslsp smacro procedure PointerTagP X;
+ X > PosInt and X < Code;
+
+syslsp smacro procedure WithinOldHeapPointer X;
+ X >= !%chipmunk!-kludge OldHeapLowerBound
+and X <= !%chipmunk!-kludge OldHeapLast;
+
+syslsp smacro procedure Mark X;
+ MkItem(Forward, X);
+
+syslsp smacro procedure Marked X;
+ Tag X eq Forward;
+
+syslsp smacro procedure MarkID X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := Forward;
+
+syslsp smacro procedure MarkedID X;
+ Tag SymNam X eq Forward;
+
+syslsp smacro procedure ClearIDMark X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := STR;
+
+flag('(CopyFromAllBases CopyFromRange CopyFromBase CopyItem CopyItem1
+ CopyFromNewHeap
+ MarkAndCopyFromID MakeIDFreeList GCStats),
+ 'InternalFunction);
+>>;
+
+external WVar ST, StackLowerBound,
+ BndStkLowerBound, BndStkPtr,
+ HeapLast, HeapLowerBound, HeapUpperBound,
+ OldHeapLast, OldHeapLowerBound, OldHeapUpperBound,
+ HeapTrapBound, OldHeapTrapBound, HeapTrapped;
+
+internal WVar StackLast, OldTime, OldSize;
+
+syslsp procedure Reclaim();
+ !%Reclaim();
+
+syslsp procedure !%Reclaim();
+begin scalar Tmp1, Tmp2;
+ if LispVar !*GC then ErrorPrintF "*** Garbage collection starting";
+ BeforeGCSystemHook();
+ StackLast := MakeAddressFromStackPointer AdjustStackPointer(ST,
+-FrameSize());
+ OldTime := TimC();
+ OldSize := HeapLast - HeapLowerBound;
+ LispVar GCKnt!* := LispVar GCKnt!* + 1;
+ OldHeapLast := HeapLast;
+ HeapLast := OldHeapLowerBound;
+ Tmp1 := HeapLowerBound;
+ Tmp2 := HeapUpperBound;
+ HeapLowerBound := OldHeapLowerBound;
+ HeapUpperBound := OldHeapUpperBound;
+ OldHeapLowerBound := Tmp1;
+ OldHeapUpperBound := Tmp2;
+ Tmp1 := HeapTrapBound;
+ HeapTrapBound := OldHeapTrapBound;
+ OldHeapTrapBound := Tmp1;
+ CopyFromAllBases();
+ MakeIDFreeList();
+ AfterGCSystemHook();
+ OldTime := TimC() - OldTime;
+ LispVar GCTime!* := Plus2(LispVar GCTime!*, OldTime);
+ if LispVar !*GC then GCStats();
+ HeapTrapped := NIL;
+ if IntInf Known!-Free!-Space() < IntInf (LispVar Heap!-Warning!-Level) then
+ ContinuableError(99, "Heap space low", NIL)
+>>;
+
+syslsp procedure MarkAndCopyFromID X;
+% SymNam has to be copied before marking, since the mark destroys the tag
+% No problem since it's only a string, can't reference itself.
+<< CopyFromBase &SymNam X;
+ MarkID X;
+ CopyFromBase &SymPrp X;
+ CopyFromBase &SymVal X >>;
+
+syslsp procedure CopyFromAllBases();
+begin scalar LastSymbol, B;
+ MarkAndCopyFromID 128;% Mark NIL first
+ for I := 0 step 1 until 127 do
+if not MarkedID I then MarkAndCopyFromID I;
+ for I := 0 step 1 until MaxObArray do
+ << B := ObArray I;
+if B > 0 and not MarkedID B then MarkAndCopyFromID B >>;
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+CopyFromBase B;
+ for I := StackLowerBound step StackDirection*AddressingUnitsPerItem
+ until StackLast do
+CopyFromBase I;
+ CopyFromNewHeap();
+end;
+
+syslsp procedure CopyFromNewHeap();
+begin scalar P, Q;
+ P := HeapLowerBound;
+ while P < HeapLast do
+ << Q := @P;
+case Tag Q of
+ HBYTES:
+ P := &P[StrPack StrLen P];
+ HHalfWords:
+ P := &P[HalfWordPack HalfWordLen P];
+ HWRDS:
+ P := &P[WrdPack WrdLen P];
+ HVECT:
+ NIL;
+ default:
+ @P := CopyItem Q;
+end;
+P := &P[1] >>;
+end;
+
+syslsp procedure CopyFromRange(Lo, Hi);
+begin scalar X, I;
+ X := Lo;
+ I := 0;
+ while X <= Hi do
+ << CopyFromBase X;
+I := I + 1;
+X := &Lo[I] >>;
+end;
+
+syslsp procedure CopyFromBase P;
+ @P := CopyItem @P;
+
+syslsp procedure CopyItem X;
+begin scalar Typ, Info, Hdr;
+ Typ := Tag X;
+ if not PointerTagP Typ then return
+ << if Typ = ID and not null X then% don't follow NIL, for speed
+<< Info := IDInf X;
+ if not MarkedID Info then MarkAndCopyFromID Info >>;
+X >>;
+ Info := Inf X;
+ if not WithinOldHeapPointer Info then return X;
+ Hdr := @Info;
+ if Marked Hdr then return MkItem(Typ, Inf Hdr);
+ return CopyItem1 X;
+end;
+
+syslsp procedure CopyItem1 S;% Copier for GC
+begin scalar NewS, Len, Ptr, StripS;
+ return case Tag S of
+ PAIR:
+<< Ptr := car S;
+ Rplaca(S, Mark(NewS := GtHeap PairPack()));
+ NewS[1] := cdr S;
+ NewS[0] := Ptr;
+ MkPAIR NewS >>;
+ STR:
+<< @StrInf S := Mark(NewS := CopyString S);
+ NewS >>;
+ VECT:
+<< StripS := VecInf S;
+ Len := VecLen StripS;
+ @StripS := Mark(Ptr := GtVECT Len);
+ for I := 0 step 1 until Len do
+VecItm(Ptr, I) := VecItm(StripS, I);
+ MkVEC Ptr >>;
+ EVECT:
+<< StripS := VecInf S;
+ Len := VecLen StripS;
+ @StripS := Mark(Ptr := GtVECT Len);
+ for I := 0 step 1 until Len do
+VecItm(Ptr, I) := VecItm(StripS, I);
+ MkItem(EVECT, Ptr) >>;
+ WRDS, FIXN, FLTN, BIGN:
+<< Ptr := Tag S;
+ @Inf S := Mark(NewS := CopyWRDS S);
+ MkItem(Ptr, NewS) >>;
+ default:
+FatalError "Unexpected tag found during garbage collection";
+ end;
+end;
+
+syslsp procedure MakeIDFreeList();
+begin scalar Previous;
+ for I := 0 step 1 until 128 do
+ClearIDMark I;
+ Previous := 129;
+ while MarkedID Previous and Previous <= MaxSymbols do
+ << ClearIDMark Previous;
+Previous := Previous + 1 >>;
+ if Previous >= MaxSymbols then
+NextSymbol := 0
+ else
+NextSymbol := Previous;% free list starts here
+ for I := Previous + 1 step 1 until MaxSymbols do
+if MarkedID I then ClearIDMark I
+else
+<< SymNam Previous := I;
+ Previous := I >>;
+ SymNam Previous := 0;% end of free list
+end;
+
+syslsp procedure GCStats();
+<< ErrorPrintF("*** GC %w: time %d ms, %d recovered, %d free",
+LispVar GCKnt!*, OldTime,
+(OldSize - (HeapLast - HeapLowerBound))/AddressingUnitsPerItem,
+(HeapUpperBound - HeapLast)/AddressingUnitsPerItem) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/oblist.red
Index: psl-1983/3-1/kernel/oblist.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/oblist.red
@@ -0,0 +1,233 @@
+%
+% OBLIST.RED - Intern, RemOb and friends
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>OBLIST.RED.9, 15-Sep-82 09:35:25, Edit by BENSON
+% InternP accepts a string as well as a symbol
+
+% CopyString and CopyStringToFrom are found in COPIERS.RED
+
+CompileTime flag('(AddToObList LookupOrAddToObList InObList
+ InitNewID GenSym1),
+ 'InternalFunction);
+
+on SysLisp;
+
+internal WConst DeletedSlotValue = -1,
+ EmptySlotValue = 0;
+
+CompileTime <<
+
+syslsp smacro procedure DeletedSlot U;
+ ObArray U eq DeletedSlotValue;
+
+syslsp smacro procedure EmptySlot U;
+ ObArray U eq EmptySlotValue;
+
+syslsp smacro procedure NextSlot H;
+ if H eq MaxObArray then 0 else H + 1;
+
+% StringEqual found in EQUAL.RED
+
+syslsp smacro procedure EqualObArrayEntry(ObArrayIndex, S);
+ StringEqual(SymNam ObArray ObArrayIndex, S);
+>>;
+
+syslsp procedure AddToObList U;
+%
+% U is an ID, which is added to the oblist if an ID with the same
+% print name is not already there. The interned ID is returned.
+%
+begin scalar V, W, X, Y;
+ W := IDInf U;
+ U := StrInf SymNam W;
+ Y := StrLen U;
+ if Y < 0 then return StdError '"The null string cannot be interned";
+ if Y eq 0 then return MkID StrByt(U, 0);
+ return if OccupiedSlot(V := InObList U) then MkID ObArray V
+ else
+ << ObArray V := W;
+ X := GtConstSTR Y;
+ CopyStringToFrom(X, U);
+ SymNam W := MkSTR X;
+ MkID W >>;
+end;
+
+syslsp procedure LookupOrAddToObList U;
+%
+% U is a String, which IS copied if it is not found on the ObList
+% The interned ID with U as print name is returned
+%
+begin scalar V, W, X, Y;
+ U := StrInf U;
+ Y := StrLen U;
+ if Y < 0 then return StdError '"The null string cannot be interned";
+ if Y eq 0 then return MkID StrByt(U, 0);
+ return if OccupiedSlot(V := InObList U) then MkID ObArray V
+ else
+ << W := GtID(); % allocate a new ID
+ ObArray V := W; % plant it in the Oblist
+ X := GtConstSTR Y; % allocate a string from uncollected
+ CopyStringToFrom(X, StrInf U); % space
+ InitNewID(W, MkSTR X) >>;
+end;
+
+syslsp procedure NewID S; %. Allocate un-interned ID with print name S
+ InitNewID(GtID(), S); % Doesn't copy S
+
+syslsp procedure InitNewID(U, V); % Initialize cells of an ID to defaults
+<< SymNam U := V;
+ U := MkID U;
+ MakeUnBound U;
+ SetProp(U, NIL);
+ MakeFUnBound U;
+ U >>;
+
+syslsp procedure HashFunction S; % Compute hash function of string
+begin scalar Len, HashVal; % Fold together a bunch of bits
+ S := StrInf S;
+ HashVal := 0; % from the first BitsPerWord - 8
+ Len := StrLen S; % chars of the string
+ if Len > BitsPerWord - 8 then Len := BitsPerWord - 8;
+ for I := 0 step 1 until Len do
+ HashVal := LXOR(HashVal, LSH(StrByt(S, I), (BitsPerWord - 8) - I));
+ return MOD(HashVal, MaxObArray);
+end;
+
+syslsp procedure InObList U; % U is a string. Returns an ObArray pointer
+begin scalar H, DSlot, WalkObArray;
+ H := HashFunction U;
+ WalkObArray := H;
+ DSlot := -1;
+Loop:
+ if EmptySlot WalkObArray then return
+ if DSlot neq -1 then
+ DSlot
+ else
+ WalkObArray
+ else if DeletedSlot WalkObArray and DSlot eq -1 then
+ DSlot := WalkObArray
+ else if EqualObArrayEntry(WalkObArray, U) then return
+ WalkObArray;
+ WalkObArray := NextSlot WalkObArray;
+ if WalkObArray eq H then FatalError "Oblist overflow";
+ goto Loop;
+end;
+
+syslsp procedure Intern U; %. Add U to ObList
+%
+% U is a string or uninterned ID
+%
+ if IDP U then
+ AddToObList U
+ else if StringP U then
+ LookupOrAddToObList U
+ else
+ TypeError(U, 'Intern, '"ID or string");
+
+syslsp procedure RemOb U; %. REMove id from OBlist
+begin scalar V;
+ if not IDP U then return
+ NonIDError(U, 'RemOb);
+ V := IDInf U;
+ if V < 128 then return
+ TypeError(U, 'RemOb, '"non-char");
+ V := SymNam V;
+ return
+ << if OccupiedSlot(V := InObList V) then
+ ObArray V := DeletedSlotValue;
+ U >>
+end;
+
+% Changed to allow a string as well as a symbol, EB, 15 September 1982
+syslsp procedure InternP U; %. Is U an interned ID?
+ if IDP U then
+ << U := IDInf U;
+ U < 128 or U eq ObArray InObList SymNam U >>
+ else if StringP U then
+ StrLen StrInf U eq 0 or OccupiedSlot InObList U
+ else NIL;
+
+internal WString GenSymPName = "G0000";
+
+syslsp procedure GenSym(); %. GENerate unique, uninterned SYMbol
+<< GenSym1 4;
+ NewID CopyString GenSymPName >>;
+
+syslsp procedure GenSym1 N; % Auxiliary function for GenSym
+begin scalar Ch;
+ return if N > 0 then
+ if (Ch := StrByt(GenSymPName, N)) < char !9 then
+ StrByt(GenSymPName, N) := Ch + 1
+ else
+ << StrByt(GenSymPName, N) := char !0;
+ GenSym1(N - 1) >>
+ else % start over
+ << StrByt(GenSymPName, 0) := StrByt(GenSymPName, 0) + 1;
+ GenSym1 4 >>;
+end;
+
+syslsp procedure InternGenSym(); %. GENerate unique, interned SYMbol
+<< GenSym1 4;
+ Intern MkSTR GenSymPName >>;
+
+syslsp procedure MapObl F; %. Apply F to every interned ID
+<< for I := 0 step 1 until 127 do Apply(F, list MkID I);
+ for I := 0 step 1 until MaxObArray do
+ if OccupiedSlot I then Apply(F, list MkID ObArray I) >>;
+
+% These functions provide support for multiple oblists
+% Cf PACKAGE.RED for their use
+
+internal WVar LastObArrayPtr;
+
+syslsp procedure GlobalLookup S; % Lookup string S in global oblist
+ if not StringP S then NonStringError(S, 'GlobalLookup)
+ else if OccupiedSlot(LastObArrayPtr := InObList S) then
+ MkID ObArray LastObArrayPtr
+ else '0;
+
+syslsp procedure GlobalInstall S; % Add new ID with PName S to oblist
+begin scalar Ind, PN;
+ Ind := GlobalLookup S;
+ return if Ind neq '0 then Ind
+ else
+ << Ind := GtID();
+ ObArray LastObArrayPtr := Ind;
+ PN := GtConstSTR StrLen StrInf S; % allocate a string from uncollected
+ CopyStringToFrom(PN, StrInf S); % space
+ InitNewID(Ind, MkSTR PN) >>;
+end;
+
+syslsp procedure GlobalRemove S; % Remove ID with PName S from oblist
+begin scalar Ind;
+ Ind := GlobalLookup S;
+ return if Ind eq '0 then '0
+ else
+ << Ind := ObArray LastObArrayPtr;
+ ObArray LastObArrayPtr := DeletedSlotValue;
+ MkID Ind >>;
+end;
+
+syslsp procedure InitObList();
+begin scalar Tmp;
+ if_system(MC68000, << % 68000 systems don't clear memory statically
+ for I := 0 step 1 until MaxObArray do
+ ObArray I := EmptySlotValue >>);
+ Tmp := NextSymbol - 1;
+ for I := 128 step 1 until Tmp do
+ ObArray InObList SymNam I := I;
+end;
+
+off SysLisp;
+
+StartupTime InitObList();
+
+END;
ADDED psl-1983/3-1/kernel/onoff.red
Index: psl-1983/3-1/kernel/onoff.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/onoff.red
@@ -0,0 +1,38 @@
+%
+% ONOFF.RED - Macros for setting/resetting flags, with SIMPFG hook
+%
+% Author: Martin Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 July 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% ONOFF.RED - ON and OFF for Bare PSL
+% MLG, from PU:RLISP-PARSER.RED
+
+lisp procedure OnOff!*(IdList, U);
+%
+% IdList is list of variables without !* prefix, U is T or NIL
+%
+begin scalar Y;
+ for each X in IdList do
+ if not IDP X then NonIDError(X, if null U then 'OFF else 'ON)
+ else
+ << Set(MkFlagVar X, U);
+ if (Y := Atsoc(U, get(X, 'SIMPFG))) then Eval second Y >>;
+end;
+
+lisp procedure MkFlagVar U; % Should be redefined in PACKAGE.RED
+ Intern Concat("*", ID2String U); % to lambda-bind current pkg to GLOBAL
+
+macro procedure ON U;
+ list('OnOff!*, MkQuote cdr U, T);
+
+macro procedure OFF U;
+ list('OnOff!*, MkQuote cdr U, NIL);
+
+flag('(ON OFF), 'IGNORE);
+
+END;
ADDED psl-1983/3-1/kernel/open-close.red
Index: psl-1983/3-1/kernel/open-close.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/open-close.red
@@ -0,0 +1,70 @@
+%
+% OPEN-CLOSE.RED - File primitives
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 27 Jan 1983 1700-PST
+% Close now checks for a legitimate FileDes argument
+
+fluid '(SpecialReadFunction!* % These must be set up for special
+ SpecialWriteFunction!* % Open call
+ SpecialCloseFunction!*);
+
+on SysLisp;
+
+external WArray ReadFunction, % indexed by channel to read a char
+ WriteFunction, % indexed by channel to write a char
+ CloseFunction, % indexed by channel to close channel
+ UnReadBuffer, % indexed by channel for input backup
+ LinePosition, % indexed by channel for Posn()
+ MaxLine; % when to force an end-of-line
+
+syslsp procedure Open(FileName, AccessType); %. Get access to file
+begin scalar FileDes;
+ if AccessType eq 'INPUT then
+ << FileDes := SystemOpenFileForInput FileName;
+ UnReadBuffer[FileDes] := char NULL;
+ WriteFunction[FileDes] := 'ReadOnlyChannel >>
+ else if AccessType eq 'OUTPUT then
+ << FileDes := SystemOpenFileForOutput FileName;
+ LinePosition[FileDes] := 0;
+ MaxLine[FileDes] := 80;
+ ReadFunction[FileDes] := 'WriteOnlyChannel >>
+ else if AccessType eq 'SPECIAL then
+ if IDP LispVar SpecialReadFunction!*
+ and IDP LispVar SpecialWriteFunction!*
+ and IDP LispVar SpecialCloseFunction!* then
+ << FileDes := SystemOpenFileSpecial FileName;
+ LinePosition[FileDes] := 0;
+ MaxLine[FileDes] := 80;
+ UnReadBuffer[FileDes] := char NULL;
+ ReadFunction[FileDes] := IdInf LispVar SpecialReadFunction!*;
+ WriteFunction[FileDes] := IdInf LispVar SpecialWriteFunction!*;
+ CloseFunction[FileDes] := IdInf LispVar SpecialCloseFunction!* >>
+ else IOError "Improperly set-up special IO open call"
+ else IOError "Unknown access type";
+ return MkINT FileDes;
+end;
+
+syslsp procedure Close FileDes; %. End access to file
+begin scalar BareFileDes;
+ BareFileDes := IntInf FileDes;
+ if not (0 <= BareFileDes and BareFileDes <= MaxChannels) then
+ NonIOChannelError(FileDes, "Close");
+ IDApply1(BareFileDes, CloseFunction[BareFileDes]);
+ SystemMarkAsClosedChannel FileDes;
+ ReadFunction[BareFileDes] := 'ChannelNotOpen;
+ WriteFunction[BareFileDes] := 'ChannelNotOpen;
+ CloseFunction[BareFileDes] := 'ChannelNotOpen;
+ return FileDes;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/other-io.red
Index: psl-1983/3-1/kernel/other-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/other-io.red
@@ -0,0 +1,90 @@
+%
+% OTHER-IO.RED - Miscellaneous input and output functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 27 Jan 1983 1428-PST
+% put in Kessler's change so ChannelLineLength allows Len=0 to mean that
+% EOL is not to be automatically written.
+% <PSL.KERNEL>OTHER-IO.RED.3, 29-Dec-82 12:23:52, Edit by PERDUE
+% added LPosn and ChannelLPosn
+% <PSL.KERNEL>OTHER-IO.RED.2, 17-Sep-82 15:46:38, Edit by BENSON
+% Added ChannelLinelength, ChannelPosn, ChannelEject, ChannelTerPri
+% ChannelReadCH, ChannelPrinC
+% <PSL.INTERP>OTHER-IO.RED.3, 21-Jul-82 00:48:35, Edit by BENSON
+% Made ReadCh do case conversion for *Raise
+
+% Most of the uninteresting I/O functions from the Standard Lisp report
+
+global '(OUT!*); % Current output channel
+
+fluid '(!*Raise); % controls case conversion of IDs
+
+on SysLisp;
+
+external WArray LinePosition, % Array indexed by channel
+ MaxLine; % ditto
+
+syslsp procedure ChannelEject C; %. Skip to top of next output page
+<< ChannelWriteChar(C, char FF); % write a formfeed
+ NIL >>;
+
+syslsp procedure Eject(); %. Skip to top of next output page
+ ChannelEject LispVar OUT!*;
+
+syslsp procedure ChannelLineLength(Chn, Len); %. Set maximum line length
+begin scalar OldLen, StripLen;
+ OldLen := MaxLine[Chn];
+ if Len then
+ if IntP Len and Len >= 0 then
+ MaxLine[Chn] := Len
+ else
+ StdError BldMsg('"%r is an invalid line length", Len);
+ return OldLen; % if Len is NIL, just return current
+end;
+
+syslsp procedure LineLength Len; %. Set maximum line length
+ ChannelLineLength(LispVar OUT!*, Len);
+
+syslsp procedure ChannelPosn Chn; %. Number of characters since last EOL
+ LinePosition[Chn];
+
+syslsp procedure Posn(); %. Number of characters since last EOL
+ ChannelPosn LispVar OUT!*;
+
+syslsp procedure ChannelLPosn Chn; %. Number of EOLs since last FF
+ PagePosition[Chn];
+
+syslsp procedure LPosn(); %. Number of EOLs since last FF
+ ChannelLPosn LispVar OUT!*;
+
+syslsp procedure ChannelReadCH Chn; %. Read a single character ID
+begin scalar X; % for Standard Lisp compatibility
+ X := ChannelReadChar Chn; % converts lower to upper when *RAISE
+ if LispVar !*Raise and X >= char lower a and X <= char lower z then
+ X := char A + (X - char lower a);
+ return MkID X;
+end;
+
+syslsp procedure ReadCH(); %. Read a single character ID
+ ChannelReadCH LispVar IN!*;
+
+syslsp procedure ChannelTerPri Chn; %. Terminate current output line
+<< ChannelWriteChar(Chn, char EOL);
+ NIL >>;
+
+syslsp procedure TerPri(); %. Terminate current output line
+ ChannelTerPri LispVar OUT!*;
+
+off SysLisp;
+
+LoadTime PutD('PrinC, 'EXPR, cdr GetD 'Prin2); % same definition as Prin2
+LoadTime PutD('ChannelPrinC, 'EXPR, cdr GetD 'ChannelPrin2);
+ % same definition as ChannelPrin2
+END;
ADDED psl-1983/3-1/kernel/others-sl.red
Index: psl-1983/3-1/kernel/others-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/others-sl.red
@@ -0,0 +1,41 @@
+%
+% OTHERS-SL.RED - Random Standard Lisp functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% These are functions that didn't have a logical home
+% Most could have been defined portably, but were not for efficiency reasons
+
+on SysLisp;
+
+off R2I;
+
+syslsp procedure FixP U; %. Is U an integer?
+ FixP U;
+
+on R2I;
+
+syslsp procedure Digit U; %. Is U an ID whose print name is a digit?
+ IDP U and (U := IDInf U) >= char !0 and U <= char !9;
+
+syslsp procedure Liter U; %. Is U a single character alphabetic ID?
+ IDP U and ((U := IDInf U) >= char A and U <= char Z
+ or U >= char !a and U <= char !z);
+
+off SysLisp;
+
+CompileTime flag('(Length1), 'InternalFunction);
+
+lisp procedure Length U; %. Length of list U
+ Length1(U, 0);
+
+lisp procedure Length1(U, N);
+ if PairP U then Length1(cdr U, IAdd1 N) else N;
+
+END;
ADDED psl-1983/3-1/kernel/p-apply-lap.red
Index: psl-1983/3-1/kernel/p-apply-lap.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/p-apply-lap.red
@@ -0,0 +1,429 @@
+%
+% P-APPLY-LAP.RED - Inefficient, portable version of APPLY-LAP
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 29 July 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Functions which must be written non-portably:
+
+% CodePrimitive
+% Takes the code pointer stored in the fluid variable CodePtr!*
+% and jumps to its address, without distubing any of the argument
+% registers. This can be flagged 'InternalFunction for compilation
+% before this file is compiled or done as an 'OpenCode and 'ExitOpenCode
+% property for the compiler.
+% CompiledCallingInterpreted
+% Called by some convention from the function cell of an ID which
+% has an interpreted function definition. It should store the ID
+% in the fluid variable CodeForm!* without disturbing the argument
+% registers, then finish with
+% (!*JCALL CompiledCallingInterpretedAux)
+% (CompiledCallingInterpretedAux may be flagged 'InternalFunction).
+% FastApply
+% Called with a functional form in (reg t1) and argument registers
+% loaded. If it is a code pointer or an ID, the function address
+% associated with either should be jumped to. If it is anything else
+% except a lambda form, an error should be signaled. If it is a lambda
+% form, store (reg t1) in the fluid variable CodeForm!* and
+% (!*JCALL FastLambdaApply)
+% (FastLambdaApply may be flagged 'InternalFunction).
+% UndefinedFunction
+% Called by some convention from the function cell of an ID (probably
+% the same as CompiledCallingInterpreted) for an undefined function.
+% Should call Error with the ID as part of the error message.
+
+CompileTime <<
+
+flag('(CompiledCallingInterpretedAuxAux BindEvalAux SaveRegisters),
+ 'InternalFunction);
+
+fluid '(CodePtr!* % gets code pointer used by CodePrimitive
+ CodeForm!* % gets fn to be called from code
+);
+>>;
+
+on Syslisp;
+
+internal WArray CodeArgs[15];
+
+syslsp procedure CodeApply(CodePtr, ArgList);
+begin scalar I;
+ I := 0;
+ LispVar CodePtr!* := CodePtr;
+ while PairP ArgList and ILessP(I, 15) do
+ << WPutV(CodeArgs , I, first ArgList);
+ I := IAdd1 I;
+ ArgList := rest ArgList >>;
+ if IGEQ(I, 15) then return StdError "Too many arguments to function";
+ return case I of
+ 0:
+ CodePrimitive();
+ 1:
+ CodePrimitive WGetV(CodeArgs, 0);
+ 2:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1));
+ 3:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2));
+ 4:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3));
+ 5:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4));
+ 6:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5));
+ 7:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6));
+ 8:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7));
+ 9:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8));
+ 10:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8),
+ WGetV(CodeArgs, 9));
+ 11:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8),
+ WGetV(CodeArgs, 9),
+ WGetV(CodeArgs, 10));
+ 12:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8),
+ WGetV(CodeArgs, 9),
+ WGetV(CodeArgs, 10),
+ WGetV(CodeArgs, 11));
+ 13:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8),
+ WGetV(CodeArgs, 9),
+ WGetV(CodeArgs, 10),
+ WGetV(CodeArgs, 11),
+ WGetV(CodeArgs, 12));
+ 14:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8),
+ WGetV(CodeArgs, 9),
+ WGetV(CodeArgs, 10),
+ WGetV(CodeArgs, 11),
+ WGetV(CodeArgs, 12),
+ WGetV(CodeArgs, 13));
+ 15:
+ CodePrimitive(WGetV(CodeArgs, 0),
+ WGetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2),
+ WGetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4),
+ WGetV(CodeArgs, 5),
+ WGetV(CodeArgs, 6),
+ WGetV(CodeArgs, 7),
+ WGetV(CodeArgs, 8),
+ WGetV(CodeArgs, 9),
+ WGetV(CodeArgs, 10),
+ WGetV(CodeArgs, 11),
+ WGetV(CodeArgs, 12),
+ WGetV(CodeArgs, 13),
+ WGetV(CodeArgs, 14));
+ end;
+end;
+
+%lisp procedure CodeEvalApply(CodePtr, ArgList);
+% CodeApply(CodePtr, EvLis ArgList);
+
+lap '((!*entry CodeEvalApply expr 2)
+ (!*ALLOC 15)
+ (!*LOC (reg 3) (frame 15))
+ (!*CALL CodeEvalApplyAux)
+ (!*EXIT 15)
+);
+
+syslsp procedure CodeEvalApplyAux(CodePtr, ArgList, P);
+begin scalar N;
+ N := 0;
+ while PairP ArgList and ILessP(N, 15) do
+ << WPutV(P, ITimes2(StackDirection, N), Eval first ArgList);
+ ArgList := rest ArgList;
+ N := IAdd1 N >>;
+ if IGEQ(N, 15) then return StdError "Too many arguments to function";
+ LispVar CodePtr!* := CodePtr;
+ return case N of
+ 0:
+ CodePrimitive();
+ 1:
+ CodePrimitive WGetV(P, ITimes2(StackDirection, 0));
+ 2:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)));
+ 3:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)));
+ 4:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)));
+ 5:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)));
+ 6:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)));
+ 7:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)));
+ 8:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)));
+ 9:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)));
+ 10:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)),
+ WGetV(P, ITimes2(StackDirection, 9)));
+ 11:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)),
+ WGetV(P, ITimes2(StackDirection, 9)),
+ WGetV(P, ITimes2(StackDirection, 10)));
+ 12:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)),
+ WGetV(P, ITimes2(StackDirection, 9)),
+ WGetV(P, ITimes2(StackDirection, 10)),
+ WGetV(P, ITimes2(StackDirection, 11)));
+ 13:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)),
+ WGetV(P, ITimes2(StackDirection, 9)),
+ WGetV(P, ITimes2(StackDirection, 10)),
+ WGetV(P, ITimes2(StackDirection, 11)),
+ WGetV(P, ITimes2(StackDirection, 12)));
+ 14:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)),
+ WGetV(P, ITimes2(StackDirection, 9)),
+ WGetV(P, ITimes2(StackDirection, 10)),
+ WGetV(P, ITimes2(StackDirection, 11)),
+ WGetV(P, ITimes2(StackDirection, 12)),
+ WGetV(P, ITimes2(StackDirection, 13)));
+ 15:
+ CodePrimitive(WGetV(P, ITimes2(StackDirection, 0)),
+ WGetV(P, ITimes2(StackDirection, 1)),
+ WGetV(P, ITimes2(StackDirection, 2)),
+ WGetV(P, ITimes2(StackDirection, 3)),
+ WGetV(P, ITimes2(StackDirection, 4)),
+ WGetV(P, ITimes2(StackDirection, 5)),
+ WGetV(P, ITimes2(StackDirection, 6)),
+ WGetV(P, ITimes2(StackDirection, 7)),
+ WGetV(P, ITimes2(StackDirection, 8)),
+ WGetV(P, ITimes2(StackDirection, 9)),
+ WGetV(P, ITimes2(StackDirection, 10)),
+ WGetV(P, ITimes2(StackDirection, 11)),
+ WGetV(P, ITimes2(StackDirection, 12)),
+ WGetV(P, ITimes2(StackDirection, 13)),
+ WGetV(P, ITimes2(StackDirection, 14)));
+ end;
+end;
+
+off Syslisp;
+
+syslsp procedure BindEval(Formals, Args);
+ BindEvalAux(Formals, Args, 0);
+
+syslsp procedure BindEvalAux(Formals, Args, N);
+begin scalar F, A;
+ return if PairP Formals then
+ if PairP Args then
+ << F := first Formals;
+ A := Eval first Args;
+ N := BindEvalAux(rest Formals, rest Args, IAdd1 N);
+ if N = -1 then -1 else
+ << LBind1(F, A);
+ N >> >>
+ else -1
+ else if PairP Args then -1
+ else N;
+end;
+
+syslsp procedure SaveRegisters(A1, A2, A3, A4, A5,
+ A6, A7, A8, A9, A10,
+ A11, A12, A13, A14, A15);
+<< CodeArgs[14] := A15;
+ CodeArgs[13] := A14;
+ CodeArgs[12] := A13;
+ CodeArgs[11] := A12;
+ CodeArgs[10] := A11;
+ CodeArgs[9] := A10;
+ CodeArgs[8] := A9;
+ CodeArgs[7] := A8;
+ CodeArgs[6] := A7;
+ CodeArgs[5] := A6;
+ CodeArgs[4] := A5;
+ CodeArgs[3] := A4;
+ CodeArgs[2] := A3;
+ CodeArgs[1] := A2;
+ CodeArgs[0] := A1 >>;
+
+syslsp procedure CompiledCallingInterpretedAux();
+<< SaveRegisters();
+ CompiledCallingInterpretedAuxAux get(LispVar CodeForm!*, '!*LambdaLink) >>;
+
+syslsp procedure FastLambdaApply();
+<< SaveRegisters();
+ CompiledCallingInterpretedAuxAux LispVar CodeForm!* >>;
+
+syslsp procedure CompiledCallingInterpretedAuxAux Fn;
+ if not (PairP Fn and car Fn = 'LAMBDA) then
+ StdError BldMsg("Ill-formed functional expression %r for %r",
+ Fn, LispVar CodeForm!*)
+ else begin scalar Formals, N, Result;
+ Formals := cadr Fn;
+ N := 0;
+ while PairP Formals do
+ << LBind1(car Formals, WGetV(CodeArgs, N));
+ Formals := cdr Formals;
+ N := IAdd1 N >>;
+ Result := EvProgN cddr Fn;
+ if N neq 0 then UnBindN N;
+ return Result;
+ end;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/kernel/printers.red
Index: psl-1983/3-1/kernel/printers.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/printers.red
@@ -0,0 +1,526 @@
+%
+% PRINTERS.RED - Printing functions for various data types
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+% <PSL.KERNEL>PRINTERS.RED.17, 7-Mar-83 11:53:59, Edit by KESSLER
+% Change Channelwriteblankoreol to check linelength = 0 also.
+% 03-Mar-83 Nancy Kendzierski
+% Changed declaration of LispScanTable!* from global to fluid.
+% Edit by MLGriss, 11:31am Saturday, 5 February 1983
+% Fix ChannelWriteBitstring to put out a single 0 if needed
+% Fixed to handle largest NEGATIVE number correctly
+% Used to get ------, since -(largest neg) NOT=largestPOS
+% <PSL.KERNEL>PRINTERS.RED.14, 31-Jan-83 15:45:30, Edit by PERDUE
+% Fix to printing of EVECTORs
+% Edit by Cris Perdue, 29 Jan 1983 1620-PST
+% Removed definition of EVecInf (both compile- and load-time)
+% Edit by Cris Perdue, 27 Jan 1983 1436-PST
+% Put in Kessler's change so CheckLineFit won't write EOL if LineLength = 0
+% <PSL.KERNEL>PRINTERS.RED.11, 10-Jan-83 13:58:14, Edit by PERDUE
+% Added some code to handle EVectors, especially to represent OBJECTs
+% <PSL.KERNEL>PRINTERS.RED.10, 21-Dec-82 15:24:18, Edit by BENSON
+% Changed order of tests in WriteInteger so that -ive hex #s are done right
+% <PSL.KERNEL>PRINTERS.RED.9, 4-Oct-82 10:04:34, Edit by BENSON
+% Added PrinLength and PrinLevel
+% <PSL.KERNEL>PRINTERS.RED.3, 23-Sep-82 13:16:20, Edit by BENSON
+% Look for # of args in code pointer, changed : to space in #<...> stuff
+% <PSL.INTERP>PRINTERS.RED.12, 2-Sep-82 09:01:31, Edit by BENSON
+% (QUOTE x y) prints correctly, not as 'x
+% <PSL.INTERP>PRINTERS.RED.11, 4-May-82 20:31:32, Edit by BENSON
+% Printers keep tags on, for Emode GC
+% <PSL.VAX-INTERP>PRINTERS.RED.6, 18-Feb-82 16:30:12, Edit by BENSON
+% Added printer for unbound, changed code to #<Code:xx>
+% <PSL.VAX-INTERP>PRINTERS.RED.2, 20-Jan-82 02:11:16, Edit by GRISS
+% fixed prining of zero length vectors
+% <PSL.VAX-INTERP>PRINTERS.RED.1, 15-Jan-82 14:27:13, Edit by BENSON
+% Changed for new integer tags
+% <PSL.INTERP>PRINTERS.RED.13, 7-Jan-82 22:47:40, Edit by BENSON
+% Made (QUOTE xxx) print as 'xxx
+% <PSL.INTERP>PRINTERS.RED.12, 5-Jan-82 21:37:41, Edit by BENSON
+% Changed OBase to OutputBase!*
+
+fluid '(OutputBase!* % current output base
+ PrinLength % length of structures to print
+ PrinLevel % level of recursion to print
+ CurrentScanTable!*
+ LispScanTable!*
+ IDEscapeChar!*
+ !*Lower); % print IDs with uppercase chars lowered
+
+LoadTime
+<< OutputBase!* := 10;
+ IDEscapeChar!* := 33; % (char !!)
+ CurrentScanTable!* := LispScanTable!* >>; % so TokenTypeOfChar works right
+
+on SysLisp;
+
+CompileTime <<
+syslsp smacro procedure UpperCaseP Ch;
+ Ch >= char A and Ch <= char Z;
+
+syslsp smacro procedure LowerCaseP Ch;
+ Ch >= char !a and Ch <= char !z;
+
+syslsp smacro procedure RaiseChar Ch;
+ (Ch - char !a) + char A;
+
+syslsp smacro procedure LowerChar Ch;
+ (Ch - char A) + char !a;
+>>;
+
+CompileTime flag('(CheckLineFit WriteNumber1 ChannelWriteBitString),
+ 'InternalFunction);
+
+%. Writes EOL first if given Len causes max line length to be exceeded
+syslsp procedure CheckLineFit(Len, Chn, Fn, Itm);
+<< if (LinePosition[Chn] + Len > MaxLine[Chn]) and (MaxLine[Chn] > 0) then
+ ChannelWriteChar(Chn, char EOL);
+ IDApply2(Chn, Itm, Fn) >>;
+
+syslsp procedure ChannelWriteString(Channel, Strng);
+%
+% Strng may be tagged or not, but it must have a length field accesible
+% by StrLen.
+%
+begin scalar UpLim;
+ UpLim := StrLen StrInf Strng;
+ for I := 0 step 1 until UpLim do
+ ChannelWriteChar(Channel, StrByt(StrInf Strng, I));
+end;
+
+syslsp procedure WriteString S;
+ ChannelWriteString(LispVar OUT!*, S);
+
+internal WString DigitString = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+internal WString WriteNumberBuffer[40];
+
+syslsp procedure ChannelWriteSysInteger(Channel, Number, Radix);
+begin scalar Exponent,N1;
+ return if (Exponent := SysPowerOf2P Radix) then
+ ChannelWriteBitString(Channel, Number, Radix - 1, Exponent)
+ else if Number < 0 then
+ << ChannelWriteChar(Channel, char '!-);
+ WriteNumber1(Channel,-(Number/Radix),Radix); % To catch largest NEG
+ ChannelWriteChar(Channel,
+ StrByt(DigitString, - MOD(Number, Radix))) >>
+ else if Number = 0 then ChannelWriteChar(Channel, char !0)
+ else WriteNumber1(Channel, Number, Radix);
+end;
+
+syslsp procedure WriteNumber1(Channel, Number, Radix);
+ if Number = 0 then Channel
+ else
+ << WriteNumber1(Channel, Number / Radix, Radix);
+ ChannelWriteChar(Channel,
+ StrByt(DigitString, MOD(Number, Radix))) >>;
+
+syslsp procedure ChannelWriteBitString(Channel, Number, DigitMask, Exponent);
+ if Number = 0 then ChannelWriteChar(Channel,char !0)
+ else ChannelWriteBitStrAux(Channel, Number, DigitMask, Exponent);
+
+syslsp procedure ChannelWriteBitStrAux(Channel, Number, DigitMask, Exponent);
+ if Number = 0 then Channel % Channel means nothing here
+ else % just trying to fool the compiler
+ << ChannelWriteBitStrAux(Channel,
+ LSH(Number, -Exponent),
+ DigitMask,
+ Exponent);
+ ChannelWriteChar(Channel,
+ StrByt(DigitString,
+ LAND(Number, DigitMask))) >>;
+
+syslsp procedure WriteSysInteger(Number, Radix);
+ ChannelWriteSysInteger(LispVar OUT!*, Number, Radix);
+
+syslsp procedure ChannelWriteFixnum(Channel, Num);
+ ChannelWriteInteger(Channel, FixVal FixInf Num);
+
+syslsp procedure ChannelWriteInteger(Channel, Num);
+begin scalar CurrentBase;
+ if (CurrentBase := LispVar OutputBase!*) neq 10 then
+ << ChannelWriteSysInteger(Channel, CurrentBase, 10);
+ ChannelWriteChar(Channel, char !#) >>;
+ ChannelWriteSysInteger(Channel,
+ Num,
+ CurrentBase);
+end;
+
+syslsp procedure ChannelWriteSysFloat(Channel, FloatPtr);
+begin scalar Ch, ChIndex;
+ WriteFloat(WriteNumberBuffer, FloatPtr);
+ ChannelWriteString(Channel, WriteNumberBuffer);
+end;
+
+syslsp procedure ChannelWriteFloat(Channel, LispFloatPtr);
+ ChannelWriteSysFloat(Channel, FloatBase FltInf LispFloatPtr);
+
+syslsp procedure ChannelPrintString(Channel, Strng);
+begin scalar Len, Ch;
+ ChannelWriteChar(Channel, char !");
+ Len := StrLen StrInf Strng;
+ for I := 0 step 1 until Len do
+ << Ch := StrByt(StrInf Strng, I);
+ if Ch eq char !" then ChannelWriteChar(Channel, char !");
+ ChannelWriteChar(Channel, Ch) >>;
+ ChannelWriteChar(Channel, char !");
+end;
+
+syslsp procedure ChannelWriteID(Channel, Itm);
+ if not LispVar !*Lower then
+ ChannelWriteString(Channel, SymNam IDInf Itm)
+ else begin scalar Ch, Len;
+ Itm := StrInf SymNam IDInf Itm;
+ Len := StrLen Itm;
+ for I := 0 step 1 until Len do
+ << Ch := StrByt(Itm, I);
+ if UpperCaseP Ch then Ch := LowerChar Ch;
+ ChannelWriteChar(Channel, Ch) >>;
+ end;
+
+syslsp procedure ChannelWriteUnbound(Channel, Itm);
+<< ChannelWriteString(Channel, "#<Unbound:");
+ ChannelWriteID(Channel, Itm);
+ ChannelWriteChar(Channel, char '!>) >>;
+
+syslsp procedure ChannelPrintID(Channel, Itm);
+begin scalar Len, Ch, TokenType;
+ Itm := StrInf SymNam IDInf Itm;
+ Len := StrLen Itm;
+ Ch := StrByt(Itm, 0);
+ if TokenTypeOfChar Ch neq 10 then ChannelWriteChar(Channel,
+ LispVar IDEscapeChar!*);
+ if not LispVar !*Lower then
+ << ChannelWriteChar(Channel, Ch);
+ for I := 1 step 1 until Len do
+ << Ch := StrByt(Itm, I);
+ TokenType := TokenTypeOfChar Ch;
+ if not (TokenType <= 10
+ or TokenType eq PLUSSIGN
+ or TokenType eq MINUSSIGN) then
+ ChannelWriteChar(Channel, LispVar IDEscapeChar!*);
+ ChannelWriteChar(Channel, Ch) >> >>
+ else
+ << if UpperCaseP Ch then Ch := LowerChar Ch;
+ ChannelWriteChar(Channel, Ch);
+ for I := 1 step 1 until Len do
+ << Ch := StrByt(Itm, I);
+ TokenType := TokenTypeOfChar Ch;
+ if not (TokenType <= 10
+ or TokenType eq PLUSSIGN
+ or TokenType eq MINUSSIGN) then
+ ChannelWriteChar(Channel, LispVar IDEscapeChar!*);
+ if UpperCaseP Ch then Ch := LowerChar Ch;
+ ChannelWriteChar(Channel, Ch) >> >>
+end;
+
+syslsp procedure ChannelPrintUnbound(Channel, Itm);
+<< ChannelWriteString(Channel, "#<Unbound ");
+ ChannelPrintID(Channel, Itm);
+ ChannelWriteChar(Channel, char '!>) >>;
+
+syslsp procedure ChannelWriteCodePointer(Channel, CP);
+begin scalar N;
+ CP := CodeInf CP;
+ ChannelWriteString(Channel, "#<Code ");
+ N := !%code!-number!-of!-arguments CP;
+ if N >= 0 and N <= MaxArgs then
+ << ChannelWriteSysInteger(Channel, N, 10);
+ ChannelWriteChar(Channel, char BLANK) >>:
+ ChannelWriteSysInteger(Channel, CP, CompressedBinaryRadix);
+ ChannelWriteChar(Channel, char '!>);
+end;
+
+syslsp procedure ChannelWriteUnknownItem(Channel, Itm);
+<< ChannelWriteString(Channel, "#<Unknown ");
+ ChannelWriteSysInteger(Channel, Itm, CompressedBinaryRadix);
+ ChannelWriteChar(Channel, char !>) >>;
+
+syslsp procedure ChannelWriteBlankOrEOL Channel;
+<< if (LinePosition[Channel] + 1 >= MaxLine[Channel]) and
+ (MaxLine[Channel] > 0) then
+ ChannelWriteChar(Channel, char EOL)
+ else
+ ChannelWriteChar(Channel, char ! ) >>;
+
+syslsp procedure ChannelWritePair(Channel, Itm, Level);
+ if IntP LispVar PrinLevel and Level >= LispVar PrinLevel then
+ ChannelWriteChar(Channel, char '!#)
+ else
+begin scalar N;
+ Level := Level + 1;
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char !( );
+ if not IntP LispVar PrinLength or 1 <= LispVar PrinLength then
+ << RecursiveChannelPrin2(Channel, car Itm, Level);
+ N := 2;
+ Itm := cdr Itm;
+ while PairP Itm and
+ (not IntP LispVar PrinLength or N <= LispVar PrinLength) do
+ << ChannelWriteBlankOrEOL Channel;
+ RecursiveChannelPrin2(Channel, car Itm, Level);
+ N := N + 1;
+ Itm := cdr Itm >>;
+ if PairP Itm then
+ CheckLineFit(3, Channel, 'ChannelWriteString, " ...")
+ else
+ if Itm then
+ << CheckLineFit(3, Channel, 'ChannelWriteString, " . ");
+ RecursiveChannelPrin2(Channel, Itm, Level) >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char !) );
+end;
+
+syslsp procedure ChannelPrintPair(Channel, Itm, Level);
+ if IntP LispVar PrinLevel and Level >= LispVar PrinLevel then
+ ChannelWriteChar(Channel, char '!#)
+ else
+begin scalar N;
+ Level := Level + 1;
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char !( );
+ if not IntP LispVar PrinLength or 1 <= LispVar PrinLength then
+ << RecursiveChannelPrin1(Channel, car Itm, Level);
+ N := 2;
+ Itm := cdr Itm;
+ while PairP Itm and
+ (not IntP LispVar PrinLength or N <= LispVar PrinLength) do
+ << ChannelWriteBlankOrEOL Channel;
+ RecursiveChannelPrin1(Channel, car Itm, Level);
+ N := N + 1;
+ Itm := cdr Itm >>;
+ if PairP Itm then
+ CheckLineFit(3, Channel, 'ChannelWriteString, " ...")
+ else
+ if Itm then
+ << CheckLineFit(3, Channel, 'ChannelWriteString, " . ");
+ RecursiveChannelPrin1(Channel, Itm, Level) >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char !) );
+end;
+
+syslsp procedure ChannelWriteVector(Channel, Vec, Level);
+ if IntP LispVar PrinLevel and Level >= LispVar PrinLevel then
+ ChannelWriteChar(Channel, char '!#)
+ else
+begin scalar Len, I;
+ Level := Level + 1;
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '![ );
+ Len := VecLen VecInf Vec;
+ If Len<0 then
+ return CheckLineFit(1, Channel, 'ChannelWriteChar, char '!] );
+ I := 0;
+LoopBegin:
+ if not IntP LispVar PrinLength or I < LispVar PrinLength then
+ << RecursiveChannelPrin2(Channel, VecItm(VecInf Vec, I), Level);
+ if (I := I + 1) <= Len then
+ << ChannelWriteBlankOrEOL Channel;
+ goto LoopBegin >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '!] );
+end;
+
+syslsp procedure ChannelPrintVector(Channel, Vec, Level);
+ if IntP LispVar PrinLevel and Level >= LispVar PrinLevel then
+ ChannelWriteChar(Channel, char '!#)
+ else
+begin scalar Len, I;
+ Level := Level + 1;
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '![ );
+ Len := VecLen VecInf Vec;
+ If Len<0 then
+ return CheckLineFit(1, Channel, 'ChannelWriteChar, char '!] );
+ I := 0;
+LoopBegin:
+ if not IntP LispVar PrinLength or I < LispVar PrinLength then
+ << RecursiveChannelPrin1(Channel, VecItm(VecInf Vec, I), Level);
+ if (I := I + 1) <= Len then
+ << ChannelWriteBlankOrEOL Channel;
+ goto LoopBegin >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '!] );
+end;
+
+syslsp procedure ChannelWriteEVector(Channel, EVec, Level);
+begin
+ scalar handler;
+ if IntP LispVar PrinLevel and Level >= LispVar PrinLevel then
+ ChannelWriteChar(Channel, char '!#)
+ else
+ if getd('object!-get!-handler!-quietly)
+ and (handler :=
+ object!-get!-handler!-quietly(EVec, 'ChannelPrin)) then
+ apply(handler, list(EVec, Channel, Level, NIL))
+ else
+ << ChannelWriteString(Channel, "#<EVector ");
+ ChannelWriteSysInteger(Channel, EVecInf EVec,
+ CompressedBinaryRadix);
+ ChannelWriteChar(Channel, char '!>); >>;
+end;
+
+syslsp procedure ChannelPrintEVector(Channel, EVec, Level);
+begin
+ scalar handler;
+ if IntP LispVar PrinLevel and Level >= LispVar PrinLevel then
+ ChannelWriteChar(Channel, char '!#)
+ else
+ if getd('object!-get!-handler!-quietly)
+ and (handler :=
+ object!-get!-handler!-quietly(EVec, 'ChannelPrin)) then
+ apply(handler, list(EVec, Channel, Level, T))
+ else
+ << ChannelWriteString(Channel, "#<EVector ");
+ ChannelWriteSysInteger(Channel, EVecInf EVec,
+ CompressedBinaryRadix);
+ ChannelWriteChar(Channel, char '!>); >>;
+end;
+
+syslsp procedure ChannelWriteWords(Channel, Itm);
+begin scalar Len, I;
+ ChannelWriteString(Channel, "#<Words:");
+ Len := WrdLen WrdInf Itm;
+ if Len < 0 then
+ return CheckLineFit(1, Channel, 'ChannelWriteChar, char '!> );
+ I := 0;
+LoopBegin:
+ if not IntP LispVar PrinLength or I < LispVar PrinLength then
+ << CheckLineFit(10, Channel, 'ChannelWriteInteger, WrdItm(WrdInf Itm, I));
+ if (I := I + 1) <= Len then
+ << ChannelWriteBlankOrEOL Channel;
+ goto LoopBegin >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '!> );
+end;
+
+syslsp procedure ChannelWriteHalfWords(Channel, Itm);
+begin scalar Len, I;
+ ChannelWriteString(Channel, "#<Halfwords:");
+ Len := HalfWordLen HalfWordInf Itm;
+ if Len < 0 then
+ return CheckLineFit(1, Channel, 'ChannelWriteChar, char '!> );
+ I := 0;
+LoopBegin:
+ if not IntP LispVar PrinLength or I < LispVar PrinLength then
+ << CheckLineFit(10, Channel, 'ChannelWriteInteger,
+ HalfWordItm(HalfWordInf Itm, I));
+ if (I := I + 1) <= Len then
+ << ChannelWriteBlankOrEOL Channel;
+ goto LoopBegin >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '!> );
+end;
+
+syslsp procedure ChannelWriteBytes(Channel, Itm);
+begin scalar Len, I;
+ ChannelWriteString(Channel, "#<Bytes:");
+ Len := StrLen StrInf Itm;
+ if Len < 0 then
+ return CheckLineFit(1, Channel, 'ChannelWriteChar, char '!> );
+ I := 0;
+LoopBegin:
+ if not IntP LispVar PrinLength or I < LispVar PrinLength then
+ << CheckLineFit(10, Channel, 'ChannelWriteInteger, StrByt(StrInf Itm, I));
+ if (I := I + 1) <= Len then
+ << ChannelWriteBlankOrEOL Channel;
+ goto LoopBegin >> >>
+ else
+ CheckLineFit(3, Channel, 'ChannelWriteString, "...");
+ CheckLineFit(1, Channel, 'ChannelWriteChar, char '!> );
+end;
+
+syslsp procedure ChannelPrin2(Channel, Itm); %. Display Itm on Channel
+ RecursiveChannelPrin2(Channel, Itm, 0);
+
+syslsp procedure RecursiveChannelPrin2(Channel, Itm, Level);
+<< case Tag Itm of
+ PosInt, NegInt:
+ CheckLineFit(10, Channel, 'ChannelWriteInteger, Itm);
+ ID:
+ CheckLineFit(StrLen StrInf SymNam IDInf Itm + 1,
+ Channel, 'ChannelWriteID, Itm);
+ UNBOUND:
+ CheckLineFit(StrLen StrInf SymNam IDInf Itm + 12,
+ Channel, 'ChannelWriteUnbound, Itm);
+ STR:
+ CheckLineFit(StrLen StrInf Itm + 1,
+ Channel, 'ChannelWriteString, Itm);
+ CODE:
+ CheckLineFit(14, Channel, 'ChannelWriteCodePointer, Itm);
+ FIXN:
+ CheckLineFit(20, Channel, 'ChannelWriteFixnum, Itm);
+ FLTN:
+ CheckLineFit(30, Channel, 'ChannelWriteFloat, Itm);
+ WRDS:
+ ChannelWriteWords(Channel, Itm);
+ Halfwords:
+ ChannelWriteHalfWords(Channel, Itm);
+ Bytes:
+ ChannelWriteBytes(Channel, Itm);
+ PAIR:
+ ChannelWritePair(Channel, Itm, Level);
+ VECT:
+ ChannelWriteVector(Channel, Itm, Level);
+ EVECT:
+ ChannelWriteEVector(Channel, Itm, Level);
+ default:
+ CheckLineFit(20, Channel, 'ChannelWriteUnknownItem, Itm)
+ end;
+ Itm >>;
+
+syslsp procedure Prin2 Itm; %. ChannelPrin2 to current channel
+ ChannelPrin2(LispVar OUT!*, Itm);
+
+syslsp procedure ChannelPrin1(Channel, Itm); %. Display Itm in READable form
+ RecursiveChannelPrin1(Channel, Itm, 0);
+
+syslsp procedure RecursiveChannelPrin1(Channel, Itm, Level);
+<< case Tag Itm of
+ PosInt, NegInt:
+ CheckLineFit(10, Channel, 'ChannelWriteInteger, Itm);
+ ID: % leave room for possible escape chars
+ CheckLineFit(StrLen StrInf SymNam IDInf Itm + 5,
+ Channel, 'ChannelPrintID, Itm);
+ UNBOUND: % leave room for possible escape chars
+ CheckLineFit(StrLen StrInf SymNam IDInf Itm + 16,
+ Channel, 'ChannelPrintUnbound, Itm);
+ STR:
+ CheckLineFit(StrLen StrInf Itm + 4,
+ Channel, 'ChannelPrintString, Itm);
+ CODE:
+ CheckLineFit(14, Channel, 'ChannelWriteCodePointer, Itm);
+ FIXN:
+ CheckLineFit(20, Channel, 'ChannelWriteFixnum, Itm);
+ FLTN:
+ CheckLineFit(20, Channel, 'ChannelWriteFloat, Itm);
+ WRDS:
+ ChannelWriteWords(Channel, Itm);
+ Halfwords:
+ ChannelWriteHalfWords(Channel, Itm);
+ Bytes:
+ ChannelWriteBytes(Channel, Itm);
+ PAIR:
+ ChannelPrintPair(Channel, Itm, Level);
+ VECT:
+ ChannelPrintVector(Channel, Itm, Level);
+ EVECT:
+ ChannelPrintEVector(Channel, Itm, Level);
+ default:
+ CheckLineFit(20, Channel, 'ChannelWriteUnknownItem, Itm)
+ end;
+ Itm >>;
+
+syslsp procedure Prin1 Itm; %. ChannelPrin1 to current output
+ ChannelPrin1(LispVar OUT!*, Itm);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/printf.red
Index: psl-1983/3-1/kernel/printf.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/printf.red
@@ -0,0 +1,210 @@
+%
+% PRINTF.RED - Formatted print routine
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>PRINTF.RED.2, 17-Sep-82 16:01:01, Edit by BENSON
+% Added ChannelPrintF
+% <PSL.INTERP>PRINTF.RED.6, 3-May-82 10:45:11, Edit by BENSON
+% %L prints nothing for NIL
+% <PSL.INTERP>PRINTF.RED.9, 23-Feb-82 21:40:31, Edit by BENSON
+% Added %x for hex
+% <PSL.INTERP>PRINTF.RED.7, 1-Dec-81 16:11:11, Edit by BENSON
+% Changed to cause error for unknown character
+
+CompileTime flag('(PrintF1 PrintF2), 'InternalFunction);
+
+fluid '(FormatForPrintF!*);
+
+% First, lambda-bind FormatForPrintF!*
+
+lisp procedure PrintF(FormatForPrintF!*, A1, A2, A3, A4, A5,
+ A6, A7, A8, A9, A10,
+ A11, A12, A13, A14);
+ PrintF1(FormatForPrintF!*, A1, A2, A3, A4, A5,
+ A6, A7, A8, A9, A10,
+ A11, A12, A13, A14);
+
+
+% Then, push all the registers on the stack and set up a pointer to them
+
+lap '((!*entry PrintF1 expr 15)
+ (!*PUSH (reg 2))
+ (!*LOC (reg 1) (frame 1))
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 4))
+ (!*PUSH (reg 5))
+ (!*PUSH (reg 6))
+ (!*PUSH (reg 7))
+ (!*PUSH (reg 8))
+ (!*PUSH (reg 9))
+ (!*PUSH (reg 10))
+ (!*PUSH (reg 11))
+ (!*PUSH (reg 12))
+ (!*PUSH (reg 13))
+ (!*PUSH (reg 14))
+ (!*PUSH (reg 15))
+ (!*CALL PrintF2)
+ (!*EXIT 14)
+);
+
+on SysLisp;
+
+% Finally, actual printf, with 1 argument, pointer to array of parameters
+
+syslsp procedure PrintF2 PrintFArgs; %. Formatted print
+%
+% Format is a string, either in the heap or not, whose characters will be
+% written on the currently selected output channel. The exception to this is
+% that when a % is encountered, the following character is interpreted as a
+% format character, to decide how to print one of the other arguments. The
+% following format characters are currently supported:
+% %b - blanks; take the next argument as integer and print that many
+% blanks
+% %c - print the next argument as a single character
+% %d - print the next argument as a decimal integer
+% %e - EVALs the next argument for side-effect -- most useful if the
+% thing EVALed does some printing
+% %f - fresh-line, print end-of-line char if not at beginning of line
+% %l - same as %w, except lists are printed without top level parens
+% %n - print end-of-line character
+% %o - print the next argument as an octal integer
+% %p - print the next argument as a Lisp item, using Prin1
+% %r - print the next argument as a Lisp item, using ErrPrin (`FOO')
+% %s - print the next argument as a string
+% %t - tab; take the next argument as an integer and
+% print spaces to that column
+% %w - print the next argument as a Lisp item, using Prin2
+% %x - print the next argument as a hexidecimal integer
+% %% - print a %
+%
+% If the character is not one of these (either upper or lower case), then an
+% error occurs.
+%
+begin scalar UpLim, I, Ch, UpCh;
+ UpLim := StrLen StrInf LispVar FormatForPrintF!*;
+ I := 0;
+ while I <= UpLim do
+ << Ch := StrByt(StrInf LispVar FormatForPrintF!*, I);
+ if Ch neq char !% then
+ WriteChar Ch
+ else
+ begin
+ I := I + 1;
+ Ch := StrByt(StrInf LispVar FormatForPrintF!*, I);
+ UpCh := if LowerCaseChar Ch then RaiseChar Ch else Ch;
+ case UpCh of
+ char B:
+ << Spaces @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char C:
+ << WriteChar @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char D:
+ << WriteSysInteger(@PrintFArgs, 10);
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char E:
+ << Eval @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char F:
+ if Posn() > 0 then WriteChar char EOL;
+ char L:
+ << Prin2L @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char N:
+ WriteChar char EOL;
+ char O:
+ << WriteSysInteger(@PrintFArgs, 8);
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char X:
+ << WriteSysInteger(@PrintFArgs, 16);
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char P:
+ << Prin1 @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char R:
+ << ErrPrin @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char S:
+ << WriteString @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char T:
+ << Tab @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char W:
+ << Prin2 @PrintFArgs;
+ PrintFArgs := &PrintFArgs[StackDirection] >>;
+ char !%:
+ WriteChar char !%;
+ default:
+ StdError BldMsg('"Unknown character code for PrintF: %r",
+ MkID Ch);
+ end;
+ end;
+ I := I + 1 >>;
+end;
+
+syslsp procedure ErrorPrintF(Format, A1, A2, A3, A4); % also A5..A14
+begin scalar SaveChannel;
+ SaveChannel := WRS LispVar ErrOut!*;
+ if LinePosition[IntInf LispVar ErrOut!*] > 0 then TerPri();
+ PrintF(Format, A1, A2, A3, A4);
+ if LinePosition[IntInf LispVar ErrOut!*] > 0 then TerPri();
+ WRS SaveChannel;
+end;
+
+syslsp procedure ToStringWriteChar(Channel, Ch); % shares TokenBuffer
+<< if TokenBuffer[0] >= MaxTokenSize - 1 then
+ << TokenBuffer[0] := 80; % truncate to 80 chars
+ StrByt(TokenBuffer, 80) := char NULL;
+ StdError list('"Buffer overflow while constructing error message:",
+ LispVar FormatForPrintF!*,
+ '"The truncated result was:",
+ CopyString MkSTR TokenBuffer) >>
+ else
+ << TokenBuffer[0] := TokenBuffer[0] + 1;
+ StrByt(TokenBuffer, TokenBuffer[0]) := Ch >> >>;
+
+syslsp procedure BldMsg(Format, Args1, Args2, Args3, Args4); %. Print to string
+begin scalar TempChannel; % takes up to 14 args
+ LinePosition[2] := 0;
+ TokenBuffer[0] := -1;
+ TempChannel := LispVar OUT!*;
+ LispVar OUT!* := '2;
+ PrintF(Format, Args1, Args2, Args3, Args4);
+ StrByt(TokenBuffer, TokenBuffer[0] + 1) := char NULL;
+ LispVar OUT!* := TempChannel;
+ return CopyString TokenBuffer;
+end;
+
+syslsp procedure ErrPrin U; %. `Prin1 with quotes'
+<< WriteChar char !`;
+ Prin1 U;
+ WriteChar char !' >>;
+
+off SysLisp;
+
+lisp procedure Prin2L Itm; %. Prin2 without top-level parens
+ if null Itm then NIL % NIL is (), print nothing
+ else if not PairP Itm then Prin2 Itm
+ else
+ << while << Prin2 car Itm;
+ Itm := cdr Itm;
+ PairP Itm >> do
+ ChannelWriteBlankOrEOL OUT!*;
+ if Itm then
+ << ChannelWriteBlankOrEOL OUT!*;
+ Prin2 Itm >> >>;
+
+syslsp procedure ChannelPrintF(OUT!*, Format, A1, A2, A3, A4, A5, A6, A7, A8,
+ A9, A10, A11, A12, A13);
+ PrintF(Format, A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, A11, A12, A13);
+
+
+END;
ADDED psl-1983/3-1/kernel/prog-and-friends.red
Index: psl-1983/3-1/kernel/prog-and-friends.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/prog-and-friends.red
@@ -0,0 +1,70 @@
+%
+% PROG-AND-FRIENDS.RED - PROG, GO, and RETURN
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>PROG-AND-FRIENDS.RED.2, 11-Oct-82 17:55:57, Edit by BENSON
+% Changed CATCH/THROW to *CATCH/*THROW
+
+% Error numbers:
+% 3000 - Unknown label
+% 3100 - outside the scope of a PROG
+% +1 in GO
+% +2 in RETURN
+
+fluid '(ProgJumpTable!* % A-List of labels and expressions
+ ProgBody!*); % Tail of the current PROG
+
+fexpr procedure Prog ProgBody!*; %. Program feature function
+begin scalar ProgJumpTable!*, N, Result;
+ if not PairP ProgBody!* then return NIL;
+ N := 0;
+ for each X in car ProgBody!* do
+ << PBind1 X;
+ N := N + 1 >>;
+ ProgBody!* := cdr ProgBody!*;
+ for each X on ProgBody!* do
+ if IDP car X then
+ ProgJumpTable!* := X . ProgJumpTable!*;
+ while << while PairP ProgBody!* and IDP car ProgBody!* do
+ ProgBody!* := cdr ProgBody!*; % skip over labels
+ PairP ProgBody!* >> do % eval the expression
+ << Result := !*Catch('!$Prog!$, Eval car ProgBody!*);
+ if not ThrowSignal!* then
+ << Result := NIL;
+ ProgBody!* := cdr ProgBody!* >> >>;
+ UnBindN N;
+ return Result;
+end;
+
+lisp fexpr procedure GO U; %. Goto label within PROG
+begin scalar NewProgBody;
+ return if ProgBody!* then
+ << NewProgBody := Atsoc(car U, ProgJumpTable!*);
+ if null NewProgBody then
+ ContinuableError(3001,
+ BldMsg(
+ "%r is not a label within the current scope", car U),
+ 'GO . U)
+ else
+ << ProgBody!* := NewProgBody;
+ !*Throw('!$Prog!$, NIL) >> >>
+ else ContinuableError(3101,
+ "GO attempted outside the scope of a PROG",
+ 'GO . U);
+end;
+
+lisp procedure Return U; %. Return value from PROG
+ if ProgBody!* then
+ << ProgBody!* := NIL;
+ !*Throw('!$Prog!$, U) >>
+ else ContError(3102, "RETURN attempted outside the scope of a PROG",
+ Return U);
+
+END;
ADDED psl-1983/3-1/kernel/prop.build
Index: psl-1983/3-1/kernel/prop.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/prop.build
@@ -0,0 +1,15 @@
+%
+% PROP.BUILD - Files with functions for property lists and function definition
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "function-primitives.red"$ % used by PutD, GetD and Eval
+PathIn "property-list.red"$ % PUT and FLAG and friends
+PathIn "fluid-global.red"$ % variable declarations
+PathIn "putd-getd.red"$ % function defining functions
ADDED psl-1983/3-1/kernel/property-list.red
Index: psl-1983/3-1/kernel/property-list.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/property-list.red
@@ -0,0 +1,144 @@
+%
+% PROPERTY-LIST.RED - Functions dealing with property lists
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.INTERP>PROPERTY-LIST.RED.11, 1-Mar-82 14:09:20, Edit by BENSON
+% Changed "move-to-front" to "exchange-with-previous"
+% <PSL.INTERP>PROPERTY-LIST.RED.7, 27-Feb-82 12:43:27, Edit by BENSON
+% Optimized GET and FLAGP, rearranges property list
+
+% Every ID in the system has a property list. It is obtained by the function
+% PROP(ID) and updated with the function SETPROP(ID, PLIST). These functions
+% are not in the Standard Lisp report, and are not intended for use in user
+% programs. A property list (whose format should also not be known to
+% user programs) is a list of IDs and dotted pairs (A-List entries). The
+% pairs are used by PUT and GET, and the IDs are used by FLAG and FLAGP.
+
+% Non-Standard Lisp functions used:
+% DELQIP -- EQ, destructive version of Delete (in EASY-NON-SL.RED)
+% ATSOC -- EQ version of ASSOC (in EASY-NON-SL.RED)
+% DELATQIP -- EQ, destructive version of DELASC (in EASY-NON-SL.RED)
+% EQCAR(A,B) -- PairP A and car A eq B (in EASY-NON-SL.RED)
+% NonIDError -- in TYPE-ERRORS.RED
+
+on SysLisp;
+
+syslsp procedure Prop U; %. Access property list of U
+ if IDP U then SymPrp IDInf U
+ else NonIDError(U, 'Prop);
+
+syslsp procedure SetProp(U, L); %. Store L as property list of U
+ if IDP U then
+ SymPrp IDInf U := L
+ else
+ NonIDError(U, 'SetProp);
+
+syslsp procedure FlagP(U, Indicator); %. Is U marked with Indicator?
+ if not IDP U or not IDP Indicator then NIL
+ else begin scalar PL, PreviousPointer;
+ PL := SymPrp IDInf U;
+ if null PL then return NIL;
+ if car PL eq Indicator then return T;
+ PreviousPointer := PL;
+ PL := cdr PL;
+Loop:
+ if null PL then return NIL;
+ if car PL eq Indicator then return
+ << Rplaca(PL, car PreviousPointer);
+ Rplaca(PreviousPointer, Indicator);
+ T >>;
+ PreviousPointer := PL;
+ PL := cdr PL;
+ goto Loop;
+ end;
+
+on FastLinks;
+
+syslsp procedure GetFnType U;
+ get(U, 'TYPE);
+
+off FastLinks;
+
+syslsp procedure Get(U, Indicator); %. Retrieve value stored for U with Ind
+ if not IDP U or not IDP Indicator then NIL
+ else begin scalar PL, X, PreviousPointer;
+ PL := SymPrp IDInf U;
+ if null PL then return NIL;
+ X := car PL;
+ if PairP X and car X eq Indicator then return cdr X;
+ PreviousPointer := PL;
+ PL := cdr PL;
+Loop:
+ if null PL then return NIL;
+ X := car PL;
+ if PairP X and car X eq Indicator then return
+ << Rplaca(PL, car PreviousPointer);
+ Rplaca(PreviousPointer, X);
+ cdr X >>;
+ PreviousPointer := PL;
+ PL := cdr PL;
+ goto Loop;
+ end;
+
+off SysLisp;
+
+lisp procedure Flag(IDList, Indicator); %. Mark all in IDList with Indicator
+ if not IDP Indicator then
+ NonIDError(Indicator, 'Flag)
+ else
+ for each U in IDList do Flag1(U, Indicator);
+
+lisp procedure Flag1(U, Indicator);
+ if not IDP U then
+ NonIDError(U, 'Flag)
+ else begin scalar PL;
+ PL := Prop U;
+ if not (Indicator memq PL) then SetProp(U, Indicator . PL);
+ end;
+
+lisp procedure RemFlag(IDList, Indicator); %. Remove marking of all in IDList
+ if not IDP Indicator then
+ NonIDError(Indicator, 'RemFlag)
+ else
+ for each U in IDList do RemFlag1(U, Indicator);
+
+lisp procedure RemFlag1(U, Indicator);
+ if not IDP U then
+ NonIDError(U, 'RemFlag)
+ else SetProp(U, DelQIP(Indicator, Prop U));
+
+
+lisp procedure Put(U, Indicator, Val); %. Store Val in U with Indicator
+ if not IDP U then
+ NonIDError(U, 'Put)
+ else if not IDP Indicator then
+ NonIDError(Indicator, 'Put)
+ else begin scalar PL, V;
+ PL := Prop U;
+ if not (V := Atsoc(Indicator, PL)) then
+ SetProp(U, (Indicator . Val) . PL)
+ else
+ RPlacD(V, Val);
+ return Val;
+ end;
+
+lisp procedure RemProp(U, Indicator); %. Remove value of U with Indicator
+ if not IDP U or not IDP Indicator then NIL
+ else begin scalar V;
+ if (V := get(U, Indicator)) then
+ SetProp(U, DelAtQIP(Indicator, Prop U));
+ return V;
+ end;
+
+
+lisp procedure RemPropL(L, Indicator); %. RemProp for all IDs in L
+ for each X in L do RemProp(X, Indicator);
+
+END;
ADDED psl-1983/3-1/kernel/putd-getd.red
Index: psl-1983/3-1/kernel/putd-getd.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/putd-getd.red
@@ -0,0 +1,122 @@
+%
+% PUTD-GETD.RED - Standard Lisp function defining functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>PUTD-GETD.RED.3, 13-Jan-83 19:09:47, Edit by PERDUE
+% Removed obsolete code from PUTD in response to Bobbie Othmer's bug report
+% <PSL.KERNEL>PUTD-GETD.RED.2, 24-Sep-82 15:01:38, Edit by BENSON
+% Added CODE-NUMBER-OF-ARGUMENTS
+% <PSL.INTERP>PUTD-GETD.RED.3, 19-Apr-82 13:10:57, Edit by BENSON
+% Function in PutD may be an ID
+% <PSL.INTERP>PUTD-GETD.RED.4, 6-Jan-82 19:18:47, Edit by GRISS
+% Add NEXPR
+% DE, DF and DM are defined in EASY-SL.RED
+
+% If the function is interpreted, the lambda form will be found by
+% GET(ID, '!*LambdaLink).
+
+% If the type of a function is other than EXPR (i.e. FEXPR or MACRO or NEXPR),
+% this will be indicated by GET(ID, 'TYPE) = 'FEXPR or 'MACRO or 'NEXPR
+
+
+% PutD makes use of the fact that FLUID and GLOBAL declarations use the
+% property list indicator TYPE
+
+% Non-Standard Lisp functions used:
+% function cell primitives FUnBoundP, etc. found in FUNCTION-PRIMITVES.RED
+% CompD -- in COMPILER.RED
+% ErrorPrintF, VerboseTypeError, BldMsg
+
+% Error numbers:
+% 1100 - ill-formed function expression
+% 1300 - unknown function type
+% +5 in GetD
+
+lisp procedure GetD U; %. Lookup function definition of U
+ IDP U and not FUnBoundP U and ((get(U, 'TYPE) or 'EXPR) .
+ (if FLambdaLinkP U then get(U, '!*LambdaLink) else GetFCodePointer U));
+
+lisp procedure RemD U; %. Remove function definition of U
+begin scalar OldGetD;
+ if (OldGetD := GetD U) then
+ << MakeFUnBound U;
+ RemProp(U, 'TYPE);
+ RemProp(U, '!*LambdaLink) >>;
+ return OldGetD;
+end;
+
+fluid '(!*RedefMSG % controls printing of redefined
+ !*UserMode); % controls query for redefinition
+LoadTime
+<< !*UserMode := NIL; % start in system mode
+ !*RedefMSG := T >>; % message in PutD
+
+fluid '(!*Comp % controls automatic compilation
+ PromptString!*);
+
+lisp procedure PutD(FnName, FnType, FnExp); %. Install function definition
+%
+% this differs from the SL Report in 2 ways:
+% - function names flagged LOSE are not defined.
+% - " " which are already fluid or global are defined anyway,
+% with a warning.
+%
+ if not IDP FnName then
+ NonIDError(FnName, 'PutD)
+ else if not (FnType memq '(EXPR FEXPR MACRO NEXPR)) then
+ ContError(1305,
+ "%r is not a legal function type",
+ FnType,
+ PutD(FnName, FnType, FnExp))
+ else if FlagP(FnName, 'LOSE) then
+ << ErrorPrintF("*** %r has not been defined, because it is flagged LOSE",
+ FnName);
+ NIL >>
+ else begin scalar VarType, PrintRedefinedMessage, OldIN, PromptString!*,
+ QueryResponse;
+ if not FUnBoundP FnName then
+ << if !*RedefMSG then PrintRedefinedMessage := T;
+ if !*UserMode and not FlagP(FnName, 'USER) then
+ if not YesP BldMsg(
+ "Do you really want to redefine the system function %r?",
+ FnName)
+ then return NIL
+ else Flag1(FnName, 'USER) >>;
+ if CodeP FnExp then
+ << MakeFCode(FnName, FnExp);
+ RemProp(FnName, '!*LambdaLink) >>
+ else if IDP FnExp and not FUnBoundP FnExp then return
+ PutD(FnName, FnType, cdr GetD FnExp)
+ else if !*Comp then
+ return CompD(FnName, FnType, FnExp)
+ else if EqCar(FnExp, 'LAMBDA) then
+ << put(FnName, '!*LambdaLink, FnExp);
+ MakeFLambdaLink FnName >>
+ else return ContError(1105,
+ "Ill-formed function expression in PutD",
+ PutD(FnName, FnType, FnExp));
+ if FnType neq 'EXPR then put(FnName, 'TYPE, FnType)
+ else RemProp(FnName, 'TYPE);
+ if !*UserMode then Flag1(FnName, 'USER) else RemFlag1(FnName, 'USER);
+ if PrintRedefinedMessage then
+ ErrorPrintF("*** Function %r has been redefined", FnName);
+ return FnName;
+ end;
+
+on Syslisp;
+
+syslsp procedure code!-number!-of!-arguments cp;
+begin scalar n;
+ return if codep cp then
+ << n := !%code!-number!-of!-arguments CodeInf cp;
+ if n >= 0 and n <= MaxArgs then n >>;
+end;
+
+END;
ADDED psl-1983/3-1/kernel/randm.build
Index: psl-1983/3-1/kernel/randm.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/randm.build
@@ -0,0 +1,18 @@
+%
+% RANDM.BUILD - Miscellaneous interpreter files
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "known-to-comp-sl.red"$ % SL functions performed inline in code
+PathIn "others-sl.red"$ % DIGIT, LITER and LENGTH
+PathIn "equal.red"$ % equality predicates
+PathIn "carcdr.red"$ % CDDDDR, etc.
+PathIn "easy-sl.red"$ % highly portable SL function defns
+PathIn "easy-non-sl.red"$ % simple, ubiquitous SL extensions
+PathIn "sets.red"$ % Set manipulation functions
ADDED psl-1983/3-1/kernel/rds-wrs.red
Index: psl-1983/3-1/kernel/rds-wrs.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/rds-wrs.red
@@ -0,0 +1,50 @@
+%
+% RDS-WRS.RED - Switch the current input or output channel
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+global '(SpecialRDSAction!* % possibly apply to old and new channel
+ SpecialWRSAction!* % ditto
+ IN!* % Current input channel
+ OUT!*); % Current output channel
+
+fluid '(StdIN!* % Standard input - may be rebound
+ StdOUT!*); % Standard output - may be rebound
+
+on SysLisp;
+
+syslsp procedure RDS Channel; %. Switch input channels, return old
+begin scalar OldIN, ReadFn;
+ if LispVar SpecialRDSAction!* then
+ Apply(LispVar SpecialRDSAction!*, list(LispVar IN!*, Channel));
+ OldIN := LispVar IN!*;
+ if null Channel then Channel := LispVar StdIN!*;
+ ReadFn := ReadFunction[IntInf Channel];
+ if ReadFn eq 'ChannelNotOpen or ReadFn eq 'WriteOnlyChannel then return
+ ChannelError(Channel, "Channel not open for input in RDS");
+ LispVar IN!* := Channel;
+ return OldIN;
+end;
+
+syslsp procedure WRS Channel; %. Switch output channels, return old
+begin scalar OldOUT, WriteFn;
+ if LispVar SpecialWRSAction!* then
+ Apply(LispVar SpecialWRSAction!*, list(LispVar OUT!*, Channel));
+ OldOUT := LispVar OUT!*;
+ if null Channel then Channel := LispVar StdOUT!*;
+ WriteFn := WriteFunction[IntInf Channel];
+ if WriteFn eq 'ChannelNotOpen or WriteFn eq 'ReadOnlyChannel then return
+ ChannelError(Channel, "Channel not open for output in WRS");
+ LispVar OUT!* := Channel;
+ return OldOUT;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/read.red
Index: psl-1983/3-1/kernel/read.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/read.red
@@ -0,0 +1,132 @@
+%
+% READ.RED - S-expression parser
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 03-Mar-83 Nancy Kendzierski
+% Changed declaration of LispScanTable!* from global to fluid.
+% <PSL.KERNEL>READ.RED.6, 20-Oct-82 11:07:28, Edit by BENSON
+% Extra right paren in file only prints warning, not error
+% <PSL.KERNEL>READ.RED.5, 6-Oct-82 11:37:33, Edit by BENSON
+% Took away CATCH in READ, EOF error binds *InsideStructureRead to NIL
+% <PSL.KERNEL>READ.RED.2, 20-Sep-82 11:24:32, Edit by BENSON
+% Right parens at top level cause an error in a file
+% <PSL.INTERP>READ.RED.6, 2-Sep-82 14:07:37, Edit by BENSON
+% Right parens are ignored at the top level
+
+fluid '(CurrentReadMacroIndicator!* % Get to find read macro function
+ CurrentScanTable!* % vector of character types
+ LispScanTable!* % CurrentScanTable!* when READing
+ !*InsideStructureRead); % indicates within compound read
+
+global '(TokType!* % Set by token scanner, type of token
+ IN!* % Current input channel
+ !$EOF!$); % has value returned when EOF is read
+
+CurrentReadMacroIndicator!* := 'LispReadMacro;
+
+CompileTime flag('(DotContextError), 'InternalFunction);
+
+lisp procedure ChannelReadTokenWithHooks Channel; % Scan token w/read macros
+%
+% This is ReadToken with hooks for read macros
+%
+begin scalar Tkn, Fn;
+ Tkn := ChannelReadToken Channel;
+ if TokType!* eq 3 and (Fn := get(Tkn, CurrentReadMacroIndicator!*)) then
+ return IDApply2(Channel, Tkn, Fn);
+ return Tkn;
+end;
+
+lisp procedure ChannelRead Channel; %. Parse S-expression from channel
+begin scalar CurrentScanTable!*, CurrentReadMacroIndicator!*;
+ CurrentScanTable!* := LispScanTable!*;
+ CurrentReadMacroIndicator!* := 'LispReadMacro;
+ return ChannelReadTokenWithHooks Channel;
+end;
+
+lisp procedure Read(); %. Parse S-expr from current input
+<< MakeInputAvailable();
+ ChannelRead IN!* >>;
+
+lisp procedure ChannelReadEof(Channel, Ef); % Handle end-of-file in Read
+ if !*InsideStructureRead then return
+ begin scalar !*InsideStructureRead;
+ return
+ StdError BldMsg("Unexpected EOF while reading on channel %r",
+ Channel);
+ end else !$EOF!$;
+
+lisp procedure ChannelReadQuotedExpression(Channel, Qt); % read macro '
+ MkQuote ChannelReadTokenWithHooks Channel;
+
+lisp procedure ChannelReadListOrDottedPair(Channel, Pa); % read macro (
+%
+% Read list or dotted pair. Collect items until closing right paren.
+% Check for dot context errors.
+%
+begin scalar Elem, StartPointer, EndPointer, !*InsideStructureRead;
+ !*InsideStructureRead := T;
+ Elem := ChannelReadTokenWithHooks Channel;
+ if TokType!* eq 3 then
+ if Elem eq '!. then return DotContextError()
+ else if Elem eq '!) then return NIL;
+ StartPointer := EndPointer := list Elem;
+LoopBegin:
+ Elem := ChannelReadTokenWithHooks Channel;
+ if TokType!* eq 3 then
+ if Elem eq '!) then return StartPointer
+ else if Elem eq '!. then
+ << Elem := ChannelReadTokenWithHooks Channel;
+ if TokType!* eq 3 and (Elem eq '!) or Elem eq '!.) then
+ return DotContextError()
+ else
+ << RplacD(EndPointer, Elem);
+ Elem := ChannelReadTokenWithHooks Channel;
+ if TokType!* eq 3 and Elem eq '!) then return StartPointer
+ else return DotContextError() >> >>;
+% If we had splice macros, I think they would be checked here
+ RplacD(EndPointer, list Elem);
+ EndPointer := cdr EndPointer;
+ goto LoopBegin;
+end;
+
+lisp procedure ChannelReadRightParen(Channel, Tok);
+% Ignore right parens at the top
+ if !*InsideStructureRead then Tok
+ else
+ << if not (Channel eq StdIN!*) then % if not reading from the terminal
+ ErrorPrintF "*** Unmatched right parenthesis";
+ ChannelReadTokenWithHooks Channel >>;
+
+lisp procedure DotContextError(); % Parsing error
+ IOError "Dot context error";
+
+% List2Vector is found in TYPE-CONVERSIONS.RED
+
+lisp procedure ChannelReadVector Channel; % read macro [
+begin scalar Elem, StartPointer, EndPointer, !*InsideStructureRead;
+ !*InsideStructureRead := T;
+ StartPointer := EndPointer := (NIL . NIL);
+ while << Elem := ChannelReadTokenWithHooks Channel;
+ TokType!* neq 3 or Elem neq '!] >> do
+ << RplacD(EndPointer, list Elem);
+ EndPointer := cdr EndPointer >>;
+ return List2Vector cdr StartPointer;
+end;
+
+StartupTime <<
+ put('!', 'LispReadMacro, function ChannelReadQuotedExpression);
+ put('!( , 'LispReadMacro, function ChannelReadListOrDottedPair);
+ put('!) , 'LispReadMacro, function ChannelReadRightParen);
+ put('![, 'LispReadMacro, function ChannelReadVector);
+ put(MkID char EOF, 'LispReadMacro, function ChannelReadEOF);
+>>;
+
+END;
ADDED psl-1983/3-1/kernel/sequence.red
Index: psl-1983/3-1/kernel/sequence.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/sequence.red
@@ -0,0 +1,341 @@
+%
+% SEQUENCE.RED - Useful functions on strings, vectors and lists
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>SEQUENCE.RED.2, 25-Jan-83 16:11:28, Edit by PERDUE
+% Removed Make-String, etc., moved to cons-mkvect.red
+% STRINGS pkg defines Make-String (differently and Common LISP compatibly)
+% <PSL.INTERP>SEQUENCE.RED.2, 27-Feb-82 00:46:03, Edit by BENSON
+% Started adding more vector types
+% <PSL.INTERP>STRING-OPS.RED.11, 6-Jan-82 20:41:16, Edit by BENSON
+% Changed String and Vector into Nexprs
+
+on SysLisp;
+
+% Indexing operations
+
+syslsp procedure Indx(R1, R2); %. Element of sequence
+begin scalar Tmp1, Tmp2;
+ if not PosIntP R2 then return IndexError(R2, 'Indx); % Subscript
+ Tmp1 := Inf R1;
+ Tmp2 := Tag R1;
+ return case Tmp2 of
+ Str, Bytes:
+ if R2 > StrLen Tmp1 then
+ RangeError(R1, R2, 'Indx)
+ else StrByt(Tmp1, R2);
+ Vect:
+ if R2 > VecLen Tmp1 then
+ RangeError(R1, R2, 'Indx)
+ else VecItm(Tmp1, R2);
+ Wrds:
+ if R2 > WrdLen Tmp1 then
+ RangeError(R1, R2, 'Indx)
+ else WrdItm(Tmp1, R2);
+ HalfWords:
+ if R2 > HalfWordLen Tmp1 then
+ RangeError(R1, R2, 'Indx)
+ else HalfWordItm(Tmp1, R2);
+ Pair:
+ << Tmp2 := R2;
+ while Tmp2 > 0 do
+ << R1 := cdr R1;
+ if atom R1 then RangeError(R1, R2, 'Indx);
+ Tmp2 := Tmp2 - 1 >>;
+ car R1 >>;
+ default:
+ NonSequenceError(R1, 'Indx);
+ end;
+end;
+
+syslsp procedure SetIndx(R1, R2, R3); %. Store at index of sequence
+begin scalar Tmp1, Tmp2;
+ if not PosIntP R2 then return IndexError(R2, 'SetIndx); % Subscript
+ Tmp1 := Inf R1;
+ Tmp2 := Tag R1;
+ return case Tmp2 of
+ Str, Bytes:
+ if R2 > StrLen Tmp1 then
+ RangeError(R1, R2, 'SetIndx)
+ else
+ << StrByt(Tmp1, R2) := R3;
+ R3 >>;
+ Vect:
+ if R2 > VecLen Tmp1 then
+ RangeError(R1, R2, 'SetIndx)
+ else
+ << VecItm(Tmp1, R2) := R3;
+ R3 >>;
+ Wrds:
+ if R2 > WrdLen Tmp1 then
+ RangeError(R1, R2, 'SetIndx)
+ else
+ << WrdItm(Tmp1, R2) := R3;
+ R3 >>;
+ HalfWords:
+ if R2 > HalfWordLen Tmp1 then
+ RangeError(R1, R2, 'SetIndx)
+ else
+ << HalfWordItm(Tmp1, R2) := R3;
+ R3 >>;
+ Pair:
+ << Tmp2 := R2;
+ while Tmp2 > 0 do
+ << R1 := cdr R1;
+ if atom R1 then RangeError(R1, R2, 'SetIndx);
+ Tmp2 := Tmp2 - 1 >>;
+ Rplaca(R1, R3);
+ R3 >>;
+ default:
+ NonSequenceError(R1, 'SetIndx);
+ end;
+end;
+
+% String and vector sub-part operations.
+
+syslsp procedure Sub(R1, R2, R3); %. Obsolete subsequence function
+ SubSeq(R1, R2, R2 + R3 + 1);
+
+syslsp procedure SubSeq(R1, R2, R3); % R2 is lower bound, R3 upper
+begin scalar NewSize, OldSize, NewItem;
+ if not PosIntP R2 then return IndexError(R2, 'SubSeq);
+ if not PosIntP R3 then return IndexError(R3, 'SubSeq);
+ NewSize := R3 - R2 - 1;
+ if NewSize < -1 then return RangeError(R1, R3, 'SubSeq);
+ return case Tag R1 of
+ Str, Bytes:
+ << OldSize := StrLen StrInf R1;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SubSeq)
+ else
+ << NewItem := GtSTR NewSize;
+ R3 := StrInf R1;
+ for I := 0 step 1 until NewSize do
+ StrByt(NewItem, I) := StrByt(R3, R2 + I);
+ case Tag R1 of
+ Str:
+ MkSTR NewItem;
+ Bytes:
+ MkBYTES NewItem;
+ end >> >>;
+ Vect:
+ << OldSize := VecLen VecInf R1;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SubSeq)
+ else
+ << NewItem := GtVECT NewSize;
+ R3 := VecInf R1;
+ for I := 0 step 1 until NewSize do
+ VecItm(NewItem, I) := VecItm(R3, R2 + I);
+ MkVEC NewItem >> >>;
+ Wrds:
+ << OldSize := WrdLen WrdInf R1;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SubSeq)
+ else
+ << NewItem := GtWRDS NewSize;
+ R3 := WrdInf R1;
+ for I := 0 step 1 until NewSize do
+ WrdItm(NewItem, I) := WrdItm(R3, R2 + I);
+ MkWRDS NewItem >> >>;
+ HalfWords:
+ << OldSize := HalfWordLen HalfWordInf R1;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SubSeq)
+ else
+ << NewItem := GtHalfWords NewSize;
+ R3 := HalfWordInf R1;
+ for I := 0 step 1 until NewSize do
+ HalfWordItm(NewItem, I) := HalfWordItm(R3, R2 + I);
+ MkHalfWords NewItem >> >>;
+ Pair:
+ << for I := 1 step 1 until R2 do
+ if PairP R1 then R1 := rest R1
+ else RangeError(R1, R2, 'SubSeq);
+ NewItem := NIL . NIL;
+ for I := 0 step 1 until NewSize do
+ if PairP R1 then
+ << TConc(NewItem, first R1);
+ R1 := rest R1 >>
+ else RangeError(R1, R3, 'SubSeq);
+ car NewItem >>;
+ default:
+ NonSequenceError(R1, 'SubSeq);
+ end;
+end;
+
+syslsp procedure SetSub(R1, R2, R3, R4); %. Obsolete subsequence function
+ SetSubSeq(R1, R2, R2 + R3 + 1, R4);
+
+syslsp procedure SetSubSeq(R1, R2, R3, R4); % R2 is lower bound, R3 upper
+begin scalar NewSize, OldSize, SubSize, NewItem;
+ if not PosIntP R2 then return IndexError(R2, 'SetSubSeq);
+ if not PosIntP R3 then return IndexError(R3, 'SetSubSeq);
+ NewSize := R3 - R2 - 1;
+ if NewSize < -1 then return RangeError(R1, R3, 'SetSubSeq);
+ case Tag R1 of
+ Str, Bytes:
+ << if not StringP R4 and not BytesP R4 then return
+ NonStringError(R4, 'SetSubSeq);
+ OldSize := StrLen StrInf R1;
+ NewItem := StrInf R4;
+ SubSize := StrLen NewItem;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SetSubSeq)
+ else if not (NewSize eq SubSize) then
+ RangeError(R4, NewSize, 'SetSubSeq)
+ else
+ << R3 := StrInf R1;
+ for I := 0 step 1 until NewSize do
+ StrByt(R3, R2 + I) := StrByt(NewItem, I) >> >>;
+ Vect:
+ << if not VectorP R4 then return
+ NonVectorError(R4, 'SetSubSeq);
+ OldSize := VecLen VecInf R1;
+ NewItem := VecInf R4;
+ SubSize := VecLen NewItem;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SetSubSeq)
+ else if not (NewSize eq SubSize) then
+ RangeError(R4, NewSize, 'SetSubSeq)
+ else
+ << R3 := VecInf R1;
+ for I := 0 step 1 until NewSize do
+ VecItm(R3, R2 + I) := VecItm(NewItem, I) >> >>;
+ Wrds:
+ << if not WrdsP R4 then return
+ NonVectorError(R4, 'SetSubSeq);
+ OldSize := WrdLen WrdInf R1;
+ NewItem := WrdInf R4;
+ SubSize := WrdLen NewItem;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SetSubSeq)
+ else if not (NewSize eq SubSize) then
+ RangeError(R4, NewSize, 'SetSubSeq)
+ else
+ << R3 := WrdInf R1;
+ for I := 0 step 1 until NewSize do
+ WrdItm(R3, R2 + I) := WrdItm(NewItem, I) >> >>;
+ HalfWords:
+ << if not HalfWordsP R4 then return
+ NonVectorError(R4, 'SetSubSeq);
+ OldSize := HalfWordLen HalfWordInf R1;
+ NewItem := HalfWordInf R4;
+ SubSize := HalfWordLen NewItem;
+ if R3 - 1 > OldSize then RangeError(R1, R3, 'SetSubSeq)
+ else if not (NewSize eq SubSize) then
+ RangeError(R4, NewSize, 'SetSubSeq)
+ else
+ << R3 := HalfWordInf R1;
+ for I := 0 step 1 until NewSize do
+ HalfWordItm(R3, R2 + I) := HalfWordItm(NewItem, I) >> >>;
+ Pair:
+ << if not PairP R4 and not null R4 then return
+ NonPairError(R4, 'SetSubSeq);
+ for I := 1 step 1 until R2 do
+ if PairP R1 then R1 := rest R1
+ else RangeError(R1, R2, 'SetSubSeq);
+ NewItem := R4;
+ for I := 0 step 1 until NewSize do
+ if PairP R1 and PairP NewItem then
+ << RPlaca(R1, first NewItem);
+ R1 := rest R1;
+ NewItem := rest NewItem >>
+ else RangeError(R1, R3, 'SetSubSeq) >>;
+ default:
+ NonSequenceError(R1, 'SetSubSeq);
+ end;
+ return R4;
+end;
+
+syslsp procedure Concat(R1, R2); %. Concatenate 2 sequences
+begin scalar I1, I2, Tmp1, Tmp2, Tmp3;
+return case Tag R1 of
+ STR, BYTES:
+ << if not (StringP R2 or BytesP R2) then return
+ NonStringError(R2, 'Concat);
+ Tmp1 := StrInf R1;
+ Tmp2 := StrInf R2;
+ I1 := StrLen Tmp1;
+ I2 := StrLen Tmp2;
+ Tmp3 := GtSTR(I1 + I2 + 1); % R1 and R2 can move
+ Tmp1 := StrInf R1;
+ Tmp2 := StrInf R2;
+ for I := 0 step 1 until I1 do
+ StrByt(Tmp3, I) := StrByt(Tmp1, I);
+ for I := 0 step 1 until I2 do
+ StrByt(Tmp3, I1 + I + 1) := StrByt(Tmp2, I);
+ if StringP R1 then MkSTR Tmp3 else MkBYTES Tmp3 >>;
+ VECT:
+ << if not VectorP R2 then return
+ NonVectorError(R2, 'Concat);
+ Tmp1 := VecInf R1;
+ Tmp2 := VecInf R2;
+ I1 := VecLen Tmp1;
+ I2 := VecLen Tmp2;
+ Tmp3 := GtVECT(I1 + I2 + 1); % R1 and R2 can move
+ Tmp1 := VecInf R1;
+ Tmp2 := VecInf R2;
+ for I := 0 step 1 until I1 do
+ VecItm(Tmp3, I) := VecItm(Tmp1, I);
+ for I := 0 step 1 until I2 do
+ VecItm(Tmp3, I1 + I + 1) := VecItm(Tmp2, I);
+ MkVEC Tmp3 >>;
+ WRDS:
+ << if not WrdsP R2 then return
+ NonVectorError(R2, 'Concat);
+ Tmp1 := WrdInf R1;
+ Tmp2 := WrdInf R2;
+ I1 := WrdLen Tmp1;
+ I2 := WrdLen Tmp2;
+ Tmp3 := GtWrds(I1 + I2 + 1); % R1 and R2 can move
+ Tmp1 := WrdInf R1;
+ Tmp2 := WrdInf R2;
+ for I := 0 step 1 until I1 do
+ WrdItm(Tmp3, I) := WrdItm(Tmp1, I);
+ for I := 0 step 1 until I2 do
+ WrdItm(Tmp3, I1 + I + 1) := WrdItm(Tmp2, I);
+ MkWRDS Tmp3 >>;
+ HALFWORDS:
+ << if not HalfWordsP R2 then return
+ NonVectorError(R2, 'Concat);
+ Tmp1 := HalfWordInf R1;
+ Tmp2 := HalfWordInf R2;
+ I1 := HalfWordLen Tmp1;
+ I2 := HalfWordLen Tmp2;
+ Tmp3 := GtHalfWords(I1 + I2 + 1); % R1 and R2 can move
+ Tmp1 := HalfWordInf R1;
+ Tmp2 := HalfWordInf R2;
+ for I := 0 step 1 until I1 do
+ HalfWordItm(Tmp3, I) := HalfWordItm(Tmp1, I);
+ for I := 0 step 1 until I2 do
+ HalfWordItm(Tmp3, I1 + I + 1) := HalfWordItm(Tmp2, I);
+ MkHalfWords Tmp3 >>;
+ PAIR, ID:
+ if null R1 or PairP R1 then Append(R1, R2);
+ default:
+ NonSequenceError(R1, 'Concat);
+ end;
+end;
+
+syslsp procedure Size S; %. Upper bound of sequence
+ case Tag S of
+ STR, BYTES, WRDS, VECT, HALFWORDS:
+ GetLen Inf S;
+ ID:
+ -1;
+ PAIR:
+ begin scalar I;
+ I := -1;
+ while PairP S do
+ << I := I + 1;
+ S := cdr S >>;
+ return I;
+ end;
+ default:
+ NonSequenceError(S, 'Size);
+ end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/sets.red
Index: psl-1983/3-1/kernel/sets.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/sets.red
@@ -0,0 +1,50 @@
+%
+% SETS.RED - Functions acting on lists as sets
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 12 December 1981
+% Copyright (c) 1981 University of Utah
+%
+
+lisp procedure List2Set L; %. Remove redundant elements from L
+ if not PairP L then NIL
+ else if car L member cdr L then List2Set cdr L
+ else car L . List2Set cdr L;
+
+lisp procedure List2SetQ L; %. EQ version of List2Set
+ if not PairP L then NIL % Don't confuse it with SetQ!
+ else if car L memq cdr L then List2Set cdr L
+ else car L . List2Set cdr L;
+
+lisp procedure Adjoin(Element, ASet); %. Add Element to Set
+ if Element member ASet then ASet else Element . ASet;
+
+lisp procedure AdjoinQ(Element, ASet); %. EQ version of Adjoin
+ if Element memq ASet then ASet else Element . ASet;
+
+lisp procedure Union(X, Y); %. Set union
+ if not PairP X then Y
+ else Union(cdr X, if car X Member Y then Y else car X . Y);
+
+lisp procedure UnionQ(X, Y); %. EQ version of UNION
+ if not PairP X then Y
+ else UnionQ(cdr X, if car X memq Y then Y else car X . Y);
+
+lisp procedure XN(U, V); %. Set intersection
+ if not PairP U then NIL
+ else if car U Member V then car U . XN(cdr U, Delete(car U, V))
+ else XN(cdr U, V);
+
+lisp procedure XNQ(U, V); %. EQ version of XN
+ if null PairP U then NIL
+ else if car U memq V then car U . XN(cdr U, DelQ(car U, V))
+ else XN(cdr U, V);
+
+LoadTime
+<< PutD('Intersection, 'EXPR, cdr GetD 'XN); % for those who like to type
+ PutD('IntersectionQ, 'EXPR, cdr GetD 'XNQ) >>;
+
+END;
ADDED psl-1983/3-1/kernel/string-gensym.red
Index: psl-1983/3-1/kernel/string-gensym.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/string-gensym.red
@@ -0,0 +1,37 @@
+%
+% STRING-GENSYM.RED - Complement to GenSym, makes a string instead of ID
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 14 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Edit by Cris Perdue, 9 Feb 1983 1620-PST
+% Modified to avoid using the CHAR macro in a top level form
+
+fluid '(StringGenSym!*);
+StringGenSym!* := copystring("L0000"); % Copy to force into heap /csp
+
+CompileTime flag('(StringGenSym1), 'InternalFunction);
+
+lisp procedure StringGenSym(); %. Generate unique string
+ StringGenSym1 4;
+
+lisp procedure StringGenSym1 N; %. Auxiliary function for StringGenSym
+begin scalar Ch;
+ return if N > 0 then
+ if (Ch := Indx(StringGenSym!*, N)) < char !9 then
+ << SetIndx(StringGenSym!*, N, Ch + 1);
+ TotalCopy StringGenSym!* >>
+ else
+ << SetIndx(StringGenSym!*, N, char !0);
+ StringGenSym1(N - 1) >>
+ else % Increment starting letter
+ << SetIndx(StringGenSym!*, 0, Indx(StringGenSym!*, 0) + 1);
+ StringGenSym() >>;
+end;
+
+END;
ADDED psl-1983/3-1/kernel/symbl.build
Index: psl-1983/3-1/kernel/symbl.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/symbl.build
@@ -0,0 +1,15 @@
+%
+% SYMBL.BUILD - Files dealing with symbols in the interpreter
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "binding.red"$ % binding from the interpreter
+PathIn "fast-binder.red"$ % for binding in compiled code, in LAP
+PathIn "symbol-values.red"$ % SET, and support for Eval
+PathIn "oblist.red"$ % Intern, RemOb and GenSym
ADDED psl-1983/3-1/kernel/symbol-values.red
Index: psl-1983/3-1/kernel/symbol-values.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/symbol-values.red
@@ -0,0 +1,50 @@
+%
+% SYMBOL-VALUES.RED - ValueCell, UnboundP, MakeUnbound and Set
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 Eric Benson
+%
+
+on SysLisp;
+
+syslsp procedure UnboundP U; %. Does U not have a value?
+ if IDP U then
+ if Tag SymVal IDInf U eq Unbound then T else NIL
+ else
+ NonIDError(U, 'UnboundP);
+
+syslsp procedure MakeUnbound U; %. Make U an unbound ID
+ if IDP U then
+ SymVal IDInf U := MkItem(Unbound, IDInf U)
+ else
+ NonIDError(U, 'MakeUnbound);
+
+syslsp procedure ValueCell U; %. Safe access to SymVal entry
+begin scalar V; % This guy is called from Eval
+ return if IDP U then
+ << V := SymVal IDInf U;
+ if Tag V eq Unbound then
+ ContinuableError('99, BldMsg('"%r is an unbound ID", U), U)
+ else V >>
+ else
+ NonIDError(U, 'ValueCell);
+end;
+
+% This version of SET differs from the Standard Lisp report in that Exp is
+% not declared fluid, in order to maintain compatibility between compiled
+% and interpreted code.
+
+syslsp procedure Set(Exp, Val); %. Assign Val to ID Exp
+ if IDP Exp then
+ if not (null Exp or Exp eq 'T) then
+ << SymVal IDInf Exp := Val;
+ Val >>
+ else StdError '"T and NIL cannot be SET"
+ else NonIDError(Exp, 'Set);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/sysio.build
Index: psl-1983/3-1/kernel/sysio.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/sysio.build
@@ -0,0 +1,13 @@
+%
+% SYSIO.BUILD - Files for system-dependent input and output
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "system-io.red"$ % system dependent IO functions
+PathIn "scan-table.red"$ % change scan table for system
ADDED psl-1983/3-1/kernel/tloop.build
Index: psl-1983/3-1/kernel/tloop.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/tloop.build
@@ -0,0 +1,14 @@
+%
+% TLOOP.BUILD - Files with top loop and related functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "break.red"$ % break package (uses top loop)
+PathIn "top-loop.red"$ % generalized top loop function
+PathIn "dskin.red"$ % Read/Eval/Print from files
ADDED psl-1983/3-1/kernel/token-scanner.red
Index: psl-1983/3-1/kernel/token-scanner.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/token-scanner.red
@@ -0,0 +1,565 @@
+%
+% TOKEN-SCANNER.RED - Table-driven token scanner
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.NEW>TOKEN-SCANNER.RED.2, 7-Apr-83 12:29:58, Edit by KESSLER
+% Changed MakeBufIntoFloat so it uses FloatZero, instead of '0.0.
+% Edit by Cris Perdue, 11 Mar 1983
+% Added argument to MakeBufIntoFloat to specify sign of number
+% Edit by Cris Perdue, 29 Jan 1983 1338-PST
+% Occurrences of "dipthong" changed to "diphthong"
+% <PSL.KERNEL>TOKEN-SCANNER.RED.2, 16-Dec-82 14:55:55, Edit by BENSON
+% MakeBufIntoFloat uses floating point arithmetic on each digit
+% <PSL.INTERP>TOKEN-SCANNER.RED.6, 15-Sep-82 10:49:54, Edit by BENSON
+% Can now scan 1+ and 1-
+% <PSL.INTERP>TOKEN-SCANNER.RED.12, 10-Jan-82 21:53:28, Edit by BENSON
+% Fixed bug in floating point parsing
+% <PSL.INTERP>TOKEN-SCANNER.RED.9, 8-Jan-82 07:06:23, Edit by GRISS
+% MakeBufIntoLispInteger becomes procedure for BigNums
+% <PSL.INTERP>TOKEN-SCANNER.RED.7, 28-Dec-81 22:09:14, Edit by BENSON
+% Made dipthong indicator last element of scan table
+
+fluid '(CurrentScanTable!* !*Raise !*Compressing !*EOLInStringOK);
+LoadTime <<
+!*Raise := T;
+!*Compressing := NIL;
+!*EOLInStringOK := NIL;
+>>;
+
+CompileTime flag('(ReadInBuf MakeBufIntoID MakeBufIntoString
+ MakeBufIntoLispInteger MakeBufIntoSysNumber
+ MakeBufIntoFloat MakeStringIntoSysInteger
+ MakeStringIntoBitString ScannerError SysPowerOf2P
+ ScanPossibleDiphthong),
+ 'InternalFunction);
+
+on SysLisp;
+
+% DIGITS are 0..9
+internal WConst LETTER = 10,
+ DELIMITER = 11,
+ COMMENTCHAR = 12,
+ DIPHTHONGSTART = 13,
+ IDESCAPECHAR = 14,
+ STRINGQUOTE = 15,
+ PACKAGEINDICATOR = 16,
+ IGNORE = 17,
+ MINUSSIGN = 18,
+ PLUSSIGN = 19,
+ DECIMALPOINT = 20,
+ IDSURROUND = 21;
+
+internal WVar TokCh,
+ TokChannel,
+ ChTokenType,
+ CurrentChar,
+ ChangedPackages,
+ TokRadix,
+ TokSign,
+ TokFloatFractionLength,
+ TokFloatExponentSign,
+ TokFloatExponent;
+
+CompileTime <<
+syslsp smacro procedure TokenTypeOfChar Ch;
+ IntInf VecItm(VecInf LispVar CurrentScanTable!*, Ch);
+
+syslsp smacro procedure CurrentDiphthongIndicator();
+ VecItm(VecInf LispVar CurrentScanTable!*, 128);
+
+syslsp smacro procedure ResetBuf();
+ CurrentChar := 0;
+
+syslsp smacro procedure BackupBuf();
+ CurrentChar := CurrentChar - 1;
+>>;
+
+syslsp procedure ReadInBuf();
+<< TokCh := ChannelReadChar TokChannel;
+ StrByt(TokenBuffer, CurrentChar) := TokCh;
+ ChTokenType := TokenTypeOfChar TokCh;
+ if CurrentChar < MaxTokenSize then
+ CurrentChar := CurrentChar + 1
+ else if CurrentChar = MaxTokenSize then
+ << ErrorPrintF("***** READ Buffer overflow, Truncating");
+ CurrentChar := MaxTokenSize + 1 >>
+ else CurrentChar := MaxTokenSize + 1 >>;
+
+CompileTime <<
+syslsp smacro procedure UnReadLastChar();
+ ChannelUnReadChar(Channel, TokCh);
+
+syslsp smacro procedure LowerCaseChar Ch;
+ Ch >= char !a and Ch <= char !z;
+
+syslsp smacro procedure RaiseChar Ch;
+ (Ch - char !a) + char A;
+
+syslsp smacro procedure RaiseLastChar();
+ if LowerCaseChar TokCh then
+ StrByt(TokenBuffer, CurrentChar - 1) := RaiseChar TokCh;
+>>;
+
+syslsp procedure MakeBufIntoID();
+<< LispVar TokType!* := '0;
+ if CurrentChar eq 1 then MkID StrByt(TokenBuffer, 0)
+ else
+ << StrByt(TokenBuffer, CurrentChar) := char NULL;
+ TokenBuffer[0] := CurrentChar - 1;
+ if LispVar !*Compressing then NewID CopyString TokenBuffer
+ else Intern MkSTR TokenBuffer >> >>;
+
+syslsp procedure MakeBufIntoString();
+<< LispVar TokType!* := '1;
+ StrByt(TokenBuffer, CurrentChar) := 0;
+ TokenBuffer[0] := CurrentChar - 1;
+ CopyString TokenBuffer >>;
+
+syslsp procedure MakeBufIntoSysNumber(Radix, Sign);
+<< StrByt(TokenBuffer, CurrentChar) := 0;
+ TokenBuffer[0] := CurrentChar - 1;
+ MakeStringIntoSysInteger(TokenBuffer, Radix, Sign) >>;
+
+syslsp procedure MakeBufIntoLispInteger(Radix, Sign);
+<< LispVar TokType!* := '2;
+ StrByt(TokenBuffer, CurrentChar) := 0;
+ TokenBuffer[0] := CurrentChar - 1;
+ MakeStringIntoLispInteger(MkSTR TokenBuffer, Radix, Sign) >>;
+
+internal WArray MakeFloatTemp1[1],
+ MakeFloatTemp2[1],
+ FloatTen[1],
+ FloatZero[1];
+
+% Changed to use floating point arithmetic on the characters, rather
+% than converting to an integer. This avoids overflow problems.
+
+syslsp procedure MakeBufIntoFloat(Exponent, MinusP);
+begin scalar F, N;
+ !*WFloat(FloatTen, 10);
+ !*WFloat(MakeFloatTemp1, 0);
+ !*WFloat(FloatZero, 0);
+ N := CurrentChar - 1;
+ for I := 0 step 1 until N do
+ << !*WFloat(MakeFloatTemp2, DigitToNumber StrByt(TokenBuffer, I));
+ !*FTimes2(MakeFloatTemp1, MakeFloatTemp1, FloatTen);
+ !*FPlus2(MakeFloatTemp1, MakeFloatTemp1, MakeFloatTemp2) >>;
+ if Exponent > 0 then
+ for I := 1 step 1 until Exponent do
+ !*FTimes2(MakeFloatTemp1, MakeFloatTemp1, FloatTen)
+ else if Exponent < 0 then
+ << Exponent := -Exponent;
+ for I := 1 step 1 until Exponent do
+ !*FQuotient(MakeFloatTemp1, MakeFloatTemp1, FloatTen) >>;
+ if Minusp then
+ !*FDifference(MakeFloatTemp1, FloatZero, MakeFloatTemp1);
+ %% Gack. It is necessary to quote 0.0 in SysLISP mode!
+ %% Is it because of the direct call on a CMACRO? Think not. /csp
+ LispVar TokType!* := '2;
+ F := GtFLTN();
+ !*FAssign(FloatBase F, MakeFloatTemp1);
+ return MkFLTN F;
+end;
+
+
+syslsp procedure ChannelReadToken Channel; %. Token scanner
+%
+% This is the basic Lisp token scanner. The value returned is a Lisp
+% item corresponding to the next token from the input stream. IDs will
+% be interned. The global Lisp variable TokType!* will be set to
+% 0 if the token is an ordinary ID,
+% 1 if the token is a string (delimited by double quotes),
+% 2 if the token is a number, or
+% 3 if the token is an unescaped delimiter.
+% In the last case, the value returned by this function will be the single
+% character ID corresponding to the delimiter.
+%
+begin
+ TokChannel := Channel;
+ ChangedPackages := 0;
+ ResetBuf();
+StartScanning:
+ TokCh := ChannelReadChar Channel;
+ ChTokenType := TokenTypeOfChar TokCh;
+ if ChTokenType eq IGNORE then goto StartScanning;
+ StrByt(TokenBuffer, CurrentChar) := TokCh;
+ CurrentChar := CurrentChar + 1;
+ case ChTokenType of
+ 0 to 9: % digit
+ << TokSign := 1;
+ goto InsideNumber >>;
+ 10: % Start of ID
+ << if null LispVar !*Raise then
+ goto InsideID
+ else
+ << RaiseLastChar();
+ goto InsideRaisedID >> >>;
+ 11: % Delimiter, but not beginning of Diphthong
+ << LispVar TokType!* := '3;
+ return MkID TokCh >>;
+ 12: % Start of comment
+ goto InsideComment;
+ 13: % Diphthong start - Lisp function uses P-list of starting char
+ return ScanPossibleDiphthong(TokChannel, MkID TokCh);
+ 14: % ID escape character
+ << if null LispVar !*Raise then
+ goto GotEscape
+ else goto GotEscapeInRaisedID >>;
+ 15: % string quote
+ << BackupBuf();
+ goto InsideString >>;
+ 16: % Package indicator - at start of token means use global package
+ << ResetBuf();
+ ChangedPackages := 1;
+ Package 'Global;
+ if null LispVar !*Raise then
+ goto GotPackageMustGetID
+ else goto GotPackageMustGetIDRaised >>;
+ 17: % Ignore - can't ever happen
+ ScannerError("Internal error - consult a wizard");
+ 18: % Minus sign
+ << TokSign := -1;
+ goto GotSign >>;
+ 19: % Plus sign
+ << TokSign := 1;
+ goto GotSign >>;
+ 20: % decimal point
+ << ResetBuf();
+ ReadInBuf();
+ if ChTokenType >= 10 then
+ << UnReadLastChar();
+ return ScanPossibleDiphthong(TokChannel, '!.) >>
+ else
+ << TokSign := 1;
+ TokFloatFractionLength := 1;
+ goto InsideFloatFraction >> >>;
+ 21: % IDSURROUND, i.e. vertical bars
+ << BackupBuf();
+ goto InsideIDSurround >>;
+ default:
+ return ScannerError("Unknown token type")
+ end;
+GotEscape:
+ BackupBuf();
+ ReadInBuf();
+ goto InsideID;
+InsideID:
+ ReadInBuf();
+ if ChTokenType <= 10
+ or ChTokenType eq PLUSSIGN
+ or ChTokenType eq MINUSSIGN then goto InsideID
+ else if ChTokenType eq IDESCAPECHAR then goto GotEscape
+ else if ChTokenType eq PACKAGEINDICATOR then
+ << BackupBuf();
+ ChangedPackages := 1;
+ Package MakeBufIntoID();
+ ResetBuf();
+ goto GotPackageMustGetID >>
+ else
+ << UnReadLastChar();
+ BackupBuf();
+ if ChangedPackages neq 0 then Package LispVar CurrentPackage!*;
+ return MakeBufIntoID() >>;
+GotPackageMustGetID:
+ ReadInBuf();
+ if ChTokenType eq LETTER then goto InsideID
+ else if ChTokenType eq IDESCAPECHAR then goto GotEscape
+ else ScannerError("Illegal to follow package indicator with non ID");
+GotEscapeInRaisedID:
+ BackupBuf();
+ ReadInBuf();
+ goto InsideRaisedID;
+InsideRaisedID:
+ ReadInBuf();
+ if ChTokenType < 10
+ or ChTokenType eq PLUSSIGN
+ or ChTokenType eq MINUSSIGN then goto InsideRaisedID
+ else if ChTokenType eq 10 then
+ << RaiseLastChar();
+ goto InsideRaisedID >>
+ else if ChTokenType eq IDESCAPECHAR then goto GotEscapeInRaisedID
+ else if ChTokenType eq PACKAGEINDICATOR then
+ << BackupBuf();
+ ChangedPackages := 1;
+ Package MakeBufIntoID();
+ ResetBuf();
+ goto GotPackageMustGetIDRaised >>
+ else
+ << UnReadLastChar();
+ BackupBuf();
+ if ChangedPackages neq 0 then Package LispVar CurrentPackage!*;
+ return MakeBufIntoID() >>;
+GotPackageMustGetIDRaised:
+ ReadInBuf();
+ if ChTokenType eq LETTER then
+ << RaiseLastChar();
+ goto InsideRaisedID >>
+ else if ChTokenType eq IDESCAPECHAR then goto GotEscapeInRaisedID
+ else ScannerError("Illegal to follow package indicator with non ID");
+InsideString:
+ ReadInBuf();
+ if ChTokenType eq STRINGQUOTE then
+ << BackupBuf();
+ ReadInBuf();
+ if ChTokenType eq STRINGQUOTE then goto InsideString
+ else
+ << UnReadLastChar();
+ BackupBuf();
+ return MakeBufIntoString() >> >>
+ else if TokCh eq char EOL and not LispVar !*EOLInStringOK then
+ ErrorPrintF("*** String continued over end-of-line")
+ else if TokCh eq char EOF then
+ ScannerError("EOF encountered inside a string");
+ goto InsideString;
+InsideIDSurround:
+ ReadInBuf();
+ if ChTokenType eq IDSURROUND then
+ << BackupBuf();
+ return MakeBufIntoID() >>
+ else if ChTokenType eq IDESCAPECHAR then
+ << BackupBuf();
+ ReadInBuf() >>
+ else if TokCh eq char EOF then
+ ScannerError("EOF encountered inside an ID");
+ goto InsideIDSurround;
+GotSign:
+ ResetBuf();
+ ReadInBuf();
+ if TokCh eq char !. then
+ << PutStrByt(TokenBuffer, 0, char !0);
+ CurrentChar := 2;
+ goto InsideFloat >>
+ else if ChTokenType eq LETTER % patch to be able to read 1+ and 1-
+ or ChTokenType eq MINUSSIGN
+ or ChTokenType eq PLUSSIGN then
+ << ResetBuf();
+ StrByt(TokenBuffer, 0) := if TokSign < 0 then char !- else char !+;
+ StrByt(TokenBuffer, 1) := TokCh;
+ CurrentChar := 2;
+ if LispVar !*Raise then
+ << RaiseLastChar();
+ goto InsideRaisedID >>
+ else goto InsideID >>
+ else if ChTokenType eq IDESCAPECHAR then
+ << ResetBuf();
+ StrByt(TokenBuffer, 0) := if TokSign < 0 then char !- else char !+;
+ CurrentChar := 1;
+ if LispVar !*Raise then
+ goto GotEscapeInRaisedID
+ else goto GotEscape >>
+ else if ChTokenType > 9 then
+ << UnReadLastChar(); % Allow + or - to start a Diphthong
+ return ScanPossibleDiphthong(Channel,
+ MkID(if TokSign < 0 then char !-
+ else char !+)) >>
+ else goto InsideNumber;
+InsideNumber:
+ ReadInBuf();
+ if ChTokenType < 10 then goto InsideNumber;
+ if TokCh eq char !# then
+ << BackupBuf();
+ TokRadix := MakeBufIntoSysNumber(10, 1);
+ ResetBuf();
+ if TokRadix < 2 or TokRadix > 36 then
+ return ScannerError("Radix out of range");
+ if TokRadix <= 10 then goto InsideIntegerRadixUnder10
+ else goto InsideIntegerRadixOver10 >>
+ else if TokCh eq char !. then goto InsideFloat
+ else if TokCh eq char B or TokCh eq char !b then
+ << BackupBuf();
+ return MakeBufIntoLispInteger(8, TokSign) >>
+ else if TokCh eq char E or TokCh eq char !e then
+ << TokFloatFractionLength := 0;
+ goto InsideFloatExponent >>
+ else if ChTokenType eq LETTER % patch to be able to read 1+ and 1-
+ or ChTokenType eq MINUSSIGN
+ or ChTokenType eq PLUSSIGN then
+ if LispVar !*Raise then
+ << RaiseLastChar();
+ goto InsideRaisedID >>
+ else goto InsideID
+ else if ChTokenType eq IDESCAPECHAR then
+ if LispVar !*Raise then
+ goto GotEscapeInRaisedID
+ else goto GotEscape
+ else
+ << UnReadLastChar();
+ BackupBuf();
+ return MakeBufIntoLispInteger(10, TokSign) >>;
+InsideIntegerRadixUnder10:
+ ReadInBuf();
+ if ChTokenType < TokRadix then goto InsideIntegerRadixUnder10;
+ if ChTokenType < 10 then return ScannerError("Digit out of range");
+NumReturn:
+ UnReadLastChar();
+ BackupBuf();
+ return MakeBufIntoLispInteger(TokRadix, TokSign);
+InsideIntegerRadixOver10:
+ ReadInBuf();
+ if ChTokenType < 10 then goto InsideIntegerRadixOver10;
+ if ChTokenType > 10 then goto NumReturn;
+ if LowerCaseChar TokCh then
+ << TokCh := RaiseChar TokCh;
+ StrByt(TokenBuffer, CurrentChar - 1) := TokCh >>;
+ if TokCh >= char A - 10 + TokRadix then goto NumReturn;
+ goto InsideIntegerRadixOver10;
+InsideFloat: % got decimal point inside number
+ BackupBuf();
+ ReadInBuf();
+ if TokCh eq char E or TokCh eq char !e then
+ << TokFloatFractionLength := 0;
+ goto InsideFloatExponent >>;
+ if ChTokenType >= 10 then % nnn. is floating point number
+ << UnReadLastChar();
+ BackupBuf();
+ return MakeBufIntoFloat(0,TokSign<0) >>;
+ TokFloatFractionLength := 1;
+InsideFloatFraction:
+ ReadInBuf();
+ if ChTokenType < 10 then
+ << if TokFloatFractionLength < 9 then
+ TokFloatFractionLength := TokFloatFractionLength + 1
+ else BackupBuf(); % don't overflow mantissa
+ goto InsideFloatFraction >>;
+ if TokCh eq char E or TokCh eq char lower e then goto InsideFloatExponent;
+ UnReadLastChar();
+ BackupBuf();
+ return MakeBufIntoFloat((-TokFloatFractionLength), TokSign<0);
+InsideFloatExponent:
+ BackupBuf();
+ TokFloatExponentSign := 1;
+ TokFloatExponent := 0;
+ TokCh := ChannelReadChar TokChannel;
+ ChTokenType := TokenTypeOfChar TokCh;
+ if ChTokenType < 10 then
+ << TokFloatExponent := ChTokenType;
+ goto DigitsInsideExponent >>;
+ if TokCh eq char '!- then TokFloatExponentSign := -1
+ else if TokCh neq char '!+ then
+ return ScannerError("Missing exponent in float");
+ TokCh := ChannelReadChar TokChannel;
+ ChTokenType := TokenTypeOfChar TokCh;
+ if ChTokenType >= 10 then
+ return ScannerError("Missing exponent in float");
+ TokFloatExponent := ChTokenType;
+DigitsInsideExponent:
+ TokCh := ChannelReadChar TokChannel;
+ ChTokenType := TokenTypeOfChar TokCh;
+ if ChTokenType < 10 then
+ << TokFloatExponent := TokFloatExponent * 10 + ChTokenType;
+ goto DigitsInsideExponent >>;
+ ChannelUnReadChar(Channel, TokCh);
+ return MakeBufIntoFloat((TokFloatExponentSign * TokFloatExponent
+ - TokFloatFractionLength), TokSign<0);
+InsideComment:
+ if (TokCh := ChannelReadChar Channel) eq char EOL then
+ << ResetBuf();
+ goto StartScanning >>
+ else if TokCh eq char EOF then return LispVar !$EOF!$
+ else goto InsideComment;
+end;
+
+syslsp procedure RAtom(); %. Read token from current input
+ ChannelReadToken LispVar IN!*;
+
+syslsp procedure DigitToNumber D;
+%
+% if D is not a digit then it is assumed to be an uppercase letter
+%
+ if D >= char !0 and D <= char !9 then D - char !0 else D - (char A - 10);
+
+syslsp procedure MakeStringIntoLispInteger(S, Radix, Sign);
+ Sys2Int MakeStringIntoSysInteger(S, Radix, Sign);
+
+syslsp procedure MakeStringIntoSysInteger(Strng, Radix, Sign);
+%
+% Unsafe string to integer conversion. Strng is assumed to contain
+% only digits and possibly uppercase letters for radices > 10. Since it
+% uses multiplication, arithmetic overflow may occur. Sign is +1 or -1
+%
+begin scalar Count, Tot, RadixExponent;
+ if RadixExponent := SysPowerOf2P Radix then return
+ MakeStringIntoBitString(Strng, Radix, RadixExponent, Sign);
+ Strng := StrInf Strng;
+ Count := StrLen Strng;
+ Tot := 0;
+ for I := 0 step 1 until Count do
+ Tot := Tot * Radix + DigitToNumber StrByt(Strng, I);
+ return if Sign < 0 then -Tot else Tot;
+end;
+
+syslsp procedure MakeStringIntoBitString(Strng, Radix, RadixExponent, Sign);
+begin scalar Count, Tot;
+ Strng := StrInf Strng;
+ Count := StrLen Strng;
+ Tot := 0;
+ for I := 0 step 1 until Count do
+ << Tot := LSH(Tot, RadixExponent);
+ Tot := LOR(Tot, DigitToNumber StrByt(Strng, I)) >>;
+ if Sign < 0 then return -Tot;
+ return Tot;
+end;
+
+syslsp procedure SysPowerOf2P Num;
+ case Num of
+ 1: 0;
+ 2: 1;
+ 4: 2;
+ 8: 3;
+ 16: 4;
+ 32: 5;
+ default: NIL
+ end;
+
+syslsp procedure ScannerError Message;
+ StdError BldMsg("***** Error in token scanner: %s", Message);
+
+syslsp procedure ScanPossibleDiphthong(Channel, StartChar);
+begin scalar Alst, Target, Ch;
+ LispVar TokType!* := '3;
+ if null (Alst := get(StartChar, CurrentDiphthongIndicator())) then
+ return StartChar;
+ if null (Target := Atsoc(Ch := MkID ChannelReadChar Channel, Alst)) then
+ << ChannelUnReadChar(Channel, IDInf Ch);
+ return StartChar >>;
+ return cdr Target;
+end;
+
+syslsp procedure ReadLine();
+<< MakeInputAvailable();
+ ChannelReadLine LispVar IN!* >>;
+
+syslsp procedure ChannelReadLine Chn;
+begin scalar C;
+ TokenBuffer[0] := -1;
+ while (C := ChannelReadChar Chn) neq char EOL and C neq char EOF do
+ << TokenBuffer[0] := TokenBuffer[0] + 1;
+ StrByt(TokenBuffer, TokenBuffer[0]) := C >>;
+ return if TokenBuffer[0] >= 0 then
+ << StrByt(TokenBuffer, TokenBuffer[0] + 1) := char NULL;
+ CopyString MkSTR TokenBuffer >>
+ else '"";
+end;
+
+% Dummy definition of package conversion function
+
+syslsp procedure Package U;
+ NIL;
+
+% Dummy definition of MakeInputAvailable, redefined by Emode
+
+syslsp procedure MakeInputAvailable();
+ NIL;
+
+off SysLisp;
+
+END;
+
+
ADDED psl-1983/3-1/kernel/top-loop.red
Index: psl-1983/3-1/kernel/top-loop.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/top-loop.red
@@ -0,0 +1,216 @@
+%
+% TOP-LOOP.RED - Generalized top loop construct
+%
+% Author: Eric Benson and M. L. Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% 03-Mar-83 Nancy Kendzierski
+% Added declaration of LispScanTable!* as a fluid.
+% <PSL.KERNEL>TOP-LOOP.RED.6, 5-Oct-82 11:02:29, Edit by BENSON
+% Added EvalInitForms, changed SaveSystem to 3 args
+% <PSL.KERNEL>TOP-LOOP.RED.5, 4-Oct-82 18:09:33, Edit by BENSON
+% Added GCTime!*
+% $pi/top-loop.red, Mon Jun 28 10:54:19 1982, Edit by Fish
+% Conditional output: !*Output, Semic!*, !*NoNil.
+% <PSL.INTERP>TOP-LOOP.RED.13, 30-Apr-82 14:32:20, Edit by BENSON
+% Minor change to !*DEFN processing
+% <PSL.INTERP>TOP-LOOP.RED.5, 29-Apr-82 03:56:06, Edit by GRISS
+% Initial attempt to add !*DEFN processing
+%<PSL.INTERP>TOP-LOOP.RED.18 24-Nov-81 15:22:25, Edit by BENSON
+% Changed Standard!-Lisp to StandardLisp
+
+CompileTime flag('(NthEntry DefnPrint DefnPrint1 HistPrint),
+ 'InternalFunction);
+
+fluid '(TopLoopRead!* % reading function
+ TopLoopPrint!* % printing function
+ TopLoopEval!* % evaluation function
+ TopLoopName!* % short name to put in prompt
+ TopLoopLevel!* % depth of top loop invocations
+ HistoryCount!* % number of entries read so far
+ HistoryList!* % list of entries read and evaluated
+ PromptString!* % input prompt
+ LispBanner!* % Welcome banner printed in StandardLisp
+ !*EMsgP % whether to print error messages
+ !*BackTrace % whether to print backtrace
+ !*Time % whether to print timing of evaluation
+ GCTime!* % Time spent in garbage collection
+ !*Defn % To "output" rather than process
+ DFPRINT!* % Alternate DEFN print function
+ !*Output % Whether to print output.
+ Semic!* % Input terminator when in Rlisps.
+ !*NoNil % Whether to supress NIL value print.
+ InitForms!* % Forms to be evaluated at startup
+ LispScanTable!* % CurrentScanTable!* when READing
+);
+
+LoadTime <<
+TopLoopLevel!* := -1;
+HistoryCount!* := 0;
+LispBanner!* := "Portable Standard LISP";
+!*Output := T; % Output ON by default.
+>>;
+
+lisp procedure TopLoop(TopLoopRead!*, %. Generalized top-loop mechanism
+ TopLoopPrint!*, %.
+ TopLoopEval!*, %.
+ TopLoopName!*, %.
+ WelcomeBanner); %.
+begin scalar PromptString!*, Semic!*, LevelPrompt, ThisGCTime,
+ InputValue, OutputValue, TimeCheck;
+Semic!* := '!; ; % Output when semicolon terminator for rlisps.
+(lambda TopLoopLevel!*;
+begin
+ TimeCheck := 0;
+ ThisGCTime := GCTime!*;
+ LevelPrompt := MkString(TopLoopLevel!*, char '!> );
+ Prin2T WelcomeBanner;
+LoopStart:
+ HistoryCount!* := IAdd1 HistoryCount!*;
+ HistoryList!* := (NIL . NIL) . HistoryList!*;
+ PromptString!* := BldMsg("%w %w%w ",
+ HistoryCount!*,
+ TopLoopName!*,
+ LevelPrompt);
+ InputValue := ErrorSet(quote Apply(TopLoopRead!*, NIL), T, !*Backtrace);
+ if InputValue eq '!$ExitTopLoop!$ then goto LoopExit;
+ if not PairP InputValue then
+ goto LoopStart;
+ InputValue := car InputValue;
+ if InputValue eq '!$ExitTopLoop!$ then goto LoopExit;
+ if InputValue eq !$EOF!$ then goto LoopExit;
+ Rplaca(car HistoryList!*, InputValue);
+ if !*Time then
+ << TimeCheck := Time();
+ ThisGCTime := GCTime!* >>;
+ if !*Defn then
+ OutputValue := DefnPrint InputValue
+ else
+ OutputValue := ErrorSet(list('Apply, MkQuote TopLoopEval!*,
+ MkQuote list InputValue),
+ T,
+ !*Backtrace);
+ if not PairP OutputValue then
+ goto LoopStart;
+ OutputValue := car OutputValue;
+ if !*Time then
+ << TimeCheck := Time() - TimeCheck;
+ ThisGCTime := GCTime!* - ThisGCTime >>;
+ Rplacd(car HistoryList!*, OutputValue);
+ if !*Output and Semic!* eq '!;
+ and not (!*NoNil and OutputValue eq NIL) then
+ ErrorSet(list('Apply,
+ MkQuote TopLoopPrint!*,
+ MkQuote list OutputValue), T, !*Backtrace);
+ if !*Time then
+ if ThisGCTime = 0 then
+ PrintF("Cpu time: %w ms%n", TimeCheck)
+ else
+ PrintF("Cpu time: %w ms, GC time: %w ms%n",
+ TimeCheck - ThisGCTime, ThisGCTime);
+ goto LoopStart;
+LoopExit:
+ PrintF("Exiting %w%n", TopLoopName!*);
+end)(IAdd1 TopLoopLevel!*);
+end;
+
+lisp procedure DefnPrint U; % handle case of !*Defn:=T
+%
+% Looks for special action on a form, otherwise prettyprints it;
+% Adapted from DFPRINT
+%
+ if PairP U and FlagP(car U, 'Ignore) then DefnPrint1 U
+ else % So 'IGNORE is EVALED, not output
+ << if DfPrint!* then Apply(DfPrint!*, list U)
+ else PrettyPrint U; % So 'EVAL gets EVALED and Output
+ if PairP U and FlagP(car U, 'Eval) then DefnPrint1 U >>;
+
+lisp procedure DefnPrint1 U;
+ ErrorSet(list('Apply, MkQuote TopLoopEval!*,
+ MkQuote list U),
+ T,
+ !*Backtrace);
+
+fluid '(!*Break);
+
+lisp procedure NthEntry N;
+begin scalar !*Break;
+ return if IGEQ(N, HistoryCount!*) then
+ StdError BldMsg("No history entry %r", N)
+ else car PNth(cdr HistoryList!*, IDifference(HistoryCount!*, N));
+end;
+
+lisp procedure Inp N; %. Return Nth input
+ car NthEntry N;
+
+expr procedure ReDo N; %. Re-evaluate Nth input
+ Apply(TopLoopEval!*, list car NthEntry N);
+
+lisp procedure Ans N; %. return Nth output
+ cdr NthEntry N;
+
+nexpr procedure Hist AL; %. Print history entries
+begin scalar I1, I2, L;
+ if ILessP(HistoryCount!*, 2) then return NIL;
+ I1 := 1;
+ I2 := ISub1 HistoryCount!*;
+ if PairP AL then
+ << if car AL = 'CLEAR then
+ << HistoryCount!* := 1;
+ HistoryList!* := NIL . NIL;
+ return NIL >>;
+ if IMinusP car AL then return
+ HistPrint(cdr HistoryList!*,
+ ISub1 HistoryCount!*,
+ IMinus car AL);
+ I1 := Max(I1, car AL);
+ AL := cdr AL >>;
+ if PairP AL then I2 := Min(I2, car AL);
+ return HistPrint(PNTH(cdr HistoryList!*,
+ IDifference(HistoryCount!*, I2)),
+ I2,
+ IAdd1 IDifference(I2, I1));
+end;
+
+lisp procedure HistPrint(L, N, M);
+ if IZeroP M then NIL else
+ << HistPrint(cdr L, ISub1 N, ISub1 M);
+ PrintF("%w Inp: %p%n Ans: %p%n",
+ N, car first L, cdr first L) >>;
+
+lisp procedure Time(); %. Get run-time in milliseconds
+ Sys2Int TimC(); % TimC is primitive runtime function
+
+lisp procedure StandardLisp(); %. Lisp top loop
+(lambda (CurrentReadMacroIndicator!*, CurrentScanTable!*);
+ TopLoop('READ, 'PrintWithFreshLine, 'EVAL, "lisp", LispBanner!*)
+ )('LispReadMacro, LispScanTable!*);
+
+lisp procedure PrintWithFreshLine X;
+ PrintF("%f%p%n", X);
+
+lisp procedure SaveSystem(Banner, File, InitForms);
+begin scalar SavedHistoryList, SavedHistoryCount;
+ SavedHistoryCount := HistoryCount!*;
+ SavedHistoryList := HistoryList!*;
+ HistoryList!* := NIL;
+ HistoryCount!* := 0;
+ LispBanner!* := BldMsg("%w, %w", Banner, Date());
+ !*UserMode := T;
+ InitForms!* := InitForms;
+ DumpLisp File;
+ InitForms!* := NIL;
+ HistoryCount!* := SavedHistoryCount;
+ HistoryList!* := SavedHistoryList;
+end;
+
+lisp procedure EvalInitForms(); %. Evaluate and clear InitForms!*
+<< for each X in InitForms!* do Eval X;
+ InitForms!* := NIL >>;
+
+END;
ADDED psl-1983/3-1/kernel/type-conversions.red
Index: psl-1983/3-1/kernel/type-conversions.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/type-conversions.red
@@ -0,0 +1,136 @@
+%
+% TYPE-CONVERSIONS.RED - Functions for converting between various data types
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+
+% <PSL.VAX-INTERP>TYPE-CONVERSIONS.RED.2, 20-Jan-82 02:10:24, Edit by GRISS
+% Fix list2vector for NIL case
+
+% The functions in this file are named `argument-type'2`result-type'.
+% The number 2 is used rather than `To' only for compatibility with old
+% versions. Any other suggestions for a consistent naming scheme are welcomed.
+% Perhaps they should also be `result-type'From`argument-type'.
+
+% Float and Fix are in ARITH.RED
+
+CompileTime flag('(Sys2FIXN), 'InternalFunction);
+
+on SysLisp;
+
+syslsp procedure ID2Int U; %. Return ID index as Lisp number
+ if IDP U then MkINT IDInf U
+ else NonIDError(U, 'ID2Int);
+
+syslsp procedure Int2ID U; %. Return ID corresponding to index
+begin scalar StripU;
+ return if IntP U then
+ << StripU := IntInf U;
+ if StripU >= 0 then MkID StripU
+ else TypeError(U, 'Int2ID, '"positive integer") >>
+ else NonIntegerError(U, 'Int2ID);
+end;
+
+syslsp procedure Int2Sys N; %. Convert Lisp integer to untagged
+ if IntP N then IntInf N
+ else if FixNP N then FixVal FixInf N
+ else NonIntegerError(N, 'Int2Sys);
+
+syslsp procedure Lisp2Char U; %. Convert Lisp item to syslsp char
+begin scalar C; % integers, IDs and strings are legal
+ return if IntP U and (C := IntInf U) >= 0 and C <= 127 then C
+ else if IDP U then % take first char of ID print name
+ StrByt(StrInf SymNam IDInf U, 0)
+ else if StringP U then
+ StrByt(StrInf U, 0) % take first character of Lisp string
+ else NonCharacterError(U, 'Lisp2Char);
+end;
+
+syslsp procedure Int2Code N; %. Convert Lisp integer to code pointer
+ MkCODE N;
+
+syslsp procedure Sys2Int N; %. Convert word to Lisp number
+ if SignedField(N, InfStartingBit - 1, InfBitLength + 1) eq N then N
+ else Sys2FIXN N;
+
+syslsp procedure Sys2FIXN N;
+begin scalar FX;
+ FX := GtFIXN();
+ FixVal FX := N;
+ return MkFIXN FX;
+end;
+
+syslsp procedure ID2String U; %. Return print name of U (not copy)
+ if IDP U then SymNam IDInf U
+ else NonIDError(U, 'ID2String);
+
+% The functions for converting strings to IDs are Intern and NewID. Intern
+% returns an interned ID, NewID returns an uninterned ID. They are both found
+% in OBLIST.RED
+
+syslsp procedure String2Vector U; %. Make vector of ASCII values in U
+ if StringP U then begin scalar StripU, V, N;
+ N := StrLen StrInf U;
+ V := GtVECT N;
+ StripU := StrInf U; % in case GC occurred
+ for I := 0 step 1 until N do
+ VecItm(V, I) := MkINT StrByt(StripU, I);
+ return MkVEC V;
+ end else NonStringError(U, 'String2Vector);
+
+syslsp procedure Vector2String V; %. Make string with ASCII values in V
+ if VectorP V then begin scalar StripV, S, N, Ch;
+ N := VecLen VecInf V;
+ S := GtSTR N;
+ StripV := VecInf V; % in case GC occurred
+ for I := 0 step 1 until N do
+ StrByt(S, I) := Lisp2Char VecItm(StripV, I);
+ return MkSTR S;
+ end else NonVectorError(V, 'Vector2String);
+
+syslsp procedure List2String P; %. Make string with ASCII values in P
+ if null P then '""
+ else if PairP P then begin scalar S, N;
+ N := IntInf Length P - 1;
+ S := GtSTR N;
+ for I := 0 step 1 until N do
+ << StrByt(S, I) := Lisp2Char car P;
+ P := cdr P >>;
+ return MkSTR S;
+ end else NonPairError(P, 'List2String);
+
+syslsp procedure String2List S; %. Make list with ASCII values in S
+ if StringP S then begin scalar L, N;
+ L := NIL;
+ N := StrLen StrInf S;
+ for I := N step -1 until 0 do
+ L := MkINT StrByt(StrInf S, I) . L; % strip S each time in case GC
+ return L;
+ end else NonStringError(S, 'String2List);
+
+syslsp procedure List2Vector L; %. convert list to vector
+ if PairP L or NULL L then begin scalar V, N;% this function is used by READ
+ N := IntInf Length L - 1;
+ V := GtVECT N;
+ for I := 0 step 1 until N do
+ << VecItm(V, I) := car L;
+ L := cdr L >>;
+ return MkVEC V;
+ end else NonPairError(L, 'List2Vector);
+
+syslsp procedure Vector2List V; %. Convert vector to list
+ if VectorP V then begin scalar L, N;
+ L := NIL;
+ N := VecLen VecInf V;
+ for I := N step -1 until 0 do
+ L := VecItm(VecInf V, I) . L; % strip V each time in case GC
+ return L;
+ end else NonVectorError(V, 'Vector2List);
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/kernel/type-errors.red
Index: psl-1983/3-1/kernel/type-errors.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/type-errors.red
@@ -0,0 +1,62 @@
+%
+% TYPE-ERRORS.RED - Error handlers for common type mismatches
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 15 September 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 27 Jan 1983 1621-PST
+% Added NonIOChannelError
+% <PSL.INTERP>TYPE-ERRORS.RED.6, 20-Jan-82 03:10:00, Edit by GRISS
+% Added NonWords Error
+
+lisp procedure TypeError(Offender, Fn, Typ);
+ StdError BldMsg("An attempt was made to do %p on %r, which is not %w",
+ Fn, Offender, Typ);
+
+lisp procedure UsageTypeError(Offender, Fn, Typ, Usage);
+ StdError
+ BldMsg("An attempt was made to use %r as %w in %p, where %w is needed",
+ Offender, Usage, Fn, Typ);
+
+lisp procedure IndexError(Offender, Fn);
+ UsageTypeError(Offender, Fn, "an integer", "an index");
+
+lisp procedure NonPairError(Offender, Fn);
+ TypeError(Offender, Fn, "a pair");
+
+lisp procedure NonIDError(Offender, Fn);
+ TypeError(Offender, Fn, "an identifier");
+
+lisp procedure NonNumberError(Offender, Fn);
+ TypeError(Offender, Fn, "a number");
+
+lisp procedure NonIntegerError(Offender, Fn);
+ TypeError(Offender, Fn, "an integer");
+
+lisp procedure NonPositiveIntegerError(Offender, Fn);
+ TypeError(Offender, Fn, "a non-negative integer");
+
+lisp procedure NonCharacterError(Offender, Fn);
+ TypeError(Offender, Fn, "a character");
+
+lisp procedure NonStringError(Offender, Fn);
+ TypeError(Offender, Fn, "a string");
+
+lisp procedure NonVectorError(Offender, Fn);
+ TypeError(Offender, Fn, "a vector");
+
+lisp procedure NonWords(Offender, Fn);
+ TypeError(Offender, Fn, "a words vector");
+
+lisp procedure NonSequenceError(Offender, Fn);
+ TypeError(Offender, Fn, "a sequence");
+
+lisp procedure NonIOChannelError(Offender, Fn);
+ TypeError(Offender, Fn, "a legal I/O channel");
+
+END;
ADDED psl-1983/3-1/kernel/types.build
Index: psl-1983/3-1/kernel/types.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/types.build
@@ -0,0 +1,14 @@
+%
+% TYPES.BUILD - Files with type conversions and others
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+PathIn "type-conversions.red"$ % convert from one type to another
+PathIn "vectors.red"$ % GetV, PutV, UpbV
+PathIn "sequence.red"$ % Indx, SetIndx, Sub, SetSub, Concat
ADDED psl-1983/3-1/kernel/vectors.red
Index: psl-1983/3-1/kernel/vectors.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/kernel/vectors.red
@@ -0,0 +1,102 @@
+%
+% VECTORS.RED - Standard Lisp Vector functions
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.KERNEL>VECTORS.RED.2, 10-Jan-83 15:54:19, Edit by PERDUE
+% Added EGetV etc. for EVectors, paralleling Vectors
+
+% MkVect and MkEVector are found in PK:CONS-MKVECT.RED
+
+on SysLisp;
+
+syslsp procedure GetV(Vec, I); %. Retrieve the I'th entry of Vec
+begin scalar StripV, StripI;
+ return if VectorP Vec then
+ if IntP I then % can't have vectors bigger than INUM
+ << StripV := VecInf Vec;
+ StripI := IntInf I;
+ if StripI >= 0 and StripI <= VecLen StripV then
+ VecItm(StripV, StripI)
+ else
+ StdError BldMsg('"Subscript %r in GetV is out of range",
+ I) >>
+ else
+ IndexError(I, 'GetV)
+ else
+ NonVectorError(Vec, 'GetV);
+end;
+
+syslsp procedure PutV(Vec, I, Val); %. Store Val at I'th position of Vec
+begin scalar StripV, StripI;
+ return if VectorP Vec then
+ if IntP I then % can't have vectors bigger than INUM
+ << StripV := VecInf Vec;
+ StripI := IntInf I;
+ if StripI >= 0 and StripI <= VecLen StripV then
+ VecItm(StripV, StripI) := Val
+ else
+ StdError BldMsg('"Subscript %r in PutV is out of range",
+ I) >>
+ else
+ IndexError(I, 'PutV)
+ else
+ NonVectorError(Vec, 'PutV);
+end;
+
+syslsp procedure UpbV V; %. Upper limit of vector V
+ if VectorP V then MkINT VecLen VecInf V else NIL;
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% EVectors
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+syslsp procedure EVECTORP V;
+ TAG(V) EQ EVECT;
+
+syslsp procedure EGETV(Vec, I); %. Retrieve the I'th entry of Vec
+begin scalar StripV, StripI;
+ return if EvectorP Vec then
+ if IntP I then % can't have vectors bigger than INUM
+ << StripV := VecInf Vec;
+ StripI := IntInf I;
+ if StripI >= 0 and StripI <= VecLen StripV then
+ VecItm(StripV, StripI)
+ else
+ StdError BldMsg('"Subscript %r in EGETV is out of range",
+ I) >>
+ else
+ IndexError(I, 'EGETV)
+ else
+ NonVectorError(Vec, 'EGETV);
+end;
+
+syslsp procedure Eputv(Vec, I, Val); %. Store Val at I'th position of Vec
+begin scalar StripV, StripI;
+ return if EvectorP Vec then
+ if IntP I then % can't have vectors bigger than INUM
+ << StripV := VecInf Vec;
+ StripI := IntInf I;
+ if StripI >= 0 and StripI <= VecLen StripV then
+ VecItm(StripV, StripI) := Val
+ else
+ StdError BldMsg('"Subscript %r in Eputv is out of range",
+ I) >>
+ else
+ IndexError(I, 'Eputv)
+ else
+ NonVectorError(Vec, 'Eputv);
+end;
+
+syslsp procedure EUpbV V; %. Upper limit of vector V
+ if EvectorP V then MkINT EVecLen EVecInf V else NIL;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/lap/addr2id.b
Index: psl-1983/3-1/lap/addr2id.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/addr2id.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/association.b
Index: psl-1983/3-1/lap/association.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/association.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/big-faslend.b
Index: psl-1983/3-1/lap/big-faslend.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/big-faslend.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/br-unbr.b
Index: psl-1983/3-1/lap/br-unbr.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/br-unbr.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/bug.b
Index: psl-1983/3-1/lap/bug.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/bug.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/build.b
Index: psl-1983/3-1/lap/build.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/build.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/char-macro.b
Index: psl-1983/3-1/lap/char-macro.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/char-macro.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/chars.b
Index: psl-1983/3-1/lap/chars.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/chars.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/clcomp.lap
Index: psl-1983/3-1/lap/clcomp.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/clcomp.lap
@@ -0,0 +1,1 @@
+(LOAD USEFUL CLCOMP1)
ADDED psl-1983/3-1/lap/clcomp1.b
Index: psl-1983/3-1/lap/clcomp1.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/clcomp1.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/common.b
Index: psl-1983/3-1/lap/common.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/common.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/comp-decls.b
Index: psl-1983/3-1/lap/comp-decls.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/comp-decls.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/compiler.b
Index: psl-1983/3-1/lap/compiler.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/compiler.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/data-machine.b
Index: psl-1983/3-1/lap/data-machine.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/data-machine.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/debug.b
Index: psl-1983/3-1/lap/debug.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/debug.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/dec20-asm.b
Index: psl-1983/3-1/lap/dec20-asm.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/dec20-asm.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/dec20-cmac.b
Index: psl-1983/3-1/lap/dec20-cmac.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/dec20-cmac.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/dec20-comp.b
Index: psl-1983/3-1/lap/dec20-comp.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/dec20-comp.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/dec20-lap.b
Index: psl-1983/3-1/lap/dec20-lap.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/dec20-lap.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/defstruct.b
Index: psl-1983/3-1/lap/defstruct.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/defstruct.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/dir-stuff.b
Index: psl-1983/3-1/lap/dir-stuff.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/dir-stuff.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/directory.b
Index: psl-1983/3-1/lap/directory.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/directory.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/display-char.b
Index: psl-1983/3-1/lap/display-char.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/display-char.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/evalhook.b
Index: psl-1983/3-1/lap/evalhook.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/evalhook.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/exec.b
Index: psl-1983/3-1/lap/exec.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/exec.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/extended-char.b
Index: psl-1983/3-1/lap/extended-char.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/extended-char.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/f-dstruct.b
Index: psl-1983/3-1/lap/f-dstruct.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/f-dstruct.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/faslout.b
Index: psl-1983/3-1/lap/faslout.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/faslout.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/fast-arith.b
Index: psl-1983/3-1/lap/fast-arith.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-arith.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/fast-defstruct.lap
Index: psl-1983/3-1/lap/fast-defstruct.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-defstruct.lap
@@ -0,0 +1,1 @@
+(LOAD DEFSTRUCT SYSLISP INUM FAST!-VECTOR F-DSTRUCT)
ADDED psl-1983/3-1/lap/fast-evectors.b
Index: psl-1983/3-1/lap/fast-evectors.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-evectors.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/fast-int.b
Index: psl-1983/3-1/lap/fast-int.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-int.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/fast-strings.b
Index: psl-1983/3-1/lap/fast-strings.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-strings.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/fast-vector.b
Index: psl-1983/3-1/lap/fast-vector.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-vector.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/fast-vectors.b
Index: psl-1983/3-1/lap/fast-vectors.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/fast-vectors.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/file-primitives.b
Index: psl-1983/3-1/lap/file-primitives.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/file-primitives.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/file-support.b
Index: psl-1983/3-1/lap/file-support.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/file-support.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/find.b
Index: psl-1983/3-1/lap/find.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/find.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/format.b
Index: psl-1983/3-1/lap/format.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/format.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/get-command-args.b
Index: psl-1983/3-1/lap/get-command-args.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/get-command-args.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/get-command-string.b
Index: psl-1983/3-1/lap/get-command-string.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/get-command-string.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/get-heap-bounds.b
Index: psl-1983/3-1/lap/get-heap-bounds.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/get-heap-bounds.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/graph-tree.b
Index: psl-1983/3-1/lap/graph-tree.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/graph-tree.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/gsort.b
Index: psl-1983/3-1/lap/gsort.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/gsort.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/h-stats-1.b
Index: psl-1983/3-1/lap/h-stats-1.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/h-stats-1.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/hash.b
Index: psl-1983/3-1/lap/hash.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/hash.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/hcons.b
Index: psl-1983/3-1/lap/hcons.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/hcons.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/heap-stats.b
Index: psl-1983/3-1/lap/heap-stats.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/heap-stats.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/help.b
Index: psl-1983/3-1/lap/help.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/help.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/history.b
Index: psl-1983/3-1/lap/history.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/history.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/homedir.b
Index: psl-1983/3-1/lap/homedir.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/homedir.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/if-system.b
Index: psl-1983/3-1/lap/if-system.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/if-system.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/if.b
Index: psl-1983/3-1/lap/if.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/if.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/init-file.b
Index: psl-1983/3-1/lap/init-file.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/init-file.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/input-stream.b
Index: psl-1983/3-1/lap/input-stream.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/input-stream.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/inspect.b
Index: psl-1983/3-1/lap/inspect.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/inspect.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/interrupt.b
Index: psl-1983/3-1/lap/interrupt.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/interrupt.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/inum.b
Index: psl-1983/3-1/lap/inum.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/inum.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/jsys.b
Index: psl-1983/3-1/lap/jsys.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/jsys.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/kernel.b
Index: psl-1983/3-1/lap/kernel.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/kernel.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/lap-to-asm.b
Index: psl-1983/3-1/lap/lap-to-asm.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/lap-to-asm.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/loop.b
Index: psl-1983/3-1/lap/loop.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/loop.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/mathlib.b
Index: psl-1983/3-1/lap/mathlib.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/mathlib.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/mini.b
Index: psl-1983/3-1/lap/mini.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/mini.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/monsym.b
Index: psl-1983/3-1/lap/monsym.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/monsym.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/nbarith.b
Index: psl-1983/3-1/lap/nbarith.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nbarith.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/nbig.lap
Index: psl-1983/3-1/lap/nbig.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nbig.lap
@@ -0,0 +1,1 @@
+(load nbarith vector!-fix nbig0)
ADDED psl-1983/3-1/lap/nbig0.b
Index: psl-1983/3-1/lap/nbig0.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nbig0.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/nmode-attributes.b
Index: psl-1983/3-1/lap/nmode-attributes.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nmode-attributes.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/nmode-parsing.b
Index: psl-1983/3-1/lap/nmode-parsing.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nmode-parsing.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/nmode.lap
Index: psl-1983/3-1/lap/nmode.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nmode.lap
@@ -0,0 +1,2 @@
+(faslin "pnb:nmode-20.b")
+(load-nmode)
ADDED psl-1983/3-1/lap/nstruct.b
Index: psl-1983/3-1/lap/nstruct.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/nstruct.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/numeric-operators.b
Index: psl-1983/3-1/lap/numeric-operators.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/numeric-operators.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/objects.b
Index: psl-1983/3-1/lap/objects.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/objects.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/output-stream.b
Index: psl-1983/3-1/lap/output-stream.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/output-stream.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/package.b
Index: psl-1983/3-1/lap/package.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/package.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/parse-command-string.b
Index: psl-1983/3-1/lap/parse-command-string.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/parse-command-string.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pass-1-lap.b
Index: psl-1983/3-1/lap/pass-1-lap.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pass-1-lap.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pathin.b
Index: psl-1983/3-1/lap/pathin.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pathin.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pathnames.b
Index: psl-1983/3-1/lap/pathnames.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pathnames.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pathnamex.b
Index: psl-1983/3-1/lap/pathnamex.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pathnamex.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pcheck.b
Index: psl-1983/3-1/lap/pcheck.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pcheck.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/poly.b
Index: psl-1983/3-1/lap/poly.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/poly.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pp.b
Index: psl-1983/3-1/lap/pp.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pp.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pr-driv.b
Index: psl-1983/3-1/lap/pr-driv.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pr-driv.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pr-main.b
Index: psl-1983/3-1/lap/pr-main.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pr-main.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pr-text.b
Index: psl-1983/3-1/lap/pr-text.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pr-text.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pr2d-driv.b
Index: psl-1983/3-1/lap/pr2d-driv.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pr2d-driv.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pr2d-main.b
Index: psl-1983/3-1/lap/pr2d-main.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pr2d-main.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pr2d-text.b
Index: psl-1983/3-1/lap/pr2d-text.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pr2d-text.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pretty.b
Index: psl-1983/3-1/lap/pretty.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pretty.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/prettyprint.lap
Index: psl-1983/3-1/lap/prettyprint.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/prettyprint.lap
@@ -0,0 +1,3 @@
+% The files prettyprint.* were changed to pp.*
+% This allows old code that loaded prettyprint to still get the module.
+(load pp)
ADDED psl-1983/3-1/lap/prlisp.lap
Index: psl-1983/3-1/lap/prlisp.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/prlisp.lap
@@ -0,0 +1,1 @@
+(load rawio rawbreak mathlib pr-main pr-text pr-driv)
ADDED psl-1983/3-1/lap/prlisp2d.lap
Index: psl-1983/3-1/lap/prlisp2d.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/prlisp2d.lap
@@ -0,0 +1,1 @@
+(load rawio rawbreak mathlib pr2d-main pr2d-text pr2d-driv)
ADDED psl-1983/3-1/lap/processor-time.b
Index: psl-1983/3-1/lap/processor-time.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/processor-time.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/program-command-interpreter.b
Index: psl-1983/3-1/lap/program-command-interpreter.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/program-command-interpreter.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/psl-input-stream.b
Index: psl-1983/3-1/lap/psl-input-stream.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/psl-input-stream.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/psl-output-stream.b
Index: psl-1983/3-1/lap/psl-output-stream.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/psl-output-stream.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/pslcomp-main.b
Index: psl-1983/3-1/lap/pslcomp-main.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/pslcomp-main.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/rawbreak.b
Index: psl-1983/3-1/lap/rawbreak.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/rawbreak.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/rawio.b
Index: psl-1983/3-1/lap/rawio.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/rawio.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/rcref.b
Index: psl-1983/3-1/lap/rcref.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/rcref.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/read-utils.b
Index: psl-1983/3-1/lap/read-utils.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/read-utils.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/ring-buffer.b
Index: psl-1983/3-1/lap/ring-buffer.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/ring-buffer.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/rlisp.b
Index: psl-1983/3-1/lap/rlisp.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/rlisp.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/rlispcomp.b
Index: psl-1983/3-1/lap/rlispcomp.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/rlispcomp.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/rprint.b
Index: psl-1983/3-1/lap/rprint.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/rprint.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/slow-strings.b
Index: psl-1983/3-1/lap/slow-strings.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/slow-strings.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/slow-vectors.b
Index: psl-1983/3-1/lap/slow-vectors.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/slow-vectors.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/sm.b
Index: psl-1983/3-1/lap/sm.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/sm.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/step.b
Index: psl-1983/3-1/lap/step.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/step.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/string-input.b
Index: psl-1983/3-1/lap/string-input.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/string-input.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/string-search.b
Index: psl-1983/3-1/lap/string-search.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/string-search.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/strings.b
Index: psl-1983/3-1/lap/strings.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/strings.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/stringx.b
Index: psl-1983/3-1/lap/stringx.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/stringx.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/syslisp-syntax.b
Index: psl-1983/3-1/lap/syslisp-syntax.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/syslisp-syntax.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/syslisp.lap
Index: psl-1983/3-1/lap/syslisp.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/syslisp.lap
@@ -0,0 +1,1 @@
+(load syslisp-syntax data-machine)
ADDED psl-1983/3-1/lap/useful.b
Index: psl-1983/3-1/lap/useful.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/useful.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/util.b
Index: psl-1983/3-1/lap/util.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/util.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/vector-fix.b
Index: psl-1983/3-1/lap/vector-fix.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/vector-fix.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/wait.b
Index: psl-1983/3-1/lap/wait.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/wait.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/windows.lap
Index: psl-1983/3-1/lap/windows.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/windows.lap
@@ -0,0 +1,2 @@
+(faslin "pwb:windows-20.b")
+(window-load-all)
ADDED psl-1983/3-1/lap/zbasic.b
Index: psl-1983/3-1/lap/zbasic.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/zbasic.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/zboot.b
Index: psl-1983/3-1/lap/zboot.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/zboot.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/zfiles.b
Index: psl-1983/3-1/lap/zfiles.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/zfiles.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/zmacro.b
Index: psl-1983/3-1/lap/zmacro.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/zmacro.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lap/zpedit.b
Index: psl-1983/3-1/lap/zpedit.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/lap/zpedit.b
cannot compute difference between binary files
ADDED psl-1983/3-1/lpt/0-titlepage.lpt
Index: psl-1983/3-1/lpt/0-titlepage.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/0-titlepage.lpt
@@ -0,0 +1,53 @@
+TR-10 March 1981
+
+
+
+
+
+
+
+
+ THE PORTABLE STANDARD LISP USERS MANUAL
THE PORTABLE STANDARD LISP USERS MANUAL
THE PORTABLE STANDARD LISP USERS MANUAL
+
+
+ BY
BY
BY
+ THE UTAH SYMBOLIC COMPUTATION GROUP
THE UTAH SYMBOLIC COMPUTATION GROUP
THE UTAH SYMBOLIC COMPUTATION GROUP
+
+
+
+ Department of Computer Science
+ University of Utah
+ Salt Lake City, Utah 84112
+
+
+
+ Version 3.1: 7 February 1983
+
+
+
+
+
+
+
+
+ ABSTRACT
ABSTRACT
ABSTRACT
+
+
+This manual describes the primitive data structures, facilities and
+functions present in the Portable Standard LISP (PSL) system. It describes
+the implementation details and functions of interest to a PSL programmer.
+Except for a small number of hand-coded routines for I/O and efficient
+function calling, PSL is written entirely in itself, using a
+machine-oriented mode of PSL, called SYSLISP, to perform word, byte, and
+efficient integer and string operations. PSL is compiled by an enhanced
+version of the Portable LISP Compiler, and currently runs on the DEC-20,
+VAX, and MC68000.
+
+
+
+
+ Copyright (c) 1982 W. Galway, M. L. Griss, B. Morrison, and B. Othmer
+
+
+Work supported in part by the National Science Foundation under Grant
+Numbers MCS80-07034 and MCS82-04247.
ADDED psl-1983/3-1/lpt/00-preface.lpt
Index: psl-1983/3-1/lpt/00-preface.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/00-preface.lpt
@@ -0,0 +1,49 @@
+PSL Manual 7 February 1983
+
+
+Preface
Preface
Preface
+
+
+
+ This Portable LISP implementation would not have been started without the
+effort and inspiration of the original STANDARD LISP reporters (A.
+C. Hearn, J. Marti, M. L. Griss and C. Griss) and the many people who gave
+freely of their advice (often unsolicited!). We especially appreciate the
+comments of A. Norman, M. Rothstein, H. Stoyan and T. Ager.
+
+ It would not have been completed without the efforts of the many people
+who have worked arduously on SYSLISP and PSL at various levels: Eric
+Benson, Will Galway, Ellen Gibson, Martin Griss, Bob Kessler, Steve Lowder,
+Chip Maguire, Beryl Morrison, Don Morrison, Bobbie Othmer, Bob Pendleton,
+and John Peterson.
+
+ We are also grateful for the many comments and significant contributions
+by the LISP users at the Hewlett-Packard Computer Research Center in Palo
+Alto.
+
+ This document has been worked on by most members of the current Utah
+Symbolic Computation Group. The primary editorial function has been in the
+hands of B. Morrison, M. L. Griss, B. Othmer, and W. Galway; major sections
+have been contributed by E. Benson, W. Galway, and D. Morrison.
+
+ This is a preliminary version of the manual, and so may suffer from a
+number of errors and omissions. Please let us know of problems you may
+detect.
+
+ We have also made some stylistic decisions regarding Font to indicate
+semantic classification and Case to make symbols more readable. Based on
+feedback from users of the earlier 3.0 PSL release and manual, we have
+decided to use LISP syntax as the primary description language; where
+appropriate RLISP syntax also appears. We would appreciate comments on
+these and other decisions.
+
+ Based on feedback from numerous users, this issue of the manual uses LISP
+syntax rather than RLISP as the primary description language; where
+appropriate, RLISP syntax also appears.
+
+ Report bugs, errors and mis-features by sending MAIL to PSL-BUGS@Utah-20;
+ Bug
Bug
alternatively, send a message to Griss from within PSL by calling the Bug
+function, BUG(); in RLISP.
+
+ Permission is given to copy this manual for internal use with the PSL
+system.
ADDED psl-1983/3-1/lpt/000-contents.lpt
Index: psl-1983/3-1/lpt/000-contents.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/000-contents.lpt
@@ -0,0 +1,437 @@
+PSL Manual 7 February 1983 page i
+Table of Contents
+
+ TABLE OF CONTENTS
TABLE OF CONTENTS
TABLE OF CONTENTS
+
+
+
+
+
+
+
+ CHAPTER 1. INTRODUCTION
CHAPTER 1. INTRODUCTION
CHAPTER 1. INTRODUCTION
+
+
+ 1.1. Opening Remarks . . . . . . . . . . . . . . 1.1
+ 1.2. Scope of the Manual . . . . . . . . . . . . . 1.2
+ 1.2.1. Typographic Conventions within the Manual . . . 1.2
+ 1.2.2. The Organization of the Manual . . . . . . . 1.3
+
+
+ CHAPTER 2. GETTING STARTED WITH PSL
CHAPTER 2. GETTING STARTED WITH PSL
CHAPTER 2. GETTING STARTED WITH PSL
+
+
+ 2.1. Purpose of This Chapter. . . . . . . . . . . . 2.1
+ 2.2. Defining Logical Device Names for PSL . . . . . . . 2.1
+ 2.2.1. DEC-20 . . . . . . . . . . . . . . . 2.2
+ 2.2.2. VAX . . . . . . . . . . . . . . . . 2.2
+ 2.3. Starting PSL . . . . . . . . . . . . . . . 2.3
+ 2.3.1. DEC-20 . . . . . . . . . . . . . . . 2.3
+ 2.3.2. VAX . . . . . . . . . . . . . . . . 2.3
+ 2.4. Running the PSL System . . . . . . . . . . . . 2.4
+ 2.4.1. Loading Optional Modules . . . . . . . . . 2.4
+ 2.4.2. Notes on Running PSL and RLISP . . . . . . . 2.4
+ 2.4.3. Transcript of a Short Session with PSL . . . . 2.5
+ 2.5. Error and Warning Messages. . . . . . . . . . . 2.8
+ 2.6. Compilation Versus Interpretation . . . . . . . . 2.8
+ 2.7. Function Types. . . . . . . . . . . . . . . 2.9
+ 2.8. Switches and Globals. . . . . . . . . . . . . 2.10
+ 2.9. Reporting Errors and Misfeatures. . . . . . . . . 2.10
+
+
+ CHAPTER 3. RLISP SYNTAX
CHAPTER 3. RLISP SYNTAX
CHAPTER 3. RLISP SYNTAX
+
+
+ 3.1. Motivation for RLISP Interface to PSL . . . . . . . 3.1
+ 3.2. An Introduction to RLISP . . . . . . . . . . . 3.2
+ 3.2.1. LISP equivalents of some RLISP constructs . . . 3.2
+ 3.3. An Overview of RLISP and LISP Syntax Correspondence . . 3.3
+ 3.3.1. Function Call Syntax in RLISP and LISP . . . . 3.3
+ ...
3.3.2. RLISP Infix Operators and Associated LISP Functions....3.4
+
+ 3.3.3. Differences between Parse and Read. . . . . . 3.6
+ 3.3.4. Procedure Definition . . . . . . . . . . 3.6
+ 3.3.5. Compound Statement Grouping . . . . . . . . 3.7
+ 3.3.6. Blocks with Local Variables . . . . . . . . 3.7
PSL Manual 7 February 1983 page ii
+Table of Contents
+
+ 3.3.7. The If Then Else Statement . . . . . . . . 3.8
+ 3.4. Looping Statements . . . . . . . . . . . . . 3.8
+ 3.4.1. While Loop. . . . . . . . . . . . . . 3.8
+ 3.4.2. Repeat Loop . . . . . . . . . . . . . 3.8
+ 3.4.3. For Each Loop. . . . . . . . . . . . . 3.8
+ 3.4.4. For Loop . . . . . . . . . . . . . . 3.9
+ 3.4.5. Loop Examples. . . . . . . . . . . . . 3.9
+ 3.5. Switch Syntax . . . . . . . . . . . . . . . 3.10
+ 3.6. RLISP I/O Syntax . . . . . . . . . . . . . . 3.10
+ 3.7. Transcript of a Short Session with RLISP . . . . . . 3.10
+
+
+ CHAPTER 4. DATA TYPES
CHAPTER 4. DATA TYPES
CHAPTER 4. DATA TYPES
+
+
+ 4.1. Data Types and Structures Supported in PSL . . . . . 4.1
+ 4.1.1. Data Types. . . . . . . . . . . . . . 4.1
+ 4.1.2. Other Notational Conventions. . . . . . . . 4.3
+ 4.1.3. Structures. . . . . . . . . . . . . . 4.4
+ 4.2. Predicates Useful with Data Types . . . . . . . . 4.5
+ 4.2.1. Functions for Testing Equality . . . . . . . 4.5
+ 4.2.2. Predicates for Testing the Type of an Object . . 4.7
+ 4.2.3. Boolean Functions . . . . . . . . . . . 4.8
+ 4.3. Converting Data Types . . . . . . . . . . . . 4.9
+
+
+ CHAPTER 5. NUMBERS AND ARITHMETIC FUNCTIONS
CHAPTER 5. NUMBERS AND ARITHMETIC FUNCTIONS
CHAPTER 5. NUMBERS AND ARITHMETIC FUNCTIONS
+
+
+ 5.1. Big Integers . . . . . . . . . . . . . . . 5.1
+ 5.2. Conversion Between Integers and Floats. . . . . . . 5.1
+ 5.3. Arithmetic Functions. . . . . . . . . . . . . 5.2
+ 5.4. Functions for Numeric Comparison. . . . . . . . . 5.5
+ 5.5. Bit Operations. . . . . . . . . . . . . . . 5.7
+ 5.6. Various Mathematical Functions . . . . . . . . . 5.8
+
+
+ CHAPTER 6. IDENTIFIERS
CHAPTER 6. IDENTIFIERS
CHAPTER 6. IDENTIFIERS
+
+
+ 6.1. Introduction . . . . . . . . . . . . . . . 6.1
+ 6.2. Fields of Ids . . . . . . . . . . . . . . . 6.2
+ 6.3. Identifiers and the Id hash table . . . . . . . . 6.2
+ 6.3.1. Identifier Functions . . . . . . . . . . 6.3
+ 6.3.2. Find. . . . . . . . . . . . . . . . 6.4
+ 6.4. Property List Functions. . . . . . . . . . . . 6.4
+ 6.4.1. Functions for Flagging Ids . . . . . . . . 6.6
+ 6.4.2. Direct Access to the Property Cell. . . . . . 6.7
+ 6.5. Value Cell Functions. . . . . . . . . . . . . 6.7
+ 6.6. Package System Functions . . . . . . . . . . . 6.10
+ 6.7. System Global Variables, Switches and Other "Hooks" . . 6.13
+ 6.7.1. Introduction . . . . . . . . . . . . . 6.13
PSL Manual 7 February 1983 page iii
+Table of Contents
+
+ 6.7.2. Setting Switches. . . . . . . . . . . . 6.14
+ 6.7.3. Special Global Variables . . . . . . . . . 6.15
+ 6.7.4. Special Put Indicators. . . . . . . . . . 6.15
+ 6.7.5. Special Flag Indicators . . . . . . . . . 6.16
+ 6.7.6. Displaying Information About Globals . . . . . 6.16
+
+
+ CHAPTER 7. LIST STRUCTURE
CHAPTER 7. LIST STRUCTURE
CHAPTER 7. LIST STRUCTURE
+
+
+ 7.1. Introduction to Lists and Pairs . . . . . . . . . 7.1
+ 7.2. Basic Functions on Pairs . . . . . . . . . . . 7.2
+ 7.3. Functions for Manipulating Lists. . . . . . . . . 7.4
+ 7.3.1. Selecting List Elements . . . . . . . . . 7.4
+ 7.3.2. Membership and Length of Lists . . . . . . . 7.6
+ 7.3.3. Constructing, Appending, and Concatenating Lists . 7.6
+ 7.3.4. Lists as Sets. . . . . . . . . . . . . 7.7
+ 7.3.5. Deleting Elements of Lists . . . . . . . . 7.8
+ 7.3.6. List Reversal. . . . . . . . . . . . . 7.9
+ 7.4. Functions for Building and Searching A-Lists. . . . . 7.10
+ 7.5. Substitutions . . . . . . . . . . . . . . . 7.11
+
+
+ CHAPTER 8. STRINGS AND VECTORS
CHAPTER 8. STRINGS AND VECTORS
CHAPTER 8. STRINGS AND VECTORS
+
+
+ 8.1. Vector-Like Objects . . . . . . . . . . . . . 8.1
+ 8.2. Strings . . . . . . . . . . . . . . . . . 8.1
+ 8.3. Vectors . . . . . . . . . . . . . . . . . 8.3
+ 8.4. Word Vectors . . . . . . . . . . . . . . . 8.5
+ 8.5. General X-Vector Operations . . . . . . . . . . 8.5
+ 8.6. Arrays . . . . . . . . . . . . . . . . . 8.7
+ 8.7. Common LISP String Functions . . . . . . . . . . 8.7
+
+
+ CHAPTER 9. FLOW OF CONTROL
CHAPTER 9. FLOW OF CONTROL
CHAPTER 9. FLOW OF CONTROL
+
+
+ 9.1. Introduction . . . . . . . . . . . . . . . 9.1
+ 9.2. Conditionals . . . . . . . . . . . . . . . 9.1
+ 9.2.1. Conds and Ifs. . . . . . . . . . . . . 9.1
+ 9.2.2. The Case Statement . . . . . . . . . . . 9.3
+ 9.3. Sequencing Evaluation . . . . . . . . . . . . 9.4
+ 9.4. Iteration . . . . . . . . . . . . . . . . 9.6
+ 9.4.1. For . . . . . . . . . . . . . . . . 9.8
+ 9.4.2. Mapping Functions . . . . . . . . . . . 9.13
+ 9.4.3. Do . . . . . . . . . . . . . . . . 9.15
+ 9.5. Non-Local Exits . . . . . . . . . . . . . . 9.17
PSL Manual 7 February 1983 page iv
+Table of Contents
+
+ CHAPTER 10. FUNCTION DEFINITION AND BINDING
CHAPTER 10. FUNCTION DEFINITION AND BINDING
CHAPTER 10. FUNCTION DEFINITION AND BINDING
+
+
+ 10.1. Function Definition in PSL . . . . . . . . . . 10.1
+ 10.1.1. Notes on Code Pointers . . . . . . . . . 10.1
+ 10.1.2. Functions Useful in Function Definition. . . . 10.2
+ 10.1.3. Function Definition in LISP Syntax . . . . . 10.4
+ 10.1.4. Function Definition in RLISP Syntax . . . . . 10.5
+ 10.1.5. Low Level Function Definition Primitives . . . 10.6
+ 10.1.6. Function Type Predicates. . . . . . . . . 10.7
+ 10.2. Variables and Bindings. . . . . . . . . . . . 10.7
+ 10.2.1. Binding Type Declaration. . . . . . . . . 10.8
+ 10.2.2. Binding Type Predicates . . . . . . . . . 10.9
+ 10.3. User Binding Functions. . . . . . . . . . . . 10.9
+ 10.3.1. Funargs, Closures and Environments . . . . . 10.10
+
+
+ CHAPTER 11. THE INTERPRETER
CHAPTER 11. THE INTERPRETER
CHAPTER 11. THE INTERPRETER
+
+
+ 11.1. Evaluator Functions Eval and Apply. . . . . . . . 11.1
+ 11.2. Support Functions for Eval and Apply . . . . . . . 11.5
+ 11.3. Special Evaluator Functions, Quote, and Function . . . 11.6
+ 11.4. Support Functions for Macro Evaluation . . . . . . 11.7
+
+
+ CHAPTER 12. INPUT AND OUTPUT
CHAPTER 12. INPUT AND OUTPUT
CHAPTER 12. INPUT AND OUTPUT
+
+
+ 12.1. Introduction . . . . . . . . . . . . . . . 12.1
+ 12.2. The Underlying Primitives for Input and Output. . . . 12.1
+ 12.3. Opening, Closing, and Selecting Channels. . . . . . 12.4
+ 12.4. Functions for Printing. . . . . . . . . . . . 12.6
+ 12.5. Functions for Reading . . . . . . . . . . . . 12.13
+ 12.5.1. Reading S-Expression . . . . . . . . . . 12.13
+ 12.5.2. Reading Files into PSL . . . . . . . . . 12.14
+ 12.5.3. Reading Single Characters . . . . . . . . 12.15
+ 12.5.4. Reading Tokens . . . . . . . . . . . . 12.16
+ 12.5.5. Read Macros . . . . . . . . . . . . . 12.24
+ 12.6. Scan Table Utility Functions. . . . . . . . . . 12.25
+ 12.7. I/O to and from Lists and Strings . . . . . . . . 12.25
+ 12.8. Example of Simple I/O in PSL. . . . . . . . . . 12.27
+
+
+ CHAPTER 13. USER INTERFACE
CHAPTER 13. USER INTERFACE
CHAPTER 13. USER INTERFACE
+
+
+ 13.1. Introduction . . . . . . . . . . . . . . . 13.1
+ 13.2. Stopping PSL and Saving a New Executable Core Image . . 13.1
+ 13.3. Init Files. . . . . . . . . . . . . . . . 13.3
+ 13.4. Changing the Default Top Level Function . . . . . . 13.3
+ 13.5. The General Purpose Top Loop Function. . . . . . . 13.4
PSL Manual 7 February 1983 page v
+Table of Contents
+
+ 13.6. The HELP Mechanism . . . . . . . . . . . . . 13.7
+ 13.7. The Break Loop . . . . . . . . . . . . . . 13.8
+ 13.8. Terminal Interaction Commands in RLISP . . . . . . 13.8
+
+
+ CHAPTER 14. ERROR HANDLING
CHAPTER 14. ERROR HANDLING
CHAPTER 14. ERROR HANDLING
+
+
+ 14.1. Introduction . . . . . . . . . . . . . . . 14.1
+ 14.2. The Basic Error Functions. . . . . . . . . . . 14.1
+ 14.3. Break Loop. . . . . . . . . . . . . . . . 14.4
+ 14.4. Interrupt Keys . . . . . . . . . . . . . . 14.8
+ 14.5. Details on the Break Loop. . . . . . . . . . . 14.8
+ 14.6. Some Convenient Error Calls . . . . . . . . . . 14.8
+ 14.7. Special Purpose Error Handlers . . . . . . . . . 14.10
+
+
+ CHAPTER 15. DEBUGGING TOOLS
CHAPTER 15. DEBUGGING TOOLS
CHAPTER 15. DEBUGGING TOOLS
+
+
+ 15.1. Introduction . . . . . . . . . . . . . . . 15.1
+ 15.1.1. Brief Summary of Full Debug Package . . . . . 15.1
+ 15.1.2. Mini-Trace Facility . . . . . . . . . . 15.2
+ 15.1.3. Step . . . . . . . . . . . . . . . 15.3
+ ....
15.1.4. Functions Which Depend on Redefining User Functions..15.4
+
+ 15.1.5. A Few Known Deficiencies. . . . . . . . . 15.4
+ 15.2. Tracing Function Execution . . . . . . . . . . 15.5
+ 15.2.1. Tracing Functions . . . . . . . . . . . 15.5
+ 15.2.2. Saving Trace Output . . . . . . . . . . 15.6
+ 15.2.3. Making Tracing More Selective . . . . . . . 15.7
+ 15.2.4. Turning Off Tracing . . . . . . . . . . 15.8
+ 15.2.5. Enabling Debug Facilities and Automatic Tracing . 15.9
+ 15.3. A Heavy Handed Backtrace Facility . . . . . . . . 15.10
+ 15.4. Embedded Functions . . . . . . . . . . . . . 15.11
+ 15.5. Counting Function Invocations . . . . . . . . . 15.11
+ 15.6. Stubs . . . . . . . . . . . . . . . . . 15.12
+ 15.7. Functions for Printing Useful Information . . . . . 15.12
+ 15.8. Printing Circular and Shared Structures . . . . . . 15.13
+ 15.9. Internals and Customization . . . . . . . . . . 15.14
+ 15.9.1. User Hooks . . . . . . . . . . . . . 15.14
+ 15.9.2. Functions Used for Printing/Reading . . . . . 15.15
+ 15.10. Example . . . . . . . . . . . . . . . . 15.16
+
+
+ CHAPTER 16. EDITORS
CHAPTER 16. EDITORS
CHAPTER 16. EDITORS
+
+
+ 16.1. A Mini Structure-Editor . . . . . . . . . . . 16.1
+ 16.2. The EMODE Screen Editor . . . . . . . . . . . 16.3
+ 16.2.1. Windows and Buffers in Emode . . . . . . . 16.5
+ 16.3. Introduction to the Full Structure Editor . . . . . 16.5
PSL Manual 7 February 1983 page vi
+Table of Contents
+
+ 16.3.1. Starting the Structure Editor . . . . . . . 16.6
+ 16.3.2. Structure Editor Commands . . . . . . . . 16.7
+
+
+ CHAPTER 17. MISCELLANEOUS UTILITIES
CHAPTER 17. MISCELLANEOUS UTILITIES
CHAPTER 17. MISCELLANEOUS UTILITIES
+
+
+ 17.1. Introduction . . . . . . . . . . . . . . . 17.1
+ 17.2. RCREF - Cross Reference Generator for PSL Files . . . 17.1
+ 17.2.1. Restrictions. . . . . . . . . . . . . 17.2
+ 17.2.2. Usage . . . . . . . . . . . . . . . 17.3
+ 17.2.3. Options . . . . . . . . . . . . . . 17.3
+ 17.3. Picture RLISP. . . . . . . . . . . . . . . 17.4
+ 17.4. Tools for Defining Macros. . . . . . . . . . . 17.11
+ 17.4.1. DefMacro . . . . . . . . . . . . . . 17.12
+ 17.4.2. BackQuote. . . . . . . . . . . . . . 17.12
+ 17.4.3. Sharp-Sign Macros . . . . . . . . . . . 17.13
+ 17.4.4. MacroExpand . . . . . . . . . . . . . 17.14
+ 17.4.5. DefLambda. . . . . . . . . . . . . . 17.14
+ 17.5. Simulating a Stack . . . . . . . . . . . . . 17.14
+ 17.6. DefStruct . . . . . . . . . . . . . . . . 17.15
+ 17.6.1. Options . . . . . . . . . . . . . . 17.17
+ 17.6.2. Slot Options. . . . . . . . . . . . . 17.18
+ 17.6.3. A Simple Example . . . . . . . . . . . 17.18
+ 17.7. DefConst . . . . . . . . . . . . . . . . 17.22
+ 17.8. Functions for Sorting . . . . . . . . . . . . 17.22
+ 17.9. Hashing Cons . . . . . . . . . . . . . . . 17.24
+ 17.10. Graph-to-Tree . . . . . . . . . . . . . . 17.25
+ 17.11. Inspect Utility. . . . . . . . . . . . . . 17.26
+
+
+ CHAPTER 18. LOADER AND COMPILER
CHAPTER 18. LOADER AND COMPILER
CHAPTER 18. LOADER AND COMPILER
+
+
+ 18.1. Introduction . . . . . . . . . . . . . . . 18.1
+ 18.2. The Compiler . . . . . . . . . . . . . . . 18.1
+ 18.2.1. Compiling Functions into Memory . . . . . . 18.2
+ 18.2.2. Compiling Functions into FASL Files . . . . . 18.2
+ 18.2.3. Loading FASL Files. . . . . . . . . . . 18.3
+ 18.2.4. Functions to Control the Time When Something is Done 18.4
+ .
+ 18.2.5. Order of Functions for Compilation . . . . . 18.5
+ 18.2.6. Fluid and Global Declarations . . . . . . . 18.5
+ 18.2.7. Switches Controlling Compiler . . . . . . . 18.6
+ 18.2.8. Differences between Compiled and Interpreted Code 18.7
+ 18.2.9. Compiler Errors. . . . . . . . . . . . 18.8
+ 18.3. The Loader. . . . . . . . . . . . . . . . 18.9
+ 18.3.1. Legal LAP Format and Pseudos . . . . . . . 18.10
+ 18.3.2. Examples of LAP for DEC-20, VAX and Apollo. . . 18.10
+ 18.3.3. Lap Switches. . . . . . . . . . . . . 18.13
+ 18.4. Structure and Customization of the Compiler. . . . . 18.14
+ 18.5. First PASS of Compiler. . . . . . . . . . . . 18.14
PSL Manual 7 February 1983 page vii
+Table of Contents
+
+ 18.5.1. Tagging Information . . . . . . . . . . 18.15
+ 18.5.2. Source to Source Transformations . . . . . . 18.15
+ 18.6. Second PASS - Basic Code Generation . . . . . . . 18.15
+ 18.6.1. The Cmacros . . . . . . . . . . . . . 18.15
+ 18.6.2. Classes of Functions . . . . . . . . . . 18.18
+ 18.6.3. Open Functions . . . . . . . . . . . . 18.18
+ 18.7. Third PASS - Optimizations . . . . . . . . . . 18.22
+ 18.8. Some Structural Notes on the Compiler. . . . . . . 18.23
+
+
+ CHAPTER 19. OPERATING SYSTEM INTERFACE
CHAPTER 19. OPERATING SYSTEM INTERFACE
CHAPTER 19. OPERATING SYSTEM INTERFACE
+
+
+ 19.1. Introduction . . . . . . . . . . . . . . . 19.1
+ 19.2. System Dependent Functions . . . . . . . . . . 19.1
+ 19.3. TOPS-20 Interface . . . . . . . . . . . . . 19.2
+ 19.3.1. User Level Interface . . . . . . . . . . 19.2
+ 19.3.2. The Basic Fork Manipulation Functions . . . . 19.4
+ 19.3.3. File Manipulation Functions. . . . . . . . 19.5
+ 19.3.4. Miscellaneous Functions . . . . . . . . . 19.6
+ 19.3.5. Jsys Interface . . . . . . . . . . . . 19.6
+ 19.3.6. Bit, Word and Address Operations for Jsys Calls . 19.8
+ 19.3.7. Examples . . . . . . . . . . . . . . 19.9
+ 19.4. New Vax Specific Interface . . . . . . . . . . 19.10
+ 19.4.1. Setting Your .LOGIN and .CSHRC files. . . . . 19.10
+ 19.4.2. Important PSL executables . . . . . . . . 19.11
+ 19.4.3. Creating the Init Files . . . . . . . . . 19.11
+ 19.4.4. Directories and Symbols . . . . . . . . 19.11
+ 19.4.5. Miscellaneous Unix Interface Functions . . . 19.14
+ 19.4.6. Oload . . . . . . . . . . . . . . 19.14
+ 19.4.7. Calling oloaded functions . . . . . . . . 19.15
+ 19.4.8. OLOAD Internals. . . . . . . . . . . . 19.16
+ 19.4.9. I/O Control functions . . . . . . . . . 19.17
+ 19.5. Apollo System Calls. . . . . . . . . . . . . 19.18
+
+
+ CHAPTER 20. SYSLISP
CHAPTER 20. SYSLISP
CHAPTER 20. SYSLISP
+
+
+ 20.1. Introduction to the SYSLISP level of PSL. . . . . . 20.1
+ 20.2. The Relationship of SYSLISP to RLISP . . . . . . . 20.2
+ 20.2.1. SYSLISP Declarations . . . . . . . . . . 20.2
+ 20.2.2. SYSLISP Mode Analysis. . . . . . . . . . 20.3
+ 20.2.3. Defining Special Functions for Mode Analysis . . 20.3
+ 20.2.4. Modified FOR Loop . . . . . . . . . . . 20.4
+ 20.2.5. Char and IDLOC Macros. . . . . . . . . . 20.4
+ 20.2.6. The Case Statement. . . . . . . . . . . 20.5
+ 20.2.7. Memory Access and Address Operations. . . . . 20.7
+ 20.2.8. Bit-Field Operation . . . . . . . . . . 20.7
+ 20.3. Using SYSLISP. . . . . . . . . . . . . . . 20.9
+ 20.3.1. To Compile SYSLISP Code . . . . . . . . . 20.9
+ 20.4. SYSLISP Functions . . . . . . . . . . . . . 20.10
PSL Manual 7 February 1983 page viii
+Table of Contents
+
+ 20.4.1. W-Arrays . . . . . . . . . . . . . . 20.11
+ 20.5. Remaining SYSLISP Issues . . . . . . . . . . . 20.11
+ 20.5.1. Stand Alone SYSLISP Programs . . . . . . . 20.11
+ 20.5.2. Need for Two Stacks . . . . . . . . . . 20.12
+ 20.5.3. New Mode System. . . . . . . . . . . . 20.12
+ 20.5.4. Extend CREF for SYSLISP . . . . . . . . . 20.12
+
+
+ CHAPTER 21. IMPLEMENTATION
CHAPTER 21. IMPLEMENTATION
CHAPTER 21. IMPLEMENTATION
+
+
+ 21.1. Overview of the Implementation . . . . . . . . . 21.1
+ 21.2. Files of Interest . . . . . . . . . . . . . 21.1
+ 21.3. Building PSL on the DEC-20 . . . . . . . . . . 21.2
+ 21.4. Building the LAP to Assembly Translator . . . . . . 21.5
+ 21.5. The Garbage Collectors and Allocators. . . . . . . 21.5
+ 21.5.1. Compacting Garbage Collector on DEC-20 . . . . 21.5
+ 21.5.2. Two-Space Stop and Copy Collector on VAX . . . 21.6
+ 21.6. The HEAPs . . . . . . . . . . . . . . . . 21.6
+ 21.7. Allocation Functions . . . . . . . . . . . . 21.8
+
+
+ CHAPTER 22. PARSER TOOLS
CHAPTER 22. PARSER TOOLS
CHAPTER 22. PARSER TOOLS
+
+
+ 22.1. Introduction . . . . . . . . . . . . . . . 22.1
+ 22.2. The Table Driven Parser . . . . . . . . . . . 22.2
+ 22.2.1. Flow Diagram for the Parser. . . . . . . . 22.2
+ 22.2.2. Associating the Infix Operator with a Function . 22.4
+ 22.2.3. Precedences . . . . . . . . . . . . . 22.5
+ 22.2.4. Special Cases of 0 <-0 and 0 0. . . . . . . 22.5
+ 22.2.5. Parenthesized Expressions . . . . . . . . 22.5
+ 22.2.6. Binary Operators in General. . . . . . . . 22.6
+ 22.2.7. Assigning Precedences to Key Words . . . . . 22.7
+ 22.2.8. Error Handling . . . . . . . . . . . . 22.7
+ 22.2.9. The Parser Program for the RLISP Language . . . 22.7
+ 22.2.10. Defining Operators . . . . . . . . . . 22.8
+ 22.3. The MINI Translator Writing System. . . . . . . . 22.10
+ 22.3.1. A Brief Guide to MINI. . . . . . . . . . 22.10
+ 22.3.2. Pattern Matching Rules . . . . . . . . . 22.12
+ 22.3.3. A Small Example. . . . . . . . . . . . 22.12
+ 22.3.4. Loading Mini. . . . . . . . . . . . . 22.12
+ 22.3.5. Running Mini. . . . . . . . . . . . . 22.13
+ 22.3.6. MINI Error messages and Error Recovery . . . . 22.13
+ 22.3.7. MINI Self-Definition . . . . . . . . . . 22.13
+ 22.3.8. The Construction of MINI. . . . . . . . . 22.15
+ 22.3.9. History of MINI Development. . . . . . . . 22.16
+ 22.4. BNF Description of RLISP Using MINI . . . . . . . 22.17
PSL Manual 7 February 1983 page ix
+Table of Contents
+
+ CHAPTER 23. BIBLIOGRAPHY
CHAPTER 23. BIBLIOGRAPHY
CHAPTER 23. BIBLIOGRAPHY
+
+
+ CHAPTER 24. INDEX OF CONCEPTS
CHAPTER 24. INDEX OF CONCEPTS
CHAPTER 24. INDEX OF CONCEPTS
+
+
+ CHAPTER 25. INDEX OF FUNCTIONS
CHAPTER 25. INDEX OF FUNCTIONS
CHAPTER 25. INDEX OF FUNCTIONS
+
+
+ CHAPTER 26. INDEX OF GLOBALS AND SWITCHES
CHAPTER 26. INDEX OF GLOBALS AND SWITCHES
CHAPTER 26. INDEX OF GLOBALS AND SWITCHES
ADDED psl-1983/3-1/lpt/01-introduction.lpt
Index: psl-1983/3-1/lpt/01-introduction.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/01-introduction.lpt
@@ -0,0 +1,207 @@
+PSL Manual 7 February 1983 Introduction
+section 1.0 page 1.1
+
+ CHAPTER 1
CHAPTER 1
CHAPTER 1
+ INTRODUCTION
INTRODUCTION
INTRODUCTION
+
+
+
+
+ 1.1. Opening Remarks . . . . . . . . . . . . . . 1.1
+ 1.2. Scope of the Manual . . . . . . . . . . . . . 1.2
+ 1.2.1. Typographic Conventions within the Manual . . . 1.2
+ 1.2.2. The Organization of the Manual . . . . . . . 1.3
+
+
+
+
+1.1. Opening Remarks
1.1. Opening Remarks
1.1. Opening Remarks
+
+ 1
+ This document describes PSL (PORTABLE STANDARD LISP ), a portable,
+"modern" LISP developed at the University of Utah for a variety of
+machines. PSL is upward-compatible with STANDARD LISP [Marti 79]. In most
+cases, STANDARD LISP did not commit itself to specific implementation
+details (since it was to be compatible with a portion of "most" LISPs).
+PSL is more specific and provides many more functions than described in
+that report.
+
+ The goals of PSL include:
+
+
+ - Providing implementation tools for LISP that can be used to
+ ____
implement a variety of LISP-like systems, including mini-lisps
+ embedded in other language systems (such as existing PASCAL or
+ ADA applications).
+
+ - Effectively supporting the REDUCE algebra system on a number of
+ machines, and providing algebra modules extracted from (or
+ modeled upon) REDUCE to be included in applications such as CAI
+ and CAGD.
+
+ - Providing a uniform, modern LISP programming environment on all
+ of the machines that we use (DEC-20, VAX, and 68000 based
+ personal machines)--of the power of FRANZ LISP, UCI LISP or
+ MACLISP.
+
+ - Studying the utility of a LISP-based systems language for other
+ applications (such as CAGD or VLSI design) in which SYSLISP code
+ provides efficiency comparable to that of C or BCPL, yet enjoys
+
+
+_______________
+
+ 1
+ "LSP" backwards!
Introduction 7 February 1983 PSL Manual
+page 1.2 section 1.1
+
+ the interactive program development and debugging environment of
+ LISP.
+
+
+
+1.2. Scope of the Manual
1.2. Scope of the Manual
1.2. Scope of the Manual
+
+ This manual is intended to describe the syntax, semantics, and
+implementation of PSL. While we have attempted to make it comprehensive,
+it is not intended for use as a primer. Some prior exposure to LISP will
+prove very helpful. A selection of LISP primers is listed in the
+bibliography in Chapter 23; see for example [Allen 79, Charniak
+80, Weissman 67, Winston 81].
+
+
+1.2.1. Typographic Conventions within the Manual
1.2.1. Typographic Conventions within the Manual
1.2.1. Typographic Conventions within the Manual
+
+ A large proportion of this manual is devoted to descriptions of the
+functions that make up PSL. Each function is provided with a prototypical
+header line. Each argument is given a name and followed by its allowed
+type. If an argument type is not commonly used, it may be a specific set
+ PutD
PutD
enclosed in brackets {...}. For example, this header shows that PutD
+(which defines other functions) takes three arguments:
+ ____
____
____
PutD expr
PutD _____ __ ____ _____ ____ ______ ____ _______ _____ __ expr
(PutD FNAME:id TYPE:ftype BODY:{lambda, code-pointer}): FNAME:id expr
+
+
+ _____ __
1. FNAME, which is an id (identifier).
+
+ ____
2. TYPE, which is the "function type" of the function being
+ defined.
+
+ ____ ______ ____ _______
3. BODY, which is a lambda expression or a code-pointer.
+
+
+ _____
and returns FNAME, the name of the function being defined. Some functions
+are compiled open; these have a note saying "open-compiled" next to the
+function type.
+
+ Some functions accept an arbitrary number of arguments. The header for
+these functions shows a single argument enclosed in square brackets--
+indicating that zero or more occurrences of that argument are allowed. For
+example:
+ And
And _ ____ _____ _______
(And [U:form]): extra-boolean
+ And
And
And is a function which accepts zero or more arguments each of which may
+ ____
be any form.
+
+ In some cases, LISP or RLISP code is given in the function documentation
+as the function's definition. As far as possible, the code is extracted
+from the the current PSL sources (perhaps converted from one syntax to the
+other); however, this code is not always necessarily actually used in PSL,
+and may be given only to clarify the semantics of the function. Please
+ _____
check carefully if you depend on the exact definition.
PSL Manual 7 February 1983 Introduction
+section 1.2 page 1.3
+
+ Some features of PSL are anticipated but not yet fully implemented. When
+these are documented in this manual they are indicated with the words:
+ ___ ___________ ___
___ ___________ ___
___ ___________ ___
[not implemented yet]
[not implemented yet]
[not implemented yet].
+
+
+1.2.2. The Organization of the Manual
1.2.2. The Organization of the Manual
1.2.2. The Organization of the Manual
+
+ This manual is arranged in separate chapters, which are meant to be
+self-contained units. Each begins with a small table of contents serving
+as a summary of constructs and as an aid in skimming. Here is a brief
+overview of the following chapters:
+
+ Chapter 2 is particularly useful for those using PSL for the first time.
+It begins with directions for starting PSL and getting help. It also
+briefly discusses the handling of errors; some of the consequences of PSL
+being both a compiled and an interpreted language; function types; switches
+and globals. PSL treats the parameters for various function types rather
+differently from a number of other dialects, and the serious user should
+definitely become familiar with this information.
+
+ While most LISP implementations use only a fully parenthesized syntax,
+PSL gives the user the option of using an ALGOL-like (or PASCAL-like)
+syntax (RLISP), which many users prefer. Chapter 3 describes the syntax of
+RLISP.
+
+ Chapter 4 describes the data types used in PSL. It includes functions
+useful for testing equality and for changing data types, and predicates
+useful with data types.
+
+ The next seven chapters describe in detail the basic functions provided
+by PSL.
+
+ Chapters 5, 6, 7, and 8 describe functions for manipulating the basic
+ ______ __ ____ ______ ______
data structures of LISP: numbers, ids, lists, and strings and vectors. As
+ _______ __________ ____
virtually every LISP program uses integers, identifiers, and lists
+extensively, these three chapters (5, 6 and 7) should be included in an
+ ______ ______
overview. As vectors and strings are used less extensively, Chapter 8 may
+be skipped on a first reading.
+
+ Chapter 9 and, to some extent, Chapter 4 describe the basic functions
+used to drive a computation. The reader wanting an overview of PSL should
+certainly read these two.
+
+ Chapter 10 describes functions useful in function definition and the idea
+of variable binding. The novice LISP user should definitely read this
+information before proceeding to the rest of the manual. Also described
+here is a proposed scheme for context-switching in the form of the funarg
+and closures.
+
+ Chapter 11 describes functions associated with the interpreter. It
+ Eval Apply
Eval Apply
includes functions having to do with evaluation (Eval and Apply.)
Introduction 7 February 1983 PSL Manual
+page 1.4 section 1.2
+
+ Chapter 12 describes the I/O facilities. Most LISP programs do not
+require sophisticated I/O, so this may be skimmed on a first reading. The
+section dealing with input deals extensively with customizing the scanner
+and reader, which is only of interest to the sophisticated user.
+
+ Chapter 13 presents information about the user interface for PSL. It
+includes some generally useful information on running the system.
+
+ Chapter 14 discusses error handling. Much of the information is of
+interest primarily to the sophisticated user. However, LISP provides a
+convenient interactive facility for correcting certain errors which may be
+of interest to all, so a first reading should include parts of this
+chapter.
+
+ Chapter 15 discusses some tools for debugging and statistics gathering
+based on the concept of embedding function definitions.
+
+ Chapter 16 describes the structure editor, which permits the user to
+construct and modify list structure, including the bodies of interpreted
+functions, and erroneous expressions within the BREAK loop. It also
+describes EMODE, an EMACS-like screen editor.
+
+ Chapter 17 briefly describes modules of useful tools. This includes the
+PSL cross-reference generator, and various tools for defining macros.
+
+ The rest of the manual may be skipped on first reading.
+
+ Chapter 18 describes functions associated with the compiler. Chapter
+19 describes some functions for communicating with the TOPS-20 and UNIX
+operating systems. Chapter 20 describes SYSLISP, a language incorporating
+features from both BCPL and LISP and which is used as an implementation
+language for PSL. Chapter 21 presents details of the portable
+implementation which may be of interest to sophisticated users, including a
+description of the garbage collector. Chapter 22 describes the extensible
+parser. Section 22.4 provides BNF descriptions of the input accepted by
+the token scanner, standard reader, and syntactic (RLISP) reader.
+
+ Chapter 23 contains the bibliography.
+
+ Chapter 24 is an alphabetical index of concepts. Chapter 25 is an
+alphabetical index of all functions defined in the manual. Chapter
+26 contains an alphabetical index of all global variables and switches
+defined in the manual.
ADDED psl-1983/3-1/lpt/02-getstart.lpt
Index: psl-1983/3-1/lpt/02-getstart.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/02-getstart.lpt
@@ -0,0 +1,475 @@
+PSL Manual 7 February 1983 Getting Started
+section 2.0 page 2.1
+
+ CHAPTER 2
CHAPTER 2
CHAPTER 2
+ GETTING STARTED WITH PSL
GETTING STARTED WITH PSL
GETTING STARTED WITH PSL
+
+
+
+
+ 2.1. Purpose of This Chapter. . . . . . . . . . . . 2.1
+ 2.2. Defining Logical Device Names for PSL . . . . . . . 2.1
+ 2.2.1. DEC-20 . . . . . . . . . . . . . . . 2.2
+ 2.2.2. VAX . . . . . . . . . . . . . . . . 2.2
+ 2.3. Starting PSL . . . . . . . . . . . . . . . 2.3
+ 2.3.1. DEC-20 . . . . . . . . . . . . . . . 2.3
+ 2.3.2. VAX . . . . . . . . . . . . . . . . 2.3
+ 2.4. Running the PSL System . . . . . . . . . . . . 2.4
+ 2.4.1. Loading Optional Modules . . . . . . . . . 2.4
+ 2.4.2. Notes on Running PSL and RLISP . . . . . . . 2.4
+ 2.4.3. Transcript of a Short Session with PSL . . . . 2.5
+ 2.5. Error and Warning Messages. . . . . . . . . . . 2.8
+ 2.6. Compilation Versus Interpretation . . . . . . . . 2.8
+ 2.7. Function Types. . . . . . . . . . . . . . . 2.9
+ 2.8. Switches and Globals. . . . . . . . . . . . . 2.10
+ 2.9. Reporting Errors and Misfeatures. . . . . . . . . 2.10
+
+
+
+
+2.1. Purpose of This Chapter
2.1. Purpose of This Chapter
2.1. Purpose of This Chapter
+
+ This chapter is for beginning users of PSL on the DEC-20 and the VAX 750
+and 780 at Utah. It also is meant to be a guide to those familiar with
+LISP, and particularly STANDARD LISP, who would like to use PSL as they
+read the manual.
+
+ It begins with descriptions of how to set up various logical device
+definitions required by PSL and how to run PSL. A number of miscellaneous
+hints and reminders are given in the remainder of the chapter.
+
+
+
+2.2. Defining Logical Device Names for PSL
2.2. Defining Logical Device Names for PSL
2.2. Defining Logical Device Names for PSL
+
+ When PSL is installed on your system, the person doing the installation
+has the option of using a number of different directory structures and
+names, depending on local conventions and available space. There are also
+options to select a small system (without all source-code online) or a full
+system. Also, as each release of PSL is prepared, we may find it
+convenient to change the names and number of sub-directories. In order to
+minimize the inconvenience, an attempt has been made to refer to such
+directories through some form of logical name ("logical device name" on
+DEC-20, shell-variable or link on VAX-UNIX, etc.). In some cases these can
+be used as if they were directory names (DEC-20), and in some cases not
+(VAX). These definitions are edited at installation time to reflect local
Getting Started 7 February 1983 PSL Manual
+page 2.2 section 2.2
+
+usage, and stored in a file whose name is something like
+"logical-names.xxx". This file will be placed on an appropriate directory
+(often <PSL> on the DEC-20, ~psl on the VAX, etc.). A message should be
+sent out by your installer to indicate where the file is, and its name. It
+is suggested that a use of this file be placed in your LOGIN.CMD , .cshrc
+or equivalent file.
+
+
+2.2.1. DEC-20
2.2.1. DEC-20
2.2.1. DEC-20
+
+ It is absolutely essential that TAKE <PSL>LOGICAL-NAMES.CMD be inserted
+in your LOGIN.CMD file, or executed at EXEC level before using PSL. PSL is
+written to rely on these logical device definitions in place of
+"hard-coded" directory names. PSL also uses TOPS-20 search paths, so that
+for example, "PH:" is defined as the directory (or search list) on which
+PSL looks for help files, "PL:" is the directory (or search list) on which
+ Lap Fasl
Lap Fasl
PSL looks for Lap and Fasl files of the form "xxxx.b", etc.
+
+ The logical name "PSL:" is defined to be the directory on which the PSL
+executables reside. Thus "PSL:PSL.EXE" should start PSL executing.
+
+ There should usually be a PSL:BARE-PSL.EXE, PSL:PSL.EXE and
+PSL:RLISP.EXE. BARE-PSL is the minimum system that is constructed during
+the PSL build sequence. PSL and RLISP usually contain additional modules
+selected by the installer, felt to be most commonly used by your community.
+
+
+2.2.2. VAX
2.2.2. VAX
2.2.2. VAX
+
+ In the current version of UNIX (4.1) there is no equivalent of logical
+device definitions that can be used to access files on other directories
+from within PSL or many UNIX utilities. We have defined a set of shell
+variables ($ variables) that may be used outside of an executing PSL to
+refer to the appropriate directories, and a series of PSL global variables
+for use inside PSL that contain the equivalent of search paths. In a
+future release of PSL for the VAX, we may be able to look up such shell or
+environment variables during the attempt to OPEN a file.
+
+ These variables are defined in the file "psl-names", usually on the
+directory "~psl" (actually /u/local/psl at UTAH). Insert a "source
+~psl/psl-names" or equivalent in your .cshrc file. Variables such as
+"$psl", "$pl", and "$pu" (on which many utility sources are stored) are
+defined.
+
+ There should usually be a "$psl/bare-psl", "$psl/psl" and "$psl/rlisp".
+Bare-psl is the minimum system that is constructed during the PSL build
+sequence. PSL and RLISP usually contain additional modules selected by the
+installer, felt to be most commonly used by your community.
PSL Manual 7 February 1983 Getting Started
+section 2.3 page 2.3
+
+2.3. Starting PSL
2.3. Starting PSL
2.3. Starting PSL
+
+
+2.3.1. DEC-20
2.3.1. DEC-20
2.3.1. DEC-20
+
+ After defining the device names, type either PSL:RLISP or PSL:PSL to the
+at-sign prompt, @. A welcome message indicates the nature of the system
+running, usually with a date and version number. This information may be
+useful in describing problems. [Messages concerning bugs or misfeatures
+should be directed to PSL-BUGS@UTAH-20; see Section 2.9.]
+
+ BARE-PSL.EXE is a "bare" PSL using LISP (i.e. parenthesis) syntax. This
+is a small core-image and is ideal for simple LISP execution. It also
+ Fasl
Fasl
includes a resident Fasl, so additional modules can be loaded. In
+particular, the compiler is not normally part of PSL.EXE.
+
+ RLISP.EXE is PSL with additional modules loaded, corresponding to the
+most common system run at Utah. It contains the compiler and an RLISP
+parser. For more information about RLISP see Chapter 3.
+
+ It is assumed by PSL and RLISP that file names be of the form "*.sl" or
+ Fasl
Fasl
"*.lsp" for LISP files, "*.red" for RLISP files, "*.b" for Fasl files, and
+ Lap
Lap
"*.lap" for Lap files.
+
+
+2.3.2. VAX
2.3.2. VAX
2.3.2. VAX
+
+ The executable files are $psl/psl and $psl/rlisp. Loadable modules are
+on $pl/*.b or $pl/*.lap. Help files are on $ph/*.hlp.
+
+ $psl/rlisp has the RLISP parser and compiler. Additional modules can be
+ Load Error
Load Error
loaded from $pl using the Load function. <Ctrl-C> causes a call to Error,
+and may be used to stop a runaway computation. <Ctrl-Z> or the function
+Quit
Quit
Quit cause the process to be stopped, and control returned to the shell;
+the process may be continued. A sequence of <Ctrl-D>'s (EOF) causes the
+process to be terminated. This is to allow the use of I/O redirection from
+the shell.
+
+ [??? Add Cntrl-B for BREAK loop call ???]
[??? Add Cntrl-B for BREAK loop call ???]
[??? Add Cntrl-B for BREAK loop call ???]
+
+ Unix 4.1 and 4.1a allow only 14 characters for file names, and case is
+significant. The use of ".r" instead of ".red" is recommended as the
+extension for RLISP files to save on meaningful characters; other
+extensions are as on the DEC-20.
Getting Started 7 February 1983 PSL Manual
+page 2.4 section 2.4
+
+2.4. Running the PSL System
2.4. Running the PSL System
2.4. Running the PSL System
+
+ The following sub-sections collect a few miscellaneous notes that are
+further expanded on elsewhere. They are provided here simply to get you
+started.
+
+
+2.4.1. Loading Optional Modules
2.4.1. Loading Optional Modules
2.4.1. Loading Optional Modules
+
+ Certain modules are not present in the "kernel" or "bare-psl" system, but
+can be loaded as options. Some of these optional modules will "auto-load"
+when first referenced; others may be explicitly loaded by the user, or
+included by the installer when building the "PSL" and "RLISP" core images.
+Optional modules can be loaded by executing
+
+ LOAD modulename; % in RLISP syntax
+ or
+ (LOAD modulename) % in LISP syntax.
+
+ The global variable OPTIONS!* contains a list of modules currently
+loaded; it does not mention those in the "bare-psl" kernel. Do not reset
+this variable; it is used by LOAD to avoid loading already present modules.
+ RELOAD
RELOAD
[See RELOAD in Chapter 18].
+
+
+2.4.2. Notes on Running PSL and RLISP
2.4.2. Notes on Running PSL and RLISP
2.4.2. Notes on Running PSL and RLISP
+
+
+ Help Help
Help Help
a. Use Help(); [(Help) in LISP] for general help or an indication
+ Help Help
Help Help
of what help is available; use Help (a, b, c); [(Help a b c) in
+ LISP] for information on topics a, b, and c. This call prints
+ Help
Help
files from the PH: (i.e. <PSL.HELP>) directory. Try Help x;
+ Help
Help
[(Help x) in LISP] on:
+
+
+ ? Exec Mini Step
+ Br Find MiniEditor Strings
+ Break Switches MiniTrace TopLoop
+ Bug For Package Tr
+ Debug Globals PRLISP Trace
+ Defstruct GSort PSL UnBr
+ Edit Help RCREF UnTr
+ EditF JSYS RLISP Useful
+ Editor Load ShowSwitches ZFiles
+ Emode Manual Slate ZPEdit
+ EWindow
+
+
+ [??? Help() does not work in RLISP ???]
[??? Help() does not work in RLISP ???]
[??? Help() does not work in RLISP ???]
+
+ b. File I/O needs string-quotes (") around file names. File names
+ may use full TOPS-20 or UNIX conventions, including directories,
PSL Manual 7 February 1983 Getting Started
+section 2.4 page 2.5
+
+ sub-directories, etc.
+
+ IN
IN
Input in RLISP mode is done using the 'IN "File-Name";' command.
+
+ Dskin
Dskin
Use (Dskin "File-Name") for input from LISP mode.
+
+ For information on similar I/O functions see Chapter 12.
+
+ Quit Quit
Quit Quit
c. Use Quit; [(Quit) in LISP] or <Ctrl-C> on the DEC-20 (<Ctrl-Z>
+ on the VAX) to exit. <Ctrl-C> (<Ctrl-Z> on the VAX) is useful
+ for stopping run-away computations. On the DEC-20, typing START
+ or CONTINUE to the @ prompt from the EXEC usually restarts in a
+ reasonable way.
+
+
+2.4.3. Transcript of a Short Session with PSL
2.4.3. Transcript of a Short Session with PSL
2.4.3. Transcript of a Short Session with PSL
+
+ The following is a transcript of running PSL on the DEC-20.
Getting Started 7 February 1983 PSL Manual
+page 2.6 section 2.4
+
+ @psl:psl
+ PSL 3.1, 11-Oct-82
+
+ 1 Lisp> % Notice the numbered prompt.
+ 1 Lisp> % Comments begin with "%" and do not change the prompt
+ 1 Lisp> % number.
+ 1 Lisp> (Setq Z '(1 2 3)) % Make an assignment for Z.
+ (1 2 3)
+ 2 Lisp> (Cdr Z) % Notice the change in prompt number.
+ (2 3)
+ 3 Lisp> (De Count (L) % Count counts the number or elements
+ 3 Lisp> (Cond ((Null L) 0) % in a list L.
+ 3 Lisp> (T (Add1 (Count (Cdr L))))))
+ COUNT
+ 4 Lisp> (Count Z) % Call Count on Z.
+ 3
+ 5 Lisp> (Tr Count) % Trace the recursive execution of "Count".
+ (COUNT)
+ 6 Lisp> % A call on "Count" now shows the value of
+ 6 Lisp> % "Count" and of its arguments each time
+ 6 Lisp> (Count Z) % it is called.
+ COUNT being entered
+ L: (1 2 3)
+ COUNT (level 2) being entered
+ L: (2 3)
+ COUNT (level 3) being entered
+ L: (3)
+ COUNT (level 4) being entered
+ L: NIL
+ COUNT (level 4) = 0
+ COUNT (level 3) = 1
+ COUNT (level 2) = 2
+ COUNT = 3
+ 3
+ 7 Lisp> (De Factorial (X)
+ 7 Lisp> (Cond ((Eq 1)
+ 7 Lisp> (T (Times X (Factorial (Sub1 X))))))
+ FACTORIAL
+ 8 Lisp> (Tr Factorial)
+ (FACTORIAL)
+ 9 Lisp> (Factorial 4) % Trace execution of "Factorial".
+ FACTORIAL being entered
+ X: 4
+ FACTORIAL (level 2) being entered
+ X: 3
+ FACTORIAL (level 3) being entered
+ X: 2 % Notice values being returned.
+ FACTORIAL (level 4) being entered
+ X: 1
+ FACTORIAL (level 4) = 1
+ FACTORIAL (level 3) = 2
+ FACTORIAL (level 2) = 6
PSL Manual 7 February 1983 Getting Started
+section 2.4 page 2.7
+
+ FACTORIAL = 24
+ 24
+ 10 Lisp> (Untr Count Factorial)
+ NIL
+ 11 Lisp> (Count 'A) % This generates an error causing the break
+ % loop to be entered.
+ ***** An attempt was made to do CDR on `A', which is not a pair
+ Break loop
+ 12 Lisp break>> ?
+ BREAK():{Error,return-value}
+ ----------------------------
+ This is a Read-Eval-Print loop, similar to the top level loop,
+ except that the following IDs at the top level cause functions to
+ be called rather than being evaluated:
+ ? Print this message, listing active Break IDs
+ T Print stack backtrace
+ Q Exit break loop back to ErrorSet
+ A Abort to top level, i.e. restart PSL
+ C Return last value to the ContinuableError call
+ R Reevaluate ErrorForm!* and return
+ M Display ErrorForm!* as the "message"
+ E Invoke a simple structure editor on ErrorForm!*
+ (For more information do Help Editor.)
+ I Show a trace of any interpreted functions
+
+ See the manual for details on the Backtrace, and how ErrorForm!* is
+ set. The Break Loop attempts to use the same TopLoopRead!* etc, as
+ the calling top loop, just expanding the PromptString!*.
+ NIL
+ 13 Lisp break>> % Get a Trace-Back of the
+ 13 Lisp break>> I % interpreted functions.
+ Backtrace, including interpreter functions, from top of stack:
+ LIST2 CDR COUNT ADD1 COND COUNT LIST2
+ NIL
+ 14 Lisp break>> Q % To exit the Break Loop.
+ 15 Lisp> % Load in a file, showing its execution.
+ 15 Lisp> % The file contains the following:
+ 15 Lisp> % (Setq X (Cons 'A (Cons 'B Nil)))
+ 15 Lisp> % (Count X)
+ 15 Lisp> % (Reverse X)
+ 15 Lisp> (Dskin "small-file.sl")
+ (A B)
+ 2
+ (B A)
+ NIL
+ 16 Lisp> (Quit)
+ @continue
+ "Continued"
+ 17 Lisp> ^C
+ @start
+
+ 18 Lisp> (Quit)
Getting Started 7 February 1983 PSL Manual
+page 2.8 section 2.5
+
+2.5. Error and Warning Messages
2.5. Error and Warning Messages
2.5. Error and Warning Messages
+
+ Many functions detect and signal appropriate errors (see Chapter 14 for
+details); in many cases, an error message is printed. The error conditions
+are given as part of a function's definition in the manual. An error
+message is preceded by five stars (*); a warning message is preceded by
+three. For example, most primitive functions check the type of their
+arguments and display an error message if an argument is incorrect. The
+type mismatch error mentions the function in which the error was detected,
+gives the expected type, and prints the actual value passed.
+
+ Sometimes one sees a prompt of the form:
+
+ Do you really want to redefine the system function `FOO'?
+
+This means you have tried to define a function with the same name as a
+function used by the PSL system. A Y, N, YES, NO, or B response is
+required. B starts a break loop. After quitting the break loop, answer Y,
+ YesP
YesP
N, Yes, or No to the query. See the definition of YesP in Chapter 13. An
+affirmative response is extremely dangerous and should be given only if you
+are a system expert. Usually this means that your function must be given a
+different name.
+
+ A common warning message is
+
+ *** Function "FOO" has been redefined
+
+If this occurs without the query above, you are redefining your own
+function. This happens normally if you read a file, edit it, and read it
+in again.
+
+ ________
The switch !*USERMODE controls whether redefinition of functions is
+"dangerous". When NIL, no query is generated. User functions entered when
+ ________
!*USERMODE is on are flagged with the 'USER indicator, used by this
+ ________
mechanism. The switch !*REDEFMSG, described in section 10.1.2, can be set
+to suppress these warning messages. There is also a property 'LOSE that
+will prevent redefinition; the new definition will be ignored, and a
+warning given.
+
+
+
+2.6. Compilation Versus Interpretation
2.6. Compilation Versus Interpretation
2.6. Compilation Versus Interpretation
+
+ PSL uses both compiled and interpreted code. If compiled, a function
+usually executes faster and is smaller. However, there are some semantic
+differences of which the user should be aware. For example, some recursive
+functions are made non-recursive, and certain functions are open-compiled.
+A call to an open-compiled function is replaced, on compilation, by a
+series of online instructions instead of just being a reference to another
+function. Functions compiled open may not do as much type checking. The
+user may have to supply some declarations to control this behavior.
PSL Manual 7 February 1983 Getting Started
+section 2.6 page 2.9
+
+ The exact semantic differences between compiled and interpreted functions
+are more fully discussed in Chapter 18 and in the Portable LISP Compiler
+paper [Griss 81].
+
+ [??? We intend to consider the modification of the LISP semantics so as
[??? We intend to consider the modification of the LISP semantics so as
[??? We intend to consider the modification of the LISP semantics so as
+ to ensure that these differences are minimized. If a conflict occurs,
to ensure that these differences are minimized. If a conflict occurs,
to ensure that these differences are minimized. If a conflict occurs,
+ we will restrict the interpreter, rather than extending (and slowing
we will restrict the interpreter, rather than extending (and slowing
we will restrict the interpreter, rather than extending (and slowing
+ down) the capabilities of the compiled code. ???]
down) the capabilities of the compiled code. ???]
down) the capabilities of the compiled code. ???]
+
+ We indicate on the function definition line if it is typically compiled
+OPEN; this information helps in debugging code that uses these functions.
+These functions do not appear in backtraces and cannot be redefined, traced
+or broken in compiled code.
+
+ [??? Should we make open-compiled functions totally un-redefinable
[??? Should we make open-compiled functions totally un-redefinable
[??? Should we make open-compiled functions totally un-redefinable
+ without special action, even for interpreted code. Consistency! E.g.
without special action, even for interpreted code. Consistency! E.g.
without special action, even for interpreted code. Consistency! E.g.
+ flag 'COND LOSE. ???]
flag 'COND LOSE. ???]
flag 'COND LOSE. ???]
+
+
+
+2.7. Function Types
2.7. Function Types
2.7. Function Types
+
+ Eval NoEval
Eval NoEval
Eval-type functions are those called with evaluated arguments. NoEval
+ Spread
Spread
functions are called with unevaluated arguments. Spread-type functions
+have their arguments passed in a one-to-one correspondence with their
+ NoSpread
NoSpread
formal parameters. NoSpread functions receive their arguments as a single
+____
list.
+
+ There are four function types implemented in PSL:
+
+
+____
____
____
expr Eval Spread
expr Eval Spread
expr An Eval, Spread function, with a maximum of 15 arguments. In
+ referring to the formal parameters we mean their values. Each
+ function of this type should always be called with the expected
+ number of parameters, as indicated in the function definition.
+ Future versions of PSL will check this consistency.
+
+_____
_____
_____
fexpr NoEval NoSpread
fexpr NoEval NoSpread
fexpr A NoEval, NoSpread function. There is no limit on the number of
+ arguments. In referring to the formal parameters we mean the
+ unevaluated arguments, collected as a single List, and passed as
+ a single formal parameter to the function body.
+
+_____
_____
_____
nexpr Eval NoSpread
nexpr Eval NoSpread
nexpr An Eval, NoSpread function. Each call on this kind of function
+ may present a different number of arguments, which are evaluated,
+ collected into a list, and passed in to the function body as a
+ single formal parameter.
+
+_____ _____
_____ _____
_____ _____
macro macro
macro macro
macro The macro is a function which creates a new S-expression for
+ subsequent evaluation or compilation. There is no limit to the
+ _____
_____
_____
macro
macro
number of arguments a macro may have. The descriptions of the
+ Eval Expand
Eval Expand
Eval and Expand functions in Chapter 11 provide precise details.
Getting Started 7 February 1983 PSL Manual
+page 2.10 section 2.8
+
+2.8. Switches and Globals
2.8. Switches and Globals
2.8. Switches and Globals
+
+ Generally, switch names begin with !* and global names end with !*, where
+"!" is an escape character. One can set a switch !*xxx to T by using On
+xxx; in RLISP [(on xxx) in LISP]; one can set it to NIL by using Off xxx;
+in RLISP [(off xxx) in LISP]. For example) !*ECHO, !*PVAL and !*PECHO are
+switches that control Input Echo, Value Echo and Parse Echo. These
+switches are described more fully in Chapters 12 and 13.
+
+ For more information, type "HELP SWITCHES;" or "HELP GLOBALS;", or see
+Section 6.7.
+
+
+
+2.9. Reporting Errors and Misfeatures
2.9. Reporting Errors and Misfeatures
2.9. Reporting Errors and Misfeatures
+
+ Send bug MAIL to PSL-BUGS@UTAH-20. The message will be distributed to a
+list of users concerned with bugs and maintenance, and a copy will be kept
+in <PSL>BUGS-MISSFEATURES.TXT at UTAH-20.
+
+
+ Bug
Bug _________ ___ __ ____ ____
(Bug ): undefined DEC-20 only, expr
+
+ Bug
Bug
The function Bug(); can be called from within PSL:RLISP. This
+ starts MAIL (actually MM) in a lower fork, with the To: line set
+ up to Griss. Simply type the subject of the complaint, and then
+ the message.
+
+ After typing message about a bug or a misfeature end finally with
+ a <Ctrl-Z>.
+
+ <Ctrl-N> aborts the message.
+
+ [??? needs switches ???]
[??? needs switches ???]
[??? needs switches ???]
ADDED psl-1983/3-1/lpt/03-rlisp.lpt
Index: psl-1983/3-1/lpt/03-rlisp.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/03-rlisp.lpt
@@ -0,0 +1,609 @@
+PSL Manual 7 February 1983 RLISP
+section 3.0 page 3.1
+
+ CHAPTER 3
CHAPTER 3
CHAPTER 3
+ RLISP SYNTAX
RLISP SYNTAX
RLISP SYNTAX
+
+
+
+
+ 3.1. Motivation for RLISP Interface to PSL . . . . . . . 3.1
+ 3.2. An Introduction to RLISP . . . . . . . . . . . 3.2
+ 3.2.1. LISP equivalents of some RLISP constructs . . . 3.2
+ 3.3. An Overview of RLISP and LISP Syntax Correspondence . . 3.3
+ 3.3.1. Function Call Syntax in RLISP and LISP . . . . 3.4
+ ...
3.3.2. RLISP Infix Operators and Associated LISP Functions....3.4
+
+ 3.3.3. Differences between Parse and Read. . . . . . 3.6
+ 3.3.4. Procedure Definition . . . . . . . . . . 3.6
+ 3.3.5. Compound Statement Grouping . . . . . . . . 3.7
+ 3.3.6. Blocks with Local Variables . . . . . . . . 3.7
+ 3.3.7. The If Then Else Statement . . . . . . . . 3.8
+ 3.4. Looping Statements . . . . . . . . . . . . . 3.8
+ 3.4.1. While Loop. . . . . . . . . . . . . . 3.8
+ 3.4.2. Repeat Loop . . . . . . . . . . . . . 3.8
+ 3.4.3. For Each Loop. . . . . . . . . . . . . 3.9
+ 3.4.4. For Loop . . . . . . . . . . . . . . 3.9
+ 3.4.5. Loop Examples. . . . . . . . . . . . . 3.9
+ 3.5. Switch Syntax . . . . . . . . . . . . . . . 3.10
+ 3.6. RLISP I/O Syntax . . . . . . . . . . . . . . 3.10
+ 3.7. Transcript of a Short Session with RLISP . . . . . . 3.11
+
+
+
+
+3.1. Motivation for RLISP Interface to PSL
3.1. Motivation for RLISP Interface to PSL
3.1. Motivation for RLISP Interface to PSL
+
+ Most of the PSL users at Utah prefer to write LISP code using an
+ALGOL-like (or PASCAL-like) preprocessor language, RLISP, because of its
+similarity to the heavily used PASCAL and C languages. RLISP was developed
+as part of the REDUCE Computer Algebra project [Hearn 73], and is the
+ALGOL-like user language as well as the implementation language. RLISP
+provides a number of syntactic niceties which we find convenient, such as
+ If-Then-Else
If-Then-Else
vector subscripts, case statement, If-Then-Else, etc. We usually do not
+distinguish LISP from RLISP, and can mechanically translate from one to the
+other in either direction using a parser and pretty-printer written in PSL.
+That is, RLISP is a convenience, but it is not necessary to use RLISP
+syntax rather than LISP. A complete BNF-like definition of RLISP and its
+translation to LISP using the MINI system is given in Section 22.4. Also
+discussed in Chapter 22 is an extensible table driven parser which is used
+for the current RLISP parser. There we give explicit tables which define
+RLISP syntax.
+
+ In this chapter we provide enough of an introduction to make the examples
+and sources readable, and to assist the user in writing RLISP code.
RLISP 7 February 1983 PSL Manual
+page 3.2 section 3.2
+
+3.2. An Introduction to RLISP
3.2. An Introduction to RLISP
3.2. An Introduction to RLISP
+
+ An RLISP program consists of a set of functional commands which are
+evaluated sequentially. RLISP expressions are built up from declarations,
+statements and expressions. Such entities are composed of sequences of
+numbers, variables, operators, strings, reserved words and delimiters (such
+as commas and parentheses), which in turn are sequences of characters. The
+evaluation proceeds by a parser first converting the ALGOL-like RLISP
+source language into LISP S-expressions, and evaluating and printing the
+ Parse-Eval-Print
Parse-Eval-Print
result. The basic cycle is thus Parse-Eval-Print, although the specific
+functions, and additional processing, are under the control of a variety of
+switches, described in appropriate sections.
+
+
+3.2.1. LISP equivalents of some RLISP constructs
3.2.1. LISP equivalents of some RLISP constructs
3.2.1. LISP equivalents of some RLISP constructs
+
+ The following gives a few examples of RLISP statements and functions and
+their corresponding LISP forms. To see the exact LISP equivalent of RLISP
+code, set the switch !*PECHO to T [On PECHO; in RLISP, (On PECHO) in LISP].
+
+ Assignment statements in RLISP and LISP:
+
+ X := 1; (setq x 1)
+
+ A procedure to take a factorial, in RLISP:
+
+ LISP PROCEDURE FACTORIAL N;
+ IF N <= 1 THEN 1
+ ELSE N * FACTORIAL (N-1);
+
+ in LISP:
+
+ (de factorial (n)
+ (cond
+ ((leq n 1) 1)
+ (T
+ (times n (factorial (difference n 1))))))
+
+ Take the Factorial of 5 in RLISP and in LISP:
+
+ FACTORIAL 5; (factorial 5)
+
+ Build a list X as a series of "Cons"es in RLISP:
+
+ X := 'A . 'B . 'C . NIL;
+
+ in LISP:
+ (setq x (cons 'a (cons 'b (cons 'c nil))))
PSL Manual 7 February 1983 RLISP
+section 3.3 page 3.3
+
+3.3. An Overview of RLISP and LISP Syntax Correspondence
3.3. An Overview of RLISP and LISP Syntax Correspondence
3.3. An Overview of RLISP and LISP Syntax Correspondence
+
+ The RLISP parser converts RLISP expressions, typed in at the terminal or
+read from a file, into directly executable LISP expressions. For
+convenience in the following examples, the "==>" arrow is used to indicate
+the LISP actually produced from the input RLISP. To see the LISP
+equivalents of RLISP code on the machine, set the switch !*PECHO to T [On
+Pecho; in RLISP, (On Pecho) in LISP]. As far as possible, upper and lower
+cases are used as follows:
+
+
+ a. Upper case tokens and punctuation represent items which must
+ appear as is in the source RLISP or output LISP.
+
+ b. Lower case tokens represent other legal RLISP constructs or
+ corresponding LISP translations. We typically use "e" for
+ ____
expression, "s" for statement, and "v" for variable; "-list" is
+ tacked on for lists of these objects.
+
+
+ For example, the following rule describes the syntax of assignment in
+RLISP:
+
+ VAR := number;
+ ==> (SETQ VAR number)
+
+ Another example:
+
+ __________ ______ _ ______ _
IF expression THEN action_1 ELSE action_2
+ __________ ______ _ ______ _
==> (COND ((expression action_1) (T action_2)))
+
+ In RLISP, a function is recognized as an "ftype" (one of the tokens EXPR,
+FEXPR, etc. or none) followed by the keyword PROCEDURE, followed by an "id"
+(the name of the function), followed by a "v-list" (the formal parameter
+names) enclosed in parentheses. A semicolon terminates the title line.
+The body of the function is a <statement> followed by a semicolon. In LISP
+syntax, a function is defined using one of the "Dx" functions, i.e. one of
+De Df Dm Dn
De Df Dm Dn
De, Df, Dm, or Dn, depending on "ftype". For example:
+
+ EXPR PROCEDURE NULL(X);
+ EQ(X, NIL);
+ ==> (DE NULL (X) (EQ X NIL))
+
+
+3.3.1. Function Call Syntax in RLISP and LISP
3.3.1. Function Call Syntax in RLISP and LISP
3.3.1. Function Call Syntax in RLISP and LISP
+
+ A function call with N arguments (called an N-ary function) is most
+commonly represented as "FN(X1, X2, ... Xn)" in RLISP and as
+"(FN X1 X2 ... Xn)" in LISP. Commas are required to separate the arguments
+in RLISP but not in LISP. A zero argument function call is "FN()" in RLISP
+and "(FN)" in LISP. An unary function call is "FN(a)" or "FN a" in RLISP
+and "(FN a)" in LISP; i.e. the parentheses may be omitted around the single
RLISP 7 February 1983 PSL Manual
+page 3.4 section 3.3
+
+argument of any unary function in RLISP.
+
+
+3.3.2. RLISP Infix Operators and Associated LISP Functions
3.3.2. RLISP Infix Operators and Associated LISP Functions
3.3.2. RLISP Infix Operators and Associated LISP Functions
+
+ Many important PSL binary functions, particularly those for arithmetic
+operations, have associated infix operators, consisting of one or two
+special characters. The conversion of an RLISP expression "A op B" to its
+corresponding LISP form is easy: "(fn A B)", in which "fn" is the
+associated function. The function name fn may also be used as an ordinary
+RLISP function call, "fn(A, B)".
+
+ Refer to Chapter 22 for details on how the association of "op" and "fn"
+is installed.
+
+ Parentheses may be used to specify the order of combination.
+"((A op_a B) op_b C)" in RLISP becomes "(fn_b (fn_a A B) C)" in LISP.
+
+ If two or more different operators appear in a sequence, such as
+"A op_a B op_b C", grouping (similar to the insertion of parentheses) is
+done based on relative precedence of the operators, with the highest
+precedence operator getting the first argument pair: "(A op_a B) op_b C"
+if Precedence(op_a) >= Precedence(op_b); "A op_a (B op_b C)" if
+Precedence(op_a) < Precedence(op_b).
+
+ If two or more of the same operator appear in a sequence, such as
+"A op B op C", grouping is normally to the left (Left Associative; i.e.
+"(fn (fn A B) C)"), unless the operator is explicitly Right Associative
+ Cons SetQ
Cons SetQ
(such as . for Cons and := for SetQ; i.e. "(fn A (fn B C))").
+
+ The operators + and * are N-ary; i.e. "A nop B nop C nop B" parses into
+"(nfn A B C D)" rather than into "(nfn (nfn (nfn A B) C) D)".
+
+ The current binary operator-function correspondence is as follows:
PSL Manual 7 February 1983 RLISP
+section 3.3 page 3.5
+
+________ ________ __________
Operator Function Precedence
+
+ Cons
Cons
. Cons 23 Right Associative
+ Expt
Expt
** Expt 23
+
+ Quotient
Quotient
/ Quotient 19
+ Times
Times
* Times 19 N-ary
+
+ Difference
Difference
- Difference 17
+ Plus
Plus
+ Plus 17 N-ary
+
+Eq Eq
Eq Eq
Eq Eq 15
+ Equal
Equal
= Equal 15
+ Geq
Geq
>= Geq 15
+ GreaterP
GreaterP
> GreaterP 15
+ Leq
Leq
<= Leq 15
+ LessP
LessP
< LessP 15
+Member Member
Member Member
Member Member 15
+Memq MemQ
Memq MemQ
Memq MemQ 15
+Neq Neq
Neq Neq
Neq Neq 15
+
+And And
And And
And And 11 N-ary
+
+Or Or
Or Or
Or Or 9 N-ary
+
+ SetQ
SetQ
:= SetQ 7 Right Associative
+
+
+ Note: There are other INFIX operators, mostly used as key-words within
+ Then Else If Do
Then Else If Do
other syntactic constructs (such as Then or Else in the If-..., or Do in
+ While
While
the While-..., etc.). They have lower precedences than those given above.
+These key-words include: the parentheses "()", the brackets "[]", the colon
+":", the comma ",", the semi-colon ";", the dollar sign "$", and the ids:
+Collect Conc Do Else End Of Procedure Product Step Such Sum
Collect Conc Do Else End Of Procedure Product Step Such Sum
Collect, Conc, Do, Else, End, Of, Procedure, Product, Step, Such, Sum,
+Then To Until
Then To Until
Then, To, and Until.
+
+ As pointed out above, an unary function FN can be used with or without
+parentheses: FN(a); or FN a;. In the latter case, FN is assumed to behave
+as a prefix operator with highest precedence (99) so that "FOO 1 ** 2"
+parses as "FOO(1) ** 2;". The operators +, -, and / can also be used as
+ Plus Minus Recip
Plus Minus Recip
unary prefix operators, mapping to Plus, Minus and Recip, respectively,
+with precedence 26. Certain other unary operators (RLISP key-words) have
+low precedences or explicit special purpose parsing functions. These
+include: BEGIN, CASE, CONT, EXIT, FOR, FOREACH, GO, GOTO, IF, IN, LAMBDA,
+NOOP, NOT, OFF, ON, OUT, PAUSE, QUIT, RECLAIM, REPEAT, RETRY, RETURN,
+SCALAR, SHOWTIME, SHUT, WHILE and WRITE.
RLISP 7 February 1983 PSL Manual
+page 3.6 section 3.3
+
+3.3.3. Differences between Parse and Read
3.3.3. Differences between Parse and Read
3.3.3. Differences between Parse and Read
+
+ A single character can be interpreted in different ways depending on
+context and on whether it is used in a LISP or in an RLISP expression.
+Such differences are not immediately apparent to a novice user of RLISP,
+but an example is given below.
+
+ The RLISP infix operator "." may appear in an RLISP expression and is
+ Parse Cons
Parse Cons
converted by the Parse function to the LISP function Cons, as in the
+expression x := 'y . 'z;. A dot may also occur in a quoted expression in
+ Read
Read
RLISP mode, in which case it is interpreted by Read as part of the notation
+ Read
Read
for pairs, as in (SETQ X '(Y . Z)). Note that Read called from LISP or
+from RLISP uses slightly different scan tables (see Chapter 12). In order
+ Cons Cons
Cons Cons
to use the function Cons in LISP one must use the word Cons in a prefix
+position.
+
+
+3.3.4. Procedure Definition
3.3.4. Procedure Definition
3.3.4. Procedure Definition
+
+ Procedure definitions in PSL (both RLISP and LISP) are not nested as in
+ALGOL; all appear at the same top level as in C. The basic function for
+ PutD
PutD
defining procedures is PutD (see Chapter 10). Special syntactic forms are
+provided in both RLISP and LISP:
+
+ mode ftype PROCEDURE name(v_1,...,v_n); body;
+ ==> (Dx name (v_1 ... v_N) body)
+
+ Examples:
+
+ PROCEDURE ADD1 N;
+ N+1;
+ ==> (DE ADD1 (N) (PLUS N 1))
+
+ MACRO PROCEDURE FOO X;
+ LIST('FUM, CDR X, CDR X);
+ ==> (DM FOO (X) (LIST 'FUM (CDR X) (CDR X))
+
+ The value returned by the procedure is the value of the body; no
+assignment to the function name (as in ALGOL or PASCAL) is needed.
+
+ In the general definition given above "mode" is usually optional; it can
+be LISP or SYMBOLIC (which mean the same thing) or SYSLISP [only of
+ ____ _____
____ _____
____ _____
expr fexpr
expr fexpr
importance if SYSLISP and LISP are inter-mixed]. "Ftype" is expr, fexpr,
+_____ _____ ______
_____ _____ ______
_____ _____ ______
macro nexpr smacro
macro nexpr smacro
macro, nexpr, or smacro (or can be omitted, in which case it defaults to
+____
____
____
expr
expr
expr). Name(v_1,...,v_N) is any legal form of call, including infix. Dx
+ ____ _____ _____ _____
____ _____ _____ _____
____ _____ _____ _____
De expr Df fexpr Dm macro Dn nexpr Ds
De expr Df fexpr Dm macro Dn nexpr Ds
is De for expr, Df for fexpr, Dm for macro, Dn for nexpr, and Ds for
+______
______
______
smacro
smacro
smacro.
+
+ ______ _____
______ _____
______ _____
smacro macro
smacro macro
The smacro is a simple substitution macro.
PSL Manual 7 February 1983 RLISP
+section 3.3 page 3.7
+
+ SMACRO PROCEDURE ELEMENT X; % Defines ELEMENT(x) to substitute
+ CAR CDR (X); % as Car Cdr x;
+ ==> (DS ELEMENT (X) (CAR (CDR X)))
+
+In code which calls ELEMENT after it was defined, ELEMENT(foo); behaves
+exactly like CAR CDR foo;.
+
+
+3.3.5. Compound Statement Grouping
3.3.5. Compound Statement Grouping
3.3.5. Compound Statement Grouping
+
+ A group of RLISP expressions may be used in any position in which a
+single expression is expected by enclosing the group of expressions in
+double angle brackets, << and >>, and separating them by the ; delimiter.
+
+ The RLISP <<A; B; C; ... Z>> becomes (PROGN A B C ... Z) in LISP. The
+value of the group is the value of the last expression, Z.
+ Example:
+
+ X:=<<PRINT X; X+1>>; % prints old X then increments X
+ ==> (SETQ X (PROGN (PRINT X) (PLUS X 1)))
+
+
+3.3.6. Blocks with Local Variables
3.3.6. Blocks with Local Variables
3.3.6. Blocks with Local Variables
+
+ A more powerful construct, sometimes used for the same purpose as the
+ Begin-End Prog
Begin-End Prog
<< >> group, is the Begin-End block in RLISP or Prog in LISP. This
+construct also permits the allocation of 0 or more local variables,
+initialized to NIL. The normal value of a block is NIL, but it may be
+ Return
Return
exited at a number of points, using the Return statement, and each can
+ GoTo
GoTo
return a different value. The block also permits labels and a GoTo
+construct.
+
+ Example:
+
+ BEGIN SCALAR X,Y; % SCALAR declares locals X and Y
+ X:='(1 2 3);
+ L1: IF NULL X THEN RETURN Y;
+ Y:=CAR X;
+ X:=CDR X;
+ GOTO L1;
+ END;
+
+
+ ==> (PROG (X Y)
+ (SETQ X '(1 2 3))
+ L1 (COND ((NULL X) (RETURN Y)))
+ (SETQ Y (CAR X))
+ (SETQ X (CDR X))
+ (GO L1))
RLISP 7 February 1983 PSL Manual
+page 3.8 section 3.3
+
+3.3.7. The If Then Else Statement
3.3.7. The If Then Else Statement
3.3.7. The If Then Else Statement
+
+ If Cond
If Cond
RLISP provides an If statement, which maps into the LISP Cond statement.
+See Chapter 9 for full details. For example:
+
+ IF e THEN s;
+ ==> (COND (e s))
+
+ IF e THEN s1 ELSE s2;
+ ==> (COND (e s1) (T s2))
+
+ IF e1 THEN s1
+ ELSE IF e2 THEN s2
+ ELSE s3;
+ ==> (COND (e1 s1)
+ (e2 s2)
+ (T s3))
+
+
+
+3.4. Looping Statements
3.4. Looping Statements
3.4. Looping Statements
+
+ While Repeat For For Each
While Repeat For For Each
RLISP provides While, Repeat, For and For Each loops. These are
+discussed in greater detail in Chapter 9. Some examples follow:
+
+
+3.4.1. While Loop
3.4.1. While Loop
3.4.1. While Loop
+
+ WHILE e DO s; % As long as e NEQ NIL, do s
+ ==> (WHILE e s)
+
+
+3.4.2. Repeat Loop
3.4.2. Repeat Loop
3.4.2. Repeat Loop
+
+ REPEAT s UNTIL e; % repeat doing s until "e" is not NIL
+ ==> (REPEAT s e)
+
+
+3.4.3. For Each Loop
3.4.3. For Each Loop
3.4.3. For Each Loop
+
+ For Each
For Each
The For Each loops provide various mapping options, processing elements
+of a list in some way and sometimes constructing a new list.
+
+ FOR EACH x IN y DO s; % y is a list, x traverses list bound to eac
+ % element in turn.
+ ==> (FOREACH x IN y DO s)
+
+ FOR EACH x ON y DO s; % y is a list, x traverses list Bound to suc
+ % Cdr's of y.
+ ==> (FOREACH x ON y DO s)
+
+ Other options can return modified lists, etc. See chapter 9.
PSL Manual 7 February 1983 RLISP
+section 3.4 page 3.9
+
+3.4.4. For Loop
3.4.4. For Loop
3.4.4. For Loop
+
+ For
For
The For loop permits an iterative form with a compacted control variable.
+Other options can compute sums and products.
+
+ FOR i := a:b DO s; % step i successively from a to b in
+ % steps of 1.
+ ==> (FOR (FROM I a b 1) DO s)
+
+ FOR i := a STEP b UNTIL c DO s; % More general stepping
+ ==> (FOR (FROM I a c b) DO s)
+
+
+3.4.5. Loop Examples
3.4.5. Loop Examples
3.4.5. Loop Examples
+
+ LISP PROCEDURE count lst; % Count elements in lst
+ BEGIN SCALAR k;
+ k:=0;
+ WHILE PAIRP lst DO <<k:=k+1; lst:=CDR lst>>;
+ RETURN k;
+ END;
+
+ ==> (DE COUNT (LST)
+ (PROG (K)
+ (SETQ K 0)
+ (WHILE (PAIRP LST)
+ (PROGN
+ (SETQ K (PLUS K 1))
+ (SETQ LST (CDR LST))))
+ (RETURN K)))
+
+ or
+
+ LISP PROCEDURE CountNil lst; % Count NIL elements in lst
+ BEGIN SCALAR k;
+ k:=0;
+ FOR EACH x IN lst DO If Null x then k:=k+1;
+ RETURN k;
+ END;
+
+ ==> (DE COUNTNIL (LST)
+ (PROG (K)
+ (SETQ K 0)
+ (FOREACH X IN LST DO (COND
+ ((NULL X) (SETQ K (PLUS K 1)))))
+ (RETURN K)))
RLISP 7 February 1983 PSL Manual
+page 3.10 section 3.5
+
+3.5. Switch Syntax
3.5. Switch Syntax
3.5. Switch Syntax
+
+ Two declarations are offered to the user for turning on or off a variety
+of switches in the system. Switches are global variables that have only
+the values T or NIL. By convention, the switch name is XXXX, but the
+associated global variable is !*XXXX. The RLISP commands ON and OFF take a
+list of switch names as argument and turn them on and off respectively
+(i.e. set the corresponding !* variable to T or NIL).
+
+ Example:
+
+ ON ECHO, FEE, FUM; % Sets !*ECHO, !*FEE, !*FUM to T;
+ ==> (ON ECHO FEE FUM)
+
+ OFF INT,SYSLISP; % Sets !*INT and !*SYSLISP to NIL
+ ==> (OFF INT SYSLISP)
+
+ [??? Mention SIMPFG property ???]
[??? Mention SIMPFG property ???]
[??? Mention SIMPFG property ???]
+
+ See Section 6.7 for a complete set of switches and global variables.
+
+
+
+3.6. RLISP I/O Syntax
3.6. RLISP I/O Syntax
3.6. RLISP I/O Syntax
+
+ RLISP provides special commands to OPEN and SELECT files for input or for
+output and to CLOSE files. File names must be enclosed in "....". Files
+ In
In
with the extension ".sl" or ".lsp" are read by In in LISP mode rather than
+RLISP mode.
+
+ IN "<griss.stuff>fff.red","ggg.lsp"; % First reads fff.red
+ % Then reads ggg.lsp
+ OUT "keep-it.output"; % Diverts output to "keep-it.ou
+ OUT "fum"; % now to fum, keeping the other
+ SHUT "fum"; % to close fum and flush the bu
+
+ File names can use the full system conventions. See Chapter 12 for more
+detail on I/O.
+
+
+
+3.7. Transcript of a Short Session with RLISP
3.7. Transcript of a Short Session with RLISP
3.7. Transcript of a Short Session with RLISP
+
+ The following is a transcript of RLISP running on the DEC-20.
PSL Manual 7 February 1983 RLISP
+section 3.7 page 3.11
+
+ @psl:rlisp
+ PSL 3.1 Rlisp, 27-Oct-82
+ [1] % Notice the numbered prompt.
+ [1] % Comments begin with "%" and do not change the prompt number.
+ [1] Z := '(1 2 3); % Make an assignment for Z.
+ (1 2 3)
+ [2] Cdr Z; % Notice the change in the prompt nu
+ (2 3)
+ [3] Lisp Procedure Count L; % "Count" counts the number of eleme
+ [3] If Null L Then 0 % in a list L.
+ [3] Else 1 + Count Cdr L;
+ COUNT
+ [4] Count Z; % Try out "Count" on Z.
+ 3
+ [5] Tr Count; % Trace the recursive execution of "Count".
+ (COUNT)
+ [6] % A call on "Count" now shows the value of
+ [6] % "Count" and of its argument each time it
+ [6] Count Z; % is called.
+ COUNT being entered
+ L: (1 2 3)
+ COUNT (level 2) being entered
+ L: (2 3)
+ COUNT (level 3) being entered
+ L: (3)
+ COUNT (level 4) being entered
+ L: NIL
+ COUNT (level 4) = 0
+ COUNT (level 3) = 1
+ COUNT (level 2) = 2
+ COUNT = 3
+ 3
+ [7] Lisp Procedure Factorial X;
+ [7] If X <= 1 Then 1
+ [7] Else X * Factorial (X-1);
+ FACTORIAL
+ [8] Tr Factorial;
+ (FACTORIAL)
+ [9] Factorial 4; % Trace execution of "Factorial".
+ FACTORIAL being entered
+ X: 4
+ FACTORIAL (level 2) being entered
+ X: 3
+ FACTORIAL (level 3) being entered
+ X: 2
+ FACTORIAL (level 4) being entered
+ X: 1
+ FACTORIAL (level 4) = 1
+ FACTORIAL (level 3) = 2
+ FACTORIAL (level 2) = 6
+ FACTORIAL = 24
+ 24
RLISP 7 February 1983 PSL Manual
+page 3.12 section 3.7
+
+ [10] UnTr Count,Factorial;
+ NIL
+ [11] Count 'A;
+ ***** An attempt was made to do CDR on `A', which is not a pair
+ Break loop
+ 1 lisp break> ?
+ BREAK():{Error,return-value}
+ ----------------------------
+ This is a Read-Eval-Print loop, similar to the top level loop, excep
+ that the following IDs at the top level cause functions to be called
+ rather than being evaluated:
+ ? Print this message, listing active Break IDs
+ T Print stack backtrace
+ Q Exit break loop back to ErrorSet
+ C Return last value to the ContinuableError call
+ R Reevaluate ErrorForm!* and return
+ M Display ErrorForm!* as the "message"
+ E Invoke a simple structure editor on ErrorForm!*
+ (For more information do Help Editor.)
+ I Show a trace of any interpreted functions
+
+ See the manual for details on the Backtrace, and how ErrorForm!* is
+ set. The Break Loop attempts to use the same TopLoopRead!* etc, as
+ the calling top loop, just expanding the PromptString!*.
+ NIL
+ 2 lisp break> % Get a Trace-Back of the
+ 2 lisp break> I % interpreted functions.
+ Backtrace, including interpreter functions, from top of stack:
+ LIST2 CDR COUNT PLUS2 PLUS COND COUNT
+ NIL
+ 3 lisp break> Q % To exit the Break Loop.
+ [12] % Load in a file, showing the file
+ [12] In "small-file.red"; % and its execution.
+ X := 'A . 'B . NIL;(A B) % Construct a list with "." for Cons.
+
+ Count X;2 % Call "Count" on X.
+
+ Reverse X;(B A) % Call "Reverse" on X.
+
+ NIL
+ [13] % This leaves RLISP and enters
+ [13] End; % LISP mode.
+ Entering LISP...
+ PSL, 27-Oct-82
+ 6 lisp> (SETQ X 3) % A LISP assignment statement.
+ 3
+ 7 lisp> (FACTORIAL 3) % Call "Factorial" on 3.
+ 6
+ 8 lisp> (BEGINRLISP) % This function returns us to RLISP.
+ Entering RLISP...
+ [14] Quit; % To exit call "Quit".
+ @continue
PSL Manual 7 February 1983 RLISP
+section 3.7 page 3.13
+
+ "Continued"
+ [15] X; % Notice the prompt number.
+ 3
+ [16] ^C % One can also quit with <Ctrl-C>.
+ @start % Alternative immediate re-entry.
+ [17] Quit;
+ @
ADDED psl-1983/3-1/lpt/04-datatypes.lpt
Index: psl-1983/3-1/lpt/04-datatypes.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/04-datatypes.lpt
@@ -0,0 +1,566 @@
+PSL Manual 7 February 1983 Data Types
+section 4.0 page 4.1
+
+ CHAPTER 4
CHAPTER 4
CHAPTER 4
+ DATA TYPES
DATA TYPES
DATA TYPES
+
+
+
+
+ 4.1. Data Types and Structures Supported in PSL . . . . . 4.1
+ 4.1.1. Data Types. . . . . . . . . . . . . . 4.1
+ 4.1.2. Other Notational Conventions. . . . . . . . 4.4
+ 4.1.3. Structures. . . . . . . . . . . . . . 4.4
+ 4.2. Predicates Useful with Data Types . . . . . . . . 4.5
+ 4.2.1. Functions for Testing Equality . . . . . . . 4.6
+ 4.2.2. Predicates for Testing the Type of an Object . . 4.7
+ 4.2.3. Boolean Functions . . . . . . . . . . . 4.8
+ 4.3. Converting Data Types . . . . . . . . . . . . 4.9
+
+
+
+
+4.1. Data Types and Structures Supported in PSL
4.1. Data Types and Structures Supported in PSL
4.1. Data Types and Structures Supported in PSL
+
+
+4.1.1. Data Types
4.1.1. Data Types
4.1.1. Data Types
+
+ Data objects in PSL are tagged with their type. This means that the type
+declarations required in many programming languages are not needed. Some
+functions are "generic" in that the result they return depends on the types
+ ____ ___
of the arguments. A tagged PSL object is called an item, and has a tag
+ ____
field (9 bits on the DEC-20, 5 bits on the VAX), an info field (18 bits on
+the DEC-20, 27 bits on the VAX), and possibly some bits for garbage
+ ____
collection. The info field is either immediate data or an index or address
+ __
into some other structure (such as the heap or id space). For the purposes
+ ____
of input and output of items, an appropriate notation is used (see Chapter
+12 for full details on syntax, restrictions, etc.). More explicit
+implementation details can be found in Chapters 20 and 21.
+
+ The basic data types supported in PSL and a brief indication of their
+representations are described below.
+
+
+_______ _______
integer The integers are also called "fixed" numbers. The magnitude
+ _______
of integers is essentially unrestricted if the "big number"
+ _______
module, BIG, is loaded (LOAD BIG). The notation for integers
+ is a sequence of digits in an appropriate radix (radix 10 is
+ the default, which can be overridden by a radix prefix, such
+ as 2#, 8#, 16# etc). There are three internal
+ _______
representations of integers, chosen to suit the
+ implementation:
+
+
+ ____ ______ ____ ____
inum A signed number fitting into info. Inums do not
+ require dynamic storage and are represented in the
Data Types 7 February 1983 PSL Manual
+page 4.2 section 4.1
+
+ same form as machine integers. (19 bit [-2^18 ...
+ 2^18 - 1] on the DEC-20, 28 bit on the VAX.)
+ ______ ____ _______
fixnum A full-word signed integer, allocated in the heap.
+ (36 bit on the DEC-20, fitting into a register; 32
+ bit on the VAX.)
+
+ [??? Do we need fixnums, and if yes how large
[??? Do we need fixnums, and if yes how large
[??? Do we need fixnums, and if yes how large
+ ???]
???]
???]
+
+ ______ _______
bignum A signed integer of arbitrary precision, allocated
+ _______ ______
as a vector of integers. Bignums are currently not
+ installed by default; to use them, do (LOAD BIG).
+
+
+_____ ________ _____
float A floating point number, allocated in the heap. The
+ _____
precision of floats is determined solely by the
+ implementation, and is 72-bit double precision on the DEC-20,
+ _____
64-bit on the VAX. The notation for a float is a sequence of
+ digits with the addition of a single floating point ( . ) and
+ optional exponent (E <integer>). (No spaces may occur
+ between the point and the digits). Radix 10 is used for
+ representing the mantissa and the exponent of dty(floating
+ point) numbers.
+
+__ __________ __ ____
id An identifier (or id) is an item whose info field points to a
+ five-item structure containing the print name, property cell,
+ value cell, function cell, and package cell. This structure
+ __
is contained in the id space. The notation for an id is its
+ print name, an alphanumeric character sequence starting with
+ __
a letter. One always refers to a particular id by giving its
+ print name. When presented with an appropriate print name,
+ __
the PSL reader will find a unique id to associate with it.
+ __
See Chapters 6 and 12 for more information on ids and their
+ __
syntax. NIL and T are treated as special ids in PSL.
+
+____ ____
pair A primitive two-item structure which has a left and right
+ ___ ________
part. A notation called dot-notation is used, with the form:
+ (<left-part> . <right-part>). The <left-part> is known as
+ Car Cdr
Car Cdr
the Car portion and the <right-part> as the Cdr portion. The
+ ____
parts may be any item. (Spaces are used to resolve ambiguity
+ _____
with floats; see Chapter 12).
+
+______ ____ _______
vector A primitive uniform structure of items; an integer index is
+ used to access random values in the structure. The
+ ______ ___ ____
individual elements of a vector may be any item. Access to
+ ______
vectors is by means of functions for indexing, sub-vector
+ extraction and concatenation, defined in Section 8.3. In the
+ ______ ______
notation for vectors, the elements of a vector are surrounded
+ ____ ____ ____
by square brackets: [item-0 item-1 ... item-n].
+
+______ ______ ______
string A packed vector (or byte vector) of characters; the elements
+ _______
are small integers representing the ASCII codes for the
PSL Manual 7 February 1983 Data Types
+section 4.1 page 4.3
+
+ ____
characters (usually inums). The elements may be accessed by
+ indexing, substring and concatenation functions, defined in
+ ______
Chapter 8. String notation consists of a series of
+ characters enclosed in double quotes, as in "THIS IS A
+ STRING". A quote is included by doubling it, as in "HE SAID,
+ ______
""LISP""". (Input strings may cross the end-of-line
+ boundary, but a warning is given.) See !*EOLINSTRINGOK in
+ chapter 12.
+
+____ ______ ______ ____
word-vector A vector of machine-sized words, used to implement such
+ ______ ______
things as fixnums, bignums, etc. The elements are not
+ ____
considered to be items, and are not examined by the garbage
+ collector.
+
+ ____ ______
____ ______
____ ______
[??? The word-vector could be used to implement
[??? The word-vector could be used to implement
[??? The word-vector could be used to implement
+ machine-code blocks on some machines. ???]
machine-code blocks on some machines. ???]
machine-code blocks on some machines. ???]
+
+____ ______ ______ ____ ______
Byte-Vector A vector of bytes. Internally a byte-vector is the same as a
+ ______
string, but it is printed differently as a vector of integers
+ instead of characters.
+
+________ ______
Halfword-Vector
+ ______
A vector of machine-sized halfwords.
+
+____ _______ ____
code-pointer This item is used to refer to the entry point of compiled
+ _____ ______ ______
_____ ______ ______
_____ ______ ______
exprs fexprs macros
exprs fexprs macros
functions (exprs, fexprs, macros, etc.), permitting compiled
+ functions to be renamed, passed around anonymously, etc. New
+ Lap Fasl
____ _______ Lap Fasl
code-pointers are created by the loader (Lap,Fasl) and
+ associated functions. They can be printed; the printing
+ function prints the number of arguments expected as well as
+ the entry point. The value appears in the convention of the
+ implementation (#<Code a nnnn> on the DEC-20 and VAX, where a
+ is the number of arguments and nnnn is the entry point).
+
+ ___
___
___
[not
___ _______ [not
env-pointer A data type used to support a funarg capability. [not
+ ___________ ___
___________ ___
___________ ___
implemented yet]
implemented yet]
implemented yet]
+
+
+4.1.2. Other Notational Conventions
4.1.2. Other Notational Conventions
4.1.2. Other Notational Conventions
+
+ Certain functional arguments can be any of a number of types. For
+convenience, we give these commonly used sets a name. We refer to these
+sets as "classes" of primitive data types. In addition to the types
+described above and the names for classes of types given below, we use the
+following conventions in the manual. {XXX, YYY} indicates that either data
+type XXX or data type YYY will do. {XXX}-{YYY} indicates that any object
+of type XXX can be used except those of type YYY; in this case, YYY is a
+ _______ _____
subset of XXX. For example, {integer, float} indicates that either an
+_______ _____ ___ ______
integer or a float is acceptable; {any}-{vector} means any type except a
+______
vector.
Data Types 7 February 1983 PSL Manual
+page 4.4 section 4.1
+
+___ _ __________
any Any of the types given above. S-expression is another term
+ ___
for any. All PSL entities have some value unless an error
+ occurs during evaluation.
+____ ___ ____
atom The class {any}-{pair}.
+_______
boolean The class of global variables {T, NIL}, or their respective
+ values, {T, NIL}. (See Chapter 6.7).
+_________ _______
character Integers in the range of 0 to 127 representing ASCII
+ character codes. These are distinct from single-character
+ __
ids.
+________ _______ _____ ______ ______ ____ _______
constant The class of {integer, float, string, vector, code-pointer}.
+ Eval
________ Eval
A constant evaluates to itself (see the definition of Eval
+ in Chapter 11).
+_____ _______
extra-boolean Any value in the system. Anything that is not NIL has the
+ _______
boolean interpretation T.
+_____ __
ftype The class of definable function types. The set of ids
+ ____ _____ _____ _____
____ _____ _____ _____
____ _____ _____ _____
expr fexpr macro nexpr
expr fexpr macro nexpr
{expr, fexpr, macro, nexpr}.
+ _____ __________
The ftype is ONLY an attribute of identifiers, and is not
+ ____ _______
associated with either executable code (code-pointers) or
+ ______
lambda expressions.
+__ _______ _______
io-channel A small integer representing an io channel.
+______ _______ _____
number The class of {integer, float}.
+_ ______ ______ ______ ______ ____ ______
x-vector Any kind of vector; i.e. a string, vector, word-vector, or
+ ____
word.
+_________
Undefined An implementation-dependent value returned by some low-level
+ functions; i.e. the user should not depend on this value.
+____ ________
None Returned A notational convenience used to indicate control functions
+ that do not return directly to the calling point, and hence
+ Go
Go
do not return a value. (e.g. Go)
+
+
+4.1.3. Structures
4.1.3. Structures
4.1.3. Structures
+
+ ____ ____
Structures are entities created using pairs. Lists are structures very
+ ____
commonly required as parameters to functions. If a list of homogeneous
+ ____
entities is required by a function, this class is denoted by xxx-list, in
+ ____
which xxx is the name of a class of primitives or structures. Thus a list
+ __ __ ____ ____ _______ _______ ____
of ids is an id-list, a list of integers is an integer-list, and so on.
+
+
+____ ____ ____ ___ ____
list A list is recursively defined as NIL or the pair (any . list). A
+ ____ ________ ____
special notation called list-notation is used to represent lists.
+ List-notation eliminates the extra parentheses and dots required
+ by dot-notation, as illustrated below. List-notation and
+ dot-notation may be mixed, as shown in the second and third
+ examples. (See section 3.3.3.)
+
+
+ ____________ _____________
dot-notation list-notation
+ (a . (b . (c . NIL))) (a b c)
+ (a . (b . c)) (a b . c)
+ (a . ((b . c) . (d . NIL)))
PSL Manual 7 February 1983 Data Types
+section 4.1 page 4.5
+
+ Note: () is an alternate input representation of NIL.
+
+_ ____ _ ____ ___________ ____
a-list An a-list, or association list, is a list in which each element
+ Car
____ Car
is a pair, the Car part being a key associated with the value in
+ Cdr
Cdr
the Cdr part.
+
+____ ____
form A form is an S-expression (any) which is legally acceptable to
+ Eval
Eval
Eval; that is, it is syntactically and semantically accepted by
+ the interpreter or the compiler. (See Chapter 11 for more
+ details.)
+
+______
lambda A lambda expression must have the form (in list-notation):
+ __ ____
(LAMBDA parameters . body). "Parameters" is an id-list of
+ ____
formal parameters for "body", which is a form to be evaluated
+ ProgN
ProgN
(note the implicit ProgN). The semantics of the evaluation are
+ Eval
Eval
defined by the Eval function (see chapter 11).
+
+________ ______ ____ _______
function A lambda, or a code-pointer. A function is always evaluated as
+ Eval Spread
Eval Spread
Eval, Spread.
+
+
+
+4.2. Predicates Useful with Data Types
4.2. Predicates Useful with Data Types
4.2. Predicates Useful with Data Types
+
+ Most functions in this Section return T if the condition defined is met
+and NIL if it is not. Exceptions are noted. Defined are type-checking
+functions and elementary comparisons.
+
+
+4.2.1. Functions for Testing Equality
4.2.1. Functions for Testing Equality
4.2.1. Functions for Testing Equality
+
+ Functions for testing equality are listed below. For other functions
+comparing arithmetic values see Chapter 5.
+
+
+ Eq
Eq _ ___ _ ___ _______ ____ ________ ____
(Eq U:any V:any): boolean open-compiled, expr
+
+ _ _
Returns T if U points to the same object as V, i.e. if they are
+ Eq
____ Eq ___
identical items. Eq is not a reliable comparison between numeric
+ arguments. This function should only be used in special
+ Equal
Equal
circumstances. Normally, equality should be tested with Equal,
+ described below.
+
+
+ EqN
EqN _ ___ _ ___ _______ ____
(EqN U:any V:any): boolean expr
+
+ Eq
_ _ Eq _ _
Returns T if U and V are Eq or if U and V are numbers and have
+ the same value and type.
+
+ [??? Should numbers of different type be EqN? e.g. 0 vs. 0.0
[??? Should numbers of different type be EqN? e.g. 0 vs. 0.0
[??? Should numbers of different type be EqN? e.g. 0 vs. 0.0
+ ???]
???]
???]
Data Types 7 February 1983 PSL Manual
+page 4.6 section 4.2
+
+ Equal
Equal _ ___ _ ___ _______ ____
(Equal U:any V:any): boolean expr
+
+ _ _ ____
Returns T if U and V are the same. Pairs are compared
+ ______
recursively to the bottom levels of their trees. Vectors must
+ Equal
Equal
have identical dimensions and Equal values in all positions.
+ ______
Strings must have identical characters, i.e. all characters must
+ Eq
____ _______ Eq
be of the same case. Code-pointers must have Eq values. Other
+ Eqn
____ Eqn
atoms must be Eqn equal. A usually valid heuristic is that if
+ Print
Print
two objects look the same if printed with the function Print,
+ Equal Equal
Equal ____ Equal
they are Equal. If one argument is known to be an atom, Equal is
+ Eq
Eq
open-compiled as Eq.
+
+ For example, if
+ (Setq X '(A B C)) and (Setq Y X) have been executed, then
+ (EQ X Y) is T
+ (EQ X '(A B C)) is NIL
+ (EQUAL X '(A B C)) is T
+ (EQ 1 1) is T
+ (EQ 1.0 1.0) is NIL
+ (EQN 1.0 1.0) is T
+ (EQN 1 1.0) is NIL
+ (EQUAL 0 0.0) is NIL
+
+
+ Neq
Neq _ ___ _ ___ _______ _____
(Neq U:any V:any): boolean macro
+
+ Not Equal
Not Equal _ _
(Not (Equal U V)).
+
+
+ Ne
Ne _ ___ _ ___ _______ ____ ________ ____
(Ne U:any V:any): boolean open-compiled, expr
+
+ Not Eq
Not Eq _ _
(Not (Eq U V)).
+
+
+ EqStr
EqStr _ ___ _ ___ _______ ____
(EqStr U:any V:any): boolean expr
+
+ ______
Compare two strings, for exact (Case sensitive) equality. For
+ case-INsensitive equality one must load the STRINGS module (see
+ EqStr Eq
EqStr _ _ Eq _ _
Section 8.7). EqStr returns T if U and V are Eq or if U and V
+ are equal strings.
+
+
+ EqCar
EqCar _ ___ _ ___ _______ ____
(EqCar U:any V:any): boolean expr
+
+ Eq Car
Eq Car _ _
Tests whether (Eq (Car U) V)). If the first argument is not a
+ EqCar
EqCar
pair, EqCar returns NIL.
PSL Manual 7 February 1983 Data Types
+section 4.2 page 4.7
+
+4.2.2. Predicates for Testing the Type of an Object
4.2.2. Predicates for Testing the Type of an Object
4.2.2. Predicates for Testing the Type of an Object
+
+
+ Atom
Atom _ ___ _______ ____ ________ ____
(Atom U:any): boolean open-compiled, expr
+
+ _ ____
Returns T if U is not a pair.
+
+
+ CodeP
CodeP _ ___ _______ ____ ________ ____
(CodeP U:any): boolean open-compiled, expr
+
+ _ ____ _______
Returns T if U is a code-pointer.
+
+
+ ConstantP
ConstantP _ ___ _______ ____
(ConstantP U:any): boolean expr
+
+ _ ________ ____ __
Returns T if U is a constant (that is, neither a pair nor an id).
+ ______ ________
Note that vectors are considered constants.
+
+ [??? Should Eval U Eq U if U is a constant? ???]
[??? Should Eval U Eq U if U is a constant? ???]
[??? Should Eval U Eq U if U is a constant? ???]
+
+
+ FixP
FixP _ ___ _______ ____ ________ ____
(FixP U:any): boolean open-compiled, expr
+
+ _ _______
Returns T if U is an integer. If BIG is loaded, this function
+ also returns T for bignums.
+
+
+ FloatP
FloatP _ ___ _______ ____ ________ ____
(FloatP U:any): boolean open-compiled, expr
+
+ _ _____
Returns T if U is a float.
+
+
+ IdP
IdP _ ___ _______ ____ ________ ____
(IdP U:any): boolean open-compiled, expr
+
+ _ __
Returns T if U is an id.
+
+
+ Null
Null _ ___ _______ ____ ________ ____
(Null U:any): boolean open-compiled, expr
+
+ Not
_ Not
Returns T if U is NIL. This is exactly the same function as Not,
+ defined in Section 4.2.3. Both are available solely to increase
+ readability.
+
+
+ NumberP
NumberP _ ___ _______ ____ ________ ____
(NumberP U:any): boolean open-compiled, expr
+
+ _ ______ _______ _____
Returns T if U is a number (integer or float).
Data Types 7 February 1983 PSL Manual
+page 4.8 section 4.2
+
+ PairP
PairP _ ___ _______ ____ ________ ____
(PairP U:any): boolean open-compiled, expr
+
+ _ ____
Returns T if U is a pair.
+
+
+ StringP
StringP _ ___ _______ ____ ________ ____
(StringP U:any): boolean open-compiled, expr
+
+ _ ______
Returns T if U is a string.
+
+
+ VectorP
VectorP _ ___ _______ ____ ________ ____
(VectorP U:any): boolean open-compiled, expr
+
+ _ ______
Returns T if U is a vector.
+
+
+4.2.3. Boolean Functions
4.2.3. Boolean Functions
4.2.3. Boolean Functions
+
+ Boolean functions return NIL for "false"; anything non-NIL is taken to be
+true, although a conventional way of representing truth is as T. Note that
+T always evaluates to itself. NIL may also be represented as '(). The
+ And Or Not
And Or Not
Boolean functions And, Or, and Not can be applied to any LISP type, and are
+ And Or
And Or
not bitwise functions. And and Or are frequently used in LISP as control
+structures as well as Boolean connectives (see Section 9.2). For example,
+the following two constructs will give the same result:
+
+ (COND ((AND A B C) D))
+
+ (AND A B C D)
+
+Since there is no specific Boolean type in LISP and since every LISP
+expression has a value which may be used freely in conditionals, there is
+no hard and fast distinction between an arbitrary function and a Boolean
+function. However, the three functions presented here are by far the most
+useful in constructing more complex tests from simple predicates.
+
+
+ Not
Not _ ___ _______ ____ ________ ____
(Not U:any): boolean open-compiled, expr
+
+ _
Returns T if U is NIL. This is exactly the same function as
+ Null
Null
Null, defined in Section 4.2.2. Both are available solely to
+ increase readability.
+
+
+ And
And _ ____ _____ _______ ____ ________ _____
(And [U:form]): extra-boolean open-compiled, fexpr
+
+ And
And _
And evaluates each U until a value of NIL is found or the end of
+ ____
the list is encountered. If a non-NIL value is the last value,
+ And
And
it is returned; otherwise NIL is returned. Note that And called
+ with zero arguments returns T.
PSL Manual 7 February 1983 Data Types
+section 4.2 page 4.9
+
+ Or
Or _ ____ _____ _______ ____ ________ _____
(Or [U:form]): extra-boolean open-compiled, fexpr
+
+ _
U is any number of expressions which are evaluated in order of
+ their appearance. If one is found to be non-NIL, it is returned
+ Or
Or
as the value of Or. If all are NIL, NIL is returned. Note that
+ Or
Or
if Or is called with zero arguments, it returns NIL.
+
+
+
+4.3. Converting Data Types
4.3. Converting Data Types
4.3. Converting Data Types
+
+ The following functions are used in converting data items from one type
+to another. They are grouped according to the type returned. Numeric
+ Fix Float
Fix Float
types may be converted using functions such as Fix and Float, described in
+Section 5.2.
+
+
+ Intern
Intern _ __ ______ __ ____
(Intern U:{id,string}): id expr
+
+ Intern
______ __ Intern __ ____ _____
Converts string to id. Intern searches the id-hash-table (or
+ __ ____ _____ __
current id-hash-table if the package system is loaded) for an id
+ _ __
with the same print name as U and returns the id on the
+ __ ____ _____
id-hash-table if a match is found. (See Chapter 6 for a
+ __ ____ _____
discussion of the id-hash-table. Any properties and GLOBAL values
+ _ _
associated with the uninterned U are lost. If U does not match
+ _
any entry, a new one is created and returned. If U has more than
+ the maximum number of characters permitted by the implementation
+ (???), an error is signalled:
+
+ ***** Too many characters to INTERN
+
+ [??? Rewrite for package system; include search path, global,
[??? Rewrite for package system; include search path, global,
[??? Rewrite for package system; include search path, global,
+ local, intern, etc. See Chapter 6. ???]
local, intern, etc. See Chapter 6. ???]
local, intern, etc. See Chapter 6. ???]
+
+ The maximum number of characters in any token is 5000.
+
+
+ NewId
NewId _ ______ __ ____
(NewId S:string): id expr
+
+ __ _____ ____
Allocates a new uninterned id, and sets its print-name to the
+ ______ _ ______ ___
string S. The string is not copied.
+
+ (Setq New (NewId "NEWONE")) returns NEWONE
+
+ __
Note that if one refers directly to the id NEWONE, it will become
+ interned and a new position in the id space will be allocated to
+ __ __
it. One has to refer to the new id indirectly through the id
+ New.
Data Types 7 February 1983 PSL Manual
+page 4.10 section 4.3
+
+ Int2Id
Int2Id _ _______ __ ____
(Int2Id I:integer): id expr
+
+ _______ __ _ __
Converts an integer to an id; this refers to the I'th id in the
+ Int2Id
__ Int2Id
id space. Since 0 ... 127 correspond to ASCII characters, Int2Id
+ with an argument in this range converts an ASCII code to the
+ __
corresponding single character id.
+
+ (Int2Id 250) returns QUOTIENT
+
+
+ Id2Int
Id2Int _ __ _______ ____
(Id2Int D:id): integer expr
+
+ __ _ _______
Returns the id space position of D as a LISP integer.
+
+ (Id2Int 'String) returns 182
+
+
+ Id2String
Id2String _ __ ______ ____
(Id2String D:id): string expr
+
+ Id2String Print
__ Id2String Print
Get name from id space. Id2String returns the Print name of its
+ ______
argument as a string. This is not a copy, so destructive
+ CopyString
CopyString
operations should not be performed on the result. See CopyString
+ in Chapter 8.
+
+ [??? Should it be a copy? ???]
[??? Should it be a copy? ???]
[??? Should it be a copy? ???]
+
+ (Id2String 'String) returns "STRING"
+
+
+ String2List
String2List _ ______ ____ ____ ____
(String2List S:string): inum-list expr
+
+ Length Add1 Size
____ Length Add1 Size _
Creates a list of Length (Add1 (Size S)), converting the ASCII
+ _______
characters into small integers.
+
+ [??? What of 0/1 base for length vs length -1. What of the
[??? What of 0/1 base for length vs length -1. What of the
[??? What of 0/1 base for length vs length -1. What of the
+ NUL char added ???]
NUL char added ???]
NUL char added ???]
+
+ (String2List "STRING") returns (83 84 82 73 78 71)
+
+
+ List2String
List2String _ ____ ____ ______ ____
(List2String L:inum-list): string expr
+
+ Size
______ Size _ ____
Allocates a string of the same Size as L, and converts inums to
+ ____
characters according to their ASCII code. The inums must be in
+ the range 0 ... 127.
+
+ [??? Check if 0 ... 127, and signal error ???]
[??? Check if 0 ... 127, and signal error ???]
[??? Check if 0 ... 127, and signal error ???]
+
+ (List2String '(83 84 82 73 78 71)) returns "STRING"
PSL Manual 7 February 1983 Data Types
+section 4.3 page 4.11
+
+ String
String _ ____ ______ _____
(String [I:inum]): string nexpr
+
+ ______ ____
Creates and returns a string containing all the inums given.
+
+ (String 83 84 82 73 78 71) returns "STRING"
+
+
+ Vector
Vector _ ___ ______ _____
(Vector [U:any]): vector nexpr
+
+ ______ _
Creates and returns a vector containing all the Us given.
+
+ (Setq X (Vector 83 84 82 73 78 71)) returns
+ [83 84 82 73 78 71]
+
+
+ Vector2String
Vector2String _ ______ ______ ____
(Vector2String V:vector): string expr
+
+ _______ ______ ______
Pack the small integers in the vector into a string of the same
+ Size
Size _______
Size, using the integers as ASCII values.
+
+ [??? check for integer in range 0 ... 127 ???]
[??? check for integer in range 0 ... 127 ???]
[??? check for integer in range 0 ... 127 ???]
+
+ (Vector2String X) where X is defined as above returns
+ "STRING"
+
+
+ String2Vector
String2Vector _ ______ ______ ____
(String2Vector S:string): vector expr
+
+ Size
______ ______ Size
Unpack the string into a vector of the same Size. The elements
+ ______
of the vector are small integers, representing the ASCII values
+ _
of the characters in S.
+
+ (String2Vector "VECTOR") returns [V E C T O R]
+
+
+ Vector2List
Vector2List _ ______ ____ ____
(Vector2List V:vector): list expr
+
+ Size Length Upbv
____ Size _ Length Upbv _
Create a list of the same Size as V (i.e. of Length Upbv(V)+1),
+ Upbv
Upbv _
copying the elements in order 0, 1, ..., Upbv(V).
+
+ (Vector2List [L I S T]) returns (L I S T)
+
+
+ List2Vector
List2Vector _ ____ ______ ____
(List2Vector L:list): vector expr
+
+ Size
____ ______ Size
Copy the elements of the list into a vector of the same Size.
+
+ (List2Vector '(V E C T O R)) returns [V E C T O R]
ADDED psl-1983/3-1/lpt/05-numbers.lpt
Index: psl-1983/3-1/lpt/05-numbers.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/05-numbers.lpt
@@ -0,0 +1,704 @@
+PSL Manual 7 February 1983 Arithmetic Functions
+section 5.0 page 5.1
+
+ CHAPTER 5
CHAPTER 5
CHAPTER 5
+ NUMBERS AND ARITHMETIC FUNCTIONS
NUMBERS AND ARITHMETIC FUNCTIONS
NUMBERS AND ARITHMETIC FUNCTIONS
+
+
+
+
+ 5.1. Big Integers . . . . . . . . . . . . . . . 5.1
+ 5.2. Conversion Between Integers and Floats. . . . . . . 5.2
+ 5.3. Arithmetic Functions. . . . . . . . . . . . . 5.2
+ 5.4. Functions for Numeric Comparison. . . . . . . . . 5.5
+ 5.5. Bit Operations. . . . . . . . . . . . . . . 5.7
+ 5.6. Various Mathematical Functions . . . . . . . . . 5.8
+
+ ______
Most of the arithmetic functions in PSL expect numbers as arguments. In
+all cases an error occurs if the parameter to an arithmetic function is not
+ ______
a number:
+
+ ***** Non-numeric argument in arithmetic
+
+Exceptions to the rule are noted.
+
+ The underlying machine arithmetic requires parameters to be either all
+_______ _____
integers or all floats. If a function receives mixed types of arguments,
+_______ _____
integers are converted to floats before arithmetic operations are
+ ______ _______
performed. The range of numbers which can be represented by an integer is
+ _____
different than that represented by a float. Because of this difference, a
+conversion is not always possible; an unsuccessful attempt to convert may
+cause an error to be signalled.
+
+ The MATHLIB package contains some useful mathematical functions. See
+Section 5.6 for documentation for these functions.
+
+
+
+5.1. Big Integers
5.1. Big Integers
5.1. Big Integers
+
+ Loading the BIG module redefines the basic arithmetic operations,
+including the logical operations, to permit arbitrary precision (or
+"bignum") integer operations.
+
+ Note that fixnums which are present before loading BIG can cause
+problems, because loading BIG restricts the legal range of fixnums.
+
+
+
+5.2. Conversion Between Integers and Floats
5.2. Conversion Between Integers and Floats
5.2. Conversion Between Integers and Floats
+
+ The conversions mentioned above can be done explicitly by the following
+functions. Other functions which alter types can be found in Section 4.3.
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.2 section 5.2
+
+ Fix
Fix _ ______ _______ ____
(Fix U:number): integer expr
+
+ _______
Returns the integer which corresponds to the truncated value of
+ _
U. The result of conversion must retain all significant portions
+ _ _ _______
of U. If U is an integer it is returned unchanged.
+
+ _____
_____
_____
[??? Note that unless big is loaded, a float with value
[??? Note that unless big is loaded, a float with value
[??? Note that unless big is loaded, a float with value
+ larger than 2**35-1 on the DEC-20 is converted into something
larger than 2**35-1 on the DEC-20 is converted into something
larger than 2**35-1 on the DEC-20 is converted into something
+ strange but without any error message. Note how truncation
strange but without any error message. Note how truncation
strange but without any error message. Note how truncation
+ works on negative numbers (always towards zero). ???]
works on negative numbers (always towards zero). ???]
works on negative numbers (always towards zero). ???]
+
+ (Fix 2.1) % returns 2
+
+ (Fix -2.1) % returns -2
+
+
+ Float
Float _ ______ _____ ____
(Float U:number): float expr
+
+ _____ _
The float corresponding to the value of the argument U is
+ _______
returned. Some of the least significant digits of an integer may
+ Float Float
Float Float _____
be lost due to the implementation of Float. Float of a float
+ ______ _
returns the number unchanged. If U is too large to represent in
+ _____
float, an error occurs:
+
+ ***** Argument to FLOAT is too large
+
+ _______
_______
_______
[??? Only if big is loaded can one make an integer of value
[??? Only if big is loaded can one make an integer of value
[??? Only if big is loaded can one make an integer of value
+ greater than 2**35-1, so without big you won't get this error
greater than 2**35-1, so without big you won't get this error
greater than 2**35-1, so without big you won't get this error
+ message. The largest representable float is
message. The largest representable float is
message. The largest representable float is
+ (2**62-1)*(2**65) on the DEC-20. ???]
(2**62-1)*(2**65) on the DEC-20. ???]
(2**62-1)*(2**65) on the DEC-20. ???]
+
+
+
+5.3. Arithmetic Functions
5.3. Arithmetic Functions
5.3. Arithmetic Functions
+
+ The functions described below handle arithmetic operations. Please note
+the remarks at the beginning of this Chapter regarding the mixing of
+argument types.
+
+
+ Abs
Abs _ ______ ______ ____
(Abs U:number): number expr
+
+ Returns the absolute value of its argument.
+
+
+ Add1
Add1 _ ______ ______ ____
(Add1 U:number): number expr
+
+ _
Returns the value of U plus 1; the returned value is of the same
+ _ _______ _____
type as U (integer or float).
PSL Manual 7 February 1983 Arithmetic Functions
+section 5.3 page 5.3
+
+ Decr
Decr _ ____ __ ______ ______ _____
(Decr U:form [Xi:number]): number macro
+
+ Part of the USEFUL package (LOAD USEFUL). With only one
+ argument, this is equivalent to
+
+ (SETF U (SUB1 U))
+
+ With multiple arguments, it is equivalent to
+
+ (SETF U (DIFFERENCE U (PLUS X1 ... Xn)))
+
+ 1 lisp> (Load Useful)
+ NIL
+ 2 lisp> (Setq Y '(1 5 7))
+ (1 5 7)
+ 3 lisp> (Decr (Car Y))
+ 0
+ 4 lisp> Y
+ (0 5 7)
+ 5 lisp> (Decr (Cadr Y) 3 4)
+ -2
+ 6 lisp> Y
+ (0 -2 7)
+
+
+ Difference
Difference _ ______ _ ______ ______ ____
(Difference U:number V:number): number expr
+
+ _ _
The value of U - V is returned.
+
+
+ Divide
Divide _ ______ _ ______ ____ ____
(Divide U:number V:number): pair expr
+
+ ____ ________ _________
The pair (quotient . remainder) is returned, as if the quotient
+ Quotient
Quotient
part was computed by the Quotient function and the remainder by
+ Remainder
Remainder
the Remainder function. An error occurs if division by zero is
+ attempted:
+
+ ***** Attempt to divide by 0 in Divide
+
+
+ Expt
Expt _ ______ _ _______ ______ ____
(Expt U:number V:integer): number expr
+
+ _ _ _____ _ _______ _
Returns U raised to the V power. A float U to an integer power V
+ ___ _ _____
does not have V changed to a float before exponentiation.
+
+
+ Incr
Incr _ ____ __ ______ ______ _____
(Incr U:form [Xi:number]): number macro
+
+ Part of the USEFUL package (LOAD USEFUL). With only one
+ argument, this is equivalent to
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.4 section 5.3
+
+ (SETF U (ADD1 U))
+
+ With multiple arguments it is equivalent to
+
+ (SETF U (PLUS U X1 ... Xn))
+
+
+ Minus
Minus _ ______ ______ ____
(Minus U:number): number expr
+
+ _
Returns -U.
+
+
+ Plus
Plus _ ______ ______ _____
(Plus [U:number]): number macro
+
+ Plus
Plus
Forms the sum of all its arguments. Plus may be called with only
+ Plus
Plus
one argument. In this case it returns its argument. If Plus is
+ called with no arguments, it returns zero.
+
+
+ Plus2
Plus2 _ ______ _ ______ ______ ____
(Plus2 U:number V:number): number expr
+
+ _ _
Returns the sum of U and V.
+
+
+ Quotient
Quotient _ ______ _ ______ ______ ____
(Quotient U:number V:number): number expr
+
+ Quotient
Quotient _ _
The Quotient of U divided by V is returned. Division of two
+ _______ _
positive or two negative integers is conventional. If both U and
+ _ _______
V are integers and exactly one of them is negative, the value
+ Quotient Abs
Quotient Abs _
returned is the negative truncation of the Quotient of Abs U and
+ Abs
Abs _ _____ _____
Abs V. If either argument is a float, a float is returned which
+ _____
is exact within the implemented precision of floats. An error
+ occurs if division by zero is attempted:
+
+ ***** Attempt to divide by 0 in QUOTIENT
+
+
+ Recip
Recip _ ______ _____ ____
(Recip U:number): float expr
+
+ Recip
Recip _ _____
Recip converts U to a float if necessary, and then finds the
+ Quotient
Quotient
inverse using the function Quotient.
+
+
+ Remainder
Remainder _ ______ _ ______ ______ ____
(Remainder U:number V:number): number expr
+
+ _ _ _______ _______
If both U and V are integers the result is the integer remainder
+ _ _ _____
of U divided by V. If either parameter is a float, the result is
+ _ _ _ _ _____
the difference between U and V*(U/V), all in float (probably
+ ______
0.0). If either number is negative the remainder is negative.
+ If both are positive or both are negative the remainder is
+ _
positive. An error occurs if V is zero:
PSL Manual 7 February 1983 Arithmetic Functions
+section 5.3 page 5.5
+
+ ***** Attempt to divide by 0 in REMAINDER
+
+ Remainder Mod
Remainder Mod
Note that the Remainder function differs from the Mod function in
+ Remainder
Remainder _ _
that Remainder returns a negative number when U is negative and V
+ is positive.
+
+
+ Sub1
Sub1 _ ______ ______ ____
(Sub1 U:number): number expr
+
+ _ _ _____
Returns the value of U minus 1. If U is a float, the value
+ _
returned is U minus 1.0.
+
+
+ Times
Times _ ______ ______ _____
(Times [U:number]): number macro
+
+ Times
Times
Returns the product of all its arguments. Times may be called
+ with only one argument. In this case it returns the value of its
+ Times
Times
argument. If Times is called with no arguments, it returns 1.
+
+
+ Times2
Times2 _ ______ _ ______ ______ ____
(Times2 U:number V:number): number expr
+
+ _ _
Returns the product of U and V.
+
+
+
+5.4. Functions for Numeric Comparison
5.4. Functions for Numeric Comparison
5.4. Functions for Numeric Comparison
+
+ The following functions compare the values of their arguments. For
+functions testing equality (or non-equality) see Section 4.2.1.
+
+
+ Geq
Geq _ ___ _ ___ _______ ____
(Geq U:any V:any): boolean expr
+
+ _ _
Returns T if U >= V, otherwise returns NIL. In RLISP, the symbol
+ ">=" can be used.
+
+
+ GreaterP
GreaterP _ ______ _ ______ _______ ____
(GreaterP U:number V:number): boolean expr
+
+ _ _
Returns T if U is strictly greater than V, otherwise returns NIL.
+ In RLISP, the symbol ">" can be used.
+
+
+ Leq
Leq _ ______ _ ______ _______ ____
(Leq U:number V:number): boolean expr
+
+ _ _
Returns T if U <= V, otherwise returns NIL. In RLISP, the symbol
+ "<=" can be used.
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.6 section 5.4
+
+ LessP
LessP _ ______ _ ______ _______ ____
(LessP U:number V:number): boolean expr
+
+ _ _
Returns T if U is strictly less than V, otherwise returns NIL.
+ In RLISP, the symbol "<" can be used.
+
+
+ Max
Max _ ______ ______ _____
(Max [U:number]): number macro
+
+ _
Returns the largest of the values in U (numeric maximum). If two
+ or more values are the same, the first is returned.
+
+
+ Max2
Max2 _ ______ _ ______ ______ ____
(Max2 U:number V:number): number expr
+
+ _ _ _ _
Returns the larger of U and V. If U and V are of the same value
+ _ _ _
U is returned (U and V might be of different types).
+
+
+ Min
Min _ ______ ______ _____
(Min [U:number]): number macro
+
+ _
Returns the smallest (numeric minimum) of the values in U. If
+ two or more values are the same, the first of these is returned.
+
+
+
+ Min2
Min2 _ ______ _ ______ ______ ____
(Min2 U:number V:number): number expr
+
+ _ _
Returns the smaller of its arguments. If U and V are the same
+ _ _ _
value, U is returned (U and V might be of different types).
+
+
+ MinusP
MinusP _ ___ _______ ____
(MinusP U:any): boolean expr
+
+ _ ______ _ ______
Returns T if U is a number and less than 0. If U is not a number
+ ______
or is a positive number, NIL is returned.
+
+
+ OneP
OneP _ ___ _______ ____
(OneP U:any): boolean expr
+
+ _ ______
Returns T if U is a number and has the value 1 or 1.0. Returns
+ NIL otherwise.
+
+
+ ZeroP
ZeroP _ ___ _______ ____
(ZeroP U:any): boolean expr
+
+ _ ______
Returns T if U is a number and has the value 0 or 0.0. Returns
+ NIL otherwise.
PSL Manual 7 February 1983 Arithmetic Functions
+section 5.5 page 5.7
+
+5.5. Bit Operations
5.5. Bit Operations
5.5. Bit Operations
+
+ The functions described in this section operate on the binary
+ _______
representation of the integers given as arguments. The returned value is
+ _______
an integer.
+
+
+ LAnd
LAnd _ _______ _ _______ _______ ____
(LAnd U:integer V:integer): integer expr
+
+ And
And
Bitwise or logical And. Each bit of the result is independently
+ determined from the corresponding bits of the operands according
+ to the following table.
+ _
U 0 0 1 1
+ _
V 0 1 0 1
+
+ Returned Value 0 0 0 1
+
+
+ LOr
LOr _ _______ _ _______ _______ ____
(LOr U:integer V:integer): integer expr
+
+ Or
Or
Bitwise or logical Or. Each bit of the result is independently
+ determined from corresponding bits of the operands according to
+ the following table.
+ _
U 0 0 1 1
+ _
V 0 1 0 1
+
+ Returned Value 0 1 1 1
+
+
+ LNot
LNot _ _______ _______ ____
(LNot U:integer): integer expr
+
+ Not
Not _ ______
Logical Not. Defined as (-U + 1) so that it works for bignums as
+ if they were 2's complement.
+
+ [??? need to clarify a bit more ???]
[??? need to clarify a bit more ???]
[??? need to clarify a bit more ???]
+
+
+ LXOr
LXOr _ _______ _ _______ _______ ____
(LXOr U:integer V:integer): integer expr
+
+ Or
Or
Bitwise or logical exclusive Or. Each bit of the result is
+ independently determined from the corresponding bits of the
+ operands according to the following table.
+ _
U 0 0 1 1
+ _
V 0 1 0 1
+
+ Returned Value 0 1 1 0
+
+
+ LShift
LShift _ _______ _ _______ _______ ____
(LShift N:integer K:integer): integer expr
+
+ _ _
Shifts N to the left by K bits. The effect is similar to
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.8 section 5.5
+
+ _
K
+ _
multiplying by 2 . It is an arithmetic shift. Negative values
+ _
are acceptable for K, and cause a right shift (in the usual
+ manner).
+
+
+
+5.6. Various Mathematical Functions
5.6. Various Mathematical Functions
5.6. Various Mathematical Functions
+
+ The optionally loadable MATHLIB module defines several commonly used
+mathematical functions. Some effort has been made to be compatible with
+Common Lisp, but this implementation tends to support fewer features. The
+examples used here should be taken with a grain of salt, since the
+precision of the results will depend on the machine being used, and may
+change in later implementations of the module.
+
+
+ Ceiling
Ceiling _ ______ _______ ____
(Ceiling X:number): integer expr
+
+ _______ _
Returns the smallest integer greater than or equal to X. For
+ example:
+
+ 1 lisp> (ceiling 2.1)
+ 3
+ 2 lisp> (ceiling -2.1)
+ -2
+
+
+ Floor
Floor _ ______ _______ ____
(Floor X:number): integer expr
+
+ _
Returns the largest integer less than or equal to X. (Note that
+ Fix
Fix
this differs from the Fix function.)
+
+ 1 lisp> (floor 2.1)
+ 2
+ 2 lisp> (floor -2.1)
+ -3
+ 3 lisp> (fix -2.1)
+ -2
+
+
+ Round
Round _ ______ _______ ____
(Round X:number): integer expr
+
+ 1
+ _
Returns the nearest integer to X.
+
+
+_______________
+
+ 1
+ Round
Round
The behavior of Round is ambiguous when its argument ends in ".5"--needs
+more work.
PSL Manual 7 February 1983 Arithmetic Functions
+section 5.6 page 5.9
+
+ TransferSign
TransferSign _ ______ ___ ______ ______ ____
(TransferSign S:number Val:number): number expr
+
+ abs
_ ___ abs ___ _
Transfers the sign of S to VAL by returning abs(VAL) if S >= 0,
+ abs sign
abs ___ sign
and -abs(VAL) otherwise. (The same as FORTRANs sign function.)
+
+
+ Mod
Mod _ _______ _ _______ _______ ____
(Mod M:integer N:integer): integer expr
+
+ remainder
_ _ remainder
Returns M modulo N. Unlike the remainder function, it returns a
+ _ _ _ _ _
positive number in the range 0..N-1 when N is positive, even if M
+ is negative.
+
+ 1 lisp> (mod -7 5)
+ 3
+ 2 lisp> (remainder -7 5)
+ -2
+
+ [??? Allow to "number" arguments instead of just "integers"?
[??? Allow to "number" arguments instead of just "integers"?
[??? Allow to "number" arguments instead of just "integers"?
+ ???]
???]
???]
+
+
+ DegreesToRadians
DegreesToRadians _ ______ ______ ____
(DegreesToRadians X:number): number expr
+
+ Returns an angle in radians given an angle in degrees.
+
+ 1 lisp> (DegreesToRadians 180)
+ 3.1415926
+
+
+ RadiansToDegrees
RadiansToDegrees _ ______ ______ ____
(RadiansToDegrees X:number): number expr
+
+ Returns an angle in degrees given an angle in radians.
+
+ 1 lisp> (RadiansToDegrees 3.1415926)
+ 180.0
+
+
+ RadiansToDMS
RadiansToDMS _ ______ ____ ____
(RadiansToDMS X:number): list expr
+
+ _ _______
Given an angle X in radians, returns a list of three integers
+ giving the angle in
+
+ (Degrees Minutes Seconds)
+
+ .
+
+ 1 lisp> (RadiansToDMS 1.0)
+ (57 17 45)
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.10 section 5.6
+
+ DMStoRadians
DMStoRadians ____ ______ ____ ______ ____ ______ ______ ____
(DMStoRadians Degs:number Mins:number Secs:number): number expr
+
+ Returns an angle in radians, given three arguments representing
+ an angle in degrees minutes and seconds.
+
+ 1 lisp> (DMStoRadians 57 17 45)
+ 1.0000009
+ 2 lisp> (DMStoRadians 180 0 0)
+ 3.1415926
+
+
+ DegreesToDMS
DegreesToDMS _ ______ ____ ____
(DegreesToDMS X:number): list expr
+
+ _ _______
Given an angle X in degrees, returns a list of three integers
+ giving the angle in (Degrees Minutes Seconds).
+
+
+ DMStoDegrees
DMStoDegrees ____ ______ ____ ______ ____ ______ ______ ____
(DMStoDegrees Degs:number Mins:number Secs:number): number expr
+
+ Returns an angle in degrees, given three arguments representing
+ an angle in degrees minutes and seconds.
+
+
+ Sin
Sin _ ______ ______ ____
(Sin X:number): number expr
+
+ sine
sine _
Returns the sine of X, an angle in radians.
+
+
+ SinD
SinD _ ______ ______ ____
(SinD X:number): number expr
+
+ sine
sine _
Returns the sine of X, an angle in degrees.
+
+
+ Cos
Cos _ ______ ______ ____
(Cos X:number): number expr
+
+ cosine
cosine _
Returns the cosine of X, an angle in radians.
+
+
+ CosD
CosD _ ______ ______ ____
(CosD X:number): number expr
+
+ cosine
cosine _
Returns the cosine of X, an angle in degrees.
+
+
+ Tan
Tan _ ______ ______ ____
(Tan X:number): number expr
+
+ tangent
tangent _
Returns the tangent of X, an angle in radians.
+
+
+ TanD
TanD _ ______ ______ ____
(TanD X:number): number expr
+
+ tangent
tangent _
Returns the tangent of X, an angle in degrees.
PSL Manual 7 February 1983 Arithmetic Functions
+section 5.6 page 5.11
+
+ Cot
Cot _ ______ ______ ____
(Cot X:number): number expr
+
+ cotangent
cotangent _
Returns the cotangent of X, an angle in radians.
+
+
+ CotD
CotD _ ______ ______ ____
(CotD X:number): number expr
+
+ cotangent
cotangent _
Returns the cotangent of X, an angle in degrees.
+
+
+ Sec
Sec _ ______ ______ ____
(Sec X:number): number expr
+
+ secant
secant _
Returns the secant of X, an angle in radians.
+
+
+ secant(X) = 1/cos(X)
+
+
+ SecD
SecD _ ______ ______ ____
(SecD X:number): number expr
+
+ secant
secant _
Returns the secant of X, an angle in degrees.
+
+
+ Csc
Csc _ ______ ______ ____
(Csc X:number): number expr
+
+ cosecant
cosecant _
Returns the cosecant of X, an angle in radians.
+
+
+ secant(X) = 1/sin(X)
+
+
+ CscD
CscD _ ______ ______ ____
(CscD X:number): number expr
+
+ cosecant
cosecant _
Returns the cosecant of X, an angle in degrees.
+
+
+ Asin
Asin _ ______ ______ ____
(Asin X:number): number expr
+
+ arc sine
arc sine _
Returns the arc sine, as an angle in radians, of X.
+
+
+ sin(asin(X)) = X
+
+
+ AsinD
AsinD _ ______ ______ ____
(AsinD X:number): number expr
+
+ arc sine
arc sine _
Returns the arc sine, as an angle in degrees, of X.
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.12 section 5.6
+
+ Acos
Acos _ ______ ______ ____
(Acos X:number): number expr
+
+ arc cosine
arc cosine _
Returns the arc cosine, as an angle in radians, of X.
+
+
+ cos(acos(X)) = X
+
+
+ AcosD
AcosD _ ______ ______ ____
(AcosD X:number): number expr
+
+ arc cosine
arc cosine _
Returns the arc cosine, as an angle in degrees, of X.
+
+
+ Atan
Atan _ ______ ______ ____
(Atan X:number): number expr
+
+ arc tangent
arc tangent _
Returns the arc tangent, as an angle in radians, of X.
+
+
+ tan(atan(X)) = X
+
+
+ AtanD
AtanD _ ______ ______ ____
(AtanD X:number): number expr
+
+ arc tangent
arc tangent _
Returns the arc tangent, as an angle in degrees, of X.
+
+
+ Atan2
Atan2 _ ______ _ ______ ______ ____
(Atan2 Y:number X:number): number expr
+
+ Returns an angle in radians corresponding to the angle between
+ _ _ _
the X axis and the vector (X,Y). (Note that Y is the first
+ argument.)
+
+ 1 lisp> (atan2 0 -1)
+ 3.1415927
+
+
+ Atan2D
Atan2D _ ______ _ ______ ______ ____
(Atan2D Y:number X:number): number expr
+
+ Returns an angle in degrees corresponding to the angle between
+ _ _
the X axis and the vector (X,Y).
+
+ 1 lisp> (atan2D -1 1)
+ 315.0
+
+
+ Acot
Acot _ ______ ______ ____
(Acot X:number): number expr
+
+ arc cotangent
arc cotangent _
Returns the arc cotangent, as an angle in radians, of X.
+
+
+ cot(acot(X)) = X
PSL Manual 7 February 1983 Arithmetic Functions
+section 5.6 page 5.13
+
+ AcotD
AcotD _ ______ ______ ____
(AcotD X:number): number expr
+
+ arc cotangent
arc cotangent _
Returns the arc cotangent, as an angle in degrees, of X.
+
+
+ Asec
Asec _ ______ ______ ____
(Asec X:number): number expr
+
+ arc secant
arc secant _
Returns the arc secant, as an angle in radians, of X.
+
+
+ sec(asec(X)) = X
+
+
+ AsecD
AsecD _ ______ ______ ____
(AsecD X:number): number expr
+
+ arc secant
arc secant _
Returns the arc secant, as an angle in degrees, of X.
+
+
+ Acsc
Acsc _ ______ ______ ____
(Acsc X:number): number expr
+
+ arc cosecant
arc cosecant _
Returns the arc cosecant, as an angle in radians, of X.
+
+
+ csc(acsc(X)) = X
+
+
+ AcscD
AcscD _ ______ ______ ____
(AcscD X:number): number expr
+
+ arc cosecant
arc cosecant _
Returns the arc cosecant, as an angle in degrees, of X.
+
+
+ Sqrt
Sqrt _ ______ ______ ____
(Sqrt X:number): number expr
+
+ _
Returns the square root of X.
+
+
+ Exp
Exp _ ______ ______ ____
(Exp X:number): number expr
+
+ _
X
+ _ _
Returns the exponential of X, i.e. e .
+
+
+ Log
Log _ ______ ______ ____
(Log X:number): number expr
+
+ _ _
Returns the natural (base e) logarithm of X.
+
+
+ log(exp(X)) = X
Arithmetic Functions 7 February 1983 PSL Manual
+page 5.14 section 5.6
+
+ Log2
Log2 _ ______ ______ ____
(Log2 X:number): number expr
+
+ _
Returns the base two logarithm of X.
+
+
+ Log10
Log10 _ ______ ______ ____
(Log10 X:number): number expr
+
+ _
Returns the base ten logarithm of X.
+
+
+ Random
Random _ _______ _______ ____
(Random N:integer): integer expr
+
+ Returns a pseudo-random number uniformly selected from the range
+ _
0..N-1.
+
+ The random number generator uses a linear congruential method.
+ To get a reproducible sequence of random numbers you should
+ assign one (or some other small number) to the FLUID variable
+ RANDOMSEED.
+
+
+ __________ ______
RANDOMSEED [Initially: set from time] global
+
+
+ Factorial
Factorial _ _______ _______ ____
(Factorial N:integer): integer expr
+
+ _
Returns the factorial of N.
+
+
+ factorial(0) = 1
+
+
+ factorial(N) = N*factorial(N-1)
ADDED psl-1983/3-1/lpt/06-ids.lpt
Index: psl-1983/3-1/lpt/06-ids.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/06-ids.lpt
@@ -0,0 +1,837 @@
+PSL Manual 7 February 1983 Identifiers
+section 6.0 page 6.1
+
+ CHAPTER 6
CHAPTER 6
CHAPTER 6
+ IDENTIFIERS
IDENTIFIERS
IDENTIFIERS
+
+
+
+
+ 6.1. Introduction . . . . . . . . . . . . . . . 6.1
+ 6.2. Fields of Ids . . . . . . . . . . . . . . . 6.2
+ 6.3. Identifiers and the Id-Hash-Table . . . . . . . . 6.2
+ 6.3.1. Identifier Functions . . . . . . . . . . 6.3
+ 6.3.2. Find. . . . . . . . . . . . . . . . 6.4
+ 6.4. Property List Functions. . . . . . . . . . . . 6.5
+ 6.4.1. Functions for Flagging Ids . . . . . . . . 6.6
+ 6.4.2. Direct Access to the Property Cell. . . . . . 6.7
+ 6.5. Value Cell Functions. . . . . . . . . . . . . 6.7
+ 6.6. Package System Functions . . . . . . . . . . . 6.10
+ 6.7. System Global Variables, Switches and Other "Hooks" . . 6.13
+ 6.7.1. Introduction . . . . . . . . . . . . . 6.13
+ 6.7.2. Setting Switches. . . . . . . . . . . . 6.14
+ 6.7.3. Special Global Variables . . . . . . . . . 6.15
+ 6.7.4. Special Put Indicators. . . . . . . . . . 6.15
+ 6.7.5. Special Flag Indicators . . . . . . . . . 6.16
+ 6.7.6. Displaying Information About Globals . . . . . 6.16
+
+
+
+
+6.1. Introduction
6.1. Introduction
6.1. Introduction
+
+ __________ __ __________
In PSL variables are called identifiers or ids. An identifier is
+implemented as a tagged data object (described in Chapter 4) containing a
+ __ _____
pointer or offset into a five item structure - the id space. One item in
+this structure is called the print name, which is the external
+ __
representation of the id.
+
+ __ ____ _____
The interpreter uses an id hash table to get from the print name of an
+__________ __ _____ __ _____ __ ____
identifier to its entry in the id space. The id space and the id hash
+_____
table are described below.
+
+ Sometimes there is a need for more than one name space when one is
+building a large system. For example, one may wish to allow several
+programmers to each produce a part of a system without having to worry
+about name conflicts. PSL provides a package system for this purpose,
+ __ ____ _____
giving the user a tree-structured id hash table.
Identifiers 7 February 1983 PSL Manual
+page 6.2 section 6.2
+
+6.2. Fields of Ids
6.2. Fields of Ids
6.2. Fields of Ids
+
+ __ ____ ____ ____
An id is an item with an info field; the info field is an offset into a
+ __ _____ ____
special id space consisting of structures of 5 fields. The fields (items)
+are:
+
+
+_____ ____ ______
print-name The print name points at a string of characters which is the
+ __________
external representation of the identifier. The syntax for
+ __________
identifiers is described in Section 12.5 on reading
+ functions.
+________ ____
property-cell One may want to associate various flags and properties with
+ __________
an identifier. These can be stored on a property-list for
+ __
an id, flags by name and properties by an (indicator .
+ __
value) pair. The property cell of an id contains a pointer
+ to this list. Access is by means of functions defined in
+ Section 6.4.
+_____ ____ __________
value-cell The value of the identifier or a pointer to the value in the
+ heap is stored in this field. If no value exists, this cell
+ __________
contains an unbound identifier indicator. These cells can
+ be accessed by functions defined in this chapter.
+ _____
_____
_____
macro
________ ____ ________ macro
function-cell An id may have a function or macro associated with it.
+ PutD GetD RemD
PutD GetD RemD
Access is by means of the PutD, GetD, and RemD functions
+ defined in Section 10.1.2.
+_______ ____
package-cell PSL permits the use of a multiple package facility (multiple
+ __ ____ _____
id hash table). The package cell refers to the appropriate
+ __ ____ _____
id hash table.
+
+
+
+6.3. Identifiers and the Id hash table
6.3. Identifiers and the Id hash table
6.3. Identifiers and the Id hash table
+
+ __________
The method used by PSL to retrieve information about an identifier makes
+ __ ____ _____
use of the id hash table (corresponding to the Oblist, or Object list, in
+ __________
some versions of LISP). A hash function is applied to the identifier name
+ __ ____ _____
giving a position in the id hash table. The contents of the hash table at
+ __ _____ __________
that point contain an offset into the id space. For a new identifier, the
+ __ _____
next free position in the id space is found and a pointer to it is placed
+in the hash table entry.
+
+ __
The process of putting an id into the hash table is called interning.
+ __
This is done automatically by the LISP reader, so any id typed in at the
+terminal is interned. Interning can also be done by the programmer using
+ Intern
Intern ______ __ __
the function Intern to convert a string to an id. An id may have an entry
+ __ _____
in the id space without being interned. In fact it is possible to have
+ __
several ids with the same print name, one interned and the others not.
+ __
(The use of the package system allows one to have several interned ids with
+the same print name.)
+
+ __ _____
Note that when one starts PSL, the id space already contains
+ __
approximately 2000 ids. These include all of the ASCII characters, the
+functions and globals described in this manual, plus system functions and
PSL Manual 7 February 1983 Identifiers
+section 6.3 page 6.3
+
+globals. If a user uses any of these names for his own functions or
+globals, there can be a conflict. This is another reason for having a
+package system. A warning message appears if a user tries to redefine a
+system function.
+
+ ? Do you really want to redefine the system function 'name? (Y or N)
+
+If the user answers "Y", his definition replaces the current definition.
+ ________
(See Chapter 10 for a description of the switch !*USERMODE which controls
+the printing of this message.)
+
+ __ ____ _____
Basic PSL currently provides a single id hash table. PSL provides all
+the "hooks" to permit a package system to be loaded as an option; certain
+functions are redefined in this process. If the package system is loaded,
+ __ ____ _____
a tree-structured id hash table can be created in which each level can be
+ __ ____ _____ __ ______
thought of as a smaller id hash table. If a new id or string is to be
+interned, it is searched for in the tree according to a specified rule.
+For more information see Section 6.6.
+
+ __
Information on converting ids to other types can be found in Chapter
+12 and Section 4.3.
+
+
+6.3.1. Identifier Functions
6.3.1. Identifier Functions
6.3.1. Identifier Functions
+
+ __________ __ ____ _____
The following functions deal with identifiers and the id hash table.
+
+
+ GenSym
GenSym __ ____
(GenSym ): id expr
+
+ __________
Creates an identifier which is not interned on the id hash table
+ Eq
Eq __
and consequently not Eq to anything else. The id is derived from
+ a string of the form "G0000", which is incremented upon each call
+ GenSym
GenSym
to GenSym.
+
+ [??? Is this interned or recorded on the NIL package ???]
[??? Is this interned or recorded on the NIL package ???]
[??? Is this interned or recorded on the NIL package ???]
+
+ [??? Can we change the GenSym string ???]
[??? Can we change the GenSym string ???]
[??? Can we change the GenSym string ???]
+
+
+ InternGenSym
InternGenSym __ ____
(InternGenSym ): id expr
+
+ GenSym
GenSym __
Similar to GenSym but returns an interned id.
+
+
+ StringGenSym
StringGenSym ______ ____
(StringGenSym ): string expr
+
+ GenSym
GenSym ______
Similar to GenSym but returns a string of the form "L0000"
+ __
instead of an id.
Identifiers 7 February 1983 PSL Manual
+page 6.4 section 6.3
+
+ RemOb
RemOb _ __ _ __ ____
(RemOb U:id): U:id expr
+
+ _
If U is present on the current package search path it is removed.
+ _
This does not affect U having properties, flags, functions and
+ _
the like. U is returned.
+
+
+ InternP
InternP _ __ ______ _______ ____
(InternP U:{id,string}): boolean expr
+
+ _
Returns T if U is interned in the current search path.
+
+
+ MapObl
MapObl _____ ________ _________ ____
(MapObl FNAME:function): Undefined expr
+
+ MapObl
MapObl _____ __
MapObl applies function FNAME to each id interned in the current
+ hash table.
+
+
+6.3.2. Find
6.3.2. Find
6.3.2. Find
+
+ ______ __ __ ____
These functions take a string or id as an argument, and scan the id hash
+_____ __
table to collect a list of ids with prefix or suffix matching the argument.
+This is a loadable option (LOAD FIND).
+
+
+ FindPrefix
FindPrefix ___ __ ______ __ ____ ____
(FindPrefix KEY:{id, string}): id-list expr
+
+ __ ____ _____ __ ___
Scans current id hash table for all ids whose prefix matches KEY.
+ Returns all the identifiers found as an alphabetically sorted
+ list.
+
+
+ FindSuffix
FindSuffix ___ __ ______ __ ____ ____
(FindSuffix KEY:{id, string}): id-list expr
+
+ __ ____ _____ __ ___
Scans current id hash table for all ids whose suffix matches KEY.
+ Returns all the identifiers found as an alphabetically sorted
+ list.
+
+ (Setq X (FindPrefix '!*) % Finds all identifiers starting with *
+
+ (Setq Y (FindSuffix "STRING")) % Finds all identifiers ending with S
+
+
+
+6.4. Property List Functions
6.4. Property List Functions
6.4. Property List Functions
+
+ __________ ____ ____
The property cell of an identifier points to a "property list". The list
+ __
is used to quickly associate an id name with a set of entities; those
+ __
entities are called "flags" if their use gives the id a boolean value, and
+ __
"properties" if the id is to have an arbitrary attribute (an indicator with
+a property).
PSL Manual 7 February 1983 Identifiers
+section 6.4 page 6.5
+
+ Put
Put _ __ ___ __ ____ ___ ___ ____
(Put U:id IND:id PROP:any): any expr
+
+ ___ ____
The indicator IND with the property PROP is placed on the
+ Put
____ __ _ Put
property list of the id U. If the action of Put occurs, the
+ ____ _ ___ __
value of PROP is returned. If either of U and IND are not ids
+ the type mismatch error occurs and no property is placed.
+
+ (Put 'Jim 'Height 68)
+
+ The above returns 68 and places (Height . 68) on the property
+ __
list of the id Jim.
+
+
+ Get
Get _ __ ___ __ ___ ____
(Get U:id IND:id): any expr
+
+ ___
Returns the property associated with indicator IND from the
+ ____ _ _ ___
property list of U. If U does not have indicator IND, NIL is
+ Get Get
Get Get
returned. (In older LISPs, Get could access functions.) Get
+ _ __
returns NIL if U is not an id.
+
+
+ (Get 'Jim 'Height) returns 68
+
+
+ DefList
DefList _ ____ ___ __ ____ ____
(DefList U:list IND:id): list expr
+
+ _
U is a list in which each element is a two-element list:
+ __ __ ____ ___ __ _ ___
(ID:ID PROP:ANY). Each id in U has the indicator IND with
+ Put
Put
property PROP placed on its property list by the Put function.
+ DefList
DefList ____
The value of DefList is a list of the first elements of each
+ Put DefList
Put DefList
two-element list. Like Put, DefList may not be used to define
+ functions.
+
+ (DE DEFLIST (U IND)
+ (COND ((NULL U) NIL)
+ (T (CONS(PROGN(PUT (CAAR U) IND (CADAR U))
+ (CAAR U))
+ (DEFLIST (CDR U) IND)))))
+
+
+ RemProp
RemProp _ __ ___ __ ___ ____
(RemProp U:id IND:id): any expr
+
+ ___ ____
Removes the property with indicator IND from the property list of
+ _
U. Returns the removed property or NIL if there was no such
+ indicator.
+
+
+ RemPropL
RemPropL _ __ ____ ___ __ ___ ____
(RemPropL U:id-list IND:id): NIL expr
+
+ ___ __ _
Remove property IND from all ids in U.
Identifiers 7 February 1983 PSL Manual
+page 6.6 section 6.4
+
+6.4.1. Functions for Flagging Ids
6.4.1. Functions for Flagging Ids
6.4.1. Functions for Flagging Ids
+
+ __
In some LISPs, flags and indicators may clash. In PSL, flags are ids and
+ ____
properties are pairs on the prop-list, so no clash occurs.
+
+
+ Flag
Flag _ __ ____ _ __ ___ ____
(Flag U:id-list V:id): NIL expr
+
+ Flag Flag
Flag __ _ _ Flag
Flag flags each id in U with V; that is, the effect of Flag is
+ FlagP
__ _ _ FlagP _
that for each id X in U, FlagP(X, V) has the value T. Both V and
+ _ __________
all the elements of U must be identifiers or the type mismatch
+ Flag
Flag __ _
error occurs. After Flagging, the id V appears on the property
+ __ _
list of each id X in U. However, flags cannot be accessed,
+ placed on, or removed from property lists using normal property
+ Get Put RemProp
Get Put RemProp
list functions Get, Put, and RemProp. Note that if an error
+ Flag
Flag __ _
occurs during execution of Flag, then some of the ids on U may be
+ _
flagged with V, and others may not be. The statement below
+ causes the flag "Lose" to be placed on the property lists of the
+ __
ids X and Y.
+
+ (Flag '(X Y) 'Lose)
+
+
+ FlagP
FlagP _ __ _ __ _______ ____
(FlagP U:id V:id): boolean expr
+
+ _ _
Returns T if U has been flagged with V; otherwise returns NIL.
+ _ _ __
Returns NIL if either U or V is not an id.
+
+
+ RemFlag
RemFlag _ __ ____ _ __ ___ ____
(RemFlag U:id-list V:id): NIL expr
+
+ _ ____
Removes the flag V from the property list of each member of the
+ ____ _ _ _ __
list U. Both V and all the elements of U must be ids or the type
+ mismatch error occurs.
+
+
+ Flag1
Flag1 _ __ _ ___ _________ ____
(Flag1 U:id V:any): Undefined expr
+
+ _ __ _
Puts flag V on the property list of id U.
+
+
+ RemFlag1
RemFlag1 _ __ _ ___ _________ ____
(RemFlag1 U:id V:any): Undefined expr
+
+ _ __ _
Removes the flag V from the property list of id U.
+
+ [??? Make Flag1 and RemFlag1 return single value. ???]
[??? Make Flag1 and RemFlag1 return single value. ???]
[??? Make Flag1 and RemFlag1 return single value. ???]
PSL Manual 7 February 1983 Identifiers
+section 6.4 page 6.7
+
+6.4.2. Direct Access to the Property Cell
6.4.2. Direct Access to the Property Cell
6.4.2. Direct Access to the Property Cell
+
+ Use of the following functions can destroy the integrity of the property
+____
list. Since PSL uses properties at a low level, care should be taken in
+the use of these functions.
+
+
+ Prop
Prop _ __ ___ ____
(Prop U:id): any expr
+
+ ____ _
Returns the property list of U.
+
+
+ SetProp
SetProp _ __ _ ___ _ ___ ____
(SetProp U:id L:any): L:any expr
+
+ _ ____ _
Store item L as the property list of U.
+
+
+
+6.5. Value Cell Functions
6.5. Value Cell Functions
6.5. Value Cell Functions
+
+ Eval
Eval
The contents of the value cell are usually accessed by Eval (Chapter 11)
+ ValueCell Set SetQ
ValueCell Set SetQ
or ValueCell (below) and changed by Set or SetQ.
+
+
+ Set
Set ___ __ _____ ___ ___ ____
(Set EXP:id VALUE:any): any expr
+
+ ___ __________
EXP must be an identifier or a type mismatch error occurs. The
+ Set
Set
effect of Set is replacement of the item bound to the identifier
+ _____
by VALUE. If the identifier is not a LOCAL variable or has not
+ been declared GLOBAL, it is automatically declared FLUID with the
+ resulting warning message:
+
+ *** EXP declared FLUID
+
+ ___
EXP must not evaluate to T or NIL or an error occurs:
+
+ ***** Cannot change T or NIL
+
+
+ SetQ
SetQ ________ __ _____ ___ ___ _____
(SetQ VARIABLE:id VALUE:any): any fexpr
+
+ ________
The value of the current binding of VARIABLE is replaced by the
+ _____
value of VALUE.
+
+ (SETQ X 1)
+
+ is equivalent to
+
+ (SET 'X 1)
+
+ SetQ
SetQ
SetQ now conforms to the Common LISP standard, allowing
+ sequential assignment:
Identifiers 7 February 1983 PSL Manual
+page 6.8 section 6.5
+
+ (SETQ A 1 B 2)
+ ==> (SETQ A 1)
+ (SETQ B 2)
+
+
+ DeSetQ
DeSetQ _ ___ _ ___ _ ___ _____
(DeSetQ U:any V:any): V:any macro
+
+ DeSetQ
DeSetQ
This is a function in "USEFUL" (Load USEFUL; in RLISP). DeSetQ
+ SetQ
SetQ
is a destructuring SetQ. That is, the first argument is a piece
+ SetQ
____ ____ __ SetQ
of list structure whose atoms are all ids. Each is SetQ'd to the
+ corresponding part of the second argument. For instance
+
+ (DeSetQ (a (b) . c) '((1) (2) (3) 4))
+
+ SetQ
SetQ
SetQ's a to (1), b to 2, and c to ((3) 4).
+
+
+ PSetQ
PSetQ ________ __ _____ ___ _________ _____
(PSetQ [VARIABLE:id VALUE:any]): Undefined macro
+
+ Part of the USEFUL package (LOAD USEFUL).
+
+ (PSETQ VAR1 VAL1 VAR2 VAL2 ... VARn VALn)
+
+ SetQ
SetQ
SetQ's the VAR's to the corresponding VAL's. The VAL's are all
+ evaluated before any assignments are made. That is, this is a
+ SetQ
SetQ
parallel SetQ.
+
+
+ SetF
SetF ___ ____ ___ ___ ___ ___ _____
(SetF [LHS:form RHS:any]): RHS:any macro
+
+ SetF SetF
SetF SetF
There are two versions of SetF. SetF is redefined on loading
+ SetF SetF
SetF SetF
USEFUL. The description below is for the resident SetF. SetF
+ provides a method for assigning values to expressions more
+ __
general than simple ids. For example:
+
+ (SETF (CAR X) 2)
+ ==> CAR X := 2;
+
+ is equivalent to
+
+ (RPLACA X 2)
+
+ SetF
SetF
In general, SetF has the form
+
+ (SetF LHS RHS)
+
+ ___ ___
in which LHS is the "left hand side" to be assigned to and RHS is
+ ___
evaluated to the value to be assigned. LHS can be one of the
+ following:
+
+
+ SetQ
__ SetQ
id SetQ is used to assign a value to the
PSL Manual 7 February 1983 Identifiers
+section 6.5 page 6.9
+
+ __
id.
+ Eval Set SetQ
Eval Set SetQ
(Eval expression) Set is used instead of SetQ. In
+ Eval
Eval
effect, the "Eval" cancels out the
+ Quote
Quote
"Quote" which would normally be used.
+ Value Eval
Value Eval
(Value expression) Is treated the same as Eval.
+ Car RplacA
Car ____ RplacA
(Car pair) RplacA is used to store into the Car
+ "field".
+ Cdr RplacD
Cdr ____ RplacD
(Cdr pair) RplacD is used to store into the Cdr
+ "field".
+ GetV PutV
GetV ______ PutV
(GetV vector) PutV is used to store into the
+ appropriate location.
+ Indx SetIndx
Indx SetIndx
(Indx "indexable object") SetIndx is used to store into the
+ object.
+ Sub SetSub
Sub ______ SetSub
(Sub vector) SetSub is used to store into the
+ appropriate subrange of the vector.
+
+
+ Car Cdr SetF
___ Car ____ Cdr ____ SetF
Note that if the LHS is (Car pair) or (Cdr pair), SetF returns
+ SetF RplacA
___ SetF RplacA
the modified pair instead of the RHS, because SetF uses RplacA
+ RplacD
RplacD
and RplacD in these cases.
+
+ SetF Caar Cadr
SetF Caar Cadr
Loading USEFUL brings in declarations to SetF about Caar, Cadr,
+ Cddddr
Cddddr
... Cddddr. This is rather handy with constructor/selector
+ Cadadr
Cadadr
macros. For instance, if FOO is a selector which maps to Cadadr,
+
+
+ (SETF (FOO X) Y)
+
+ works; that is, it maps to something which does a
+
+ (RPLACA (CDADR X) Y)
+
+ and then returns X.
+
+
+ PSetF
PSetF ___ ____ ___ ___ _________ _____
(PSetF [LHS:form RHS:any]): Undefined macro
+
+ PSetF SetF
PSetF SetF
Part of the USEFUL package (LOAD USEFUL). PSetF does a SetF in
+ ___
parallel: i.e. it evaluates all the right hand sides (RHS) before
+ ___
assigning any to the left hand sides (LHS).
+
+
+ MakeUnBound
MakeUnBound _ __ _________ ____
(MakeUnBound U:id): Undefined expr
+
+ _ __
Make U an unbound id by storing a "magic" number in the value
+ cell.
+
+
+ ValueCell
ValueCell _ __ ___ ____
(ValueCell U:id): any expr
+
+ __ _
Safe access to the value cell of an id. If U is not an id a type
+ _
mismatch error is signalled; if U is an unbound id, an unbound id
Identifiers 7 February 1983 PSL Manual
+page 6.10 section 6.5
+
+ _
error is signalled. Otherwise the current value of U is
+ Value LispVar
Value LispVar
returned. [See also the Value and LispVar functions, described
+ in Chapter 20, for more direct access].
+
+
+ UnBoundP
UnBoundP _ __ _______ ____
(UnBoundP U:id): boolean expr
+
+ _
Tests whether U has no value.
+
+ [??? Define and describe General Property LISTs or hash-tables. See
[??? Define and describe General Property LISTs or hash-tables. See
[??? Define and describe General Property LISTs or hash-tables. See
+ Hcons. ???]
Hcons. ???]
Hcons. ???]
+
+
+
+6.6. Package System Functions
6.6. Package System Functions
6.6. Package System Functions
+
+ To get the package system (Load Package). An example of the use of this
+system is at the end of this section.
+
+ The character "\" is normally reserved in the basic Read-Table (see
+Chapter 12) to make up multi-part names of the form "PackageName\LocalId".
+If the package system is loaded, the Intern process starts searching a path
+in a linked structure from "PackageName", itself an id accessible in the
+"CurrentPackage". The print-name is still "LocalId", but the additional
+ Prin1 Prin2
Prin1 Prin2
package field in each id records "PackageName". Prin1 and Prin2 are
+modified to access this field in loading the package system. The root of
+the tree is the GLOBAL package, indicated by \. If the package system is
+loaded, the basic id hash table is made into the GLOBAL package. Thus \ID
+is guaranteed in the root (in fact the pre-existing id hash table).
+
+ [??? Explain further or at least more clearly. ???]
[??? Explain further or at least more clearly. ???]
[??? Explain further or at least more clearly. ???]
+
+ The following fluid variables are managed by the package system.
+
+
+ __________ ______
\CURRENTPACKAGE!* [Initially: Global] global
+
+ This is the start of the search path if interning.
+ \CurrentPackage!*
\CurrentPackage!*
\CurrentPackage!* is rebound in the token scanner on encountering
+ a "\".
+
+
+ __________ ______
\PACKAGENAMES!* [Initially: (Global)] global
+
+ List of ALL package names currently created.
+
+ Our current package model uses a set of general path functions that
+access functions specific to each level of the id hash table tree to do
+various things: "Localxxxx(s)" and "Pathxxxx(s)" in which "xxxx" is one of
+ InternP, Intern, RemOb, MapObl
InternP, Intern, RemOb, MapObl
the set (InternP, Intern, RemOb, MapObl). By storing different functions,
+each package may have a different structure and associated functions. The
+ ______
current implementation of a package uses a vector
PSL Manual 7 February 1983 Identifiers
+section 6.6 page 6.11
+
+[Name Father GetFn PutFn RemFn MapFn]
+
+
+ __
stored under the indicator 'Package on the PackageName id.
+
+ A simple bucket id hash table can also be used for experiments, or the
+user can build his own. As far as possible, each function checks that a
+legal package is given before performing the operation.
+
+ [??? Should we have a package Tag ???]
[??? Should we have a package Tag ???]
[??? Should we have a package Tag ???]
+
+ The following functions should be used.
+
+
+ \CreatePackage
\CreatePackage ____ __ _____________ __ __ ____
(\CreatePackage NAME:id FATHERPACKAGE:id): id expr
+
+ This creates a convenient size id hash table, generates the
+ functions to manage it for this package, and links the new
+ _____________
package to the FATHERPACKAGE so that path searches for ids are
+ required.
+
+
+ \SetPackage
\SetPackage ____ __ __ ____
(\SetPackage NAME:id): id expr
+
+ ______
Selects another package such as GLOBAL\.
+
+
+ \PathInternP
\PathInternP _ __ ______ _______ ____
(\PathInternP S:{id string}): boolean expr
+
+ _
Searches from CurrentPackage!* to see if S is interned.
+
+
+ \PathIntern
\PathIntern _ __ ______ __ ____
(\PathIntern S:{id string}): id expr
+
+ __
Look up or insert an id.
+
+
+ \PathRemob
\PathRemob _ __ ______ __ ____
(\PathRemob S:{id string}): id expr
+
+ Remobs, puts in NIL package.
+
+
+ \PathMapObl
\PathMapObl _ ________ ___ ____
(\PathMapObl F:function): NIL expr
+
+ _ __
Applies F to ALL ids in path.
+
+
+ \LocalInternP
\LocalInternP _ __ ______ _______ ____
(\LocalInternP S:{id string}): boolean expr
+
+ Searches in CURRENTPACKAGE!*.
Identifiers 7 February 1983 PSL Manual
+page 6.12 section 6.6
+
+ \LocalIntern
\LocalIntern _ __ ______ __ ____
(\LocalIntern S:{id string}): id expr
+
+ __
Look up or insert in CURRENTPACKAGE!* (forces ids uninterned in
+ CURRENTPACKAGE!* into CURRENTPACKAGE!*) .
+
+
+ \LocalRemob
\LocalRemob _ __ ______ __ ____
(\LocalRemob S:{id string}): id expr
+
+ Remobs, puts in NIL package.
+
+
+ \LocalMapObl
\LocalMapObl _ ________ ___ ____
(\LocalMapObl F:function): NIL expr
+
+ _ __
Applies F to ALL ids in (CurrentPackage!*).
+
+ ______
Note that if a string is used, it CANNOT include the \. Also, since most
+__
ids are "RAISED" on input, be careful.
+
+ \PathIntern
\PathIntern
Current intern, etc. are \PathIntern, etc.
+
+ Several restrictions are placed on the use of packages when compiled.
+Since it is a loaded module and not integrated with the basic PSL system,
+all ids in the compiled package are Interned in Global\ before they are
+defined. This requires a slightly more complex loading system for
+packages. Names and function ids which conflict with names in Global\ (or
+other packages in the path) must be forced into the id hash table of the
+desired package. The package is compiled WITHOUT the package module
+loaded.
+
+ In addition, if a function call must be issued for a function which has
+been redefined in the package the function name must be changed. When
+ Fasl
Fasl
PACKAGE has been integrated with Fasl and PSL, it will be sufficient to
+prefix the function name with the package name (e.g. Global\Print).
+Currently, one must actually change the function name (e.g. Global!.Print).
+
+ Other problems in the package system include:
+
+
+ a. Single character identifiers are handled specially (i.e. not
+ interned) and therefore may not be used in any packages without
+ doing an explicit intern
+
+ b. By leaving the the package identifier and '\' off the identifier
+ will place it in the Global\ package instead of the current
+ package
+
+ c. If an identifier is installed in the Global\ package, then
+ reference to it with another package identifier will return the
+ Global\ value instead of issuing an error
+
+
+ Print
Print
As an example, a small package which redefines the system function Print
PSL Manual 7 February 1983 Identifiers
+section 6.6 page 6.13
+
+is shown. The assumed file name is PrintPack.SL.
+
+ (De GetFieldFn (Relation Field)
+ (Slotdescslotfn
+ (Cdr (Assoc Field
+ (Dsdescslotalist Getdefstruct Relation)))))
+
+ (Df Print (Args)
+ (Prog (Fields)
+ (Setq Fields (Get (Car Args) 'Fields))
+ (Foreach Elem In (Eval (Car Args)) Do
+ (Cons
+ Global!.Print
+ (Foreach Field In Fields Collect
+ (Apply (GetFieldFn
+ (Car Args) Field) ('List Elem)))))
+ (Return (Car Args))))
+
+ This package would be compiled as follows (immediately after entering
+PSL):
+
+ (Faslout "PrintPackage")
+ (Dskin "PrintPack.SL"$)
+ (Faslend)
+ (Quit)
+
+ This package would be loaded as follows (immediately after entering PSL):
+
+ (Load '(Defstruct Package))
+ (CopyD 'Global!.Print Print)
+ (Progn (\CreatePackage 'PrintPack 'Global)
+ (\SetPAckage 'PrintPack)
+ (LocalIntern 'Print))
+ (Faslin "PrintPack.B")
+
+
+
+6.7. System Global Variables, Switches and Other "Hooks"
6.7. System Global Variables, Switches and Other "Hooks"
6.7. System Global Variables, Switches and Other "Hooks"
+
+
+6.7.1. Introduction
6.7.1. Introduction
6.7.1. Introduction
+
+ A number of global variables provide global control of the LISP system,
+or implement values which are constant throughout execution. Certain
+options are controlled by switches, with T or NIL properties (e.g. ECHOing
+as a file is read in); others require a value, such as an integer for the
+current output base. PSL has the convention (following the REDUCE/RLISP
+convention) of using a "!*" in the name of the variable: !*XXXXX for GLOBAL
+variables expecting a T/NIL value (called "switches"), and XXXXX!* for
+other GLOBALs. Chapter 26 is an index of switches and global variables
+used in PSL.
Identifiers 7 February 1983 PSL Manual
+page 6.14 section 6.7
+
+ [??? These should all be FLUIDs, so that ANY one of these variables may
[??? These should all be FLUIDs, so that ANY one of these variables may
[??? These should all be FLUIDs, so that ANY one of these variables may
+ be rebound, as appropriate ???]
be rebound, as appropriate ???]
be rebound, as appropriate ???]
+
+
+6.7.2. Setting Switches
6.7.2. Setting Switches
6.7.2. Setting Switches
+
+ Strictly speaking, XXXX is a switch and !*XXXX is a corresponding global
+variable that assumes the T/NIL value; both are loosely referred to as
+switches elsewhere in the manual.
+
+ On Off
On Off
The On and Off functions are used to change the values of the variables
+associated with switches. Some switches contain an s-expression on their
+ 1
+property lists under the indicator 'SIMPFG . The s-expression has the form
+ Cond
Cond
of a Cond list:
+
+
+((T (action-for-ON)) (NIL (action-for-OFF)))
+
+
+ On Off
On Off
If the 'SIMPFG indicator is present, then the On and Off functions also
+evaluate the appropriate action in the s-expression.
+
+
+ On
On _ __ ____ _____
(On [U:id]): None macro
+
+ _
For each U, the associated !*U variable is set to T. If a "(T
+ GET
GET _
(action-for-ON))" clause is found by (GET U 'SIMPFG), the
+ "action" is EVAL'ed.
+
+
+ Off
Off _ __ ____ _____
(Off [U:id]): None macro
+
+ _
For each U, the associated !*U variable is set to NIL. If a
+ GET
GET _
"(NIL (action-for-OFF)" clause is found by (GET U 'SIMPFG), the
+ "action" is EVAL'ed.
+
+ (On Comp Ord Usermode)
+
+ will set !*Comp, !*Ord, and !*Usermode to T.
+
+ Note that
+
+
+
+
+_______________
+
+ 1
+ The name SIMPFG comes from its introduction in the REDUCE algebra
+system, where it was used as a "simp flag" to specify various
+simplifications to be performed as various switches were turned on or off.
PSL Manual 7 February 1983 Identifiers
+section 6.7 page 6.15
+
+ (Get 'Cref 'Simpfg)
+
+returns
+
+ ((T (Crefon)) (Nil (Crefoff)))
+
+ ____ ____
Setting CREF on will result in !*CREF being set to T and the function
+Crefon
Crefon
Crefon being evaluated.
+
+
+6.7.3. Special Global Variables
6.7.3. Special Global Variables
6.7.3. Special Global Variables
+
+
+ __________ ______
NIL [Initially: NIL] global
+
+ NIL is a special GLOBAL variable. It is protected from being
+ Set SetQ
Set SetQ
modified by Set or SetQ.
+
+
+ __________ ______
T [Initially: T] global
+
+ T is a special GLOBAL variable. It is protected from being
+ Set SetQ
Set SetQ
modified by Set or SetQ.
+
+
+6.7.4. Special Put Indicators
6.7.4. Special Put Indicators
6.7.4. Special Put Indicators
+
+ __
Some actions search the property list of relevant ids for these
+indicators:
+
+
+ __
'HELPFUNCTION An id, a function to be executed to give help about the
+ topic; ideally for a complex topic, a clever function is
+ used.
+
+'HELPSTRING A help string, kept in core for important or short topics.
+
+'HELPFILE The most common case, the name of a file to print; later we
+ hope to load this file into an EMODE buffer for perusal in a
+ window.
+
+'SWITCHINFO A string describing the purpose of the SWITCH, see
+ ShowSwitches
ShowSwitches
ShowSwitches below.
+
+'GLOBALINFO A string describing the purpose of the GLOBAL, see
+ ShowGlobals
ShowGlobals
ShowGlobals below.
+
+ __
'BREAKFUNCTION Associates a function to be run with an Id typed at Break
+ Loop, see Chapter 14.
+
+'TYPE PSL uses the property TYPE to indicate whether a function is
+ a FEXPR, MACRO, or NEXPR; if no property is present, EXPR is
Identifiers 7 February 1983 PSL Manual
+page 6.16 section 6.7
+
+ assumed.
+
+'VARTYPE PSL uses the property VARTYPE to indicate whether an
+ __________
identifier is of type GLOBAL or FLUID.
+
+'!*LAMBDALINK The interpreter also looks under '!*LAMBDALINK for a Lambda
+ expression, if a procedure is not compiled.
+
+
+6.7.5. Special Flag Indicators
6.7.5. Special Flag Indicators
6.7.5. Special Flag Indicators
+
+
+ __
'EVAL If the id is flagged EVAL, the RLISP top-loop evaluates and
+ On Defn
__ On Defn
outputs any expression (id ...) in On Defn (!*DEFN := T) mode.
+
+ __
'IGNORE If the id is flagged IGNORE, the RLISP top-loop evaluates but
+ On Defn
__ On Defn
does NOT output any expression (id ...) in On Defn (!*DEFN := T)
+ mode.
+
+ PutD
__ PutD
'LOSE If an id has the 'LOSE flag, it will not be defined by PutD when
+ it is read in.
+
+'USER 'USER is put on all functions defined when in !*USERMODE, to
+ distinguish them from "system" functions. See Chapter 10.
+
+
+ LoadTime CompileTime
LoadTime CompileTime
See also the functions LoadTime and CompileTime in Chapter 18.
+
+ [??? Mention Parser properties ???]
[??? Mention Parser properties ???]
[??? Mention Parser properties ???]
+
+
+6.7.6. Displaying Information About Globals
6.7.6. Displaying Information About Globals
6.7.6. Displaying Information About Globals
+
+ Help
Help
The Help function has two options, (HELP SWITCHES) and (HELP GLOBALS),
+which should display the current state of a variety of switches and globals
+respectively. These calls have the same effect as using the functions
+below, using an initial table of Switches and Globals.
+
+ ShowSwitches
ShowSwitches
The function (ShowSwitches switch-list) may be used to print names,
+current settings and purpose of some switches. Use NIL as the switch-list
+ ShowSwitches
ShowSwitches
to get information on ALL switches of interest; ShowSwitches in this case
+ MapObl
MapObl
does a MapObl (Section 6.3.1) looking for 'SwitchInfo property.
+
+ ShowGlobals
ShowGlobals
Similarly, (ShowGlobals global-list) may be used to print names, values
+and purposes of important GLOBALs. Again, NIL used as the global-list
+ ShowGlobals MapObl
ShowGlobals MapObl
causes ShowGlobals to do a MapObl looking for a 'GlobalInfo property; the
+result is some information about all globals of interest.
ADDED psl-1983/3-1/lpt/07-lists.lpt
Index: psl-1983/3-1/lpt/07-lists.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/07-lists.lpt
@@ -0,0 +1,591 @@
+PSL Manual 7 February 1983 List Structure
+section 7.0 page 7.1
+
+ CHAPTER 7
CHAPTER 7
CHAPTER 7
+ LIST STRUCTURE
LIST STRUCTURE
LIST STRUCTURE
+
+
+
+
+ 7.1. Introduction to Lists and Pairs . . . . . . . . . 7.1
+ 7.2. Basic Functions on Pairs . . . . . . . . . . . 7.2
+ 7.3. Functions for Manipulating Lists. . . . . . . . . 7.4
+ 7.3.1. Selecting List Elements . . . . . . . . . 7.4
+ 7.3.2. Membership and Length of Lists . . . . . . . 7.6
+ 7.3.3. Constructing, Appending, and Concatenating Lists . 7.6
+ 7.3.4. Lists as Sets. . . . . . . . . . . . . 7.7
+ 7.3.5. Deleting Elements of Lists . . . . . . . . 7.8
+ 7.3.6. List Reversal. . . . . . . . . . . . . 7.9
+ 7.4. Functions for Building and Searching A-Lists. . . . . 7.10
+ 7.5. Substitutions . . . . . . . . . . . . . . . 7.11
+
+
+
+
+7.1. Introduction to Lists and Pairs
7.1. Introduction to Lists and Pairs
7.1. Introduction to Lists and Pairs
+
+ ____
The pair is a fundamental PSL data type, and is one of the major
+ ____ ____
attractions of LISP programming. A pair consists of a two-item structure.
+ Car Cdr
Car Cdr
In PSL the first element is called the Car and the second the Cdr; in other
+LISPs, the physical relationship of the parts may be different. An
+ Car
Car
illustration of the tree structure is given below as a box diagram; the Car
+ Cdr
Cdr
and the Cdr are each represented as a portion of the box.
+
+
+ -----------------
+ || Car | Cdr ||
+ -----------------
+
+
+ As an example, a tree written as ((A . B) . (C . D)) in dot-notation is
+drawn below as a box diagram.
+
+
+ -----------------
+ || / | \ ||
+ ----/-------\----
+ / \
+ ----------------- -----------------
+ || A | B || || C | D ||
+ ----------------- -----------------
+
+
+ The box diagrams are tedious to draw, so dot-notation is normally used.
+ ____
Note that a space is left on each side of the . to ensure that pairs are
+ _____
not confused with floats. Note also that in RLISP a dot may be used as the
List Structure 7 February 1983 PSL Manual
+page 7.2 section 7.1
+
+ Cons
Cons
infix operator for the function Cons, as in the expression x := 'y . 'z;,
+ ____
or as part of the notation for pairs, as in the expression x := '(y . z);
+(see Section 3.3.3).
+
+ An important special case occurs frequently enough that it has a special
+ ____
notation. This is a list of items, terminated by convention with the id
+NIL. The dot and surrounding parentheses are omitted, as well as the
+trailing NIL. Thus
+
+
+ (A . (B . (C . NIL)))
+
+
+can be represented in list-notation as
+
+
+ (A B C)
+
+
+
+7.2. Basic Functions on Pairs
7.2. Basic Functions on Pairs
7.2. Basic Functions on Pairs
+
+ ____
The following are elementary functions on pairs. All functions in this
+Chapter which require pairs as parameters signal a type mismatch error if
+the parameter given is not a pair.
+
+
+ Cons
Cons _ ___ _ ___ ____ ____
(Cons U:any V:any): pair expr
+
+ Eq
____ Eq _
Returns a pair which is not Eq to anything else and has U as its
+ Car Cdr
Car _ Cdr
Car part and V as its Cdr part. In RLISP syntax the dot, ".", is
+ Cons
Cons
an infix operator meaning Cons. Thus (A . (B . fn C) . D) is
+ Cons Cons Cons
Cons Cons Cons
equivalent to Cons (A, Cons (Cons (B, fn C), D)). See Section
+ 3.3.3 for more discussion of how dot is read.
+
+
+ Car
Car _ ____ ___ ____ ________ ____
(Car U:pair): any open-compiled, expr
+
+ _
The left part of U is returned. A type mismatch error occurs if
+ _ ____ _
U is not a pair, except when U is NIL. Then NIL is returned.
+ Car Cons
Car Cons
(Car (Cons a b)) ==> a.
+
+
+ Cdr
Cdr _ ____ ___ ____ ________ ____
(Cdr U:pair): any open-compiled, expr
+
+ _
The right part of U is returned. A type mismatch error occurs if
+ _ ____ _
U is not a pair, except when U is NIL. Then NIL is returned.
+ Cdr Cons
Cdr Cons
(Cdr (Cons a b)) ==> b.
+
+ Car Cdr
Car Cdr
The composites of Car and Cdr are supported up to four levels.
PSL Manual 7 February 1983 List Structure
+section 7.2 page 7.3
+
+ Car Cdr
Car Cdr
Car Cdr
+ Caar Cdar Cadr Cddr
Caar Cdar Cadr Cddr
Caar Cdar Cadr Cddr
+ Caaar Cdaar Cadar Cddar Caadr Cdadr Caddr Cdddr
Caaar Cdaar Cadar Cddar Caadr Cdadr Caddr Cdddr
Caaar Cdaar Cadar Cddar Caadr Cdadr Caddr Cdddr
+ Caaaar Cadaar Caadar Caddar Caaadr Cadadr Caaddr Cadddr
Caaaar Cadaar Caadar Caddar Caaadr Cadadr Caaddr Cadddr
Caaaar Cadaar Caadar Caddar Caaadr Cadadr Caaddr Cadddr
+ Cdaaar Cddaar Cdadar Cdddar Cdaadr Cddadr Cdaddr Cddddr
Cdaaar Cddaar Cdadar Cdddar Cdaadr Cddadr Cdaddr Cddddr
Cdaaar Cddaar Cdadar Cdddar Cdaadr Cddadr Cdaddr Cddddr
+
+ ____
____
____
expr
expr
These are all exprs of one argument. They may return any type
+ and are generally open-compiled. An example of their use is that
+ Cddar Cdr Cdr Car Car Cdr
Cddar Cdr Cdr Car Car Cdr
Cddar p is equivalent to Cdr Cdr Car p. As with Car and Cdr, a
+ type mismatch error occurs if the argument does not possess the
+ specified component.
+
+ As an alternative to employing chains of CxxxxR to obscure depths,
+ ____
particularly in extracting elements of a list, consider the use of the
+ First Second Third Fourth Nth
First Second Third Fourth Nth
functions First, Second, Third, Fourth, or Nth (Section 7.3.1), or possibly
+even the Defstruct package (Section 17.6).
+
+
+ NCons
NCons _ ___ ____ ____ ________ ____
(NCons U:any): pair open-compiled, expr
+
+ Cons
Cons _
Equivalent to Cons (U, NIL).
+
+
+ XCons
XCons _ ___ _ ___ ____ ____ ________ ____
(XCons U:any V:any): pair open-compiled, expr
+
+ Cons
Cons _ _
Equivalent to Cons (V, U).
+
+
+ Copy
Copy _ ___ ___ ____
(Copy X:any): any expr
+
+ ____ _
Copies all pairs in X, but does not make copies of atoms
+ (including vectors and strings). For example, if A is
+
+ ([2 5] "ATOM")
+
+ and B is the result of (Copy A), then
+
+
+ (Eq A B) is NIL
+ but (Eq (Car A) (Car B)) is T
+ and (Eq (Cadr A) (Cadr B)) is T
+
+
+ TotalCopy Copy
TotalCopy Copy
See TotalCopy in Section 8.5. Note that Copy is recursive and
+ will not terminate if its argument is a circular list.
+
+ See Chapter 8 for other relevant functions.
+
+ The following functions are known as "destructive" functions, because
+they change the structure of the pair given as their argument, and
+consequently change the structure of the object containing the pair. They
+are most frequently used for various "efficient" functions (e.g. the
List Structure 7 February 1983 PSL Manual
+page 7.4 section 7.2
+
+ ReverseIP NConc DeleteIP
ReverseIP NConc DeleteIP
non-copying ReverseIP and NConc functions, and destructive DeleteIP) and to
+build structures that have deliberately shared sub-structure. They are
+also capable of creating circular structures, which create havoc with
+ careful
careful
normal printing and list traversal functions. Be careful using them.
+
+
+ RplacA
RplacA _ ____ _ ___ ____ ____ ________ ____
(RplacA U:pair V:any): pair open-compiled, expr
+
+ Car
Car _ _ _
The Car of the pair U is replaced by V, and the modified U is
+ _ _
returned. (If U is (a . b) then (V .b) is returned). A type
+ _
mismatch error occurs if U is not a pair.
+
+
+ RplacD
RplacD _ ____ _ ___ ____ ____ ________ ____
(RplacD U:pair V:any): pair open-compiled, expr
+
+ Cdr
Cdr _ _ _
The Cdr of the pair U is replaced by V, and the modified U is
+ _ _
returned. (If U is (a . b) then (a . V) is returned). A type
+ _
mismatch error occurs if U is not a pair.
+
+
+ RplacW
RplacW _ ____ _ ____ ____ ____
(RplacW A:pair B:pair): pair expr
+
+ Car Car
Car _ Car
Replaces the whole pair: the Car of A is replaced with the Car
+ Cdr Cdr
_ Cdr _ Cdr _ _
of B, and the Cdr of A with the Cdr of B. The modified A is
+ returned.
+
+ [??? Should we add some more functions here someday? Probably the
[??? Should we add some more functions here someday? Probably the
[??? Should we add some more functions here someday? Probably the
+ RLISP guys that do arbitrary depth member type stuff. ???]
RLISP guys that do arbitrary depth member type stuff. ???]
RLISP guys that do arbitrary depth member type stuff. ???]
+
+
+
+7.3. Functions for Manipulating Lists
7.3. Functions for Manipulating Lists
7.3. Functions for Manipulating Lists
+
+ ____ ____
The following functions are meant for the special pairs which are lists,
+as described in Section 7.1. Note that the functions described in Chapter
+8 can also be used on lists.
+
+ [??? Make some mention of mapping with FOR...COLLECT and such like.
[??? Make some mention of mapping with FOR...COLLECT and such like.
[??? Make some mention of mapping with FOR...COLLECT and such like.
+ ???]
???]
???]
+
+
+7.3.1. Selecting List Elements
7.3.1. Selecting List Elements
7.3.1. Selecting List Elements
+
+
+ First
First _ ____ ___ _____
(First L:pair): any macro
+
+ Car
Car _
A synonym for Car L.
PSL Manual 7 February 1983 List Structure
+section 7.3 page 7.5
+
+ Second
Second _ ____ ___ _____
(Second L:pair): any macro
+
+ Cadr
Cadr _
A synonym for Cadr L.
+
+
+ Third
Third _ ____ ___ _____
(Third L:pair): any macro
+
+ Caddr
Caddr _
A synonym for Caddr L.
+
+
+ Fourth
Fourth _ ____ ___ _____
(Fourth L:pair): any macro
+
+ Cadddr
Cadddr _
A synonym for Cadddr L.
+
+
+ Rest
Rest _ ____ ___ _____
(Rest L:pair): any macro
+
+ Cdr
Cdr _
A synonym for Cdr L.
+
+
+ LastPair
LastPair _ ____ ___ ____
(LastPair L:pair): any expr
+
+ ____ ____
Last pair of a list. It is often useful to think of this as a
+ pointer to the last element for use with destructive functions
+ RplacA
RplacA _
such as RplacA. Note that if L is atomic a type mismatch error
+ occurs.
+
+ (De LastPair (L)
+ (Cond ((Null (Rest L)) L)
+ (T (LastPair (Rest L)))))
+
+
+ LastCar
LastCar _ ___ ___ ____
(LastCar L:any): any expr
+
+ ____ _
Returns the last element of the list L. A type mismatch error
+ First LastPair
_ First LastPair _
results if L is not a list. Equivalent to First LastPair L.
+
+
+ Nth
Nth _ ____ _ _______ ___ ____
(Nth L:pair N:integer): any expr
+
+ ____ _ _
Returns the Nth element of the list L. If L is atomic or
+ _
contains fewer than N elements, an out of range error occurs.
+ First PNth
First PNth
Equivalent to (First (PNth L N)).
+
+
+ PNth
PNth _ ____ _ _______ ___ ____
(PNth L:list N:integer): any expr
+
+ ____ ____ _
Returns list starting with the Nth element of a list L. Note
+ that it is often useful to view this as a pointer to the Nth
+ RplacA
_ RplacA
element of L for use with destructive functions such as RplacA.
+ _ _
If L is atomic or contains fewer than N elements, an out of range
+ error occurs.
List Structure 7 February 1983 PSL Manual
+page 7.6 section 7.3
+
+ (De PNth (L N)
+ (Cond ((Leq N 1) L)
+ (T (PNth (Cdr L) (Sub1 N)))))
+
+
+7.3.2. Membership and Length of Lists
7.3.2. Membership and Length of Lists
7.3.2. Membership and Length of Lists
+
+
+ Member
Member _ ___ _ ____ _____ _______ ____
(Member A:any L:list): extra-boolean expr
+
+ Equal
_ Equal ____
Returns NIL if A is not Equal to some top level element of list
+ _ _
L; otherwise it returns the remainder of L whose first element is
+ _
A.
+
+ (De Member (A L)
+ (Cond((Null L) Nil)
+ ((Equal A (First L)) L)
+ (T (Member A (Rest L)))))
+
+
+ MemQ
MemQ _ ___ _ ____ _____ _______ ____
(MemQ A:any B:list): extra-boolean expr
+
+ Member Eq
Member Eq
Same as Member, but an Eq check is used for comparison.
+
+ (De Memq (A L)
+ (Cond((Null L) Nil)
+ ((Eq A (First L)) L)
+ (T (Memq A (Rest L)))))
+
+
+ Length
Length _ ___ _______ ____
(Length X:any): integer expr
+
+ ____ _
The top level length of the list X is returned.
+
+ (De Length (X)
+ (Cond((Atom X) 0)
+ (T (Plus (Length X) 1))))
+
+
+7.3.3. Constructing, Appending, and Concatenating Lists
7.3.3. Constructing, Appending, and Concatenating Lists
7.3.3. Constructing, Appending, and Concatenating Lists
+
+
+ List
List _ ___ ____ _____
(List [U:any]): list fexpr
+
+ ____ ____
Construct a list of the evaluated arguments. A list of the
+ _
evaluation of each element of U is returned.
+
+
+ Append
Append _ ____ _ ____ ____ ____
(Append U:list V:list): list expr
+
+ ____ _
Returns a constructed list in which the last element of U is
+ _ ____ _ _
followed by the first element of V. The list U is copied, but V
PSL Manual 7 February 1983 List Structure
+section 7.3 page 7.7
+
+ is not.
+
+ (De Append (U V)
+ (Cond ((Null U) V)
+ (T (Cons (Car U) (Append (Cdr U) V)))))
+
+
+ NConc
NConc _ ____ _ ____ ____ ____
(NConc U:list V:list): list expr
+
+ Append
Append _ _
Destructive version of Append. Concatenates V to U without
+ Cdr
_ Cdr _ _
copying U. The last Cdr of U is modified to point to V. See the
+ warning on page 7.3 about the use of destructive functions.
+
+ (De Nconc (U V)
+ (Cond ((Null U) V)
+ (T (Rplacd (Lastcdr U V)))))
+
+
+ AConc
AConc _ ____ _ ___ ____ ____
(AConc U:list V:any): list expr
+
+ _ ____ _
Destructively adds element V to the tail of list U.
+
+
+ LConc
LConc ___ ____ ____ ____ ____ ____
(LConc PTR:list ELEM:list): list expr
+
+ NConc
NConc
Effectively NConc, but avoids scanning from the front to the end
+ RPLACD
___ RPLACD ___ ____
of PTR for the RPLACD(PTR, ELEM) by maintaining a pointer to end
+ LastPair
____ ___ ___ ____ LastPair ____
of the list PTR. PTR is (list . LastPair list). Returns updated
+ ___ ___
PTR. PTR should be initialized to NIL . NIL before calling the
+ ____
first time. Used to build lists from left to right.
+
+
+ TConc
TConc ___ ____ ____ ___ ____ ____
(TConc PTR:list ELEM:any): list expr
+
+ AConc
AConc
Effectively AConc, but avoids scanning from the front to the end
+ RPLACD List
___ RPLACD ___ List ____
of PTR for the RPLACD(PTR, List(ELEM)) by maintaining a pointer
+ LastPair
____ ___ ___ ____ LastPair ____
to end of the list PTR. PTR is (list . LastPair list). Returns
+ ___ ___
updated PTR. PTR should be initialized to NIL . NIL before
+ ____
calling the first time. Used to build lists from left to right.
+
+
+7.3.4. Lists as Sets
7.3.4. Lists as Sets
7.3.4. Lists as Sets
+
+ ____
A set is a list in which each element occurs only once. Order of
+elements does not matter, so these functions may not preserve order.
+
+
+ Adjoin
Adjoin _______ ___ ___ ____ ____ ____
(Adjoin ELEMENT:any SET:list): list expr
+
+ Equal
_______ ___ Equal
Add ELEMENT to SET if it is not already on the top level. Equal
+ is used to test for equality.
List Structure 7 February 1983 PSL Manual
+page 7.8 section 7.3
+
+ AdjoinQ
AdjoinQ _______ ___ ___ ____ ____ ____
(AdjoinQ ELEMENT:any SET:list): list expr
+
+ Adjoin Eq
Adjoin Eq _______ ___
Adjoin using Eq for the test whether ELEMENT is already in SET.
+
+
+ Union
Union _ ____ _ ____ ____ ____
(Union X:list Y:list): list expr
+
+ Set union.
+
+
+ UnionQ
UnionQ _ ____ _ ____ ____ ____
(UnionQ X:list Y:list): list expr
+
+ Eq Union
Eq Union
Eq version of Union.
+
+
+ InterSection
InterSection _ ____ _ ____ ____ ____
(InterSection U:list V:list): list expr
+
+ Set intersection.
+
+
+ InterSectionQ
InterSectionQ _ ____ _ ____ ____ ____
(InterSectionQ U:list V:list): list expr
+
+ Eq InterSection
Eq InterSection
Eq version of InterSection.
+
+
+ List2Set
List2Set ___ ____ ____ ____
(List2Set SET:list): list expr
+
+ Equal
___ Equal
Remove redundant elements from the top level of SET using Equal.
+
+
+ List2SetQ
List2SetQ ___ ____ ____ ____
(List2SetQ SET:list): list expr
+
+ Eq
___ Eq
Remove redundant elements from the top level of SET using Eq.
+
+
+7.3.5. Deleting Elements of Lists
7.3.5. Deleting Elements of Lists
7.3.5. Deleting Elements of Lists
+
+ xxxIP xxx
xxxIP xxx
Note that functions with names of the form xxxIP indicate that xxx is
+done InPlace.
+
+
+ Delete
Delete _ ___ _ ____ ____ ____
(Delete U:any V:list): list expr
+
+ _ _
Returns V with the first top level occurrence of U removed from
+ _ _
it. That portion of V before the first occurrence of U is
+ copied.
+
+ (De Delete (U V)
+ (Cond((Null V) Nil)
+ ((Equal (First V) U) (Rest V))
+ (T (Cons (First V) (Delete U (Rest V))))))
PSL Manual 7 February 1983 List Structure
+section 7.3 page 7.9
+
+ Del
Del _ ________ _ ___ _ ____ ____ ____
(Del F:function U:any V:list): list expr
+
+ Delete
Delete _
Generalized Delete function with F as the comparison function.
+
+
+ DeletIP
DeletIP _ ___ _ ____ ____ ____
(DeletIP U:any V:list): list expr
+
+ Delete RplacD
Delete _ RplacD _
Destructive Delete; modifies V using RplacD. Do not depend on V
+ ____
itself correctly referring to list.
+
+
+ DelQ
DelQ _ ___ _ ____ ____ ____
(DelQ U:any V:list): list expr
+
+ Eq
_ _ Eq
Delete U from V, using Eq for comparison.
+
+
+ DelQIP
DelQIP _ ___ _ ____ ____ ____
(DelQIP U:any V:list): list expr
+
+ DelQ DeletIP
DelQ DeletIP
Destructive version of DelQ; see DeletIP.
+
+
+ DelAsc
DelAsc _ ___ _ _ ____ _ ____ ____
(DelAsc U:any V:a-list): a-list expr
+
+ _ _
Remove first (U . xxx) from V.
+
+
+ DelAscIP
DelAscIP _ ___ _ _ ____ _ ____ ____
(DelAscIP U:any V:a-list): a-list expr
+
+ DelAsc
DelAsc
Destructive DelAsc.
+
+
+ DelatQ
DelatQ _ ___ _ _ ____ _ ____ ____
(DelatQ U:any V:a-list): a-list expr
+
+ Eq
_ _ Eq _
Delete first (U . xxx) from V, using Eq to check equality with U.
+
+
+ DelatQIP
DelatQIP _ ___ _ _ ____ _ ____ ____
(DelatQIP U:any V:a-list): a-list expr
+
+ DelatQ
DelatQ
Destructive DelatQ.
+
+
+7.3.6. List Reversal
7.3.6. List Reversal
7.3.6. List Reversal
+
+
+ Reverse
Reverse _ ____ ____ ____
(Reverse U:list): list expr
+
+ _
Returns a copy of the top level of U in reverse order.
List Structure 7 February 1983 PSL Manual
+page 7.10 section 7.3
+
+ (De Reverse (U)
+ (Prog (W)
+ (While U
+ (ProgN
+ (Setq W (Cons (Car U) W))
+ (Setq U (Cdr U))))
+ (Return W)))
+
+
+ ReversIP
ReversIP _ ____ ____ ____
(ReversIP U:list): list expr
+
+ Reverse
Reverse
Destructive Reverse.
+
+
+
+7.4. Functions for Building and Searching A-Lists
7.4. Functions for Building and Searching A-Lists
7.4. Functions for Building and Searching A-Lists
+
+
+ Assoc
Assoc _ ___ _ _ ____ ____ ___ ____
(Assoc U:any V:a-list): {pair, NIL} expr
+
+ Car
_ Car _ ____ _
If U occurs as the Car portion of an element of the a-list V, the
+ ____ _
pair in which U occurred is returned, else NIL is returned.
+ Assoc
Assoc _ ____
Assoc might not detect a poorly formed a-list so an invalid
+ Car Cdr
Car Cdr
construction may be detected by Car or Cdr.
+
+ (De Assoc (U V)
+ (Cond ((Null V) Nil)
+ ((Atom (Car V))
+ (Error 000 (List V "is a poorly formed alis
+ ((Equal U (Caar V)) (Car V))
+ (T (Assoc U (Cdr V)))))
+
+
+ Atsoc
Atsoc __ ___ __ ___ ___ ____
(Atsoc R1:any R2:any): any expr
+
+ Car Eq Eq Assoc
__ ____ Car Eq __ Eq Assoc
Scan R2 for pair with Car Eq R1. Eq version of Assoc.
+
+
+ Ass
Ass _ ________ _ ___ _ _ ____ ____ ___ ____
(Ass F:function U:any V:a-list): {pair, NIL} expr
+
+ Ass Assoc
Ass Assoc _
Ass is a generalized Assoc function. F is the comparison
+ function.
+
+
+ SAssoc
SAssoc _ ___ _ _ ____ __ ________ ___ ____
(SAssoc U:any V:a-list FN:function): any expr
+
+ _ ____ _ _ _
Searches the a-list V for an occurrence of U. If U is not in the
+ _ ____ __
a-list, the evaluation of function FN is returned.
PSL Manual 7 February 1983 List Structure
+section 7.4 page 7.11
+
+ (De SAssoc (U V FN)
+ (Cond ((Null V) (FN))
+ ((Equal U (Caar V)) (Car V))
+ (T (SAssoc U (Cdr V) FN))))
+
+
+ Pair
Pair _ ____ _ ____ _ ____ ____
(Pair U:list V:list): a-list expr
+
+ _ _ ____
U and V are lists which must have an identical number of
+ ____
elements. If not, an error occurs. Returned is a list in which
+ Car
____ Car ____ _
each element is a pair, the Car of the pair being from U and the
+ Cdr
Cdr _
Cdr being the corresponding element from V.
+
+ (De Pair (U V)
+ (Cond ((And U V)(Cons (Cons (Car U)(Car V))
+ (Pair (Cdr U)(Cdr V))))
+ ((Or U V)(Error 000 "Different length lists i
+ (T Nil)))
+
+
+
+7.5. Substitutions
7.5. Substitutions
7.5. Substitutions
+
+
+ Subst
Subst _ ___ _ ___ _ ___ ___ ____
(Subst U:any V:any W:any): any expr
+
+ _ _
Returns the result of substituting U for all occurrences of V in
+ _ _ _
W. Copies all of W which is not replaced by U. The test used is
+ Equal
Equal
Equal.
+
+ (De Subst (U V W)
+ (Cond ((Null W) Nil)
+ ((Equal V W) U)
+ ((Atom W) W)
+ (T (Cons (Subst U V (Car W))(Subst U V (Cdr
+
+
+ SubstIP
SubstIP _ ___ _ ___ _ ___ ___ ____
(SubstIP U:any V:any W:any): any expr
+
+ Subst
Subst
Destructive Subst.
+
+
+ SubLis
SubLis _ _ ____ _ ___ ___ ____
(SubLis X:a-list Y:any): any expr
+
+ Subst
Subst
This performs a series of Substs in parallel. The value returned
+ Cdr
Cdr
is the result of substituting the Cdr of each element of the
+ Car
_ ____ _ Car
a-list X for every occurrence of the Car part of that element in
+ _
Y.
List Structure 7 February 1983 PSL Manual
+page 7.12 section 7.5
+
+ (De SubLis (X Y)
+ (Cond
+ ((Null X) Y)
+ (T
+ (Prog (U)
+ (Setq U (Assoc Y X))
+ (Return
+ (Cond
+ (U (Cdr U))
+ ((Atom Y) Y)
+ (T (Cons (SubLis X (Car Y)) (SubLis X (Cdr Y))
+
+
+ SublA
SublA _ _ ____ _ ___ ___ ____
(SublA U:a-list V:any): any expr
+
+ Eq SubLis
Eq SubLis
Eq version of SubLis; replaces atoms only.
ADDED psl-1983/3-1/lpt/08-strings.lpt
Index: psl-1983/3-1/lpt/08-strings.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/08-strings.lpt
@@ -0,0 +1,673 @@
+PSL Manual 7 February 1983 Strings and Vectors
+section 8.0 page 8.1
+
+ CHAPTER 8
CHAPTER 8
CHAPTER 8
+ STRINGS AND VECTORS
STRINGS AND VECTORS
STRINGS AND VECTORS
+
+
+
+
+ 8.1. Vector-Like Objects . . . . . . . . . . . . . 8.1
+ 8.2. Strings . . . . . . . . . . . . . . . . . 8.1
+ 8.3. Vectors . . . . . . . . . . . . . . . . . 8.3
+ 8.4. Word Vectors . . . . . . . . . . . . . . . 8.5
+ 8.5. General X-Vector Operations . . . . . . . . . . 8.5
+ 8.6. Arrays . . . . . . . . . . . . . . . . . 8.7
+ 8.7. Common LISP String Functions . . . . . . . . . . 8.7
+
+
+
+
+8.1. Vector-Like Objects
8.1. Vector-Like Objects
8.1. Vector-Like Objects
+
+ ______ ______ ____ ______ ________ ______
In this Chapter, LISP strings, vectors, word-vectors, halfword-vectors,
+ ____ ______
and byte-vectors are described. Each may have several elements, accessed
+ _______
by an integer index. For convenience, members of this set are referred to
+ _ ______ _ ______ ____
as x-vectors. X-vector functions also apply to lists. Currently, the
+ Size UpB
_ ______ Size UpB
index for x-vectors ranges from 0 to an upper limit, called the Size or UpB
+ Size
_ ______ Size ______
(upper bound). Thus an x-vector X has 1 + Size(X) elements. Strings index
+ ______
from 0 because they are considered to be packed vectors of bytes. Bytes
+are 7 bits on the DEC-20 and 8 bits on the VAX.
+
+ ______ ____
______ ____
______ ____
[??? Note that with new integer tagging, strings are "packed" words,
[??? Note that with new integer tagging, strings are "packed" words,
[??? Note that with new integer tagging, strings are "packed" words,
+ ______
______
______
which are special cases of vectors. Should we add byte-vectors too, so
which are special cases of vectors. Should we add byte-vectors too, so
which are special cases of vectors. Should we add byte-vectors too, so
+ ______
______
______
that strings are different print mode of byte vector ???]
that strings are different print mode of byte vector ???]
that strings are different print mode of byte vector ???]
+
+ [??? Size should probably be replaced by UPLIM or UPB. ???]
[??? Size should probably be replaced by UPLIM or UPB. ???]
[??? Size should probably be replaced by UPLIM or UPB. ???]
+
+ In RLISP syntax, X[i]; may be used to access the i'th element of an
+_ ______
x-vector, and X[i]:=y; is used to change the i'th element to y. These
+ Indx SetIndx
Indx SetIndx
functions correspond to the LISP functions Indx and SetIndx.
+
+ [??? Change names to GetIndex, PutIndex ???]
[??? Change names to GetIndex, PutIndex ???]
[??? Change names to GetIndex, PutIndex ???]
+
+For functions which change an object from one data type to another, see
+Section 4.3.
+
+
+
+8.2. Strings
8.2. Strings
8.2. Strings
+
+ ______ ______
A string is currently thought of as a Byte vector, or a packed integer
+______ ______
vector, with elements that are ASCII characters. A string has a header
+containing its length and perhaps a tag. The next M words contain the 0
+... Size characters, packed as appropriate, terminated with at least 1
+ ______ ______
NULL. On the DEC-20, this means that strings have an ASCIZ string starting
Strings and Vectors 7 February 1983 PSL Manual
+page 8.2 section 8.2
+
+in the second word. (ASCIZ strings are NULL terminated.)
+
+
+ Make!-String
Make!-String ____ _______ _______ _______ ______ ____
(Make!-String SIZE:integer INITVAL:integer): string expr
+
+ ______ ____
Constructs and returns a string with SIZE characters, each
+ _______
initialized to the ASCII code INITVAL.
+
+
+ MkString
MkString _____ _______ _______ _______ ______ ____
(MkString UPLIM:integer INITVAL:integer): string expr
+
+ Make!-String
Make!-String
An old form of Make!-String. Returns a string of characters all
+ _______ _____
initialized to INITVAL, with upper bound UPLIM. So, the returned
+ _____ _
string contains a total of UPLIM + 1 characters.
+
+
+ String
String ____ _______ ______ _____
(String [ARGS:integer]): string nexpr
+
+ ______ ____
Create string of elements from a list of ARGS.
+
+ [??? Should we check each arg in 0 ... 127. What about 128
[??? Should we check each arg in 0 ... 127. What about 128
[??? Should we check each arg in 0 ... 127. What about 128
+ - 255 with 8 bit vectors? ???]
- 255 with 8 bit vectors? ???]
- 255 with 8 bit vectors? ???]
+
+
+ (String 65 66 67) returns "ABC"
+
+
+ CopyStringToFrom
CopyStringToFrom ___ ______ ___ ______ ___ ______ ____
(CopyStringToFrom NEW:string OLD:string): NEW:string expr
+
+ ___ ___
Copy all characters from OLD into NEW. This function is
+ destructive.
+
+
+ CopyString
CopyString _ ______ ______ ____
(CopyString S:string): string expr
+
+ ______
Copy to new heap string, allocating space.
+
+ [??? Should we add GetS, PutS, UpbS, etc ???]
[??? Should we add GetS, PutS, UpbS, etc ???]
[??? Should we add GetS, PutS, UpbS, etc ???]
+
+ When processing strings it is frequently necessary to be able to specify
+a particular character. In PSL a character is just its ASCII code
+representation, but it is difficult to remember the code, and the use of
+ Char
Char
codes does not add to the readability of programs. One can use the Char
+ __
macro, defined in Chapter 20. It expects a single character id as argument
+and returns the ASCII code of that character. For example
+
+
+ (Char A) returns 65
+ (Char !a) returns 97
+ (Char !@) returns 64
PSL Manual 7 February 1983 Strings and Vectors
+section 8.2 page 8.3
+
+Note that to get lower-case a one must precede the a by "!", otherwise the
+a will be raised. See also the sharp-sign macros in Chapter 17.
+
+
+
+8.3. Vectors
8.3. Vectors
8.3. Vectors
+
+ ______ ____
A vector is a structured entity in which random item elements may be
+ _______ ______
accessed with an integer index. A vector has a single dimension. Its
+maximum size is determined by the implementation and available space. A
+ ______
suggested input/output "vector notation" is defined (see Chapter 12).
+
+
+ GetV
GetV _ ______ _____ _______ ___ ____
(GetV V:vector INDEX:integer): any expr
+
+ _____ ______ _
Returns the value stored at position INDEX of the vector V. The
+ _____
type mismatch error may occur. An error occurs if the INDEX does
+ UPBV
UPBV _
not lie within 0 ... (UPBV V) inclusive:
+
+ ***** INDEX subscript is out of range
+
+ _ _____
A similar effect may be obtained in RLISP by using V[INDEX];.
+
+
+ MkVect
MkVect _____ _______ ______ ____
(MkVect UPLIM:integer): vector expr
+
+ ______ _____
Defines and allocates space for a vector with UPLIM + 1 elements
+ _____
accessed as 0 ... UPLIM. Each element is initialized to NIL. If
+ _____
UPLIM is -1, an empty vector is returned. An error occurs if
+ _____ ______
UPLIM is < -1 or if there is not enough space for a vector of
+ this size:
+
+ ***** A vector of size UPLIM cannot be allocated
+
+
+ Make!-Vector
Make!-Vector _____ _______ _______ ___ ______ ____
(Make!-Vector UPLIM:integer INITVAL:any): vector expr
+
+ MkVect
MkVect _______
Like MkVect but each element is initialized to INITVAL.
+
+
+ PutV
PutV _ ______ _____ _______ _____ ___ ___ ____
(PutV V:vector INDEX:integer VALUE:any): any expr
+
+ _____ ______ _ _____ _____
Stores VALUE in the vector V at position INDEX. VALUE is
+ _____
returned. The type mismatch error may occur. If INDEX does not
+ UPBV
UPBV _
lie in 0 ... UPBV(V), an error occurs:
+
+ ***** INDEX subscript is out of range
+
+ A similar effect can be obtained in RLISP by typing in
+ _ _____ _____
V[INDEX]:=VALUE;. It is important to use square brackets, i.e.
+ "[]".
Strings and Vectors 7 February 1983 PSL Manual
+page 8.4 section 8.3
+
+ UpbV
UpbV _ ___ ___ _______ ____
(UpbV U:any): {NIL, integer} expr
+
+ _ _ ______
Returns the upper limit of U if U is a vector, or NIL if it is
+ not.
+
+
+ Vector
Vector ____ ___ ______ _____
(Vector [ARGS:any]): vector nexpr
+
+ ______ ____ ____ ______
Create vector of elements from list of ARGS. The vector has N
+ Size
Size ____
elements, i.e. Size = N - 1, in which N is the number of ARGS.
+
+
+ CopyVectorToFrom
CopyVectorToFrom ___ ______ ___ ______ ___ ______ ____
(CopyVectorToFrom NEW:vector OLD:vector): NEW:vector expr
+
+ Move elements, don't recurse.
+
+ [ ???Check size compatibility? ]
[ ???Check size compatibility? ]
[ ???Check size compatibility? ]
+
+
+ CopyVector
CopyVector _ ______ ______ ____
(CopyVector V:vector): vector expr
+
+ ______
Copy to new vector in heap.
+
+ The following functions can be used after the FAST!-VECTOR module has
+been loaded (LOAD FAST!-VECTOR).
+
+
+ IGetV
IGetV _ ______ _____ _______ ___ ____ ________ ____
(IGetV V:vector INDEX:integer): any open-compiled, expr
+
+ GetV
GetV
Used the same way as GetV.
+
+
+ IPutV
IPutV _ ______ _____ _______ _____ ___ ___ ____ ________ ____
(IPutV V:vector INDEX:integer VALUE:any): any open-compiled, expr
+
+ PutV
PutV
Fast version of PutV.
+
+
+ ISizeV
ISizeV _ ___ ___ _______ ____ ________ ____
(ISizeV U:any): {NIL,integer} open-compiled, expr
+
+ UpbV
UpbV
Fast version of UpbV.
+
+
+ ISizeS
ISizeS _ _ ______ _______ ____ ________ ____
(ISizeS X:x-vector): integer open-compiled, expr
+
+ Size
Size
Fast version of Size.
+
+
+ IGetS
IGetS _ _ ______ _ _______ ___ ____ ________ ____
(IGetS X:x-vector I:integer): any open-compiled, expr
+
+ Indx
Indx
Fast version of Indx.
PSL Manual 7 February 1983 Strings and Vectors
+section 8.3 page 8.5
+
+ IPutS
IPutS _ _ ______ _ _______ _ ___ ___ ____ ________ ____
(IPutS X:x-vector I:integer A:any): any open-compiled, expr
+
+ SetIndx
SetIndx
Fast version of SetIndx.
+
+
+
+8.4. Word Vectors
8.4. Word Vectors
8.4. Word Vectors
+
+ ____ ______ _ _______
Word-vectors or w-vectors are vector-like structures, in which each
+element is a "word" sized, untagged entity. This can be thought of as a
+ ______ ______
special case of fixnum vector, in which the tags have been removed.
+
+
+ Make!-Words
Make!-Words _____ _______ _______ _______ ____ ______ ____
(Make!-Words UPLIM:integer INITVAL:integer): Word-Vector expr
+
+ ____ ______ _____
Defines and allocates space for a Word-Vector with UPLIM + 1
+ _______
elements, each initialized to INITVAL.
+
+
+ Make!-Halfwords
Make!-Halfwords _____ _______ _______ _______ ________ ______ ____
(Make!-Halfwords UPLIM:integer INITVAL:integer): Halfword-Vector expr
+
+ ________ ______ _____
Defines and allocates space for a Halfword-vector with UPLIM + 1
+ _______
elements, each initialized to INITVAL.
+
+
+ Make!-Bytes
Make!-Bytes _____ _______ _______ _______ ____ ______ ____
(Make!-Bytes UPLIM:integer INITVAL:integer): Byte-vector expr
+
+ ____ ______ _____
Defines and allocates space for a Byte-Vector with UPLIM + 1
+ _______
elements, each initialized to INITVAL.
+
+ [??? Should we convert elements to true integers when accessing ???]
[??? Should we convert elements to true integers when accessing ???]
[??? Should we convert elements to true integers when accessing ???]
+
+ [??? Should we add GetW, PutW, UpbW, etc ???]
[??? Should we add GetW, PutW, UpbW, etc ???]
[??? Should we add GetW, PutW, UpbW, etc ???]
+
+
+
+8.5. General X-Vector Operations
8.5. General X-Vector Operations
8.5. General X-Vector Operations
+
+
+ Size
Size _ _ ______ _______ ____
(Size X:x-vector): integer expr
+
+ _ ______
Size (upper bound) of x-vector.
+
+
+ Indx
Indx _ _ ______ _ _______ ___ ____
(Indx X:x-vector I:integer): any expr
+
+ _ ______
Access the I'th element of an x-vector.
+
+ [??? Rename to GetIndex, or some such ???]
[??? Rename to GetIndex, or some such ???]
[??? Rename to GetIndex, or some such ???]
+
+ Size
_ Size _
Generates a range error if I is outside the range 0 ... Size(X):
+
Strings and Vectors 7 February 1983 PSL Manual
+page 8.6 section 8.5
+
+ ***** Index is out of range
+
+
+ SetIndx
SetIndx _ _ ______ _ _______ _ ___ ___ ____
(SetIndx X:x-vector I:integer A:any): any expr
+
+ _
Store an appropriate value, A, as the I'th element of an
+ _ ______ _
x-vector. Generates a range error if I is outside the range
+ Size
Size _
0...Size(X):
+
+ ***** Index is out of range
+
+
+ Sub
Sub _ _ ______ __ _______ _ _______ _ ______ ____
(Sub X:x-vector I1:integer S:integer): x-vector expr
+
+ _ ______ __
Extract a subrange of an x-vector, starting at I1, producing a
+ Size Size
_ ______ Size _ ____ _ ______ Size ___
new x-vector of Size S. Note that an x-vector of Size 0 has one
+ entry.
+
+
+ SetSub
SetSub _ _ ______ __ _______ _ _______ _ _ ______ _ ______ ____
(SetSub X:x-vector I1:integer S:integer Y:x-vector): x-vector expr
+
+ _ _ _ __ _
Store subrange of Y of size S into X starting at I1. Returns Y.
+
+
+ SubSeq
SubSeq _ _ ______ __ _______ __ _______ _ ______ ____
(SubSeq X:x-vector LO:integer HI:integer): x-vector expr
+
+ Size
_ ______ Size __ __
Returns an x-vector of Size HI-LO-1, beginning with the element
+ _ __ _
of X with index LO. In other words, returns the subsequence of X
+ __ ____ ______ __
starting at LO and ending just before HI. For example,
+
+ (Setq A '[0 1 2 3 4 5 6])
+ (SubSeq A 4 6)
+
+ returns [4 5].
+
+
+ SetSubSeq
SetSubSeq _ _ ______ __ _______ __ _______ _ _ ______ _ _ ______ ____
(SetSubSeq X:x-vector LO:integer HI:integer Y:x-vector): Y:x-vector expr
+
+ Size
_ Size __ __
Y must be of Size HI-LO-1; it must also be of the same type of
+ _ ______ _ __ __ _
x-vector as X. Elements LO through HI-1 in X are replaced by
+ Size
Size _ _ _ _
elements 0 through Size(Y) of Y. Y is returned and X is changed
+ destructively. If A is "0123456" and B is "abcd", then
+
+ (SetSubSeq A 3 7 B)
+
+ returns "abcd". A is "012abcd" and B is unchanged.
+
+
+ Concat
Concat _ _ ______ _ _ ______ _ ______ ____
(Concat X:x-vector Y:x-vector): x-vector expr
+
+ _ ______
Concatenate 2 x-vectors. Currently they must be of same type.
PSL Manual 7 February 1983 Strings and Vectors
+section 8.5 page 8.7
+
+ [??? Should we do conversion to common type ???]
[??? Should we do conversion to common type ???]
[??? Should we do conversion to common type ???]
+
+
+ TotalCopy
TotalCopy _ ___ ___ ____
(TotalCopy S:any): any expr
+
+ Returns a unique copy of entire structure, i.e., it copies
+ everything for which storage is allocated - everything but inums
+ Copy TotalCopy
Copy TotalCopy
and ids. Like Copy (Chapter 7)TotalCopy will not terminate when
+ applied to circular structures.
+
+
+
+8.6. Arrays
8.6. Arrays
8.6. Arrays
+
+ _____
_____
_____
macro
macro
Arrays do not exist in PSL as distinct data-types; rather an array macro
+package is anticipated for declaring and managing multi-dimensional arrays
+ ____ _________ ____
of items, characters and words, by mapping them onto one dimensional
+vectors.
+
+ [??? What operations, how to map, and what sort of checking ???]
[??? What operations, how to map, and what sort of checking ???]
[??? What operations, how to map, and what sort of checking ???]
+
+
+
+8.7. Common LISP String Functions
8.7. Common LISP String Functions
8.7. Common LISP String Functions
+
+ A Common LISP compatible package of string and character functions has
+been implemented in PSL, obtained by LOADing the STRINGS module. The
+following functions are defined from Chapters 13 and 14 of the Common LISP
+ Char String
Char String
manual [Steele 81]. Char and String are not defined because of PSL
+functions with the same name.
+
+ Common LISP provides a character data type in which every character
+object has three attributes: code, bits, and font. The bits attribute
+allows extra flags to be associated with a character. The font attribute
+permits a specification of the style of the glyphs (such as italics). PSL
+does not support nonzero bit and font attributes. Because of this some of
+the Common LISP character functions described below have no affect or are
+not very useful as implemented in PSL. They are present for compatibility.
+
+ Recall that in PSL a character is represented as its code, a number in
+the range 0...127. For an argument to the following character functions
+ Char
Char
give the code or use the Char function or the sharp-sign macros in Chapter
+17.
+
+
+ Standard!-CharP
Standard!-CharP _ _________ _______ ____
(Standard!-CharP C:character): boolean expr
+
+ Returns T if the argument is a "standard character", that is, one
+ of the ninety-five ASCII printing characters or <return>.
Strings and Vectors 7 February 1983 PSL Manual
+page 8.8 section 8.7
+
+ (Standard-CharP (Char A)) returns T
+ (Standard-CharP (Char !^A)) returns NIL
+
+
+ GraphicP
GraphicP _ _________ _______ ____
(GraphicP C:character): boolean expr
+
+ _
Returns T if C is a printable character and NIL if it is a
+ non-printable (formatting or control) character. The space
+ character is assumed to be graphic.
+
+
+ String!-CharP
String!-CharP _ _________ _______ ____
(String!-CharP C:character): boolean expr
+
+ _
Returns T if C is a character that can be an element of a string.
+ Standard-Charp Graphicp
Standard-Charp Graphicp
Any character that satisfies Standard-Charp and Graphicp also
+ String-Charp
String-Charp
satisfies String-Charp.
+
+
+ AlphaP
AlphaP _ _________ _______ ____
(AlphaP C:character): boolean expr
+
+ _
Returns T if C is an alphabetic character.
+
+
+ UpperCaseP
UpperCaseP _ _________ _______ ____
(UpperCaseP C:character): boolean expr
+
+ _
Returns T if C is an upper case letter.
+
+
+ LowerCaseP
LowerCaseP _ _________ _______ ____
(LowerCaseP C:character): boolean expr
+
+ _
Returns T if C is a lower case letter.
+
+
+ BothCaseP
BothCaseP _ _________ _______ ____
(BothCaseP C:character): boolean expr
+
+ AlphaP
AlphaP
In PSL this function is the same as AlphaP.
+
+
+ DigitP
DigitP _ _________ _______ ____
(DigitP C:character): boolean expr
+
+ _
Returns T if C is a digit character (optional radix not
+ supported).
+
+
+ AlphaNumericP
AlphaNumericP _ _________ _______ ____
(AlphaNumericP C:character): boolean expr
+
+ _
Returns T if C is a digit or an alphabetic.
PSL Manual 7 February 1983 Strings and Vectors
+section 8.7 page 8.9
+
+ Char!=
Char!= __ _________ __ _________ _______ ____
(Char!= C1:character C2:character): boolean expr
+
+ __ __
Returns T if C1 and C2 are the same in all three attributes.
+
+
+ Char!-Equal
Char!-Equal __ _________ __ _________ _______ ____
(Char!-Equal C1:character C2:character): boolean expr
+
+ __ __
Returns T if C1 and C2 are similar. Differences in case, bits,
+ or font are ignored by this function.
+
+
+ Char!<
Char!< __ _________ __ _________ _______ ____
(Char!< C1:character C2:character): boolean expr
+
+ __ __
Returns T if C1 is strictly less than C2.
+
+
+ Char!>
Char!> __ _________ __ _________ _______ ____
(Char!> C1:character C2:character): boolean expr
+
+ __ __
Returns T if C1 is strictly greater than C2.
+
+
+ Char!-LessP
Char!-LessP __ _________ __ _________ _______ ____
(Char!-LessP C1:character C2:character): boolean expr
+
+ Char!<
Char!<
Like Char!< but ignores differences in case, fonts, and bits.
+
+
+ Char!-GreaterP
Char!-GreaterP __ _________ __ _________ _______ ____
(Char!-GreaterP C1:character C2:character): boolean expr
+
+ Char!>
Char!>
Like Char!> but ignores differences in case, fonts, and bits.
+
+
+ Char!-Code
Char!-Code _ _________ _________ ____
(Char!-Code C:character): character expr
+
+ _
Returns the code attribute of C. In PSL this function is an
+ identity function.
+
+
+ Char!-Bits
Char!-Bits _ _________ _______ ____
(Char!-Bits C:character): integer expr
+
+ _
Returns the bits attribute of C, which is always 0 in PSL.
+
+
+ Char!-Font
Char!-Font _ _________ _______ ____
(Char!-Font C:character): integer expr
+
+ _
Returns the font attribute of C, which is always 0 in PSL.
+
+
+ Code!-Char
Code!-Char _ _______ _________ ___ ____
(Code!-Char I:integer): {character,nil} expr
+
+ The purpose of this function is to be able to construct a
+ character by specifying the code, bits, and font. Because bits
+ Code!-Char
Code!-Char
and font attributes are not used in PSL, Code!-Char is an
Strings and Vectors 7 February 1983 PSL Manual
+page 8.10 section 8.7
+
+ identity function.
+
+
+ Character
Character _ _________ ______ __ _________ ____
(Character C:{character, string, id}): character expr
+
+ _ _ _
Attempts to coerce C to be a character. If C is a character, C
+ _
is returned. If C is a string, then the first character of the
+ _
string is returned. If C is a symbol, the first character of the
+ symbol is returned. Otherwise an error occurs.
+
+
+ Char!-UpCase
Char!-UpCase _ _________ _________ ____
(Char!-UpCase C:character): character expr
+
+ LowerCaseP Char-UpCase
LowerCaseP _ Char-UpCase
If LowerCaseP(C) is true, then Char-UpCase returns the code of
+ _ _
the upper case of C. Otherwise it returns the code of C.
+
+
+ Char!-DownCase
Char!-DownCase _ _________ _________ ____
(Char!-DownCase C:character): character expr
+
+ UpperCaseP Char-DownCase
UpperCaseP _ Char-DownCase
If UpperCaseP(C) is true, then Char-DownCase returns the code of
+ _ _
the lower case of C. Otherwise it returns the code of C.
+
+
+ Digit!-Char
Digit!-Char _ _________ _______ ____
(Digit!-Char C:character): integer expr
+
+ _ _
Converts character to its code if C is a one-digit number. If C
+ _
is larger than one digit, NIL is returned. If C is not numeric,
+ an error message is caused.
+
+
+ Char!-Int
Char!-Int _ _________ _______ ____
(Char!-Int C:character): integer expr
+
+ Converts character to integer. This is the identity operation in
+ PSL.
+
+
+ Int!-Char
Int!-Char _ _______ _________ ____
(Int!-Char I:integer): character expr
+
+ Converts integer to character. This is the identity operation in
+ PSL.
+
+ The string functions follow.
+
+
+ RplaChar
RplaChar _ ______ _ _______ _ _________ _________ ____
(RplaChar S:string I:integer C:character): character expr
+
+ _ _ _
Store a character C in a string S at position I.
PSL Manual 7 February 1983 Strings and Vectors
+section 8.7 page 8.11
+
+ String!=
String!= __ ______ __ ______ _______ ____
(String!= S1:string S2:string): boolean expr
+
+ __ __
Compares two strings S1 and S2, case sensitive. (Substring
+ options not implemented).
+
+
+ String!-Equal
String!-Equal __ ______ __ ______ _______ ____
(String!-Equal S1:string S2:string): boolean expr
+
+ __ __
Compare two strings S1 and S2, ignoring case, bits and font.
+
+ _____ _______
The following string comparison functions are extra-boolean. If the
+comparison results in a value of T, the first position of inequality in the
+strings is returned.
+
+
+ String!<
String!< __ ______ __ ______ _____ _______ ____
(String!< S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case sensitive.
+
+
+ String!>
String!> __ ______ __ ______ _____ _______ ____
(String!> S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case sensitive.
+
+
+ String!<!=
String!<!= __ ______ __ ______ _____ _______ ____
(String!<!= S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case sensitive.
+
+
+ String!>!=
String!>!= __ ______ __ ______ _____ _______ ____
(String!>!= S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case sensitive.
+
+
+ String!<!>
String!<!> __ ______ __ ______ _____ _______ ____
(String!<!> S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case sensitive.
+
+
+ String!-LessP
String!-LessP __ ______ __ ______ _____ _______ ____
(String!-LessP S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case differences are
+ ignored.
+
+
+ String!-GreaterP
String!-GreaterP __ ______ __ ______ _____ _______ ____
(String!-GreaterP S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case differences are
+ ignored.
Strings and Vectors 7 February 1983 PSL Manual
+page 8.12 section 8.7
+
+ String!-Not!-GreaterP
String!-Not!-GreaterP __ ______ __ ______ _____ _______ ____
(String!-Not!-GreaterP S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case differences are
+ ignored.
+
+
+ String!-Not!-LessP
String!-Not!-LessP __ ______ __ ______ _____ _______ ____
(String!-Not!-LessP S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case differences are
+ ignored.
+
+
+ String!-Not!-Equal
String!-Not!-Equal __ ______ __ ______ _____ _______ ____
(String!-Not!-Equal S1:string S2:string): extra-boolean expr
+
+ Lexicographic comparison of strings. Case differences are
+ ignored.
+
+
+ String!-Repeat
String!-Repeat _ ______ _ _______ ______ ____
(String!-Repeat S:string I:integer): string expr
+
+ _ _
Appends copy of S to itself total of I-1 times.
+
+
+ String!-Trim
String!-Trim ___ ____ ______ _ ______ ______ ____
(String!-Trim BAG:{list, string} S:string): string expr
+
+ ___ _
Remove leading and trailing characters in BAG from a string S.
+
+
+ (String-Trim "ABC" "AABAXYZCB") returns "XYZ"
+ (String-Trim (List (Char A) (Char B) (Char C))
+ "AABAXYZCB")
+ returns "XYZ"
+ (String-Trim '(65 66 67) "ABCBAVXZCC") returns "VXZ"
+
+
+ String!-Left!-Trim
String!-Left!-Trim ___ ____ ______ _ ______ ______ ____
(String!-Left!-Trim BAG:{list, string} S:string): string expr
+
+ Remove leading characters from string.
+
+
+ String!-Right!-Trim
String!-Right!-Trim ___ ____ ______ _ ______ ______ ____
(String!-Right!-Trim BAG:{list, string} S:string): string expr
+
+ Remove trailing characters from string.
+
+
+ String!-UpCase
String!-UpCase _ ______ ______ ____
(String!-UpCase S:string): string expr
+
+ Copy and raise all alphabetic characters in string.
PSL Manual 7 February 1983 Strings and Vectors
+section 8.7 page 8.13
+
+ NString!-UpCase
NString!-UpCase _ ______ ______ ____
(NString!-UpCase S:string): string expr
+
+ Destructively raise all alphabetic characters in string.
+
+
+ String!-DownCase
String!-DownCase _ ______ ______ ____
(String!-DownCase S:string): string expr
+
+ Copy and lower all alphabetic characters in string.
+
+
+ NString!-DownCase
NString!-DownCase _ ______ ______ ____
(NString!-DownCase S:string): string expr
+
+ Destructively lower all alphabetic characters in string.
+
+
+ String!-Capitalize
String!-Capitalize _ ______ ______ ____
(String!-Capitalize S:string): string expr
+
+ Copy and raise first letter of all words in string; other letters
+ in lower case.
+
+
+ NString!-Capitalize
NString!-Capitalize _ ______ ______ ____
(NString!-Capitalize S:string): string expr
+
+ Destructively raise first letter of all words; other letters in
+ lower case.
+
+
+ String!-to!-List
String!-to!-List _ ______ ____ ____
(String!-to!-List S:string): list expr
+
+ Unpack string characters into a list.
+
+
+ String!-to!-Vector
String!-to!-Vector _ ______ ______ ____
(String!-to!-Vector S:string): vector expr
+
+ Unpack string characters into a vector.
+
+
+ SubString
SubString _ ______ __ _______ __ _______ ______ ____
(SubString S:string LO:integer HI:integer): string expr
+
+ SubSeq
SubSeq ______
Same as SubSeq, but the first argument must be a string. Returns
+ Size
_ Size __ __
a substring of S of Size HI - LO - 1, beginning with the element
+ __
with index LO.
+
+
+ String!-Length
String!-Length _ ______ _______ ____
(String!-Length S:string): integer expr
+
+ Last index of a string, plus one.
ADDED psl-1983/3-1/lpt/09-flowofcontrol.lpt
Index: psl-1983/3-1/lpt/09-flowofcontrol.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/09-flowofcontrol.lpt
@@ -0,0 +1,992 @@
+PSL Manual 7 February 1983 Flow Of Control
+section 9.0 page 9.1
+
+ CHAPTER 9
CHAPTER 9
CHAPTER 9
+ FLOW OF CONTROL
FLOW OF CONTROL
FLOW OF CONTROL
+
+
+
+
+ 9.1. Introduction . . . . . . . . . . . . . . . 9.1
+ 9.2. Conditionals . . . . . . . . . . . . . . . 9.1
+ 9.2.1. Conds and Ifs. . . . . . . . . . . . . 9.1
+ 9.2.2. The Case Statement . . . . . . . . . . . 9.3
+ 9.3. Sequencing Evaluation . . . . . . . . . . . . 9.4
+ 9.4. Iteration . . . . . . . . . . . . . . . . 9.7
+ 9.4.1. For . . . . . . . . . . . . . . . . 9.8
+ 9.4.2. Mapping Functions . . . . . . . . . . . 9.13
+ 9.4.3. Do . . . . . . . . . . . . . . . . 9.16
+ 9.5. Non-Local Exits . . . . . . . . . . . . . . 9.18
+
+
+
+
+9.1. Introduction
9.1. Introduction
9.1. Introduction
+
+ Most of the constructs presented in this Chapter have a special syntax in
+RLISP. This syntax is presented along with the definitions of the
+underlying functions. Many of the examples are presented using this
+special RLISP syntax as well as LISP.
+
+
+
+9.2. Conditionals
9.2. Conditionals
9.2. Conditionals
+
+
+9.2.1. Conds and Ifs
9.2.1. Conds and Ifs
9.2.1. Conds and Ifs
+
+
+ Cond
Cond _ ____ ____ ___ ____ ________ _____
(Cond [U:form-list]): any open-compiled, fexpr
+
+ Cond If
Cond If
The LISP function Cond corresponds to the If statement of most
+ If
If
programming languages. In RLISP this is simply the familiar If
+ Then Else
Then Else
... Then ... Else construct. For example:
+
+ _________ ______
IF predicate THEN action1
+ ______
ELSE action2
+
+ _________ ______
==> (COND (predicate action1)
+ ______
(T action2))
+
+ ______ _________
Action1 is evaluated if the predicate has a non-NIL evaluation;
+ Else
______ Else
otherwise, action2 is evaluated. Dangling Elses are resolved in
+ Then
Then
the ALGOL manner by pairing them with the nearest preceding Then.
+ For example:
Flow Of Control 7 February 1983 PSL Manual
+page 9.2 section 9.2
+
+ IF F(X) THEN
+ IF G(Y) THEN PRINT(X)
+ ELSE PRINT(Y);
+
+ is equivalent to
+
+ IF F(X) THEN
+ << IF G(Y) THEN PRINT(X)
+ ELSE PRINT(Y) >>;
+
+ Note that if F(X) is NIL, nothing is printed.
+
+ Taken simply as a function, without RLISP syntax, the arguments
+ Cond
Cond
to Cond have the form:
+
+ _________ ______ ______
(COND (predicate action action ...)
+ _________ ______ ______
(predicate action action ...)
+ ...
+ _________ ______ ______
(predicate action action ...) )
+
+ The predicates are evaluated in the order of their appearance
+ until a non-NIL value is encountered. The corresponding actions
+ are evaluated and the value of the last becomes the value of the
+ Cond Else
Cond Else
Cond. The dangling Else example above is:
+
+ (COND ((F X) (COND ((G X) (PRINT X))
+ ( T (PRINT Y)) ) ))
+
+ Go Return
Go Return
The actions may also contain the special functions Go, Return,
+ Exit Next
Exit Next
Exit, and Next, subject to the constraints on placement of these
+ Cond
Cond
functions given in Section 9.3. In these cases, Cond does not
+ have a defined value, but rather an effect. If no predicate is
+ Cond
Cond
non-NIL, the value of Cond is NIL.
+
+ The following MACROs are defined in the USEFUL module for convenience,
+and are mostly used from LISP syntax:
+
+
+ If
If _ ____ __ ____ _ ____ ___ _____
(If E:form S0:form [S:form]): any macro
+
+ If Cond
If Cond
If is a macro to simplify the writing of a common form of Cond in
+ which there are only two clauses and the antecedent of the second
+ is T. It cannot be used in RLISP syntax.
+
+ (IF E S0 S1...Sn)
+
+ __ _
The then-clause S0 is evaluated if and only if the test E is
+ _
non-NIL, otherwise the else-clauses Si are evaluated, and the
+ last returned. There may be no else-clauses.
+
+ Related macros for common COND forms are WHEN and UNLESS.
PSL Manual 7 February 1983 Flow Of Control
+section 9.2 page 9.3
+
+ When
When _ ____ _ ____ ___ _____
(When E:form [S:form]): any macro
+
+ (WHEN E S1 S2 ... Sn)
+
+ evaluates the Si and returns the value of Sn if and only if the
+ When
_ When
test E is non-NIL. Otherwise When returns NIL.
+
+
+ Unless
Unless _ ____ _ ____ ___ _____
(Unless E:form [U:form]): any macro
+
+ (UNLESS E S1 S2 ... Sn)
+
+ _
Evaluates the Si if and only if the test E is NIL. It is
+ equivalent to
+
+ (WHEN (NOT E) S1 S2 ... Sn)
+
+ And Or
And Or
While And and Or are primarily of interest as Boolean connectives, they
+are often used in LISP as conditionals. For example,
+
+ (AND (FOO) (BAR) (BAZ))
+
+has the same result as
+
+ (COND ((FOO) (COND ((BAR) (BAZ)))))
+
+See Section 4.2.3.
+
+
+9.2.2. The Case Statement
9.2.2. The Case Statement
9.2.2. The Case Statement
+
+ PSL provides a numeric case statement, that is compiled quite
+efficiently; some effort is made to examine special cases (compact vs. non
+compact sets of cases, short vs. long sets of cases, etc.). It has mostly
+been used in SYSLISP mode, but can also be used from LISP mode provided
+that case-tags are numeric. There is also an FEXPR, CASE, for the
+interpreter.
+
+ The RLISP syntax is:
+
+
+Case-Statement ::= CASE expr OF case-list END
+
+Case-list ::= Case-expr [; Case-list ]
+
+Case-expr ::= Tag-expr : expr
+
+tag-expr ::= DEFAULT | OTHERWISE |
+ tag | tag, tag ... tag |
+ tag TO tag
+
+Tag ::= Integer | Wconst-Integer
Flow Of Control 7 February 1983 PSL Manual
+page 9.4 section 9.2
+
+
+For example:
+
+ CASE i OF
+ 1: Print("First");
+ 2,3: Print("Second");
+ 4 to 10: Print("Third");
+ Default: Print("Fourth");
+ END
+
+
+
+ The RLISP syntax parses into the following LISP form:
+
+
+ Case
Case _ ____ _ ____ ____ ___ ____ ________ _____
(Case I:form [U:case-list]): any open-compiled, fexpr
+
+ _ _______
I is meant to evaluate to an integer, and is used as a selector
+ _
amongst the various Us. Each case-list has the form (case-expr
+ form) where case-expr has the form:
+
+ NIL -> default case
+ (I1 I2 ... In) -> where each Ik is an integer or
+ (RANGE low high)
+
+ The above example becomes:
+
+ (CASE i ((1) (Print "First"))
+ ((2 3) (Print "Second"))
+ (((Range 4 10)) (Print "Third"))
+ ( NIL (Print "Fourth")))
+
+ [??? Perhaps we should move SELECTQ (and define a SELECT) from the
[??? Perhaps we should move SELECTQ (and define a SELECT) from the
[??? Perhaps we should move SELECTQ (and define a SELECT) from the
+ COMMON module to the basic system ???]
COMMON module to the basic system ???]
COMMON module to the basic system ???]
+
+ .
+
+
+
+9.3. Sequencing Evaluation
9.3. Sequencing Evaluation
9.3. Sequencing Evaluation
+
+ These functions provide for explicit control sequencing, and the
+definition of blocks altering the scope of local variables.
+
+
+ ProgN
ProgN _ ____ ___ ____ ________ _____
(ProgN [U:form]): any open-compiled, fexpr
+
+ _
U is a set of expressions which are executed sequentially. The
+ value returned is the value of the last expression.
PSL Manual 7 February 1983 Flow Of Control
+section 9.3 page 9.5
+
+ Prog2
Prog2 _ ____ _ ____ ___ ____ ________ ____
(Prog2 A:form B:form): any open-compiled, expr
+
+ _
Returns the value of B (the second argument).
+
+ [??? Redefine prog2 to take N arguments, return second. ???]
[??? Redefine prog2 to take N arguments, return second. ???]
[??? Redefine prog2 to take N arguments, return second. ???]
+
+
+ Prog1
Prog1 _ ____ ___ _____
(Prog1 [U:form]): any macro
+
+ Prog1
Prog1
Prog1 is a function defined in the USEFUL package; to use it,
+ Prog1
Prog1
type (LOAD USEFUL). Prog1 evaluates its arguments in order, like
+ ProgN
ProgN
ProgN, but returns the value of the first.
+
+
+ Prog
Prog ____ __ ____ _______ __ ____ ___ ____ ________ _____
(Prog VARS:id-list [PROGRAM:{id,form}]): any open-compiled, fexpr
+
+ Prog
____ ____ __ Prog
VARS is a list of ids which are considered FLUID if the Prog is
+ interpreted and LOCAL if compiled (see the "Variables and
+ Prog
Prog
Bindings" Section, 10.2). The Prog's variables are allocated
+ Prog
Prog
space if the Prog form is applied, and are deallocated if the
+ Prog Prog
Prog Prog
Prog is exited. Prog variables are initialized to NIL. The
+ _______
PROGRAM is a set of expressions to be evaluated in order of their
+ Prog
Prog __________
appearance in the Prog function. identifiers appearing in the
+ _______
top level of the PROGRAM are labels which can be referred to by
+ Go Prog
Go Prog
Go. The value returned by the Prog function is determined by a
+ Return Prog
Return Prog
Return function or NIL if the Prog "falls through".
+
+ There are restrictions as to where a number of control functions, such as
+Go Return
Go Return
Go and Return, may be placed. This is so that they may have only locally
+determinable effects. Unlike most LISPs, which make this restriction only
+in compiled code, PSL enforces this restriction uniformly in both compiled
+and interpreted code. Not only does this help keep the semantics of
+compiled and interpreted code the same, but we believe it leads to more
+readable programs. For cases in which a non-local exit is truly required,
+ Catch Throw
Catch Throw
there are the functions Catch and Throw, described in Section 9.5.
+
+ Go Return Exit Next
Go Return Exit Next
The functions so restricted are Go, Return, Exit, and Next. They must be
+placed at top-level within the surrounding control structure to which they
+ Prog Return
Prog Return
refer (e.g. the Prog which Return causes to be terminated), or nested
+within only selected functions. The functions in which they may be nested
+(to arbitrary depth) are:
+ ProgN
ProgN
- ProgN (compound statement)
+ Cond
Cond
- actions of Conds (if then else)
+ Case
Case
- actions in Cases
+
+
+ Go
Go _____ __ ____ ________ ____ ________ _____
(Go LABEL:id): None Returned open-compiled, fexpr
+
+ Go Prog
Go Prog
Go alters the normal flow of control within a Prog function. The
+ Prog
Prog
next statement of a Prog function to be evaluated is immediately
+ Go
_____ Go
preceded by LABEL. A Go may appear only in the following
+ situations:
Flow Of Control 7 February 1983 PSL Manual
+page 9.6 section 9.3
+
+ Prog
Prog _____
a. At the top level of a Prog referring to a LABEL that also
+ Prog
Prog
appears at the top level of the same Prog.
+ Cond
Cond
b. As the action of a Cond item
+
+
+ Prog
Prog
i. appearing on the top level of a Prog.
+ Cond
Cond
ii. which appears as the action of a Cond item to any
+ level.
+
+
+ ProgN
ProgN
c. As the last statement of a ProgN
+
+
+ Prog
Prog
i. which appears at the top level of a Prog or in a
+ ProgN Cond
ProgN Cond
ProgN appearing in the action of a Cond to any level
+ subject to the restrictions of b.i, or b.ii.
+ ProgN Cond ProgN
ProgN Cond ProgN
ii. within a ProgN or as the action of a Cond in a ProgN
+ to any level subject to the restrictions of b.i,
+ b.ii, and c.i.
+
+
+ Prog
_____ Prog
If LABEL does not appear at the top level of the Prog in which
+ Go
Go
the Go appears, an error occurs:
+
+ ***** LABEL is not a label within the current scope
+
+ Go
Go
If the Go has been placed in a position not defined by rules a-c,
+ another error is detected:
+
+ ***** Illegal use of GO To LABEL
+
+
+ Return
Return _ ____ ____ ________ ____ ________ ____
(Return U:form): None Returned open-compiled, expr
+
+ Prog Return Prog
Prog Return Prog
Within a Prog, Return terminates the evaluation of a Prog and
+ Prog
_ Prog
returns U as the value of the Prog. The restrictions on the
+ Return Go
Return Go
placement of Return are exactly those of Go. Improper placement
+ Return
Return
of Return results in the error:
+
+ ***** Illegal use of RETURN
+
+
+
+9.4. Iteration
9.4. Iteration
9.4. Iteration
+
+
+ While
While _ ____ _ ____ ___ _____
(While E:form [S:form]): NIL macro
+
+ This is the most commonly used construct for indefinite iteration
+ _ _
in LISP. E is evaluated; if non-NIL, the S's are evaluated from
+ _
left to right and then the process is repeated. If E evaluates
+ While Exit
While Exit
to NIL the While returns NIL. Exit may be used to terminate the
PSL Manual 7 February 1983 Flow Of Control
+section 9.4 page 9.7
+
+ While Next
While Next
While from within the body and to return a value. Next may be
+ used to terminate the current iteration. In RLISP syntax this is
+ While Do
While Do
While ... Do ... . Note that in RLISP syntax there may be only a
+ Do ProgN
Do ProgN
single expression after the Do; however, it may be a ProgN
+ delimited by <<...>>. That is,
+
+ (While E S1 S2)
+
+ should be written in RLISP as
+
+ While E do <<S1; S2>>;
+
+
+ Repeat
Repeat _ ____ _ ____ ___ _____
(Repeat E:form [S:form]): NIL macro
+
+ _ _
The S's are evaluated left to right, and then E is evaluated.
+ Repeat
_ Repeat
This is repeated until the value of E is NIL, if Repeat returns
+ Next Exit
Next Exit _
NIL. Next and Exit may be used in the S's branch to the next
+ Repeat
Repeat
iteration of a Repeat or to terminate one and possibly return a
+ Go Return
Go Return _
value. Go, and Return may appear in the S's. The RLISP syntax
+ Repeat Repeat Until While
Repeat Repeat Until While
for Repeat is Repeat Until. Like While, RLISP syntax only allows
+ _
a single S, so
+
+ (REPEAT E S1 S2)
+
+ should be written in RLISP as
+
+ REPEAT << S1; S2 >> UNTIL E;
+
+ [??? maybe do REPEAT S1 ... Sn E ???]
[??? maybe do REPEAT S1 ... Sn E ???]
[??? maybe do REPEAT S1 ... Sn E ???]
+
+
+ Next
Next ____ ________ ____ ________ __________ _____
(Next ): None Returned open-compiled, restricted, macro
+
+ This terminates the current iteration of the most closely
+ While Repeat
While Repeat
surrounding While or Repeat, and causes the next to commence.
+ See the note in Section 9.3 about the lexical restrictions on
+ GO
GO
placement of this construct, which is essentially a GO to a
+ special label placed at the front of a loop construct.
+
+
+ Exit
Exit _ ____ ____ ________ ____ ________ __________ _____
(Exit [U:form]): None Returned open-compiled,restricted, macro
+
+ _
The U's are evaluated left to right, the most closely surrounding
+ While Repeat
While Repeat _
While or Repeat is terminated, and the value of the last U is
+ returned. With no arguments, NIL is returned. See the note in
+ Section 9.3 about the lexical restrictions on placement of this
+ Return
Return
construct, which is essentially a Return.
+
+ While Repeat Prog Next Exit
While Repeat Prog Next Exit
While and Repeat each macro expand into a Prog; Next and Exit are macro
+ Go Return Prog
Go Return Prog
expanded into a Go and a Return respectively to this Prog. Thus using a
+Next Exit Prog While Repeat
Next Exit Prog While Repeat
Next or an Exit within a Prog within a While or Repeat will result only in
Flow Of Control 7 February 1983 PSL Manual
+page 9.8 section 9.4
+
+ Prog
Prog
an exit of the internal Prog. In RLISP be careful to use
+
+ WHILE E DO << S1;...;EXIT(1);...;Sn>>
+
+not
+
+ WHILE E DO BEGIN S1;...;EXIT(1);...;Sn;END;
+
+
+9.4.1. For
9.4.1. For
9.4.1. For
+
+ For
For
A simple For construct is available in the basic PSL system and RLISP; an
+extended form can obtained by loading USEFUL. It is planned to make the
+extended form the version available in the basic system, combining all the
+ FOR ForEach For
FOR ForEach For
features of FOR and ForEach. The basic PSL For provides only the (FROM ..)
+ ForEach
ForEach
iterator, and (DO ...) action clause, and uses the ForEach construct for
+some of the (IN ...) and (ON ...) iterators. Most PSL syntax users should
+ For
For
use the full For construct.
+
+
+ For
For _ ____ ___ _____
(For [S:form]): any macro
+
+ For
For
The arguments to For are clauses; each clause is itself a list of
+ a keyword and one or more arguments. The clauses may introduce
+ local variables, specify return values and when the iteration
+ should cease, have side-effects, and so on. Before going
+ further, it is probably best to give some examples.
+
+ (FOR (FROM I 1 10 2) (DO (PRINT I)))
+ Prints the numbers 1 3 5 7 9
+
+ (FOR (IN U '(A B C)) (DO (PRINT U)))
+ Prints the letters A B C
+
+ (FOR (ON U '(A B C)) (DO (PRINT U)))
+ Prints the lists (A B C) (B C) and (C)
+
+ Finally, the function
+ (DE ZIP (X Y)
+ (FOR (IN U X) (IN V Y)
+ (COLLECT (LIST U V))))
+
+ produces a list of 2 element lists, each consisting of the the
+ corresponding elements of the three lists X, Y and Z. For
+ example,
+
+ (ZIP '(1 2 3 4) '(A B C) )
+
+ produces
PSL Manual 7 February 1983 Flow Of Control
+section 9.4 page 9.9
+
+ ((1 a)(2 b)(3 c))
+
+ The iteration terminates as soon as one of the (IN ..) clauses is
+ exhausted.
+
+ Note that the (IN ... ), (ON ...) and (FROM ...) clauses
+ introduce local variables U, V or I, that are referred to in the
+ action clause.
+
+ All the possible clauses are described below. The first few
+ introduce iteration variables. Most of these also give some
+ means of indicating when iteration should cease. For example, if
+ In
____ In
a list being mapped over by an In clause is exhausted, iteration
+ For
For
must cease. If several such clauses are given in For expression,
+ iteration ceases when one of the clauses indicates it should,
+ whether or not the other clauses indicate that it should cease.
+
+
+ (IN V1 V2)
+ ____
assigns the variable V1 successive elements of the list
+ V2.
+
+ This may take an additional, optional argument: a
+ function to be applied to the extracted element or
+ sublist before it is assigned to the variable. The
+ following returns the sum of the lengths of all the
+ elements of L.
+
+ [??? Rather a kludge -- not sure why this is here.
[??? Rather a kludge -- not sure why this is here.
[??? Rather a kludge -- not sure why this is here.
+ Perhaps it should come out again. ???]
Perhaps it should come out again. ???]
Perhaps it should come out again. ???]
+
+ (DE LENGTHS (L)
+ (FOR (IN N L LENGTH)
+ (COLLECT (LIST N N)))
+
+ is the same as
+
+ (DE LENGTHS (L)
+ (FOR (IN N L)
+ (COLLECT
+ (LIST (LENGTH N) (LENGTH N))))
+ )
+
+ but only calls LENGTH once. Using the (WITH ..) form to
+ introduce a local LN may be clearer.
+
+ For example,
+ (SUMLENGTHS
+ '((1 2 3 4 5)(a b c)(x y)))
+ is
+ ((5 5) (3 3) (2 2))
Flow Of Control 7 February 1983 PSL Manual
+page 9.10 section 9.4
+
+ (ON V1 V2)
+ Cdr
Cdr ____
assigns the variable V1 successive Cdrs of the list V2.
+
+ (FROM VAR INIT FINAL STEP)
+ is a numeric iteration clause. The variable is first
+ assigned INIT, and then incremented by step until it is
+ larger than FINAL. INIT, FINAL, and STEP are optional.
+ INIT and STEP both default to 1, and if FINAL is
+ omitted the iteration continues until stopped by some
+ other means. To specify a STEP with INIT or FINAL
+ omitted, or a FINAL with INIT omitted, place NIL (the
+ constant -- it cannot be an expression) in the
+ appropriate slot to be omitted. FINAL and STEP are
+ only evaluated once.
+
+ (FOR VAR INIT NEXT)
+ assigns the variable INIT first, and subsequently the
+ value of the expression NEXT. INIT and NEXT may be
+ omitted. Note that this is identical to the behavior
+ Do
Do
of iterators in a Do.
+
+ (WITH V1 V2 ... Vn)
+ introduces N locals, initialized to NIL. In addition,
+ each Vi may also be of the form (VAR INIT), in which
+ case it is initialized to INIT.
+
+ (DO S1 S2 ... Sn)
+ causes the Si's to be evaluated at each iteration.
+
+
+ There are two clauses which allow arbitrary code to be executed
+ before the first iteration, and after the last.
+
+
+ (INITIALLY S1 S2 ... Sn)
+ causes the Si's to be evaluated in the new environment
+ (i.e. with the iteration variables bound to their
+ initial values) before the first iteration.
+
+ (FINALLY S1 S2 ... Sn)
+ causes the Si's to be evaluated just before the
+ function returns.
+
+
+ The next few clauses build up return types. Except for the
+ RETURNS/RETURNING clause, they may each take an additional
+ argument which specifies that instead of returning the
+ appropriate value, it is accumulated in the specified variable.
+ For example, an unzipper might be defined as
PSL Manual 7 February 1983 Flow Of Control
+section 9.4 page 9.11
+
+ (DE UNZIP (L)
+ (FOR (IN U L) (WITH X Y)
+ (COLLECT (FIRST U) X)
+ (COLLECT (SECOND U) Y)
+ (RETURNS (LIST X Y))))
+
+ Zip
Zip ____
This is essentially the opposite of Zip. Given a list of 2
+ ____ ____ ____
element lists, it unzips them into 2 lists, and returns a list of
+ ____
those 2 lists. For example, (unzip '((1 a)(2 b)(3 c))) returns
+ is ((1 2 3)(a b c)).
+
+
+ (RETURNS EXP)
+ For
For
causes the given expression to be the value of the For.
+ Returning is synonymous with returns. It may be given
+ additional arguments, in which case they are evaluated
+ in order and the value of the last is returned
+ ProgN
ProgN
(implicit ProgN).
+
+ (COLLECT EXP)
+ causes the successive values of the expression to be
+ Append
____ Append
collected into a list. Each value is Appended to the
+ ____
end of the list.
+
+ (UNION EXP)
+ ____
is similar, but only adds an element to the list if it
+ is not equal to anything already there.
+
+ (CONC EXP)
+ NConc
NConc
causes the successive values to be NConc'd together.
+
+ (JOIN EXP)
+ causes them to be appended.
+
+ (COUNT EXP)
+ returns the number of times EXP was non-NIL.
+
+ (SUM EXP), (PRODUCT EXP), (MAXIMIZE EXP), and (MINIMIZE EXP)
+ do the obvious. Synonyms are summing, maximizing, and
+ minimizing.
+
+ (ALWAYS EXP)
+ returns T if EXP is non-NIL on each iteration. If EXP
+ is ever NIL, the loop terminates immediately, no
+ epilogue code, such as that introduced by finally is
+ run, and NIL is returned.
+
+ (NEVER EXP)
+ is equivalent to (ALWAYS (NOT EXP)).
+
+ (WHILE EXP) and (UNTIL EXP)
+ Explicit tests for the end of the loop may be given
Flow Of Control 7 February 1983 PSL Manual
+page 9.12 section 9.4
+
+ using (WHILE EXP). The loop terminates if EXP becomes
+ NIL at the beginning of an iteration. (UNTIL EXP) is
+ While Until
While Until
equivalent to (WHILE (NOT EXP)). Both While and Until
+ may be given additional arguments; (WHILE E1 E2 ... En)
+ is equivalent to (WHILE (AND E1 E2 ... En)) and
+ (UNTIL E1 E2 ... En) is equivalent to
+ (UNTIL (OR E1 E2 ... En)).
+
+ (WHEN EXP)
+ causes a jump to the next iteration if EXP is NIL.
+
+ (UNLESS EXP)
+ is equivalent to (WHEN (NOT EXP)).
+
+
+ For
For
For is a general iteration construct similar in many ways to the LISP
+ Loop
Loop
Machine and MACLISP Loop construct, and the earlier Interlisp CLISP
+ For
For
iteration construct. For, however, is considerably simpler, far more
+ For
For
"lispy", and somewhat less powerful. For only works in LISP syntax.
+
+ All variable binding/updating still precedes any tests or other code.
+ When Unless
When Unless
Also note that all When or Unless clauses apply to all action clauses, not
+ For
For
just subsequent ones. This fixed order of evaluation makes For less
+ Loop
Loop
powerful than Loop, but also keeps it considerably simpler. The basic
+order of evaluation is
+
+
+ a. bind variables to initial values (computed in the outer
+ environment)
+
+ Initially
Initially
b. execute prologue (i.e. Initially clauses)
+
+ c. while none of the termination conditions are satisfied:
+
+
+ When Unless
When Unless
i. check conditionalization clauses (When and Unless), and
+ start next iteration if all are not satisfied.
+
+ ii. perform body, collecting into variables as necessary
+
+ iii. next iteration
+
+
+ d. (after a termination condition is satisfied) execute the
+ Finally
Finally
epilogue (i.e. Finally clauses)
+
+
+For
For
For does all variable binding/updating in parallel. There is a similar
+ For*
For*
macro, For*, which does it sequentially.
PSL Manual 7 February 1983 Flow Of Control
+section 9.4 page 9.13
+
+ For!*
For!* _ ____ ___ _____
(For!* [S:form]): any macro
+
+
+9.4.2. Mapping Functions
9.4.2. Mapping Functions
9.4.2. Mapping Functions
+
+ )
+
+ The mapping functions long familiar to LISP programmers are present in
+ For
For
PSL. However, we believe that the For construct described above or the
+ ForEach
ForEach
simpler ForEach described below is generally more useful, since it obviates
+the usual necessity of constructing a lambda expression, and is often more
+transparent. Mapping functions with more than two arguments are not
+ ____
currently supported. Note however that several lists may be iterated along
+ For
For
with For, and with considerably more generality. For example:
+
+ (Prog (I)
+ (Setq I 0)
+ (Return
+ (Mapcar L
+ (Function (Lambda (X)
+ (Progn
+ (Setq I (Plus I 1))
+ (Cons I X)))))))
+
+may be expressed more transparently as
+
+ (For (IN X L) (FROM I 1) (COLLECT (CONS I X)))
+
+Note that there is currently no RLISP syntax for this, but we are
+contemplating something like:
+
+ FOR X IN L AS I FROM 1 COLLECT I . X;
+
+ For
For
To augment the simpler For loop present in basic PSL and support the
+ For Each
For Each
RLISP For Each construct, the following list iterator has been provided:
+
+
+ ForEach
ForEach _ ___ ___ _____
(ForEach U:any): any macro
+
+ _____
_____
_____
macro
macro
This macro is essentially equivalent to the the map functions as
+ follows:
+
+
+ Possible forms are:
+ Setting X to successive elements (CARs) of U:
+ (FOREACH X IN U DO (FOO X)) --> (MAPC U 'FOO)
+ (FOREACH X IN U COLLECT (FOO X))--> (MAPCAR U 'FOO)
+ (FOREACH X IN U CONC (FOO X)) --> (MAPCAN U 'FOO)
+ (FOREACH X IN U JOIN (FOO X)) --> (MAPCAN U 'FOO)
+
+ Setting X to successive CDRs of U:
+ (FOREACH X ON U DO (FOO X)) --> (MAP U 'FOO)
Flow Of Control 7 February 1983 PSL Manual
+page 9.14 section 9.4
+
+ (FOREACH X ON U COLLECT (FOO X))--> (MAPLIST U 'FOO)
+ (FOREACH X ON U CONC (FOO X)) --> (MAPCON U 'FOO)
+ (FOREACH X ON U JOIN (FOO X)) --> (MAPCON U 'FOO)
+
+
+ The RLISP syntax is quite simple:
+
+ FOR EACH x IN y DO z;
+ FOR EACH x ON y COLLECT z;
+ etc.
+
+ Note that FOR EACH may be written as FOREACH
+
+
+ Map
Map _ ____ __ ________ ___ ____
(Map X:list FN:function): NIL expr
+
+ Cdr
__ Cdr _
Applies FN to successive Cdr segments of X. NIL is returned.
+ This is equivalent to:
+
+ (FOREACH u ON x DO (FN u))
+
+
+ MapC
MapC _ ____ __ ________ ___ ____
(MapC X:list FN:function): NIL expr
+
+ Car
__ Car ____ _
FN is applied to successive Car segments of list X. NIL is
+ returned. This is equivalent to:
+
+ (FOREACH u IN x DO (FN u))
+
+
+ MapCan
MapCan _ ____ __ ________ ____ ____
(MapCan X:list FN:function): list expr
+
+ Car
____ __ Car _
A concatenated list of FN applied to successive Car elements of X
+ is returned. This is equivalent to:
+
+ (FOREACH u IN x CONC (FN u))
+
+
+ MapCar
MapCar _ ____ __ ________ ____ ____
(MapCar X:list FN:function): list expr
+
+ ____ __
Returned is a constructed list, the elements of which are FN
+ Car
Car ____ _
applied to each Car of list X. This is equivalent to:
+
+ (FOREACH u IN x COLLECT (FN u))
+
+
+ MapCon
MapCon _ ____ __ ________ ____ ____
(MapCon X:list FN:function): list expr
+
+ Cdr
____ __ Cdr
Returned is a concatenated list of FN applied to successive Cdr
+ _
segments of X. This is equivalent to:
PSL Manual 7 February 1983 Flow Of Control
+section 9.4 page 9.15
+
+ (FOREACH u ON x CONC (FN u))
+
+
+ MapList
MapList _ ____ __ ________ ____ ____
(MapList X:list FN:function): list expr
+
+ ____ __
Returns a constructed list, the elements of which are FN applied
+ Cdr
Cdr _
to successive Cdr segments of X. This is equivalent to:
+
+ (FOREACH u ON x COLLECT (FN u))
+
+
+9.4.3. Do
9.4.3. Do
9.4.3. Do
+
+ Do Let
Do Let
The MACLISP style Do and Let are now partially implemented in the USEFUL
+module.
+
+
+ Do
Do _ ____ _ ____ _ ____ ___ _____
(Do A:list B:list [S:form]): any macro
+
+ Do
Do
The Do macro is a general iteration construct similar to that of
+ LISPM and friends. However, it does differ in some details; in
+ Do
Do
particular it is not compatible with the "old style Do" of
+ MACLISP, nor does it support the "no end test means once only"
+ Do
Do
convention. Do has the form
+
+ (DO (I1 I2 ... In)
+ (TEST R1 R2 ... Rk)
+ S1
+ S2
+ ...
+ Sm)
+
+ in which there may be zero or more I's, R's, and S's. In general
+ the I's have the form
+
+ (var init step)
+
+ Do
Do
On entry to the Do form, all the inits are evaluated, then the
+ variables are bound to their respective inits. The test is
+ evaluated, and if non-NIL the form evaluates the R's and returns
+ the value of the last one. If none are supplied it returns NIL.
+ If the test evaluates to NIL the S's are evaluated, the variables
+ are assigned the values of their respective steps in parallel,
+ and the test evaluated again. This iteration continues until
+ test evaluates to a non-NIL value. Note that the inits are
+ evaluated in the surrounding environment, while the steps are
+ Do
Do
evaluated in the new environment. The body of the Do (the S's)
+ Prog Go
Prog Go
is a Prog, and may contain labels and Go's, though use of this is
+ Return
Return
discouraged. It may be changed at a later date. Return used
+ Do
Do
within a Do returns immediately without evaluating the test or
+ exit forms (R's).
Flow Of Control 7 February 1983 PSL Manual
+page 9.16 section 9.4
+
+ There are alternative forms for the I's: If the step is omitted,
+ the variable's value is left unchanged. If both the init and
+ __
step are omitted or if the I is an id, it is initialized to NIL
+ and left unchanged. This is particularly useful for introducing
+ SetQ
SetQ
dummy variables which are SetQ'd inside the body.
+
+
+ Do!*
Do!* _ ____ _ ____ _ ____ ___ _____
(Do!* A:list B:list [C:form]): any macro
+
+ Do!* Do
Do!* Do
Do!* is like Do, except the variable bindings and updatings are
+ done sequentially instead of in parallel.
+
+
+ Do-Loop
Do-Loop _ ____ _ ____ _ ____ _ ____ ___ _____
(Do-Loop A:list B:list C:list [S:form]): any macro
+
+ Do-Loop Do
Do-Loop Do
Do-Loop is like Do, except that it takes an additional argument,
+ a prologue. The general form is
+
+ (DO-LOOP (I1 I2 ... In)
+ (P1 P2 ... Pj)
+ (TEST R1 R2 ... Rk)
+ S1
+ S2
+ ...
+ Sm)
+
+ Do
Do
This is executed just like the corresponding Do, except that
+ after the bindings are established and initial values assigned,
+ but before the test is first executed the P's are evaluated, in
+ order. Note that the P's are all evaluated exactly once
+ (assuming that none of the P's err out, or otherwise throw to a
+ surrounding context).
+
+
+ Do-Loop!*
Do-Loop!* _ ____ _ ____ _ ____ _ ____ ___ _____
(Do-Loop!* A:list B:list C:list [S:form_]): any macro
+
+ Do-Loop!*
Do-Loop!*
Do-Loop!* does the variable bindings and undates sequentially
+ instead of in parallel.
+
+
+ Let
Let _ ____ _ ____ ___ _____
(Let A:list [B:form]): any macro
+
+ Let
Let
Let is a macro giving a more perspicuous form for writing lambda
+ expressions. The basic form is
+
+ (LET ((V1 I1) (V2 I2) ...(Vn In)) S1 S2 ... Sn)
+
+ The I's are evaluated (in an unspecified order), and then the V's
+ are bound to these values, the S's evaluated, and the value of
+ the last is returned. Note that the I's are evaluated in the
+ outer environment before the V's are bound.
PSL Manual 7 February 1983 Flow Of Control
+section 9.4 page 9.17
+
+ __
Note: the id LET conflicts with a similar construct in RLISP and
+ REDUCE
+
+
+ Let!*
Let!* _ ____ _ ____ ___ _____
(Let!* A:list [B:form]): any macro
+
+ Let!* Let
Let!* Let
Let!* is just like Let except that it makes the assignments
+ sequentially. That is, the first binding is made before the
+ value for the second one is computed.
+
+
+
+9.5. Non-Local Exits
9.5. Non-Local Exits
9.5. Non-Local Exits
+
+ One occasionally wishes to discontinue a computation in which the lexical
+ Return
Return
restrictions on placement of Return are too restrictive. The non-local
+ Catch Throw
Catch Throw
exit constructs Catch and Throw exist for these cases. They should not,
+however, be used indiscriminately. The lexical restrictions on their more
+local counterparts ensure that the flow of control can be ascertained by
+ Catch Throw
Catch Throw
looking at a single piece of code. With Catch and Throw, control may be
+passed to and from totally unrelated pieces of code. Under some
+conditions, these functions are invaluable. Under others, they can wreak
+havoc.
+
+
+ Catch
Catch ___ __ ____ ____ ___ ____ ________ _____
(Catch TAG:id [FORM:form]): any Open-Compiled, fexpr
+
+ Catch Eval
Catch ___ Eval ____
Catch evaluates the TAG and then calls Eval on the FORMs in a
+ Throw
Throw ___ ___
protected environment. If during this evaluation (Throw TAG VAL)
+ Catch Throw
Catch ___ Throw
occurs, Catch immediately returns VAL. If no Throw occurs, the
+ ____
value of the last FORM is returned. Note that in general only
+ Throw Throw Eq
Throw ___ Throw ___ Eq
Throws with the same TAG are caught. Throws whose TAG is not Eq
+ Catch Catch
Catch Catch ___
to that of Catch are passed on out to surrounding Catches. A TAG
+ Catch
Catch
of NIL, however, is special. (Catch NIL @var[form)] catches any
+ Throw
Throw
Throw.
+
+
+ __________ ______
THROWSIGNAL!* [Initially: NIL] global
+
+
+ __________ ______
THROWTAG!* [Initially: NIL] global
+
+ The FLUID variables THROWSIGNAL!* and THROWTAG!* may be
+ Catch
Catch
interrogated to find out if the most recently evaluated Catch was
+ Throw Throw
Throw Throw
Thrown to, and what tag was passed to the Throw. THROWSIGNAL!*
+ Set Catch
Set Catch
is Set to NIL upon normal exit from a Catch, and to T upon normal
+ Throw Set
Throw Set
exit from Throw. THROWTAG!* is Set to the first argument passed
+ Throw Throw Eval
Throw Throw Eval ____
to the Throw. (Mark a place to Throw to, Eval FORM.)
Flow Of Control 7 February 1983 PSL Manual
+page 9.18 section 9.5
+
+ Throw
Throw ___ __ ___ ___ ____ ________ ____
(Throw TAG:id VAL:any): None Returned expr
+
+ Catch Eq
Catch Eq
This passes control to the closest surrounding Catch with an Eq
+ Catch
___ Catch
or null TAG. If there is no such surrounding Catch it is an
+ _____
_____
_____
Throw
__ ___ _______ __ ___ Throw
error in the context of the Throw. That is, control is not
+ Throw Error
Throw Error
Thrown to the top level before the call on Error. (Non-local
+ Goto
Goto
Goto.)
+
+ Some examples:
+
+ In LISP syntax, with
+
+ (DE DOIT (x)
+ (COND ((EQN x 1) 100)
+ (T (THROW 'FOO 200))))
+
+ (CATCH 'FOO (DOIT 1) (PRINT "NOPE") 0)
+ will continue and execute the PRINT statement
+ and return 0
+ while
+
+ (CATCH 'FOO (DOIT 2) (PRINT "NOPE") 0)
+
+ will of course THROW, returning 200 and not executing
+ the last forms.
+
+
+ A common problem people encounter is how to pass arguments and/or
+ CATCH
CATCH
computed functions or tags into CATCH for protected evaluation. The
+following examples should illustrate. Note that TAG is quoted, since it is
+evaluated before use in CATCH and THROW.
+
+ In LISP syntax:
+
+ (DE PASS-ARGS(X1 X2)
+ (CATCH 'FOO (FEE (PLUS2 X1 X2) (DIFFERENCE X1 X2))))
+
+ This is simple, because CATCH compiles open. No FLUID declarations or
+ Apply
Apply
LIST building is needed, as in previous versions of PSL. An explicit Apply
+must be used for a function argument; usually, the APPLY will compile open,
+with no overhead:
+
+ In LISP syntax:
+
+ (DE PASS-FN(X1 FN)
+ (CATCH 'FOO (APPLY FN (LIST X1))))
+
+ Catch Throw
Catch Throw
The following MACROs are provided to aid in the use of Catch and Throw
+with a NIL tag, by examining the THROWSIGNAL!* and THROWTAG!*:
PSL Manual 7 February 1983 Flow Of Control
+section 9.5 page 9.19
+
+ Catch!-All
Catch!-All __ ________ ____ ____ ___ _____
(Catch!-All FN:function [FORM:form]): any macro
+
+ Catch
Catch
This issues a (Catch NIL ...); if a Throw was actually done, the
+ __
function FN is applied to the two arguments THROWTAG!* and the
+ throw Throw
throw Throw
value returned by the throw. Thus FN is applied only if a Throw
+ was executed.
+
+
+ Unwind!-All
Unwind!-All __ ________ ____ ____ ___ _____
(Unwind!-All FN:function [FORM:form]): any macro
+
+ Catch
Catch __
This issues a (Catch NIL ...). The function FN is always called,
+ and applied to the two arguments THROWTAG!* and the value
+ throw Throw
throw Throw __
returned by the throw. If no Throw was done then FN is called on
+ NIL and the value returned.
+
+
+ Unwind!-Protect
Unwind!-Protect _ ____ _ ____ ___ _____
(Unwind!-Protect F:form [C:form]): any macro
+
+ _
The idea is to execute the "protected" form, F, and then run some
+ _
"clean-up" forms C even if a Throw (or Error) occurred during the
+ Catch
_ Catch
evaluation of F. This issues a (Catch NIL ...), the cleanup forms
+ are then run, and finally either the value is returned if no
+ Throw occurred, or the Throw is "re-thrown" to the same tag.
+
+ A common example is to ensure a file be closed after processing,
+ even if an error or throw occurred:
+
+ (SETQ chan (OPEN file ....))
+ (UNWIND-PROTECT (process-file)
+ (CLOSE chan))
+
+ Note: Certain special tags are used in the PSL system, and should not be
+interfered with casually:
+
+
+ Error ErrorSet
Error ErrorSet
!$ERROR!$ Used by Error and ErrorSet which are implemented in terms of
+ Catch Throw
Catch Throw
Catch and Throw, see Chapter 14).
+
+!$UNWIND!-PROTECT!$
+ A special TAG placed to ensure that ALL throws pause at the
+ UNWIND-PROTECT "mark".
+
+ PROG GO RETURN
PROG GO RETURN
!$PROG!$ Used to communicate between interpreted PROGs, GOs and RETURNs.
ADDED psl-1983/3-1/lpt/10-functions.lpt
Index: psl-1983/3-1/lpt/10-functions.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/10-functions.lpt
@@ -0,0 +1,562 @@
+PSL Manual 7 February 1983 Function Definition
+section 10.0 page 10.1
+
+ CHAPTER 10
CHAPTER 10
CHAPTER 10
+ FUNCTION DEFINITION AND BINDING
FUNCTION DEFINITION AND BINDING
FUNCTION DEFINITION AND BINDING
+
+
+
+
+ 10.1. Function Definition in PSL . . . . . . . . . . 10.1
+ 10.1.1. Notes on Code Pointers . . . . . . . . . 10.1
+ 10.1.2. Functions Useful in Function Definition. . . . 10.2
+ 10.1.3. Function Definition in LISP Syntax . . . . . 10.4
+ 10.1.4. Function Definition in RLISP Syntax . . . . . 10.6
+ 10.1.5. Low Level Function Definition Primitives . . . 10.6
+ 10.1.6. Function Type Predicates. . . . . . . . . 10.7
+ 10.2. Variables and Bindings. . . . . . . . . . . . 10.8
+ 10.2.1. Binding Type Declaration. . . . . . . . . 10.8
+ 10.2.2. Binding Type Predicates . . . . . . . . . 10.9
+ 10.3. User Binding Functions. . . . . . . . . . . . 10.10
+ 10.3.1. Funargs, Closures and Environments . . . . . 10.10
+
+
+
+
+10.1. Function Definition in PSL
10.1. Function Definition in PSL
10.1. Function Definition in PSL
+
+ Functions in PSL are GLOBAL entities. To avoid function-variable naming
+clashes, the Standard LISP Report required that no variable have the same
+name as a function. There is no conflict in PSL, as separate function
+cells and value cells are used. A warning message is given for
+compatibility. The first major section in this chapter describes how to
+define new functions; the second describes the binding of variables in PSL.
+The final section presents binding functions useful in building new
+interpreter functions.
+
+
+10.1.1. Notes on Code Pointers
10.1.1. Notes on Code Pointers
10.1.1. Notes on Code Pointers
+
+ Print
____ _______ Print
A code-pointer may be displayed by the Print functions or expanded by
+Explode
Explode
Explode. The value appears in the convention of the implementation
+(#<Code:a nnnn>, where a is the number of arguments of the function, and
+ ____ _______
nnnn is the function's entry point, on the DEC-20 and VAX). A code-pointer
+ Compress
Compress
may not be created by Compress. (See Chapter 12 for descriptions of
+Explode Compress
Explode Compress ____ _______
Explode and Compress.) The code-pointer associated with a compiled
+ GetD
GetD
function may be retrieved by GetD and is valid as long as PSL is in
+execution (on the DEC-20 and VAX, compiled code is not relocated, so
+ PutD
____ _______ ____ _______ PutD
code-pointers do not change). A code-pointer may be stored using PutD,
+Put SetQ
Put SetQ
Put, SetQ and the like or by being bound to a variable. It may be checked
+ Eq
Eq ____ _______
for equivalence by Eq. The value may be checked for being a code-pointer
+ CodeP
CodeP
by the CodeP function.
Function Definition 7 February 1983 PSL Manual
+page 10.2 section 10.1
+
+10.1.2. Functions Useful in Function Definition
10.1.2. Functions Useful in Function Definition
10.1.2. Functions Useful in Function Definition
+
+ __
In PSL, ids have a function cell that usually contains an executable
+instruction which either JUMPs directly to the entry point of a compiled
+function or executes a CALL to an auxiliary routine that handles
+interpreted functions, undefined functions, or other special services (such
+ ________
as auto-loading functions, etc). The user can pass anonymous function
+ ____ _______
objects around either as a code-pointer, which is a tagged object referring
+ ______
to a compiled code block, or a lambda expression, representing an
+interpreted function.
+
+
+ PutD
PutD _____ __ ____ _____ ____ ______ ____ _______ __ ____
(PutD FNAME:id TYPE:ftype BODY:{lambda,code-pointer}): id expr
+
+ _____ ____ ____
Creates a function with name FNAME and type TYPE, with BODY as
+ PutD
PutD
the function definition. If successful, PutD returns the name of
+ the defined function.
+
+ ____ _______
If the body is a code-pointer or is compiled (i.e. !*COMP=T as
+ the function was defined), a special instruction to jump to the
+ start of the code is placed in the function cell. If it is a
+ ______
lambda, the lambda expression is saved on the property list under
+ the indicator !*LAMBDALINK and a call to an interpreter function
+ LambdaLink
LambdaLink
(LambdaLink) is placed in the function cell.
+
+ ____ ____ _____
The TYPE is recorded on the property list of FNAME if it is not
+ ____
____
____
expr
expr
an expr.
+
+ [??? We need to add code to check that the the arglist has no
[??? We need to add code to check that the the arglist has no
[??? We need to add code to check that the the arglist has no
+ more than 15 arguments for exprs, 1 argument for fexprs and
more than 15 arguments for exprs, 1 argument for fexprs and
more than 15 arguments for exprs, 1 argument for fexprs and
+ macros, and ??? for nexprs. Declaration mechanisms to avoid
macros, and ??? for nexprs. Declaration mechanisms to avoid
macros, and ??? for nexprs. Declaration mechanisms to avoid
+ overhead also need to be available. (In fact are available
overhead also need to be available. (In fact are available
overhead also need to be available. (In fact are available
+ for the compiler, although still poorly documented.) When
for the compiler, although still poorly documented.) When
for the compiler, although still poorly documented.) When
+ should we expand macros? ???]
should we expand macros? ???]
should we expand macros? ???]
+
+ PutD GetD
PutD _____ GetD ____ _____
After using PutD on FNAME, GetD returns a pair of the the FNAME's
+ ____ ____
(TYPE . BODY).
+
+ GlobalP
GlobalP
The GlobalP predicate returns T if queried with the defined
+ _____
function's name. If the function FNAME has already been declared
+ as a GLOBAL or FLUID variable the warning:
+
+ *** FNAME is a non-local variable
+
+ _____
occurs, but the function is defined. If function FNAME is
+ already defined, a warning message appears:
+
+ *** Function FNAME has been redefined
+
+ ____
Note: All function types may be compiled.
+
+ The following switches are useful when defining functions.
PSL Manual 7 February 1983 Function Definition
+section 10.1 page 10.3
+
+ __________ ______
!*REDEFMSG [Initially: T] switch
+
+ If !*REDEFMSG is not NIL, the message
+
+ *** Function `FOO' has been redefined
+
+ is printed whenever a function is redefined.
+
+
+ __________ ______
!*USERMODE [Initially: T] switch
+
+ Controls action on redefinition of a function. All functions
+ defined if !*USERMODE is T are flagged USER. Functions which are
+ flagged USER can be redefined freely. If an attempt is made to
+ redefine a function which is not flagged USER, the query
+
+ Do you really want to redefine the system function `FOO'?
+
+ is made, requiring a Y, N, YES, NO, or B response. B starts the
+ break loop, so that one can change the setting of !*USERMODE.
+ After exiting the break loop, one must answer Y, Yes, N, or No.
+ YesP
YesP
See YesP in Chapter 13. If !*UserMode is NIL, all functions can
+ be redefined freely, and all functions defined have the USER flag
+ removed. This provides some protection from redefining system
+ functions.
+
+
+ __________ ______
!*COMP [Initially: NIL] switch
+
+ PutD
PutD
The value of !*COMP controls whether or not PutD compiles the
+ function defined in its arguments before defining it. If !*COMP
+ is NIL the function is defined as a lambda expression. If !*COMP
+ is non-NIL, the function is first compiled. Compilation produces
+ certain changes in the semantics of functions, particularly FLUID
+ type access.
+
+
+ GetD
GetD _ ___ ___ ____ ____
(GetD U:any): {NIL, pair} expr
+
+ _
If U is not the name of a defined function, NIL is returned. If
+ _ ____
U is a defined function then the pair
+ ____ _____ _____ _____
____ _____ _____ _____
____ _____ _____ _____
expr, fexpr, macro, nexpr
expr, fexpr, macro, nexpr ____ _______ ______
({expr, fexpr, macro, nexpr} . {code-pointer, lambda}) is
+ returned.
+
+
+ CopyD
CopyD ___ __ ___ __ ___ __ ____
(CopyD NEW:id OLD:id): NEW:id expr
+
+ ___ ___
The function body and type for NEW become the same as OLD. If no
+ ___
definition exists for OLD an error:
+
+ ***** OLD has no definition in COPYD
Function Definition 7 February 1983 PSL Manual
+page 10.4 section 10.1
+
+ ___
is given. NEW is returned.
+
+
+ RemD
RemD _ __ ___ ____ ____
(RemD U:id): {NIL, pair} expr
+
+ _
Removes the function named U from the set of defined functions.
+ GetD
____ GetD
Returns the (ftype . function) pair or NIL, as does GetD. The
+ ________ _
function type attribute of U is removed from the property list of
+ _
U.
+
+
+10.1.3. Function Definition in LISP Syntax
10.1.3. Function Definition in LISP Syntax
10.1.3. Function Definition in LISP Syntax
+
+ De Df Dn Dm Ds
De Df Dn Dm Ds
The functions De, Df, Dn, Dm, and Ds are most commonly used in the LISP
+syntax form of PSL. They are difficult to use from RLISP as there is not a
+convenient way to represent the argument list. The functions are compiled
+if the compiler is loaded and the GLOBAL !*COMP is T.
+
+
+ De
De _____ __ ______ __ ____ __ ____ __ _____
(De FNAME:id PARAMS:id-list [FN:form]): id macro
+
+ ____
____
____
expr
_____ expr ____ __
Defines the function named FNAME, of type expr. The forms FN are
+ made into a lambda expression with the formal parameter list
+ 1
+ ______
PARAMS, and this is used as the body of the function.
+
+ Previous definitions of the function are lost. The name of the
+ _____
defined function, FNAME, is returned.
+
+
+ Df
Df _____ __ _____ __ ____ __ ___ __ _____
(Df FNAME:id PARAM:id-list FN:any): id macro
+
+ _____
_____
_____
fexpr
_____ fexpr ____ __
Defines the function named FNAME, of type fexpr. The forms FN
+ are made into a lambda expression with the formal parameter list
+ ______
PARAMS, and this is used as the body of the function.
+
+ Previous definitions of the function are lost. The name of the
+ _____
defined function, FNAME, is returned.
+
+
+ Dn
Dn _____ __ _____ __ ____ __ ___ __ _____
(Dn FNAME:id PARAM:id-list FN:any): id macro
+
+ _____
_____
_____
nexpr
_____ nexpr ____ __
Defines the function named FNAME, of type nexpr. The forms FN
+ are made into a lambda expression with the formal parameter list
+ ______
PARAMS, and this is used as the body of the function.
+
+
+_______________
+
+ 1
+ Or the compiled code pointer for the lambda expression if the compiler
+is on.
PSL Manual 7 February 1983 Function Definition
+section 10.1 page 10.5
+
+ Previous definitions of the function are lost. The name of the
+ _____
defined function, FNAME, is returned.
+
+
+ Dm
Dm _____ __ _____ __ ____ __ ___ __ _____
(Dm MNAME:id PARAM:id-list FN:any): id macro
+
+ _____
_____
_____
macro
_____ macro ____ __
Defines the function named FNAME, of type macro. The forms FN
+ are made into a lambda expression with the formal parameter list
+ ______
PARAMS, and this is used as the body of the function.
+
+ Previous definitions of the function are lost. The name of the
+ _____
defined function, FNAME, is returned.
+
+
+ Ds
Ds _____ __ _____ __ ____ __ ___ __ _____
(Ds SNAME:id PARAM:id-list FN:any): id macro
+
+ ______ _______
______ _______
______ _______
smacro Smacros
smacro _____ Smacros
Defines the smacro SNAME. Smacros are actually a syntactic
+ _____
_____
_____
macro
macro
notation for a special class of macros, those that essentially
+ treat the macro's argument as a list of arguments to be
+ substituted into the body of the expression and then expanded in
+ _____
_____
_____
macro
macro
line, rather than using the computational power of the macro to
+ defmacro
defmacro
customize code. Thus they are a special case of defmacro. See
+ also the BackQuote facility.
+
+ For example:
+
+ Lisp syntax:
+ To make a substitution macro for
+ FIRST ->CAR we could say
+
+ (DM FIRST(X)
+ (LIST 'CAR (CADR X)))
+
+ Instead the following is clearer
+
+ (DS FIRST(X)
+ (CAR X))
+
+
+10.1.4. Function Definition in RLISP Syntax
10.1.4. Function Definition in RLISP Syntax
10.1.4. Function Definition in RLISP Syntax
+
+ [??? THIS IS NOT SUFFICIENT DOCUMENTATION! Either move it all to
[??? THIS IS NOT SUFFICIENT DOCUMENTATION! Either move it all to
[??? THIS IS NOT SUFFICIENT DOCUMENTATION! Either move it all to
+ chapter 3 or do a better job here. ???]
chapter 3 or do a better job here. ???]
chapter 3 or do a better job here. ???]
+
+ In RLISP syntax, procedures are defined by using the Procedure construct,
+as discussed in Chapter 3.
+
+ mode type PROCEDURE name(args);
+ body;
+
+where mode is SYSLISP or LISP or SYMBOLIC and defaults to LISP, and type
+defaults to EXPR.
Function Definition 7 February 1983 PSL Manual
+page 10.6 section 10.1
+
+10.1.5. Low Level Function Definition Primitives
10.1.5. Low Level Function Definition Primitives
10.1.5. Low Level Function Definition Primitives
+
+ PutD GetD
PutD GetD
The following functions are used especially by PutD and GetD, defined
+ Eval Apply
Eval Apply
above in Section 10.1.2, and by Eval and Apply, defined in Chapter 11.
+
+
+ FUnBoundP
FUnBoundP _ __ _______ ____
(FUnBoundP U:id): boolean expr
+
+ ________ _
Tests whether there is a definition in the function cell of U;
+ returns NIL if so, T if not.
+
+ Note: Undefined functions actually call a special function,
+ UndefinedFunction Error FUnBoundP
UndefinedFunction Error FUnBoundP
UndefinedFunction, that invokes Error. FUnBoundP defines
+ UndefinedFunction
UndefinedFunction
"unbound" to mean "calls UndefinedFunction".
+
+
+ FLambdaLinkP
FLambdaLinkP _ __ _______ ____
(FLambdaLinkP U:id): boolean expr
+
+ _
Tests whether U is an interpreted function; return T if so, NIL
+ if not. This is done by checking for the special code-address of
+ lambdaLink
lambdaLink
the lambdaLink function, which calls the interpreter.
+
+
+ FCodeP
FCodeP _ __ _______ ____
(FCodeP U:id): boolean expr
+
+ _
Tests whether U is a compiled function; returns T if so, NIL if
+ not.
+
+
+ MakeFUnBound
MakeFUnBound _ __ ___ ____
(MakeFUnBound U:id): NIL expr
+
+ _
Makes U an undefined function by planting a special call to an
+ UndefinedFunction
UndefinedFunction ________ _
error function, UndefinedFunction, in the function cell of U.
+
+
+ MakeFLambdaLink
MakeFLambdaLink _ __ ___ ____
(MakeFLambdaLink U:id): NIL expr
+
+ _
Makes U an interpreted function by planting a special call to an
+ lambdaLink
lambdaLink
interpreter support function (lambdaLink) function in the
+ ________ _
function cell of U.}
+
+
+ MakeFCode
MakeFCode _ __ _ ____ _______ ___ ____
(MakeFCode U:id C:code-pointer): NIL expr
+
+ _
Makes U a compiled function by planting a special JUMP to the
+ _
code-address associated with C.
+
+
+ GetFCodePointer
GetFCodePointer _ __ ____ _______ ____
(GetFCodePointer U:id): code-pointer expr
+
+ ____ _______ _
Gets the code-pointer for U.
PSL Manual 7 February 1983 Function Definition
+section 10.1 page 10.7
+
+ Code!-Number!-Of!-Arguments
Code!-Number!-Of!-Arguments _ ____ _______ ___ _______ ____
(Code!-Number!-Of!-Arguments C:code-pointer): {NIL,integer} expr
+
+ Some compiled functions have the argument number they expect
+ _
stored in association with the codepointer C. This integer, or
+ NIL is returned.
+
+ _____ ____
_____ ____
_____ ____
[??? Should be extended for nexprs and declared exprs. ???]
[??? Should be extended for nexprs and declared exprs. ???]
[??? Should be extended for nexprs and declared exprs. ???]
+
+
+10.1.6. Function Type Predicates
10.1.6. Function Type Predicates
10.1.6. Function Type Predicates
+
+ See Section 2.7 for a discussion of the function types available in PSL.
+
+
+ ExprP
ExprP _ ___ _______ ____
(ExprP U:any): boolean expr
+
+ ____
____
____
expr
_ ____ _______ ______ __ expr
Test if U is a code-pointer, lambda form, or an id with expr
+ definition.
+
+
+ FExprP
FExprP _ ___ _______ ____
(FExprP U:any): boolean expr
+
+ _____
_____
_____
fexpr
_ __ fexpr
Test if U is an id with fexpr definition.
+
+
+ NExprP
NExprP _ ___ _______ ____
(NExprP U:any): boolean expr
+
+ _____
_____
_____
nexpr
_ __ nexpr
Test if U is an id with nexpr definition.
+
+
+ MacroP
MacroP _ ___ _______ ____
(MacroP U:any): boolean expr
+
+ _____
_____
_____
macro
_ __ macro
Test if U is an id with macro definition.
+
+
+
+10.2. Variables and Bindings
10.2. Variables and Bindings
10.2. Variables and Bindings
+
+ __
Variables in PSL are ids, and associated values are usually stored in and
+ __
retrieved from the value cell of this id. If variables appear as
+ Prog
Prog
parameters in lambda expressions or in Prog's, the contents of the value
+cell are saved on a binding stack. A new value or NIL is stored in the
+ Prog
Prog
value cell and the computation proceeds. On exit from the lambda or Prog
+the old value is restored. This is called the "shallow binding" model of
+LISP. It is chosen to permit compiled code to do binding efficiently. For
+even more efficiency, compiled code may eliminate the variable names and
+simply keep values in registers or a stack. The scope of a variable is the
+range over which the variable has a defined value. There are three
+different binding mechanisms in PSL.
+
+
+LOCAL BINDING Only compiled functions bind variables locally. Local
Function Definition 7 February 1983 PSL Manual
+page 10.8 section 10.2
+
+ variables occur as formal parameters in lambda expressions
+ Prog
Prog
and as LOCAL variables in Prog's. The binding occurs as a
+ Prog
Prog
lambda expression is evaluated or as a Prog form is
+ executed. The scope of a local variable is the body of the
+ function in which it is defined.
+
+FLUID BINDING FLUID variables are GLOBAL in scope but may occur as formal
+ Prog
Prog
parameters or Prog form variables. In interpreted
+ functions, all formal parameters and LOCAL variables are
+ considered to have FLUID binding until changed to LOCAL
+ binding by compilation. A variable can be treated as a
+ FLUID only by declaration. If FLUID variables are used as
+ parameters or LOCALs they are rebound in such a way that the
+ previous binding may be restored. All references to FLUID
+ variables are to the currently active binding. Access to
+ the values is by name, going to the value cell.
+
+GLOBAL BINDING GLOBAL variables may never be rebound. Access is to the
+ value bound to the variable. The scope of a GLOBAL variable
+ is universal. Variables declared GLOBAL may not appear as
+ Prog
Prog
parameters in lambda expressions or as Prog form variables.
+ A variable must be declared GLOBAL prior to its use as a
+ GLOBAL variable since the default type for undeclared
+ variables is FLUID. Note that the interpreter does not stop
+ one from rebinding a global variable. The compiler will
+ issue a warning in this situation.
+
+
+10.2.1. Binding Type Declaration
10.2.1. Binding Type Declaration
10.2.1. Binding Type Declaration
+
+
+ Fluid
Fluid ______ __ ____ ___ ____
(Fluid IDLIST:id-list): NIL expr
+
+ __ ______ __
The ids in IDLIST are declared as FLUID type variables (ids not
+ ______
previously declared are initialized to NIL). Variables in IDLIST
+ already declared FLUID are ignored. Changing a variable's type
+ from GLOBAL to FLUID is not permissible and results in the error:
+
+
+ ***** ID cannot be changed to FLUID
+
+
+ Global
Global ______ __ ____ ___ ____
(Global IDLIST:id-list): NIL expr
+
+ __ ______ __
The ids of IDLIST are declared GLOBAL type variables. If an id
+ has not been previously declared, it is initialized to NIL.
+ Variables already declared GLOBAL are ignored. Changing a
+ variable's type from FLUID to GLOBAL is not permissible and
+ results in the error:
+
+ ***** ID cannot be changed to GLOBAL
PSL Manual 7 February 1983 Function Definition
+section 10.2 page 10.9
+
+ UnFluid
UnFluid ______ __ ____ ___ ____
(UnFluid IDLIST:id-list): NIL expr
+
+ ______
The variables in IDLIST which have been declared as FLUID
+ variables are no longer considered as FLUID variables. Others
+ are ignored. This affects only compiled functions, as free
+ variables in interpreted functions are automatically considered
+ FLUID (see [Griss 81]).
+
+
+10.2.2. Binding Type Predicates
10.2.2. Binding Type Predicates
10.2.2. Binding Type Predicates
+
+
+ FluidP
FluidP _ ___ _______ ____
(FluidP U:any): boolean expr
+
+ _
If U is FLUID (by declaration only), T is returned; otherwise,
+ NIL is returned.
+
+
+ GlobalP
GlobalP _ ___ _______ ____
(GlobalP U:any): boolean expr
+
+ _
If U has been declared GLOBAL or is the name of a defined
+ function, T is returned; else NIL is returned.
+
+
+ UnBoundP
UnBoundP _ __ _______ ____
(UnBoundP U:id): boolean expr
+
+ _
Tests whether U has no value.
+
+
+
+10.3. User Binding Functions
10.3. User Binding Functions
10.3. User Binding Functions
+
+ The following functions are available to build one's own interpreter
+functions that use the built-in FLUID binding mechanism, and interact well
+with the automatic unbinding that takes place during Throw and Error calls.
+
+
+ [??? Are these correct when Environments are managed correctly ???]
[??? Are these correct when Environments are managed correctly ???]
[??? Are these correct when Environments are managed correctly ???]
+
+
+ UnBindN
UnBindN _ _______ _________ ____
(UnBindN N:integer): Undefined expr
+
+ Prog
Prog
Used in user-defined interpreter functions (like Prog) to restore
+ _
previous bindings to the last N values bound.
+
+
+ LBind1
LBind1 ______ __ ___________ ___ _________ ____
(LBind1 IDNAME:id VALUETOBIND:any): Undefined expr
+
+ ______
Support for LAMBDA-like binding. The current value of IDNAME is
+ ___________
saved on the binding stack; the value of VALUETOBIND is then
+ ______
bound to IDNAME.
Function Definition 7 February 1983 PSL Manual
+page 10.10 section 10.3
+
+ PBind1
PBind1 ______ __ _________ ____
(PBind1 IDNAME:id): Undefined expr
+
+ Prog
Prog ______
Support for Prog. Binds NIL to IDNAME after saving value on the
+ LBind1
LBind1 ______
binding stack. Essentially LBind1(IDNAME, NIL)
+
+
+10.3.1. Funargs, Closures and Environments
10.3.1. Funargs, Closures and Environments
10.3.1. Funargs, Closures and Environments
+
+ [??? Not yet connected to V3 ???]
[??? Not yet connected to V3 ???]
[??? Not yet connected to V3 ???]
+
+ We have an experimental implementation of Baker's re-rooting funarg
+scheme [Baker 78], in which we always re-root upon binding; this permits
+efficient use of a GLOBAL value cell in the compiler. We are also
+considering implementing a restricted FUNARG or CLOSURE mechanism. The
+implementation we have does not work with the current version of PSL.
+
+ This currently uses a module (ALTBIND) to redefine the fluid binding
+ _ ____
mechanism of PSL to be functionally equivalent to an a-list binding scheme.
+However, it retains the principal advantage of the usual shallow binding
+scheme: variable lookup is extremely cheap -- just look in a value cell.
+Typical LISP programs currently run about 8% slower if using ALTBIND than
+with the initial shallow binding mechanism. It is expected that this 8%
+difference will go away presently. This mechanism will also probably
+become a standard part of PSL, rather than an add on module.
+
+ To use ALTBIND simply do "load altbind;" ["(load altbind)" in LISP].
+Existing code, both interpreted and compiled, should then commence using
+the new binding mechanism.
+
+ The following functions are of most interest to the user:
+
+
+ Closure
Closure _ ____ ____ _____
(Closure U:form): form macro
+
+ Function
Function
This is similar to Function, but returns a function closure
+ Function
Function
including environment information, similar to Function in LISP
+ Function* Eval Apply
Function* Eval Apply
1.5 and Function* in LISP 1.6 and MACLISP. Eval and Apply are
+ redefined to handle closures correctly. Currently only closures
+ ____
____
____
expr
expr
of exprs are supported.
+
+
+ EvalInEnvironment
EvalInEnvironment _ ____ ___ ___ _______ ___ ____
(EvalInEnvironment F:form ENV:env-pointer): any expr
+
+
+ ApplyInEnvironment
ApplyInEnvironment __ ________ ____ ____ ____ ___ ___ _______ ___ ____
(ApplyInEnvironment FN:function ARGS:form-list ENV:env-pointer): any expr
+
+ Eval Apply
Eval Apply
These are like Eval and Apply, but take an extra, last argument,
+ and environment pointer. They perform their work in this
+ environment instead of the current one.
+
+ The following functions should be used with care:
PSL Manual 7 February 1983 Function Definition
+section 10.3 page 10.11
+
+ CaptureEnvironment
CaptureEnvironment ___ _______ ____
(CaptureEnvironment ): env-pointer expr
+
+ Save the current bindings to be restored at some later point.
+ CaptureEnvironment
CaptureEnvironment
This is best used inside a closure. CaptureEnvironment returns
+ ____
an environment pointer. This object is normally a circular list
+ structure, and so should not be printed. The same warning
+ applies to closures, which contain environment pointers. It is
+ hoped that environment pointers will be made a new LISP data type
+ soon, and will be made to print safely, relaxing this
+ restriction.
+
+ [??? add true envpointer ???]
[??? add true envpointer ???]
[??? add true envpointer ???]
+
+
+ RestoreEnvironment
RestoreEnvironment ___ ___ _______ _________ ____
(RestoreEnvironment PTR:env-pointer): Undefined expr
+
+ Restore old bindings to what they were in the captured
+ ___
environment, PTR.
+
+
+ ClearBindings
ClearBindings _________ ____
(ClearBindings ): Undefined expr
+
+ Restore bindings to top level, i.e strip the entire stack.
+
+ For a demonstration of closures, do (in RLISP)
+`in "PU:altbind-tests.red";'.
+
+ [??? Give a practical example ???]
[??? Give a practical example ???]
[??? Give a practical example ???]
ADDED psl-1983/3-1/lpt/11-interp.lpt
Index: psl-1983/3-1/lpt/11-interp.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/11-interp.lpt
@@ -0,0 +1,289 @@
+PSL Manual 7 February 1983 The Interpreter
+section 11.0 page 11.1
+
+ CHAPTER 11
CHAPTER 11
CHAPTER 11
+ THE INTERPRETER
THE INTERPRETER
THE INTERPRETER
+
+
+
+
+ 11.1. Evaluator Functions Eval and Apply. . . . . . . . 11.1
+ 11.2. Support Functions for Eval and Apply . . . . . . . 11.5
+ 11.3. Special Evaluator Functions, Quote, and Function . . . 11.6
+ 11.4. Support Functions for Macro Evaluation . . . . . . 11.6
+
+
+
+
+11.1. Evaluator Functions Eval and Apply
11.1. Evaluator Functions Eval and Apply
11.1. Evaluator Functions Eval and Apply
+
+ The PSL evaluator uses an identifier's function cell (SYMFNC(id#) which
+is directly accessible from kernel functions only) to access the address of
+the code for executing the identifier's function definition, as described
+in chapter 10. The function cell contains either the entry address of a
+compiled function, or the address of a support routine that either signals
+an undefined function or calls the lambda interpreter. The PSL model of a
+function call is to place the arguments (after treatment appropriate to
+function type) in "registers", and then to jump to or call the code in the
+function cell.
+
+ ____
Expressions which can be legally evaluated are called forms. They are
+restricted S-expressions:
+
+ ____ __
form ::= id
+ ________
| constant
+ __ ____ ____
| (id form ... form)
+ ___
| (special . any) % Special cases: COND, PROG, etc.
+ _____ _____
_____ _____
_____ _____
fexpr macro
fexpr macro
% usually fexprs or macros.
+
+ Eval Apply
Eval Apply ____
The definitions of Eval and Apply may clarify which expressions are forms.
+
+ Eval Apply ContinuableError
Eval Apply ContinuableError
In Eval, Apply, and the support functions below, ContinuableError is used
+ ______
to indicate malformed lambda expressions, undefined functions or mismatched
+argument numbers; the user is permitted to correct the offending expression
+ Break
Break
or to define a missing function inside a Break loop.
+
+ Eval Apply
Eval Apply
The functions Eval and Apply are central to the PSL interpreter. Since
+their efficiency is important, some of the support functions they use are
+ LambdaApply LambdaEvalApply CodeApply
LambdaApply LambdaEvalApply CodeApply
hand-coded in LAP. The functions LambdaApply, LambdaEvalApply, CodeApply,
+CodeEvalApply IDApply1 Eval Apply
CodeEvalApply IDApply1 Eval Apply
CodeEvalApply, and IDApply1 are support functions for Eval and Apply.
+CodeApply CodeEvalApply IDApply1
CodeApply CodeEvalApply IDApply1
CodeApply and CodeEvalApply are coded in LAP. IDApply1 is handled by the
+compiler.
The Interpreter 7 February 1983 PSL Manual
+page 11.2 section 11.1
+
+ Eval
Eval _ ____ ___ ____
(Eval U:form): any expr
+
+ _
The value of the form U is computed. The following is an
+ approximation of the real code, leaving out some implementation
+ details.
PSL Manual 7 February 1983 The Interpreter
+section 11.1 page 11.3
+
+ (DE EVAL (U)
+ (PROG (FN)
+ (COND
+ ((IDP U) (RETURN (VALUECELL U))))
+ % ValueCell returns the contents of Value Cell if ID
+ % BoundP, else signals unbound error.
+ (COND ((NOT (PAIRP U)) (RETURN U)))
+
+ % This is a "constant" which EVAL's to itself
+ (COND
+ ((EQCAR (CAR U) 'LAMBDA)
+ (RETURN
+ (LAMBDAEVALAPPLY (CAR U) (CDR U)))))
+
+ % LambdaEvalApply applies the lambda- expression Car U
+ % list containing the evaluation of each argument in C
+ (COND
+ ((CODEP (CAR U))
+ (RETURN (CODEEVALAPPLY (CAR U) (CDR U)))))
+
+ % CodeEvalApply applies the function with code-pointer
+ % to the list containing the evaluation of each argume
+ % Cdr U.
+ (COND
+ ((NOT (IDP (CAR U)))
+ (RETURN
+ % permit user to correct U, and reevaluate.
+ (CONTINUABLEERROR 1101
+ "Ill-formed expression in EVAL" U))))
+
+ (SETQ FN (GETD (CAR U)))
+ (COND
+ ((NULL FN)
+ % user might define missing function and retry
+ (RETURN
+ (CONTINUABLEERROR 1001 "Undefined function EVAL
+
+ (COND
+ ((EQ (CAR FN) 'EXPR)
+ (RETURN
+ (COND
+ ((CODEP (CDR FN))
+ % CodeEvalApply applies the function with
+ % codepointer Cdr FN to the list containing
+ % evaluation of each argument in Cdr U.
+ (CODEEVALAPPLY (CDR FN) (CDR U)))
+
+ (T
+ (LAMBDAEVALAPPLY
+ (CDR FN) (CDR U)))))))
+
+ % LambdaEvalApply applies the lambda-expression Cdr FN
The Interpreter 7 February 1983 PSL Manual
+page 11.4 section 11.1
+
+ % list containing the evaluation of each argument in C
+ (COND
+ ((EQ (CAR FN) 'FEXPR)
+ % IDApply1 applies the fexpr Car U to the list of
+ % unevaluated arguments.
+ (RETURN (IDAPPLY1 (CDR U) (CAR U))))
+
+ ((EQ (CAR FN) 'MACRO)
+ % IDApply1 first expands the macro call U and then
+ % evaluates the result.
+ (RETURN (EVAL (IDAPPLY1 U (CAR U)))))
+
+ ((EQ (CAR FN) 'NEXPR)
+ % IDApply1 applies the nexpr Car U to the list obt
+ % by evaluating the arguments in Cdr U.
+ (RETURN (IDAPPLY1 (EVLIS (CDR U)) (CAR U)))))))
+
+
+ Apply
Apply __ __ ________ ____ ____ ____ ___ ____
(Apply FN:{id,function} ARGS:form-list): any expr
+
+ Apply
Apply
Apply allows one to make an indirect function call. It returns
+ __ ____
the value of FN with actual parameters ARGS. The actual
+ ____
parameters in ARGS are already in the form required for binding
+ __
to the formal parameters of FN. PSL permits the application of
+ _____ ______ _____
_____ ______ _____
_____ ______ _____
macro nexprs fexpr Apply Cdr
macro nexprs fexpr Apply Cdr
macros, nexprs and fexprs; the effect is the same as (Apply (Cdr
+ GetD
GetD __ ____
(GetD FN)) ARGS); i.e. no fix-up is done to quote arguments, etc.
+ Apply List
Apply List
as in some LISPs. A call to Apply using List on the second
+ Apply List
Apply List
argument [e.g. (Apply F (List X Y))] is compiled so that the
+ ____
list is not actually constructed.
+
+ The following is an approximation of the real code, leaving out
+ implementation details.
PSL Manual 7 February 1983 The Interpreter
+section 11.1 page 11.5
+
+ (DE APPLY (FN ARGS)
+ (PROG (DEFN)
+ (COND
+ ((CODEP FN)
+ % Spread the ARGS into the registers and transfer
+ % entry point of the function.
+ (RETURN (CODEAPPLY FN ARGS)))
+
+ ((EQCAR FN 'LAMBDA)
+ % Bind the actual parameters in ARGS to the formal
+ % parameters of the lambda expression If the two l
+ % are not of equal length then signal
+ % (CONTINUABLEERROR 1204
+ % "Number of parameters do not match"
+ % (CONS FN ARGS))
+
+ (RETURN (LAMBDAAPPLY FN ARGS)))
+
+ ((NOT (IDP FN))
+ (RETURN (CONTINUABLEERROR 1104
+ "Ill-formed function in APPLY"
+ (CONS FN ARG))))
+
+ ((NULL (SETQ DEFN (GETD FN)))
+ (RETURN (CONTINUABLEERROR 1004
+ "Undefined function in Apply"
+ (CONS FN ARGS))))
+
+ (T
+ % Do EXPR's, NEXPR's, FEXPR's and MACRO's alike, a
+ % EXPR's
+ (RETURN (APPLY (CDR DEFN) ARGS))))))
+
+ [??? Instead, could check for specific function types in Apply ???]
[??? Instead, could check for specific function types in Apply ???]
[??? Instead, could check for specific function types in Apply ???]
+
+
+
+11.2. Support Functions for Eval and Apply
11.2. Support Functions for Eval and Apply
11.2. Support Functions for Eval and Apply
+
+
+ EvLis
EvLis _ ___ ____ ___ ____ ____
(EvLis U:any-list): any-list expr
+
+ EvLis
EvLis ____ _
EvLis returns a list of the evaluation of each element of U.
+
+
+ LambdaApply
LambdaApply __ ______ _ ___ ____ ___ ____
(LambdaApply FN:lambda, U:any-list): any expr
+
+ __ ______ ______
Checks that FN is a legal lambda, binds the formals of the lambda
+ LBind1 EvProgN
LBind1 _ EvProgN
using LBind1 to the arguments in U, and then uses EvProgN to
+ ______
evaluate the forms in the lambda body. Finally the formals are
+ UnBindN
UnBindN
unbound, using UnBindN, and the result returned.
The Interpreter 7 February 1983 PSL Manual
+page 11.6 section 11.2
+
+ LambdaEvalApply
LambdaEvalApply __ ______ _ ____ ____ ___ ____
(LambdaEvalApply FN:lambda, U:form-list): any expr
+
+ LambdaApply EvLis
LambdaApply __ EvLis _
Essentially LambdaApply(FN,EvLis(U)), though done more
+ efficiently.
+
+
+ CodeApply
CodeApply __ ____ _______ _ ___ ____ ___ ____
(CodeApply FN:code-pointer, U:any-list): any expr
+
+ _
Efficiently spreads the arguments in U into the "registers", and
+ __
then transfers to the starting address referred to by FN
+
+
+ CodeEvalApply
CodeEvalApply __ ____ _______ _ ___ ____ ___ ____
(CodeEvalApply FN:code-pointer, U:any-list): any expr
+
+ CodeApply EvLis
CodeApply __ EvLis _
Essentially CodeApply(FN,EvLis(U)), though more efficient.
+
+ The following entry points are used to get efficient calls on named
+functions, and are open compiled.
+
+
+ IdApply0
IdApply0 __ __ ___ ____
(IdApply0 FN:id): any expr
+
+
+ IdApply1
IdApply1 __ ____ __ __ ___ ____
(IdApply1 A1:form, FN:id): any expr
+
+
+ IdApply2
IdApply2 __ ____ __ ____ __ __ ___ ____
(IdApply2 A1:form, A2:form, FN:id): any expr
+
+
+ IdApply3
IdApply3 __ ____ __ ____ __ ____ __ __ ___ ____
(IdApply3 A1:form, A2:form, A3:form, FN:id): any expr
+
+
+ IdApply4
IdApply4 __ ____ __ ____ __ ____ __ ____ __ __ ___ ____
(IdApply4 A1:form, A2:form, A3:form, A4:form, FN:id): any expr
+
+
+ EvProgN
EvProgN _ ____ ____ ___ ____
(EvProgN U:form-list): any expr
+
+ _
Evaluates each form in U in turn, returning the value of the
+ ProgN
ProgN
last. Used for various implied ProgNs.
+
+
+
+11.3. Special Evaluator Functions, Quote, and Function
11.3. Special Evaluator Functions, Quote, and Function
11.3. Special Evaluator Functions, Quote, and Function
+
+
+ Quote
Quote _ ___ ___ _____
(Quote U:any): any fexpr
+
+ Eval
_ Eval
Returns U. Thus the argument is not evaluated by Eval.
PSL Manual 7 February 1983 The Interpreter
+section 11.3 page 11.7
+
+ MkQuote
MkQuote _ ___ ____ ____
(MkQuote U:any): list expr
+
+ MkQuote List
MkQuote _ List
(MkQuote U) returns (List 'QUOTE U)
+
+
+ Function
Function __ ________ ________ _____
(Function FN:function): function fexpr
+
+ __ __
The function FN is to be passed to another function. If FN is to
+ have side effects its free variables must be FLUID or GLOBAL.
+ Function Quote
Function Quote
Function is like Quote but its argument may be affected by
+ compilation.
+
+ [??? Add FQUOTE, and make FUNCTION become CLOSURE ???]
[??? Add FQUOTE, and make FUNCTION become CLOSURE ???]
[??? Add FQUOTE, and make FUNCTION become CLOSURE ???]
+
+ Closure
Closure
See also the discussion of Closure and related functions in Section 10.3.
+
+
+
+11.4. Support Functions for Macro Evaluation
11.4. Support Functions for Macro Evaluation
11.4. Support Functions for Macro Evaluation
+
+
+ Expand
Expand _ ____ __ ________ ____ ____
(Expand L:list, FN:function): list expr
+
+ __
FN is a defined function of two arguments to be used in the
+ _____
_____
_____
macro Expand
macro Expand ____
expansion of a macro. Expand returns a list in the form:
+
+ (FN L[0] (FN L[1] ... (FN L[n-1] L[n]) ... ))
+
+ _
"n" is the number of elements in L, L[i] is the i'th element of
+ _
L.
+
+ (DE EXPAND (L FN)
+ (COND ((NULL (CDR L)) (CAR L))
+ (T (LIST FN (CAR L) (EXPAND (CDR L) FN)))))
+
+ [??? Add RobustExpand (sure!) (document) ???]
[??? Add RobustExpand (sure!) (document) ???]
[??? Add RobustExpand (sure!) (document) ???]
+
+ [??? Add an Evalhook and Apply hook for CMU toplevel (document) ???]
[??? Add an Evalhook and Apply hook for CMU toplevel (document) ???]
[??? Add an Evalhook and Apply hook for CMU toplevel (document) ???]
ADDED psl-1983/3-1/lpt/12-io.lpt
Index: psl-1983/3-1/lpt/12-io.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/12-io.lpt
@@ -0,0 +1,1424 @@
+PSL Manual 7 February 1983 Input and Output
+section 12.0 page 12.1
+
+ CHAPTER 12
CHAPTER 12
CHAPTER 12
+ INPUT AND OUTPUT
INPUT AND OUTPUT
INPUT AND OUTPUT
+
+
+
+
+ 12.1. Introduction . . . . . . . . . . . . . . . 12.1
+ 12.2. The Underlying Primitives for Input and Output. . . . 12.1
+ 12.3. Opening, Closing, and Selecting Channels. . . . . . 12.5
+ 12.4. Functions for Printing. . . . . . . . . . . . 12.8
+ 12.5. Functions for Reading . . . . . . . . . . . . 12.16
+ 12.5.1. Reading S-Expression . . . . . . . . . . 12.16
+ 12.5.2. Reading Files into PSL . . . . . . . . . 12.17
+ 12.5.3. Reading Single Characters . . . . . . . . 12.20
+ 12.5.4. Reading Tokens . . . . . . . . . . . . 12.21
+ 12.5.5. Read Macros . . . . . . . . . . . . . 12.30
+ 12.6. Scan Table Utility Functions. . . . . . . . . . 12.31
+ 12.7. I/O to and from Lists and Strings . . . . . . . . 12.32
+ 12.8. Example of Simple I/O in PSL. . . . . . . . . . 12.34
+
+
+
+
+12.1. Introduction
12.1. Introduction
12.1. Introduction
+
+ Most LISP programs are written with no sophisticated I/O, so this chapter
+may be skimmed by those with simple I/O requirements. Section
+12.8 contains an example showing the use of some I/O functions. This
+should help the beginning PSL user get started. Sections 12.5 and
+12.6 deal extensively with customizing the scanner and reader, which is of
+interest only to the sophisticated user.
+
+
+
+12.2. The Underlying Primitives for Input and Output
12.2. The Underlying Primitives for Input and Output
12.2. The Underlying Primitives for Input and Output
+
+ All input and output functions are implemented in terms of operations on
+ 1
+ _______
"channels". A channel is just a small integer which has 3 functions and
+some other information associated with it. The three functions are:
+
+
+ a. A reading function, which is called with the channel as its
+ _______
argument and returns the integer ASCII value of the next
+
+
+_______________
+
+ 1
+ The range of channel numbers is from 0 to MaxChannels, where MaxChannels
+is a system-dependent constant, currently 31, defined in IO-DATA.RED.
+MaxChannels is a WCONST, and is not available for use at runtime.
Input and Output 7 February 1983 PSL Manual
+page 12.2 section 12.2
+
+ character of the input stream. If the channel is for writing
+ WriteOnlyChannel
WriteOnlyChannel
only, this function is WriteOnlyChannel. If the channel has not
+ ChannelNotOpen
ChannelNotOpen
been opened, this function is ChannelNotOpen. The reading
+ function is responsible for echoing characters if the flag
+ WriteChar
WriteChar
!*ECHO is T. It should use the function WriteChar to echo the
+ character. It may not be appropriate for a read function to
+ echo characters. For example, the "disk" reading function does
+ Compress
Compress
echoing, while the reader used to implement the Compress
+ function does not.
+
+ The read function must also be concerned with the handling of
+ ends of "files" (actually, ends of channels) and ends of lines.
+ It should return the ASCII code for an end of file character
+ (system dependent) when reaching the end of a channel. It
+ should return the ASCII code for a line feed character to
+ indicate an end of line (or "newline"). This may require that
+ the ASCII code for carriage return be ignored when read, not
+ returned.
+
+ b. A writing function, which is called with the channel as its
+ _______
first argument and the integer ASCII value of the character to
+ write as its second argument. If the channel is for reading
+ ReadOnlyChannel
ReadOnlyChannel
only, this function is ReadOnlyChannel. If the channel has not
+ ChannelNotOpen
ChannelNotOpen
been opened, this function is ChannelNotOpen.
+
+ c. A closing function, which is called with the channel as its
+ argument and performs any action necessary for the graceful
+ termination of input and/or output operations to that channel.
+ ChannelNotOpen
ChannelNotOpen
If the channel is not open, this function is ChannelNotOpen.
+
+
+ The other information associated with a channel includes the current
+ Posn
Posn
position in the output line (used by Posn), the maximum line length allowed
+ LineLength
LineLength
(used by LineLength and the printing functions), the single character input
+backup buffer (used by the token scanner), and other system-dependent
+information.
+
+ Ordinarily, the user need not be aware of the existence of this
+mechanism. However, because of its generality, it is possible to implement
+operations other than just reading from and writing to files using it. In
+ Explode Compress
Explode Compress
particular, the LISP functions Explode and Compress are performed by
+ ____ ____
writing to a list and reading from a list, respectively (on channels 3 and
+4 respectively).
+
+ Ordinarily, user interaction with the system is done by reading from the
+standard input channel and writing to the standard output channel. These
+are 0 and 1 respectively, to which the GLOBAL variables STDIN!* and
+STDOUT!* are bound. These channels usually refer to the user's terminal,
+and cannot be closed. Other files are accessed by calling the function
+Open
Open
Open, which returns a channel. Most functions which perform input and
+output come in two forms, one which takes a channel as its first argument,
+ Rds
Rds
and one which uses the "currently selected channel". The functions Rds and
PSL Manual 7 February 1983 Input and Output
+section 12.2 page 12.3
+
+Wrs
Wrs
Wrs are used to change the currently selected input and output channels.
+The GLOBAL variables IN!* and OUT!* are bound to these channels.
+
+ GLOBAL variables containing information about channels are listed below.
+
+
+ __________ ______
IN!* [Initially: 0] global
+
+ Contains the currently selected input channel. This is changed
+ Rds
Rds
by the function Rds.
+
+
+ __________ ______
OUT!* [Initially: 1] global
+
+ Contains the currently selected output channel. This is changed
+ Wrs
Wrs
by the function Wrs.
+
+
+ __________ ______
STDIN!* [Initially: 0] global
+
+ The standard input channel.
+
+
+ __________ ______
STDOUT!* [Initially: 1] global
+
+ The standard output channel.
+
+
+ __________ ______
BREAKIN!* [Initially: NIL] global
+
+ BREAK
BREAK
The channel from which the BREAK loop gets its input. It has
+ been set to default to STDIN!*, but may have to be changed on
+ some systems with buffered-IO.
+
+
+ __________ ______
BREAKOUT!* [Initially: NIL] global
+
+ BREAK
BREAK
The channel to which the BREAK loop sends its output. It has
+ been set to default to STDOUT!*, but may have to be changed on
+ some systems with buffered-IO.
+
+
+ __________ ______
HELPIN!* [Initially: NIL] global
+
+ Help
Help
The channel used for input by the Help mechanism.
+
+
+ __________ ______
HELPOUT!* [Initially: NIL] global
+
+ Help
Help
The channel used for output by the Help mechanism.
Input and Output 7 February 1983 PSL Manual
+page 12.4 section 12.2
+
+ __________ ______
ERROUT!* [Initially: 1] global
+
+ ErrorPrintF
ErrorPrintF
The channel used by the ErrorPrintF.
+
+
+ __________ ______
PROMPTSTRING!* [Initially: "lisp>"] global
+
+ Displayed as a prompt when any input is taken from TTY. Thus
+ prompts should not be directly printed. Instead the value should
+ be bound to PROMPTSTRING!*.
+
+
+
+12.3. Opening, Closing, and Selecting Channels
12.3. Opening, Closing, and Selecting Channels
12.3. Opening, Closing, and Selecting Channels
+
+
+ Open
Open ________ ______ __________ __ _______ __ _______ ____
(Open FILENAME:string ACCESSTYPE:id): CHANNEL:io-channel expr
+
+ Eq
__________ Eq
If ACCESSTYPE is Eq to INPUT or OUTPUT, an attempt is made to
+ ________
access the system-dependent FILENAME for reading or writing. If
+ the attempt is unsuccessful, an error is generated; otherwise a
+ free channel is returned and initialized to the default
+ conditions for ordinary file input or output.
+
+ Eq
__________ Eq
If ACCESSTYPE is Eq to SPECIAL and the GLOBAL variables
+ SPECIALREADFUNCTION!*, SPECIALWRITEFUNCTION!*, and
+ __
SPECIALCLOSEFUNCTION!* are bound to ids, then a free channel is
+ returned and its associated functions are set to the values of
+ these variables. Other non system-dependent status is set to
+ default conditions, which can later be overridden. The functions
+ ReadOnlyChannel WriteOnlyChannel
ReadOnlyChannel WriteOnlyChannel
ReadOnlyChannel and WriteOnlyChannel are available as error
+ ________
handlers. The parameter FILENAME is used only if an error
+ occurs.
+
+ [??? We should replace these globals and SPECIAL option by a
[??? We should replace these globals and SPECIAL option by a
[??? We should replace these globals and SPECIAL option by a
+ (SPECIALOPEN Readfunction writefunction closefunction) call
(SPECIALOPEN Readfunction writefunction closefunction) call
(SPECIALOPEN Readfunction writefunction closefunction) call
+ ???]
???]
???]
+
+ If none of these conditions hold, a file is not available, or
+ there are no free channels, an error is generated.
+
+ ***** Unknown access type
+
+ ***** Improperly set-up special IO open call
+
+ ***** File not found
+
+ ***** No free channels
+
+ FileP
FileP
One can use FileP to find out whether a file exists.
PSL Manual 7 February 1983 Input and Output
+section 12.3 page 12.5
+
+ FileP
FileP ____ ______ _______ ____
(FileP NAME:string): boolean expr
+
+ ____
This function will return T if file NAME can be opened, and NIL
+ if not, e.g. if it does not exist.
+
+
+ Close
Close _______ __ _______ __ _______ ____
(Close CHANNEL:io-channel): io-channel expr
+
+ _______
The closing function associated with CHANNEL is called, with
+ _______ _______
CHANNEL as its argument. If it is illegal to close CHANNEL, if
+ _______ _______
CHANNEL is not open, or if CHANNEL is associated with a file and
+ the file cannot be closed by the operating system, this function
+ _______
generates an error. Otherwise, CHANNEL is marked as free and is
+ returned.
+
+
+ Shut
Shut _ ______ ____ ________ _____
(Shut [L:string]): None Returned macro
+
+ Shut
_ Shut
Closes the output files in the list L. Note that Shut takes file
+ Close
Close __ _______
names as arguments, while Close takes an io-channel. The RLISP
+ IN
IN
IN function maintains a stack of file-name . io-channel
+ shut
shut
associations for this purpose. Thus a shut will also correctly
+ select the previous file for further output.
+
+
+ EvShut
EvShut _ ______ ____ ____ ________ ____
(EvShut L:string-list): none Returned expr
+
+ Shut
Shut
Does the same as Shut but evaluates its arguments.
+
+
+ Rds
Rds _______ __ _______ ___ __ _______ ____
(Rds {CHANNEL:io-channel, NIL}): io-channel expr
+
+ Rds
Rds
Rds sets IN!* to the value of its argument, and returns the
+ previous value of IN!*. In addition, if SPECIALRDSACTION!* is
+ non-NIL, it should be a function of 2 arguments, which is called
+ _______ _______
with the old CHANNEL as its first argument and the new CHANNEL as
+ Rds Rds
Rds Rds
its second argument. Rds(NIL) does the same as Rds(STDIN!*).
+
+
+ Wrs
Wrs _______ __ _______ ___ __ _______ ____
(Wrs {CHANNEL:io-channel, NIL}): io-channel expr
+
+ Wrs
Wrs
Wrs sets OUT!* to the value of its argument and returns the
+ previous value of OUT!*. In addition, if SPECIALWRSACTION!* is
+ non-NIL, it should be a function of 2 arguments, which is called
+ _______ _______
with the old CHANNEL as its first argument and the new CHANNEL as
+ Wrs Wrs
Wrs Wrs
its second argument. Wrs(NIL) does the same as Wrs(STDOUT!*).
+
+
+ Out
Out _ ______ ____ ________ _____
(Out U:string): None Returned macro
+
+ _
Opens file U for output, redirecting standard output. Note that
+ Out Wrs
Out ______ Wrs __ _______
Out takes a string as an argument, while Wrs takes an io-channel.
Input and Output 7 February 1983 PSL Manual
+page 12.6 section 12.3
+
+ EvOut
EvOut _ ______ ____ ____ ________ ____
(EvOut L:string-list): None Returned expr
+
+ _
L is a list containing one file name which must be a string.
+ EvOut Out
EvOut Out
EvOut is the called by Out after evaluating its argument.
+
+ The reading and writing functions come in two flavors: those that read or
+ RDS WRS
RDS WRS
write to the current channel, as set by a previous RDS or WRS into IN!* or
+OUT!*, and those that explicitly designate the desired input or output
+ Channel
Channel
channel. The latter typically have a Channel as part of their name.
+
+ ________
The following GLOBALs are used by the functions in this section.
+
+
+ __________ ______
SPECIALCLOSEFUNCTION!* [Initially: NIL] global
+
+
+ __________ ______
SPECIALRDSACTION!* [Initially: NIL] global
+
+
+ __________ ______
SPECIALREADFUNCTION!* [Initially: NIL] global
+
+
+ __________ ______
SPECIALWRITEFUNCTION!* [Initially: NIL] global
+
+
+ __________ ______
SPECIALWRSACTION!* [Initially: NIL] global
+
+
+
+12.4. Functions for Printing
12.4. Functions for Printing
12.4. Functions for Printing
+
+
+ ChannelWriteChar
ChannelWriteChar _______ __ _______ __ _________ _________ ____
(ChannelWriteChar CHANNEL:io-channel CH:character): character expr
+
+ _______
Write one character to CHANNEL. All output is defined in terms
+ __
of this function. If CH is equal to char EOL (ASCII LF, 8#12)
+ _______
the line counter POSN associated with CHANNEL is set to zero.
+ Otherwise, it is increased by one. The writing function
+ _______ _______ __
associated with CHANNEL is called with CHANNEL and CH as its
+ arguments.
+
+
+ WriteChar
WriteChar __ _________ _________ ____
(WriteChar CH:character): character expr
+
+ Write single character to current output.
+
+ (de WRITECHAR (CH)
+ (CHANNELWRITECHAR OUT!* CH))
PSL Manual 7 February 1983 Input and Output
+section 12.4 page 12.7
+
+ ChannelPrin1
ChannelPrin1 ____ __ _______ ___ ___ ___ ___ ____
(ChannelPrin1 CHAN:io-channel ITM:any): ITM:any expr
+
+ ChannelPrin1
ChannelPrin1
ChannelPrin1 is the basic LISP printing function. For
+ well-formed, non-circular (non-self-referential) structures, the
+ Read
Read
result can be parsed by the function Read.
+
+
+ ______
- Strings are printed surrounded by double quotes (").
+
+ __
- Delimiters inside ids are preceded by the escape character
+ (!).
+
+ _____
- Floats are printed as {-}nnn.nnn{E{-}nn}.
+
+ _______
- Integers are printed as {-}nnn, unless the value of
+ OUTPUTBASE!* is not 10, in which case they are printed as
+ {-}r#nnn; r is the value of OutPutBase!*.
+
+ ____
- Pairs are printed in list-notation. For example,
+
+
+ (a . (b . c))
+
+
+ is printed as
+
+
+ (a b . c)
+
+
+ while
+
+
+ (a . (b . (c . NIL)))
+
+
+ is printed as
+
+
+ (a b c)
+
+
+ ______ ______
- Vectors are printed in vector-notation; a vector of three
+ elements a, b, and c is printed as [a b c].
+
+
+ Read
Read
The following items can be printed, but cannot be parsed by Read.
+
+
+ ____ _______
- code-pointers are printed as
+ ________ _____ _____ _______ _____ _______
#<Code argument-count octal-address>. where octal-address
+ is the octal machine address of the entry point of the code
Input and Output 7 February 1983 PSL Manual
+page 12.8 section 12.4
+
+ ______ ________ _____
vector, and argument-count is the number of arguments that
+ the code takes. The argument count cannot always be
+ determined, in which case nothing is printed for the
+ ________ _____
argument-count.
+
+ - Anything else is printed as #<Unknown:nnnn>, where nnnn is
+ the octal value found in the argument register. Such items
+ are not legal LISP entities and may cause garbage collector
+ errors if they are found in the heap.
+
+
+ Prin1
Prin1 ___ ___ ___ ___ ____
(Prin1 ITM:any): ITM:any expr
+
+
+ ErrPrin
ErrPrin _ ___ ____ ________ ____
(ErrPrin U:any): None Returned expr
+
+ Prin1
Prin1 _
Prin1 with special quotes to highlight U.
+
+
+ ChannelPrin2
ChannelPrin2 ____ __ _______ ___ ___ ___ ___ ____
(ChannelPrin2 CHAN:io-channel ITM:any): ITM:any expr
+
+ ChannelPrin2 ChannelPrin1
ChannelPrin2 ChannelPrin1 ______
ChannelPrin2 is similar to ChannelPrin1, except that strings are
+ printed without the surrounding double quotes, and delimiters
+ __
within ids are not preceded by the escape character.
+
+
+ Prin2
Prin2 ___ ___ ___ ___ ____
(Prin2 ITM:any): ITM:any expr
+
+
+ ChannelPrinC
ChannelPrinC ____ __ _______ ___ ___ ___ ___ ____
(ChannelPrinC CHAN:io-channel ITM:any): ITM:any expr
+
+ ChannelPrint2
ChannelPrint2
Same function as ChannelPrint2.
+
+
+ PrinC
PrinC ___ ___ ___ ___ ____
(PrinC ITM:any): ITM:any expr
+
+ Prin2
Prin2
Same function as Prin2.
+
+
+ ChannelPrint
ChannelPrint ____ __ _______ _ ___ _ ___ ____
(ChannelPrint CHAN:io-channel U:any): U:any expr
+
+ ChannelPrin1
_ ChannelPrin1
Display U using ChannelPrin1 and terminate line using
+ ChannelTerpri
ChannelTerpri
ChannelTerpri.
+
+
+ Print
Print _ ___ _ ___ ____
(Print U:any): U:any expr
+
+ ChannelPrint
ChannelPrint _
ChannelPrint U to current output channel, OUT!*.
PSL Manual 7 February 1983 Input and Output
+section 12.4 page 12.9
+
+ ChannelPrintF
ChannelPrintF ____ __ _______ ______ ______ ____ ___ ___ ____
(ChannelPrintF CHAN:io-channel FORMAT:string [ARGS:any]): NIL expr
+
+ ChannelPrintF
ChannelPrintF
ChannelPrintF is a simple routine for formatted printing, similar
+ ______
to the function with the same name in the C language[22]. FORMAT
+ ______
is either a LISP or SYSLISP string, which is printed on the
+ currently selected output channel. However, if a % is
+ ______
encountered in the string, the character following it is a
+ formatting directive, used to interpret and print the other
+ ChannelPrintF
ChannelPrintF
arguments to ChannelPrintF in order. The following format
+ characters are currently supported:
+
+
+ - For SYSLISP arguments, use:
+
+
+ _______
%d print the next argument as a decimal integer
+ _______
%o print the next argument as an octal integer
+ _______
%x print the next argument as a hexadecimal integer
+ %c print the next argument as a single character
+ ______
%s print the next argument as a string
+
+
+ - For LISP tagged items, use:
+
+
+ %p print the next argument as a LISP item, using
+ Prin1
Prin1
Prin1
+ %w print the next argument as a LISP item, using
+ Prin2
Prin2
Prin2
+ %r print the next argument as a LISP item, using
+ ErrPrin Prin2 Prin1 Prin2
ErrPrin Prin2 Prin1 Prin2
ErrPrin (Ordinarily Prin2 "`"; Prin1 Arg; Prin2
+ "'" )
+ %l same as %w, except lists are printed without top
+ level parens; NIL is printed as a blank
+ %e eval the next argument for side-effect -- most
+ eval
eval
useful if the thing evaled does some printing
+
+
+ - Control formats:
+
+
+ %b take next argument as an integer and print that
+ many blanks
+ %f "fresh-line", print an end-of-line character if
+ not at the beginning of the output line (does not
+ use a matching argument)
+ %n print end-of-line character (does not use a
+ matching argument)
+ %t take the next argument as an integer, and
+ ChannelTab
ChannelTab
ChannelTab to that position
Input and Output 7 February 1983 PSL Manual
+page 12.10 section 12.4
+
+ If the character following % is not either one of the above or
+ another %, it causes an error. Thus, to include a % in the
+ format to be printed, use %%.
+
+ There is no checking for correspondence between the number of
+ ______
arguments the FORMAT expects and the number given. If the number
+ ______
given is less than the number in the FORMAT string, then garbage
+ will be inserted for the missing arguments. If the number given
+ ______
is greater than the number in the FORMAT string, then the extra
+ ones are ignored.
+
+
+ PrintF
PrintF ______ ______ ____ ___ ___ ____
(PrintF FORMAT:string [ARGS:any]): NIL expr
+
+ ChannelPrintF
ChannelPrintF
ChannelPrintF to the current output channel, OUT!*.
+
+
+ ErrorPrintF
ErrorPrintF ______ ______ ____ ___ ___ ____
(ErrorPrintF FORMAT:string [ARGS:any]): NIL expr
+
+ ErrorPrintF PrintF
ErrorPrintF PrintF
ErrorPrintF is similar to PrintF, except that instead of using
+ the currently selected output channel, ERROUT!* is used. Also,
+ an end-of-line character is always printed after the message, and
+ an end-of-line character is printed before the message if the
+ line position of ERROUT!* is greater than zero.
+
+
+ ChannelTerPri
ChannelTerPri ____ __ _______ ___ ____
(ChannelTerPri CHAN:io-channel): NIL expr
+
+ ____
Terminate OUTPUT line on channel CHAN, and reset the POSN counter
+ to 0.
+
+
+ TerPri
TerPri ___ ____
(TerPri ): NIL expr
+
+ Terminate current OUTPUT line, and reset the POSN counter to 0.
+
+
+ ChannelEject
ChannelEject ____ __ _______ ___ ____
(ChannelEject CHAN:io-channel): NIL expr
+
+ ____
Skip to top of next output page on channel CHAN.
+
+
+ Eject
Eject ___ ____
(Eject ): NIL expr
+
+ Skip to top of next output page on current output channel.
+
+
+ ChannelPosn
ChannelPosn ____ __ _______ _______ ____
(ChannelPosn CHAN:io-channel): integer expr
+
+ Returns number of characters output on this line (i.e. POSN
+ counter since last Terpri) on this channel.
PSL Manual 7 February 1983 Input and Output
+section 12.4 page 12.11
+
+ Posn
Posn _______ ____
(Posn ): integer expr
+
+ Returns number of characters output on this line (i.e. POSN
+ counter since last Terpri)
+
+
+ ChannelLPosn
ChannelLPosn ____ __ _______ _______ ____
(ChannelLPosn CHAN:io-channel): integer expr
+
+ LPosn
LPosn
Returns number of lines output on this page (i.e. LPosn counter
+ since last Eject) on this channel.
+
+
+ LPosn
LPosn _______ ____
(LPosn ): integer expr
+
+ LPosn
LPosn
Returns number of lines output on this page (i.e. LPosn counter
+ since last Eject).
+
+
+ ChannelLineLength
ChannelLineLength ____ __ _______ ___ _______ ___ _______ ____
(ChannelLineLength CHAN:io-channel LEN:{integer, NIL}): integer expr
+
+ ____ _______
Set maximum output line length on CHAN if a positive integer,
+ returning previous value. If NIL just return previous value.
+ Terpri
Terpri
Controls the insertion of automatic Terpri's.
+
+
+ LineLength
LineLength ___ _______ ___ _______ ____
(LineLength LEN:{integer, NIL}): integer expr
+
+ Set maximum output line length on current channel OUT!* if a
+ _______
positive integer, returning previous value. If NIL just return
+ Terpri
Terpri
previous value. Controls the insertion of automatic Terpri's.
+
+
+ RPrint
RPrint _ ____ ___ ____
(RPrint U:form): NIL expr
+
+ Print in RLISP format. Autoloading.
+
+
+ PrettyPrint
PrettyPrint _ ____ _ ____
(PrettyPrint U:form): U expr
+
+ _
Prettyprints U. Autoloading.
+
+
+ Prin2L
Prin2L _ ___ _ ____
(Prin2L L:any): L expr
+
+ Prin2
Prin2 ____
Prin2, except that a list is printed without the top level
+ parens.
+
+
+ ChannelSpaces
ChannelSpaces ____ __ _______ _ _______ ___ ____
(ChannelSpaces CHAN:io-channel N:integer): NIL expr
+
+ ChannelPrin2
ChannelPrin2 _ _
ChannelPrin2 N spaces. Will continue across multiple lines if N
+ is greater than the number of positions in the output buffer.
Input and Output 7 February 1983 PSL Manual
+page 12.12 section 12.4
+
+ POSN LINELENGTH
POSN LINELENGTH
(See POSN and LINELENGTH)
+
+
+ Spaces
Spaces _ _______ ___ ____
(Spaces N:integer): NIL expr
+
+ Prin2
Prin2 _
Prin2 N spaces.
+
+
+ ChannelPrin2T
ChannelPrin2T ____ __ _______ _ ___ ___ ____
(ChannelPrin2T CHAN:io-channel X:any): any expr
+
+ ChannelPrin2
_ ChannelPrin2
Output X using ChannelPrin2 and terminate line with
+ ChannelTerpri
ChannelTerpri
ChannelTerpri.
+
+
+ Prin2T
Prin2T _ ___ ___ ____
(Prin2T X:any): any expr
+
+ ChannelPrin2T
ChannelPrin2T _
ChannelPrin2T X to the current output channel, OUT!*.
+
+
+ ChannelTab
ChannelTab ____ __ _______ _ _______ ___ ____
(ChannelTab CHAN:io-channel N:integer): NIL expr
+
+ _ ____
Move to position N on channel CHAN, emitting spaces as needed.
+ ChannelTerPri
ChannelTerPri _
Calls ChannelTerPri if past column N.
+
+
+ Tab
Tab _ _______ ___ ____
(Tab N:integer): NIL expr
+
+ TerPri
_ TerPri
Move to position N, emitting spaces as needed. TerPri() if past
+ _
column N.
+
+ _________ __________
The fluid variables PRINLEVEL and PRINLENGTH allow the user to control
+how deep the printer will print and how many elements at a given level the
+printer will print. This is useful for debugging or dealing large or deep
+ Prin1 Prin2 PrinC Print
Prin1 Prin2 PrinC Print
objects. These variables affect the functions Prin1, Prin2, PrinC, Print,
+ PrintF
PrintF
and PrintF (and the corresponding Channel functions). The documentation of
+these variables is from the Common Lisp Manual.
+
+
+ __________ ______
PRINLEVEL [Initially: Nil] global
+
+ Controls how many levels deep a nested data object will print.
+ _________
If PRINLEVEL is NIL, then no control is exercised. Otherwise the
+ value should be an integer, indicating the maximum level to be
+ printed. An object to be printed is at level 0.
+
+
+ __________ ______
PRINLENGTH [Initially: Nil] global
+
+ Controls how many elements at a given level are printed. A value
+ of NIL indicates that there be no limit to the number of
+ __________
components printed. Otherwise the value of PRINLENGTH should be
+ an integer.
PSL Manual 7 February 1983 Input and Output
+section 12.5 page 12.13
+
+12.5. Functions for Reading
12.5. Functions for Reading
12.5. Functions for Reading
+
+
+12.5.1. Reading S-Expression
12.5.1. Reading S-Expression
12.5.1. Reading S-Expression
+
+
+ ChannelRead
ChannelRead ____ __ _______ ___ ____
(ChannelRead CHAN:io-channel): any expr
+
+ ____
Reads and returns the next S-expression from input channel CHAN.
+ Valid input forms are: vector-notation, pair-notation, list-
+ ______ ____ _______ ______ __________
notation, numbers, code-pointers, strings, and identifiers.
+ Intern
__________ Intern
Identifiers are interned (see the Intern function in Chapter 6),
+ ChannelRead
ChannelRead
unless the FLUID variable !*COMPRESSING is non-NIL. ChannelRead
+ returns the value of the global variable !$EOF!$ when the end of
+ the currently selected input channel is reached.
+
+ ChannelRead ChannelReadToken
ChannelRead ChannelReadToken
ChannelRead uses the ChannelReadToken function, with tokens
+ scanned according to the "Lisp scan table". The user can define
+ similar read functions for use with other scan tables.
+ ____ _____
____ _____
____ _____
ChannelRead Read macro
ChannelRead Read macro
ChannelRead uses the Read macro mechanism to do S-expression
+ parsing. See section 12.5.5 for more information on read macros
+ and how to add extensions. The following read macros are defined
+ initially:
+
+
+ ( Starts a scan collecting S-expressions according to
+ ____ ____
list or dot notation until terminated by a ). A pair
+ ____
or list is returned.
+
+ [ Starts a scan collecting S-expressions according to
+ ______
vector notation until terminated by a ]. A vector is
+ returned.
+
+ Read
Read
' Calls Read to get an S-expression, x, and then returns
+ Quote
Quote
the list (Quote x).
+
+ !$EOF!$ Generates an error when still inside an S-expression:
+
+
+ ***** Unexpected EOF while reading on channel
+
+ . Otherwise !$EOF!$ is returned.
+
+
+ Read
Read ___ ____
(Read ): any expr
+
+ Reads and returns an S-expression from the current input channel.
+ ChannelRead
ChannelRead
That is, it does a ChannelRead(IN!*).
Input and Output 7 February 1983 PSL Manual
+page 12.14 section 12.5
+
+12.5.2. Reading Files into PSL
12.5.2. Reading Files into PSL
12.5.2. Reading Files into PSL
+
+ The following procedures are used to read complete files into PSL, by
+ Open
Open
first calling Open, and then looping until end of file. The effect is
+similar to what would happen if the file were typed into PSL. Recall that
+file names are strings, and therefore one needs string-quotes (") around
+file names. File names may be given using full system dependent file name
+conventions, including directories and sub-directories, "links" and
+"logical-device-names", as appropriate on the specific system.
+
+
+ __________ ______
!*ECHO [Initially: Nil] switch
+
+ ____
The switch !*ECHO is used to control the echoing of input. When
+ (On Echo) is placed in an input file, the contents of the file
+ Dskin
Dskin
are echoed on the standard output device. Dskin does not change
+ ____
the value of !*ECHO, so one may say (On Echo) before calling
+ Dskin
Dskin
Dskin, and the input will be echoed.
+
+
+ DskIn
DskIn _ ______ ____ ________ ____
(DskIn F:string): None Returned expr
+
+ Read Eval Print
Read Eval Print _
Enters a Read-Eval-Print loop on the contents of the file F.
+ DskIn
DskIn _
DskIn expects LISP syntax in the file F. Use the following
+ format: (DskIn "File").
+
+
+ LapIn
LapIn _ ______ ____ ________ ____
(LapIn U:string): None Returned expr
+
+ Reads a single LISP file as "quietly" as possible, i.e., it does
+ LapIn
LapIn
not echo or return values. Note that LapIn can be used only for
+ LISP files. By convention, files with the extension ".LAP" are
+ LapIn
LapIn
intended to be read by LapIn. These files are typically used to
+ load modules made up of several binary (also known as FASL)
+ Load
Load
files. The use of the Load function is normally preferable to
+ LapIn
LapIn
using LapIn. For information about fast loading of files of
+ Load FaslIn
Load FaslIn
compiled functions (FASL files) see FASL and the Load and FaslIn
+ functions in Chapter 18.
+
+ The following functions are present in RLISP, they can be used from
+Bare-PSL by loading RLISP.
+
+
+ In
In _ ______ ____ ________ _____
(In [L:string]): None Returned macro
+
+ DskIn
DskIn
Similar to DskIn but expects RLISP syntax in the files it reads
+ unless it can determine that the files are not in RLISP syntax.
+ In
In
Also In can take more than one file name as an argument. On most
+ In
In
systems the function In expects files with extension .LSP and .SL
+ to be written in LISP syntax, not in RLISP. This is convenient
+ when using both LISP and RLISP files. It is conventional to use
+ the extension .RED (or .R) for RLISP files and use .LSP or .SL
PSL Manual 7 February 1983 Input and Output
+section 12.5 page 12.15
+
+ only for fully parenthesized LISP files. There are some system
+ programs, such as TAGS on the DEC-20, which expect RLISP files to
+ have the extension .RED.
+
+ If it is not desired to have the contents of the file echoed as
+ In
In
it is read, either end the In command with a "$" in RLISP, as
+
+ In "FILE1.RED","FILE2.SL"$
+
+ Off
Off ____
or include the statement "Off ECHO;" in your file.
+
+
+ PathIn
PathIn ________ ____ ______ ____ ________ ____
(PathIn FileName-Tail:string): None Returned expr
+
+ IN
IN
Allows the use of a directory search path with the Rlisp IN
+ function. It finds a list of search paths in the fluid variable
+ PATHIN!*. These are successively concatenated onto the front of
+ PathIn
PathIn
the string argument to PathIn until an existing file is found
+ FileP In
FileP In
(using FileP. If one is found, In will be invoked on this file.
+ If not, a continuable error occurs. For example on the VAX,
+
+ (Setq PathIn!* '( "" "/u/psl/" "/u/smith/"))
+ (PathIn "foo.red")
+
+ will attempt to open "foo.red", then "/u/psl/foo.red", and
+ finally "/u/smith/foo.red" until a successful open is achieved.
+
+ Pathin
Pathin
To use Pathin in Bare-PSL, load PATHIN as well as RLISP.
+
+
+ EvIn
EvIn _ ______ ____ ____ ________ ____
(EvIn L:string-list): None Returned expr
+
+ EvIn
_ EvIn
L must be a list of strings that are filenames. EvIn is the
+ In In
In In
function called by In after evaluating its arguments. In is
+ EvIn
EvIn
useful only at the top-level, while EvIn can be used inside
+ functions with file names passed as parameters.
+
+
+12.5.3. Reading Single Characters
12.5.3. Reading Single Characters
12.5.3. Reading Single Characters
+
+
+ ChannelReadChar
ChannelReadChar _______ __ _______ _________ ____
(ChannelReadChar CHANNEL:io-channel): character expr
+
+ _______ _______
Reads one character (an integer) from CHANNEL. All input is
+ _______
defined in terms of this function. If CHANNEL is not open or is
+ open for writing only, an error is generated. If there is a
+ _______
non-zero value in the backup buffer associated with CHANNEL, the
+ buffer is emptied (set to zero) and the value returned.
+ _______
Otherwise, the reading function associated with CHANNEL is called
+ _______
with CHANNEL as argument, and the value it returns is returned by
+ ChannelReadChar
ChannelReadChar
ChannelReadChar.
Input and Output 7 February 1983 PSL Manual
+page 12.16 section 12.5
+
+ ***** Channel not open
+
+ ***** Channel open for write only
+
+
+ ReadChar
ReadChar _________ ____
(ReadChar ): character expr
+
+ Reads one character from the current input channel.
+
+
+ ChannelReadCH
ChannelReadCH ____ __ _______ __ ____
(ChannelReadCH CHAN:io-channel): id expr
+
+ ChannelReadChar
ChannelReadChar __
Like ChannelReadChar, but returns the id for the character rather
+ than its ASCII code.
+
+
+ ReadCH
ReadCH __ ____
(ReadCH ): id expr
+
+ ChannelReadCH
ChannelReadCH
ChannelReadCH from the current input channel.
+
+
+ ChannelUnReadChar
ChannelUnReadChar ____ __ _______ __ _________ _________ ____
(ChannelUnReadChar CHAN:io-channel CH:character): Undefined expr
+
+ __
The input backup function. CH is deposited in the backup buffer
+ ____
associated with CHAN. This function should be only called after
+ ChannelReadChar
ChannelReadChar
ChannelReadChar is called, before any intervening input
+ operations, since it is used by the token scanner.
+
+
+ UnReadChar
UnReadChar __ _________ _________ ____
(UnReadChar CH:character): Undefined expr
+
+ Backup on the current input channel.
+
+
+12.5.4. Reading Tokens
12.5.4. Reading Tokens
12.5.4. Reading Tokens
+
+ The functions described here pertain to the token scanner and reader.
+Globals and switches used by these functions are defined at the end of this
+section.
+
+
+ ChannelReadToken
ChannelReadToken _______ __ _______ __ ______ ______ ____
(ChannelReadToken CHANNEL:io-channel): {id, number, string} expr
+
+ This is the basic LISP token scanner. The value returned is a
+ LISP item corresponding to the next token from the input stream.
+ __
Ids are interned, unless the FLUID variable !*COMPRESSING is
+ non-NIL. The GLOBAL variable TOKTYPE!* is set to:
+
+
+ __
0 if the token is an ordinary id,
+ ______
1 if the token is a string,
+ ______
2 if the token is a number, or
PSL Manual 7 February 1983 Input and Output
+section 12.5 page 12.17
+
+ 3 if the token is an unescaped delimiter.
+
+
+ __
In the last case, the value returned is the id whose print name
+ is the same as the delimiter.
+
+ The precise behavior of this function depends on two FLUID
+ variables:
+
+
+ CURRENTSCANTABLE!*
+ ______
Is bound to a vector known as a scan table. Described
+ below.
+
+ CURRENTREADMACROINDICATOR!*
+ __
Bound to an id known as a read macro indicator.
+ Described below.
+
+
+ Scan tables have 129 entries, indexed by 0 through 128. 0
+ _______
through 127 are indexed by ASCII character code to get an integer
+ code determining the treatment of the corresponding character.
+ _______ __
The last entry is not an integer, but rather an id which
+ _________ _________
specifies a Diphthong Indicator for the token scanner.
+
+ [??? A future implementation may replace the FLUID
[??? A future implementation may replace the FLUID
[??? A future implementation may replace the FLUID
+ CURRENTREADMACROINDICATOR!* with another entry in the scan
CURRENTREADMACROINDICATOR!* with another entry in the scan
CURRENTREADMACROINDICATOR!* with another entry in the scan
+ table. ???]
table. ???]
table. ???]
+
+ The following encoding for characters is used.
+
+
+ 0 ... 9 DIGIT: indicates the character is a digit, and gives
+ the corresponding numeric value.
+ 10 LETTER: indicates that the character is a letter.
+ 11 DELIMITER: indicates that the character is a delimiter
+ which is not the starting character of a diphthong.
+ 12 COMMENT: indicates that the character begins a comment
+ terminated by an end of line.
+ 13 DIPHTHONG: indicates that the character is a delimiter
+ which may be the starting character of a diphthong. (A
+ diphthong is a two character sequence read as one
+ token, i.e., "<<" or ":=".)
+ 14 IDESCAPE: indicates that the character is an escape
+ character, to cause the following character to be taken
+ __
as part of an id. (Ordinarily an exclamation point,
+ i.e. "!".)
+ 15 STRINGQUOTE: indicates that the character is a string
+ quote. (Ordinarily a double quote, i.e. '"'.)
+ 16 PACKAGE: indicates that the character is used to
+ introduce explicit package names. (Ordinarily "\".)
+ 17 IGNORE: indicates that the character is to be ignored.
Input and Output 7 February 1983 PSL Manual
+page 12.18 section 12.5
+
+ (Ordinarily BLANK, TAB, EOL and NULL.)
+ 18 MINUS: indicates that the character is a minus sign.
+ 19 PLUS: indicates that the character is a plus sign.
+ 20 DECIMAL: indicates that the character is a decimal
+ point.
+ 21 IDSURROUND: indicates that the character is to act for
+ identifiers as a string quote acts for strings.
+ Although this is not used in the default scan table,
+ the intended character for this function is a vertical
+ bar, |.)
+
+
+ System builders who wish to define their own parsers can bind an
+ appropriate scan table to CURRENTSCANTABLE!* and then call
+ ChannelReadToken ChannelReadTokenWithHooks
ChannelReadToken ChannelReadTokenWithHooks
ChannelReadToken or ChannelReadTokenWithHooks for lexical
+ scanning. Utility functions for building scan tables are
+ described in the next section.
+
+ The following standards for scanning tokens are used.
+
+
+ __
- Ids begin with a letter or any character preceded by an
+ escape character. They may contain letters, digits and
+ __
escaped characters. Ids may also start with a digit, if the
+ first non-digit following is a plus sign, minus sign, or
+ letter other than "b" or "e". This is to allow identifiers
+ such as "1+" which occur in some LISPs. Finally, a string
+ of characters bounded by the IDSURROUND character is treated
+ __
as an id.
+
+ If !*RAISE is non-NIL, unescaped lower case letters are
+ __
folded to upper case. The maximum size of an id (or any
+ other token) is currently 5000 characters.
+
+ __________
Note: Using lower case letters in identifiers may cause
+ portability problems. Lower case letters are automatically
+ converted to upper case if the !*RAISE switch is T. This
+ __
case conversion is done only for id input, not for single
+ character or string input.
+
+ [??? Can we retain input Case, but Compare RAISEd ???]
[??? Can we retain input Case, but Compare RAISEd ???]
[??? Can we retain input Case, but Compare RAISEd ???]
+
+ Here are some examples, using the RLISP scan table. Note
+ that the first and second examples are read as the same
+ identifier if !*RAISE is T. The fourth and fifth examples
+ are read as the same identifier.
+
+
+ * ThisIsALongIdentifier
+ * THISISALONGIDENTIFIER
+ * ThisIsALongIdentifierAndDifferentFromTheOther
+ * this_is_a_long_identifier_with_underscores
PSL Manual 7 February 1983 Input and Output
+section 12.5 page 12.19
+
+ * this!_is!_a!_long!_identifier!_with!_underscores
+ * an!-identifier!-with!-dashes
+ * !*RAISE
+ * !2222
+
+
+ The following examples show the same identifiers in a form
+ accepted by the LISP scan table. Note that most characters
+ are treated as letters by the LISP scan table, while they
+ are treated as delimiters by the RLISP scan table.
+
+
+ * ThisIsALongIdentifier
+ * THISISALONGIDENTIFIER
+ * ThisIsALongIdentifierAndDifferentFromTheOther
+ * this_is_a_long_identifier_with_underscores
+ * this!_is!_a!_long!_identifier!_with!_underscores
+ * an-identifier-with-dashes
+ * *RAISE
+ * !2222
+
+
+ ______
- Strings begin with a double quote (") and include all
+ characters up to a closing double quote. A double quote can
+ ______ ______
be included in a string by doubling it. An empty string,
+ consisting of only the enclosing quote marks, is allowed.
+ ______
The characters of a string are not affected by the value of
+ the !*RAISE. Examples:
+
+
+ * "This is a string"
+ * "This is a ""string"""
+ * ""
+
+
+ ____ _______
- Code-pointers cannot be read directly, but can be printed
+ and constructed. Currently printed as
+ ________ _____ _____ _______
#<Code argument-count octal-address>.
+
+ _______
- Integers begin with a digit, optionally preceded by a + or
+ - sign, and consist only of digits. The GLOBAL input radix
+ is 10; there is no way to change this. However, numbers of
+ different radices may be read by the following convention.
+ A decimal number from 2 to 36 followed by a sharp sign (#),
+ causes the digits (and possibly letters) that follow to be
+ 2
+ read in the radix of the number preceding the #. Thus 63
+_______________
+
+ 2
+ Octal numbers can also be written as a string of digits followed by the
+letter "B". This "feature" may be removed in the future.
Input and Output 7 February 1983 PSL Manual
+page 12.20 section 12.5
+
+ may be entered as 8#77, or 255 as 16#ff or 16#FF. The
+ output radix can be changed, by setting OUTPUTBASE!*. If
+ _______
OutPutBase!* is not 10, the printed integer appears with
+ appropriate radix. Leading zeros are suppressed and a minus
+ _______
sign precedes the digits if the integer is negative.
+ Examples:
+
+
+ * 100
+ * +5234
+ * -8#44 (equal to -36)
+
+
+ [??? Should we permit trailing . in integers for
[??? Should we permit trailing . in integers for
[??? Should we permit trailing . in integers for
+ compatibility with some LISPs and require digits on each
compatibility with some LISPs and require digits on each
compatibility with some LISPs and require digits on each
+ side of . for floats ???]
side of . for floats ???]
side of . for floats ???]
+
+ _____
- Floats have a period and/or a letter "e" or "E" in them.
+ _____
Any of the following are read as floats. The value appears
+ in the format [-]n.nn...nnE[-]mm if the magnitude of the
+ number is too large or small to display in [-]nnnn.nnnn
+ format. The crossover point is determined by the
+ _____
implementation. In BNF, floats are recognized by the
+ grammar:
+
+
+ <base> ::= <unsigned-integer>.|
+ .<unsigned-integer>|
+ <unsigned-integer>.<unsigned-integer>
+ <ebase> ::= <base>|<unsigned-integer>
+ <unsigned-float> ::= <base>|
+ <ebase>e<unsigned-integer>|
+ <ebase>e-<unsigned-integer>|
+ <ebase>e+<unsigned-integer>|
+ <ebase>E<unsigned-integer>|
+ <ebase>E-<unsigned-integer>|
+ <ebase>E+<unsigned-integer>
+ <float> ::= <unsigned-float>|
+ +<unsigned-float>|
+ -<unsigned-float>
+
+
+ That is:
+
+
+ * [+|-][nnn][.]nnn{e|E}[+|-]nnn
+ * nnn.
+ * .nnn
+ * nnn.nnn
+
+
+ Examples:
PSL Manual 7 February 1983 Input and Output
+section 12.5 page 12.21
+
+ * 1e6
+ * .2
+ * 2.
+ * 2.0
+ * -1.25E-9
+
+
+ RAtom
RAtom __ ______ ______ ____
(RAtom ): {id, number, string} expr
+
+ Reads a token from the current input channel. (Not called
+ ReadToken
ReadToken
ReadToken for historical reasons.)
+
+ [??? Should we bind CurrentScanTable!* for this function too
[??? Should we bind CurrentScanTable!* for this function too
[??? Should we bind CurrentScanTable!* for this function too
+ ???]
???]
???]
+
+
+ __________ ______
!*COMPRESSING [Initially: NIL] switch
+
+ ChannelReadToken
ChannelReadToken
If !*COMPRESSING is non-NIL, ChannelReadToken does not intern
+ __
ids.
+
+
+ __________ ______
!*EOLINSTRINGOK [Initially: NIL] switch
+
+ If !*EOLINSTRINGOK is non-NIL, the warning message
+
+ *** STRING CONTINUED OVER END-OF-LINE
+
+ is suppressed.
+
+
+ __________ ______
!*RAISE [Initially: T] switch
+
+ __
If !*RAISE is non-NIL, all characters input for ids through PSL
+ input functions are raised to upper case. If !*RAISE is NIL,
+ ______
characters are input as is. A string is unaffected by !*RAISE.
+
+
+ __________ ______
CURRENTSCANTABLE!* [Initially: ] global
+
+ Read
Read
This variable is set to LISPSCANTABLE!* by the Read function (the
+ "Lisp syntax" reader). The RLISP reader sets it to
+ RLISPSCANTABLE!* or LISPSCANTABLE!* depending on the syntax it
+ expects.
Input and Output 7 February 1983 PSL Manual
+page 12.22 section 12.5
+
+ __________ ______
LISPSCANTABLE!* [Initially: as shown in following table] global
+
+
+0 ^@ IGNORE 32 IGNORE 64 @ LETTER 96 ` DELIMITER
+1 ^A LETTER 33 ! IDESCAPECHAR 65 A LETTER 97 a LETTER
+2 ^B LETTER 34 " STRINGQUOTE 66 B LETTER 98 b LETTER
+3 ^C LETTER 35 # LETTER 67 C LETTER 99 c LETTER
+4 ^D LETTER 36 $ LETTER 68 D LETTER 100 d LETTER
+5 ^E LETTER 37 % COMMENTCHAR 69 E LETTER 101 e LETTER
+6 ^F LETTER 38 & LETTER 70 F LETTER 102 f LETTER
+7 ^G LETTER 39 ' DELIMITER 71 G LETTER 103 g LETTER
+8 ^H LETTER 40 ( DELIMITER 72 H LETTER 104 h LETTER
+9 <tab> IGNORE 41 ) DELIMITER 73 I LETTER 105 i LETTER
+10 <lf> IGNORE 42 * LETTER 74 J LETTER 106 j LETTER
+11 ^K LETTER 43 + PLUSSIGN 75 K LETTER 107 k LETTER
+12 ^L IGNORE 44 , DIPHTHONGSTART 76 L LETTER 108 l LETTER
+13 <cr> IGNORE 45 - MINUSSIGN 77 M LETTER 109 m LETTER
+14 ^N LETTER 46 . DECIMALPOINT 78 N LETTER 110 n LETTER
+15 ^O LETTER 47 / LETTER 79 O LETTER 111 o LETTER
+16 ^P LETTER 48 0 DIGIT 80 P LETTER 112 p LETTER
+17 ^Q LETTER 49 1 DIGIT 81 Q LETTER 113 q LETTER
+18 ^R LETTER 50 2 DIGIT 82 R LETTER 114 r LETTER
+19 ^S LETTER 51 3 DIGIT 83 S LETTER 115 s LETTER
+20 ^T LETTER 52 4 DIGIT 84 T LETTER 116 t LETTER
+21 ^U LETTER 53 5 DIGIT 85 U LETTER 117 u LETTER
+22 ^V LETTER 54 6 DIGIT 86 V LETTER 118 v LETTER
+23 ^W LETTER 55 7 DIGIT 87 W LETTER 119 w LETTER
+24 ^X LETTER 56 8 DIGIT 88 X LETTER 120 x LETTER
+25 ^Y LETTER 57 9 DIGIT 89 Y LETTER 121 y LETTER
+26 ^Z DELIMITER 58 : LETTER 90 Z LETTER 122 z LETTER
+27 $ LETTER 59 ; LETTER 91 [ DELIMITER 123 { LETTER
+28 ^\ LETTER 60 < LETTER 92 \ PACKAGE 124 | LETTER
+29 ^] LETTER 61 = LETTER 93 ] DELIMITER 125 } LETTER
+30 ^^ LETTER 62 > LETTER 94 ^ LETTER 126 ~ LETTER
+31 ^_ LETTER 63 ? LETTER 95 _ LETTER 127 <rubout>
+ LETTER
+
+
+ _________ _________
The Diphthong Indicator in the 128th entry is the identifier
+LISPDIPTHONG.
+
+ [??? Note that LISPDIPTHONG should be spelled LISPDIPHTHONG, this will
[??? Note that LISPDIPTHONG should be spelled LISPDIPHTHONG, this will
[??? Note that LISPDIPTHONG should be spelled LISPDIPHTHONG, this will
+ probably be corrected in the future. ???]
probably be corrected in the future. ???]
probably be corrected in the future. ???]
PSL Manual 7 February 1983 Input and Output
+section 12.5 page 12.23
+
+ __________ ______
RLISPSCANTABLE!* [Initially: as shown in following table] global
+
+
+0 ^@ IGNORE 32 IGNORE 64 @ DELIMITER 96 ` DELIMITER
+1 ^A DELIMITER 33 ! IDESCAPECHAR 65 A LETTER 97 a LETTER
+2 ^B DELIMITER 34 " STRINGQUOTE 66 B LETTER 98 b LETTER
+3 ^C DELIMITER 35 # DELIMITER 67 C LETTER 99 c LETTER
+4 ^D DELIMITER 36 $ DELIMITER 68 D LETTER 100 d LETTER
+5 ^E DELIMITER 37 % COMMENTCHAR 69 E LETTER 101 e LETTER
+6 ^F DELIMITER 38 & DELIMITER 70 F LETTER 102 f LETTER
+7 ^G DELIMITER 39 ' DELIMITER 71 G LETTER 103 g LETTER
+8 ^H DELIMITER 40 ( DELIMITER 72 H LETTER 104 h LETTER
+9 <tab> IGNORE 41 ) DELIMITER 73 I LETTER 105 i LETTER
+10 <lf> IGNORE 42 * DIPHTHONGSTART 74 J LETTER 106 j LETTER
+11 ^K DELIMITER 43 + DELIMITER 75 K LETTER 107 k LETTER
+12 ^L IGNORE 44 , DELIMITER 76 L LETTER 108 l LETTER
+13 <cr> IGNORE 45 - DELIMITER 77 M LETTER 109 m LETTER
+14 ^N DELIMITER 46 . DECIMALPOINT 78 N LETTER 110 n LETTER
+15 ^O DELIMITER 47 / DELIMITER 79 O LETTER 111 o LETTER
+16 ^P DELIMITER 48 0 DIGIT 80 P LETTER 112 p LETTER
+17 ^Q DELIMITER 49 1 DIGIT 81 Q LETTER 113 q LETTER
+18 ^R DELIMITER 50 2 DIGIT 82 R LETTER 114 r LETTER
+19 ^S DELIMITER 51 3 DIGIT 83 S LETTER 115 s LETTER
+20 ^T DELIMITER 52 4 DIGIT 84 T LETTER 116 t LETTER
+21 ^U DELIMITER 53 5 DIGIT 85 U LETTER 117 u LETTER
+22 ^V DELIMITER 54 6 DIGIT 86 V LETTER 118 v LETTER
+23 ^W DELIMITER 55 7 DIGIT 87 W LETTER 119 w LETTER
+24 ^X DELIMITER 56 8 DIGIT 88 X LETTER 120 x LETTER
+25 ^Y DELIMITER 57 9 DIGIT 89 Y LETTER 121 y LETTER
+26 ^Z DELIMITER 58 : DIPHTHONGSTART 90 Z LETTER 122 z LETTER
+27 $ DELIMITER 59 ; DELIMITER 91 [ DELIMITER 123 { DELIMITER
+28 ^\ DELIMITER 60 < DIPHTHONGSTART 92 \ PACKAGE 124 | DELIMITER
+29 ^] DELIMITER 61 = DELIMITER 93 ] DELIMITER 125 } DELIMITER
+30 ^^ DELIMITER 62 > DIPHTHONGSTART 94 ^ DELIMITER 126 ~ DELIMITER
+31 ^_ DELIMITER 63 ? DELIMITER 95 _ LETTER 127 <rubout>
+ DELIMITER
+
+
+ _________ _________
The Diphthong Indicator in the 128th entry is the identifier
+RLISPDIPTHONG.
+
+ [??? Note that RLISPDIPTHONG should be spelled RLISPDIPHTHONG, this
[??? Note that RLISPDIPTHONG should be spelled RLISPDIPHTHONG, this
[??? Note that RLISPDIPTHONG should be spelled RLISPDIPHTHONG, this
+ will probably be corrected in the future. ???]
will probably be corrected in the future. ???]
will probably be corrected in the future. ???]
+
+ [??? What about the RlispRead scantable ???]
[??? What about the RlispRead scantable ???]
[??? What about the RlispRead scantable ???]
+
+ [??? Perhaps describe one basic table, and changes from one to other,
[??? Perhaps describe one basic table, and changes from one to other,
[??? Perhaps describe one basic table, and changes from one to other,
+ since mostly the same ???]
since mostly the same ???]
since mostly the same ???]
Input and Output 7 February 1983 PSL Manual
+page 12.24 section 12.5
+
+ __________ ______
OUTPUTBASE!* [Initially: 10] global
+
+ This global can be set to control the radix in which integers are
+ printed out. If the radix is not 10, the radix is given before a
+ sharp sign, e.g. 8#20 is"20" in base 8, or 16.
+
+
+ __________ ______
TOKTYPE!* [Initially: 3] global
+
+ ChannelReadToken
ChannelReadToken
ChannelReadToken sets TOKTYPE!* to:
+
+
+ __
0 if the token is an ordinary id,
+ ______
1 if the token is a string,
+ ______
2 if the token is a number, or
+ 3 if the token is an unescaped delimiter.
+
+
+ __
In the last case, the value returned is the id whose print name
+ is the same as the delimiter.
+
+
+12.5.5. Read Macros
12.5.5. Read Macros
12.5.5. Read Macros
+
+ Channel Token
Channel Token
A function of two arguments (Channel, Token) can be associated with any
+DELIMITER or DIPHTHONG token (i.e. those that have TOKTYPE!*=3) by calling
+PutReadMacro ChannelReadTokenWithHooks
PutReadMacro _________ ChannelReadTokenWithHooks
PutReadMacro. A ReadMacro function is called by ChannelReadTokenWithHooks
+ ChannelReadToken
ChannelReadToken
if the appropriate token with TOKTYPE!*=3 is returned by ChannelReadToken.
+This function can then take over the reading (or scanning) process, finally
+returning a token (actually an S-expression) to be returned in place of the
+token itself.
+
+ Quote
Quote
Example: The quote mark, 'x converting to (Quote x), is done by the
+ PutReadMacro
PutReadMacro
following example which makes use of the function PutReadMacro which is
+defined in Section 12.6.
+
+ In LISP:
+
+ (de DOQUOTE (CHANNEL TOKEN))
+ (LIST 'QUOTE (CHANNELREAD CHANNEL))
+
+ (PUTREADMACRO LISPSCANTABLE!* '!' (FUNCTION DOQUOTE))
+
+ _________
A ReadMacro is installed on the property list of the macro-character as a
+function under the indicators 'LISPREADMACRO, 'RLISPREADMACRO, etc. A
+_________
Diphthong is installed on the property list of the first character as
+(second-character . diphthong) under the indicators 'LISPDIPHTHONG,
+'RLISPDIPHTHONG, etc.
PSL Manual 7 February 1983 Input and Output
+section 12.6 page 12.25
+
+12.6. Scan Table Utility Functions
12.6. Scan Table Utility Functions
12.6. Scan Table Utility Functions
+
+ The following functions are provided to manage scan tables, in the
+READ-UTILS module (use via LOAD READ-UTILS):
+
+
+ PrintScanTable
PrintScanTable _____ ______ ___ ____
(PrintScanTable TABLE:vector): NIL expr
+
+ Prints the entire scantable, gives the 0 ... 127 entries with the
+ name of the character class. Also prints the indicator used for
+ diphthongs.
+
+ [??? Make smarter, reduce output, use nice names for control
[??? Make smarter, reduce output, use nice names for control
[??? Make smarter, reduce output, use nice names for control
+ characters, ala EMODE. ???]
characters, ala EMODE. ???]
characters, ala EMODE. ???]
+
+
+ CopyScanTable
CopyScanTable ________ ______ ___ ______ ____
(CopyScanTable OLDTABLE:{vector, NIL}): vector expr
+
+ Copies the existing scantable (or CURRENTSCANTABLE!* if given
+ GenSym
GenSym
NIL). Currently GenSym()'s the indicators used for diphthongs.
+
+ [??? Change when we use Property Lists in extra slots of the
[??? Change when we use Property Lists in extra slots of the
[??? Change when we use Property Lists in extra slots of the
+ Scan-Table ???]
Scan-Table ???]
Scan-Table ???]
+
+
+ PutDipthong
PutDipthong _____ ______ __ __ ___ __ ___ __ ___ ____
(PutDipthong TABLE:vector, D1:id ID2:id DIP:id): NIL expr
+
+ ___ ___ ___
Installs DIP as the name of the diphthong ID1 followed by ID2 in
+ the given scan table.
+
+ [??? Note that PutDipthong should be spelled PutDiphthong,
[??? Note that PutDipthong should be spelled PutDiphthong,
[??? Note that PutDipthong should be spelled PutDiphthong,
+ this will probably be corrected in the future. ???]
this will probably be corrected in the future. ???]
this will probably be corrected in the future. ???]
+
+
+ PutReadMacro
PutReadMacro _____ ______ ___ __ _____ __ ___ ____
(PutReadMacro TABLE:vector ID1:id FNAME:id): NIL expr
+
+ ____ _____
____ _____
____ _____
Read macro
_____ Read macro
Installs FNAME as the name of the Read macro function for the
+ ___
___
___
[not
___ [not
delimiter or diphthong ID1 in the given scan table. [not
+ ___________ ___
___________ ___
___________ ___
implemented yet]
implemented yet]
implemented yet]
+
+
+
+12.7. I/O to and from Lists and Strings
12.7. I/O to and from Lists and Strings
12.7. I/O to and from Lists and Strings
+
+
+ Digit
Digit _ ___ _______ ____
(Digit U:any): boolean expr
+
+ _
Returns T if U is a digit, otherwise NIL. Effectively this is:
+
+ (de DIGIT (U)
+ (IF (MEMQ U '(!0 !1 !2 !3 !4 !5 !6 !7 !8 !9)) T NIL))
Input and Output 7 February 1983 PSL Manual
+page 12.26 section 12.7
+
+ Liter
Liter _ ___ _______ ____
(Liter U:any): boolean expr
+
+ _
Returns T if U is a character of the alphabet, NIL otherwise.
+ This is effectively:
+
+ (de LITER(U)
+ (IF (MEMQ U '(A B C D E F G H I J K L M
+ N O P Q R S T U V W X Y Z a b c d e f
+ g h i j k l m n o p q r s t u v w x y
+ z)) T NIL))
+
+
+ Explode
Explode _ ___ __ ____ ____
(Explode U:any): id-list expr
+
+ Explode
Explode
Explode takes the constituent characters of an S-expression and
+ ____ __
forms a list of single character ids. It is implemented via the
+ ChannelPrin1
ChannelPrin1 ____
function ChannelPrin1, with a list rather than a file or terminal
+ ____
as destination. Returned is a list of interned characters
+ _
representing the characters required to print the value of U.
+ Example:
+
+
+ - Explode 'FOO; => (F O O)
+
+ - Explode '(A . B); => (!( A ! !. ! B !))
+
+
+ [??? add print macros. cf. UCI lisp ???]
[??? add print macros. cf. UCI lisp ???]
[??? add print macros. cf. UCI lisp ???]
+
+
+ Explode2
Explode2 _ ____ ______ __ ____ ____
(Explode2 U:{atom}-{vector}): id-list expr
+
+ Prin2 Explode
Prin2 Explode
Prin2 version of Explode.
+
+
+ Compress
Compress _ __ ____ ____ ______ ____
(Compress U:id-list): {atom}-{vector} expr
+
+ _ ____
U is a list of single character identifiers which is built into a
+ ______ ______
PSL entity and returned. Recognized are numbers, strings, and
+ __________
identifiers with the escape character prefixing special
+ characters. The formats of these items appear in the "Primitive
+ __________ ___
Data Types" Section, Section 4.1.2. Identifiers are not interned
+ ________ _______
on the ID-HASH-TABLE. Function pointers may not be compressed.
+ _
If an entity cannot be parsed out of U or characters are left
+ over after parsing an error occurs:
+
+ ***** Poorly formed atom in COMPRESS
PSL Manual 7 February 1983 Input and Output
+section 12.7 page 12.27
+
+ Implode
Implode _ __ ____ ____ ____
(Implode U:id-list): atom expr
+
+ Compress
Compress __
Compress with ids interned.
+
+
+ FlatSize
FlatSize _ ___ _______ ____
(FlatSize U:any): integer expr
+
+ Prin1
Prin1
Character length of Prin1 S-expression.
+
+
+ FlatSize2
FlatSize2 _ ___ _______ ____
(FlatSize2 U:any): integer expr
+
+ Prin2 flatsize
Prin2 flatsize
Prin2 version of flatsize.
+
+
+ BldMsg
BldMsg ______ ______ ____ ___ ______ ____
(BldMsg FORMAT:string, [ARGS:any]): string expr
+
+ PrintF BldMsg
PrintF ______ BldMsg ______
PrintF to string. BldMsg returns a string stating that the
+ ______
string could not be constructed if overflow occurs.
+
+
+
+12.8. Example of Simple I/O in PSL
12.8. Example of Simple I/O in PSL
12.8. Example of Simple I/O in PSL
+
+ In the following example a list of S-expressions is read, one expression
+at a time, from a file STUFF.IN and is written to a file STUFF.OUT.
+Following is the contents of STUFF.IN:
+
+ (r e d)
+ (a b c)
+ (1 2 3 4)
+ "ho ho ho"
+ 6.78
+ 5000
+ xyz
+
+ The following shows the execution of the function TRYIO.
Input and Output 7 February 1983 PSL Manual
+page 12.28 section 12.8
+
+ @psl:psl
+ PSL 3.1, 15-Nov-82
+ 1 lisp> (On Echo)
+ NIL
+ 2 lisp> (Dskin "Exampio.Sl")
+ (De Tryio (Fil1 Fil2)
+ (Prog (Oldin Oldout Exp)
+ (Setq Oldin (Rds (Open Fil1 'input)))
+ (Setq Oldout (Wrs (Open Fil2 'output)))
+ (While (Neq (Setq Exp (Read)) !$EOF!$)
+ (Print Exp))
+ (Close (Rds Oldin))
+ (Close (Wrs Oldout))))
+ TRYIO
+ NIL
+ 3 lisp> (Off Echo)
+ NIL
+ 4 lisp> (Tryio "Stuff.In" "Stuff.Out")
+ NIL
+
+ The output file STUFF.OUT contains the following.
+
+ (R E D)
+ (A B C)
+ (1 2 3 4)
+ "ho ho ho"
+ 6.78
+ 5000
+ XYZ
ADDED psl-1983/3-1/lpt/13-toploop.lpt
Index: psl-1983/3-1/lpt/13-toploop.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/13-toploop.lpt
@@ -0,0 +1,399 @@
+PSL Manual 7 February 1983 User Interface
+section 13.0 page 13.1
+
+ CHAPTER 13
CHAPTER 13
CHAPTER 13
+ USER INTERFACE
USER INTERFACE
USER INTERFACE
+
+
+
+
+ 13.1. Introduction . . . . . . . . . . . . . . . 13.1
+ 13.2. Stopping PSL and Saving a New Executable Core Image . . 13.1
+ 13.3. Init Files. . . . . . . . . . . . . . . . 13.3
+ 13.4. Changing the Default Top Level Function . . . . . . 13.3
+ 13.5. The General Purpose Top Loop Function. . . . . . . 13.4
+ 13.6. The HELP Mechanism . . . . . . . . . . . . . 13.7
+ 13.7. The Break Loop . . . . . . . . . . . . . . 13.8
+ 13.8. Terminal Interaction Commands in RLISP . . . . . . 13.8
+
+
+
+
+13.1. Introduction
13.1. Introduction
13.1. Introduction
+
+ In this chapter those functions are presented relating directly to the
+user interface; for example, the general purpose Top Loop function, the
+History mechanism, and changing the default Top Level function.
+
+
+
+13.2. Stopping PSL and Saving a New Executable Core Image
13.2. Stopping PSL and Saving a New Executable Core Image
13.2. Stopping PSL and Saving a New Executable Core Image
+
+ Quit
Quit
The normal way to stop PSL execution is to call the Quit function or to
+strike <Ctrl-C> on the DEC-20 or <Ctrl-Z> on the VAX.
+
+
+ Quit
Quit _________ ____
(Quit ): Undefined expr
+
+ Return from LISP to superior process.
+
+ After either of these actions, PSL may be re-entered by typing START or
+CONTINUE to the EXEC on the DEC-20. After exiting, the core image may also
+be saved using the Tops-20 monitor command "SAVE filename". On the VAX,
+Quit
Quit
Quit causes a stop signal to be sent, so that PSL may be continued from the
+shell. If you desire that the process be killed, use the function
+ExitLisp
ExitLisp
ExitLisp.
+
+
+ ExitLisp
ExitLisp _________ ____
(ExitLisp ): Undefined expr
+
+ Quit
Quit
To be used on the VAX. Like Quit except that the process is
+ ExitLisp
ExitLisp
killed. ExitLisp calls the Unix library routine exit().
+
+ A better way to exit and save the core image is to call the function
+SaveSystem
SaveSystem
SaveSystem.
User Interface 7 February 1983 PSL Manual
+page 13.2 section 13.2
+
+ SaveSystem
SaveSystem ___ ______ ____ ______ _____ ____ ____ _________ ____
(SaveSystem MSG:string FILE:string FORMS:form-list): Undefined expr
+
+ This records the welcome message (after attaching a date) in the
+ StandardLisp
StandardLisp
global variable LISPBANNER!* used by StandardLisp's call on
+ TopLoop DumpLisp
TopLoop DumpLisp
TopLoop, and then calls DumpLisp to compact the core image and
+ write it out as a machine dependent executable file with the name
+ ____ ____
FILE. FILE should have the appropriate extension for an
+ SaveSystem
SaveSystem
executable file. SaveSystem also sets USERMODE!* to T.
+
+ _____
The forms in the list FORMS will be evaluated when the new core
+ image is started. For example
+
+ (SaveSystem "PSL 3.1" "PSL.EXE" '((Read-Init-File "PSL")
+ (InitializeInterrupts)))
+
+ SaveSystem
SaveSystem
If RLISP has been loaded, SaveSystem will have been redefined to
+ Main
Main
save the message in the global variable DATE!*, and redefine Main
+ RlispMain Begin1
RlispMain Begin1
to call RlispMain, which uses DATE!* in Begin1. The older
+ SaveSystem LispSaveSystem
SaveSystem LispSaveSystem
SaveSystem will be saved as the function LispSaveSystem.
+
+
+ DumpLisp
DumpLisp ____ ______ _________ ____
(DumpLisp FILE:string): Undefined expr
+
+ Reclaim
Reclaim
This calls Reclaim to compact the heap, and unmaps the unused
+ pages (DEC-20) or moves various segment pointers (VAX) to
+ decrease the core image. The core image is then written as an
+ ____
executable file, with the name FILE.
+
+
+ Reset
Reset _________ ____
(Reset ): Undefined expr
+
+ Return to top level of LISP. Equivalent to <Ctrl-C> and Start on
+ DEC-20.
+
+
+ Time
Time _______ ____
(Time ): integer expr
+
+ CPU time in milliseconds since login time.
+
+
+ Date
Date ______ ____
(Date ): string expr
+
+ The date in the form 16-Dec-82.
+
+
+ __________ ______
LISPBANNER!* [Initially: ] global
+
+ SaveSystem
SaveSystem
Records the welcome message given by a call to SaveSystem from
+ Date
Date
PSL. Also contains the date, given by the function Date.
PSL Manual 7 February 1983 User Interface
+section 13.2 page 13.3
+
+ __________ ______
DATE!* [Initially: Nil] global
+
+ SaveSystem
SaveSystem
Records the welcome message given by a call to SaveSystem from
+ RLISP.
+
+
+
+13.3. Init Files
13.3. Init Files
13.3. Init Files
+
+ Init files are available to make it easier for the user to customize PSL
+to his/her own needs. When PSL, RLISP, or PSLCOMP is executed, if a file
+PSL.INIT, RLISP.INIT, or PSLCOMP.INIT (.pslrc, rlisprc, or .pslcomprc on
+the VAX) is on the home directory, it will be read and evaluated.
+Currently all init files must be written in LISP syntax. They may use
+FASLIN LOAD
FASLIN LOAD
FASLIN or LOAD as needed.
+
+ The following functions are used to implement init files, and can be
+accessed by LOADing the INIT-FILE module.
+
+
+ User-HomeDir-String
User-HomeDir-String ______ ____
(User-HomeDir-String ): string expr
+
+ Returns a full pathname for the user's home directory.
+
+
+ Init-File-String
Init-File-String ___________ ______ ______ ____
(Init-File-String PROGRAMNAME:string): string expr
+
+ Returns the full pathname of the user's init file for the program
+ ___________
PROGRAMNAME.
+
+ (Init-File-String "PSL")
+
+
+ Read-Init-File
Read-Init-File ___________ ______ ___ ____
(Read-Init-File PROGRAMNAME:string): Nil expr
+
+ ___________
Reads and evaluates the init file with name PROGRAMNAME.
+ Read-Init-File Init-File-String
Read-Init-File Init-File-String ___________
Read-Init-File calls Init-File-String with argument PROGRAMNAME.
+
+
+ (Read-Init-File "PSL")
+
+
+
+13.4. Changing the Default Top Level Function
13.4. Changing the Default Top Level Function
13.4. Changing the Default Top Level Function
+
+ As PSL starts up, it first sets the stack pointer and various other
+ Main While
Main While
variables, and then calls the function Main inside a While loop, protected
+ Catch Main StandardLisp
Catch Main StandardLisp
by a Catch. By default, Main calls a StandardLisp top loop, defined using
+ TopLoop
TopLoop
the general TopLoop function, described in the next Section. In order to
+ Main
Main
have a saved PSL come up in a different top loop, the function Main should
+be appropriately redefined by the user (e.g. as is done to create RLISP).
User Interface 7 February 1983 PSL Manual
+page 13.4 section 13.4
+
+ Main
Main _________ ____
(Main ): Undefined expr
+
+ Initialization function, called after setting the stack. Should
+ TopLoop
TopLoop
be redefined by the user to change the default TopLoop.
+
+
+
+13.5. The General Purpose Top Loop Function
13.5. The General Purpose Top Loop Function
13.5. The General Purpose Top Loop Function
+
+ PSL provides a general purpose Top Loop that allows the user to specify
+ Read Eval Print
Read Eval Print
his own Read, Eval and Print functions and otherwise obtain a standard set
+of services, such as Timing, History, Break Loop interface, and Interface
+to Help system.
+
+
+ __________ ______
TOPLOOPEVAL!* [Initially: NIL] global
+
+ Eval
Eval
The Eval used in the current Top Loop.
+
+
+ __________ ______
TOPLOOPPRINT!* [Initially: NIL] global
+
+ Print
Print
The Print used in the current Top Loop.
+
+
+ __________ ______
TOPLOOPREAD!* [Initially: NIL] global
+
+ Read
Read
The Read used in the current Top Loop.
+
+
+ TopLoop
TopLoop ___________ ________ ____________ ________
(TopLoop TOPLOOPREAD!*:function TOPLOOPPRINT!*:function
+___________ ________ ___________ __ _____________ ______ ___ ____
TOPLOOPEVAL!*:function TOPLOOPNAME!*:id WELCOMEBANNER:string): NIL expr
+
+ This function is called to establish a new Top Loop (currently
+ Standard LISP Break
Standard LISP Break
used for Standard LISP, RLISP, and Break). It prints the
+ Read-Eval-Print
_____________ Read-Eval-Print
WELCOMEBANNER and then invokes a "Read-Eval-Print" loop, using
+ ___________
the given functions. Note that TOPLOOPREAD!*, etc. are FLUID
+ variables, and so may be examined (and changed) within the
+ TopLoop
TopLoop
executing Top Loop. TopLoop provides a standard History and
+ ____ ___________
timing mechanism, retaining on a list (HISTORYLIST!*) the input
+ ____ ____
and output as a list of pairs. A prompt is constructed from
+ ___________
TOPLOOPNAME!* and is printed out, prefixed by the History count.
+ As a convention, the name is followed by a number of ">"'s,
+ indicating the loop depth.
+
+
+ __________ ______
TOPLOOPNAME!* [Initially: ] global
+
+ Short name to put in prompt.
PSL Manual 7 February 1983 User Interface
+section 13.5 page 13.5
+
+ __________ ______
TOPLOOPLEVEL!* [Initially: ] global
+
+ Depth of top loop invocations.
+
+
+ __________ ______
!*EMSGP [Initially: ] switch
+
+ Whether to print error messages.
+
+
+ __________ ______
GCTIME!* [Initially: ] global
+
+ Time spent in garbage collection.
+
+
+ __________ ______
INITFORMS!* [Initially: ] global
+
+ Forms to be evaluated at startup.
+
+
+ __________ ______
!*PECHO [Initially: NIL] switch
+
+ StandardLisp
StandardLisp
Causes parsed form read in top-loop StandardLisp to be printed,
+ if T.
+
+
+ __________ ______
!*PVAL [Initially: T] switch
+
+ StandardLisp
StandardLisp
Causes values computed in top-loop StandardLisp to be printed, if
+ T.
+
+
+ __________ ______
!*TIME [Initially: NIL] switch
+
+ If on, causes a step evaluation time to be printed after each
+ command.
+
+
+ Hist
Hist _ _______ ___ _____
(Hist [N:integer]): NIL nexpr
+
+ This function does not work with the Top Loop used by PSL:RLISP
+ or by (beginrlisp); it does work with LISP and with RLISP if it
+ Hist
Hist
is started from LISP using the RLISP function. Hist is called
+ with 0, 1 or 2 integers, which control how much history is to be
+ printed out:
+
+
+ (HIST) Display full history.
+ (HIST n m)
+ Display history from n to m.
+ (HIST n) Display history from n to present.
+ (HIST -n) Display last n entries.
User Interface 7 February 1983 PSL Manual
+page 13.6 section 13.5
+
+ [??? Add more info about what a history is. ???]
[??? Add more info about what a history is. ???]
[??? Add more info about what a history is. ???]
+
+ The following functions permit the user to access and resubmit previous
+expressions, and to re-examine previous results.
+
+
+ Inp
Inp _ _______ ___ ____
(Inp N:integer): any expr
+
+ Return N'th input at this level.
+
+
+ ReDo
ReDo _ _______ ___ ____
(ReDo N:integer): any expr
+
+ Reevaluate N'th input.
+
+
+ Ans
Ans _ _______ ___ ____
(Ans N:integer): any expr
+
+ Return N'th result.
+
+
+ __________ ______
HISTORYCOUNT!* [Initially: 0] global
+
+ Number of entries read so far.
+
+
+ __________ ______
HISTORYLIST!* [Initially: Nil] global
+
+ List of entries read and evaluated.
+
+ TopLoop StandardLisp
TopLoop StandardLisp
TopLoop has been used to define the following StandardLisp and RLISP top
+loops.
+
+
+ StandardLisp
StandardLisp ___ ____
(StandardLisp ): NIL expr
+
+ Interpreter LISP syntax top loop, defined as:
+
+ (De StandardLisp Nil
+ (Prog (CurrentReadMacroIndicator!* CurrentScanTable!*)
+ (Setq CurrentReadMacroIndicator!* 'LispReadMacro)
+ (Setq CurrentScanTable!* LispScanTable!*)
+ (Toploop 'Read 'Print 'Eval "LISP"
+ "PORTABLE STANDARD LISP")))
+
+ Note that the scan tables are modified.
+
+
+ RLisp
RLisp ___ ____
(RLisp ): NIL expr
+
+ Alternative interpreter RLISP syntax top loop, defined as:
PSL Manual 7 February 1983 User Interface
+section 13.5 page 13.7
+
+ [??? xread described in RLISP Section ???]
[??? xread described in RLISP Section ???]
[??? xread described in RLISP Section ???]
+
+ (De RLisp Nil
+ (Toploop 'XRead 'Print 'Eval "RLISP" "PSL RLISP"))
+
+ Note that for the moment, the default RLISP loop is not this
+ (though this may be used experimentally); instead a similar
+ BeginRlisp
BeginRlisp
(special purpose hand coded) function, BeginRlisp, based on the
+ Begin1
Begin1
older Begin1 is used. It is hoped to change the RLISP top-level
+ to use the general purpose capability.
+
+
+ BeginRLisp
BeginRLisp ____ ________ ____
(BeginRLisp ): None Returned expr
+
+ Starts RLISP from PSL:PSL only if RLISP is loaded. The module
+ RLISP is present if you started in RLISP and then entered PSL.
+
+
+
+13.6. The HELP Mechanism
13.6. The HELP Mechanism
13.6. The HELP Mechanism
+
+ PSL provides a general purpose Help mechanism, that is called in the
+TopLoop Help
TopLoop Help
TopLoop by invoking Help sometimes a ? may be used, as for example in the
+break loop.
+
+
+ Help
Help ______ __ ___ _____
(Help [TOPICS:id]): NIL fexpr
+
+ If no arguments are given, a message describing Help itself and
+ __
known topics is printed. Otherwise, each of the id arguments is
+ checked to see if any help information is available. If it has a
+ value under the property list indicator HelpFunction, that
+ function is called. If it has a value under the indicator
+ HelpString, the value is printed. If it has a value under the
+ indicator HelpFile, the file is displayed on the terminal. By
+ default, a file called "topic.HLP" on the Logical device, "PH:"
+ is looked for, and printed if found.
+
+ Help
Help
Help also prints out the values of the TopLoop fluids, and
+ finally searches the current Id-Hash-Table for loaded modules.
+
+
+ __________ ______
HELPIN!* [Initially: NIL] global
+
+ Help
Help
The channel used for input by the Help mechanism.
+
+
+ __________ ______
HELPOUT!* [Initially: NIL] global
+
+ Help
Help
The channel used for output by the Help mechanism.
User Interface 7 February 1983 PSL Manual
+page 13.8 section 13.7
+
+13.7. The Break Loop
13.7. The Break Loop
13.7. The Break Loop
+
+ The Break Loop is described in detail in Chapter 14. For information,
+look there.
+
+
+
+13.8. Terminal Interaction Commands in RLISP
13.8. Terminal Interaction Commands in RLISP
13.8. Terminal Interaction Commands in RLISP
+
+ Two commands are available in RLISP for use in interactive computing.
+
+
+ Pause
Pause ___ ____
(Pause ): Nil expr
+
+ The command PAUSE; may be inserted at any point in an input file.
+ If this command is encountered on input, the system prints the
+ YesP
YesP
message CONT? on the user's terminal and halts by calling YesP.
+
+
+ YesP
YesP _______ ______ _______ ____
(YesP MESSAGE:string): boolean expr
+
+ YesP
YesP
If the user responds Y or Yes, YesP returns T and the calculation
+ continues from that point in the file. If the user responds N or
+ YesP
YesP
No, YesP returns NIL and control is returned to the terminal, and
+ the user can type in further commands. However, later on he can
+ use the command CONT; and control is then transferred back to the
+ point in the file after the last PAUSE was encountered. If the
+ user responds B, one enters a break loop. After quitting the
+ break loop, one still must respond Y, N, Yes, or No.
ADDED psl-1983/3-1/lpt/14-errors.lpt
Index: psl-1983/3-1/lpt/14-errors.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/14-errors.lpt
@@ -0,0 +1,467 @@
+PSL Manual 7 February 1983 Error Handling and Recovery
+section 14.0 page 14.1
+
+ CHAPTER 14
CHAPTER 14
CHAPTER 14
+ ERROR HANDLING
ERROR HANDLING
ERROR HANDLING
+
+
+
+
+ 14.1. Introduction . . . . . . . . . . . . . . . 14.1
+ 14.2. The Basic Error Functions. . . . . . . . . . . 14.1
+ 14.3. Break Loop. . . . . . . . . . . . . . . . 14.4
+ 14.4. Interrupt Keys . . . . . . . . . . . . . . 14.7
+ 14.5. Details on the Break Loop. . . . . . . . . . . 14.7
+ 14.6. Some Convenient Error Calls . . . . . . . . . . 14.7
+ 14.7. Special Purpose Error Handlers . . . . . . . . . 14.9
+
+
+
+
+14.1. Introduction
14.1. Introduction
14.1. Introduction
+
+ In PSL, as in most LISP systems, various kinds of errors are detected by
+functions in the process of checking the validity of their argument types
+and other conditions. Errors are then "signalled" to a currently active
+ ErrorSet Error
ErrorSet Error
error handler (called ErrorSet) by a call on an Error function. In PSL,
+ Break
Break
the error handler typically calls an interactive Break loop, which permits
+the user to examine the context of the error and optionally make some
+corrections and continue the computation, or to abort the computation.
+
+ Break
Break
While in the Break loop, the user remains in the binding context of the
+function that detected the error; the user sees the value of FLUID
+variables as they are in the function itself. If the user aborts the
+ Throw
Throw
computation, a call on Throw with a tag of !$ERROR!$ is done, and fluids
+are unbound.
+
+ [??? What about errors signalled to the Interrupt Handler ???]
[??? What about errors signalled to the Interrupt Handler ???]
[??? What about errors signalled to the Interrupt Handler ???]
+
+
+
+14.2. The Basic Error Functions
14.2. The Basic Error Functions
14.2. The Basic Error Functions
+
+ The following two switches and one global variable are used by the
+functions in this section.
+
+
+ __________ ______
!*BACKTRACE [Initially: T] switch
+
+ ErrorSet
ErrorSet
Set in ErrorSet. Controls whether an unwind backtrace is
+ requested.
Error Handling and Recovery 7 February 1983 PSL Manual
+page 14.2 section 14.2
+
+ __________ ______
!*MSGP [Initially: T] switch
+
+ ErrorSet
ErrorSet
Set in ErrorSet. Controls error message printing during call on
+ error.
+
+
+ __________ ______
EMSG!* [Initially: NIL] global
+
+ Contains the message generated by the last error call.
+
+
+ ErrorSet
ErrorSet _ ___ ____ _______ _________ _______ ___ ____
(ErrorSet U:any !*MSGP:boolean !*BACKTRACE:boolean): any expr
+
+ _
If an uncorrected error occurs during the evaluation of U, the
+ ______
value of NUMBER from the associated error call is returned as the
+ ____
____
____
ErrorSet ErrorSet expr
ErrorSet ErrorSet expr _
value of ErrorSet. Note that ErrorSet is an expr, so U gets
+ evaluated twice, once as the parameter is passed and once inside
+ ErrorSet ErrorSet Catch
ErrorSet ErrorSet Catch
ErrorSet. [Actually, ErrorSet executes a Catch with tag
+ Throw
Throw
!$ERROR!$, and so intercepts any Throw with this tag.] In
+ addition, if the value of !*MSGP is non-NIL, the message from the
+ error call is displayed upon both the standard output device and
+ the currently selected output device unless the standard output
+ device is not open. The message appears prefixed with 5
+ asterisks. The message list is displayed without top level
+ parentheses. The message from the error call is available in the
+ GLOBAL variable EMSG!*. The exact format of error messages
+ generated by PSL functions described in this document may not be
+ exactly as given and should not be relied upon to be in any
+ particular form. Likewise, error numbers generated by PSL
+ functions are not fixed. Currently, a number of different calls
+ Error
Error
on Error result in the same error message, since the cause of the
+ error is the same and the information to the user is the same.
+ The error number is then used to indicate which function actually
+ detected the error.
+
+ [??? Describe Error # ranges here, or have in a file on
[??? Describe Error # ranges here, or have in a file on
[??? Describe Error # ranges here, or have in a file on
+ machine ???]
machine ???]
machine ???]
+
+ _
If no error occurs during the evaluation of U, the value of
+ List Eval
List Eval _
(List (Eval U)) is returned.
+
+ If an error has been signalled and the value of !*BACKTRACE is
+ non-NIL, a traceback sequence is initiated on the selected output
+ device. The traceback displays information such as unbindings of
+ FLUID variables, argument lists and so on in an implementation--
+ dependent format.
+
+
+ Error
Error ______ _______ _______ ___ ____ ________ ____
(Error NUMBER:integer MESSAGE:any): None Returned expr
+
+ _______
MESSAGE is placed in the GLOBAL variable EMSG!* and the error
+ ErrorSet
ErrorSet
number becomes the value of the surrounding ErrorSet (if any
PSL Manual 7 February 1983 Error Handling and Recovery
+section 14.2 page 14.3
+
+ Break
Break
intervening Break loop is exited). FLUID variables and LOCAL
+ bindings are unbound to return to the environment of the
+ ErrorSet
ErrorSet
ErrorSet. GLOBAL variables are not affected by the process.
+ Error Break
Error Break
Error actually signals a non-continuable error to the Break loop,
+ and it subsequently does a throw with tag !$ERROR!$.
+
+
+ ContinuableError
ContinuableError ______ _______ _______ ___ ____ ____ ___ ____
(ContinuableError NUMBER:integer MESSAGE:any FORM:form): any expr
+
+ _______
MESSAGE is placed in the GLOBAL variable EMSG!* and the error
+ ErrorSet
ErrorSet
number becomes the value of the surrounding ErrorSet if the
+ Break
Break
intervening Break loop is "QUIT" rather than "Continued" or
+ "Retried". FLUID variables and LOCAL bindings are unbound to
+ ErrorSet
ErrorSet
return to the environment of the ErrorSet. GLOBAL variables are
+ Error
Error
not affected by the process. Error actually signals a
+ Break
Break
continuable error to the Break loop, and it subsequently does a
+ throw with tag !$ERROR!$.
+
+ The FORM is stored in the GLOBAL variable ERRORFORM!*, for
+ examination, editing or possible reevaluation after defining
+ missing functions, etc. Setting up the ERRORFORM!* can get a bit
+ MkQuote
MkQuote
tricky, often involving MkQuoteing of already evaluated
+ arguments. The following MACRO may be useful.
+
+
+ ContError
ContError ____ ___ ___ _____
(ContError [ARGS:any]): any macro
+
+ ____
The format of ARGS is (ErrorNumber, FormatString, {arguments to
+ ____________
PrintF}, ReEvalForm). The FORMATSTRING is used with the
+ BldMsg
BldMsg
following arguments in a call on BldMsg to build an error
+ PrintF
PrintF
message. If the only argument to PrintF is a string, the
+ BldMsg
____________ BldMsg
FORMATSTRING may be omitted, and no call to BldMsg is made. The
+ ReEvalForm is something like Foo(X, Y) which becomes list('Foo,
+ MkQuote X, MkQuote Y) to be passed to the function
+ ContinuableError
ContinuableError
ContinuableError.
+
+ (DE DIVIDE (U, V)
+ (COND((ZEROP V)
+ (CONTERROR 99 "Attempt to divide by 0 in DIVIDE
+ (DIVIDE U V
+ (T (CONS (QUOTIENT U V) (REMAINDER U V)))))
+
+
+ __________ ______
!*CONTINUABLEERROR [Initially: NIL] switch
+
+ ________________
If !*CONTINUABLEERROR is T, then one is inside a continuable
+ error.
Error Handling and Recovery 7 February 1983 PSL Manual
+page 14.4 section 14.3
+
+14.3. Break Loop
14.3. Break Loop
14.3. Break Loop
+
+ Read/Eval/Print
Read/Eval/Print
On detecting an error, PSL normally enters a Read/Eval/Print loop called
+ Break
Break
a Break loop. Here the user can examine the state of his computation,
+change the values of FLUIDs, or define missing functions. He can then
+ ErrorSet
ErrorSet
dismiss the error call to the normal error handling mechanism (the ErrorSet
+above) or (in some situations) continue the computation. By setting the
+ Break
Break
switch !*BREAK to NIL, all Break loops can be suppressed, and just an error
+message is displayed.
+
+
+ __________ ______
!*BREAK [Initially: T] switch
+
+ Break
Break
Controls whether the Break package is called before unwinding the
+ stack on error.
+
+
+ __________ ______
BREAKLEVEL!* [Initially: 0] global
+
+ The current number of nesting level of breaks.
+
+
+ __________ ______
MAXBREAKLEVEL!* [Initially: 5] global
+
+ The maximum number of nesting levels of breaks permitted.
+
+ Break
Break
The prompt "Break>" indicates that PSL has entered a Break loop. A
+message of the form "Continuation requires a value for ..." may also be
+printed, in which case the user is able to continue his computation by
+ Break
Break
repairing the offending expression. By default, a Break loop uses the
+ Read Eval Print
Read Eval Print
functions Read, Eval, and Print. This may be changed by setting
+BREAKREADER!*, BREAKEVALUATOR!*, or BREAKPRINTER!* to the appropriate
+function name.
+
+
+ __________ ______
ERRORFORM!* [Initially: NIL] global
+
+ Break
Break
Contains an expression to reevaluate inside a Break loop for
+ continuable errors. [Not enough errors set this yet]. Used as a
+ tag for various Error functions.
+
+ Break
__ Break
Several ids, if typed at top-level, are special in a Break loop. These
+are used as commands, and are currently E, M, R, T, Q, A, I, and C. They
+call functions stored on their property lists under the indicator
+ __
'BreakFunction. These ids are special only at top-level, and do not cause
+any difficulty if used as variables inside expressions. However, they may
+not be simply typed at top-level to see their values. This is not expected
+to cause any difficulty. If it does, an escape command will be provided
+for examining the relevant variables.
+
+ The meanings of these commands are:
PSL Manual 7 February 1983 Error Handling and Recovery
+section 14.3 page 14.5
+
+E Edit the value of ERRORFORM!*. This is the object printed in the
+ "Continuation requires a value for ..." message. The function
+ BreakEdit
BreakEdit
BreakEdit is the associated function called by this command. The
+ Retry
Retry
Retry command (below) uses the corrected version of ERRORFORM!*.
+ The currently available editors are described in Chapter 16.
+
+ BreakErrmsg
BreakErrmsg
M Show the modified ERRORFORM!*. Calls the function BreakErrmsg.
+
+R Retry. This tries to evaluate the offending expression again,
+ and continue the computation. It evaluates the value of
+ ERRORFORM!*. This is often useful after defining a missing
+ Edit
Edit
function, assigning a value to a variable, or using the Edit
+ BreakRetry
BreakRetry
command, above. This command calls the function BreakRetry.
+
+ Break
Break
C This causes the expression last printed by the Break loop to be
+ returned as the value of the offending expression. This is often
+ useful as an automatic stub. If an expression containing an
+ Break
Break
undefined function is evaluated, a Break loop is entered, and
+ this may be used to return the value of the function call. This
+ BreakContinue
BreakContinue
command calls the function BreakContinue.
+
+ Break
Break
Q Quit. This exits the Break loop by throwing to the closest
+ ErrorSet BreakQuit
ErrorSet BreakQuit
surrounding ErrorSet. It calls the function BreakQuit.
+
+A Abort. This aborts to the top level, i.e., restarts PSL. It
+ Reset
Reset
calls the function Reset.
+
+T Trace. This prints a backtrace of function calls on the stack
+ except for those on the lists IGNOREDINBACKTRACE!* and
+ BackTrace
BackTrace
INTERPRETERFUNCTIONS!*. It calls the function BackTrace.
+
+I Interpreter Trace. This prints a backtrace of only interpreted
+ functions call on the stack except for those on the list
+ InterpBackTrace
InterpBackTrace
INTERPRETERFUNCTIONS!*. It calls the function InterpBackTrace.
+
+
+An attempt to continue a non-continuable error with R or C prints a message
+and behaves as Q.
+
+
+ __________
IGNOREDINBACKTRACE!* [Initially: '(Eval Apply FastApply CodeApply
+CodeEvalApply Catch ErrorSet EvProgN TopLoop BreakEval
+ ______
BindEval Break Main)] global
+
+ A list of function names that will not be printed by the commands
+ Break
Break
I and T given within a Break loop.
+
+
+ __________ ______
INTERPRETERFUNCTIONS!* [Initially: '(Cond Prog And Or ProgN SetQ)] global
+
+ A list of function names that will not be printed by the command
+ Break
Break
I given within a Break loop.
Error Handling and Recovery 7 February 1983 PSL Manual
+page 14.6 section 14.3
+
+ The above two globals can be reset in an init file if the programmer
+desires to do so.
+
+ The following is a slightly edited transcript, showing some of the BREAK
+options:
PSL Manual 7 February 1983 Error Handling and Recovery
+section 14.3 page 14.7
+
+ % foo is an undefined function, so the following has two errors
+ % in it
+
+ 1> (Plus2 (foo 1)(foo 2))
+ ***** `FOO' is an undefined function {1001}
+ ***** Continuation requires a value for `(FOO 1)'
+ Break loop
+ 1 lisp break> (plus2 1 1) % We simply compute a value
+ 2 % prints as 2
+ 2 lisp break> c % continue with this value
+
+ % it returns to compute "(foo 2)"
+
+ ***** `FOO' is an undefined function {1001}
+ ***** Continuation requires a value for `(FOO 2)'
+ Break loop
+ 1 lisp break> 3 % again compute a value
+ 3
+ 2 lisp break> c % and return
+ 5 % finally complete
+
+ % Pretend that we had really meant to call "fee":
+
+ 2> (de fee (x) (add1 x))
+ FEE
+ 3> (plus2 (foo 1)(foo 2)) % now the bad expression
+ ***** `FOO' is an undefined function {1001}
+ ***** Continuation requires a value for `(FOO 1)'
+ Break loop
+ 1 lisp break> e % lets edit it
+
+ Type HELP<CR> for a list of commands.
+
+ edit> p % print form
+ (FOO 1)
+ edit> (1 fee) % replace 1'st by "fee"
+ edit> p % print again
+ (FEE 1)
+ edit> ok % we like it
+ (FEE 1)
+ 2 lisp break> m % show modified ErrorForm!*
+ ErrorForm!* : `(FEE 1)'
+ NIL
+ 3 lisp break> r % Retry EVAL ErrorForm!*
+ ***** `FOO' is an undefined function {1001}
+ ***** Continuation requires a value for `(FOO 2)'
+ Break loop
+ 1 lisp break> (de foo(x) (plus2 x 1)) % define foo
+ FOO
+ 2 lisp break> r % and retry
+ 5
Error Handling and Recovery 7 February 1983 PSL Manual
+page 14.8 section 14.4
+
+14.4. Interrupt Keys
14.4. Interrupt Keys
14.4. Interrupt Keys
+
+ Need to "LOAD INTERRUPT;" to enable. This applies only to the DEC20.
+
+ <Ctrl-T> indicates routine currently executing, gives the load average,
+and gives the location counter in octal;
+
+ <Ctrl-G> returns you to the Top-Loop;
+
+ <Ctrl-B> takes you into a lower-level Break loop.
+
+
+
+14.5. Details on the Break Loop
14.5. Details on the Break Loop
14.5. Details on the Break Loop
+
+ Break Error
Break Error
If the SWITCH !*BREAK is T, the function Break() is called by Error or
+ContinuableError
ContinuableError
ContinuableError before unwinding the stacks, or printing a backtrace.
+ Break
Break
Input and output to/from Break loops is done from/to the values (channels)
+of BREAKIN!* and BREAKOUT!*. The channels selected on entrance to the
+Break
Break
Break loop are restored upon exit.
+
+
+ __________ ______
BREAKIN!* [Initially: NIL] global
+
+ Rds
Rds
So Rds chooses STDIN!*.
+
+
+ __________ ______
BREAKOUT!* [Initially: NIL] global
+
+ Similar to BREAKIN!*.
+
+ Break Read-Eval-Print
Break Read-Eval-Print
Break is essentially a Read-Eval-Print function, called in the error
+context. Any FLUID may be printed or changed, function definitions
+ Break TopLoop
Break TopLoop
changed, etc. The Break uses the normal TopLoop mechanism (including
+ Catch TopLoop
Catch TopLoop
History), embedded in a Catch with tag !$BREAK!$. The TopLoop attempts to
+use the parent loop's TOPLOOPREAD!*, TOPLOOPPRINT!* and TOPLOOPEVAL!*; the
+BreakEval
BreakEval __
BreakEval function first checks top-level ids to see if they have a special
+BREAKFUNCTION on their property lists, stored under 'BREAKFUNCTION. This
+is expected to be a function of no arguments, and is applied instead of
+Eval
Eval
Eval.
+
+
+
+14.6. Some Convenient Error Calls
14.6. Some Convenient Error Calls
14.6. Some Convenient Error Calls
+
+ The following functions may be useful in user packages:
+
+
+ FatalError
FatalError _ ___ ____ ________ ____
(FatalError S:any): None Returned expr
PSL Manual 7 February 1983 Error Handling and Recovery
+section 14.6 page 14.9
+
+ (ProgN (ErrorPrintF "***** Fatal error: %s" S)
+ (While T Quit))
+
+
+ RangeError
RangeError ______ ___ _____ _______ __ ________ ____ ________ ____
(RangeError Object:any Index:integer Fn:function): None Returned expr
+
+ (StdError (BldMsg "Index %r out of range for %p in %p"
+ Index Object Fn))
+
+
+ StdError
StdError _______ ______ ____ ________ ____
(StdError Message:string): None Returned expr
+
+ (Error 99 Message)
+
+
+ TypeError
TypeError ________ ___ __ ________ ___ ___ ____ ________ ____
(TypeError Offender:any Fn:function Typ:any): None Returned expr
+
+ (StdError (BldMsg "An attempt was made to do %p on %r,
+ which is not %w" Fn Offender Typ))
+
+
+ UsageTypeError
UsageTypeError ___ ___ __ ________ ___ ___ _____ ___ ____ ________ ____
(UsageTypeError Off:any Fn:function Typ:any Usage:any): None Returned expr
+
+ (StdError
+ (BldMsg "An attempt was made to use %r as %w in %p,
+ where %w is needed" Offender Usage Fn Typ))
+
+
+ IndexError
IndexError ________ ___ __ ________ ____ ________ ____
(IndexError Offender:any Fn:function): None Returned expr
+
+ (UsageTypeError Offender Fn "an integer" "an index")
+
+
+ NonPairError
NonPairError ________ ___ __ ________ ____ ________ ____
(NonPairError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a pair")
+
+
+ NonIDError
NonIDError ________ ___ __ ________ ____ ________ ____
(NonIDError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "an identifier")
+
+
+ NonNumberError
NonNumberError ________ ___ __ ________ ____ ________ ____
(NonNumberError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a number")
+
+
+ NonIntegerError
NonIntegerError ________ ___ __ ________ ____ ________ ____
(NonIntegerError Offender:any Fn:function): None Returned expr
Error Handling and Recovery 7 February 1983 PSL Manual
+page 14.10 section 14.6
+
+ (TypeError Offender Fn "an integer")
+
+
+ NonPositiveIntegerError
NonPositiveIntegerError ________ ___ __ ________ ____ ________ ____
(NonPositiveIntegerError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a non-negative integer")
+
+
+ NonCharacterError
NonCharacterError ________ ___ __ ________ ____ ________ ____
(NonCharacterError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a character")
+
+
+ NonStringError
NonStringError ________ ___ __ ________ ____ ________ ____
(NonStringError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a string")
+
+
+ NonVectorError
NonVectorError ________ ___ __ ________ ____ ________ ____
(NonVectorError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a vector")
+
+
+ NonSequenceError
NonSequenceError ________ ___ __ ________ ____ ________ ____
(NonSequenceError Offender:any Fn:function): None Returned expr
+
+ (TypeError Offender Fn "a sequence")
+
+
+
+14.7. Special Purpose Error Handlers
14.7. Special Purpose Error Handlers
14.7. Special Purpose Error Handlers
+
+ [??? This needs to be rethought and reimplemented. Currently not
[??? This needs to be rethought and reimplemented. Currently not
[??? This needs to be rethought and reimplemented. Currently not
+ installed. ???]
installed. ???]
installed. ???]
+
+ It is possible to handle errors specially. The value of
+ Error
_ ____ ____ Error
ERRORHANDLERS!* is an a-list of error number/handler pairs. If Error is
+ Car
Car
called with a number which appears as the Car of an element of
+ Cdr
Cdr
ERRORHANDLERS!*, its Cdr is taken to be a function of two variables, the
+error number and the error message, which is called instead. If called
+ ContinuableError
ContinuableError
from ContinuableError with a non-NIL third argument, any value returned by
+the error handler is returned as the value of the function call.
+ Throw
Throw
Otherwise, normal termination of the handler Throws to the closest
+ ErrorSet
ErrorSet
surrounding ErrorSet.
ADDED psl-1983/3-1/lpt/15-debug.lpt
Index: psl-1983/3-1/lpt/15-debug.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/15-debug.lpt
@@ -0,0 +1,1066 @@
+PSL Manual 7 February 1983 Debugging Tools
+section 15.0 page 15.1
+
+ CHAPTER 15
CHAPTER 15
CHAPTER 15
+ DEBUGGING TOOLS
DEBUGGING TOOLS
DEBUGGING TOOLS
+
+
+
+
+ 15.1. Introduction . . . . . . . . . . . . . . . 15.1
+ 15.1.1. Brief Summary of Full Debug Package . . . . . 15.1
+ 15.1.2. Mini-Trace Facility . . . . . . . . . . 15.2
+ 15.1.3. Step . . . . . . . . . . . . . . . 15.3
+ ....
15.1.4. Functions Which Depend on Redefining User Functions..15.4
+
+ 15.1.5. A Few Known Deficiencies. . . . . . . . . 15.5
+ 15.2. Tracing Function Execution . . . . . . . . . . 15.5
+ 15.2.1. Tracing Functions . . . . . . . . . . . 15.5
+ 15.2.2. Saving Trace Output . . . . . . . . . . 15.6
+ 15.2.3. Making Tracing More Selective . . . . . . . 15.7
+ 15.2.4. Turning Off Tracing . . . . . . . . . . 15.9
+ 15.2.5. Enabling Debug Facilities and Automatic Tracing of 15.9
+ Newly Defined Functions . . . . . . . . .
+ 15.3. A Heavy Handed Backtrace Facility . . . . . . . . 15.10
+ 15.4. Embedded Functions . . . . . . . . . . . . . 15.11
+ 15.5. Counting Function Invocations . . . . . . . . . 15.12
+ 15.6. Stubs . . . . . . . . . . . . . . . . . 15.12
+ 15.7. Functions for Printing Useful Information . . . . . 15.13
+ 15.8. Printing Circular and Shared Structures . . . . . . 15.13
+ 15.9. Internals and Customization . . . . . . . . . . 15.14
+ 15.9.1. User Hooks . . . . . . . . . . . . . 15.14
+ 15.9.2. Functions Used for Printing/Reading . . . . . 15.15
+ 15.10. Example . . . . . . . . . . . . . . . . 15.16
+
+
+
+
+15.1. Introduction
15.1. Introduction
15.1. Introduction
+
+ PSL offers a small group of debugging functions in a mini-trace package
+described in Section MINITRACE; in addition, there is a separate debugging
+package which is the subject of the bulk of this Chapter. To use the
+debugging package (LOAD DEBUG). An extensive example showing the use of
+the facilities in the debugging package can be found in Section 15.10.
+
+
+15.1.1. Brief Summary of Full Debug Package
15.1.1. Brief Summary of Full Debug Package
15.1.1. Brief Summary of Full Debug Package
+
+ The PSL debugging package contains a selection of functions that can be
+ 1
+used to aid program development and to investigate faulty programs.
+_______________
+
+ 1
+ Much of this Chapter was adapted from a paper by Norman and Morrison.
Debugging Tools 7 February 1983 PSL Manual
+page 15.2 section 15.1
+
+ It contains the following facilities.
+
+
+ - A trace package. This allows the user to see the arguments
+ passed to and the values returned by selected functions. It is
+ also possible to have traced interpreted functions print all the
+ SetQ
SetQ
assignments they make with SetQ (see Section 15.2).
+
+ - A backtrace facility. This allows one to see which of a set of
+ selected functions were active as an error occurred (see Section
+ 15.3).
+
+ - Embedded functions make it possible to do everything that the
+ trace package can do, and much more besides (see Section 15.4).
+ This facility is available only in RLISP.
+
+ - Some primitive statistics gathering (see Section 15.5).
+
+ - Generation of simple stubs. If invoked, procedures defined as
+ stubs simply print their argument and read a value to return (see
+ Section 15.6).
+
+ - Some functions for printing useful information, such as property
+ lists, in an intelligible format (see Section 15.7).
+
+ PrintX
PrintX
- PrintX is a function that can print circular and re-entrant lists
+ and vectors, and so can sometimes allow debugging to proceed even
+ RplacA
RplacA
in the face of severe damage caused by the wild use of RplacA and
+ RplacD
RplacD
RplacD (see Section 15.8).
+
+
+ [??? Install a feature BR and UNBR to wrap a break around functions.
[??? Install a feature BR and UNBR to wrap a break around functions.
[??? Install a feature BR and UNBR to wrap a break around functions.
+ See the old mini-trace (PK:MINI-TRACE.RED). ???]
See the old mini-trace (PK:MINI-TRACE.RED). ???]
See the old mini-trace (PK:MINI-TRACE.RED). ???]
+
+
+15.1.2. Mini-Trace Facility
15.1.2. Mini-Trace Facility
15.1.2. Mini-Trace Facility
+
+ A small trace package is provided in the bare PSL and RLISP. This
+ Tr
Tr
provides a command Tr for tracing LISP function calls, as does the full
+ UnTr
UnTr
Debug package. This command and the associated command UnTr are used in
+the form:
+
+
+ Tr
Tr
Tr <function name>, <function name>,..., <function name>;
+ or
+ Tr
Tr
Tr( <function name>, <function name>,..., <function name>);
+
+ from RLISP, and
+
+ Tr
Tr
(Tr <function name> <function name> ... <function name>)
+
+ from LISP.
PSL Manual 7 February 1983 Debugging Tools
+section 15.1 page 15.3
+
+ Tr
Tr _____ __ _________ _____
(Tr [FNAME:id]): Undefined macro
+
+
+ UnTr
UnTr _____ __ _________ _____
(UnTr [FNAME:id]): Undefined macro
+
+ Mini-Trace also contains the capability for tracing interpreted functions
+ Trst
Trst
at a deeper level. Trst causes the body of an interpreted function to be
+ Trst
Trst
redefined so that all assignments in its body are printed. Calling Trst on
+ Tr UnTrst
Tr UnTrst
a function has the effect of doing a Tr on it too. The function UnTrst is
+ Trst
Trst
used to turn off the effects of Trst. These functions are used in the same
+ Tr UnTr
Tr UnTr
way as Tr and UnTr.
+
+
+ Trst
Trst _____ __ _________ _____
(Trst [FNAME:id]): Undefined macro
+
+
+ UnTrst
UnTrst _____ __ _________ _____
(UnTrst [FNAME:id]): Undefined macro
+
+ Tr Trst
Tr Trst
Note that only the functions Tr and Trst are in Mini-Trace. However
+invoking either of them causes the debug package to be loaded, making the
+rest of the functions in Debug available.
+
+ Do (HELP TRACE) for more information, or see Section 15.2.
+
+
+15.1.3. Step
15.1.3. Step
15.1.3. Step
+
+
+ Step
Step _ ____ ___ ____
(Step F:form): any expr
+
+ Step
Step _
Step is a loadable option (LOAD STEP). It evaluates the form F,
+ _
single-stepping. F is printed, preceded by -> on entry, <-> for
+ _
macro expansions. After evaluation, F is printed preceded by
+ <- and followed by the result of evaluation. A single character
+ is read at each step to determine the action to be taken:
+
+
+ <Ctrl-N> (Next)
+ Step to the Next thing. The stepper continues until
+ the next thing to print out, and it accepts another
+ command.
+
+ Space Go to the next thing at this level. In other words,
+ continue to evaluate at this level, but don't step
+ anything at lower levels. This is a good way to skip
+ over parts of the evaluation that don't interest you.
+
+ <Ctrl-U> (Up)
+ Continue evaluating until we go up one level. This is
+ like the space command, only more so; it skips over
+ anything on the current level as well as lower levels.
Debugging Tools 7 February 1983 PSL Manual
+page 15.4 section 15.1
+
+ <Ctrl-X> (eXit)
+ Exit; finish evaluating without any more stepping.
+
+ <Ctrl-G> or <Ctrl-P> (Grind)
+ Grind (i.e. prettyprint) the current form.
+
+ <Ctrl-R> Grind the form in Rlisp syntax.
+
+ <Ctrl-E> (Editor)
+ Invoke the structure editor on the current form.
+
+ <Ctrl-B> (Break)
+ Enter a break loop from which you can examine the
+ values of variables and other aspects of the current
+ environment.
+
+ <Ctrl-L> Redisplay the last 10 pending forms.
+
+ ? Display the help file.
+
+
+ H
H _
To step through the evaluation of function H on argument X do
+
+ (Step '(H X))
+
+
+15.1.4. Functions Which Depend on Redefining User Functions
15.1.4. Functions Which Depend on Redefining User Functions
15.1.4. Functions Which Depend on Redefining User Functions
+
+ A number of facilities in Debug depend on redefining user functions, so
+that they may log or print behavior if called. The Debug package tries to
+redefine user functions once and for all, and then keep specific
+information about what is required at run time in a table. This allows
+considerable flexibility, and is used for a number of different facilities,
+including trace/traceset in Section 15.2, a backtrace facility in Section
+15.3, some statistics gathering in Section 15.5 and embedding functions in
+Section 15.4.
+
+ Some facilities, like trace and EMB (the embedding function), only take
+effect if further action is requested on specific user functions. Others,
+like backtrace and statistics, are of a more global nature. Once one of
+these global facilities is enabled it applies to all functions which have
+ Restr
Restr
been made "known" to Debug. To undo this, use Restr defined in Section
+15.2.4.
+
+
+15.1.5. A Few Known Deficiencies
15.1.5. A Few Known Deficiencies
15.1.5. A Few Known Deficiencies
+
+
+ Cons
Cons
- An attempt to trace certain system functions (e.g. Cons) causes
+ the trace package to overwrite itself. Given the names of
+ functions that cause this sort of trouble it is fairly easy to
+ change the trace package to deal gracefully with them - so report
PSL Manual 7 February 1983 Debugging Tools
+section 15.1 page 15.5
+
+ trouble to a system expert.
+
+ - The Portable LISP Compiler uses information about registers which
+ certain system functions destroy. Tracing these functions may
+ make the optimizations based thereon invalid. The correct way of
+ handling this problem is currently under consideration. In the
+ mean time you should avoid tracing any functions with the ONEREG
+ or TWOREG flags.
+
+
+
+15.2. Tracing Function Execution
15.2. Tracing Function Execution
15.2. Tracing Function Execution
+
+
+15.2.1. Tracing Functions
15.2.1. Tracing Functions
15.2.1. Tracing Functions
+
+ To see when a function gets called, what arguments it is given and what
+value it returns, do
+
+ (TR functionname)
+
+or if several functions are of interest,
+
+ (TR name1 name2 ...)
+
+
+ Tr
Tr _____ __ _________ _____
(Tr [FNAME:id]): Undefined macro
+
+ ____ _____ _____
____ _____ _____
____ _____ _____
expr fexpr nexpr
expr fexpr nexpr
If the specified functions are defined (as expr, fexpr, nexpr or
+ _____
_____
_____
macro Tr
macro Tr
macro), Tr modifies the function definition to include print
+ statements. The following example shows the style of output
+ produced by this sort of tracing:
+
+ The input...
+
+ (DE XCDR (A)
+ (CDR A) %A very simple function)
+ (TR XCDR)
+ (XCDR '(P Q R))
+
+ gives output...
+
+ XCDR entered
+ A: (P Q R)
+ XCDR = (Q R)
+
+ Interpreted functions can also be traced at a deeper level.
Debugging Tools 7 February 1983 PSL Manual
+page 15.6 section 15.2
+
+ Trst
Trst _____ __ _________ _____
(Trst [FNAME:id]): Undefined macro
+
+ (TRST name1 name2 ...)
+
+ causes the body of an interpreted function to be redefined so
+ SetQ
SetQ
that all assignments (made with SetQ) in its body are printed.
+ Trst
Trst
Calling Trst on a function automatically has the effect of doing
+ Tr
Tr
a Tr on it too, so that it is not possible to have a function
+ Trst Tr
Trst Tr
subject to Trst but not Tr.
+
+ Trace output often appears mixed up with output from the program being
+ Tr
Tr
studied, and to avoid too much confusion Tr arranges to preserve the column
+in which printing was taking place across any output that it generates. If
+trace output is produced as part of a line has been printed, the trace data
+are enclosed in markers '<' and '>', and these symbols are placed on the
+line so as to mark out the amount of printing that had occurred before
+trace was entered.
+
+
+ __________ ______
!*NOTRARGS [Initially: NIL] switch
+
+ If !*NOTRARGS is T, printing of the arguments of traced functions
+ is suppressed.
+
+
+15.2.2. Saving Trace Output
15.2.2. Saving Trace Output
15.2.2. Saving Trace Output
+
+ The trace facility makes it possible to discover in some detail how a
+function is used, but in certain cases its direct use results in the
+generation of vast amounts of (mostly useless) print-out. There are
+several options. One is to make tracing more selective (see Section
+15.2.3). The other, discussed here, is to either print only the most
+recent information, or dump it all to a file to be perused at leisure.
+
+ Debug has a ring buffer in which it saves information to reproduce the
+ Tr Trst
Tr Trst
most recent information printed by the trace facility (both Tr and Trst).
+ Tr
Tr
To see the contents of this buffer use Tr without any arguments
+
+ (TR)
+
+
+ NewTrBuff
NewTrBuff _ _______ _________ ____
(NewTrBuff N:integer): Undefined expr
+
+ To set the number of entries retained to n use
+
+ (NEWTRBUFF n)
+
+ Initially the number of entries in the ring buffer is 5.
PSL Manual 7 February 1983 Debugging Tools
+section 15.2 page 15.7
+
+ __________ ______
!*TRACE [Initially: T] switch
+
+ Enables runtime printing of trace information for functions which
+ have been traced.
+
+ Turning off the TRACE switch
+
+ (OFF TRACE)
+
+suppresses the printing of any trace information at run time; it is still
+saved in the ring buffer. Thus a useful technique for isolating the
+function in which an error occurs is to trace a large number of candidate
+functions, do OFF TRACE and after the failure look at the latest trace
+ Tr
Tr
information by calling Tr with no arguments.
+
+
+ TrOut
TrOut _____ __ _________ ____
(TrOut [FNAME:id]): Undefined expr
+
+
+ StdTrace
StdTrace _________ ____
(StdTrace ): Undefined expr
+
+ Normally trace information is directed to the standard output,
+ rather than the currently selected output. To send it elsewhere
+ use the statement
+
+ (TROUT filename)
+
+ The statement
+
+ (STDTRACE)
+
+ closes that file and cause future trace output to be sent to the
+ standard output. Note that output saved in the ring buffer is
+ sent to the currently selected output, not that selected by
+ TrOut
TrOut
TrOut.
+
+
+15.2.3. Making Tracing More Selective
15.2.3. Making Tracing More Selective
15.2.3. Making Tracing More Selective
+
+
+ TraceCount
TraceCount _ _______ _________ ____
(TraceCount N:integer): Undefined expr
+
+ TraceCount
TraceCount
The function (TraceCount n) can be used to switch off trace
+ TraceCount
TraceCount
output. If n is a positive number, after a call to (TraceCount
+ n) the next n items of trace output that are generated are not
+ TraceCount
TraceCount
printed. (TraceCount n) with n negative or zero switches all
+ TraceCount
TraceCount
trace output back on. (TraceCount NIL) returns the residual
+ count, i.e. the number of additional trace entries that are
+ suppressed.
+
+ To get detailed tracing in the stages of a calculation that lead up to an
+error, try
Debugging Tools 7 February 1983 PSL Manual
+page 15.8 section 15.2
+
+ (TRACECOUNT 1000000) % or some other suitable large number
+ (TR ...) % as required
+ %run the failing problem
+ (TRACECOUNT NIL)
+
+It is now possible to calculate how many trace entries occurred before the
+ TraceCount
TraceCount
error, and so the problem can now be re-run with TraceCount set to some
+number slightly less than that.
+
+ TraceCount
TraceCount
An alternative to the use of TraceCount for getting more selective trace
+ TrIn
TrIn
output is TrIn.
+
+
+ TrIn
TrIn _____ __ _________ _____
(TrIn [FNAME:id]): Undefined macro
+
+ TrIn
TrIn
To use TrIn, establish tracing for a collection of functions,
+ Tr TrIn
Tr TrIn
using Tr in the normal way. Then do TrIn on some small
+ Tr
Tr
collection of other functions. The effect is just as for Tr,
+ except that trace output is inhibited except if control is
+ TrIn
TrIn
dynamically within the TrIn functions. This makes it possible to
+ Tr
Tr
use Tr on a number of heavily used general purpose functions, and
+ then only see the calls to them that occur within some specific
+ subpart of your entire program.
+
+
+ __________ ______
TRACEMINLEVEL!* [Initially: 0] global
+
+
+ __________ ______
TRACEMAXLEVEL!* [Initially: 1000] global
+
+ The global variables TRACEMINLEVEL!* and TRACEMAXLEVEL!* (whose
+ values should be non-negative integers) are the minimum and
+ maximum depths of recursion at which to print trace information.
+ Thus if you only want to see top level calls of a highly
+ Length
Length
recursive function (like a simple-minded version of Length)
+ simply do
+
+ (SETQ TRACEMAXLEVEL!* 1)
+
+
+15.2.4. Turning Off Tracing
15.2.4. Turning Off Tracing
15.2.4. Turning Off Tracing
+
+ If a particular function no longer needs tracing, do
+
+ (UNTR functionname)
+
+or
+
+ (UNTR name1 name2 ...)
PSL Manual 7 February 1983 Debugging Tools
+section 15.2 page 15.9
+
+ UnTr
UnTr _____ __ _________ _____
(UnTr [FNAME:id]): Undefined macro
+
+ This merely suppresses generation of trace output. Other
+ information, such as invocation counts, backtrace information,
+ and the number of arguments is retained.
+
+ To completely destroy information about a function use
+
+ (RESTR name1 name2 ...)
+
+
+ Restr
Restr _____ __ _________ ____
(Restr [FNAME:id]): Undefined expr
+
+ This returns the function to it's original state.
+
+ To suppress traceset output without suppressing normal trace output use
+
+
+ (UNTRST name1 name2 ...)
+
+
+ UnTrst
UnTrst _____ __ _________ _____
(UnTrst [FNAME:id]): Undefined macro
+
+ UnTr Trst UnTrst
UnTr Trst UnTrst
UnTring a Trsted function also UnTrst's it.
+
+ TrIn UnTr UnTrst
TrIn UnTr UnTrst
TrIn in Section 15.2.3 is undone by UnTr (but not by UnTrst).
+
+
+15.2.5. Enabling Debug Facilities and Automatic Tracing
15.2.5. Enabling Debug Facilities and Automatic Tracing
15.2.5. Enabling Debug Facilities and Automatic Tracing
+
+ Under the influence of
+
+ (ON TRACEALL)
+
+ PutD PutD
PutD PutD
any functions successfully defined by PutD are traced. Note that if PutD
+fails (as might happen under the influence of the LOSE flag) no attempt is
+made to trace the function.
+
+ Btr TrCount
Btr TrCount
To enable those facilities (such as Btr in Section 15.3 and TrCount in
+Section 15.5) which require redefinition, but without tracing, use
+
+ (ON INSTALL)
+
+ Thus, a common scenario might look like
+
+ (ON INSTALL)
+ (DSKIN "MYFNS.SL")
+ (OFF INSTALL)
+
+which would enable the backtrace and statistics routines to work with all
+the functions defined in the MYFNS file.
Debugging Tools 7 February 1983 PSL Manual
+page 15.10 section 15.2
+
+ __________ ______
!*INSTALL [Initially: NIL] switch
+
+ PutD
PutD
Causes DEBUG to know about all functions defined with PutD.
+
+
+ __________ ______
!*TRACEALL [Initially: NIL] switch
+
+ PutD
PutD
Causes all functions defined with PutD to be traced.
+
+
+
+15.3. A Heavy Handed Backtrace Facility
15.3. A Heavy Handed Backtrace Facility
15.3. A Heavy Handed Backtrace Facility
+
+ The backtrace facility allows one to see which of a set of selected
+ Btr
Btr
functions were active as an error occurred. The function Btr gives the
+backtrace information. The information kept is controlled by two switches:
+!*BTR and !*BTRSAVE.
+
+ When backtracing is enabled (BTR is on), a stack is kept of functions
+entered but not left. This stack records the names of functions and the
+arguments that they were called with. If a function returns normally the
+stack is unwound. If however the function fails, the stack is left alone
+by the normal LISP error recovery processes.
+
+
+ Btr
Btr _____ __ _________ _____
(Btr [FNAME:id]): Undefined macro
+
+ Btr
Btr
When called with no arguments, Btr prints the backtrace
+ information available. When called with arguments (which should
+ be function names), the stack is reset to NIL, and the functions
+ named are added to the list of functions Debug knows about.
+
+
+ ResBtr
ResBtr _____ __ _________ ____
(ResBtr [FNAME:id]): Undefined expr
+
+ ResBtr
ResBtr
ResBtr resets the backtrace stack to NIL.
+
+
+ __________ ______
!*BTR [Initially: T] switch
+
+ If !*BTR is T, it enables backtracing of functions which the
+ Debug package has been told about. If it is NIL, backtrace
+ information is not saved.
+
+
+ __________ ______
!*BTRSAVE [Initially: T] switch
+
+ Controls the disposition of information about functions which
+ ErrorSet
ErrorSet
failed within an ErrorSet. If it is on, the information is saved
+ separately and printed when the stack is printed. If it is off,
+ the information is thrown away.
PSL Manual 7 February 1983 Debugging Tools
+section 15.4 page 15.11
+
+15.4. Embedded Functions
15.4. Embedded Functions
15.4. Embedded Functions
+
+ Embedding means redefining a function in terms of its old definition,
+usually with the intent that the new version does some tests or printing,
+uses the old one, does some more printing and then returns. If ff is a
+function of two arguments, it can be embedded using a statement of the
+form:
+
+ SYMBOLIC EMB PROCEDURE ff(A1,A2);
+ << PRINT A1;
+ PRINT A2;
+ PRINT ff(A1,A2) >>;
+
+ Tr
Tr
The effect of this particular use of embed is broadly similar to a call Tr
+ff, and arranges that whenever ff is called it prints both its arguments
+and its result. After a function has been embedded, the embedding can be
+temporarily removed by the use of
+
+ UNEMBED ff;
+
+and it can be reinstated by
+
+ EMBED ff;
+
+ This facility is available only to RLISP users.
+
+
+
+15.5. Counting Function Invocations
15.5. Counting Function Invocations
15.5. Counting Function Invocations
+
+
+ __________ ______
!*TRCOUNT [Initially: T] switch
+
+ Enables counting invocations of functions known to Debug. If the
+ switch TRCOUNT is ON, the number of times user functions known to
+ Debug are entered is counted. The statement
+
+ (ON TRCOUNT)
+
+ also resets that count to zero. The statement
+
+ (OFF TRCOUNT)
+
+ causes a simple histogram of function invocations to be printed.
+
+ Tr
Tr
If regular tracing (provided by Tr) is not desired, but you wish to count
+the function invocations, use
+
+ (TRCNT name1 name2 ...)
Debugging Tools 7 February 1983 PSL Manual
+page 15.12 section 15.5
+
+ TrCnt
TrCnt _____ __ _________ _____
(TrCnt [FNAME:id]): Undefined macro
+
+ See also Section 15.2.5.
+
+
+
+15.6. Stubs
15.6. Stubs
15.6. Stubs
+
+ Stubs are useful in top-down program development. If a stub is invoked,
+it prints its arguments and asks for a value to return.
+
+
+ Stub
Stub __________ ____ _____
(Stub [FuncInvoke:form]): macro
+
+ __________
Each FUNCINVOKE must be of the form (id arg1 arg2 ...), where
+ ____
____
____
Stub expr
Stub expr
there may be zero arguments. Stub defines an expr for each form
+ with name id and formal arguments arg1, arg2, etc. If executed
+ such a stub prints its arguments and reads a value to return.
+
+ The statement
+
+ (STUB (FOO U V))
+
+ ____
____
____
expr Foo
expr Foo
defines an expr, Foo, of two arguments.
+
+
+ FStub
FStub __________ ____ ___ _____
(FStub [FuncInvoke:form]): Nil macro
+
+ _____
_____
_____
FStub Stub fexpr
FStub Stub fexpr
FStub does the same as Stub but defines fexprs.
+
+ At present the currently (i.e. when the stub is executed) selected input
+and output are used. This may be changed in the future. Algebraic and
+ _____
_____
_____
macro
macro
possibly macro stubs may be implemented in the future.
+
+
+
+15.7. Functions for Printing Useful Information
15.7. Functions for Printing Useful Information
15.7. Functions for Printing Useful Information
+
+
+ PList
PList _ __ _____
(PList [X:id]): macro
+
+ (PLIST id1 id2 ...)
+
+ __
prints the property lists of the specified ids in an easily
+ readable form.
+
+
+ Ppf
Ppf _____ __ _____
(Ppf [FNAME:id]): macro
+
+ (PPF fn1 fn2 ...)
+
+ prints the definitions and other useful information about the
PSL Manual 7 February 1983 Debugging Tools
+section 15.7 page 15.13
+
+ specified functions.
+
+
+
+15.8. Printing Circular and Shared Structures
15.8. Printing Circular and Shared Structures
15.8. Printing Circular and Shared Structures
+
+ Some LISP programs rely on parts of their data structures being shared,
+ Eq Equal
Eq Equal
so that an Eq test can be used rather than the more expensive Equal one.
+Other programs (either deliberately or by accident) construct circular
+ RplacA RplacD
RplacA RplacD
lists through the use of RplacA or RplacD. Such lists can be displayed by
+ PrintX
PrintX
use of the function PrintX. This function also prints circular vectors.
+
+
+ PrintX
PrintX _ ___ ___ ____
(PrintX A:any): NIL expr
+
+ If given a normal list the behavior of this function is similar
+ Print
Print
to that of Print; if it is given a looped or re-entrant data
+ structures it prints it in a special format. The representation
+ PrintX
PrintX
used by PrintX for re-entrant structures is based on the idea of
+ labels for those nodes in the structure that are referred to more
+ than once.
+
+ Consider the list created by the operations:
+
+ (SETQ R '(S W))
+ (RPLACA R (CDR R))
+
+ Print
Print _
The function Print called on the list R gives
+
+ ((W) W)
+
+ PrintX
PrintX _ _
If PrintX is called on the list R, it discovers that the list (W) is
+referred to twice, and invents the label %L1 for it. The structure is then
+printed as
+
+ (%L1: (W) . %L1)
+
+%L1: sets the label, and the other instance of %L1 refers back to it.
+Labeled sublists can appear anywhere within the list being printed. Thus
+the list created by the following statements
+
+ (SETQ L '(A B C))
+ (SETQ K (CDR L))
+ (SETQ X (CONS L K))
+
+which is printed as
+
+ ((A B C) B C)
+
+ Print PrintX
Print PrintX
by Print could be printed by PrintX as
Debugging Tools 7 February 1983 PSL Manual
+page 15.14 section 15.8
+
+ ((A %L1, B C) . %L1)
+
+A label set with a comma (rather than a colon) is a label for part of a
+list, not for the sublist.
+
+
+ __________ ______
!*SAVENAMES [Initially: NIL] switch
+
+ PrintX
PrintX
If on, names assigned to substructures by PrintX are retained
+ from one use to the next. Thus substructures common to different
+ items will be shown as the same.
+
+
+
+15.9. Internals and Customization
15.9. Internals and Customization
15.9. Internals and Customization
+
+ This Section describes some internal details of the Debug package which
+may be useful in customizing it for specific applications. The reader is
+urged to consult the source for further details.
+
+
+15.9.1. User Hooks
15.9.1. User Hooks
15.9.1. User Hooks
+
+ These are all global variables whose values are normally NIL. If
+ ____
____
____
expr
expr
non-NIL, they should be exprs taking the number of variables specified, and
+are called as specified.
+
+
+ __________ ______
PUTDHOOK!* [Initially: NIL] global
+
+ Takes one argument, the function name. It is called after the
+ function has been defined, and any tracing under the influence of
+ !*TRACEALL or !*INSTALL has taken place. It is not called if the
+ function cannot be defined (as might happen if the function has
+ been flagged LOSE).
+
+
+ __________ ______
TRACENTRYHOOK!* [Initially: NIL] global
+
+ Takes two arguments, the function name and a list of the actual
+ arguments. It is called by the trace package if a traced
+ function is entered, but before it is executed. The execution of
+ a surrounding EMB function takes place after TRACENTRYHOOK!* is
+ called. This is useful if you need to call special user-provided
+ print routines to display critical data structures, as are
+ TRACEXITHOOK!* and TRACEXPANDHOOK!*.
+
+
+ __________ ______
TRACEXITHOOK!* [Initially: NIL] global
+
+ Takes two arguments, the function name and the value. It is
+ called after the function has been evaluated.
PSL Manual 7 February 1983 Debugging Tools
+section 15.9 page 15.15
+
+ __________ ______
TRACEXPANDHOOK!* [Initially: NIL] global
+
+ _____
_____
_____
macro
macro
Takes two arguments, the function name and the macro expansion.
+ _____ _____
_____ _____
_____ _____
macro macro
macro macro
It is only called for macros, and is called after the macro is
+ expanded, but before the expansion has been evaluated.
+
+
+ __________ ______
TRINSTALLHOOK!* [Initially: NIL] global
+
+ Takes one argument, a function name. It is called if a function
+ is redefined by the Debug package, as for example when it is
+ first traced. It is called before the redefinition takes place.
+
+
+15.9.2. Functions Used for Printing/Reading
15.9.2. Functions Used for Printing/Reading
15.9.2. Functions Used for Printing/Reading
+
+ _____
_____
_____
EXPRS
EXPRS
These should all contain EXPRS taking the specified number of arguments.
+The initial values are given in square brackets.
+
+
+ __________ ______
PPFPRINTER!* [Initially: PRINT] global
+
+ Ppf
Ppf
Takes one argument. It is used by Ppf to print the body of an
+ interpreted function.
+
+
+ __________ ______
PROPERTYPRINTER!* [Initially: PRETTYPRINT] global
+
+ PList
PList
Takes one argument. It is used by PList to print the values of
+ properties.
+
+
+ __________ ______
STUBPRINTER!* [Initially: PRINTX] global
+
+ Stub/FStub
Stub/FStub
Takes one argument. Stubs defined with Stub/FStub use it to
+ print their arguments.
+
+
+ __________ ______
STUBREADER!* [Initially: !-REDREADER] global
+
+ Stub/FStub
Stub/FStub
Takes no arguments. Stubs defined with Stub/FStub use it to read
+ their return value.
+
+
+ __________ ______
TREXPRINTER!* [Initially: PRINT] global
+
+ Takes one argument. It is used to print the expansions of traced
+ _____
_____
_____
macro
macro
macros.
Debugging Tools 7 February 1983 PSL Manual
+page 15.16 section 15.9
+
+ __________ ______
TRPRINTER!* [Initially: PRINTX] global
+
+ Takes one argument. It is used to print the arguments and values
+ of traced functions.
+
+
+ __________ ______
TRSPACE!* [Initially: 0] global
+
+ Controls indentation.
+
+
+
+15.10. Example
15.10. Example
15.10. Example
+
+ This contrived example demonstrates many of the available features. It
+is a transcript of an actual PSL session.
PSL Manual 7 February 1983 Debugging Tools
+section 15.10 page 15.17
+
+ @PSL
+ PSL 3.1, 15-Nov-82
+ 1 lisp> (LOAD DEBUG)
+ NIL
+ 2 lisp> (DE FOO (N)
+ 2 lisp> (PROG (A)
+ 2 lisp> (COND ((AND (NEQ (REMAINDER N 2) 0) (LESSP N 0))
+ 2 lisp> (SETQ A (CAR N)))) %Should err out if N is a n
+ 2 lisp> (COND ((EQUAL N 0) (RETURN 'BOTTOM)))
+ 2 lisp> (SETQ N (DIFFERENCE N 2))
+ 2 lisp> (SETQ A (BAR N))
+ 2 lisp> (SETQ N (DIFFERENCE N 2))
+ 2 lisp> (RETURN (LIST A (BAR N) A))))
+ FOO
+ 3 lisp> (DE FOOBAR (N)
+ 3 lisp> (PROGN (FOO N) NIL))
+ FOOBAR
+ 4 lisp> (TR FOO FOOBAR)
+ (FOO FOOBAR)
+ 5 lisp> (PPF FOOBAR FOO)
+
+
+ EXPR procedure FOOBAR(N) [TRACED;Invoked 0 times]:
+ PROGN
+ (FOO N)
+ NIL
+
+
+ EXPR procedure FOO(N) [TRACED;Invoked 0 times]:
+ PROG
+ (A)
+ (COND ((AND (NEQ (REMAINDER N 2) 0) (LESSP N 0)) (SETQ A (CAR N))))
+ (COND ((EQUAL N 0) (RETURN 'BOTTOM)))
+ (SETQ N (DIFFERENCE N 2))
+ (SETQ A (BAR N))
+ (SETQ N (DIFFERENCE N 2))
+ (RETURN (LIST A (BAR N) A))
+
+ (FOOBAR FOO)
+ 6 lisp> (ON COMP)
+ NIL
+ 7 lisp> (DE BAR (N)
+ 7 lisp> (COND ((EQUAL (REMAINDER N 2) 0) (FOO (TIMES 2 (QUOTIENT N
+ 7 lisp> (T (FOO (SUB1 (TIMES 2 (QUOTIENT N 4)))))))
+ *** (BAR): base 275266, length 21 words
+ BAR
+ 8 lisp> (OFF COMP)
+ NIL
+ 9 lisp> (FOOBAR 8)
+ FOOBAR being entered
+ N: 8
+ FOO being entered
Debugging Tools 7 February 1983 PSL Manual
+page 15.18 section 15.10
+
+ N: 8
+ FOO (level 2) being entered
+ N: 2
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ FOO (level 2) being entered
+ N: 2
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ FOO = (%L1: (BOTTOM BOTTOM BOTTOM) (BOTTOM BOTTOM BOTTOM)
+ %L1)
+ FOOBAR = NIL
+ NIL
+ 10 lisp> % Notice how in the above PRINTX printed the return values
+ 10 lisp> % to show shared structure
+ 10 lisp> (TRST FOO)
+ (FOO)
+ 11 lisp> (FOOBAR 8)
+ FOOBAR being entered
+ N: 8
+ FOO being entered
+ N: 8
+ N := 6
+ FOO (level 2) being entered
+ N: 2
+ N := 0
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ A := BOTTOM
+ N := -2
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ A := (BOTTOM BOTTOM BOTTOM)
+ N := 4
+ FOO (level 2) being entered
+ N: 2
+ N := 0
+ FOO (level 3) being entered
+ N: 0
PSL Manual 7 February 1983 Debugging Tools
+section 15.10 page 15.19
+
+ FOO (level 3) = BOTTOM
+ A := BOTTOM
+ N := -2
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ FOO = (%L1: (BOTTOM BOTTOM BOTTOM) (BOTTOM BOTTOM BOTTOM)
+ %L1)
+ FOOBAR = NIL
+ NIL
+ 12 lisp> (TR BAR)
+ (BAR)
+ 13 lisp> (FOOBAR 8)
+ FOOBAR being entered
+ N: 8
+ FOO being entered
+ N: 8
+ BAR being entered
+ A1: 6
+ FOO (level 2) being entered
+ N: 2
+ BAR (level 2) being entered
+ A1: 0
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ BAR (level 2) = BOTTOM
+ BAR (level 2) being entered
+ A1: -2
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ BAR (level 2) = BOTTOM
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ BAR = (BOTTOM BOTTOM BOTTOM)
+ BAR being entered
+ A1: 4
+ FOO (level 2) being entered
+ N: 2
+ BAR (level 2) being entered
+ A1: 0
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ BAR (level 2) = BOTTOM
+ BAR (level 2) being entered
+ A1: -2
+ FOO (level 3) being entered
+ N: 0
+ FOO (level 3) = BOTTOM
+ BAR (level 2) = BOTTOM
Debugging Tools 7 February 1983 PSL Manual
+page 15.20 section 15.10
+
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ BAR = (BOTTOM BOTTOM BOTTOM)
+ FOO = (%L1: (BOTTOM BOTTOM BOTTOM) (BOTTOM BOTTOM BOTTOM)
+ %L1)
+ FOOBAR = NIL
+ NIL
+ 14 lisp> (OFF TRACE)
+ NIL
+ 15 lisp> (FOOBAR 8)
+ NIL
+ 16 lisp> (TR)
+ *** Start of saved trace information ***
+ BAR (level 2) = BOTTOM
+ FOO (level 2) = (BOTTOM BOTTOM BOTTOM)
+ BAR = (BOTTOM BOTTOM BOTTOM)
+ FOO = (%L1: (BOTTOM BOTTOM BOTTOM) (BOTTOM BOTTOM BOTTOM)
+ %L1)
+ FOOBAR = NIL
+ *** End of saved trace information ***
+ NIL
+ 17 lisp> (FOOBAR 13)
+ ***** An attempt was made to do CAR on `-1', which is not a pair
+ Break loop
+ 18 lisp break>> Q
+ 19 lisp> (TR)
+ *** Start of saved trace information ***
+ FOO being entered
+ N: 13
+ BAR being entered
+ A1: 11
+ FOO (level 2) being entered
+ N: 3
+ BAR (level 2) being entered
+ A1: 1
+ FOO (level 3) being entered
+ N: -1
+ *** End of saved trace information ***
+ NIL
+ 20 lisp> (BTR)
+ *** Backtrace: ***
+ These functions were left abnormally:
+ FOO
+ N: -1
+ BAR
+ A1: 1
+ FOO
+ N: 3
+ BAR
+ A1: 11
+ FOO
+ N: 13
+ FOOBAR
PSL Manual 7 February 1983 Debugging Tools
+section 15.10 page 15.21
+
+ N: 13
+ *** End of backtrace ***
+ NIL
+ 21 lisp> (STUB (FOO N))
+ *** Function `FOO' has been redefined
+ NIL
+ 22 lisp> (FOOBAR 13)
+ Stub FOO called
+
+ N: 13
+ Return? :
+ 22 lisp> (BAR (DIFFERENCE N 2))
+ Stub FOO called
+
+ N: 3
+ Return? :
+ 22 lisp> (BAR (DIFFERENCE N 2))
+ Stub FOO called
+
+ N: -1
+ Return? :
+ 22 lisp> 'ERROR
+ NIL
+ 23 lisp> (TR)
+ *** Start of saved trace information ***
+ BAR being entered
+ A1: 11
+ BAR (level 2) being entered
+ A1: 1
+ BAR (level 2) = ERROR
+ BAR = ERROR
+ FOOBAR = NIL
+ *** End of saved trace information ***
+ NIL
+ 24 lisp> (OFF TRCOUNT)
+
+
+ FOOBAR(6) ******************
+ BAR(16) ************************************************
+
+
+ NIL
+ 22 lisp> (QUIT)
ADDED psl-1983/3-1/lpt/16-editor.lpt
Index: psl-1983/3-1/lpt/16-editor.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/16-editor.lpt
@@ -0,0 +1,1457 @@
+PSL Manual 7 February 1983 EDITOR
+section 16.0 page 16.1
+
+ CHAPTER 16
CHAPTER 16
CHAPTER 16
+ EDITORS
EDITORS
EDITORS
+
+
+
+
+ 16.1. A Mini-Structure Editor . . . . . . . . . . . 16.1
+ 16.2. The EMODE Screen Editor . . . . . . . . . . . 16.3
+ 16.2.1. Windows and Buffers in Emode . . . . . . . 16.5
+ 16.3. Introduction to the Full Structure Editor . . . . . 16.6
+ 16.4. User Entry to Editor . . . . . . . . . . . . 16.6
+ 16.5. Editor Command Reference . . . . . . . . . . . 16.8
+
+
+
+
+16.1. A Mini Structure-Editor
16.1. A Mini Structure-Editor
16.1. A Mini Structure-Editor
+
+ PSL and RLISP provide a fairly simple structure editor, essentially a
+subset of the structure editor described below in section
+FULL-STRUCTURE-EDITOR. This mini editor is usually resident in PSL and
+RLISP, or can be LOADed. It is useful for correcting errors in input,
+often via the E option in the BREAK loop. Do HELP(EDITOR) for more
+information.
+
+ Edit
Edit
To edit an expression, call the function Edit with the expression as an
+argument. The edited copy is returned. To edit the definition of a
+ EditF
EditF
function, call EditF with the function name as an argument.
+
+ In the editor, the following commands are available (N indicates a
+ _______
non-negative integer):
+
+
+P
P ____
P edit
+
+ Prints the subexpression under consideration. On entry, this is
+ the entire expression. This only prints down PLEVEL levels,
+ replacing all edited subexpressions by ***. PLEVEL is initially
+ 3.
+
+
+PL
PL _ ____
PL (N) edit
+
+ _
Changes PLEVEL to N.
+
+
+ ____ _______
____ _______
____ _______
N edit-command
N _______ edit-command
N:integer edit-command
+
+
+ Sets the subexpression under consideration to be the nth
+ subexpression of the current one. That is, walk down to the nth
+ subexpression.
EDITOR 7 February 1983 PSL Manual
+page 16.2 section 16.1
+
+ ____ _______
____ _______
____ _______
-N edit-command
-N _______ edit-command
-N:integer edit-command
+
+
+ Cdr
Cdr
Sets the current subexpression to be the nth Cdr of the current
+ one.
+
+
+UP
UP ____
UP edit
+
+ Go to the subexpression you were in just before this one.
+
+
+T
T ____
T edit
+
+ Go to the top of the original expression.
+
+
+F
F _ ____
F (S) edit
+
+ _
Find the first occurrence of the S-expression S. The test is
+ Equal Eq
Equal Eq
performed by Equal, not Eq. The current level is set to the
+ _
first level in which S was found.
+
+
+ ____ _______
____ _______
____ _______
N edit-command
N _______ edit-command
(N:integer) edit-command
+
+
+ Delete the Nth element of the current expression.
+
+
+ ____ _______
____ _______
____ _______
N edit-command
N _______ ___ edit-command
(N:integer [ARG]) edit-command
+
+
+ ___
Replace the Nth element by ARGs.
+
+
+ ____ _______
____ _______
____ _______
-N edit-command
-N _______ ___ edit-command
(-N:integer [ARG]) edit-command
+
+
+ ___
Insert the elements ARGs before the nth element.
+
+
+ R
R __ __ ____
(R S1 S2) edit
+
+ Replace all occurrences of S1 (in the tree you are placed at) by
+ S2.
+
+
+B
B ____
B edit
+
+ Break
Break
Enter a Break loop under the editor.
PSL Manual 7 February 1983 EDITOR
+section 16.1 page 16.3
+
+OK
OK ____
OK edit
+
+ Leave the editor, returning the edited expression.
+
+
+HELP
HELP ____
HELP edit
+
+ Print an explanatory message.
+
+ Break
Break
If the editor is called from a Break loop, the edited value is assigned
+back to ERRORFORM!*.
+
+
+
+16.2. The EMODE Screen Editor
16.2. The EMODE Screen Editor
16.2. The EMODE Screen Editor
+
+ EMODE is an EMACS-like screen editor, written entirely in PSL. To invoke
+EMODE, call the function EMODE after LOADing the EMODE module. EMODE is
+modeled after EMACS, so use that fact as a guide.
+
+ After starting up EMODE, you can use one of the following commands to
+exit.
+
+
+<Ctrl-X Ctrl-Z>
+ "quits" to the EXEC (you can continue or start again).
+<Ctrl-Z Ctrl-Z>
+ goes back into "normal" I/O mode.
+
+
+EMODE is built to run on a Teleray terminal as the default. To use some
+other terminal you must LOAD in a set of different driver functions after
+loading EMODE. The following drivers are currently available:
+
+
+ - HP2648A
+ - TELERAY
+ - VT100
+ - VT52
+ - AAA [Ann Arbor Ambassador]
+
+
+The sources for these files are on <PSL.EMODE> (logical name PE:). It
+should be quite easy to modify one of these files for other terminals. See
+the file PE:TERMINAL-DRIVERS.TXT for some more information on how this
+works.
+
+ An important (but currently somewhat bug-ridden) feature of EMODE is the
+ability to evaluate expressions that are in your buffer. Use <Meta-E> to
+evaluate the expression starting on the current line. <Meta-E> (normally)
+automatically enters two window mode if anything is "printed" to the
+OUT_WINDOW buffer, which is shown in the lower window. If you don't want
EDITOR 7 February 1983 PSL Manual
+page 16.4 section 16.2
+
+to see things being printed to the output window, you can set the variable
+!*OUTWINDOW to NIL. (Or use the RLISP command "OFF OUTWINDOW;".) This
+prevents EMODE from automatically going into two window mode if something
+is printed to OUT_WINDOW. You must still use the "<Ctrl-X> 1" command to
+enter one window mode initially.
+
+ You may also find the <Ctrl-Meta-Y> command useful. This inserts into
+the current buffer the text printed as a result of the last <Meta-E>.
+
+ The function "PrintAllDispatch" prints out the current dispatch table.
+You must call EMODE before this table is set up.
+
+ While in EMODE, the <Meta-?> (meta-question mark) character asks for a
+command character and tries to print information about it.
+
+ The basic dispatch table is (roughly) as follows:
+
+
+Character Function Comments
+
+<Ctrl-@> SETMARK
+<Ctrl-A> !$BEGINNINGOFLINE
+<Ctrl-B> !$BACKWARDCHARACTER
+<Ctrl-D> !$DELETEFORWARDCHARACTER
+<Ctrl-E> !$ENDOFLINE
+<Ctrl-F> !$FORWARDCHARACTER
+Linefeed !$CRLF Acts like carriage return
+<Ctrl-K> KILL_LINE
+<Ctrl-L> FULLREFRESH
+Return !$CRLF
+<Ctrl-N> !$FORWARDLINE
+<Ctrl-O> OPENLINE
+<Ctrl-P> !$BACKWARDLINE
+<Ctrl-R> Backward search for string, type
+ a carriage return to terminate
+ the string
+<Ctrl-S> Forward search for string
+<Ctrl-U> Repeat a command. Asks for
+ count (terminate with a carriage
+ return), then it asks for the
+ command character
+<Ctrl-V> DOWNWINDOW
+<Ctrl-W> KILL_REGION
+<Ctrl-X> !$DOCNTRLX As in EMACS, <Ctrl-X> is a
+ prefix for "fancier" commands
+<Ctrl-Y> INSERT_KILL_BUFFER Yanks back killed text
+<Ctrl-Z> DOCONTROLMETA As in EMACS, acts like
+ <Ctrl-Meta->
+escape ESCAPEASMETA As in EMACS, escape acts like
+ the <Meta-> key
+rubout !$DELETEBACKWARDCHARACTER
+<Ctrl-Meta-B> BACKWARD_SEXPR
PSL Manual 7 February 1983 EDITOR
+section 16.2 page 16.5
+
+<Ctrl-Meta-F> FORWARD_SEXPR
+<Ctrl-Meta-K> KILL_FORWARD_SEXPR
+<Ctrl-Meta-Y> INSERT_LAST_EXPRESSION Insert the last "expression"
+ typed as the result of a
+ <Meta-E>
+<Ctrl-Meta-Z> OLDFACE Leave EMODE, go back to
+ "regular" RLISP
+<Meta-Ctrl-rubout> KILL_BACKWARD_SEXPR
+<Meta-<> !$BEGINNINGOFBUFFER As in EMACS, move to beginning
+ of buffer
+<Meta->> !$ENDOFBUFFER As in EMACS, move to end of
+ buffer
+<Meta-?> !$HELPDISPATCH Asks for a character, tries to
+ print information about it
+<Meta-B> BACKWARD_WORD
+<Meta-D> KILL_FORWARD_WORD
+<Meta-E> Evaluate an expression
+<Meta-V> UPWINDOW As in EMACS, move up a window
+<Meta-W> COPY_REGION
+<Meta-X> !$DOMETAX As in EMACS, <Meta-X> is another
+ prefix for "fancy" stuff
+<Meta-Y> UNKILL_PREVIOUS As in EMACS
+<Meta-Rubout> KILL_BACKWARD_WORD
+<Ctrl-X> <Ctrl-B> PRINTBUFFERNAMES Prints a list of buffers
+<Ctrl-X> <Ctrl-R> CNTRLXREAD Read a file into the buffer
+<Ctrl-X> <Ctrl-W> CNTRLXWRITE Write the buffer out to a file
+<Ctrl-X> <Ctrl-X> EXCHANGEPOINTANDMARK
+<Ctrl-X> <Ctrl-Z> As in EMACS, exits to the EXEC
+<Ctrl-X> 1 ONEWINDOW Go into one window mode
+<Ctrl-X> 2 TWOWINDOWS Go into two window mode
+<Ctrl-X> B CHOOSEBUFFER EMODE asks for a buffer name,
+ and then puts you in that buffer
+<Ctrl-X> O OTHERWINDOW Select other window
+<Ctrl-X> P WRITESCREENPHOTO Write a "photograph" of the
+ screen to a file
+
+
+16.2.1. Windows and Buffers in Emode
16.2.1. Windows and Buffers in Emode
16.2.1. Windows and Buffers in Emode
+
+ [??? This section to be completed at a later date. ???]
[??? This section to be completed at a later date. ???]
[??? This section to be completed at a later date. ???]
+
+
+
+16.3. Introduction to the Full Structure Editor
16.3. Introduction to the Full Structure Editor
16.3. Introduction to the Full Structure Editor
+
+ 1
+ PSL also provides an extremely powerful form-oriented editor . This
+_______________
+
+ 1
+ This version of the UCI LISP editor was translated to to Standard LISP
+by Tryg Ager and Jim MacDonald of IMSSS, Stanford, and adapted to PSL by
+E. Benson. The UCI LISP editor is derived from the INTERLISP editor.
EDITOR 7 February 1983 PSL Manual
+page 16.6 section 16.3
+
+facility allows the user to easily alter function definitions, variable
+values and property list entries. It thereby makes it entirely unnecessary
+for the user to employ a conventional text editor in the maintenance of
+programs. This document is a guide to using the editor. Certain features
+of the UCI LISP editor have not been incorporated in the translated editor,
+and we have tried to mark all such differences.
+
+
+16.3.1. Starting the Structure Editor
16.3.1. Starting the Structure Editor
16.3.1. Starting the Structure Editor
+
+ EditF
EditF
This section describes normal user entry to the editor (with the EditF,
+EditP EditV
EditP EditV
EditP and EditV fuunctions) and the editing commands which are available.
+This section is by no means complete. In particular, material covering
+programmed calls to the editor routines is not treated. Consult the UCI
+LISP manual for further details.
+
+ To edit a function named FOO do
+
+
+*(EDITF FOO)
+
+
+To edit the value of an atom named BAZ do
+
+
+*(EDITV BAZ)
+
+
+To edit the property list of an atom named FOOBAZ do
+
+
+*(EDITP FOOBAZ)
+
+
+These functions are described later in the chapter.
+
+ Warning: Editing the property list of an atom may position pointers at
+unprintable structures. It is best to use the F (find) command before
+trying to print property lists. This editor capability is variable from
+implementation to implementation.
+
+ The editor prompts with
+
+
+-E-
+*
+
+
+ You can then input any editor command. The input scanner is not very
+smart. It terminates its scan and begins processing when it sees a
+printable character immediately followed by a carriage return. Do not use
+escape to terminate an editor command. If the editor seems to be
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.7
+
+repeatedly requesting input type P<ret> (print the current expression) or
+some other command that ordinarily does no damage, but terminates the input
+solicitation.
+
+ The following set of topics makes a good "first glance" at the editor.
+
+
+ Entering the editor: EDITF, EDITV.
+ Leaving the editor: OK.
+ Editor's attention: CURRENT-EXP.
+ Changing attention: POS-INTEGER, NEG-INTEGER, 0, ^, NX, BK.
+ Printing: P, PP.
+ Modification: POS-INTEGER, NEG-INTEGER, A, B, :, N.
+ Changing parens: BI, BO.
+ Undoing changes: UNDO.
+
+
+For the more discriminating user, the next topics might be some of the
+following.
+
+
+Searches: PATTERN, F, BF.
+Complex commands: R, SW, XTR, MBD, MOVE.
+Changing parens: LI, LO, RI, RO.
+Undoing changes: TEST, UNBLOCK, !UNDO.
+
+
+ Other features should be skimmed but not studied until it appears that
+they may be useful.
+
+
+16.3.2. Structure Editor Commands
16.3.2. Structure Editor Commands
16.3.2. Structure Editor Commands
+
+ Note that arguments contained in angle brackets <> are optional.
+
+
+A
A ___ ____
A ([ARG]) edit
+
+ ___ _
This command inserts the ARGs (arbitrary LISP expressions) After
+ UP
UP
the current expression. This is accomplished by doing an UP and
+ a (-2 exp1 exp2 ... expn) or an (N exp1 exp2 ... expn), as
+ appropriate. Note the way in which the current expression is
+ UP
UP
changed by the UP.
+
+
+B
B ___ ____
B ([ARG]) edit
+
+ ___ _
This command inserts the ARGs (arbitrary LISP forms) Before the
+ UP
UP
current expression. This is accomplished by doing an UP followed
+ by a (-1 exp1 exp2 ... expn). Note the way in which the current
+ UP
UP
expression is changed by the UP.
EDITOR 7 February 1983 PSL Manual
+page 16.8 section 16.3
+
+BELOW
BELOW ___ _ ____
BELOW (COM, <N>) edit
+
+ This command changes the current expression in the following
+ ___ ___
manner. The edit command COM is executed. If COM is not a
+ ___
recognized command, then (_ COM) is executed instead. Note that
+ ___
COM should cause ascent in the edit chain (i.e. should be
+ BELOW
BELOW
equivalent to some number of zeros). BELOW then evaluates
+ (note!) N and descends N links in the resulting edit chain. That
+ BELOW
BELOW
is, BELOW ascends the edit chain (does repeated 0s) looking for
+ ___
the link specified by COM and stops N links below that (backs off
+ N 0s). If N is not given, 1 is assumed.
+
+
+BF
BF ___ ___ ____
BF (PAT, <FLG>) edit
+
+ Also can be used as:
+
+
+ BF PAT
+
+
+ _ _ ___
This command performs a Backwards Find, searching for PAT (an
+ edit pattern). Search begins with the expression immediately
+ before the current expression and proceeds in reverse print
+ order. (If the current expression is the top level expression,
+ the entire expression is searched in reverse print order.)
+ Search begins at the end of each list, and descends into each
+ element before attempting to match that element. If the match
+ fails, proceed to the previous element, etc. until the front of
+ BF
BF
the list is reached. At that point, BF ascends and backs up,
+ etc.
+
+ The search algorithm may be slightly modified by use of a second
+ ___
argument. Possible FLGs and their meanings are as follows.
+
+
+ T begins search with the current expression rather than
+ with the preceding expression at this level.
+ BF
BF ___
NIL or missing - same as BF PAT.
+
+
+ NOTE: if the variable UPFINDFLG is non-NIL, the editor does an
+ UP
UP ___
UP after the expression matching PAT is located. Thus, doing a
+ BF
BF
BF for a function name yields a current expression which is the
+ entire function call. If this is not desired, UPFINDFLG may be
+ set to NIL. UPFINDFLG is initially T.
+
+ BF
BF
BF is protected from circular searches by the variable MAXLEVEL.
+ Car Cdr
Car Cdr
If the total number of Cars and Cdrs descended into reaches
+ MAXLEVEL (initially 300), search of that tail or element is
+ abandoned exactly as though a complete search had failed.
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.9
+
+BI
BI __ __ ____
BI (N1, N2) edit
+
+ This command inserts a pair of parentheses in the current
+ _ _
expression; i.e. it is a Balanced Insert. (Note that parentheses
+ are ALWAYS balanced, and hence must be added or removed in
+ pairs.) A left parenthesis is inserted before element N1 of the
+ current expression. A right parenthesis is inserted after
+ element N2 of the current expression. Both N1 and N2 are usually
+ integers, and element N2 must be to the right of element N1.
+
+ (BI n1) is equivalent to (BI n1 n1).
+
+ NTH
NTH
The NTH command is used in the search, so that N1 and N2 may be
+ any location specifications. The expressions used are the first
+ element of the current expression in which the specified form is
+ found at any level.
+
+
+BIND
BIND ___ ____
BIND ([COM]) edit
+
+ This command provides the user with temporary variables for use
+ during the execution of the sequence of edit commands coms.
+ There are three variables available: #1, #2 and #3. The binding
+ BIND
BIND
is recursive and BIND may be executed recursively if necessary.
+ All variables are initialized to NIL. This feature is useful
+ chiefly in defining edit macros.
+
+
+BK
BK ____
BK edit
+
+ The current expression becomes the expression immediately
+ _ _
preceding the present current expression; i.e. Back Up. This
+ command generates an error if the current expression is the first
+ expression in the list.
+
+
+BO
BO _ ____
BO (N) edit
+
+ BO
BO
The BO command removes a pair of parentheses from the Nth element
+ _ _
of the current expression; i.e. it is a Balanced Remove. The
+ NTH
NTH
parameter N is usually an integer. The NTH command is used in
+ the search, however, so that any location specification may be
+ used. The expression referred to is the first element of the
+ current expression in which the specified form is found at any
+ level.
+
+
+ CHANGE
CHANGE ___ __ ___ ____
(CHANGE LOC To [ARG]) edit
+
+ This command replaces the current expression after executing the
+ ___ ___
location specification LOC by ARGs.
EDITOR 7 February 1983 PSL Manual
+page 16.10 section 16.3
+
+ COMS
COMS ___ ____
(COMS [ARG]) edit
+
+ ___
This command evaluates its ARGs and executes them as edit
+ commands.
+
+
+ COMSQ
COMSQ ___ ____
(COMSQ [ARG]) edit
+
+ ___
This command executes each ARG as an edit command.
+
+ At any given time, the attention of the editor is focused on a single
+expression or form. We call that form the current expression. Editor
+commands may be divided into two broad classes. Those commands which
+change the current expression are called attention- changing commands.
+Those commands which modify structure are called structure modification
+commands.
+
+
+DELETE
DELETE ____
DELETE edit
+
+ This command deletes the current expression. If the current
+ expression is a tail, only the first element is deleted. This
+ command is equivalent to (:).
+
+
+ E
E ____ _ ____
(E FORM <T>) edit
+
+ ____
This command evaluates FORM. This may also be typed in as:
+
+
+ E FORM
+
+
+ but is valid only if typed in from the TTY. (E FORM) evaluates
+ ____
FORM and prints the value on the terminal. The form (E FORM T)
+ ____
evaluates FORM but does not print the result.
+
+
+ EditF
EditF __ __ ___ ____
(EditF FN:id): any expr
+
+ __
This function initiates editing of the function whose name is FN.
+
+
+ EditFns
EditFns __ ____ __ ____ ____ ____ ___ _____
(EditFns FN-LIST:id-list, COMS:form): NIL fexpr
+
+ ____
This function applies the sequence of editor commands, COMS, to
+ __ ____
each of several functions. The argument FN-LIST is evaluated,
+ ____
and should evaluate to a list of function names. COMS is applied
+ __ ____
to each function in FN-LIST, in turn. Errors in editing one
+ function do not affect editing of others. The editor call is via
+ EditF
EditF
EditF, so that values may also be edited in this way.
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.11
+
+ EditP
EditP __ __ ____ ____ ____ ___ _____
(EditP AT:id, COMS:form-list): any fexpr
+
+ This function initiates editing of the property list of the atom
+ ____
whose name is at. The argument COMS is a possibly null sequence
+ of edit commands which is executed before calling for input from
+ the terminal.
+
+
+ EditV
EditV __ __ ____ _____ ____ ___ _____
(EditV AT:id, COMS:forms-list): NIL fexpr
+
+ This function initiates editing of the value of the atom whose
+ __ ____
name is AT. The argument COMS is a possibly null sequence of
+ edit commands which is executed before calling for input from the
+ terminal.
+
+
+ EMBED
EMBED ___ __ ___ ____
(EMBED LOC In ARG) edit
+
+ This command replaces the expression which would be current after
+ ___
executing the location specification LOC by another expression
+ which has that expression as a sub-expression. The manner in
+ which the transformation is carried out depends on the form of
+ ___ ___ ____
ARG. If ARG is a list, then each occurrence of the atom '*' in
+ ___
ARG is replaced by the expression which would be current after
+ ___
doing LOC. (NOTE: a fresh copy is used for each substitution.)
+ ___
If ARG is atomic, the result is equivalent to:
+
+
+ (EMBED loc IN (arg *))
+
+
+ A call of the form
+
+
+ (EMBED loc IN exp1 exp2 ... expn)
+
+
+ is equivalent to:
+
+
+ (EMBED loc IN (exp1 exp2 ... expn *))
+
+
+ EMBED
___ EMBED
If the expression after doing LOC is a tail, EMBED behaves as
+ though the expression were the first element of that tail.
+
+
+ EXTRACT
EXTRACT ____ ____ ____ ____
(EXTRACT LOC1 From LOC2) edit
+
+ This command replaces the expression which would be current after
+ ____
doing the location specification LOC2 by the expression which
+ ____
would be current after doing LOC1. The expression specified by
EDITOR 7 February 1983 PSL Manual
+page 16.12 section 16.3
+
+ ____ ____
LOC1 must be a sub-expression of that specified by LOC2.
+
+
+ F
F ___ ___ ____
(F PAT <FLG>) edit
+
+ Also can be used as:
+
+
+ F PAT
+
+
+ ___
This command causes the next command, PAT, to be interpreted as a
+ pattern. The current expression is searched for the next
+ ___ _ ___
occurrence of PAT; i.e. Find. If PAT is a top level element of
+ ___
the current expression, then PAT matches that top level
+ occurrence and a full recursive search is not attempted.
+ Otherwise, the search proceeds in print order. Recursion is done
+ Car Cdr
Car Cdr
first in the Car and then in the Cdr direction.
+
+ The form (F PAT FLG) of the command may be used to modify the
+ ___
search algorithm according to the value of FLG. Possible values
+ and their actions are:
+
+
+ N suppresses the top-level check. That is, finds the
+ ___
next print order occurrence of PAT regardless of any
+ top level occurrences.
+
+ T like N, but may succeed without changing the current
+ expression. That is, succeeds even if the current
+ ___
expression itself is the only occurrence of PAT.
+
+ positive integer
+ ___
finds the nth place at which PAT is matched. This is
+ equivalent to (F PAT T) followed by n-1 (F PAT N)s. If
+ n occurrences are not found, the current expression is
+ unchanged.
+
+ NIL or missing
+ Only searches top level elements of the current
+ expression. May succeed without changing the current
+ expression.
+
+
+ NOTE: If the variable UPFINDFLG is non-NIL, F does an UP after
+ locating a match. This ensures that F fn, in which fn is a
+ function name, results in a current expression which is the
+ entire function call. If this is undesirable, set UPFINDFLG to
+ NIL. Its initial value is T.
+
+ As protection against searching circular lists, the search is
+ Car-Cdr
Car-Cdr
abandoned if the total number of Car-Cdr descents exceeds the
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.13
+
+ value of the variable MAXLEVEL. (The initial value is 300.) The
+ search fails just as if the entire element had been
+ unsuccessfully searched.
+
+
+ FS
FS ___ ____
(FS [PAT]) edit
+
+ FS
FS _ _
The FS command does sequential finds; i.e. Find Sequential. That
+ ___
is, it searches (in print order) first for the first PAT, then
+ ___
for the second PAT, etc. If any search fails, the current
+ expression is left at that form which matched in the last
+ successful search. This command is, therefore, equivalent to a
+ F
F
sequence of F commands.
+
+
+ F=
F= ___ ___ ____
(F= EXP FLG) edit
+
+ Eq
_ Eq
This command is equivalent to (F (== exp) flg); i.e. Find Eq.
+ ___
That is, it searches, in the manner specified by FLG, for a form
+ Eq
Eq ___
which is Eq to EXP. Note that for keyboard type-ins, this always
+ ___
fails unless EXP is atomic.
+
+
+HELP
HELP ____
HELP edit
+
+ This command provides an easy way of invoking the HELP system
+ from the editor.
+
+
+ I
I ___ ___ ____
(I COM [ARG]) edit
+
+ ___ ___
This command evaluates the ARGs and executes COM on the resulting
+ values. This command is thus equivalent to: (com val1 val2 ...
+ valn), Each vali is equal to (EVAL argi).
+
+
+ IF
IF ___ ____
(IF ARG) edit
+
+ This command, useful in edit macros, conditionally causes an
+ editor error. If (EVAL arg) is NIL (or if evaluation of arg
+ IF
IF
causes a LISP error), then IF generates an editor error.
+
+
+ INSERT
INSERT ___ ____
(INSERT [EXP ARG LOC]) edit
+
+ INSERT A B :
INSERT A B :
The INSERT command provides equivalents of the A, B and :
+ ___ ___
commands incorporating a location specification, LOC. ARG can be
+ ___
AFTER, BEFORE, or FOR. This command inserts EXPs AFTER, BEFORE
+ or FOR (in place of) the expression which is current after
+ ___
executing LOC. Note, however, that the current expression is not
+ changed.
EDITOR 7 February 1983 PSL Manual
+page 16.14 section 16.3
+
+ LC
LC ___ ____
(LC LOC) edit
+
+ This command, which takes as an argument a location
+ specification, explicitly invokes the location specification
+ _ _
search; i.e. Locate. The current expression is changed to that
+ ___
which is current after executing LOC.
+
+ ___
See LOC-SPEC for details on the definition of LOC and the search
+ method in question.
+
+
+ LCL
LCL ___ ____
(LCL LOC) edit
+
+ This command, which takes as an argument a location
+ specification, explicitly invokes the location specification
+ search. However, the search is limited to the current expression
+ _ _ _
itself; i.e. Locate Limited. The current expression is changed
+ ___
to that which is current after executing LOC.
+
+
+ LI
LI _ ____
(LI N) edit
+
+ This command inserts a left parenthesis (and, of course, a
+ _ _
matching right parenthesis); i.e. Left Parenthesis Insert. The
+ left parenthesis is inserted before the Nth element of the
+ current expression and the right parenthesis at the end of the
+ current expression. Thus, this command is equivalent to (BI n
+ -1).
+
+ NTH
NTH
The NTH command is used in the search, so that N, which is
+ usually an integer, may be any location specification. The
+ expression referred to is the first element of the current
+ expression which contains the form specified at any level.
+
+
+ LO
LO _ ____
(LO N) edit
+
+ This command removes a left parenthesis (and a matching right
+ parenthesis, of course) from the Nth element of the current
+ _ _
expression; i.e. Left Parenthesis Remove. All elements after
+ the Nth are deleted.
+
+ NTH
NTH
The command uses the NTH command for the search. The parameter
+ N, which is usually an integer, may be any location
+ specification. The expression actually referred to is the first
+ element of the current expression which contains the specified
+ form at any depth.
+
+ Many of the more complex edit commands take as an argument a location
+ ___
specification (abbreviated LOC throughout this document). A location
+specification is a list of edit commands, which are, with two exceptions,
+executed in the normal way. Any command not recognized by the editor is
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.15
+
+ F
F
treated as though it were preceded by F. Furthermore, if one of the
+commands causes an error and the current expression has been changed by
+prior commands, the location operation continues rather than aborting.
+This is a sort of back-up operation. For example, suppose the location
+ Cond
Cond
specification is (COND 2 3), and the first clause of the first Cond has
+only 2 forms. The location operation proceeds by searching for the next
+Cond
Cond
Cond and trying again. If a point were reached in which there were no more
+Cond
Cond
Conds, the location operation would then fail.
+
+
+ LP
LP ____ ____
(LP COMS) edit
+
+ ____
This command, useful in macros, repeatedly executes COMS (a
+ sequence of edit commands) until an editor error occurs; i.e.
+ LP
_ _ LP
Loop. As LP exits, it prints the number of OCCURRENCES; that is,
+ ____
the number of times COMS was successfully executed. After
+ execution of the command, the current expression is left at what
+ ____
it was after the last complete successful execution of COMS.
+
+ The command terminates if the number of iterations exceeds the
+ value of the variable MAXLOOP (initially 30).
+
+
+ LPQ
LPQ ____ ____
(LPQ COMS) edit
+
+ ____
This command, useful in macros, repeatedly executes COMS (a
+ sequence of edit commands) until an editor error occurs; i.e.
+ _ _ _
Loop Quietly. After execution of the command, the current
+ expression is left at what it was after the last complete
+ ____
successful execution of COMS.
+
+ The command terminates if the number of iterations exceeds the
+ value of the variable MAXLOOP (initially 30).
+
+ LP
LP
This command is equivalent to LP, except that OCCURRENCES is not
+ printed.
+
+
+ M
M ___ ___ ____
(M (NAM) ([EXP) COMS)]) edit
+
+ This can also be used as:
+
+
+ (M NAM COMS)
+
+
+ or as:
+
+
+ (M (NAM) ARG COMS)
EDITOR 7 February 1983 PSL Manual
+page 16.16 section 16.3
+
+ _
The editor provides the user with a macro facility; i.e. M. The
+ user may define frequently used command sequences to be edit
+ macros, which may then be invoked simply by giving the macro name
+ M
M
as an edit command. The M command provides the user with a
+ method of defining edit macros.
+
+ The first alternate form of the command defines an atomic command
+ ___
which takes no arguments. The argument NAM is the atomic name of
+ ___
the macro. This defines NAM to be an edit macro equivalent to
+ ____ ___
the sequence of edit commands COMS. If NAM previously had a
+ definition as an edit macro, the new definition replaces the old.
+ NOTE: Edit command names take precedence over macros. It is not
+ possible to redefine edit command names.
+
+ The main form of the M command as given above defines a list
+ command, which takes a fixed number of arguments. In this case,
+ ___
NAM is defined to be an edit macro equivalent to the sequence of
+ ____
edit commands COMS. However, as (nam exp1 exp2 ... expn) is
+ executed, the expi are substituted for the corresponding argi in
+ ____ ____
COMS before COMS are executed.
+
+ The second alternate form of the M command defines a list command
+ which may take an arbitrary number of arguments. Execution of
+ ___
the macro NAM is accomplished by substituting (exp1 exp2 ...
+ Cdr
Cdr
expn) (that is, the Cdr of the macro call (nam exp1 exp2 ...
+ ___ ____
expn)) for all occurrences of the atom ARG in COMS, and then
+ ____
executing COMS.
+
+
+ MAKEFN
MAKEFN ___ ____ ____ __ __ ____
(MAKEFN (NAM VARS) ARGS N1 <N2>) edit
+
+ This command defines a portion of the current expression as a
+ function and replaces that portion of the expression by a call to
+ ____ _ _ ___ ____
the function; i.e. Make Function. The form (NAM VARS) is the
+ __ __
call which replaces the N1st through N2nd elements of the current
+ ___
expression. Thus, NAM is the name of the function to be defined.
+ ____
VARS is a sequence of local variables (in the current
+ ____
expression), and ARGS is a list of dummy variables. The function
+ definition is formed by replacing each occurrence of an element
+ Cdr
Cdr ___ ____
in vars (the Cdr of (NAM VARS)) by the corresponding element of
+ ____ ____
ARGS. Thus, ARGS are the names of the formal parameters in the
+ newly defined function.
+
+ __ __
If N2 is omitted, it is assumed to be equal to N1.
+
+
+MARK
MARK ____
MARK edit
+
+ This command saves the current position within the form in such a
+ way that it can later be returned to. The return is accomplished
+ via _ or __.
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.17
+
+MBD
MBD ___ ____
MBD (ARG) edit
+
+ This command replaces the current expression by some form which
+ ___
has the current expression as a sub-expression. If ARG is a
+ MBD
____ MBD
list, MBD substitutes a fresh copy of the current expression for
+ ___ ___
each occurrence of the atom '*' in ARG. If ARG is a sequence of
+ expressions, as:
+
+
+ (MBD exp1 exp2 ... expn)
+
+
+ then the call is equivalent to one of the form:
+
+
+ (MBD (exp1 exp2 ... expn *))
+
+
+ The same is true if arg is atomic:
+
+
+ (MBD atom) = (MBD (atom *))
+
+
+ MOVE
MOVE ____ __ ___ ____ ____
(MOVE <LOC1> To COM <LOC2>) edit
+
+ MOVE
MOVE ____
The MOVE command allows the user to Move a structure from one
+ point to another. The user may specify the form to be moved (via
+ ____
LOC1, the first location specification), the position to which it
+ ____
is to be moved (via LOC2, the second location specification) and
+ ___ ___
the action to be performed there (via COM). The argument COM may
+ be BEFORE, AFTER or the name of a list command (e.g. :, N, etc.).
+ This command performs in the following manner. Take the current
+ ____
expression after executing LOC1 (or its first element, if it is a
+ ____
tail); call it expr. Execute LOC2 (beginning at the current
+ expression AS OF ENTRY TO MOVE -- NOT the expression which would
+ ____ ___
be current after execution of LOC1), and then execute (COM expr).
+ Now go back and delete expr from its original position. The
+ current expression is not changed by this command.
+
+ ____
If LOC1 is NIL (that is, missing), the current expression is
+ moved. In this case, the current expression becomes the result
+ ___
of the execution of (COM expr).
+
+ ____
If LOC2 is NIL (that is missing) or HERE, then the current
+ ____
expression specifies the point to which the form given by LOC2 is
+ to be moved.
EDITOR 7 February 1983 PSL Manual
+page 16.18 section 16.3
+
+ N
N ___ ____
(N [EXP]) edit
+
+ ___
This command adds the EXPs to the end of the current expression;
+ _
i.e. Add at End. This compensates for the fact that the negative
+ integer command does not allow insertion after the last element.
+
+
+ ____ _______
____ _______
____ _______
-N:integer edit-command
-N:integer ___ edit-command
(-N:integer [EXP]) edit-command
+
+
+ Also can be used as:
+
+
+ -N
+
+
+ This is really two separate commands. The atomic form is an
+ attention changing command. The current expression becomes the
+ nth form from the end of the old current expression; i.e. Add
+ _
Before End. That is, -1 specifies the last element, -2 the
+ second from last, etc.
+
+ The list form of the command is a structure modification command.
+ This command inserts exp1 through expn (at least one expi must be
+ present) before the nth element (counting from the BEGINNING) of
+ the current expression. That is, -1 inserts before the first
+ element, -2 before the second, etc.
+
+
+ NEX
NEX ___ ____
(NEX COM) edit
+
+ Also can be used as:
+
+
+ NEX
+
+
+ BELOW NX
BELOW ___ NX
This command is equivalent to (BELOW COM) followed by NX. That
+ is, it does repeated 0s until a current expression matching com
+ NX
NX
is found. It then backs off by one 0 and does a NX.
+
+ The atomic form of the command is equivalent to (NEX _). This is
+ MARK
MARK
useful if the user is doing repeated (NEX x)s. He can MARK at x
+ and then use the atomic form.
+
+
+ NTH
NTH ___ ____
(NTH LOC) edit
+
+ LCL BELOW UP
LCL ___ BELOW UP
This command effectively performs (LCL LOC), (BELOW <), UP. The
+ net effect is to search the current expression only for the form
+ ___
specified by the location specification LOC. From there, return
+ to the initial level and set the current expression to be the
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.19
+
+ ___
tail whose first element contains the form specified by LOC at
+ any level.
+
+
+ NX
NX _ ____
(NX N) edit
+
+ Also can be used as:
+
+
+ NX
+
+
+ The atomic form of this command makes the current expression the
+ expression following the present current expression (at the same
+ _ _
level); i.e. Next.
+
+ The list form of the command is equivalent to n (an integer
+ NX
NX
number) repetitions of NX. If an error occurs (e.g. if there are
+ _
not N expressions following the current expression), the current
+ expression is unchanged.
+
+
+OK
OK ____
OK edit
+
+ This command causes normal exit from the editor.
+
+ The state of the edit is saved on property LASTVALUE of the atom
+ EDIT. If the next form edited is the same, the edit is restored.
+ That is, it is (with the exception of a BLOCK on the undo-list)
+ as though the editor had never been exited.
+
+ It is possible to save edit states for more than one form by
+ SAVE
SAVE
exiting from the editor via the SAVE command.
+
+
+ ORF
ORF ___ ____
(ORF [PAT]) edit
+
+ This command searches the current expression, in print order, for
+ ___
the first occurrence of any form which matches one of the PATs;
+ UP
__ _ UP
i.e. Print Order Final. If found, an UP is executed, and the
+ current expression becomes the expression so specified. This
+ command is equivalent to (F (*ANY* pat1 pat2 ... patn) N). Note
+ that the top level check is not performed.
+
+
+ ORR
ORR ____ ____
(ORR [COMS]) edit
+
+ ____
This command operates in the following manner. Each COMS is a
+ ORR
ORR ____
list of edit commands. ORR first executes the first COMS. If no
+ ORR
ORR
error occurs, ORR terminates, leaving the current expression as
+ ____
it was at the end of executing COMS. Otherwise, it restores the
+ current expression to what it was on entry and repeats this
EDITOR 7 February 1983 PSL Manual
+page 16.20 section 16.3
+
+ ____ ____
operation on the second COMS, etc. If no COMS is successfully
+ ORR
ORR
executed without error, ORR generates an error and the current
+ expression is unchanged.
+
+
+ P
P __ __ ____
(P N1 <N2>) edit
+
+ Also can be used as:
+
+
+ P
+
+
+ _
This command prints the current expression; i.e. Print. The
+ atomic form of the command prints the current expression to a
+ depth of 2. More deeply nested forms are printed as &.
+
+ __
The form (P N1) prints the N1st element of the current expression
+ __
to a depth of 2. The argument N1 need not be an integer. It may
+ NTH
NTH
be a general location specification. The NTH command is used in
+ the search, so that the expression printed is the first element
+ of the current expression which contains the desired form at any
+ level.
+
+ __
The third form of the command prints the N1st element of the
+ __ __
current expression to a depth of N2. Again, N1 may be a general
+ location specification.
+
+ __
If N1 is 0, the current expression is printed.
+
+ Many of the editor commands, particularly those which search,
+ ___
take as an argument a pattern (abbreviated PAT). A pattern may
+ be any combination of literal list structure and special pattern
+ elements.
+
+ The special elements are as follows.
+
+
+ & this matches any single element.
+
+ *ANY* if (CAR pat) is the atom *ANY*, then (CDR pat) must be
+ ___
a list of patterns. PAT matches any form which matches
+ Cdr
Cdr ___
any of the patterns in (Cdr PAT).
+
+ @ if an element of pat is a literal atom whose last
+ character is @, then that element matches any literal
+ atom whose initial characters match the initial
+ characters of the element. That is, VER matches
+ VERYLONGATOM.
+
+ -- this matches any tail of a list or any interior segment
+ of a list.
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.21
+
+ Car Cdr
Car ___ ___ Cdr ___
== if (Car PAT) is ==, then PAT matches X iff (Cdr PAT) is
+ Eq
Eq
Eq to X.
+
+ Cdr
___ Cdr ___
::: if PAT begins with :::, the Cdr of PAT is matched
+ against tails of the expression.
+
+
+ ____ _______
____ _______
____ _______
N:integer edit-command
N:integer ___ edit-command
(N:integer [EXP]) edit-command
+
+
+ Also can be used as:
+
+
+ N:integer
+
+
+ This command, a strictly positive integer N, is really two
+ commands. The atomic form of the command is an
+ attention-changing command. The current expression becomes the
+ nth element of the current expression.
+
+ The list form of the command is a structure modification command.
+ It replaces the Nth element of the current expression by the
+ ___
forms EXP. If no forms are given, then the Nth element of the
+ current expression is deleted.
+
+
+PP
PP ____
PP edit
+
+ _ _
This command Pretty-Prints the current expression.
+
+
+ R
R ____ ____ ____
(R EXP1 EXP2) edit
+
+ _ ____ ____
This command Replaces all occurrences of EXP1 by EXP2 in the
+ current expression.
+
+ ____
Note that EXP1 may be either the literal s-expression to be
+ replaced, or it may be an edit pattern. If a pattern is given,
+ the form which first matches that pattern is replaced throughout.
+ All forms which match the pattern are NOT replaced.
+
+
+ REPACK
REPACK ___ ____
(REPACK LOC) edit
+
+ Also can be used as:
+
+
+ REPACK
+
+
+ This command allows the editing of long strings (or atom names)
EDITOR 7 February 1983 PSL Manual
+page 16.22 section 16.3
+
+ REPACK
REPACK
one character at a time. REPACK calls the editor recursively on
+ UNPACK
UNPACK
UNPACK of the specified atom. (In the atomic form of the
+ command, the current expression is used unless it is a list;
+ then, the first element is used. In the list form of the
+ command, the form specified by the location specification is
+ OK
OK
treated in the same way.) If the lower editor is exited via OK,
+ STOP
STOP
the result is repacked and replaces the original atom. If STOP
+ is used, no replacement is done. The new atom is always printed.
+
+
+ RI
RI __ __ ____
(RI N1 N2) edit
+
+ This command moves a right parenthesis. The parenthesis is moved
+ __
from the end of the the N1st element of the current expression to
+ __ __ _
after the N2nd element of the N1st element; i.e. Right
+ _ __
Parenthesis Insert. Remaining elements of the N1st element are
+ raised to the top level of the current expression.
+
+ __ __
The arguments, N1 and N2, are normally integers. However,
+ NTH
NTH
because the NTH command is used in the search, they may be any
+ location specifications. The expressions referred to are the
+ first element of the current expression in which the specified
+ form is found at any level, and the first element of that
+ __
expression in which the form specified by N2 is found at any
+ level.
+
+
+ RO
RO _ ____
(RO N) edit
+
+ This command moves the right parenthesis from the end of the nth
+ element of the current expression to the end of the current
+ _ _
expression; i.e. Right Parenthesis Remove. All elements
+ following the Nth are moved inside the nth element.
+
+ NTH
NTH _
Because the NTH command is used for the search, the argument N,
+ which is normally an integer, may be any location specification.
+ The expression referred to is the first element of the current
+ expression in which the specified form is found at any depth.
+
+
+ S
S ___ ___ ____
(S VAR LOC) edit
+
+ SetQ
_ SetQ ___
This command Sets (via SetQ) the variable whose name is VAR to
+ the current expression after executing the location specification
+ ___
LOC. The current expression is not changed.
+
+
+SAVE
SAVE ____
SAVE edit
+
+ This command exits normally from the editor. The state of the
+ edit is saved on the property EDIT-SAVE of the atom being edited.
+ When the same atom is next edited, the state of the edit is
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.23
+
+ restored and (with the exception of a BLOCK on the undo-list) it
+ is as if the editor had never been exited. It is not necessary
+ SAVE
SAVE
to use the SAVE command if only a single atom is being edited.
+ OK
OK
See the OK command.
+
+
+ SECOND
SECOND ___ ____
(SECOND LOC) edit
+
+ This command changes the current expression to what it would be
+ ___
after the location specification LOC is executed twice. The
+ ___
current expression is unchanged if either execution of LOC fails.
+
+
+STOP
STOP ____
STOP edit
+
+ ____
This command exits abnormally from the editor; i.e. Stop Editing.
+ TTY:
TTY:
This command is useful mainly in conjunction with TTY: commands
+ which the user wishes to abort. For example, if the user is
+ executing
+
+
+ (MOVE 3 TO AFTER COND TTY:)
+
+
+ OK MOVE
OK MOVE
and he exits from the lower editor via OK, the MOVE command
+ completes its operation. If, on the other hand, the user exits
+ STOP TTY: MOVE
STOP TTY: MOVE
via STOP, TTY: produces an error and MOVE aborts.
+
+
+ SW
SW __ __ ____
(SW N1 N2) edit
+
+ __ __ __
This command Swaps the N1st and N2nd elements of the current
+ expression. The arguments are normally but not necessarily
+ SW NTH
SW NTH
integers. SW uses NTH to perform the search, so that any
+ location specifications may be used. In each case, the first
+ element of the current expression which contains the specified
+ form at any depth is used.
+
+
+TEST
TEST ____
TEST edit
+
+ This command adds an undo-block to the undo-list. This block
+ UNDO !UNDO
UNDO !UNDO
limits the scope of UNDO and !UNDO commands to changes made after
+ UNBLOCK
UNBLOCK
the block was inserted. The block may be removed via UNBLOCK.
+
+
+ THIRD
THIRD ___ ____
(THIRD LOC) edit
+
+ This command executes the location specification loc three times.
+ LC
LC ___
It is equivalent to three repetitions of (LC LOC). Note,
+ however, that if any of the executions causes an editor error,
+ the current expression remains unchanged.
EDITOR 7 February 1983 PSL Manual
+page 16.24 section 16.3
+
+ THROUGH
____ THROUGH ____ ____
(LOC1 THROUGH LOC2) edit
+
+ This command makes the current expression the segment from the
+ ____
form specified by LOC1 through (including) the form specified by
+ LC UP BI
____ LC ____ UP BI ____
LOC2. It is equivalent to (LC LOC1), UP, (BI 1 LOC2), 1. Thus,
+ it makes a single element of the specified elements and makes
+ that the current expression.
+
+ This command is meant for use in the location specifications
+ DELETE, EMBED, EXTRACT REPLACE
DELETE, EMBED, EXTRACT REPLACE
given to the DELETE, EMBED, EXTRACT and REPLACE commands, and is
+ THROUGH
THROUGH
not particularly useful by itself. Use of THROUGH with these
+ commands sets a special flag so that the editor removes the extra
+ THROUGH
THROUGH
set of parens added by THROUGH.
+
+
+ TO
____ TO ____ ____
(LOC1 TO LOC2) edit
+
+ This command makes the current expression the segment from the
+ ____
form specified by LOC1 up to (but not including) the form
+ LC UP BI
____ LC ____ UP BI
specified by LOC2. It is equivalent to (LC LOC1), UP, (BI 1
+ RI
RI
loc), (RI 1 -2), 1. Thus, it makes a single element of the
+ specified elements and makes that the current expression.
+
+ This command is meant for use in the location specifications
+ DELETE, EMBED, EXTRACT REPLACE
DELETE, EMBED, EXTRACT REPLACE
given to the DELETE, EMBED, EXTRACT and REPLACE commands, and is
+ TO
TO
not particularly useful by itself. Use of TO with these commands
+ sets a special flag so that the editor removes the extra set of
+ TO
TO
parens added by TO.
+
+
+TTY:
TTY: ____
TTY: edit
+
+ This command calls the editor recursively, invoking a 'lower
+ editor.' The user may execute any and all edit commands in this
+ TTY:
TTY:
lower editor. The TTY: command terminates when the lower editor
+ OK STOP
OK STOP
is exited via OK or STOP.
+
+ The form being edited in the lower editor is the same as that
+ being edited in the upper editor. Upon entry, the current
+ expression in the lower is the same as that in the upper editor.
+
+
+UNBLOCK
UNBLOCK ____
UNBLOCK edit
+
+ This command removes an undo-block from the undo-list, allowing
+ UNDO !UNDO
UNDO !UNDO
UNDO and !UNDO to operate on changes which were made before the
+ block was inserted.
+
+ TEST
TEST
Blocks may be inserted by exiting from the editor and by the TEST
+ command.
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.25
+
+UNDO
UNDO ___ ____
UNDO (COM) edit
+
+ Also can use as:
+
+
+ UNDO
+
+
+ This command undoes editing changes. All editing changes are
+ undoable, provided that the information is available to the
+ editor. (The necessary information is always available unless
+ SAVE
SAVE
several forms are being edited and the SAVE command is not used.)
+ Changes made in the current editing session are ALWAYS undoable.
+
+ The short form of the command undoes the most recent change.
+ UNDO !UNDO
UNDO !UNDO
Note, however, that UNDO and !UNDO changes are skipped, even
+ though they are themselves undoable.
+
+ The long form of the command allows the user to undo an arbitrary
+ UNDO !UNDO
UNDO !UNDO
command, not necessarily the most recent. UNDO and !UNDO may
+ also be undone in this manner.
+
+
+UP
UP ____
UP edit
+
+ If the current expression is a tail of the next higher
+ UP
UP
expression, UP has no effect. Otherwise the current expression
+ becomes the form whose first element is the old current
+ expression.
+
+
+ XTR
XTR ___ ____
(XTR LOC) edit
+
+ This command replaces the current expression by one of its
+ ___
subexpressions. The location specification, LOC, gives the form
+ to be used. Note that only the current expression is searched.
+ If the current expression is a tail, the command operates on the
+ first element of the tail.
+
+
+ ____ _______
____ _______
____ _______
edit-command
edit-command
0 edit-command
+
+
+ This command makes the current expression the next higher
+ expression. This usually, but not always, corresponds to
+ returning to the next higher left parenthesis. This command is,
+ in some sense, the inverse of the POS-INTEGER and NEG- INTEGER
+ atomic commands.
+
+
+ _____ ____ _______
_____ ____ _______
_____ ____ _______
## fexpr, edit-command
## ___ ____ ___ fexpr, edit-command
## ([COM:form]): any fexpr, edit-command
EDITOR 7 February 1983 PSL Manual
+page 16.26 section 16.3
+
+ The value of this fexpr, useful mainly in macros, is the
+ ___
expression which would be current after executing all of the COMs
+ in sequence. The current expression is not changed.
+
+ CHANGE INSERT
CHANGE INSERT
Commands in which this fexpr might be used (e.g. CHANGE, INSERT, and
+REPLACE
REPLACE
REPLACE) make special checks and use a copy of the expression returned.
+
+
+ ____ _______
____ _______
____ _______
^ edit-command
^ edit-command
^ edit-command
+
+
+ This command makes the top level expression the current
+ expression.
+
+
+ ____ _______
____ _______
____ _______
? edit-command
? edit-command
? edit-command
+
+
+ This command prints the current expression to a level of 100. It
+ is equivalent to (P 0 100).
+
+
+ ____ _______
____ _______
____ _______
?? edit-command
?? edit-command
?? edit-command
+
+
+ This command displays the entries on the undo-list.
+
+
+ ____ _______
____ _______
____ _______
_ edit-command
_ edit-command
_ edit-command
+
+
+ This command returns to the position indicated by the most recent
+ MARK MARK
MARK MARK
MARK command. The MARK is not removed.
+
+
+ ____ _______
____ _______
____ _______
_ edit-command
_ ___ edit-command
(_ PAT) edit-command
+
+
+ This command ascends (does repeated 0s), testing the current
+ ___
expression at each ascent for a match with PAT. The current
+ expression becomes the first form to match. If pattern is
+ atomic, it is matched with the first element of each expression;
+ otherwise, it is matched against the entire form.
+
+
+ ____ _______
____ _______
____ _______
__ edit-command
__ edit-command
__ edit-command
+
+
+ This command returns to the position indicated by the most recent
+ MARK MARK
MARK MARK
MARK command and removes the MARK.
PSL Manual 7 February 1983 EDITOR
+section 16.3 page 16.27
+
+ ____ _______
____ _______
____ _______
: edit-command
: ___ edit-command
(: [EXP]) edit-command
+
+
+ Also can be used as:
+
+
+ (:)
+
+
+ ___
This command replaces the current expression by the forms EXP.
+ If no forms are given (as in the second form of the command), the
+ current expression is deleted.
+
+
+ ____ _______
____ _______
____ _______
:: edit-command
___ :: ___ edit-command
(PAT :: LOC) edit-command
+
+
+ This command sets the current expression to the first form (in
+ ___
print order) which matches PAT and contains the form specified by
+ ___
the location specification LOC at any level. The command is
+ F LCL
F ___ LCL ___ ___
equivalent to (F PAT N), (LCL LOC), (_ PAT).
+
+
+ ____ _______
____ _______
____ _______
\ edit-command
\ edit-command
\ edit-command
+
+
+ This command returns to the expression which was current before
+ the last 'big jump.' Big jumps are caused by these commands: ^,
+ _, __, !NX, all commands which perform a search or use a location
+ specification, \ itself, and \P. NOTE: \ is shift-L on a
+ teletype.
+
+
+ ____ _______
____ _______
____ _______
\P edit-command
\P edit-command
\P edit-command
+
+
+ This command returns to the expression which was current before
+ the last print operation (P, PP or ?). Only the two most recent
+ locations are saved. NOTE: \ is shift-L on a teletype.
+
+
+ ____ _______
____ _______
____ _______
!NX edit-command
!NX edit-command
!NX edit-command
+
+
+ This command makes the next expression at a higher level the
+ current expression. That is, it goes through any number of right
+ parentheses to get to the next expression.
+
+
+ ____ _______
____ _______
____ _______
!UNDO edit-command
!UNDO edit-command
!UNDO edit-command
EDITOR 7 February 1983 PSL Manual
+page 16.28 section 16.3
+
+ This command undoes all changes made in the current editing
+ session (back to the most recent block). All changes are
+ undoable.
+
+ TEST
TEST
Blocks may be inserted by exiting the editor or by the TEST
+ UNBLOCK
UNBLOCK
command. They may be removed with the UNBLOCK command.
+
+
+ ____ _______
____ _______
____ _______
!0 edit-command
!0 edit-command
!0 edit-command
+
+
+ This command does repeated 0s until it reaches an expression
+ which is not a tail of the next higher expression. That
+ expression becomes the new current expression. That is, this
+ command returns to the next higher left parenthesis, regardless
+ of intervening tails.
ADDED psl-1983/3-1/lpt/17-utilities.lpt
Index: psl-1983/3-1/lpt/17-utilities.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/17-utilities.lpt
@@ -0,0 +1,1299 @@
+PSL Manual 7 February 1983 Utilities
+section 17.0 page 17.1
+
+ CHAPTER 17
CHAPTER 17
CHAPTER 17
+ MISCELLANEOUS UTILITIES
MISCELLANEOUS UTILITIES
MISCELLANEOUS UTILITIES
+
+
+
+
+ 17.1. Introduction . . . . . . . . . . . . . . . 17.1
+ 17.2. RCREF - Cross Reference Generator for PSL Files . . . 17.1
+ 17.2.1. Restrictions. . . . . . . . . . . . . 17.2
+ 17.2.2. Usage . . . . . . . . . . . . . . . 17.3
+ 17.2.3. Options . . . . . . . . . . . . . . 17.3
+ 17.3. Picture RLISP. . . . . . . . . . . . . . . 17.4
+ 17.3.1. Running PictureRLISP on HP2648A and on TEKTRONIX 17.10
+ 4006-1 Terminals . . . . . . . . . . .
+ 17.4. Tools for Defining Macros. . . . . . . . . . . 17.11
+ 17.4.1. DefMacro . . . . . . . . . . . . . . 17.11
+ 17.4.2. BackQuote. . . . . . . . . . . . . . 17.12
+ 17.4.3. Sharp-Sign Macros . . . . . . . . . . . 17.12
+ 17.4.4. MacroExpand . . . . . . . . . . . . . 17.13
+ 17.4.5. DefLambda. . . . . . . . . . . . . . 17.13
+ 17.5. Simulating a Stack . . . . . . . . . . . . . 17.14
+ 17.6. DefStruct . . . . . . . . . . . . . . . . 17.14
+ 17.6.1. Options . . . . . . . . . . . . . . 17.17
+ 17.6.2. Slot Options. . . . . . . . . . . . . 17.18
+ 17.6.3. A Simple Example . . . . . . . . . . . 17.18
+ 17.7. DefConst . . . . . . . . . . . . . . . . 17.21
+ 17.8. Functions for Sorting . . . . . . . . . . . . 17.22
+ 17.9. Hashing Cons . . . . . . . . . . . . . . . 17.23
+ 17.10. Graph-to-Tree . . . . . . . . . . . . . . 17.25
+ 17.11. Inspect Utility. . . . . . . . . . . . . . 17.25
+
+
+
+
+17.1. Introduction
17.1. Introduction
17.1. Introduction
+
+ This chapter describes an assortment of utility packages. Its purpose is
+to record the existence and capabilities of a number of tools. More
+information on existing packages can be found by looking at the current set
+of HELP files (DIR PH:*.* on the DEC-20).
+
+
+
+17.2. RCREF - Cross Reference Generator for PSL Files
17.2. RCREF - Cross Reference Generator for PSL Files
17.2. RCREF - Cross Reference Generator for PSL Files
+
+ RCREF is a Standard LISP program for processing a set of Standard LISP
+function definitions to produce:
+
+
+ a. A "Summary" showing:
Utilities 7 February 1983 PSL Manual
+page 17.2 section 17.2
+
+ i. A list of files processed.
+ ii. A list of "entry points" (functions which are not called
+ or are called only by themselves).
+ iii. A list of undefined functions (functions called but not
+ defined in this set of functions).
+ iv. A list of variables that were used non-locally but not
+ declared GLOBAL or FLUID before their use.
+ v. A list of variables that were declared GLOBAL but used as
+ FLUIDs (i.e. bound in a function).
+ vi. A list of FLUID variables that were not bound in a
+ function so that one might consider declaring them
+ GLOBALs.
+ vii. A list of all GLOBAL variables present.
+ viii. A list of all FLUID variables present.
+ ix. A list of all functions present.
+
+
+ b. A "global variable usage" table, showing for each non-local
+ variable:
+
+
+ i. Functions in which it is used as a declared FLUID or
+ GLOBAL.
+ ii. Functions in which it is used but not declared before.
+ iii. Functions in which it is bound.
+ SetQ
SetQ
iv. Functions in which it is changed by SetQ.
+
+
+ c. A "function usage" table showing for each function:
+
+
+ i. Where it is defined.
+ ii. Functions which call this function.
+ iii. Functions called by it.
+ iv. Non-local variables used.
+
+
+ The output is alphabetized on the first seven characters of each function
+name.
+
+ RCREF also checks that functions are called with the correct number of
+arguments.
+
+
+17.2.1. Restrictions
17.2.1. Restrictions
17.2.1. Restrictions
+
+ Algebraic procedures in REDUCE are treated as if they were symbolic, so
+that algebraic constructs actually appear as calls to symbolic functions,
+ AEval
AEval
such as AEval.
+
+ SYSLISP procedures are not correctly analyzed.
PSL Manual 7 February 1983 Utilities
+section 17.2 page 17.3
+
+17.2.2. Usage
17.2.2. Usage
17.2.2. Usage
+
+ RCREF should be used in PSL:RLISP. To make a file FILE.CRF which is a
+cross reference listing for files FILE1.EX1 and FILE2.EX2 do the following
+in RLISP:
+
+ @PSL:RLISP
+ LOAD RCREF; % RCREF is now autoloading, so this may be omitted
+
+ OUT "file.crf"; % later, CREFOUT ...
+ ON CREF;
+ IN "file1.ex1","file2.ex2";
+ OFF CREF;
+ SHUT "file.crf"; % later CREFEND
+
+To process more files, more IN statements may be added, or the IN statement
+may be changed to include more files.
+
+
+17.2.3. Options
17.2.3. Options
17.2.3. Options
+
+
+ __________ ______
!*CREFSUMMARY [Initially: NIL] switch
+
+ If the switch CREFSUMMARY is ON then only the summary (see 1
+ above) is produced.
+
+ Functions with the flag NOLIST are not examined or output. Initially,
+all Standard LISP functions are so flagged. (In fact, they are kept on a
+list NOLIST!*, so if you wish to see references to ALL functions, then CREF
+should be first loaded with the command LOAD RCREF, and this variable then
+set to NIL). (RCREF is now autoloading.)
+
+
+ __________ ______
NOLIST!* [Initially: the following list] global
+
+ (AND COND LIST MAX MIN OR PLUS PROG PROG2 PROGN TIMES LAMB
+ ADD1 APPEND APPLY ASSOC ATOM CAR CDR CAAR CADR CDAR CDDR
+ CAADR CADAR CADDR CDAAR CDADR CDDAR CDDDR CAAAAR CAAADR
+ CAADDR CADAAR CADADR CADDAR CADDDR CDAAAR CDAADR CDADAR
+ CDDAAR CDDADR CDDDAR CDDDDR CLOSE CODEP COMPRESS CONS CO
+ DE DEFLIST DELETE DF DIFFERENCE DIGIT DIVIDE DM EJECT
+ EQUAL ERROR ERRORSET EVAL EVLIS EXPAND EXPLODE EXPT FIX FI
+ FLAGP FLOAT FLOATP FLUID FLUIDP FUNCTION GENSYM GET GET
+ GLOBAL GLOBALP GO GREATERP IDP INTERN LENGTH LESSP LIN
+ LITER LPOSN MAP MAPC MAPCAN MAPCAR MAPCON MAPLIST MAX2
+ MEMQ MINUS MINUSP MIN2 MKVECT NCONC NOT NULL NUMBERP ONE
+ PAGELENGTH PAIR PAIRP PLUS2 POSN PRINC PRINT PRIN1 PRIN2
+ PUT PUTD PUTV QUOTE QUOTIENT RDS READ READCH REMAINDE
+ REMFLAG REMOB REMPROP RETURN REVERSE RPLACA RPLACD SASS
+ SETQ STRINGP SUBLIS SUBST SUB1 TERPRI TIMES2 UNFLUID UPBV
+ WRS ZEROP)
Utilities 7 February 1983 PSL Manual
+page 17.4 section 17.2
+
+ It should also be remembered that in RLISP any macros with the flag
+EXPAND or, if FORCE is on, without the flag NOEXPAND are expanded before
+the definition is seen by the cross-reference program, so this flag can
+also be used to select those macros you require expanded and those you do
+not. The use of ON FORCE; is highly recommended for CREF.
+
+
+
+17.3. Picture RLISP
17.3. Picture RLISP
17.3. Picture RLISP
+
+ [??? ReWrite ???]
[??? ReWrite ???]
[??? ReWrite ???]
+
+ Picture RLISP is an ALGOL-like graphics language for Teleray, HP2648a and
+Tektronix, in which graphics Model primitives are combined into complete
+Models for display. PRLISP is a 3D version; PRLISP2D is a faster, smaller
+2D version which also drives more terminals. Two demonstration files,
+PR-DEMO.RED and PR-DEMO.Sl, are available on PU. See the help files
+PH:PRLISP.HLP and PRLISP2D.HLP.
+
+ Model primitives include:
+
+
+P:={x,y,z};
+ A point (y, and z may be omitted, default to 0).
+
+PS:=P1_ P2_ ... Pn;
+ A Point Set is an ordered set of Points (Polygon).
+
+G := PS1 & PS2 & ... PSn;
+ A Group of Polygons.
+
+Point Set Modifiers
+ alter the interpretation of Point Sets within their scope.
+
+BEZIER() causes the point-set to be interpreted as the specification
+ points for a BEZIER curve, open pointset.
+
+BSPLINE() does the same for a Bspline curve, closed pointset.
+
+TRANSFORMS:
+ Mostly return a transformation matrix.
+
+Translation:
+ Move the specified amount along the specified axis.
+ XMOVE(deltaX); YMOVE(deltaY); ZMOVE(deltaZ);
+ MOVE(deltaX, deltaY, deltaZ);
+
+Scale: Scale the Model SCALE (factor) XSCALE(factor); YSCALE(factor);
+ ZSCALE(factor);
+ SCALE1(x.scale.factor, y.scale.factor, z.scale.factor);
+ SCALE<Scale factor>;. Scale along all axes.
PSL Manual 7 February 1983 Utilities
+section 17.3 page 17.5
+
+Rotation: ROT(degrees); ROT(degrees, point.specifying.axis); XROT(degrees);
+ YROT(degrees); ZROT(degrees);
+
+Window (z.eye,z.screen):
+ The WINDOW primitives assume that the viewer is located along the
+ z axis looking in the positive z direction, and that the viewing
+ window is to be centered on both the x and y axis.
+
+Vwport(leftclip,rightclip,topclip,bottomclip):
+ The VWPORT, which specifies the region of the screen which is
+ used for display.
+
+REPEATED (number.of.times, my.transform):
+ The Section of the Model which is contained within the scope of
+ the Repeat Specification is replicated. Note that REPEATED is
+ intended to duplicate a sub-image in several different places on
+ the screen; it was not designed for animation.
+
+Identifiers of other Models
+ the Model referred to is displayed as if it were part of the
+ current Model for dynamic display.
+
+Calls to PictureRLISP Procedures
+ This Model primitive allows procedure calls to be imbedded within
+ Models. When the Model interpreter reaches the procedure
+ identifier it calls it, passing it the portion of the Model below
+ the procedure as an argument. The current transformation matrix
+ and the current pen position are available to such procedures as
+ the values of the global identifiers GLOBAL!.TRANSFORM and
+ HEREPOINT. If normal procedure call syntax, i.e.
+ proc.name (parameters), is used then the procedure is called at
+ Model-building time, but if only the procedure's identifier is
+ used then the procedure is imbedded in the Model.
+
+ERASE() Clears the screen and leaves the cursor at the origin.
+
+SHOW(pict)
+ Takes a picture and displays it on the screen.
+
+ESHOW (pict)
+ Erases the whole screen and display "pict".
+
+HP!.INIT(), TEK!.INIT(), TEL!.INIT()
+ Initializes the operating system's view of the characteristics of
+ HP2648A terminal, TEKTRONIX 4006-1 (also ADM-3A with
+ Retrographics board, and Teleray-1061).
+
+
+ For example, the Model
Utilities 7 February 1983 PSL Manual
+page 17.6 section 17.3
+
+ (A _ B _ C & {1,2} _ B) | XROT (30) | 'TRAN ;
+
+ %
+ % PictureRLISP Commands to SHOW lots of Cubes
+ %
+ % Outline is a Point Set defining the 20 by 20
+ % square which is part of the Cubeface
+ %
+ Outline := { 10, 10} _ {-10, 10} _
+ {-10,-10} _ { 10,-10} _ {10, 10};
+
+ % Cubeface also has an Arrow on it
+ %
+ Arrow := {0,-1} _ {0,2} & {-1,1} _ {0,2} _ {1,1};
+
+ % We are ready for the Cubeface
+
+ Cubeface := (Outline & Arrow) | 'Tranz;
+
+ % Note the use of static clustering to keep objects
+ % meaningful as well as the quoted Cluster
+ % to the as yet undefined transformation Tranz,
+ % which results in its evaluation being
+ % deferred until SHOW time
+
+ % and now define the Cube
+
+ Cube := Cubeface
+ & Cubeface | XROT (180) % 180 degrees
+ & Cubeface | YROT ( 90)
+ & Cubeface | YROT (-90)
+ & Cubeface | XROT ( 90)
+ & Cubeface | XROT (-90);
+ % In order to have a more pleasant look at
+ % the picture shown on the screen we magnify
+ % cube by 5 times.
+ BigCube := Cube | SCALE 5;
+
+ % Set up initial Z Transform for each cube face
+ %
+ Tranz := ZMOVE (10); % 10 units out
+
+ %
+ % GLOBAL!.TRANSFORM has been treated as a global variable.
+ % GLOBAL!.TRANSFORM should be initialized as a perspective
+ % transformation matrix so that a viewer can have a correct
+ % look at the picture as the viewing location changed.
+ % For instance, it may be set as the desired perspective
+ % with a perspective window centered at the origin and
+ % of screen size 60, and the observer at -300 on the z axis.
+ % Currently this has been set as default perspective transformation.
PSL Manual 7 February 1983 Utilities
+section 17.3 page 17.7
+
+ % Now draw cube
+ %
+ SHOW BigCube;
+
+ %
Utilities 7 February 1983 PSL Manual
+page 17.8 section 17.3
+
+
+ % Draw it again rotated and moved left
+ %
+ SHOW (BigCube | XROT 20 | YROT 30 | ZROT 10);
+
+ % Dynamically expand the faces out
+ %
+ Tranz := ZMOVE 12;
+ %
+ SHOW (BigCube | YROT 30 | ZROT 10);
+
+ % Now show 5 cubes, each moved further right by 80
+ %
+ Tranz := ZMOVE 10;
+ %
+ SHOW (Cube | SCALE 2.5 | XMOVE (-240) | REPEATED(5, XMOVE 80));
+
+ %
+ % Now try pointset modifier.
+ % Given a pointset (polygon) as control points either a BEZIER or a
+ % BSPLINE curve can be drawn.
+ %
+ Cpts := {0,0} _ {70,-60} _ {189,-69} _ {206,33} _ {145,130} _ {48,13
+ _ {0,84} $
+ %
+ % Now draw Bezier curve
+ % Show the polygon and the Bezier curve
+ %
+ SHOW (Cpts & Cpts | BEZIER());
+
+ % Now draw Bspline curve
+ % Show the polygon and the Bspline curve
+ %
+ SHOW (Cpts & Cpts | BSPLINE());
+
+ % Now work on the Circle
+ % Given a center position and a radius a circle is drawn
+ %
+ SHOW ( {10,10} | CIRCLE(50));
+
+ %
+ % Define a procedure which returns a model of
+ % a Cube when passed the face to be used
+ %
+ Symbolic Procedure Buildcube;
+ List 'Buildcube;
+ % put the name onto the property list
+ Put('buildcube, 'pbintrp, 'Dobuildcube);
+ Symbolic Procedure Dobuildcube Face$
+ Face & Face | XROT(180)
+ & Face | YROT(90)
+ & Face | YROT(-90)
PSL Manual 7 February 1983 Utilities
+section 17.3 page 17.9
+
+ & Face | XROT(90)
+ & Face | XROT(-90) ;
+ % just return the value of the one statement
+
+ % Use this procedure to display 2 cubes, with and
+ % without the Arrow - first do it by calling
+ % Buildcube at time the Model is built
+ %
+ P := Cubeface | Buildcube() | XMOVE(-15) &
+ (Outline | 'Tranz) | Buildcube() | XMOVE 15;
+ %
+ SHOW (P | SCALE 5);
+
+ % Now define a procedure which returns a Model of
+ % a cube when passed the half size parameter
+
+ Symbolic Procedure Cubemodel;
+ List 'Cubemodel;
+ %put the name onto the property list
+ Put('Cubemodel,'Pbintrp, 'Docubemodel);
+ Symbolic Procedure Docubemodel HSize;
+ << if idp HSize then HSize := eval HSize$
+ { HSize, HSize, HSize} _
+ {-HSize, HSize, HSize} _
+ {-HSize, -HSize, HSize} _
+ { HSize, -HSize, HSize} _
+ { HSize, HSize, HSize} _
+ { HSize, HSize, -HSize} _
+ {-HSize, HSize, -HSize} _
+ {-HSize, -HSize, -HSize} _
+ { HSize, -HSize, -HSize} _
+ { HSize, HSize, -HSize} &
+ {-HSize, HSize, -HSize} _
+ {-HSize, HSize, HSize} &
+ {-HSize, -HSize, -HSize} _
+ {-HSize, -HSize, HSize} &
+ { HSize, -HSize, -HSize} _
+ { HSize, -HSize, HSize} >>;
+
+ % Imbed the parameterized cube in some Models
+ %
+ His!.cube := 'His!.size | Cubemodel();
+ Her!.cube := 'Her!.size | Cubemodel();
+ R := His!.cube | XMOVE (60) &
+ Her!.cube | XMOVE (-60) ;
+
+ % Set up some sizes and SHOW them
+
+ His!.size := 50;
+ Her!.size := 30;
+ %
+ SHOW R ;
Utilities 7 February 1983 PSL Manual
+page 17.10 section 17.3
+
+
+ %
+ % Set up some different sizes and SHOW them again
+ %
+ His!.size := 35;
+ Her!.size := 60;
+ %
+ SHOW R;
+
+ %
+ % Now show a triangle rotated 45 degree about the z axis.
+ Rotatedtriangle := {0,0} _ {50,50} _
+ {100,0} _ {0,0} | Zrot (45);
+ %
+ SHOW Rotatedtriangle;
+
+ %
+ % Define a procedure which returns a model of a Pyramid
+ % when passed 4 vertices of a pyramid.
+ % Procedure Second,Third, Fourth and Fifth are primitive procedures
+ % written in the source program which return the second, the third,
+ % the fourth and the fifth element of a list respectively.
+ % This procedure simply takes 4 points and connects the vertices to
+ % show a pyramid.
+ Symbolic Procedure Pyramid (Point4); %.point4 is a pointset
+ Point4 &
+ Third Point4 _
+ Fifth Point4 _
+ Second Point4 _
+ Fourth Point4 ;
+
+ % Now give a pointset indicating 4 vertices build a pyramid
+ % and show it
+ %
+ My!.vertices := {-40,0} _ {20,-40} _ {90,20} _ {70,100};
+ My!.pyramid := Pyramid Vertices;
+ %
+ SHOW ( My!.pyramid | XROT 30);
+
+ %
+ % A procedure that makes a wheel with "count"
+ % spokes rotated around the z axis.
+ % in which "count" is the number specified.
+ Symbolic Procedure Dowheel(spoke,count)$
+ begin scalar rotatedangle$
+ count := first count$
+ rotatedangle := 360.0 / count$
+ return (spoke | REPEATED(count, ZROT rotatedangle))
+ end$
+ %
+ % Now draw a wheel consisting of 8 cubes
+ %
PSL Manual 7 February 1983 Utilities
+section 17.3 page 17.11
+
+ Cubeonspoke := (Outline | ZMOVE 10 | SCALE 2) | buildcube();
+ Eight!.cubes := Cubeonspoke | XMOVE 50 | WHEEL(8);
+ %
+ SHOW Eight!.cubes;
+
+ %
+ %Draw a cube in which each face consists of just
+ % a wheel of 8 Outlines
+ %
+ Flat!.Spoke := outline | XMOVE 25$
+ A!.Fancy!.Cube := Flat!.Spoke | WHEEL(8) | ZMOVE 50 | Buildcube()$
+ %
+ SHOW A!.Fancy!.Cube;
+
+ %
+ % Redraw the fancy cube, after changing perspective by
+ % moving the observer farther out along Z axis
+ %
+ GLOBAL!.TRANSFORM := WINDOW(-500,60);
+ %
+ SHOW A!.Fancy!.Cube;
+
+ %
+ % Note the flexibility resulting from the fact that
+ % both Buildcube and Wheel simply take or return any
+ % Model as their argument or value
+
+ The current version of PictureRLISP runs on HP2648A graphics terminal and
+TEKTRONIX 4006-1 computer display terminal. The screen of the HP terminal
+is 720 units long in the X direction, and 360 units high in the Y
+direction. The coordinate system used in HP terminal places the origin in
+approximately the center of the screen, and uses a domain of -360 to 360
+and a range of -180 to 180. Similarly, the screen of the TEKTRONIX
+terminal is 1024 units long in the X direction, and 780 units high in the Y
+direction. The same origin is used but the domain is -512 to 512 in the X
+direction and the range is -390 to 390 in the Y direction.
+
+ Procedures HP!.INIT and TEK!.INIT are used to set the terminals to
+graphics mode and initiate the lower level procedures on HP and TEKTRONIX
+terminals respectively. Basically, INIT procedures are written for
+different terminals depending on their specific characteristics. Using
+INIT procedures keeps terminal device dependence at the user's level to a
+minimum.
+
+
+
+17.4. Tools for Defining Macros
17.4. Tools for Defining Macros
17.4. Tools for Defining Macros
+
+ The following (and other) macro utilities are in the file PU:USEFUL.SL;
Utilities 7 February 1983 PSL Manual
+page 17.12 section 17.4
+
+ 1
+use (LOAD USEFUL) to access. See PH:USEFUL.HLP for more information.
+
+
+17.4.1. DefMacro
17.4.1. DefMacro
17.4.1. DefMacro
+
+
+ DefMacro
DefMacro _ __ _ ____ _ ____ __ _____
(DefMacro A:id B:form [C:form]): id macro
+
+ _____
_____
_____
DefMacro macro DefMacro
DefMacro macro DefMacro
DefMacro is a useful tool for defining macros. A DefMacro form
+ looks like
+
+ (DEFMACRO <NAME> <PATTERN> <S1> <S2> ... <Sn>)
+
+ ____ __
The <PATTERN> is an S-expression made of pairs and ids. It is
+ _____
_____
_____
macro
macro
matched against the arguments of the macro much like the first
+ DeSetQ
DeSetQ __
argument to DeSetQ. All of the non-NIL ids in <pattern> are
+ local variables which may be used freely in the body (the <Si>).
+ _____
_____
_____
macro ProgN
macro ProgN
If the macro is called the <Si> are evaluated as in a ProgN with
+ the local variables in <pattern> appropriately bound, and the
+ DefMacro
DefMacro
value of <Sn> is returned. DefMacro is often used with
+ BackQuote.
+
+
+17.4.2. BackQuote
17.4.2. BackQuote
17.4.2. BackQuote
+
+ Note that the special symbols described below only work in LISP syntax,
+ BackQuote UnQuote
BackQuote UnQuote
not RLISP. In RLISP you may simply use the functions BackQuote, UnQuote,
+ UnQuoteL BackQuote
UnQuoteL BackQuote
and UnQuoteL. Load USEFUL to get the BackQuote function.
+
+ _____
_____
_____
Read macro
Read macro
The backquote symbol "`" is a Read macro which introduces a quoted
+expression which may contain the unquote symbols comma "," and comma-atsign
+",@". An appropriate form consisting of the unquoted expression calls to
+ Cons
Cons
the function Cons and quoted expressions are produced so that the resulting
+expression looks like the quoted one except that the values of the unquoted
+expressions are substituted in the appropriate place. ",@" splices in the
+value of the subsequent expression (i.e. strips off the outer layer of
+parentheses). Thus
+
+ `(a (b ,x) c d ,@x e f)
+
+is equivalent to
+
+ (cons 'a (cons (list 'b x) (append '(c d) (append x '(e f)))))
+
+In particular, if x is bound to (1 2 3) this evaluates to
+
+
+_______________
+
+ 1
+ Useful was written by D. Morrison.
PSL Manual 7 February 1983 Utilities
+section 17.4 page 17.13
+
+ (a (b (1 2 3)) c d 1 2 3 e f)
+
+
+ BackQuote
BackQuote _ ____ ____ _____
(BackQuote A:form): form macro
+
+ Function name for back quote `.
+
+
+ UnQuote
UnQuote _ ___ _________ _____
(UnQuote A:any): Undefined fexpr
+
+ Eval
Eval
Function name for comma ,. It is an error to Eval this function;
+ BackQuote
BackQuote
it should occur only inside a BackQuote.
+
+
+ UnQuoteL
UnQuoteL _ ___ _________ _____
(UnQuoteL A:any): Undefined fexpr
+
+ Eval
Eval
Function name for comma-atsign ,@. It is an error to Eval this
+ BackQuote
BackQuote
function; it should only occur inside a BackQuote.
+
+
+17.4.3. Sharp-Sign Macros
17.4.3. Sharp-Sign Macros
17.4.3. Sharp-Sign Macros
+
+ USEFUL defines several MACLISP style sharp sign read macros. Note that
+these only work with the LISP reader, not RLISP. Those currently included
+are
+
+ #' : this is like the quote mark ' but is for FUNCTION instead of QUOTE.
+
+ #/ : this returns the numeric form of the following character read
+without raising it. For example #/a is 97 while #/A is 65.
+
+ #\ : This is a read macro for the CHAR macro, described in the PSL
+manual. Not that the argument is raised, if *RAISE is non-nil. For
+ Char
Char
example, #\a = #\A = 65, while #\!a = #\(lower a) = 97. Char has been
+redefined in USEFUL to be slightly more table driven -- users can now add
+new "prefixes" such as META or CONTROL: just hang the appropriate function
+(from integers to integers) off the char-prefix-function property of the
+"prefix". A LARGE number of additional alias for various characters have
+been added, including all the "standard" ASCII names like NAK and DC1.
+
+ #. : this causes the following expression to be evaluated at read time.
+For example, `(1 2 #.(plus 1 2) 4) reads as (1 2 3 4)
+
+ #+ : this reads two expressions, and passes them to the if_system macro.
+That is, the first should be a system name, and if that is the current
+system the second argument is returned by the reader. If not, the next
+expression is returned.
+
+ #-: #- is similar, but causes the second arg to be returned only if it
+is NOT the current system.
Utilities 7 February 1983 PSL Manual
+page 17.14 section 17.4
+
+17.4.4. MacroExpand
17.4.4. MacroExpand
17.4.4. MacroExpand
+
+
+ MacroExpand
MacroExpand _ ____ _ __ ____ _____
(MacroExpand A:form [B:id]): form macro
+
+ _____
_____
_____
MacroExpand macro
MacroExpand macro
MacroExpand is a useful tool for debugging macro definitions. If
+ MacroExpand macro
MacroExpand macro
given one argument, MacroExpand expands all the macros in that
+ form. Often one wishes for more control over this process. For
+ _____
_____
_____
macro Let
macro Let
example, if a macro expands into a Let, we may not wish to see
+ Let
Let
the Let itself expanded to a lambda expression. Therefore
+ MacroExpand
MacroExpand
additional arguments may be given to MacroExpand. If these are
+ _____
_____
_____
macro
macro
supplied, they should be macros, and only those specified are
+ expanded.
+
+
+17.4.5. DefLambda
17.4.5. DefLambda
17.4.5. DefLambda
+
+
+ DefLambda
DefLambda _____
(DefLambda ): macro
+
+ Yet another little (two line) macro has been added to USEFUL:
+ DefLambda
DefLambda
DefLambda. This defines a macro much like a substitution macro
+ ______
______
______
smacro
smacro
(smacro) except that it is a lambda expression. Thus, modulo
+ ____
____
____
expr
expr
redefinability, it has the same semantics as the equivalent expr.
+ It is mostly intended as an easy way to open compile things. For
+ example, we would not normally want to define a substitution
+ macro for a constructor (NEW-FOO X) which maps into (CONS X X),
+ in case X is expensive to compute or, far worse, has side
+ effects. (DEFLAMBDA NEW-FOO (X) (CONS X X)) defines it as a
+ macro which maps (NEW-FOO (SETQ BAR (BAZ))) to
+ ((LAMBDA (X) (CONS X X)) (SETQ BAR (BAZ))).
+
+
+
+17.5. Simulating a Stack
17.5. Simulating a Stack
17.5. Simulating a Stack
+
+ The following macros are in the USEFUL package. They are convenient for
+ ____
adding and deleting things from the head of a list.
+
+
+ Push
Push ___ ___ ___ ____ ___ _____
(Push ITM:any STK:list): any macro
+
+ (PUSH ITEM STACK)
+
+ is equivalent to
+
+ (SETF STACK (CONS ITEM STACK))
PSL Manual 7 February 1983 Utilities
+section 17.5 page 17.15
+
+ Pop
Pop ___ ____ ___ _____
(Pop STK:list): any macro
+
+ (POP STACK)
+
+ does
+
+ (SETF STACK (CDR STACK))
+
+ _____
and returns the item popped off STACK. An additional argument
+ Pop
Pop
may be supplied to Pop, in which case it is a variable which is
+ SetQ
SetQ
SetQ'd to the popped value.
+
+
+
+17.6. DefStruct
17.6. DefStruct
17.6. DefStruct
+
+ (LOAD DEFSTRUCT) to use the functions described below, or FAST!-DEFSTRUCT
+to use those functions but with fast vector operations used. DefStruct is
+similar to the Spice (Common) LISP/LISP machine/MacLISP flavor of struct
+definitions, and is expected to be subsumed by the Mode package. It is
+ 2
+implemented in PSL as a function which builds access macros and fns for
+"typed" vectors, including constructor and alterant macros, a type
+predicate for the structure type, and individual selector/assignment fns
+for the elements. DefStruct understands a keyword-option oriented
+structure specification. DefStruct is now autoloading.
+
+ First a few miscellaneous functions on types, before getting into the
+depths of defining DefStructs:
+
+
+ DefstructP
DefstructP ____ __ _____ _______ ____
(DefstructP NAME:id): extra-boolean expr
+
+ This is a predicate that returns non-NIL (the Defstruct
+ ____
definition) if NAME is a structured type which has been defined
+ using Defstruct, or NIL if it is not.
+
+
+ DefstructType
DefstructType _ ______ __ ____
(DefstructType S:struct): id expr
+
+ This returns the type name field of an instance of a structured
+ _
type, or NIL if S cannot be a Defstruct type.
+
+
+
+
+
+
+_______________
+
+ 2
+ Defstruct was implemented by Russ Fish.
Utilities 7 February 1983 PSL Manual
+page 17.16 section 17.6
+
+ SubTypeP
SubTypeP _____ __ _____ __ _______ ____
(SubTypeP NAME1:id NAME2:id): boolean expr
+
+ _____
This returns true if NAME1 is a structured type which has been
+ _____
!:Included in the definition of structured type NAME2, possibly
+ through intermediate structure definitions. (In other words, the
+ _____ _____
selectors of NAME1 can be applied to NAME2.)
+
+ Now the function which defines the beasties, in all its gory glory:
+
+
+ Defstruct
Defstruct ____ ___ _______ __ ____ ____ _____ __ ____ __ _____
(Defstruct NAME-AND-OPTIONS:{id,list} [SLOT-DESCS:{id,list}]): id fexpr
+
+ Defines a record-structure data type. A general call to
+ Defstruct
Defstruct
Defstruct looks like this: (in RLISP syntax)
+
+ defstruct( struct-name( option-1, option-2, ... ),
+ slot-description-1,
+ slot-description-2,
+ ...
+ );
+
+ The name of the defined structure is returned.
+
+ Slot-descriptions are:
+
+
+slot-name( default-init, slot-option-1, slot-option-2, ... )
+
+
+ __
Struct-name and slot-name are ids. If there are no options following a
+name in a spec, it can be a bare id with no option argument list. The
+default-init form is optional and may be omitted. The default-init form is
+evaluated EACH TIME a structure is to be constructed and the value is used
+as the initial value of the slot. Options are either a keyword id, or the
+keyword followed by its argument list. Options are described below.
+
+ _____
_____
_____
macro
macro
A call to a constructor macro has the form:
+
+ MakeThing( slot-name-1( value-expr-1 ),
+ slot-name-2( value-expr-2 ),
+ ... );
+
+The slot-name:value lists override the default-init values which were part
+of the structure definition. Note that the slot-names look like unary
+functions of the value, so the parens can be left off. A call to MakeThing
+with no arguments of course takes all of the default values. The order of
+evaluation of the default-init forms and the list of assigned values is
+undefined, so code should not depend upon the ordering.
+
+ ____________ ____
Implementors Note: Common/LispMachine Lisps define it this way, but Is
+this necessary? It wouldn't be too tough to make the order be the same as
+the struct defn, or the argument order in the constructor call. Maybe they
PSL Manual 7 February 1983 Utilities
+section 17.6 page 17.17
+
+think such things should not be advertised and thus constrained in the
+future. Or perhaps the theory is that constructs such as this can be
+compiled more efficiently if the ordering is flexible?? Also, should the
+overridden default-init forms be evaluated or not? I think not.
+
+ _____
_____
_____
macro
macro
The alterant macro calls have a similar form:
+
+ AlterThing( thing,
+ slot-name-1 value-expr-1,
+ slot-name-2 value-expr-2,
+ ... );
+
+The first argument evaluates to the struct to be altered. (The optional
+parens were left off here.) This is just a multiple-assignment form, which
+eventually goes through the slot depositors. Remember that the slot-names
+are used, not the depositor names. (See !:Prefix, below.) The altered
+structure instance is returned as the value of an Alterant macro.
+
+ Implementators note: Common/LispMachine Lisp defines this such that all
+of the slots are altered in parallel AFTER the new value forms are
+evaluated, but still with the order of evaluation of the forms undefined.
+This seemed to lose more than it gained, but arguments for its worth will
+be entertained.
+
+
+17.6.1. Options
17.6.1. Options
17.6.1. Options
+
+ Structure options appear as an argument list to the struct-name. Many of
+the options themselves take argument lists, which are sometimes optional.
+Option ids all start with a colon (!:), on the theory that this
+distinguishes them from other things.
+
+ By default, the names of the constructor, alterant and predicate macros
+are MakeName, AlterName and NameP. "Name" is the struct-name. The
+!:Constructor, !:Alterant, and !:Predicate options can be used to override
+the default names. Their argument is the name to use, and a name of NIL
+causes the respective macro not to be defined at all.
+
+ The !:Creator option causes a different form of constructor to be
+defined, in addition to the regular "Make" constructor (which can be
+suppressed.) As in the !:Constructor option above, an argument supplies
+the name of the macro, but the default name in this case is CreateName. A
+call to a Creator macro has the form:
+
+
+ CreateThing( slot-value-1, slot-value-2, ... );
+
+
+___ ____ __ _______
All of the slot-values of the structure must be present, in the order they
+appear in the structure definition. No checking is done, other than
+assuring that the number of values is the same as the number of slots. For
+ ___ ___ ___________
obvious reasons, constructors of this form are not recommended for
Utilities 7 February 1983 PSL Manual
+page 17.18 section 17.6
+
+structures with many fields, or which may be expanded or modified.
+
+ Slot selector macros may appear on either the left side or the right side
+of an assignment. They are by default named the same as the slot-names,
+but can be given a common prefix by the !:Prefix option. If !:Prefix does
+not have an argument, the structure name is the prefix. If there is an
+argument, it should be a string or an id whose print name is the prefix.
+
+ The !:Include option allows building a new structure definition as an
+extension of an old one. The required argument is the name of a previously
+defined structure type. The access functions for the slots of the source
+type also works on instances of the new type. This can be used to build
+hierarchies of types. The source types contain generic information in
+common to the more specific subtypes which !:Include them.
+
+ The !:IncludeInit option takes an argument list of "slot-name(default-
+init)" pairs, like slot-descriptors without slot-options, and files them
+away to modify the default-init values for fields inherited as part of the
+!:Included structure type.
+
+
+17.6.2. Slot Options
17.6.2. Slot Options
17.6.2. Slot Options
+
+ Slot-options include the !:Type option, which has an argument declaring
+the type of the slot as a type id or list of permissible type ids. This is
+not enforced now, but anticipates the Mode system structures.
+
+ The !:UserGet and !:UserPut slot-options allow overriding the simple
+vector reference and assignment semantics of the generated selector macros
+with user-defined functions. The !:UserGet FNAME is a combination of the
+slot-name and a !:Prefix if applicable. The !:UserPut FNAME is the same,
+with "Put" prefixed. One application of this capability is building
+depositors which handle the incremental maintenance of parallel data
+structures as a side effect, such as automatically maintaining display file
+representations of objects which are resident in a remote display processor
+in parallel with modifications to the LISP structures which describe the
+objects. The Make and Create macros bypass the depositors, while Alter
+uses them.
+
+
+17.6.3. A Simple Example
17.6.3. A Simple Example
17.6.3. A Simple Example
+
+ (Input lines have a "> " prompt at the beginning.)
PSL Manual 7 February 1983 Utilities
+section 17.6 page 17.19
+
+
+ > % (Do definitions twice to see what functions were defined.)
+ > macro procedure TWICE u; list( 'PROGN, second u, second u );
+ TWICE
+
+ > % A definition of Complex, structure with Real and Imaginary parts
+ > % Redefine to see what functions were defined. Give 0 Init values
+ > TWICE
+ > Defstruct( Complex( !:Creator(Complex) ), R(0), I(0) );
+ *** Function `MAKECOMPLEX' has been redefined
+ *** Function `ALTERCOMPLEX' has been redefined
+ *** Function `COMPLEXP' has been redefined
+ *** Function `COMPLEX' has been redefined
+ *** Function `R' has been redefined
+ *** Function `PUTR' has been redefined
+ *** Function `I' has been redefined
+ *** Function `PUTI' has been redefined
+ *** Defstruct `COMPLEX' has been redefined
+ COMPLEX
+
+
+ > C0 := MakeComplex(); % Constructor with default inits.
+ [COMPLEX 0 0]
+
+ > ComplexP C0;% Predicate.
+ T
+
+ > C1:=MakeComplex( R 1, I 2 ); % Constructor with named values.
+ [COMPLEX 1 2]
+
+ > R(C1); I(C1);% Named selectors.
+ 1
+ 2
+
+ > C2:=Complex(3,4) % Creator with positional values.
+ [COMPLEX 3 4]
+
+ > AlterComplex( C1, R(2), I(3) ); % Alterant with named values.
+ [COMPLEX 2 3]
+
+ > C1;
+ [COMPLEX 2 3]
+
+ > R(C1):=5; I(C1):=6; % Named depositors.
+ 5
+ 6
+
+ > C1;
+ [COMPLEX 5 6]
+
+ > % Show use of Include Option. (Again, redef to show fns defined.)
+ > TWICE
Utilities 7 February 1983 PSL Manual
+page 17.20 section 17.6
+
+ > Defstruct( MoreComplex( !:Include(Complex) ), Z(99) );
+ *** Function `MAKEMORECOMPLEX' has been redefined
+ *** Function `ALTERMORECOMPLEX' has been redefined
+ *** Function `MORECOMPLEXP' has been redefined
+ *** Function `Z' has been redefined
+ *** Function `PUTZ' has been redefined
+ *** Defstruct `MORECOMPLEX' has been redefined
+ MORECOMPLEX
+
+
+ > M0 := MakeMoreComplex();
+ [MORECOMPLEX 0 0 99]
+
+ > M1 := MakeMoreComplex( R 1, I 2, Z 3 );
+ [MORECOMPLEX 1 2 3]
+
+ > R C1;
+ 5
+
+ > R M1;
+ 1
+
+ > % A more complicated example: The structures which are used in the
+ > % Defstruct facility to represent defstructs. (The EX prefix has
+ > % been added to the names to protect the innocent...)
+ > TWICE% Redef to show fns generated.
+ > Defstruct(
+ > EXDefstructDescriptor( !:Prefix(EXDsDesc), !:Creator ),
+ >DsSize(!:Type int ), % (Upper Bound of vector.)
+ >Prefix(!:Type string ),
+ >SlotAlist( !:Type alist ), % (Cdrs are SlotDescriptors.)
+ >ConsName( !:Type fnId ),
+ >AltrName( !:Type fnId ),
+ >PredName( !:Type fnId ),
+ >CreateName( !:Type fnId ),
+ >Include( !:Type typeid ),
+ >InclInit( !:Type alist )
+ > );
+ *** Function `MAKEEXDEFSTRUCTDESCRIPTOR' has been redefined
+ *** Function `ALTEREXDEFSTRUCTDESCRIPTOR' has been redefined
+ *** Function `EXDEFSTRUCTDESCRIPTORP' has been redefined
+ *** Function `CREATEEXDEFSTRUCTDESCRIPTOR' has been redefined
+ *** Function `EXDSDESCDSSIZE' has been redefined
+ *** Function `PUTEXDSDESCDSSIZE' has been redefined
+ *** Function `EXDSDESCPREFIX' has been redefined
+ *** Function `PUTEXDSDESCPREFIX' has been redefined
+ *** Function `EXDSDESCSLOTALIST' has been redefined
+ *** Function `PUTEXDSDESCSLOTALIST' has been redefined
+ *** Function `EXDSDESCCONSNAME' has been redefined
+ *** Function `PUTEXDSDESCCONSNAME' has been redefined
+ *** Function `EXDSDESCALTRNAME' has been redefined
+ *** Function `PUTEXDSDESCALTRNAME' has been redefined
PSL Manual 7 February 1983 Utilities
+section 17.6 page 17.21
+
+ *** Function `EXDSDESCPREDNAME' has been redefined
+ *** Function `PUTEXDSDESCPREDNAME' has been redefined
+ *** Function `EXDSDESCCREATENAME' has been redefined
+ *** Function `PUTEXDSDESCCREATENAME' has been redefined
+ *** Function `EXDSDESCINCLUDE' has been redefined
+ *** Function `PUTEXDSDESCINCLUDE' has been redefined
+ *** Function `EXDSDESCINCLINIT' has been redefined
+ *** Function `PUTEXDSDESCINCLINIT' has been redefined
+ *** Defstruct `EXDEFSTRUCTDESCRIPTOR' has been redefined
+ EXDEFSTRUCTDESCRIPTOR
+
+
+ > TWICE% Redef to show fns generated.
+ > Defstruct(
+ > EXSlotDescriptor( !:Prefix(EXSlotDesc), !:Creator ),
+ >SlotNum( !:Type int ),
+ >InitForm( !:Type form ),
+ >SlotFn(!:Type fnId ), % Selector/Depositor id.
+ >SlotType( !:Type type ), % Hm...
+ >UserGet( !:Type boolean ),
+ >UserPut( !:Type boolean )
+ > );
+ *** Function `MAKEEXSLOTDESCRIPTOR' has been redefined
+ *** Function `ALTEREXSLOTDESCRIPTOR' has been redefined
+ *** Function `EXSLOTDESCRIPTORP' has been redefined
+ *** Function `CREATEEXSLOTDESCRIPTOR' has been redefined
+ *** Function `EXSLOTDESCSLOTNUM' has been redefined
+ *** Function `PUTEXSLOTDESCSLOTNUM' has been redefined
+ *** Function `EXSLOTDESCINITFORM' has been redefined
+ *** Function `PUTEXSLOTDESCINITFORM' has been redefined
+ *** Function `EXSLOTDESCSLOTFN' has been redefined
+ *** Function `PUTEXSLOTDESCSLOTFN' has been redefined
+ *** Function `EXSLOTDESCSLOTTYPE' has been redefined
+ *** Function `PUTEXSLOTDESCSLOTTYPE' has been redefined
+ *** Function `EXSLOTDESCUSERGET' has been redefined
+ *** Function `PUTEXSLOTDESCUSERGET' has been redefined
+ *** Function `EXSLOTDESCUSERPUT' has been redefined
+ *** Function `PUTEXSLOTDESCUSERPUT' has been redefined
+ *** Defstruct `EXSLOTDESCRIPTOR' has been redefined
+ EXSLOTDESCRIPTOR
+
+
+ > END;
+ NIL
Utilities 7 February 1983 PSL Manual
+page 17.22 section 17.7
+
+17.7. DefConst
17.7. DefConst
17.7. DefConst
+
+
+ DefConst
DefConst _ __ _ ______ _________ _____
(DefConst [U:id V:number]): Undefined macro
+
+ DefConst
DefConst
DefConst is a simple means for defining and using symbolic
+ constants, as an alternative to the heavy-handed NEWNAM or DEFINE
+ facility in REDUCE/RLISP. Constants are defined thus:
+ DefConst(FooSize, 3); or as sequential pairs:
+
+ DEFCONST(FOOSIZE, 3,
+ BARSIZE, 4);
+
+
+ Const
Const _ __ ______ _____
(Const U:id): number macro
+
+ Const
Const
They are referred to by the macro Const, so
+
+ CONST(FOOSIZE)
+
+ would be replaced by 3.
+
+
+
+17.8. Functions for Sorting
17.8. Functions for Sorting
17.8. Functions for Sorting
+
+ The Gsort module provides functions for sorting lists and vectors. Some
+ __________ ________
of the functions take a comparison function as an argument. The comparison
+function takes two arguments and returns NIL if they are out of order, i.e.
+if the second argument should come before the first in the sorted result.
+Lambda expressions are acceptable as comparison functions.
+
+
+ Gsort
Gsort _____ ____ ______ ___ __ __ ________ ____ ______ ____
(Gsort TABLE:{list,vector} leq-fn:{id,function}): {list,vector} expr
+
+ ____ ______ ___ __
Returns a sorted list or vector. LEQ-FN is the comparison
+ _____
function used to determine the sorting order. The original TABLE
+ Gsort
Gsort
is unchanged. Gsort uses a stable sorting algorithm. In other
+ _ _ _
words, if X appears before Y in the original table then X will
+ _ _ _
appear before Y in the final table unless X and Y are out of
+ _ _
order. (An unstable sort, on the other hand, might swap X and Y
+ _ _
even if they're in order. This could happen when X and Y have
+ the same "key field", so either one could come first without
+ making a difference to the comparison function.)
+
+
+ GmergeSort
GmergeSort _____ ____ ______ ___ __ __ ________ ____ ______ ____
(GmergeSort TABLE:{list,vector} leq-fn:{id,function}): {list,vector} expr
+
+ Gsort
Gsort _____
The same as Gsort, but destructively modifies the TABLE argument.
+ GmergeSort Gsort
GmergeSort Gsort
GmergeSort has the advantage of being somewhat faster than Gsort.
+
+ Note that you should use the value returned by the function--
PSL Manual 7 February 1983 Utilities
+section 17.8 page 17.23
+
+ don't depend on the modified argument to give the right answer.
+
+
+ IdSort
IdSort _____ ____ ______ ____ ______ ____
(IdSort TABLE:{list,vector}): {list,vector} expr
+
+ __
Returns a table of ids sorted into alphabetical order. The
+ original table is unchanged. Case is not significant in
+ determining the alphabetical order. The table may contain
+ ______ __
strings as well as ids.
+
+ The following example illustrates the use of Gsort.
+
+ 1 lisp> (load gsort)
+ NIL
+ 2 lisp> (setq X '(3 8 -7 2 1 5))
+ (3 8 -7 2 1 5)
+ 3 lisp> % Sort from smallest to largest.
+ 3 lisp> (Gsort X 'leq)
+ (-7 1 2 3 5 8)
+ 4 lisp> % Sort from largest to smallest.
+ 4 lisp> (GmergeSort X 'geq)
+ (8 5 3 2 1 -7)
+ 5 lisp> % Note that X was "destroyed" by GmergeSort.
+ 5 lisp> X
+ (3 2 1 -7)
+ 6 lisp>
+ 6 lisp> % Here's IdSort, taking a vector as its argument.
+ 6 lisp> (IdSort '[the quick brown fox jumped over the lazy dog])
+ [BROWN DOG FOX JUMPED LAZY OVER QUICK THE THE]
+ 7 lisp>
+ 7 lisp> % Some examples of user defined comparison functions...
+ 7 lisp> (setq X '(("Joe" . 20000) ("Moe" . 21000) ("Larry" . 7000)))
+ (("Joe" . 20000) ("Moe" . 21000) ("Larry" . 7000))
+ 8 lisp>
+ 8 lisp> % First, sort the list alphabetically according to name,
+ 8 lisp> % using a lambda expression as the comparison function.
+ 8 lisp> (Gsort X
+ 8 lisp> '(lambda (X Y) (string-not-greaterp (car X) (car Y))))
+ (("Joe" . 20000) ("Larry" . 7000) ("Moe" . 21000))
+ 9 lisp>
+ 9 lisp> % Now, define a comparison function that compares cdrs of
+ 9 lisp> % pairs, and returns T if the first is less than or equal
+ 9 lisp> % to the second.
+ 9 lisp> (de cdr_leq (pair1 pair2)
+ 9 lisp> (leq (cdr pair1) (cdr pair2)))
+ CDR_LEQ
+ 10 lisp>
+ 10 lisp> % Use the cdr_leq function to sort X.
+ 10 lisp> (Gsort X 'cdr_leq)
+ (("Larry" . 7000) ("Joe" . 20000) ("Moe" . 21000))
Utilities 7 February 1983 PSL Manual
+page 17.24 section 17.9
+
+17.9. Hashing Cons
17.9. Hashing Cons
17.9. Hashing Cons
+
+ HCons
HCons
HCONS is a loadable module. The HCons function creates unique dotted
+ HCons Eq HCons Eq
HCons _ _ Eq HCons _ _ _ Eq _
pairs. In other words, HCons(A, B) Eq HCons(C, D) if and only if A Eq C
+ Eq
_ Eq _
and B Eq D. This allows rapid tests for equality between structures, at
+the cost of expending more time in creating the structures. The use of
+HCons
HCons
HCons may also save space in cases where lists share common substructure,
+since only one copy of the substructure is stored.
+
+ Hcons
Hcons ____ ____ _____
Hcons works by keeping a pair hash table of all pairs that have been
+ HCons
HCons
created by HCons. (So the space advantage of sharing substructure may be
+offset by the space consumed by table entries.) This hash table also
+allows the system to store property lists for pairs--in the same way that
+LISP has property lists for identifiers.
+
+ HCons RplacA RplacD
HCons ______ ___ RplacA RplacD
Pairs created by HCons should not be modified with RplacA and RplacD.
+Doing so will make the pair hash table inconsistent, as well as being very
+likely to modify structure shared with something that you don't wish to
+change. Also note that large numbers may be equal without being eq, so the
+HCons Eq HCons
HCons Eq HCons
HCons of two large numbers may not be Eq to the HCons of two other numbers
+that appear to be the same. (Similar warnings hold for strings and
+vectors.)
+
+ The following "user" functions are provided by HCONS:
+
+
+ HCons
HCons _ ___ ____ _____
(HCons [U:any]): pair macro
+
+ HCons
HCons
The HCons macro takes one or more arguments and returns their
+ "hashed cons" (right associatively). With two arguments this
+ Cons
Cons
corresponds to a call of Cons.
+
+
+ HList
HList _ ___ ____ _____
(HList [U:any]): list nexpr
+
+ HList List
HList List
HList is the "HCONS version" of the List function.
+
+
+ HCopy
HCopy _ ___ ___ _____
(HCopy U:any): any macro
+
+ HCopy Copy HCopy
HCopy Copy HCopy
HCopy is the HCONS version of the Copy function. Note that HCopy
+ Copy
Copy
serves a very different purpose than Copy, which is usually used
+ to copy a structure so that destructive changes can be made to
+ HCopy
HCopy
the copy without changing the original. HCopy only copies those
+ Cons
Cons
parts of the structure which haven't already been "Consed
+ HCons
HCons
together" by HCons.
+
+
+ HAppend
HAppend _ ____ _ ____ ____ ____
(HAppend U:list V:list): list expr
+
+ HCons Append
HCons Append
The HCons version of Append.
PSL Manual 7 February 1983 Utilities
+section 17.9 page 17.25
+
+ HReverse
HReverse _ ____ ____ ____
(HReverse U:list): list expr
+
+ HCons Reverse
HCons Reverse
The HCons version of Reverse.
+
+ Get Put
Get Put
The following two functions can be used to "Get" and "Put" properties for
+pairs or identifiers. The pairs for these functions must be created by
+HCons SetF
HCons SetF
HCons. These functions are known to the SetF macro.
+
+
+ Extended-Put
Extended-Put _ __ ____ ___ __ ____ ___ ___ ____
(Extended-Put U:{id,pair} IND:id PROP:any): any expr
+
+
+ Extended-Get
Extended-Get _ __ ____ ___ ___ ___ ____
(Extended-Get U:{id,pair} IND:any): any expr
+
+
+
+17.10. Graph-to-Tree
17.10. Graph-to-Tree
17.10. Graph-to-Tree
+
+ GRAPH-TO-TREE is a loadable module. For resident functions printing
+circular lists see Section 15.8.
+
+
+ Graph-to-Tree
Graph-to-Tree _ ____ ____ ____
(Graph-to-Tree A:form): form expr
+
+ Graph-to-Tree
Graph-to-Tree
The function Graph-to-Tree copies an arbitrary s-expression,
+ removing circularity. It does NOT show non-circular shared
+ Eq
Eq
structure. Places where a substructure is Eq to one of its
+ ancestors are replaced by non-interned ids of the form <n> where
+ n is a small integer. The parent is replaced by a two element
+ list of the form (<n>: u) where the n's match, and u is the
+ (de-circularized) structure. This is most useful in adapting any
+ printer for use with circular structures.
+
+
+ CPrint
CPrint _ ___ ___ ____
(CPrint A:any): NIL expr
+
+ CPrint
CPrint
The function CPrint, also defined in the module GRAPH-TO-TREE, is
+ PrettyPrint Graph-to-Tree
PrettyPrint Graph-to-Tree
simply (PrettyPrint (Graph-to-Tree X)).
+
+ Note that GRAPH-TO-TREE is very embryonic. It is MUCH more inefficient
+than it needs to be, heavily consing. A better implementation would use a
+stack (vector) instead of lists to hold intermediate expressions for
+comparison, and would not copy non-circular structure. In addition
+facilities should be added for optionally showing shared structure, for
+performing the inverse operation, and for also editing long or deep
+structures. Finally, the output representation was chosen at random and
+can probably be improved, or at least brought in line with CL or some other
+standard.
Utilities 7 February 1983 PSL Manual
+page 17.26 section 17.11
+
+17.11. Inspect Utility
17.11. Inspect Utility
17.11. Inspect Utility
+
+ INSPECT is a loadable module.
+
+
+ Inspect
Inspect ________ ______ ____
(Inspect FILENAME:string): expr
+
+ This is a simple utility which scans the contents of a source
+ file to tell what functions are defined in it. It will be
+ embellished slightly to permit the on-line querying of certain
+ Inspect
Inspect
attributes of files. Inspect reads one or more files, printing
+ and collecting information on defined functions.
+
+ Usage:
+
+ (LOAD INSPECT)
+ (INSPECT "file-name") % Scans the file, and prints proc
+ % names. It also
+ % builds the lists ProcedureList!*
+ % FileList!* and ProcFileList!*
+
+ % File-Name can DSKIN other files
+
+On the Fly printing is controlled by !*PrintInspect, default is T. Other
+lists built include FileList!* and ProcFileList!*, which is a list of
+(procedure . filename) for multi-file processing.
+
+ For more complete process, do:
+
+ (LOAD INSPECT)
+ (OFF PRINTINSPECT)
+ (INSPECTOUT)
+ (DSKIN ...)
+ (DSKIN ...)
+ (INSPECTEND)
ADDED psl-1983/3-1/lpt/18-complr.lpt
Index: psl-1983/3-1/lpt/18-complr.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/18-complr.lpt
@@ -0,0 +1,1285 @@
+PSL Manual 7 February 1983 Compiler and Loader
+section 18.0 page 18.1
+
+ CHAPTER 18
CHAPTER 18
CHAPTER 18
+ LOADER AND COMPILER
LOADER AND COMPILER
LOADER AND COMPILER
+
+
+
+
+ 18.1. Introduction . . . . . . . . . . . . . . . 18.1
+ 18.2. The Compiler . . . . . . . . . . . . . . . 18.2
+ 18.2.1. Compiling Functions into Memory . . . . . . 18.2
+ 18.2.2. Compiling Functions into FASL Files . . . . . 18.3
+ 18.2.3. Loading FASL Files. . . . . . . . . . . 18.3
+ 18.2.4. Functions to Control the Time When Something is Done 18.5
+ .
+ 18.2.5. Order of Functions for Compilation . . . . . 18.6
+ 18.2.6. Fluid and Global Declarations . . . . . . . 18.6
+ 18.2.7. Switches Controlling Compiler . . . . . . . 18.8
+ 18.2.8. Differences between Compiled and Interpreted Code 18.10
+ 18.2.9. Compiler Errors. . . . . . . . . . . . 18.11
+ 18.3. The Loader. . . . . . . . . . . . . . . . 18.13
+ 18.3.1. Legal LAP Format and Pseudos . . . . . . . 18.14
+ 18.3.2. Examples of LAP for DEC-20, VAX and Apollo. . . 18.14
+ 18.3.3. Lap Switches. . . . . . . . . . . . . 18.17
+ 18.4. Structure and Customization of the Compiler. . . . . 18.18
+ 18.5. First PASS of Compiler. . . . . . . . . . . . 18.19
+ 18.5.1. Tagging Information . . . . . . . . . . 18.19
+ 18.5.2. Source to Source Transformations . . . . . . 18.20
+ 18.6. Second PASS - Basic Code Generation . . . . . . . 18.20
+ 18.6.1. The Cmacros . . . . . . . . . . . . . 18.20
+ 18.6.2. Classes of Functions . . . . . . . . . . 18.23
+ 18.6.3. Open Functions . . . . . . . . . . . . 18.24
+ 18.7. Third PASS - Optimizations . . . . . . . . . . 18.29
+ 18.8. Some Structural Notes on the Compiler. . . . . . . 18.30
+
+
+
+
+18.1. Introduction
18.1. Introduction
18.1. Introduction
+
+ The functions and facilities in the PSL LISP/SYSLISP compiler and
+supporting loaders (LAP and FASL) are described in this chapter.
+
+ [??? This chapter is out of date and will be rewritten soon. ???]
[??? This chapter is out of date and will be rewritten soon. ???]
[??? This chapter is out of date and will be rewritten soon. ???]
+
+
+
+18.2. The Compiler
18.2. The Compiler
18.2. The Compiler
+
+ The compiler is a version of the Portable LISP Compiler [Griss 81],
Compiler and Loader 7 February 1983 PSL Manual
+page 18.2 section 18.2
+
+ 1
+modified and extended to more efficiently support both LISP and SYSLISP
+compilation. See the later sections in this chapter and references [Griss
+81] and [Benson 81] for more details.
+
+
+18.2.1. Compiling Functions into Memory
18.2.1. Compiling Functions into Memory
18.2.1. Compiling Functions into Memory
+
+
+ __________ ______
!*COMP [Initially: NIL] switch
+
+ If the compiler is loaded (which is usually the case, otherwise
+ on
on
execute LOAD COMPILER;), turning on the switch !*COMP (via on
+ comp; in RLISP) causes all subsequent procedure definitions of
+ appropriate type to be compiled automatically and a message of
+ the form
+
+ <function-name> COMPILED, <words> WORDS, <words> LEFT
+
+ to be printed. The first number is the number of words of binary
+ program space the compiled function took, and the second number
+ the number of words left unused in binary program space. See
+ !*PWRDS in Section 18.2.7.
+
+ ____ _____ _____ _____
____ _____ _____ _____
____ _____ _____ _____
expr fexpr nexpr macro
expr fexpr nexpr macro
Currently, exprs, fexprs, nexprs and macros may be compiled. This is
+controlled by a flag ('COMPILE) on the property list of the procedure type.
+
+ If desired, uncompiled functions already resident may be compiled by
+using
+
+
+ Compile
Compile _____ __ ____ ___ ____
(Compile NAMES:id-list): any expr
+
+
+18.2.2. Compiling Functions into FASL Files
18.2.2. Compiling Functions into FASL Files
18.2.2. Compiling Functions into FASL Files
+
+ Load FaslIn
Load FaslIn
In order to produce files that may be input using Load or FaslIn, the
+FaslOut FaslEnd
FaslOut FaslEnd
FaslOut and FaslEnd pair may be used in RLISP mode:
+
+
+ FaslOut
FaslOut ____ ______ ___ ____
(FaslOut FILE:string): NIL expr
+
+
+
+
+
+
+_______________
+
+ 1
+ Many of the recent extensions to the PLC were implemented by John
+Peterson.
PSL Manual 7 February 1983 Compiler and Loader
+section 18.2 page 18.3
+
+ FaslEnd
FaslEnd ___ ____
(FaslEnd ): NIL expr
+
+ FaslOut
FaslOut
After the command FaslOut has been given, all subsequent
+ S-expressions and function definitions typed in or input from
+ files are processed by the Compiler, LAP and FASL as needed, and
+ ____
output to FILE. Functions are compiled and partially assembled,
+ and output as in a compressed binary form, involving blocks of
+ code and relocation bits. This activity continues until the
+ FaslEnd
FaslEnd
function FaslEnd terminates this process.
+
+ FaslOut FaslEnd
FaslOut FaslEnd
The FaslOut and FaslEnd pair also use the DFPRINT!* mechanism, turning on
+the switch !*DEFN, and redefining DFPRINT!* to trap the parsed input in the
+RLISP top-loop. Currently this is not useable from pure LISP level.
+
+ [??? Fix, by adding !*DEFN mechanism to basic top-loop. ???]
[??? Fix, by adding !*DEFN mechanism to basic top-loop. ???]
[??? Fix, by adding !*DEFN mechanism to basic top-loop. ???]
+
+
+18.2.3. Loading FASL Files
18.2.3. Loading FASL Files
18.2.3. Loading FASL Files
+
+ Two convenient procedures are available for loading FASL files (.b files
+on the VAX); see Section 18.2.2 for information on producing FASL files.
+
+
+ Load
Load ____ ______ __ ___ _____
(Load [FILE:{string, id}]): NIL macro
+
+ ____
Each FILE is converted into a file name of the form
+ "/u/local/lib/psl/file.b" on the VAX, "pl:file.b" on the DEC-20.
+ FaslIn
FaslIn
An attempt is made to execute the function FaslIn on it. Once
+ ____
loaded, the symbol FILE is added to the GLOBAL variable
+ OPTIONS!*.
+
+
+ FaslIn
FaslIn ________ ______ ___ ____
(FaslIn FILENAME:string): NIL expr
+
+ This is an efficient binary read loop, which fetches blocks of
+ __
code, constants and compactly stored ids. It uses a bit-table to
+ relocate code and to identify special LISP-oriented constructs.
+ ________
FILENAME must be a complete file name.
+
+
+ ReLoad
ReLoad ____ ______ __ ___ _____
(ReLoad [FILE:{string,id}]): NIL macro
+
+ Removes the filename from the list OPTIONS!* and executes the
+ Load
Load
function Load.
+
+
+ Imports
Imports ___________ ____ ___ ____
(Imports MODULENAMES:list): NIL expr
+
+ LOAD
___________ __ LOAD
MODULENAMES is a list of ids representing modules to be LOAD'ed
+ after the module containing this function has been loaded.
+ Imports
Imports
Imports works only in compiled code.
Compiler and Loader 7 February 1983 PSL Manual
+page 18.4 section 18.2
+
+ __________ ______
LOADDIRECTORIES!* [Initially: A list of strings] global
+
+ Contains a list of strings to append to the front of file names
+ Load
Load
given in Load commands. This list may be one of the following,
+ if your system is an Apollo, Dec-20, or Vax:
+
+ ("" "/utah/psl/lap/")
+ ("" "pl:")
+ ("" "/usr/local/src/cmd/psl/dist/lap/")
+
+
+ __________ ______
LOADEXTENSIONS!* [Initially: An a-list] global
+
+ Contains an a-list of (str . fn) in which the str is an extension
+ to append to the end of the filename and fn is a function to
+ apply. The a-list contains
+
+ ((".b" . FaslIn)(".lap" . LapIn)(".sl" . LapIN))
+
+ [??? Describe FASL format in more detail ???]
[??? Describe FASL format in more detail ???]
[??? Describe FASL format in more detail ???]
+
+
+18.2.4. Functions to Control the Time When Something is Done
18.2.4. Functions to Control the Time When Something is Done
18.2.4. Functions to Control the Time When Something is Done
+
+ Which expressions are evaluated during compilation ONLY, which output to
+the file for LOAD TIME evaluation, and which do both (such as macro
+definitions) can be controlled by the properties 'EVAL and 'IGNORE on
+certain function names, or the following functions.
+
+
+ CommentOutCode
CommentOutCode _ ____ ___ _____
(CommentOutCode U:form): NIL macro
+
+ _
Comment out a single expression; use <<U>> to comment out a block
+ of code.
+
+
+ CompileTime
CompileTime _ ____ ___ ____
(CompileTime U:form): NIL expr
+
+ _
Evaluate the expression U at compile time only, such as defining
+ auxiliary smacros and macros that should not go into the file.
+
+ Certain functions have the FLAG 'IGNORE on their property lists
+ to achieve the same effect. E.g. FLAG('(LAPOUT LAPEND),'IGNORE)
+ has been done.
+
+
+ BothTimes
BothTimes _ ____ _ ____ ____
(BothTimes U:form): U:form expr
+
+ Evaluate at compile and load time. This is equivalent in effect
+ Flag
Flag
to executing Flag('(f1 f2),'EVAL) for certain functions.
PSL Manual 7 February 1983 Compiler and Loader
+section 18.2 page 18.5
+
+ LoadTime
LoadTime _ ____ _ ____ ____
(LoadTime U:form): U:form expr
+
+ Evaluate at load time only. Should not even compile code, just
+ pass direct to file.
+
+ [??? EVAL and IGNORE are for compatibility, and enable the above sort
[??? EVAL and IGNORE are for compatibility, and enable the above sort
[??? EVAL and IGNORE are for compatibility, and enable the above sort
+ of functions to be easily written. The user should AVOID EVAL and
of functions to be easily written. The user should AVOID EVAL and
of functions to be easily written. The user should AVOID EVAL and
+ IGNORE flags, if Possible ???]
IGNORE flags, if Possible ???]
IGNORE flags, if Possible ???]
+
+
+18.2.5. Order of Functions for Compilation
18.2.5. Order of Functions for Compilation
18.2.5. Order of Functions for Compilation
+
+ ____
____
____
expr
expr
Non-expr procedures must be defined before their use in a compiled
+function, since the compiler treats the various function types differently.
+_____ _____
_____ _____
_____ _____
Macro fexpr
Macro fexpr
Macros are expanded and then compiled; the argument list fexprs quoted; the
+ _____
_____
_____
nexpr
nexpr
arguments of nexprs are collected into a single list. Sometimes it is
+convenient to define a Dummy version of the function of appropriate type,
+to be redefined later. This acts as an "External or Forward" declaration
+of the function.
+
+ [??? Add such a declaration. ???]
[??? Add such a declaration. ???]
[??? Add such a declaration. ???]
+
+
+18.2.6. Fluid and Global Declarations
18.2.6. Fluid and Global Declarations
18.2.6. Fluid and Global Declarations
+
+ The FLUID and GLOBAL declarations must be used to indicate variables that
+are to be used as non-LOCALs in compiled code. Currently, the compiler
+defaults variables bound in a particular procedure to LOCAL. The effect of
+this is that the variable only exists as an "anonymous" stack location; its
+name is compiled away and called routines cannot see it (i.e. they would
+have to use the name). Undeclared non-LOCAL variables are automatically
+declared FLUID by the compiler with a warning. In many cases, this means
+that a previous procedure that bound this variable should have known about
+this as a FLUID. Declare it with FLUID, below, and recompile, since the
+caller cannot be automatically fixed.
+
+ [??? Should we provide an !*AllFluid switch to make the default Fluid,
[??? Should we provide an !*AllFluid switch to make the default Fluid,
[??? Should we provide an !*AllFluid switch to make the default Fluid,
+ or should we make Interpreter have a LOCAL variable as default, or both
or should we make Interpreter have a LOCAL variable as default, or both
or should we make Interpreter have a LOCAL variable as default, or both
+ ???]
???]
???]
+
+
+ Fluid
Fluid _____ __ ____ ___ ____
(Fluid NAMES:id-list): any expr
+
+ Declares each variable FLUID (if not previously declared); this
+ Prog
Prog
means that it can be used as a Prog LOCAL, or as a parameter. On
+ entry to the procedure, its current value is saved on the Binding
+ Stack (BSTACK), and all access is always to the VALUE cell
+ Throw Error
Throw Error
(SYMVAL) of the variable; on exit (or Throw or Error), the old
+ values are restored.
Compiler and Loader 7 February 1983 PSL Manual
+page 18.6 section 18.2
+
+ Global
Global _____ __ ____ ___ ____
(Global NAMES:id-list): any expr
+
+ Declares each variable GLOBAL (if not previously declared); this
+ means that it cannot be used as a LOCAL, or as a parameter.
+ Access is always to the VALUE cell (SYMVAL) of the variable.
+
+ [??? Should we eliminate GLOBALs ???]
[??? Should we eliminate GLOBALs ???]
[??? Should we eliminate GLOBALs ???]
+
+
+18.2.7. Switches Controlling Compiler
18.2.7. Switches Controlling Compiler
18.2.7. Switches Controlling Compiler
+
+ The compilation process is controlled by a number of switches, as well as
+the above declarations and the !*COMP switch, of course.
+
+
+ __________ ______
!*R2I [Initially: T] switch
+
+ T
T
If T, causes recursion removal if possible, converting recursive
+ calls on a function into a jump to its start. If this is not
+ possible, it uses a faster call to its own "internal" entry,
+ rather than going via the Symbol Table function cell. The effect
+ in both cases is that tracing this function does not show the
+ internal or eliminated recursive calls, nor the backtrace
+ information.
+
+
+ __________ ______
!*NOLINKE [Initially: NIL] switch
+
+ T NIL
T NIL
If T, inhibits use of !*LINKE cmacro. If NIL, "exit" calls on
+ functions that would then immediately return. For example, the
+ calls on FOO(x) and FEE(X) in
+
+ PROCEDURE DUM(X,Y);
+ IF X=Y THEN FOO(X) ELSE FEE(X+Y);
+
+ can be converted into direct JUMP's to FEE or FOO's entry point.
+ This is known as a "tail-recursive" call being converted to a
+ jump. If this happens, there is no indication of the call of DUM
+ on the backtrace stack if FEE or FOO cause an error.
+
+
+ __________ ______
!*ORD [Initially: NIL] switch
+
+ T
T
If T, forces the compiler to compile arguments in Left-Right
+ Order, even though more optimal code can be generated.
+
+ [??? !*ORD currently has a bug, and may not be fixed for some
[??? !*ORD currently has a bug, and may not be fixed for some
[??? !*ORD currently has a bug, and may not be fixed for some
+ time. Thus do NOT depend on evaluation order in argument
time. Thus do NOT depend on evaluation order in argument
time. Thus do NOT depend on evaluation order in argument
+ lists ???]
lists ???]
lists ???]
PSL Manual 7 February 1983 Compiler and Loader
+section 18.2 page 18.7
+
+ __________ ______
!*MODULE [Initially: NIL] switch
+
+ Indicates block compilation (a future extension of this
+ compiler). When implemented, even more function and variable
+ names are "compiled away".
+
+ The following switches control the printing of information during the
+compilation process:
+
+
+ __________ ______
!*PWRDS [Initially: NIL] switch
+
+ T
T
If T, causes the compiled size to be printed in the form
+
+ *** NAME: base NNN, length MMM
+
+ The base is in octal, the length is in current Radix.
+
+ [??? more mnemonic name ???]
[??? more mnemonic name ???]
[??? more mnemonic name ???]
+
+
+ __________ ______
!*PLAP [Initially: NIL] switch
+
+ T
T
If T, causes the printing of the portable cmacros produced by the
+ the compiler.
+
+ Most of this information is printed by the resident LAP, and controlled
+by its switches, described below.
+
+
+18.2.8. Differences between Compiled and Interpreted Code
18.2.8. Differences between Compiled and Interpreted Code
18.2.8. Differences between Compiled and Interpreted Code
+
+ The following just re-iterates some of the points made above and in other
+Sections of the manual regarding the "obscure" differences that compilation
+introduces.
+
+ [??? This needs some careful work, and perhaps some effort to reduce
[??? This needs some careful work, and perhaps some effort to reduce
[??? This needs some careful work, and perhaps some effort to reduce
+ the list of differences ???]
the list of differences ???]
the list of differences ???]
+
+ In the process of compilation, many functions are open-coded, and hence
+cannot be redefined or traced in the compiled code. Such functions are
+noted to be OPEN-CODED in the manual. If called from compiled code, the
+call on an open-compiled function is replaced by a series of online
+instructions. Most of these functions have some sort of indicator on their
+property lists: 'OPEN, 'ANYREG, 'CMACRO, 'COMPFN, etc. For example: SETQ,
+CAR, CDR, COND, WPLUS2, MAP functions, PROG, PROGN, etc. Also note that
+ _____
_____
_____
macro
macro
some functions are defined as macros, which convert to some other form
+(such as PROG), which itself might compile open.
+
+ Some optimizations are performed that cause inaccessible or redundant
+code to be removed, e.g. 0*foo(x) could cause foo(x) not to be called.
Compiler and Loader 7 February 1983 PSL Manual
+page 18.8 section 18.2
+
+ _____ ______
_____ ______
_____ ______
Fluid global
Fluid global
Unless variables are declared (or detected) to be Fluid or global, they
+ _____
_____
_____
local
local
are compiled as local variables. This causes their names to disappear, and
+so are not visible on the Binding Stack. Further more, these variables are
+NOT available to functions called in the dynamic scope of the function
+containing their binding.
+
+ _____ _____ _____
_____ _____ _____
_____ _____ _____
macro fexpr nexpr
macro fexpr nexpr
Since compiled calls on macros, fexprs and nexprs are different from the
+ ____
____
____
expr
expr
default exprs, these functions must be declared (or defined) before
+ _____ _____
_____ _____
_____ _____
fexpr nexpr
fexpr nexpr
compiling the code that uses them. While fexprs and nexprs may
+ _____
_____
_____
macro
macro
subsequently be redefined (as new functions of same type), macros are
+executed by the compiler to get the replacement form, which is then
+compiled. The interpreter of course picks up the most recent definition of
+ANY function, and so functions can switch type as well as body.
+
+ [??? If we expand macros at PUTD time, then this difference will go
[??? If we expand macros at PUTD time, then this difference will go
[??? If we expand macros at PUTD time, then this difference will go
+ away. ???]
away. ???]
away. ???]
+
+ As noted above, the !*R2I, !*NOLINKE and !*MODULE switches cause certain
+functions to call other functions (or themselves usually) by a faster route
+(JUMP or internal call). This means that the recursion or call may not be
+visible during tracing or backtrace.
+
+
+18.2.9. Compiler Errors
18.2.9. Compiler Errors
18.2.9. Compiler Errors
+
+ A number of compiler errors are listed below with possible explanations
+of the error.
+
+ *** Function form converted to APPLY
+
+ Car
Car
This message indicates that the Car of a form is either
+
+
+ a. Non-atomic,
+ b. a local variable, or
+ c. a global or fluid variable.
+
+
+The compiler converts (F X1 X2 ...), where F is one of the above, to (APPLY
+F (LIST X1 X2 ...)).
+
+ *** NAME already SYSLISP non-local
+
+This indicates that NAME is either a WVAR or WARRAY in SYSLISP mode, but is
+being used as a local variable in LISP mode. No special action is taken.
+
+ *** WVAR NAME used as local
+
+This indicates that NAME is a WVAR, but is being used as a bound variable
+in SYSLISP mode. The variable is treated as an an anonymous local variable
+within the scope of its binding.
PSL Manual 7 February 1983 Compiler and Loader
+section 18.2 page 18.9
+
+ *** NAME already SYSLISP non-local
+
+This indicates that a variable was previously declared as a SYSLISP WVAR or
+WARRAY and is now being used as a LISP fluid or global. No special action
+is taken.
+
+ *** NAME already LISP non-local
+
+This indicates that a variable was previously declared as a LISP fluid or
+global and is now being used as a SYSLISP WVAR or WARRAY. No special
+action is taken.
+
+ *** Undefined symbol NAME in Syslisp, treated as WVAR
+
+A variable was encountered in SYSLISP mode which is not local nor a WVAR or
+WARRAY. The compiler declares it a WVAR. This is an error, all WVARs
+should be explicitly declared.
+
+ *** NAME declared fluid
+
+A variable was encountered in LISP mode which is not local nor a previously
+declared fluid or global. The compiler declares it fluid. This is
+sometimes an error, if the variable was used strictly locally in an earlier
+function definition, but was intended to be bound non-locally. All fluids
+should be declared before being used.
+
+
+
+18.3. The Loader
18.3. The Loader
18.3. The Loader
+
+ [??? update ???]
[??? update ???]
[??? update ???]
+
+ Currently, PSL on the DEC-20 provides a simple LISP assembler, LAP. This
+is modeled after the original LISP 1.6 LAP, although completely
+reimplemented to take advantage of PSL constructs, and to support the
+additional requirements of SYSLISP. In the process of implementing the VAX
+LAP and developing the LAP-to-ASM translator required to bootstrap PSL onto
+the next machine (Apollo MC68000), a much more table-driven form of LAP was
+designed to make all LAP's, LAP-to-ASM's and FASL's (fast loaders,
+sometimes called FAP) easier to maintain. This is now in use on the VAX
+and being used to implement Apollo PSL.
+
+ [??? FASL now works ???]
[??? FASL now works ???]
[??? FASL now works ???]
+
+ Until that is complete, we will briefly describe the available functions,
+and give a sample of current and future LAP; this Section will be
+completely rewritten in the next revision. LAP is currently a full two
+pass assembler; on the VAX and Apollo it also includes a pass to optimize
+long and short jumps.
Compiler and Loader 7 February 1983 PSL Manual
+page 18.10 section 18.3
+
+ LAP
LAP ____ ____ ____ _______ ____
(LAP CODE:list): code-pointer expr
+
+ ____
CODE is a list of legal LAP forms, including:
+
+
+ a. Machine specific Mnemonics (using opcode-names from the
+ assembler on the DEC-20, VAX or Apollo).
+
+ b. Compiler cmacros (which expand in a machine specific way).
+ These can be thought of as "generic" or LISP-oriented
+ instructions. See the next Section on the Compiler details, and
+ list of legal cmacros.
+
+ c. LAP pseudo instructions, to declare entry points, indicate data
+ and constants, etc.
+
+
+ The first pass of LAP converts mnemonics into LISP integers, doing as
+much of the assembly as possible, allocating labels and constants. The
+second (and third?) pass fills in labels and completes the assembly,
+depositing code into the next available locations in BPS, or creating FASL
+or LAP files.
+
+ [??? What is BPS (binary program space) ???]
[??? What is BPS (binary program space) ???]
[??? What is BPS (binary program space) ???]
+
+
+18.3.1. Legal LAP Format and Pseudos
18.3.1. Legal LAP Format and Pseudos
18.3.1. Legal LAP Format and Pseudos
+
+ [??? Describe LAP format in detail ???]
[??? Describe LAP format in detail ???]
[??? Describe LAP format in detail ???]
+
+
+18.3.2. Examples of LAP for DEC-20, VAX and Apollo
18.3.2. Examples of LAP for DEC-20, VAX and Apollo
18.3.2. Examples of LAP for DEC-20, VAX and Apollo
+
+ The following is a piece of VAX specific LAP, using the current "new"
+format. Apart from the VAX mnemonics, notice the extra tags around the
+register names, and the symbols to indicate addressing modes (essentially
+PREFIX syntax rather then INFIX @ etc.). This is from PV:APPLY-LAP.RED.
+Note they are almost ENTIRELY written in cmacros, to aid in re-coding for
+the next machine.
PSL Manual 7 February 1983 Compiler and Loader
+section 18.3 page 18.11
+
+ lap '((!*entry FastApply expr 0)
+ %. Apply with arguments loaded
+ % Called with arguments in the registers and functional form in t1
+ (!*FIELD (reg t2) (reg t1)
+ (WConst TagStartingBit) (WConst TagBitLength))
+ (!*FIELD (reg t1) (reg t1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*JUMPNOTEQ (Label NotAnID) (reg t2) (WConst ID))
+ (!*WTIMES2 (reg t1) (WConst AddressingUnitsPerFunctionCell))
+ (!*JUMP (MEMORY (reg t1) (WArray SymFnc)))
+ NotAnID
+ (!*JUMPNOTEQ (Label NotACodePointer) (reg t2) (WConst CODE))
+ (!*JUMP (MEMORY (reg t1) (WConst 0)))
+ NotACodePointer
+ (!*JUMPNOTEQ (Label IllegalFunctionalForm) (reg t2) (WConst
+ (!*MOVE (MEMORY (reg t1) (WConst 0)) (reg t2))
+ % CAR with pair already unta
+ (!*JUMPNOTEQ (Label IllegalFunctionalForm) (reg t2) (QUOTE L
+ (!*MOVE (reg t1) (reg t2)) % put lambda form in t2
+ (!*PUSH (QUOTE NIL)) % align stack
+ (!*JCALL FastLambdaApply)
+ IllegalFunctionalForm
+ (!*MOVE (QUOTE "Illegal functional form in Apply") (reg 1))
+ (!*MOVE (reg t1) (reg 2))
+ (!*CALL List2)
+ (!*JCALL StdError)
+ );
+
+ lap '((!*entry UndefinedFunction expr 0)
+ %. Error Handler for non code
+ % Called by JSB
+ %
+ (subl3 (immediate (plus2 (WArray SymFnc) 6))
+ (autoincrement (reg st))
+ (reg t1))
+ (divl2 6 (reg t1))
+ (!*MKITEM (reg t1) (WConst ID))
+ (!*MOVE (reg t1) (reg 2))
+ (!*MOVE (QUOTE "Undefined function %r called from compiled c
+ (reg 1))
+ (!*CALL BldMsg)
+ (!*JCALL StdError)
+ );
+
+
+ The following is a piece of Apollo specific LAP, using the current NEW
+format. Apart from the MC68000 mnemonics, notice the extra tags around the
+register names, and the symbols to indicate addressing modes (essentially
+PREFIX syntax rather then INFIX @ etc.). This is from P68:M68K-USEFUL-
+LAP.RED.
Compiler and Loader 7 February 1983 PSL Manual
+page 18.12 section 18.3
+
+ % Signed multiply of 32 bits numbers in A1 and A2,
+ % returns 64 bits in A1 and A2, low in A1 high in A2
+ % Clobbers D1,D2,D3,D4,D5,D6,D7, no saving
+ % [Can insert MOVEM!.L D1-D7,-(SP)
+ % and MOVEM!.L (SP)+,D1-D7]
+ LAP '((!*entry Mult32 expr 2) % Arguments in A1 and A2
+ (move!.l (reg a1) (reg d1))
+ (move!.l (reg a1) (reg d6))
+ (move!.l (reg a2) (reg d2))
+ (move!.l (reg a2) (reg d7)) % Need copies
+ % Now do Unsigned Multiply
+ (move!.l (reg d1) (reg d3))
+ (move!.l (reg d1) (reg d4))
+ (swap (reg d4))
+ (move!.l (reg d2) (reg d5))
+ (swap (reg d5)) % Swapped for partial products
+ (mulu!.w (reg d2) (reg d1)) % partial products (pp1)
+ (mulu!.w (reg d4) (reg d2)) % pp2
+ (mulu!.w (reg d5) (reg d3)) % pp3
+ (mulu!.w (reg d5) (reg d4)) % pp4
+ (swap (reg d1)) % sum1=pp#2low+pp#1hi
+ (add (reg d2) (reg d1))
+ (clr!.l (reg d5))
+ (addx!.l (reg d5) (reg d4)) % propagate carry
+ (add (reg d3) (reg d1)) % sum2=sum1+pp#3low
+ (addx!.l (reg d5) (reg d4)) % carry inot pp#4
+ (swap (reg d1)) % low order product
+ (clr (reg d2))
+ (swap (reg d2))
+ (clr (reg d3))
+ (swap (reg d3))
+ (add!.l (reg d3) (reg d2)) % Sum3=pp2low+pp3Hi
+ (add!.l (reg d4) (reg d2)) % Sum4=Sum3+pp4
+ % Now do adjustment
+ (tst!.l (reg d7)) % Negative
+ (bpl!.s chkd6) % nope
+ (sub!.l (reg d6) (reg d2)) % Flip
+ chkd6
+ (tst!.l (reg d6)) % Negative
+ (bpl!.s done) % nope
+ (sub!.l (reg d7) (reg d2)) % Flip
+ done
+ (movea!.l (reg d1) (reg a1)) % low part
+ (movea!.l (reg d2) (reg a2)) % high part
+ (rts));
PSL Manual 7 February 1983 Compiler and Loader
+section 18.3 page 18.13
+
+18.3.3. Lap Switches
18.3.3. Lap Switches
18.3.3. Lap Switches
+
+ The following switches control the printing of information from LAP and
+other optional behavior of LAP:
+
+
+ __________ ______
!*PLAP [Initially: NIL] switch
+
+ Causes LAP forms to printed before expansion. Used mainly to see
+ output of compiler before assembly.
+
+
+ __________ ______
!*PGWD [Initially: NIL] switch
+
+ Causes LAP to print the actual DEC-20 mnemonics and corresponding
+ assembled instruction in octal, displaying OPCODE, REGISTER,
+ INDIRECT, INDEX and ADDRESS fields.
+
+
+ __________ ______
!*PWRDS [Initially: T] switch
+
+ Prints a LAP message of the form
+
+ *** NAME: base NNN, length MMM
+
+ The base is in octal, the length is in current Radix.
+
+
+ __________ ______
!*SAVECOM [Initially: T] switch
+
+ If T, the LAP is deposited in BPS, and the returned Code-Pointer
+ used to (re)define the procedure associated with the (!*entry
+ name type n).
+
+
+ __________ ______
!*SAVEDEF [Initially: NIL] switch
+
+ If T, and if !*SAVECOM is T, saves any preexisting procedure
+ definition under '!*SAVEDEF on the property list of the procedure
+ name, "just in case".
+
+ LAP also uses the following indicators on property lists:
+
+
+'MC Cmacros and some mnemonics have associated PASS1 expansions in
+ terms of simpler instructions or operations. The form (mc a1 ...
+ an) has its associated function applied to (a1 ... an).
+
+
+ For more details, see "P20:LAP.RED".
Compiler and Loader 7 February 1983 PSL Manual
+page 18.14 section 18.4
+
+18.4. Structure and Customization of the Compiler
18.4. Structure and Customization of the Compiler
18.4. Structure and Customization of the Compiler
+
+ The following is a brief summary of the compiler structure and model.
+The purpose of this Section is to aid the user to add new compilation
+forms, and to understand the task of bootstrapping a new version of PSL.
+The original paper on the Portable LISP Compiler [Griss 81] has complete
+details on the original version of the compiler, and should be read in
+conjunction with this Section. It might be useful to also examine the
+paper on recent work on the compiler [Griss 82].
+
+ [??? This needs a LOT of work ???]
[??? This needs a LOT of work ???]
[??? This needs a LOT of work ???]
+
+ The compiler is basically three-pass:
+
+
+ ______
______
______
macros
macros
a. The first pass expands ordinary macros, and compiler specific
+ cmacros. It also uses some special purpose 'PA1REFORM and
+ 'PA1FN functions on the property lists of certain functions to
+ produce a simpler and more explicit LISP for the next pass.
+ Variables and constants, x, are explicitly tagged as (FLUID x),
+ (GLOBAL x), (QUOTE x), (WCONST x), etc.
+
+ b. The second pass recursively compiles the code, using 'COMPFN's
+ to handle special cases, and the recursive function !&COMPILE
+ for the general case. In general, code is compiled to cause
+ function arguments to be loaded into R1...Rn in order, a CALL to
+ the function to be made, and the returned value to appear in R1.
+ Temporaries and function arguments to be reused later are saved
+ on the stack. The compiler allocates a single FRAME for the
+ maximum stack space that might be needed, and then trims it down
+ in the third pass. PSL requires registers R1 ... R15, though
+ not all need be "REAL registers"; the extra are simulated as
+ memory locations. Special cases avoid a lot of LOAD/STORES to
+ move arguments around. The compiled code is emitted as a
+ sequence of abstract LISP machine cmacros. The current set of
+ cmacros is described below.
+
+ c. The third pass scans the list of cmacros for patterns, removing
+ LOADs and STOREs, redundant JUMP's and LABEL's, compressings the
+ stack frame, and possibly mapping temporaries stored on the
+ stack into any of the REAL registers that would otherwise be
+ unused. This optimized cmacro list is then passed to LAP.
+
+
+
+18.5. First PASS of Compiler
18.5. First PASS of Compiler
18.5. First PASS of Compiler
PSL Manual 7 February 1983 Compiler and Loader
+section 18.5 page 18.15
+
+18.5.1. Tagging Information
18.5.1. Tagging Information
18.5.1. Tagging Information
+
+ This affects many parts of the compiler. The basic idea is that all
+information is to be tagged. These tags fit in three categories: variable
+tags, location (register and frame) tags, and constant tags. Tags used for
+variables must be flagged 'VAR; tags for constants must be flagged 'CONST.
+Currently, the register tag is REG and the frame tag is FRAME. Frame
+locations are always positive integers.
+
+ These tags are used everywhere; thus, register 1 is always described by
+(REG 1) in both emitted cmacros and internally in the register list REGS.
+Pass 1 tags all variable references with a source to source transformation
+of the variables (suitably obscure names must be used for these tags to
+prevent conflicts with named functions).
+
+ The purpose behind this tagging is to make the compiler easier to work
+with in adding new features; new notions of registers, constants, and
+variables can all be accommodated through new tags. Also, the components
+of the cmacros are more clearly identified for pass 3.
+
+
+18.5.2. Source to Source Transformations
18.5.2. Source to Source Transformations
18.5.2. Source to Source Transformations
+
+ A PA1REFORMFN has been provided to augment PA1FN's. The only difference
+between these functions is that the PA1REFORM function is passed code which
+has already been through PASS1. This was previously done by calling pass 1
+within a PA1FN.
+
+
+
+18.6. Second PASS - Basic Code Generation
18.6. Second PASS - Basic Code Generation
18.6. Second PASS - Basic Code Generation
+
+
+18.6.1. The Cmacros
18.6.1. The Cmacros
18.6.1. The Cmacros
+
+ The compiler second pass compiles the input LISP into a series of
+abstract machine instructions, called cmacros. These are instructions for
+a LISP-oriented Register machine.
+
+
+___ _______ ______ _______
The current DEC-20 cmacros
+
+Definitions of arguments
+
+ reg: (REG n) n = 1,2,... MAXNARGS
+ var: frame | (GLOBAL name) | (FLUID name)
+ frame: (FRAME n) n = 0,1,2, ..
+ const: (QUOTE value) | (WCONST value)
+ label: (LABEL symbol)
+ regn: reg | NIL | frame
+ regf: reg | frame
+ loc: reg | var | const
Compiler and Loader 7 February 1983 PSL Manual
+page 18.16 section 18.6
+
+ anyreg: (CAR anyreg) | (CDR anyreg) | loc
+Basic Cmacros for LISP and SYSLISP
+
+(!*ALLOC nframe)
+(!*DEALLOC nframe)
+(!*ENTRY fname ftype nargs)
+(!*EXIT nframe)
+(!*FREERSTR (NONLOCALVARS f1 f2 ...))
+(!*JUMP label)
+(!*JUMPxx label loc loc')
+ where xx = ATOM, EQ, NOTEQ, NOTTYPE, PAIRP, TYPE
+(!*JUMPON lower upper (label-1 ... Label-n))
+(!*LINK fname ftype nargs)
+(!*LINKE nframe fn type nargs)
+(!*LINKF nargs reg) where reg contains the function name,
+ nargs an integer
+(!*LINKEF nframe nargs reg) %/ ?
+(!*LBL label)
+(!*LAMBIND (REGISTERS reg1 reg2 ...) (NONLOCALVARS f1 f2 ...))
+ where f1, f2, ... = (FLUID name )
+ No frame location will be allocated (depends on switch)
+(!*LOAD reg anyreg)
+(!*PROGBIND (NONLOCALVARS f1 f2 ...))
+(!*PUSH reg)
+(!*RPLACA regf loc)
+(!*RPLACD regf loc)
+(!*STORE regn var) | (!*STORE regn reg)
+
+SYSLISP oriented Cmacros
+
+(!*ADDMEM loc)
+(!*ADJSP ?)
+(!*DECMEM loc)
+(!*INCMEM loc)
+(!*INTINF loc)
+(!*JUMPWGEQ label loc loc')
+(!*JUMPWGREATERP label loc loc')
+(!*JUMPWITHIN label loc loc')
+(!*JUMPWLEQ label loc loc')
+(!*JUMPWLESSP label loc loc')
+(!*MKITEM loc loc')
+(!*MPYMEM loc loc')
+(!*NEGMEM loc)
+(!*SUBMEM loc loc')
+(!*WAND loc loc')
+(!*WDIFFERENCE loc loc')
+(!*WMINUS loc)
+(!*WNOT loc)
+(!*WOR loc loc')
+(!*WPLUS2 loc loc')
+(!*WSHIFT loc loc')
+(!*WTIMES2 loc loc')
PSL Manual 7 February 1983 Compiler and Loader
+section 18.6 page 18.17
+
+(!*WXOR loc loc')
+
+_____ _______
68000 Cmacros
+
+Basic LISP and SYSLISP Cmacros
+
+(!*ALLOC nframe)
+(!*CALL fname)
+(!*DEALLOC nframe)
+(!*ENTRY fname ftype nargs)
+(!*EXIT nframe)
+(!*JCALL fname)
+(!*JUMP label)
+(!*JUMPEQ label loc loc')
+(!*JUMPINTYPE label type)
+(!*JUMPNOTEQ label loc loc')
+(!*JUMPNOTINTYPE label loc type)
+(!*JUMPNOTTYPE label loc type)
+(!*JUMPTYPE label loc type)
+(!*LAMBIND label loc loc')
+(!*LBL label)
+(!*LINK fname ftype nargs)
+(!*LINKE fname ftype nargs nframe)
+(!*MOVE loc loc')
+(!*PROGBIND label loc loc')
+(!*PUSH loc)
+
+SYSLISP specific Cmacros
+
+(!*APOLLOCALL label loc loc')
+(!*ASHIFT loc loc')
+(!*FIELD loc loc')
+(!*FOREIGNLINK loc loc')
+(!*INF loc loc')
+(!*JUMPON loc loc')
+(!*JUMPWGEQ loc loc')
+(!*JUMPWGREATERP loc loc')
+(!*JUMPWITHIN loc loc')
+(!*JUMPWLEQ loc loc')
+(!*JUMPWLESSP loc loc')
+(!*LOC loc loc')
+(!*MKITEM loc loc')
+(!*PUTFIELD loc loc')
+(!*PUTINF loc loc')
+(!*PUTTAG loc loc')
+(!*SIGNEDFIELD loc loc')
+(!*TAG loc loc')
+(!*WAND loc loc')
+(!*WDIFFERENCE loc loc')
+(!*WMINUS loc loc')
+(!*WNOT loc loc')
+(!*WOR loc loc')
Compiler and Loader 7 February 1983 PSL Manual
+page 18.18 section 18.6
+
+(!*WPLUS2 loc loc')
+(!*WSHIFT loc loc')
+(!*WTIMES2 loc loc')
+(!*WXOR loc loc')
+
+
+
+18.6.2. Classes of Functions
18.6.2. Classes of Functions
18.6.2. Classes of Functions
+
+ The compiler groups functions into four basic classes:
+
+
+ a. ANYREG functions. No side effects and can be done in a single
+ register. Passed directly to CMACROs. Viewed as a form of
+ "extended addressing" mode.
+
+ b. Specially compiled or "OPEN" functions. These are functions
+ have a special compiling function stored under a 'COMPFN
+ indicator. While many of these functions are specially coded,
+ many are written with the aid of supporting patterns; these are
+ called 'OPENFN or 'OPENTST patterns. Some OPEN functions alter
+ registers which are in use, allocate new frames or obtain unused
+ registers. These open functions also include open compilation
+ of tests.
+
+ c. Built-in or 'stable' functions. These functions are called in
+ the standard fashion by the compiler, but they have properties
+ which are useful to the compiler and are assumed to always hold.
+ Currently, a function may be flagged as NOSIDEEFFECT and have
+ the property DESTROYS, which contains a list of registers
+ destroyed by the function.
+
+ d. All other functions are assumed to be totally random, destroying
+ every register and causing side effects.
+
+
+ [??? Mark non-random functions of various levels elsewhere ???]
[??? Mark non-random functions of various levels elsewhere ???]
[??? Mark non-random functions of various levels elsewhere ???]
+
+ The most important of these categories is the OPEN function. It is hoped
+that improved OPEN functions will eliminate the need for temporary
+registers to be allocated by the assembler. Most OPEN functions emit
+cmacros especially tailored for each function.
+
+
+18.6.3. Open Functions
18.6.3. Open Functions
18.6.3. Open Functions
+
+ [??? Explain how to CODE them ???]
[??? Explain how to CODE them ???]
[??? Explain how to CODE them ???]
+
+ There are 3 basic kinds of open function:
+
+
+ a. Test: the destination is a LABEL.
PSL Manual 7 February 1983 Compiler and Loader
+section 18.6 page 18.19
+
+ b. Value: the result is to be placed in a particular register.
+ c. Effect: the result is a side effect, and no destination is
+ needed.
+
+
+Note that an EFFECT open function does not have a destination. It is not
+really a separate class of function, just a separate usage. Example:
+
+ (PROGN (SETQ X 0) ... )
+
+ - the SETQ is for effect only - could be implemented with a "clear"
+instruction.
+
+ (FOO (SETQ X 0) ... )
+
+ - here the 0 is also placed in a register (the destination register).
+
+ The use of OPENTST is also derived from context: in
+
+ (COND ((EQ A B) ...))
+
+- EQ is interpreted as a test.
+
+ (RETURN (EQ A B))
+
+, though, must have a value. It should be noted that a pseudo
+source-source transformation occurs if an OPENTST is called for value:
+
+ (RETURN (EQ A B)) ->
+ (RETURN (COND ((EQ A B) T) (T NIL)))
+
+An OPENTST function always returns T/NIL if called for value. No separate
+handling for non test cases is needed (as opposed to the effect/value cases
+for normal OPEN funs in which two separate expansions can be supplied)
+
+ Also, there are 3 basic issues encountered in generating the code:
+
+
+ a. Bringing arguments into registers as needed.
+ b. Emitting the actual code.
+ c. Updating the final register contents.
+
+
+ Initially, the arguments to an open function are removed of all but
+ANYREG functions. Thus, these arguments fall into four classes:
+
+
+ a. Registers
+ b. Memory locations (FLUID, GLOBAL, FRAME, !*MEMORY)
+ c. Constants
+ d. ANYREG functions (viewed as extended addressing modes)
Compiler and Loader 7 February 1983 PSL Manual
+page 18.20 section 18.6
+
+Also, along with the arguments coming in is the destination (register or
+label).
+
+ The first step is to replace some arguments by registers by emitting
+LOAD's. This step can be controlled by a function, called the adjust
+function, which emits LOAD's and replaces the corresponding arguments by
+registers. Next, cmacros are emitted. These cmacros are selected through
+a pattern which defines the format of the particular OPEN function call.
+
+ Note that the pattern is matching the locations of the arguments to the
+open function. For example, assume that FOO is OPEN, and the call
+
+ (FOO 'A (CDR B) C D)
+
+is encountered. Assume also that B is frame 1, C is frame 2, and D was
+found in reg 1.
+
+ The argument list being matched is thus
+
+ ('A (CDR (FRAME 1)) (FRAME 2) (REG 1))
+
+For most purposes, this would be interpreted as (const anyreg mem reg). Of
+course, a pattern can use the value of a constant (you might recognize
+(!*WPLUS2 1 X) as an increment). Also, the actual register may be
+important for register args, especially if one of the args is also the
+destination. You would probably emit different code for
+
+ (REG 1) := (!*WPLUS2 (REG 2) (REG 3))
+
+than
+
+ (REG 1) := (!*WPLUS2 (REG 1) (REG 2))
+
+ To avoid a profusion of properties which would be associated with an OPEN
+function, two properties of the function name are used to hold all
+information associated with OPEN compiling. These properties are OPENFN
+and OPENTST.
+
+ The OPENFN and OPENTST properties have the following format:
+
+ (PATTERN MACRONAME PARAMETERS)
+ or function name.
+
+ The PATTERN field contains either the pattern itself or a pattern name.
+ __
A pattern name is an id having the PATTERN property. In the following
+material, DEST refers to the destination label in an OPENTST and to the
+destination register in an OPENFN. If the function is being evaluated for
+effect only, DEST is a temporary register which need not be used.
+
+ A pattern has the following format:
PSL Manual 7 February 1983 Compiler and Loader
+section 18.6 page 18.21
+
+ (ADJUST_FN
+ REG_FN
+ (P1 M11 M12 M13 ..)
+ (P2 M21 M22 M23 ..)
+ ...)
+
+The Pi are patterns and Mij are cmacros or pseudo cmacros. ADJUST_FN is a
+register adjustment function used to place things in registers as required,
+and to factor out basic properties of the function from the pattern. For
+example, you almost never could do anything with ANYREG stuff except load
+it somewhere (emitting (!*WPLUS2 X (CDR (CAR Y))) directly probably won't
+work - you must bring (CDR (CAR Y)) into a reg before further progress can
+be made). The most common adjust function is NOANYREG, which replaces
+ANYREG stuff with registers. This eliminates the problem of having to test
+for ANYREG stuff in the patterns.
+
+ Some pattern elements currently supported are:
+
+
+ANY matches anything
+DEST matches the destination register or label
+NOTDEST matches any register except the destination
+REG matches any register
+REGN Any register or 'NIL or a frame location
+VAR A LOCAL, GLOBAL, or FLUID variable
+MEM A memory address, currently constants + vars (NOT REGS)
+ANYREGFN matches an ANYREG function
+'literal matches the literal
+(p1 p2 ... pn)
+ matches a field whose components match p1 ... pn
+NOVAL matches only if STATUS > 1; must be the first component of a
+ pattern, consumes no part of the subject.
+
+
+ The cmacros associated with the patterns fall into two classes: actual
+cmacros to be emitted and pseudo cmacros which are interpreted by the
+compiler. In either case, the components of the cmacros are handled in the
+same fashion. The cmacros contain:
+
+
+Ai replaced by the ith argument to the OPEN function (after
+ adjustment)
+Ti replaced by a temporary register
+Li replaced by a temporary label
+Pi replaced by corresponding parameter from OPENFN
+DEST replaced by the destination register or label (depending on
+ OPENFN or OPENTST).
+FN replaced by the name of the OPEN function
+MAC synonym for P1, by convention a cmacro name
+'literal
+(x1 x2 ... )
+ xi as above, forms a list
Compiler and Loader 7 February 1983 PSL Manual
+page 18.22 section 18.6
+
+ The pseudo cmacros currently supported are:
+
+
+ !*DESTROY
!*DESTROY __ __ ____ ______
(!*DESTROY R1, R2, ...): list cmacro
+
+ __ __
Remove any register values from R1 ... RN.
+
+
+ !*DO
!*DO ________ ____ ____ ____ ______
(!*DO FUNCTION ARG1 ARG2 ...): list cmacro
+
+ ________
Call the FUNCTION.
+
+
+ !*SET
!*SET ___ ___ ____ ______
(!*SET REG VAL): list cmacro
+
+ ___ ___
Set the value in REG to VAL.
+
+ The cmacros which are known to the compiler are
+
+
+ !*LOAD
!*LOAD ____ ______
(!*LOAD ): list cmacro
+
+
+ !*STORE
!*STORE ____ ______
(!*STORE ): list cmacro
+
+
+ !*JUMP
!*JUMP ____ ______
(!*JUMP ): list cmacro
+
+
+ !*LBL
!*LBL ____ ______
(!*LBL ): list cmacro
+
+ These cmacros have special emit functions which are called as they are
+emitted; otherwise the cmacro is directly attached to CODELIST.
+
+
+
+18.7. Third PASS - Optimizations
18.7. Third PASS - Optimizations
18.7. Third PASS - Optimizations
+
+ The third pass of the compiler is responsible for doing optimizations,
+getting rid of extra labels and jumps, removing redundant code, adjusting
+the stack frame to squeeze out "holes" or even reallocating temporaries to
+excess registers if no "random" functions are called by this function.
+
+ This pass also does "peephole" optimizations (controlled by patterns that
+examine the Output CMACRO list for cmacros that can be merged). These
+tables can be adjusted by the user. This pass also gathers information on
+register usage that may be accumulated to aid block compilation or
+recompilation of a set of functions that are NOT redefined, and so can use
+information about each other (i.e. become "stable").
+
+ The 'OPTFN property is used to associate an optimization function with a
+particular CMACRO name. This function looks at the CMACRO arguments and
PSL Manual 7 February 1983 Compiler and Loader
+section 18.7 page 18.23
+
+some subsequent CMACROs in the code-list, to see if a transformation is
+possible. The OPTFN takes a single argument, the code-list in reverse
+order starting at the associated CMACRO. The OPTFN can also examine
+certain parameters. Currently !*LBL, !*MOVE and !*JUMP have 'OPTFNS. For
+example, !&STOPT, associated with !*MOVE, checks if previous CMACRO was
+!*ALLOC, and that this !*MOVE moves a register to the slot just allocated.
+If so, it converts the !*ALLOC and !*MOVE into a single !*PUSH. Likewise,
+!&LBLOPT removes duplicate labels defined at one place, aliasing one with
+the other, and so permitting certain JUMP optimizations to take place.
+
+ Tags in the cmacros are processed in a final pass through the code. At
+this time the compiler can do substitutions using functions attached to
+these tags. Currently, (!*FRAMESIZE) is converted to the frame size and
+holes are squeezed out (using the FRAME tag) by !&REFORMMACROS.
+Transformation functions are attached to tags (or any function) through the
+TRANFN property currently.
+
+
+
+18.8. Some Structural Notes on the Compiler
18.8. Some Structural Notes on the Compiler
18.8. Some Structural Notes on the Compiler
+
+ [??? This Section is very ROUGH, just to give some additional
[??? This Section is very ROUGH, just to give some additional
[??? This Section is very ROUGH, just to give some additional
+ information in interim ???]
information in interim ???]
information in interim ???]
+
+ External variables and properties used by the compiler:
+
+ _________ ___ ________
Variables and Switches
+
+
+ __________ ______
!*ERFG [Initially: ] switch
+
+
+ __________ ______
!*INSTALLDESTROY [Initially: NIL] switch
+
+ If true, causes the compiler to install the DESTROYS property on
+ any function compiled which leaves one or more registers
+ unchanged
+
+
+ __________ ______
!*INT [Initially: T] switch
+
+
+ __________ ______
!*NOFRAMEFLUID [Initially: T] switch
+
+ If true, inhibits allocation of frame locations for FLUIDS
+
+
+ __________ ______
!*SHOWDEST [Initially: NIL] switch
+
+ If true, compiler prints out which registers a function destroys
+ unless all are destroyed
Compiler and Loader 7 February 1983 PSL Manual
+page 18.24 section 18.8
+
+ __________ ______
!*SYSLISP [Initially: NIL] switch
+
+ Switch compilation mode from default of LISP to SYSLISP. This
+ affects constant tagging, and in RLISP also causes LISP functions
+ to be replaced by SYSLISP equivalents. Also, non-locals default
+ to WVAR's rather than FLUIDs. See Chapter 20.
+
+
+ __________ ______
!*UNSAFEBINDER [Initially: NIL] switch
+
+ for Don's BAKER problem...GC may be called in Binder, so regs
+ cannot be preserved, and Binder called as regular function.
+
+
+ __________ ______
!*USEREGFLUID [Initially: NIL] switch
+
+ If true, LAMBIND and PROGBIND cmacros may contain registers as
+ well as frame locations (through FIXFRM).
+
+ _______
Globals:
+
+
+ __________ ______
LASTACTUALREG [Initially: 5] global
+
+ The number of the last real register; FIXFRM does not map stack
+ locations into registers > LASTACTUALREG. Also, temporary
+ registers are actual registers if possible.
+
+
+ __________ ______
MAXNARGS [Initially: 15] global
+
+ Number of registers
+
+ __________ ___ _____
Properties and Flags:
+
+
+CONST A tag property, indicates tags for constants (WCONST and QUOTE)
+EXTVAR A tag property, indicates a variable type whose name is
+ externally known (!$FLUID, !$GLOBAL, !$WVAR)
+MEMMOD A cmacro property, indicates in place memory operations. The
+ first argument to the cmacro is assumed to be the memory location
+ (var or !*MEMORY)
+NOSIDEEFFECT
+ A function property, used both in dealing with !*ORD and to
+ determine if the result should be placed in register status
+REG A tag property, indicates a register (REG)
+TERMINAL A tag property, indicates terminals (leaves) whose arguments are
+ not tagged items (!$FLUID !$GLOBAL !$WVAR REG LABEL QUOTE WCONST
+ FRAME !*FRAMESIZE IREG)
+TRANSFER A property of cmacros and functions, indicates cmacros &
+ functions which cause unconditional transfers (!*JUMP !*EXIT
+ !*LINKE !*LINKEF ERROR)
PSL Manual 7 February 1983 Compiler and Loader
+section 18.8 page 18.25
+
+VAR A tag property, indicates a variable type (!$LOCAL !$FLUID
+ !$GLOBAL !$WVAR)
+
+
+ __________
Properties:
+
+
+ANYREG A function property, non-NIL indicates an ANYREG function
+CFNTYPE Used in compiler to relate to Recursion-to-iteration conversion.
+DESTROYS A function property, contains a (tagged) list of registers
+ destroyed by the function
+DOFN A function property, contains the name of a compile time
+ evaluation function for numeric arguments.
+EMITFN A cmacro or pseudo cmacro property, contains the name of a
+ special function for emitting (or executing) the cmacro, such as
+ !&ATTJMP for !*JUMP.
+EXITING A cmacro property, used in FIXLINKS. Contains the name of an
+ associated exiting cmacro (!*LINK : !*LINKE, !*LINKF : !*LINKEF)
+FLIPTST A function property, contains the name of the opposite of a test
+ function. All open compiled test functions must have one. (EQ :
+ NOTEQ, ATOM : PAIRP)
+GROUPOPS A function property, used in constant folding. Attached to the
+ three functions of a group, always a list of the three functions
+ in the order +, -, MINUS. (!*WPLUS2, !*WDIFFERENCE, !*WMINUS :
+ (!*WPLUS2 !*WDIFFERENCE !*WMINUS))
+MATCHFN A property attached to an atom in a pattern. Contains the name
+ of a boolean function for use in pattern matching.
+NEGJMP A cmacro property, contains the inverted test jump cmacro name.
+ (!*JUMPEQ : !*JUMPNOTEQ, !*JUMPNOTEQ : !*JUMPEQ ...)
+ONE A function property, contains the (numeric) value of an identity
+ associated with the function (!*WPLUS2 : 0, !*WTIMES2 : 1, ...)
+PATTERN A property associated with atoms appearing in OPENFN or OPENTST
+ properties, contains a pattern for open coding of functions.
+SUBSTFN A property of atoms found in cmacros which are inside patterns.
+ Contains a function name; the function value is substituted into
+ the cmacro as emitted.
+ZERO Like ONE, designates a value which acts as a 0 in a ring over *.
+ (!*WTIMES2 : 0 , !*LOGAND : 0)
ADDED psl-1983/3-1/lpt/19-dec20.lpt
Index: psl-1983/3-1/lpt/19-dec20.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/19-dec20.lpt
@@ -0,0 +1,909 @@
+PSL Manual 7 February 1983 System Interface
+section 19.0 page 19.1
+
+ CHAPTER 19
CHAPTER 19
CHAPTER 19
+ OPERATING SYSTEM INTERFACE
OPERATING SYSTEM INTERFACE
OPERATING SYSTEM INTERFACE
+
+
+
+
+ 19.1. Introduction . . . . . . . . . . . . . . . 19.1
+ 19.2. System Dependent Functions . . . . . . . . . . 19.2
+ 19.3. TOPS-20 Interface . . . . . . . . . . . . . 19.2
+ 19.3.1. User Level Interface . . . . . . . . . . 19.2
+ 19.3.2. The Basic Fork Manipulation Functions . . . . 19.5
+ 19.3.3. File Manipulation Functions. . . . . . . . 19.6
+ 19.3.4. Miscellaneous Functions . . . . . . . . . 19.7
+ 19.3.5. Jsys Interface . . . . . . . . . . . . 19.8
+ 19.3.6. Bit, Word and Address Operations for Jsys Calls . 19.10
+ 19.3.7. Examples . . . . . . . . . . . . . . 19.12
+ 19.4. New Vax Specific Interface . . . . . . . . . . 19.13
+ 19.4.1. Setting Your .LOGIN and .CSHRC files. . . . . 19.13
+ 19.4.2. Important PSL executables . . . . . . . . 19.14
+ 19.4.3. Creating the Init Files . . . . . . . . . 19.14
+ 19.4.4. Directories and Symbols . . . . . . . . 19.15
+ 19.4.5. Miscellaneous Unix Interface Functions . . . 19.18
+ 19.4.6. Oload . . . . . . . . . . . . . . 19.18
+ 19.4.7. Calling oloaded functions . . . . . . . . 19.20
+ 19.4.8. OLOAD Internals. . . . . . . . . . . . 19.21
+ 19.4.9. I/O Control functions . . . . . . . . . 19.24
+
+
+
+
+19.1. Introduction
19.1. Introduction
19.1. Introduction
+
+ From within each PSL implementation, there will be a set of functions
+that permit the user to access specific operating system services. On the
+DEC-20 and VAX these include the ability to submit commands to be run in a
+"lower fork", such as starting an editor, submitting a system print
+command, listing directories, and so on. We will attempt to provide such
+ EXEC CMDS
EXEC CMDS
calls (EXEC and CMDS) in all PSL implementations. We also will provide as
+clean an interface to Low-level services as possible. On the DEC-20, this
+ Jsys
Jsys
is the Jsys function. Appropriate support functions (such as bit
+operations, byte-pointers, etc.) are also used by the assembler. On the
+ SYSCALL
SYSCALL
VAX we will provide the SYSCALL capability.
+
+
+
+19.2. System Dependent Functions
19.2. System Dependent Functions
19.2. System Dependent Functions
+
+
+ If_System
If_System ___ ____ __ ____ ____ ___ _____ ____ ___ ___ ______
(If_System SYS-NAME:id, TRUE-CASE:any, FALSE-CASE:any): any cmacro
+
+ This is a compile-time conditional macro for system-dependent
+ _____ ____ ___ ____
code. FALSE-CASE can be omitted and defaults to NIL. SYS-NAME
System Interface 7 February 1983 PSL Manual
+page 19.2 section 19.2
+
+ must be a member of the fluid variable System_List!*. For the
+ Dec-20, System_List!* is (Dec20 PDP10 Tops20 KL10). For the VAX
+ it is (VAX Unix VMUnix). An example of its use follows.
+
+ PROCEDURE MAIL();
+ IF_SYSTEM(TOPS20, RUNFORK "SYS:MM.EXE",
+ IF_SYSTEM(UNIX, SYSTEM "/BIN/MAIL",
+ STDERROR "MAIL COMMAND NOT IMPLEMENTED"));
+
+
+
+19.3. TOPS-20 Interface
19.3. TOPS-20 Interface
19.3. TOPS-20 Interface
+
+
+19.3.1. User Level Interface
19.3.1. User Level Interface
19.3.1. User Level Interface
+
+ DoCmds
DoCmds
The basic function of interest is DoCmds, which takes a list of strings
+as arguments, concatenates them together, starts a lower fork, and submits
+this string (via the Rescan buffer). The string should include appropriate
+<CR><LF>, "POP" etc. A global variable, CRLF, is provided with the
+<CR><LF> string. Some additional entry points, and common calls have been
+defined to simplify the task of submitting these commands.
+
+
+ DoCmds
DoCmds _ ______ ____ ___ ____
(DoCmds L:string-list): any expr
+
+ Concatenate strings into a single string (using ConcatS), place
+ into the rescan buffer using PutRescan, and then run a lower
+ EXEC, trying to use an existing Exec fork if possible.
+
+
+ __________ ______
CRLF [Initially: "<cr><lf>"] global
+
+ This variable is "CR-LF", to be appended to or inserted in
+ Command strings for fnc(DoCmds). It is STRING(Char CR,Char LF).
+
+
+ ConcatS
ConcatS _ ______ ____ ______ ____
(ConcatS L:string-list): string expr
+
+ Concatenate string-list into a single string, ending with CRLF.
+
+ [??? Probably ConcatS should be in STRING, we add final CRLF in
+ PutRescan ???]
+
+
+ Cmds
Cmds _ ______ ___ _____
(Cmds [L:string]): any fexpr
+
+ Submit a set of commands to lower EXEC
+
+ E.g. CMDS("VDIR *.RED ", CRLF, "DEL *.LPT", CRLF, "POP");.
+
+ The following useful commands are defined:
PSL Manual 7 February 1983 System Interface
+section 19.3 page 19.3
+
+ VDir
VDir _ ______ ___ ____
(VDir L:string): any expr
+
+ Display a directory and return to PSL, e.g. (VDIR "R.*").
+ Defined as DoCmds LIST("VDIR ",L,CRLF,"POP");
+
+
+ HelpDir
HelpDir ___ ____
(HelpDir ): any expr
+
+ Display PSL help directory. Defined as DoCmds LIST("DIR
+ PH:*.HLP",CRLF,"POP").
+
+
+ Sys
Sys _ ______ ___ ____
(Sys L:string): any expr
+
+ Defined as DoCmds LIST("SYS ", L, CRLF, "POP");
+
+
+ Take
Take _ ____ ___ ____
(Take L:list): any expr
+
+ Defined as DoCmds LIST("Take ",FileName,CRLF,"POP");
+
+
+ Type
Type _ ______ ___ ____
(Type L:string): any expr
+
+ Type out files. Defined as DoCmds LIST("TYPE ",L,CRLF,"POP");
+
+ While definable in terms of the above DoCmds via a string, more direct
+execution of files and fork manipulation is provided by the following
+functions. Recall that file names are simply Strings, e.g. "<psl>foo.exe",
+and that ForkHandles are allocated by TOPS-20 as large integers.
+
+
+ Run
Run ________ ______ ___ ____
(Run FILENAME:string): any expr
+
+ Create a fork, into which file name will be loaded, then run it,
+ waiting for completion. Finally Kill the fork.
+
+
+ Exec
Exec ___ ____
(Exec ): any expr
+
+ Continue a lower EXEC, return with POP. The Fork will be created
+ the first time this is run, and the ForkHandle preserved in the
+ global variable ExecFork.
+
+
+ Emacs
Emacs ___ ____
(Emacs ): any expr
+
+ Continue a lower EMACS fork. The Fork will be created the first
+ time this is run, and the ForkHandle preserved in the global
+ variable EmacsFork.
+
+ [??? Figure out how to pass a buffer to from Emacs ???]
System Interface 7 February 1983 PSL Manual
+page 19.4 section 19.3
+
+ MM
MM ___ ____
(MM ): any expr
+
+ Continue a lower MM fork. The Fork will be created the first
+ time this is run, and the ForkHandle preserved in the global
+ variable MMFork.
+
+ [??? MM looks in the rescan buffer for commands, so fairly
[??? MM looks in the rescan buffer for commands, so fairly
[??? MM looks in the rescan buffer for commands, so fairly
+ useful mailers (e.g. for BUG reports) can be created.
useful mailers (e.g. for BUG reports) can be created.
useful mailers (e.g. for BUG reports) can be created.
+ Perhaps make MM(s:string) for this purpose. ???]
Perhaps make MM(s:string) for this purpose. ???]
Perhaps make MM(s:string) for this purpose. ???]
+
+
+ Reset
Reset ____ ________ ____
(Reset ): None Returned expr
+
+ This function causes the system to be restarted.
+
+
+19.3.2. The Basic Fork Manipulation Functions
19.3.2. The Basic Fork Manipulation Functions
19.3.2. The Basic Fork Manipulation Functions
+
+
+ GetFork
GetFork ___ _______ _______ ____
(GetFork JFN:integer): integer expr
+
+ Create a fork handle for a file; a GET on the file is done.
+
+
+ StartFork
StartFork __ _______ ____ ________ ____
(StartFork FH:integer): None Returned expr
+
+ Start a fork running, don't wait, do something else. Can also be
+ used to Restart a fork, after a WaitFork.
+
+
+ WaitFork
WaitFork __ _______ _______ ____
(WaitFork FH:integer): Unknown expr
+
+ Wait for a running fork to terminate.
+
+
+ RunFork
RunFork __ _______ _______ ____
(RunFork FH:integer): Unknown expr
+
+ Start and Wait for a FORK to terminate.
+
+
+ KillFork
KillFork __ _______ _______ ____
(KillFork FH:integer): Unknown expr
+
+ Kill a fork (may not be restarted).
+
+
+ OpenFork
OpenFork ________ ______ _______ ____
(OpenFork FILENAME:string): integer expr
+
+ Get a file into a Fork, ready to be run.
PSL Manual 7 February 1983 System Interface
+section 19.3 page 19.5
+
+ PutRescan
PutRescan _ ______ _______ ____
(PutRescan S:string): Unknown expr
+
+ Copy a string into the rescan buffer, and announce to system, so
+ that next PBIN will get this characters. Used to pass command
+ strings to lower forks.
+
+
+ GetRescan
GetRescan ___ ______ ____
(GetRescan ): {NIL,string} expr
+
+ See if there is a string in the rescan buffer. If not, Return
+ NIL, else extract that string and return it. This is useful for
+ getting command line arguments in PSL, if MAIN() is rewritten by
+ the user. This will also include the program name, under which
+ this is called.
+
+
+19.3.3. File Manipulation Functions
19.3.3. File Manipulation Functions
19.3.3. File Manipulation Functions
+
+ These mostly return a JFN, as a small integer.
+
+
+ GetOldJfn
GetOldJfn ________ ______ _______ ____
(GetOldJfn FILENAME:string): integer expr
+
+ Get a Jfn on an existing file.
+
+
+ GetNewJfn
GetNewJfn ________ ______ _______ ____
(GetNewJfn FILENAME:string): integer expr
+
+ Get a Jfn for an new (non-existing) file.
+
+
+ RelJfn
RelJfn ___ _______ _______ ____
(RelJfn JFN:integer): integer expr
+
+ Return Jfn to TOPS-20 for re-use.
+
+
+ FileP
FileP ________ ______ _______ ____
(FileP FILENAME:string): boolean expr
+
+ Check if FILENAME is existing file; this is a more efficient
+ method than the kernel version that uses ErrorSet.
+
+
+ OpenOldJfn
OpenOldJfn ___ _______ _______ ____
(OpenOldJfn JFN:integer): integer expr
+
+ Open file on Jfn to READ 7-bit bytes.
+
+
+ OpenNewJfn
OpenNewJfn ___ _______ _______ ____
(OpenNewJfn JFN:integer): Unknown expr
+
+ Open file on Jfn to write 7 bit bytes.
System Interface 7 February 1983 PSL Manual
+page 19.6 section 19.3
+
+ GtJfn
GtJfn ________ ______ ____ _______ _______ ____
(GtJfn FILENAME:string,BITS:integer): integer expr
+
+ Get a Jfn for a file, with standard Tops-20 Access bits set.
+
+
+ NameFromJfn
NameFromJfn ___ _______ ______ ____
(NameFromJfn JFN:integer): string expr
+
+ Find the name of the File attached to the Jfn.
+
+
+19.3.4. Miscellaneous Functions
19.3.4. Miscellaneous Functions
19.3.4. Miscellaneous Functions
+
+
+ GetUName
GetUName ______ ____
(GetUName ): string expr
+
+ Get USER name as a string
+
+
+ GetCDir
GetCDir ______ ____
(GetCDir ): string expr
+
+ Get Connected DIRECTORY
+
+
+ InFile
InFile ____ __ ____ _______ _____
(InFile [FILS:id-list]): Unknown fexpr
+
+ Either solicit user for file name (InFile), and then open that
+ file, else open specified file, for input.
+
+
+19.3.5. Jsys Interface
19.3.5. Jsys Interface
19.3.5. Jsys Interface
+
+ Jsys
Jsys
The Jsys interface and jsys-names (as symbols of the form jsXXX) are
+defined in the source file PU:JSYS0.RED.
+
+ The access to the Jsys call is modeled after IDapply to avoid CONS,
+register reloads. These could easily be done Open coded
+
+ The following SYSLISP calls, XJsys'n', expect W-values in the registers,
+R1...R4, a W-value for the Jsys number, Jnum and the contents of the 'nth'
+register. Unused registers should be given 0. Any errors detected will
+ JsysError
JsysError
result in the JsysError being called, which will use the system ErStr JSYS
+ StdError
StdError
to find the error string, and issue a StdError.
+
+
+ XJsys0
XJsys0 __ _ _______ __ _ _______ __ _ _______
(XJsys0 R1:s-integer, R2:s-integer, R3:s-integer,
+ __ _ _______ ____ _ _______ _ _______ ____
R4:s-integer, Jnum:s-integer): s-integer expr
+
+ Used if no result register is needed.
PSL Manual 7 February 1983 System Interface
+section 19.3 page 19.7
+
+ XJsys1
XJsys1 __ _ _______ __ _ _______ __ _ _______
(XJsys1 R1:s-integer, R2:s-integer, R3:s-integer,
+ __ _ _______ ____ _ _______ _ _______ ____
R4:s-integer, Jnum:s-integer): s-integer expr
+
+
+ XJsys2
XJsys2 __ _ _______ __ _ _______ __ _ _______
(XJsys2 R1:s-integer, R2:s-integer, R3:s-integer,
+ __ _ _______ ____ _ _______ _ _______ ____
R4:s-integer, Jnum:s-integer): s-integer expr
+
+
+ XJsys3
XJsys3 __ _ _______ __ _ _______ __ _ _______
(XJsys3 R1:s-integer, R2:s-integer, R3:s-integer,
+ __ _ _______ ____ _ _______ _ _______ ____
R4:s-integer, Jnum:s-integer): s-integer expr
+
+
+ XJsys4
XJsys4 __ _ _______ __ _ _______ __ _ _______
(XJsys4 R1:s-integer, R2:s-integer, R3:s-integer,
+ __ _ _______ ____ _ _______ _ _______ ____
R4:s-integer, Jnum:s-integer): s-integer expr
+
+ The following functions are the LISP level calls, and expect integers or
+strings for the arguments, which are converted into s-integers by the
+ JConv
JConv
function JConv, below. We will use JS to indicate the argument type. The
+ _______
result returned is an integer, which should be converted to appropriate
+type by the user, depending on the nature of the Jsys. See the examples
+below for clarification.
+
+
+ Jsys0
Jsys0 __ __ __ __ __ __ __ __ ____ _ _______ _______ ____
(Jsys0 R1:JS, R2:JS, R3:JS, R4:JS, Jnum:s-integer): integer expr
+
+ Used is no result register is needed.
+
+
+ Jsys1
Jsys1 __ __ __ __ __ __ __ __ ____ _ _______ _______ ____
(Jsys1 R1:JS, R2:JS, R3:JS, R4:JS, Jnum:s-integer): integer expr
+
+
+ Jsys2
Jsys2 __ __ __ __ __ __ __ __ ____ _ _______ _______ ____
(Jsys2 R1:JS, R2:JS, R3:JS, R4:JS, Jnum:s-integer): integer expr
+
+
+ Jsys3
Jsys3 __ __ __ __ __ __ __ __ ____ _ _______ _______ ____
(Jsys3 R1:JS, R2:JS, R3:JS, R4:JS, Jnum:s-integer): integer expr
+
+
+ Jsys4
Jsys4 __ __ __ __ __ __ __ __ ____ _ _______ _______ ____
(Jsys4 R1:JS, R2:JS, R3:JS, R4:JS, Jnum:s-integer): integer expr
+
+ JConv
JConv
The JConv converts the argument type, JS, to an appropriate s-integer,
+representing either an integer, or string pointer, or address.
+
+
+ JConv
JConv _ _______ ______ _ _______ ____
(JConv J:{integer,string}): s-integer expr
+
+ _______
An integer J is directly converted to a s-integer, by Int2Sys(J).
+ ______
A string J is converted to a byte pointer by the call
+ Lor(8#10700000000,Strinf(J)). Otherwise a StdError, "'J' not
+ known in Jconv" is produced.
+
+ Additional convertions of interest may be performed by the functions
+Int2Sys Sys2Int
Int2Sys Sys2Int
Int2Sys, Sys2Int, and the following functions:
System Interface 7 February 1983 PSL Manual
+page 19.8 section 19.3
+
+ Str2Int
Str2Int _ ______ _______ ____
(Str2Int S:string): integer expr
+
+ Returns the physical address of the string start as an integer;
+ this can CHANGE if a GC takes place, so should be done just
+ before calling the jsys.
+
+
+ Int2Str
Int2Str _ _______ ______ ____
(Int2Str J:integer): string expr
+
+ J is assumed to be the address of a string, and a legal, tagged
+ string is created.
+
+
+19.3.6. Bit, Word and Address Operations for Jsys Calls
19.3.6. Bit, Word and Address Operations for Jsys Calls
19.3.6. Bit, Word and Address Operations for Jsys Calls
+
+
+ RecopyStringToNULL
RecopyStringToNULL _ _ ______ ______ ____
(RecopyStringToNULL S:w-string): string expr
+
+ S is assumed to be the address of a string, and a legal, tagged
+ string is created, by searching for the terminating NULL,
+ allocating a HEAP string, and copying the characters into it.
+ This is used to ensure that addresses not in the LISP heap are
+ not passed around "cavalierly" (although PSL is designed to
+ permit this quite safely).
+
+
+ Swap
Swap _ _______ _______ ____
(Swap X:integer): integer expr
+
+ Swap half words of X; actually Xword(LowHalfWord X,HighHalfWord
+ X).
+
+
+ LowHalfWord
LowHalfWord _ _______ _______ ____
(LowHalfWord X:integer): integer expr
+
+ Return the low-half word of the machine representation of
+ X. Actually Land(X,8#777777).
+
+
+ HighHalfWord
HighHalfWord _ _______ _______ ____
(HighHalfWord X:integer): integer expr
+
+ Return the Upper half word as a small integer, of the machine
+ word representation of X. Actually
+ Lsh(Land(X,8#777777000000),-18).
+
+
+ Xword
Xword _ _______ _ _______ _______ ____
(Xword X:integer,Y:integer): integer expr
+
+ Build a Word from Half-Words, actually
+ Lor(Lsh(LowHalfWord(X),18),LowHalfWord Y).
PSL Manual 7 February 1983 System Interface
+section 19.3 page 19.9
+
+ JBits
JBits _ ____ _______ ____
(JBits L:list): integer expr
+
+ Construct a word-image by OR'ing together selected bits or
+ byte-fields. L is list of integers or integer pairs. A single
+ integer in the range 0...35, BitPos, represents a single bit to
+ be turned on. A pair of integers, (FieldValue . RightBitPos),
+ causes the integer FieldValue to be shifted so its least
+ significant bit (LSB) will fall in the position, RightBitPos.
+ This value is then OR'ed into the result. Recall that on the
+ DEC-20, the most significant bit (MSB), is bit 0 and that the LSB
+ is bit 35.
+
+
+ Bits
Bits _ ____ _______ _____
(Bits L:list): integer macro
+
+ A convenient access to Jbits: JBits cdr L.
+
+
+19.3.7. Examples
19.3.7. Examples
19.3.7. Examples
+
+ The following range of examples illustrate the use of the above
+functions. More examples can be found in PU:exec0.red.
+
+
+
+Jsys1
Jsys1
Jsys1(0,0,0,0,jsPBIN);
+ % Reads a character, returns the ASCII code.
+
+Jsys0
Jsys0
Jsys0(ch,0,0,0,jsPBOUT);
+ % Takes ch as Ascii code, and prints it out.
+
+Procedure OPENOLDJfn Jfn; %. OPEN to READ
+ JSYS0(Jfn,Bits( (7 . 5),19),0,0,jsOPENF);
+
+Lisp procedure GetFork Jfn; %. Create Fork, READ File on Jfn
+ Begin scalar FH;
+ FH := JSYS1(Bits(1),0,0,0,jsCFork);
+ JSYS0(Xword(FH ,Jfn),0,0,0,jsGet);
+ return FH
+ END;
+
+Procedure GetOLDJfn FileName; %. test If file OLD and return Jfn
+ Begin scalar Jfn;
+ If NULL StringP FileName then return NIL;
+ Jfn := JSYS1(Bits(2,3,17),FileName,0,0,jsGTJfn);
+ % OLD!MSG!SHORT
+ If Jfn<0 then return NIL;
+ return Jfn
+ END;
+
+Procedure GetUNAME; %. USER name
+ Begin Scalar S;
System Interface 7 February 1983 PSL Manual
+page 19.10 section 19.3
+
+ S:=Mkstring 80; % Allocate a 80 char buffer
+ JSYS0(s,JSYS1(0,0,0,0,jsGJINF),0,0,jsDIRST);
+ Return RecopyStringToNULL S;
+ % Since a NULL may be appear before end
+ End;
+
+Procedure ReadTTY;
+Begin Scalar S;
+ S:=MkString(30); % Allocate a String Buffer
+ Jsys0
Jsys0
Jsys0(S,BITS(10,(30 . 35),"Retype it!",0,jsRDTTY);
+ % Sets a length halt (Bit 10),
+ % and length 30 (field at 35) in R2
+ % Gives a Prompt string in R3
+ % The input is RAISE'd to upper case.
+ % The Prompt will be typed if <Ctrl-R> is input
+ Return RecopyStringToNULL S;
+ % Since S will now possibly have a shorter
+ % string returned
+end;
+
+
+
+19.4. New Vax Specific Interface
19.4. New Vax Specific Interface
19.4. New Vax Specific Interface
+
+ Most of this information depends on the use of the Berkeley c-shell (csh)
+and will need modification (or might not work) if the Bourne shell (sh) is
+your command shell of choice. Extensive use is made of csh variables to
+ 1
+describe path-names to the various PSL subdirectories.
+
+
+19.4.1. Setting Your .LOGIN and .CSHRC files
19.4.1. Setting Your .LOGIN and .CSHRC files
19.4.1. Setting Your .LOGIN and .CSHRC files
+
+ During installation of PSL, a file "psl-names" defining these path-names
+will have been edited and tested by the installer. The message announcing
+the location of PSL on your system should indicate where this file is. It
+is often placed on "~psl" or "~psl/dist".
+
+ It is absolutely essential that you place the line
+
+
+ source ~psl/psl-names
+
+
+in your .login and .cshrc files. If you do not have either of these, they
+
+
+_______________
+
+ 1
+ This section was contributed by Russ Fish. The source for most of the
+functions mentioned is "$pv/system-extras.red".
PSL Manual 7 February 1983 System Interface
+section 19.4 page 19.11
+
+should be created. After execution of this statement, a set of "$
+variables" will be available to refer to files of interest in the PSL
+system from the c-shell, from editors, and from within PSL.
+
+ You may have to add another directory to the search path of your shell,
+in the definition of path in your .login file, which gives the location of
+the PSL executable files. This should be done after the line "source
+~psl/psl-names", and is a line of the form
+
+
+ set path=(. $psys /bin /usr/bin)
+
+
+ $psys is the c-cshell variable defined in psl-names to point at the psl
+"executables".
+
+
+19.4.2. Important PSL executables
19.4.2. Important PSL executables
19.4.2. Important PSL executables
+
+ "psl" is the PSL executable with a LISP syntax toploop. "rlisp" runs an
+RLISP (Algol-like) toploop syntax. At some installations, "bare-psl" and
+"pslcomp" also exist, particularly if "psl" has had many modules preloaded
+for local customization.
+
+ There are also a set of c-shell scripts that can be run as if they were
+exectable programs. These include a "build" utility to recompile utility
+modules, "oload" to permit dynamic loading of non-LISP code into PSL, and
+"cmds.csh" to define some useful PSL related aliases.
+
+
+19.4.3. Creating the Init Files
19.4.3. Creating the Init Files
19.4.3. Creating the Init Files
+
+ On startup PSL, RLISP, and PSLCOMP look for LISP syntax init files on
+your home (login) directory, respectively named ".pslrc", ".rlisprc" and
+".pslcomprc", which are executed in the PSL before it prompts for user
+ SaveSystem
SaveSystem
input. Other PSL based programs that are saved by SaveSystem can also be
+made to look for .xxxrc files of their own.
+
+ These files typically contain code to load modules of interest, set
+various switches, such as !*BREAK, etc.
+
+
+19.4.4. Directories and Symbols
19.4.4. Directories and Symbols
19.4.4. Directories and Symbols
+
+ The specific locations of subtrees of PSL files is left up to the
+installer, to reflect the conventions of local usage and file system
+layout. This section discusses the use of c-shell variables ($ variables)
+for system-invariant navigation. To use these, the lines
+
+
+ source ~psl/psl-names
+ source $pvsup/cmds.csh
System Interface 7 February 1983 PSL Manual
+page 19.12 section 19.4
+
+ source lisp-psl-names
+
+
+should be placed in your login.cmd file
+
+ The root of the PSL distribution tree is (usually) located in the home
+directory of a pseudo-user named "psl", and hence may be accessed as
+"~psl/dist". During installation, links in ~psl are often also made to
+startup files in the vax support directory, "$pvsup". (These should be
+SYMBOLIC links in Berkeley 4.1a VmUnix and above.)
+
+ Note - the c-shell expands "~user" and "$variable" in filenames. The
+current version of PSL 3.1 will also permit these constructions in
+filenames, though in a somewhat limited form. Future PSL releases will
+integrate this more fully. Currently, a file of psl-names in LISP systax is
+generated by the "source lisp-psl-names", and it must be read into PSL, etc
+via the .xxxrc files.
+
+ File "~psl/psl-names" defines c-shell symbols for the whole hierarchy of
+distributed PSL directories.
+
+ File $pvsup/cmds.csh contains c-shell commands useful in conjunction with
+PSL. As of this writing, there are only two commands (c-shell alias)
+defined there:
+
+
+ a. "lisp-psl-names". When run from the .login file, it creates a
+ file "psl-names.sl" on your home directory. This file contains
+ a series of PUT statements to associate the full Unix path names
+ with ids that have the same name as the C-shell aliases created
+ by various set commands in your .login. Each entry has the form
+
+
+ (PUT (quote ID) (quote pslname) "pathname")
+
+
+ It is suggested that the line
+
+
+ lisp-psl-names
+
+
+ be placed at the end of your .login if you wish to use this
+ feature. The file "psl-names.sl" should then be read into the
+ various PSL, RLISP, etc by placing a line
+
+
+ (load vax!-path)
+
+
+ into your .pslrc, .rlisprc, etc. This loads the VAX-PATH module,
+ and reads the file "psl-names.sl" which was created by the
PSL Manual 7 February 1983 System Interface
+section 19.4 page 19.13
+
+ "lisp-psl-names" command on your "home" directory, which can
+ also be loaded to give a procedure PATH that builds files names
+ using a "$ID/.." syntax, and also a modified OPEN.
+
+ b. "lisp-csh-vars". An older form of lisp-psl-names.It returns
+ LISP syntax assignments for all of the directory variables
+ defined in the c-shell in which it is executed. Its output may
+ be directly put into files ".pslrc" and ".rlisprc" in your home
+ directory by placing this command in your .login file:
+
+
+ lisp-csh-vars | tee .pslrc
+
+
+ .rlisprc > after which any directory variables set in your
+ c-shell startup will be known in your PSL as arguments for "cd".
+ There are innumerable variations on this, of course.
+
+
+ cd
cd ___ ______ _______ ____
(cd DIR:string): boolean expr
+
+ Like the shell "cd" command, sets the current directory (".") of
+ cd
cd
the running PSL. Unless cd is executed, the current directory
+ __ ___
will remain the same as the current directory of the shell at the
+ ____ ___ ___ ___ _______
time the PSL was started. (Unix filenames are paths relative to
+ Cd
Cd
the current directory unless they begin with a slash.) Cd
+ returns T if it successfully found the directory given in the
+ argument as a path, NIL otherwise.
+
+
+ pwd
pwd ______ ____
(pwd ): string expr
+
+ Like the "pwd" unix command, meaning "print working directory".
+ Returns the current directory of the PSL as a string, terminated
+ with a slash so filenames may be direcly "concat"ed to it. The
+ cd
cd
trailing slash is ignored by cd.
+
+
+ path
path _ ______ ______ ____
(path S:string): string expr
+
+ Examines the argument string; if it starts with $, extracts the
+ next string up to the / (if any), converts it to (an upper-case)
+ __
id. Then an associated string is looked for under the indicator
+ 'pslnames. If an associated string is not found, an Error is
+ _
generated. If S does not start with $, it is returned unchanged.
+
+ Thus CD PATH "$PU"; will work.
+
+ When VAX-PATH is loaded, OPEN is redefined to apply PATH to the
+ file-name. Thus OPEN, IN, DSKIN, OUT, FILEP and and LAPIN can use
+ $vars in file names without calling PATH explicitly. LOAD-PATH
+ also reads the "psl-names.sl" files from the user's
System Interface 7 February 1983 PSL Manual
+page 19.14 section 19.4
+
+ home-directory.
+
+
+19.4.5. Miscellaneous Unix Interface Functions
19.4.5. Miscellaneous Unix Interface Functions
19.4.5. Miscellaneous Unix Interface Functions
+
+
+ ExitLisp
ExitLisp _________ ____
(ExitLisp ): undefined expr
+
+ Since "quit" uses the Berkeley job-control facility to the PSL
+ (like a ^Z at the keyboard), a separate function is needed when
+ ExitLisp
ExitLisp
you really want the PSL to terminate. ExitLisp does it. (A "^\"
+ from the keyboard has the same effect, assuming you have your
+ core-dump limit set low.)
+
+
+ GetEnv
GetEnv __________ ______ ______ ____
(GetEnv ENVVARNAME:string): string expr
+
+ Returns value of the specified Unix environment variable as a
+ string, or NIL if the argument is not a string or the environment
+ variable is not set.
+
+
+ System
System _______ ______ _________ ____
(System UNIXCMD:string): undefined expr
+
+ Starts up a sub-shell and passes the Unix command to it via the
+ Unix "system" command. The working directory of the command will
+ be the same as the PSL.
+
+
+19.4.6. Oload
19.4.6. Oload
19.4.6. Oload
+
+
+
+oload( LdSpec:String ) c-shell-script
+---------------------- --------------
+
+
+ Oload is a means of linking Unix .o and .a files into a running Vax PSL.
+It was developed to get access to existing C code driver libraries for
+graphics devices, but should work for any Unix compiled code with C calling
+conventions.
+
+ The single argument to the oload function is a string containing
+arguments to the Unix "ld" loader, separated by blanks. File names ending
+in ".o" are compiled relocatable code files. ".a" files are "ar" load
+libraries, which are assumed to contain a set of ".o" files, all of which
+are to be loaded. Other loader arguments should follow, specifying
+whatever libraries are necessary to satisfy all external references from
+the ".o" and ".a" files mentioned. Library specs are in the form "-lfoo"
+to search the "libfoo.a" library on /lib, /usr/lib, or /usr/local/lib, e.g.
+"-lc" for the C library.
PSL Manual 7 February 1983 System Interface
+section 19.4 page 19.15
+
+ This is an "incremental" (-A flag) load. Symbols which are already known
+in the running PSL will be linked to the existing addresses.
+
+ If the load string argument is NIL, an attempt is made to re-oload from
+an existing .oload.out file. This can only be done if the BPS and WARRAY
+base addresses are EXACTLY the same as they were on the previously done,
+full oload. An error message results if the BPS locations are different.
+This is meant to facilitate rapidly repeating an oload at startup time.
+
+ Alternately, a customized version of PSL may be saved by the function
+SaveSystem
SaveSystem
SaveSystem, after first performing oloads and loading or compiling in PSL
+code including functions which interface to the oloaded code.
+
+ Oload returns a status code of T if it succeded, or NIL if not.
+
+
+19.4.7. Calling oloaded functions
19.4.7. Calling oloaded functions
19.4.7. Calling oloaded functions
+
+ All entry points and global data objects in ".o" and ".a" files mentioned
+are made known to the PSL system. C functions may be called from compiled
+code ONLY, and are flagged 'ForeignFunction by oload. Data areas are
+flagged 'ForeignData, with a property containing a pair of the data
+location and size in bytes for use by SYSLISP interface code.
+
+ Currently, foreign function calls may not be compiled into Fasl files, so
+ Compile
Compile
the compilation must be done incrementally, via "on Comp" or Compile.
+
+ C
C
The names of oloaded C functions within PSL are the "true" names, which
+have an underscore ("_") prefixed to the C name. This makes it easy to
+make a compiled "pass through" interface function which gives the same name
+within PSL as the C names. e.g. "procedure foo(); _foo();"
+
+ Functions which take integer arguments can be called directly, due to the
+invisible tagging of integers up to +-2^^27 in Vax PSL. Similarly, integer
+return values will be passed back from the C functions. String or
+structured arguments will require a bit of conversion code in the interface
+functions, using SYSLISP functions to remove tags on arguments and add them
+ ImportForeignString
ImportForeignString
to return values. The function ImportForeignString constructs a LISP
+string, given a C string (char *).
+
+ Warning: currently, foreign function calls may have no more than 5
+arguments and floating point and struct arguments and return values are not
+supported. This will be remedied in the compiler eventually. In the mean
+time, both of these restrictions may be easily circumvented by putting
+arguments in work areas and passing the address of the work area as an
+argument to an intermediate C "kluge function" which unpacks the real
+arguments and passes them on to the target C function.
+
+ If work areas are needed in SYSLISP interface code, as when arrays must
+be passed to the C code, use a LispVar to hold the address of a word block
+ GtWArray GtWrds
GtWArray GtWrds
acquired via GtWArray (for static arrays) or GtWrds (for dynamic blocks in
+ C
C
the heap). Pass the array address to the C function as the pointer
System Interface 7 February 1983 PSL Manual
+page 19.16 section 19.4
+
+argument.
+
+
+19.4.8. OLOAD Internals
19.4.8. OLOAD Internals
19.4.8. OLOAD Internals
+
+ Oload invokes the Unix "ld" loader through a c-shell script to convert
+the relocatable code in .o files inwto absolute form, then reads it into
+space allocated within the BPS area of the PSL. The text segment goes at
+the low end of BPS, and the data and bss segments go at the high end,
+following the BPS storage allocation conventions of the LISP compiler.
+
+ Since an incremental (-A) load is done, oload needs a filename path to
+the executable file containing the loader symbol table of the previous
+load. The variable SymbolFileName!* tells both Oload and
+SaveSystem/DumpLisp the file name string to use (for this reason, the
+executable files should be publicly readable.)
+
+ When PSL is started, SymbolFileName!* is automatically set to the name of
+the executed PSL file. This is done by importing the Unix argument string
+to variable UnixArgs!*. UnixArgs!*[0] is the (possibly partial) path to
+the PSL file which was executed. The unix environment variable PATH
+contains a set of path prefixes to which partial paths are appended, until
+a valid filename results. "." refers to the path to the current
+directory, which is returned by pwd(). [ Unix system interface functions
+are contained in file $pv/system-extras.red. ]
+
+ SymbolFileName!* is set to ".oload.out" by oload, so that succesive
+oloads will accumulate a loader symbol table, and so that unexec, called by
+DumpSystem
DumpSystem
DumpSystem, will get the right symbol table in the saved PSL. (It may be
+useful to know that the initial value of SymbolFileName!* is saved in
+StartupName!*.)
+
+ A number of work files are created on the current directory by the oload
+script, with file names that begin ".oload". The .oload.out file in
+particular is quite large because it spans the gap of unused space in BPS.
+It is a good idea to remove those files if you do not intend to repeat the
+oload exactly. This can be done from your rlisp, via the command ''
+system( "rm .oload.*" ); ''.
+
+
+ ImportForeignString
ImportForeignString _ ______ ____ ______ ____
(ImportForeignString C_STRING:word): string expr
+
+ Constructs and returns a LISP string, given a C string (char *)
+ returned from a C ForeignFunction. A NULL (0) string pointer is
+ returned as NIL.
+
+
+ __________ ______
SYMBOLFILENAME!* [Initially: ] global
+
+ Gives the name of the PSL executable file to be examined by both
+ Oload and SaveSystem/DumpLisp to find the Unix symbol table of
+ the PSL. Set to the executed PSL file at startup, changed to
PSL Manual 7 February 1983 System Interface
+section 19.4 page 19.17
+
+ ".oload.out" by Oload.
+
+
+ __________ ______
STARTUPNAME!* [Initially: ] global
+
+ The path to the originally executed PSL file, as returned by
+ GetStartupName
GetStartupName
function GetStartupName, based on UnixArgs!*[0].
+
+
+ __________ ______
UNIXARGS!* [Initially: ] global
+
+ A vector of strings, passed to the PSL on startup by the Unix
+ shell. Imported by function "getUnixArgs".
+
+
+19.4.9. I/O Control functions
19.4.9. I/O Control functions
19.4.9. I/O Control functions
+
+
+ EchoOff
EchoOff _________ ____
(EchoOff ): undefined expr
+
+
+ EchoOn
EchoOn _________ ____
(EchoOn ): undefined expr
+
+ EchoOff
EchoOff
EchoOff enters raw, character-at-a-time input mode for Emode,
+ EchoOn
EchoOn
Nmode, and similar keystroke oriented environments. EchoOn
+ returns to normal, line oriented input mode.
+
+
+ CharsInInputBuffer
CharsInInputBuffer _______ ____
(CharsInInputBuffer ): integer expr
+
+ Returns the number of characters waiting for input from the TTY,
+ including those still in the Stdio buffer and those not yet read
+ from Unix.
+
+
+ FlushStdOutputBuffer
FlushStdOutputBuffer ____ ________ ____
(FlushStdOutputBuffer ): None Returned expr
+
+ The standard output from PSL is in Stdio line-buffered mode, and
+ is normally flushed to the TTY whenever an end-of-line is printed
+ or before waiting for input. In screen-oriented output
+ environements like Emode/Nmode which use screen cursor
+ positioning, it is necessary to explictly flush the buffer at
+ appropriate times. It may also be desireable to see partial
+ lines of output at other times.
+
+
+ ChannelFlush
ChannelFlush ____ __ _______ ____ ________ ____
(ChannelFlush Chnl:io-channel): None Returned expr
+
+ Flushes any channel, as FlushStdOutputBuffer does for StdOut!*.
System Interface 7 February 1983 PSL Manual
+page 19.18 section 19.5
+
+19.5. Apollo System Calls
19.5. Apollo System Calls
19.5. Apollo System Calls
+
+ PSL contains a syscall package for use on the Apollo PSL. See the USCG
+operating note "Apollo Syscall Package for PSL", by S. Lowder, G. Maguire,
+and J. W. Peterson.
ADDED psl-1983/3-1/lpt/20-syslisp.lpt
Index: psl-1983/3-1/lpt/20-syslisp.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/20-syslisp.lpt
@@ -0,0 +1,606 @@
+PSL Manual 7 February 1983 SYSLISP
+section 20.0 page 20.1
+
+ CHAPTER 20
CHAPTER 20
CHAPTER 20
+ SYSLISP
SYSLISP
SYSLISP
+
+
+
+
+ 20.1. Introduction to the SYSLISP level of PSL. . . . . . 20.1
+ 20.2. The Relationship of SYSLISP to RLISP . . . . . . . 20.2
+ 20.2.1. SYSLISP Declarations . . . . . . . . . . 20.2
+ 20.2.2. SYSLISP Mode Analysis. . . . . . . . . . 20.3
+ 20.2.3. Defining Special Functions for Mode Analysis . . 20.4
+ 20.2.4. Modified FOR Loop . . . . . . . . . . . 20.4
+ 20.2.5. Char and IDLOC Macros. . . . . . . . . . 20.5
+ 20.2.6. The Case Statement. . . . . . . . . . . 20.6
+ 20.2.7. Memory Access and Address Operations. . . . . 20.7
+ 20.2.8. Bit-Field Operation . . . . . . . . . . 20.8
+ 20.3. Using SYSLISP. . . . . . . . . . . . . . . 20.9
+ 20.3.1. To Compile SYSLISP Code . . . . . . . . . 20.9
+ 20.4. SYSLISP Functions . . . . . . . . . . . . . 20.10
+ 20.4.1. W-Arrays . . . . . . . . . . . . . . 20.11
+ 20.5. Remaining SYSLISP Issues . . . . . . . . . . . 20.12
+ 20.5.1. Stand Alone SYSLISP Programs . . . . . . . 20.12
+ 20.5.2. Need for Two Stacks . . . . . . . . . . 20.12
+ 20.5.3. New Mode System. . . . . . . . . . . . 20.13
+ 20.5.4. Extend CREF for SYSLISP . . . . . . . . . 20.13
+
+ This chapter is very out of date and will be replaced as soon as
+possible.
+
+
+
+20.1. Introduction to the SYSLISP level of PSL
20.1. Introduction to the SYSLISP level of PSL
20.1. Introduction to the SYSLISP level of PSL
+
+ SYSLISP [Benson 81] is a BCPL-like language, couched in LISP form,
+providing operations on machine words, machine bytes and LISP ITEMs (tagged
+objects, packed into one or more words). We actually think of SYSLISP as a
+lower level of PSL, dealing with words, bytes, bit-fields, machine
+operations, and compile-time storage allocation, enabling us to write
+essentially all of the kernel in PSL.
+
+ The control structures and definition language are those of LISP, but the
+ Plus2 Times2 WPlus2 WTimes2
Plus2 Times2 WPlus2 WTimes2
familiar Plus2, Times2, etc. are mapped to word operations WPlus2, WTimes2,
+etc. SYSLISP handles static allocation of SYSLISP variables and arrays and
+initial LISP symbols, permitting the easy definition of higher level
+Standard LISP functions and storage areas. SYSLISP provides convenient
+ ______
compile-time constants for handling strings, LISP symbols, etc. The
+SYSLISP compiler is based on the PORTABLE STANDARD LISP Compiler, with
+extensions to handle word level objects and efficient, open-coded,
+word-level operations. The SYSLISP mode of the compiler does efficient
+compile-time folding of constants and more comprehensive register
+allocation than in the distributed version of the PLC. Currently, SYSLISP
+handles bytes through the explicit packing and unpacking operations
SYSLISP 7 February 1983 PSL Manual
+page 20.2 section 20.1
+
+GetByte
GetByte
GetByte(word-address,byte-number) /
+PutByte
PutByte
PutByte(word-address,byte-number,byte-value) without the notion of byte-
+pointer; it is planned to extend SYSLISP to a C-like language by adding the
+appropriate declarations and analysis of word/byte/structure operations.
+
+ SYSLISP is a collection of functions and their corresponding data types
+which are used to implement low level primitives in PSL, such as storage
+allocation, garbage collection and input and output. The basic data object
+ ____
in SYSLISP is the "word", a unit of storage large enough to contain a LISP
+____ ____ ____
item. On the PDP-10, a SYSLISP word is just a 36-bit PDP-10 word. On the
+ ____
VAX and most other byte addressed machines, a word is 4 bytes, or 32 bits.
+Conceptually, SYSLISP functions manipulate the actual bit patterns found in
+words, unlike normal LISP functions which manipulate higher-level objects,
+ ____ ______ _____ ______
such as pairs, vectors, and floats or arbitrary-precision numbers.
+Arithmetic in SYSLISP is comparable to the corresponding operations in
+FORTRAN or PASCAL. In fact, SYSLISP is most closely modeled after BCPL, in
+that operations are essentially "typeless".
+
+
+
+20.2. The Relationship of SYSLISP to RLISP
20.2. The Relationship of SYSLISP to RLISP
20.2. The Relationship of SYSLISP to RLISP
+
+ ______
______
______
smacro
smacro
RLISP was extended with a CASE statement, SYSLISP declarations, smacros
+ _____
_____
_____
macro
macro
and macros to provide convenient infix syntax (+, *, / etc.) for calling
+the SYSLISP primitives. Even though SYSLISP is semantically somewhat
+different from LISP (RLISP), we have tried to keep the syntax as similar as
+possible so that SYSLISP code is "familiar" to RLISP users, and easy to
+use. RLISP functions can be easily converted and interfaced to functions
+at the SYSLISP level, gaining considerable efficiency by declaring and
+directly using words and bytes instead of tagged LISP objects.
+
+
+20.2.1. SYSLISP Declarations
20.2.1. SYSLISP Declarations
20.2.1. SYSLISP Declarations
+
+ SYSLISP variables are either GLOBAL, memory locations (allocated by the
+compiler), or local stack locations. Locals are declared by SCALAR, as
+usual. Globals come in the following flavors:
+
+
+WCONST id = wconstexp {,id = wconstexp} ;
+
+Wconstexp is an expression involving constants and wconsts.
+
+WVAR wvardecl {, wvardecl} ;
+
+wvardecl ::= id | id = wconstexp
+
+
+WARRAY warraydecl {, warraydecl} ;
+
+warraydecl ::= id[wconstexp] | id[] = [ wconstexp {,wconstexp} ]
+ | id[] = string
PSL Manual 7 February 1983 SYSLISP
+section 20.2 page 20.3
+
+
+
+WSTRING warraydecl {, warraydecl} ;
+
+Each of these declarations can also be prefixed with the keywords:
+
+INTERNAL or EXTERNAL.
+
+If nothing appears, then a DEFAULT is used.
+
+(Notice there are no metasyntactic square brackets here,
+only curly brackets.)
+
+
+ For example, the following GLOBAL-DATA is used in PSL:
+
+ on SysLisp;
+
+ exported WConst MaxSymbols = 8000,
+ MaxConstants = 500,
+ HeapSize = 100000;
+
+ external WArray SymNam, SymVal, SymFnc, SymPrp, ConstantVector;
+
+ external WVar NextSymbol, NextConstant;
+
+ exported WConst MaxRealRegs = 5,
+ MaxArgs = 15;
+
+ external WArray ArgumentBlock;
+
+ off SysLisp;
+
+ END;
+
+
+
+20.2.2. SYSLISP Mode Analysis
20.2.2. SYSLISP Mode Analysis
20.2.2. SYSLISP Mode Analysis
+
+ ____
In SYSLISP mode, the basic operators +, *, -, /, etc., are bound to word
+ WPlus2 WTimes2 WMinus
WPlus2 WTimes2 WMinus
operators (WPlus2, WTimes2, WMinus, etc.), which compile OPEN as
+ ____
conventional machine operations on machine words. Thus most SYSLISP
+expressions, loops, etc. look exactly like their RLISP equivalents.
+
+
+20.2.3. Defining Special Functions for Mode Analysis
20.2.3. Defining Special Functions for Mode Analysis
20.2.3. Defining Special Functions for Mode Analysis
+
+ To have the Mode analyzer (currently a REFORM function) replace LISP
+function names by SYSLISP ones, do:
+
+ PUT('LispName,'SYSNAME,'SysLispName);
SYSLISP 7 February 1983 PSL Manual
+page 20.4 section 20.2
+
+ The Following have been done:
+
+
+ DefList('((Plus WPlus2)
+ (Plus2 WPlus2)
+ (Minus WMinus)
+ (Difference WDifference)
+ (Times WTimes2)
+ (Times2 WTimes2)
+ (Quotient WQuotient)
+ (Remainder WRemainder)
+ (Mod WRemainder)
+ (Land WAnd)
+ (Lor WOr)
+ (Lxor WXor)
+ (Lnot WNot)
+ (LShift WShift)
+ (LSH WShift)), 'SysName);
+
+ DefList('((Neq WNeq)
+ (Equal WEq)
+ (Eqn WEq)
+ (Eq WEq)
+ (Greaterp WGreaterp)
+ (Lessp WLessp)
+ (Geq WGeq)
+ (Leq WLeq)
+ (Getv WGetv)
+ (Indx WGetv)
+ (Putv WPutv)
+ (SetIndx WPutv)), 'SysName);
+
+
+20.2.4. Modified FOR Loop
20.2.4. Modified FOR Loop
20.2.4. Modified FOR Loop
+
+ Wxxxx
Wxxxx
The FOR loop is modified in SYSLISP mode to use the Wxxxx functions to do
+loop incrementation and testing.
+
+ [??? Should pick up via SysReform ???]
[??? Should pick up via SysReform ???]
[??? Should pick up via SysReform ???]
+
+
+20.2.5. Char and IDLOC Macros
20.2.5. Char and IDLOC Macros
20.2.5. Char and IDLOC Macros
+
+ ____
In SYSLISP mode, '<id> refers to the tagged item, just as in LISP mode,
+IdLoc LispVar
IdLoc __ LispVar
IdLoc <id> refers to the id space offset of the <id>, and LispVar <id>
+ ____
refers to the GLOBAL value cell of a GLOBAL or FLUID variable. Note:
+LispVar
LispVar
LispVar can be used on the left hand side of an argument sentence. For
+ __
example, to store a NIL in the value cell of id FOO, we do any one of the
+following.
PSL Manual 7 February 1983 SYSLISP
+section 20.2 page 20.5
+
+ SYMVAL IDLOC FOO := 'NIL;
+
+ LISPVAR FOO := MKITEM(ID,IDLOC NIL);
+
+
+ Char
Char _ __ _______ _____
(Char U:id): integer macro
+
+ Char
Char
The Char macro returns the ASCII code corresponding to its single
+character-id argument. CHAR also can handle alias's for certain special
+characters, remove QUOTE marks that may be needed to pass special
+characters through the parser, and can accept a prefixes to compute LOWER
+case, <Ctrl> characters, and <Meta> characters. For example:
+
+ Little_a:= Char LOWER A; % In case we think RAISE will occur
+ Little_a:= Char '!a; % !a should not be raised
+ Meta_X := Char META X;
+ Weird := Char META Lower X;
+ Dinger := Char <Ctrl-G>;
+ Dinger := Char BELL;
+
+ PUT
PUT
The following Aliases are defined by PUTing the association under the
+indicator 'CharConst:
+
+ DefList('((NULL 8#0)
+ (BELL 8#7)
+ (BACKSPACE 8#10)
+ (TAB 8#11)
+ (LF 8#12)
+ (EOL 8#12)
+ (FF 8#14)
+ (CR 8#15)
+ (EOF 26)
+ (ESC 27)
+ (ESCAPE 27)
+ (BLANK 32)
+ (RUB 8#177)
+ (RUBOUT 8#177)
+ (DEL 8#177)
+ (DELETE 8#177)), 'CharConst);
+
+
+20.2.6. The Case Statement
20.2.6. The Case Statement
20.2.6. The Case Statement
+
+ RLISP in SYSLISP mode provides a Numeric case statement, that is
+implemented quite efficiently; some effort is made to examine special cases
+(compact vs. non compact sets of cases, short vs. long sets of cases,
+etc.).
+
+ [??? Note, CASE can also be used from LISP mode, provided tags are
[??? Note, CASE can also be used from LISP mode, provided tags are
[??? Note, CASE can also be used from LISP mode, provided tags are
+ numeric. There is also an FEXPR, CASE ???]
numeric. There is also an FEXPR, CASE ???]
numeric. There is also an FEXPR, CASE ???]
+
+ The syntax is:
SYSLISP 7 February 1983 PSL Manual
+page 20.6 section 20.2
+
+Case-Statement ::= CASE expr OF case-list END
+
+Case-list ::= Case-expr [; Case-list ]
+
+Case-expr ::= Tag-expr : expr
+
+tag-expr ::= DEFAULT | OTHERWISE |
+ tag | tag, tag ... tag |
+ tag TO tag
+
+Tag ::= Integer | Wconst-Integer
+
+
+% This is a piece of code from the Token Scanner,
+% in file "PI:token-Scanner.red"
+.....
+ case ChTokenType of
+ 0 to 9: % digit
+ << TokSign := 1;
+ goto InsideNumber >>;
+ 10: % Start of ID
+ << if null LispVar !*Raise then
+ goto InsideID
+ else
+ << RaiseLastChar();
+ goto InsideRaisedID >> >>;
+ 11: % Delimiter, but not beginning of diphthong
+ << LispVar TokType!* := '3;
+ return MkID TokCh >>;
+ 12: % Start of comment
+ goto InsideComment;
+ 13: % Diphthong start-Lisp function uses P-list of starting char
+ return ScanPossibleDipthong(TokChannel, MkID TokCh);
+ 14: % ID escape character
+ << if null LispVar !*Raise then
+ goto GotEscape
+ else goto GotEscapeInRaisedID >>;
+ 15: % string quote
+ << BackupBuf();
+ goto InsideString >>;
+ 16: % Package indicator -
+ % at start of token means use global package
+ << ResetBuf();
+ ChangedPackages := 1;
+ Package 'Global;
+ if null LispVar !*Raise then
+ goto GotPackageMustGetID
+ else goto GotPackageMustGetIDRaised >>;
+ 17: % Ignore - can't ever happen
+ ScannerError("Internal error - consult a wizard");
+ 18: % Minus sign
+ << TokSign := -1;
PSL Manual 7 February 1983 SYSLISP
+section 20.2 page 20.7
+
+ goto GotSign >>;
+ 19: % Plus sign
+ << TokSign := 1;
+ goto GotSign >>;
+ 20: % decimal point
+ << ResetBuf();
+ ReadInBuf();
+ if ChTokenType >= 10 then
+ << UnReadLastChar();
+ return ScanPossibleDipthong(TokChannel, '!.) >>
+ else
+ << TokSign := 1;
+ TokFloatFractionLength := 1;
+ goto InsideFloatFraction >> >>;
+ default:
+ return ScannerError("Unknown token type")
+ end;
+ .....
+
+
+
+20.2.7. Memory Access and Address Operations
20.2.7. Memory Access and Address Operations
20.2.7. Memory Access and Address Operations
+
+ The operators @ and & (corresponding to GetMem and Loc) may be used to do
+direct memory operations, similar to * and & in C.
+
+ @ may also be used on the LHS of an assignment. Example:
+
+
+ WARRAY FOO[10];
+ WVAR FEE=&FOO[0];
+
+ ...
+ @(fee+2) := @(fee+4) + & foo(5);
+ ...
+
+
+20.2.8. Bit-Field Operation
20.2.8. Bit-Field Operation
20.2.8. Bit-Field Operation
+
+ The Field and PutField operations are used for accessing fields smaller
+than whole words:
+
+ PUTFIELD(LOC, BITOFFSET, BITLENGTH, VALUE);
+
+ and
+
+ GETFIELD(LOC,BITOFFSET, BITLENGTH);
+
+ Special cases such as bytes, halfwords, single bits are optimized if
+possible.
+
+ For example, the following definitions on the DEC-20 are used to define
SYSLISP 7 February 1983 PSL Manual
+page 20.8 section 20.2
+
+the fields of an item (in file p20c:data-machine.red):
+
+
+ % Divide up the 36 bit DEC-20 word:
+
+ WConst TagStartingBit = 0,
+ TagBitLength = 18,
+ StrictTagStartingBit = 9,
+ StrictTagBitLength = 9,
+ InfStartingBit = 18,
+ InfBitLength = 18,
+ GCStartingBit = 0,
+ GCBitLength = 9;
+
+ % Access to tag (type indicator) of Lisp item in ordinary code
+
+ syslsp macro procedure Tag U;
+ list('Field, cadr U, '(wconst TagStartingBit), '(wconst TagBitLe
+
+ syslsp macro procedure PutTag U;
+ list('PutField, cadr U, '(wconst TagStartingBit),
+ '(wconst TagBitLength), caddr U);
+
+ % Access to tag of Lisp item in garbage collector,
+ % if GC bits may be in use
+
+ syslsp macro procedure StrictTag U;
+ list('Field, cadr U, '(wconst StrictTagStartingBit),
+ '(wconst StrictTagBitLength));
+
+ syslsp macro procedure PutStrictTag U;
+ list('PutField,
+ cadr U, '(wconst StrictTagStartingBit),
+ '(wconst StrictTagBitLength), caddr U);
+
+ % Access to info field of item (pointer or immediate operand)
+
+ syslsp macro procedure Inf U;
+ list('Field, cadr U, '(wconst InfStartingBit), '(wconst InfBitLe
+
+ syslsp macro procedure PutInf U;
+ list('PutField, cadr U, '(wconst InfStartingBit),
+ '(wconst InfBitLength), caddr U);
PSL Manual 7 February 1983 SYSLISP
+section 20.3 page 20.9
+
+20.3. Using SYSLISP
20.3. Using SYSLISP
20.3. Using SYSLISP
+
+ ___________
Restriction: SYSLISP code is currently ONLY compiled, since it is
+converted into machine level operations, most of which are dangerous or
+tricky to use in an interpreted environment.
+
+ Note: In SYSLISP mode, we currently execute some commands in the above
+PARSE/EVAL/PRINT mode, either to load files or select options, but most
+SYSLISP code is compiled to a file, rather than being immediately
+interpreted or compiled in-core.
+
+
+20.3.1. To Compile SYSLISP Code
20.3.1. To Compile SYSLISP Code
20.3.1. To Compile SYSLISP Code
+
+ Use PSL:RLISP, which usually has the Compiler, with SYSLISP extensions,
+loaded. Alternatively, one may use <psl>syscmp.exe. This is a version of
+RLISP built upon <PSL>psl.exe with the SYSLISP compiler and data-machine
+macros loaded.
+
+ % Turn on SYSLISP mode:
+
+ ON SYSLISP; % This is causes the "mode-analysis" to be done
+ % Converting some LISP names to SYSLISP names.
+
+ % Use SYSLSP as the procedure type.
+
+ Example:
+
+ % Small file to access BPS origin and end.
+ % Starts in LISP mode
+
+ Fluid '(NextBP0 LastBP0);
+
+ NextBP0:=NIL;
+ LastBP0:=NIL;
+
+ On SYSLISP,COMP; % Switch to SYSLISP mode
+
+ syslsp procedure BPSize();
+ Begin scalar N1,L1;
+ If Null LispVar NextBP0 then LispVar NextBP0:=GtBPS 0;
+ If Null LispVar LastBP0 then LispVar LastBP0:=GtWarray 0;
+ N1 :=GtBPS(0);
+ L1:= GtWarray(0);
+ PrintF('" NextBPS=8#%o, used %d, LastBPS=8#%o, used %d%n",
+ N1, N1-LispVar(NextBP0), L1,LispVar(LastBP0)-L1)
+ LispVar NextBP0:=N1;
+ LispVar LastBP0:=L1;
+ End;
+
+ BPSize(); % Call the function
SYSLISP 7 February 1983 PSL Manual
+page 20.10 section 20.4
+
+20.4. SYSLISP Functions
20.4. SYSLISP Functions
20.4. SYSLISP Functions
+
+ [??? What about overflow in Syslisp arithmetic? ???]
[??? What about overflow in Syslisp arithmetic? ???]
[??? What about overflow in Syslisp arithmetic? ???]
+
+
+ WPlus2
WPlus2 _ ____ _ ____ ____ ____ ________ ____
(WPlus2 U:word, V:word): word open-compiled, expr
+
+
+ WDifference
WDifference _ ____ _ ____ ____ ____ ________ ____
(WDifference U:word, V:word): word open-compiled, expr
+
+
+ WTimes2
WTimes2 _ ____ _ ____ ____ ____ ________ ____
(WTimes2 U:word, V:word): word open-compiled, expr
+
+
+ WQuotient
WQuotient _ ____ _ ____ ____ ____ ________ ____
(WQuotient U:word, V:word): word open-compiled, expr
+
+
+ WRemainder
WRemainder _ ____ _ ____ ____ ____ ________ ____
(WRemainder U:word, V:word): word open-compiled, expr
+
+
+ WShift
WShift _ ____ _ ____ ____ ____ ________ ____
(WShift U:word, V:word): word open-compiled, expr
+
+
+ WAnd
WAnd _ ____ _ ____ ____ ____ ________ ____
(WAnd U:word, V:word): word open-compiled, expr
+
+
+ WOr
WOr _ ____ _ ____ ____ ____ ________ ____
(WOr U:word, V:word): word open-compiled, expr
+
+
+ WXor
WXor _ ____ _ ____ ____ ____ ________ ____
(WXor U:word, V:word): word open-compiled, expr
+
+
+ WNot
WNot _ ____ ____ ____ ________ ____
(WNot U:word): word open-compiled, expr
+
+
+ WEQ
WEQ _ ____ _ ____ _______ ____ ________ ____
(WEQ U:word, V:word): boolean open-compiled, expr
+
+
+ WNEQ
WNEQ _ ____ _ ____ _______ ____ ________ ____
(WNEQ U:word, V:word): boolean open-compiled, expr
+
+
+ WGreaterP
WGreaterP _ ____ _ ____ _______ ____ ________ ____
(WGreaterP U:word, V:word): boolean open-compiled, expr
+
+
+ WLessP
WLessP _ ____ _ ____ _______ ____ ________ ____
(WLessP U:word, V:word): boolean open-compiled, expr
+
+
+ WGEQ
WGEQ _ ____ _ ____ _______ ____ ________ ____
(WGEQ U:word, V:word): boolean open-compiled, expr
PSL Manual 7 February 1983 SYSLISP
+section 20.4 page 20.11
+
+ WLEQ
WLEQ _ ____ _ ____ _______ ____ ________ ____
(WLEQ U:word, V:word): boolean open-compiled, expr
+
+
+ WGetV
WGetV _ ____ _ ____ ____ ____ ________ _____
(WGetV U:word, V:word): word open-compiled, macro
+
+
+ WPutV
WPutV _ ____ _ ____ _ ____ ____ ____ ________ _____
(WPutV U:word, V:word, W:word): word open-compiled, macro
+
+
+ Byte
Byte _ ____ _ ____ ____ ____ ________ ____
(Byte U:word, V:word): word open-compiled, expr
+
+
+ PutByte
PutByte _ ____ _ ____ _ ____ ____ ____ ________ ____
(PutByte U:word, V:word, W:word): word open-compiled, expr
+
+
+20.4.1. W-Arrays
20.4.1. W-Arrays
20.4.1. W-Arrays
+
+
+ CopyWArray
CopyWArray ___ _ ______ ___ _ ______ _____ ___ ___ _ ______ ____
(CopyWArray NEW:w-vector, OLD:w-vector, UPLIM:any): NEW:w-vector expr
+
+ _____
Copy UPLIM + 1 words.
+
+
+ CopyWRDSToFrom
CopyWRDSToFrom ___ _ ______ ___ ___ ___ ____
(CopyWRDSToFrom NEW:w-vector, OLD:any): any expr
+
+ CopyWArray
CopyWArray
Like CopyWArray in heap.
+
+
+ CopyWRDS
CopyWRDS _ ___ ___ ____
(CopyWRDS S:any): any expr
+
+ Allocate new WRDS array in heap.
+
+
+
+20.5. Remaining SYSLISP Issues
20.5. Remaining SYSLISP Issues
20.5. Remaining SYSLISP Issues
+
+ The system should be made less dependent on the assemblers, compilers and
+loaders of the particular machine it is implemented on. One way to do this
+is to bring up a very small kernel including a fast loader to load in the
+rest.
+
+
+20.5.1. Stand Alone SYSLISP Programs
20.5.1. Stand Alone SYSLISP Programs
20.5.1. Stand Alone SYSLISP Programs
+
+ In principle it works, but we need to clearly define a small set of
+support functions. Also, need to implement EXTERNAL properly, so that a
+normal LINKING loader can be used. In PSL, we currently produce a single
+kernel module, with resident LAP (or later FAP), and it serves as dynamic
+linking loader for SYSLISP (ala MAIN SAIL).
SYSLISP 7 February 1983 PSL Manual
+page 20.12 section 20.5
+
+20.5.2. Need for Two Stacks
20.5.2. Need for Two Stacks
20.5.2. Need for Two Stacks
+
+ We must distinguish between true LISP items and untagged SYSLISP items on
+the stack for the garbage collector to work properly. Two of the options
+for this are
+
+ 1. Put a mark on the stack indicating a region containing untagged items.
+
+ 2. Use a separate stack for untagged items.
+
+ Either of these involves a change in the compiler, since it currently
+only allocates one frame for temporaries on the stack and does not
+distinguish where they get put.
+
+ The garbage collector should probably be recoded more modularly and at a
+higher level, short of redesigning the entire storage management scheme.
+This in itself would probably require the existence of a separate stack
+which is not traced through for return addresses and SYSLISP temporaries.
+
+
+20.5.3. New Mode System
20.5.3. New Mode System
20.5.3. New Mode System
+
+ A better scheme for intermixing SYSLISP and LISP within a package is
+needed. Mode Reduce will probably take care of this.
+
+
+20.5.4. Extend CREF for SYSLISP
20.5.4. Extend CREF for SYSLISP
20.5.4. Extend CREF for SYSLISP
+
+ The usual range of LISP tools should be available, such as profiling, a
+break package, tracing, etc.
ADDED psl-1983/3-1/lpt/21-implementation.lpt
Index: psl-1983/3-1/lpt/21-implementation.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/21-implementation.lpt
@@ -0,0 +1,494 @@
+PSL Manual 7 February 1983 Implementation
+section 21.0 page 21.1
+
+ CHAPTER 21
CHAPTER 21
CHAPTER 21
+ IMPLEMENTATION
IMPLEMENTATION
IMPLEMENTATION
+
+
+
+
+ 21.1. Overview of the Implementation . . . . . . . . . 21.1
+ 21.2. Files of Interest . . . . . . . . . . . . . 21.1
+ 21.3. Building PSL on the DEC-20 . . . . . . . . . . 21.2
+ 21.4. Building the LAP to Assembly Translator . . . . . . 21.5
+ 21.5. The Garbage Collectors and Allocators. . . . . . . 21.5
+ 21.5.1. Compacting Garbage Collector on DEC-20 . . . . 21.5
+ 21.5.2. Two-Space Stop and Copy Collector on VAX . . . 21.6
+ 21.6. The HEAPs . . . . . . . . . . . . . . . . 21.6
+ 21.7. Allocation Functions . . . . . . . . . . . . 21.8
+
+ This chapter is very out of date and will be replaced as soon as
+possible. Refer to the release notes for your machine and the forthcoming
+implementation guide.
+
+
+
+21.1. Overview of the Implementation
21.1. Overview of the Implementation
21.1. Overview of the Implementation
+
+ In this Chapter we give a guide to the sources, although they are still
+rapidly changing. With these notes in mind, and an understanding of
+SYSLISP and the compiler at the level of Chapters 18 and 20, it is hoped
+the user will be able to understand and change most of the system. Much of
+the current information is contained in comments in the source files, and
+cannot be reproduced here.
+
+ [??? This Section needs a LOT of work ???]
[??? This Section needs a LOT of work ???]
[??? This Section needs a LOT of work ???]
+
+
+
+21.2. Files of Interest
21.2. Files of Interest
21.2. Files of Interest
+
+ The complete sources are divided up into a fairly large number of files,
+spread over a number of sub-directories of <PSL>. This is so that files
+representing a common machine-independent kernel are in a single directory,
+and additional machine specific files in others. Furthermore, we have
+separated the compiler and LAP files from the rest of the files, since they
+are looked at first when doing a new implementation, but are not actually
+important to understanding the working of PSL.
+
+ Some convenient logical device names are defined in <psl>logical-
+names.cmd. This file should have been TAKEn in your LOGIN.CMD. Current
+definitions are:
+
+
+;Officially recognized logical names for PSL subdirectories on UTAH-20
+define psl: <psl> ! Executable files and miscellaneous
Implementation 7 February 1983 PSL Manual
+page 21.2 section 21.2
+
+define ploc: <psl.local> ! Non-distributed miscellaneous
+define pi: <psl.interp> ! Interpreter sources
+define pc: <psl.comp> ! Compiler sources
+define pu: <psl.util> ! Utility program sources
+define plocu: <psl.local.util> ! Non-distributed utility sources
+define pd: <psl.doc> ! Documentation to TYPE
+define pe: <psl.emode> ! Emode sources and build files
+define plpt: <psl.lpt> ! Printer version of Documentation
+define ph: <psl.help> ! Help files
+define plap: <psl.lap> ! LAP and B files
+define ploclap: <psl.local.lap> ! Non-distributed LAP and B files
+define pred: <reduce.psl-reduce>! Temporary home of Reduce built upon
+ ! PSL
+define p20: <psl.20-interp> ! Dec-20 specific interpreter sources
+define p20c: <psl.20-comp> ! Dec-20 specific compiler sources
+define p20d: <psl.20-dist> ! Dec-20 distribution files
+define pv: <psl.vax-interp> ! Vax specific interpreter sources
+define pvc: <psl.vax-comp> ! Vax specific compiler sources
+define pvd: <psl.vax-dist> ! Vax distribution files
+define p68: <psl.68000-interp> ! M68000 specific interpreter sources
+define p68c: <psl.68000-comp> ! M68000 specific compiler sources
+define pcr: <psl.cray-interp> ! Cray-1 interpreter sources
+define pcrc: <psl.cray-comp> ! Cray-1 compiler sources
+define pcrd: <psl.cray-dist> ! Cray-1 distribution files
+define pl: plap:,ploclap: ! Search list for LOAD
+
+
+ Sources mostly live on PI:. DEC-20 build files and very machine specific
+files live on P20:.
+
+
+
+21.3. Building PSL on the DEC-20
21.3. Building PSL on the DEC-20
21.3. Building PSL on the DEC-20
+
+ [??? fix as FASL works ???]
[??? fix as FASL works ???]
[??? fix as FASL works ???]
+
+ Building proceeds in number of steps. First the kernel files are
+compiled to MIDAS, using a LAP-to-MIDAS translator, which follows the
+normal LISP/SYSLISP compilation to LAP. This phase also includes the
+conversion of constants (atoms names, strings, etc) into structures in the
+heap, and initialization code into an INIT procedure. The resulting module
+is assembled, linked, and saved as BARE-PSL.EXE. If executed, it reads in
+a batch of LAP files, previously compiled, representing those functions
+that should be in a minimal PSL, but in fact are not needed to implement
+LAP.
+
+ [??? When FAP is implemented, these LAP files will become FAP files,
[??? When FAP is implemented, these LAP files will become FAP files,
[??? When FAP is implemented, these LAP files will become FAP files,
+ and the kernel will get smaller ???]
and the kernel will get smaller ???]
and the kernel will get smaller ???]
+
+.
+
+ The BARE-PSL kernel build file is P20:PSL-KERNEL.CTL, and is reproduced
PSL Manual 7 February 1983 Implementation
+section 21.3 page 21.3
+
+here, slightly edited:
+
+
+
+; This requires PL:PSL-NON-KERNEL.LAP and P20C:PSLDEF.MID
+copy BARE-PSL.SYM PSL.SYM
+PSL:MIDASCMP ! previously saved with LAPtoMIDAS
+in "PSL-KERNEL.RED"; % Files for kernel
+quit;
+MIDAS ! assemble kernel data
+dpsl
+MIDAS ! assemble kernel init code
+spsl
+MIDAS ! assemble kernel code
+psl
+load DPSL.REL, SPSL.REL, PSL.REL ! link into one module
+save BARE-PSL.EXE ! save executable
+
+
+
+ The kernel files mentioned in PSL-KERNEL.RED are:
+
+
+MIDASOUT "PSL";
+IN "BINDING.RED"$ % binding from the interpreter
+IN "FAST-BINDER.RED"$ % for binding in compiled code,
+ % in LAP
+IN "SYMBOL-VALUES.RED"$ % SET, and support for Eval
+IN "FUNCTION-PRIMITIVES.RED"$ % used by PutD, GetD and Eval
+IN "OBLIST.RED"$ % Intern, RemOb and GenSym
+IN "CATCH-THROW.RED"$ % non-local GOTO mechanism
+IN "ALLOCATORS.RED"$ % heap, symbol and code space alloc
+IN "COPIERS.RED"$ % copying functions
+IN "CONS-MKVECT.RED"$ % SL constructor functions
+IN "GC.RED"$ % the garbage collector
+IN "APPLY-LAP.RED"$ % low-level function linkage, in LAP
+IN "EQUAL.RED"$ % equality predicates
+IN "EVAL-APPLY.RED"$ % interpreter functions
+IN "PROPERTY-LIST.RED"$ % PUT and FLAG and friends
+IN "FLUID-GLOBAL.RED"$ % variable declarations
+IN "PUTD-GETD.RED"$ % function defining functions
+IN "KNOWN-TO-COMP-SL.RED"$ % SL functions performed online
+ % in code
+IN "OTHERS-SL.RED"$ % DIGIT, LITER and LENGTH
+IN "CARCDR.RED"$ % CDDDDR, etc.
+IN "EASY-SL.RED"$ % highly portable SL function defns
+IN "EASY-NON-SL.RED"$ % simple, ubiquitous SL extensions
+IN "COMP-SUPPORT.RED"$ % optimized CONS and LIST compilation
+IN "ERROR-HANDLERS.RED"$ % low level error handlers
+IN "TYPE-CONVERSIONS.RED"$ % convert from one type to another
+IN "ARITH.RED"$ % Lisp arithmetic functions
+IN "IO-DATA.RED"$ % Data structures used by IO
Implementation 7 February 1983 PSL Manual
+page 21.4 section 21.3
+
+IN "SYSTEM-IO.RED"$ % system dependent IO functions
+IN "CHAR-IO.RED"$ % bottom level IO primitives
+IN "OPEN-CLOSE.RED"$ % file primitives
+IN "RDS-WRS.RED"$ % IO channel switching functions
+IN "OTHER-IO.RED"$ % random SL IO functions
+IN "READ.RED"$ % S-expression parser
+IN "TOKEN-SCANNER.RED"$ % table-driven token scanner
+IN "PRINTERS.RED"$ % Printing functions
+IN "WRITE-FLOAT.RED"$ % Floating point printer
+IN "PRINTF.RED"$ % formatted print routines
+IN "IO-ERRORS.RED"$ % I/O error handlers
+IN "IO-EXTENSIONS.RED"$ % Random non-SL IO functions
+IN "VECTORS.RED"$ % GetV, PutV, UpbV
+IN "STRING-OPS.RED"$ % Indx, SetIndx, Sub, SetSub, Concat
+IN "EXPLODE-COMPRESS.RED"$ % Access to characters of atoms
+IN "BACKTRACE.RED"$ % Stack backtrace
+IN "DEC-20-EXTRAS.RED"$ % Dec-20 specific routines
+IN "LAP.RED"$ % Compiled code loader
+IN "INTERESTING-SYMBOLS.RED"$ % to access important WCONSTs
+IN "MAIN-START.RED"$ % first routine called
+MIDASEND;
+InitSymTab();
+END;
+
+
+
+ The current non-kernel files are defined in PSL-NON-KERNEL.RED:
+
+
+LapOut "PL:PSL-NON-KERNEL.LAP";
+in "EVAL-WHEN.RED"$ % control evaluation time(load first)
+in "CONT-ERROR.RED"$ % macro for ContinuableError
+in "MINI-TRACE.RED"$ % simple function tracing
+in "TOP-LOOP.RED"$ % generalized top loop function
+in "PROG-AND-FRIENDS.RED"$ % Prog, Go and Return
+in "ERROR-ERRORSET.RED"$ % most basic error handling
+in "TYPE-ERRORS.RED"$ % type mismatch error calls
+in "SETS.RED"$ % Set manipulation functions
+in "DSKIN.RED"$ % Read/Eval/Print from files
+in "LISP-MACROS.RED"$ % If, SetF
+in "LOOP-MACROS.RED"$ % While, Repeat, ForEach
+in "CHAR.RED"$ % Character constant macro
+in "LOAD.RED"$ % Standard module LAP loader
+in "PSL-MAIN.RED"$ % SaveSystem and Version stuff
+LapEnd;
+
+
+
+ The model on the VAX is similar.
+
+ The file GLOBAL-DATA.RED is automatically loaded by the compiler in the
+LAP-to-Assembly phase. It defines most important external symbols.
PSL Manual 7 February 1983 Implementation
+section 21.3 page 21.5
+
+ A symbol table file, PSL.SYM is produced, and is meant to be used to aid
+in independent recompilation of modules. It records assigned ID numbers,
+locations of WVARS, WARRAYS, and WSTRINGs, etc. It is not currently used.
+
+ The file P20C:DATA-MACHINE.RED defines important macros and constants,
+allocating fields within a DEC-20 word (the TAGs, etc). It is used only
+with compiled code, and is so associated with the P20C: (20 compiler
+specific code); other files on this directory include the code-generator
+tables and compiler customization files. More information on the compiler
+and its support can be found in Chapter 18.
+
+
+
+21.4. Building the LAP to Assembly Translator
21.4. Building the LAP to Assembly Translator
21.4. Building the LAP to Assembly Translator
+
+ [??? Write after new table-driven LAP and LAP-to-ASM is stable ???]
[??? Write after new table-driven LAP and LAP-to-ASM is stable ???]
[??? Write after new table-driven LAP and LAP-to-ASM is stable ???]
+
+
+
+21.5. The Garbage Collectors and Allocators
21.5. The Garbage Collectors and Allocators
21.5. The Garbage Collectors and Allocators
+
+
+21.5.1. Compacting Garbage Collector on DEC-20
21.5.1. Compacting Garbage Collector on DEC-20
21.5.1. Compacting Garbage Collector on DEC-20
+
+ DEC-20 PSL uses essentially the same compacting garbage collector
+developed for the previous MTLISP systems: a single heap with all objects
+tagged in the heap in such a way that a linear scan from the low end
+permits objects to be identified; they are either tagged as normal objects,
+and are thus in a PAIR, or are tagged with a "pseudo-tag", indicating a
+header item for some sort of BYTE, WORD or ITEM array. Tracing of objects
+is done using a small stack, and relocation via a segment table and extra
+bits in the item. The extra bits in the item can be replaced by a
+bit-table, and this may become the default method.
+
+ During compaction, objects are "tamped" to the low end of the heap,
+permitting "genetic" ordering for algebraic operations, and rapid
+stack-like allocation.
+
+ Since the MTLISP systems included a number of variable sized data-types
+ ______ ______
(e.g. vectors and strings), we had to reduce the working set, and ease the
+addition of new data-types, by using a single heap with explicitly tagged
+objects, and compacting garbage collector. In some versions, a bit-table
+was used both for marking and for compaction. To preserve locality,
+structures are "tamped" to one end of the heap, maintaining relative
+(creation time or "Genetic" [Terashima 78]) ordering. The order
+preservation was rather useful for an inexpensive canonical ordering
+required in the REDUCE algebra system (simply compare heap positions, which
+are "naturally" related to object creation). The single heap, with
+explicit tags made the addition of new data-types rather easy. The virtual
+memory was implemented as a low level "memory" extension, invisible to the
+allocator and garbage collector.
Implementation 7 February 1983 PSL Manual
+page 21.6 section 21.5
+
+ This garbage collector has been rewritten a number of times; it is fairly
+easy to extend, but does waste lot of space in each DEC-20 word. Among
+possible alternative allocators/GC is a bit-table version, which is
+semantically equivalent to that described above but has the Dmov field
+replaced by a procedure to count ones in a segment of the bit-table. At
+some point, the separate heap model (tried on Z-80 and PDP-11 MTLISP's) may
+be implemented, but the separate page-per-type method (BIBOP:="big bag of
+pages") might also be tried; this permits user definition of new types.
+
+ Allocation proceeds as from a stack, permitting rapid allocation, and
+preserving creation time ordering. The current implementation uses a
+recursive mark phase with a small stack (G stack) of about 500 entries.
+
+ Relocation is accomplished with aid the of the SEGMENT table (overlays G
+stack), and a small field (Dmov) in each item (header) that gives
+additional motion of this item relative to the relocation of its segment.
+
+
+21.5.2. Two-Space Stop and Copy Collector on VAX
21.5.2. Two-Space Stop and Copy Collector on VAX
21.5.2. Two-Space Stop and Copy Collector on VAX
+
+ Another alternative is a copying, 2-space GC, which is fast and good for
+large address space (e.g. extended addressing DEC-20 or VAX).
+
+
+
+21.6. The HEAPs
21.6. The HEAPs
21.6. The HEAPs
+
+ The HEAP is used to store variable sized objects. Since one of the
+possible implementations is to have a separate heap for each of the data
+types PAIR, STR, CODE, and VECT (or for the groupings PAIR, CODE+STR,
+VECT), the heap is accessed in type specific fashion only. The current
+implementation of the allocator and garbage collector maps these
+type-specific operations onto a single array of item sized blocks, the
+first of which is a normal tagged item (CAR of a PAIR), or a pseudo-item
+(header of CODE, STR or VECT). The following blocks are either tagged
+items or packed bytes. The header item contains a "length" in items, or
+bytes, as appropriate. Using item sized blocks results in a slight wastage
+at the end of strings and code-vectors.
+
+ Reclamation:
+
+
+h:=INF(x) For garbage collection, compaction and relocation. The heap is
+ viewed as a set of ITEM sized blocks
+PUTINF(x,h)
+PUTTYPE(x,t)
+MARK(h)
+UNMARK(h) Modify the garbage collector mark
+MARKED(h) Test the mark (in a bit-table, ITEM header, or ITEM itself).
+
+
+ Other Garbage collector primitives include:
PSL Manual 7 February 1983 Implementation
+section 21.6 page 21.7
+
+GCPUSH(x) Push an ITEM onto GCSTACK for later trace
+x:=GCPOP()
+ Retrieve ITEM for tracing
+x:=GCTOP()
+ Examine top of GCSTACK
+
+
+ The Garbage collector uses a GCSTACK for saving pointers still to be
+traced. The compaction and relocation takes place by "tamping", without
+structure reorganization, so that any structure is relocated by the same or
+more than a neighboring structure, lower in the heap. This "monotonicity"
+means that the heap can be divided into "segments", and the relocation of
+any structure computed as the relocation of its segment, plus an additional
+movement within the segment. The segment table is an additional structure,
+while the "offset" is computed from the bits in the bit-table, or from a
+small field (if available) in the ITEM. This garbage collector is similar
+to that described in [Terashima 78].
+
+
+RELOC(h):=SEGKNT(SEG(h))+DMOV(h)
+ SEGKNT(SEG(h)) is the segment relocation of the segment in which
+ h is, and DMOV is the incremental move within this segment.
+
+i:=SEG(h) Computes the segment number
+
+i:=DSEG(h)
+ The "offset" in the segment
+
+
+ Note that DMOV may actually be a small field in an ITEM header, if there
+is space, or can be computed from the bits in a segment of the BIT-table,
+or may map to some other construct. The segment table may actually overlay
+the GCSTACK space, since these are active in different passes of the
+garbage collection. The garbage collector used in the MTLISP system is an
+extension of that attributed to S. Brown in [Harrison 73, Harrison 74].
+See also [Terashima 78].
+
+
+ __________ ______
!*GC [Initially: NIL] switch
+
+ !*GC controls the printing of garbage collector messages. If NIL
+ no indication of garbage collection occurs. If non-NIL various
+ system dependent messages may be displayed.
+
+
+ __________ ______
GCKNT!* [Initially: 0] global
+
+ Reclaim
Reclaim
Records the number of times that Reclaim has been called to this
+ point. GCKNT!* may be reset to another value to record counts
+ incrementally, as desired.
Implementation 7 February 1983 PSL Manual
+page 21.8 section 21.6
+
+ Reclaim
Reclaim _______ ____
(Reclaim ): integer expr
+
+ User call on GC; does a mark-trace and compaction of HEAP.
+ Returns size of current Heap top. If !*GC is T, prints some
+ Reclaim
Reclaim
statistics. Increments GCKNT!*. Reclaim(); is the user level
+ call to the garbage collector.
+
+
+ !%Reclaim
!%Reclaim ___ _______ ____
(!%Reclaim ): Not Defined expr
+
+ !%Reclaim
!%Reclaim
!%Reclaim(); is the system level call to the garbage collector.
+ Active data in the heap is made contiguous and all tagged
+ pointers into the heap from active local stack frames, the
+ binding stack and the symbol table are relocated.
+
+
+
+21.7. Allocation Functions
21.7. Allocation Functions
21.7. Allocation Functions
+
+
+ GtHEAP
GtHEAP _____ ____ ____ ____
(GtHEAP NWRDS:word): word expr
+
+ _____
Return address in HEAP of a block of NWRDS item sized pieces.
+ GtHeap
GtHeap
Generates HeapOverflow Message if can't satisfy. GtHeap NIL;
+ returns the number of words (Lisp items) left in the heap.
+ GtHeap
GtHeap
GtHeap 0; returns a pointer to the top of the active heap.
+ GtHeap
GtHeap
GtHeap N; returns a pointer to N words (items).
+
+
+ GtStr
GtStr _____ ____ ____ ____
(GtStr UPLIM:word): word expr
+
+ ______ _____
Address of string, 0..UPLIM bytes. (Allocate space for a string
+ _____
UPLIM characters.)
+
+
+ GtConstStr
GtConstStr _ ______ ____
(GtConstStr N:string): expr
+
+ GtStr
GtStr
(Allocate un-collected string for print name. Same as GtStr, but
+ uses BPS, not heap.)
+
+
+ GtWrds
GtWrds _____ ____ ____ ____
(GtWrds UPLIM:word): word expr
+
+ _____ _____
Address of WRD, 0..UPLIM WORDS. (Allocate space for UPLIM
+ untraced words.)
+
+
+ GtVect
GtVect _____ ____ ____ ____
(GtVect UPLIM:word): word expr
+
+ ______ _____
Address of vector, UPLIM items. (Allocate space for a vector
+ _____
UPLIM items.)
PSL Manual 7 February 1983 Implementation
+section 21.7 page 21.9
+
+ GtFixN
GtFixN _ _______ ____
(GtFixN ): s-integer expr
+
+ Allocate space for a fixnum.
+
+
+ GtFltN
GtFltN _ _______ ____
(GtFltN ): s-integer expr
+
+ _____
Allocate space for a float.
+
+
+ GtID
GtID __ ____
(GtID ): id expr
+
+ __
Allocate a new id.
+
+
+ GtBps
GtBps _ _ _______ _ _______ ____
(GtBps N:s-integer): s-integer expr
+
+ _
Allocate N words for binary code.
+
+
+ GtWArray
GtWArray _ _ _______ _ _______ ____
(GtWArray N:s-integer): s-integer expr
+
+ _
Allocate N words for WVar/WArray/WString.
+
+
+ DelBps
DelBps ____
(DelBps ): expr
+
+
+ DelWArray
DelWArray ____
(DelWArray ): expr
+
+ GtBps GtWArray
GtBps GtWArray
GtBps NIL; returns the number of words left in BPS. GtWArray NIL returns
+the same quantity.
+
+ GtBps
GtBps
GtBps 0; returns a pointer to the bottom of BPS, that is, the current
+ GtWArray
GtWArray
value of NextBPS. GtWArray 0; returns a pointer to the top of BPS, the
+ DelBps
DelBps
current value of LastBPS. This is sometimes convenient for use with DelBps
+ DelWArray
DelWArray
and DelWArray.
+
+ GtBps
GtBps
GtBps N; returns a pointer to N words in BPS, moving NextBPS up by that
+ GtWArray
GtWArray
amount. GtWArray returns a pointer to (the bottom of) N words at the top
+of BPS, pushing LastBPS down by that amount. Remember that the arguments
+are number of WORDS to allocate, that is, 1/4 the number of bytes on the
+VAX or 68000.
+
+ DelBps
DelBps
DelBps(Lo, Hi) returns a block to BPS, if it is contiguous with the
+current free space. In other words, if Hi is equal to NextBPS, then
+NextBPS is set to Lo. Otherwise, NIL is returned and no space is added to
+ DelHeap DelBps
DelHeap DelBps
BPS. DelHeap(Lo, Hi) is similar in action to DelBps.
+
+ DelWArray
DelWArray
DelWArray(Lo, Hi) returns a block to the top of BPS, if it is contiguous
+with the current free space. In other words, if Lo is equal to LastBPS,
+then LastBPS is set to Hi. Otherwise, NIL is returned and no space is
Implementation 7 February 1983 PSL Manual
+page 21.10 section 21.7
+
+added to BPS.
+
+ The storage management routines above are intended for either very long
+term or very short term use. BPS is not examined by the garbage collector
+at all. The routines below should be used with great care, as they deal
+with the heap which must be kept in a consistent state for the garbage
+collector. All blocks of memory allocated in the heap must have header
+words describing the size and type of data contained, and all pointers into
+the heap must have type tags consistent with the data they refer to.
ADDED psl-1983/3-1/lpt/22-parser.lpt
Index: psl-1983/3-1/lpt/22-parser.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/22-parser.lpt
@@ -0,0 +1,1038 @@
+PSL Manual 7 February 1983 Parser Tools
+section 22.0 page 22.1
+
+ CHAPTER 22
CHAPTER 22
CHAPTER 22
+ PARSER TOOLS
PARSER TOOLS
PARSER TOOLS
+
+
+
+
+ 22.1. Introduction . . . . . . . . . . . . . . . 22.1
+ 22.2. The Table Driven Parser . . . . . . . . . . . 22.2
+ 22.2.1. Flow Diagram for the Parser. . . . . . . . 22.2
+ 22.2.2. Associating the Infix Operator with a Function . 22.4
+ 22.2.3. Precedences . . . . . . . . . . . . . 22.5
+ 22.2.4. Special Cases of 0 <-0 and 0 0. . . . . . . 22.5
+ 22.2.5. Parenthesized Expressions . . . . . . . . 22.5
+ 22.2.6. Binary Operators in General. . . . . . . . 22.6
+ 22.2.7. Assigning Precedences to Key Words . . . . . 22.7
+ 22.2.8. Error Handling . . . . . . . . . . . . 22.7
+ 22.2.9. The Parser Program for the RLISP Language . . . 22.7
+ 22.2.10. Defining Operators . . . . . . . . . . 22.8
+ 22.3. The MINI Translator Writing System. . . . . . . . 22.10
+ 22.3.1. A Brief Guide to MINI. . . . . . . . . . 22.10
+ 22.3.2. Pattern Matching Rules . . . . . . . . . 22.12
+ 22.3.3. A Small Example. . . . . . . . . . . . 22.12
+ 22.3.4. Loading Mini. . . . . . . . . . . . . 22.13
+ 22.3.5. Running Mini. . . . . . . . . . . . . 22.13
+ 22.3.6. MINI Error messages and Error Recovery . . . . 22.13
+ 22.3.7. MINI Self-Definition . . . . . . . . . . 22.13
+ 22.3.8. The Construction of MINI. . . . . . . . . 22.15
+ 22.3.9. History of MINI Development. . . . . . . . 22.16
+ 22.4. BNF Description of RLISP Using MINI . . . . . . . 22.17
+
+
+
+
+22.1. Introduction
22.1. Introduction
22.1. Introduction
+
+ In many applications, it is convenient to define a special
+"problem-oriented" language, tailored to provide a natural input format.
+Examples include the RLISP ALGOL-like surface language for algebraic work,
+graphics languages, boolean query languages for data-base, etc. Another
+ ________
important case is the requirement to accept existing programs in some
+language, either to translate them to another language, to compile to
+machine language, to be able to adapt existing code into the PSL
+environment (e.g. mathematical libraries, etc.), or because we wish to use
+PSL based tools to analyze a program written in another language. One
+approach is to hand-code a program in PSL (called a "parser") that
+translates the input language to the desired form; this is tedious and
+error prone, and it is more convenient to use a "parser-writing-tool".
+
+ In this Chapter we describe in detail two important parser writing tools
+available to the PSL programmer: an extensible table-driven parser that is
+used for the RLISP parser (described in Chapter 3), and the MINI parser
+generator. The table-driven parser is most useful for languages that are
Parser Tools 7 February 1983 PSL Manual
+page 22.2 section 22.1
+
+simple extensions of RLISP, or in fact for rapidly adding new syntactic
+constructs to RLISP. The MINI system is used for the development of more
+complete user languages.
+
+
+
+22.2. The Table Driven Parser
22.2. The Table Driven Parser
22.2. The Table Driven Parser
+
+ The parser is a top-down recursive descent parser, which uses a table of
+___________
Precedences to control the parse; if numeric precedence is not adequate,
+LISP functions may be inserted into the table to provide more control. The
+parser described here was developed by Nordstrom [Nordstrom 73], and is
+very similar to parser described by Pratt [Pratt 73], and apparently used
+for the CGOL language, another LISP surface language.
+
+ Scan Scan
Scan Scan
The parser reads tokens from an input stream using a function Scan. Scan
+ ChannelReadToken
ChannelReadToken
calls the ChannelReadToken function described in Chapter 12, and performs
+some additional checks, described below. Each token is defined to be one
+of the following:
+
+
+ non-operator O
+ right operator O->
+ binary operator <-O->
+
+
+ All combinations of . . .O-> O. . . and O <-O->. . . are supposed to be
+legal, while the combinations . . .O-> <-O->. . ., . . .<-O-> <-O->. . .
+and O O. . . are normally illegal (error ARG MISSING and error OP MISSING,
+respectively).
+
+ __
With each operator (which must be an id) is associated a construction
+function, a right precedence, and for binary operators, a left precedence.
+
+ The Unary Prefix operators have this information stored under the
+indicator 'RLISPPREFIX and Binary operators have it stored under
+'RLISPINFIX. (Actually, the indicator used at any time during parsing is
+the VALUE of GRAMPREFIX or GRAMINFIX, which may be changed by the user).
+
+
+22.2.1. Flow Diagram for the Parser
22.2.1. Flow Diagram for the Parser
22.2.1. Flow Diagram for the Parser
+
+ In this diagram RP stands for Right Precedence, LP for Left Precedence
+and CF for Construction Function. OP is a global variable which holds the
+current token.
PSL Manual 7 February 1983 Parser Tools
+section 22.2 page 22.3
+
+
+ procedure PARSE(RP);
+ RDRIGHT(RP,SCAN()); % SCAN reads next token
+
+ RDRIGHT(RP,Y)
+ |
+ \|/
+ |
+ ------------------------
+ | |yes
+ | Y is Right OP |-----> Y:=APPLY(Y.CF,
+ | | RDRIGHT(Y.RP));
+ ------------------------ .
+ | .
+ \|/ no .
+ | .
+ ------------------------ .
+ERROR yes| | no .
+ARG <----| Y is Binary OP |----> OP:= .
+MISSING | | SCAN(); .
+ ------------------------ . .
+ |--------<------------<------*
+ RDLEFT: \|/ ^
+ | ^
+ ------------------------ ^
+ERROR no| | ^
+ OP <----| OP is Binary | ^
+MISSING | | ^
+ ------------------------ ^
+ | ^
+ \|/ yes ^
+ | ^
+ ------------------------ ^
+RETURN yes| |no ^
+ (Y) <----| RP > OP.lp |---> Y:=APPLY(OP.cf,Y,
+ ------------------------ PARSE(OP.lp,SCAN());
Parser Tools 7 February 1983 PSL Manual
+page 22.4 section 22.2
+
+ This diagram reflects the major behavior, though some trivial additions
+are included in the RLISP case to handle cases such as OP-> <-OP, '!;, etc.
+[See PU:RLISP-PARSER.RED for full details.]
+
+ The technique involved may also be described by the following figure:
+
+
+ . . . 0-> Y <-0 . . .
+ rp lp
+
+
+ Y is a token or an already parsed expression between two operators (as
+indicated). If 0->'s RP is greater than <-0's LP, then 0-> is the winner
+and Y goes to 0->'s construction function (and vice versa). The result
+from the construction function is a "new Y" in another parse situation.
+
+ By associating precedences and construction functions with the operators,
+we are now able to parse arithmetic expressions (except for function calls)
+and a large number of syntactical constructions such as IF - THEN - ELSE
+- ; etc. The following discussion of how to expand the parser to cover a
+language such as RLISP (or ALGOL) may also be seen as general tools for
+handling the parser and defining construction functions and precedences.
+
+
+22.2.2. Associating the Infix Operator with a Function
22.2.2. Associating the Infix Operator with a Function
22.2.2. Associating the Infix Operator with a Function
+
+ Scan RAtomHook
Scan RAtomHook __ __
The Scan, after calling RAtomHook, checks ids and special ids (those with
+TOKTYPE!* = 3) to see if they should be renamed from external form to
+ Plus2
Plus2
internal form (e.g. '!+ to Plus2). This is done by checking for a NEWNAM
+ __ __
or NEWNAM!-OP property on the id. For special ids, the NEWNAM!-OP property
+is first checked. The value of the property is a replacement token, i.e.
+
+
+PUT('!+,'NEWNAM!-OP,'PLUS2)
+
+
+has been done.
+
+ Scan RlispRead
Scan RlispRead
Scan also handles the ' mark, calling RlispRead to get the S-expression.
+RlispRead Read
RlispRead Read
RlispRead is a version of Read, using a special SCANTABLE,
+RLISPREADSCANTABLE!*.
+
+ Scan
Scan
The function Scan also sets SEMIC!* to '!; or '!$ if CURSYM!* is detected
+to be '!*SEMICOL!* (the internal name for '!; and "!$). This controls the
+RLISP echo/no-echo capability. Finally, if the renamed token is 'COMMENT
+ ReadCh
ReadCh
then characters are ReadCh'd until a '!; or '!$ .
PSL Manual 7 February 1983 Parser Tools
+section 22.2 page 22.5
+
+22.2.3. Precedences
22.2.3. Precedences
22.2.3. Precedences
+
+ To set up precedences, it is often helpful to set up a precedence matrix
+of the operators involved. If any operator has one "precedence" with
+respect to one particular operator and another "precedence" with respect to
+some other, it is sometimes not possible to run the parser with just
+numbered precedences for the operators without introducing ambiguities. If
+this is the case, replace the number RP by the operator RP and test with
+something like:
+
+
+ IF RP *GREATER* OP . . .
+
+
+*GREATER* may check in the precedence matrix. An example in which such a
+scheme might be used is the case for which ALGOL uses ":" both as a label
+marker and as an index separator (although in this case there is no need
+for the change above). It is also a good policy to have even numbers for
+right precedences and odd numbers for left precedences (or vice versa).
+
+
+22.2.4. Special Cases of 0 <-0 and 0 0
22.2.4. Special Cases of 0 <-0 and 0 0
22.2.4. Special Cases of 0 <-0 and 0 0
+
+ If . . .0 0. . . is a legal case (i.e. F A may translate to (F A)),
+ERROR OP MISSING is replaced by:
+
+
+ Y:=REPCOM(Y,RDRIGHT(99,OP)); GO TO RDLEFT;
+
+
+The value 99 is chosen in order to have the first object (F) behave as a
+right operator with maximum precedence. If . . .0 <-0. . . is legal for
+some combinations of operators, replace ERROR ARG MISSING by something
+equivalent to the illegal RLISP statement:
+
+
+IF ISOPOP(OP,RP,Y)
+ THEN <<OP:=Y;
+ Y:=(something else, i.e. NIL);
+ GOTO RDLEFT>>
+ ELSE ERROR ARG MISSING;
+
+
+ISOPOP is supposed to return T if the present situation is legal.
+
+
+22.2.5. Parenthesized Expressions
22.2.5. Parenthesized Expressions
22.2.5. Parenthesized Expressions
+
+
+ (a) is to be translated to a.
+
+ E.g.
Parser Tools 7 February 1983 PSL Manual
+page 22.6 section 22.2
+
+ BEGIN a END translates to (PROG a).
+
+
+ Define "(" and BEGIN as right operators with low precedences (2 and -2
+respectively). Also define ")" and END as binary operators with matching
+left precedences (1 and -3 respectively). The construction functions for
+"(" and BEGIN are then something like: [See pu:RLISP-PARSER.RED for exact
+details on ParseBEGIN]
+
+
+BEGIN (X);PROG2(OP:=SCAN();MAKEPROG(X));
+"(" (X);PROG2(IF OP=') THEN OP:=SCAN()
+ ELSE ERROR, x);
+
+
+ Note that the construction functions in these cases have to read the next
+token; that is the effect of ")" closing the last "(" and not all earlier
+"("'s. This is also an example of binary operators declared only for the
+purpose of having a left precedence.
+
+
+22.2.6. Binary Operators in General
22.2.6. Binary Operators in General
22.2.6. Binary Operators in General
+
+ As almost all binary operators have a construction function like
+
+
+ LIST(OP,X,Y);
+
+
+it is assumed to be of that kind if no other is given. If OP is a binary
+operator, then "a OP b OP c" is interpreted as "(a OP b) OP c" only if OP's
+LP is less than OP's RP.
+
+ Example:
+
+
+ A + B + C translates to (A + B) + C
+ because +'RP = 20 and +'LP = 19
+
+ A ^ B ^ C translates to A ^ (B ^ C)
+ because ^'RP = 20 and ^'LP = 21
+
+
+ If you want some operators to translate to n-ary expressions, you have to
+define a proper construction function for that operator.
+
+ Example:
+
+
+PLUS (X,Y); IF CAR(X) = 'PLUS THEN NCONC(X,LIST(Y))
+ ELSE LIST('PLUS,X,Y);
PSL Manual 7 February 1983 Parser Tools
+section 22.2 page 22.7
+
+ By defining "," and ";" as ordinary binary operators, the parser
+automatically takes care of constructions like . . .e,e,e,e,e. . . and
+. . . stm;stm;stm;stm;. . . It is then up to some other operators to
+remove the "," or the ";" from the parsed result.
+
+
+22.2.7. Assigning Precedences to Key Words
22.2.7. Assigning Precedences to Key Words
22.2.7. Assigning Precedences to Key Words
+
+ If you want some operators to have control immediately, insert
+
+
+ IF RP = NIL THEN RETURN Y ELSE
+
+
+as the very first test in RDRIGHT and set the right precedence of those to
+NIL. This is sometimes useful for key-word expressions. If entering a
+construction function of such an operator, X is the token immediately after
+the operator. E.g.: We want to parse PROCEDURE EQ(X,Y); . . . Define
+PROCEDURE as a right operator with NIL as precedence. The construction
+function for PROCEDURE can always call the parser and set the rest of the
+expression. Note that if PROCEDURE was not defined as above, the parser
+would misunderstand the expression in the case of EQ as declared as a
+binary operator.
+
+
+22.2.8. Error Handling
22.2.8. Error Handling
22.2.8. Error Handling
+
+ For the present, if an error occurs a message is printed but no attempt
+is made to correct or handle the error. Mostly the parser goes wild for a
+while (until a left precedence less than current right precedence is found)
+and then goes on as usual.
+
+
+22.2.9. The Parser Program for the RLISP Language
22.2.9. The Parser Program for the RLISP Language
22.2.9. The Parser Program for the RLISP Language
+
+ SCAN();
+
+ The purpose of this function is to read the next token from the input
+stream. It uses the general purpose table driven token scanner described
+in Chapter 12, with a specially set up ReadTable, RLISPSCANTABLE!*. As
+ Scan
__________ Scan
RLISP has multiple identifiers for the same operators, Scan uses the
+following translation table:
+ = EQUAL >= GEQ
+ + PLUS > GREATERP
+ - DIFFERENCE <= LEQ
+ / QUOTIENT < LESSP
+ . CONS * TIMES
+ := SETQ ** EXPT
+
+
+ Scan
Scan
In these cases, Scan returns the right hand side of the table values.
+ Scan
Scan
Also, two special cases are taken care of in Scan:
Parser Tools 7 February 1983 PSL Manual
+page 22.8 section 22.2
+
+ a. ' is the QUOTE mark. If a parenthesized expression follows '
+ then the syntax within the parenthesis is that of LISP, using a
+ special scan table, RLISPREADSCANTABLE!*. The only major
+ difference from ordinary LISP is that ! is required for all
+ special characters.
+
+ b. ! in RLISP means actually two things:
+
+
+ i. the following symbol is not treated as a special symbol
+ (but belongs to the print name of the atom in process);
+
+ ii. the atom created cannot be an operator.
+
+
+ Example: !( in the text behaves as the atom "(".
+
+ To signal to the parser that this is the case, the flag variable ESCAPEFL
+must be set to T if this situation occurs.
+
+
+22.2.10. Defining Operators
22.2.10. Defining Operators
22.2.10. Defining Operators
+
+ To define operators use:
+
+
+DEFINEROP(op,p{,stm});
+ For right or prefix operators.
+
+DEFINEBOP(op,lp,rp{,stm});
+ For binary operators.
+
+
+ These use the VALUE of DEFPREFIX and DEFINFIX to store the precedences
+and construction functions. The default is set for RLISP, to be
+ __________
'RLISPPREFIX and 'RLISPINFIX. The same identifier can be defined both as
+the right and binary operator. The context defines which one applies.
+
+ Stm is the construction function. If stm is omitted, the common defaults
+are used:
+
+
+LIST(OP,x)
+ prefix case, x is parsed expression following,
+ x=RDRIGHT(p,SCAN()).
+
+LIST(OP,x,y)
+ binary case, x is previously parsed expression, y is expression
+ following, y=RDRIGHT(rp,SCAN()).
+
+
+ __
If stm is an id, it is assumed to be a procedure of one or two arguments,
PSL Manual 7 February 1983 Parser Tools
+section 22.2 page 22.9
+
+for "x" or "x,y". If it is an expression, it is embedded as
+(LAMBDA(X) stm) or (LAMBDA(X Y) stm), and should refer to X and Y, as
+needed.
+
+ Also remember that the free variable OP holds the last token (normally
+the binary operator which stopped the parser). If "p" or "rp" is NIL,
+RDRIGHT is not called by default, so that only SCAN() (the next token) is
+passed.
+
+
+For example,
+
+DEFINEBOP('DIFFERENCE,17,18);
+ % Most common case, left associative, stm=LIST(OP,x,y);
+
+DEFINEBOP('CONS,23,21);
+ % Right Associative, default stm=LIST(OP,x,y)
+
+DEFINEBOP('AND,11,12,ParseAND);
+ % Left Associative, special function
+ PROCEDURE ParseAND(X,Y);
+ NARY('AND,X,Y);
+
+DEFINEBOP('SETQ,7,6,ParseSETQ);
+ % Right Associative, Special Function
+ PROCEDURE ParseSETQ(LHS,RHS);
+ LIST(IF ATOM LHS THEN 'SETQ ELSE 'SETF, LHS, RHS);
+
+DEFINEROP('MINUS,26); % default C-fn, just (list OP arg)
+
+DEFINEROP('PLUS,26,ParsePLUS1); %
+
+DEFINEROP('GO,NIL,ParseGO );
+ % Special Function, DO NOT use default PARSE ahead
+ PROCEDURE ParseGO X; X is now JUST next-token
+ IF X EQ 'TO THEN LIST('GO,PARSE0(6,T))
+ % Explicit Parse ahead
+ ELSE <<OP := SCAN(); % get Next Token
+ LIST('GO,X)>>;
+
+DEFINEROP('GOTO,NIL,ParseGOTO );
+ % Suppress Parse Ahead, just pass NextToken
+ PROCEDURE ParseGOTO X;
+ <<OP := SCAN();
+ LIST('GO,X)>>;
Parser Tools 7 February 1983 PSL Manual
+page 22.10 section 22.3
+
+22.3. The MINI Translator Writing System
22.3. The MINI Translator Writing System
22.3. The MINI Translator Writing System
+
+ Note that MINI is now autoloading.
+
+
+22.3.1. A Brief Guide to MINI
22.3.1. A Brief Guide to MINI
22.3.1. A Brief Guide to MINI
+
+ The following is a brief introduction to MINI, the reader is referred
+to [Marti 79] for a more detailed discussion of the META/RLISP operators,
+which are very similar to those of MINI.
+
+ The MINI system reads in a definition of a translator, using a BNF-like
+form. This is processed by MINI into a set of LISP functions, one for each
+production, which make calls on each other, and a set of support routines
+that recognize a variety of simple constructs. MINI uses a stack to
+perform parsing, and the user can access sub-trees already on the stack,
+replacing them by other trees built from these sub-trees. The primitive
+ __ _______
functions that recognize ids, integers, etc. each place their recognized
+token on this stack.
+
+ For example,
+
+
+ FOO: ID '!- ID +(PLUS2 #2 #1) ;
+
+
+defines a rule FOO, which recognizes two identifiers separated by a minus
+ __________
sign (each ID pushes the recognized identifier onto the stack). The last
+expression replaces the top 2 elements on the stack (#2 pops the first ID
+pushed onto the stack, while #1 pops the other) with a LISP statement.
+
+
+ Id
Id _______ ____
(Id ): boolean expr
+
+ __________
See if current token is an identifier and not a keyword. If it
+ is, then push onto the stack and fetch the next token.
+
+
+ AnyId
AnyId _______ ____
(AnyId ): boolean expr
+
+ __
See if current token is an id whether or not it is a key word.
+
+
+ AnyTok
AnyTok _______ ____
(AnyTok ): boolean expr
+
+ Always succeeds by pushing the current token onto the stack.
+
+
+ Num
Num _______ ____
(Num ): boolean expr
+
+ ______
Tests to see if the current token is a number, if so it pushes
+ ______
the number onto the stack and fetches the next token.
PSL Manual 7 February 1983 Parser Tools
+section 22.3 page 22.11
+
+ Str
Str _______ ____
(Str ): boolean expr
+
+ Num
Num ______
Same as Num, except for strings.
+
+ Specification of a parser using MINI consists of defining the syntax with
+BNF-like rules and semantics with LISP expressions. The following is a
+brief list of the operators:
+
+
+' Used to designate a terminal symbol (i.e. 'WHILE, 'DO, '!=).
+
+Identifier
+ Specifies a nonterminal.
+
+( ) Used for grouping (i.e. (FOO BAR) requires rule FOO to parse
+ followed immediately by BAR).
+
+< > Optional parse, if it fails then continue (i.e. <FOO> tries to
+ parse FOO).
+
+/ Optional rules (i.e. FOO / BAR allows either FOO or BAR to parse,
+ with FOO tested first).
+
+STMT* Parse any number of STMT.
+
+STMT[ANYTOKEN]*
+ Parse any number of STMT separated by ANYTOKEN, create a list and
+ __________
push onto the stack (i.e. ID[,]* parses a number of identifiers
+ separated by commas, like in an argument list).
+
+ _______
##n Refer to the nth stack location (n must be an integer).
+
+ _______
#n Pop the nth stack location (n must be an integer).
+
++(STMT) Push the unevaluated (STMT) onto the stack.
+
+.(SEXPR) Evaluate the SEXPR and ignore the result.
+
+=(SEXPR) Evaluate the SEXPR and test if result non-NIL.
+
++.(SEXPR) Evaluate the SEXPR and push the result on the stack.
+
+@ANYTOKEN Specifies a statement terminator; used in the error recovery
+ mechanism to search for the occurrence of errors.
+
+@@ANYTOKEN
+ Grammar terminator; also stops scan, but if encountered in
+ error-recovery, terminates grammar.
Parser Tools 7 February 1983 PSL Manual
+page 22.12 section 22.3
+
+22.3.2. Pattern Matching Rules
22.3.2. Pattern Matching Rules
22.3.2. Pattern Matching Rules
+
+ In addition to the BNF-like rules that define procedures with 0 arguments
+and which scan tokens by calls on NEXT!-TOK() and operate on the stack,
+MINI also includes a simple TREE pattern matcher and syntax to define
+PatternProcedures that accept and return a single argument, trying a series
+of patterns until one succeeds.
+
+
+E.g. template -> replacement
+
+PATTERN = (PLUS2 &1 0) -> &1,
+ (PLUS2 &1 &1) -> (LIST 'TIMES2 2 &1),
+ &1 -> &1;
+
+
+defines a pattern with 3 rules. &n is used to indicate a matched sub-tree
+in both the template and replacement. A repeated &n, as in the second
+ Equal
Equal
rule, requires Equal sub-trees.
+
+
+22.3.3. A Small Example
22.3.3. A Small Example
22.3.3. A Small Example
+
+
+% A simple demo of MINI, to produce a LIST-NOTATION reader.
+% INVOKE 'LSPLOOP reads S-expressions, separated by ;
+
+mini 'lsploop; % Invoke MINI, give name of ROOT
+ % Comments can appear anywhere,
+ % prefix by % to end-of-line
+lsploop:lsp* @@# ; % @@# is GRAMMAR terminator
+ % like '# but stops TOKEN SCAN
+lsp: sexp @; % @; is RULE terminator, like ';
+ .(print #1) % but stops SCAN, to print
+ .(next!-tok) ; % so call NEXT!-TOK() explicitly
+sexp: id / num / str / '( dotexp ') ;
+dotexp: sexp* < '. sexp +.(attach #2 #1) > ;
+fin
+
+symbolic procedure attach(x,y);
+<<for each z in reverse x do y:=z . y; y>>;
+
+
+22.3.4. Loading Mini
22.3.4. Loading Mini
22.3.4. Loading Mini
+
+ MINI is loaded from PH: using LOAD MINI;.
PSL Manual 7 February 1983 Parser Tools
+section 22.3 page 22.13
+
+22.3.5. Running Mini
22.3.5. Running Mini
22.3.5. Running Mini
+
+ Invoke
Invoke
A MINI grammar is run by calling Invoke rootname;. This installs
+appropriate Key Words (stored on the property list of rootname), and start
+the grammar by calling the Rootname as first procedure.
+
+
+22.3.6. MINI Error messages and Error Recovery
22.3.6. MINI Error messages and Error Recovery
22.3.6. MINI Error messages and Error Recovery
+
+ If MINI detects a non-fatal error, a message be printed, and the current
+token and stack is shown. MINI then calls NEXT!-TOK() repeatedly until
+either a statement terminator (@ANYTOKEN) or grammar terminator (@ANYTOKEN)
+is seen. If a grammar terminator, the grammar is exited; otherwise parsing
+resumes from the ROOT.
+
+ [??? Interaction with BREAK loop rather poor at the moment ???]
[??? Interaction with BREAK loop rather poor at the moment ???]
[??? Interaction with BREAK loop rather poor at the moment ???]
+
+
+22.3.7. MINI Self-Definition
22.3.7. MINI Self-Definition
22.3.7. MINI Self-Definition
+
+
+% The following is the definition of the MINI meta system in terms of
+% itself. Some support procedures are needed, and exist in a
+% separate file.
+% To define a grammar, call the procedure MINI with the argument
+% being the root rule name. Then when the grammar is defined it may
+% be called by using INVOKE root rule name.
+
+% The following is the MINI Meta self definition.
+
+MINI 'RUL;
+
+% Define the diphthongs to be used in the grammar.
+DIP: !#!#, !-!>, !+!., !@!@ ;
+
+% The root rule is called RUL.
+RUL: ('DIP ': ANYTOK[,]* .(DIPBLD #1) '; /
+ (ID .(SETQ !#LABLIST!# NIL)
+ ( ': ALT +(DE #2 NIL #1) @; /
+ '= PRUL[,]* @; .(RULE!-DEFINE '(PUT(QUOTE ##2)(QUOTE RB)
+ (QUOTE #1)))
+ +(DE ##1 (A)
+ (RBMATCH A (GET (QUOTE #1) (QUOTE RB))
+ NIL)))
+ .(RULE!-DEFINE #1) .(NEXT!-TOK) ))* @@FIN ;
+
+% An alternative is a sequence of statements separated by /'s;
+ALT: SEQ < '/ ALT +(OR #2 #1) >;
+
+% A sequence is a list of items that must be matched.
+SEQ: REP < SEQ +(AND #2 (FAIL!-NOT #1)) >;
Parser Tools 7 February 1983 PSL Manual
+page 22.14 section 22.3
+
+% A repetition may be 0 or more single items (*) or 0 or more items
+% separated by any token (ID[,]* parses a list of ID's separated
+% by ,'s.
+REP: ONE
+ <'[ (ID +(#1) /
+ '' ANYKEY +(EQTOK!-NEXT (QUOTE #1)) /
+ ANYKEY +(EQTOK!-NEXT (QUOTE #1))) '] +(AND #2 #1) '* BLD!-EXPR /
+ '* BLD!-EXPR>;
+
+% Create an sexpression to build a repetition.
+BLD!-EXPR: +(PROG (X) (SETQ X (STK!-LENGTH))
+ $1 (COND (#1 (GO $1)))
+ (BUILD!-REPEAT X)
+ (RETURN T));
+
+ANYKEY: ANYTOK .(ADDKEY ##1) ; % Add a new KEY
+
+% One defines a single item.
+ONE: '' ANYKEY +(EQTOK!-NEXT (QUOTE #1)) /
+ '@ ANYKEY .(ADDRTERM ##1) +(EQTOK (QUOTE #1)) /
+ '@@ ANYKEY .(ADDGTERM ##1) +(EQTOK (QUOTE #1)) /
+ '+ UNLBLD +(PUSH #1) /
+ '. EVLBLD +(PROGN #1 T) /
+ '= EVLBLD /
+ '< ALT '> +(PROGN #1 T) /
+ '( ALT ') /
+ '+. EVLBLD +(PUSH #1) /
+ ID +(#1) ;
+
+% This rule defines an un evaled list. It builds a list with
+% everything quoted.
+UNLBLD: '( UNLBLD ('. UNLBLD ') +(CONS #2 #1) /
+ UNLBLD* ') +(LIST . (#2 . #1)) /
+ ') +(LIST . #1)) /
+ LBLD /
+ ID +(QUOTE #1) ;
+
+% EVLBLD builds a list of evaled items.
+EVLBLD: '( EVLBLD ('. EVLBLD ') +(CONS #2 #1) /
+ EVLBLD* ') +(#2 . #1) /
+ ') ) /
+ LBLD /
+ ID ;
+
+LBLD: '# NUM +(EXTRACT #1) /
+ '## NUM +(REF #1) /
+ '$ NUM +(GENLAB #1) /
+ '& NUM +(CADR (ASSOC #1 (CAR VARLIST))) /
+ NUM /
+ STR /
+ '' ('( UNLBLD* ') +(LIST . #1) /
+ ANYTOK +(QUOTE #1));
PSL Manual 7 February 1983 Parser Tools
+section 22.3 page 22.15
+
+
+% Defines the pattern matching rules (PATTERN -> BODY).
+PRUL: .(SETQ INDEXLIST!* NIL)
+ PAT '-> (EVLBLD)*
+ +(LAMBDA (VARLIST T1 T2 T3) (AND . #1))
+ .(SETQ PNAM (GENSYM))
+ .(RULE!-DEFINE (LIST 'PUTD (LIST 'QUOTE PNAM)
+ '(QUOTE EXPR) (LIST 'QUOTE #1)))
+ +.(CONS #1 PNAM);
+
+% Defines a pattern.
+% We now allow the . operator to be the next to last in a ().
+PAT: '& ('< PSIMP[/]* '> NUM
+ +.(PROGN (SETQ INDEXLIST!* (CONS ##1 INDEXLIST!*))
+ (LIST '!& #2 #1) ) /
+ NUM
+ +.(COND ((MEMQ ##1 INDEXLIST!*)
+ (LIST '!& '!& #1))
+ (T (PROGN (SETQ INDEXLIST!* (CONS ##1 INDEXLIST!*))
+ (LIST '!& #1)))) )
+ / ID
+ / '!( PAT* <'. PAT +.(APPEND #2 #1)> '!)
+ / '' ANYTOK
+ / STR
+ / NUM ;
+
+% Defines the primitives in a pattern.
+PSIMP: ID / NUM / '( PSIMP* ') / '' ANYTOK;
+
+% The grammar terminator.
+FIN
+
+
+
+22.3.8. The Construction of MINI
22.3.8. The Construction of MINI
22.3.8. The Construction of MINI
+
+ MINI is actually described in terms of a support package for any
+MINI-generated parser and a self-description of MINI. The useful files (on
+PU: and PL:) are as follows:
+
+
+MINI.MIN The self definition of MINI in MINI.
+MINI.SL A Standard LISP version of MINI.MIN, translated by MINI itself.
+MINI.RED The support RLISP for MINI.
+MINI-PATCH.RED and MINI.FIX
+ Some additions being tested.
+MINI.LAP The precompiled LAP file. Use LOAD MINI.
+MINI-LAP-BUILD.CTL
+ A batch file that builds PL:MINI.LAP from the above files.
+MINI-SELF-BUILD.CTL
+ A batch file that builds the MINI.SL file by loading and
+ translating MINI.MIN.
Parser Tools 7 February 1983 PSL Manual
+page 22.16 section 22.3
+
+22.3.9. History of MINI Development
22.3.9. History of MINI Development
22.3.9. History of MINI Development
+
+ The MINI Translator Writing System was developed in two steps. The first
+was the enhancement of the META/RLISP [Marti 79] system with the definition
+of pattern matching primitives to aid in describing and performing
+tree-to-tree transformations. META/RLISP is very proficient at translating
+an input programming language into LISP or LISP-like trees, but did not
+have a good method for manipulating the trees nor for direct generation of
+target machine code. PMETA (as it was initially called) [Kessler 79]
+solved these problems and created a very good environment for the
+development of compilers. In fact, the PMETA enhancements have been fully
+integrated into META/RLISP.
+
+ The second step was the elimination of META/RLISP and the development of
+a smaller, faster system (MINI). Since META/RLISP was designed to provide
+maximum flexibility and full generality, the parsers that is creates are
+large and slow. One of its most significant problems is that it uses its
+own single character driven LISP functions for token scanning and
+recognition. Elimination of this overhead has produced a faster
+translator. MINI uses the hand coded scanner in the underlying RLISP. The
+other main aspect of MINI was the elimination of various META/RLISP
+features to decrease the size of the system (also decreasing the
+flexibility, but MINI has been successful for the various purposes in COG).
+MINI is now small enough to run on small LISP systems (as long as a token
+scanner is provided). The META/RLISP features that MINI has changed or
+eliminated include the following:
+
+
+ a. The ability to backup the parser state upon failure is supported
+ in META/RLISP. However, by modifying a grammar definition, the
+ need for backup can be mostly avoided and was therefore
+ eliminated from MINI.
+
+ b. META/RLISP has extensive mechanisms to allow arbitrary length
+ diphthongs. MINI only supports two character diphthongs,
+ declared prior to their use.
+
+ c. The target machine language and error specification operators
+ are not supported because they can be implemented with support
+ routines.
+
+ d. RLISP subsyntax for specification of semantic operations is not
+ supported (only LISP is provided).
+
+
+Although MINI lacks many of the features of META/RLISP, it still has been
+quite sufficient for a variety of languages.
PSL Manual 7 February 1983 Parser Tools
+section 22.4 page 22.17
+
+22.4. BNF Description of RLISP Using MINI
22.4. BNF Description of RLISP Using MINI
22.4. BNF Description of RLISP Using MINI
+
+ The following formal scheme for the translation of RLISP syntax to LISP
+syntax is presented to eliminate misinterpretation of the definitions. We
+have used the above MINI syntactic form since it is close enough to BNF and
+has also been checked mechanically.
+
+ Recall that the transformation scheme produces an S-expression
+corresponding to the input RLISP expression. A rule has a name by which it
+is known and is defined by what follows the meta symbol :. Each rule of
+the set consists of one or more "alternatives" separated by the meta symbol
+/, being the different ways in which the rule is matched by source text.
+Each rule ends with a ;. Each alternative is composed of a "recognizer"
+and a "generator". The "generator" is a MINI + expression which builds an
+S-expression from constants and elements loaded on the stack. The result
+is then loaded on the stack. The #n and ##n refer to elements loaded by
+MINI primitives or other rules. The "generator" is thus a template into
+which previously generated items are substituted. Recall that terminals in
+both recognizer and generator are quoted with a ' mark.
+
+ This RLISP/SYSLISP syntax is based on a series of META and MINI
+definitions, started by R. Loos in 1970, continued by M. Griss, R. Kessler
+and A. Wang.
+
+ [??? This MINI.RLISP grammar is a bit out of date ???]
[??? This MINI.RLISP grammar is a bit out of date ???]
[??? This MINI.RLISP grammar is a bit out of date ???]
+
+
+ [??? Need to confirm for latest RLISP ???]
[??? Need to confirm for latest RLISP ???]
[??? Need to confirm for latest RLISP ???]
+
+
+
+mini 'rlisp;
+
+dip: !: , !<!< , !>!> , !:!= , !*!* , !<!= , !>!= , !' , !#!# ;
+
+termin: '; / '$ ; % $ used to not echo result
+rtermin: @; / @$ ;
+
+rlisp: ( cmds rtermin .(next!-tok) )* ; % Note explicit Scan
+
+cmds: procdef / rexpr ;
+
+%------ Procedure definition:
+
+procdef: emodeproc (ftype procs/ procs) /
+ ftype procs / procs ;
+
+ftype: 'fexpr .(setq FTYPE!* 'fexpr) / % function type
+ 'macro .(setq FTYPE!* 'macro) /
+ 'smacro .(setq FTYPE!* 'smacro) /
+ 'nmacro .(setq FTYPE!* 'nmacro) /
+ ('expr / =T) .(setq FTYPE!* 'expr) ;
Parser Tools 7 February 1983 PSL Manual
+page 22.18 section 22.4
+
+
+
+emodeproc: 'syslsp .(setq EMODE!* 'syslsp)/
+ ('lisp/'symbolic/=T) .(setq EMODE!* 'symbolic) ;
+
+
+procs: 'procedure id proctail
+ +(putd (quote #2) (quote FTYPE!* ) #1) ;
+
+proctail: '( id[,]* ') termin rexpr +(quote (lambda #2 #1)) /
+ termin rexpr +(quote (lambda nil #1)) /
+ id termin rexpr +(quote (lambda (#2) #1)) ;
+
+%------ Rexpr definition:
+
+rexpr: disjunction ;
+
+disjunction: conjunction (disjunctail / =T) ;
+
+disjunctail: ('or conjunction ('or conjunction)*)
+ +.(cons 'or (cons #3 (cons #2 #1))) ;
+
+conjunction: negation (conjunctail / =T) ;
+
+conjunctail: ('and negation ('and negation)*)
+ +.(cons (quote and) (cons #3 (cons #2 #1))) ;
+
+negation: 'not negation +(null #1) /
+ 'null negation +(null #1) /
+ relation ;
+
+relation: term reltail ;
+
+reltail: relop term +(#2 #2 #1) / =T ;
+
+term: ('- factor +(minus #1) / factor) termtail ;
+
+termtail: (plusop factor +(#2 #2 #1) termtail) / =T ;
+
+factor: powerexpr factortail ;
+
+factortail: (timop powerexpr +(#2 #2 #1) factortail) / =T ;
+
+powerexpr: dotexpr powtail ;
+
+powtail: ('** dotexpr +(expt #2 #1) powtail) / =T ;
+
+dotexpr: primary dottail ;
+
+dottail: ('. primary +(cons #2 #1) dottail) / =T ;
+
+primary: ifstate / groupstate / beginstate /
PSL Manual 7 February 1983 Parser Tools
+section 22.4 page 22.19
+
+ whilestate / repeatstate / forstmts /
+ definestate / onoffstate / lambdastate /
+ ('( rexpr ') ) /
+ ('' (lists / id / num) +(quote #1)) /
+ id primtail / num ;
+
+primtail:(':= rexpr +(setq #2 #1)) /
+ (': labstmts ) /
+ '( actualst / (primary +(#2 #1)) / =T ;
+
+lists: '( (elements)* ') ;
+
+elements: lists / id / num ;
+
+%------ If statement:
+
+ifstate: 'if rexpr 'then rexpr elserexpr
+ +(cond (#3 #2) (T #1)) ;
+
+elserexpr: 'else rexpr / =T +nil ;
+
+%------ While statement:
+
+whilestate: 'while rexpr 'do rexpr
+ +(while #2 #1) ;
+
+%----- Repeat statement:
+
+repeatstate: 'repeat rexpr 'until rexpr
+ +(repeat #2 #1) ;
+
+%---- For statement:
+
+forstmts: 'for fortail ;
+
+fortail: ('each foreachstate) / forstate ;
+
+foreachstate: id inoron rexpr actchoice rexpr
+ +(foreach #5 #4 #3 #2 #1) ;
+
+inoron: ('in +in / 'on +on) ;
+
+actchoice: ('do +do / 'collect +collect / 'conc +conc) ;
+
+forstate: id ':= rexpr loops ;
+
+loops: (': rexpr types rexpr
+ +(for #5 (#4 1 #3) #2 #1) ) /
+ ('step rexpr 'until rexpr types rexpr
+ +(for #6 (#5 #4 #3) #2 #1) ) ;
+
+types: ('do +do / 'sum +sum / 'product +product) ;
Parser Tools 7 February 1983 PSL Manual
+page 22.20 section 22.4
+
+
+%----- Function call parameter list:
+
+actualst: ') +(#1) / rexpr[,]* ') +.(cons #2 #1) ;
+
+%------ Compound group statement:
+
+groupstate: '<< rexprlist '>> +.(cons (quote progn) #1) ;
+
+%------ Compound begin-end statement:
+
+beginstate: 'begin blockbody 'end ;
+
+blockbody: decllist blockstates
+ +.(cons (quote prog) (cons #2 #1)) ;
+
+decllist: (decls[;]* +.(flatten #1)) / (=T +nil) ;
+
+decls: ('integer / 'scalar) id[,]* ;
+
+blockstates: labstmts[;]* ;
+
+labstmts: ('return rexpr +(return #1)) /
+ (('goto / 'go 'to) id +(go #1)) /
+ ('if rexpr 'then labstmts blkelse
+ +(cond (#3 #2) (T #1))) /
+ rexpr ;
+
+blkelse: 'else labstmts / =T +nil ;
+
+rexprlist: rexpr [;]* ;
+
+lambdastate: 'lambda lamtail ;
+
+lamtail: '( id[,]* ') termin rexpr +(lambda #2 #1) /
+ termin rexpr +(lambda nil #1) /
+ id termin rexpr +(lambda (#2) #1) ;
+
+%------ Define statement: (id and value are put onto table
+% named DEFNTAB:
+
+definestate: 'define delist +.(cons (quote progn) #1) ;
+
+delist: (id '= rexpr +(put (quote #2) (quote defntab)
+ (quote #1)))[,]* ;
+
+%------ On or off statement:
+
+onoffstate: ('on +T / 'off +nil) switchlists ;
+
+switchlists: 'defn +(set '!*defn #1) ;
PSL Manual 7 February 1983 Parser Tools
+section 22.4 page 22.21
+
+timop: ('* +times / '/ +quotient) ;
+
+plusop: ('+ +plus2 / '- +difference) ;
+
+relop: ('< +lessp / '<= +lep / '= +equal /
+ '>= +gep / '> +greaterp) ;
+
+
+FIN
ADDED psl-1983/3-1/lpt/23-biblio.lpt
Index: psl-1983/3-1/lpt/23-biblio.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/23-biblio.lpt
@@ -0,0 +1,209 @@
+PSL Manual 14 January 1983 Bibliography
+section 23.0 page 23.1
+
+ CHAPTER 23
CHAPTER 23
CHAPTER 23
+ BIBLIOGRAPHY
BIBLIOGRAPHY
BIBLIOGRAPHY
+
+ The following books and articles either are directly referred to in the
+manual text, or will be helpful for supplementary reading.
+
+[Allen 79] Allen, J. R.
+ ___ _______ __ ____
The Anatomy of LISP.
+ McGraw-Hill, New York, New York, 1979.
+
+[Baker 78] Baker, H. G.
+ Shallow Binding in LISP 1.5.
+ ____
CACM 21(7):565, July, 1978.
+
+[Benson 81] Benson, E. and Griss, M. L.
+ _______ _ ________ ____ _____ _______ ______________
SYSLISP: A Portable LISP Based Systems Implementation
+ ________
Language.
+ Utah Symbolic Computation Group Report UCP-81, University
+ of Utah, Department of Computer Science, February,
+ 1981.
+
+[Bobrow 76] Bobrow, R. J.; Burton, R. R.; Jacobs, J. M.; and Lewis, D.
+ ___ ____ ______ _______
UCI LISP MANUAL (revised).
+ Online Manual RS:UCLSP.MAN, University of California,
+ Irvine, ??, 1976.
+
+[Charniak 80] Charniak, E.; Riesbeck, C. K.; and McDermott, D. V.
+ __________ ____________ ___________
Artificial Intelligence Programming.
+ Lawrence Erlbaum Associates, Hillsdale, New Jersey, 1980.
+
+[Fitch 77] Fitch, J. and Norman, A.
+ Implementing LISP in a High Level Language.
+ ________ ________ ___ __________
Software: Practise and Experience 7:713-xx, 1977.
+
+[Foderaro 81] Foderaro, J. K. and Sklower, K. L.
+ ___ _____ ____ ______
The Franz LISP Manual
+ 1981.
+
+[Frick 78] Frick, I. B.
+ ______ ___ ________ ____ __ ___ _________ __ ___ __
Manual for Standard LISP on the DECSYSTEM 10 and 20.
+ Utah Symbolic Computation Group Technical Report TR-2,
+ University of Utah, Department of Computer Science,
+ July, 1978.
+
+[Griss 77a] Griss, M. L.
+ ___ _ ________ ______________ ________ ___ ____ ____
BIL: A Portable Implementation Language for LISP-Like
+ _______
Systems.
+ Utah Symbolic Computation Group Opnote No. 36, University
+ of Utah, Department of Computer Science, 1977.
Bibliography 14 January 1983 PSL Manual
+page 23.2 section 23.0
+
+[Griss 77b] Griss, M. L. and Swanson, M. R.
+ MBALM/1700 : A Micro-coded LISP Machine for the Burroughs
+ B1726.
+ ___________ __ _____ __ ___
In Proceedings of Micro-10 ACM, pages 15. ACM, 1977.
+
+[Griss 78a] Griss, M. L. and Kessler, R. R.
+ REDUCE 1700: A Micro-coded Algebra System.
+ ___________ __ ___ ____ ______ ________________
In Proceedings of The 11th Annual Microprogramming
+ ________
Workshop, pages 130-138. IEEE, November, 1978.
+
+[Griss 78b] Griss, M. L.
+ _____ ___ _ ________ ____ ___________
MBALM/BIL: A Portable LISP Interpreter.
+ Utah Symbolic Computation Group Opnote No. 38, University
+ of Utah, Department of Computer Science, 1978.
+
+[Griss 79a] Griss, M. L.; Kessler, R. R.; and Maguire, G. Q. Jr.
+ TLISP - A Portable LISP Implemented in P-code.
+ ___________ __ _______ __
In Proceedings of EUROSAM 79, pages 490-502. ACM, June,
+ 1979.
+
+[Griss 79b] Griss, M. L. and Kessler, R. R.
+ _ _______________ ______________ __ ____ ___ ______ __ ___
A Microprogrammed Implementation of LISP and REDUCE on the
+ _________ _____ _____ ________
Burroughs B1700/B1800 Computer.
+ Utah Symbolic Computation Group Report UCP 70, University
+ of Utah, Department of Computer Science, 1979.
+
+[Griss 81] Griss, M. L. and Hearn, A. C.
+ A Portable LISP Compiler.
+ ________ ________ ___ __________
Software - Practice and Experience 11:541-605, June, 1981.
+
+[Griss 82] Griss, M. L.; Benson. E.; and Hearn, A. C.
+ Current Status of a Portable LISP Compiler.
+ ___________ __ ___ _______ ____ _________ __ ________
In Proceedings of the SIGPLAN 1982 Symposium on Compiler
+ ____________
Construction, pages 276-283. ACM SIGPLAN, June, 1982.
+ Also: Utah Symbolic Computation Group, Report UCP-82.
+
+[Harrison 73] Harrison, M. C.
+ ____ __________ ___ ___________
Data structures and Programming.
+ Scott, Foresman and Company, Glenview, Illinois, 1973.
+
+[Harrison 74] Harrison, M. C.
+ A Language Oriented Instruction Set for BALM.
+ ___________ __ _______ ________ _
In Proceedings of SIGPLAN/SIGMICRO 9, pages 161. ACM,
+ 1974.
+
+[Hearn 66] Hearn, A. C.
+ Standard LISP.
+ _______ _______ _______
SIGPLAN Notices Notices 4(9):xx, September, 1966.
+ Also Published in SIGSAM Bulletin, ACM Vol. 13, 1969,
+ p. 28-49. .
PSL Manual 14 January 1983 Bibliography
+section 23.0 page 23.3
+
+[Hearn 73] Hearn, A. C.
+ ______ _ _____ ______
REDUCE 2 Users Manual.
+ Utah Symbolic Computation Group Report UCP-19, University
+ of Utah, Department of Computer Science, 1973.
+
+[Kessler 79] Kessler, R. R.
+ _____ _______ ________ ____ ______
PMETA - Pattern Matching META/REDUCE.
+ Utah Symbolic Computation Group Opnote No. 40, University
+ of Utah, Department of Computer Science, January, 1979.
+
+[Lefaivre 78] Lefaivre, R.
+ _______ ___ ____ ______
RUTGERS/UCI LISP MANUAL.
+ Online Manual, RS:RUTLSP.MAN, Rutgers University,
+ Computer Science Department, May, 1978.
+
+[LISP360 xx] xx.
+ ____ ___ _________ ______
LISP/360 Reference Manual.
+ Technical Report, Stanford Centre for Information
+ Processing, Stanford University, xx.
+
+[MACLISP 76] xx.
+ _______ _________ ______
MACLISP Reference Manual.
+ Technical Report, MIT, March, 1976.
+
+[Marti 79] Marti, J. B., et al.
+ Standard LISP Report.
+ _______ _______
SIGPLAN Notices 14(10):48-68, October, 1979.
+
+[McCarthy 73] McCarthy, J. C. et al.
+ ____ _ _ __________ _ ______
LISP 1.5 Programmer's Manual.
+ M.I.T. Press, 1973.
+ 7th Printing January 1973.
+
+[Moore 76] J. Strother Moore II.
+ ___ _________ _______ _______ _____________
The INTERLISP Virtual Machine Specification.
+ CSL 76-5, Xerox, Palo Alto Research Center, 3333 Coyote
+ Road,etc, September, 1976.
+
+[Nordstrom 73] Nordstrom, M.
+ _ _______ _________
A Parsing Technique.
+ Utah Computational Physics Group Opnote No. 12, University
+ of Utah, Department of Computer Science, November,
+ 1973.
+
+[Nordstrom 78] Nordstrom, M.; Sandewall, E.; and Breslaw, D.
+ ____ __ _ _______ ______________ __ _________
LISP F3 : A FORTRAN Implementation of InterLISP.
+ Manual, Datalogilaboratoriet, Sturegatan 2 B, S 752 23,
+ Uppsala, SWEDEN, 1978.
+ Mentioned by M. Nordstrom in 'Short Announcement of LISP
+ F3', a handout at LISP80.
Bibliography 14 January 1983 PSL Manual
+page 23.4 section 23.0
+
+[Norman 81] Norman, A.C. and Morrison, D. F.
+ ___ ______ _________ _______
The REDUCE Debugging Package.
+ Utah Symbolic Computation Group Opnote No. 49, University
+ of Utah, Department of Computer Science, February,
+ 1981.
+
+[Pratt 73] Pratt, V.
+ Top Down Operator Precedence.
+ ___________ __ ____ _
In Proceedings of POPL-1, pages ??-??. ACM, 1973.
+
+[Quam 69] Quam, L. H. and Diffie, W.
+ ________ ____ _ _ ______
Stanford LISP 1.6 Manual.
+ Operating Note 28.7, Stanford Artificial Intelligence
+ Laboratory, 1969.
+
+[Sandewall 78] Sandewall, E.
+ Programming in an Interactive Environment : The LISP
+ Experience.
+ _________ _______
Computing Surveys 10(1):35-72, March, 1978.
+
+[Steele 81] Steele, G. L. and Fahlman, S. E.
+ _____ ____ _________ ______
Spice LISP Reference Manual.
+ Manual , Carnegie-Mellon University, Pittsburgh,
+ September, 1981.
+ (Preliminary Common LISP Report).
+
+[Teitelman 78] Teitelman, W.; et al.
+ _________ _________ ______ ___ ________
Interlisp Reference Manual, (3rd Revision).
+ Xerox Palo Alto Research Center, 3333 Coyote Hill Road,
+ Palo Alto,Calif. 94304, 1978.
+
+[Teitelman 81] Teitleman, W. and Masinter, L.
+ The InterLISP Programming Environment.
+ ____ ________
IEEE Computer 14(4):25-34, 1981.
+
+[Terashima 78] Terashima, M. and Goto, E.
+ Genetic Order and Compactifying Garbage Collectors.
+ ___________ __________ _______
Information Processing Letters 7(1):27-32, 1978.
+
+[Weinreb 81] Weinreb, D. and Moon, D.
+ ____ _______ ______
LISP Machine Manual
+ 1981.
+ Fourth edition.
+
+[Weissman 67] Weissman.
+ ____ _ _ ______
LISP 1.5 Primer.
+ Dickenson Publishing Company, Inc., 1967.
+
+[Winston 81] Winston, P. H., and Horn, B. K. P.
+ ____
LISP.
+ Addison-Wesley Publishing Company, Reading, Mass., 1981.
ADDED psl-1983/3-1/lpt/24-top-index.lpt
Index: psl-1983/3-1/lpt/24-top-index.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/24-top-index.lpt
@@ -0,0 +1,647 @@
+PSL Manual 7 February 1983 Concept Index
+section 24.0 page 24.1
+
+ CHAPTER 24
CHAPTER 24
CHAPTER 24
+ INDEX OF CONCEPTS
INDEX OF CONCEPTS
INDEX OF CONCEPTS
+
+ The following is an alphabetical list of concepts, with the page on which
+they are discussed.
+
+
+ << >> . . . . . . . . . . . . 3.4
+
+ A-Lists . . . . . . . . . . . 4.4, 7.8, 7.10
+ Absolute Value. . . . . . . . 5.2
+ Abstract Machines . . . . . . 18.15
+ Access to Value Cell. . . . . 18.5
+ Addition. . . . . . . . . . . 5.2
+ Addressing Modes. . . . . . . 18.10
+ Allocation Functions. . . . . 21.8
+ Allocation. . . . . . . . . . 18.22
+ Always. . . . . . . . . . . . 9.8
+ And function. . . . . . . . . 4.8
+ And . . . . . . . . . . . . . 9.8
+ Any -catchall data type . . . 4.3
+ ANYREG Functions. . . . . . . 18.18
+ Apollo LAP. . . . . . . . . . 18.10
+ Appending Lists . . . . . . . 7.6
+ Arc cosecant function . . . . 5.13
+ Arc cosine function . . . . . 5.12
+ Arc cotangent function. . . . 5.12
+ Arc secant function . . . . . 5.13
+ Arc sine function . . . . . . 5.11
+ Arc tangent function. . . . . 5.12
+ Arguments . . . . . . . . . . 2.9, 10.7
+ Arithmetic. . . . . . . . . . 5.2
+ Arrays. . . . . . . . . . . . 8.7
+ As, (proposed iteration construct . . . . . . . . . . . . . . . . .
+ 9.13
+ ASCII . . . . . . . . . . . . 12.1, 12.6, 12.13
+ Assigning Precedence. . . . . 22.7
+ Assignment. . . . . . . . . . 6.7
+ Association list. . . . . . . 4.5
+ Association lists . . . . . . 7.8, 7.10
+ Atom. . . . . . . . . . . . . 4.7
+ Atoms . . . . . . . . . . . . 4.3
+ Auto-load . . . . . . . . . . 2.4
+ Automatic Tracing . . . . . . 15.9
+
+ Back Quote. . . . . . . . . . 17.12
+ Back Trace Functions. . . . . 15.4
+ Backtrace . . . . . . . . . . 15.10
+ Backup Buffer . . . . . . . . 12.13
+ Big Integers. . . . . . . . . 5.1
+ BigNum. . . . . . . . . . . . 4.1, 5.1
+ Binary Infix Operators. . . . 22.2
Concept Index 7 February 1983 PSL Manual
+page 24.2 section 24.0
+
+ Binary Operators. . . . . . . 22.6
+ Binary Trees. . . . . . . . . 7.1
+ Binary. . . . . . . . . . . . 12.14
+ Binding Type. . . . . . . . . 10.8, 10.9
+ Binding . . . . . . . . . . . 6.7, 10.7, 10.10
+ Bit Field Operation . . . . . 20.7
+ Bit Operations. . . . . . . . 5.7
+ BNF . . . . . . . . . . . . . 22.10, 22.17
+ Boolean Functions . . . . . . 4.8
+ Boolean . . . . . . . . . . . 4.7, 5.5
+ Booleans. . . . . . . . . . . 4.3
+ Box Diagrams. . . . . . . . . 7.1
+ Break Commands. . . . . . . . 14.4
+ Break Loop. . . . . . . . . . 13.8, 14.1, 14.4, 14.8
+ Buffers in EMODE. . . . . . . 16.5
+ Bugs. . . . . . . . . . . . . 2.3, 2.10
+ Building A-Lists. . . . . . . 7.10
+ Building LAP. . . . . . . . . 21.5
+ Building PSL. . . . . . . . . 21.2
+ Built-In Functions. . . . . . 18.18
+ Byte-Vector . . . . . . . . . 4.1, 8.5
+
+ Car Manipulation. . . . . . . 7.2
+ Case Statement. . . . . . . . 9.3, 20.5
+ Catch . . . . . . . . . . . . 14.1, 14.8
+ Cdr Manipulation. . . . . . . 7.2
+ CGOL. . . . . . . . . . . . . 22.2
+ Channels. . . . . . . . . . . 12.1, 12.6
+ Char and IDLOC Macros . . . . 20.4
+ Characters. . . . . . . . . . 4.3
+ Circular Functions. . . . . . 5.8
+ Circular Structures . . . . . 15.13, 17.25
+ Classes of Data Types . . . . 4.3
+ Classes of Functions. . . . . 18.18
+ Closing Functions . . . . . . 12.1
+ Closure . . . . . . . . . . . 10.10
+ Cmacros . . . . . . . . . . . 18.15
+ Code Generation . . . . . . . 18.15
+ Code-Pointer. . . . . . . . . 4.1, 4.7, 10.1, 10.6, 12.13
+ Collect . . . . . . . . . . . 9.8
+ Comments. . . . . . . . . . . 22.4
+ Common Lisp . . . . . . . . . 8.7
+ Compacting G. C.. . . . . . . 21.5
+ Comparison. . . . . . . . . . 17.22
+ Compilation . . . . . . . . . 2.8, 10.7, 18.7
+ Compiled Functions. . . . . . 10.6
+ Compiled vs. Interpreted. . . 18.7
+ Compiler Second Pass. . . . . 18.15
+ Compiler Third Pass . . . . . 18.22
+ Compiler. . . . . . . . . . . 18.1
+ Compiling Functions . . . . . 18.2
+ Compiling SYSLISP Code. . . . 20.9
PSL Manual 7 February 1983 Concept Index
+section 24.0 page 24.3
+
+ Compiling to FASL Files . . . 18.2
+ Compiling to Memory . . . . . 18.2
+ Composites of Car and Cdr . . 7.2
+ Compound Statements . . . . . 3.7
+ Conc. . . . . . . . . . . . . 9.8
+ Concatenating Lists . . . . . 7.6
+ Cond. . . . . . . . . . . . . 9.4
+ Conditional Statements. . . . 3.8
+ Conditionals. . . . . . . . . 9.1
+ Constant. . . . . . . . . . . 4.7
+ Constants . . . . . . . . . . 4.3
+ Construction Function . . . . 22.2
+ Construction of MINI. . . . . 22.15
+ Continuing After Errors . . . 14.1
+ Control Time of Execution . . 18.4
+ Converting Data Types . . . . 4.9, 5.1
+ Copying Functions . . . . . . 10.2
+ Copying Strings . . . . . . . 8.1
+ Copying Vectors . . . . . . . 8.3
+ Copying X-Vectors . . . . . . 8.5
+ Copying . . . . . . . . . . . 7.2
+ Cosecant function . . . . . . 5.11
+ Cosine function . . . . . . . 5.10
+ Cotangent function. . . . . . 5.11
+ Count . . . . . . . . . . . . 9.8
+ Counting Function Calls . . . 15.11
+ CREF. . . . . . . . . . . . . 17.1
+ Cross Reference Generator . . 17.1
+ Customizing Debug . . . . . . 15.14
+
+ Data Type Conversion. . . . . 4.9, 5.1
+ Data Types. . . . . . . . . . 4.1, 12.6, 12.13
+ Debug and Redefinition. . . . 15.4
+ Debug Deficiencies. . . . . . 15.4
+ Debug Example . . . . . . . . 15.16
+ Debug Printing Functions. . . 15.15
+ Debug Reading Functions . . . 15.15
+ Debugging Tools . . . . . . . 15.1
+ Dec-20 LAP. . . . . . . . . . 18.10
+ DEC-20 PSL. . . . . . . . . . 21.2, 21.5
+ Decimal Output. . . . . . . . 12.6
+ Declaration . . . . . . . . . 10.7, 10.8
+ Default Top Level . . . . . . 13.3
+ DefConst. . . . . . . . . . . 17.22
+ Deficiencies in Debug . . . . 15.4
+ DefMacro. . . . . . . . . . . 17.12
+ Deletion from lists . . . . . 7.8
+ Delimiters. . . . . . . . . . 12.6, 12.13
+ Details of the Compiler . . . 18.14
+ Digits. . . . . . . . . . . . 12.13
+ Diphthong Indicator . . . . . 12.17
+ Diphthong . . . . . . . . . . 12.25
Concept Index 7 February 1983 PSL Manual
+page 24.4 section 24.0
+
+ Division. . . . . . . . . . . 5.2
+ Do. . . . . . . . . . . . . . 9.8
+ Dot Notation. . . . . . . . . 3.6, 7.1
+ Dot-notation. . . . . . . . . 4.2
+
+ Each. . . . . . . . . . . . . 9.13
+ Edit Commands . . . . . . . . 16.1, 16.7
+ Editing in the Break Loop . . 14.4, 16.1
+ Editing with EMODE. . . . . . 16.3
+ Editor. . . . . . . . . . . . 16.1
+ Elementary Functions. . . . . 5.8
+ EMB Functions . . . . . . . . 15.4
+ Embedded Functions. . . . . . 15.11
+ EMODE . . . . . . . . . . . . 16.3
+ Enabling debug facilities . . 15.9
+ End of file . . . . . . . . . 12.2
+ End of line . . . . . . . . . 12.2
+ Environment . . . . . . . . . 10.10
+ EOF . . . . . . . . . . . . . 12.2
+ EOL . . . . . . . . . . . . . 12.2
+ Equality testing functions. . 4.5
+ Error Calls . . . . . . . . . 14.8
+ Error Functions . . . . . . . 14.1
+ Error Handling in MINI. . . . 22.13
+ Error Handling. . . . . . . . 14.1, 22.7
+ Error Messages. . . . . . . . 2.8, 12.6
+ Error Number. . . . . . . . . 14.1
+ Error Recovery in MINI. . . . 22.13
+ Errors. . . . . . . . . . . . 2.8, 2.10, 10.9
+ Escaped Characters. . . . . . 22.7
+ Eval flag . . . . . . . . . . 6.16
+ Eval Type Functions . . . . . 2.9
+ Evaluation. . . . . . . . . . 11.1
+ Example of MINI . . . . . . . 22.12
+ Examples. . . . . . . . . . . 2.5, 3.2, 3.3, 14.4, 15.16, 17.18,
+ 18.10, 20.9, 22.6, 22.8
+ Exclamation Point in RLISP. . 22.7
+ Executable. . . . . . . . . . 13.1
+ Exit. . . . . . . . . . . . . 9.1, 9.17
+ Explicit Sequence Control . . 9.4
+ Exponent. . . . . . . . . . . 4.1
+ Exponential Functions . . . . 5.8
+ Exponentiation. . . . . . . . 5.2
+ Expr. . . . . . . . . . . . . 2.9, 10.7
+ Extend CREF for SYSLISP . . . 20.12
+ Extensible Parser . . . . . . 22.1
+ External Form . . . . . . . . 22.4
+ Extra-Booleans. . . . . . . . 4.3
+
+ Factorial function. . . . . . 5.14
+ FASL. . . . . . . . . . . . . 12.14
+ Fexpr . . . . . . . . . . . . 2.9, 10.7
PSL Manual 7 February 1983 Concept Index
+section 24.0 page 24.5
+
+ Field . . . . . . . . . . . . 4.1
+ File Input. . . . . . . . . . 12.14
+ File Names. . . . . . . . . . 12.4, 12.14
+ File Output . . . . . . . . . 12.14
+ Filename Conventions. . . . . 12.14
+ Files about MINI. . . . . . . 22.15
+ Finally . . . . . . . . . . . 9.8
+ Find. . . . . . . . . . . . . 6.4
+ FixNum. . . . . . . . . . . . 4.1
+ Flag indicators . . . . . . . 6.16
+ Flagging Ids. . . . . . . . . 6.6
+ Flags . . . . . . . . . . . . 6.4, 6.6
+ Float . . . . . . . . . . . . 4.1, 4.7, 12.13
+ Floats. . . . . . . . . . . . 5.1
+ Fluid Binding . . . . . . . . 10.7, 10.10
+ Fluid Declarations. . . . . . 18.5
+ For . . . . . . . . . . . . . 9.8
+ Form Oriented Editor. . . . . 16.5
+ Form. . . . . . . . . . . . . 4.4
+ Format. . . . . . . . . . . . 12.6, 12.13, 12.25
+ Formatted Printing. . . . . . 12.6
+ From. . . . . . . . . . . . . 9.8
+ FType . . . . . . . . . . . . 4.3
+ Funarg. . . . . . . . . . . . 10.10
+ Function Calls. . . . . . . . 22.4
+ Function Cell . . . . . . . . 6.2, 11.1
+ Function definition . . . . . 3.3, 3.6, 10.1
+ Function Execution Tracing. . 15.5
+ Function Order. . . . . . . . 18.5
+ Function Redefinition . . . . 2.8, 15.4
+ Function types. . . . . . . . 2.9, 10.7
+ Function. . . . . . . . . . . 4.4
+
+ Garbage Collector . . . . . . 21.5
+ GC. . . . . . . . . . . . . . 21.5
+ Generator . . . . . . . . . . 22.17
+ Global Binding. . . . . . . . 10.7
+ Global Declarations . . . . . 18.5
+ Global Variables. . . . . . . 3.10
+ Globals . . . . . . . . . . . 2.10, 6.10, 6.16
+ Go. . . . . . . . . . . . . . 9.1
+ Graph-to-Tree . . . . . . . . 17.25
+
+ Halfword-Vector . . . . . . . 4.1, 8.5
+ Handlers. . . . . . . . . . . 12.4
+ Hash table. . . . . . . . . . 17.24
+ Hashing Cons. . . . . . . . . 17.24
+ Heap. . . . . . . . . . . . . 4.1, 21.6
+ Help. . . . . . . . . . . . . 2.4, 6.16, 13.7
+ Hexadecimal Output. . . . . . 12.6
+ History Mechanism . . . . . . 2.4, 13.4
+ History of MINI . . . . . . . 22.16
Concept Index 7 February 1983 PSL Manual
+page 24.6 section 24.0
+
+ Hook. . . . . . . . . . . . . 6.2
+
+ I/O Buffer. . . . . . . . . . 12.13
+ I/O . . . . . . . . . . . . . 12.25
+ Id hash table . . . . . . . . 6.2, 6.4, 6.10
+ Id Space. . . . . . . . . . . 4.1, 6.2
+ Id-Hash-Table . . . . . . . . 13.7
+ Id. . . . . . . . . . . . . . 4.1, 4.7, 4.9, 6.1, 12.13
+ Identifier. . . . . . . . . . 4.1, 4.7, 4.9, 6.1, 12.13
+ If Then Construct . . . . . . 9.1
+ If Then Statements. . . . . . 3.8
+ Ignore flag . . . . . . . . . 6.16
+ Implementation. . . . . . . . 21.1
+ In. . . . . . . . . . . . . . 9.8
+ Indexing vectors and strings . . . . . . . . . . . . . . . . . . .
+ 8.1
+ Indicator, on property list . 6.4
+ Infix Operators . . . . . . . 3.4, 22.4
+ Init Files. . . . . . . . . . 13.3
+ Initially . . . . . . . . . . 9.8
+ Input Functions . . . . . . . 12.13
+ Input in Files. . . . . . . . 12.14
+ Input . . . . . . . . . . . . 3.10, 12.1, 22.2
+ Integer . . . . . . . . . . . 4.1, 4.7, 4.9, 12.13
+ Integers. . . . . . . . . . . 5.1
+ INTERLISP . . . . . . . . . . 16.5
+ Intern. . . . . . . . . . . . 4.9, 6.2, 6.10
+ InternalForm. . . . . . . . . 22.4
+ Internals in Debug. . . . . . 15.14
+ Interpretation. . . . . . . . 2.8, 18.7
+ Interpreted Functions . . . . 10.6, 10.9
+ Interpreter . . . . . . . . . 11.1
+ Interrupt Keys. . . . . . . . 14.8
+ Inum. . . . . . . . . . . . . 4.1, 4.9
+ Inverse Circular Functions. . 5.11
+ Inverse Trigonometric Functions . . . . . . . . . . . . . . . . . .
+ 5.11
+ Item. . . . . . . . . . . . . 4.1
+ Iteration . . . . . . . . . . 9.6
+
+ Join. . . . . . . . . . . . . 9.8
+
+ Key Words . . . . . . . . . . 22.7
+
+ Lambda. . . . . . . . . . . . 4.4, 10.7, 10.9, 11.5
+ LAP Format. . . . . . . . . . 18.10
+ Lap Switches. . . . . . . . . 18.13
+ LAP-to-ASM for Apollo . . . . 18.9
+ LAP . . . . . . . . . . . . . 21.5
+ Length. . . . . . . . . . . . 7.6
+ Letter as Token Type. . . . . 12.13
+ Line feed . . . . . . . . . . 12.2
PSL Manual 7 February 1983 Concept Index
+section 24.0 page 24.7
+
+ LISP Surface Language . . . . 22.2
+ Lisp syntax . . . . . . . . . 12.18, 12.21
+ LISP, compared with RLISP . . 3.3
+ List Concatenation. . . . . . 7.6
+ List Element Deletion . . . . 7.8
+ List Element Selection. . . . 7.4
+ List IO . . . . . . . . . . . 12.25
+ List Length . . . . . . . . . 7.6
+ List Manipulation . . . . . . 7.4
+ List Membership Functions . . 7.6
+ List Notation Reader. . . . . 22.12
+ List Notation . . . . . . . . 7.1
+ List Reversal . . . . . . . . 7.9
+ List Substitutions. . . . . . 7.11
+ List-notation . . . . . . . . 4.4
+ List. . . . . . . . . . . . . 4.4, 4.9, 6.4, 7.1
+ Loader. . . . . . . . . . . . 18.9
+ Loading FASL Files. . . . . . 18.3
+ Local Binding . . . . . . . . 10.7
+ Local Variables . . . . . . . 3.7
+ Logarithms. . . . . . . . . . 5.8
+ Logical And . . . . . . . . . 5.7
+ Logical Devices for PSL . . . 2.1, 21.1
+ Logical Exclusive Or. . . . . 5.7
+ Logical Not . . . . . . . . . 5.7
+ Logical Or. . . . . . . . . . 5.7
+ Looping Constructs. . . . . . 9.6
+ Loops . . . . . . . . . . . . 3.8, 3.9
+ Lose flag . . . . . . . . . . 6.16
+
+ Machine Instructions. . . . . 18.15
+ Macro Defining Tools. . . . . 17.11
+ Macro Expand. . . . . . . . . 17.14
+ Macro . . . . . . . . . . . . 2.9, 10.7, 11.7
+ Mapping Functions . . . . . . 9.13
+ Mathematical Functions. . . . 5.8
+ MaxChannels . . . . . . . . . 12.1
+ Maximize. . . . . . . . . . . 9.8
+ Memory Access Operations. . . 20.7
+ Memory Address Operations . . 20.7
+ Messages. . . . . . . . . . . 2.8
+ Meta Compiler . . . . . . . . 22.1
+ MINI Development. . . . . . . 22.16
+ MINI Error Handling . . . . . 22.13
+ MINI Error Recovery . . . . . 22.13
+ MINI Example. . . . . . . . . 22.12
+ MINI Operators. . . . . . . . 22.10
+ MINI Self-Definition. . . . . 22.13
+ Mini Trace. . . . . . . . . . 15.2
+ MINI. . . . . . . . . . . . . 22.10
+ Minimize. . . . . . . . . . . 9.8
+ Minus as Token Type . . . . . 12.13
Concept Index 7 February 1983 PSL Manual
+page 24.8 section 24.0
+
+ Mode Analysis Functions . . . 20.3
+ Modified FOR Loop . . . . . . 20.4
+ Modules . . . . . . . . . . . 2.4
+ Modulo function . . . . . . . 5.9
+ Multiplication. . . . . . . . 5.2
+
+ N-ary Expressions . . . . . . 22.6
+ N-ary Functions . . . . . . . 3.3
+ Need for Two Stacks . . . . . 20.12
+ Never . . . . . . . . . . . . 9.8
+ New Mode System . . . . . . . 20.12
+ Newline . . . . . . . . . . . 12.2
+ Nexpr . . . . . . . . . . . . 2.9, 10.7
+ Next. . . . . . . . . . . . . 9.1
+ NIL . . . . . . . . . . . . . 4.7, 4.8, 6.15
+ NoEval Type Functions . . . . 2.9
+ Non-Local Exit. . . . . . . . 9.17
+ None Returned . . . . . . . . 4.3
+ NoSpread Type Functions . . . 2.9
+ Not function. . . . . . . . . 4.8
+ Not . . . . . . . . . . . . . 9.8
+ Notation. . . . . . . . . . . 4.1
+ Number. . . . . . . . . . . . 4.7, 4.9, 12.13
+ Numbers . . . . . . . . . . . 4.3, 5.1
+ Numeric Comparison. . . . . . 5.5
+
+ Object list . . . . . . . . . 6.2
+ Oblist. . . . . . . . . . . . 6.2, 6.4
+ Octal Output. . . . . . . . . 12.6
+ OFF command . . . . . . . . . 3.10, 6.14
+ Oload . . . . . . . . . . . . 19.14
+ ON command. . . . . . . . . . 3.10, 6.14
+ On. . . . . . . . . . . . . . 9.8
+ Open Coding . . . . . . . . . 18.7
+ OPEN Functions. . . . . . . . 18.18
+ Operator Definition . . . . . 22.8
+ Operator Precedence . . . . . 3.4
+ Operators . . . . . . . . . . 22.2
+ Optimizations . . . . . . . . 18.22
+ Optional Modules. . . . . . . 2.4
+ Or function . . . . . . . . . 4.8
+ Or. . . . . . . . . . . . . . 9.8
+ Order of Functions. . . . . . 18.5
+ Output Base . . . . . . . . . 12.6
+ Output. . . . . . . . . . . . 3.10, 12.1
+ OutPutBase!*. . . . . . . . . 12.6
+ Overflow. . . . . . . . . . . 12.25
+
+ Package Cell. . . . . . . . . 6.2
+ Package . . . . . . . . . . . 6.2, 6.10
+ Pair Construction . . . . . . 7.2
+ Pair hash table . . . . . . . 17.24
PSL Manual 7 February 1983 Concept Index
+section 24.0 page 24.9
+
+ Pair Manipulation . . . . . . 7.2
+ Pair. . . . . . . . . . . . . 4.1, 4.4, 4.7, 7.1
+ Pairs . . . . . . . . . . . . 7.1
+ Parameters. . . . . . . . . . 2.9, 10.7
+ Parentheses . . . . . . . . . 22.5
+ Parse function. . . . . . . . 3.6
+ Parser Flow Diagram . . . . . 22.2
+ Parser Generator. . . . . . . 22.1
+ Parser. . . . . . . . . . . . 12.13
+ Parsers . . . . . . . . . . . 22.1
+ Parsing Precedence. . . . . . 22.2
+ PASS1 of Compiler . . . . . . 18.14
+ Pattern Matcher . . . . . . . 22.12
+ Pattern Matching in MINI. . . 22.12
+ Picture RLISP . . . . . . . . 17.4
+ Plus as Token Type. . . . . . 12.13
+ Precedence Table. . . . . . . 22.2
+ Precedence. . . . . . . . . . 3.4, 22.5
+ Predicates. . . . . . . . . . 4.5, 5.5, 7.6, 10.6, 10.7, 10.9
+ Print Name. . . . . . . . . . 6.2, 22.7
+ Printing Circular Lists . . . 15.13, 17.25
+ Printing Circular Vectors . . 17.25
+ Printing Functions. . . . . . 15.12
+ Printing Property Lists . . . 15.12
+ Printing Registers. . . . . . 12.6
+ Printing. . . . . . . . . . . 12.6
+ PRLISP. . . . . . . . . . . . 17.4
+ Procedure definition. . . . . 3.3, 3.6
+ Product . . . . . . . . . . . 9.8
+ Productions . . . . . . . . . 22.10
+ Prog. . . . . . . . . . . . . 3.7, 9.4, 10.7, 10.9
+ Progn . . . . . . . . . . . . 3.7, 9.4
+ Properties. . . . . . . . . . 6.4
+ Property Cell Access. . . . . 6.7
+ Property Cell . . . . . . . . 6.2, 6.4
+ Property List . . . . . . . . 6.2, 6.4, 6.15, 22.4
+ Pseudos . . . . . . . . . . . 18.10
+ PSL Files . . . . . . . . . . 21.1
+ PSL Sample Session. . . . . . 2.5
+ Put Indicators. . . . . . . . 6.15
+
+ Quote Mark in RLISP . . . . . 22.7
+ Quote Mark. . . . . . . . . . 22.4
+
+ Radix for I/O . . . . . . . . 12.13
+ Random Functions. . . . . . . 18.18
+ Random Numbers. . . . . . . . 5.8
+ RCREF . . . . . . . . . . . . 17.1
+ Read function . . . . . . . . 3.6
+ Read macro indicator. . . . . 12.17
+ Read Macros . . . . . . . . . 12.24, 12.25
+ Read. . . . . . . . . . . . . 22.2
Concept Index 7 February 1983 PSL Manual
+page 24.10 section 24.0
+
+ Reading Functions . . . . . . 12.1, 12.13
+ Recognizer. . . . . . . . . . 22.17
+ Reduce. . . . . . . . . . . . 3.1
+ Register and Tracing. . . . . 15.4
+ Registers . . . . . . . . . . 12.6
+ Remainder function. . . . . . 5.2
+ Remaining SYSLISP Issues. . . 20.11
+ Removing Functions. . . . . . 10.2
+ Return. . . . . . . . . . . . 9.1
+ Returns . . . . . . . . . . . 9.8
+ Reversal of lists . . . . . . 7.9
+ Right Precedence. . . . . . . 22.2
+ RLISP Commands. . . . . . . . 13.8
+ RLISP Input . . . . . . . . . 3.10
+ RLISP Output. . . . . . . . . 3.10
+ RLISP Parser. . . . . . . . . 22.7
+ RLISP Syntax. . . . . . . . . 3.2, 12.18
+ RLISP to LISP Translation . . 22.17
+ RLISP to LISP Using MINI. . . 22.17
+ RLISP, compared with LISP . . 3.3
+ RLISP, compared with SYSLISP. . . . . . . . . . . . . . . . . . . .
+ 20.2
+ RLISP . . . . . . . . . . . . 3.1
+ Running MINI. . . . . . . . . 22.13
+
+ S-expression. . . . . . . . . 12.13
+ S-Expressions . . . . . . . . 4.3
+ S-Integer . . . . . . . . . . 4.9
+ Saving Executable PSL . . . . 13.1
+ Saving Trace Output . . . . . 15.6
+ Scalar. . . . . . . . . . . . 3.4, 3.7, 3.9
+ Scan Table. . . . . . . . . . 12.13, 12.17, 12.25, 13.4, 22.4
+ Scope of Variables. . . . . . 10.7
+ Screen Editor . . . . . . . . 16.3
+ Searching A-Lists . . . . . . 7.10
+ Secant function . . . . . . . 5.11
+ Selective Trace . . . . . . . 15.7
+ Sequence of Evaluation. . . . 9.4
+ Set Functions . . . . . . . . 7.7
+ Sharp-Sign Macros . . . . . . 17.13
+ Side Effects. . . . . . . . . 18.18
+ Sine function . . . . . . . . 5.10
+ Skip to Top of Page . . . . . 12.6
+ Sorting . . . . . . . . . . . 17.22
+ Special Error Handlers. . . . 14.10
+ Special I/O Functions . . . . 12.4
+ Spread Type Functions . . . . 2.9
+ Square Root function. . . . . 5.13
+ Stable Functions. . . . . . . 18.18
+ Stack . . . . . . . . . . . . 17.14
+ Stand Alone SYSLISP . . . . . 20.11
+ Starting MINI . . . . . . . . 22.12
PSL Manual 7 February 1983 Concept Index
+section 24.0 page 24.11
+
+ Starting PSL. . . . . . . . . 2.1, 2.3, 26.i
+ Statistics Functions. . . . . 15.4
+ Stop and Copy on VAX. . . . . 21.6
+ Stopping PSL. . . . . . . . . 13.1
+ String IO . . . . . . . . . . 12.25
+ String Operations . . . . . . 8.1
+ String Quotes . . . . . . . . 12.13
+ String. . . . . . . . . . . . 4.1, 4.7, 4.9, 12.13
+ Structural Notes: Compiler. . 18.23
+ Structure Definition. . . . . 17.15
+ Structure Editor. . . . . . . 16.5
+ Structure . . . . . . . . . . 4.4
+ Stubs . . . . . . . . . . . . 15.12
+ Substitutions . . . . . . . . 7.11
+ Substring Matching. . . . . . 6.4
+ Subtraction . . . . . . . . . 5.2
+ Sum . . . . . . . . . . . . . 9.8
+ Switches Controlling Compiler . . . . . . . . . . . . . . . . . . .
+ 18.6
+ Switches. . . . . . . . . . . 2.10, 3.10, 6.14, 6.16
+ SYSLISP Arguments . . . . . . 12.6
+ SYSLISP Declarations. . . . . 20.2
+ SYSLISP Functions . . . . . . 20.10
+ SYSLISP Level of PSL. . . . . 20.1
+ SYSLISP Mode Analysis . . . . 20.3
+ SYSLISP Programs. . . . . . . 20.11
+ SYSLISP, compared with RLISP. . . . . . . . . . . . . . . . . . . .
+ 20.2
+ System Dependent Functions. . 19.1
+
+ T . . . . . . . . . . . . . . 6.15
+ Table Driven Parser . . . . . 22.2
+ Tag Field . . . . . . . . . . 4.1
+ Tagging Information . . . . . 18.15
+ Tangent function. . . . . . . 5.10
+ Template and Replacement. . . 22.12
+ Terminal Interaction. . . . . 13.8
+ Throw . . . . . . . . . . . . 14.1, 14.10
+ Time Control Functions. . . . 18.4
+ Token scanner . . . . . . . . 12.13
+ Tokens. . . . . . . . . . . . 22.2
+ Top Level Function. . . . . . 13.3
+ Top Loop Mechanism. . . . . . 14.8
+ Top Loop. . . . . . . . . . . 13.4
+ Trace Output. . . . . . . . . 15.6
+ Trace ring buffer . . . . . . 15.6
+ Trace . . . . . . . . . . . . 15.4
+ Tracing Functions . . . . . . 2.4, 15.2, 15.5
+ Tracing Macros. . . . . . . . 15.4
+ Tracing New Functions . . . . 15.9
+ Transcendental Functions. . . 5.8
+ Trees . . . . . . . . . . . . 22.10
Concept Index 7 February 1983 PSL Manual
+page 24.12 section 24.0
+
+ Trigonometric Functions . . . 5.8
+ Truth and falsity . . . . . . 4.8
+ Turning Off Trace . . . . . . 15.8
+ Type Checking Functions . . . 4.7
+ Type Conversion . . . . . . . 4.9, 5.1
+ Type Declarations . . . . . . 4.1
+ Type Field. . . . . . . . . . 4.1
+ Type Mismatch . . . . . . . . 12.25
+
+ UCI LISP. . . . . . . . . . . 16.5
+ Unary Functions . . . . . . . 3.3, 5.2
+ Unary Prefix Operators. . . . 22.2
+ Undefined . . . . . . . . . . 4.3
+ Union . . . . . . . . . . . . 9.8
+ Unix interface functions. . . 19.14
+ Unless. . . . . . . . . . . . 9.8
+ Until . . . . . . . . . . . . 9.8
+ Untraceable Functions . . . . 15.4
+ User flag . . . . . . . . . . 6.16
+ User Function Redefinition. . 15.4
+ User Hooks in Debug . . . . . 15.14
+ User Interface. . . . . . . . 13.1
+ Using SYSLISP . . . . . . . . 20.9
+ Utility modules . . . . . . . 17.1
+
+ Value Cell. . . . . . . . . . 6.2, 6.7, 10.7
+ Variable Binding. . . . . . . 6.7, 10.7
+ Vax init files. . . . . . . . 19.11
+ VAX LAP . . . . . . . . . . . 18.9, 18.10
+ Vax login files . . . . . . . 19.10
+ Vax PSL directories . . . . . 19.11
+ VAX PSL . . . . . . . . . . . 21.6
+ Vax system interface. . . . . 19.10
+ Vector Indexing . . . . . . . 8.1
+ Vector Operations . . . . . . 8.3
+ Vector. . . . . . . . . . . . 4.1, 4.7, 4.9
+
+ Warning Messages. . . . . . . 2.8
+ When. . . . . . . . . . . . . 9.8
+ While . . . . . . . . . . . . 9.8
+ Windows in EMODE. . . . . . . 16.5
+ With. . . . . . . . . . . . . 9.8
+ Word Operations . . . . . . . 8.5
+ Word-Vector . . . . . . . . . 4.1, 8.5
+ Word. . . . . . . . . . . . . 4.1
+ Writing Functions . . . . . . 12.1
+
+ X-Vector Operations . . . . . 8.5
+ X-Vector. . . . . . . . . . . 8.1
+ X-Vectors . . . . . . . . . . 4.3
ADDED psl-1983/3-1/lpt/25-fun-index.lpt
Index: psl-1983/3-1/lpt/25-fun-index.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/25-fun-index.lpt
@@ -0,0 +1,789 @@
+PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.1
+
+ CHAPTER 25
CHAPTER 25
CHAPTER 25
+ INDEX OF FUNCTIONS
INDEX OF FUNCTIONS
INDEX OF FUNCTIONS
+
+ The following is an alphabetical list of the PSL functions, with the page
+on which they are defined.
+
+
+ !%Reclaim . . . . . . . . . . expr 21.8
+ !*DESTROY . . . . . . . . . . cmacro 18.22
+ !*DO. . . . . . . . . . . . . cmacro 18.22
+ !*JUMP. . . . . . . . . . . . cmacro 18.22
+ !*LBL . . . . . . . . . . . . cmacro 18.22
+ !*LOAD. . . . . . . . . . . . cmacro 18.22
+ !*SET . . . . . . . . . . . . cmacro 18.22
+ !*STORE . . . . . . . . . . . cmacro 18.22
+
+ \CreatePackage. . . . . . . . expr 6.11
+ \LocalIntern. . . . . . . . . expr 6.12
+ \LocalInternP . . . . . . . . expr 6.11
+ \LocalMapObl. . . . . . . . . expr 6.12
+ \LocalRemob . . . . . . . . . expr 6.12
+ \PathIntern . . . . . . . . . expr 6.11
+ \PathInternP. . . . . . . . . expr 6.11
+ \PathMapObl . . . . . . . . . expr 6.11
+ \PathRemob. . . . . . . . . . expr 6.11
+ \SetPackage . . . . . . . . . expr 6.11
+
+ A . . . . . . . . . . . . . . edit 16.7
+ Abs . . . . . . . . . . . . . expr 5.2
+ AConc . . . . . . . . . . . . expr 7.7
+ Acos. . . . . . . . . . . . . expr 5.12
+ AcosD . . . . . . . . . . . . expr 5.12
+ Acot. . . . . . . . . . . . . expr 5.12
+ AcotD . . . . . . . . . . . . expr 5.13
+ Acsc. . . . . . . . . . . . . expr 5.13
+ AcscD . . . . . . . . . . . . expr 5.13
+ Add1. . . . . . . . . . . . . expr 5.2
+ Adjoin. . . . . . . . . . . . expr 7.7
+ AdjoinQ . . . . . . . . . . . expr 7.8
+ AlphaNumericP . . . . . . . . expr 8.8
+ AlphaP. . . . . . . . . . . . expr 8.8
+ And . . . . . . . . . . . . . fexpr 4.8
+ Ans . . . . . . . . . . . . . expr 13.6
+ AnyId . . . . . . . . . . . . expr 22.10
+ AnyTok. . . . . . . . . . . . expr 22.10
+ Append. . . . . . . . . . . . expr 7.6
+ Apply . . . . . . . . . . . . expr 11.4
+ ApplyInEnvironment. . . . . . expr 10.10
+ Asec. . . . . . . . . . . . . expr 5.13
+ AsecD . . . . . . . . . . . . expr 5.13
+ Asin. . . . . . . . . . . . . expr 5.11
+ AsinD . . . . . . . . . . . . expr 5.11
Function Index 7 February 1983 PSL Manual
+page 25.2 section 25.0
+
+ Ass . . . . . . . . . . . . . expr 7.10
+ Assoc . . . . . . . . . . . . expr 7.10
+ Atan2 . . . . . . . . . . . . expr 5.12
+ Atan2D. . . . . . . . . . . . expr 5.12
+ Atan. . . . . . . . . . . . . expr 5.12
+ AtanD . . . . . . . . . . . . expr 5.12
+ Atom. . . . . . . . . . . . . expr 4.7
+ Atsoc . . . . . . . . . . . . expr 7.10
+
+ B . . . . . . . . . . . . . . edit 16.2, 16.7
+ BackQuote . . . . . . . . . . macro 17.13
+ BeginRLisp. . . . . . . . . . expr 13.7
+ BELOW . . . . . . . . . . . . edit 16.8
+ BF. . . . . . . . . . . . . . edit 16.8
+ BI. . . . . . . . . . . . . . edit 16.9
+ BIND. . . . . . . . . . . . . edit 16.9
+ Bits. . . . . . . . . . . . . macro 19.9
+ BK. . . . . . . . . . . . . . edit 16.9
+ BldMsg. . . . . . . . . . . . expr 12.27
+ BO. . . . . . . . . . . . . . edit 16.9
+ BothCaseP . . . . . . . . . . expr 8.8
+ BothTimes . . . . . . . . . . expr 18.4
+ Btr . . . . . . . . . . . . . macro 15.10
+ Bug . . . . . . . . . . . . . expr 2.10
+ Byte. . . . . . . . . . . . . expr 20.11
+
+ CaptureEnvironment. . . . . . expr 10.11
+ Car . . . . . . . . . . . . . expr 7.2
+ Case. . . . . . . . . . . . . fexpr 9.4
+ Catch!-All. . . . . . . . . . macro 9.19
+ Catch . . . . . . . . . . . . fexpr 9.17
+ Cd. . . . . . . . . . . . . . expr 19.13
+ Cdr . . . . . . . . . . . . . expr 7.2
+ Ceiling . . . . . . . . . . . expr 5.8
+ CHANGE. . . . . . . . . . . . edit 16.9
+ ChannelEject. . . . . . . . . expr 12.10
+ ChannelFlush. . . . . . . . . expr 19.17
+ ChannelLineLength . . . . . . expr 12.11
+ ChannelLPosn. . . . . . . . . expr 12.11
+ ChannelPosn . . . . . . . . . expr 12.10
+ ChannelPrin1. . . . . . . . . expr 12.7
+ ChannelPrin2. . . . . . . . . expr 12.8
+ ChannelPrin2T . . . . . . . . expr 12.12
+ ChannelPrinC. . . . . . . . . expr 12.8
+ ChannelPrint. . . . . . . . . expr 12.8
+ ChannelPrintF . . . . . . . . expr 12.9
+ ChannelRead . . . . . . . . . expr 12.13
+ ChannelReadCH . . . . . . . . expr 12.16
+ ChannelReadChar . . . . . . . expr 12.15
+ ChannelReadToken. . . . . . . expr 12.16
+ ChannelSpaces . . . . . . . . expr 12.11
+ ChannelTab. . . . . . . . . . expr 12.12
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.3
+
+ ChannelTerPri . . . . . . . . expr 12.10
+ ChannelUnReadChar . . . . . . expr 12.16
+ ChannelWriteChar. . . . . . . expr 12.6
+ Char!-Bits. . . . . . . . . . expr 8.9
+ Char!-Code. . . . . . . . . . expr 8.9
+ Char!-DownCase. . . . . . . . expr 8.10
+ Char!-Equal . . . . . . . . . expr 8.9
+ Char!-Font. . . . . . . . . . expr 8.9
+ Char!-GreaterP. . . . . . . . expr 8.9
+ Char!-Int . . . . . . . . . . expr 8.10
+ Char!-LessP . . . . . . . . . expr 8.9
+ Char!-UpCase. . . . . . . . . expr 8.10
+ Char!<. . . . . . . . . . . . expr 8.9
+ Char!=. . . . . . . . . . . . expr 8.9
+ Char!>. . . . . . . . . . . . expr 8.9
+ Char. . . . . . . . . . . . . macro 20.5
+ Character . . . . . . . . . . expr 8.10
+ CharsInInputBuffer. . . . . . expr 19.17
+ ClearBindings . . . . . . . . expr 10.11
+ Close . . . . . . . . . . . . expr 12.5
+ Closure . . . . . . . . . . . macro 10.10
+ Cmds. . . . . . . . . . . . . fexpr 19.2
+ Code!-Char. . . . . . . . . . expr 8.9
+ Code!-Number!-Of!-Arguments . expr 10.7
+ CodeApply . . . . . . . . . . expr 11.6
+ CodeEvalApply . . . . . . . . expr 11.6
+ CodeP . . . . . . . . . . . . expr 4.7
+ CommentOutCode. . . . . . . . macro 18.4
+ Compile . . . . . . . . . . . expr 18.2
+ CompileTime . . . . . . . . . expr 18.4
+ Compress. . . . . . . . . . . expr 12.26
+ COMS. . . . . . . . . . . . . edit 16.10
+ COMSQ . . . . . . . . . . . . edit 16.10
+ Concat. . . . . . . . . . . . expr 8.6
+ ConcatS . . . . . . . . . . . expr 19.2
+ Cond. . . . . . . . . . . . . fexpr 9.1
+ Cons. . . . . . . . . . . . . expr 7.2
+ Const . . . . . . . . . . . . macro 17.22
+ ConstantP . . . . . . . . . . expr 4.7
+ ContError . . . . . . . . . . macro 14.3
+ ContinuableError. . . . . . . expr 14.3
+ Copy. . . . . . . . . . . . . expr 7.3
+ CopyD . . . . . . . . . . . . expr 10.3
+ CopyScanTable . . . . . . . . expr 12.25
+ CopyString. . . . . . . . . . expr 8.2
+ CopyStringToFrom. . . . . . . expr 8.2
+ CopyVector. . . . . . . . . . expr 8.4
+ CopyVectorToFrom. . . . . . . expr 8.4
+ CopyWArray. . . . . . . . . . expr 20.11
+ CopyWRDS. . . . . . . . . . . expr 20.11
+ CopyWRDSToFrom. . . . . . . . expr 20.11
+ Cos . . . . . . . . . . . . . expr 5.10
Function Index 7 February 1983 PSL Manual
+page 25.4 section 25.0
+
+ CosD. . . . . . . . . . . . . expr 5.10
+ Cot . . . . . . . . . . . . . expr 5.11
+ CotD. . . . . . . . . . . . . expr 5.11
+ CPrint. . . . . . . . . . . . expr 17.25
+ Csc . . . . . . . . . . . . . expr 5.11
+ CscD. . . . . . . . . . . . . expr 5.11
+
+ Date. . . . . . . . . . . . . expr 13.2
+ De. . . . . . . . . . . . . . macro 10.4
+ Decr. . . . . . . . . . . . . macro 5.3
+ DefConst. . . . . . . . . . . macro 17.22
+ DefLambda . . . . . . . . . . macro 17.14
+ DefList . . . . . . . . . . . expr 6.5
+ DefMacro. . . . . . . . . . . macro 17.12
+ Defstruct . . . . . . . . . . fexpr 17.16
+ DefstructP. . . . . . . . . . expr 17.15
+ DefstructType . . . . . . . . expr 17.15
+ DegreesToDMS. . . . . . . . . expr 5.10
+ DegreesToRadians. . . . . . . expr 5.9
+ Del . . . . . . . . . . . . . expr 7.9
+ DelAsc. . . . . . . . . . . . expr 7.9
+ DelAscIP. . . . . . . . . . . expr 7.9
+ DelatQ. . . . . . . . . . . . expr 7.9
+ DelatQIP. . . . . . . . . . . expr 7.9
+ DelBps. . . . . . . . . . . . expr 21.9
+ DELETE. . . . . . . . . . . . edit 16.10
+ Delete. . . . . . . . . . . . expr 7.8
+ DeletIP . . . . . . . . . . . expr 7.9
+ DelQ. . . . . . . . . . . . . expr 7.9
+ DelQIP. . . . . . . . . . . . expr 7.9
+ DelWArray . . . . . . . . . . expr 21.9
+ DeSetQ. . . . . . . . . . . . macro 6.8
+ Df. . . . . . . . . . . . . . macro 10.4
+ Difference. . . . . . . . . . expr 5.3
+ Digit!-Char . . . . . . . . . expr 8.10
+ Digit . . . . . . . . . . . . expr 12.25
+ DigitP. . . . . . . . . . . . expr 8.8
+ Divide. . . . . . . . . . . . expr 5.3
+ Dm. . . . . . . . . . . . . . macro 10.5
+ DMStoDegrees. . . . . . . . . expr 5.10
+ DMStoRadians. . . . . . . . . expr 5.10
+ Dn. . . . . . . . . . . . . . macro 10.4
+ Do!*. . . . . . . . . . . . . macro 9.16
+ Do-Loop!* . . . . . . . . . . macro 9.16
+ Do-Loop . . . . . . . . . . . macro 9.16
+ Do. . . . . . . . . . . . . . macro 9.15
+ DoCmds. . . . . . . . . . . . expr 19.2
+ Ds. . . . . . . . . . . . . . macro 10.5
+ DskIn . . . . . . . . . . . . expr 12.14
+ DumpLisp. . . . . . . . . . . expr 13.2
+
+ E . . . . . . . . . . . . . . edit 16.10
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.5
+
+ EchoOff . . . . . . . . . . . expr 19.17
+ EchoOn. . . . . . . . . . . . expr 19.17
+ EditF . . . . . . . . . . . . expr 16.10
+ EditFns . . . . . . . . . . . fexpr 16.10
+ EditP . . . . . . . . . . . . fexpr 16.11
+ EditV . . . . . . . . . . . . fexpr 16.11
+ Eject . . . . . . . . . . . . expr 12.10
+ Emacs . . . . . . . . . . . . expr 19.3
+ EMBED . . . . . . . . . . . . edit 16.11
+ Eq. . . . . . . . . . . . . . expr 4.5
+ EqCar . . . . . . . . . . . . expr 4.6
+ EqN . . . . . . . . . . . . . expr 4.5
+ EqStr . . . . . . . . . . . . expr 4.6
+ Equal . . . . . . . . . . . . expr 4.6
+ Error . . . . . . . . . . . . expr 14.2
+ ErrorPrintF . . . . . . . . . expr 12.10
+ ErrorSet. . . . . . . . . . . expr 14.2
+ ErrPrin . . . . . . . . . . . expr 12.8
+ Eval. . . . . . . . . . . . . expr 11.2
+ EvalInEnvironment . . . . . . expr 10.10
+ EvIn. . . . . . . . . . . . . expr 12.15
+ EvLis . . . . . . . . . . . . expr 11.5
+ EvOut . . . . . . . . . . . . expr 12.6
+ EvProgN . . . . . . . . . . . expr 11.6
+ EvShut. . . . . . . . . . . . expr 12.5
+ Exec. . . . . . . . . . . . . expr 19.3
+ Exit. . . . . . . . . . . . . macro 9.7
+ ExitLisp. . . . . . . . . . . expr 13.1, 19.14
+ Exp . . . . . . . . . . . . . expr 5.13
+ Expand. . . . . . . . . . . . expr 11.7
+ Explode2. . . . . . . . . . . expr 12.26
+ Explode . . . . . . . . . . . expr 12.26
+ ExprP . . . . . . . . . . . . expr 10.7
+ Expt. . . . . . . . . . . . . expr 5.3
+ Extended-Get. . . . . . . . . expr 17.25
+ Extended-Put. . . . . . . . . expr 17.25
+ EXTRACT . . . . . . . . . . . edit 16.11
+
+ F=. . . . . . . . . . . . . . edit 16.13
+ F . . . . . . . . . . . . . . edit 16.2, 16.12
+ Factorial . . . . . . . . . . expr 5.14
+ FaslEnd . . . . . . . . . . . expr 18.3
+ FaslIn. . . . . . . . . . . . expr 18.3
+ FaslOut . . . . . . . . . . . expr 18.2
+ FatalError. . . . . . . . . . expr 14.8
+ FCodeP. . . . . . . . . . . . expr 10.6
+ FExprP. . . . . . . . . . . . expr 10.7
+ FileP . . . . . . . . . . . . expr 12.5, 19.5
+ FindPrefix. . . . . . . . . . expr 6.4
+ FindSuffix. . . . . . . . . . expr 6.4
+ First . . . . . . . . . . . . macro 7.4
+ Fix . . . . . . . . . . . . . expr 5.2
Function Index 7 February 1983 PSL Manual
+page 25.6 section 25.0
+
+ FixP. . . . . . . . . . . . . expr 4.7
+ Flag1 . . . . . . . . . . . . expr 6.6
+ Flag. . . . . . . . . . . . . expr 6.6
+ FlagP . . . . . . . . . . . . expr 6.6
+ FLambdaLinkP. . . . . . . . . expr 10.6
+ FlatSize2 . . . . . . . . . . expr 12.27
+ FlatSize. . . . . . . . . . . expr 12.27
+ Float . . . . . . . . . . . . expr 5.2
+ FloatP. . . . . . . . . . . . expr 4.7
+ Floor . . . . . . . . . . . . expr 5.8
+ Fluid . . . . . . . . . . . . expr 10.8, 18.5
+ FluidP. . . . . . . . . . . . expr 10.9
+ FlushStdOutputBuffer. . . . . expr 19.17
+ For!* . . . . . . . . . . . . macro 9.13
+ For . . . . . . . . . . . . . macro 9.8
+ ForEach . . . . . . . . . . . macro 9.13
+ Fourth. . . . . . . . . . . . macro 7.5
+ FS. . . . . . . . . . . . . . edit 16.13
+ FStub . . . . . . . . . . . . macro 15.12
+ FUnBoundP . . . . . . . . . . expr 10.6
+ Function. . . . . . . . . . . fexpr 11.7
+
+ GenSym. . . . . . . . . . . . expr 6.3
+ Geq . . . . . . . . . . . . . expr 5.5
+ Get . . . . . . . . . . . . . expr 6.5
+ GetCDir . . . . . . . . . . . expr 19.6
+ GetD. . . . . . . . . . . . . expr 10.3
+ GetEnv. . . . . . . . . . . . expr 19.14
+ GetFCodePointer . . . . . . . expr 10.6
+ GetFork . . . . . . . . . . . expr 19.4
+ GetNewJfn . . . . . . . . . . expr 19.5
+ GetOldJfn . . . . . . . . . . expr 19.5
+ GetRescan . . . . . . . . . . expr 19.5
+ GetUName. . . . . . . . . . . expr 19.6
+ GetV. . . . . . . . . . . . . expr 8.3
+ Global. . . . . . . . . . . . expr 10.8, 18.6
+ GlobalP . . . . . . . . . . . expr 10.9
+ GmergeSort. . . . . . . . . . expr 17.22
+ Go. . . . . . . . . . . . . . fexpr 9.5
+ Graph-to-Tree . . . . . . . . expr 17.25
+ GraphicP. . . . . . . . . . . expr 8.8
+ GreaterP. . . . . . . . . . . expr 5.5
+ Gsort . . . . . . . . . . . . expr 17.22
+ GtBps . . . . . . . . . . . . expr 21.9
+ GtConstStr. . . . . . . . . . expr 21.8
+ GtFixN. . . . . . . . . . . . expr 21.9
+ GtFltN. . . . . . . . . . . . expr 21.9
+ GtHEAP. . . . . . . . . . . . expr 21.8
+ GtID. . . . . . . . . . . . . expr 21.9
+ GtJfn . . . . . . . . . . . . expr 19.6
+ GtStr . . . . . . . . . . . . expr 21.8
+ GtVect. . . . . . . . . . . . expr 21.8
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.7
+
+ GtWArray. . . . . . . . . . . expr 21.9
+ GtWrds. . . . . . . . . . . . expr 21.8
+
+ HAppend . . . . . . . . . . . expr 17.24
+ HCons . . . . . . . . . . . . macro 17.24
+ HCopy . . . . . . . . . . . . macro 17.24
+ HELP. . . . . . . . . . . . . edit 16.3, 16.13
+ Help. . . . . . . . . . . . . fexpr 13.7
+ HelpDir . . . . . . . . . . . expr 19.3
+ HighHalfWord. . . . . . . . . expr 19.8
+ Hist. . . . . . . . . . . . . nexpr 13.5
+ HList . . . . . . . . . . . . nexpr 17.24
+ HReverse. . . . . . . . . . . expr 17.25
+
+ I . . . . . . . . . . . . . . edit 16.13
+ Id2Int. . . . . . . . . . . . expr 4.10
+ Id2String . . . . . . . . . . expr 4.10
+ Id. . . . . . . . . . . . . . expr 22.10
+ IdApply0. . . . . . . . . . . expr 11.6
+ IdApply1. . . . . . . . . . . expr 11.6
+ IdApply2. . . . . . . . . . . expr 11.6
+ IdApply3. . . . . . . . . . . expr 11.6
+ IdApply4. . . . . . . . . . . expr 11.6
+ IdP . . . . . . . . . . . . . expr 4.7
+ IdSort. . . . . . . . . . . . expr 17.23
+ IF. . . . . . . . . . . . . . edit 16.13
+ If. . . . . . . . . . . . . . macro 9.2
+ If_System . . . . . . . . . . cmacro 19.1
+ IGetS . . . . . . . . . . . . expr 8.4
+ IGetV . . . . . . . . . . . . expr 8.4
+ Implode . . . . . . . . . . . expr 12.27
+ ImportForeignString . . . . . expr 19.16
+ Imports . . . . . . . . . . . expr 18.3
+ In. . . . . . . . . . . . . . macro 12.14
+ Incr. . . . . . . . . . . . . macro 5.3
+ IndexError. . . . . . . . . . expr 14.9
+ Indx. . . . . . . . . . . . . expr 8.5
+ InFile. . . . . . . . . . . . fexpr 19.6
+ Init-File-String. . . . . . . expr 13.3
+ Inp . . . . . . . . . . . . . expr 13.6
+ INSERT. . . . . . . . . . . . edit 16.13
+ Inspect . . . . . . . . . . . expr 17.26
+ Int!-Char . . . . . . . . . . expr 8.10
+ Int2Id. . . . . . . . . . . . expr 4.10
+ Int2Str . . . . . . . . . . . expr 19.8
+ Intern. . . . . . . . . . . . expr 4.9
+ InternGenSym. . . . . . . . . expr 6.3
+ InternP . . . . . . . . . . . expr 6.4
+ InterSection. . . . . . . . . expr 7.8
+ InterSectionQ . . . . . . . . expr 7.8
+ IPutS . . . . . . . . . . . . expr 8.5
+ IPutV . . . . . . . . . . . . expr 8.4
Function Index 7 February 1983 PSL Manual
+page 25.8 section 25.0
+
+ ISizeS. . . . . . . . . . . . expr 8.4
+ ISizeV. . . . . . . . . . . . expr 8.4
+
+ JBits . . . . . . . . . . . . expr 19.9
+ JConv . . . . . . . . . . . . expr 19.7
+ Jsys0 . . . . . . . . . . . . expr 19.7
+ Jsys1 . . . . . . . . . . . . expr 19.7
+ Jsys2 . . . . . . . . . . . . expr 19.7
+ Jsys3 . . . . . . . . . . . . expr 19.7
+ Jsys4 . . . . . . . . . . . . expr 19.7
+
+ KillFork. . . . . . . . . . . expr 19.4
+
+ LambdaApply . . . . . . . . . expr 11.5
+ LambdaEvalApply . . . . . . . expr 11.6
+ LAnd. . . . . . . . . . . . . expr 5.7
+ LAP . . . . . . . . . . . . . expr 18.10
+ LapIn . . . . . . . . . . . . expr 12.14
+ LastCar . . . . . . . . . . . expr 7.5
+ LastPair. . . . . . . . . . . expr 7.5
+ LBind1. . . . . . . . . . . . expr 10.9
+ LC. . . . . . . . . . . . . . edit 16.14
+ LCL . . . . . . . . . . . . . edit 16.14
+ LConc . . . . . . . . . . . . expr 7.7
+ Length. . . . . . . . . . . . expr 7.6
+ Leq . . . . . . . . . . . . . expr 5.5
+ LessP . . . . . . . . . . . . expr 5.6
+ Let!* . . . . . . . . . . . . macro 9.17
+ Let . . . . . . . . . . . . . macro 9.16
+ LI. . . . . . . . . . . . . . edit 16.14
+ LineLength. . . . . . . . . . expr 12.11
+ List2Set. . . . . . . . . . . expr 7.8
+ List2SetQ . . . . . . . . . . expr 7.8
+ List2String . . . . . . . . . expr 4.10
+ List2Vector . . . . . . . . . expr 4.11
+ List. . . . . . . . . . . . . fexpr 7.6
+ Liter . . . . . . . . . . . . expr 12.26
+ LNot. . . . . . . . . . . . . expr 5.7
+ LO. . . . . . . . . . . . . . edit 16.14
+ Load. . . . . . . . . . . . . macro 18.3
+ LoadTime. . . . . . . . . . . expr 18.5
+ Log10 . . . . . . . . . . . . expr 5.14
+ Log2. . . . . . . . . . . . . expr 5.14
+ Log . . . . . . . . . . . . . expr 5.13
+ LOr . . . . . . . . . . . . . expr 5.7
+ LowerCaseP. . . . . . . . . . expr 8.8
+ LowHalfWord . . . . . . . . . expr 19.8
+ LP. . . . . . . . . . . . . . edit 16.15
+ LPosn . . . . . . . . . . . . expr 12.11
+ LPQ . . . . . . . . . . . . . edit 16.15
+ LShift. . . . . . . . . . . . expr 5.7
+ LXOr. . . . . . . . . . . . . expr 5.7
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.9
+
+
+ M . . . . . . . . . . . . . . edit 16.15
+ MacroExpand . . . . . . . . . macro 17.14
+ MacroP. . . . . . . . . . . . expr 10.7
+ Main. . . . . . . . . . . . . expr 13.4
+ Make!-Bytes . . . . . . . . . expr 8.5
+ Make!-Halfwords . . . . . . . expr 8.5
+ Make!-String. . . . . . . . . expr 8.2
+ Make!-Vector. . . . . . . . . expr 8.3
+ Make!-Words . . . . . . . . . expr 8.5
+ MakeFCode . . . . . . . . . . expr 10.6
+ MakeFLambdaLink . . . . . . . expr 10.6
+ MAKEFN. . . . . . . . . . . . edit 16.16
+ MakeFUnBound. . . . . . . . . expr 10.6
+ MakeUnBound . . . . . . . . . expr 6.9
+ Map . . . . . . . . . . . . . expr 9.14
+ MapC. . . . . . . . . . . . . expr 9.14
+ MapCan. . . . . . . . . . . . expr 9.14
+ MapCar. . . . . . . . . . . . expr 9.14
+ MapCon. . . . . . . . . . . . expr 9.14
+ MapList . . . . . . . . . . . expr 9.15
+ MapObl. . . . . . . . . . . . expr 6.4
+ MARK. . . . . . . . . . . . . edit 16.16
+ Max2. . . . . . . . . . . . . expr 5.6
+ Max . . . . . . . . . . . . . macro 5.6
+ MBD . . . . . . . . . . . . . edit 16.17
+ Member. . . . . . . . . . . . expr 7.6
+ MemQ. . . . . . . . . . . . . expr 7.6
+ Min2. . . . . . . . . . . . . expr 5.6
+ Min . . . . . . . . . . . . . macro 5.6
+ Minus . . . . . . . . . . . . expr 5.4
+ MinusP. . . . . . . . . . . . expr 5.6
+ MkQuote . . . . . . . . . . . expr 11.7
+ MkString. . . . . . . . . . . expr 8.2
+ MkVect. . . . . . . . . . . . expr 8.3
+ MM. . . . . . . . . . . . . . expr 19.4
+ Mod . . . . . . . . . . . . . expr 5.9
+ MOVE. . . . . . . . . . . . . edit 16.17
+
+ N . . . . . . . . . . . . . . edit 16.18
+ NameFromJfn . . . . . . . . . expr 19.6
+ NConc . . . . . . . . . . . . expr 7.7
+ NCons . . . . . . . . . . . . expr 7.3
+ Ne. . . . . . . . . . . . . . expr 4.6
+ Neq . . . . . . . . . . . . . macro 4.6
+ NewId . . . . . . . . . . . . expr 4.9
+ NewTrBuff . . . . . . . . . . expr 15.6
+ NEX . . . . . . . . . . . . . edit 16.18
+ NExprP. . . . . . . . . . . . expr 10.7
+ Next. . . . . . . . . . . . . macro 9.7
+ NonCharacterError . . . . . . expr 14.10
+ NonIDError. . . . . . . . . . expr 14.9
Function Index 7 February 1983 PSL Manual
+page 25.10 section 25.0
+
+ NonIntegerError . . . . . . . expr 14.9
+ NonNumberError. . . . . . . . expr 14.9
+ NonPairError. . . . . . . . . expr 14.9
+ NonPositiveIntegerError . . . expr 14.10
+ NonSequenceError. . . . . . . expr 14.10
+ NonStringError. . . . . . . . expr 14.10
+ NonVectorError. . . . . . . . expr 14.10
+ Not . . . . . . . . . . . . . expr 4.8
+ NString!-Capitalize . . . . . expr 8.13
+ NString!-DownCase . . . . . . expr 8.13
+ NString!-UpCase . . . . . . . expr 8.13
+ NTH . . . . . . . . . . . . . edit 16.18
+ Nth . . . . . . . . . . . . . expr 7.5
+ Null. . . . . . . . . . . . . expr 4.7
+ Num . . . . . . . . . . . . . expr 22.10
+ NumberP . . . . . . . . . . . expr 4.7
+ NX. . . . . . . . . . . . . . edit 16.19
+
+ Off . . . . . . . . . . . . . macro 6.14
+ OK. . . . . . . . . . . . . . edit 16.3, 16.19
+ On. . . . . . . . . . . . . . macro 6.14
+ OneP. . . . . . . . . . . . . expr 5.6
+ Open. . . . . . . . . . . . . expr 12.4
+ OpenFork. . . . . . . . . . . expr 19.4
+ OpenNewJfn. . . . . . . . . . expr 19.5
+ OpenOldJfn. . . . . . . . . . expr 19.5
+ Or. . . . . . . . . . . . . . fexpr 4.9
+ ORF . . . . . . . . . . . . . edit 16.19
+ ORR . . . . . . . . . . . . . edit 16.19
+ Out . . . . . . . . . . . . . macro 12.5
+
+ P . . . . . . . . . . . . . . edit 16.1, 16.20
+ Pair. . . . . . . . . . . . . expr 7.11
+ PairP . . . . . . . . . . . . expr 4.8
+ Path. . . . . . . . . . . . . expr 19.13
+ PathIn. . . . . . . . . . . . expr 12.15
+ Pause . . . . . . . . . . . . expr 13.8
+ PBind1. . . . . . . . . . . . expr 10.10
+ PL. . . . . . . . . . . . . . edit 16.1
+ PList . . . . . . . . . . . . macro 15.12
+ Plus2 . . . . . . . . . . . . expr 5.4
+ Plus. . . . . . . . . . . . . macro 5.4
+ PNth. . . . . . . . . . . . . expr 7.5
+ Pop . . . . . . . . . . . . . macro 17.15
+ Posn. . . . . . . . . . . . . expr 12.11
+ PP. . . . . . . . . . . . . . edit 16.21
+ Ppf . . . . . . . . . . . . . macro 15.12
+ PrettyPrint . . . . . . . . . expr 12.11
+ Prin1 . . . . . . . . . . . . expr 12.8
+ Prin2 . . . . . . . . . . . . expr 12.8
+ Prin2L. . . . . . . . . . . . expr 12.11
+ Prin2T. . . . . . . . . . . . expr 12.12
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.11
+
+ PrinC . . . . . . . . . . . . expr 12.8
+ Print . . . . . . . . . . . . expr 12.8
+ PrintF. . . . . . . . . . . . expr 12.10
+ PrintScanTable. . . . . . . . expr 12.25
+ PrintX. . . . . . . . . . . . expr 15.13
+ Prog1 . . . . . . . . . . . . macro 9.5
+ Prog2 . . . . . . . . . . . . expr 9.5
+ Prog. . . . . . . . . . . . . fexpr 9.5
+ ProgN . . . . . . . . . . . . fexpr 9.4
+ Prop. . . . . . . . . . . . . expr 6.7
+ PSetF . . . . . . . . . . . . macro 6.9
+ PSetQ . . . . . . . . . . . . macro 6.8
+ Push. . . . . . . . . . . . . macro 17.14
+ Put . . . . . . . . . . . . . expr 6.5
+ PutByte . . . . . . . . . . . expr 20.11
+ PutD. . . . . . . . . . . . . expr 10.2
+ PutDipthong . . . . . . . . . expr 12.25
+ PutReadMacro. . . . . . . . . expr 12.25
+ PutRescan . . . . . . . . . . expr 19.5
+ PutV. . . . . . . . . . . . . expr 8.3
+ Pwd . . . . . . . . . . . . . expr 19.13
+
+ Quit. . . . . . . . . . . . . expr 13.1
+ Quote . . . . . . . . . . . . fexpr 11.6
+ Quotient. . . . . . . . . . . expr 5.4
+
+ R . . . . . . . . . . . . . . edit 16.2, 16.21
+ RadiansToDegrees. . . . . . . expr 5.9
+ RadiansToDMS. . . . . . . . . expr 5.9
+ Random. . . . . . . . . . . . expr 5.14
+ RangeError. . . . . . . . . . expr 14.9
+ RAtom . . . . . . . . . . . . expr 12.21
+ Rds . . . . . . . . . . . . . expr 12.5
+ Read-Init-File. . . . . . . . expr 13.3
+ Read. . . . . . . . . . . . . expr 12.13
+ ReadCH. . . . . . . . . . . . expr 12.16
+ ReadChar. . . . . . . . . . . expr 12.16
+ Recip . . . . . . . . . . . . expr 5.4
+ Reclaim . . . . . . . . . . . expr 21.8
+ RecopyStringToNULL. . . . . . expr 19.8
+ ReDo. . . . . . . . . . . . . expr 13.6
+ RelJfn. . . . . . . . . . . . expr 19.5
+ ReLoad. . . . . . . . . . . . macro 18.3
+ Remainder . . . . . . . . . . expr 5.4
+ RemD. . . . . . . . . . . . . expr 10.4
+ RemFlag1. . . . . . . . . . . expr 6.6
+ RemFlag . . . . . . . . . . . expr 6.6
+ RemOb . . . . . . . . . . . . expr 6.4
+ RemProp . . . . . . . . . . . expr 6.5
+ RemPropL. . . . . . . . . . . expr 6.5
+ REPACK. . . . . . . . . . . . edit 16.21
+ Repeat. . . . . . . . . . . . macro 9.7
Function Index 7 February 1983 PSL Manual
+page 25.12 section 25.0
+
+ ResBtr. . . . . . . . . . . . expr 15.10
+ Reset . . . . . . . . . . . . expr 13.2, 19.4
+ Rest. . . . . . . . . . . . . macro 7.5
+ RestoreEnvironment. . . . . . expr 10.11
+ Restr . . . . . . . . . . . . expr 15.9
+ Return. . . . . . . . . . . . expr 9.6
+ Reverse . . . . . . . . . . . expr 7.9
+ ReversIP. . . . . . . . . . . expr 7.10
+ RI. . . . . . . . . . . . . . edit 16.22
+ RLisp . . . . . . . . . . . . expr 13.6
+ RO. . . . . . . . . . . . . . edit 16.22
+ Round . . . . . . . . . . . . expr 5.8
+ RplacA. . . . . . . . . . . . expr 7.4
+ RplacD. . . . . . . . . . . . expr 7.4
+ RplaChar. . . . . . . . . . . expr 8.10
+ RplacW. . . . . . . . . . . . expr 7.4
+ RPrint. . . . . . . . . . . . expr 12.11
+ Run . . . . . . . . . . . . . expr 19.3
+ RunFork . . . . . . . . . . . expr 19.4
+
+ S . . . . . . . . . . . . . . edit 16.22
+ SAssoc. . . . . . . . . . . . expr 7.10
+ SAVE. . . . . . . . . . . . . edit 16.22
+ SaveSystem. . . . . . . . . . expr 13.2
+ Sec . . . . . . . . . . . . . expr 5.11
+ SecD. . . . . . . . . . . . . expr 5.11
+ SECOND. . . . . . . . . . . . edit 16.23
+ Second. . . . . . . . . . . . macro 7.5
+ Set . . . . . . . . . . . . . expr 6.7
+ SetF. . . . . . . . . . . . . macro 6.8
+ SetIndx . . . . . . . . . . . expr 8.6
+ SetProp . . . . . . . . . . . expr 6.7
+ SetQ. . . . . . . . . . . . . fexpr 6.7
+ SetSub. . . . . . . . . . . . expr 8.6
+ SetSubSeq . . . . . . . . . . expr 8.6
+ Shut. . . . . . . . . . . . . macro 12.5
+ Sin . . . . . . . . . . . . . expr 5.10
+ SinD. . . . . . . . . . . . . expr 5.10
+ Size. . . . . . . . . . . . . expr 8.5
+ Spaces. . . . . . . . . . . . expr 12.12
+ Sqrt. . . . . . . . . . . . . expr 5.13
+ Standard!-CharP . . . . . . . expr 8.7
+ StandardLisp. . . . . . . . . expr 13.6
+ StartFork . . . . . . . . . . expr 19.4
+ StdError. . . . . . . . . . . expr 14.9
+ StdTrace. . . . . . . . . . . expr 15.7
+ Step. . . . . . . . . . . . . expr 15.3
+ STOP. . . . . . . . . . . . . edit 16.23
+ Str2Int . . . . . . . . . . . expr 19.8
+ Str . . . . . . . . . . . . . expr 22.11
+ String!-Capitalize. . . . . . expr 8.13
+ String!-CharP . . . . . . . . expr 8.8
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.13
+
+ String!-DownCase. . . . . . . expr 8.13
+ String!-Equal . . . . . . . . expr 8.11
+ String!-GreaterP. . . . . . . expr 8.11
+ String!-Left!-Trim. . . . . . expr 8.12
+ String!-Length. . . . . . . . expr 8.13
+ String!-LessP . . . . . . . . expr 8.11
+ String!-Not!-Equal. . . . . . expr 8.12
+ String!-Not!-GreaterP . . . . expr 8.12
+ String!-Not!-LessP. . . . . . expr 8.12
+ String!-Repeat. . . . . . . . expr 8.12
+ String!-Right!-Trim . . . . . expr 8.12
+ String!-to!-List. . . . . . . expr 8.13
+ String!-to!-Vector. . . . . . expr 8.13
+ String!-Trim. . . . . . . . . expr 8.12
+ String!-UpCase. . . . . . . . expr 8.12
+ String!<!=. . . . . . . . . . expr 8.11
+ String!<!>. . . . . . . . . . expr 8.11
+ String!<. . . . . . . . . . . expr 8.11
+ String!=. . . . . . . . . . . expr 8.11
+ String!>!=. . . . . . . . . . expr 8.11
+ String!>. . . . . . . . . . . expr 8.11
+ String2List . . . . . . . . . expr 4.10
+ String2Vector . . . . . . . . expr 4.11
+ String. . . . . . . . . . . . nexpr 4.11, 8.2
+ StringGenSym. . . . . . . . . expr 6.3
+ StringP . . . . . . . . . . . expr 4.8
+ Stub. . . . . . . . . . . . . macro 15.12
+ Sub1. . . . . . . . . . . . . expr 5.5
+ Sub . . . . . . . . . . . . . expr 8.6
+ SublA . . . . . . . . . . . . expr 7.12
+ SubLis. . . . . . . . . . . . expr 7.11
+ SubSeq. . . . . . . . . . . . expr 8.6
+ Subst . . . . . . . . . . . . expr 7.11
+ SubstIP . . . . . . . . . . . expr 7.11
+ SubString . . . . . . . . . . expr 8.13
+ SubTypeP. . . . . . . . . . . expr 17.16
+ SW. . . . . . . . . . . . . . edit 16.23
+ Swap. . . . . . . . . . . . . expr 19.8
+ Sys . . . . . . . . . . . . . expr 19.3
+ System. . . . . . . . . . . . expr 19.14
+
+ T . . . . . . . . . . . . . . edit 16.2
+ Tab . . . . . . . . . . . . . expr 12.12
+ Take. . . . . . . . . . . . . expr 19.3
+ Tan . . . . . . . . . . . . . expr 5.10
+ TanD. . . . . . . . . . . . . expr 5.10
+ TConc . . . . . . . . . . . . expr 7.7
+ TerPri. . . . . . . . . . . . expr 12.10
+ TEST. . . . . . . . . . . . . edit 16.23
+ THIRD . . . . . . . . . . . . edit 16.23
+ Third . . . . . . . . . . . . macro 7.5
+ THROUGH . . . . . . . . . . . edit 16.24
Function Index 7 February 1983 PSL Manual
+page 25.14 section 25.0
+
+ Throw . . . . . . . . . . . . expr 9.18
+ Time. . . . . . . . . . . . . expr 13.2
+ Times2. . . . . . . . . . . . expr 5.5
+ Times . . . . . . . . . . . . macro 5.5
+ TO. . . . . . . . . . . . . . edit 16.24
+ TopLoop . . . . . . . . . . . expr 13.4
+ TotalCopy . . . . . . . . . . expr 8.7
+ Tr. . . . . . . . . . . . . . macro 15.3, 15.5
+ TraceCount. . . . . . . . . . expr 15.7
+ TransferSign. . . . . . . . . expr 5.9
+ TrCnt . . . . . . . . . . . . macro 15.12
+ TrIn. . . . . . . . . . . . . macro 15.8
+ TrOut . . . . . . . . . . . . expr 15.7
+ Trst. . . . . . . . . . . . . macro 15.3, 15.6
+ TTY:. . . . . . . . . . . . . edit 16.24
+ Type. . . . . . . . . . . . . expr 19.3
+ TypeError . . . . . . . . . . expr 14.9
+
+ UnBindN . . . . . . . . . . . expr 10.9
+ UNBLOCK . . . . . . . . . . . edit 16.24
+ UnBoundP. . . . . . . . . . . expr 6.10, 10.9
+ UNDO. . . . . . . . . . . . . edit 16.25
+ UnFluid . . . . . . . . . . . expr 10.9
+ Union . . . . . . . . . . . . expr 7.8
+ UnionQ. . . . . . . . . . . . expr 7.8
+ Unless. . . . . . . . . . . . macro 9.3
+ UnQuote . . . . . . . . . . . fexpr 17.13
+ UnQuoteL. . . . . . . . . . . fexpr 17.13
+ UnReadChar. . . . . . . . . . expr 12.16
+ UnTr. . . . . . . . . . . . . macro 15.3, 15.9
+ UnTrst. . . . . . . . . . . . macro 15.3, 15.9
+ Unwind!-All . . . . . . . . . macro 9.19
+ Unwind!-Protect . . . . . . . macro 9.19
+ UP. . . . . . . . . . . . . . edit 16.2, 16.25
+ UpbV. . . . . . . . . . . . . expr 8.4
+ UpperCaseP. . . . . . . . . . expr 8.8
+ UsageTypeError. . . . . . . . expr 14.9
+ User-HomeDir-String . . . . . expr 13.3
+
+ ValueCell . . . . . . . . . . expr 6.9
+ VDir. . . . . . . . . . . . . expr 19.3
+ Vector2List . . . . . . . . . expr 4.11
+ Vector2String . . . . . . . . expr 4.11
+ Vector. . . . . . . . . . . . nexpr 4.11, 8.4
+ VectorP . . . . . . . . . . . expr 4.8
+
+ WaitFork. . . . . . . . . . . expr 19.4
+ WAnd. . . . . . . . . . . . . expr 20.10
+ WDifference . . . . . . . . . expr 20.10
+ WEQ . . . . . . . . . . . . . expr 20.10
+ WGEQ. . . . . . . . . . . . . expr 20.10
+ WGetV . . . . . . . . . . . . macro 20.11
PSL Manual 7 February 1983 Function Index
+section 25.0 page 25.15
+
+ WGreaterP . . . . . . . . . . expr 20.10
+ When. . . . . . . . . . . . . macro 9.3
+ While . . . . . . . . . . . . macro 9.6
+ WLEQ. . . . . . . . . . . . . expr 20.11
+ WLessP. . . . . . . . . . . . expr 20.10
+ WNEQ. . . . . . . . . . . . . expr 20.10
+ WNot. . . . . . . . . . . . . expr 20.10
+ WOr . . . . . . . . . . . . . expr 20.10
+ WPlus2. . . . . . . . . . . . expr 20.10
+ WPutV . . . . . . . . . . . . macro 20.11
+ WQuotient . . . . . . . . . . expr 20.10
+ WRemainder. . . . . . . . . . expr 20.10
+ WriteChar . . . . . . . . . . expr 12.6
+ Wrs . . . . . . . . . . . . . expr 12.5
+ WShift. . . . . . . . . . . . expr 20.10
+ WTimes2 . . . . . . . . . . . expr 20.10
+ WXor. . . . . . . . . . . . . expr 20.10
+
+ XCons . . . . . . . . . . . . expr 7.3
+ XJsys0. . . . . . . . . . . . expr 19.6
+ XJsys1. . . . . . . . . . . . expr 19.7
+ XJsys2. . . . . . . . . . . . expr 19.7
+ XJsys3. . . . . . . . . . . . expr 19.7
+ XJsys4. . . . . . . . . . . . expr 19.7
+ XTR . . . . . . . . . . . . . edit 16.25
+ Xword . . . . . . . . . . . . expr 19.8
+
+ YesP. . . . . . . . . . . . . expr 13.8
+
+ ZeroP . . . . . . . . . . . . expr 5.6
ADDED psl-1983/3-1/lpt/26-glo-index.lpt
Index: psl-1983/3-1/lpt/26-glo-index.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/lpt/26-glo-index.lpt
@@ -0,0 +1,157 @@
+PSL Manual 7 February 1983 Global Index
+section 26.0 page 26.1
+
+ CHAPTER 26
CHAPTER 26
CHAPTER 26
+ INDEX OF GLOBALS AND SWITCHES
INDEX OF GLOBALS AND SWITCHES
INDEX OF GLOBALS AND SWITCHES
+
+ The following is an alphabetical list of the PSL global variables, with
+the page on which they are defined.
+
+
+ !$BREAK!$ . . . . . . . . . . global 14.8
+ !$ERROR!$ . . . . . . . . . . global 14.1, 14.2
+ !*BACKTRACE . . . . . . . . . switch 14.1, 14.2
+ !*BREAK . . . . . . . . . . . switch 14.4, 14.8
+ !*BTR . . . . . . . . . . . . switch 15.10
+ !*BTRSAVE . . . . . . . . . . switch 15.10
+ !*COMP. . . . . . . . . . . . switch 10.3, 18.2
+ !*COMPRESSING . . . . . . . . switch 12.13, 12.16, 12.21
+ !*ContinuableError. . . . . . switch 14.3
+ !*CREFSUMMARY . . . . . . . . switch 17.3
+ !*DEFN. . . . . . . . . . . . switch 18.3
+ !*ECHO. . . . . . . . . . . . switch 12.2, 12.14
+ !*EMsgP . . . . . . . . . . . switch 13.5
+ !*EOLINSTRINGOK . . . . . . . switch 12.21
+ !*ERFG. . . . . . . . . . . . switch 18.23
+ !*GC. . . . . . . . . . . . . switch 21.7
+ !*INSTALL . . . . . . . . . . switch 15.10, 15.14
+ !*INSTALLDESTROY. . . . . . . switch 18.23
+ !*INT . . . . . . . . . . . . switch 18.23
+ !*MODULE. . . . . . . . . . . switch 18.7
+ !*MSGP. . . . . . . . . . . . switch 14.2
+ !*NOFRAMEFLUID. . . . . . . . switch 18.23
+ !*NOLINKE . . . . . . . . . . switch 18.6
+ !*NOTRARGS. . . . . . . . . . switch 15.6
+ !*ORD . . . . . . . . . . . . switch 18.6
+ !*PECHO . . . . . . . . . . . switch 13.5
+ !*PGWD. . . . . . . . . . . . switch 18.13
+ !*PLAP. . . . . . . . . . . . switch 18.7, 18.13
+ !*PVAL. . . . . . . . . . . . switch 13.5
+ !*PWRDS . . . . . . . . . . . switch 18.7, 18.13
+ !*R2I . . . . . . . . . . . . switch 18.6
+ !*RAISE . . . . . . . . . . . switch 12.19, 12.21
+ !*REDEFMSG. . . . . . . . . . switch 10.3
+ !*SAVECOM . . . . . . . . . . switch 18.13
+ !*SAVEDEF . . . . . . . . . . switch 18.13
+ !*SAVENAMES . . . . . . . . . switch 15.14
+ !*SHOWDEST. . . . . . . . . . switch 18.23
+ !*SYSLISP . . . . . . . . . . switch 18.24
+ !*TIME. . . . . . . . . . . . switch 13.5
+ !*TRACE . . . . . . . . . . . switch 15.7
+ !*TRACEALL. . . . . . . . . . switch 15.10, 15.14
+ !*TRCOUNT . . . . . . . . . . switch 15.11
+ !*UNSAFEBINDER. . . . . . . . switch 18.24
+ !*USEREGFLUID . . . . . . . . switch 18.24
+ !*USERMODE. . . . . . . . . . switch 10.3
Global Index 7 February 1983 PSL Manual
+page 26.2 section 26.0
+
+
+ \CURRENTPACKAGE!* . . . . . . global 6.10
+ \PACKAGENAMES!* . . . . . . . global 6.10
+
+ BREAKEVALUATOR!*. . . . . . . global 14.4
+ BreakIn!* . . . . . . . . . . global 12.3, 14.8
+ BreakLevel!*. . . . . . . . . global 14.4
+ BreakOut!*. . . . . . . . . . global 12.3, 14.8
+ BREAKPRINTER!*. . . . . . . . global 14.4
+ BREAKREADER!* . . . . . . . . global 14.4
+
+ CRLF. . . . . . . . . . . . . global 19.2
+ CurrentReadMacroIndicator!* . global 12.17
+ CurrentScanTable!*. . . . . . global 12.17, 12.18, 12.21, 12.25
+
+ Date!*. . . . . . . . . . . . global 13.3
+ DFPRINT!* . . . . . . . . . . global 18.3
+
+ EMSG!*. . . . . . . . . . . . global 14.2
+ ERRORFORM!* . . . . . . . . . global 14.3, 14.4, 14.5
+ ERRORHANDLERS!* . . . . . . . global 14.10
+ ERROUT!*. . . . . . . . . . . global 12.4, 12.10
+
+ GCKNT!* . . . . . . . . . . . global 21.7
+ GCTime!*. . . . . . . . . . . global 13.5
+
+ HelpIn!*. . . . . . . . . . . global 12.3, 13.7
+ HelpOut!* . . . . . . . . . . global 12.3, 13.7
+ HistoryCount!*. . . . . . . . global 13.6
+ HistoryList!* . . . . . . . . global 13.6
+
+ IgnoredInBacktrace!*. . . . . global 14.5
+ IN!*. . . . . . . . . . . . . global 12.3, 12.5, 12.13
+ InitForms!* . . . . . . . . . global 13.5
+ InterpreterFunctions!*. . . . global 14.5
+
+ LASTACTUALREG . . . . . . . . global 18.24
+ LispBanner!*. . . . . . . . . global 13.2
+ LISPSCANTABLE!* . . . . . . . global 12.21
+ LoadDirectories!* . . . . . . global 18.4
+ LoadExtensions!*. . . . . . . global 18.4
+
+ MaxBreakLevel!* . . . . . . . global 14.4
+ MAXLEVEL. . . . . . . . . . . global 16.12
+ MAXNARGS. . . . . . . . . . . global 18.24
+
+ NIL . . . . . . . . . . . . . global 6.15
+ NOLIST!*. . . . . . . . . . . global 17.3
+
+ OPTIONS!* . . . . . . . . . . global 18.3
+ OUT!* . . . . . . . . . . . . global 12.3, 12.5
+ OUTPUTBASE!*. . . . . . . . . global 12.20, 12.24
PSL Manual 7 February 1983 Global Index
+section 26.0 page 26.3
+
+
+ PATHIN!*. . . . . . . . . . . global 12.15
+ PLEVEL. . . . . . . . . . . . global 16.1
+ PPFPRINTER!*. . . . . . . . . global 15.15
+ PrinLength. . . . . . . . . . global 12.12
+ PrinLevel . . . . . . . . . . global 12.12
+ PROMPTSTRING!*. . . . . . . . global 12.4
+ PROPERTYPRINTER!* . . . . . . global 15.15
+ PUTDHOOK!*. . . . . . . . . . global 15.14
+
+ RandomSeed. . . . . . . . . . global 5.14
+ RLISPSCANTABLE!*. . . . . . . global 12.21, 12.22
+
+ SPECIALCLOSEFUNCTION!*. . . . global 12.4, 12.6
+ SPECIALRDSACTION!*. . . . . . global 12.5, 12.6
+ SPECIALREADFUNCTION!* . . . . global 12.4, 12.6
+ SPECIALWRITEFUNCTION!*. . . . global 12.4, 12.6
+ SPECIALWRSACTION!*. . . . . . global 12.5, 12.6
+ StartupName!* . . . . . . . . global 19.17
+ STDIN!* . . . . . . . . . . . global 12.2, 12.3, 12.5
+ STDOUT!*. . . . . . . . . . . global 12.2, 12.3, 12.5
+ STUBPRINTER!* . . . . . . . . global 15.15
+ STUBREADER!*. . . . . . . . . global 15.15
+ SymbolFileName!*. . . . . . . global 19.16
+
+ T . . . . . . . . . . . . . . global 6.15
+ ThrowSignal!* . . . . . . . . global 9.17
+ ThrowTag!*. . . . . . . . . . global 9.17
+ TOKTYPE!* . . . . . . . . . . global 12.16, 12.24
+ TopLoopEval!* . . . . . . . . global 13.4, 14.8
+ TopLoopLevel!*. . . . . . . . global 13.5
+ TopLoopName!* . . . . . . . . global 13.4
+ TopLoopPrint!*. . . . . . . . global 13.4, 14.8
+ TopLoopRead!* . . . . . . . . global 13.4, 14.8
+ TRACEMAXLEVEL!* . . . . . . . global 15.8
+ TRACEMINLEVEL!* . . . . . . . global 15.8
+ TRACENTRYHOOK!* . . . . . . . global 15.14
+ TRACEXITHOOK!*. . . . . . . . global 15.14
+ TRACEXPANDHOOK!*. . . . . . . global 15.15
+ TREXPRINTER!* . . . . . . . . global 15.15
+ TRINSTALLHOOK!* . . . . . . . global 15.15
+ TRPRINTER!* . . . . . . . . . global 15.16
+ TRSPACE!* . . . . . . . . . . global 15.16
+
+ UnixArgs!*. . . . . . . . . . global 19.17
+ UPFINDFLG . . . . . . . . . . global 16.12
ADDED psl-1983/3-1/minimal-logical-names.cmd
Index: psl-1983/3-1/minimal-logical-names.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/minimal-logical-names.cmd
@@ -0,0 +1,27 @@
+; Officially recognized logical names for MINIMAL
+; PSL system, in single directory
+; EDIT <psl> into <name> as appropriate
+define psl: <psl> ! Executable files and miscellaneous
+;define pc: <psl> ! Compiler sources
+;define p20c: <psl> ! 20 Specific Compiler sources
+;define pdist: <psl> ! Distribution files
+;define pd: <psl> ! Documentation files
+;define p20d: <psl> ! 20 Specific Documentation files
+;define pndoc: <psl> ! NMODE Documentation files
+; not distributed define pe: <psl> ! EMODE support and drivers
+;define pg: <psl> ! GLISP source
+define ph: <psl> ! Help files
+;define pk: <psl> ! Kernel Source files
+;define p20k: <psl> ! 20 Specific Kernel Sources
+define pl: <psl> ! LAP files
+;define plpt: <psl> ! Printer version of Documentation
+;define pn: <psl> ! NMODE editor files
+define pnb: <psl> ! NMODE editor binaries
+;define pnk: <psl> ! PSL Non Kernel source files
+;define pt: <psl> ! PSL Test files
+;define p20t: <psl> ! PSL 20 Specific Test files
+;define pu: <psl> ! Utility program sources
+;define p20u: <psl> ! 20 specific Utility files
+;define pw: <psl> ! NMODE Window files
+define pwb: <psl> ! NMODE Window binaries
+take
ADDED psl-1983/3-1/minimal-restore.ctl
Index: psl-1983/3-1/minimal-restore.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/minimal-restore.ctl
@@ -0,0 +1,54 @@
+; Used to retrieve subset of ssnames for MINIMAL PSL system
+; First edit MINIMAL-LOGICAL-NAMES.CMD to reflect <name>
+; then TAKE to install names
+; then BUILD sub-directories or single directory
+; then mount TAPE, def X:
+@DUMPER
+*tape X:
+*density 1600
+*files
+*account system-default
+
+*; --- Skip over the logical names etc to do the restore.
+*skip 1
+*restore dsk*:<*>*.*.* PSL:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* PC:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* P20C:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* PDIST:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* PD:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* P20D:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* PNDOC:*.*.*
+*skip 1
+; --- not distributed anymore --- *restore dsk*:<*>*.*.* pe:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* pg:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* ph:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* pk:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* p20:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* pl:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* plpt:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pn:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* pnb:*.*.*
+; --- not needed --- *restore dsk*:<*>*.*.* pnk:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pT:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* p20T:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pu:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* p20u:*.*.*
+*skip 1
+; --- not needed --- *restore dsk*:<*>*.*.* pw:*.*.*
+*skip 1
+*restore dsk*:<*>*.*.* pwb:*.*.*
+
ADDED psl-1983/3-1/nmode/-file.list
Index: psl-1983/3-1/nmode/-file.list
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/-file.list
@@ -0,0 +1,53 @@
+NMODE Source Files Summary - 15 February 1983
+-------------------------------------------------------------------------------
+AUTOFILL.SL - auto fill mode
+BROWSER.SL - browser object definition
+BROWSER-SUPPORT.SL - general support functions for browsers
+BUFFER-BROWSER.SL - the buffer browser (C-X C-B)
+BUFFER-IO.SL - support for PSL I/O to and from text buffers
+BUFFER-POSITION.SL - type representing (line,char) pairs
+BUFFER-WINDOW.SL - abstract data type mapping text buffer to virtual screen
+BUFFER.SL - auxiliary functions for operating on the current buffer
+BUFFERS.SL - functions managing set of existing buffers
+CASE-COMMANDS.SL - commands for changing the case of text
+COMMAND-INPUT.SL - functions for command input
+COMMANDS.SL - miscellaneous editor commands
+DEFUN-COMMANDS.SL - editor commands related to top-level definitions in code
+DIRED.SL - directory edit subsystem
+DISPATCH.SL - command dispatch table manager
+DOC.SL - online documentation facility
+EXTENDED-INPUT.SL - functions for reading extended characters
+FILEIO.SL - functions for I/O to and from files
+INCR.SL - incremental search command
+INDENT-COMMANDS.SL - editor commands relating to indentation
+KILL-COMMANDS.SL - editor commands relating to killing text
+LISP-COMMANDS.SL - miscellaneous editor commands relating to lisp code
+LISP-INDENTING.SL - commands and functions for indenting lisp code
+LISP-INTERFACE.SL - interaction between NMODE and Lisp (including MAIN)
+LISP-PARSER.SL - basic parser for Lisp code
+M-X.SL - the M-X command reader
+M-XCMD.SL - miscellaneous extended commands
+MODE-DEFS.SL - definitions of standard modes
+MODES.SL - mode definition functions
+MOVE-COMMANDS.SL - editor commands relating to cursor motion
+NMODE-20.SL - system dependent functions for Dec-20
+NMODE-9836.SL - system dependent functions for HP9836
+NMODE-ATTRIBUTES.SL - macros for constructing parsing attributes
+NMODE-BREAK.SL - NMODE's break handler
+NMODE-INIT.SL - initialization code
+NMODE-PARSING.SL - primitive functions for parsing source code
+PROMPTING.SL - string input and basic prompt line functions
+QUERY-REPLACE.SL - query-replace subsystem
+READER.SL - NMODE command reader
+REC.SL - recursive editing functions
+SCREEN-LAYOUT.SL - functions managing overall NMODE screen layout
+SEARCH.SL. - searching functions
+SET-TERMINAL-20.SL - Dec-20 terminal driver selection
+SET-TERMINAL-9836.SL - HP9836 terminal driver selection
+SOFTKEYS.SL - NMode softkeys (Esc-/)
+STRUCTURE-FUNCTIONS.SL - functions for moving about structured text
+TERMINAL-INPUT.SL - terminal input functions, including prompted input
+TEXT-BUFFER.SL - text buffer abstract data type
+TEXT-COMMANDS.SL - sentence, paragraph, and formatting stuff
+WINDOW.SL - auxiliary functions for manipulating the current window
+WINDOW-LABEL.SL - manages label area of a window
ADDED psl-1983/3-1/nmode/-nmode.files
Index: psl-1983/3-1/nmode/-nmode.files
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/-nmode.files
@@ -0,0 +1,54 @@
+NMODE Source Files Summary - 5 April 1983
+-------------------------------------------------------------------------------
+AUTOFILL.SL - auto fill mode
+BROWSER-BROWSER.SL - the browser browser
+BROWSER-SUPPORT.SL - general support functions for browsers
+BROWSER.SL - browser object definition
+BUFFER-BROWSER.SL - the buffer browser (C-X C-B)
+BUFFER-IO.SL - support for PSL I/O to and from text buffers
+BUFFER-POSITION.SL - type representing (line,char) pairs
+BUFFER-WINDOW.SL - abstract data type mapping text buffer to virtual screen
+BUFFER.SL - auxiliary functions for operating on the current buffer
+BUFFERS.SL - functions managing set of existing buffers
+CASE-COMMANDS.SL - commands for changing the case of text
+COMMAND-INPUT.SL - functions for command input
+COMMANDS.SL - miscellaneous editor commands
+DEFUN-COMMANDS.SL - editor commands related to top-level definitions in code
+DIRED.SL - directory edit subsystem
+DISPATCH.SL - command dispatch table manager
+DOC.SL - online documentation facility
+EXTENDED-INPUT.SL - functions for reading extended characters
+FILEIO.SL - functions for I/O to and from files
+HP9836-DEV.SL - development support for 9836
+INCR.SL - incremental search command
+INDENT-COMMANDS.SL - editor commands relating to indentation
+KILL-COMMANDS.SL - editor commands relating to killing text
+LISP-COMMANDS.SL - miscellaneous editor commands relating to lisp code
+LISP-INDENTING.SL - commands and functions for indenting lisp code
+LISP-INTERFACE.SL - interaction between NMODE and Lisp (including MAIN)
+LISP-PARSER.SL - basic parser for Lisp code
+M-X.SL - the M-X command reader
+M-XCMD.SL - miscellaneous extended commands
+MODE-DEFS.SL - definitions of standard modes
+MODES.SL - mode definition functions
+MOVE-COMMANDS.SL - editor commands relating to cursor motion
+NMODE-20.SL - system dependent functions for Dec-20
+NMODE-9836.SL - system dependent functions for HP9836
+NMODE-ATTRIBUTES.SL - macros for constructing parsing attributes
+NMODE-BREAK.SL - NMODE's break handler
+NMODE-INIT.SL - initialization code
+NMODE-PARSING.SL - primitive functions for parsing source code
+NMODE-VAX.SL - system dependent functions for Vax-Unix
+PROMPTING.SL - string input and basic prompt line functions
+QUERY-REPLACE.SL - query-replace subsystem
+READER.SL - NMODE command reader
+REC.SL - recursive editing functions
+SCREEN-LAYOUT.SL - functions managing overall NMODE screen layout
+SEARCH.SL. - searching functions
+SOFTKEYS.SL - NMode softkeys (Esc-/)
+STRUCTURE-FUNCTIONS.SL - functions for moving about structured text
+TERMINAL-INPUT.SL - terminal input functions, including prompted input
+TEXT-BUFFER.SL - text buffer abstract data type
+TEXT-COMMANDS.SL - sentence, paragraph, and formatting stuff
+WINDOW-LABEL.SL - manages label area of a window
+WINDOW.SL - auxiliary functions for manipulating the current window
ADDED psl-1983/3-1/nmode/-this-.directory
Index: psl-1983/3-1/nmode/-this-.directory
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/-this-.directory
@@ -0,0 +1,2 @@
+This directory contains the sources and non-loadable binaries for the NMODE
+editor.
ADDED psl-1983/3-1/nmode/autofill.sl
Index: psl-1983/3-1/nmode/autofill.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/autofill.sl
@@ -0,0 +1,129 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% AUTOFILL.SL - NMODE Auto-Fill Mode
+%
+% Author: Jeff Soreff
+% Hewlett-Packard/CRC
+% Date: 3 November 1982
+% Revised: 18 January 1983
+%
+% 16-Nov-82 Jeff Soreff
+% Fixed bugs (handling very long lines, breaking at punctuation)
+% and improved efficiency.
+% 29-Nov-82 Jeff Soreff
+% Fixed bug with too-long word.
+% 18-Jan-83 Jeff Soreff
+% Made autofill preserve textual context of buffer position.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load extended-char fast-int fast-strings fast-vectors))
+
+% Externals used here:
+(fluid '(nmode-command-argument nmode-command-argument-given))
+
+% Globals defined here:
+(fluid '(fill-prefix fill-column auto-fill-mode))
+
+(setf fill-prefix nil)
+(setf fill-column 70)
+(setf auto-fill-mode
+ (nmode-define-mode "Fill" '((auto-fill-setup))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de auto-fill-mode-command ()
+ (toggle-minor-mode auto-fill-mode))
+
+(de auto-fill-setup ()
+ (if (eq (dispatch-table-lookup (x-char SPACE)) 'insert-self-command)
+ (nmode-define-command (x-char SPACE) 'auto-fill-space)
+ ))
+
+(de set-fill-column-command ()
+ (if nmode-command-argument-given
+ (setq fill-column nmode-command-argument)
+ (setq fill-column (current-display-column)))
+ (write-message
+ (bldmsg "%w%p" "Fill Column = " fill-column)))
+
+(de set-fill-prefix-command ()
+ (let ((temp (buffer-get-position)))
+ (cond ((at-line-start?)
+ (setq fill-prefix nil)
+ (write-message "Fill Prefix now empty"))
+ (t (move-to-start-of-line)
+ (setq fill-prefix
+ (extract-text
+ nil (buffer-get-position)
+ temp))
+ (buffer-set-position temp)
+ (write-message
+ (bldmsg "%w%p" "Fill Prefix now "
+ (vector-fetch fill-prefix 0)))))))
+
+(de blank-char (char) (or (= char #\tab) (= char #\blank)))
+
+(de skip-forward-blanks-in-line ()
+ (while (and (not (at-line-end?))
+ (blank-char (next-character)))
+ (move-forward)))
+
+(de skip-backward-blanks-in-line ()
+ (while (and (not (at-line-start?))
+ (blank-char (previous-character)))
+ (move-backward)))
+
+(de skip-forward-nonblanks-in-line ()
+ (while (and (not (at-line-end?))
+ (not (blank-char (next-character))))
+ (move-forward)))
+
+(de auto-fill-space ()
+ (for (from i 1 nmode-command-argument 1)
+ (do (insert-character #\blank)))
+ (when (> (current-display-column) fill-column)
+ (let ((word-too-long nil)
+ (current-place (buffer-get-position)))
+ (set-display-column fill-column)
+ (while (or (not (at-line-end?)) word-too-long)
+ (let ((start nil)(end nil))
+ (while (not (or (at-line-start?)
+ (and (blank-char % start natural break
+ (next-character))
+ (not (blank-char
+ (previous-character))))))
+ (move-backward))
+ (unless (setf word-too-long
+ (and (at-line-start?)
+ (not (blank-char (next-character)))))
+ (setf start (buffer-get-position))
+ (skip-forward-blanks-in-line)
+ (setf end (buffer-get-position))
+ (when (buffer-position-lessp start current-place) % Correct for
+ (if (buffer-position-lessp current-place end) % the extraction.
+ (setf current-place start) % Within extracted interval
+ (setf current-place % After extracted interval
+ (buffer-position-create
+ (buffer-position-line current-place)
+ (- (buffer-position-column current-place)
+ (- (buffer-position-column end)
+ (buffer-position-column start)))))))
+ (extract-text t start end)
+ (when (buffer-position-lessp (buffer-get-position) current-place)
+ (setf current-place % Correct for new line break being added
+ (buffer-position-create
+ (+ (buffer-position-line current-place) 1)
+ (- (buffer-position-column current-place)
+ (current-char-pos)))))
+ (insert-eol)
+ (when fill-prefix
+ (insert-text fill-prefix)
+ (setf current-place % Correct for prefix length
+ (buffer-position-create
+ (buffer-position-line current-place)
+ (+ (buffer-position-column current-place)
+ (string-length (vector-fetch fill-prefix 0))))))))
+ (if word-too-long
+ (move-to-end-of-line)
+ (set-display-column fill-column)))
+ (buffer-set-position current-place))))
ADDED psl-1983/3-1/nmode/binary/autofill.b
Index: psl-1983/3-1/nmode/binary/autofill.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/autofill.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/browser-browser.b
Index: psl-1983/3-1/nmode/binary/browser-browser.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/browser-browser.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/browser-support.b
Index: psl-1983/3-1/nmode/binary/browser-support.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/browser-support.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/browser.b
Index: psl-1983/3-1/nmode/binary/browser.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/browser.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/buffer-browser.b
Index: psl-1983/3-1/nmode/binary/buffer-browser.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/buffer-browser.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/buffer-io.b
Index: psl-1983/3-1/nmode/binary/buffer-io.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/buffer-io.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/buffer-position.b
Index: psl-1983/3-1/nmode/binary/buffer-position.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/buffer-position.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/buffer-window.b
Index: psl-1983/3-1/nmode/binary/buffer-window.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/buffer-window.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/buffer.b
Index: psl-1983/3-1/nmode/binary/buffer.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/buffer.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/buffers.b
Index: psl-1983/3-1/nmode/binary/buffers.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/buffers.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/case-commands.b
Index: psl-1983/3-1/nmode/binary/case-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/case-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/command-input.b
Index: psl-1983/3-1/nmode/binary/command-input.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/command-input.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/commands.b
Index: psl-1983/3-1/nmode/binary/commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/dabbrevs.b
Index: psl-1983/3-1/nmode/binary/dabbrevs.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/dabbrevs.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/defun-commands.b
Index: psl-1983/3-1/nmode/binary/defun-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/defun-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/dired.b
Index: psl-1983/3-1/nmode/binary/dired.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/dired.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/dispatch.b
Index: psl-1983/3-1/nmode/binary/dispatch.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/dispatch.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/doc.b
Index: psl-1983/3-1/nmode/binary/doc.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/doc.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/extended-input.b
Index: psl-1983/3-1/nmode/binary/extended-input.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/extended-input.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/fileio.b
Index: psl-1983/3-1/nmode/binary/fileio.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/fileio.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/incr.b
Index: psl-1983/3-1/nmode/binary/incr.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/incr.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/indent-commands.b
Index: psl-1983/3-1/nmode/binary/indent-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/indent-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/kill-commands.b
Index: psl-1983/3-1/nmode/binary/kill-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/kill-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/lisp-commands.b
Index: psl-1983/3-1/nmode/binary/lisp-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/lisp-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/lisp-indenting.b
Index: psl-1983/3-1/nmode/binary/lisp-indenting.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/lisp-indenting.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/lisp-interface.b
Index: psl-1983/3-1/nmode/binary/lisp-interface.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/lisp-interface.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/lisp-parser.b
Index: psl-1983/3-1/nmode/binary/lisp-parser.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/lisp-parser.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/m-x.b
Index: psl-1983/3-1/nmode/binary/m-x.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/m-x.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/m-xcmd.b
Index: psl-1983/3-1/nmode/binary/m-xcmd.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/m-xcmd.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/mode-defs.b
Index: psl-1983/3-1/nmode/binary/mode-defs.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/mode-defs.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/modes.b
Index: psl-1983/3-1/nmode/binary/modes.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/modes.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/move-commands.b
Index: psl-1983/3-1/nmode/binary/move-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/move-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/nmode-20.b
Index: psl-1983/3-1/nmode/binary/nmode-20.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/nmode-20.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/nmode-break.b
Index: psl-1983/3-1/nmode/binary/nmode-break.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/nmode-break.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/nmode-init.b
Index: psl-1983/3-1/nmode/binary/nmode-init.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/nmode-init.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/process.b
Index: psl-1983/3-1/nmode/binary/process.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/process.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/prompting.b
Index: psl-1983/3-1/nmode/binary/prompting.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/prompting.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/query-replace.b
Index: psl-1983/3-1/nmode/binary/query-replace.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/query-replace.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/reader.b
Index: psl-1983/3-1/nmode/binary/reader.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/reader.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/rec.b
Index: psl-1983/3-1/nmode/binary/rec.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/rec.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/screen-layout.b
Index: psl-1983/3-1/nmode/binary/screen-layout.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/screen-layout.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/search.b
Index: psl-1983/3-1/nmode/binary/search.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/search.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/set-terminal.b
Index: psl-1983/3-1/nmode/binary/set-terminal.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/set-terminal.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/softkeys.b
Index: psl-1983/3-1/nmode/binary/softkeys.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/softkeys.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/structure-functions.b
Index: psl-1983/3-1/nmode/binary/structure-functions.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/structure-functions.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/terminal-input.b
Index: psl-1983/3-1/nmode/binary/terminal-input.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/terminal-input.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/text-buffer.b
Index: psl-1983/3-1/nmode/binary/text-buffer.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/text-buffer.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/text-commands.b
Index: psl-1983/3-1/nmode/binary/text-commands.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/text-commands.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/window-label-rewrite.b
Index: psl-1983/3-1/nmode/binary/window-label-rewrite.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/window-label-rewrite.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/window-label.b
Index: psl-1983/3-1/nmode/binary/window-label.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/window-label.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/binary/window.b
Index: psl-1983/3-1/nmode/binary/window.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/binary/window.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nmode/browser-browser.sl
Index: psl-1983/3-1/nmode/browser-browser.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/browser-browser.sl
@@ -0,0 +1,267 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Browser-Browser.SL - Browser Browser Subsystem
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 14 March 1983
+% Revised: 12 April 1983
+%
+% This file implements the browser browser subsystem.
+%
+% 12-April-83 Jeff Soreff
+% Bug fix: R and S commented out of the command list, pending sort
+% implementations.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load extended-char fast-strings))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(read-only-text-mode))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal static variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(browser-browser-mode
+ browser-browser-command-list
+ browser-browser-documentation-text
+ browser-browser-help-text
+ nmode-browser-prototypes
+ ))
+
+(setf browser-browser-help-text
+ ["? View-documentation Browse Kill uN/Ignore Quit"])
+
+(setf browser-browser-documentation-text
+ ["The Browser Browser displays all existing browsers, as well as"
+ "prototypes for browsers that can be created. The Browse (B) command"
+ "given when the cursor points at an existing browser will select"
+ "that browser. The Browse (B) command given when the cursor points"
+ "at a prototype browser will cause a new browser of that kind to be"
+ "created, possibly after requesting additional information."
+ "The View-Documentation (V) command will display information about"
+ "the browser or prototype browser pointed at by the cursor."
+ "The Kill (K) command will kill the browser pointed at by the cursor."
+ "The Ignore (I) command will remove the pointed-at browser from the display."
+ "The uNignore (N) command will restore all Ignored browsers to the display."
+ "The Quit (Q) command will exit the browser browser."
+ ])
+
+(setf browser-browser-mode (nmode-define-mode "Browser-Browser" '(
+ (nmode-define-commands browser-browser-command-list)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ )))
+
+(setf browser-browser-command-list
+ (list
+ (cons (x-char ?) 'browser-help-command)
+ (cons (x-char B) 'browser-browser-browse-command)
+ (cons (x-char I) 'browser-ignore-command)
+ (cons (x-char K) 'browser-kill-command)
+ (cons (x-char N) 'browser-undo-filter-command)
+ (cons (x-char Q) 'browser-exit-command)
+% (cons (x-char R) 'browser-browser-reverse-sort) % not implemented!
+% (cons (x-char S) 'browser-browser-sort) % not implemented!
+ (cons (x-char V) 'browser-view-command)
+ (cons (x-char SPACE) 'move-down-command)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de browser-browser-command ()
+ % Bring up the browser browser subsystem.
+ (let ((browser (or (find-browser 'BROWSER-BROWSER "")
+ (create-browser-browser)
+ )))
+ (browser-enter browser)
+ ))
+
+(de create-browser-browser ()
+ % Create the browser browser subsystem.
+ % The set of items is created when the browser buffer is selected.
+
+ (let* ((b (create-unnamed-buffer browser-browser-mode))
+ (header-text (vector "NMODE Browsers" ""))
+ )
+ (let ((browser (create-browser
+ 'BROWSER-BROWSER "Browsers" "" browser-browser-mode
+ NIL header-text browser-browser-documentation-text
+ browser-browser-help-text
+ () #'browser-browser-name-sorter)
+ ))
+ (=> browser set-select-function 'browser-update)
+ (=> browser set-update-function 'browser-browser-update)
+ (=> browser put 'browser-list ())
+ browser
+ )))
+
+(de browser-browser-update (browser)
+ % Add any new browsers to the browser browser.
+
+ (let* ((old-browser-list (=> browser get 'browser-list))
+ (new-browser-list (delq browser (all-browsers)))
+ (old-prototype-list (=> browser get 'prototype-list))
+ (new-prototype-list nmode-browser-prototypes)
+ (old-current-item (=> browser current-item))
+ (new-items
+ (append
+ (for (in br new-browser-list)
+ (when (not (memq br old-browser-list)))
+ (collect (create-browser-browser-item br))
+ )
+ (when (not (eq old-prototype-list new-prototype-list))
+ (for (in pr new-prototype-list)
+ (when (not (memq pr old-prototype-list)))
+ (collect pr)
+ ))
+ )))
+ (=> browser add-items new-items)
+ (=> browser put 'browser-list new-browser-list)
+ (=> browser put 'prototype-list new-prototype-list)
+ (=> browser select-item old-current-item)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Special Browser Browser commands:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de browser-browser-browse-command ()
+ (let ((item (browser-current-item)))
+ (cond ((not item) (Ding))
+ ((eq (object-type item) 'BROWSER-BROWSER-ITEM)
+ (browser-enter (=> item browser))
+ )
+ (t (=> item instantiate))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Sorting Predicates
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de browser-browser-name-sorter (b1 b2)
+ (let* ((text1 (=> b1 display-text))
+ (text2 (=> b2 display-text))
+ )
+ (StringSortFN text1 text2)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% The browser-browser-item flavor:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de create-browser-browser-item (b)
+ (make-instance 'browser-browser-item
+ 'browser b
+ ))
+
+(defflavor browser-browser-item
+ (display-text
+ browser
+ )
+ ()
+ (gettable-instance-variables)
+ (initable-instance-variables)
+ )
+
+(defmethod (browser-browser-item init) (init-plist)
+ (=> self &update-display-text)
+ )
+
+(defmethod (browser-browser-item &update-display-text) ()
+ (let* ((kind-string (=> browser browser-kind-string))
+ (info-string (=> browser browser-info-string))
+ )
+ (setf display-text (string-concat " " kind-string))
+ (when (and info-string (not (string-empty? info-string)))
+ (setf display-text (string-concat display-text " (" info-string ")")))
+ ))
+
+(defmethod (browser-browser-item update) ()
+ (when (browser-is-active? browser)
+ (=> self &update-display-text)
+ T
+ ))
+
+(defmethod (browser-browser-item kill) ()
+ (kill-browser browser)
+ )
+
+(defmethod (browser-browser-item view-buffer) (x)
+ (=> browser documentation-buffer)
+ )
+
+(defmethod (browser-browser-item cleanup) ()
+ )
+
+(defmethod (browser-browser-item apply-filter) (filter)
+ (apply filter (list browser))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% The browser-browser-prototype-item flavor:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de define-browser-prototype (create-function display-text documentation-text)
+ (let ((item (create-browser-browser-prototype-item create-function
+ display-text
+ documentation-text
+ )))
+ (setf nmode-browser-prototypes
+ (cons item nmode-browser-prototypes))
+ ))
+
+(de create-browser-browser-prototype-item (create-fcn display-text doc-text)
+ (make-instance 'browser-browser-prototype-item
+ 'create-function create-fcn
+ 'display-text display-text
+ 'documentation-text doc-text
+ ))
+
+(defflavor browser-browser-prototype-item
+ (display-text
+ create-function
+ documentation-text
+ documentation-buffer
+ )
+ ()
+ (gettable-instance-variables display-text)
+ (initable-instance-variables display-text create-function documentation-text)
+ )
+
+(defmethod (browser-browser-prototype-item init) (init-plist)
+ (setf display-text (string-concat "Prototype: " display-text))
+ (setf documentation-buffer (create-unnamed-buffer read-only-text-mode))
+ (=> documentation-buffer insert-text documentation-text)
+ (=> documentation-buffer insert-eol)
+ (=> documentation-buffer set-modified? NIL)
+ (=> documentation-buffer move-to-buffer-start)
+ (=> documentation-buffer set-label-string
+ (string-concat "(Documentation on " display-text ")"))
+ )
+
+(defmethod (browser-browser-prototype-item update) ()
+ T
+ )
+
+(defmethod (browser-browser-prototype-item kill) ()
+ NIL
+ )
+
+(defmethod (browser-browser-prototype-item view-buffer) (x)
+ documentation-buffer
+ )
+
+(defmethod (browser-browser-prototype-item cleanup) ()
+ )
+
+(defmethod (browser-browser-prototype-item apply-filter) (filter)
+ T
+ )
+
+(defmethod (browser-browser-prototype-item instantiate) ()
+ (apply create-function '())
+ )
ADDED psl-1983/3-1/nmode/browser-support.sl
Index: psl-1983/3-1/nmode/browser-support.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/browser-support.sl
@@ -0,0 +1,363 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Browser-Support.SL - General Browser Support
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 18 October 1982
+% Revised: 14 March 1983
+%
+% 14-Mar-83 Alan Snyder
+% Added functions to find existing browsers. New functions:
+% browser-current-item, browser-view-buffer, browser-edit-buffer,
+% browser-help-command, browser-exit, current-browser, kill-browser,
+% kill-browser-command, browser-update. Change browser-enter to take browser
+% as arg instead of buffer. Fix browser-enter and browser-exit to
+% restore old buffers upon exit.
+% 4-Mar-83 Alan Snyder
+% New functions: browser-add-item, browser-add-items.
+% 3-Feb-83 Alan Snyder
+% Revised to use Browser objects.
+%
+% This file contains support functions for browsers, such as the Buffer
+% Browser and DIRED. A browser is a buffer that displays a set of items, one
+% item per line, and allows the individual items to be manipulated.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load numeric-operators))
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-top-window
+ nmode-bottom-window
+ nmode-current-buffer
+ nmode-current-window
+ nmode-command-argument
+ nmode-command-argument-given
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% User options:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(
+ browser-split-screen
+ ))
+(setf browser-split-screen NIL)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal Static Variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-active-browsers))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% General Browser Support Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-register-browser (browser)
+ % Add the specified browser to the list of active browsers. This list is
+ % used to create the items for the browser browser, for example. This
+ % function is called by create-browser.
+
+ (if (unboundp 'nmode-active-browsers)
+ (setf nmode-active-browsers ()))
+ (when (not (memq browser nmode-active-browsers))
+ (setf nmode-active-browsers (cons browser nmode-active-browsers)))
+ )
+
+(de nmode-unregister-browser (browser)
+ % Remove the specified browser from the list of active browsers.
+
+ (if (unboundp 'nmode-active-browsers)
+ (setf nmode-active-browsers ()))
+ (when (memq browser nmode-active-browsers)
+ (setf nmode-active-browsers (delq browser nmode-active-browsers)))
+ )
+
+(de browser-is-active? (browser)
+ (memq browser nmode-active-browsers)
+ )
+
+(de browser-enter (browser)
+ % Start up a browser.
+ (let ((wp (nmode-window-position)))
+ (=> browser put 'window-status wp)
+ (=> browser put 'old-top (=> (=> nmode-top-window buffer) name))
+ (=> browser put 'old-bottom
+ (when browser-split-screen (=> (=> nmode-bottom-window buffer) name)))
+ (if browser-split-screen
+ (if (eq wp 'bottom) (nmode-switch-windows))
+ (nmode-1-window)
+ ))
+ (=> browser enter)
+ )
+
+(de browser-exit (browser)
+ % Exit the browser, which means to detach its buffers from windows and
+ % restore the window to its previous state.
+
+ (let* ((ws (=> browser get 'window-status))
+ (old-top (=> browser get 'old-top))
+ (old-bottom (=> browser get 'old-bottom))
+ )
+ (nmode-set-window-position ws)
+ (when old-top
+ (window-select-buffer nmode-top-window (buffer-find old-top)))
+ (when old-bottom
+ (window-select-buffer nmode-bottom-window (buffer-find old-bottom)))
+ (=> browser exit)
+ ))
+
+(de kill-browser (browser)
+ % Kill the browser, which means exit it and then remove it from the list
+ % of active browsers (which should allow it to be garbage collected).
+
+ (=> browser exit)
+ (nmode-unregister-browser browser)
+ )
+
+(de all-browsers ()
+ % Return a list of all active browsers. The list should not be modified.
+
+ nmode-active-browsers
+ )
+
+(de all-browsers-of-a-kind (browser-kind-id)
+ % Return a list of all existing browsers of the specified kind.
+
+ (for (in br (all-browsers))
+ (when (eq (=> br browser-kind) browser-kind-id))
+ (collect br)
+ ))
+
+(de find-browser (browser-kind-id info-string)
+ % Search for a browser of the specified kind with the specified info string.
+
+ (for (in br (all-browsers-of-a-kind browser-kind-id))
+ (when (equal (=> br browser-info-string) info-string))
+ (do (exit br))
+ ))
+
+(de browser-update (browser)
+ (=> browser update-items)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Browser commands: attach these to keys in your browser mode
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de browser-kill-and-exit-command ()
+ (browser-kill-deleted-items-command)
+ (browser-exit-command)
+ )
+
+(de browser-exit-command ()
+ % Exit the current browser. This removes the browser from the display,
+ % but does not destroy it (it can be reentered).
+
+ (let ((browser (current-browser)))
+ (when browser
+ (browser-exit browser)
+ )))
+
+(de kill-browser-command ()
+ % Kill the current browser. This removes the browser from the display,
+ % and removes it from the active browser list (it cannot be reentered).
+
+ (let ((browser (current-browser)))
+ (when browser
+ (kill-browser browser)
+ )))
+
+(de browser-delete-command ()
+ % Mark items as 'deleted'.
+ (browser-do-repeated-command 'delete-item () nil)
+ )
+
+(de browser-undelete-command ()
+ % Mark items as not 'deleted'.
+ (browser-do-repeated-command 'undelete-item () nil)
+ )
+
+(de browser-undelete-backwards-command ()
+ % Mark items as not 'deleted'.
+ (setf nmode-command-argument (- nmode-command-argument))
+ (browser-do-repeated-command 'undelete-item () nil)
+ )
+
+(de browser-kill-command ()
+ % Kill items.
+ (browser-do-repeated-command 'kill-item () t)
+ )
+
+(de browser-ignore-command ()
+ % Ignore items: filter them out.
+ (browser-do-repeated-command 'ignore-item () t)
+ )
+
+(de browser-view-command ()
+ % View the current item.
+ (let ((buffer (browser-view-item-in-buffer)))
+ (if buffer
+ (browser-view-buffer buffer nmode-command-argument-given)
+ (Ding)
+ )))
+
+(de browser-edit-command ()
+ % Edit the current item.
+ (let ((buffer (browser-view-item-in-buffer)))
+ (if buffer
+ (browser-edit-buffer buffer nmode-command-argument-given)
+ (Ding)
+ )))
+
+(de browser-kill-deleted-items-command ()
+ (let ((browser (current-browser)))
+ (=> browser kill-deleted-items)
+ ))
+
+(de browser-undo-filter-command ()
+ (let* ((browser (current-browser))
+ (filter (=> browser undo-filter))
+ )
+ (if filter
+ (set-prompt (bldmsg "Application of %w undone." filter))
+ (nmode-error "No filters have been applied to create this list.")
+ )))
+
+(de browser-help-command ()
+ (let ((browser (current-browser)))
+ (when browser
+ (=> browser display-documentation)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Browser functions: use these in browser commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-browser ()
+ (=> nmode-current-buffer get 'browser))
+
+(de browser-sort (prompt sorter)
+ (let ((browser (current-browser)))
+ (=> browser sort sorter)
+ (write-prompt prompt)
+ ))
+
+(de browser-current-item ()
+ % Return the current item, if any, NIL otherwise.
+
+ (let ((browser (current-browser)))
+ (when browser
+ (=> browser current-item)
+ )))
+
+(de browser-view-item (w)
+ % View the current item in the specified window. Return T if successful,
+ % NIL otherwise.
+
+ (let ((buffer (browser-view-item-in-buffer)))
+ (when buffer
+ (=> buffer set-previous-buffer nmode-current-buffer)
+ (window-select-buffer w buffer)
+ T
+ )))
+
+(de browser-view-item-in-buffer ()
+ % View the current item in a buffer. Return the buffer if successful,
+ % NIL otherwise. The buffer is not attached to any window.
+
+ (let ((browser (current-browser)))
+ (when browser
+ (=> browser view-item)
+ )))
+
+(de browser-view-buffer (b invert-split-screen-option)
+ % View the buffer B like an item is viewed.
+ (let* ((use-other (xor browser-split-screen invert-split-screen-option))
+ (w (if use-other (nmode-other-window) nmode-current-window))
+ )
+ (=> b set-previous-buffer nmode-current-buffer)
+ (window-select-buffer w b)
+ (if use-other
+ (nmode-2-windows) % display the other window
+ (set-message "C-M-L returns to browser.")
+ )))
+
+(de browser-edit-buffer (b invert-split-screen-option)
+ % Edit the buffer B like an item is edited.
+ (let* ((use-other (xor browser-split-screen invert-split-screen-option))
+ (w (if use-other (nmode-other-window) nmode-current-window))
+ )
+ (=> b set-previous-buffer nmode-current-buffer)
+ (window-select-buffer w b)
+ (cond (use-other
+ (nmode-2-windows) % display the other window
+ (nmode-select-window w)
+ (set-message "C-X O returns to browser.")
+ )
+ (t
+ (set-message "C-M-L returns to browser.")
+ ))))
+
+(de browser-add-item-and-view (new-item)
+ % Add the item to the current browser. Then, if in split screen mode,
+ % view the item.
+
+ (browser-add-item new-item)
+ (when browser-split-screen
+ (setf nmode-command-argument-given NIL)
+ (browser-view-command)
+ ))
+
+(de browser-add-item (new-item)
+ % Add the item to the current browser.
+
+ (let ((browser (current-browser)))
+ (when browser
+ (=> browser add-item new-item)
+ T
+ )))
+
+(de browser-add-items (new-item-list)
+ % Add the items to the current browser.
+
+ (let ((browser (current-browser)))
+ (when browser
+ (=> browser add-items new-item-list)
+ T
+ )))
+
+(de browser-do-repeated-command (msg args removes?)
+ % Perform a browser command that takes a signed numeric argument to mean
+ % a repetition count. On each iteration, the browser is sent
+ % the specified message with the specified arguments. If REMOVES? is
+ % true, then the browser operation may remove the current item and
+ % it will return true if it does.
+
+ (let ((browser (current-browser)))
+ (if (> nmode-command-argument 0)
+ (for (from i 1 nmode-command-argument)
+ (do (when (not (=> browser current-item))
+ (Ding) (exit))
+ (if (not (and (lexpr-send browser msg args) removes?))
+ (move-to-next-line)
+ )))
+ (for (from i 1 (- nmode-command-argument))
+ (do (when (current-line-is-first?)
+ (Ding) (exit))
+ (move-to-previous-line)
+ (when (not (=> browser current-item))
+ (move-to-next-line) (Ding) (exit))
+ (lexpr-send browser msg args)
+ ))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/browser.sl
Index: psl-1983/3-1/nmode/browser.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/browser.sl
@@ -0,0 +1,643 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Browser.SL - Browser object definition
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 February 1983
+% Revised: 14 March 1983
+%
+% This file implements browser objects. These objects form the basis of a
+% general browser support mechanism. See Browser-Support.SL for additional
+% support functions and Buffer-Browser.SL for an example of a browser using
+% this mechanism.
+%
+% 14-Mar-83 Alan Snyder
+% New methods: enter, select, display-documentation, set-items, update-items,
+% filter-count, get, put. New documentation fields, etc. Create-Browser
+% changed incompatibly.
+% 4-Mar-83 Alan Snyder
+% New methods: add-item and add-items.
+% 14-Feb-83 Alan Snyder
+% Fix bug in filter application (was trying to apply a macro).
+% 11-Feb-83 Alan Snyder
+% Fix &remove-current-item to reset the display buffer's modified flag.
+% Improve comments.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-vectors numeric-operators))
+(on fast-integers)
+(load gsort)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-top-window
+ nmode-bottom-window
+ nmode-current-window
+ nmode-current-buffer
+ browser-split-screen
+ read-only-text-mode
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de create-browser (browser-kind
+ browser-kind-string
+ browser-info-string
+ display-buffer-mode
+ view-buffer
+ header-text
+ documentation-text
+ help-text
+ items
+ current-sorter
+ )
+
+ % Create a brower. BROWSER-KIND should be an ID that identifies the kind of
+ % browser this is. This ID is provided for optional use by the creator of
+ % the browser to locate existing browsers of its kind. BROWSER-KIND-STRING
+ % should be a string that identifies the kind of browser this is. This
+ % STRING is used in the browser browser display. BROWSER-INFO-STRING should
+ % be a string that identifies this particular browser, as differentiated
+ % from others of the same kind. This STRING is used in the browser browser
+ % display.
+
+ % DISPLAY-BUFFER-MODE is the mode to use for the browser display buffer.
+ % VIEW-BUFFER is the buffer to use for viewing an item; if NIL, the item is
+ % expected to provide its own buffer. HEADER-TEXT is a vector of strings to
+ % display at the top of the display buffer; it may be NIL.
+ % DOCUMENTATION-TEXT is a vector of strings to display in the documentation
+ % buffer, which is displayed in the bottom window when there is no
+ % currently-viewed item; it may be NIL. HELP-TEXT is a vector of strings to
+ % display at the bottom of the screen; it may be NIL. The HELP-TEXT should
+ % briefly list the available commands. (Currently the HELP-TEXT should
+ % consist of at most one string, which will be displayed in the message
+ % window.) ITEMS is a list or vector containing the set of items to display
+ % (this data structure will not be modified). CURRENT-SORTER may be NIL or
+ % a function ID. If non-NIL, the function will be used to sort the initial
+ % set of items.
+
+ (let ((browser (make-instance 'browser
+ 'browser-kind browser-kind
+ 'browser-kind-string browser-kind-string
+ 'browser-info-string browser-info-string
+ 'display-buffer-mode display-buffer-mode
+ 'view-buffer view-buffer
+ 'header-text header-text
+ 'documentation-text documentation-text
+ 'help-text help-text
+ 'items items
+ 'current-sorter current-sorter
+ 'display-width (=> nmode-top-window width)
+ )))
+ (nmode-register-browser browser)
+ browser
+ ))
+
+(defflavor browser
+ ((browser-kind NIL) % ID identifying kind of browser
+ (browser-kind-string "") % string identifying kind of browser
+ (browser-info-string "") % string describing this particular browser
+
+ (select-function NIL) % function to invoke when selected (arg: self)
+ (update-function NIL) % function to invoke when updated (arg: self)
+
+ display-width
+ (display-buffer-mode NIL) % mode of browser display buffer
+ display-buffer % buffer used to display items
+ (view-buffer NIL) % buffer used to view items (NIL => ask item)
+ documentation-buffer % buffer used to display documentation
+
+ (header-text NIL) % text displayed at top of buffer
+ first-item-linepos % line number of first item in display
+ (documentation-text NIL) % text displayed in documentation buffer
+ (help-text NIL) % text displayed in help line
+
+ items % vector of visible items (may have junk at end)
+ last-item-index % index of last valid item in ITEMS vector
+ (viewed-item NIL) % the item most recently viewed (or NIL)
+ filtered-items % list of lists of items removed by filtering
+ (current-sorter NIL) % sorter used if items are un-filtered
+
+ (p-list NIL) % association list of properties
+ )
+ ()
+ (gettable-instance-variables
+ browser-kind browser-kind-string display-width
+ display-buffer help-text documentation-buffer
+ )
+ (settable-instance-variables
+ browser-info-string
+ select-function
+ update-function
+ )
+ (initable-instance-variables
+ browser-kind browser-kind-string display-width
+ display-buffer-mode view-buffer header-text
+ documentation-text help-text
+ items current-sorter)
+ )
+
+% Methods provided by items:
+%
+% (=> item display-text)
+% Return string used to display the item.
+%
+% (=> item delete)
+% Mark the item as deleted. May do nothing if deletion is not supported.
+% May change the display-text. This method need not be provided if no
+% delete commands are provided in the particular browser.
+%
+% (=> item undelete)
+% Mark the item as not deleted. May do nothing if deletion is not
+% supported. May change the display-text. This method need not be provided
+% if no delete commands are provided in the particular browser.
+%
+% (=> item deleted?)
+% Return T if the item has been marked for deletion. This method need not
+% be provided if no delete commands are provided in the particular browser.
+%
+% (=> item kill)
+% Kill the real item. (Instead of just marking the item for deletion, this
+% should actually dispose of the item, if that action is supported.) May do
+% nothing if killing is not supported. Return T if the item is actually
+% killed, NIL otherwise. This method need not be provided if no delete
+% commands are provided in the particular browser.
+%
+% (=> item view-buffer buffer)
+% Return a buffer containing the item for viewing. If the buffer argument
+% is non-NIL, then that buffer should be used for viewing. Otherwise, the
+% item must provide its own buffer.
+%
+% (=> item cleanup)
+% Throw away any unneeded stuff, such as a buffer created for viewing. This
+% method is invoked when an item is no longer being viewed, or when the item
+% is being filtered out, or when the browser is being exited.
+%
+% (=> item update)
+% The item should check for any changes in the object that it represents and
+% update itself accordingly. This method should return NIL if and only if
+% the object no longer exists, in which case it will be removed. (The item
+% should clean itself up in this case.) Updating is performed on active
+% items by the update-items method; in addtion, items that are unfiltered
+% are also updated at that time.
+%
+% (=> item apply-filter filter)
+% The item should apply the filter to itself and return T if the filter
+% matches the item and NIL otherwise.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Public methods for browsers:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (browser select) ()
+ % This method is invoked when the browser buffer is newly selected.
+ (=> self &display-viewed-item)
+ (=> self display-help)
+ (when select-function (apply select-function (list self)))
+ )
+
+(defmethod (browser enter) ()
+ % Entering a browser means selecting its display buffer in the current
+ % window.
+
+ (when (not (eq display-buffer nmode-current-buffer))
+ (=> display-buffer set-previous-buffer nmode-current-buffer))
+ (buffer-select display-buffer)
+ )
+
+(defmethod (browser exit) ()
+ % Exiting a browser means to clean up its items and detach any of its
+ % buffers from any windows. It is still an active browser and may be
+ % reentered later.
+
+ (for (from i 0 last-item-index)
+ (do (=> (vector-fetch items i) cleanup)))
+ (if display-buffer
+ (buffer-kill-and-detach display-buffer))
+ (if documentation-buffer
+ (buffer-kill-and-detach documentation-buffer))
+ (if view-buffer
+ (buffer-kill-and-detach view-buffer))
+ )
+
+(defmethod (browser display-help) ()
+ (when (and help-text (not (vector-empty? help-text)))
+ (write-message (vector-fetch help-text 0))
+ ))
+
+(defmethod (browser display-documentation) ()
+ (=> documentation-buffer move-to-buffer-start)
+ (=> self &set-viewed-item NIL)
+ (cond (browser-split-screen
+ (=> nmode-bottom-window set-line-position 0)
+ (=> nmode-bottom-window adjust-window)
+ )
+ (t
+ (browser-view-buffer documentation-buffer NIL)
+ )))
+
+(defmethod (browser current-item) ()
+ % Return the current item, which is the item that is displayed on the
+ % display-buffer's current line, or NIL, if there is no such item.
+
+ (let ((index (- (=> display-buffer line-pos) first-item-linepos)))
+ (when (and (>= index 0) (<= index last-item-index))
+ (vector-fetch items index)
+ )))
+
+(defmethod (browser current-item-index) ()
+ % Return the index of the current item, which is the item that is displayed
+ % on the display-buffer's current line, or NIL, if there is no such item.
+
+ (let ((index (- (=> display-buffer line-pos) first-item-linepos)))
+ (when (and (>= index 0) (<= index last-item-index))
+ index
+ )))
+
+(defmethod (browser add-item) (new-item)
+ % Add the specified item to the set of items. If a sort function is
+ % currently defined, it will be used to sort the set of items. The new item
+ % becomes the current item.
+
+ (=> self add-items (list new-item))
+ )
+
+(defmethod (browser add-items) (new-item-list)
+ % Add the specified items to the set of items. If a sort function is
+ % currently defined, it will be used to sort the set of items. The first
+ % new item becomes the current item.
+
+ (when new-item-list
+ (let ((new-current-item (first new-item-list)))
+ (=> self &insert-items new-item-list)
+ (=> self &sort-items)
+ (=> self &update-display)
+ (=> self select-item new-current-item)
+ )))
+
+(defmethod (browser kill-item) ()
+ % Kill the current item, if any. Return T if the item is killed,
+ % NIL otherwise.
+
+ (let ((item (=> self current-item)))
+ (when (=> item kill)
+ (=> self &remove-current-item)
+ )))
+
+(defmethod (browser kill-deleted-items) ()
+ % Attempts to KILL all items that have been marked for deletion.
+ % Returns a list of the items actually killed.
+ (=> self &keep-items '&browser-item-not-killed ())
+ )
+
+(defmethod (browser delete-item) ()
+ % Mark the current item as deleted, if any. Return T if the item exists,
+ % NIL otherwise.
+
+ (let ((item (=> self current-item)))
+ (when item
+ (=> item delete)
+ (=> self &update-current-item)
+ T
+ )))
+
+(defmethod (browser undelete-item) ()
+ % Mark the current item as not deleted, if any. Return T if the item exists,
+ % NIL otherwise.
+
+ (let ((item (=> self current-item)))
+ (when item
+ (=> item undelete)
+ (=> self &update-current-item)
+ T
+ )))
+
+(defmethod (browser view-item) ()
+ % View the current item, if any, in a separate buffer. Return the buffer if
+ % the item exists, NIL otherwise.
+
+ (let ((item (=> self current-item)))
+ (when item
+ (=> self &set-viewed-item item)
+ (=> item view-buffer view-buffer) % return the buffer
+ )))
+
+(defmethod (browser ignore-item) ()
+ % Ignore the current item, if any. Return T if the item exists. Ignoring
+ % an item is like running a filter that accepts every item except the
+ % current one, except that multiple successive ignores coalesce into one
+ % filtered-item-set for undoing purposes.
+
+ (let ((item (=> self &remove-current-item)))
+ (when item
+ (cond ((and filtered-items (eqcar (car filtered-items) 'IGNORE-COMMAND))
+ % add this item to the previous list of ignored items
+ (let ((filter-set (car filtered-items)))
+ (setf (cdr filter-set) (cons item (cdr filter-set)))
+ ))
+ (t (setf filtered-items
+ (cons (list 'IGNORE-COMMAND item) filtered-items))
+ )))))
+
+(defmethod (browser update-items) ()
+ % Ask all active items to update themselves. Items that report that they
+ % are no longer meaningful will be removed. Then, the update-function
+ % is called. This function may choose to add new items for objects that
+ % have been created since the browser was created.
+
+ (=> self &keep-items 'ev-send '(update))
+ (when update-function
+ (apply update-function (list self))
+ ))
+
+(defmethod (browser filter-items) (filter)
+ % Remove those items that do not match the specified filter. If some items
+ % are removed, then they are added as a set to the list of filtered items,
+ % so that this step can be undone, and T is returned. Otherwise, no new set
+ % is created, and NIL is returned.
+
+ (let ((filtered-list (=> self &keep-items 'ev-send
+ (list 'apply-filter (list filter)))))
+ (when filtered-list
+ (setf filtered-list (cons filter filtered-list))
+ (setf filtered-items (cons filtered-list filtered-items))
+ T
+ )))
+
+(defmethod (browser undo-filter) ()
+ % Undo the effect of the most recent active filtering step. Return the
+ % filter or NIL if there are no active filtering steps. All unfiltered
+ % items are asked to update themselves. Items that report that they are no
+ % longer meaningful will be removed.
+
+ (when filtered-items
+ (let ((filter (car (car filtered-items)))
+ (the-items (cdr (car filtered-items)))
+ (current-item (=> self current-item))
+ )
+ (setf filtered-items (cdr filtered-items))
+ (while the-items
+ (let ((item (car the-items)))
+ (setf the-items (cdr the-items))
+ (when (=> item update)
+ (setf last-item-index (+ last-item-index 1))
+ (vector-store items last-item-index item)
+ )))
+ (=> self &sort-items)
+ (=> self &update-display)
+ (=> self select-item current-item)
+ filter
+ )))
+
+(defmethod (browser filter-count) ()
+ % Return the number of active filters.
+ (length filtered-items)
+ )
+
+(defmethod (browser items) ()
+ % Return a list of the active (unfiltered) items.
+ (for (from i 0 last-item-index)
+ (collect (vector-fetch items i)))
+ )
+
+(defmethod (browser set-items) (new-items)
+ % Replace the entire existing set of items (both active items and filtered
+ % items) with a new set of items. NEW-ITEMS may be a list or a vector.
+
+ (for (from i 0 last-item-index)
+ (do (=> (vector-fetch items i) cleanup)))
+ (setf items (cond ((ListP new-items) (List2Vector new-items))
+ ((VectorP new-items) (CopyVector new-items))
+ (t (Vector))
+ ))
+ (setf last-item-index (vector-upper-bound items))
+ (setf filtered-items ())
+ (=> self &set-viewed-item NIL)
+ (=> self &sort-items)
+ (=> self &update-display)
+ )
+
+(defmethod (browser sort) (sorter)
+ % Specify a new sorting function and sort the items accordingly.
+ (let ((current-item (=> self current-item)))
+ (setf current-sorter sorter)
+ (=> self &sort-items)
+ (=> self &update-display)
+ (=> self select-item current-item)
+ ))
+
+(defmethod (browser send-item) (msg args)
+ % Send the current item, if any, the specified message with the specified
+ % arguments. Return NIL if there is no current item; otherwise, return the
+ % result of sending the message to the item.
+
+ (let ((item (=> self current-item)))
+ (when item
+ (prog1
+ (lexpr-send item msg args)
+ (=> self &update-current-item)
+ ))))
+
+(defmethod (browser select-item) (item)
+ % If ITEM is not NIL, then adjust the buffer pointer to point to that item.
+
+ (for (from i 0 last-item-index)
+ (do (when (eq item (vector-fetch items i))
+ (=> display-buffer goto (+ i first-item-linepos) 0)
+ (exit)
+ ))))
+
+(defmethod (browser get) (property-name)
+ % Return the object associated with the specified property name (ID).
+ % Returns NIL if named property has not been defined.
+
+ (let ((pair (atsoc property-name p-list)))
+ (if (PairP pair) (cdr pair))))
+
+(defmethod (browser put) (property-name property)
+ % Associate the specified object with the specified property name (ID).
+ % GET on that property-name will henceforth return the object.
+
+ (let ((pair (atsoc property-name p-list)))
+ (if (PairP pair)
+ (rplacd pair property)
+ (setf p-list (cons (cons property-name property) p-list))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Private methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (browser init) (init-plist)
+ (setf last-item-index -1)
+ (when (not display-buffer-mode)
+ (setf display-buffer-mode Read-Only-Text-Mode))
+ (setf display-buffer (create-unnamed-buffer display-buffer-mode))
+ (when (and browser-info-string (not (string-empty? browser-info-string)))
+ (=> display-buffer set-label-string
+ (string-concat "(" browser-info-string ")")
+ ))
+ (setf documentation-buffer (create-unnamed-buffer Read-Only-Text-Mode))
+ (when documentation-text
+ (=> documentation-buffer insert-text documentation-text)
+ (=> documentation-buffer insert-eol)
+ (=> documentation-buffer set-modified? NIL)
+ (=> documentation-buffer move-to-buffer-start)
+ (=> documentation-buffer set-label-string
+ (string-concat "(Documentation on " browser-kind-string " browser)"))
+ )
+ (let ((old-browser (=> display-buffer get 'browser)))
+ (when old-browser
+ (=> old-browser exit)
+ ))
+ (=> display-buffer put 'browser self)
+ (=> self set-items items)
+ )
+
+(defmethod (browser &update-display) ()
+ % Update the display. The cursor is moved to the first item.
+ (=> display-buffer reset)
+ (when header-text
+ (=> display-buffer insert-text header-text)
+ (=> display-buffer insert-eol)
+ )
+ (setf first-item-linepos (=> display-buffer line-pos))
+ (for (from i 0 last-item-index)
+ (do (let ((item (vector-fetch items i)))
+ (=> display-buffer insert-line (=> item display-text))
+ )))
+ (=> display-buffer set-modified? NIL)
+ (=> display-buffer goto first-item-linepos 0)
+ )
+
+(defmethod (browser &set-viewed-item) (item)
+ (when (not (eq item viewed-item))
+ (if viewed-item (=> viewed-item cleanup))
+ (setf viewed-item item)
+ (when (not viewed-item) (=> self &display-viewed-item))
+ ))
+
+(defmethod (browser &display-viewed-item) ()
+ % This method causes the viewed item to be displayed in the bottom window,
+ % if the browser is selected in the top window and the split-screen option
+ % is selected. If there is no viewed item, then the documentation buffer is
+ % displayed.
+
+ (when (and (eq nmode-current-window nmode-top-window) browser-split-screen)
+ (let ((b (if viewed-item
+ (=> viewed-item view-buffer view-buffer)
+ documentation-buffer
+ )))
+ (when b
+ (=> b set-previous-buffer nmode-current-buffer)
+ (window-select-buffer (nmode-other-window) b)
+ (nmode-2-windows)
+ ))))
+
+(defmethod (browser &sort-items) ()
+ % Sort the items according to the current sorter, if any.
+ % Do not update the display buffer.
+
+ (when current-sorter
+ (let ((list ()))
+ (for (from i 0 last-item-index)
+ (do (setf list (cons (vector-fetch items i) list)))
+ )
+ (setf list (GSort list current-sorter))
+ (for (from i 0 last-item-index)
+ (do (vector-store items i (car list))
+ (setf list (cdr list))
+ ))
+ )))
+
+(defmethod (browser &insert-items) (item-list)
+ % Add the specified items to the end of the current set of items. The
+ % vector size is increased to ensure there is room for all items, including
+ % any that may have been filtered out.
+
+ (let ((new-items (mkvect (+ (vector-upper-bound items) (length item-list)))))
+ (for (from i 0 last-item-index)
+ (do (vector-store new-items i (vector-fetch items i))))
+ (for (in item item-list)
+ (do (setf last-item-index (+ last-item-index 1))
+ (vector-store new-items last-item-index item)
+ ))
+ (setf items new-items)
+ ))
+
+(defmethod (browser &remove-current-item) ()
+ % Remove the current item from ITEMS and the display.
+ % Return the item or NIL if there is no current item.
+
+ (let ((index (=> self current-item-index)))
+ (when index
+ (let ((item (vector-fetch items index)))
+ (when (eq item viewed-item) (=> self &set-viewed-item NIL))
+ (for (from i (+ index 1) last-item-index)
+ (do (vector-store items (- i 1) (vector-fetch items i))
+ ))
+ (vector-store items last-item-index NIL)
+ (setf last-item-index (- last-item-index 1))
+ (=> display-buffer move-to-start-of-line)
+ (let ((start-pos (=> display-buffer position)))
+ (=> display-buffer move-to-next-line)
+ (=> display-buffer extract-region T start-pos
+ (=> display-buffer position))
+ (=> display-buffer set-modified? NIL)
+ )
+ item
+ ))))
+
+(defmethod (browser &update-current-item) ()
+ % Update the display for the current item.
+ (let ((index (=> self current-item-index)))
+ (when index
+ (let ((item (vector-fetch items index)))
+ (=> display-buffer store-line (+ index first-item-linepos)
+ (=> item display-text))
+ (=> display-buffer set-modified? NIL)
+ ))))
+
+(defmethod (browser &keep-items) (fcn args)
+ % Apply the function FCN once for each item. The first argument to FCN
+ % is the item; the remaining items are ARGS (a list).
+ % Remove those items for which FCN returns NIL and return them
+ % in a list of items.
+
+ (let ((removed-items ())
+ (ptr 0)
+ (current-item-index (=> self current-item-index))
+ (new-current-item-index 0)
+ )
+ (for (from i 0 last-item-index)
+ (do (let ((item (vector-fetch items i))
+ (this-ptr ptr)
+ )
+ (cond ((apply fcn (cons item args)) % keep it
+ (vector-store items ptr item)
+ (setf ptr (+ ptr 1))
+ )
+ (t % remove it
+ (setf removed-items (cons item removed-items))
+ (=> item cleanup)
+ (when (eq item viewed-item) (=> self &set-viewed-item NIL))
+ ))
+ (when (and current-item-index (= i current-item-index))
+ (setf new-current-item-index this-ptr))
+ )))
+ (setf last-item-index (- ptr 1))
+ (=> self &update-display)
+ (=> display-buffer goto (+ new-current-item-index first-item-linepos) 0)
+ removed-items
+ ))
+
+(de &browser-item-not-killed (item)
+ (or (not (=> item deleted?))
+ (not (=> item kill))
+ ))
ADDED psl-1983/3-1/nmode/buffer-browser.sl
Index: psl-1983/3-1/nmode/buffer-browser.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/buffer-browser.sl
@@ -0,0 +1,456 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Buffer-Browser.SL - Buffer Browser Subsystem
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 18 October 1982
+% Revised: 8 April 1983
+%
+% This file implements a buffer browser subsystem.
+%
+% 8-April-83 Jeff Soreff
+% Filter commands, predicate, and associated funtions implemented.
+% Declare is used to speed up code somewhat.
+% 14-Mar-83 Alan Snyder
+% Convert for revised browser mechanism (with documentation, etc.)
+% 4-Mar-83 Alan Snyder
+% Added Create command.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 4-Feb-83 Alan Snyder
+% Rewritten using new browser support.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load extended-char fast-vectors fast-strings stringx
+ numeric-operators))
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(
+ nmode-selectable-buffers
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal static variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(buffer-browser-mode
+ buffer-browser-command-list
+ buffer-browser-documentation-text
+ buffer-browser-help-text
+ buffer-browser-argument-list
+ ))
+
+(setf buffer-browser-help-text
+ ["? View Edit Filter Write Create Un/Delete Kill uN/Ignore Sort/Reverse Quit"])
+
+(setf buffer-browser-documentation-text
+ ["The Buffer Browser displays the existing editor buffers."
+ "Terminology: the current buffer is the buffer pointed at by the cursor."
+ "The View (V) and Edit (E) commands both display the current buffer."
+ "In split-screen mode, Edit selects the bottom window while View does not."
+ "The Write (W) command saves the current buffer in its file, if needed."
+ "The Create (C) command creates a new buffer, but does not select it."
+ "The Delete (D) command marks the current buffer for deletion upon Quit."
+ "The Undelete (U) command removes the mark made by the Delete command."
+ "The Kill (K) command kills the current buffer immediately."
+ "The Ignore (I) command removes the current buffer from the display."
+ "The Filter (F) command ignores buffer sets, using names, modes and files."
+ "The uNignore (N) command restores all Ignored buffers to the display."
+ "The Sort (S) command sorts the buffers in various ways."
+ "The Reverse (R) command sorts the buffers in reverse order."
+ "The Quit (Q) command exits the browser and deletes any marked buffers."
+ ])
+
+(setf buffer-browser-mode (nmode-define-mode "Buffer-Browser" '(
+ (nmode-define-commands Buffer-Browser-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ )))
+
+(setf buffer-browser-command-list
+ (list
+ (cons (x-char ?) 'browser-help-command)
+ (cons (x-char C) 'buffer-browser-create-command)
+ (cons (x-char D) 'browser-delete-command)
+ (cons (x-char E) 'browser-edit-command)
+ (cons (x-char W) 'buffer-browser-save-file-command)
+ (cons (x-char I) 'browser-ignore-command)
+ (cons (x-char K) 'browser-kill-command)
+ (cons (x-char F) 'buffer-browser-filter-command)
+ (cons (x-char N) 'browser-undo-filter-command)
+ (cons (x-char Q) 'browser-kill-and-exit-command)
+ (cons (x-char R) 'buffer-browser-reverse-sort)
+ (cons (x-char S) 'buffer-browser-sort)
+ (cons (x-char U) 'browser-undelete-command)
+ (cons (x-char V) 'browser-view-command)
+ (cons (x-char X) 'browser-exit-command)
+ (cons (x-char BACKSPACE) 'browser-undelete-backwards-command)
+ (cons (x-char RUBOUT) 'browser-undelete-backwards-command)
+ (cons (x-char SPACE) 'move-down-command)
+ (cons (x-char M-~) 'buffer-browser-not-modified-command)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-browser-command ()
+ % Bring up the buffer browser subsystem.
+ (let ((browser (or (find-browser 'BUFFER-BROWSER "")
+ (create-buffer-browser)
+ )))
+ (browser-enter browser)
+ ))
+
+(de create-buffer-browser ()
+ % Create the buffer browser subsystem.
+ % The set of items is created when the browser is selected.
+
+ (let* ((header-text
+ (vector
+ (string-concat " "
+ (string-pad-right "Buffer Name" 24)
+ (string-pad-left "Size" 6)
+ " "
+ "File Name"
+ )
+ ""
+ ))
+ (browser
+ (create-browser 'BUFFER-BROWSER "Buffers" "" buffer-browser-mode
+ NIL header-text buffer-browser-documentation-text
+ buffer-browser-help-text
+ () #'buffer-browser-name-sorter)
+ ))
+ (=> browser set-select-function 'browser-update)
+ (=> browser set-update-function 'buffer-browser-update)
+ (=> browser put 'buffer-list ())
+ browser
+ ))
+
+(de buffer-browser-update (browser)
+ % Add any new buffers to the buffer browser.
+
+ (let* ((width (=> browser display-width))
+ (old-buffer-list (=> browser get 'buffer-list))
+ (old-current-item (=> browser current-item))
+ (new-items
+ (for (in b nmode-selectable-buffers)
+ (when (not (memq b old-buffer-list)))
+ (collect (create-buffer-browser-item b width))
+ ))
+ )
+ (=> browser add-items new-items)
+ (=> browser put 'buffer-list nmode-selectable-buffers)
+ (=> browser select-item old-current-item)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Special Buffer Browser commands:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-browser-create-command ()
+ (let* ((browser (current-browser))
+ (new-buffer-name (prompt-for-string "Create buffer whose name is:" NIL))
+ (b (buffer-create-default new-buffer-name))
+ (item (create-buffer-browser-item b (=> browser display-width)))
+ )
+ (write-prompt (bldmsg "Buffer %w created." (=> b name)))
+ (=> browser put 'buffer-list
+ (cons b (=> browser get 'buffer-list)))
+ (browser-add-item-and-view item)
+ ))
+
+(de buffer-browser-save-file-command ()
+ (browser-do-repeated-command 'send-item '(save-file ()) NIL)
+ )
+
+(de buffer-browser-not-modified-command ()
+ (browser-do-repeated-command 'send-item '(set-unmodified ()) NIL)
+ )
+
+(de buffer-browser-reverse-sort ()
+ (nmode-set-immediate-prompt "Reverse Sort by ")
+ (buffer-browser-reverse-sort-dispatch)
+ )
+
+(de buffer-browser-reverse-sort-dispatch ()
+ (selectq (char-upcase (input-base-character))
+ (#/N (browser-sort "Reverse Sort by Name" 'buffer-browser-name-reverser))
+ (#/S (browser-sort "Reverse Sort by Size" 'buffer-browser-size-reverser))
+ (#/F (browser-sort "Reverse Sort by File" 'buffer-browser-file-reverser))
+ (#/M
+ (browser-sort "Reverse Sort by Modified" 'buffer-browser-modified-reverser))
+ (#/?
+ (nmode-set-immediate-prompt
+ "Reverse Sort by (Name, Size, File, Modified) ")
+ (buffer-browser-reverse-sort-dispatch)
+ )
+ (t (write-prompt "") (Ding))
+ ))
+
+(de buffer-browser-sort ()
+ (nmode-set-immediate-prompt "Sort by ")
+ (buffer-browser-sort-dispatch)
+ )
+
+(de buffer-browser-sort-dispatch ()
+ (selectq (char-upcase (input-base-character))
+ (#/N (browser-sort "Sort by Name" 'buffer-browser-name-sorter))
+ (#/S (browser-sort "Sort by Size" 'buffer-browser-size-sorter))
+ (#/F (browser-sort "Sort by File" 'buffer-browser-file-sorter))
+ (#/M (browser-sort "Sort by Modified" 'buffer-browser-modified-sorter))
+ (#/? (nmode-set-immediate-prompt "Sort by (Name, Size, File, Modified) ")
+ (buffer-browser-sort-dispatch)
+ )
+ (t (write-prompt "") (Ding))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Filtering Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-browser-filter-command ()
+ (nmode-set-immediate-prompt "Filter by File-name, Mode, or Name?")
+ (buffer-browser-filter-dispatch1))
+
+(de buffer-browser-filter-dispatch1 ()
+ (selectq (char-upcase (input-base-character))
+ (#/F (buffer-browser-filter-prompter2
+ (list "file-name" #'buffer-browser-file-name-extractor)))
+ (#/M (buffer-browser-filter-prompter2
+ (list "mode" #'buffer-browser-mode-extractor)))
+ (#/N (buffer-browser-filter-prompter2
+ (list "name" #'buffer-browser-name-extractor)))
+ (#/? (nmode-set-immediate-prompt
+ "Type F for File-name, M for Mode, N for Name")
+ (buffer-browser-filter-dispatch1))
+ (t (write-prompt "") (Ding))))
+
+(declare-flavor text-buffer item-buffer)
+
+(de buffer-browser-file-name-extractor (item-buffer)
+ (=> item-buffer file-name))
+
+(declare-flavor mode mode-temp)
+
+(de buffer-browser-mode-extractor (item-buffer)
+ (let ((mode-temp (=> item-buffer mode)))
+ (=> mode-temp name)))
+
+(undeclare-flavor mode-temp)
+
+(de buffer-browser-name-extractor (item-buffer)
+ (=> item-buffer name))
+
+(undeclare-flavor item-buffer)
+
+(de buffer-browser-filter-prompter2 (aspect)
+ (nmode-set-immediate-prompt "Flush or Keep matching buffers?")
+ (buffer-browser-filter-dispatch2 aspect))
+
+(de buffer-browser-filter-dispatch2 (aspect)
+ (selectq (char-upcase (input-base-character))
+ (#/F (buffer-browser-filter-compose t aspect))
+ (#/K (buffer-browser-filter-compose nil aspect))
+ (#/?
+ (nmode-set-immediate-prompt
+ (bldmsg
+ "Type F to flush or K to keep buffers with matching %ws."
+ (first aspect)))
+ (buffer-browser-filter-dispatch2 aspect))
+ (t (write-prompt "") (Ding))))
+
+(de buffer-browser-filter-compose (flag aspect)
+ (let ((browser (current-browser))
+ (buffer-browser-argument-list
+ (list
+ (string-upcase % Make the search pattern upper case.
+ (prompt-for-string
+ (bldmsg "%w buffers with %w matching string"
+ (if flag "flush" "keep")
+ (first aspect))
+ ""))
+ flag % Keep or flush flag
+ (second aspect)))) % extractor function
+ (=> browser filter-items #'buffer-browser-filter-predicate)))
+
+(declare-flavor buffer-browser-item buffer-browser-item)
+
+(de buffer-browser-filter-predicate (buffer-browser-item)
+ (let* ((aspect (or (apply (third buffer-browser-argument-list)
+ (list (=> buffer-browser-item buffer))) ""))
+ (match (forward-search-in-string
+ aspect (first buffer-browser-argument-list))))
+ (when (second buffer-browser-argument-list)
+ (setf match (not match)))
+ match))
+
+(undeclare-flavor buffer-browser-item)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Sorting Predicates
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(declare-flavor buffer-browser-item b1 b2)
+
+(de buffer-browser-name-sorter (b1 b2)
+ (let ((name1 (=> (=> b1 buffer) name))
+ (name2 (=> (=> b2 buffer) name))
+ )
+ (StringSortFn name1 name2)
+ ))
+
+(de buffer-browser-name-reverser (b1 b2)
+ (not (buffer-browser-name-sorter)))
+
+(de buffer-browser-size-sorter (b1 b2)
+ (let ((s1 (=> (=> b1 buffer) visible-size))
+ (s2 (=> (=> b2 buffer) visible-size))
+ )
+ (or (< s1 s2)
+ (and (= s1 s2) (buffer-browser-name-sorter b1 b2))
+ )))
+
+(de buffer-browser-size-reverser (b1 b2)
+ (let ((s1 (=> (=> b1 buffer) visible-size))
+ (s2 (=> (=> b2 buffer) visible-size))
+ )
+ (or (> s1 s2)
+ (and (= s1 s2) (buffer-browser-name-sorter b1 b2))
+ )))
+
+(de buffer-browser-file-sorter (b1 b2)
+ (let ((f1 (or (=> (=> b1 buffer) file-name) ""))
+ (f2 (or (=> (=> b2 buffer) file-name) ""))
+ )
+ (StringSortFn f1 f2)
+ ))
+
+(de buffer-browser-file-reverser (b1 b2)
+ (not (buffer-browser-file-sorter b1 b2)))
+
+(de buffer-browser-modified-sorter (b1 b2)
+ (let ((m1 (=> (=> b1 buffer) modified?))
+ (m2 (=> (=> b2 buffer) modified?))
+ )
+ (cond ((not (eq m1 m2))
+ (=> (=> b1 buffer) modified?)) % saying 'M1' results in compiler bug
+ (t (buffer-browser-name-sorter b1 b2))
+ )))
+
+(de buffer-browser-modified-reverser (b1 b2)
+ (let ((m1 (=> (=> b1 buffer) modified?))
+ (m2 (=> (=> b2 buffer) modified?))
+ )
+ (cond ((not (eq m1 m2))
+ (=> (=> b2 buffer) modified?)) % saying 'M2' results in compiler bug
+ (t (buffer-browser-name-sorter b1 b2))
+ )))
+
+(undeclare-flavor b1 b2)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% The buffer-browser-item flavor:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de create-buffer-browser-item (b width)
+ (make-instance 'buffer-browser-item
+ 'buffer b
+ 'display-width width
+ ))
+
+(defflavor buffer-browser-item
+ (display-text
+ display-width
+ buffer
+ (delete-flag NIL)
+ )
+ ()
+ (gettable-instance-variables display-text buffer)
+ (initable-instance-variables)
+ )
+
+(defmethod (buffer-browser-item init) (init-plist)
+ (=> self &update-display-text)
+ )
+
+(defmethod (buffer-browser-item &update-display-text) ()
+ (setf display-text
+ (string-concat (if delete-flag "D" " ")
+ (if (=> buffer modified?) "*" " ")
+ " "
+ (string-pad-right (=> buffer name) 24)
+ (string-pad-left (bldmsg "%d" (=> buffer visible-size)) 6)
+ " "
+ (or (=> buffer file-name) "")
+ )
+ ))
+
+(defmethod (buffer-browser-item update) ()
+ (when (memq buffer nmode-selectable-buffers)
+ (=> self &update-display-text)
+ ))
+
+(defmethod (buffer-browser-item delete) ()
+ (when (not delete-flag)
+ (cond ((not (buffer-killable? buffer))
+ (nmode-error
+ (BldMsg "Buffer %w may not be deleted!" (=> buffer name)))
+ )
+ (t
+ (setf delete-flag T)
+ (=> self &update-display-text)
+ ))))
+
+(defmethod (buffer-browser-item undelete) ()
+ (when delete-flag
+ (setf delete-flag NIL)
+ (=> self &update-display-text)
+ ))
+
+(defmethod (buffer-browser-item deleted?) ()
+ delete-flag
+ )
+
+(defmethod (buffer-browser-item kill) ()
+ (cond ((not (buffer-killable? buffer))
+ (nmode-error (BldMsg "Buffer %w may not be killed!" (=> buffer name)))
+ NIL
+ )
+ ((or (not (=> buffer modified?))
+ (YesP (BldMsg "Kill unsaved buffer %w?" (=> buffer name))))
+ (=> buffer set-previous-buffer NIL)
+ (buffer-kill-and-detach buffer)
+ T
+ )))
+
+(defmethod (buffer-browser-item view-buffer) (x)
+ (if (buffer-is-selectable? buffer) buffer)
+ )
+
+(defmethod (buffer-browser-item cleanup) ()
+ )
+
+(defmethod (buffer-browser-item apply-filter) (filter)
+ (apply filter (list self))
+ )
+
+(defmethod (buffer-browser-item save-file) ()
+ (when (=> buffer modified?)
+ (save-file buffer)
+ (=> self &update-display-text)
+ ))
+
+(defmethod (buffer-browser-item set-unmodified) ()
+ (when (=> buffer modified?)
+ (=> buffer set-modified? NIL)
+ (=> self &update-display-text)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/buffer-io.sl
Index: psl-1983/3-1/nmode/buffer-io.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/buffer-io.sl
@@ -0,0 +1,239 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Buffer-IO.SL - PSL I/O to and from NMODE buffers
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 26 August 1982
+% Revised: 18 February 1983
+%
+% Adapted from Will Galway's EMODE
+%
+% 18-Feb-83 Alan Snyder
+% Fix to adjust an exposed window when displaying output.
+% 16-Feb-83 Alan Snyder
+% Recode using objects; add output cache for efficiency.
+% Remove time-since-last-redisplay check (it causes a 2X slowdown);
+% now display output only after Newline or cache full.
+% Declare -> Declare-Flavor.
+% 30-Dec-82 Alan Snyder
+% Add declarations for buffers and windows; use fast-vectors (for efficiency).
+% 27-Dec-82 Alan Snyder
+% Use generic arithmetic for Time (for portability); reformat.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-vectors))
+
+(fluid '(nmode-current-window *nmode-init-running))
+
+(DefConst MaxChannels 32) % Maximum number of channels supported by PSL.
+
+(defflavor buffer-channel
+ (
+ (editor-function NIL) % NIL or a function to obtain new input
+ (input-buffer NIL) % NIL or a buffer to obtain input from
+ (input-position NIL) % the current read pointer
+ (output-buffer NIL) % NIL or a buffer to send output to
+ (output-cache NIL) % cache of output (for efficiency)
+ output-cache-pos % pointer into output cache
+ )
+ ()
+ (settable-instance-variables)
+ )
+
+(fluid '(buffer-channel-vector))
+
+(when (or (not (BoundP 'buffer-channel-vector)) (null buffer-channel-vector))
+ (setf buffer-channel-vector (MkVect (const MaxChannels)))
+ )
+
+(fluid '(*outwindow % T => expose output window on output
+ ))
+
+(setf *outwindow T)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(declare-flavor text-buffer input-buffer output-buffer)
+(declare-flavor buffer-window w)
+(declare-flavor buffer-channel bc)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de OpenBufferChannel (input-buffer output-buffer Editor)
+
+ % Open a channel for buffer I/O. Input-Buffer and Output-Buffer may be buffer
+ % objects or NIL. Input will be read from the current location in the Input
+ % Buffer. Output will be inserted at the current location in the Output
+ % Buffer. Editor may be a function object (ID) or NIL. The Editor function
+ % can be used if you want something to "happen" every time a reader begins to
+ % read from the channel. If Editor is NIL, then the reader will simply
+ % continue reading from the current location in the input buffer.
+
+ (setf SpecialWriteFunction* 'buffer-print-character)
+ (setf SpecialReadFunction* 'buffer-read-character)
+ (setf SpecialCloseFunction* 'buffer-channel-close)
+ (let ((chn (open "buffers" 'SPECIAL))
+ (bc (make-instance 'buffer-channel))
+ )
+ (vector-store buffer-channel-vector chn bc)
+ (=> bc set-input-buffer input-buffer)
+ (=> bc set-input-position (and input-buffer (=> input-buffer position)))
+ (=> bc set-output-buffer output-buffer)
+ (=> bc set-editor-function Editor)
+ chn
+ ))
+
+(de buffer-channel-close (chn)
+ % Close up an NMODE buffer channel.
+ (vector-store buffer-channel-vector chn NIL)
+ )
+
+(de buffer-channel-set-input-buffer (chn input-buffer)
+ (let ((bc (vector-fetch buffer-channel-vector chn)))
+ (when bc
+ (=> bc set-input-buffer input-buffer)
+ (=> bc set-input-position (=> input-buffer position))
+ )))
+
+(de buffer-channel-set-input-position (chn bp)
+ (let ((bc (vector-fetch buffer-channel-vector chn)))
+ (when bc
+ (=> bc set-input-position bp)
+ )))
+
+(de buffer-channel-set-output-buffer (chn output-buffer)
+ (let ((bc (vector-fetch buffer-channel-vector chn)))
+ (when bc
+ (=> bc set-output-buffer output-buffer)
+ )))
+
+(de buffer-print-character (chn ch)
+ (let ((bc (vector-fetch buffer-channel-vector chn)))
+ (when bc
+ (=> bc putc ch)
+ )))
+
+(de buffer-channel-flush (chn)
+ (let ((bc (vector-fetch buffer-channel-vector chn)))
+ (when bc
+ (=> bc flush)
+ )))
+
+(defmethod (buffer-channel flush) ()
+ % If there is output lingering in the output cache, then append it to the
+ % output buffer and return T. Otherwise return NIL.
+
+ (when (and output-buffer output-cache (> output-cache-pos 0))
+ (let ((old-pos (=> output-buffer position)))
+ (=> output-buffer move-to-buffer-end)
+ (=> output-buffer insert-string
+ (substring output-cache 0 output-cache-pos))
+ (=> output-buffer set-position old-pos)
+ (setf output-cache-pos 0)
+ T
+ )))
+
+(defmethod (buffer-channel refresh) ()
+ % If this channel is being used for output, then refresh the display of that
+ % output. The buffer will automatically be exposed in a window (if
+ % requested by the *OutWindow flag), the output cache will be flushed, the
+ % display window will be adjusted, and the screen refreshed.
+
+ (when output-buffer
+ (if (and *OutWindow
+ (not *nmode-init-running)
+ (not (buffer-is-displayed? output-buffer)))
+ (nmode-expose-output-buffer output-buffer))
+ (let ((window-list (find-buffer-in-exposed-windows output-buffer)))
+ (when window-list
+ (=> self flush)
+ (nmode-adjust-output-window (car window-list))
+ ))))
+
+(defmethod (buffer-channel put-newline) ()
+ (=> self flush)
+ (let ((old-pos (=> output-buffer position)))
+ (=> output-buffer move-to-buffer-end)
+ (=> output-buffer insert-eol)
+ (=> output-buffer set-position old-pos)
+ )
+ (=> self refresh)
+ )
+
+(defmethod (buffer-channel putc) (ch)
+ % "Print" character CH by appending it to the output buffer.
+ (if (= ch #\EOL)
+ (=> self put-newline)
+ (when output-buffer
+ (when (null output-cache)
+ (setf output-cache (make-string 200 #\space))
+ (setf output-cache-pos 0)
+ )
+ (string-store output-cache output-cache-pos ch)
+ (setf output-cache-pos (+ output-cache-pos 1))
+ (when (>= output-cache-pos 200)
+ (=> self flush)
+ (=> self refresh)
+ ))))
+
+(de nmode-adjust-output-window (w)
+ (let ((output-buffer (=> w buffer)))
+ (=> w set-position (=> output-buffer buffer-end-position))
+ (nmode-adjust-window w)
+ (if (=> w exposed?) (nmode-refresh))
+ ))
+
+(de buffer-read-character (chn)
+ (let ((bc (vector-fetch buffer-channel-vector chn)))
+ (when bc
+ (=> bc getc)
+ )))
+
+(defmethod (buffer-channel getc) ()
+
+ % Read a character from the input buffer; advance over that character.
+ % Return End Of File if at end of buffer or if no buffer. If the "read
+ % point" equals the "buffer cursor", then the "buffer cursor" will be
+ % advanced also.
+
+ (if (not input-buffer)
+ #\EOF
+ % Otherwise (there is an input buffer)
+ (let* ((old-position (=> input-buffer position))
+ (was-at-cursor (buffer-position-equal input-position old-position))
+ result
+ )
+ (=> input-buffer set-position input-position)
+ (if (=> input-buffer at-buffer-end?)
+ (setf result #\EOF)
+ % Otherwise (not at end of buffer)
+ (setf result (=> input-buffer next-character))
+ (=> input-buffer move-forward)
+ (setf input-position (=> input-buffer position))
+ )
+ (if (not was-at-cursor)
+ (=> input-buffer set-position old-position))
+ (if *ECHO (=> self putc result))
+ result
+ )))
+
+(de MakeInputAvailable ()
+ % THIS IS THE MAGIC FUNCTION invoked by READ, and other "reader functions".
+ % IN* is a FLUID (actually GLOBAL) variable.
+ (let ((bc (vector-fetch buffer-channel-vector IN*)))
+ (when bc
+ (=> bc run-editor)
+ )))
+
+(defmethod (buffer-channel run-editor) ()
+ (if editor-function (apply editor-function (list IN*)))
+ NIL
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor input-buffer output-buffer)
+(undeclare-flavor w)
+(undeclare-flavor bc)
ADDED psl-1983/3-1/nmode/buffer-position.sl
Index: psl-1983/3-1/nmode/buffer-position.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/buffer-position.sl
@@ -0,0 +1,35 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% BUFFER-POSITION.SL - Buffer Position Objects
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 6 July 1982
+%
+% This file implements objects that store buffer positions.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int))
+
+(de buffer-position-create (line-number column-number)
+ (cons line-number column-number))
+
+(de buffer-position-line (bp)
+ (car bp))
+
+(de buffer-position-column (bp)
+ (cdr bp))
+
+(de buffer-position-equal (bp1 bp2)
+ (and (= (car bp1) (car bp2)) (= (cdr bp1) (cdr bp2))))
+
+(de buffer-position-compare (bp1 bp2)
+ (cond ((< (buffer-position-line bp1) (buffer-position-line bp2)) -1)
+ ((> (buffer-position-line bp1) (buffer-position-line bp2)) 1)
+ ((< (buffer-position-column bp1) (buffer-position-column bp2)) -1)
+ ((> (buffer-position-column bp1) (buffer-position-column bp2)) 1)
+ (t 0)))
+
+(de buffer-position-lessp (bp1 bp2)
+ (<= (buffer-position-compare bp1 bp2) 0))
ADDED psl-1983/3-1/nmode/buffer-window.sl
Index: psl-1983/3-1/nmode/buffer-window.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/buffer-window.sl
@@ -0,0 +1,468 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Buffer-Window.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 18 August 1982
+% Revised: 24 February 1983
+%
+% Inspired by Will Galway's EMODE Virtual Screen package.
+%
+% A Buffer-Window object maintains an attachment between an editor buffer and a
+% virtual screen. This module is responsible for mapping the contents of the
+% editor buffer to an image on the virtual screen. A "window label" object
+% may be specified to maintain a descriptive label at the bottom of the
+% virtual screen (see comment for the SET-LABEL method).
+%
+% 24-Feb-83 Alan Snyder
+% Fixed bug: cursor positioning didn't take buffer-left into account.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 7-Feb-83 Alan Snyder
+% Refresh now returns a flag indicating completion (no breakout).
+% Add cached method for label refresh.
+% 31-Jan-83 Alan Snyder
+% Modified to use separate window-label object to write the label area.
+% Note: SET-SIZE height argument is now interpreted as the screen height!
+% 20-Jan-83 Alan Snyder
+% Bug fix: adjust window after changing screen size.
+% 28-Dec-82 Alan Snyder
+% Replaced call to current-display-column in REFRESH, which was incorrect
+% because it assumes the buffer is current. Changed to display position of
+% window, rather than position of buffer (meaningful only when the window
+% package can display multiple cursors). Added methods: CHAR-POSITION,
+% SET-SCREEN, and &NEW-SCREEN. Changed EXPOSE to refresh first, for more
+% graceful screen update when using direct writing. Change label writing to
+% clear-eol after writing the label, not before, also for more graceful
+% screen update. Changed &WRITE-LINE-TO-SCREEN to buffer its changes in a
+% string, for efficiency. General cleanup.
+% 20-Dec-82 Alan Snyder
+% Added declarations for buffer and screen instance variables, for
+% efficiency.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors fast-strings display-char))
+
+(de create-unlabeled-buffer-window (buffer virtual-screen)
+ % Create a buffer window object that presents the specified buffer onto
+ % the specified virtual-screen. There will be no label area.
+ (make-instance 'buffer-window 'buffer buffer 'screen virtual-screen)
+ )
+
+(de create-buffer-window (buffer virtual-screen)
+ % Create a buffer window object that presents the specified buffer onto
+ % the specified virtual-screen. There will be a one-line label.
+ (let ((w (create-unlabeled-buffer-window buffer virtual-screen)))
+ (=> w set-label (create-window-label w))
+ w
+ ))
+
+(defflavor buffer-window
+ (height % number of rows of text (rows are 0 indexed)
+ maxrow % highest numbered row
+ width % number of columns of text (cols are 0 indexed)
+ maxcol % highest numbered column
+ (buffer-left 0) % leftmost buffer column displayed
+ (buffer-top 0) % topmost buffer line displayed
+ (overflow-marker #/!) % display character used to mark overlong lines
+ (saved-position NIL) % buffer position saved here while not selected
+
+ (label NIL) % the optional label-maintaining object
+ (label-height 0) % number of lines occupied by the label
+ (label-refresh-method NIL) % cached method for refreshing the label
+
+ (text-enhancement (dc-make-enhancement-mask))
+ % display enhancement used in text area
+
+ line-buffer % string of characters used to write line
+
+ buffer % the buffer being displayed
+ screen % the virtual screen used for display
+ buffer-lines % vector of buffer lines currently displayed
+ % % NIL used for EQable empty string
+ )
+ ()
+ (gettable-instance-variables
+ height
+ width
+ screen
+ buffer
+ buffer-left
+ buffer-top
+ text-enhancement
+ )
+ (initable-instance-variables
+ screen
+ buffer
+ text-enhancement
+ )
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(declare-flavor text-buffer buffer)
+(declare-flavor virtual-screen screen)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Public methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (buffer-window select) ()
+ % This method is invoked when the window is selected. It restores the saved
+ % buffer pointer, if any. It will not scroll the window: instead, it will
+ % adjust the buffer position, if necessary, to keep the buffer pointer within
+ % the window.
+ (when saved-position
+ (=> buffer set-position saved-position)
+ (setf saved-position NIL)
+ )
+ (=> self adjust-buffer)
+ )
+
+(defmethod (buffer-window deselect) ()
+ % This method is invoked when the window is deselected. It saves the current
+ % buffer pointer, which will be restored when the window is again selected.
+ % It adjusts the window to ensure that the window shows the saved position.
+ (setf saved-position (=> buffer position))
+ (=> self adjust-window)
+ )
+
+(defmethod (buffer-window expose) ()
+ % Expose the window, putting it "on top" (expose the attached virtual screen).
+ (=> self refresh nil)
+ (=> screen expose)
+ )
+
+(defmethod (buffer-window deexpose) ()
+ % De-expose the window (de-expose the attached virtual screen).
+ (=> screen deexpose)
+ )
+
+(defmethod (buffer-window exposed?) ()
+ (=> screen exposed?)
+ )
+
+(defmethod (buffer-window set-screen) (new-screen)
+ (when (not (eq screen new-screen))
+ (let ((exposed? (=> screen exposed?))
+ (old-screen screen)
+ )
+ (setf screen new-screen)
+ (=> self &new-screen)
+ (when exposed? (=> self expose) (=> old-screen deexpose))
+ )))
+
+(defmethod (buffer-window set-label) (new-label)
+ % Specify a "label" object to write a label at the bottom of the screen. NIL
+ % implies that no label area is wanted. If an object is specified, it
+ % must support the following operations:
+
+ % (=> label height)
+ % Return the number of lines occupied by the label area at the bottom
+ % of the buffer-window's virtual screen.
+ % (=> label resize)
+ % Tell the label that the window has changed size. This may cause
+ % the label to change its height, but should not cause a refresh.
+ % (=> label refresh)
+ % This instructs the label object to refresh the label area. The label
+ % area is assumed to be the bottom-most <height> lines on the
+ % buffer-window's virtual screen, although it could be on a totally
+ % different virtual screen, if desired (in which case the "height"
+ % operation should return 0).
+
+ % This operation may change the number of lines available for text, which
+ % may require adjusting the window position. A refresh is not done
+ % immediately.
+
+ (setf label new-label)
+ (setf label-refresh-method (if label (object-get-handler label 'refresh)))
+ (=> self &new-size)
+ )
+
+(defmethod (buffer-window position) ()
+ % If the window is selected, return the position of the buffer. Otherwise,
+ % return the "saved position".
+ (or saved-position (=> buffer position)))
+
+(defmethod (buffer-window line-position) ()
+ (if saved-position
+ (buffer-position-line saved-position)
+ (=> buffer line-pos)
+ ))
+
+(defmethod (buffer-window char-position) ()
+ (if saved-position
+ (buffer-position-column saved-position)
+ (=> buffer char-pos)
+ ))
+
+(defmethod (buffer-window set-position) (bp)
+ % If the window is selected, set the buffer position. Otherwise, set the
+ % "saved position".
+ (if saved-position
+ (setf saved-position bp)
+ (=> buffer set-position bp)
+ ))
+
+(defmethod (buffer-window set-line-position) (line)
+ % If the window is selected, set the buffer position.
+ % Otherwise, set the "saved position".
+
+ (if saved-position
+ (setf saved-position (buffer-position-create line 0))
+ (=> buffer set-line-pos line)
+ ))
+
+(defmethod (buffer-window adjust-window) ()
+ % Adjust the window position, if necessary, to ensure that the current
+ % buffer location (if the window is selected) or the saved buffer location
+ % (if the window is not selected) is within the window.
+ (let ((line (=> self line-position)))
+ (if (or (< line buffer-top) (>= line (+ buffer-top height)))
+ % The desired line doesn't show in the window.
+ (=> self readjust-window)
+ )))
+
+(defmethod (buffer-window readjust-window) ()
+ % Adjust the window position to nicely show the current location.
+ (let ((line (=> self line-position))
+ (one-third-screen (/ height 3))
+ )
+ (=> self set-buffer-top
+ (if (>= line (- (=> buffer size) one-third-screen))
+ (- line (* 2 one-third-screen))
+ (- line one-third-screen)
+ ))))
+
+(defmethod (buffer-window adjust-buffer) ()
+ % Adjust the buffer position, if necessary, to ensure that the current
+ % buffer location is visible on the screen. If the window position is
+ % past the end of the buffer, it will be changed.
+ (let ((size (=> buffer size)))
+ (cond ((>= buffer-top size)
+ % The window is past the end of the buffer.
+ (=> self set-buffer-top (- size (/ height 3)))
+ )))
+ (let ((line (=> buffer line-pos)))
+ (cond ((or (< line buffer-top) (>= line (+ buffer-top height)))
+ % The current line doesn't show in the window.
+ (=> buffer set-line-pos (+ buffer-top (/ height 3)))
+ ))))
+
+(defmethod (buffer-window set-buffer) (new-buffer)
+ (setf buffer new-buffer)
+ (setf buffer-left 0)
+ (setf buffer-top 0)
+ (if saved-position (setf saved-position (=> buffer position)))
+ (=> self adjust-window)
+ (=> self &reset)
+ )
+
+(defmethod (buffer-window set-buffer-top) (new-top)
+ (cond ((<= new-top 0) (setf new-top 0))
+ ((>= new-top (=> buffer visible-size))
+ (setf new-top (- (=> buffer visible-size) 1)))
+ )
+ (setf buffer-top new-top)
+ )
+
+(defmethod (buffer-window set-buffer-left) (new-left)
+ (when (~= new-left buffer-left)
+ (if (< new-left 0) (setf new-left 0))
+ (when (~= new-left buffer-left)
+ (setf buffer-left new-left)
+ (=> self &reset)
+ )))
+
+(defmethod (buffer-window set-size) (new-height new-width)
+ % Change the size of the screen to have the specified height and width.
+ % The size is adjusted to ensure that there is at least one row of text.
+
+ (setf new-height (max new-height (+ label-height 1)))
+ (setf new-width (max new-width 1))
+ (when (or (~= new-height (=> screen height))
+ (~= new-width (=> screen width)))
+ (=> screen set-size new-height new-width)
+ (=> self &new-size)
+ ))
+
+(defmethod (buffer-window set-text-enhancement) (e-mask)
+ (when (~= text-enhancement e-mask)
+ (setf text-enhancement e-mask)
+ (=> screen set-default-enhancement e-mask)
+ (=> self &reset)
+ ))
+
+(defmethod (buffer-window refresh) (breakout-allowed)
+ % Update the virtual screen (including the label) to correspond to the
+ % current state of the attached buffer. Return true if the refresh
+ % was completed (no breakout occurred).
+
+ (if (not (and breakout-allowed (input-available?)))
+ (let ((buffer-end (=> buffer visible-size)))
+ (for (from row 0 maxrow)
+ (for line-number buffer-top (+ line-number 1))
+ (do
+ % NIL is used to represent all EMPTY lines, so that EQ will work.
+ (let ((line (and (< line-number buffer-end)
+ (=> buffer fetch-line line-number))))
+ (if (and line (string-empty? line)) (setf line NIL))
+ (when (not (eq line (vector-fetch buffer-lines row)))
+ (vector-store buffer-lines row line)
+ (=> self &write-line-to-screen line row)
+ )))
+ )
+ (if (and label label-refresh-method)
+ (apply label-refresh-method (list label)))
+ (let* ((linepos (=> self line-position))
+ (charpos (=> self char-position))
+ (row (- linepos buffer-top))
+ (line (vector-fetch buffer-lines row))
+ (column (- (map-char-to-column line charpos) buffer-left))
+ )
+ (=> screen set-cursor-position row column)
+ )
+ T % refresh completed
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Private methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (buffer-window init) (init-plist)
+ (=> self &new-screen)
+ )
+
+(defmethod (buffer-window &new-screen) ()
+ (=> screen set-default-enhancement text-enhancement)
+ (=> self &new-size)
+ )
+
+(defmethod (buffer-window &new-size) ()
+ % The size of the screen and/or label may have changed. Adjust
+ % the internal state of the buffer-window accordingly.
+
+ (if label (=> label resize)) % may change label height
+ (setf label-height (if label (max 0 (=> label height)) 0))
+ (setf height (- (=> screen height) label-height))
+ (setf width (=> screen width))
+ (setf maxrow (- height 1))
+ (setf maxcol (- width 1))
+ (setf buffer-lines (make-vector maxrow 'UNKNOWN))
+ (setf line-buffer (make-string (+ maxcol 10) #\space))
+ (=> self adjust-window) % ensure that cursor is still visible
+ )
+
+(defmethod (buffer-window &reset) ()
+ % "Forget" information about displayed lines.
+ (for (from i 0 maxrow)
+ (do (vector-store buffer-lines i 'UNKNOWN))))
+
+(defmethod (buffer-window &write-line-to-screen) (line row)
+ (if (null line)
+ (=> screen clear-to-eol row 0)
+ % else
+ (let ((count (=> self &compute-screen-line line)))
+ (cond
+ ((> count width)
+ (=> screen write-string row 0 line-buffer maxcol)
+ (=> screen write overflow-marker row maxcol)
+ )
+ (t
+ (=> screen write-string row 0 line-buffer count)
+ (=> screen clear-to-eol row count)
+ )))))
+
+(defmacro &write-char (ch)
+ % Used by &COMPUTE-SCREEN-LINE.
+ `(progn
+ (if (>= line-index 0)
+ (string-store line-buf line-index ,ch))
+ (setf line-index (+ line-index 1))
+ (setf line-column (+ line-column 1))
+ ))
+
+(defmethod (buffer-window &compute-screen-line) (line)
+ % Internal method used by &WRITE-LINE-TO-SCREEN. It fills the line buffer
+ % with the appropriate characters and returns the number of characters in
+ % the line buffer.
+
+ (let ((line-buf line-buffer) % local variables are more efficient
+ (line-column 0)
+ (line-index (- buffer-left))
+ (the-width width) % local variables are more efficient
+ )
+ (for (from i 0 (string-upper-bound line))
+ (until (> line-index the-width)) % have written past the right edge
+ (do (let ((ch (string-fetch line i)))
+ (cond
+ ((= ch #\TAB) % TABs are converted to spaces.
+ (let ((tabcol (& (+ line-column 8) (~ 7))))
+ (while (< line-column tabcol)
+ (&write-char #\space)
+ )))
+ ((or (< ch #\space) (= ch #\rubout))
+ % Control characters are converted to "uparrow" form.
+ (&write-char #/^)
+ (&write-char (^ ch 8#100))
+ )
+ (t (&write-char ch))
+ ))))
+ line-index
+ ))
+
+(de map-char-to-column (line n)
+ % Map character position N to the corresponding display column index with
+ % respect to the specified LINE. Handle funny mapping of TABs and control
+ % characters.
+
+ (setf n (- n 1))
+ (let ((upper-bound (string-upper-bound line)))
+ (if (> n upper-bound) (setf n upper-bound)))
+ (for* (from i 0 n)
+ (with (col 0))
+ (do (let ((ch (string-fetch line i)))
+ (cond
+ ((= ch #\TAB)
+ % TABs are converted to an appropriate number of spaces.
+ (setf col (& (+ col 8) (~ 7)))
+ )
+ ((or (< ch #\space) (= ch #\rubout))
+ % Control characters are converted to "uparrow" form.
+ (setf col (+ col 2))
+ )
+ (t
+ (setf col (+ col 1))
+ ))))
+ (returns col)))
+
+(de map-column-to-char (line n)
+ % Map display column index N to the corresponding character position with
+ % respect to the specified LINE. Handle funny mapping of TABs and control
+ % characters.
+
+ (for* (from i 0 (string-upper-bound line))
+ (with (col 0))
+ (until (>= col n))
+ (do (let ((ch (string-fetch line i)))
+ (cond
+ ((= ch #\TAB)
+ % TABs are converted to an appropriate number of spaces.
+ (setf col (& (+ col 8) (~ 7)))
+ )
+ ((or (< ch #\space) (= ch #\rubout))
+ % Control characters are converted to "uparrow" form.
+ (setf col (+ col 2))
+ )
+ (t
+ (setf col (+ col 1))
+ ))))
+ (returns i)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor buffer screen)
ADDED psl-1983/3-1/nmode/buffer.sl
Index: psl-1983/3-1/nmode/buffer.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/buffer.sl
@@ -0,0 +1,267 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Buffer.SL - Auxiliary Functions for manipulating the current buffer.
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 20 August 1982
+% Revised: 16 February 1983
+%
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects))
+
+(fluid '(nmode-current-buffer))
+
+(declare-flavor text-buffer nmode-current-buffer)
+
+(de buffer-get-position ()
+ % Return the "current position" in the current buffer as a BUFFER-POSITION
+ % object.
+ (=> nmode-current-buffer position))
+
+(de buffer-set-position (bp)
+ % Set the "current position" in the current buffer from the specified
+ % BUFFER-POSITION object. Clips the line-position and char-position.
+
+ (if bp (=> nmode-current-buffer set-position bp)))
+
+(de current-buffer-goto (line-number char-number)
+ % Set the "current position" in the current buffer.
+ % Clips the line-position and char-position.
+ (=> nmode-current-buffer goto line-number char-number))
+
+(de current-line-pos ()
+ % Return the "current line position" in the current buffer.
+ (=> nmode-current-buffer line-pos))
+
+(de set-line-pos (n)
+ % Set the "current line position" in the current buffer.
+ % Clips the line-position and char-position.
+ (=> nmode-current-buffer set-line-pos n))
+
+(de current-char-pos ()
+ % Return the "current character position" in the current buffer.
+ (=> nmode-current-buffer char-pos))
+
+(de set-char-pos (n)
+ % Set the "current character position" in the current buffer.
+ % Clips the specified position to lie in the range 0..line-length.
+ (=> nmode-current-buffer set-char-pos n))
+
+(de current-display-column ()
+ % Return the column index corresponding to the current character position
+ % in the display of the current line. In other words, what screen column
+ % should the cursor be in (ignoring horizontal scrolling)?
+ (map-char-to-column (current-line) (current-char-pos)))
+
+(de set-display-column (n)
+ % Adjust the character position within the current buffer so that
+ % the current display column will be the smallest possible value
+ % not less than N. (The display column may differ than N because
+ % certain characters display in multiple columns.)
+ (set-char-pos (map-column-to-char (current-line) n)))
+
+(de current-buffer-size ()
+ % Return the number of lines in the current buffer.
+ % This count may include a fake empty line at the end of the buffer.
+ (=> nmode-current-buffer size))
+
+(de current-buffer-visible-size ()
+ % Return the apparent number of lines in the current buffer.
+ % The fake empty line that may be present at the end of the
+ % buffer is not counted.
+ (=> nmode-current-buffer visible-size))
+
+(de current-line ()
+ % Return the current line in the current buffer (as a string).
+ (=> nmode-current-buffer fetch-line (current-line-pos)))
+
+(de current-line-replace (s)
+ % Replace the current line of the current buffer with the specified string.
+ (=> nmode-current-buffer store-line (current-line-pos) s))
+
+(de current-buffer-fetch (n)
+ % Return the line at line position N within the current buffer.
+ (=> nmode-current-buffer fetch-line n))
+
+(de current-buffer-store (n l)
+ % Store the line L at line position N within the current buffer.
+ (=> nmode-current-buffer store-line n l))
+
+(de set-mark (bp)
+ % PUSH the specified position onto the ring buffer of marks associated with
+ % the current buffer. The specified position thus becomes the current "mark".
+ (=> nmode-current-buffer set-mark bp))
+
+(de set-mark-from-point ()
+ % PUSH the current position onto the ring buffer of marks associated with
+ % the current buffer. The current position thus becomes the current "mark".
+ (=> nmode-current-buffer set-mark-from-point))
+
+(de current-mark ()
+ % Return the current mark associated with the current buffer.
+ (=> nmode-current-buffer mark))
+
+(de previous-mark ()
+ % POP the current mark off the ring buffer of marks associated with the
+ % current buffer. Return the new current mark.
+ (=> nmode-current-buffer previous-mark))
+
+(de reset-buffer ()
+ % Reset the contents of the current buffer to empty and "not modified".
+ (=> nmode-current-buffer reset))
+
+(de extract-region (delete-it bp1 bp2)
+
+ % Delete (if delete-it is non-NIL) or copy (otherwise) the text between
+ % position BP1 and position BP2. Return the deleted (or copied) text as a
+ % pair (CONS direction-of-deletion vector-of-strings). The returned
+ % direction is +1 if BP1 <= BP2, and -1 otherwise. The current position is
+ % set to the beginning of the region if deletion is performed.
+
+ (=> nmode-current-buffer extract-region delete-it bp1 bp2))
+
+(de extract-text (delete-it bp1 bp2)
+
+ % Delete (if delete-it is non-NIL) or copy (otherwise) the text between
+ % position BP1 and position BP2. Return the deleted (or copied) text as a
+ % vector-of-strings. The current position is set to the beginning of the
+ % region if deletion is performed.
+
+ (cdr (=> nmode-current-buffer extract-region delete-it bp1 bp2)))
+
+(de current-line-length ()
+ % Return the number of characters in the current line.
+ (=> nmode-current-buffer current-line-length))
+
+(de current-line-empty? ()
+ % Return T if the current line contains no characters.
+ (=> nmode-current-buffer current-line-empty?))
+
+(de current-line-blank? ()
+ % Return T if the current line contains no non-blank characters.
+ (=> nmode-current-buffer current-line-blank?))
+
+(de at-line-start? ()
+ % Return T if we are positioned at the start of the current line.
+ (=> nmode-current-buffer at-line-start?))
+
+(de at-line-end? ()
+ % Return T if we are positioned at the end of the current line.
+ (=> nmode-current-buffer at-line-end?))
+
+(de at-buffer-start? ()
+ % Return T if we are positioned at the start of the buffer.
+ (=> nmode-current-buffer at-buffer-start?))
+
+(de at-buffer-end? ()
+ % Return T if we are positioned at the end of the buffer.
+ (=> nmode-current-buffer at-buffer-end?))
+
+(de current-line-is-first? ()
+ % Return T if the current line is the first line in the buffer.
+ (=> nmode-current-buffer current-line-is-first?))
+
+(de current-line-is-last? ()
+ % Return T if the current line is the last line in the buffer.
+ (=> nmode-current-buffer current-line-is-last?))
+
+(de current-line-fetch (n)
+ % Return the character at character position N within the current line.
+ % An error is signalled if N is out of range.
+ (=> nmode-current-buffer current-line-fetch n))
+
+(de current-line-store (n c)
+ % Store the character C at char position N within the current line.
+ % An error is signalled if N is out of range.
+ (=> nmode-current-buffer current-line-store n c))
+
+(de move-to-buffer-start ()
+ % Move to the beginning of the current buffer.
+ (=> nmode-current-buffer move-to-buffer-start))
+
+(de move-to-buffer-end ()
+ % Move to the end of the current buffer.
+ (=> nmode-current-buffer move-to-buffer-end))
+
+(de move-to-start-of-line ()
+ % Move to the beginning of the current line.
+ (=> nmode-current-buffer move-to-start-of-line))
+
+(de move-to-end-of-line ()
+ % Move to the end of the current line.
+ (=> nmode-current-buffer move-to-end-of-line))
+
+(de move-to-next-line ()
+ % Move to the beginning of the next line.
+ % If already at the last line, move to the end of the line.
+ (=> nmode-current-buffer move-to-next-line))
+
+(de move-to-previous-line ()
+ % Move to the beginning of the previous line.
+ % If already at the first line, move to the beginning of the line.
+ (=> nmode-current-buffer move-to-previous-line))
+
+(de move-forward ()
+ % Move to the next character in the current buffer.
+ % Do nothing if already at the end of the buffer.
+ (=> nmode-current-buffer move-forward))
+
+(de move-backward ()
+ % Move to the previous character in the current buffer.
+ % Do nothing if already at the start of the buffer.
+ (=> nmode-current-buffer move-backward))
+
+(de next-character ()
+ % Return the character to the right of the current position.
+ % Return NIL if at the end of the buffer.
+ (=> nmode-current-buffer next-character))
+
+(de previous-character ()
+ % Return the character to the left of the current position.
+ % Return NIL if at the beginning of the buffer.
+ (=> nmode-current-buffer previous-character))
+
+(de insert-character (c)
+ % Insert character C at the current position in the buffer and advance past
+ % that character.
+ (=> nmode-current-buffer insert-character c))
+
+(de insert-eol ()
+ % Insert a line-break at the current position in the buffer and advance to
+ % the beginning of the newly-formed line.
+ (=> nmode-current-buffer insert-eol))
+
+(de insert-line (l)
+ % Insert the specified string as a new line in front of the
+ % current line. Advance past the newly inserted line.
+ (=> nmode-current-buffer insert-line l))
+
+(de insert-string (s)
+ % Insert the string S at the current position. Advance past the
+ % newly-inserted string. Note: S must not contain EOL characters!
+ (=> nmode-current-buffer insert-string s))
+
+(de insert-text (v)
+
+ % V is a vector of strings similar to LINES (e.g., the last string in V is
+ % considered to be an unterminated line). Thus, V must have at least one
+ % element. Insert this stuff at the current position and advance past it.
+
+ (=> nmode-current-buffer insert-text v))
+
+(de delete-next-character ()
+ % Delete the next character.
+ % Do nothing if at the end of the buffer.
+ (=> nmode-current-buffer delete-next-character))
+
+(de delete-previous-character ()
+ % Delete the previous character.
+ % Do nothing if at the beginning of the buffer.
+ (=> nmode-current-buffer delete-previous-character))
+
+(undeclare-flavor nmode-current-buffer)
ADDED psl-1983/3-1/nmode/buffers.sl
Index: psl-1983/3-1/nmode/buffers.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/buffers.sl
@@ -0,0 +1,413 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Buffers.SL - Buffer Collection Manipulation Functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 August 1982
+% Revised: 14 March 1983
+%
+% This file contains functions that manipulate the set of existing buffers.
+%
+% 14-Mar-83 Alan Snyder
+% Add new function: nmode-new-window-or-buffer. Extend the notion of
+% selectable buffer to include unnamed buffers. Replace
+% buffer-create-unselectable with create-unnamed-buffer. Change
+% window-select-buffer to do nothing if the buffer is already attached to the
+% window.
+% 25-Jan-83 Alan Snyder
+% Fix bug in buffer name completion: now accepts the name of an existing buffer
+% even when the name is a prefix of the name of some other buffer.
+% 29-Dec-82 Alan Snyder
+% Revise prompt-for-buffer code to use new prompted input.
+% PROMPT-FOR-EXISTING-BUFFER now completes on CR and LF, as well as SPACE.
+% 3-Dec-82 Alan Snyder
+% Added CLEANUP-BUFFERS.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char fast-strings numeric-operators))
+(load stringx)
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-current-buffer nmode-current-window nmode-main-buffer
+ nmode-output-buffer nmode-default-mode nmode-input-default
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Global variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-selectable-buffers))
+(if (not (boundp 'nmode-selectable-buffers))
+ (setf nmode-selectable-buffers NIL))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% A buffer is selectable if it is a named buffer on the selectable buffer list
+% (i.e., a buffer that can be selected by name) or if it is an unnamed buffer.
+% A buffer that has a name but is not on the list may not be selected, since
+% the user would expect to be able to select it by name. These buffers are
+% ones that the user has killed.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(prompt-for-buffer-command-list
+ prompt-for-existing-buffer-command-list
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Creating buffers:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-create-default (buffer-name)
+
+ % Create a new buffer with the default mode. The name of the new buffer will
+ % be the specified name if no buffer already exists with that name.
+ % Otherwise, a similar name will be chosen. The buffer becomes selectable,
+ % but is not selected.
+
+ (buffer-create buffer-name nmode-default-mode))
+
+(de buffer-create (buffer-name initial-mode)
+ % Create a new buffer. The name of the new buffer will be the specified name
+ % if no buffer already exists with that name. Otherwise, a similar name will
+ % be chosen. The buffer becomes selectable, but is not selected.
+
+ (setf buffer-name (buffer-make-unique-name buffer-name))
+ (let ((b (create-text-buffer buffer-name)))
+ (=> b set-mode initial-mode)
+ (=> b set-previous-buffer nmode-current-buffer)
+ (setq nmode-selectable-buffers (cons b nmode-selectable-buffers))
+ b))
+
+(de create-unnamed-buffer (initial-mode)
+ % Create a new, unnamed buffer with the specified mode.
+
+ (let ((b (create-text-buffer NIL)))
+ (=> b set-mode initial-mode)
+ (=> b set-previous-buffer nmode-current-buffer)
+ b))
+
+(de buffer-make-unique-name (buffer-name)
+ % Return a buffer name not equal to the name of any existing buffer.
+
+ (setf buffer-name (string-upcase buffer-name))
+ (for*
+ (with (root-name (string-concat buffer-name "-")))
+ (for count 0 (+ count 1))
+ (for name buffer-name (string-concat root-name (BldMsg "%d" count)))
+ (do (if (not (buffer-exists? name)) (exit name)))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Finding buffers:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-find (buffer-name)
+ % If a selectable buffer exists with the specified name (case does
+ % not matter), then return it. Otherwise, return NIL.
+
+ (for (in b nmode-selectable-buffers)
+ (do (if (string-equal buffer-name (=> b name))
+ (exit b)))
+ (returns nil)
+ ))
+
+(de buffer-find-or-create (buffer-name)
+ % Return the specified buffer, if it exists and is selectable.
+ % Otherwise, create a buffer of that name and return it.
+
+ (or (buffer-find buffer-name)
+ (buffer-create-default buffer-name)
+ ))
+
+(de buffer-exists? (buffer-name)
+ % Return T if a selectable buffer exists with the specified name
+ % (case does not matter), NIL otherwise.
+
+ (if (buffer-find buffer-name) T NIL))
+
+(de nmode-user-buffers ()
+ % Return a list of those selectable buffers whose names do not begin
+ % with a '+'.
+
+ (for (in b nmode-selectable-buffers)
+ (when (~= (string-fetch (=> b name) 0) #/+))
+ (collect b)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Manipulating buffers:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-is-selectable? (b)
+ % Return T if the specified buffer is selectable.
+ (or (not (=> b name))
+ (MemQ b nmode-selectable-buffers)
+ ))
+
+(de buffer-set-mode (b mode)
+ % Set the "mode" of the buffer B. If B is the current buffer, then the
+ % mode is "established".
+
+ (=> b set-mode mode)
+ (when (eq b nmode-current-buffer)
+ (nmode-establish-current-mode)
+ (set-message "")
+ ))
+
+(de cleanup-buffers ()
+ % Ask each buffer to "clean up" any unneeded storage.
+ (for (in b nmode-selectable-buffers)
+ (do (=> b cleanup))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Selecting Buffers:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-select (b)
+ % If B is not NIL and B is a selectable buffer, then make it the current
+ % buffer, attach it to the current window, and return it. Otherwise, do
+ % nothing and return NIL.
+
+ (window-select-buffer nmode-current-window b))
+
+(de buffer-select-previous (b)
+ % Select the previous buffer of B, if it exists and is selectable.
+ % Otherwise, select the MAIN buffer.
+
+ (if (not (buffer-select (=> b previous-buffer)))
+ (buffer-select nmode-main-buffer))
+ )
+
+(de buffer-select-by-name (buffer-name)
+ % If the specified named buffer exists and is selectable, select it and
+ % return it. Otherwise, return NIL.
+
+ (buffer-select (buffer-find buffer-name)))
+
+(de buffer-select-or-create (buffer-name)
+ % Select the specified named buffer, if it exists and is selectable.
+ % Otherwise, create a buffer of that name and select it.
+
+ (or (buffer-select-by-name buffer-name)
+ (buffer-select (buffer-create-default buffer-name))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Prompting for buffer names:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(setf prompt-for-buffer-command-list
+ (list
+ (cons (x-char SPACE) 'complete-input-buffer-name)
+ (cons (x-char CR) 'check-input-buffer-name)
+ (cons (x-char LF) 'check-input-buffer-name)
+ ))
+
+(setf prompt-for-existing-buffer-command-list
+ (list
+ (cons (x-char SPACE) 'complete-input-buffer-name)
+ (cons (x-char CR) 'complete-input-existing-buffer-name)
+ (cons (x-char LF) 'complete-input-existing-buffer-name)
+ ))
+
+(de prompt-for-buffer (prompt default-b)
+ % Ask the user for the name of a buffer. If the user gives a name that does
+ % not name an existing buffer, a new buffer with that name will be created
+ % (but NOT selected), and the prompt "(New Buffer)" will be displayed.
+ % Return the buffer. DEFAULT-B is the buffer to return as default (it may
+ % be NIL). A valid buffer will always be returned (the user may ABORT).
+
+ (let* ((default-name (and default-b (=> default-b name)))
+ (name (prompt-for-string-special
+ prompt
+ default-name
+ prompt-for-buffer-command-list
+ ))
+ )
+ (or (buffer-find name)
+ (prog1
+ (buffer-create-default (string-upcase name))
+ (write-prompt "(New Buffer)")
+ ))))
+
+(de prompt-for-existing-buffer (prompt default-b)
+ % Ask the user for the name of an existing buffer. Return the buffer.
+ % DEFAULT-B is the buffer to return as default (it may be NIL). A valid
+ % buffer will always be returned, unless the user aborts (throw 'ABORT).
+
+ (let* ((default-name (and default-b (=> default-b name)))
+ (name (prompt-for-string-special
+ prompt
+ default-name
+ prompt-for-existing-buffer-command-list
+ ))
+ )
+ (buffer-find name)
+ ))
+
+% Internal functions:
+
+(de complete-input-buffer-name ()
+ % Extend the string in the input buffer as far as possible to match the set of
+ % existing buffers. Return T if the resulting string names an existing
+ % buffer; otherwise Beep and return NIL.
+
+ (let* ((name (nmode-get-input-string))
+ (names (buffer-names-that-match name))
+ )
+ (when (not (null names))
+ (setf name (strings-largest-common-prefix names))
+ (nmode-replace-input-string name)
+ )
+ (if (member name names)
+ T
+ (progn (Ding) NIL)
+ )))
+
+(de check-input-buffer-name ()
+ % Check the string in the input buffer to ensure that it is non-empty, or if
+ % it is empty, that the default string exists and is not empty. Beep if this
+ % condition fails, otherwise terminate the input.
+
+ (if (or (not (string-empty? (nmode-get-input-string)))
+ (and nmode-input-default
+ (not (string-empty? nmode-input-default))))
+ (nmode-terminate-input)
+ (Ding)
+ ))
+
+(de complete-input-existing-buffer-name ()
+ % If the input buffer is empty and there is a default string, substitute the
+ % default string. Then, extend the string in the input buffer as far as
+ % possible to match the set of existing buffers. If the resulting string
+ % names an existing buffer, refresh and terminate input. Otherwise, beep.
+
+ (nmode-substitute-default-input)
+ (when (complete-input-buffer-name)
+ (nmode-refresh)
+ (nmode-terminate-input)
+ ))
+
+(de buffer-names-that-match (name)
+ (for (in b nmode-selectable-buffers)
+ (when (buffer-name-matches b name))
+ (collect (=> b name))))
+
+(de buffer-name-matches (b name2)
+ (let* ((len2 (string-length name2))
+ (name1 (=> b name))
+ (len1 (string-length name1))
+ )
+ (and
+ (>= len1 len2)
+ (string-equal (substring name1 0 len2) name2)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Attaching buffers to windows
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-select-buffer (w b)
+ % If B is not NIL and B is a selectable buffer, then attach B to the window
+ % W and return B. Otherwise, do nothing and return NIL. If W is the
+ % current window, then the buffer becomes the current buffer.
+
+ (when (and b (buffer-is-selectable? b) (not (eq b (=> w buffer))))
+ (=> w set-buffer b)
+ (nmode-adjust-window w)
+ (when (eq w nmode-current-window)
+ (nmode-new-window-or-buffer)
+ )
+ b
+ ))
+
+(de window-select-previous-buffer (w)
+ % Replace window W's current buffer with that buffer's previous buffer, if
+ % it exists and is selectable. Otherwise, replace it with the MAIN buffer.
+
+ (if (not (window-select-buffer w (=> (=> w buffer) previous-buffer)))
+ (window-select-buffer w nmode-main-buffer)))
+
+(de window-copy-buffer (w-source w-dest)
+ % Attach to window W-DEST the buffer belonging to window W-SOURCE.
+ % Duplicate the window's BUFFER-TOP and BUFFER-LEFT as well. If W is the
+ % current window, then the buffer becomes the current buffer.
+
+ (let ((b (=> w-source buffer)))
+ (=> w-dest set-buffer b)
+ (=> w-dest set-buffer-top (=> w-source buffer-top))
+ (=> w-dest set-buffer-left (=> w-source buffer-left))
+ (when (eq w-dest nmode-current-window)
+ (nmode-new-window-or-buffer)
+ )))
+
+(de nmode-new-window-or-buffer ()
+ % This function should be called if a new window has been selected or a new
+ % buffer has been attached to the current window. This should be the only
+ % function that sets the variable NMODE-CURRENT-BUFFER.
+
+ (let ((new-current-buffer (=> nmode-current-window buffer)))
+ (when (not (eq new-current-buffer nmode-current-buffer))
+ (setf nmode-current-buffer new-current-buffer)
+ (nmode-establish-current-mode)
+ (reset-message)
+ (let ((browser (=> nmode-current-buffer get 'browser)))
+ (when browser
+ (=> browser select)
+ )))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Killing Buffers
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-kill-buffer ()
+ % This function kills the buffer associated with the current window and
+ % detaches it from that window or any other window (replacing it with
+ % another buffer, preferrably the buffer's "previous buffer").
+ % Do not kill the MAIN or OUTPUT buffer.
+
+ (buffer-kill-and-detach (=> nmode-current-window buffer)))
+
+(de buffer-kill-and-detach (b)
+ % Kill the specified buffer and detach it from any existing windows
+ % (replacing with another buffer, preferrably the buffer's previous buffer).
+ % Do not kill the MAIN or OUTPUT buffer.
+
+ (if (buffer-kill b)
+ (for (in w (find-buffer-in-windows b))
+ (do (window-select-previous-buffer w)))))
+
+(de buffer-killable? (b)
+ (not (or (eq b nmode-main-buffer)
+ (eq b nmode-output-buffer)
+ )))
+
+% Internal function:
+
+(de buffer-kill (b)
+ % Remove the specified buffer from the list of selectable buffers and return
+ % T, unless the buffer is the MAIN or OUTPUT buffer, in which case do
+ % nothing and return NIL.
+
+ (let ((kill? (buffer-killable? b)))
+ (if kill?
+ (setf nmode-selectable-buffers (DelQ b nmode-selectable-buffers))
+ )
+ kill?
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/build-vax-nmode.sl
Index: psl-1983/3-1/nmode/build-vax-nmode.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/build-vax-nmode.sl
@@ -0,0 +1,240 @@
+% A sketchy build file for NMODE binaries. Probably best executed from within
+% NMODE itself. (Won't necessarily run "sequentially"--it should work, but
+% it's never been tried, as of 29-mar-83.)
+
+% NOTE: need to build window stuff first, see $pw/VAX-SOURCES/build-windows.sl.
+
+(off usermode) % Avoid queries about redefining functions.
+
+% NOTE: there are several problems with the PSL compiler (and LAP) that cause
+% problems when compiling NMODE (29-mar-83). The following "patches"
+% should fix things (on HP VENUS) until the compiler gets fixed up.
+
+(setq options* NIL) % Force reloading of files.
+(load compiler)
+% Fix problems with ASHL, etc.
+(faslin "/vb/griss/vax-lap-fix.b")
+
+% Avoid problem with cmacro expansion for the SUBSTRING function (cmacro
+% seems silly anyway, overkill for imagined efficiency). (Note that the
+% cmacro isn't really at fault, it simply brings out the real problem(s)
+% with the compiler.)
+(load common)
+(remprop 'substring 'cmacro)
+
+(setf old-directory (pwd))
+
+% Connect to the destination directory for the binaries.
+(cd "$pn/BINARIES")
+
+% Augment the directories used to lookup LOAD modules.
+(setf loaddirectories*
+ (append
+ '("" "$pn/BINARIES/" "$pw/BINARIES/")
+ (delete "" loaddirectories*)))
+
+
+(faslout "browser")
+(dskin "$pn/browser.sl")
+(faslend)
+
+(faslout "browser-support")
+(dskin "$pn/browser-support.sl")
+(faslend)
+
+(faslout "buffer")
+(dskin "$pn/buffer.sl")
+(faslend)
+
+(faslout "buffer-io")
+(dskin "$pn/buffer-io.sl")
+(faslend)
+
+(faslout "buffer-position")
+(dskin "$pn/buffer-position.sl")
+(faslend)
+
+(faslout "buffer-window")
+(dskin "$pn/buffer-window.sl")
+(faslend)
+
+(faslout "buffers")
+(dskin "$pn/buffers.sl")
+(faslend)
+
+(faslout "case-commands")
+(dskin "$pn/case-commands.sl")
+(faslend)
+
+(faslout "command-input")
+(dskin "$pn/command-input.sl")
+(faslend)
+
+(faslout "commands")
+(dskin "$pn/commands.sl")
+(faslend)
+
+(faslout "defun-commands")
+(dskin "$pn/defun-commands.sl")
+(faslend)
+
+(faslout "dispatch")
+(dskin "$pn/dispatch.sl")
+(faslend)
+
+(faslout "extended-input")
+(dskin "$pn/extended-input.sl")
+(faslend)
+
+(faslout "fileio")
+(dskin "$pn/fileio.sl")
+(faslend)
+
+(faslout "incr")
+(dskin "$pn/incr.sl")
+(faslend)
+
+(faslout "indent-commands")
+(dskin "$pn/indent-commands.sl")
+(faslend)
+
+(faslout "kill-commands")
+(dskin "$pn/kill-commands.sl")
+(faslend)
+
+(faslout "lisp-commands")
+(dskin "$pn/lisp-commands.sl")
+(faslend)
+
+(faslout "lisp-indenting")
+(dskin "$pn/lisp-indenting.sl")
+(faslend)
+
+(faslout "lisp-interface")
+(dskin "$pn/lisp-interface.sl")
+(faslend)
+
+(faslout "lisp-parser")
+(dskin "$pn/lisp-parser.sl")
+(faslend)
+
+(faslout "m-x")
+(dskin "$pn/m-x.sl")
+(faslend)
+
+(faslout "m-xcmd")
+(dskin "$pn/m-xcmd.sl")
+(faslend)
+
+(faslout "modes")
+(dskin "$pn/modes.sl")
+(faslend)
+
+(faslout "mode-defs")
+(dskin "$pn/mode-defs.sl")
+(faslend)
+
+(faslout "move-commands")
+(dskin "$pn/move-commands.sl")
+(faslend)
+
+(faslout "nmode-attributes")
+(dskin "$pn/nmode-attributes.sl")
+(faslend)
+
+(faslout "nmode-break")
+(dskin "$pn/nmode-break.sl")
+(faslend)
+
+(faslout "nmode-init")
+(dskin "$pn/nmode-init.sl")
+(faslend)
+
+(faslout "nmode-parsing")
+(dskin "$pn/nmode-parsing.sl")
+(faslend)
+
+% Use Vax version of sources.
+(faslout "nmode-vax")
+(dskin "$pn/VAX-SOURCES/nmode-vax.sl")
+(faslend)
+
+(faslout "prompting")
+(dskin "$pn/prompting.sl")
+(faslend)
+
+(faslout "query-replace")
+(dskin "$pn/query-replace.sl")
+(faslend)
+
+(faslout "reader")
+(dskin "$pn/reader.sl")
+(faslend)
+
+(faslout "rec")
+(dskin "$pn/rec.sl")
+(faslend)
+
+(faslout "screen-layout")
+(dskin "$pn/screen-layout.sl")
+(faslend)
+
+(faslout "search")
+(dskin "$pn/search.sl")
+(faslend)
+
+% Use Vax version of sources.
+(faslout "set-terminal")
+(dskin "$pn/VAX-SOURCES/set-terminal.sl")
+(faslend)
+
+(faslout "softkeys")
+(dskin "$pn/softkeys.sl")
+(faslend)
+
+(faslout "structure-functions")
+(dskin "$pn/structure-functions.sl")
+(faslend)
+
+(faslout "terminal-input")
+(dskin "$pn/terminal-input.sl")
+(faslend)
+
+(faslout "text-buffer")
+(dskin "$pn/text-buffer.sl")
+(faslend)
+
+(faslout "text-commands")
+(dskin "$pn/text-commands.sl")
+(faslend)
+
+(faslout "window")
+(dskin "$pn/window.sl")
+(faslend)
+
+(faslout "window-label")
+(dskin "$pn/window-label.sl")
+(faslend)
+
+(faslout "autofill")
+(dskin "$pn/autofill.sl")
+(faslend)
+
+(faslout "browser-browser")
+(dskin "$pn/browser-browser.sl")
+(faslend)
+
+(faslout "buffer-browser")
+(dskin "$pn/buffer-browser.sl")
+(faslend)
+
+%* (faslout "dired")
+%* (dskin "$pn/dired.sl")
+%* (faslend)
+
+(faslout "doc")
+(dskin "$pn/doc.sl")
+(faslend)
+
+(cd old-directory)
+
ADDED psl-1983/3-1/nmode/case-commands.sl
Index: psl-1983/3-1/nmode/case-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/case-commands.sl
@@ -0,0 +1,151 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Case-Commands.SL - NMODE Case Conversion commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 6 October 1982
+%
+% The original code was contributed by Jeff Soreff.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-vectors fast-strings))
+
+(fluid '(
+ nmode-command-argument
+ nmode-current-buffer
+ ))
+
+% Global variables:
+
+(fluid '(shifted-digits-association-list))
+(setf shifted-digits-association-list NIL)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Case Conversion Commands:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de uppercase-word-command ()
+ (transform-region-with-next-word-or-fragment #'string-upcase))
+
+(de lowercase-word-command ()
+ (transform-region-with-next-word-or-fragment #'string-downcase))
+
+(de uppercase-initial-command ()
+ (transform-region-with-next-word-or-fragment #'string-capitalize))
+
+(de uppercase-region-command ()
+ (transform-marked-region #'string-upcase))
+
+(de lowercase-region-command ()
+ (transform-marked-region #'string-downcase))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Upcase Digit Command:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de upcase-digit-command ()
+ % Convert the previous digit to the corresponding "shifted character"
+ % on the keyboard. Search only within the current line or the previous
+ % line. Ding if no digit found.
+
+
+ (let ((point (buffer-get-position))
+ (limit-line-pos (- (current-line-pos) 1))
+ (ok NIL)
+ )
+ (while (and (>= (current-line-pos) limit-line-pos)
+ (not (at-buffer-start?))
+ (not (setf ok (digitp (previous-character))))
+ )
+ (move-backward)
+ )
+ (cond ((and ok (set-up-shifted-digits-association-list))
+ (let* ((old (previous-character))
+ (new (cdr (assoc old shifted-digits-association-list)))
+ )
+ (delete-previous-character)
+ (insert-character new)
+ ))
+ (t (Ding))
+ )
+ (buffer-set-position point)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% General Transformation Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de transform-region (string-conversion-function bp1 bp2)
+ % Transform the region in the current buffer between the positions
+ % BP1 and BP2 by applying the specified function to each partial or
+ % complete line. The function should accept a single string argument
+ % and return the transformed string. Return 1 if BP2 > BP1;
+ % return -1 if BP2 < BP1. The buffer pointer is left at the "end"
+ % of the transformed region (the greater of BP1 and BP2).
+
+ (let* ((modified-flag (=> nmode-current-buffer modified?))
+ (extracted-pair (extract-region t bp1 bp2))
+ (newregion (cdr extracted-pair))
+ (oldregion (if (not modified-flag) (copyvector newregion)))
+ )
+ (for (from index 0 (vector-upper-bound newregion) 1)
+ (do (vector-store newregion index
+ (apply string-conversion-function
+ (list (vector-fetch newregion index))))))
+ (insert-text newregion)
+ (if (and (not modified-flag) (text-equal newregion oldregion))
+ (=> nmode-current-buffer set-modified? nil)
+ )
+ (car extracted-pair)
+ ))
+
+(de transform-region-with-next-word-or-fragment (string-conversion-function)
+ % Transform the region consisting of the following N words, where N is
+ % the command argument. N may be negative, meaning previous words.
+
+ (let ((start (buffer-get-position)))
+ (move-over-words nmode-command-argument)
+ (transform-region string-conversion-function start (buffer-get-position))
+ ))
+
+(de transform-marked-region (string-conversion-function)
+ % Transform the region defined by point and mark.
+
+ (let ((point (buffer-get-position))
+ (mark (current-mark))
+ )
+ (when (= (transform-region string-conversion-function point mark) 1)
+ % The mark was at the end of the region. If the transformation changed
+ % the length of the region, the mark may need to be updated.
+ (previous-mark) % pop off old mark
+ (set-mark-from-point) % set the mark to the end of the transformed region
+ (buffer-set-position point)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Auxiliary Function:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de set-up-shifted-digits-association-list ()
+ % Ensure that the "shifted digits association list" is set up properly.
+ % If necessary, ask the user for the required information. Returns the
+ % association list if properly set up, NIL if an error occurred.
+
+ (if (not shifted-digits-association-list)
+ (let ((shifted-digits
+ (prompt-for-string
+ "Type the digits 1, 2, ... 9, 0, holding down Shift:" nil)))
+ (cond ((= (string-length shifted-digits) 10)
+ (setq shifted-digits-association-list
+ (pair
+ (string-to-list "1234567890")
+ (string-to-list shifted-digits))))
+ ((> (string-length shifted-digits) 10)
+ (nmode-error "Typed too many shifted digits!"))
+ (t
+ (nmode-error "Typed too few shifted digits!"))
+ )))
+ shifted-digits-association-list
+ )
ADDED psl-1983/3-1/nmode/command-input.sl
Index: psl-1983/3-1/nmode/command-input.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/command-input.sl
@@ -0,0 +1,88 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Command-Input.SL - NMODE Command Input Routines
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 27 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load extended-char fast-int))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Command Prefix Character Functions:
+%
+% A command prefix character function must be tagged with the property
+% 'COMMAND-PREFIX. It should also define the property 'COMMAND-PREFIX-NAME
+% to be a string that will be used to print the command name of commands
+% that include a prefix character that is mapped to that function. (The
+% function DEFINE-COMMAND-PREFIX is used to set these properties.) The
+% function itself should return a command (see dispatch.sl for a description).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de define-command-prefix (function-name name-string)
+ (put function-name 'command-prefix T)
+ (put function-name 'command-prefix-name name-string)
+ )
+
+(de prefix-name (ch)
+ % Return the string to be used in printing a command with this prefix char.
+ (let ((func (dispatch-table-lookup ch)))
+ (or (and func (get func 'command-prefix-name))
+ (string-concat (x-char-name ch) " ")
+ )))
+
+% Here we define some prefix command functions:
+(define-command-prefix 'c-x-prefix "C-X ")
+(define-command-prefix 'Esc-prefix "Esc-")
+(define-command-prefix 'Lisp-prefix "Lisp-")
+(define-command-prefix 'm-x-prefix "M-X ")
+
+(de c-x-prefix ()
+ (nmode-append-separated-prompt "C-X ")
+ (let ((ch (input-terminal-character)))
+ (nmode-complete-prompt (x-char-name ch))
+ (list (x-char C-X) ch)
+ ))
+
+(de Esc-prefix ()
+ (nmode-append-separated-prompt "Esc-")
+ (let ((ch (input-extended-character)))
+ (nmode-complete-prompt (x-char-name ch))
+ (list (x-char ESC) ch)
+ ))
+
+(de Lisp-prefix ()
+ (nmode-append-separated-prompt "Lisp-")
+ (let ((ch (input-terminal-character)))
+ (nmode-complete-prompt (x-char-name ch))
+ (list (x-char C-!]) ch)
+ ))
+
+(de m-x-prefix ()
+ (list (x-char M-X) (prompt-for-extended-command "Extended Command:")))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Command Input Functions:
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de input-base-character ()
+ (X-Base (input-terminal-character))
+ )
+
+(de input-command ()
+ % Return either a single (extended) character or a list containing a valid
+ % prefix character plus its argument (character or string).
+
+ (let* ((ch (input-extended-character))
+ (func (dispatch-table-lookup ch))
+ )
+ (if (and func (get func 'command-prefix))
+ (apply func ())
+ ch
+ )))
ADDED psl-1983/3-1/nmode/commands.sl
Index: psl-1983/3-1/nmode/commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/commands.sl
@@ -0,0 +1,229 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Commands.SL - Miscellaneous NMODE commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 24 August 1982
+% Revised: 9 March 1983
+%
+% 9-Mar-83 Alan Snyder
+% Create-buffer-unselectable -> Create-Unnamed-Buffer.
+% 3-Dec-82 Alan Snyder
+% Changed Insert-Self-Command to handle control- and meta- characters.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char fast-int))
+
+% External variables used:
+
+(fluid '(nmode-current-buffer nmode-command-argument nmode-current-window
+ nmode-command-argument-given nmode-current-command
+ nmode-terminal nmode-allow-refresh-breakout
+ Text-Mode
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de insert-self-command ()
+ (if (FixP nmode-current-command)
+ (let ((ch (x-base nmode-current-command)))
+ (if (x-control? nmode-current-command)
+ (let ((nch (char-upcase ch)))
+ (if (and (>= nch #/@) (<= nch #/_))
+ (setf ch (^ nch #/@))
+ )))
+ (for (from i 1 nmode-command-argument)
+ (do (insert-character ch)))
+ )
+ % otherwise
+ (Ding)
+ ))
+
+(de insert-next-character-command ()
+ (nmode-append-separated-prompt "C-Q")
+ (let ((ch (x-base (input-direct-terminal-character))))
+ (nmode-complete-prompt (string-concat " " (x-char-name ch)))
+ (for (from i 1 nmode-command-argument)
+ (do (insert-character ch)))))
+
+(de return-command ()
+ % Insert an EOL, unless we are at the end of thee current line and the
+ % next line is empty. Repeat as directed.
+
+ (for (from i 1 nmode-command-argument)
+ (do (cond ((and (at-line-end?) (not (at-buffer-end?)))
+ (move-to-next-line)
+ (cond ((not (current-line-empty?))
+ (insert-eol)
+ (move-to-previous-line)
+ )))
+ (t (insert-eol))))))
+
+(de select-buffer-command ()
+ (buffer-select (prompt-for-selectable-buffer)))
+
+(de prompt-for-selectable-buffer ()
+ (let ((default-b (=> nmode-current-buffer previous-buffer)))
+ (if (and default-b (not (buffer-is-selectable? default-b)))
+ (setf default-b NIL))
+ (prompt-for-buffer "Select Buffer: " default-b)))
+
+(de kill-buffer-command ()
+ (let ((b (prompt-for-existing-buffer "Kill buffer: " nmode-current-buffer)))
+ (if (or (not (=> b modified?))
+ (YesP "Kill unsaved buffer?"))
+ (buffer-kill-and-detach b))))
+
+(de insert-buffer-command ()
+ (let ((b (prompt-for-existing-buffer "Insert Buffer:" nmode-current-buffer)))
+ (insert-buffer-into-buffer b nmode-current-buffer)
+ ))
+
+(de select-previous-buffer-command ()
+ (let ((old-buffer nmode-current-buffer))
+ (buffer-select-previous nmode-current-buffer)
+ (if (eq old-buffer nmode-current-buffer) (Ding)) % nothing visible happened
+ ))
+
+(de visit-in-other-window-command ()
+ (nmode-2-windows)
+ (selectq (char-upcase (input-base-character))
+ (#/B (let ((b (prompt-for-selectable-buffer)))
+ (window-select-buffer (nmode-other-window) b)))
+ (#/F (find-file-in-window
+ (nmode-other-window)
+ (prompt-for-file-name "Find file: " NIL)
+ ))
+ (t (Ding))
+ ))
+
+(de nmode-refresh-command ()
+ (if nmode-command-argument-given
+ (let* ((arg nmode-command-argument)
+ (w nmode-current-window)
+ (height (=> w height))
+ (line (current-line-pos))
+ )
+ (if (>= arg 0)
+ (=> w set-buffer-top (- line arg))
+ (=> w set-buffer-top (- (- line height) arg)))
+ (nmode-refresh)
+ )
+ % Otherwise
+ (=> nmode-current-window readjust-window)
+ (nmode-full-refresh)
+ ))
+
+(de open-line-command ()
+ (for (from i 1 nmode-command-argument)
+ (do (insert-eol)
+ (move-backward)
+ )))
+
+(de Ding ()
+ (=> nmode-terminal ring-bell))
+
+(de buffer-not-modified-command ()
+ (=> nmode-current-buffer set-modified? NIL)
+ )
+
+(de set-mark-command ()
+ (cond (nmode-command-argument-given
+ (buffer-set-position (current-mark))
+ (previous-mark)
+ )
+ (t
+ (set-mark-from-point)
+ )))
+
+(de mark-beginning-command ()
+ (let ((old-pos (buffer-get-position)))
+ (move-to-buffer-start)
+ (set-mark-from-point)
+ (buffer-set-position old-pos)
+ ))
+
+(de mark-end-command ()
+ (let ((old-pos (buffer-get-position)))
+ (move-to-buffer-end)
+ (set-mark-from-point)
+ (buffer-set-position old-pos)
+ ))
+
+(de transpose-characters-command ()
+ (cond ((or (at-line-start?) (< (current-line-length) 2))
+ (Ding)
+ )
+ (t
+ (if (at-line-end?) % We are at the end of a non-empty line.
+ (move-backward)
+ )
+ % We are in the middle of a line.
+ (let ((ch (previous-character)))
+ (delete-previous-character)
+ (move-forward)
+ (insert-character ch)
+ )
+ )))
+
+(de mark-word-command ()
+ (let ((old-pos (buffer-get-position)))
+ (move-forward-word-command)
+ (set-mark-from-point)
+ (buffer-set-position old-pos)
+ ))
+
+(de mark-form-command ()
+ (let ((old-pos (buffer-get-position)))
+ (move-forward-form-command)
+ (set-mark-from-point)
+ (buffer-set-position old-pos)
+ ))
+
+(de mark-whole-buffer-command ()
+ (move-to-buffer-end)
+ (set-mark-from-point)
+ (move-to-buffer-start)
+ )
+
+(de nmode-abort-command ()
+ (throw 'abort NIL)
+ )
+
+(de start-scripting-command ()
+ (let ((b (prompt-for-buffer "Script Input to Buffer:" NIL)))
+ (nmode-script-terminal-input b)
+ ))
+
+(de stop-scripting-command ()
+ (nmode-script-terminal-input nil)
+ )
+
+(de execute-buffer-command ()
+ (let ((b (prompt-for-buffer "Execute from Buffer:" NIL)))
+ (setf nmode-allow-refresh-breakout nmode-command-argument-given)
+ (nmode-execute-buffer b)
+ ))
+
+(de execute-file-command ()
+ (nmode-execute-file (prompt-for-file-name "Execute File:" NIL)))
+
+(de nmode-execute-file (fn)
+ (let ((b (create-unnamed-buffer Text-Mode)))
+ (read-file-into-buffer b fn)
+ (setf nmode-allow-refresh-breakout nmode-command-argument-given)
+ (nmode-execute-buffer b)
+ ))
+
+(de apropos-command ()
+ (let ((s (prompt-for-string
+ "Show commands whose names contain the string:"
+ NIL
+ )))
+ (nmode-begin-typeout)
+ (print-matching-dispatch s)
+ (printf "-----")
+ (nmode-end-typeout)
+ ))
ADDED psl-1983/3-1/nmode/dabbrevs.sl
Index: psl-1983/3-1/nmode/dabbrevs.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/dabbrevs.sl
@@ -0,0 +1,166 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Dabbrevs.SL - Dynamic Abbreviations for NMODE
+%
+% Author: Mark R. Swanson
+% University of Utah
+% Date: 15 June 1983
+%
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Methods provided: (all internal, really)
+% initial-expansion
+% expand-aux
+% find-next-expansion
+% get-expansion-from-buffer
+% expand
+% save-expansion
+%
+% Commands defined:
+% instant-abbrev-command
+% Tries to "expand" the word (or prefix) before point by searching for other
+% words with the same prefix. The search goes back from point (or from the
+% location of the last expansion found for the current abbreviation); if
+% unsuccessful, a search is done forward from point. Re-issuing the command
+% causes a search for the next possible expansion. The command is initially
+% bound to the M-<space> key.
+
+(CompileTime
+ (load objects fast-int))
+
+(fluid '(current-abbrev-expansion))
+(setf current-abbrev-expansion nil)
+
+(defflavor abbrev-expansion
+ (abbrev % original abbreviation string
+ abbrev-start-pos
+ abbrev-end-pos
+ (expansion-list nil) % list of all expansions tried (including abbrev)
+ expansion-start-pos % start of latest expansion
+ expansion-end-pos % end of latest expansion
+ last-pos % position of end of latest expansion/abbrev in
+ % buffer
+ (direction -1) % initially look backwards (-1)
+ (word-delim-list '(#\!( #\!) #\!' #\- #\space #\<)) % word delimitors
+ )
+ ()
+)
+
+(defmethod (abbrev-expansion initial-expansion) ()
+% Initial attempt to find an expansion for "word" before point. Search goes
+% first backward, then forward, through buffer for an appropriate expansion.
+
+ (setf last-pos (setf abbrev-end-pos (buffer-get-position)))
+ (if (not (move-backward-word)) % is there a word to expand?
+ (ding) % no
+ % else yes
+ (setf abbrev-start-pos (buffer-get-position)) % bracket its position
+ (setf abbrev (cdr (extract-region nil abbrev-start-pos abbrev-end-pos)))
+ (=> self save-expansion abbrev) % abbrev is its own initial "expansion"
+ (=> self expand-aux)
+ ))
+
+(defmethod (abbrev-expansion expand-aux) ()
+% Actually do the expansion (or re-expansion); search backwards first, then
+% forwards if necessary; do not re-present duplicate expansions which have
+% already been tried.
+
+ (write-message (concat "Expanding " (vector-fetch abbrev 0)))
+ (let ((found-one nil)
+ new-expansion)
+ (while (and (~= direction 0) % if zero we have searched in both directions
+ (not found-one))
+ (setf new-expansion (=> self find-next-expansion direction))
+ (if new-expansion % then
+ (progn
+ (if (< direction 0) % move ptr for next search (may not be necessary)
+ (move-backward) (move-forward))
+ (setf found-one (not (member new-expansion expansion-list))))
+%else
+ (setf direction (if (= direction -1) 1 0)) % change directions
+ (buffer-set-position last-pos) % and start from original location
+ ))
+% Finally insert expansion and add it to history
+ (if found-one
+ (progn
+ (extract-region T abbrev-start-pos last-pos) %remove old abbrev/expans.
+ (insert-string (vector-fetch new-expansion 0)) % put in new expans.
+ (setf last-pos (buffer-get-position)) % note end of expans.
+ (=> self save-expansion new-expansion))
+% else
+ (buffer-set-position last-pos) % put point back where we started
+ (ding) % let user know we failed
+ )))
+
+(defmethod (abbrev-expansion find-next-expansion) (dir)
+% Search backward/forward from current location for an expansion (string match of
+% abbreviation preceded by a word delimitor. Returns NIL on failure,
+% expansion-string on success; leaves point at start of last string match.
+
+ (let ((found-one nil))
+ (while (and (not found-one)
+ (buffer-text-search? abbrev dir))
+ (if (or (=> nmode-current-buffer at-line-start?)
+ (member (=> nmode-current-buffer previous-character)
+ word-delim-list))
+ (setf found-one T)
+ (if (< dir 0)
+ (move-backward)
+ (move-forward))))
+ (if found-one
+ (=> self get-expansion-from-buffer))))
+
+(defmethod (abbrev-expansion get-expansion-from-buffer) ()
+ % Extracts the expansion from the buffer; on entry point should be at start
+ % of expansion, on exit it will be returned to that position. Form of
+ % result should be a vector containing 1 string.
+
+ (let (expans)
+ (setf expansion-start-pos (buffer-get-position))
+ (move-forward-word)
+ (setf expansion-end-pos (buffer-get-position))
+ (setf expans (cdr (extract-region NIL expansion-start-pos expansion-end-pos)))
+ (buffer-set-position expansion-start-pos)
+ expans))
+
+(defmethod (abbrev-expansion expand) ()
+ % Attempt to re-expand last expansion. Point must be at end of previous
+ % expansion, word itself should not have been changed.
+
+ (let ((cur-pos (buffer-get-position)))
+ (if (and
+ (equal last-pos (buffer-get-position))
+ (move-backward-word)
+ (equal abbrev-start-pos (buffer-get-position))
+ (equal (car expansion-list)
+ (cdr (extract-region nil abbrev-start-pos last-pos))))
+ (progn
+ (buffer-set-position expansion-start-pos)
+ (=> nmode-current-buffer move-backward)
+ (=> self expand-aux))
+ (buffer-set-position cur-pos)
+ nil
+ )))
+
+(defmethod (abbrev-expansion save-expansion) (expansion)
+ (setf expansion-list (adjoin expansion expansion-list)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% dynamic abbreviation command and its installation
+%
+
+(de instant-abbrev-command ()
+ (cond ((or
+ (null current-abbrev-expansion)
+ (null (=> current-abbrev-expansion expand)))
+ (setf current-abbrev-expansion (make-instance 'abbrev-expansion))
+ (=> current-abbrev-expansion initial-expansion))))
+
+(setf Text-Command-List
+ (NConc Text-Command-List
+ (list
+ (cons (x-char M-! ) 'instant-abbrev-command)
+ )))
+
ADDED psl-1983/3-1/nmode/defun-commands.sl
Index: psl-1983/3-1/nmode/defun-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/defun-commands.sl
@@ -0,0 +1,179 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Defun-Commands.SL - NMODE DEFUN commands and functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 12 November 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int))
+
+(fluid '(nmode-command-argument
+ nmode-command-argument-given
+ nmode-current-command
+ ))
+
+% Global variables:
+
+(fluid '(nmode-defun-predicate
+ nmode-defun-scanner
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Defun Commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de reposition-window-command ()
+ % Adjust the current window so that the beginning of the
+ % current DEFUN is on the top line of the screen. If this change
+ % would push the current line off the screen, do nothing but ring
+ % the bell.
+
+ (let ((old-pos (buffer-get-position)))
+ (when (move-to-start-of-current-defun) % if search for defun succeeds
+ (let ((old-line (buffer-position-line old-pos))
+ (defun-line (current-line-pos))
+ )
+ (if (or (< old-line defun-line) % Impossible?
+ (>= old-line (+ defun-line (current-window-height)))
+ )
+ (Ding) % Old Line wouldn't show on the screen
+ % otherwise
+ (current-window-set-top-line defun-line)
+ ))
+ (buffer-set-position old-pos)
+ )))
+
+(de end-of-defun-command ()
+ % This command has a very strange definition in EMACS. I don't even
+ % want to try to explain it! It is probably a kludge in EMACS since
+ % it generates very strange error messages!
+
+ (if (< nmode-command-argument 0)
+ (move-backward))
+
+ % First, we must get positioned up at the beginning of the proper defun.
+ % If we are within a defun, we want to start at the beginning of that
+ % defun. If we are between defuns, then we want to start at the beginning
+ % of the next defun.
+
+ (if (not (move-to-start-of-current-defun))
+ (move-forward-defun))
+
+ % Next, we move to the requested defun, and complain if we can't find it.
+ (unless
+ (cond
+ ((> nmode-command-argument 1)
+ (move-over-defuns (- nmode-command-argument 1)))
+ ((< nmode-command-argument 0)
+ (move-over-defuns nmode-command-argument))
+ (t t)
+ )
+ (Ding)
+ )
+
+ % Finally, we move to the end of whatever defun we wound up at.
+ (if (not (move-to-end-of-current-defun)) (Ding))
+ )
+
+(de mark-defun-command ()
+ (cond ((or (move-to-end-of-current-defun)
+ (and (move-forward-defun) (move-to-end-of-current-defun))
+ )
+ (set-mark-from-point)
+ (move-backward-defun)
+ (when (not (current-line-is-first?))
+ (move-to-previous-line)
+ (if (not (current-line-blank?))
+ (move-to-next-line))
+ ))
+ (t (Ding))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Defun Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-backward-defun ()
+ % Move backward at least one character to the previous beginning of a
+ % "defun". If no defun is found, return NIL and leave point unchanged.
+
+ (when (move-backward-character)
+ (or (beginning-of-defun)
+ (progn (move-forward-character) NIL) % return NIL
+ )))
+
+(de beginning-of-defun ()
+ % Move backward, if necessary, to the beginning of a
+ % "defun". If no defun is found, return NIL and leave point unchanged.
+
+ (let ((old-pos (buffer-get-position)))
+ (move-to-start-of-line)
+ (while T
+ (when (current-line-is-defun?) (exit T))
+ (when (current-line-is-first?) (buffer-set-position old-pos) (exit NIL))
+ (move-to-previous-line)
+ )))
+
+(de move-forward-defun ()
+ % Move forward at least one character to the next beginning of a
+ % "defun". If no defun is found, return NIL and leave point unchanged.
+
+ (let ((old-pos (buffer-get-position)))
+ (while T
+ (when (current-line-is-last?) (buffer-set-position old-pos) (exit NIL))
+ (move-to-next-line)
+ (when (current-line-is-defun?) (exit T))
+ )))
+
+(de move-to-start-of-current-defun ()
+ % If point lies within the text of a (possibly incomplete) defun, or on
+ % the last line of a complete defun, then move to the beginning of the
+ % defun. Otherwise, return NIL and leave point unchanged.
+
+ (let ((old-pos (buffer-get-position))) % save original position
+ (if (beginning-of-defun) % find previous defun start
+ (let ((start-pos (buffer-get-position))) % save defun starting position
+ % We succeed if the current defun has no end, or if the end is
+ % beyond the old position in the buffer.
+ (if (or (not (scan-past-defun))
+ (<= (buffer-position-line old-pos) (current-line-pos))
+ )
+ (progn (buffer-set-position start-pos) T)
+ (progn (buffer-set-position old-pos) NIL)
+ )))))
+
+(de move-to-end-of-current-defun ()
+ % If point lies within the text of a complete defun, or on the last line
+ % of the defun, then move to the next line following the end of the defun.
+ % Otherwise, return NIL and leave point unchanged.
+
+ (let ((old-pos (buffer-get-position))) % save original position
+ (if (and (beginning-of-defun) % find previous defun start
+ (scan-past-defun) % find end of that defun
+ (<= (buffer-position-line old-pos) (current-line-pos))
+ )
+ (progn (move-to-next-line) T)
+ (progn (buffer-set-position old-pos) NIL)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Basic Defun Scanning Primitives
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-line-is-defun? ()
+ (if nmode-defun-predicate
+ (apply nmode-defun-predicate ())
+ ))
+
+(de scan-past-defun ()
+ % This function should be called with point at the start of a defun.
+ % It will scan past the end of the defun (not to the beginning of the
+ % next line, however). If the end of the defun is not found, it returns
+ % NIL and leaves point unchanged.
+
+ (if nmode-defun-scanner
+ (apply nmode-defun-scanner ())
+ ))
ADDED psl-1983/3-1/nmode/dired.sl
Index: psl-1983/3-1/nmode/dired.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/dired.sl
@@ -0,0 +1,626 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% DIRED.SL - Directory Editor Subsystem
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 July 1982
+% Revised: 11 April 1983
+%
+% This file implements a directory editor subsystem.
+%
+% 5-April-83 Jeff Soreff
+% Added filter functions to dired commands.
+% 17-Mar-83 Alan Snyder
+% Bug fix: new item made by create command had wrong width.
+% 14-Mar-83 Alan Snyder
+% Fix C-X D to view directory of current file, rather than connected
+% directory, when the current filename has only a device field. Add Create
+% and Look commands. Change to sort based on displayed name rather than full
+% name (since that's what the user sees). Check for NIL dates in sort
+% functions. Change to cleanup item when killed. Convert for revised
+% browser mechanism.
+% 4-Mar-83 Alan Snyder
+% Fix to work with files whose names are not valid pathnames.
+% 3-Mar-83 Alan Snyder
+% Add Browse command to browse subdirectories.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% Fix cleanup method to NIL out the buffer variable to allow the buffer object
+% to be garbage collected.
+% 11-Feb-83 Alan Snyder
+% Fix bug in previous change.
+% 8-Feb-83 Alan Snyder
+% Enlarge width of size field in display.
+% 4-Feb-83 Alan Snyder
+% Rewritten to use new browser support.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load extended-char fast-strings numeric-operators))
+(load directory stringx)
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(
+ nmode-current-buffer
+ nmode-terminal
+ nmode-command-argument
+ nmode-command-argument-given
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal static variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(file-browser-mode
+ file-browser-command-list
+ file-browser-documentation-text
+ file-browser-help-text
+ dired-argument-list
+ ))
+
+(setf file-browser-help-text
+ ["? View Edit Browse Create Filter Un/Delete Kill-now uN/Ignore Sort/Reverse Look Quit"])
+
+(setf file-browser-documentation-text
+ ["The File Browser displays the files in a directory."
+ "Terminology: the current file is the file pointed at by the cursor."
+ "The View (V) and Edit (E) commands both display the current file."
+ "In split-screen mode, Edit selects the bottom window while View does not."
+ "The Create (C) command creates a new file, but does not select it."
+ "The Filter (F) command removes a set of files from the display."
+ "The Delete (D) command marks the current file for deletion upon Quit."
+ "The Undelete (U) command removes the mark made by the Delete command."
+ "The Kill (K) command deletes the current file immediately."
+ "The Ignore (I) command removes the current file from the display."
+ "The uNignore (N) command restores all Ignored files to the display."
+ "The Sort (S) command sorts the files in various ways."
+ "The Reverse (R) command sorts the files in reverse order."
+ "The Look (L) command re-reads the directory to get up-to-date info."
+ "The Quit (Q) command exits the browser and deletes any marked files,"
+ "after first asking for permission."
+ ])
+
+(setf file-browser-mode (nmode-define-mode "File-Browser" '(
+ (nmode-define-commands File-Browser-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ )))
+
+(setf file-browser-command-list (list
+ (cons (x-char ?) 'browser-help-command)
+ (cons (x-char B) 'dired-browse-command)
+ (cons (x-char C) 'dired-create-command)
+ (cons (x-char D) 'browser-delete-command)
+ (cons (x-char E) 'browser-edit-command)
+ (cons (x-char F) 'dired-filter-command)
+ (cons (x-char I) 'browser-ignore-command)
+ (cons (x-char K) 'browser-kill-command)
+ (cons (x-char L) 'dired-look-command)
+ (cons (x-char N) 'browser-undo-filter-command)
+ (cons (x-char Q) 'dired-exit)
+ (cons (x-char R) 'dired-reverse-sort)
+ (cons (x-char S) 'dired-sort)
+ (cons (x-char U) 'browser-undelete-command)
+ (cons (x-char V) 'browser-view-command)
+ (cons (x-char X) 'dired-exit)
+ (cons (x-char BACKSPACE) 'browser-undelete-backwards-command)
+ (cons (x-char RUBOUT) 'browser-undelete-backwards-command)
+ (cons (x-char SPACE) 'move-down-command)
+ (cons (x-char control D) 'browser-delete-command)
+ (cons (x-char control K) 'browser-kill-command)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de dired-command ()
+ (let ((fn (=> nmode-current-buffer file-name))
+ directory-name
+ )
+ (cond
+ ((or (not fn) (>= nmode-command-argument 4))
+ (setf directory-name (prompt-for-string "Edit Directory: " NIL))
+ )
+ (nmode-command-argument-given
+ (setf directory-name (namestring (pathname-without-version fn)))
+ )
+ (t
+ (setf directory-name (namestring (pathname-without-name fn)))
+ ))
+ (directory-editor directory-name)
+ ))
+
+(de edit-directory-command ()
+ (let* ((fn (=> nmode-current-buffer file-name))
+ (directory-name
+ (prompt-for-string
+ "Edit Directory:"
+ (and fn (directory-namestring fn))
+ )))
+ (directory-editor directory-name)
+ ))
+
+(define-browser-prototype 'edit-directory-command
+ "File Directory Browser"
+ ["This prototype creates a browser for the"
+ "set of files in a directory."])
+
+(de directory-editor (directory-name)
+ % Put up a directory editor subsystem, containing all files that match the
+ % specified string. If the string specifies a directory, then all files in
+ % that directory are displayed.
+
+ (setf directory-name (fixup-directory-name directory-name))
+ (write-prompt "Reading directory or directories...")
+ (let ((file-list (find-matching-files directory-name t)))
+ (if (null file-list)
+ (write-prompt (BldMsg "No files match: %w" directory-name))
+ % otherwise
+ (let* ((browser (or (find-browser 'FILE-BROWSER directory-name)
+ (create-file-browser directory-name)
+ ))
+ (items (dired-create-items file-list (=> browser display-width)))
+ )
+ (=> browser set-items items)
+ (browser-enter browser)
+ ))))
+
+(de create-file-browser (directory-name)
+ (let* ((header-text (vector
+ (string-concat "Directory List of " directory-name)
+ ""
+ ))
+ (browser
+ (create-browser 'FILE-BROWSER "Files" directory-name
+ file-browser-mode NIL header-text
+ file-browser-documentation-text
+ file-browser-help-text
+ () #'dired-filename-sorter)
+ ))
+ (=> browser put 'directory-name directory-name)
+ browser
+ ))
+
+(de dired-create-items (file-list display-width)
+ % Accepts a list containing one element per file, where each element is
+ % a list. Returns a list of file-browser-items.
+
+ (when file-list
+ (let* ((names (for (in f file-list)
+ (collect (fixup-file-name (nth f 1)))
+ ))
+ (prefix (trim-filename-to-prefix
+ (strings-largest-common-prefix names)))
+ (prefix-length (string-length prefix))
+ )
+ (for (in f file-list)
+ (collect
+ (create-file-browser-item
+ display-width
+ (nth f 1) % full-name
+ (string-rest (fixup-file-name (nth f 1)) prefix-length) % nice-name
+ (nth f 2) % deleted?
+ (nth f 3) % size
+ (nth f 4) % write-date
+ (nth f 5) % read-date
+ ))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% DIRED command procedures:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de dired-exit ()
+ (let ((actions (dired-determine-actions nmode-current-buffer)))
+ (if (and (null (first actions)) (null (second actions)))
+ (browser-exit-command)
+ % else
+ (let ((command (dired-present-actions actions)))
+ (cond
+ ((eq command 'exit)
+ (browser-exit-command)
+ )
+ ((eq command t)
+ (dired-perform-actions actions)
+ (browser-exit-command)
+ )
+ ))
+ )))
+
+(de dired-browse-command ()
+ % Browse the current item (presumably, a subdirectory).
+
+ (let* ((browser (current-browser))
+ (item (=> browser current-item))
+ )
+ (if item
+ (directory-editor (=> item full-name))
+ (Ding)
+ )))
+
+(de dired-create-command ()
+ (let* ((browser (current-browser))
+ (dir-pn (pathname-without-name (=> browser get 'directory-name)))
+ (fn (prompt-for-string "Create file whose name is:" NIL))
+ (pn (maybe-pathname fn))
+ sout
+ )
+ (if (not pn)
+ (nmode-error (bldmsg "Invalid pathname: %w" fn))
+ % otherwise
+ (if (not (and (null (pathname-device pn))
+ (null (pathname-directory pn))
+ ))
+ (nmode-error "Device and directory may not be specified.")
+ % otherwise
+ (setf pn (merge-pathname-defaults dir-pn
+ (pathname-name pn)
+ (pathname-type pn)
+ (pathname-version pn)
+ ))
+ (setf fn (namestring pn))
+ (if (filep fn)
+ (nmode-error (bldmsg "File %w already exists." fn))
+ % otherwise
+ (setf fn (actualize-file-name fn))
+ (if (or (not fn) (not (setf sout (attempt-to-open-output fn))))
+ (nmode-error (bldmsg "Unable to create file: %w" (namestring pn)))
+ % otherwise
+ (=> sout close)
+ (let ((item (create-file-browser-item
+ (=> browser display-width)
+ fn
+ (file-namestring fn)
+ nil 0 nil nil)))
+ (browser-add-item-and-view item)
+ )))))))
+
+(de dired-look-command ()
+ % Reinitialize the file directory browser.
+
+ (write-prompt "Reading directory or directories...")
+ (let* ((browser (current-browser))
+ (directory-name (=> browser get 'directory-name))
+ (file-list (find-matching-files directory-name t))
+ (items (dired-create-items file-list (=> browser display-width)))
+ )
+ (=> browser set-items items)
+ ))
+
+(de dired-filter-command ()
+ (nmode-set-immediate-prompt "Flush or Keep matching filenames?")
+ (dired-filter-dispatch))
+
+(de dired-filter-dispatch ()
+ (selectq (char-upcase (input-base-character))
+ (#/F (dired-filter-compose t))
+ (#/K (dired-filter-compose nil))
+ (#/?
+ (nmode-set-immediate-prompt
+ "Type F to flush or K to keep matching filenames.")
+ (dired-filter-dispatch))
+ (t (write-prompt "") (Ding))))
+
+(de dired-filter-compose (flag)
+ (let ((browser (current-browser))
+ (dired-argument-list
+ (list
+ (string-upcase
+ (prompt-for-string
+ (if flag
+ "Flush filenames matching what string?"
+ "Keep filenames matching what string?")
+ ""))
+ flag)))
+ (=> browser filter-items #'dired-string-filter-predicate)))
+
+(de dired-reverse-sort ()
+ (nmode-set-immediate-prompt "Reverse Sort by ")
+ (dired-reverse-sort-dispatch)
+ )
+
+(de dired-reverse-sort-dispatch ()
+ (selectq (char-upcase (input-base-character))
+ (#/F (browser-sort "Reverse Sort by Filename" 'dired-filename-reverser))
+ (#/S (browser-sort "Reverse Sort by Size" 'dired-size-reverser))
+ (#/W (browser-sort "Reverse Sort by Write date" 'dired-write-reverser))
+ (#/R (browser-sort "Reverse Sort by Read date" 'dired-read-reverser))
+ (#/?
+ (nmode-set-immediate-prompt
+ "Reverse Sort by (Filename, Size, Read date, Write date) ")
+ (dired-reverse-sort-dispatch)
+ )
+ (t (write-prompt "") (Ding))
+ ))
+
+(de dired-sort ()
+ (nmode-set-immediate-prompt "Sort by ")
+ (dired-sort-dispatch)
+ )
+
+(de dired-sort-dispatch ()
+ (selectq (char-upcase (input-base-character))
+ (#/F (browser-sort "Sort by Filename" 'dired-filename-sorter))
+ (#/S (browser-sort "Sort by Size" 'dired-size-sorter))
+ (#/W (browser-sort "Sort by Write date" 'dired-write-sorter))
+ (#/R (browser-sort "Sort by Read date" 'dired-read-sorter))
+ (#/? (nmode-set-immediate-prompt
+ "Sort by (Filename, Size, Read date, Write date) ")
+ (dired-sort-dispatch)
+ )
+ (t (write-prompt "") (Ding))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% DIRED Support Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de dired-string-filter-predicate (file-browser-item)
+ (let* ((nice-name (=> file-browser-item nice-name))
+ (match (forward-search-in-string
+ nice-name (first dired-argument-list))))
+ (when (second dired-argument-list)
+ (setf match (not match)))
+ match))
+
+(de dired-determine-actions (b)
+ % Return a list containing two lists: the first a list of file names to be
+ % deleted, the second a list of file names to be undeleted.
+
+ (let ((items (=> (=> b get 'browser) items))
+ (delete-list ())
+ (undelete-list ())
+ )
+ (for (in item items)
+ (do (selectq (=> item action-wanted)
+ (delete
+ (setf delete-list (aconc delete-list (=> item full-name))))
+ (undelete
+ (setf undelete-list (aconc undelete-list (=> item full-name))))
+ )))
+ (list delete-list undelete-list)
+ ))
+
+(de dired-present-actions (action-list)
+ (let ((delete-list (first action-list))
+ (undelete-list (second action-list))
+ )
+ (nmode-begin-typeout)
+ (dired-present-list delete-list "These files to be deleted:")
+ (dired-present-list undelete-list "These files to be undeleted:")
+ (while t
+ (printf "%nDo It (YES, N, X)? ")
+ (selectq (get-upchar)
+ (#/Y
+ (if (= (get-upchar) #/E)
+ (if (= (get-upchar) #/S)
+ (exit T)
+ (Ding) (next))
+ (Ding) (next))
+ )
+ (#/N (exit NIL))
+ (#/X (exit 'EXIT))
+ (#/? (printf "%n YES-Do it, N-Return to DIRED, X-Exit from DIRED."))
+ (t (Ding))
+ ))))
+
+(de get-upchar ()
+ % This function is used during "normal PSL" typeout, so we cannot use
+ % the NMODE input functions, for they will refresh the NMODE windows.
+
+ (let ((ch (X-Base (=> nmode-terminal get-character))))
+ (when (AlphaP ch) (setf ch (char-upcase ch)) (WriteChar ch))
+ ch))
+
+(de dired-present-list (list prompt)
+ (when list
+ (printf "%w%n" prompt)
+ (for (in item list)
+ (for count 0 (if (= count 1) 0 (+ count 1)))
+ (do (printf "%w" (string-pad-right item 38))
+ (if (= count 1) (printf "%n"))
+ )
+ )
+ (printf "%n")
+ ))
+
+(de dired-perform-actions (action-list)
+ (let ((delete-list (first action-list))
+ (undelete-list (second action-list))
+ )
+ (for (in file delete-list)
+ (do (file-delete file)))
+ (for (in file undelete-list)
+ (do (file-undelete file)))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Sorting predicates:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(declare-flavor file-browser-item f1 f2)
+
+(de dired-filename-sorter (f1 f2)
+ (let ((n1 (=> f1 sort-name))
+ (n2 (=> f2 sort-name))
+ )
+ (if (string= n1 n2)
+ (<= (=> f1 version-number) (=> f2 version-number))
+ (string<= n1 n2)
+ )))
+
+(de dired-filename-reverser (f1 f2)
+ (not (dired-filename-sorter f1 f2)))
+
+(de dired-size-sorter (f1 f2)
+ (let ((size1 (=> f1 size))
+ (size2 (=> f2 size))
+ )
+ (or (< size1 size2)
+ (and (= size1 size2)
+ (dired-filename-sorter f1 f2))
+ )))
+
+(de dired-size-reverser (f1 f2)
+ (let ((size1 (=> f1 size))
+ (size2 (=> f2 size))
+ )
+ (or (> size1 size2)
+ (and (= size1 size2)
+ (dired-filename-sorter f1 f2))
+ )))
+
+(de dired-write-sorter (f1 f2)
+ (let ((d1 (or (=> f1 write-date) 0))
+ (d2 (or (=> f2 write-date) 0))
+ )
+ (or (LessP d1 d2)
+ (and (EqN d1 d2) (dired-filename-sorter f1 f2))
+ )))
+
+(de dired-write-reverser (f1 f2)
+ (let ((d1 (or (=> f1 write-date) 0))
+ (d2 (or (=> f2 write-date) 0))
+ )
+ (or (GreaterP d1 d2)
+ (and (EqN d1 d2) (dired-filename-sorter f1 f2))
+ )))
+
+(de dired-read-sorter (f1 f2)
+ (let ((d1 (or (=> f1 read-date) 0))
+ (d2 (or (=> f2 read-date) 0))
+ )
+ (or (LessP d1 d2)
+ (and (EqN d1 d2) (dired-filename-sorter f1 f2))
+ )))
+
+(de dired-read-reverser (f1 f2)
+ (let ((d1 (or (=> f1 read-date) 0))
+ (d2 (or (=> f2 read-date) 0))
+ )
+ (or (GreaterP d1 d2)
+ (and (EqN d1 d2) (dired-filename-sorter f1 f2))
+ )))
+
+(undeclare-flavor f1 f2)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% The file-browser-item flavor:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de create-file-browser-item (width full-name nice-name deleted? size
+ write-date read-date)
+ (make-instance 'file-browser-item
+ 'full-name full-name
+ 'nice-name nice-name
+ 'deleted? deleted?
+ 'size size
+ 'write-date write-date
+ 'read-date read-date
+ 'display-width width
+ ))
+
+(defflavor file-browser-item
+ (
+ display-text
+ display-width
+ full-name % full name of file
+ nice-name % file name as displayed
+ sort-name % name without version (for sorting purposes)
+ version-number % version number (or 0) (for sorting purposes)
+ size % size of file (arbitrary units)
+ write-date % write date of file (or NIL)
+ read-date % read date of file (or NIL)
+ deleted? % file is actually deleted
+ delete-flag % user wants file deleted
+ (buffer NIL) % buffer created to view file
+ )
+ ()
+ (gettable-instance-variables display-text full-name nice-name
+ sort-name version-number
+ size write-date read-date)
+ (initable-instance-variables)
+ )
+
+(defmethod (file-browser-item init) (init-plist)
+ (let ((pn (maybe-pathname nice-name)))
+ (setf sort-name
+ (if pn (namestring (pathname-without-version pn)) nice-name))
+ (setf version-number (if pn (pathname-version pn) 0))
+ (if (not (fixp version-number)) (setf version-number 0))
+ )
+ (setf display-text
+ (string-concat
+ (if deleted? "D " " ")
+ (string-pad-right nice-name (- display-width 48))
+ (string-pad-left (BldMsg "%d" size) 8)
+ (string-pad-left (if write-date (file-date-to-string write-date) "") 19)
+ (string-pad-left (if read-date (file-date-to-string read-date) "") 19)
+ ))
+ (setf delete-flag deleted?)
+ )
+
+(defmethod (file-browser-item update) ()
+ % Updating is too expensive, so we do nothing.
+ T
+ )
+
+(defmethod (file-browser-item delete) ()
+ (when (not delete-flag)
+ (setf display-text (copystring display-text))
+ (string-store display-text 0 #/D)
+ (setf delete-flag T)
+ ))
+
+(defmethod (file-browser-item undelete) ()
+ (when delete-flag
+ (setf display-text (copystring display-text))
+ (string-store display-text 0 #\space)
+ (setf delete-flag NIL)
+ ))
+
+(defmethod (file-browser-item deleted?) ()
+ delete-flag
+ )
+
+(defmethod (file-browser-item kill) ()
+ (let ((result (nmode-delete-file full-name)))
+ (when result
+ (=> self cleanup)
+ )
+ result
+ ))
+
+(defmethod (file-browser-item view-buffer) (x)
+ (or (find-file-in-existing-buffer full-name)
+ (setf buffer (find-file-in-buffer full-name T))
+ ))
+
+(defmethod (file-browser-item cleanup) ()
+ (when (and buffer (not (=> buffer modified?)))
+ (when (buffer-is-selectable? buffer)
+ (=> buffer set-previous-buffer NIL) % don't display the browser
+ (buffer-kill-and-detach buffer)
+ )
+ (setf buffer NIL)
+ ))
+
+(defmethod (file-browser-item apply-filter) (filter)
+ (apply filter (list self))
+ )
+
+(defmethod (file-browser-item action-wanted) ()
+ % Return 'DELETE, 'UNDELETE, or NIL.
+ (if (not (eq deleted? delete-flag)) % user wants some action taken
+ (let ((file-status (file-deleted-status full-name)))
+ (if file-status % File currently exists (otherwise, forget it)
+ (let ((actually-deleted? (eq file-status 'deleted)))
+ (if (not (eq delete-flag actually-deleted?))
+ (if delete-flag 'DELETE 'UNDELETE)
+ ))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/dispatch.sl
Index: psl-1983/3-1/nmode/dispatch.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/dispatch.sl
@@ -0,0 +1,300 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% DISPATCH.SL - NMODE Dispatch table utilities
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 24 August 1982
+%
+% Adapted from Will Galway's EMODE
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char fast-int fast-vectors))
+(fluid '(nmode-current-buffer nmode-minor-modes))
+
+% A command is represented either as a single extended character (i.e., a
+% character including Meta and Control bits) or as a list whose first element
+% is an extended character (a command prefix character, e.g. C-X or M-X) and
+% whose second element is the "argument", either an extended character or a
+% string (for M-X).
+
+% The dispatch table maps commands (as defined above) to functions (of no
+% arguments). There is a single command table that defines the "keyboard
+% bindings" for the current mode. Associated with every buffer is a list of
+% forms to evaluate which will establish the keyboard bindings for that
+% buffer.
+
+% The dispatch table is represented by a 512-element vector
+% NMODE-DISPATCH-TABLE which maps extended characters to functions, augmented
+% by an association list for each prefix character (e.g., C-X and M-X) that
+% maps extended characters to functions. The prefix character assocation lists
+% are themselves stored in an association list that maps from prefix
+% characters. This master association list is bound to the variable
+% NMODE-PREFIX-DISPATCH-LIST.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% The following are INTERNAL static variables:
+
+(fluid '(nmode-dispatch-table nmode-prefix-dispatch-list))
+
+(if (null nmode-dispatch-table)
+ (setf nmode-dispatch-table (MkVect 511)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Dispatch table lookup functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de dispatch-table-lookup (command)
+ % Return the dispatch table entry for the specified character or character
+ % sequence. NIL is returned for undefined commands.
+
+ (cond
+ % Single character:
+ ((FixP command)
+ (getv nmode-dispatch-table command)
+ )
+
+ % Character sequence:
+ ((PairP command)
+ (let* ((prefix-char (car command))
+ (argument (cadr command))
+ (prefix-entry (lookup-prefix-character prefix-char))
+ )
+ (and prefix-entry
+ % Look up the entry for the prefixed character.
+ (let ((char-entry (Atsoc argument prefix-entry)))
+ (and char-entry (cdr char-entry))
+ ))))
+
+ % If we get here, we were given a bad argument
+ (t
+ (StdError (BldMsg "Bad argument %p for Dispatch-Table-Lookup" command))
+ )))
+
+(de lookup-prefix-character (ch)
+
+ % Return the pair (PREFIX-CHAR . ASSOCIATION-LIST) for the specified prefix
+ % character. This pair may be modified using RPLACD.
+
+ (let ((assoc-entry (atsoc ch nmode-prefix-dispatch-list)))
+ (when (null assoc-entry)
+ % Create an entry for this prefix character.
+ (setf assoc-entry (cons ch NIL))
+ (setf nmode-prefix-dispatch-list
+ (cons assoc-entry nmode-prefix-dispatch-list))
+ )
+ assoc-entry
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Manipulating the dispatch table:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-make-self-inserting (chr)
+ % Define the specified character to be "self inserting".
+ (nmode-define-command chr 'insert-self-command))
+
+(de nmode-undefine-command (chr)
+ % Remove the command definition of the specified command.
+ % If the command is entered, the bell will be rung.
+ (nmode-define-command chr NIL))
+
+(de nmode-define-commands (lis)
+ (for (in x lis) (do (nmode-define-command (car x) (cdr x)))))
+
+(de nmode-define-normal-self-inserts ()
+ (nmode-make-self-inserting (char TAB))
+ (for (from i 32 126) (do (nmode-make-self-inserting i))))
+
+(de nmode-define-command (command op)
+ % Set up the keyboard dispatch table for a character or a character sequence.
+ % If the character is uppercase, define the equivalent lower case character
+ % also.
+
+ (cond
+ % Single character:
+ ((FixP command)
+ (vector-store nmode-dispatch-table command op)
+ (cond
+ ((X-UpperCaseP command)
+ (vector-store nmode-dispatch-table (X-Char-DownCase command) op))))
+
+ % Character Sequence:
+ ((PairP command)
+ (let* ((prefix-char (car command))
+ (argument (cadr command))
+ (prefix-entry (lookup-prefix-character prefix-char))
+ )
+
+ (if (null prefix-entry)
+ (StdError (BldMsg "Undefined prefix-character in command %p" command))
+ % else
+
+ % Add the prefixed character to the association list. Note that in
+ % case of duplicate entries the last one added is the one that counts.
+
+ (rplacd prefix-entry
+ (cons (cons argument op) (cdr prefix-entry)))
+
+ % Define the lower case version of the character, if relevent.
+ (cond
+ ((and (FixP argument) (X-UpperCaseP argument))
+ (rplacd prefix-entry
+ (cons (cons (X-Char-DownCase argument) op)
+ (cdr prefix-entry)))
+ )))))
+
+ % If we get here, we were given a bad argument
+ (t
+ (StdError (BldMsg "Impossible command %p" command))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Mode Establishing
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-establish-current-mode ()
+ (when nmode-current-buffer
+ (nmode-clear-dispatch-table)
+ (nmode-establish-mode (=> nmode-current-buffer mode))
+ (for (in minor-mode nmode-minor-modes)
+ (do (nmode-establish-mode minor-mode)))
+ ))
+
+(de nmode-establish-mode (mode)
+
+ % "Establish" the specified MODE: evaluate its "establish expressions" to set
+ % up the dispatch table. Use reverse so things on front of list are
+ % evaluated last. (So that later incremental changes are added later.)
+
+ (for (in x (reverse (=> mode establish-expressions)))
+ (do
+ (if (pairp x)
+ (eval x)
+ (StdError (BldMsg "Invalid mode expression: %r" x))
+ ))
+ ))
+
+(de nmode-clear-dispatch-table ()
+ % Set up a "clear" dispatch table.
+ (for (from i 0 511)
+ (do (nmode-undefine-command i)))
+ (setf nmode-prefix-dispatch-list NIL))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Help for Commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de help-dispatch ()
+
+ % Give a little information on the routine bound to a keyboard character (or
+ % characters, in the case of prefixed things).
+
+ (nmode-set-delayed-prompt "Show function of command: ")
+ (let* ((command (input-command))
+ (func (dispatch-table-lookup command))
+ (prompt (BldMsg "%w %w" (command-name command)
+ (or func "Undefined")))
+ )
+ (write-prompt prompt)
+ ))
+
+(de print-all-dispatch ()
+ % Print out the current dispatch table.
+ (print-matching-dispatch NIL))
+
+(fluid '(function-name-match-string))
+(de function-name-matcher (f)
+ (string-indexs (id2string f) function-name-match-string))
+
+(de string-indexs (s pattern)
+
+ % Search in the string S for the specified pattern. If we find it, we return
+ % the position of the first matching character. Otherwise, we return NIL.
+
+ (let* ((pattern-length (string-length pattern))
+ (limit (- (string-length s) pattern-length))
+ )
+ (for (from pos 0 limit)
+ (do (if (pattern-in-string pattern s pos)
+ (exit pos)))
+ )
+ ))
+
+(de pattern-in-string (pattern s pos)
+ % Return T if PATTERN occurs as substring of S, starting at POS.
+ % No bounds checking is performed on S.
+
+ (let ((i 0) (patlimit (string-upper-bound pattern)))
+ (while (and (<= i patlimit)
+ (= (string-fetch pattern i)
+ (string-fetch s (+ i pos)))
+ )
+ (setf i (+ i 1))
+ )
+ (> i patlimit) % T if all chars matched, NIL otherwise
+ ))
+
+(de print-matching-dispatch (s)
+ % Print out the current dispatch table, showing only those function
+ % whose names contain the string S (if S is NIL, show all functions).
+
+ (let (f)
+ (when s
+ (setf function-name-match-string (string-upcase s))
+ (setf f #'function-name-matcher)
+ )
+
+ % List the routines bound to single characters:
+ (for (from ch 0 511)
+ (do (print-dispatch-entry ch f)))
+ % List the routines bound to prefix characters:
+ (for (in prefix-entry nmode-prefix-dispatch-list)
+ (do (for (in char-entry (cdr prefix-entry))
+ (do (print-dispatch-entry
+ (list (car prefix-entry) (car char-entry))
+ f
+ )
+ ))))
+ ))
+
+(de print-dispatch-entry (command f)
+ % Print out the dispatch routine for a character or character sequence.
+ % Don't print anything if F is non-nill and (F fname) returns NIL, the
+ % command is a self inserting character, "undefined", or a lower-case
+ % character whose upper-case equivalent has the same definition.
+
+ (let ((fname (dispatch-table-lookup command)))
+ (if (not (or (null fname)
+ (memq fname
+ '(insert-self-command argument-or-insert-command Ding))
+ (and f (null (apply f (list fname))))
+ (is-redundant-command? command)
+ ))
+ (PrintF "%w %w%n" (string-pad-right (command-name command) 22) fname)
+ )))
+
+(de is-redundant-command? (command)
+ (let ((ch (if (FixP command) command (cadr command))))
+ (and (FixP ch)
+ (X-LowerCaseP ch)
+ (eq (dispatch-table-lookup command)
+ (dispatch-table-lookup
+ (if (FixP command)
+ (X-Char-UpCase command)
+ (list (car command) (X-Char-Upcase (cadr command)))
+ ))))))
+
+(de command-name (command)
+ % Return a string giving the name for a character or character sequence.
+ (if (PairP command)
+ (string-concat
+ (prefix-name (car command))
+ (let ((argument (cadr command)))
+ (cond ((FixP argument) (x-char-name argument))
+ (t argument)
+ )))
+ (x-char-name command)
+ ))
ADDED psl-1983/3-1/nmode/doc.sl
Index: psl-1983/3-1/nmode/doc.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/doc.sl
@@ -0,0 +1,224 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Doc.SL - NMODE On-line Documentation
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 15 February 1983
+% Revised: 8 April 1983
+%
+% 8-April-83 Jeff Soreff
+% Altered doc-filter-predicate and apply-filter method to adhere to the
+% "return list of self" convention (see code for apply filter method).
+% Declare-flavor was used to preserve efficiency of doc-filter-predicate.
+% 31-Mar-83 Jeff Soreff
+% Altered set-up-documentation to remove interaction with FRL.
+% A use of channelread was replaced with nmode-read-and-evaluate-file.
+% 14-Mar-83 Alan Snyder
+% Convert for changes in browser mechanism. Clear modified flag of
+% documentation buffer. Fixup external declarations and load statement.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects extended-char fast-strings numeric-operators))
+(on fast-integers)
+
+% External variables:
+
+(fluid '(text-mode))
+
+% Internal static variables:
+
+(fluid '(view-mode
+ doc-obj-list
+ doc-browser-mode
+ doc-browser-command-list
+ doc-browser-documentation-text
+ doc-browser-help-text
+ doc-filter-argument-list
+ doc-text-file
+ reference-text-file
+ doc-text-buffer))
+
+(setf doc-obj-list nil)
+(setf doc-text-file "SS:<PSL.NMODE-DOC>FRAMES.LPT")
+(setf reference-text-file "SS:<PSL.NMODE-DOC>COSTLY.SL")
+
+(setf doc-browser-help-text
+ ["? View Edit Filter uNdo-filter Ignore Quit"])
+
+(setf doc-browser-documentation-text
+ ["The Documentation Browser displays documentation on NMODE."
+ "Terminology: the current item is the item pointed at by the cursor."
+ "The View (V) and Edit (E) commands both display the current item."
+ "In split-screen mode, Edit selects the bottom window while View does not."
+ "The Filter (F) command asks for a string and removes all items that"
+ "do not match the string."
+ "The Ignore (I) command removes the current item from the display."
+ "The uNdo-Filter (N) command restores the items removed by the most"
+ "recent Filter command or by the most recent series of Ignore commands."
+ "The Quit (Q) command exits the browser."
+ ])
+
+(de set-up-documentation ()
+ (when (null doc-obj-list)
+ (setf doc-text-buffer (create-unnamed-buffer text-mode))
+ (insert-file-into-buffer doc-text-buffer doc-text-file)
+ (=> doc-text-buffer set-modified? NIL)
+ (nmode-read-and-evaluate-file reference-text-file)
+ (let ((browser (create-nmode-documentation-browser)))
+ (=> browser set-items doc-obj-list)
+ )
+ NIL
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Documentation Browser Commands
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(setf view-mode
+ (nmode-define-mode
+ "View"
+ '((nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Window-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ (nmode-define-commands Basic-Command-List)
+ (nmode-define-commands
+ (list (cons (x-char Q) 'select-previous-buffer-command)))
+ )))
+
+(setf Doc-Browser-Mode (nmode-define-mode "Doc-Browser" '(
+ (nmode-define-commands Doc-Browser-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ )))
+
+(setf Doc-Browser-Command-List
+ (list
+ (cons (x-char ?) 'browser-help-command)
+ (cons (x-char F) 'doc-filter-command)
+ (cons (x-char E) 'browser-edit-command)
+ (cons (x-char I) 'browser-ignore-command)
+ (cons (x-char N) 'browser-undo-filter-command)
+ (cons (x-char V) 'browser-view-command)
+ (cons (x-char Q) 'browser-exit-command)
+ (cons (x-char SPACE) 'move-down-command)
+ ))
+
+(de doc-obj-compare (obj1 obj2)
+ (let ((indx1 (doc-browse-obj$index obj1))
+ (indx2 (doc-browse-obj$index obj2)))
+ (< indx1 indx2)))
+
+(de doc-filter-command ()
+ (let ((browser (current-browser))
+ (doc-filter-argument-list
+ (list (prompt-for-string
+ "Search for what string in a command's name or references?"
+ ""))))
+ (=> browser filter-items #'doc-filter-predicate)
+ ))
+
+(declare-flavor doc-browse-obj doc-obj obj-temp)
+
+(de doc-filter-predicate (doc-obj)
+ (let* ((old-name (=> doc-obj name))
+ (ref-list (=> doc-obj ref-list))
+ (pattern (string-upcase (first doc-filter-argument-list)))
+ (pattern-length (string-length pattern))
+ (name-list (cons old-name
+ (for (in ref ref-list)
+ (with name-list obj-temp)
+ (collect
+ (let ((obj-temp (eval ref)))
+ (=> obj-temp name))
+ name-list)
+ (returns name-list)))))
+ (for (in name name-list)
+ (with found)
+ (do (when (let ((limit (- (string-length name) pattern-length))
+ (char-pos 0))
+ (while (<= char-pos limit)
+ (if (pattern-matches-in-line pattern name char-pos)
+ (exit char-pos))
+ (incr char-pos)))
+ (setf found t)))
+ (returns found))))
+
+(undeclare-flavor doc-obj obj-temp)
+
+(de create-nmode-documentation-browser ()
+ (create-browser 'DOCUMENTATION-BROWSER "Documentation" "NMODE"
+ doc-browser-mode (create-unnamed-buffer view-mode)
+ ["NMODE Documentation Browser Subsystem" ""]
+ doc-browser-documentation-text
+ doc-browser-help-text
+ () #'doc-obj-compare)
+ )
+
+(de apropos-command ()
+ (let* ((doc-filter-argument-list
+ (list (prompt-for-string
+ "Search for what string in a command's name or references?"
+ "")))
+ (jnk (set-up-documentation))
+ (browser (or (find-browser 'DOCUMENTATION-BROWSER "NMODE")
+ (create-nmode-documentation-browser)
+ )))
+ (=> browser set-items doc-obj-list)
+ (=> browser filter-items #'doc-filter-predicate)
+ (browser-enter browser)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% The doc-browse-obj (documentation-browser-object) flavor:
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defflavor doc-browse-obj
+ (
+ name
+ type
+ index
+ (start-line NIL)
+ (end-line NIL)
+ (ref-list ())
+ )
+ ()
+ initable-instance-variables
+ gettable-instance-variables
+ )
+
+(defmethod (doc-browse-obj display-text) ()
+ (string-concat (id2string type) ": " name))
+
+(defmethod (doc-browse-obj view-buffer) (buffer)
+ (unless buffer
+ (setf buffer (create-unnamed-buffer view-mode)))
+ (=> buffer reset)
+ (if (not (and start-line end-line))
+ (=> buffer insert-string
+ "Sorry, no documentation is availible on this topic.")
+ (=> buffer insert-text
+ (cdr (=> doc-text-buffer extract-region
+ NIL (cons start-line 0) (cons end-line 0)))))
+ (=> buffer move-to-buffer-start)
+ (=> buffer set-modified? nil)
+ buffer)
+
+(defmethod (doc-browse-obj update) ()
+ T
+ )
+
+(defmethod (doc-browse-obj cleanup) ()
+ NIL)
+
+(defmethod (doc-browse-obj apply-filter) (filter)
+ (apply filter (list self)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/extended-input.sl
Index: psl-1983/3-1/nmode/extended-input.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/extended-input.sl
@@ -0,0 +1,104 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Extended-Input.SL - 9-bit terminal input (for 7 or 8 bit terminals)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 31 August 1982
+% Revised: 11 April 1983
+%
+% 11-Apr-83 Alan Snyder
+% Change "obsolete" #\BS to #\BackSpace.
+% 17-Feb-83 Alan Snyder
+% Added PUSH-BACK-INPUT-CHARACTER function. Revise mapping so that
+% bit prefix characters are recognized after mapping.
+% 22-Dec-82 Jeffrey Soreff
+% Added PUSH-BACK-EXTENDED-CHARACTER function.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load extended-char fast-int fast-vectors))
+
+% Global variables:
+
+(fluid '(nmode-meta-bit-prefix-character
+ nmode-control-bit-prefix-character
+ nmode-control-meta-bit-prefix-character))
+
+(setf nmode-meta-bit-prefix-character (x-char C-!\))
+(setf nmode-control-bit-prefix-character (x-char C-^))
+(setf nmode-control-meta-bit-prefix-character (x-char C-Z))
+
+% Internal static variables:
+
+(fluid '(nmode-terminal-map nmode-lookahead-extended-char nmode-lookahead-char))
+(setf nmode-lookahead-extended-char nil)
+(setf nmode-lookahead-char nil)
+
+(de nmode-initialize-extended-input ()
+ (setf nmode-terminal-map (MkVect 255))
+
+ % Most input characters map to themselves.
+ (for (from i 0 255)
+ (do (vector-store nmode-terminal-map i i)))
+
+ % Some ASCII control character map to Extended Control characters.
+ % Exceptions: BACKSPACE, TAB, RETURN, LINEFEED, ESCAPE
+ (for (from i 0 31)
+ (unless (member i '#.(list #\BackSpace #\Tab #\CR #\LF #\ESC)))
+ (do (let ((mch (X-Set-Control (+ i 64))))
+ (vector-store nmode-terminal-map i mch)
+ (vector-store nmode-terminal-map (+ i 128) (+ mch 128))
+ )))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de input-extended-character ()
+ (if nmode-lookahead-extended-char
+ (prog1 nmode-lookahead-extended-char
+ (setf nmode-lookahead-extended-char nil))
+ (input-direct-extended-character)))
+
+(de push-back-extended-character (ch)
+ (setf nmode-lookahead-extended-char ch))
+
+(de input-direct-extended-character ()
+ % Read an extended character from the terminal.
+ % Recognize and interpret bit-prefix characters.
+
+ (let* ((ch (input-terminal-character)))
+ (cond
+ ((= ch nmode-meta-bit-prefix-character)
+ (nmode-append-separated-prompt "M-")
+ (setf ch (input-terminal-character))
+ (nmode-complete-prompt (x-char-name (x-unmeta ch)))
+ (x-set-meta ch)
+ )
+ ((= ch nmode-control-bit-prefix-character)
+ (nmode-append-separated-prompt "C-")
+ (setf ch (input-terminal-character))
+ (nmode-complete-prompt (x-char-name (x-uncontrol ch)))
+ (x-set-control ch)
+ )
+ ((= ch nmode-control-meta-bit-prefix-character)
+ (nmode-append-separated-prompt "C-M-")
+ (setf ch (input-terminal-character))
+ (nmode-complete-prompt (x-char-name (x-base ch)))
+ (x-set-meta (x-set-control ch))
+ )
+ (t ch)
+ )))
+
+(de push-back-input-character (ch)
+ (setf nmode-lookahead-char ch)
+ )
+
+(de input-terminal-character ()
+ % Read an extended character from the terminal. Perform mapping from 8-bit
+ % to 9-bit characters. Do not interpret bit prefix characters.
+
+ (if nmode-lookahead-char
+ (prog1 nmode-lookahead-char (setf nmode-lookahead-char nil))
+ (vector-fetch nmode-terminal-map (input-direct-terminal-character))
+ ))
ADDED psl-1983/3-1/nmode/fileio.sl
Index: psl-1983/3-1/nmode/fileio.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/fileio.sl
@@ -0,0 +1,518 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% FileIO.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 September 1982
+% Revised: 31 March 1983
+%
+% File I/O for NMODE.
+%
+% 31-Mar-83 Alan Snyder
+% Fix bug: Print-Buffer didn't do tabs right (because the PSL manual
+% incorrectly described the Repeat macro!).
+% 15-Mar-83 Alan Snyder
+% Create-buffer-unselectable -> Create-unnamed-buffer. Add
+% print-buffer-command. Rename write-screen-photo-command to
+% write-screen-command; Fix to work when there are multiple physical screens;
+% add a default file name.
+% 4-Mar-83 Alan Snyder
+% Added error handling for bad pathname specified by user. Added some
+% recovery for bad pathnames in general. Pathname-without-version renamed to
+% Filename-without-version.
+% 4-Feb-83 Alan Snyder
+% Added functions for deleting/undeleting files and writing a message.
+% Find-file-in-buffer changed incompatibly to make it more useful. Use
+% nmode-error to report errors.
+% 1-Feb-83 Alan Snyder
+% Added separate default string for Insert File command.
+% 27-Dec-82 Alan Snyder
+% Removed runtime LOAD statements, for portability.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects numeric-operators fast-strings pathnames))
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External Variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-selectable-buffers nmode-current-buffer nmode-screen
+ nmode-command-argument-given nmode-current-window Text-Mode
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal static variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(text-io-default-fn
+ insert-file-default-fn
+ nmode-print-device
+ write-screen-default-fn
+ ))
+
+(setf nmode-print-device "PRINTER:") % probably override this in system file
+(setf text-io-default-fn NIL)
+(setf insert-file-default-fn NIL)
+(setf write-screen-default-fn NIL)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% File commands:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de visit-file-command ()
+ % Ask for and read in a file.
+ (let ((fn (prompt-for-defaulted-filename "Visit File: " NIL)))
+ (visit-file nmode-current-buffer fn)
+ ))
+
+(de insert-file-command ()
+ % Ask for and read a file, inserting it into the current buffer.
+ (setf insert-file-default-fn
+ (prompt-for-file-name "Insert File: " insert-file-default-fn))
+ (insert-file-into-buffer nmode-current-buffer insert-file-default-fn)
+ )
+
+(de write-file-command ()
+ % Ask for filename, write out the buffer to the file.
+ (write-buffer-to-file
+ nmode-current-buffer
+ (prompt-for-defaulted-filename "Write File:" NIL)))
+
+(de save-file-command ()
+ % Save current buffer on its associated file, ask for file if unknown.
+ (cond
+ ((not (=> nmode-current-buffer modified?))
+ (write-prompt "(No changes need to be written)"))
+ (t (save-file nmode-current-buffer))))
+
+(de save-file-version-command ()
+ % Save current buffer on its associated file, ask for file if unknown.
+ % The file is written using the current version number.
+ (cond
+ ((not (=> nmode-current-buffer modified?))
+ (write-prompt "(No changes need to be written)"))
+ (t (save-file-version nmode-current-buffer))))
+
+(de find-file-command ()
+ % Ask for filename and then read it into a buffer created especially for that
+ % file, or select already existing buffer containing the file.
+
+ (find-file (prompt-for-defaulted-filename "Find file: " NIL))
+ )
+
+(de write-screen-command ()
+ % Ask for filename, write out the screen to the file.
+ (setf write-screen-default-fn
+ (prompt-for-file-name "Write Screen to File: " write-screen-default-fn))
+ (write-screen write-screen-default-fn)
+ )
+
+(de write-region-command ()
+ % Ask for filename, write out the region to the file.
+ (write-text-to-file
+ (cdr (extract-region NIL (buffer-get-position) (current-mark)))
+ (setf text-io-default-fn
+ (prompt-for-file-name "Write Region to File:" text-io-default-fn))))
+
+(de prepend-to-file-command ()
+ % Ask for filename, prepend the region to the file.
+ (prepend-text-to-file
+ (cdr (extract-region NIL (buffer-get-position) (current-mark)))
+ (setf text-io-default-fn
+ (prompt-for-file-name "Prepend Region to File:" text-io-default-fn))))
+
+(de append-to-file-command ()
+ % Ask for filename, append the region to the file.
+ (append-text-to-file
+ (cdr (extract-region NIL (buffer-get-position) (current-mark)))
+ (setf text-io-default-fn
+ (prompt-for-file-name "Append Region to File:" text-io-default-fn))))
+
+(de delete-file-command ()
+ (nmode-delete-file (prompt-for-defaulted-filename "Delete File:" NIL)))
+
+(de delete-and-expunge-file-command ()
+ (nmode-delete-and-expunge-file
+ (prompt-for-defaulted-filename "Delete and Expunge File:" NIL)))
+
+(de undelete-file-command ()
+ (nmode-undelete-file (prompt-for-defaulted-filename "Undelete File:" NIL)))
+
+(de save-all-files-command ()
+ % Save all files. Ask first, unless arg given.
+ (for
+ (in b nmode-selectable-buffers)
+ (do
+ (cond ((and (=> b file-name)
+ (=> b modified?)
+ (or nmode-command-argument-given
+ (nmode-y-or-n?
+ (bldmsg "Save %w in %w (Y or N)?"
+ (=> b name) (=> b file-name)))
+ ))
+ (save-file b))
+ ))))
+
+(de print-buffer-command ()
+ % Print the current buffer. Translates tabs and control characters.
+ (setf nmode-print-device
+ (prompt-for-string "Print buffer to device:" nmode-print-device))
+ (print-buffer nmode-print-device)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% File functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de prompt-for-defaulted-filename (prompt b)
+ % The default name is the name associated with the specified buffer (without
+ % Version number). Will throw 'ABORT if a bad file name is given.
+ % If B is NIL, the "current" buffer is used.
+
+ (let ((fn (=> (or b nmode-current-buffer) file-name)))
+ (prompt-for-file-name prompt
+ (and fn (filename-without-version fn))
+ )))
+
+(de prompt-for-file-name (prompt default-name)
+ % Default-Name may be NIL.
+ % Will throw 'ABORT if a bad file name is given.
+
+ (let* ((fn (prompt-for-string prompt default-name))
+ (pn (maybe-pathname fn))
+ )
+ (when (not pn)
+ (nmode-error (bldmsg "Invalid pathname: %w" fn))
+ (throw 'ABORT)
+ )
+ (if default-name
+ (setf pn (attempt-to-merge-pathname-defaults
+ pn default-name (pathname-type default-name) NIL)))
+ (namestring pn)
+ ))
+
+(de attempt-to-merge-pathname-defaults (pn dn type version)
+ (let ((result (errset (merge-pathname-defaults pn dn type version) NIL)))
+ (cond
+ ((listp result) (car result))
+ (t (nmode-error EMSG*)
+ (throw 'ABORT)))))
+
+(de read-file-into-buffer (b file-name)
+ (=> b set-file-name file-name)
+ (buffer-set-mode b (pathname-default-mode file-name))
+ (let ((s (attempt-to-open-input file-name)))
+ (if s
+ (read-stream-into-buffer b s)
+ % else
+ (=> b reset)
+ (=> b set-modified? NIL)
+ (write-prompt "(New File)")
+ )))
+
+(de read-stream-into-buffer (b s)
+ (let ((fn (=> s file-name)))
+ (write-prompt (bldmsg "Reading file: %w" fn))
+ (=> b read-from-stream s)
+ (=> s close)
+ (write-prompt (bldmsg "File read: %w (%d lines)" fn (=> b visible-size)))
+ ))
+
+(de insert-file-into-buffer (buf pn)
+ (let ((b (create-unnamed-buffer Text-Mode)))
+ (read-file-into-buffer b pn)
+ (insert-buffer-into-buffer b buf)
+ ))
+
+(de insert-buffer-into-buffer (source destination)
+ (let ((old-pos (=> destination position)))
+ (=> destination insert-text (=> source contents))
+ (=> destination set-mark-from-point)
+ (=> destination set-position old-pos)
+ ))
+
+(de save-file (b)
+ % Save the specified buffer on its associated file, ask for file if unknown.
+ (let ((fn (=> b file-name)))
+ (cond
+ ((not (=> b modified?)) nil)
+ (fn (write-buffer-to-file b (filename-without-version fn)))
+ (T (write-file b)))))
+
+(de save-file-version (b)
+ % Save the specified buffer on its associated file, ask for file if unknown.
+ % The file is written to the current version number.
+ (let ((fn (=> b file-name)))
+ (cond
+ ((not (=> b modified?)) nil)
+ (fn (write-buffer-to-file b fn))
+ (T (write-file b)))))
+
+(de write-file (b)
+ % Ask for filename, write out the buffer to the file.
+ (let ((msg (bldmsg "Write Buffer %w to File: " (=> b name))))
+ (write-buffer-to-file b (prompt-for-defaulted-filename msg b))))
+
+(de write-buffer-to-file (b pn)
+ % Write the specified buffer to a file.
+ (write-prompt "")
+ (let* ((file-name (namestring pn))
+ (s (attempt-to-open-output file-name))
+ )
+ (if s
+ (let ((fn (=> s file-name)))
+ (write-prompt (bldmsg "Writing file: %w" fn))
+ (=> b write-to-stream s)
+ (=> s close)
+ (write-prompt
+ (bldmsg "File written: %w (%d lines)" fn (=> b visible-size)))
+ (=> b set-modified? NIL)
+ (=> b set-file-name fn)
+ )
+ (nmode-error (bldmsg "Unable to write file: %w" file-name))
+ )))
+
+(de write-text-to-file (text pn)
+ (let ((b (create-unnamed-buffer Text-Mode)))
+ (=> b insert-text text)
+ (write-buffer-to-file b pn)
+ ))
+
+(de prepend-text-to-file (text pn)
+ (let ((b (create-unnamed-buffer Text-Mode)))
+ (read-file-into-buffer b pn)
+ (=> b move-to-buffer-start)
+ (=> b insert-text text)
+ (write-buffer-to-file b pn)
+ ))
+
+(de append-text-to-file (text pn)
+ (let ((b (create-unnamed-buffer Text-Mode)))
+ (read-file-into-buffer b pn)
+ (=> b move-to-buffer-end)
+ (=> b insert-text text)
+ (write-buffer-to-file b pn)
+ ))
+
+(de visit-file (b file-name)
+ % If the specified file exists, read it into the specified buffer.
+ % Otherwise, clear the buffer for a new file.
+ % If the buffer contains precious data, offer to save it first.
+
+ (if (=> b modified?)
+ (let* ((fn (=> b file-name))
+ (msg (if fn (bldmsg "file %w" fn)
+ (bldmsg "buffer %w" (=> b name))))
+ )
+ (if (nmode-yes-or-no? (bldmsg "Write out changes in %w?" msg))
+ (save-file b)
+ )))
+ (let ((fn (actualize-file-name file-name)))
+ (if fn
+ (read-file-into-buffer b fn)
+ (nmode-error (bldmsg "Unable to read or create file: %w" file-name))
+ )))
+
+(de find-file (file-name)
+ % Select a buffer containing the specified file. If the file exists in a
+ % buffer already, then that buffer is selected. Otherwise, a new buffer is
+ % created and the file read into it (if the file exists).
+
+ (find-file-in-window nmode-current-window file-name))
+
+(de find-file-in-window (w file-name)
+ % Attach a buffer to the specified window that contains the specified file.
+ % If the file exists in a buffer already, then that buffer is used.
+ % Otherwise, a new buffer is created and the file read into it (if the file
+ % exists).
+
+ (let ((b (find-file-in-buffer file-name nil)))
+ (if b
+ (window-select-buffer w b)
+ % otherwise
+ (nmode-error (bldmsg "Unable to read or create file: %w" file-name))
+ )))
+
+(de find-file-in-buffer (file-name existing-file-only?)
+ % Return a buffer containing the specified file. The buffer is not
+ % selected. If the file exists in a buffer already, then that buffer is
+ % returned. Otherwise, if the file exists and can be read, a new buffer is
+ % created and the file read into it. Otherwise, if EXISTING-FILE-ONLY? is
+ % NIL and the file is potentially creatable, a new buffer is created and
+ % returned. Otherwise, NIL is returned.
+
+ (setf file-name (actualize-file-name file-name))
+ (if (and file-name (not (string-empty? file-name)))
+ (or
+ (find-file-in-existing-buffer file-name) % look for existing buffer
+ (let ((s (attempt-to-open-input file-name)))
+ (when (or s (not existing-file-only?)) % create a buffer
+ (let ((b (buffer-create-default
+ (buffer-make-unique-name
+ (filename-to-buffername file-name)))))
+ (=> b set-file-name file-name)
+ (buffer-set-mode b (pathname-default-mode file-name))
+ (if s
+ (read-stream-into-buffer b s)
+ (write-prompt "(New File)")
+ )
+ b
+ ))))))
+
+(de find-file-in-existing-buffer (file-name)
+ % Look for the specified file in an existing buffer. If found, return
+ % that buffer, otherwise return NIL. The filename should be complete.
+
+ (let ((pn (maybe-pathname file-name)))
+ (when pn
+ (for (in b nmode-selectable-buffers)
+ (do (if (pathnames-match pn (=> b file-name)) (exit b)))
+ (returns nil))
+ )))
+
+(de nmode-delete-file (fn)
+ (let ((del-fn (file-delete fn)))
+ (if del-fn
+ (write-prompt (bldmsg "File deleted: %w" del-fn))
+ (nmode-error (bldmsg "Unable to delete file: %w" fn))
+ )
+ del-fn
+ ))
+
+(de nmode-delete-and-expunge-file (fn)
+ (let ((del-fn (file-delete-and-expunge fn)))
+ (if del-fn
+ (write-prompt (bldmsg "File deleted and expunged: %w" del-fn))
+ (nmode-error (bldmsg "Unable to delete file: %w" fn))
+ )
+ del-fn
+ ))
+
+(de nmode-undelete-file (fn)
+ (let ((del-fn (file-undelete fn)))
+ (if del-fn
+ (write-prompt (bldmsg "File undeleted: %w" del-fn))
+ (nmode-error (bldmsg "Unable to undelete file: %w" fn))
+ )
+ del-fn
+ ))
+
+(de write-screen (file-name)
+ % Write the current screen to file.
+ (let ((s (attempt-to-open-output file-name)))
+ (if s
+ (let ((screen (=> (=> nmode-current-window screen) screen)))
+ (nmode-refresh)
+ (=> screen write-to-stream s)
+ (=> s close)
+ (write-prompt (bldmsg "File written: %w" (=> s file-name)))
+ )
+ (nmode-error (bldmsg "Unable to write file: %w" file-name))
+ )))
+
+(de print-buffer (print-device)
+ % Print the current buffer. PSL output is used because it is probably more
+ % general (less specialized) and will handle character output devices. This
+ % routine is likely to be redefined in the system file.
+
+ (let ((result (errset (open print-device 'OUTPUT))))
+ (if (not (pairp result))
+ (nmode-error (bldmsg "Unable to write to %w" print-device))
+ % otherwise
+ (let* ((chn (car result))
+ (upper-bound (- (current-buffer-size) 1))
+ )
+ (for (from i 0 upper-bound)
+ (do
+ (print-buffer-line chn (current-buffer-fetch i))
+ (channelterpri chn)
+ ))
+ (close chn)
+ ))))
+
+(de print-buffer-line (chn line)
+ % Used by print-buffer.
+ (for (from i 0 (string-upper-bound line))
+ (with (col 0))
+ (do
+ (let ((ch (string-fetch line i)))
+ (cond
+ ((= ch #\TAB)
+ % TABs are converted to an appropriate number of spaces.
+ (repeat
+ (channelwritechar chn #\space)
+ (setf col (+ col 1))
+ % until
+ (= (& col 7) 0)
+ ))
+ ((or (< ch #\space) (= ch #\rubout))
+ % Control characters are converted to "uparrow" form.
+ (channelwritechar chn #/^)
+ (channelwritechar chn (^ ch 8#100))
+ (setf col (+ col 2))
+ )
+ (t
+ (channelwritechar chn ch)
+ (setf col (+ col 1))
+ ))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Auxiliary functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de actualize-file-name (file-name)
+ % If the specified file exists, return its "true" (and complete) name.
+ % Otherwise, return the "true" name of the file that would be created if one
+ % were to do so. (Unfortunately, we have no way to do this except by actually
+ % creating the file and then deleting it!) Return NIL if the file cannot be
+ % read or created.
+
+ (let ((s (attempt-to-open-input file-name)))
+ (cond ((not s)
+ (setf s (attempt-to-open-output file-name))
+ (when s
+ (setf file-name (=> s file-name))
+ (=> s close)
+ (file-delete-and-expunge file-name)
+ file-name
+ )
+ )
+ (t
+ (setf file-name (=> s file-name))
+ (=> s close)
+ file-name
+ ))))
+
+(de filename-to-buffername (fn)
+ % Convert from a pathname to the "default" corresponding buffer name.
+ (let ((pn (maybe-pathname fn)))
+ (if pn
+ (string-upcase (file-namestring (pathname-without-version pn)))
+ (string-upcase fn)
+ )))
+
+(de pathnames-match (pn1 pn2)
+ (setf pn1 (pathname pn1))
+ (setf pn2 (pathname pn2))
+ (and (equal (pathname-device pn1) (pathname-device pn2))
+ (equal (pathname-directory pn1) (pathname-directory pn2))
+ (equal (pathname-name pn1) (pathname-name pn2))
+ (equal (pathname-type pn1) (pathname-type pn2))
+ (or (null (pathname-version pn1))
+ (null (pathname-version pn2))
+ (equal (pathname-version pn1) (pathname-version pn2)))
+ ))
+
+(de filename-without-version (fn)
+ (let ((pn (maybe-pathname fn)))
+ (if pn
+ (namestring (pathname-without-version pn))
+ fn
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/hp9836-dev.sl
Index: psl-1983/3-1/nmode/hp9836-dev.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/hp9836-dev.sl
@@ -0,0 +1,123 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% HP9836-DEV.SL - HP9836 NMODE Development Support (not normally loaded)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 20 January 1983
+% Revised: 4 April 1983
+%
+% 4-Apr-83 Alan Snyder
+% Changes relating to keeping NMODE source and binary files in separate
+% directories.
+% 16-Mar-83 Alan Snyder
+% New function: window-ftp.
+% 14-Mar-83 Alan Snyder
+% Changed nmode-compile and window-compile to take any number of arguments.
+% New function: nmode-ftp.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings extended-char))
+(bothtimes (load strings common))
+
+(fluid '(nmode-source-prefix
+ nmode-binary-prefix
+ window-source-prefix
+ window-binary-prefix
+ ))
+
+(setf prinlevel 3)
+(setf prinlength 10)
+
+(dn nmode-compile (s-list)
+ (for (in s s-list)
+ (do (nmode-compile-1 s))
+ ))
+
+(de nmode-compile-1 (s)
+ (setf s (nmode-fixup-name s))
+ (let ((object-name (string-concat nmode-binary-prefix s))
+ (source-name (string-concat nmode-source-prefix
+ (string-concat s ".sl")))
+ )
+ (compile-lisp-file source-name object-name)
+ ))
+
+(dn window-compile (s-list)
+ (for (in s s-list)
+ (do (window-compile-1 s))
+ ))
+
+(de window-compile-1 (s)
+ (setf s (nmode-fixup-name s))
+ (let ((object-name (string-concat window-binary-prefix s))
+ (source-name (string-concat window-source-prefix
+ (string-concat s ".sl")))
+ )
+ (compile-lisp-file source-name object-name)
+ ))
+
+(de pu-compile (s)
+ (let ((object-name (string-concat "pl:" s))
+ (source-name (string-concat "pu:" (string-concat s ".sl")))
+ )
+ (compile-lisp-file source-name object-name)
+ ))
+
+(de phpu-compile (s)
+ (let ((object-name (string-concat "pl:" s))
+ (source-name (string-concat "phpu:" (string-concat s ".sl")))
+ )
+ (compile-lisp-file source-name object-name)
+ ))
+
+(de nmode-compile-all ()
+ (for (in s nmode-file-list)
+ (do (nmode-compile s))
+ ))
+
+(de window-compile-all ()
+ (for (in s window-file-list)
+ (do (window-compile s))
+ ))
+
+(dn nmode-ftp (s-list)
+ (let* ((sout (open-output "FTP-NMODE"))
+ (dummy (make-string 1 0))
+ )
+ (=> sout putl "XTERM")
+ (string-store dummy 0 128)
+ (=> sout puts dummy)
+ (for (in s s-list)
+ (do (nmode-ftp-1 s sout))
+ )
+ (=> sout putl "")
+ (=> sout close)
+ ))
+
+(de nmode-ftp-1 (s sout)
+ (=> sout puts "S") % Send command
+ (=> sout putl (string-concat nmode-source-prefix (nmode-fixup-name s) ".sl"))
+ (=> sout putl (string-concat "n:" s ".sl"))
+ )
+
+(dn window-ftp (s-list)
+ (let* ((sout (open-output "FTP-WINDOW"))
+ (dummy (make-string 1 0))
+ )
+ (=> sout putl "XTERM")
+ (string-store dummy 0 128)
+ (=> sout puts dummy)
+ (for (in s s-list)
+ (do (window-ftp-1 s sout))
+ )
+ (=> sout putl "")
+ (=> sout close)
+ ))
+
+(de window-ftp-1 (s sout)
+ (=> sout puts "S") % Send command
+ (=> sout putl (string-concat window-source-prefix (window-fixup-name s) ".sl"))
+ (=> sout putl (string-concat "n:" s ".sl"))
+ )
ADDED psl-1983/3-1/nmode/incr.sl
Index: psl-1983/3-1/nmode/incr.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/incr.sl
@@ -0,0 +1,327 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Incremental-Search.SL - Incremental Search Routines for NMODE
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 21 December 1982
+% Revised: 17 February 1982
+%
+% 17-Feb-83 Alan Snyder
+% Fixed to allow pushback of bit-prefix characters.
+% 7-Feb-83 Alan Snyder
+% Revised to refresh all windows when writing message (write-message no
+% longer does this).
+% 18 January 1982 Jeffrey Soreff
+% This was revised to preserve the message existing before a search.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-strings fast-vectors fast-int extended-char))
+(BothTimes (load objects))
+
+% Global Variables
+
+(fluid '(text-last-searched-for))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Actual Command Functions
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de incremental-search-command () (incr-search 1))
+
+(de reverse-search-command () (incr-search -1))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Support Objects and Methods
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defflavor search-state
+ ((state-list nil)
+ (halt nil) % Halt means that the search should halt on this iteration.
+ direct % This is the direction of the search: +1 for forward, -1 for back.
+ (repeat-flag nil) % When repeating a search for the same text as before.
+ (found-flag t) % This flag indicates that the current text was found.
+ (place (buffer-get-position)) % This is set to the start of text found.
+ (apparent-place (buffer-get-position))
+ % Apparent-place is put where the user should see the cursor: after the
+ % text for forward searching, and before it for backward searching.
+ (text [""])) % The text being searched for.
+ ()
+ (gettable-instance-variables halt)
+ (initable-instance-variables direct)
+ )
+
+(defmethod (search-state push) ()
+ % This method stores the information needed when one deletes a
+ % character from the search string. It affects only state-list.
+ (setf state-list
+ (cons
+ (vector direct repeat-flag found-flag place apparent-place)
+ state-list)))
+
+(defmethod (search-state pop) ()
+ % This method restores the last state of the search. The text is
+ % recomputed on the fly, while most of the other elements of the
+ % state are explicitly retrieved from the list. "Halt" is not
+ % retrieved, since the search should never pass a state where halt
+ % is true. In addition to altering local variables,
+ % text-last-searched-for is set equal to the truncated text, and
+ % point is moved to its last location.
+ (unless repeat-flag (setf text (trim-text text)))
+ (when (cdr state-list)
+ (setf state-list (cdr state-list))
+ (setf text-last-searched-for text)) % see next line.
+ % Don't destroy information from previous search if one is in the
+ % first state of a search and a deletion is attempted.
+ (let ((state (car state-list)))
+ (setf direct (vector-fetch state 0))
+ (setf repeat-flag (vector-fetch state 1))
+ (setf found-flag (vector-fetch state 2))
+ (setf place (vector-fetch state 3))
+ (setf apparent-place (vector-fetch state 4)))
+ (buffer-set-position apparent-place))
+
+(defmethod (search-state do-search) (next-command)
+ % This method sets up searches. It analyses the current command to
+ % determine if a search for old text is being repeated, or if a new
+ % character is being added on to the existing text. It updates the
+ % text being searched for, the record of the last text searched for,
+ % the direction of the search, and it sets up point before searches.
+ (let ((char-add-list nil))
+ (cond ((setf repeat-flag (=> next-command repeat-flag))
+ (setf direct (=> next-command direct))
+ (when (and (= direct (vector-fetch (car state-list) 0))
+ % The direction hasn't changed since the last search.
+ (equal text [""]))
+ (setf repeat-flag nil) % This is not a search for the text last searched for.
+ (setf char-add-list (text2list text-last-searched-for))))
+ (t (setf char-add-list (list (=> next-command char)))))
+ (if repeat-flag
+ (=> self actual-search)
+ % else
+ (for (in current-char char-add-list)
+ (do (setf text (new-text text current-char))
+ (buffer-set-position place)
+ (=> self actual-search)))))
+ (unless (equal text [""]) (setf text-last-searched-for text)))
+
+(defmethod (search-state actual-search) ()
+ % This method does the actual searching for text. It first checks to
+ % see if the search could possibly succeed, which it couldn't if the
+ % search just extends a previously unsuccessful search in the old
+ % direction. This method also stores the location of the start of
+ % the new text and the location at which the user should see the
+ % cursor after the search.
+ (when (or found-flag (~= direct (vector-fetch (car state-list) 0)))
+ % One should search if the last text was found or the direction has changed.
+ (let ((backed-up (when (and repeat-flag (< direct 0))
+ (move-backward-character))))
+ % Avoid jamming at the current string in repeated backward search.
+ (setf found-flag (buffer-text-search? text direct))
+ (when (not found-flag) (ding))
+ (when (and backed-up (not found-flag)) (move-forward-character))))
+ (when found-flag
+ (setf place (buffer-get-position))
+ (if (> direct 0) (move-over-text text))
+ (setf apparent-place (buffer-get-position))) % end of text if forward
+ (buffer-set-position apparent-place)
+ (=> self push))
+
+(defmethod (search-state super-pop) ()
+ % This method pops off all unsuccessful searches or, if the last
+ % search was successful, undoes all the searching.
+ (cond (found-flag (setf state-list (lastpair state-list)) % first state
+ (setf text [""])
+ (setf halt t)
+ (=> self pop))
+ (t (while (not found-flag)
+ (=> self pop))
+ (ding))))
+
+(defmethod (search-state init) ()
+ (=> self prompt)
+ (=> self push))
+
+(defmethod (search-state prompt) ()
+ (update-message text found-flag direct))
+
+(defflavor parsed-char
+ (char halt pop-flag repeat-flag direct)
+ % Char is the next character returned after processing. Halt is a
+ % flag indicating if the searching should halt unconditionally.
+ % Pop-flag indicates whether a delete is being done. Repeat-flag
+ % indicates whether one of the commands (^R and ^S) which trigger
+ % searching for the same text as before (but possibly in a new
+ % direction) has occured. Direct indicates the direction that the
+ % search should take.
+ ()
+ gettable-instance-variables)
+
+(defmethod (parsed-char parse-next-character) ()
+ % This function inputs and parses new characters or commands.
+ (setf char (input-terminal-character))
+ (setf halt nil)
+ (setf pop-flag nil)
+ (setf repeat-flag nil)
+ (let ((up-char (X-Char-Upcase char)))
+ (cond ((= up-char (x-char C-Q))
+ (setf char (input-direct-terminal-character)))
+ ((or (= up-char (x-char Rubout))(= up-char (x-char Backspace)))
+ (setf repeat-flag nil)
+ (setf pop-flag t))
+ ((= up-char (x-char C-G))
+ (setf repeat-flag t)
+ (setf pop-flag t))
+ ((or (= up-char (x-char C-S))(= up-char (x-char C-R)))
+ (setf repeat-flag t)
+ (if (= up-char (x-char C-S))
+ (setf direct +1)
+ (setf direct -1)))
+ ((= up-char (x-char Escape))
+ (setf halt t))
+ ((or (= up-char (x-char Return))(not (X-Control? up-char))))
+ % The last line detects normal characters.
+ (t % normal control character
+ (push-back-input-character char)
+ (setf halt t)))))
+
+(de incr-search (direct)
+ % The main function for the search
+ (let* ((old-msg (write-message ""))
+ (search-at (make-instance 'search-state 'direct direct))
+ (next-command (make-instance 'parsed-char)))
+ (while (continue search-at next-command) % gets and parses next char
+ % The main loop for the search
+ (if (=> next-command pop-flag)
+ (if (=> next-command repeat-flag)
+ (=> search-at super-pop)
+ (=> search-at pop))
+ (=> search-at do-search next-command))
+ (=> search-at prompt))
+ (write-message old-msg))) % This restores the message after the search.
+
+(de continue (search-state parsed-char)
+ % This function parses the next input character, if that is called
+ % for, and determines if the search should continue or be halted. It
+ % returns a boolean value which is true if the search should
+ % continue.
+ (unless
+ (=> search-state halt)
+ (=> parsed-char parse-next-character)
+ (not (=> parsed-char halt))))
+
+(de update-message (text found direct)
+ % This function displays the last line of the search string, whether
+ % it was found, and in what direction the search proceeded.
+ (let* ((line-count (vector-upper-bound text))
+ (last-line (vector-fetch text line-count)))
+ (write-message
+ (string-concat
+ (if found "" "Failing ")
+ (if (> direct 0) "" "Reverse ")
+ "I-search: "
+ last-line))
+ (nmode-refresh)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Start of text handling functions
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-over-text (text)
+ % This function moves point to the end of a chunk of text, assuming
+ % that point is started at the beginning of the text.
+ (let ((line-count (vector-upper-bound text)))
+ (set-line-pos (+ (current-line-pos) line-count))
+ (if (> line-count 0)(move-to-start-of-line))
+ (move-over-characters (string-length (vector-fetch text line-count)))))
+
+(de trim-text (old-text)
+ % This is a pure function, without side effects. It trims one
+ % character or empty line return off the old text. It will not,
+ % however, delete the last null string from a text vector. In that
+ % case it dings and returns the old text.
+ (let* ((line-count (vector-upper-bound old-text))
+ (short-text (sub old-text 0 (- line-count 1)))
+ (last-line (vector-fetch old-text line-count))
+ (last-count (string-length last-line)))
+ (if (> last-count 0)
+ (concat short-text (vector (sub last-line 0 (- last-count 2))))
+ (if (> line-count 0) short-text (Ding) old-text))))
+
+(de new-text (old-text char)
+ % This is a pure function, without side effects. It returns an
+ % updated version of the text vector. It updates the text vector by
+ % adding a new character or a new line.
+ (let* ((line-count (vector-upper-bound old-text))
+ (short-text (sub old-text 0 (- line-count 1)))
+ (last-line (vector-fetch old-text line-count)))
+ (if (= char (x-char Return))
+ (concat old-text [""])
+ (concat short-text
+ (vector (string-concat last-line (string char)))))))
+
+(de text2list (text)
+ % This function converts text into a list of characters, with cursor
+ % returns where the breaks between strings used to be.
+ (append (string2list (vector-fetch text 0))
+ (for (from indx 1 (vector-upper-bound text) 1)
+ (join (cons (x-char return)
+ (string2list (vector-fetch text indx)))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Start of text searching functions
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de buffer-text-search? (text direct)
+ % This function searches in the buffer for the specified text. The
+ % direct is +1 for forward searching and -1 for backward
+ % searching. This function leaves point at the start of the text,
+ % if it is found, and at the old point if the text is not found.
+ % This function returns a boolean, true if it found the text.
+ (let ((current-place (buffer-get-position))
+ (match-rest nil))
+ (while (and (not match-rest)
+ (buffer-search (vector-fetch text 0) direct))
+ (setf match-rest (match-rest-of-text? text))
+ (unless match-rest
+ (if (> direct 0)(move-forward)(move-backward))))
+ (unless match-rest (buffer-set-position current-place))
+ match-rest))
+
+(de match-rest-of-text? (text)
+ % This function determines if two conditions are satified: First,
+ % that all lines in text except the last fill out their respective
+ % lines. Second, that all lines except the first match their
+ % respective lines. This function assumes that point is initially
+ % at the start of a string which matches the first string in text.
+ % It also assumes that text is in upper case. This function returns
+ % a boolean value. It does not move point.
+ (let ((temp nil) % This avoids a compiler bug.
+ (indx 0)
+ (match-rest t)
+ (line (current-line-pos))
+ (char-pos (current-char-pos)))
+ (while (and match-rest (< indx (vector-upper-bound text)))
+ (setf temp (+ char-pos (string-length (vector-fetch text indx))))
+ (setf match-rest
+ (and match-rest % Check filling out of lines.
+ (= temp
+ (string-length (current-buffer-fetch (+ line indx))))))
+ (setf char-pos 0) % Only the first string is set back on its line.
+ (incr indx)
+ (setf match-rest
+ (and match-rest % Check matching of lines.
+ (pattern-matches-in-line
+ (string-upcase (vector-fetch text indx))
+ (current-buffer-fetch (+ line indx)) 0))))
+ (and match-rest (= indx (vector-upper-bound text)))))
ADDED psl-1983/3-1/nmode/indent-commands.sl
Index: psl-1983/3-1/nmode/indent-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/indent-commands.sl
@@ -0,0 +1,226 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Indent-commands.SL - NMODE indenting commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 24 August 1982
+% Revised: 18 February 1983
+%
+% 18-Feb-83 Alan Snyder
+% Removed use of "obsolete" #\ names.
+% 11-Nov-82 Alan Snyder
+% DELETE-INDENTATION-COMMAND (M-^) now obeys command argument.
+% INDENT-CURRENT-LINE now avoids modifying buffer if indentation unchanged.
+% Added INDENT-REGION stuff.
+% General clean-up.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int fast-strings extended-char common))
+(load stringx)
+
+(fluid '(nmode-command-argument
+ nmode-command-argument-given
+ nmode-command-number-given
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Indenting Commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de indent-new-line-command ()
+ (let ((func (dispatch-table-lookup (x-char CR))))
+ (if func (apply func NIL)))
+ (setf nmode-command-argument 1)
+ (setf nmode-command-argument-given NIL)
+ (setf nmode-command-number-given NIL)
+ (let ((func (dispatch-table-lookup (x-char TAB))))
+ (if func (apply func NIL))))
+
+(de tab-to-tab-stop-command ()
+ (for (from i 1 nmode-command-argument)
+ (do (insert-character #\TAB))
+ ))
+
+(de delete-horizontal-space-command ()
+ (while (and (not (at-line-end?)) (char-blank? (next-character)))
+ (delete-next-character)
+ )
+ (while (and (not (at-line-start?)) (char-blank? (previous-character)))
+ (delete-previous-character)
+ )
+ )
+
+(de delete-blank-lines-command ()
+ (cond ((current-line-blank?)
+ % We are on a blank line.
+ % Replace multiple blank lines with one.
+ % First, search backwards for the first blank line
+ % and save its index.
+ (while (not (current-line-is-first?))
+ (move-to-previous-line)
+ (cond ((not (current-line-blank?))
+ (move-to-next-line)
+ (exit))
+ ))
+ (delete-following-blank-lines)
+ )
+ (t
+ % We are on a non-blank line. Delete any blank lines
+ % that follow this one.
+ (delete-following-blank-lines)
+ )
+ ))
+
+(de back-to-indentation-command ()
+ (move-to-start-of-line)
+ (while (char-blank? (next-character))
+ (move-forward)
+ ))
+
+(de delete-indentation-command ()
+ (if nmode-command-argument-given (move-to-next-line))
+ (current-line-strip-indent)
+ (move-to-start-of-line)
+ (when (not (current-line-is-first?))
+ (delete-previous-character)
+ (if (and (not (at-line-start?))
+ (not (= (previous-character) #/( ))
+ (not (= (next-character) #/) ))
+ )
+ (insert-character #\SPACE)
+ )))
+
+(de split-line-command ()
+ (while (char-blank? (next-character))
+ (move-forward))
+ (if (> nmode-command-argument 0)
+ (let ((pos (current-display-column)))
+ (for (from i 1 nmode-command-argument)
+ (do (insert-eol)))
+ (indent-current-line pos)
+ )))
+
+(de indent-region-command ()
+ (if nmode-command-argument-given
+ (indent-region #'indent-to-argument)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Basic Indenting Primitives
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de char-blank? (ch)
+ (or (= ch #\SPACE) (= ch #\TAB)))
+
+(de current-line-indent ()
+ % Return the indentation of the current line, in terms of spaces.
+
+ (let ((line (current-line)))
+ (for* (from i 0 (string-upper-bound line))
+ (with ch)
+ (while (char-blank? (setf ch (string-fetch line i))))
+ (sum (if (= ch #\TAB) 8 1))
+ )))
+
+(de current-line-strip-indent ()
+ % Strip all leading blanks and tabs from the current line.
+
+ (let ((line (current-line)))
+ (for* (from i 0 (string-upper-bound line))
+ (while (char-blank? (string-fetch line i)))
+ (finally
+ (when (> i 0)
+ (set-char-pos (- (current-char-pos) i))
+ (current-line-replace (string-rest line i))
+ ))
+ )))
+
+(de strip-previous-blanks ()
+ % Strip all blanks and tabs before point.
+ (while (and (not (at-buffer-start?))
+ (char-blank? (previous-character)))
+ (delete-previous-character)
+ ))
+
+(de indent-current-line (n)
+ % Adjust the current line to have the specified indentation.
+
+ (when (and (~= n (current-line-indent)) (>= n 0))
+ (current-line-strip-indent)
+ (let ((n-spaces (remainder n 8))
+ (n-tabs (quotient n 8))
+ (line (current-line))
+ (cp (current-char-pos))
+ )
+ (for (from i 1 n-spaces)
+ (do (setf line (string-concat #.(string #\SPACE) line))
+ (setf cp (+ 1 cp))))
+ (for (from i 1 n-tabs)
+ (do (setf line (string-concat #.(string #\TAB) line))
+ (setf cp (+ 1 cp))))
+ (current-line-replace line)
+ (set-char-pos cp)
+ )))
+
+(de delete-following-blank-lines ()
+
+ % Delete any blank lines that immediately follow the current one.
+
+ (if (not (current-line-is-last?))
+ (let ((old-pos (buffer-get-position))
+ first-pos
+ )
+ % Advance past the current line until the next nonblank line.
+ (move-to-next-line)
+ (setf first-pos (buffer-get-position))
+ (while (and (not (at-buffer-end?)) (current-line-blank?))
+ (move-to-next-line))
+ (extract-region T first-pos (buffer-get-position))
+ (buffer-set-position old-pos)
+ )))
+
+(de indent-to-argument ()
+ % Indent the current line to the position specified by nmode-command-argument.
+ (indent-current-line nmode-command-argument)
+ )
+
+(de indent-region (indenting-function)
+ % Indent the lines whose first characters are between point and mark.
+ % Attempt to adjust point and mark appropriately should their lines
+ % be re-indented. The function INDENTING-FUNCTION is called to indent
+ % the current line.
+
+ (let* ((point (buffer-get-position))
+ (mark (current-mark))
+ (bp1 point)
+ (bp2 mark)
+ )
+ (if (< 0 (buffer-position-compare bp1 bp2))
+ (psetf bp1 mark bp2 point))
+ (let ((first-line (buffer-position-line bp1))
+ (last-line (buffer-position-line bp2))
+ )
+ (if (> (buffer-position-column bp1) 0)
+ (setf first-line (+ first-line 1)))
+ (for (from i first-line last-line)
+ (do
+ (set-line-pos i)
+ (cond
+ ((= i (buffer-position-line point))
+ (set-char-pos (buffer-position-column point)))
+ ((= i (buffer-position-line mark))
+ (set-char-pos (buffer-position-column mark)))
+ )
+ (apply indenting-function ())
+ (cond
+ ((= i (buffer-position-line point))
+ (setf point (buffer-position-create i (current-char-pos))))
+ ((= i (buffer-position-line mark))
+ (setf mark (buffer-position-create i (current-char-pos))))
+ ))))
+ (previous-mark) % pop off old mark
+ (set-mark mark) % push (possibly adjusted) mark
+ (buffer-set-position point)
+ ))
ADDED psl-1983/3-1/nmode/kill-commands.sl
Index: psl-1983/3-1/nmode/kill-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/kill-commands.sl
@@ -0,0 +1,494 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Kill-Commands.SL - NMODE Kill and Delete commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 August 1982
+% Revised: 16 November 1982
+%
+% 16-Nov-82 Alan Snyder
+% Modified C-Y and M-Y to obey comamnd argument.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-vectors fast-int))
+(load gsort)
+
+(fluid '(nmode-current-buffer nmode-command-argument
+ nmode-command-argument-given nmode-command-number-given
+ nmode-previous-command-killed nmode-command-killed
+ ))
+
+% Internal static variables:
+
+(fluid '(nmode-kill-ring))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-initialize-kill-ring ()
+ (setf nmode-kill-ring (ring-buffer-create 16))
+ (setf nmode-command-killed NIL)
+ )
+
+(de insert-kill-buffer ()
+ % Insert the specified "kill buffer" into the buffer at the current location.
+ (cond
+ ((<= nmode-command-argument 0)
+ (Ding))
+ (nmode-command-number-given
+ (insert-from-kill-ring (+ (- nmode-command-argument) 1) NIL))
+ (nmode-command-argument-given
+ (insert-from-kill-ring 0 T))
+ (t
+ (insert-from-kill-ring 0 NIL))
+ ))
+
+(de insert-from-kill-ring (index flip-positions)
+ (insert-text-safely (=> nmode-kill-ring fetch index) flip-positions)
+ )
+
+(de insert-text-safely (text flip-positions)
+ (cond (text
+ (=> nmode-current-buffer set-mark-from-point)
+ (insert-text text)
+ (when flip-positions (exchange-point-and-mark))
+ )
+ (t (Ding))
+ ))
+
+(de safe-to-unkill ()
+ % Return T if the current region contains the same text as the current
+ % kill buffer.
+
+ (let ((killed-text (ring-buffer-top nmode-kill-ring))
+ (region (extract-text NIL (buffer-get-position) (current-mark)))
+ )
+ (and killed-text (text-equal killed-text region))
+ ))
+
+(de unkill-previous ()
+ % Delete (without saving away) the current region, and then unkill (yank) the
+ % specified entry in the kill ring. "Ding" if the current region does not
+ % contain the same text as the current entry in the kill ring.
+
+ (cond ((not (safe-to-unkill))
+ (Ding))
+ ((= nmode-command-argument 0)
+ (extract-region T (buffer-get-position) (current-mark)))
+ (t
+ (extract-region T (buffer-get-position) (current-mark))
+ (=> nmode-kill-ring rotate (- nmode-command-argument))
+ (insert-from-kill-ring 0 NIL)
+ )
+ ))
+
+(de update-kill-buffer (kill-info)
+ % Update the "kill buffer", either appending/prepending to the current
+ % buffer, or "pushing" the kill ring, as appropriate. kill-info is a pair,
+ % the car of which is +1 if the text was "forward killed", and -1 if
+ % "backwards killed". The cdr is the actual text (a vector of strings).
+
+ (let ((killed-text (cdr kill-info))
+ (dir (car kill-info))
+ )
+ (if (not nmode-previous-command-killed)
+ % If previous command wasn't a kill, then "push" the new text.
+ (ring-buffer-push nmode-kill-ring killed-text)
+ % Otherwise, append or prepend the text, as appropriate.
+ (let ((text (ring-buffer-top nmode-kill-ring)))
+ % Swap the two pieces of text if deletion was "backwards".
+ (if (< dir 0) (psetf text killed-text killed-text text))
+ % Replace text with the concatenation of the two.
+ (ring-buffer-pop nmode-kill-ring)
+ (ring-buffer-push nmode-kill-ring (text-append text killed-text))
+ ))))
+
+(de text-append (t1 t2)
+ % Append two text-vectors.
+ % The last line of T1 is concatenated with the first line of T2.
+ (let ((text (MkVect (+ (vector-upper-bound t1) (vector-upper-bound t2))))
+ (ti 0) % index into TEXT
+ )
+ (for (from i 0 (- (vector-upper-bound t1) 1))
+ (do (vector-store text ti (vector-fetch t1 i))
+ (setf ti (+ ti 1))
+ ))
+ (vector-store text ti
+ (string-concat (vector-fetch t1 (vector-upper-bound t1))
+ (vector-fetch t2 0)))
+ (setf ti (+ ti 1))
+ (for (from i 1 (vector-upper-bound t2))
+ (do (vector-store text ti (vector-fetch t2 i))
+ (setf ti (+ ti 1))
+ ))
+ text))
+
+(de text-equal (t1 t2)
+ % Compare two text vectors for equality.
+ (let ((limit (vector-upper-bound t1)))
+ (and (= limit (vector-upper-bound t2))
+ (for (from i 0 limit)
+ (always (string= (vector-fetch t1 i) (vector-fetch t2 i)))
+ ))))
+
+(de kill-region ()
+ % Kill (and save in kill buffer) the region between point and mark.
+ (update-kill-buffer (extract-region T (buffer-get-position) (current-mark)))
+ (setf nmode-command-killed T)
+ )
+
+(de copy-region ()
+ (update-kill-buffer (extract-region NIL (buffer-get-position) (current-mark)))
+ )
+
+(de append-to-buffer-command ()
+ (let* ((text (cdr (extract-region NIL (buffer-get-position) (current-mark))))
+ (b (prompt-for-buffer "Append Region to Buffer: " NIL))
+ )
+ (=> b insert-text text)
+ ))
+
+(de prompt-for-register-name (prompt)
+ % Prompt for the name of a "Register", which must be a letter
+ % or a digit. Return the corresponding Lisp Symbol. Return NIL
+ % if an invalid name is given.
+
+ (nmode-set-delayed-prompt prompt)
+ (let ((ch (input-base-character)))
+ (cond ((AlphaNumericP ch)
+ (intern (string-concat "nmode-register-" (string ch))))
+ (t (Ding) NIL))))
+
+(de put-register-command ()
+ (let ((register (prompt-for-register-name
+ (if nmode-command-argument-given
+ "Withdraw Region to Register: "
+ "Copy Region to Register: "))))
+ (cond (register
+ (set register (cdr (extract-region nmode-command-argument-given
+ (buffer-get-position)
+ (current-mark))))
+ ))))
+
+(de get-register-command ()
+ (let ((register (prompt-for-register-name "Insert from Register: "))
+ (old-pos (buffer-get-position))
+ )
+ (cond (register
+ (cond ((BoundP register)
+ (insert-text (ValueCell register))
+ (set-mark-from-point)
+ (buffer-set-position old-pos)
+ (if nmode-command-argument-given
+ (exchange-point-and-mark))
+ )
+ (t (Ding))
+ )))))
+
+(de append-next-kill-command ()
+ (if (ring-buffer-top nmode-kill-ring) % If there is a kill buffer...
+ (setf nmode-command-killed T)
+ ))
+
+(de kill-line ()
+ (let ((old-pos (buffer-get-position)))
+ (if nmode-command-argument-given
+ (cond ((> nmode-command-argument 0)
+ % Kill through that many line terminators
+ (for (from i 1 nmode-command-argument)
+ (do (move-to-next-line)))
+ )
+ ((= nmode-command-argument 0)
+ % Kill preceding text on this line
+ (move-to-start-of-line)
+ )
+ (t
+ % Kill through that many previous line starts
+ % This line counts only if we are not at the beginning of it.
+ (if (not (at-line-start?))
+ (progn
+ (move-to-start-of-line)
+ (setf nmode-command-argument (+ nmode-command-argument 1))
+ ))
+ (for (from i 1 (- nmode-command-argument))
+ (do (move-to-previous-line)))
+ ))
+ % else (no argument given)
+ (while (char-blank? (next-character))
+ (move-forward))
+ (if (at-line-end?)
+ (move-to-next-line)
+ (move-to-end-of-line)
+ )
+ )
+ (update-kill-buffer (extract-region T old-pos (buffer-get-position)))
+ (setf nmode-command-killed T)
+ ))
+
+(de kill-forward-word-command ()
+ (delete-words nmode-command-argument)
+ (setf nmode-command-killed T)
+ )
+
+(de kill-backward-word-command ()
+ (delete-words (- nmode-command-argument))
+ (setf nmode-command-killed T)
+ )
+
+(de kill-forward-form-command ()
+ (delete-forms nmode-command-argument)
+ (setf nmode-command-killed T)
+ )
+
+(de kill-backward-form-command ()
+ (delete-forms (- nmode-command-argument))
+ (setf nmode-command-killed T)
+ )
+
+(de delete-backward-character-command ()
+ (cond
+ (nmode-command-argument-given
+ (delete-characters (- nmode-command-argument))
+ (setf nmode-command-killed T))
+ (t
+ (if (at-buffer-start?)
+ (Ding)
+ (delete-previous-character)
+ ))))
+
+(de delete-forward-character-command ()
+ (cond
+ (nmode-command-argument-given
+ (delete-characters nmode-command-argument)
+ (setf nmode-command-killed T))
+ (t
+ (if (at-buffer-end?)
+ (Ding)
+ (delete-next-character)
+ ))))
+
+(de delete-backward-hacking-tabs-command ()
+ (cond
+ (nmode-command-argument-given
+ (delete-characters-hacking-tabs (- nmode-command-argument))
+ (setf nmode-command-killed T))
+ (t
+ (if (at-buffer-start?)
+ (Ding)
+ (move-backward-character-hacking-tabs)
+ (delete-next-character)
+ ))))
+
+(de transpose-words ()
+ (let ((old-pos (buffer-get-position)))
+ (cond ((not (attempt-to-transpose-words nmode-command-argument))
+ (Ding)
+ (buffer-set-position old-pos)
+ ))))
+
+(de attempt-to-transpose-words (n)
+ % Returns non-NIL if successful.
+ (prog (bp1 bp2 bp3 bp4 word1 word2)
+ (cond ((= n 0)
+ (setf bp1 (buffer-get-position))
+ (if (not (move-forward-word)) (return NIL))
+ (setf bp2 (buffer-get-position))
+ (buffer-set-position (current-mark))
+ (setf bp3 (buffer-get-position))
+ (if (not (move-forward-word)) (return NIL))
+ (setf bp4 (buffer-get-position))
+ (exchange-regions bp3 bp4 bp1 bp2)
+ (move-backward-word)
+ )
+ (t
+ (if (not (move-backward-word)) (return NIL))
+ (setf bp1 (buffer-get-position))
+ (if (not (move-forward-word)) (return NIL))
+ (setf bp2 (buffer-get-position))
+ (if (not (move-over-words (if (< n 0) (- n 1) n))) (return NIL))
+ (setf bp4 (buffer-get-position))
+ (if (not (move-over-words (- 0 n))) (return NIL))
+ (setf bp3 (buffer-get-position))
+ (exchange-regions bp1 bp2 bp3 bp4)
+ ))
+ (return T)
+ ))
+
+(de transpose-lines ()
+ (let ((old-pos (buffer-get-position)))
+ (cond ((not (attempt-to-transpose-lines nmode-command-argument))
+ (Ding)
+ (buffer-set-position old-pos)
+ ))))
+
+(de attempt-to-transpose-lines (n)
+ % Returns non-NIL if successful.
+ (prog (bp1 bp2 bp3 bp4 line1 line2 current marked last)
+ (setf current (current-line-pos))
+ (setf last (- (current-buffer-size) 1))
+ % The last line doesn't count, because it is unterminated.
+ (setf marked (buffer-position-line (current-mark)))
+ (cond ((= n 0)
+ (if (or (>= current last) (>= marked last)) (return NIL))
+ (setf bp1 (buffer-position-create current 0))
+ (setf bp2 (buffer-position-create (+ current 1) 0))
+ (setf bp3 (buffer-position-create marked 0))
+ (setf bp4 (buffer-position-create (+ marked 1) 0))
+ (exchange-regions bp3 bp4 bp1 bp2)
+ (move-to-previous-line)
+ )
+ (t
+ % Dragged line is the previous one.
+ (if (= current 0) (return NIL))
+ (setf bp1 (buffer-position-create (- current 1) 0))
+ (setf bp2 (buffer-position-create current 0))
+ (setf marked (- (+ current n) 1))
+ (if (or (< marked 0) (>= marked last)) (return NIL))
+ (setf bp3 (buffer-position-create marked 0))
+ (setf bp4 (buffer-position-create (+ marked 1) 0))
+ (exchange-regions bp1 bp2 bp3 bp4)
+ ))
+ (return T)
+ ))
+
+(de transpose-forms ()
+ (let ((old-pos (buffer-get-position)))
+ (cond ((not (attempt-to-transpose-forms nmode-command-argument))
+ (Ding)
+ (buffer-set-position old-pos)
+ ))))
+
+(de attempt-to-transpose-forms (n)
+ % Returns non-NIL if successful.
+ (prog (bp1 bp2 bp3 bp4 form1 form2)
+ (cond ((= n 0)
+ (setf bp1 (buffer-get-position))
+ (if (not (move-forward-form)) (return NIL))
+ (setf bp2 (buffer-get-position))
+ (buffer-set-position (current-mark))
+ (setf bp3 (buffer-get-position))
+ (if (not (move-forward-form)) (return NIL))
+ (setf bp4 (buffer-get-position))
+ (exchange-regions bp3 bp4 bp1 bp2)
+ (move-backward-form)
+ )
+ (t
+ (if (not (move-backward-form)) (return NIL))
+ (setf bp1 (buffer-get-position))
+ (if (not (move-forward-form)) (return NIL))
+ (setf bp2 (buffer-get-position))
+ (if (not (move-over-forms (if (< n 0) (- n 1) n))) (return NIL))
+ (setf bp4 (buffer-get-position))
+ (if (not (move-over-forms (- 0 n))) (return NIL))
+ (setf bp3 (buffer-get-position))
+ (exchange-regions bp1 bp2 bp3 bp4)
+ ))
+ (return T)
+ ))
+
+(de transpose-regions ()
+ (let ((old-pos (buffer-get-position)))
+ (cond ((not (attempt-to-transpose-regions nmode-command-argument))
+ (Ding)
+ (buffer-set-position old-pos)
+ ))))
+
+(de attempt-to-transpose-regions (n)
+ % Returns non-NIL if successful.
+ % Transpose regions defined by cursor and three most recent marks.
+ % EMACS resets all of the marks; we just reset the cursor to the
+ % end of the higher region.
+
+ (prog (bp1 bp2 bp3 bp4 bp-list)
+ (setf bp1 (buffer-get-position))
+ (setf bp2 (current-mark))
+ (setf bp3 (previous-mark))
+ (setf bp4 (previous-mark))
+ (previous-mark)
+ (setf bp-list (list bp1 bp2 bp3 bp4))
+ (gsort bp-list (function buffer-position-lessp))
+ (exchange-regions (first bp-list)
+ (second bp-list)
+ (third bp-list)
+ (fourth bp-list))
+ (buffer-set-position (fourth bp-list))
+ (return T)
+ ))
+
+% Support functions:
+
+(de delete-characters (n)
+ (let ((old-pos (buffer-get-position)))
+ (move-over-characters n)
+ (update-kill-buffer
+ (extract-region T old-pos (buffer-get-position)))
+ ))
+
+(de delete-characters-hacking-tabs (n)
+
+ % Note: EMACS doesn't try to hack tabs when deleting forward.
+ % We do, but it's a crock. What should really happen is that all
+ % consecutive tabs are converted to spaces.
+
+ (cond ((< n 0)
+ % Deleting backwards is tricky because the conversion of tabs to
+ % spaces may change the numeric value of the original "position".
+ % Our solution is to first move backwards the proper number of
+ % characters (converting tabs to spaces), and then move back over them.
+
+ (let ((count (- n)))
+ (setf n 0)
+ (while (and (> count 0)
+ (move-backward-character-hacking-tabs))
+ (setf count (- count 1))
+ (setf n (- n 1))
+ )
+ (move-over-characters (- n))
+ )))
+
+ (let ((old-pos (buffer-get-position)))
+ (move-over-characters-hacking-tabs n)
+ (update-kill-buffer
+ (extract-region T old-pos (buffer-get-position)))
+ ))
+
+(de delete-words (n)
+ (let ((old-pos (buffer-get-position)))
+ (move-over-words n)
+ (update-kill-buffer
+ (extract-region T old-pos (buffer-get-position)))
+ ))
+
+(de delete-forms (n)
+ (let ((old-pos (buffer-get-position)))
+ (move-over-forms n)
+ (update-kill-buffer
+ (extract-region T old-pos (buffer-get-position)))
+ ))
+
+(de exchange-regions (bp1 bp2 bp3 bp4)
+ % The specified positions define two regions: R1=<BP1,BP2> and
+ % R2=<BP3,BP4>. These regions should not overlap, unless they
+ % are identical. The contents of the two regions will be exchanged.
+ % The cursor will be moved to the right of the region R1 (in its new
+ % position).
+
+ (let ((dir (buffer-position-compare bp1 bp3))
+ (r1 (cdr (extract-region NIL bp1 bp2)))
+ (r2 (cdr (extract-region NIL bp3 bp4)))
+ )
+ (cond ((< dir 0) % R1 is before R2
+ (extract-region T bp3 bp4)
+ (insert-text r1)
+ (extract-region T bp1 bp2)
+ (insert-text r2)
+ (buffer-set-position bp4)
+ )
+ ((> dir 0) % R2 is before R1
+ (extract-region T bp1 bp2)
+ (insert-text r2)
+ (extract-region T bp3 bp4)
+ (insert-text r1)
+ ))
+ ))
ADDED psl-1983/3-1/nmode/lisp-commands.sl
Index: psl-1983/3-1/nmode/lisp-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/lisp-commands.sl
@@ -0,0 +1,112 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Lisp-Commands.SL - Miscellaneous NMODE Lisp-related commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 12 November 1982
+% Revised: 18 February 1983
+%
+% 18-Feb-83 Alan Snyder
+% Rename down-list to down-list-command; extend to obey the command argument.
+% Rename insert-parens to make-parens-command; extend to obey the command
+% argument and to insert a space if needed (like EMACS). Rename
+% move-over-paren to move-over-paren-command; revise to follow EMACS more
+% closely. Remove use of "obsolete" #\ names.
+% 12-Nov-82 Alan Snyder
+% This file is the result of a complete rewrite of the Lisp stuff. The only
+% things that remain in this file are those things that don't fit in elsewhere.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int))
+
+(fluid '(nmode-command-argument
+ nmode-command-argument-given
+ nmode-current-command
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de insert-closing-bracket ()
+ % Insert a closing bracket, then display the matching opening bracket.
+ (if (not (fixp nmode-current-command))
+ (Ding)
+ % otherwise
+ (for (from i 1 nmode-command-argument)
+ (do (insert-character nmode-current-command)))
+ (display-matching-opener)
+ ))
+
+(de down-list-command ()
+ % Move inside the next or previous contained list. If the command argument
+ % is positive, move forward past the next open bracket without an
+ % intervening close bracket. If the command argument is negative, move
+ % backward to the next previous close bracket without an intervening open
+ % bracket. If the specified bracket cannot be found, Ding, but do not move.
+
+ % Note: this command differs from the EMACS Down-List command in that it
+ % always stays within the current list. The EMACS command moves forward
+ % as far as needed to find a list at the next lower level.
+
+ (if (> nmode-command-argument 0)
+ (for (from i 1 nmode-command-argument)
+ (do (when (not (move-forward-down-list)) (Ding) (exit))))
+ (for (from i 1 (- nmode-command-argument))
+ (do (when (not (move-backward-down-list)) (Ding) (exit))))
+ ))
+
+(de make-parens-command ()
+ % Insert a space if it looks like we need one. Insert an open paren. Skip
+ % forward over the requested number of forms, if any. Insert a close paren.
+ % Move back to the open paren.
+
+ (when (not (at-line-start?))
+ (let ((ch (previous-character)))
+ (when (and (not (char-blank? ch)) (not (= ch #/( )))
+ (insert-character #\Space)
+ )))
+ (insert-character #/( )
+ (let ((old-pos (buffer-get-position)))
+ (when nmode-command-argument-given
+ (if (or (<= nmode-command-argument 0)
+ (not (move-over-forms nmode-command-argument)))
+ (Ding)))
+ (insert-character #/) )
+ (buffer-set-position old-pos)
+ ))
+
+(de move-over-paren-command ()
+ % Move forward past N closing brackets at any level. Delete any indentation
+ % before the first closing bracket found. Insert an end of line after the
+ % last closing bracket found and indent the new line. Aside: This
+ % definition follows EMACS. I don't understand the motivation for this way
+ % of interpreting the command argument.
+
+ (if (<= nmode-command-argument 0)
+ (Ding)
+ (for (from i 1 nmode-command-argument)
+ (do
+ (when (not (forward-scan-for-right-paren 10000))
+ (when (> i 1)
+ (insert-eol)
+ (lisp-indent-current-line)
+ )
+ (Ding)
+ (exit)
+ )
+ (when (= i 1)
+ (move-backward-item)
+ (strip-previous-blanks)
+ (move-forward-item)
+ )
+ (when (= i nmode-command-argument)
+ (insert-eol)
+ (lisp-indent-current-line)
+ )
+ ))))
+
+(de insert-comment-command ()
+ (move-to-end-of-line)
+ (insert-string "% ")
+ )
ADDED psl-1983/3-1/nmode/lisp-indenting.sl
Index: psl-1983/3-1/nmode/lisp-indenting.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/lisp-indenting.sl
@@ -0,0 +1,216 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Lisp-Indenting.SL - NMODE Lisp Indenting commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 25 August 1982
+% Revised: 12 November 1982
+%
+% 25-Feb-83 Alan Snyder
+% Move-down-list renamed to Move-forward-down-list.
+% 12-Nov-82 Alan Snyder
+% Improved indenting using new structure-movement primitives.
+% Changed multi-line indenting commands to clear any blank lines.
+% Added LISP-INDENT-REGION-COMMAND.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int fast-vectors))
+
+(fluid '(nmode-command-argument nmode-command-argument-given))
+
+(de lisp-tab-command ()
+ (cond (nmode-command-argument-given
+ (let ((n nmode-command-argument))
+ (cond ((< n 0)
+ (let ((last-line (- (current-line-pos) 1)))
+ (set-line-pos (+ (current-line-pos) n))
+ (let ((first-line (current-line-pos)))
+ (while (<= (current-line-pos) last-line)
+ (lisp-indent-or-clear-current-line)
+ (move-to-next-line)
+ )
+ (current-buffer-goto first-line 0)
+ )))
+ ((> n 0)
+ (while (> n 0)
+ (lisp-indent-or-clear-current-line)
+ (move-to-next-line)
+ (if (at-buffer-end?) (exit))
+ (setf n (- n 1))
+ ))
+ (t
+ (lisp-indent-current-line)
+ (move-to-start-of-line)
+ ))))
+ (t (lisp-indent-current-line))))
+
+(de lisp-indent-current-line ()
+ (indent-current-line (lisp-current-line-indent)))
+
+(de lisp-indent-or-clear-current-line ()
+ (indent-current-line
+ (if (current-line-blank?)
+ 0
+ (lisp-current-line-indent))))
+
+(de lisp-indent-sexpr ()
+ (if (not (move-forward-down-list)) % Find next open bracket
+ (Ding) % None found
+ % otherwise
+ (move-backward-item) % Move back to the open bracket
+ (let ((old-line (current-line-pos))
+ (old-point (current-char-pos))
+ )
+ (if (not (move-forward-form)) % Find end of form
+ (Ding) % No matching close bracket found
+ % otherwise
+ (for (from i (+ old-line 1) (current-line-pos))
+ (do
+ (set-line-pos i)
+ (lisp-indent-or-clear-current-line)
+ ))
+ (current-buffer-goto old-line old-point)
+ ))))
+
+(de lisp-indent-region-command ()
+ (if nmode-command-argument-given
+ (indent-region #'indent-to-argument)
+ (indent-region #'lisp-indent-or-clear-current-line)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Basic Indenting Primitive
+%
+% This function determines what indentation the current line should receive.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de lisp-current-line-indent ()
+ % Return the desired indentation for the current line.
+ % Point is unchanged.
+ (let ((old-pos (buffer-get-position)))
+ (unwind-protect
+ (unsafe-lisp-current-line-indent)
+ (buffer-set-position old-pos)
+ )))
+
+(de unsafe-lisp-current-line-indent ()
+ % Return the desired indentation for the current line.
+ % Point may change.
+ (move-to-start-of-line)
+ (let ((item (move-backward-form))
+ (number-of-forms 0)
+ (leftmost-form-type NIL)
+ )
+ % If there are multiple forms at the same level of nesting
+ % on the same line, we want to find the left-most one.
+ (while (or (eq item 'ATOM) (eq item 'STRUCTURE))
+ (setf number-of-forms (+ number-of-forms 1))
+ (setf leftmost-form-type item)
+ (let ((next-item (move-backward-form-within-line)))
+ (if (not next-item) (exit)) % We have the first item on the line.
+ (setf item next-item)
+ ))
+ (selectq item
+ ((ATOM STRUCTURE) (current-display-column)) % Line up with form.
+ (OPENER (lisp-indent-under-paren leftmost-form-type number-of-forms))
+ (t 0) % There is no previous form.
+ )))
+
+(de lisp-indent-under-paren (leftmost-form-type number-of-forms)
+ % This function is called to determine the indentation for a line
+ % that immediately follows (i.e., there is no intervening line
+ % containing a form) the line containing the open paren that
+ % begins the nesting level for the line being indented. This
+ % function is called with the current position being at the open
+ % paren. NUMBER-OF-FORMS specifies the number of forms that
+ % follow the open paren on its line. LEFTMOST-FORM-TYPE specifies
+ % the type of the first such form (either ATOM, STRUCTURE, or NIL).
+
+ (skip-prefixes) % Skip over any "prefix characters" (like ' in Lisp).
+ (let ((paren-column (current-display-column))
+ the-atom pos1 pos2 atom-text atom-string second-column
+ )
+ (if (not (eq leftmost-form-type 'ATOM))
+ (+ paren-column 1)
+ % Otherwise
+ (move-forward-item) % Move past the paren.
+ (setf pos1 (buffer-get-position))
+ (move-forward-form) % Move past the first form.
+ (setf pos2 (buffer-get-position))
+ (setf atom-text (extract-text NIL pos1 pos2))
+ (setf atom-string (string-upcase (vector-fetch atom-text 0)))
+ (if (internp atom-string) (setf the-atom (intern atom-string)))
+ (when (> number-of-forms 1)
+ (move-forward-form)
+ (move-backward-form)
+ (setf second-column (current-display-column))
+ )
+ (lisp-indent-under-atom
+ the-atom paren-column second-column number-of-forms)
+ )))
+
+(de lisp-indent-under-atom (the-id paren-column
+ second-column number-of-forms)
+ % This function is called to determine the indentation for a line
+ % that immediately follows (i.e., there is no intervening line
+ % containing a form) the line containing the open paren that
+ % begins the nesting level for the line being indented.
+ % The open paren is followed on the same line by at least one form
+ % that is not a structure.
+ % NUMBER-OF-FORMS specifies the number of forms that
+ % follow the open paren on its line. If there are two or more forms,
+ % then SECOND-COLUMN is the display column of the second form;
+ % otherwise, SECOND-COLUMN is NIL. If the first
+ % form is recognized as being an
+ % interned ID, then THE-ID is that ID; otherwise, THE-ID is NIL.
+ % PAREN-COLUMN is the display column of the open paren.
+
+ (or
+ (if the-id (id-specific-indent the-id paren-column second-column))
+ second-column
+ (+ paren-column 1)
+ ))
+
+(put 'prog 'indentation 2)
+(put 'lambda 'indentation 2)
+(put 'lambdaq 'indentation 2)
+(put 'while 'indentation 2)
+(put 'de 'indentation 2)
+(put 'defun 'indentation 2)
+(put 'defmacro 'indentation 2)
+(put 'df 'indentation 2)
+(put 'dm 'indentation 2)
+(put 'dn 'indentation 2)
+(put 'ds 'indentation 2)
+(put 'let 'indentation 2)
+(put 'let* 'indentation 2)
+(put 'if 'indentation 2)
+(put 'when 'indentation 2)
+(put 'unless 'indentation 2)
+(put 'defmethod 'indentation 2)
+(put 'defflavor 'indentation 2)
+(put 'selectq 'indentation 2)
+(put 'catch 'indentation 2)
+(put 'catch-all 'indentation 2)
+(put 'setf 'indentation 2)
+(put 'setq 'indentation 2)
+
+(de id-specific-indent (id paren-column second-column)
+
+ % The default indentation for a pattern like this:
+ % .... (foo bar ...
+ % bletch ...
+ % is to line up bletch with bar. This pattern applies when FOO
+ % is an atom (not a structure) and there is at least one
+ % form (e.g. BAR) following it on the same line. This function
+ % is used to specify exceptions to this rule. It is invoked
+ % only when FOO is an INTERNed ID, since the exceptions are
+ % defined by putting a property on the ID.
+
+ (let ((indent (get id 'indentation)))
+ (if indent (+ paren-column indent))
+ ))
ADDED psl-1983/3-1/nmode/lisp-interface.sl
Index: psl-1983/3-1/nmode/lisp-interface.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/lisp-interface.sl
@@ -0,0 +1,342 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% LISP-Interface.SL - NMODE Lisp Text Execution Interface
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 August 1982
+% Revised: 28 February 1983
+%
+% Adapted from Will Galway's EMODE
+%
+% 28-Feb-83 Alan Snyder
+% Change nmode-main to initially call leave-raw-mode. This is to make NMODE
+% refresh the display automatically when it is restarted.
+% 14-Feb-83 Alan Snyder
+% Added statement to flush output buffer cache.
+% 2-Feb-83 Alan Snyder
+% Added Execute-Defun-Command. Change to supply the free EOL at the end of
+% the input buffer whenever the buffer-modified flag is set, instead of only
+% when currently at the end of the buffer.
+% 25-Jan-83 Alan Snyder
+% Check terminal type after resuming.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects))
+
+(fluid '(nmode-current-buffer
+ nmode-output-buffer
+ nmode-terminal
+ nmode-initialized
+ *NMODE-RUNNING
+ *GC
+ LispBanner*
+ *RAWIO
+ *nmode-init-running
+ *nmode-init-has-run
+ nmode-terminal-input-buffer
+ nmode-default-init-file-name
+ nmode-auto-start
+ nmode-first-start
+ ))
+
+(setf *NMODE-RUNNING NIL)
+(setf *nmode-init-running NIL)
+(setf *nmode-init-has-run NIL)
+(setf nmode-default-init-file-name "PSL:NMODE.INIT")
+(setf nmode-auto-start NIL)
+(setf nmode-first-start T)
+
+(fluid '(
+ nmode-buffer-channel % Channel used for NMODE I/O.
+ nmode-output-start-position % Where most recent "output" started in buffer.
+ nmode-output-end-position % Where most recent "output" ended in buffer.
+ OldStdIn
+ OldStdOut
+ OldErrOut
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de yank-last-output-command ()
+ % Insert "last output" typed in the OUTPUT buffer. Output is demarked by
+ % NMODE-OUTPUT-START-POSITION and NMODE-OUTPUT-END-POSITION.
+
+ (if (not nmode-output-start-position)
+ (Ding)
+ % Otherwise
+ (let ((text (=> nmode-output-buffer
+ extract-region
+ NIL
+ nmode-output-start-position
+ (or nmode-output-end-position
+ (buffer-position-create (=> nmode-output-buffer size) 0)
+ )
+ )))
+ (=> nmode-current-buffer insert-text (cdr text))
+ )))
+
+(de execute-form-command ()
+ % Execute starting at the beginning of the current line.
+
+ (set-mark-from-point) % in case the user wants to come back
+ (move-to-start-of-line)
+ (execute-from-buffer)
+ )
+
+(de execute-defun-command ()
+ % Execute starting at the beginning of the current defun (if the current
+ % position is within a defun) or from the current position (otherwise).
+
+ (set-mark-from-point) % in case the user wants to come back
+ (move-to-start-of-current-defun)
+ (execute-from-buffer)
+ )
+
+(de make-buffer-terminated ()
+ % If the current buffer ends with an "unterminated" line, add an EOL to
+ % terminate it.
+
+ (let ((old-pos (buffer-get-position)))
+ (move-to-buffer-end)
+ (when (not (current-line-empty?)) (insert-eol))
+ (buffer-set-position old-pos)
+ ))
+
+(de execute-from-buffer ()
+ % Causes NMODE to return to the procedure that called it (via
+ % nmode-channel-editor) with input redirected to come from the (now) current
+ % buffer. We arrange for output to go to the end of the output buffer.
+
+ (if (=> nmode-current-buffer modified?) (make-buffer-terminated))
+ (buffer-channel-set-input-buffer nmode-buffer-channel nmode-current-buffer)
+
+ % Output will go to end of the output buffer. Supply a free EOL if the last
+ % line is unterminated. Record the current end-of-buffer for later use by
+ % Lisp-Y.
+
+ (let ((old-pos (=> nmode-output-buffer position)))
+ (=> nmode-output-buffer move-to-buffer-end)
+ (if (not (=> nmode-output-buffer current-line-empty?))
+ (=> nmode-output-buffer insert-eol))
+ (setf nmode-output-start-position (=> nmode-output-buffer position))
+ (=> nmode-output-buffer set-position old-pos)
+ )
+
+ % Set things up to read from and write to NMODE buffers.
+ (nmode-select-buffer-channel)
+ (exit-nmode-reader)
+ )
+
+(de nmode-exit-to-superior ()
+ (if (not *NMODE-RUNNING)
+ (original-quit)
+ % else
+ (leave-raw-mode) % Turn echoing back on. Next refresh is FULL.
+ (original-quit)
+ (enter-raw-mode) % Turn echoing off.
+ (nmode-set-terminal) % Ensure proper terminal driver is loaded.
+ ))
+
+% Redefine QUIT so that it restores the terminal to echoing before exiting.
+(when (FUnboundP 'original!-quit)
+ (CopyD 'original!-quit 'quit)
+ (CopyD 'quit 'nmode-exit-to-superior)
+ )
+
+(de emode () (nmode)) % for user convenience
+
+(de nmode ()
+
+ % Rebind the PSL input channel to the NMODE buffer channel and return. This
+ % will cause the next READ to invoke Nmode-Channel-Editor and start running
+ % NMODE. Use the function "exit-nmode" to switch back to original channels.
+
+ (nmode-initialize) % does nothing if already initialized
+ (when (neq STDIN* nmode-buffer-channel)
+ (setf OldStdIn STDIN*)
+ (setf OldStdOut STDOUT*)
+ (setf OldErrOut ErrOut*)
+ )
+ (nmode-select-buffer-input-channel)
+ )
+
+(de nmode-run-init-file ()
+ (setf *nmode-init-has-run T)
+ (let ((fn (namestring (init-file-pathname "NMODE"))))
+ (cond ((FileP fn)
+ (nmode-execute-init-file fn))
+ ((FileP (setf fn nmode-default-init-file-name))
+ (nmode-execute-init-file fn))
+ )))
+
+(de nmode-execute-init-file (fn)
+ (let ((*nmode-init-running T))
+ (nmode-read-and-evaluate-file fn)
+ ))
+
+(de nmode-read-and-evaluate-file (fn)
+ (let ((chn (open fn 'INPUT))
+ exp
+ )
+ (while (not (eq (setf exp (ChannelRead chn)) $Eof$))
+ (eval exp)
+ )
+ (close chn)
+ )
+ )
+
+(de exit-nmode ()
+ % Leave NMODE, return to normal listen loop.
+ (nmode-select-old-channels)
+ (=> nmode-terminal move-cursor (=> nmode-terminal maxrow) 0)
+ (leave-raw-mode)
+ (setf *NMODE-RUNNING NIL)
+ (setf *GC T)
+ (exit-nmode-reader) % Set flag to cause NMODE to exit.
+ )
+
+% The following function is not currently used.
+(de nmode-invoke-lisp-listener ()
+ % Invoke a normal listen loop.
+ (let* ((*NMODE-RUNNING NIL)
+ (OldIN* IN*)
+ (OldOUT* OUT*)
+ (ERROUT* 1)
+ (StdIn* 0)
+ (StdOut* 1)
+ (old-raw-mode (=> nmode-terminal raw-mode))
+ )
+ (leave-raw-mode)
+ (RDS 0)
+ (WRS 1)
+ (unwind-protect
+ (TopLoop 'Read 'Print 'Eval "Lisp" "Return to NMODE with ^Z")
+ (RDS OldIN*)
+ (WRS OldOUT*)
+ (if old-raw-mode (enter-raw-mode))
+ )))
+% (de emode () (throw '$read$ $eof$)) % use with above function
+% (de nmode () (throw '$read$ $eof$)) % use with above function
+
+(de nmode-select-old-channels ()
+ % Select channels that were in effect when "Lisp Interface" was started up.
+ % (But don't turn echoing on.) NOTE that the "old channels" are normally
+ % selected while NMODE is actually running (this is somewhat counter
+ % intuitive). This is so that any error messages created by bugs in NMODE
+ % will not be printed into NMODE buffers. (If they were, it might break
+ % things recursively!)
+
+ (setf STDIN* OldStdIn)
+ (setf STDOUT* OldStdOut)
+ (setf ErrOut* OldErrOut)
+ (RDS STDIN*) % Select the channels.
+ (WRS STDOUT*)
+ )
+
+(de nmode-select-buffer-channel ()
+ % Select channels that read from and write to NMODE buffers.
+ (nmode-select-buffer-input-channel)
+ (setf STDOUT* nmode-buffer-channel)
+ (setf ErrOut* nmode-buffer-channel)
+ (WRS STDOUT*)
+ )
+
+(de nmode-select-buffer-input-channel ()
+ % Select channel that reads from NMODE buffer. "NMODE-Channel-Editor" is
+ % called when read routines invoke the "editor routine" for the newly selected
+ % channel.
+
+ (if (null nmode-buffer-channel)
+ (setf nmode-buffer-channel
+ (OpenBufferChannel NIL nmode-output-buffer 'nmode-channel-editor)))
+ (setf STDIN* nmode-buffer-channel)
+ (RDS STDIN*)
+ )
+
+(de nmode-channel-editor (chn)
+
+ % This procedure is called every time that input is requested from an NMODE
+ % buffer. It starts up NMODE (if not already running) and resumes NMODE
+ % execution. When the user has decided on what input to give to the channel
+ % (by performing Lisp-E), the NMODE-reader will return with I/O bound to the
+ % "buffer channel". The reader will also return if the user performs Lisp-L,
+ % in which case I/O will remain bound to the "standard" channels.
+
+ % Select "old" channels, so if an error occurs we don't get a bad recursive
+ % situation where printing into a buffer causes more trouble!
+
+ (nmode-select-old-channels)
+ (cond ((not *NMODE-RUNNING)
+ (setf *NMODE-RUNNING T)
+ (setf *GC NIL)
+ (if (not *nmode-init-has-run)
+ (nmode-run-init-file)
+ )
+ )
+ (t
+ (buffer-channel-flush nmode-buffer-channel)
+ (setf nmode-output-end-position (=> nmode-output-buffer position))
+ % compensate for moving to line start on next Lisp-E:
+ (if (not (at-line-start?))
+ (move-to-next-line))
+ )
+ )
+ (enter-raw-mode)
+ (nmode-select-major-window) % just in case
+ (NMODE-reader NIL) % NIL => don't exit when a command aborts
+ )
+
+(de nmode-main ()
+ (setf CurrentReadMacroIndicator* 'LispReadMacro) % Crock!
+ (setf CurrentScanTable* LispScanTable*)
+ (when (not toploopread*)
+ (setf toploopread* 'read)
+ (setf toploopprint* 'print)
+ (setf toploopeval* 'eval)
+ (setf toploopname* "NMODE Lisp")
+ )
+ (nmode-initialize) % does nothing if already initialized
+ (nmode-set-terminal) % ensure proper terminal driver is loaded
+
+ % Note: RESET may cause echoing to be turned on without clearing *RawIO.
+ (when *RawIO
+ (setf *RawIO NIL)
+ (EchoOff)
+ )
+ (leave-raw-mode)
+
+ (when nmode-first-start
+ (setf nmode-first-start NIL) % never again
+ (cond (nmode-auto-start
+ (setf *NMODE-RUNNING T) % see below
+ (let ((was-modified? (=> nmode-output-buffer modified?)))
+ (=> nmode-output-buffer insert-line LispBanner*)
+ (if (not was-modified?)
+ (=> nmode-output-buffer set-modified? NIL)
+ )))
+ (t
+ (printf "%w%n" LispBanner*)
+ ))
+ )
+
+ (while T
+ (setf nmode-terminal-input-buffer NIL) % flush execution from buffers
+ (cond (*NMODE-RUNNING
+ (setf *NMODE-RUNNING NIL) % force full start-up
+ (nmode) % cause next READ to start up NMODE
+ )
+ (t
+ (RDS 0)
+ (WRS 1)
+ ))
+ (nmode-top-loop)
+ ))
+
+(copyd 'main 'nmode-main)
+
+(de nmode-top-loop ()
+ (TopLoop toploopread* toploopprint* toploopeval* toploopname* "")
+ (Printf "End of File read!")
+ )
ADDED psl-1983/3-1/nmode/lisp-parser.sl
Index: psl-1983/3-1/nmode/lisp-parser.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/lisp-parser.sl
@@ -0,0 +1,184 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Lisp-Parser.SL - NMODE's Lisp parser
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 10 December 1982
+% Revised: 18 February 1983
+%
+% See the document NMODE-PARSING.TXT for a description of the parsing strategy.
+%
+% 18-Feb-1983 Alan Snyder
+% Removed use of "obsolete" #\ names.
+% 6-Jan-83 Alan Snyder
+% Use LOAD instead of FASLIN to get macros (for portability).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int fast-strings fast-vectors nmode-attributes))
+
+% Imported variables:
+
+(fluid '(nmode-defun-predicate
+ nmode-defun-scanner
+ nmode-current-parser
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de establish-lisp-parser ()
+ (setf nmode-defun-predicate #'lisp-current-line-is-defun?)
+ (setf nmode-defun-scanner #'lisp-scan-past-defun)
+ (setf nmode-current-parser #'lisp-parse-line)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% This file defines the basic primitive used by NMODE to
+% analyze Lisp source code. It currently recognizes:
+%
+% ( and ) as list brackets
+% [ and ] as vector brackets
+% comments beginning with %
+% #/x as character constants
+% " ... " as string literals
+% !x as a quoted character
+% ' ` #' #. , ,@ as prefixes to ( and [
+
+(de lisp-parse-line (str vec)
+ % Fill Vec[i] to be the attributes of Str[i].
+
+ (let* ((previous-attributes -1)
+ attributes ch is-first
+ (high (string-upper-bound str))
+ (in-comment NIL)
+ (in-string NIL)
+ (last-was-sharp NIL)
+ (last-was-sharp-slash NIL)
+ (last-was-sharp-quote NIL)
+ (last-was-sharp-dot NIL)
+ (last-was-quoter NIL)
+ (last-was-comma NIL)
+ (last-was-comma-atsign NIL)
+ (last-prefix-ending-index NIL)
+ (last-prefix-length NIL)
+ )
+ (for (from i 0 high)
+ (do
+ (setf ch (string-fetch str i))
+ % Determine the type attributes of the current character and update
+ % the parsing state for the next character.
+ (cond
+ (in-comment (setf attributes (attributes COMMENT)))
+ (in-string
+ (setf attributes (attributes ATOM))
+ (setf in-string (not (= ch #/")))
+ )
+ (last-was-sharp-slash
+ (setf attributes (attributes ATOM))
+ (setf last-was-sharp-slash NIL)
+ )
+ (last-was-quoter
+ (setf attributes (attributes ATOM))
+ (setf last-was-quoter NIL)
+ )
+ (t
+ (setf attributes (lisp-character-attributes ch))
+ (setf in-comment (= ch #/%))
+ (setf in-string (= ch #/"))
+ (setf last-was-sharp-slash (and last-was-sharp (= ch #//)))
+ (setf last-was-sharp-quote (and last-was-sharp (= ch #/')))
+ (setf last-was-sharp-dot (and last-was-sharp (= ch #/.)))
+ (setf last-was-sharp (= ch #/#))
+ (setf last-was-quoter (= ch #/!))
+ (setf last-was-comma-atsign (and last-was-comma (= ch #/@)))
+ (setf last-was-comma (= ch #/,))
+ (let ((prefix-length
+ (cond
+ (last-was-sharp-quote 2)
+ (last-was-sharp-dot 2)
+ ((= ch #/') 1)
+ ((= ch #/`) 1)
+ (last-was-comma 1)
+ (last-was-comma-atsign 1) % is 1 because comma is a prefix
+ (t 0)
+ )))
+ (when (> prefix-length 0)
+ % We just passed a prefix.
+ % Does it merge with the previous prefix?
+ (if (and last-prefix-ending-index
+ (= last-prefix-ending-index (- i prefix-length))
+ )
+ (setf last-prefix-length (+ last-prefix-length prefix-length))
+ % Otherwise
+ (setf last-prefix-length prefix-length)
+ )
+ (setf last-prefix-ending-index i)
+ ))
+ ))
+ % Determine the position attributes:
+ % LISP is simple: brackets are single characters (except for
+ % prefixes, which are handled below), atoms are maximal
+ % contiguous strings of atomic-characters.
+ (setf is-first (or (= attributes (attributes OPENER))
+ (= attributes (attributes CLOSER))
+ (~= attributes previous-attributes)))
+ (setf previous-attributes attributes)
+ (cond
+ % First we test for an open bracket immediately preceded
+ % by one or more prefixes.
+ ((and (= attributes (attributes OPENER))
+ last-prefix-ending-index
+ (= last-prefix-ending-index (- i 1))
+ )
+ (let ((prefix-start (- i last-prefix-length)))
+ (vector-store vec prefix-start (attributes FIRST PREFIX OPENER))
+ (lp-set-last vec (- prefix-start 1))
+ (for (from j (+ prefix-start 1) (- i 1))
+ (do (vector-store vec j (attributes MIDDLE PREFIX OPENER))))
+ ))
+ (is-first
+ (setf attributes (| attributes (attributes FIRST)))
+ (lp-set-last vec (- i 1))
+ )
+ (t
+ (setf attributes (| attributes (attributes MIDDLE)))
+ ))
+ (vector-store vec i attributes)
+ ))
+ (lp-set-last vec high)
+ ))
+
+(de lisp-character-attributes (ch)
+ (selectq ch
+ (NIL (attributes))
+ ((#/( #/[) (attributes OPENER))
+ ((#/) #/]) (attributes CLOSER))
+ ((#\SPACE #\TAB #\LF #\CR) (attributes BLANKS))
+ (#/% (attributes COMMENT))
+ (t (attributes ATOM))
+ ))
+
+(de lp-set-last (vec i)
+ (if (>= i 0)
+ (vector-store vec i (& (| (attributes LAST) (vector-fetch vec i))
+ (~ (attributes MIDDLE))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Lisp Defun Primitives
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de lisp-current-line-is-defun? ()
+ (and (not (current-line-empty?))
+ (= (current-line-fetch 0) #/()
+ ))
+
+(de lisp-scan-past-defun ()
+ % This function should be called with point at the start of a defun.
+ % It will scan past the end of the defun (not to the beginning of the
+ % next line, however). If the end of the defun is not found, it returns
+ % NIL and leaves point unchanged.
+
+ (move-forward-form)
+ )
ADDED psl-1983/3-1/nmode/m-x.sl
Index: psl-1983/3-1/nmode/m-x.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/m-x.sl
@@ -0,0 +1,163 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% M-X.SL - NMODE Extended Command Support
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 20 September 1982
+% Revised: 29 December 1982
+%
+% 29-Dec-82 Alan Snyder
+% Revise PROMPT-FOR-EXTENDED-COMMAND to use new prompted input.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int fast-strings extended-char))
+
+(fluid '(nmode-input-buffer))
+
+% Internal variables:
+
+(fluid '(prompt-for-extended-command-command-list
+ current-extended-command-list
+ ))
+
+(setf prompt-for-extended-command-command-list
+ (list
+ (cons (x-char SPACE) 'complete-input-command-name)
+ (cons (x-char CR) 'complete-and-terminate-input-command-name)
+ (cons (x-char LF) 'complete-and-terminate-input-command-name)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de prompt-for-extended-command (prompt)
+ % Ask the user for the name of an extended command. Return the full command
+ % name from the dispatch table (so that EQ can be used to compare).
+
+ (setf current-extended-command-list (lookup-prefix-character (x-char M-X)))
+ (let* ((input-name (prompt-for-string-special
+ prompt
+ nil
+ prompt-for-extended-command-command-list))
+ (matching-names (extended-command-names-that-match input-name))
+ )
+ (first matching-names)
+ ))
+
+% Internal functions:
+
+(de complete-input-command-name ()
+ % Extend the string in the input buffer by at most one word to match
+ % the existing extended command names. Ring the bell if the string
+ % is not extended.
+
+ (let ((original-length (string-length (nmode-get-input-string))))
+ (complete-input-extended-command-name NIL)
+ (if (= original-length (string-length (nmode-get-input-string)))
+ (Ding)
+ )))
+
+(de complete-and-terminate-input-command-name ()
+ % Extend the string in the input buffer as far as possible to match the
+ % existing extended command names. If the resulting string uniquely
+ % identifies a single command name, refresh and terminate input. Otherwise,
+ % if the string was not extended, ring the bell.
+
+ (let* ((original-length (string-length (nmode-get-input-string)))
+ (name (complete-input-extended-command-name T))
+ )
+ (if name
+ (progn (nmode-refresh) (nmode-terminate-input))
+ (if (= original-length (string-length (nmode-get-input-string)))
+ (Ding)
+ ))))
+
+(de complete-input-extended-command-name (many-ok)
+ % Extend the string in the input buffer BY WORDS. If MANY-OK is non-nil, then
+ % extend by as many words as possible; otherwise, by only one word. If the
+ % extended name matches exactly one command name, return that command name.
+ % Otherwise, return NIL.
+
+ (let* ((name (nmode-get-input-string))
+ (names (extended-command-names-that-match name))
+ )
+ (cond
+ ((string-equal name "E")
+ (nmode-replace-input-string "Edit ")
+ NIL
+ )
+ ((string-equal name "L")
+ (nmode-replace-input-string "List ")
+ NIL
+ )
+ ((string-equal name "K")
+ (nmode-replace-input-string "Kill ")
+ NIL
+ )
+ ((string-equal name "V")
+ (nmode-replace-input-string "View ")
+ NIL
+ )
+ ((string-equal name "W")
+ (nmode-replace-input-string "What ")
+ NIL
+ )
+ ((null names) % The name matches no command.
+ NIL
+ )
+ ((null (cdr names)) % The name matches exactly one command.
+ (nmode-replace-input-string (extend-name-by-words name names many-ok))
+ (car names)
+ )
+ (t % The name matches more than one command.
+ (nmode-replace-input-string (extend-name-by-words name names many-ok))
+ NIL
+ ))
+ ))
+
+(de extend-name-by-words (name names many-ok)
+ % NAME is the current contents of the input buffer. Extend it "by words" as
+ % long as it matches all of the specified NAMES. NAMES must be a list
+ % containing one or more strings. If MANY-OK is non-NIL, then extend it by as
+ % many words as possible. Otherwise, extend it by at most one word.
+ % Extending by words means that you do not append a new partial word, although
+ % you may partially complete a word already started. Return the extended
+ % string.
+
+ (let* ((match-prefix (strings-largest-common-prefix names))
+ (partial-word
+ (not (or
+ (string-empty? name)
+ (= (string-fetch name (string-upper-bound name)) #\space)
+ )))
+ (bound (string-length name))
+ )
+ % Try to increase the "bound":
+ (for (from i bound (string-upper-bound match-prefix))
+ (do (when (= (string-fetch match-prefix i) #\space)
+ (setf bound (+ i 1)) % this far is OK
+ (setf partial-word NIL) % further words will extend only in full
+ (if (not many-ok) (exit))
+ ))
+ (finally
+ (if (or partial-word (null (cdr names)))
+ (setf bound (string-length match-prefix))
+ )))
+ (substring match-prefix 0 bound)
+ ))
+
+(de extended-command-names-that-match (name)
+ (for (in pair (cdr current-extended-command-list))
+ (when (name-matches-prefix name (car pair)))
+ (collect (car pair))
+ ))
+
+(de name-matches-prefix (test-name name)
+ (let ((test-len (string-length test-name))
+ (name-len (string-length name))
+ )
+ (and
+ (>= name-len test-len)
+ (string-equal (substring name 0 test-len) test-name)
+ )))
ADDED psl-1983/3-1/nmode/m-xcmd.sl
Index: psl-1983/3-1/nmode/m-xcmd.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/m-xcmd.sl
@@ -0,0 +1,172 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% M-XCMD.SL - Miscellaneous Extended Commands
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 24 January 1983
+% Revised: 8 March 1983
+%
+% 8-March-83 Jeffrey Soreff
+% Revert File revised to try and preserve point.
+% 17-Feb-83 Alan Snyder
+% Revise M-X Set Visited Filename to actualize the new file name (i.e.,
+% convert it to the true name of the file). Revise M-X Rename Buffer to
+% convert buffer name to upper case and to check for use of an existing
+% buffer name.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-int))
+
+(fluid '(nmode-current-buffer))
+
+(de delete-matching-lines-command () (delete-possibly-matching-lines nil))
+
+(de delete-non-matching-lines-command () (delete-possibly-matching-lines t))
+
+(de delete-possibly-matching-lines (retain-if-match)
+ % This function prompts for a string which it searches for in all
+ % lines including and after the current one. The search is
+ % insensitive to case. If retain-if-match is true then all lines
+ % with the string will be retained and all lines lacking it will be
+ % deleted, otherwise all lines with the string will be deleted.
+ % Point is left at the start of the line that it was originally on.
+ % This function does not return a useful value.
+ (move-to-start-of-line)
+ (let ((modified-flag (=> nmode-current-buffer modified?))
+ (starting-line (current-line-pos))
+ (next-unfilled-line (current-line-pos))
+ (match-string (string-upcase
+ (prompt-for-string "Comparison String: " ""))))
+ (for (from test-line starting-line (- (current-buffer-size) 1) 1)
+ (do (when
+ (if retain-if-match % This sets the sign of the selections.
+ (forward-search-on-line test-line 0 match-string)
+ (not (forward-search-on-line test-line 0 match-string)))
+ (current-buffer-store next-unfilled-line
+ (current-buffer-fetch test-line))
+ (incr next-unfilled-line))))
+ (if (= next-unfilled-line (current-buffer-size)) % No lines were tossed.
+ (=> nmode-current-buffer set-modified? modified-flag)
+ % Else
+ (extract-region t
+ (buffer-position-create next-unfilled-line 0)
+ (progn (move-to-buffer-end) (buffer-get-position))))
+ (set-line-pos starting-line)))
+
+(de count-occurrences-command ()
+ % This function counts the number of instances of a string after the
+ % current buffer position. The counting is insensitive to case.
+ % The user is prompted for the string. If the user supplies an
+ % empty string, they are told that it can't be counted. This avoids
+ % an infinite loop. The count obtained is displayed in the prompt
+ % line. This function does not return a useful value.
+ (let ((count 0)
+ (initial-place (buffer-get-position))
+ (match-string (string-upcase
+ (prompt-for-string "Count Occurrences: " ""))))
+ (if (equal match-string "")
+ (write-prompt "One can't count instances of the empty string.")
+ (while (forward-search match-string)
+ (incr count)
+ (move-forward))
+ (buffer-set-position initial-place)
+ (write-prompt (bldmsg "%d occurrences" count)))))
+
+(de set-key-command ()
+ % This binds a user-selected function to a command. The user is
+ % prompted for the function name and the key sequence of the
+ % command. This function then tests to see if the user's function
+ % exists, then asks for confirmation just before doing the binding.
+ % This function does not return a useful value.
+ (let ((function (intern (string-upcase
+ (prompt-for-string "Function Name: " "")))))
+ (if (funboundp function)
+ (write-prompt (bldmsg "No function %w was found." function))
+ (let* ((junk (write-message (bldmsg "Put %p on key:" function)))
+ (command (input-command)))
+ (when (nmode-y-or-n? (bldmsg "Load %w with %w"
+ (command-name command) function))
+ (set-text-command command function))))))
+
+(de set-visited-filename-command ()
+ % This command allows a user to alter the filename associated with the
+ % current buffer. Prompt-for-defaulted-filename is used to set default
+ % characteristics. This function does not return a useful value.
+ (let* ((new-name
+ (prompt-for-defaulted-filename "Set Visited Filename: " NIL)))
+ (=> nmode-current-buffer set-file-name
+ (or (actualize-file-name new-name) new-name)
+ )))
+
+(de rename-buffer-command ()
+ % This function allows the user to rename the current buffer if it is not a
+ % system buffer like main or output. It prompts the user for a new buffer
+ % name. If the user inputs an empty string, the buffer name is set to a
+ % converted version of the filename associated with the buffer. Buffer
+ % names are converted to upper case. An error is reported if the user
+ % chooses the name of another existing buffer. This function does not
+ % return a useful value.
+ (if (not (buffer-killable? nmode-current-buffer)) % tests for main and output
+ (nmode-error (bldmsg "Buffer %w cannot be renamed."
+ (=> nmode-current-buffer name)))
+ (let* ((old-name (=> nmode-current-buffer name))
+ (new-name
+ (string-upcase
+ (prompt-for-string
+ "Rename Buffer: "
+ (let ((filename (=> nmode-current-buffer file-name))) % Default
+ (if filename
+ (filename-to-buffername filename)
+ % Else, if there is no filename
+ (=> nmode-current-buffer name)))))))
+ (when (not (string= new-name old-name))
+ (if (buffer-exists? new-name)
+ (nmode-error (bldmsg "Name %w already in use." new-name))
+ (=> nmode-current-buffer set-name new-name)
+ )))))
+
+(de kill-some-buffers-command ()
+ % This functions lists the killable buffers one by one, letting the
+ % user kill, retain, or examine each one as it is named. This
+ % function does not return a useful value.
+ (let ((buffer-list (nmode-user-buffers)))
+ (while buffer-list
+ (let ((buffer-to-die (car buffer-list)))
+ (setf buffer-list (cdr buffer-list))
+ (when (and (buffer-killable? buffer-to-die)
+ (let ((name (=> buffer-to-die name))
+ (mod-warn (if (=> buffer-to-die modified?)
+ "HAS BEEN EDITED"
+ "is unmodified")))
+ (recursive-edit-y-or-n
+ buffer-to-die
+ (bldmsg
+ "Buffer %w %w. Kill it? Type Y or N or ^R to edit"
+ name mod-warn)
+ (bldmsg
+ "Type Y to kill or N to save buffer %w" name))))
+ (buffer-kill-and-detach buffer-to-die))))))
+
+(de insert-date-command ()
+ % This inserts the current date into the text, after point, and
+ % moves point past it. It does not return a useful value.
+ (insert-string (current-date-time)))
+
+(de revert-file-command ()
+ % This function allows the user to replace the current buffer's
+ % contents with the contents of the file associated with the current
+ % buffer, if there is one. It asks for confirmation before actually
+ % performing the replacement. It tries to put point close to the
+ % old position. This function does not return a useful value.
+ (let ((fn (=> nmode-current-buffer file-name))
+ (bn (=> nmode-current-buffer name))
+ (current-place (buffer-get-position)))
+ (when (and
+ (if fn T (write-prompt "No file to read old copy from") NIL)
+ (nmode-y-or-n?
+ (BldMsg "Want to replace buffer %w with %w from disk?"
+ bn fn)))
+ (read-file-into-buffer nmode-current-buffer fn)
+ (buffer-set-position current-place))))
ADDED psl-1983/3-1/nmode/mode-defs.sl
Index: psl-1983/3-1/nmode/mode-defs.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/mode-defs.sl
@@ -0,0 +1,515 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% MODE-DEFS.SL - NMODE Command Table and Mode Definitions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 14 September 1982
+% Revised: 15 March 1983
+%
+% 15-Mar-83 Alan Snyder
+% Add M-X List Browsers, M-X Print Buffer, C-X C-P. Define modes at load
+% time. Rename write-screen-photo-command to write-screen-command; change to
+% M-X Write Screen (instead of C-X P).
+% 18-Feb-83 Alan Snyder
+% Rename down-list and insert-parens. Add M-) command.
+% 9-Feb-83 Alan Snyder
+% Add Esc-_ (Help), temporarily attached to M-X Apropos.
+% Move some M-X commands into text-command-list.
+% 2-Feb-83 Alan Snyder
+% Add Lisp-D.
+% 26-Jan-83 Alan Snyder
+% Add Esc-/.
+% 25-Jan-83 Alan Snyder
+% Created Window-Command-List to allow scrolling in Recurse mode.
+% Removed modifying text commands from Recurse mode.
+% 24-Jan-83 Jeffrey Soreff
+% Added definition of Recurse-Mode
+% Defined M-X commands: Delete Matching Lines, Flush Lines,
+% Delete Non-Matching Lines, Keep Lines, How Many, Count Occurrences,
+% Set Key, Set Visited Filename, Rename Buffer, Kill Some Buffers,
+% Insert Date, Revert File
+% 5-Jan-83 Alan Snyder
+% Revised definition of input mode, C-S, and C-R.
+% 3-Dec-82 Alan Snyder
+% New definitions for ) and ] in Lisp mode.
+% New definitions for C-M-(, C-M-), C-M-U, C-M-N, and C-M-P.
+% New definitions for C-M-A, C-M-[, and C-M-R.
+% Define C-M-\ (Indent Region) in Lisp mode and Text mode.
+% Define C-? same as M-?, C-( same as C-M-(, C-) same as C-M-).
+% Lisp Mode establishes Lisp Parser.
+% Define C-M-C.
+% Define the text commands: C-=, C-X =, M-A, M-E, M-K, C-X Rubout, M-Z, M-Q,
+% M-G, M-H, M-], M-[, M-S.
+% Fix definitions of digits and hyphen: inserting definition goes on
+% text-command-list (where insertion commands go).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% (CompileTime (load objects))
+(CompileTime (load extended-char))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-default-mode
+ nmode-current-buffer
+ nmode-input-special-command-list
+ ))
+
+% Mode definitions:
+
+(fluid '(Lisp-Interface-Mode
+ Text-Mode
+ Basic-Mode
+ Read-Only-Text-Mode
+ Input-Mode
+ Recurse-Mode
+ ))
+
+% Command lists:
+
+(fluid '(Input-Command-List
+ Read-Only-Text-Command-List
+ Text-Command-List
+ Rlisp-Command-List
+ Lisp-Command-List
+ Read-Only-Terminal-Command-List
+ Modifying-Terminal-Command-List
+ Window-Command-List
+ Basic-Command-List
+ Essential-Command-List
+ Recurse-Command-List
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Mode Definitions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(setf Basic-Mode
+ (nmode-define-mode
+ "Basic"
+ '((nmode-define-commands Basic-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Window-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ )))
+
+(setf Read-Only-Text-Mode
+ (nmode-define-mode
+ "Read-Only-Text"
+ '((nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-establish-mode Basic-Mode)
+ )))
+
+(setf Text-Mode
+ (nmode-define-mode
+ "Text"
+ '((nmode-define-commands Text-Command-List)
+ (nmode-define-commands Modifying-Terminal-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ (nmode-define-normal-self-inserts)
+ )))
+
+(setf Lisp-Interface-Mode
+ (nmode-define-mode
+ "Lisp"
+ '((nmode-define-commands Rlisp-Command-List)
+ (establish-lisp-parser)
+ (nmode-define-commands Lisp-Command-List)
+ (nmode-establish-mode Text-Mode)
+ )))
+
+(setf Input-Mode
+ (nmode-define-mode
+ "Input"
+ '((nmode-define-commands nmode-input-special-command-list)
+ (nmode-define-command (x-char CR) 'nmode-terminate-input)
+ (nmode-define-command (x-char LF) 'nmode-terminate-input)
+ (nmode-define-commands Input-Command-List)
+ (nmode-define-commands Text-Command-List)
+ (nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ (nmode-define-normal-self-inserts)
+ )))
+
+(setf Recurse-Mode
+ (nmode-define-mode
+ "Recurse"
+ '((nmode-define-commands Read-Only-Text-Command-List)
+ (nmode-define-commands Read-Only-Terminal-Command-List)
+ (nmode-define-commands Window-Command-List)
+ (nmode-define-commands Essential-Command-List)
+ (nmode-define-commands Recurse-Command-List)
+ )))
+
+(setf nmode-default-mode Text-Mode)
+
+(de nmode-initialize-modes ()
+ % Define initial set of file modes.
+ (nmode-declare-file-mode "txt" Text-Mode)
+ (nmode-declare-file-mode "red" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "sl" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "lsp" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "lap" Lisp-Interface-Mode)
+ (nmode-declare-file-mode "build" Lisp-Interface-Mode)
+ )
+
+(de lisp-mode-command ()
+ (buffer-set-mode nmode-current-buffer Lisp-Interface-Mode)
+ )
+
+(de text-mode-command ()
+ (buffer-set-mode nmode-current-buffer Text-Mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Command Lists:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Rlisp-Command-List - commands related to the LISP interface
+
+(setf Rlisp-Command-List
+ (list
+ (cons (x-char C-!]) 'Lisp-prefix)
+ (cons (x-chars C-!] !?) 'lisp-help-command)
+ (cons (x-chars C-!] A) 'lisp-abort-command)
+ (cons (x-chars C-!] B) 'lisp-backtrace-command)
+ (cons (x-chars C-!] C) 'lisp-continue-command)
+ (cons (x-chars C-!] D) 'execute-defun-command)
+ (cons (x-chars C-!] E) 'execute-form-command)
+ (cons (x-chars C-!] L) 'exit-nmode)
+ (cons (x-chars C-!] Q) 'lisp-quit-command)
+ (cons (x-chars C-!] R) 'lisp-retry-command)
+ (cons (x-chars C-!] Y) 'yank-last-output-command)
+ ))
+
+% Lisp-Command-List - commands related to editing LISP text
+
+(setf Lisp-Command-List
+ (list
+ (cons (x-char !)) 'insert-closing-bracket)
+ (cons (x-char !]) 'insert-closing-bracket)
+ (cons (x-char C-!() 'backward-up-list-command)
+ (cons (x-char C-!)) 'forward-up-list-command)
+ (cons (x-char C-M-!() 'backward-up-list-command)
+ (cons (x-char C-M-!)) 'forward-up-list-command)
+ (cons (x-char C-M-![) 'move-backward-defun-command)
+ (cons (x-char C-M-!]) 'end-of-defun-command)
+ (cons (x-char C-M-!\) 'lisp-indent-region-command)
+ (cons (x-char C-M-@) 'mark-form-command)
+ (cons (x-char C-M-A) 'move-backward-defun-command)
+ (cons (x-char C-M-B) 'move-backward-form-command)
+ (cons (x-char C-M-BACKSPACE) 'mark-defun-command)
+ (cons (x-char C-M-D) 'down-list-command)
+ (cons (x-char C-M-E) 'end-of-defun-command)
+ (cons (x-char C-M-F) 'move-forward-form-command)
+ (cons (x-char C-M-H) 'mark-defun-command)
+ (cons (x-char C-M-I) 'lisp-tab-command)
+ (cons (x-char C-M-K) 'kill-forward-form-command)
+ (cons (x-char C-M-N) 'move-forward-list-command)
+ (cons (x-char C-M-P) 'move-backward-list-command)
+ (cons (x-char C-M-Q) 'lisp-indent-sexpr)
+ (cons (x-char C-M-R) 'reposition-window-command)
+ (cons (x-char C-M-RUBOUT) 'kill-backward-form-command)
+ (cons (x-char C-M-T) 'transpose-forms)
+ (cons (x-char C-M-TAB) 'lisp-tab-command)
+ (cons (x-char C-M-U) 'backward-up-list-command)
+ (cons (x-char M-!;) 'insert-comment-command)
+ (cons (x-char M-BACKSPACE) 'mark-defun-command)
+ (cons (x-char M-!() 'make-parens-command)
+ (cons (x-char M-!)) 'move-over-paren-command)
+ (cons (x-char RUBOUT) 'delete-backward-hacking-tabs-command)
+ (cons (x-char TAB) 'lisp-tab-command)
+ ))
+
+% Essential-Command-List: the most essential commands
+
+(setf Essential-Command-List
+ (list
+ (cons (x-char C-X) 'c-x-prefix)
+ (cons (x-char ESC) 'Esc-prefix)
+ (cons (x-char M-X) 'm-x-prefix)
+ (cons (x-char C-M-X) 'm-x-prefix)
+ (cons (x-char C-G) 'nmode-abort-command)
+ (cons (x-char C-L) 'nmode-refresh-command)
+ (cons (x-char C-U) 'universal-argument)
+ (cons (x-char 0) 'argument-digit)
+ (cons (x-char 1) 'argument-digit)
+ (cons (x-char 2) 'argument-digit)
+ (cons (x-char 3) 'argument-digit)
+ (cons (x-char 4) 'argument-digit)
+ (cons (x-char 5) 'argument-digit)
+ (cons (x-char 6) 'argument-digit)
+ (cons (x-char 7) 'argument-digit)
+ (cons (x-char 8) 'argument-digit)
+ (cons (x-char 9) 'argument-digit)
+ (cons (x-char -) 'negative-argument)
+ (cons (x-char C-0) 'argument-digit)
+ (cons (x-char C-1) 'argument-digit)
+ (cons (x-char C-2) 'argument-digit)
+ (cons (x-char C-3) 'argument-digit)
+ (cons (x-char C-4) 'argument-digit)
+ (cons (x-char C-5) 'argument-digit)
+ (cons (x-char C-6) 'argument-digit)
+ (cons (x-char C-7) 'argument-digit)
+ (cons (x-char C-8) 'argument-digit)
+ (cons (x-char C-9) 'argument-digit)
+ (cons (x-char C--) 'negative-argument)
+ (cons (x-char M-0) 'argument-digit)
+ (cons (x-char M-1) 'argument-digit)
+ (cons (x-char M-2) 'argument-digit)
+ (cons (x-char M-3) 'argument-digit)
+ (cons (x-char M-4) 'argument-digit)
+ (cons (x-char M-5) 'argument-digit)
+ (cons (x-char M-6) 'argument-digit)
+ (cons (x-char M-7) 'argument-digit)
+ (cons (x-char M-8) 'argument-digit)
+ (cons (x-char M-9) 'argument-digit)
+ (cons (x-char M--) 'negative-argument)
+ (cons (x-char C-M-0) 'argument-digit)
+ (cons (x-char C-M-1) 'argument-digit)
+ (cons (x-char C-M-2) 'argument-digit)
+ (cons (x-char C-M-3) 'argument-digit)
+ (cons (x-char C-M-4) 'argument-digit)
+ (cons (x-char C-M-5) 'argument-digit)
+ (cons (x-char C-M-6) 'argument-digit)
+ (cons (x-char C-M-7) 'argument-digit)
+ (cons (x-char C-M-8) 'argument-digit)
+ (cons (x-char C-M-9) 'argument-digit)
+ (cons (x-char C-M--) 'negative-argument)
+ (cons (x-chars C-X C-Z) 'nmode-exit-to-superior)
+ (cons (x-chars C-X V) 'nmode-invert-video)
+ (cons (x-chars Esc !/) 'execute-softkey-command)
+ ))
+
+% Window-Command-List: commands for scrolling, etc.
+% These commands do not allow selecting a new window, buffer, mode, etc.
+
+(setf Window-Command-List
+ (list
+ (cons (x-char C-M-V) 'scroll-other-window-command)
+ (cons (x-char C-V) 'next-screen-command)
+ (cons (x-char M-R) 'move-to-screen-edge-command)
+ (cons (x-char M-V) 'previous-screen-command)
+ (cons (x-chars C-X <) 'scroll-window-left-command)
+ (cons (x-chars C-X >) 'scroll-window-right-command)
+ (cons (x-chars C-X ^) 'grow-window-command)
+ (cons (m-x "Write Screen") 'write-screen-command)
+ ))
+
+% Basic-Command-List: contains commands desirable in almost any mode.
+
+(setf Basic-Command-List
+ (list
+ (cons (x-char C-!?) 'help-dispatch)
+ (cons (x-char C-M-L) 'select-previous-buffer-command)
+ (cons (x-char M-!/) 'help-dispatch)
+ (cons (x-char M-!?) 'help-dispatch)
+ (cons (x-char M-!~) 'buffer-not-modified-command)
+ (cons (x-chars C-X !.) 'set-fill-prefix-command)
+ (cons (x-chars C-X 1) 'one-window-command)
+ (cons (x-chars C-X 2) 'two-windows-command)
+ (cons (x-chars C-X 3) 'view-two-windows-command)
+ (cons (x-chars C-X 4) 'visit-in-other-window-command)
+ (cons (x-chars C-X B) 'select-buffer-command)
+ (cons (x-chars C-X C-B) 'buffer-browser-command)
+ (cons (x-chars C-X C-F) 'find-file-command)
+ (cons (x-chars C-X C-P) 'print-buffer-command)
+ (cons (x-chars C-X C-S) 'save-file-command)
+ (cons (x-chars C-X C-W) 'write-file-command) % here???
+ (cons (x-chars C-X D) 'dired-command)
+ (cons (x-chars C-X E) 'exchange-windows-command)
+ (cons (x-chars C-X F) 'set-fill-column-command)
+ (cons (x-chars C-X K) 'kill-buffer-command)
+ (cons (x-chars C-X O) 'other-window-command)
+ (cons (x-chars Esc _) 'apropos-command)
+ (cons (m-x "Append to File") 'append-to-file-command)
+ (cons (m-x "Apropos") 'apropos-command)
+ (cons (m-x "Auto Fill Mode") 'auto-fill-mode-command)
+ (cons (m-x "Count Occurrences") 'Count-Occurrences-command)
+ (cons (m-x "Delete and Expunge File") 'delete-and-expunge-file-command)
+ (cons (m-x "Delete File") 'delete-file-command)
+ (cons (m-x "DIRED") 'edit-directory-command)
+ (cons (m-x "Edit Directory") 'edit-directory-command)
+ (cons (m-x "Execute Buffer") 'execute-buffer-command)
+ (cons (m-x "Execute File") 'execute-file-command)
+ (cons (m-x "Find File") 'find-file-command)
+ (cons (m-x "How Many") 'Count-Occurrences-command)
+ (cons (m-x "Kill Buffer") 'kill-buffer-command)
+ (cons (m-x "Kill File") 'delete-file-command)
+ (cons (m-x "Kill Some Buffers") 'kill-some-buffers-command)
+ (cons (m-x "List Browsers") 'browser-browser-command)
+ (cons (m-x "List Buffers") 'buffer-browser-command)
+ (cons (m-x "Make Space") 'nmode-gc)
+ (cons (m-x "Prepend to File") 'prepend-to-file-command)
+ (cons (m-x "Print Buffer") 'print-buffer-command)
+ (cons (m-x "Rename Buffer") 'rename-buffer-command)
+ (cons (m-x "Save All Files") 'save-all-files-command)
+ (cons (m-x "Select Buffer") 'select-buffer-command)
+ (cons (m-x "Set Key") 'set-key-command)
+ (cons (m-x "Set Visited Filename") 'set-visited-filename-command)
+ (cons (m-x "Start Scripting") 'start-scripting-command)
+ (cons (m-x "Start Timing NMODE") 'start-timing-command)
+ (cons (m-x "Stop Scripting") 'stop-scripting-command)
+ (cons (m-x "Stop Timing NMODE") 'stop-timing-command)
+ (cons (m-x "Undelete File") 'undelete-file-command)
+ (cons (m-x "Write File") 'write-file-command) % here???
+ (cons (m-x "Write Region") 'write-region-command)
+ ))
+
+% Read-Only-Text-Command-List: Commands for editing text buffers that
+% do not modify the buffer.
+
+(setf Read-Only-Text-Command-List
+ (list
+ % These commands are read-only commands for text mode.
+ (cons (x-char BACKSPACE) 'move-backward-character-command)
+ (cons (x-char C-<) 'mark-beginning-command)
+ (cons (x-char C->) 'mark-end-command)
+ (cons (x-char C-=) 'what-cursor-position-command)
+ (cons (x-char C-@) 'set-mark-command)
+ (cons (x-char C-A) 'move-to-start-of-line-command)
+ (cons (x-char C-B) 'move-backward-character-command)
+ (cons (x-char C-E) 'move-to-end-of-line-command)
+ (cons (x-char C-F) 'move-forward-character-command)
+ (cons (x-char C-M-M) 'back-to-indentation-command)
+ (cons (x-char C-M-RETURN) 'back-to-indentation-command)
+ (cons (x-char C-M-W) 'append-next-kill-command)
+ (cons (x-char C-N) 'move-down-command)
+ (cons (x-char C-P) 'move-up-command)
+ (cons (x-char C-R) 'reverse-search-command)
+ (cons (x-char C-S) 'incremental-search-command)
+ (cons (x-char C-SPACE) 'set-mark-command)
+ (cons (x-char M-<) 'move-to-buffer-start-command)
+ (cons (x-char M->) 'move-to-buffer-end-command)
+ (cons (x-char M-![) 'backward-paragraph-command)
+ (cons (x-char M-!]) 'forward-paragraph-command)
+ (cons (x-char M-@) 'mark-word-command)
+ (cons (x-char M-A) 'backward-sentence-command)
+ (cons (x-char M-B) 'move-backward-word-command)
+ (cons (x-char M-E) 'forward-sentence-command)
+ (cons (x-char M-F) 'move-forward-word-command)
+ (cons (x-char M-H) 'mark-paragraph-command)
+ (cons (x-char M-M) 'back-to-indentation-command)
+ (cons (x-char M-RETURN) 'back-to-indentation-command)
+ (cons (x-char M-W) 'copy-region)
+ (cons (x-chars C-X A) 'append-to-buffer-command)
+ (cons (x-chars C-X C-N) 'set-goal-column-command)
+ (cons (x-chars C-X C-X) 'exchange-point-and-mark)
+ (cons (x-chars C-X H) 'mark-whole-buffer-command)
+ (cons (x-chars C-X =) 'what-cursor-position-command)
+ ))
+
+% Text-Command-List: Commands for editing text buffers that might modify
+% the buffer. Note: put read-only commands on
+% Read-Only-Text-Command-List (above).
+
+(setf Text-Command-List
+ (list
+ (cons (x-char 0) 'argument-or-insert-command)
+ (cons (x-char 1) 'argument-or-insert-command)
+ (cons (x-char 2) 'argument-or-insert-command)
+ (cons (x-char 3) 'argument-or-insert-command)
+ (cons (x-char 4) 'argument-or-insert-command)
+ (cons (x-char 5) 'argument-or-insert-command)
+ (cons (x-char 6) 'argument-or-insert-command)
+ (cons (x-char 7) 'argument-or-insert-command)
+ (cons (x-char 8) 'argument-or-insert-command)
+ (cons (x-char 9) 'argument-or-insert-command)
+ (cons (x-char -) 'argument-or-insert-command)
+ (cons (x-char C-!%) 'replace-string-command)
+ (cons (x-char C-D) 'delete-forward-character-command)
+ (cons (x-char C-K) 'kill-line)
+ (cons (x-char C-M-C) 'insert-self-command)
+ (cons (x-char C-M-O) 'split-line-command)
+ (cons (x-char C-M-!\) 'indent-region-command)
+ (cons (x-char C-N) 'move-down-extending-command)
+ (cons (x-char C-O) 'open-line-command)
+ (cons (x-char C-Q) 'insert-next-character-command)
+ (cons (x-char C-RUBOUT) 'delete-backward-hacking-tabs-command)
+ (cons (x-char C-T) 'transpose-characters-command)
+ (cons (x-char C-W) 'kill-region)
+ (cons (x-char C-Y) 'insert-kill-buffer)
+ (cons (x-char LF) 'indent-new-line-command)
+ (cons (x-char M-!') 'upcase-digit-command)
+ (cons (x-char M-!%) 'query-replace-command)
+ (cons (x-char M-!\) 'delete-horizontal-space-command)
+ (cons (x-char M-C) 'uppercase-initial-command)
+ (cons (x-char M-D) 'kill-forward-word-command)
+ (cons (x-char M-G) 'fill-region-command)
+ (cons (x-char M-I) 'tab-to-tab-stop-command)
+ (cons (x-char M-K) 'kill-sentence-command)
+ (cons (x-char M-L) 'lowercase-word-command)
+ (cons (x-char M-Q) 'fill-paragraph-command)
+ (cons (x-char M-RUBOUT) 'kill-backward-word-command)
+ (cons (x-char M-S) 'center-line-command)
+ (cons (x-char M-T) 'transpose-words)
+ (cons (x-char M-TAB) 'tab-to-tab-stop-command)
+ (cons (x-char M-U) 'uppercase-word-command)
+ (cons (x-char M-Y) 'unkill-previous)
+ (cons (x-char M-Z) 'fill-comment-command)
+ (cons (x-char M-^) 'delete-indentation-command)
+ (cons (x-char RETURN) 'return-command)
+ (cons (x-char RUBOUT) 'delete-backward-character-command)
+ (cons (x-char TAB) 'tab-to-tab-stop-command)
+ (cons (x-chars C-X C-L) 'lowercase-region-command)
+ (cons (x-chars C-X C-O) 'delete-blank-lines-command)
+ (cons (x-chars C-X C-T) 'transpose-lines)
+ (cons (x-chars C-X C-U) 'uppercase-region-command)
+ (cons (x-chars C-X C-V) 'visit-file-command)
+ (cons (x-chars C-X G) 'get-register-command)
+ (cons (x-chars C-X Rubout) 'backward-kill-sentence-command)
+ (cons (x-chars C-X T) 'transpose-regions)
+ (cons (x-chars C-X X) 'put-register-command)
+ (cons (m-x "Delete Matching Lines") 'delete-matching-lines-command)
+ (cons (m-x "Delete Non-Matching Lines") 'delete-non-matching-lines-command)
+ (cons (m-x "Flush Lines") 'delete-matching-lines-command)
+ (cons (m-x "Insert Buffer") 'insert-buffer-command)
+ (cons (m-x "Insert Date") 'insert-date-command)
+ (cons (m-x "Insert File") 'insert-file-command)
+ (cons (m-x "Keep Lines") 'delete-non-matching-lines-command)
+ (cons (m-x "Lisp Mode") 'lisp-mode-command)
+ (cons (m-x "Replace String") 'replace-string-command)
+ (cons (m-x "Query Replace") 'query-replace-command)
+ (cons (m-x "Revert File") 'revert-file-command)
+ (cons (m-x "Text Mode") 'text-mode-command)
+ (cons (m-x "Visit File") 'visit-file-command)
+ ))
+
+(setf Read-Only-Terminal-Command-List
+ (list
+ (cons (x-chars ESC !h) 'move-to-buffer-start-command)
+ (cons (x-chars ESC 4) 'move-backward-word-command)
+ (cons (x-chars ESC 5) 'move-forward-word-command)
+ (cons (x-chars ESC A) 'move-up-command)
+ (cons (x-chars ESC B) 'move-down-command)
+ (cons (x-chars ESC C) 'move-forward-character-command)
+ (cons (x-chars ESC D) 'move-backward-character-command)
+ (cons (x-chars ESC F) 'move-to-buffer-end-command)
+ (cons (x-chars ESC J) 'nmode-full-refresh)
+ (cons (x-chars ESC S) 'scroll-window-up-line-command)
+ (cons (x-chars ESC T) 'scroll-window-down-line-command)
+ (cons (x-chars ESC U) 'scroll-window-up-page-command)
+ (cons (x-chars ESC V) 'scroll-window-down-page-command)
+ ))
+
+(setf Modifying-Terminal-Command-List
+ (list
+ (cons (x-chars ESC L) 'open-line-command)
+ (cons (x-chars ESC M) 'kill-line)
+ (cons (x-chars ESC P) 'delete-forward-character-command)
+ ))
+
+(setf Input-Command-List
+ (list
+ (cons (x-char C-R) 'nmode-yank-default-input)
+ ))
+
+(setf Recurse-Command-List
+ (list
+ (cons (x-char y) 'affirmative-exit)
+ (cons (x-char n) 'negative-exit)
+ ))
ADDED psl-1983/3-1/nmode/modes.sl
Index: psl-1983/3-1/nmode/modes.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/modes.sl
@@ -0,0 +1,185 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% MODES.SL - NMODE Mode Manipulation Functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 14 September 1982
+% Revised: 4 March 1983
+%
+% 4-Mar-83 Alan Snyder
+% Revise pathname-default-mode to handle invalid pathname.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char))
+
+% Global variables:
+
+(fluid '(nmode-default-mode
+ nmode-minor-modes % list of active minor modes (don't modify inplace!)
+ ))
+
+% Internal static variables:
+
+(fluid '(nmode-defined-modes
+ nmode-file-modes
+ ))
+
+(setf nmode-default-mode NIL)
+(setf nmode-defined-modes ())
+(setf nmode-file-modes ())
+(setf nmode-minor-modes ())
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Mode Definition:
+%
+% The following function is used to define a mode (either major or minor):
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-define-mode (name establish-expressions)
+ (let* ((mode (make-instance 'mode
+ 'name name
+ 'establish-expressions establish-expressions
+ ))
+ (pair (Ass
+ (function string-equal)
+ name
+ nmode-defined-modes
+ )))
+ (if pair
+ (rplacd pair mode)
+ (setf nmode-defined-modes
+ (cons (cons name mode) nmode-defined-modes)
+ ))
+ mode
+ ))
+
+(defflavor mode (
+ name
+ establish-expressions
+ )
+ ()
+ gettable-instance-variables
+ initable-instance-variables
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% File Modes
+%
+% The following functions associate a default mode with certain filename
+% extensions.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-declare-file-mode (file-type mode)
+ (let ((pair (Ass
+ (function string-equal)
+ file-type
+ nmode-file-modes
+ )))
+ (if pair
+ (rplacd pair mode)
+ (setf nmode-file-modes
+ (cons (cons file-type mode) nmode-file-modes)
+ ))
+ ))
+
+(de pathname-default-mode (fn)
+ (let ((pn (maybe-pathname fn)))
+ (if pn
+ (let ((pair (Ass
+ (function string-equal)
+ (pathname-type pn)
+ nmode-file-modes
+ )))
+ (if pair (cdr pair) nmode-default-mode)
+ )
+ nmode-default-mode
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Minor Modes
+%
+% A minor mode is a mode that can be turned on or off independently of the
+% current buffer or the current major mode.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de minor-mode-active? (m)
+ % M is a mode object. Return T if it is an active minor mode.
+ (memq m nmode-minor-modes)
+ )
+
+(de activate-minor-mode (m)
+ % M is a mode object. Make it active (if it isn't already).
+ (when (not (minor-mode-active? m))
+ (setf nmode-minor-modes (cons m nmode-minor-modes))
+ (nmode-establish-current-mode)
+ ))
+
+(de deactivate-minor-mode (m)
+ % M is a mode object. If it is active, deactivate it.
+ (when (minor-mode-active? m)
+ (setf nmode-minor-modes (delq m nmode-minor-modes))
+ (nmode-establish-current-mode)
+ ))
+
+(de toggle-minor-mode (m)
+ % M is a mode object. If it is active, deactivate it and return T;
+ % otherwise, activate it and return NIL.
+
+ (let ((is-active? (minor-mode-active? m)))
+ (if is-active?
+ (deactivate-minor-mode m)
+ (activate-minor-mode m)
+ )
+ is-active?
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Manipulating mode lists:
+%
+% The following functions are provided for use in user init files. They are
+% not used in NMODE. See the file -CUSTOMIZING.TXT for information on how to
+% customize NMODE.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de add-to-command-list (listname command func)
+ (let* ((old-list (eval listname))
+ (old-binding (assoc command old-list))
+ (binding (cons command func))
+ )
+ (cond
+ % If the binding isn't already in the a-list.
+ ((null old-binding)
+ % Add the new binding
+ (set listname (aconc old-list binding)))
+ % Otherwise, replace the old operation in the binding.
+ (T
+ (setf (cdr old-binding) func)))
+ NIL
+ ))
+
+(de remove-from-command-list (listname command)
+ (let* ((old-list (eval listname))
+ (old-binding (assoc command old-list))
+ )
+ (cond (old-binding
+ (set listname (DelQ old-binding old-list))
+ NIL
+ ))))
+
+(de set-text-command (command func)
+
+ % This function is a shorthand for modifying text mode. The arguments are as
+ % for ADD-TO-COMMAND-LIST. The change takes effect immediately.
+
+ (add-to-command-list 'Text-Command-List command func)
+ (nmode-establish-current-mode))
ADDED psl-1983/3-1/nmode/move-commands.sl
Index: psl-1983/3-1/nmode/move-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/move-commands.sl
@@ -0,0 +1,415 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Move-Commands.SL - NMODE Move commands
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 August 1982
+% Revised: 17 February 1983
+%
+% 17-Feb-83 Alan Snyder
+% Bug fix: permanent goal column wasn't permanent.
+% 18-Nov-82 Alan Snyder
+% Added move-up-list, move-over-list, and move-over-defun commands.
+% Changed skip-forward-blanks and skip-backward-blanks.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int))
+
+(fluid '(nmode-current-buffer
+ nmode-command-argument
+ nmode-command-argument-given
+ nmode-previous-command-function))
+
+% Internal static variables:
+
+(fluid '(nmode-goal-column % permanent goal (set by user)
+ nmode-temporary-goal-column % temporary goal within cmd sequence
+ nmode-goal-column-functions % cmds that don't reset temp goal
+ ))
+
+(setf nmode-goal-column nil)
+(setf nmode-temporary-goal-column nil)
+(setf nmode-goal-column-functions
+ (list
+ (function move-down-command)
+ (function move-down-extending-command)
+ (function move-up-command)
+ (function set-goal-column-command)
+ ))
+
+(de move-to-buffer-start-command ()
+ (set-mark-from-point)
+ (move-to-buffer-start)
+ )
+
+(de move-to-buffer-end-command ()
+ (set-mark-from-point)
+ (move-to-buffer-end)
+ )
+
+(de move-to-start-of-line-command ()
+ (current-buffer-goto (+ (current-line-pos) (- nmode-command-argument 1)) 0)
+ )
+
+(de move-to-end-of-line-command ()
+ (move-to-start-of-line-command)
+ (move-to-end-of-line))
+
+(de set-goal-column-command ()
+ (cond ((= nmode-command-argument 1)
+ (setf nmode-goal-column (current-display-column))
+ (write-prompt (BldMsg "Goal Column = %p" nmode-goal-column))
+ )
+ (t
+ (setf nmode-goal-column NIL)
+ (write-prompt "No Goal Column")
+ )))
+
+(de setup-goal-column ()
+ % If this is the first in a new (potential) sequence of up/down commands,
+ % then set the temporary goal column for that sequence of commands.
+ (if (not (memq nmode-previous-command-function nmode-goal-column-functions))
+ (setf nmode-temporary-goal-column (current-display-column)))
+ )
+
+(de goto-goal-column ()
+ % Move the cursor to the current goal column, which is the permanent goal
+ % column (if set by the user) or the temporary goal column (otherwise).
+ (cond (nmode-goal-column
+ (set-display-column nmode-goal-column))
+ (nmode-temporary-goal-column
+ (set-display-column nmode-temporary-goal-column))
+ ))
+
+(de move-up-command ()
+ (setup-goal-column)
+ (set-line-pos (- (current-line-pos) nmode-command-argument))
+ (goto-goal-column)
+ )
+
+(de move-down-extending-command ()
+ (when (and (not nmode-command-argument-given) (current-line-is-last?))
+ (let ((old-pos (buffer-get-position)))
+ (move-to-buffer-end)
+ (insert-eol)
+ (buffer-set-position old-pos)
+ ))
+ (move-down-command)
+ )
+
+(de move-down-command ()
+ (setup-goal-column)
+ (set-line-pos (+ (current-line-pos) nmode-command-argument))
+ (goto-goal-column)
+ )
+
+(de exchange-point-and-mark ()
+ (let ((old-mark (current-mark)))
+ (previous-mark) % pop off the old mark
+ (set-mark-from-point) % push the new one
+ (buffer-set-position old-mark)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Skipping Blanks
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de char-blank-or-newline? (ch)
+ (or (char-blank? ch) (= ch #\LF)))
+
+(de skip-forward-blanks ()
+ % Skip over "blanks", return the first non-blank character seen.
+ % Cursor is positioned to the left of that character.
+ (while (and (not (at-buffer-end?))
+ (char-blank-or-newline? (next-character))
+ )
+ (move-forward))
+ (next-character))
+
+(de skip-backward-blanks ()
+ % Skip backwards over "blanks", return the first non-blank character seen.
+ % Cursor is positioned to the right of that character.
+ (while (and (not (at-buffer-start?))
+ (char-blank-or-newline? (previous-character))
+ )
+ (move-backward))
+ (previous-character))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Over-Characters commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-character-command ()
+ (if (not (move-over-characters nmode-command-argument))
+ (Ding)))
+
+(de move-backward-character-command ()
+ (if (not (move-over-characters (- nmode-command-argument)))
+ (Ding)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Over-Word commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-word-command ()
+ (if (not (move-over-words nmode-command-argument))
+ (Ding)))
+
+(de move-backward-word-command ()
+ (if (not (move-over-words (- nmode-command-argument)))
+ (Ding)))
+
+(de move-over-words (n)
+ % Move forward (n>0) or backwards (n<0) over |n| words. Return T if the
+ % specified number of words were found, NIL otherwise. The cursor remains at
+ % the last word found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-word)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-word)))
+ (setf n (+ n 1)))
+ flag))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Over-Form commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-form-command ()
+ (if (not (move-over-forms nmode-command-argument))
+ (Ding)))
+
+(de move-backward-form-command ()
+ (if (not (move-over-forms (- nmode-command-argument)))
+ (Ding)))
+
+(de move-over-forms (n)
+ % Move forward (n>0) or backwards (n<0) over |n| forms. Return T if the
+ % specified number of forms were found, NIL otherwise. The cursor remains at
+ % the last form found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-form)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-form)))
+ (setf n (+ n 1)))
+ flag))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Up-List commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de forward-up-list-command ()
+ (if (not (move-up-lists nmode-command-argument))
+ (Ding)))
+
+(de backward-up-list-command ()
+ (if (not (move-up-lists (- nmode-command-argument)))
+ (Ding)))
+
+(de move-up-lists (n)
+ % Move forward (n>0) or backwards (n<0) out of |n| lists (structures).
+ % Return T if the specified number of brackets were found, NIL otherwise.
+ % The cursor remains at the last bracket found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-up-list)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-up-list)))
+ (setf n (+ n 1)))
+ flag
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Over-List commands
+%
+% Note: In EMACS, these commands were motivated by the fact that EMACS did
+% not understand Lisp comments. Thus, in EMACS, move-forward-list could be
+% used as a move-forward-form that ignored comments. Since NMODE does
+% understand comments, it is not clear that these commands have any use.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-list-command ()
+ (if (not (move-over-lists nmode-command-argument))
+ (Ding)))
+
+(de move-backward-list-command ()
+ (if (not (move-over-lists (- nmode-command-argument)))
+ (Ding)))
+
+(de move-over-lists (n)
+ % Move forward (n>0) or backwards (n<0) over |n| lists (structures).
+ % Return T if the specified number of lists were found, NIL otherwise.
+ % The cursor remains at the last list found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-list)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-list)))
+ (setf n (+ n 1)))
+ flag
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Over-Defun commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-defun-command ()
+ (if (not (move-over-defuns nmode-command-argument))
+ (Ding)))
+
+(de move-backward-defun-command ()
+ (if (not (move-over-defuns (- nmode-command-argument)))
+ (Ding)))
+
+(de move-over-defuns (n)
+ % Move forward (n>0) or backwards (n<0) over |n| defuns.
+ % Return T if the specified number of defuns were found, NIL otherwise.
+ % The cursor remains at the last defun found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-defun)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-defun)))
+ (setf n (+ n 1)))
+ flag
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Basic Character Movement Primitives
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-over-characters (n)
+ % Move forward (n>0) or backwards (n<0) over |n| characters. Return T if the
+ % specified number of characters were found, NIL otherwise. The cursor
+ % remains at the last character found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-character)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-character)))
+ (setf n (+ n 1)))
+ flag))
+
+(de move-forward-character ()
+ % Move forward one character. If there is no next character, leave cursor
+ % unchanged and return NIL; otherwise, return T.
+
+ (if (at-buffer-end?)
+ NIL
+ (move-forward)
+ T
+ ))
+
+(de move-backward-character ()
+ % Move backward one character. If there is no previous character, leave
+ % cursor unchanged and return NIL; otherwise, return T.
+
+ (if (at-buffer-start?)
+ NIL
+ (move-backward)
+ T
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Basic Character Movement Primitives (Hacking Tabs Version)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-over-characters-hacking-tabs (n)
+ % Move forward (n>0) or backwards (n<0) over |n| characters. Return T if the
+ % specified number of characters were found, NIL otherwise. The cursor
+ % remains at the last character found.
+
+ (let ((flag T))
+ (while (and (> n 0) (setf flag (move-forward-character-hacking-tabs)))
+ (setf n (- n 1)))
+ (while (and (< n 0) (setf flag (move-backward-character-hacking-tabs)))
+ (setf n (+ n 1)))
+ flag))
+
+(de move-forward-character-hacking-tabs ()
+ % Move forward one character. If the next character is a tab, first
+ % replace it with the appropriate number of spaces. If there is no next
+ % character, leave cursor unchanged and return NIL; otherwise, return T.
+
+ (if (at-buffer-end?)
+ NIL
+ (cond ((= (next-character) (char TAB))
+ (delete-next-character)
+ (let ((n (- 8 (& (current-display-column) 7))))
+ (insert-string (substring " " 0 n))
+ (set-char-pos (- (current-char-pos) n))
+ )))
+ (move-forward)
+ T
+ ))
+
+(de move-backward-character-hacking-tabs ()
+ % Move backward one character. If the previous character is a tab, first
+ % replace it with the appropriate number of spaces. If there is no previous
+ % character, leave cursor unchanged and return NIL; otherwise, return T.
+
+ (if (at-buffer-start?)
+ NIL
+ (cond ((= (previous-character) (char TAB))
+ (delete-previous-character)
+ (let ((n (- 8 (& (current-display-column) 7))))
+ (insert-string (substring " " 0 n))
+ )))
+ (move-backward)
+ T
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Basic Word Movement Primitives
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de word-char? (ch)
+ (or (AlphanumericP ch) (= ch (char -))))
+
+(de move-forward-word ()
+ % Move forward one "word", starting from point. Leave cursor to the
+ % right of the "word". If there is no next word, leave cursor unchanged
+ % and return NIL; otherwise, return T.
+
+ (let ((old-pos (buffer-get-position)))
+ (while (and (not (at-buffer-end?)) % scan for start of word
+ (not (word-char? (next-character)))
+ )
+ (move-forward))
+ (cond ((at-buffer-end?)
+ (buffer-set-position old-pos)
+ NIL
+ )
+ (t
+ (while (and (not (at-buffer-end?)) % scan for end of word
+ (word-char? (next-character))
+ )
+ (move-forward))
+ T
+ ))))
+
+(de move-backward-word ()
+ % Move backward one "word", starting from point. Leave cursor to the left of
+ % the "word". If there is no previous word, leave cursor unchanged and
+ % return NIL; otherwise, return T.
+
+ (let ((old-pos (buffer-get-position)))
+ (while (and (not (at-buffer-start?)) % scan for end of word
+ (not (word-char? (previous-character)))
+ )
+ (move-backward))
+ (cond ((at-buffer-start?)
+ (buffer-set-position old-pos)
+ NIL
+ )
+ (t
+ (while (and (not (at-buffer-start?)) % scan for start of word
+ (word-char? (previous-character))
+ )
+ (move-backward))
+ T
+ ))))
ADDED psl-1983/3-1/nmode/nmode-20.lap
Index: psl-1983/3-1/nmode/nmode-20.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-20.lap
@@ -0,0 +1,2 @@
+(faslin "pnb:nmode-20.b")
+(load-nmode)
ADDED psl-1983/3-1/nmode/nmode-20.sl
Index: psl-1983/3-1/nmode/nmode-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-20.sl
@@ -0,0 +1,221 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-20.SL - DEC-20 NMODE Stuff (intended for DEC-20 Version Only)
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 24 January 1983
+% Revised: 5 April 1983
+%
+% 5-Apr-83 Alan Snyder
+% Add load-nmode and set-terminal stuff to make it more like other systems.
+% 15-Mar-83 Alan Snyder
+% Add nmode-print-device.
+% 25-Jan-83 Alan Snyder
+% Add version of actualize-file-name that ensures that transiently-created
+% file has delete access.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime
+ (load useful common fast-strings))
+
+% External variables used here:
+
+(fluid '(nmode-file-list
+ nmode-source-prefix
+ nmode-binary-prefix
+ *usermode
+ *redefmsg
+ doc-text-file
+ reference-text-file
+ nmode-print-device
+ nmode-terminal
+ ))
+
+% Global variables defined here:
+
+(fluid '(terminal-type))
+
+
+(if (or (unboundp 'nmode-source-prefix) (null nmode-source-prefix))
+ (setf nmode-source-prefix "pn:"))
+
+(if (or (unboundp 'nmode-binary-prefix) (null nmode-binary-prefix))
+ (setf nmode-binary-prefix "pnb:"))
+
+(de load-nmode ()
+ % Load NMODE.
+ % Any system-dependent customization is done here so that it can
+ % be overridden by the user before NMODE is initialized.
+
+ (nmode-load-required-modules)
+ (nmode-load-all)
+ (setf nmode-print-device "LPT:")
+ % Set up "pointers" to online documentation.
+ (setf doc-text-file "SS:<PSL.NMODE-DOC>FRAMES.LPT")
+ (setf reference-text-file "SS:<PSL.NMODE-DOC>COSTLY.SL")
+ (let ((*usermode nil) (*redefmsg nil))
+ (copyd 'actualize-file-name 'dec20-actualize-file-name)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Terminal Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-set-terminal ()
+ (setf terminal-type (jsys2 65 0 0 0 (const jsgttyp)))
+ (selectq terminal-type
+ (21 % HP2621
+ (ensure-terminal-type 'hp2648a)
+ )
+ (6 % HP264X
+ (ensure-terminal-type 'hp2648a)
+ )
+ (15 % VT52
+ (ensure-terminal-type 'vt52x)
+ )
+ (t
+ (or nmode-terminal (ensure-terminal-type 'hp2648a))
+ )
+ ))
+
+
+% These functions defined for compatibility:
+
+(de hp2648a () (ensure-terminal-type 'hp2648a))
+(de vt52x () (ensure-terminal-type 'vt52x))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% System-Dependent Stuff:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-date-time () % Stolen directly from Nancy Kendzierski
+ % Date/time in appropriate format for the network mail header
+ (let ((date-time (MkString 80)))
+ (jsys1 date-time -1 #.(bits 5 7 10 12 13) 0 (const jsODTIM))
+ (recopystringtonull date-time)))
+
+(de dec20-actualize-file-name (file-name)
+ % If the specified file exists, return its "true" (and complete) name.
+ % Otherwise, return the "true" name of the file that would be created if one
+ % were to do so. (Unfortunately, we have no way to do this except by actually
+ % creating the file and then deleting it!) Return NIL if the file cannot be
+ % read or created.
+
+ (let ((s (attempt-to-open-input file-name)))
+ (cond ((not s)
+ (setf s (attempt-to-open-output
+ (string-concat file-name ";P777777") % so we can delete it!
+ ))
+ (when s
+ (setf file-name (=> s file-name))
+ (=> s close)
+ (file-delete-and-expunge file-name)
+ file-name
+ )
+ )
+ (t
+ (setf file-name (=> s file-name))
+ (=> s close)
+ file-name
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building NMODE:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-load-required-modules ()
+ (load objects)
+ (load common)
+ (load useful)
+ (load strings)
+ (load pathnames)
+ (load pathnamex)
+ (load ring-buffer)
+ (load extended-char)
+ (load directory)
+ (load input-stream)
+ (load output-stream)
+ (load processor-time)
+ (load wait)
+ (load vector-fix)
+ (load nmode-parsing)
+ (load rawio)
+ (load windows)
+ )
+
+(de nmode-fixup-name (s) s)
+
+(de nmode-load-all ()
+ (for (in s nmode-file-list)
+ (do (nmode-load s))
+ ))
+
+(de nmode-load (s)
+ (nmode-faslin nmode-binary-prefix s)
+ )
+
+(de nmode-faslin (directory-name module-name)
+ (setf module-name (nmode-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf nmode-file-list
+ (list
+ "browser"
+ "browser-support"
+ "buffer"
+ "buffer-io"
+ "buffer-position"
+ "buffer-window"
+ "buffers"
+ "case-commands"
+ "command-input"
+ "commands"
+ "defun-commands"
+ "dispatch"
+ "extended-input"
+ "fileio"
+ "incr"
+ "indent-commands"
+ "kill-commands"
+ "lisp-commands"
+ "lisp-indenting"
+ "lisp-interface"
+ "lisp-parser"
+ "m-x"
+ "m-xcmd"
+ "modes"
+ "mode-defs"
+ "move-commands"
+ "nmode-break"
+ "nmode-init"
+ "prompting"
+ "query-replace"
+ "reader"
+ "rec"
+ "screen-layout"
+ "search"
+ "softkeys"
+ "structure-functions"
+ "terminal-input"
+ "text-buffer"
+ "text-commands"
+ "window"
+ "window-label"
+
+ % These must be last:
+
+ "autofill"
+ "browser-browser"
+ "buffer-browser"
+ "dired"
+ "doc"
+ ))
ADDED psl-1983/3-1/nmode/nmode-9836.lap
Index: psl-1983/3-1/nmode/nmode-9836.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-9836.lap
@@ -0,0 +1,2 @@
+(faslin "pnb:nmode-9836.b")
+(load-nmode)
ADDED psl-1983/3-1/nmode/nmode-9836.sl
Index: psl-1983/3-1/nmode/nmode-9836.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-9836.sl
@@ -0,0 +1,277 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-9836.SL - HP9836 Nmode Stuff (intended only for HP9836 version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 20 January 1983
+% Revised: 5 April 1983
+%
+% 5-Apr-83 Alan Snyder
+% Changes relating to keeping NMODE source and binary files in separate
+% directories. Add NMODE-SET-TERMINAL from old set-terminal file.
+% Remove set-terminal from list of source files.
+% 24-Mar-83 Alan Snyder
+% External function renamed: System-Date -> Date-and-Time.
+% 15-Mar-83 Alan Snyder
+% Add browser-browser. Implement current-date-time.
+% 4-Mar-83 Alan Snyder
+% Load pathnamex. Load nmode-aids (instead of lapin).
+% 15-Feb-83 Alan Snyder
+% No longer sets NMODE-AUTO-START (inconsistent with other systems). Add new
+% online documentation stuff.
+% 7-Feb-83 Alan Snyder
+% Load browser.
+% 31-Jan-83 Alan Snyder
+% Add softkey stuff, keyboard mapping stuff, load window-label. Redefine
+% PasFiler and PasEditor to refresh the screen upon exit, if NMODE was
+% running.
+% 25-Jan-83 Alan Snyder
+% Added dummy version of current-date-time function; load M-XCMD and REC.
+% 21-Jan-83 Alan Snyder
+% Load more stuff. Change INIT to return NIL.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings fast-int extended-char))
+(bothtimes (load strings common))
+
+(fluid '(alpha-terminal
+ color-terminal
+ nmode-file-list
+ nmode-source-prefix
+ nmode-binary-prefix
+ *quiet_faslout
+ *usermode
+ *redefmsg
+ installkeys-address
+ uninstallkeys-address
+ nmode-softkey-label-screen-height
+ nmode-softkey-label-screen-width
+ doc-text-file
+ reference-text-file
+ ))
+
+(if (or (unboundp 'nmode-source-prefix) (null nmode-source-prefix))
+ (setf nmode-source-prefix "pn:"))
+
+(if (or (unboundp 'nmode-binary-prefix) (null nmode-binary-prefix))
+ (setf nmode-binary-prefix "pnb:"))
+
+(if (funboundp 'pre-nmode-main)
+ (copyd 'pre-nmode-main 'main))
+
+(if (funboundp 'pre-nmode-pasfiler)
+ (copyd 'pre-nmode-pasfiler 'pasfiler))
+
+(if (funboundp 'pre-nmode-paseditor)
+ (copyd 'pre-nmode-paseditor 'paseditor))
+
+(setf installkeys-address (system-address "NMODEKEYS_INSTALL_KEYMAP"))
+(setf uninstallkeys-address (system-address "NMODEKEYS_UNINSTALL_KEYMAP"))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% 9836 Customization:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-9836-init ()
+ % This function modifies "standard" NMODE for use on the 9836.
+ (let ((*usermode nil) (*redefmsg nil))
+ (copyd 'nmode-initialize 'original-nmode-initialize)
+ (copyd 'actualize-file-name '9836-actualize-file-name)
+ )
+ (original-nmode-initialize)
+ (add-to-command-list 'basic-command-list (x-chars C-X C-Z) 'exit-nmode)
+ (nmode-establish-current-mode)
+ (setf alpha-terminal nmode-terminal)
+ (setf color-terminal (make-instance '9836-color))
+ nil % for looks
+ )
+
+(de nmode-set-terminal ()
+ (or nmode-terminal (ensure-terminal-type '9836-alpha))
+ (or nmode-other-terminal (ensure-other-terminal-type '9836-color))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Useful Functions for Compiling:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de load-nmode ()
+ % Load NMODE.
+ % Any system-dependent customization is done here so that it can
+ % be overrided by the user before nmode is initialized.
+ (nmode-load-required-modules)
+ (nmode-load-all)
+ (setf nmode-softkey-label-screen-height 2) % two rows
+ (setf nmode-softkey-label-screen-width 5) % of five keys each
+ (setf doc-text-file "psl:nmode.frames")
+ (setf reference-text-file "psl:nmode.xref")
+ (let ((*usermode nil) (*redefmsg nil))
+ (if (funboundp 'original-nmode-initialize)
+ (copyd 'original-nmode-initialize 'nmode-initialize))
+ (copyd 'nmode-initialize 'nmode-9836-init)
+ ))
+
+(de compile-lisp-file (source-name object-name)
+ (let ((*quiet_faslout T))
+ (if (not (filep source-name))
+ (printf "Unable to open source file: %w%n" source-name)
+ % else
+ (printf "%n----- Compiling %w to %w%n"
+ source-name (string-concat object-name ".b"))
+ (faslout object-name)
+ (unwind-protect
+ (dskin source-name)
+ (faslend)
+ )
+ (printf "%n----------------------------------------------------------%n")
+ )))
+
+(de file-compile (s)
+ (let ((object-name s)
+ (source-name (string-concat s ".sl"))
+ )
+ (compile-lisp-file source-name object-name)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% System-Dependent Stuff:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-date-time () (date-and-time))
+
+(de 9836-actualize-file-name (fn) fn)
+
+(de nmode-use-color ()
+ % Use the COLOR screen (only).
+ (setf nmode-terminal color-terminal)
+ (nmode-new-terminal)
+ )
+
+(de nmode-use-alpha ()
+ % Use the ALPHA screen as the primary screen.
+ (setf nmode-terminal alpha-terminal)
+ (nmode-new-terminal)
+ )
+
+(de install-nmode-keymap ()
+ (setf nmode-meta-bit-prefix-character (x-char ^!\))
+ (lpcall0 installkeys-address)
+ )
+
+(de uninstall-nmode-keymap ()
+ (setf nmode-meta-bit-prefix-character (x-char ^![))
+ (lpcall0 uninstallkeys-address)
+ )
+
+(de pasfiler ()
+ (pre-nmode-pasfiler)
+ (if *NMODE-RUNNING (nmode-full-refresh))
+ )
+
+(de paseditor ()
+ (pre-nmode-paseditor)
+ (if *NMODE-RUNNING (nmode-full-refresh))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building NMODE:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-load-required-modules ()
+ (load addr2id)
+ (load objects)
+ (load common)
+ (load useful)
+ (load strings)
+ (load pathnames)
+ (load pathnamex)
+ (load ring-buffer)
+ (load extended-char)
+ (load directory)
+ (load input-stream)
+ (load output-stream)
+ (load processor-time)
+ (load wait)
+ (load vector-fix)
+ (load nmode-parsing)
+ (load windows)
+ (load nmode-aids)
+ )
+
+(de nmode-fixup-name (s) s)
+
+(de nmode-load-all ()
+ (for (in s nmode-file-list)
+ (do (nmode-load s))
+ ))
+
+(de nmode-load (s)
+ (nmode-faslin nmode-binary-prefix s)
+ )
+
+(de nmode-faslin (directory-name module-name)
+ (setf module-name (nmode-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf nmode-file-list
+ (list
+ "browser"
+ "browser-support"
+ "buffer"
+ "buffer-io"
+ "buffer-position"
+ "buffer-window"
+ "buffers"
+ "case-commands"
+ "command-input"
+ "commands"
+ "defun-commands"
+ "dispatch"
+ "extended-input"
+ "fileio"
+ "incr"
+ "indent-commands"
+ "kill-commands"
+ "lisp-commands"
+ "lisp-indenting"
+ "lisp-interface"
+ "lisp-parser"
+ "m-x"
+ "m-xcmd"
+ "modes"
+ "mode-defs"
+ "move-commands"
+ "nmode-break"
+ "nmode-init"
+ "prompting"
+ "query-replace"
+ "reader"
+ "rec"
+ "screen-layout"
+ "search"
+ "softkeys"
+ "structure-functions"
+ "terminal-input"
+ "text-buffer"
+ "text-commands"
+ "window"
+ "window-label"
+
+ % These must be last:
+
+ "autofill"
+ "browser-browser"
+ "buffer-browser"
+ "dired"
+ "doc"
+ ))
+
ADDED psl-1983/3-1/nmode/nmode-attributes.sl
Index: psl-1983/3-1/nmode/nmode-attributes.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-attributes.sl
@@ -0,0 +1,124 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Nmode-Attributes.SL - macros for NMODE parsing primitives
+% [This file used to be Parsing-Attributes.SL]
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 22 November 1982
+%
+% This file defines Macros! Load it at compile-time!
+%
+% See the document NMODE-PARSING.TXT for a description of the parsing strategy.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int))
+
+% Internal Constants:
+
+% Type attributes:
+% Exactly one of these should always be on.
+
+(defconst OPENER-BITS 2#000000001) % part of an opening "bracket"
+(defconst CLOSER-BITS 2#000000010) % part of a closing "bracket"
+(defconst ATOM-BITS 2#000000100) % part of an "atom"
+(defconst BLANKS-BITS 2#000001000) % part of a "blank region"
+(defconst COMMENT-BITS 2#000010000) % part of a comment
+
+% Secondary attributes:
+% Zero or more of these may be on.
+
+(defconst PREFIX-BITS 2#000100000) % a subclass of opening bracket
+
+% Position attributes:
+% One or two of these should always be on.
+
+(defconst FIRST-BITS 2#001000000) % the first character of an item
+(defconst MIDDLE-BITS 2#010000000) % neither first nor last
+(defconst LAST-BITS 2#100000000) % the last character of an item
+
+% Masks:
+(defconst POSITION-BITS #.(| (const FIRST-BITS)
+ (| (const MIDDLE-BITS) (const LAST-BITS))))
+(defconst BRACKET-BITS #.(| (const OPENER-BITS) (const CLOSER-BITS)))
+(defconst WHITESPACE-BITS #.(| (const BLANKS-BITS) (const COMMENT-BITS)))
+
+(defconst NOT-SPACE-BITS #.(| (const BRACKET-BITS) (const ATOM-BITS)))
+(defconst PRIMARY-TYPE-BITS #.(| (const NOT-SPACE-BITS)
+ (const WHITESPACE-BITS)))
+(defconst SECONDARY-TYPE-BITS #.(const PREFIX-BITS))
+(defconst TYPE-BITS #.(| (const PRIMARY-TYPE-BITS)
+ (const SECONDARY-TYPE-BITS)))
+
+(de parse-character-attributes (attribute-list)
+ % Given a list of attribute names, return an integer containing
+ % all of their bits.
+
+ (let ((bits 0))
+ (for (in attribute-name attribute-list)
+ (do
+ (selectq attribute-name
+ (OPENER (setf bits (| bits (const OPENER-BITS))))
+ (CLOSER (setf bits (| bits (const CLOSER-BITS))))
+ (BRACKET (setf bits (| bits (const BRACKET-BITS))))
+ (ATOM (setf bits (| bits (const ATOM-BITS))))
+ (BLANKS (setf bits (| bits (const BLANKS-BITS))))
+ (COMMENT (setf bits (| bits (const COMMENT-BITS))))
+ (WHITESPACE (setf bits (| bits (const WHITESPACE-BITS))))
+ (NOT-SPACE (setf bits (| bits (const NOT-SPACE-BITS))))
+ (PREFIX (setf bits (| bits (const PREFIX-BITS))))
+ (FIRST (setf bits (| bits (const FIRST-BITS))))
+ (MIDDLE (setf bits (| bits (const MIDDLE-BITS))))
+ (LAST (setf bits (| bits (const LAST-BITS))))
+ (t (StdError
+ (BldMsg "Invalid character attribute: %p" attribute-name)))
+ )))
+ bits
+ ))
+
+(de unparse-character-attributes (bits)
+ % Return a list of attribute names.
+
+ (let ((l ()))
+ (if (~= 0 (& bits (const OPENER-BITS))) (setf l (cons 'OPENER l)))
+ (if (~= 0 (& bits (const CLOSER-BITS))) (setf l (cons 'CLOSER l)))
+ (if (~= 0 (& bits (const ATOM-BITS))) (setf l (cons 'ATOM l)))
+ (if (~= 0 (& bits (const BLANKS-BITS))) (setf l (cons 'BLANKS l)))
+ (if (~= 0 (& bits (const COMMENT-BITS))) (setf l (cons 'COMMENT l)))
+ (if (~= 0 (& bits (const PREFIX-BITS))) (setf l (cons 'PREFIX l)))
+ (if (~= 0 (& bits (const LAST-BITS))) (setf l (cons 'LAST l)))
+ (if (~= 0 (& bits (const MIDDLE-BITS))) (setf l (cons 'MIDDLE l)))
+ (if (~= 0 (& bits (const FIRST-BITS))) (setf l (cons 'FIRST l)))
+ l
+ ))
+
+(de decode-character-attribute-type (bits)
+ % Return a primary type attribute name or NIL.
+
+ (cond
+ ((~= 0 (& bits (const OPENER-BITS))) 'OPENER)
+ ((~= 0 (& bits (const CLOSER-BITS))) 'CLOSER)
+ ((~= 0 (& bits (const ATOM-BITS))) 'ATOM)
+ ((~= 0 (& bits (const BLANKS-BITS))) 'BLANKS)
+ ((~= 0 (& bits (const COMMENT-BITS))) 'COMMENT)
+ (t NIL)
+ ))
+
+(de fix-attribute-bits (bits)
+ (if (= (& bits (const POSITION-BITS)) 0)
+ % No position specified? Then any position will do.
+ (setf bits (| bits (const POSITION-BITS))))
+ (if (= (& bits (const TYPE-BITS)) 0)
+ % No type specified? Then any type will do.
+ (setf bits (| bits (const TYPE-BITS))))
+ bits
+ )
+
+(defmacro attributes attributes-list
+ (parse-character-attributes attributes-list)
+ )
+
+(defmacro test-attributes attributes-list
+ (fix-attribute-bits (parse-character-attributes attributes-list))
+ )
ADDED psl-1983/3-1/nmode/nmode-break.sl
Index: psl-1983/3-1/nmode/nmode-break.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-break.sl
@@ -0,0 +1,207 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-BREAK.SL - NMODE Break Handler
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 26 August 1982
+%
+% Adapted from Will Galway's EMODE
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects))
+(fluid '(*NMODE-RUNNING
+ *nmode-init-running
+ *OutWindow
+ nmode-terminal
+ nmode-command-argument
+ nmode-buffer-channel))
+
+(fluid '(BreakLevel* *QuitBreak BreakEval* BreakName* ERROUT* ErrorForm*))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% We redefine BREAK (the break handler) and YESP.
+% Grab the original versions (if we can find them!).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(if (FUnboundP 'pre-nmode-break)
+ (CopyD 'pre-nmode-break
+ (if (FUnboundP 'pre_rawio_break)
+ 'break
+ 'pre_rawio_break
+ )))
+
+(if (FUnboundP 'pre-nmode-yesp)
+ (CopyD 'pre-nmode-yesp 'yesp))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Initialization:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de enable-nmode-break ()
+ (let ((*usermode NIL)
+ (*redefmsg NIL)
+ )
+ (CopyD 'break 'nmode-break)
+ (CopyD 'yesp 'nmode-yesp)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Break handler:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-break ()
+ (cond (*NMODE-RUNNING (nmode-break-handler))
+ (t
+ (let ((old-raw-mode (=> nmode-terminal raw-mode)))
+ (leave-raw-mode)
+ (prog1
+ (pre-nmode-break)
+ (if old-raw-mode (enter-raw-mode))
+ )))))
+
+(de nmode-break-handler ()
+ (let* ((BreakLevel* (+ BreakLevel* 1))
+ (*QuitBreak T)
+ (BreakEval* 'Eval)
+ (BreakName* "NMODE Break")
+ (OldIN* IN*)
+ (OldOUT* OUT*)
+ (nmode-error? (eq in* 0))
+ (nmode-channel? (eq in* nmode-buffer-channel))
+ (init-error? *nmode-init-running)
+ (old-raw-mode (=> nmode-terminal raw-mode))
+ (*OutWindow T) % always pop up on a break
+ (*nmode-init-running NIL) % ditto
+ (*NMODE-RUNNING (not nmode-error?))
+ )
+ (cond (nmode-error?
+ (leave-raw-mode)
+ (RDS 0)
+ (WRS 1)
+ )
+ (t
+ (RDS nmode-buffer-channel)
+ (WRS nmode-buffer-channel)
+ (enter-raw-mode)
+ ))
+ (when init-error?
+ (Printf "Error occurred while executing your NMODE INIT file!%n")
+ (Ding)
+ )
+ (unwind-protect
+ (Catch '$Break$
+ (TopLoop 'Read 'Print 'BreakEval BreakName* "NMODE Break loop")
+ )
+ (RDS OldIN*)
+ (WRS OldOUT*)
+ (if old-raw-mode (enter-raw-mode))
+ )
+ (if *QuitBreak
+ (let ((*Break NIL)
+ (*EmsgP NIL)
+ )
+ (StdError "Exit to ErrorSet")))
+ )
+ (Eval ErrorForm*)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Break command functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de lisp-quit-command ()
+ (cond ((ensure-in-break)
+ (setf *QuitBreak T)
+ (throw '$Break$ NIL)
+ )))
+
+(de lisp-retry-command ()
+ (cond ((ensure-in-break)
+ (cond (*ContinuableError
+ (setf *QuitBreak NIL)
+ (throw '$Break$ NIL)
+ )
+ (t
+ (write-prompt "Cannot retry: error is not continuable.")
+ (Ding)))
+ )))
+
+(de lisp-continue-command ()
+ (cond ((ensure-in-break)
+ (cond (*ContinuableError
+ (setf ErrorForm* (MkQuote BreakValue*))
+ (setf *QuitBreak NIL)
+ (throw '$Break$ NIL)
+ )
+ (t
+ (write-prompt "Cannot continue: error is not continuable.")
+ (Ding)))
+ )))
+
+(de lisp-abort-command ()
+ (cond ((ensure-in-break)
+ (reset))))
+
+(de lisp-backtrace-command ()
+ (cond ((ensure-in-break)
+ (nmode-select-buffer-channel)
+ (cond ((>= nmode-command-argument 16) (VerboseBackTrace))
+ ((>= nmode-command-argument 4) (InterpBackTrace))
+ (t (BackTrace)))
+ (nmode-select-old-channels)
+ )))
+
+(de lisp-help-command ()
+ (write-message
+ (if (> BreakLevel* 0)
+ "Lisp break commands: Q-quit;A-abort;R-retry;C-continue;B-backtrace"
+ "Lisp commands: E-execute form;Y-yank last output;L-invoke Lisp Listener"
+ )))
+
+(de ensure-in-break ()
+ (if (> BreakLevel* 0)
+ T
+ (write-prompt "Not in a break loop!")
+ (Ding)
+ NIL
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Query functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-yesp (message)
+ (cond ((and *NMODE-RUNNING (=> nmode-terminal raw-mode))
+ (nmode-yes-or-no? message))
+ (t (pre-nmode-yesp message))
+ ))
+
+(de nmode-yes-or-no? (message)
+ (let ((response (prompt-for-string message NIL)))
+ (while T
+ (cond ((string-equal response "Yes") (exit T))
+ ((string-equal response "No") (exit NIL))
+ (t (Ding)
+ (write-prompt "Please answer YES or NO.")
+ (sleep-until-timeout-or-input 60)
+ (setf response (prompt-for-string message NIL))
+ )))))
+
+(de nmode-y-or-n? (message)
+ (write-message message)
+ (nmode-set-immediate-prompt "Y or N: ")
+ (let ((answer
+ (while T
+ (let ((ch (char-upcase (input-direct-terminal-character))))
+ (when (= ch #/Y) (nmode-complete-prompt "Y") (exit T))
+ (when (= ch #/N) (nmode-complete-prompt "N") (exit NIL))
+ (when (= ch #\BELL) (exit 'ABORT))
+ (Ding)
+ ))))
+ (set-prompt "")
+ (write-message "")
+ (if (eq answer 'ABORT) (throw 'ABORT NIL))
+ answer
+ ))
ADDED psl-1983/3-1/nmode/nmode-ex-20.sl
Index: psl-1983/3-1/nmode/nmode-ex-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-ex-20.sl
@@ -0,0 +1,238 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-20.SL - DEC-20 NMODE Stuff (intended for DEC-20 Version Only)
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 24 January 1983
+% Revised: 5 April 1983
+%
+% 15-Jun-83 Robert Kessler
+% Add ambassador, teleray and VT100 terminal support.
+% 5-Apr-83 Alan Snyder
+% Add load-nmode and set-terminal stuff to make it more like other systems.
+% 15-Mar-83 Alan Snyder
+% Add nmode-print-device.
+% 25-Jan-83 Alan Snyder
+% Add version of actualize-file-name that ensures that transiently-created
+% file has delete access.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime
+ (load useful common fast-strings))
+
+% External variables used here:
+
+(fluid '(nmode-file-list
+ nmode-source-prefix
+ nmode-binary-prefix
+ *usermode
+ *redefmsg
+ doc-text-file
+ reference-text-file
+ nmode-print-device
+ nmode-terminal
+ ))
+
+% Global variables defined here:
+
+(fluid '(terminal-type))
+
+
+(if (or (unboundp 'nmode-source-prefix) (null nmode-source-prefix))
+ (setf nmode-source-prefix "pn:"))
+
+(if (or (unboundp 'nmode-binary-prefix) (null nmode-binary-prefix))
+ (setf nmode-binary-prefix "pnb:"))
+
+(de load-nmode ()
+ % Load NMODE.
+ % Any system-dependent customization is done here so that it can
+ % be overridden by the user before NMODE is initialized.
+
+ (nmode-load-required-modules)
+ (nmode-load-all)
+ (setf nmode-print-device "LPT:")
+ % Set up "pointers" to online documentation.
+ (setf doc-text-file "PS:<PSL.DOC.NMODE>FRAMES.LPT")
+ (setf reference-text-file "PS:<PSL.DOC.NMODE>COSTLY.SL")
+ % Get our version of the prompt line with date/time
+ (load exec)
+ (faslin "pnb:window-label-rewrite.b")
+ (let ((*usermode nil) (*redefmsg nil))
+ (copyd 'actualize-file-name 'dec20-actualize-file-name)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Terminal Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-set-terminal ()
+ (setf terminal-type (jsys2 65 0 0 0 (const jsgttyp)))
+ (selectq terminal-type
+ (6 % HP264X
+ (ensure-terminal-type 'hp2648a)
+ )
+ (7 % Teleray
+ (ensure-terminal-type 'teleray)
+ )
+ (15 % VT52
+ (ensure-terminal-type 'vt52x)
+ )
+ (16 % VT100
+ (ensure-terminal-type 'vt100)
+ )
+ (19 % ambassador
+ (ensure-terminal-type 'ambassador)
+ )
+ (21 % HP2621
+ (ensure-terminal-type 'hp2648a)
+ )
+ (t
+ (or nmode-terminal (ensure-terminal-type 'hp2648a))
+ )
+ ))
+
+
+% These functions defined for compatibility:
+
+(de ambassador () (ensure-terminal-type 'ambassador))
+(de hp2648a () (ensure-terminal-type 'hp2648a))
+(de vt52x () (ensure-terminal-type 'vt52x))
+(de teleray () (ensure-terminal-type 'teleray))
+(de vt100 () (ensure-terminal-type 'vt100))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% System-Dependent Stuff:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-date-time () % Stolen directly from Nancy Kendzierski
+ % Date/time in appropriate format for the network mail header
+ (let ((date-time (MkString 80)))
+ (jsys1 date-time -1 #.(bits 5 7 10 12 13) 0 (const jsODTIM))
+ (recopystringtonull date-time)))
+
+(de dec20-actualize-file-name (file-name)
+ % If the specified file exists, return its "true" (and complete) name.
+ % Otherwise, return the "true" name of the file that would be created if one
+ % were to do so. (Unfortunately, we have no way to do this except by actually
+ % creating the file and then deleting it!) Return NIL if the file cannot be
+ % read or created.
+
+ (let ((s (attempt-to-open-input file-name)))
+ (cond ((not s)
+ (setf s (attempt-to-open-output
+ (string-concat file-name ";P777777") % so we can delete it!
+ ))
+ (when s
+ (setf file-name (=> s file-name))
+ (=> s close)
+ (file-delete-and-expunge file-name)
+ file-name
+ )
+ )
+ (t
+ (setf file-name (=> s file-name))
+ (=> s close)
+ file-name
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building NMODE:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-load-required-modules ()
+ (load objects)
+ (load common)
+ (load useful)
+ (load strings)
+ (load pathnames)
+ (load pathnamex)
+ (load ring-buffer)
+ (load extended-char)
+ (load directory)
+ (load input-stream)
+ (load output-stream)
+ (load processor-time)
+ (load wait)
+ (load vector-fix)
+ (load nmode-parsing)
+ (load rawio)
+ (load windows)
+ )
+
+(de nmode-fixup-name (s) s)
+
+(de nmode-load-all ()
+ (for (in s nmode-file-list)
+ (do (nmode-load s))
+ ))
+
+(de nmode-load (s)
+ (nmode-faslin nmode-binary-prefix s)
+ )
+
+(de nmode-faslin (directory-name module-name)
+ (setf module-name (nmode-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf nmode-file-list
+ (list
+ "browser"
+ "browser-support"
+ "buffer"
+ "buffer-io"
+ "buffer-position"
+ "buffer-window"
+ "buffers"
+ "case-commands"
+ "command-input"
+ "commands"
+ "defun-commands"
+ "dispatch"
+ "extended-input"
+ "fileio"
+ "incr"
+ "indent-commands"
+ "kill-commands"
+ "lisp-commands"
+ "lisp-indenting"
+ "lisp-interface"
+ "lisp-parser"
+ "m-x"
+ "m-xcmd"
+ "modes"
+ "mode-defs"
+ "move-commands"
+ "nmode-break"
+ "nmode-init"
+ "prompting"
+ "query-replace"
+ "reader"
+ "rec"
+ "screen-layout"
+ "search"
+ "softkeys"
+ "structure-functions"
+ "terminal-input"
+ "text-buffer"
+ "text-commands"
+ "window"
+ "window-label"
+
+ % These must be last:
+
+ "autofill"
+ "browser-browser"
+ "buffer-browser"
+ "dired"
+ "doc"
+ ))
ADDED psl-1983/3-1/nmode/nmode-init.sl
Index: psl-1983/3-1/nmode/nmode-init.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-init.sl
@@ -0,0 +1,50 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-INIT.SL - NMODE Initialization
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 24 August 1982
+% Revised: 11 March 1983
+%
+% 11-Mar-83 Alan Snyder
+% Buffer-Create-Unselectable -> Create-Unnamed-Buffer.
+% Create buffer browser.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects))
+
+(fluid '(lisp-interface-mode
+ input-mode
+ nmode-main-buffer
+ nmode-output-buffer
+ nmode-input-buffer
+ nmode-initialized
+ ))
+
+(setf nmode-initialized NIL)
+
+(de nmode-initialize ()
+ (cond ((not nmode-initialized)
+ (nmode-initialize-extended-input)
+ (nmode-initialize-modes)
+ (nmode-initialize-buffers) % modes must be initialized previously
+ (nmode-initialize-screen-layout) % buffers must be init previously
+ (nmode-initialize-kill-ring)
+ (create-buffer-browser)
+ (enable-nmode-break)
+ (setf nmode-initialized T)
+ )))
+
+(de nmode-initialize-buffers ()
+ (if (null nmode-main-buffer)
+ (setf nmode-main-buffer
+ (buffer-create "MAIN" lisp-interface-mode)))
+ (if (null nmode-output-buffer)
+ (setf nmode-output-buffer
+ (buffer-create "OUTPUT" lisp-interface-mode)))
+ (if (null nmode-input-buffer)
+ (setf nmode-input-buffer
+ (create-unnamed-buffer input-mode)))
+ )
ADDED psl-1983/3-1/nmode/nmode-parsing.sl
Index: psl-1983/3-1/nmode/nmode-parsing.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-parsing.sl
@@ -0,0 +1,143 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-Parsing.SL - NMODE parsing primitives
+% [This file used to be Parsing-Functions.SL]
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 10 December 1982
+% Revised: 6 January 1983
+%
+% This file defines Macros! Load it at compile-time!
+%
+% This file defines the basic primitives used by NMODE functions to analyze
+% source code. See the document NMODE-PARSING.TXT for a description of the
+% parsing strategy.
+%
+% 6-Jan-83 Alan Snyder
+% Use LOAD instead of FASLIN to get macros (for portability).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int fast-strings fast-vectors))
+(BothTimes (load nmode-attributes))
+
+% Global Variables:
+
+(fluid '(nmode-current-parser))
+(setf nmode-current-parser 'lisp-parse-line)
+
+% Internal Static Variables:
+
+(fluid '(nmode-parsed-line
+ nmode-parsed-line-info
+ ))
+
+(setf nmode-parsed-line NIL)
+(setf nmode-parsed-line-info (make-vector 200 0))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% These are the exported functions:
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro test-current-attributes attributes-list
+ `(test-current-attributes-bits (test-attributes ,@attributes-list))
+ )
+
+(defmacro move-forward-to attributes-list
+ `(move-forward-to-bits (test-attributes ,@attributes-list))
+ )
+
+(defmacro move-backward-to attributes-list
+ `(move-backward-to-bits (test-attributes ,@attributes-list))
+ )
+
+(defmacro move-forward-within-line-to attributes-list
+ `(move-forward-within-line-to-bits (test-attributes ,@attributes-list))
+ )
+
+(defmacro move-backward-within-line-to attributes-list
+ `(move-backward-within-line-to-bits (test-attributes ,@attributes-list))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% These are internal, non-primitive functions:
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de test-current-attributes-bits (bits)
+ (let* ((x (current-attributes))
+ (match-bits (& x bits))
+ )
+ (and (~= 0 (& match-bits (const POSITION-BITS)))
+ (~= 0 (& match-bits (const TYPE-BITS)))
+ )))
+
+(de move-forward-to-bits (bits)
+ (move-forward-to-bits-until bits #'at-buffer-end?))
+
+(de move-backward-to-bits (bits)
+ (move-backward-to-bits-until bits #'at-buffer-start?))
+
+(de move-forward-within-line-to-bits (bits)
+ (move-forward-to-bits-until bits #'at-line-end?))
+
+(de move-backward-within-line-to-bits (bits)
+ (move-backward-to-bits-until bits #'at-line-start?))
+
+(de move-forward-to-bits-until (bits stop-predicate)
+ (let ((old-pos (buffer-get-position)))
+ (while T
+ (when (apply stop-predicate ()) (buffer-set-position old-pos) (exit NIL))
+ (when (test-current-attributes-bits bits)
+ (exit (decode-character-attribute-type (current-attributes))))
+ (move-forward-character)
+ )))
+
+(de move-backward-to-bits-until (bits stop-predicate)
+ (let ((old-pos (buffer-get-position)))
+ (while T
+ (when (test-current-attributes-bits bits)
+ (exit (decode-character-attribute-type (current-attributes))))
+ (when (apply stop-predicate ()) (buffer-set-position old-pos) (exit NIL))
+ (move-backward-character)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% The (internal) primitive parsing function:
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-attributes ()
+ (let* ((str (current-line))
+ (len (string-length str))
+ (pos (current-char-pos))
+ )
+ (if (>= pos len)
+ (attributes FIRST LAST BLANKS)
+ % Otherwise
+ (when (not (eq nmode-parsed-line str))
+ (setf nmode-parsed-line str)
+ (if (< (vector-size nmode-parsed-line-info) len)
+ (setf nmode-parsed-line-info (make-vector len 0)))
+ (apply nmode-current-parser
+ (list nmode-parsed-line nmode-parsed-line-info))
+ )
+ (vector-fetch nmode-parsed-line-info pos)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Testing code:
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load extended-char))
+(de show-current-character ()
+ (write-prompt
+ (bldmsg "%l" (unparse-character-attributes (current-attributes)))))
+%(set-text-command (x-char C-=) 'show-current-character)
ADDED psl-1983/3-1/nmode/nmode-vax.lap
Index: psl-1983/3-1/nmode/nmode-vax.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-vax.lap
@@ -0,0 +1,2 @@
+(faslin "$pnb/nmode-vax.b")
+(load-nmode)
ADDED psl-1983/3-1/nmode/nmode-vax.sl
Index: psl-1983/3-1/nmode/nmode-vax.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode-vax.sl
@@ -0,0 +1,219 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% NMODE-VAX.SL Vax-Unix specific loading and modifications for NMODE.
+%
+% Author: William F. Galway
+% University of Utah
+% Date: 28 March 1983
+% Revised: 5 April 1983
+%
+% 7-Apr-83 Nancy Kendzierski
+% Added knowledge about hp and 2641 terminal types to table.
+% 5-Apr-83 Alan Snyder
+% Revised to be more like the 9836 code: add load-nmode stuff and set-terminal
+% stuff.
+%
+% This file contains functions to load NMODE and make some final changes to
+% customize things for Vax-Unix. Some modules for NMODE are unimplemented on
+% the Vax, thus not loaded for now; these are commented out with a "%*".
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime
+ (load useful common fast-strings))
+
+
+% External variables used here:
+
+(fluid '(nmode-file-list
+ nmode-source-prefix
+ nmode-binary-prefix
+ *usermode
+ *redefmsg
+ doc-text-file
+ reference-text-file
+ nmode-terminal
+ ))
+
+% Global variables defined here:
+
+(fluid
+ '(
+ % Association list of (Unix-TERM-name . NMODE-terminal-name). The
+ % Unix-TERM-name is a string, the NMODE-terminal-name is an identifier.
+ term-name-table
+ ))
+
+(setf term-name-table
+ '(
+% ("t10" . teleray)
+% ("aaa" . ambassador)
+ ("hp" . hp2648a)
+ ("2621" . hp2648a)
+ ("vt52" . vt52x)))
+
+(if (or (unboundp 'nmode-source-prefix) (null nmode-source-prefix))
+ (setf nmode-source-prefix "$pn/"))
+
+(if (or (unboundp 'nmode-binary-prefix) (null nmode-binary-prefix))
+ (setf nmode-binary-prefix "$pnb/"))
+
+(if (funboundp 'pre-nmode-main)
+ (copyd 'pre-nmode-main 'main))
+
+(de load-nmode ()
+ % Load NMODE.
+ % Any system-dependent customization is done here so that it can
+ % be overrided by the user before nmode is initialized.
+ (nmode-load-required-modules)
+ (nmode-load-all)
+ % Set up "pointers" to online documentation.
+ (setf doc-text-file "$pn/ONLINE-DOCS/frames.lpt")
+ (setf reference-text-file "$pn/ONLINE-DOCS/costly.sl")
+ (let ((*usermode nil) (*redefmsg nil))
+ (copyd 'actualize-file-name 'vax-actualize-file-name)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Terminal Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-set-terminal ()
+ % Needs better error handling?
+ (let* (
+ % Get terminal name from the system.
+ (system-term-type (GetEnv "TERM"))
+ % Map to NMODE name.
+ (table-entry
+ (assoc system-term-type term-name-table))
+ (terminal-type
+ (cond
+ (table-entry
+ (cdr table-entry))
+ (T
+ (StdError
+ (BldMsg "%r is unsupported terminal type" system-term-type))
+ ))))
+
+ (ensure-terminal-type terminal-type)))
+
+
+% These functions defined for compatibility:
+
+(de hp2648a () (ensure-terminal-type 'hp2648a))
+(de vt52x () (ensure-terminal-type 'vt52x))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% System-Dependent Stuff:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de vax-actualize-file-name (file-name)
+ (cond
+ % If the file-name starts with a character that's "special" to
+ % Unix, just pass it on through.
+ ((MemQ (string-fetch file-name 0) '(#// #/~ #/$))
+ file-name)
+ (T
+ % Otherwise, tack the current working directory onto the front
+ % of the name.
+ (string-concat (pwd) file-name))))
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building NMODE:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-load-required-modules ()
+ (load objects)
+ (load common)
+ (load useful)
+ (load strings)
+ (load pathnames)
+ (load pathnamex)
+ (load ring-buffer)
+ (load extended-char)
+ %* (load directory)
+ (load input-stream)
+ (load output-stream)
+ %* (load processor-time)
+ (load wait)
+ (load vector-fix)
+ (load nmode-parsing)
+ (load windows)
+ (load rawio)
+ )
+
+(de nmode-fixup-name (s) s)
+
+(de nmode-load-all ()
+ (for (in s nmode-file-list)
+ (do (nmode-load s))
+ ))
+
+(de nmode-load (s)
+ (nmode-faslin nmode-binary-prefix s)
+ )
+
+(de nmode-faslin (directory-name module-name)
+ (setf module-name (nmode-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf nmode-file-list
+ (list
+ "browser"
+ "browser-support"
+ "buffer"
+ "buffer-io"
+ "buffer-position"
+ "buffer-window"
+ "buffers"
+ "case-commands"
+ "command-input"
+ "commands"
+ "defun-commands"
+ "dispatch"
+ "extended-input"
+ "fileio"
+ "incr"
+ "indent-commands"
+ "kill-commands"
+ "lisp-commands"
+ "lisp-indenting"
+ "lisp-interface"
+ "lisp-parser"
+ "m-x"
+ "m-xcmd"
+ "modes"
+ "mode-defs"
+ "move-commands"
+ "nmode-break"
+ "nmode-init"
+ "prompting"
+ "query-replace"
+ "reader"
+ "rec"
+ "screen-layout"
+ "search"
+ "softkeys"
+ "structure-functions"
+ "terminal-input"
+ "text-buffer"
+ "text-commands"
+ "window"
+ "window-label"
+
+ % These must be last:
+
+ "autofill"
+ "browser-browser"
+ "buffer-browser"
+ %* "dired"
+ "doc"
+ ))
ADDED psl-1983/3-1/nmode/nmode.lap
Index: psl-1983/3-1/nmode/nmode.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/nmode.lap
@@ -0,0 +1,68 @@
+(load directory)
+(load extended-char)
+(load input-stream)
+(load objects)
+(load output-stream)
+(load nmode-parsing)
+(load pathnames)
+(load pathnamex)
+(load processor-time)
+(load rawio)
+(load ring-buffer)
+(load vector-fix) % for TruncateVector
+(load windows)
+
+(faslin "pn:browser.b")
+(faslin "pn:browser-support.b")
+(faslin "pn:buffer.b")
+(faslin "pn:buffer-io.b")
+(faslin "pn:buffer-position.b")
+(faslin "pn:buffer-window.b")
+(faslin "pn:buffers.b")
+(faslin "pn:case-commands.b")
+(faslin "pn:command-input.b")
+(faslin "pn:commands.b")
+(faslin "pn:defun-commands.b")
+(faslin "pn:dispatch.b")
+(faslin "pn:extended-input.b")
+(faslin "pn:fileio.b")
+(faslin "pn:incr.b")
+(faslin "pn:indent-commands.b")
+(faslin "pn:kill-commands.b")
+(faslin "pn:lisp-commands.b")
+(faslin "pn:lisp-indenting.b")
+(faslin "pn:lisp-interface.b")
+(faslin "pn:lisp-parser.b")
+(faslin "pn:m-x.b")
+(faslin "pn:m-xcmd.b")
+(faslin "pn:modes.b")
+(faslin "pn:mode-defs.b")
+(faslin "pn:move-commands.b")
+(faslin "pn:nmode-break.b")
+(faslin "pn:nmode-init.b")
+(faslin "pn:prompting.b")
+(faslin "pn:query-replace.b")
+(faslin "pn:reader.b")
+(faslin "pn:rec.b")
+(faslin "pn:screen-layout.b")
+(faslin "pn:search.b")
+(faslin "pn:set-terminal.b") % compiled from set-terminal-20, etc.
+(faslin "pn:softkeys.b")
+(faslin "pn:structure-functions.b")
+(faslin "pn:terminal-input.b")
+(faslin "pn:text-buffer.b")
+(faslin "pn:text-commands.b")
+(faslin "pn:window.b")
+(faslin "pn:window-label.b")
+
+% This redefines things:
+
+(faslin "pn:nmode-20.b")
+
+% Subsystems: load last! (they define modes at load-time)
+
+(faslin "pn:autofill.b")
+(faslin "pn:browser-browser.b")
+(faslin "pn:buffer-browser.b")
+(faslin "pn:dired.b")
+(faslin "pn:doc.b")
ADDED psl-1983/3-1/nmode/process.build
Index: psl-1983/3-1/nmode/process.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/process.build
@@ -0,0 +1,5 @@
+(faslout "process")
+(dskin "process.sl")
+(dskin "wait.sl")
+(faslend)
+
ADDED psl-1983/3-1/nmode/process.sl
Index: psl-1983/3-1/nmode/process.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/process.sl
@@ -0,0 +1,534 @@
+%
+% PROCESS.SL
+% Routines to support generalized inferior processes in TOPS20 PSL.
+% Much of the code is based on PHOTO.FAI
+%
+% Mark R. Swanson
+% University of Utah
+% June 17, 1983
+%
+
+(load objects monsym jsys)
+(fluid '(current-process
+ process-list
+ nmode-selectable-processes))
+
+(setf current-process nil)
+(setf process-list nil)
+(setf nmode-selectable-processes ())
+
+(de create-process-stream (name b)
+ (let ((process (make-instance 'process-stream
+ 'exe-file-name name
+ 'out-buf b)))
+ process))
+
+(defflavor process-stream (
+ (sys-proc-id 0)
+ ttyjfn
+ ptyjfn
+ (exe-jfn -1)
+ exe-file-name
+ out-buf
+ output-end
+ mode-word
+ string-in
+ status
+ )
+ ()
+ (initable-instance-variables exe-file-name out-buf)
+ (gettable-instance-variables ttyjfn
+ out-buf mode-word
+ status exe-file-name
+ sys-proc-id)
+)
+
+(defmethod (process-stream init) ()
+ (=> self getjfn) % get jfn for executable
+ (=> self getpty) % get a jfn for pty
+ (=> self efork) % create an inferior fork and attach it to PTY
+ (=> self setpty) % set up pty parameters, links, etc.
+ (=> self runfrk) % start up the fork
+ )
+
+(defmethod (process-stream write-to-process) (string)
+ % Send the given string to the inferior process thru the PTY, but do not
+ % block if buffer is full (for whatever reason). Also, only dole out the
+ % string in bite-size pieces.
+ % 91 seems to be a magic number, as far as tty buffers go.
+
+ (let ((str-len (add1 (size string)))
+ (i 0)
+ cur-sout-len)
+ (while (and (timeout-wait 'accepting-output? (list ttyjfn) 60)
+ (> str-len 0))
+ (setf cur-sout-len (min 92 str-len))
+ (jsys0 ptyjfn
+ (sub string i (sub1 cur-sout-len))
+ cur-sout-len
+ 0 (const jsSOUT))
+ (setf i (+ i cur-sout-len))
+ (setf str-len (- str-len cur-sout-len)))
+ (if (~= str-len 0)
+ (write-message "Current process not accepting input"))
+ ))
+
+(de user-typed-input? ()
+ % Return T if our user has typed something, NIL if not
+ (~= (xsibe 8#100) 0))
+
+(de accepting-output? (jfn)
+ % See if PTY buffer is already filled to capacity
+ (<= (xsibe jfn) 92)) % 8#91 is assumed not to exceed buffer capacity
+ % of a PTY, but be enough to force process wakeup
+
+% The following are provided to avoid unwanted error handling on the +1 return
+
+(lap '((!*entry xsibe expr 1)
+ (jsys (const jssibe))
+ (jfcl)
+ (!*move (reg 2) (reg 1))
+ (!*exit 0)))
+
+(lap '((!*entry xsobe expr 1)
+ (jsys (const jssobe))
+ (jfcl)
+ (!*move (reg 2) (reg 1))
+ (!*exit 0)))
+
+(defmethod (process-stream read-into-buffer) ()
+ % Reads output of inferior process into associated buffer, if any output
+ % is to be had; waits only a *small* finite amount of time for input to
+ % appear.
+
+ (let ((chars-read nil)
+ (input-recvd nil))
+ (=> out-buf move-to-buffer-end) % New output should appear at buffer end
+ (while (and % Keep reading until no more output from
+ (not (user-typed-input?)) % process or user typein.
+ (setf chars-read (=> self read-from-process)))
+ (setf input-recvd t) % So we will know to refresh window.
+ (let ((string string-in)
+ (i 0)
+ char)
+ (while
+ (< i chars-read)
+ (if (~= (setf char (string-fetch string i)) #\cr) % ignore CR's
+ (=> out-buf insert-character char))
+ (setf i (+ i 1))
+ )))
+ (setf output-end (=> out-buf position))
+ (if input-recvd (=> self window-refresh)) % refresh window when all done
+ ))
+
+(defmethod (process-stream read-from-process) ()
+ % READ-FROM-PROCESS reads as many chars as are waiting to be read into
+ % string-in and returns number read, or NIL if there were none. Will
+ % not block if no output is available, though it will wait a short
+ % time for some to arrive.
+
+ (let ((chars-to-read (timeout-wait 'output-waiting? (list ttyjfn) 20))
+ )
+ (if (null chars-to-read) (exit nil))
+ (setf string-in (mkstring (- chars-to-read 1) 0))
+ (- chars-to-read (jsys3 ptyjfn string-in chars-to-read 0 (const jsSIN)))
+ ))
+
+(de output-waiting? (jfn)
+ % OUTPUT-WAITING? checks inferior process' tty output buffer to see if it's
+ % empty. Returns NIL if it is empty, else the count of characters in buffer.
+
+ (let ((n (xsobe jfn)))
+ (if (= n 0) nil n)))
+
+(defmethod (process-stream getjfn) ()
+ % GETJFN -- get a jfn for executable file specified by exe-file-name
+ (setf exe-jfn (jsys1 (bits 2 17) exe-file-name 0 0 (const jsGTJFN)))
+ )
+
+(defmethod (process-stream efork) ()
+ % EFORK -- create an inferior fork and get a copy of the desired file into it
+ (setf sys-proc-id (jsys1 (bits 1) 0 0 0 (const jsCFORK))) % create fork
+ (jsys0 sys-proc-id 0 0 0 (const jsFFORK)) % freeze it
+ (jsys0 (xword sys-proc-id exe-jfn) 0 0 0 (const jsGET)) % get the executable into it
+ (jsys0 sys-proc-id % don't allow LOGOff or CTRL-C trap
+ (xword 8#200001
+ (lowhalfword (jsys2 sys-proc-id 0 0 0 (const jsRPCAP))))
+ 0 0 (const jsEPCAP))
+ (jsys0 sys-proc-id (xword ttyjfn ttyjfn) 0 0 (const jsSPJFN))
+ )
+
+(defmethod (process-stream runfrk) ()
+ % RUNFRK -- run something in an inferior fork
+ % returns with ERRFLG T if the fork terminated abnormally
+ (jsys0 sys-proc-id 0 0 0 (const jsSFRKV))
+ (jsys0 sys-proc-id 0 0 0 (const jsRFORK))
+ (setf status (jsys1 sys-proc-id 0 0 0 (const jsRFSTS)))
+ % (setf error-flag (not (eqn 2 (land (loworderhalf status) 2))))
+ )
+
+% (defmethod (process-stream proc-sts) ()
+% (setf status (jsys1 sys-proc-id 0 0 0 (const jsRFSTS)))
+% (setf mode-word (jsys2 ttyjfn 0 0 0 (const jsRFMOD)))
+% )
+
+%(defmethod (process-stream running) ()
+% (not (eqn (land (highhalfword status) 8#400000) 8#400000)))
+
+%(defmethod (process-stream io-wait) ()
+% (eqn (land (highhalfword status) 8#377777) 1))
+
+(defmethod (process-stream getpty) ()
+ % GETPTY - get a jfn on a pty and also its TTY number
+ (let ((curpty (get-1-pty)))
+ (cond ((eqn curpty -1)
+ (ErrorPrintF
+ "There are too many people using PTY's now; try again later.")))
+ (setf ptyjfn (openpty (ptynum curpty)))
+ (setf ttyjfn (openpty (ttynum curpty)))
+ ))
+
+(defmethod (process-stream intrpt-process) ()
+ % essentially the same as ^C to the inferior
+ (jsys0 sys-proc-id (bits 1) 0 0 (const jsIIC))
+ )
+
+(defmethod (process-stream close-pty) ()
+ (jsys0 ptyjfn 0 0 0 (const jsCLOSF))
+ (jsys0 ttyjfn 0 0 0 (const jsCLOSF))
+ (setf ptyjfn 0)
+ (setf ttyjfn 0)
+ )
+
+(defmethod (process-stream kill) ()
+ % kil the fork, close its PTY's, reset fork handle
+ (jsys0 sys-proc-id 0 0 0 (const jsKfork))
+ (setf sys-proc-id 0)
+ (=> self close-pty)
+ )
+
+(de get-1-pty ()
+ % find an available PTY; note that TOPS20 will tell us that a PTY is available
+ % to us if we have it in use already--ensure that we get a new one.
+
+ (for* (with dev-characteristics pty-owning-job
+ (numpty (HighHalfWord (jsys1 26 0 0 0 (const JsGETAB))))
+ (my-job-num (jsys3 -1 (xword -1 3) 0 0 (const jsGETJI))))
+ (from curpty 0 numpty 1)
+ (finally (return -1)) % in case none is found
+ (do
+ (setf dev-characteristics
+ (jsys2 (xword 8#600013 curpty) 0 0 0 (const JsDVCHR)))
+ (setf pty-owning-job
+ (highhalfword (jsys3 (xword 8#600013 curpty) 0 0 0 (const JsDVCHR))))
+ (cond
+ ((and
+ (eqn 8#010000 % is it available?
+ (land (highhalfword dev-characteristics) 8#010000)) % dv%av
+ (not (eqn my-job-num % does it already belong to us?
+ pty-owning-job)))
+ (return curpty))
+ )
+ )))
+
+(de openpty (ptynum)
+ %
+ (let ((devnam (Mkstring 10))
+ ptyjfn)
+ (jsys0 devnam % turn Device descriptor into a name-string
+ (jsys1 ptynum 0 0 0 (const JsDVCHR))
+ 0 0 (const JsDEVST))
+ (setf devnam (recopystringtonull devnam)) % truncate it at NULL
+ (setf ptyjfn % make it into a TOPS-20 dev name
+ (jsys1 (Xword 8#001 0) (concat devnam ":") 0 0 (const JsGTJFN))) % gj%sht!gj%acc
+ (jsys0 ptyjfn (Xword 8#70000 8#300000) 0 0 (const JsOPENF)) % 7 bit byte,in-out
+ ptyjfn))
+
+(de ttynum (ptynum)
+% TTYNUM--given a PTY number, turn it into the device designator of the
+% associated TTY
+ (plus ptynum
+ (LowHalfWord (jsys1 22 0 0 0 (const JsGETAB))) % 26 is the index of the PTY table
+ 8#400000)) % .ttdes
+
+(de ptynum (ptynum)
+ % PTYNUM--given a PTY number, turn it into a PTY device designator
+ (xword 8#600013 ptynum))
+
+(defmethod (process-stream setpty) ()
+ % SETPTY-- set up PTY mode
+
+ (jsys0 ttyjfn 8#525252525252 8#525252525252 0 (const jsSFCOC))
+ (setf mode-word (jsys2 ttyjfn 0 0 0 (const jsRFMOD)))
+ (jsys0 ttyjfn (land mode-word 8#777777774000) 0 0 (const jsSFMOD))
+ (jsys0 ttyjfn (land mode-word 8#777777774000) 0 0 (const jsSTPAR))
+ )
+
+(defmethod (process-stream window-refresh) ()
+ (when out-buf
+ (if (and *OutWindow
+ (not (buffer-is-displayed? out-buf)))
+ (nmode-expose-output-buffer out-buf))
+ (let ((window-list (find-buffer-in-exposed-windows out-buf)))
+ (when window-list
+ (nmode-adjust-output-window (car window-list))
+ ))))
+
+(defmethod (process-stream name) ()
+ (=> out-buf name))
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+(de feed-process-from-buffer (terminate-flag)
+ % Causes NMODE to send input to an inferior process from the current buffer.
+ % Output will go to end of the output buffer. Supply a free EOL if the last
+ % line is unterminated.
+
+ (if (null current-process) (write-message "No process")
+ (if (=> nmode-current-buffer modified?) (make-buffer-terminated))
+ (let* ((process-output-buffer (=> current-process out-buf))
+ (old-pos (=> process-output-buffer position))
+ (input-line (=> nmode-current-buffer current-line))
+ )
+ (=> process-output-buffer set-mark-from-point)
+
+ % Set things up to read from and write to NMODE buffers.
+ (=> current-process write-to-process input-line)
+ (if terminate-flag
+ (=> current-process write-to-process (mkstring 0 #\lf)))
+ (=> nmode-current-buffer move-to-next-line)
+ (=> current-process read-into-buffer)
+ )))
+
+(de create-process-command ()
+ (let* ((fn (prompt-for-file-name "Executable file: " "SYSTEM:EXEC.EXE"))
+ (nmode-default-mode process-mode)
+ (b (buffer-create-default
+ (buffer-make-unique-name
+ (filename-to-buffername fn))))
+ (process (create-process-stream fn b)))
+ (setf nmode-selectable-processes (cons process nmode-selectable-processes))
+ (setf current-process process)
+ ))
+
+(de execute-region-command ()
+ % Send region to inferior process; one line at a time.
+ % NOT YET FULLY IMPLEMENTED
+ (set-mark-from-point) % in case the user wants to come back
+ (move-to-start-of-line)
+ (feed-process-from-buffer t)
+ )
+
+(de execute-line-command ()
+ % Send current line to inferior process; start at the beginning of the line.
+
+ (set-mark-from-point) % in case the user wants to come back
+ (move-to-start-of-line)
+ (feed-process-from-buffer t)
+ )
+
+(de execute-unterminated-line-command ()
+ % Execute starting at the beginning of the current line, do not send an EOL.
+
+ (set-mark-from-point) % in case the user wants to come back
+ (move-to-start-of-line)
+ (feed-process-from-buffer nil)
+ )
+
+(de intrpt-process-command ()
+ (if (null current-process)
+ (write-message "No process")
+ (=> current-process intrpt-process)))
+
+(de kill-process-command ()
+ (if current-process
+ (progn
+ (=> current-process kill)
+ (setf current-process (cadr nmode-selectable-processes))
+ (setf nmode-selectable-processes (cdr nmode-selectable-processes)))
+ (write-message "No process")))
+
+(de send-char-immediate-command ()
+ % Send the next character as is, without waiting for a line terminator
+ % Useful for sending control characters, and for talking to programs (such
+ % as DDT, that break on single, non-control characters such as "/"
+
+ (if current-process
+ (let ((ch (input-direct-terminal-character)))
+ (=> current-process write-to-process (mkstring 0 ch))
+ (=> current-process read-into-buffer))
+ (write-message "No process")))
+
+(de execute-from-input-window ()
+ (if (null current-process)
+ (write-message "No process")
+ %else
+ (let* ((buf (=> current-process out-buf))
+ (prompt-string (progn
+ (=> buf move-to-buffer-end)
+ (=> buf current-line))))
+ (=> current-process write-to-process (prompt-for-process-string
+ prompt-string NIL))
+ (=> current-process write-to-process (mkstring 0 #\lf))
+ (=> current-process read-into-buffer))
+ ))
+
+(de cut-line-command ()
+ (let ((cur-char-pos (current-char-pos))
+ (cur-line (current-line)))
+ (update-kill-buffer
+ (cons 1 (vector (sub cur-line cur-char-pos
+ (- (size cur-line) cur-char-pos))))
+ )))
+
+% A replacement for NMODE-READER-STEP (found in PN:READER.SL); the only
+% change is to check for output from inferior process(es)
+
+(de nmode-reader-step ()
+ (cond ((not nmode-timing?)
+ (nmode-refresh)
+ (nmode-gc-check)
+ (nmode-process-output-check)
+ (nmode-read-command)
+ (nmode-execute-current-command)
+ )
+ (t (nmode-timed-reader-step))
+ ))
+
+(de nmode-process-output-check()
+ % Check for output from the current (if there is one) process; read it if
+ % there is any; the read should not block waiting for further output
+ (cond ((and
+ current-process
+ (output-waiting? (=> current-process ttyjfn)))
+ (=> current-process read-into-buffer)))
+ T
+ )
+
+(de prompt-for-process-string (prompt-string restore-inserts?)
+ % This function is similar to PROMPT-FOR-STRING.
+ (setf nmode-input-special-command-list nil)
+ (if restore-inserts?
+ (self-inserting-command))
+ (if (> nmode-input-level 0)
+ (throw '$error$ NIL)
+ % else
+ (let ((old-msg nmode-message-string)
+ (old-window nmode-current-window)
+ (nmode-input-level (+ nmode-input-level 1)) % FLUID
+ )
+ (=> (=> nmode-input-window buffer) reset)
+ (nmode-select-window nmode-input-window)
+ (set-message prompt-string)
+ (set-prompt "") % avoid old prompt popping back up when we're done
+
+ % Edit the buffer until an "exit" character is typed or the user aborts.
+
+ (cond ((eq (NMODE-reader T) 'abort)
+ (=> nmode-input-window deexpose)
+ (nmode-select-window old-window)
+ (set-message old-msg)
+ (throw 'abort NIL)
+ ))
+
+ % Show the user that his input has been accepted.
+ (move-to-start-of-line)
+ (nmode-refresh-one-window nmode-input-window)
+
+ % Pick up the string that was typed.
+ (let ((return-string (current-line)))
+
+ % Switch back to old window, etc.
+ (=> nmode-input-window deexpose)
+ (nmode-select-window old-window)
+
+ % Restore original "message window".
+ (set-message old-msg)
+ return-string
+ ))))
+
+(de Process-prefix ()
+ (nmode-append-separated-prompt "Process-")
+ (let ((ch (input-terminal-character)))
+ (nmode-complete-prompt (x-char-name ch))
+ (list (x-char C-!\) ch)
+ ))
+
+(define-command-prefix 'Process-prefix "Process-")
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Most of what follows really should gpo into MODE-DEFS.SL, if processes become
+% an accepted part of NMODE
+
+(CompileTime (load extended-char))
+
+(fluid '(Process-Mode
+ ))
+
+(fluid '(Process-Command-List
+ Process-Mode-Command-List
+ ))
+
+(setf Text-Mode
+ (nmode-define-mode
+ "Text"
+ '((nmode-define-commands Text-Command-List)
+ (nmode-define-commands Modifying-Terminal-Command-List)
+ (nmode-define-commands Process-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ (nmode-define-normal-self-inserts)
+ )))
+
+(setf Process-Mode
+ (nmode-define-mode
+ "Process"
+ '((nmode-define-commands Process-Command-List)
+ (nmode-define-commands Process-Mode-Command-List)
+ (nmode-establish-mode Read-Only-Text-Mode)
+ )))
+
+(setf Lisp-Interface-Mode
+ (nmode-define-mode
+ "Lisp"
+ '((nmode-define-commands Rlisp-Command-List)
+ (establish-lisp-parser)
+ (nmode-define-commands Lisp-Command-List)
+ (nmode-define-commands Process-Command-List)
+ (nmode-establish-mode Text-Mode)
+ )))
+
+(de process-mode-command ()
+ (buffer-set-mode nmode-current-buffer Process-Mode)
+ )
+
+% Process-Mode-Command-List - commands related to the Process interface
+
+(setf Process-Mode-Command-List
+ (list
+ (cons (x-char C-k) 'cut-line-command)
+ (cons (x-char RETURN) 'execute-line-command)
+ ))
+
+% Process-Command-List - commands related to the Process interface
+
+(setf Process-Command-List
+ (list
+ (cons (x-char C-!\) 'Process-prefix)
+ (cons (x-chars C-!\ C) 'intrpt-process-command)
+ (cons (x-chars C-!\ E) 'execute-line-command)
+ (cons (x-chars C-!\ I) 'execute-from-input-window)
+ (cons (x-chars C-!\ K) 'kill-process-command)
+ (cons (x-chars C-!\ Q) 'send-char-immediate-command)
+ (cons (x-chars C-!\ P) 'process-browser-command)
+ (cons (x-chars C-!\ U) 'execute-unterminated-line-command)
+ ))
+
+(setf Basic-Command-List
+ (NConc Basic-Command-List
+ (list (cons (m-x "Create Process") 'create-process-command))))
+
+(setf Text-Command-List
+ (NConc Text-Command-List
+ (list (cons (m-x "Process Mode") 'Process-mode-command))))
ADDED psl-1983/3-1/nmode/prompting.sl
Index: psl-1983/3-1/nmode/prompting.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/prompting.sl
@@ -0,0 +1,282 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Prompting.SL - NMODE Prompt Line Manager
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 19 August 1982
+% Revised: 28 February 1983
+%
+% Adapted from Will Galway's EMODE.
+%
+% 28-Feb-83 Alan Snyder
+% Extend write-prompt to work properly when NMODE is not running.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 7-Feb-83 Alan Snyder
+% Use one-window or one-screen refresh.
+% 29-Dec-82 Alan Snyder
+% Revised input completion support to run completion characters as commands
+% rather than terminating and resuming. Added new functions to manipulate the
+% input buffer.
+% 22-Dec-82 Jeffrey Soreff
+% Revised to handle control characters on prompt and message lines.
+% 21-Dec-82 Alan Snyder
+% Efficiency improvement: Added declarations for virtual screens and buffer
+% windows.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char fast-strings numeric-operators))
+(on fast-integers)
+
+% External variables used:
+
+(fluid
+ '(nmode-prompt-screen
+ nmode-message-screen
+ nmode-input-window
+ nmode-current-window
+ *NMODE-RUNNING
+ ))
+
+% Global variables defined here:
+
+(fluid
+ '(nmode-input-default
+ ))
+
+% Internal static variables:
+
+(fluid
+ '(nmode-prompt-cursor
+ nmode-message-cursor
+ nmode-message-string
+ nmode-input-level
+ nmode-input-special-command-list
+ ))
+
+(setf nmode-prompt-cursor 0)
+(setf nmode-message-cursor 0)
+(setf nmode-message-string "")
+(setf nmode-input-level 0)
+(setf nmode-input-default NIL)
+
+(declare-flavor virtual-screen nmode-prompt-screen nmode-message-screen)
+(declare-flavor buffer-window nmode-input-window nmode-current-window)
+(declare-flavor text-buffer input-buffer)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% String input:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de prompt-for-string (prompt-string default-string)
+
+ % Prompt for a string (terminated by CR or NL). Use default-string if an
+ % empty string is returned (and default-string is non-NIL). The original
+ % message line is restored, but not refreshed. Note: if you attempt to use
+ % this function recursively, it will automatically throw '$ERROR$. The effect
+ % of this action is that in string-input mode, commands that request string
+ % input appear to be undefined. (This assumes that all such commands do
+ % nothing visible before they first request string input.)
+
+ (prompt-for-string-special prompt-string default-string NIL))
+
+(de prompt-for-string-special (prompt-string default-string command-list)
+
+ % This function is similar to PROMPT-FOR-STRING, except that it accepts a
+ % command list that specifies a set of additional commands to be defined
+ % while the user is typing at the input window.
+
+ (if (> nmode-input-level 0)
+ (throw '$error$ NIL)
+ % else
+ (setf nmode-input-special-command-list command-list)
+ (setf nmode-input-default default-string)
+ (let ((old-msg nmode-message-string)
+ (old-window nmode-current-window)
+ (nmode-input-level (+ nmode-input-level 1)) % FLUID
+ )
+ (if default-string
+ (setf prompt-string
+ (string-concat prompt-string " (Default is: '" default-string "')")))
+
+ (=> (=> nmode-input-window buffer) reset)
+ (nmode-select-window nmode-input-window)
+ (set-message prompt-string)
+ (set-prompt "") % avoid old prompt popping back up when we're done
+
+ % Edit the buffer until an "exit" character is typed or the user aborts.
+
+ (cond ((eq (NMODE-reader T) 'abort)
+ (=> nmode-input-window deexpose)
+ (nmode-select-window old-window)
+ (set-message old-msg)
+ (throw 'abort NIL)
+ ))
+
+ % Show the user that his input has been accepted.
+ (move-to-start-of-line)
+ (nmode-refresh-one-window nmode-input-window)
+
+ % Pick up the string that was typed.
+ (let ((return-string (current-line)))
+
+ % Switch back to old window, etc.
+ (=> nmode-input-window deexpose)
+ (nmode-select-window old-window)
+
+ % Restore original "message window".
+ (set-message old-msg)
+
+ % If an empty string, use default (unless it's NIL).
+ (if (and default-string (equal return-string ""))
+ default-string
+ return-string
+ )))))
+
+(de nmode-substitute-default-input ()
+ % If the input buffer is empty and there is a default string, then stuff the
+ % default string into the input buffer.
+
+ (let ((input-buffer (=> nmode-input-window buffer)))
+ (if (and (=> input-buffer at-buffer-start?)
+ (=> input-buffer at-buffer-end?)
+ nmode-input-default
+ (stringp nmode-input-default)
+ )
+ (=> input-buffer insert-string nmode-input-default)
+ )))
+
+(de nmode-get-input-string ()
+ % Return the contents of the input buffer as a string. If the buffer contains
+ % more than one line, only the current line is returned.
+
+ (let ((input-buffer (=> nmode-input-window buffer)))
+ (=> input-buffer current-line)
+ ))
+
+(de nmode-replace-input-string (s)
+ % Replace the contents of the input buffer with the specified string.
+ (let ((input-buffer (=> nmode-input-window buffer)))
+ (=> input-buffer reset)
+ (=> input-buffer insert-string s)
+ ))
+
+(de nmode-terminate-input ()
+ % A command bound to this function will act to terminate string input.
+ (exit-nmode-reader)
+ )
+
+(de nmode-yank-default-input ()
+ % A command bound to this function will act to insert the default string into
+ % the input buffer.
+ (if nmode-input-default
+ (insert-string nmode-input-default)
+ (Ding)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Prompt line functions:
+%
+% NOTE: if your intent is to display a prompt string for user input, you should
+% use a function defined in TERMINAL-INPUT rather than one of these.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de write-prompt (msg)
+ % Write the specified string to the prompt line and refresh the prompt
+ % line. Note: the major windows are not refreshed.
+
+ (cond
+ (*NMODE-RUNNING
+ (set-prompt msg)
+ (nmode-refresh-virtual-screen nmode-prompt-screen)
+ )
+ (t
+ (printf "%w%n" msg)
+ )))
+
+(de set-prompt (msg)
+ % Write the specified string to the prompt window, but do not refresh.
+ (setf nmode-prompt-cursor 0)
+ (=> nmode-prompt-screen clear)
+ (prompt-append-string msg)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Message line functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de write-message (msg)
+ % Display a string to the message window and refresh the message window.
+ % Note: the major windows are not refreshed.
+ % Return the previous message string.
+
+ (prog1
+ (set-message msg)
+ (nmode-refresh-virtual-screen nmode-message-screen)
+ ))
+
+(de rewrite-message ()
+ % Rewrite the existing message (used when the default enhancement changes).
+ (set-message nmode-message-string)
+ )
+
+(de set-message (msg)
+ % Display a string in the "message" window, do not refresh.
+ % Message will not appear until a refresh is done.
+ % Return the previous message string.
+
+ (let ((old-message nmode-message-string))
+ (setf nmode-message-string msg)
+ (setf nmode-message-cursor 0)
+ (=> nmode-message-screen clear)
+ (message-append-string msg)
+ old-message
+ ))
+
+(de reset-message ()
+ % Clear the "message" window, but do not refresh.
+ (setf nmode-message-string "")
+ (setf nmode-message-cursor 0)
+ (=> nmode-message-screen clear)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de prompt-append-string (s)
+ (for (from i 0 (string-upper-bound s))
+ (do (prompt-append-character (string-fetch s i)))))
+
+(de prompt-append-character (ch)
+ (cond
+ ((or (< ch #\space) (= ch #\rubout)) % Control Characters
+ (=> nmode-prompt-screen write #/^ 0 nmode-prompt-cursor)
+ (setf nmode-prompt-cursor (+ nmode-prompt-cursor 1))
+ (=> nmode-prompt-screen write (^ ch 8#100) 0 nmode-prompt-cursor)
+ (setf nmode-prompt-cursor (+ nmode-prompt-cursor 1)))
+ (t (=> nmode-prompt-screen write ch 0 nmode-prompt-cursor) % Normal Char
+ (setf nmode-prompt-cursor (+ nmode-prompt-cursor 1)))))
+
+(de message-append-string (s)
+ (for (from i 0 (string-upper-bound s))
+ (do (message-append-character (string-fetch s i)))))
+
+(de message-append-character (ch)
+ (cond
+ ((or (< ch #\space) (= ch #\rubout)) % Control Characters
+ (=> nmode-message-screen write #/^ 0 nmode-message-cursor)
+ (setf nmode-message-cursor (+ nmode-message-cursor 1))
+ (=> nmode-message-screen write (^ ch 8#100) 0 nmode-message-cursor)
+ (setf nmode-message-cursor (+ nmode-message-cursor 1)))
+ (t (=> nmode-message-screen write ch 0 nmode-message-cursor) % Normal Char
+ (setf nmode-message-cursor (+ nmode-message-cursor 1)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor nmode-prompt-screen nmode-message-screen)
+(undeclare-flavor nmode-input-window nmode-current-window)
+(undeclare-flavor input-buffer)
ADDED psl-1983/3-1/nmode/query-replace.sl
Index: psl-1983/3-1/nmode/query-replace.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/query-replace.sl
@@ -0,0 +1,164 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% QUERY-REPLACE.SL - Query/Replace command
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 6 July 1982
+% Revised: 17 February 1983
+%
+% 17-Feb-83 Alan Snyder
+% Define backspace to be a synonym for rubout. Terminate when a non-command
+% character is read and push back the character (like EMACS).
+% 9-Feb-83 Alan Snyder
+% Must now refresh since write-message no longer does.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char fast-int fast-strings))
+
+% Externals used here:
+
+(fluid '(last-search-string nmode-current-buffer))
+
+% Internal static variables:
+
+(fluid '(query-replace-message
+ query-replace-help
+ query-replace-pause-help))
+
+(setf query-replace-message "Query-Replace")
+(setf query-replace-help
+ (string-concat
+ query-replace-message
+ " SPACE:yes RUBOUT:no ESC:exit .:yes&exit ,:yes&show !:do all ^:back"
+ ))
+(setf query-replace-pause-help
+ (string-concat
+ query-replace-message
+ " SPACE:go on ESC:exit !:do all ^:back"
+ ))
+
+(de replace-string-command ()
+ (let* ((pattern
+ (setf last-search-string
+ (prompt-for-string "Replace string: " last-search-string)))
+ (replacement (prompt-for-string "Replace string with: " NIL))
+ (count 0)
+ (old-pos (buffer-get-position))
+ )
+ (while (buffer-search pattern 1)
+ (do-string-replacement pattern replacement)
+ (setf count (+ count 1))
+ )
+ (buffer-set-position old-pos)
+ (write-prompt (BldMsg "Number of replacements: %d" count))
+ ))
+
+(de query-replace-command ()
+ (let* ((ask t)
+ ch pattern replacement
+ (pausing nil)
+ (ring-buffer (ring-buffer-create 16))
+ )
+
+ (setf pattern
+ (setf last-search-string
+ (prompt-for-string
+ "Query Replace (string to replace): "
+ last-search-string
+ )))
+
+ (setf replacement
+ (prompt-for-string "Replace string with: " NIL))
+
+ (set-message query-replace-message)
+ (while (or pausing (buffer-search pattern 1))
+ (if ask
+ (progn
+ (cond (pausing
+ (nmode-set-immediate-prompt "Command? ")
+ )
+ (t
+ (ring-buffer-push ring-buffer (buffer-get-position))
+ (nmode-set-immediate-prompt "Replace? ")
+ ))
+ (nmode-refresh)
+ (setf ch (input-terminal-character))
+ (write-prompt "")
+ )
+ (setf ch (x-char space)) % if not asking
+ )
+ (if pausing
+ (selectq ch
+ ((#.(x-char space) #.(x-char rubout)
+ #.(x-char backspace) #.(x-char !,))
+ (write-message query-replace-message)
+ (setf pausing nil))
+ (#.(x-char !!)
+ (setf ask nil) (setf pausing nil))
+ ((#.(x-char escape) #.(x-char !.))
+ (exit))
+ (#.(x-char C-L)
+ (nmode-full-refresh))
+ (#.(x-char ^)
+ (ring-buffer-pop ring-buffer)
+ (buffer-set-position (ring-buffer-top ring-buffer)))
+ (#.(x-char ?)
+ (write-message query-replace-pause-help) (next))
+ (t (push-back-input-character ch) (exit))
+ )
+ (selectq ch
+ (#.(x-char space)
+ (do-string-replacement pattern replacement))
+ (#.(x-char !,)
+ (do-string-replacement pattern replacement)
+ (write-message query-replace-message)
+ (setf pausing t))
+ ((#.(x-char rubout) #.(x-char backspace))
+ (advance-over-string pattern))
+ (#.(x-char !!)
+ (do-string-replacement pattern replacement)
+ (setf ask nil))
+ (#.(x-char !.)
+ (do-string-replacement pattern replacement)
+ (exit))
+ (#.(x-char ?)
+ (write-message query-replace-help) (next))
+ (#.(x-char escape)
+ (exit))
+ (#.(x-char C-L)
+ (nmode-full-refresh))
+ (#.(x-char ^)
+ (ring-buffer-pop ring-buffer)
+ (buffer-set-position (ring-buffer-top ring-buffer))
+ (setf pausing t))
+ (t (push-back-input-character ch) (exit))
+ )
+ )
+ )
+ (reset-message)
+ (write-prompt "Query Replace Done.")
+ ))
+
+(de do-string-replacement (pattern replacement)
+
+ % Both PATTERN and REPLACEMENT must be single line strings. PATTERN is
+ % assumed to be in the current buffer beginning at POINT. It is deleted and
+ % replaced with REPLACEMENT. POINT is left pointing just past the inserted
+ % text.
+
+ (let ((old-pos (buffer-get-position)))
+ (advance-over-string pattern)
+ (extract-region T old-pos (buffer-get-position))
+ (insert-string replacement)
+ ))
+
+(de advance-over-string (pattern)
+
+ % PATTERN must be a single line string. PATTERN is assumed to be in the
+ % current buffer beginning at POINT. POINT is advanced past PATTERN.
+
+ (let ((pattern-length (string-length pattern)))
+ (set-char-pos (+ (current-char-pos) pattern-length))
+ ))
ADDED psl-1983/3-1/nmode/reader.sl
Index: psl-1983/3-1/nmode/reader.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/reader.sl
@@ -0,0 +1,400 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Reader.SL - NMODE Command Reader
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 August 1982
+% Revised: 16 February 1983
+%
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 3-Dec-82 Alan Snyder
+% GC calls cleanup-buffers before reclaiming.
+% 21-Dec-82 Alan Snyder
+% Use generic arithmetic on processor times (overflowed on 9836).
+% Add declaration for NMODE-TIMER-OUTPUT-STREAM.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects extended-char fast-int pathnames))
+
+% External variables used here:
+
+(fluid '(nmode-allow-refresh-breakout))
+
+% Global variables defined here:
+
+(fluid '(
+ nmode-command-argument % Numeric C-U argument (default: 1)
+ nmode-command-argument-given % T if C-U used for this command
+ nmode-command-number-given % T if an explicit number given
+ nmode-previous-command-killed % T if previous command KILLED text
+ nmode-current-command % Current command (char or list)
+ nmode-previous-command % Previous command (char or list)
+ nmode-current-command-function % Function for current command
+ nmode-previous-command-function% Function for previous command
+ nmode-autoarg-mode % T => digits start command argument
+ nmode-temporary-autoarg % T while reading command argument
+ nmode-command-killed % Commands set this if they KILL text
+ nmode-command-set-argument % Commands like C-U set this
+ nmode-reader-exit-flag % Internal flag: causes reader to exit
+ nmode-gc-check-level % number of free words causing GC
+ nmode-timing? % T => time command execution
+ nmode-display-times? % T => display times after each command
+ nmode-timer-output-stream % optional stream to write times to
+
+ % The following variables are set when timing is on:
+
+ nmode-timed-step-count % number of reader steps timed
+ nmode-refresh-time % time used for last refresh
+ nmode-read-time % time used for last read command
+ nmode-command-execution-time % time to execute last command
+ nmode-total-refresh-time % sum of nmode-refresh-time
+ nmode-total-read-time % sum of nmode-read-time
+ nmode-total-command-execution-time% sum of nmode-command-execution-time
+ nmode-gc-start-count % GCKnt when timing starts
+ nmode-gc-reported-count % GCKnt when last reported
+ nmode-total-cons-count % total words allocated (except GC)
+ ))
+
+(setf nmode-timing? NIL)
+(setf nmode-display-times? NIL)
+
+(declare-flavor output-stream nmode-timer-output-stream)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(nmode-exit-on-abort))
+(de nmode-reader (nmode-exit-on-abort)
+
+ % Execute refresh/read/dispatch loop. The loop can terminate in the following
+ % ways: (1) A command can cause the reader to exit by either calling
+ % EXIT-NMODE-READER or by throwing 'EXIT-NMODE. In this case, the reader
+ % terminates and returns NIL. (2) A command can throw 'ABORT. If
+ % NMODE-EXIT-ON-ABORT is non-NIL, then the reader will terminate and return
+ % 'ABORT; otherwise, it will ring the bell and continue. (3) A command can
+ % throw '$BREAK$ or 'RESET; this throw is relayed. Other errors and throws
+ % within a command are caught, messages are printed, and execution resumes.
+
+ (let* ((nmode-reader-exit-flag NIL) % FLUID variable
+ (nmode-previous-command-killed NIL) % FLUID variable
+ (nmode-command-killed NIL) % FLUID variable
+ (nmode-command-argument 1) % FLUID variable
+ (nmode-command-argument-given NIL) % FLUID variable
+ (nmode-command-number-given NIL) % FLUID variable
+ (nmode-current-command NIL) % FLUID variable
+ (nmode-previous-command NIL) % FLUID variable
+ (nmode-current-command-function NIL) % FLUID variable
+ (nmode-previous-command-function NIL) % FLUID variable
+ (nmode-command-set-argument NIL) % FLUID variable
+ (nmode-timing? NIL) % FLUID variable
+ (*MsgP T) % FLUID variable
+ (*BackTrace T) % FLUID variable
+ )
+
+ (while (not nmode-reader-exit-flag)
+ (catch-all
+ #'(lambda (tag result)
+ (cond
+ ((eq tag 'abort)
+ (if nmode-exit-on-abort (exit 'abort) (Ding)))
+ ((or (eq tag '$Break$) (eq tag 'RESET))
+ (nmode-select-buffer-channel)
+ (throw tag NIL))
+ ((eq tag '$error$) (Ding))
+ ((eq tag 'exit-nmode) (exit NIL))
+ (t (Printf "*****Unhandled THROW of %p" tag) (Ding))
+ ))
+ (nmode-reader-step)
+ ))))
+
+(de nmode-reader-step ()
+ (cond ((not nmode-timing?)
+ (nmode-refresh)
+ (nmode-gc-check)
+ (nmode-read-command)
+ (nmode-execute-current-command)
+ )
+ (t (nmode-timed-reader-step))
+ ))
+
+(de nmode-read-command ()
+ % Read one command and set the appropriate global variables.
+
+ (when (not nmode-command-set-argument) % starting a new command
+ (setf nmode-previous-command-killed nmode-command-killed)
+ (setf nmode-previous-command nmode-current-command)
+ (setf nmode-previous-command-function nmode-current-command-function)
+ (setf nmode-command-argument 1)
+ (setf nmode-command-argument-given NIL)
+ (setf nmode-command-number-given NIL)
+ (setf nmode-command-killed NIL)
+ (setf nmode-temporary-autoarg NIL)
+ (nmode-set-delayed-prompt "")
+ )
+ (setf nmode-current-command (input-command))
+ (setf nmode-current-command-function
+ (dispatch-table-lookup nmode-current-command))
+ )
+
+(de nmode-execute-current-command ()
+ (setf nmode-command-set-argument NIL)
+ (if nmode-current-command-function
+ (apply nmode-current-command-function NIL)
+ (nmode-undefined-command nmode-current-command)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Timing Support
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de start-timing-command ()
+ (let ((fn (prompt-for-file-name
+ "Timing output to file:"
+ (namestring (make-pathname 'name "timing" 'type "txt"))
+ )))
+ (cond ((not (setf nmode-timer-output-stream (attempt-to-open-output fn)))
+ (write-prompt "Unable to open file.")
+ (Ding)
+ )
+ (t
+ (reclaim)
+ (nmode-start-timing))
+ )))
+
+(de stop-timing-command ()
+ (cond (nmode-timing?
+ (nmode-stop-timing)
+ (if nmode-timer-output-stream (=> nmode-timer-output-stream close))
+ (setf nmode-timer-output-stream nil)
+ )))
+
+(de nmode-start-timing ()
+ (setf nmode-timing? T)
+ (setf nmode-total-refresh-time 0)
+ (setf nmode-total-read-time 0)
+ (setf nmode-total-command-execution-time 0)
+ (setf nmode-timed-step-count 0)
+ (setf nmode-gc-start-count GCknt*)
+ (setf nmode-gc-reported-count nmode-gc-start-count)
+ (setf nmode-total-cons-count 0)
+ )
+
+(de nmode-stop-timing ()
+ (cond (nmode-timing?
+ (setf nmode-timing? NIL)
+ (nmode-timing-message
+ (BldMsg "Total times: Refresh=%d Read=%d Execute=%d Cons=%d #GC=%d"
+ nmode-total-refresh-time
+ nmode-total-read-time
+ nmode-total-command-execution-time
+ nmode-total-cons-count
+ (- GCknt* nmode-gc-start-count)
+ ))
+ (nmode-timing-message
+ (BldMsg "Number of reader steps: %d" nmode-timed-step-count))
+ (if (> nmode-timed-step-count 0)
+ (nmode-timing-message
+ (BldMsg "Averages: Refresh=%d Read=%d Execute=%d Cons=%d"
+ (/ nmode-total-refresh-time nmode-timed-step-count)
+ (/ nmode-total-read-time nmode-timed-step-count)
+ (/ nmode-total-command-execution-time nmode-timed-step-count)
+ (/ nmode-total-cons-count nmode-timed-step-count)
+ ))))))
+
+(de nmode-timed-reader-step ()
+ (let ((heapx (GtHeap NIL))
+ gc-happened
+ )
+ (nmode-timed-refresh)
+ (nmode-gc-check)
+ (nmode-timed-read-command)
+ (nmode-timed-execute-current-command)
+ (setf heapx (- heapx (GtHeap NIL)))
+ (setf gc-happened (> GCknt* nmode-gc-reported-count))
+ (setf nmode-gc-reported-count GCknt*)
+
+ (cond ((not gc-happened)
+ (setf nmode-timed-step-count (+ nmode-timed-step-count 1))
+ (setf nmode-total-refresh-time
+ (+ nmode-total-refresh-time nmode-refresh-time))
+ (setf nmode-total-read-time
+ (+ nmode-total-read-time nmode-read-time))
+ (setf nmode-total-command-execution-time
+ (+ nmode-total-command-execution-time
+ nmode-command-execution-time))
+ (setf nmode-total-cons-count
+ (+ nmode-total-cons-count heapx))
+ ))
+
+ (nmode-timing-message
+ (BldMsg "%w Refresh=%d Read=%d Execute=%d %w"
+ (string-pad-left (command-name nmode-current-command) 20)
+ nmode-refresh-time
+ nmode-read-time
+ nmode-command-execution-time
+ (if gc-happened
+ (BldMsg "#GC=%d" nmode-gc-reported-count)
+ (BldMsg "Cons=%d" heapx)
+ )
+ ))))
+
+(de nmode-timed-refresh ()
+ (let ((ptime (processor-time)))
+ (nmode-refresh)
+ (setf nmode-refresh-time (difference (processor-time) ptime))
+ ))
+
+(de nmode-timed-read-command ()
+ (let ((ptime (processor-time)))
+ (nmode-read-command)
+ (setf nmode-read-time (difference (processor-time) ptime))
+ ))
+
+(de nmode-timed-execute-current-command ()
+ (let ((ptime (processor-time)))
+ (nmode-execute-current-command)
+ (setf nmode-command-execution-time (difference (processor-time) ptime))
+ ))
+
+(de nmode-timing-message (s)
+ (cond (nmode-display-times? (write-message s))
+ (nmode-timer-output-stream
+ (=> nmode-timer-output-stream putl s))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Garbage Collection
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-gc-check ()
+ % Check to see if a garbage collection is needed (because we are low on
+ % space). If so, display a message and invoke the garbage collector. (If a
+ % garbage collection happens "by itself", no message will be displayed.)
+
+ (if (not nmode-gc-check-level) (setf nmode-gc-check-level 1000))
+ (when (< (GtHeap NIL) nmode-gc-check-level)
+ (nmode-gc)
+ ))
+
+(de nmode-gc ()
+ % Perform garbage collection while displaying a message.
+ (let ((nmode-allow-refresh-breakout NIL)) % FLUID variable
+ (write-prompt "Garbage Collecting!")
+ (cleanup-buffers)
+ (reclaim)
+ (write-prompt
+ (BldMsg "Garbage Collection Done: Free Space = %d words" (GtHeap NIL)))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Miscellaneous Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de exit-nmode-reader ()
+ % Set flag to cause exit from NMODE reader loop.
+ (setf nmode-reader-exit-flag T)
+ )
+
+(de nmode-undefined-command (command)
+ (nmode-error (BldMsg "Undefined command: %w" (command-name command)))
+ )
+
+(de nmode-error (s)
+ (let ((nmode-allow-refresh-breakout NIL)) % FLUID variable
+ (write-prompt s)
+ (Ding)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Numeric Argument Command Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de argument-digit ()
+ % This procedure must be attached only to extended characters whose base
+ % characters are digits.
+ (let* ((command nmode-current-command)
+ (base-ch (if (FixP command) (X-base command)))
+ (n (if (and base-ch (digitp base-ch)) (char-digit base-ch)))
+ )
+ (if (null n)
+ (Ding)
+ (argument-digit-number n)
+ )))
+
+(de negative-argument ()
+ (if (not nmode-command-number-given)
+ % make "C-U -" do the right thing
+ (cond ((> nmode-command-argument 0) (setf nmode-command-argument 1))
+ ((< nmode-command-argument 0) (setf nmode-command-argument -1))
+ ))
+ (setf nmode-command-argument (- nmode-command-argument))
+ (setf nmode-command-argument-given T)
+ (setf nmode-command-set-argument T)
+ (nmode-set-delayed-prompt
+ (cond
+ ((= nmode-command-argument 1) "C-U ")
+ ((= nmode-command-argument -1) "C-U -")
+ (t (BldMsg "C-U %d" nmode-command-argument))
+ )))
+
+(de universal-argument ()
+ (setf nmode-command-argument (* nmode-command-argument 4))
+ (setf nmode-command-argument-given T)
+ (setf nmode-command-set-argument T)
+ (setf nmode-temporary-autoarg T)
+ (cond
+ (nmode-command-number-given
+ (nmode-set-delayed-prompt (BldMsg "C-U %d" nmode-command-argument))
+ )
+ (t (nmode-append-separated-prompt "C-U"))
+ ))
+
+(de argument-or-insert-command ()
+ % This command interprets digits and leading hyphens as argument
+ % prefix characters if NMODE-AUTOARG-MODE or NMODE-TEMPORARY-AUTOARG
+ % is non-NIL; otherwise, it self-inserts.
+
+ (let ((base-ch
+ (if (FixP nmode-current-command) (X-base nmode-current-command)))
+ )
+ (cond
+ ((and (digitp base-ch) (or nmode-temporary-autoarg nmode-autoarg-mode))
+ (argument-digit (char-digit base-ch)))
+ ((and (= base-ch #/-)
+ (or nmode-temporary-autoarg nmode-autoarg-mode)
+ (not nmode-command-number-given))
+ (negative-argument))
+ (t (insert-self-command))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Numeric Argument Support Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de argument-digit-number (n)
+ (cond
+ (nmode-command-number-given % this is not the first digit
+ (setf nmode-command-argument
+ (+ (* nmode-command-argument 10)
+ (if (>= nmode-command-argument 0) n (- n))))
+ )
+ (t % this is the first digit
+ (if (> nmode-command-argument 0)
+ (setf nmode-command-argument n)
+ (setf nmode-command-argument (- n))
+ )))
+ (nmode-set-delayed-prompt (BldMsg "C-U %d" nmode-command-argument))
+ (setf nmode-command-argument-given T)
+ (setf nmode-command-number-given T)
+ (setf nmode-command-set-argument T)
+ )
+
+% Convert from character code to digit.
+(de char-digit (c)
+ (cond ((digitp c) (difference (char-int c) (char-int #/0)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor nmode-timer-output-stream)
ADDED psl-1983/3-1/nmode/rec.sl
Index: psl-1983/3-1/nmode/rec.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/rec.sl
@@ -0,0 +1,74 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% REC.SL - Recursive Editing Functioons
+%
+% Author: Jeffrey Soreff
+% Hewlett-Packard/CRC
+% Date: 24 Jan 1983
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load extended-char fast-int objects))
+
+% External variables used here:
+
+(fluid '(recurse-mode nmode-current-buffer))
+
+% Global variables defined here:
+
+(fluid '(recurse-query recurse-query-answered))
+
+% Recurse-Query will be T if the user leaves a recursive editing level
+% with a "Y". It will be nil if the user leaves with an "N". In either
+% of those cases recurse-query-answered will be set to T. If the user
+% leaves the recursive editing level by some other means then
+% recurse-query-answered will be NIL.
+
+(de recursive-edit-y-or-n (buffer outer-message inner-message)
+ % This function allows a user to make a yes or no decision about
+ % some buffer, either before looking at it with the editor or while
+ % editing within it. Before starting to edit the user is prompted
+ % with the outer message. This function takes care of interpreting a
+ % Y or N prior to editing and of providing a prompt (the outer
+ % message) before editing. The call to recursive-edit takes care of
+ % the prompt during editing and of interpreting a Y or N during
+ % editing. This function returns a boolean value.
+ (prog1
+ (while t
+ (write-message outer-message)
+ (let ((ch (x-char-upcase (input-extended-character))))
+ (when (= ch (x-char Y)) (exit T))
+ (when (= ch (x-char N)) (exit NIL))
+ (when (= ch (x-char C-R))
+ (recursive-edit buffer recurse-mode inner-message))
+ (when recurse-query-answered (exit recurse-query))))
+ (write-message "")))
+
+(de recursive-edit (new-buffer mode inner-message)
+ % This function triggers the recursive editing loop, switching
+ % buffers, setting the new buffer temporarily into a user selected
+ % mode, and returning the buffer and mode to their old values after
+ % the editing. This function returns a value only through global
+ % variables, particularly recurse-query and recurse-query-answered.
+ (let ((old-buffer nmode-current-buffer)
+ (old-mode (=> new-buffer mode)))
+ (=> new-buffer set-mode mode)
+ (buffer-select new-buffer)
+ (let ((old-message (write-message inner-message)))
+ (setf recurse-query-answered NIL)
+ (nmode-reader NIL)
+ (write-message old-message))
+ (=> new-buffer set-mode old-mode)
+ (buffer-select old-buffer))) % Note: resets nmode-current-buffer
+
+(de affirmative-exit ()
+ % Returns T from a recursive editing mode, usually bound to Y.
+ (setf recurse-query T)
+ (setf recurse-query-answered T)
+ (exit-nmode-reader))
+
+(de negative-exit ()
+ % Returns NIL from a recursive editing mode, usually bound to N.
+ (setf recurse-query NIL)
+ (setf recurse-query-answered T)
+ (exit-nmode-reader))
ADDED psl-1983/3-1/nmode/screen-layout.sl
Index: psl-1983/3-1/nmode/screen-layout.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/screen-layout.sl
@@ -0,0 +1,786 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Screen-Layout.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 19 August 1982
+% Revised: 5 April 1983
+%
+% This file contains functions that manage the screen layout for NMODE.
+%
+% 5-Apr-83 Alan Snyder
+% Add system-independent functions from set-terminal files.
+% Call nmode-set-terminal instead of nmode-default-terminal.
+% 8-Mar-83 Alan Snyder
+% Call nmode-new-window-or-buffer (new fcn) when selecting a new window.
+% 28-Feb-83 Alan Snyder
+% Reset message line in select-major-window (part of clean up on restart).
+% Explicitly use fast-integers.
+% 18-Feb-83 Alan Snyder
+% Add new function: find-buffer-in-exposed-windows.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 7-Feb-83 Alan Snyder
+% Revise handling of refresh breakout to allow refresh-one-window to work.
+% 31-Jan-83 Alan Snyder
+% Revise for new interpretation of argument to buffer-window$set-size.
+% Make input window an unlabeled buffer-window.
+% 27-Jan-83 Alan Snyder
+% Added (optional) softkey label screen.
+% 7-Jan-83 Alan Snyder
+% Change ENTER-RAW-MODE to not touch the other screen unless we are in
+% two-screen mode.
+% 6-Jan-83 Alan Snyder
+% Change NMODE-SELECT-MAJOR-WINDOW to also deexpose input window.
+% 30-Dec-82 Alan Snyder
+% Added two-screen mode. Minor change to NMODE-SELECT-WINDOW to make
+% things more graceful when using direct writing.
+% 20-Dec-82 Alan Snyder
+% Added declarations and made other small changes to improve efficiency by
+% reducing the amount of run-time method lookup. Fixed efficiency bug in
+% NMODE-NEW-TERMINAL: it failed to de-expose old screens and windows.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load display-char objects))
+(load numeric-operators objects)
+(on fast-integers)
+
+% External variables used here:
+
+(fluid '(nmode-command-argument-given
+ nmode-command-argument
+ browser-split-screen
+ ))
+
+% Options:
+
+(fluid '(
+ nmode-allow-refresh-breakout % Abort refresh if user types something
+ nmode-normal-enhancement % Display enhancement for normal text
+ nmode-inverse-enhancement % Display enhancement for "inverse video" text
+ ))
+
+% Global variables defined here:
+
+(fluid '(
+ nmode-current-buffer % buffer that commands operate on
+ nmode-current-window % window displaying current buffer
+ nmode-major-window % the user's idea of nmode-current-window
+ nmode-layout-mode % either 1 or 2
+ nmode-two-screens? % T => each window has its own screen
+
+ nmode-input-window % window used for string input
+ nmode-message-screen % screen displaying NMODE "message"
+ nmode-prompt-screen % screen displaying NMODE "prompt"
+ nmode-main-buffer % buffer "MAIN"
+ nmode-output-buffer % buffer "OUTPUT" (used for PSL output)
+ nmode-input-buffer % internal buffer used for string input
+ nmode-softkey-label-screen % screen displaying softkey labels (or NIL)
+
+ nmode-terminal % the terminal object
+ nmode-physical-screen % the physical screen object
+ nmode-screen % the shared screen object
+
+ nmode-other-terminal % the other terminal object (two-screen mode)
+ nmode-other-physical-screen % the other physical screen object
+ nmode-other-screen % the other shared screen object
+ ))
+
+% Internal static variables:
+
+(fluid '(
+ nmode-top-window % the top or full major window
+ nmode-bottom-window % the bottom major window
+ full-refresh-needed % next refresh should clear the screen first
+ nmode-breakout-occurred? % last refresh was interrupted
+ nmode-total-lines % total number of screen lines for window(s)
+ nmode-top-lines % number of screen lines for top window
+ nmode-inverse-video? % Display using "inverse video"
+ nmode-blank-screen % blank screen used to clear the display
+ ))
+
+(declare-flavor buffer-window
+ nmode-current-window
+ nmode-top-window nmode-bottom-window nmode-input-window)
+(declare-flavor virtual-screen
+ nmode-blank-screen)
+(declare-flavor shared-physical-screen
+ nmode-screen
+ nmode-other-screen)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Initialization Function:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-initialize-screen-layout ()
+
+ % This function is called as part of NMODE initialization, which occurs
+ % before NMODE is saved.
+
+ (setf nmode-allow-refresh-breakout T)
+ (setf nmode-normal-enhancement (dc-make-enhancement-mask))
+ (setf nmode-inverse-enhancement
+ (dc-make-enhancement-mask INVERSE-VIDEO INTENSIFY))
+ (setf nmode-inverse-video? NIL)
+ (nmode-set-terminal)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Functions for changing the screen layout:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-1-window ()
+ (nmode-expand-top-window)
+ )
+
+(de nmode-expand-top-window ()
+
+ % This function does nothing if already in 1-window mode.
+ % Otherwise: expands the top window to fill the screen; the top window
+ % becomes current.
+
+ (when (not (= nmode-layout-mode 1))
+ (nmode-select-window nmode-top-window)
+ (=> nmode-bottom-window deexpose)
+ (setf nmode-layout-mode 1)
+ (nmode-set-window-sizes)
+ ))
+
+(de nmode-expand-bottom-window ()
+
+ % This function does nothing if already in 1-window mode.
+ % Otherwise: expands the bottom window to fill the screen; the bottom
+ % window becomes current.
+
+ (when (not (= nmode-layout-mode 1))
+ (psetf nmode-top-window nmode-bottom-window
+ nmode-bottom-window nmode-top-window)
+ (nmode-expand-top-window)
+ ))
+
+(de nmode-2-windows ()
+
+ % This function does nothing if already in 2-window mode.
+ % Otherwise: shrinks the top window and exposes the bottom window.
+
+ (cond
+ ((not (= nmode-layout-mode 2))
+ (setf nmode-layout-mode 2)
+ (nmode-set-window-sizes)
+ )))
+
+(de nmode-set-window-position (p)
+ (selectq p
+ (FULL (nmode-1-window))
+ (TOP (nmode-2-windows) (nmode-select-window nmode-top-window))
+ (BOTTOM (nmode-2-windows) (nmode-select-window nmode-bottom-window))
+ ))
+
+(de nmode-exchange-windows ()
+
+ % Exchanges the current window with the other window, which becomes current.
+ % In two window mode, the windows swap physical positions.
+
+ (let ((w (nmode-other-window)))
+ (psetf nmode-top-window nmode-bottom-window
+ nmode-bottom-window nmode-top-window)
+ (nmode-set-window-sizes)
+ (nmode-select-window w)
+ ))
+
+(de nmode-grow-window (n)
+ % Increase (decrease if n<0) the size of the current window by N lines.
+ % Does nothing and returns NIL if not in 2-window mode.
+
+ (selectq (nmode-window-position)
+ (FULL
+ NIL
+ )
+ (TOP
+ (setf nmode-top-lines (+ nmode-top-lines n))
+ (nmode-set-window-sizes)
+ T
+ )
+ (BOTTOM
+ (setf nmode-top-lines (- nmode-top-lines n))
+ (nmode-set-window-sizes)
+ T
+ )))
+
+(de nmode-expose-output-buffer (b)
+
+ % Buffer B is being used as an output channel. It is not currently being
+ % displayed. Cause it to be displayed (in the "other window", if we
+ % are already in 2-window mode, in the bottom window otherwise).
+
+ (nmode-2-windows)
+ (window-select-buffer (nmode-other-window) b)
+ )
+
+(de nmode-normal-video ()
+ % Cause the display to use "normal" video polarity.
+ (when nmode-inverse-video?
+ (setf nmode-inverse-video? NIL)
+ (nmode-establish-video-polarity)
+ ))
+
+(de nmode-inverse-video ()
+ % Cause the display to use "inverse" video polarity.
+ (when (not nmode-inverse-video?)
+ (setf nmode-inverse-video? T)
+ (nmode-establish-video-polarity)
+ ))
+
+(de nmode-invert-video ()
+ % Toggle between normal and inverse video.
+ (setf nmode-inverse-video? (not nmode-inverse-video?))
+ (nmode-establish-video-polarity)
+ )
+
+(de nmode-use-two-screens ()
+ % If two screens are available, use them both.
+ (when (and nmode-other-screen (not nmode-two-screens?))
+ (when (not (=> nmode-other-terminal raw-mode))
+ (=> nmode-other-terminal enter-raw-mode)
+ (setf full-refresh-needed t)
+ )
+ (setf nmode-two-screens? T)
+ (setf browser-split-screen T)
+ (setf nmode-layout-mode 2)
+ (nmode-set-window-sizes)
+ ))
+
+(de nmode-use-one-screen ()
+ % Use only the main screen.
+ (when nmode-two-screens?
+ (setf nmode-two-screens? NIL)
+ (nmode-set-window-sizes)
+ (if nmode-other-screen (=> nmode-other-screen refresh)) % clear it
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Screen Layout Commands:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de one-window-command ()
+
+ % The "C-X 1" command. Return to one window mode.
+
+ (when (not (= nmode-layout-mode 1))
+ (if nmode-command-argument-given
+ (nmode-expand-bottom-window)
+ (nmode-expand-top-window)
+ )))
+
+(de two-windows-command ()
+
+ % The "C-X 2" command. The bottom window is selected.
+
+ (when (not (= nmode-layout-mode 2))
+ (nmode-2-windows)
+ (if nmode-command-argument-given
+ (window-copy-buffer nmode-top-window nmode-bottom-window))
+ (nmode-switch-windows)
+ ))
+
+(de view-two-windows-command ()
+
+ % The "C-X 3" command. The top window remains selected.
+
+ (when (not (= nmode-layout-mode 2))
+ (nmode-2-windows)
+ (if nmode-command-argument-given
+ (window-copy-buffer nmode-top-window nmode-bottom-window))
+ ))
+
+(de grow-window-command ()
+ (if (not (nmode-grow-window nmode-command-argument))
+ (nmode-error "Not in 2-window mode!")
+ ))
+
+(de other-window-command ()
+ (let ((old-buffer nmode-current-buffer))
+ (nmode-switch-windows)
+ (if nmode-command-argument-given
+ (buffer-select old-buffer))
+ ))
+
+(de exchange-windows-command ()
+ (selectq nmode-layout-mode
+ (1 (Ding))
+ (2 (nmode-exchange-windows))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Window Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-select-window (window)
+
+ % Expose the specified window and make it the "current" window. Its buffer
+ % becomes the "current" buffer. This is the only function that should set
+ % the variable "NMODE-CURRENT-WINDOW".
+
+ (when (not (eq window nmode-current-window))
+ (if nmode-current-window (=> nmode-current-window deselect))
+ (when (not (eq window nmode-input-window))
+ (setf nmode-major-window window)
+ (when (not (eq nmode-current-window nmode-input-window))
+ (reset-message)
+ ))
+ (setf nmode-current-window window)
+ (=> window expose)
+ (=> window select)
+ (nmode-new-window-or-buffer)
+ ))
+
+(de nmode-switch-windows ()
+
+ % Select the "other" window.
+
+ (selectq nmode-layout-mode
+ (2 (nmode-select-window (nmode-other-window)))
+ (1 (nmode-exchange-windows))
+ ))
+
+(de nmode-select-major-window ()
+
+ % This function is used for possible error recovery. It ensures that the
+ % current window is one of the exposed major windows (not, for example, the
+ % INPUT window) and that the INPUT window is deexposed.
+
+ (when (not (or (eq nmode-current-window nmode-top-window)
+ (eq nmode-current-window nmode-bottom-window)
+ ))
+ (nmode-select-window nmode-top-window)
+ (reset-message)
+ )
+ (=> nmode-input-window deexpose)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Screen Information Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-window-position ()
+ (cond ((= nmode-layout-mode 1) 'FULL)
+ ((eq nmode-current-window nmode-top-window) 'TOP)
+ (t 'BOTTOM)
+ ))
+
+(de nmode-other-window ()
+
+ % Return the "other" window.
+
+ (if (eq nmode-current-window nmode-top-window)
+ nmode-bottom-window
+ nmode-top-window
+ ))
+
+(de find-buffer-in-windows (b)
+
+ % Return a list containing the windows displaying the specified buffer.
+ % The windows may or may not be displayed.
+
+ (for (in w (list nmode-bottom-window nmode-top-window))
+ % Put bottom window first in this list so that it will be
+ % the one that is automatically adjusted on output if the
+ % output buffer is being displayed by both windows.
+ (when (eq b (=> w buffer)))
+ (collect w))
+ )
+
+(de find-buffer-in-exposed-windows (b)
+
+ % Return a list containing the exposed windows displaying the specified
+ % buffer.
+
+ (for (in w (find-buffer-in-windows b))
+ (when (=> w exposed?))
+ (collect w))
+ )
+
+(de buffer-is-displayed? (b)
+
+ % Return T if the specified buffer is being displayed by an active window.
+
+ (not
+ (for (in w (nmode-active-windows))
+ (never (eq b (=> w buffer)))
+ )))
+
+(de nmode-active-windows ()
+ (selectq nmode-layout-mode
+ (1 (list nmode-top-window))
+ (2 (list nmode-top-window nmode-bottom-window))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Typeout Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-begin-typeout ()
+
+ % Call this function before doing typeout using the standard output channel.
+ % Someday this will do something clever, but for now it merely clears the
+ % screen.
+
+ (nmode-clear-screen)
+ )
+
+(de nmode-end-typeout ()
+
+ % Call this function after doing typeout using the standard output channel.
+ % Someday this will do something clever, but for now it merely waits for
+ % the user to type a character.
+
+ (pause-until-terminal-input)
+ )
+
+(de nmode-clear-screen ()
+
+ % This is somewhat of a hack to clear the screen for normal typeout. The
+ % next time a refresh is done, a full refresh will be done automatically.
+
+ (=> nmode-blank-screen expose)
+ (=> nmode-screen full-refresh NIL)
+ (setf full-refresh-needed t)
+ )
+
+(de Enter-Raw-Mode ()
+
+ % Use this function to enter "raw mode", in which terminal input is not
+ % echoed and special terminal keys are enabled. The next REFRESH will
+ % automatically be a "full" refresh.
+
+ (when (not (=> nmode-terminal raw-mode))
+ (=> nmode-terminal enter-raw-mode)
+ (setf full-refresh-needed t)
+ )
+ (when (and nmode-two-screens?
+ nmode-other-terminal
+ (not (=> nmode-other-terminal raw-mode)))
+ (=> nmode-other-terminal enter-raw-mode)
+ (setf full-refresh-needed t)
+ )
+ )
+
+(de leave-raw-mode ()
+
+ % Use this function to leave "raw mode", i.e. turn on echoing of terminal
+ % input and disable any special terminal keys. The cursor is positioned
+ % on the last line of the screen, which is cleared.
+
+ (when (=> nmode-terminal raw-mode)
+ (=> nmode-terminal move-cursor (=> nmode-terminal maxrow) 0)
+ (=> nmode-terminal clear-line)
+ (=> nmode-terminal leave-raw-mode)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Refresh functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-refresh ()
+ % This function refreshes the screen. It first ensures that all exposed
+ % NMODE windows update their corresponding virtual screens. Then, it
+ % asks the window package to update the display. A "full refresh" will
+ % be done if some prior operation has indicated the need for one.
+
+ (cond (full-refresh-needed
+ (nmode-full-refresh))
+ (t
+ (nmode-refresh-windows)
+ (when (not nmode-breakout-occurred?)
+ (=> nmode-screen refresh nmode-allow-refresh-breakout)
+ (if (and nmode-other-screen nmode-two-screens?)
+ (=> nmode-other-screen refresh nmode-allow-refresh-breakout))
+ ))))
+
+(de nmode-full-refresh ()
+ % This function refreshes the screen after first clearing the terminal
+ % display. It it used when the state of the terminal display is in doubt.
+
+ (nmode-refresh-windows)
+ (when (not (setf full-refresh-needed nmode-breakout-occurred?))
+ (=> nmode-screen full-refresh nil)
+ (if (and nmode-other-screen nmode-two-screens?)
+ (=> nmode-other-screen full-refresh nil))
+ ))
+
+(de nmode-refresh-one-window (w)
+ % This function refreshes the display, but only updates the virtual screen
+ % corresponding to the specified window.
+
+ (cond (full-refresh-needed
+ (nmode-full-refresh))
+ (nmode-breakout-occurred?
+ (nmode-refresh))
+ (t
+ (if (eq (=> nmode-screen owner 0 0) nmode-blank-screen) % hack!
+ (=> nmode-blank-screen deexpose))
+ (nmode-adjust-window w)
+ (nmode-refresh-window w)
+ (nmode-refresh-screen (=> (=> w screen) screen))
+ )))
+
+(de nmode-refresh-virtual-screen (s)
+ % This function refreshes the shared screen containing the specified
+ % virtual screen.
+
+ (cond (full-refresh-needed
+ (nmode-full-refresh))
+ (nmode-breakout-occurred?
+ (nmode-refresh))
+ (t
+ (if (eq (=> nmode-screen owner 0 0) nmode-blank-screen) % hack!
+ (=> nmode-blank-screen deexpose))
+ (nmode-refresh-screen (=> s screen))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-refresh-windows ()
+ % Cause all windows to update their corresponding virtual screens. The
+ % variable nmode-breakout-occurred? is set to T if the refresh is
+ % interrupted by user input.
+
+ (setf nmode-breakout-occurred? NIL)
+ (=> nmode-blank-screen deexpose) % hack!
+ (=> nmode-current-window adjust-window)
+ (nmode-refresh-window nmode-top-window)
+ (nmode-refresh-window nmode-bottom-window)
+ (nmode-refresh-window nmode-input-window)
+ )
+
+(de nmode-refresh-window (w)
+ % Refresh only if window is exposed and no breakout has occurred.
+ % Update the flag nmode-breakout-occurred?
+
+ (if (not nmode-breakout-occurred?)
+ (if (eq (object-type w) 'buffer-window) % hack for efficiency
+ (if (buffer-window$exposed? w)
+ (setf nmode-breakout-occurred?
+ (not (buffer-window$refresh w nmode-allow-refresh-breakout))))
+ (if (=> w exposed?)
+ (setf nmode-breakout-occurred?
+ (not (=> w refresh nmode-allow-refresh-breakout))))
+ )))
+
+(de nmode-refresh-screen (s)
+ % Refresh the specified shared-screen.
+
+ (if (eq (object-type s) 'shared-physical-screen) % hack for efficiency
+ (shared-physical-screen$refresh s nmode-allow-refresh-breakout)
+ (=> s refresh nmode-allow-refresh-breakout)
+ ))
+
+(de nmode-establish-video-polarity ()
+ (let ((mask (if nmode-inverse-video?
+ nmode-inverse-enhancement
+ nmode-normal-enhancement
+ )))
+ (=> nmode-top-window set-text-enhancement mask)
+ (=> nmode-bottom-window set-text-enhancement mask)
+ (=> nmode-input-window set-text-enhancement mask)
+ (=> nmode-prompt-screen set-default-enhancement mask)
+ (=> nmode-message-screen set-default-enhancement mask)
+ (=> nmode-blank-screen set-default-enhancement mask)
+ (=> nmode-prompt-screen clear)
+ (rewrite-message)
+ (=> nmode-blank-screen clear)
+ ))
+
+(de ensure-terminal-type (type)
+ % Ensure that NMODE-TERMINAL is bound to an object of the specified type.
+
+ (cond ((or (null nmode-terminal)
+ (not (eq type (object-type nmode-terminal))))
+ (setf nmode-terminal (make-instance type))
+ (nmode-new-terminal)
+ )))
+
+(de ensure-other-terminal-type (type)
+ % Ensure that NMODE-OTHER-TERMINAL is bound to an object of the specified
+ % type.
+
+ (cond ((or (null nmode-other-terminal)
+ (not (eq type (object-type nmode-other-terminal))))
+ (setf nmode-other-terminal (make-instance type))
+ (nmode-new-terminal)
+ )))
+
+(de nmode-new-terminal ()
+ % This function should be called when either NMODE-TERMINAL or
+ % NMODE-OTHER-TERMINAL changes.
+
+ (setf full-refresh-needed T)
+ (setf nmode-physical-screen (create-physical-screen nmode-terminal))
+ (setf nmode-other-physical-screen
+ (if nmode-other-terminal
+ (create-physical-screen nmode-other-terminal)))
+ (if nmode-screen
+ (=> nmode-screen set-screen nmode-physical-screen)
+ (setf nmode-screen (create-shared-physical-screen nmode-physical-screen))
+ )
+ (nmode-setup-softkey-label-screen nmode-screen)
+ (if nmode-other-terminal
+ (if nmode-other-screen
+ (=> nmode-other-screen set-screen nmode-other-physical-screen)
+ (setf nmode-other-screen
+ (create-shared-physical-screen nmode-other-physical-screen))
+ )
+ (setf nmode-other-screen nil)
+ )
+ (let ((height (=> nmode-screen height))
+ (width (=> nmode-screen width))
+ )
+ (when nmode-softkey-label-screen
+ (setf height (- height (=> nmode-softkey-label-screen height)))
+ )
+ (setf nmode-total-lines (- height 2)) % all but message and prompt lines
+ (setf nmode-top-lines (/ nmode-total-lines 2)) % half for the top window
+
+ % Throw away the old windows and screens!
+ (if nmode-blank-screen (=> nmode-blank-screen deexpose))
+ (if nmode-message-screen (=> nmode-message-screen deexpose))
+ (if nmode-prompt-screen (=> nmode-prompt-screen deexpose))
+ (if nmode-input-window (=> nmode-input-window deexpose))
+
+ % Create new windows and screens:
+ (setf nmode-blank-screen % hack to implement clear screen
+ (nmode-create-screen height width 0 0))
+ (setf nmode-message-screen (nmode-create-screen 1 width (- height 2) 0))
+ (setf nmode-prompt-screen (nmode-create-screen 1 width (- height 1) 0))
+ (setf nmode-input-window
+ (create-unlabeled-buffer-window nmode-input-buffer
+ (nmode-create-screen 1 width (- height 1) 0)))
+ (nmode-fixup-windows)
+ (setf nmode-layout-mode (if nmode-two-screens? 2 1))
+ (=> nmode-message-screen expose)
+ (=> nmode-prompt-screen expose)
+ (nmode-select-window nmode-top-window)
+ (nmode-establish-video-polarity)
+ (nmode-set-window-sizes)
+ ))
+
+(de nmode-create-screen (height width row-origin column-origin)
+ (make-instance 'virtual-screen
+ 'screen nmode-screen
+ 'height height
+ 'width width
+ 'row-origin row-origin
+ 'column-origin column-origin)
+ )
+
+(de nmode-set-window-sizes ()
+ % This function ensures that the top and bottom windows are properly
+ % set up and exposed.
+
+ (cond ((< nmode-top-lines 2)
+ (setf nmode-top-lines 2))
+ ((> nmode-top-lines (- nmode-total-lines 2))
+ (setf nmode-top-lines (- nmode-total-lines 2)))
+ )
+ (nmode-fixup-windows)
+ (cond
+ (nmode-two-screens?
+ (nmode-position-window nmode-top-window nmode-total-lines 0)
+ (nmode-position-window nmode-bottom-window nmode-total-lines 0)
+ (nmode-expose-both-windows)
+ )
+ ((= nmode-layout-mode 1)
+ (nmode-position-window nmode-top-window nmode-total-lines 0)
+ (nmode-position-window nmode-bottom-window nmode-total-lines 0)
+ (=> nmode-top-window expose)
+ )
+ ((= nmode-layout-mode 2)
+ (nmode-position-window nmode-top-window nmode-top-lines 0)
+ (nmode-position-window nmode-bottom-window
+ (- nmode-total-lines nmode-top-lines)
+ nmode-top-lines
+ )
+ (nmode-expose-both-windows)
+ )))
+
+(de nmode-position-window (w height origin)
+ (if (eq (=> (=> w screen) screen) nmode-other-screen)
+ (setf height (=> nmode-other-screen height)))
+ (=> w set-size height (=> w width))
+ (let ((s (=> w screen)))
+ (=> s set-origin origin 0))
+ )
+
+(de nmode-expose-both-windows ()
+ (cond ((eq nmode-top-window nmode-current-window)
+ (=> nmode-bottom-window expose)
+ (=> nmode-top-window expose)
+ )
+ (t
+ (=> nmode-top-window expose)
+ (=> nmode-bottom-window expose)
+ )))
+
+(de nmode-fixup-windows ()
+ % Ensure that the two buffer-windows exist and are attached to the proper
+ % shared-screens.
+
+ (let ((top-screen (if (and nmode-two-screens? nmode-other-screen)
+ nmode-other-screen
+ nmode-screen
+ ))
+ (bottom-screen nmode-screen)
+ )
+ (if (or (not nmode-top-window)
+ (neq (=> (=> nmode-top-window screen) screen) top-screen)
+ )
+ (nmode-create-top-window)
+ )
+ (if (or (not nmode-bottom-window)
+ (neq (=> (=> nmode-bottom-window screen) screen) bottom-screen)
+ )
+ (nmode-create-bottom-window)
+ )
+ ))
+
+(de nmode-create-top-window ()
+ (let ((vs (if (and nmode-two-screens? nmode-other-screen)
+ (make-instance 'virtual-screen
+ 'screen nmode-other-screen
+ 'height (=> nmode-other-screen height)
+ 'width (=> nmode-other-screen width)
+ 'row-origin 0
+ )
+ (make-instance 'virtual-screen
+ 'screen nmode-screen
+ 'height nmode-total-lines
+ 'width (=> nmode-screen width)
+ 'row-origin 0
+ )))
+ )
+ (if nmode-top-window
+ (=> nmode-top-window set-screen vs)
+ (setf nmode-top-window (create-buffer-window nmode-main-buffer vs))
+ )))
+
+(de nmode-create-bottom-window ()
+ (let ((vs (make-instance 'virtual-screen
+ 'screen nmode-screen
+ 'height nmode-total-lines
+ 'width (=> nmode-screen width)
+ 'row-origin 0
+ ))
+ )
+ (if nmode-bottom-window
+ (=> nmode-bottom-window set-screen vs)
+ (setf nmode-bottom-window (create-buffer-window nmode-output-buffer vs))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor nmode-top-window nmode-bottom-window nmode-input-window
+ nmode-current-window nmode-blank-screen nmode-screen)
ADDED psl-1983/3-1/nmode/search.sl
Index: psl-1983/3-1/nmode/search.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/search.sl
@@ -0,0 +1,240 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Search.SL - Search utilities
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 August 1982
+% Revised: 5 April 1983
+%
+% 19-June-83 Mark R. Swanson
+% Added PATTERN-STARTS-IN-LINE to traverse entire line looking for first
+% character of PATTERN; this avoids many, many procedure calls.
+% 5-Apr-83 Nancy Kendzierski
+% Removed extra right parenthesis at end of forward-search and reverse-search.
+% 5-April-83 Jeff Soreff
+% Forward-Search-In-String was added to allow use of searching within a
+% string, as well as within a buffer.
+% Adapted from Will Galway's EMODE
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% These routines to implement minimal string searches for EMODE. Searches
+% are non-incremental, limited to single line patterns, and always ignore
+% case.
+
+(CompileTime (load objects fast-strings fast-int))
+
+(fluid '(last-search-string))
+(setf last-search-string NIL)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de forward-string-search ()
+ % Invoked from keyboard, search forward from point for string, leave
+ % "point" unchanged if not found.
+
+ (let ((strng (prompt-for-string "Forward search: " last-search-string)))
+ (setf last-search-string strng)
+ (if (buffer-search strng 1)
+ (for (from i 0 (string-upper-bound strng))
+ (do (move-forward))
+ )
+ % else
+ (write-prompt "Search failed.")
+ (Ding)
+ )))
+
+(de reverse-string-search ()
+ % Invoked from keyboard, search backwards from point for string, leave
+ % "point unchanged if not found.
+
+ (let ((strng (prompt-for-string "Reverse search: " last-search-string)))
+ (setf last-search-string strng)
+ (move-backward)
+ (if (not (buffer-search strng -1))
+ (progn (move-forward) (write-prompt "Search failed.") (Ding)))
+ ))
+
+(de buffer-search (pattern dir)
+
+ % Search in buffer for the specified pattern. Dir should be +1 for forward,
+ % -1 for backward. If the pattern is found, the buffer cursor will be set to
+ % the beginning of the matching string and T will be returned. Otherwise,
+ % the buffer cursor will remain unchanged and NIL will be returned.
+
+ (setf pattern (string-upcase pattern))
+ (if (> dir 0)
+ (forward-search pattern)
+ (reverse-search pattern)
+ ))
+
+(de forward-search (pattern)
+
+ % Search forward in the current buffer for the specified pattern.
+ % If the pattern is found, the buffer cursor will be set to
+ % the beginning of the matching string and T will be returned. Otherwise,
+ % the buffer cursor will remain unchanged and NIL will be returned.
+
+ (let ((line-pos (current-line-pos))
+ (char-pos (current-char-pos))
+ (limit (current-buffer-size))
+ found-pos
+ )
+
+ (while
+ (and (< line-pos limit)
+ (not (setf found-pos
+ (forward-search-on-line line-pos char-pos pattern)))
+ )
+ (setf line-pos (+ line-pos 1))
+ (setf char-pos NIL)
+ )
+ (if found-pos
+ (progn (current-buffer-goto line-pos found-pos) T)))
+ )
+
+(de forward-search-in-string (string pattern)
+ % Search in the string for the specified pattern, starting at the
+ % beginning of the string. If we find it, we return the CHAR-POS of
+ % the first matching character. Otherwise, we return NIL.
+ (let* ((pattern-length (string-length pattern))
+ (limit (- (string-length string) pattern-length))
+ (char-pos 0))
+ (while (<= char-pos limit)
+ (if (pattern-matches-in-line pattern string char-pos)
+ (exit char-pos))
+ (incr char-pos))))
+
+(de forward-search-on-line (line-pos char-pos pattern)
+ % Returns START-POSITION of pattern if it occurs in line, NIL otherwise.
+ % Uses two subroutines:
+ % PATTERN-STARTS-IN-LINE, which scans LINE for the first character of
+ % PATTERN, constrained by the length of pattern
+ % PATTERN-MATCHES-IN-LINE, which tries to match PATTERN with contents of
+ % LINE at POS
+
+ (let* ((line (current-buffer-fetch line-pos))
+ (pattern-length (string-length pattern))
+ (limit (- (string-length line) pattern-length))
+ (pattern-char (string-fetch pattern 0))
+ )
+ (if (null char-pos) (setf char-pos 0))
+ (while (<= char-pos limit)
+ (setf char-pos (pattern-starts-in-line pattern-char limit line char-pos))
+ (if (> char-pos limit)
+ (exit nil))
+ (if (pattern-matches-in-line pattern line char-pos)
+ (exit char-pos))
+ (setf char-pos (+ char-pos 1))
+ )))
+
+(de reverse-search (pattern)
+
+ % Search backward in the current buffer for the specified pattern.
+ % If the pattern is found, the buffer cursor will be set to
+ % the beginning of the matching string and T will be returned. Otherwise,
+ % the buffer cursor will remain unchanged and NIL will be returned.
+
+ (let ((line-pos (current-line-pos))
+ (char-pos (current-char-pos))
+ found-pos
+ )
+
+ (while
+ (and (>= line-pos 0)
+ (not (setf found-pos
+ (reverse-search-on-line line-pos char-pos pattern)))
+ )
+ (setf line-pos (- line-pos 1))
+ (setf char-pos NIL)
+ )
+ (if found-pos
+ (progn (current-buffer-goto line-pos found-pos) T)))
+ )
+
+(de reverse-search-on-line (line-pos char-pos pattern)
+ % Returns START-POSITION of pattern if it occurs in line, NIL otherwise.
+ % Uses two subroutines:
+ % REV-PATTERN-STARTS-IN-LINE, which scans LINE for the first character of
+ % PATTERN, constrained by the length of pattern
+ % PATTERN-MATCHES-IN-LINE, which tries to match PATTERN with contents of
+ % LINE at POS
+
+ (let* ((line (current-buffer-fetch line-pos))
+ (pattern-length (string-length pattern))
+ (limit (- (string-length line) pattern-length))
+ (pattern-char (string-fetch pattern 0))
+ )
+ (if (or (null char-pos) (> char-pos limit))
+ (setf char-pos limit))
+ (while (>= char-pos 0)
+ (setf char-pos (rev-pattern-starts-in-line pattern-char line char-pos))
+ (if (< char-pos 0)
+ (exit nil))
+ (if (pattern-matches-in-line pattern line char-pos)
+ (exit char-pos))
+ (setf char-pos (- char-pos 1))
+ )))
+
+(de pattern-starts-in-line (pattern-char search-limit line pos)
+ % Return position if PATTERN-CHAR occurs in LINE, with sufficient room
+ % for rest of pattern; start looking at POS.
+ % Ignore case differences. No bounds checking is performed on LINE.
+
+ (let ((i pos))
+ (while (<= i search-limit)
+ (if (= pattern-char
+ %(char-upcase (string-fetch line i))
+ (let ((xchar (string-fetch line i)))
+ (cond
+ ((< xchar #/a) xchar)
+ ((> xchar #/z) xchar)
+ (T
+ (- xchar 32)))))
+ (exit i)
+ (setf i (+ i 1))))
+ (exit i) % nothing matched, i > limit will indicate such
+ ))
+
+(de rev-pattern-starts-in-line (pattern-char line pos)
+ % Return position if PATTERN-CHAR occurs in LINE, with sufficient room
+ % for rest of pattern; start looking at POS.
+ % Ignore case differences. No bounds checking is performed on LINE.
+
+ (let ((i pos))
+ (while (>= i 0)
+ (if (= pattern-char
+ %(char-upcase (string-fetch line i))
+ (let ((xchar (string-fetch line i)))
+ (cond
+ ((< xchar #/a) xchar)
+ ((> xchar #/z) xchar)
+ (T
+ (- xchar 32)))))
+ (exit i)
+ (setf i (- i 1))))
+ (exit i) % nothing matched, i > limit will indicate such
+ ))
+
+(de pattern-matches-in-line (pattern line pos)
+ % Return T if PATTERN occurs as substring of LINE, starting at POS.
+ % Ignore case differences. No bounds checking is performed on LINE.
+
+ (let ((i 0) (patlimit (string-upper-bound pattern)))
+ (while (and (<= i patlimit)
+ (= (string-fetch pattern i)
+ %(char-upcase (string-fetch line (+ i pos)))
+ (let ((xchar (string-fetch line (+ i pos))))
+ (cond
+ ((< xchar #/a) xchar)
+ ((> xchar #/z) xchar)
+ (T
+ (- xchar 32))))
+ )
+ )
+ (setf i (+ i 1))
+ )
+ (> i patlimit) % T if all chars matched, NIL otherwise
+ ))
+
ADDED psl-1983/3-1/nmode/set-terminal-20.sl
Index: psl-1983/3-1/nmode/set-terminal-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/set-terminal-20.sl
@@ -0,0 +1,58 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Set-Terminal-20.SL (Tops-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 1 November 1982
+%
+% This file contains functions that set NMODE's terminal.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+
+% External variables used here:
+
+(fluid '(nmode-terminal))
+
+% Global variables defined here:
+
+(fluid '(terminal-type))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Terminal Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-default-terminal ()
+ (nmode-set-terminal)
+ )
+
+(de nmode-set-terminal ()
+ (setf terminal-type (jsys2 65 0 0 0 (const jsgttyp)))
+ (selectq terminal-type
+ (21 % HP2621
+ (ensure-terminal-type 'hp2648a)
+ )
+ (6 % HP264X
+ (ensure-terminal-type 'hp2648a)
+ )
+ (15 % VT52
+ (ensure-terminal-type 'vt52x)
+ )
+ (t
+ (or nmode-terminal (ensure-terminal-type 'hp2648a))
+ )
+ ))
+
+(de ensure-terminal-type (type)
+ (cond ((or (null nmode-terminal)
+ (not (eq type (object-type nmode-terminal))))
+ (setf nmode-terminal (make-instance type))
+ (nmode-new-terminal)
+ )))
+
+% These functions defined for compatibility:
+
+(de hp2648a () (ensure-terminal-type 'hp2648a))
+(de vt52x () (ensure-terminal-type 'vt52x))
ADDED psl-1983/3-1/nmode/set-terminal-9836.sl
Index: psl-1983/3-1/nmode/set-terminal-9836.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/set-terminal-9836.sl
@@ -0,0 +1,45 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Set-Terminal-9836.SL (9836 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 27 December 1982
+%
+% This file contains functions that set NMODE's terminal.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+
+% External variables used here:
+
+(fluid '(nmode-terminal nmode-other-terminal))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Terminal Selection Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-default-terminal ()
+ (nmode-set-terminal)
+ )
+
+(de nmode-set-terminal ()
+ (or nmode-terminal (ensure-terminal-type '9836-alpha))
+ (or nmode-other-terminal (ensure-other-terminal-type '9836-color))
+ )
+
+(de ensure-terminal-type (type)
+ (cond ((or (null nmode-terminal)
+ (not (eq type (object-type nmode-terminal))))
+ (setf nmode-terminal (make-instance type))
+ (nmode-new-terminal)
+ )))
+
+(de ensure-other-terminal-type (type)
+ (cond ((or (null nmode-other-terminal)
+ (not (eq type (object-type nmode-other-terminal))))
+ (setf nmode-other-terminal (make-instance type))
+ (nmode-new-terminal)
+ )))
+
ADDED psl-1983/3-1/nmode/softkeys.sl
Index: psl-1983/3-1/nmode/softkeys.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/softkeys.sl
@@ -0,0 +1,163 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% SoftKeys.SL - NMODE SoftKeys
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 28 January 1983
+%
+% This implementation of softkeys is intended primarily for the HP9836
+% implementation. It recognizes the escape-sequence Esc-/, followed by
+% a single character, as instructing NMODE to execute the softkey
+% corresponding to that character. In the HP9836 implementation,
+% we can cause the keys K0-K9 to send the appropriate escape sequence.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-strings fast-vectors display-char))
+
+% Global variables defined here:
+
+(fluid '(nmode-softkey-label-screen
+ nmode-softkey-label-screen-height % number of rows of keys
+ nmode-softkey-label-screen-width % number of keys per row
+ ))
+
+% Internal static variables (don't use elsewhere!):
+
+(fluid '(nmode-softkey-defs % vector of softkey definitions (see below)
+ nmode-softkey-labels % vector of softkey label strings
+ nmode-softkey-label-width % number of characters wide
+ nmode-softkey-label-count % number of displayed labels
+ ))
+
+(when (or (unboundp 'nmode-softkey-defs) (null nmode-softkey-defs))
+ (setf nmode-softkey-label-screen NIL)
+ (setf nmode-softkey-label-screen-height 0)
+ (setf nmode-softkey-label-screen-width 0)
+ (setf nmode-softkey-defs (make-vector 40 NIL))
+ (setf nmode-softkey-labels (make-vector 40 NIL))
+ (setf nmode-softkey-label-width 0)
+ (setf nmode-softkey-label-count 0)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-define-softkey (n fcn label-string)
+ % N should be a softkey number. FCN should be a function ID, a string,
+ % or NIL. Define softkey #n to run the specified function, execute the
+ % specified string (as if typed), or be undefined, respectively.
+ % LABEL-STRING should be a string or NIL. The string will be centered.
+
+ (if (and (valid-softkey-number? n)
+ (or (null fcn) (idp fcn) (stringp fcn))
+ (or (null label-string) (stringp label-string))
+ )
+ (progn
+ (vector-store nmode-softkey-defs n fcn)
+ (vector-store nmode-softkey-labels n label-string)
+ (nmode-write-softkey-label n)
+ )
+ (nmode-error "Invalid arguments to Define Softkey")
+ ))
+
+(de valid-softkey-number? (n)
+ (and (fixp n) (>= n 0) (<= n (vector-upper-bound nmode-softkey-defs)))
+ )
+
+(de softkey-char-to-number (ch)
+ (- (char-code ch) #/0))
+
+(de softkey-number-to-char (n)
+ (+ n #/0))
+
+(de nmode-execute-softkey (n)
+ % Execute softkey #n.
+
+ (if (valid-softkey-number? n)
+ (let ((fcn (vector-fetch nmode-softkey-defs n)))
+ (cond ((null fcn)
+ (nmode-error (bldmsg "Softkey %w is undefined." n)))
+ ((stringp fcn)
+ (nmode-execute-string fcn))
+ ((idp fcn)
+ (apply fcn ()))
+ (t
+ (nmode-error (bldmsg "Softkey %w has a bad definition." n)))
+ ))
+ (nmode-error (bldmsg "Invalid Softkey specified."))
+ ))
+
+(de execute-softkey-command (n)
+ (nmode-set-delayed-prompt "Execute Softkey: ")
+ (let ((ch (input-direct-terminal-character)))
+ (nmode-execute-softkey (softkey-char-to-number ch))
+ ))
+
+(de nmode-setup-softkey-label-screen (sps)
+ % If the requested size of the softkey label screen is nonzero, then
+ % create a virtual screen of that size on the given shared screen.
+ % The requested size is obtained from global variables.
+
+ (setf nmode-softkey-label-width 0)
+ (setf nmode-softkey-label-count 0)
+ (let ((height nmode-softkey-label-screen-height)
+ (width nmode-softkey-label-screen-width)
+ (screen-height (=> sps height))
+ (screen-width (=> sps width))
+ )
+ (setf nmode-softkey-label-screen
+ (when (and (> height 0) (> width 0) (> screen-width (* 2 width))
+ (>= screen-height height)
+ )
+ (let ((s (make-instance 'virtual-screen
+ 'screen sps
+ 'height height
+ 'width screen-width
+ 'row-origin (- screen-height height)
+ 'column-origin 0
+ )))
+ (setf nmode-softkey-label-width (/ screen-width width))
+ (setf nmode-softkey-label-count (* width height))
+ (=> s set-default-enhancement (=> sps highlighted-enhancement))
+ s
+ )))
+ (when nmode-softkey-label-screen
+ (for (from i 0 (- nmode-softkey-label-count 1))
+ (do (nmode-write-softkey-label i)))
+ (=> nmode-softkey-label-screen expose)
+ )
+ ))
+
+(de nmode-write-softkey-label (n)
+ (when (and nmode-softkey-label-screen
+ (>= n 0)
+ (< n nmode-softkey-label-count)
+ )
+ (let* ((row (/ n nmode-softkey-label-screen-width))
+ (lcol (// n nmode-softkey-label-screen-width))
+ (col (* lcol nmode-softkey-label-width))
+ (enhancement (if (xor (= (// row 2) 0) (= (// lcol 2) 0))
+ (dc-make-enhancement-mask INVERSE-VIDEO INTENSIFY)
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ ))
+ (label (vector-fetch nmode-softkey-labels n))
+ (bound (if label (string-upper-bound label) -1))
+ (padding (/ (- nmode-softkey-label-width (+ bound 1)) 2))
+ )
+ (=> nmode-softkey-label-screen set-default-enhancement enhancement)
+ (if (< padding 0) (setf padding 0))
+ (for (from i 1 padding)
+ (do (=> nmode-softkey-label-screen write #\space row col)
+ (setf col (+ col 1))
+ ))
+ (for (from i 0 (- (- nmode-softkey-label-width padding) 1))
+ (do (let ((ch (if (<= i bound)
+ (string-fetch label i)
+ #\space
+ )))
+ (=> nmode-softkey-label-screen write ch row (+ col i))
+ )))
+ )))
ADDED psl-1983/3-1/nmode/structure-functions.sl
Index: psl-1983/3-1/nmode/structure-functions.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/structure-functions.sl
@@ -0,0 +1,299 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Structure-Functions.SL - NMODE functions for moving about structured text
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 12 November 1982
+% Revised: 18 February 1983
+%
+% This file contains functions for moving about structured text, such as Lisp
+% source code. The functions are based on the primitives in the module
+% NMODE-Parsing; the variable NMODE-CURRENT-PARSER determines the actual syntax
+% (e.g., Lisp, RLISP, etc.). See the document NMODE-PARSING.TXT for a
+% description of the parsing strategy.
+%
+% 18-Feb-83 Alan Snyder
+% Replaced move-down-list with move-forward-down-list and
+% move-backward-down-list.
+% 6-Jan-83 Alan Snyder
+% Use LOAD instead of FASLIN to get macros (for portability); reformat source.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int nmode-parsing))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Form Movement Functions
+%
+% A form is an ATOM or a nested structure.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-form ()
+ % Move to the end (just past the last character) of the current (if any) or
+ % the next (otherwise) complete form or unmatched closing bracket. Returns
+ % either NIL (no complete form found), 'ATOM, 'CLOSER (unmatched closing
+ % bracket), or 'STRUCTURE (complete structure). If NIL is returned, then
+ % point is unchanged.
+
+ (let* ((old-pos (buffer-get-position)) % save current position
+ (first-item (move-forward-item)) % find next item (see below)
+ )
+ (if (eq first-item 'OPENER) % it is an opening bracket
+ (while T % scan past complete forms until an unmatched closing bracket
+ (selectq (move-forward-form)
+ (NIL (buffer-set-position old-pos) (exit NIL)) % end of text
+ (CLOSER (exit 'STRUCTURE)) % found the matching closing bracket
+ ))
+ first-item % Otherwise, just return the information.
+ )))
+
+(de move-backward-form ()
+ % Move backward at least one character to the preceding character that is not
+ % part of whitespace; then move to the beginning of the smallest form that
+ % contains that character. If no form is found, return NIL and leave point
+ % unchanged. Otherwise, return either 'ATOM, 'STRUCTURE (passed over complete
+ % structure), or 'OPENER (passed over unmatched open bracket).
+
+ (let* ((old-pos (buffer-get-position)) % save current position
+ (first-item (move-backward-item)) % find previous item (see below)
+ )
+ (if (eq first-item 'CLOSER) % it is a closing bracket
+ (while T % scan past complete forms until an unmatched opening bracket
+ (selectq (move-backward-form)
+ (NIL (buffer-set-position old-pos) (exit NIL)) % beginning of text
+ (OPENER (exit 'STRUCTURE)) % found the matching opening bracket
+ ))
+ first-item % Otherwise, just return the information.
+ )))
+
+(de move-backward-form-interruptible ()
+ % This function is like move-backward-form, except it can be interrupted by
+ % user type-ahead. If it is interrupted, it returns 'INTERRUPT and restores
+ % the old position.
+
+ (let ((old-pos (buffer-get-position))
+ (paren-depth 0)
+ )
+ (while T
+ (when (input-available?) (buffer-set-position old-pos) (exit 'INTERRUPT))
+ (let ((item (move-backward-item)))
+ (selectq item
+ (NIL (buffer-set-position old-pos) (exit NIL))
+ (OPENER (setf paren-depth (- paren-depth 1))
+ (if (= paren-depth 0) (exit 'STRUCTURE))
+ )
+ (CLOSER (setf paren-depth (+ paren-depth 1)))
+ )
+ (if (<= paren-depth 0) (exit item))
+ ))))
+
+(de move-backward-form-within-line ()
+ % This is the same as MOVE-BACKWARD-FORM, except that it looks only within the
+ % current line.
+
+ (let* ((old-pos (buffer-get-position)) % save current position
+ (first-item (move-backward-item-within-line)) % find previous item
+ )
+ (if (eq first-item 'CLOSER) % it is a closing bracket
+ (while T % scan past complete forms until an unmatched opening bracket
+ (selectq (move-backward-form-within-line)
+ (NIL (buffer-set-position old-pos) (exit NIL)) % beginning of text
+ (OPENER (exit 'STRUCTURE)) % found the matching opening bracket
+ ))
+ first-item % Otherwise, just return the information.
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Item Movement Functions
+%
+% An item is an ATOM or a structure bracket.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-item ()
+ % Move to the end (just past the last character) of the current (if any) or
+ % the next (otherwise) atom or bracket. Returns either NIL (no item found),
+ % 'ATOM, 'OPENER, or 'CLOSER. If NIL is returned, then point is unchanged.
+
+ (let ((item-type (move-forward-to LAST NOT-SPACE)))
+ (if item-type (move-forward-character))
+ item-type
+ ))
+
+(de move-backward-item ()
+ % Move backward at least one character to the preceding character that is not
+ % part of whitespace; then move to the beginning of the atom or bracket that
+ % contains that character. Returns either NIL (no item found), 'ATOM,
+ % 'OPENER, or 'CLOSER. If NIL is returned, then point is unchanged.
+
+ (let ((old-pos (buffer-get-position))
+ (item-type nil)
+ )
+ (if (move-backward-character)
+ (setf item-type (move-backward-to FIRST NOT-SPACE)))
+ (if (not item-type) (buffer-set-position old-pos))
+ item-type
+ ))
+
+(de move-backward-item-within-line ()
+ % This is the same as MOVE-BACKWARD-ITEM, except that it looks only within the
+ % current line.
+
+ (if (not (at-line-start?))
+ (let ((old-pos (buffer-get-position))
+ (item-type nil)
+ )
+ (move-backward-character)
+ (setf item-type (move-backward-within-line-to FIRST NOT-SPACE))
+ (if (not item-type) (buffer-set-position old-pos))
+ item-type
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Move-Up-Forms Functions
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-up-list ()
+ % Move to the right of the current structure (e.g. list). In other words,
+ % find the next closing structure bracket whose matching opening structure
+ % bracket is before point. If no such bracket can be found, return NIL and
+ % leave point unchanged.
+
+ (forward-scan-for-right-paren -1)
+ )
+
+(de move-backward-up-list ()
+ % Move to the beginning of the current structure (e.g. list). In other words,
+ % find the previous opening structure bracket whose matching closing structure
+ % bracket is after point. If no such bracket can be found, return NIL and
+ % leave point unchanged.
+
+ (reverse-scan-for-left-paren 1)
+ )
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% List Movement Functions
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-list ()
+ % Move to the right of the current or next structure (e.g. list). In other
+ % words, find the next closing structure bracket whose matching opening
+ % structure bracket is before point or is the first opening structure bracket
+ % after point. If no such bracket can be found, return NIL and leave point
+ % unchanged.
+
+ (forward-scan-for-right-paren 0)
+ )
+
+(de move-backward-list ()
+ % Move to the beginning of the current or previous structure (e.g. list). In
+ % other words, find the previous opening structure bracket whose matching
+ % closing structure bracket is after point or is the first closing structure
+ % bracket before point. If no such bracket can be found, return NIL and leave
+ % point unchanged.
+
+ (reverse-scan-for-left-paren 0)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Display Commands
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de display-matching-opener ()
+ % If the previous character is the last character of a closing bracket, then
+ % move backward to the beginning of the form, wait a while so that the user
+ % can see where it is, then return to the previous position.
+ (let ((old-pos (buffer-get-position)))
+ (unwind-protect
+ (unsafe-display-matching-opener)
+ (buffer-set-position old-pos)
+ )))
+
+(de unsafe-display-matching-opener ()
+ (move-backward-character)
+ (when (test-current-attributes LAST CLOSER)
+ (move-forward-character)
+ (selectq (move-backward-form-interruptible)
+ (STRUCTURE
+ (nmode-refresh) % Show the user where we are.
+ (sleep-until-timeout-or-input 30) % wait a while
+ )
+ (INTERRUPT)
+ (t (Ding))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal List Scanning Primitives
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de reverse-scan-for-left-paren (depth)
+ % Scan backwards (starting with the character before point) for a left paren
+ % at depth >= the specified depth. If found, the left paren will be after
+ % point and T will be returned. Otherwise, point will not change and NIL will
+ % be returned.
+ (let ((old-pos (buffer-get-position))
+ (paren-depth 0)
+ )
+ (while T
+ (selectq (move-backward-item)
+ (NIL (buffer-set-position old-pos) (exit NIL))
+ (CLOSER (setf paren-depth (- paren-depth 1)))
+ (OPENER (setf paren-depth (+ paren-depth 1))
+ (if (>= paren-depth depth) (exit T))
+ )
+ ))))
+
+(de forward-scan-for-right-paren (depth)
+ % Scan forward (starting with the character after point) for a right paren at
+ % depth <= the specified depth. If found, the right paren will be before
+ % point and T will be returned. Otherwise, point will not change and NIL will
+ % be returned.
+ (let ((old-pos (buffer-get-position))
+ (paren-depth 0)
+ )
+ (while T
+ (selectq (move-forward-item)
+ (NIL (buffer-set-position old-pos) (exit NIL))
+ (CLOSER (setf paren-depth (- paren-depth 1))
+ (if (<= paren-depth depth) (exit T))
+ )
+ (OPENER (setf paren-depth (+ paren-depth 1)))
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Move-Down-List functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de move-forward-down-list ()
+ % Move forward past the next open bracket at the current level.
+ (let ((old-pos (buffer-get-position)))
+ (while T
+ (selectq (move-forward-item)
+ ((NIL CLOSER) (buffer-set-position old-pos) (exit NIL))
+ (OPENER (exit T))
+ ))))
+
+(de move-backward-down-list ()
+ % Move backward past the previous close bracket at the current level.
+ (let ((old-pos (buffer-get-position)))
+ (while T
+ (selectq (move-backward-item)
+ ((NIL OPENER) (buffer-set-position old-pos) (exit NIL))
+ (CLOSER (exit T))
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de skip-prefixes ()
+ % Skip over any "prefix characters" (like ' in Lisp).
+ (while (test-current-attributes PREFIX) (move-forward))
+ )
ADDED psl-1983/3-1/nmode/terminal-input.sl
Index: psl-1983/3-1/nmode/terminal-input.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/terminal-input.sl
@@ -0,0 +1,290 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Terminal-Input.SL - NMODE Terminal Input Routines
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 27 August 1982
+% Revised: 14 March 1983
+%
+% 14-Mar-83 Alan Snyder
+% Get terminal character from physical screen, to take advantage of its
+% cached method.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 26-Jan-83 Alan Snyder
+% Add ability to read from string.
+% 21-Dec-82 Alan Snyder
+% Efficiency improvement: Added declarations for text buffers.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int fast-strings))
+(load wait)
+
+% External variables used:
+
+(fluid '(nmode-terminal
+ nmode-allow-refresh-breakout
+ nmode-physical-screen
+ ))
+
+% Internal static variables (don't use elsewhere!):
+
+(fluid
+ '(nmode-prompt-string % current prompt for character input
+ nmode-prompt-immediately % true => show prompt immediately
+ nmode-terminal-script-buffer % if non-NIL, is a buffer to script to
+ nmode-terminal-input-buffer % if non-NIL, is a buffer to read from
+ nmode-terminal-input-string % if non-NIL, is a string to read from
+ nmode-terminal-input-string-pos % index of next character in string
+ ))
+
+(setf nmode-prompt-string "")
+(setf nmode-prompt-immediately NIL)
+(setf nmode-terminal-script-buffer NIL)
+(setf nmode-terminal-input-buffer NIL)
+(setf nmode-terminal-input-string NIL)
+
+(declare-flavor text-buffer
+ nmode-terminal-input-buffer
+ nmode-terminal-script-buffer)
+(declare-flavor physical-screen nmode-physical-screen)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% A primary goal of this module is to support delayed prompting. Prompting can
+% mean both echoing (some kind of confirmation) of the previous input and
+% information relating to expected input. The basic idea behind delayed
+% prompting is that as long as the user is rapidly typing input characters,
+% there is no need for the system to display any prompts, since the user
+% probably knows what he is doing. However, should the user ever pause for a
+% "sufficiently long" time, then the current prompt should be displayed to
+% inform the user of the current state.
+
+% An important notion is that some command interactions form a logical sequence.
+% In the case of a logical sequence of prompted inputs, each additional prompt
+% string should be appended to the existing prompt string, without first erasing
+% the prompt line. Furthermore, once the prompt line for this sequence is
+% displayed, any further prompts within the same sequence should be output
+% immediately. A command sequence is started using the function
+% NMODE-SET-DELAYED-PROMPT. Additional prompting within the same sequence is
+% specified using either NMODE-APPEND-DELAYED-PROMPT or
+% NMODE-APPEND-SEPARATED-PROMPT.
+
+(de nmode-set-immediate-prompt (prompt-string)
+
+ % This function is used to specify the beginning of a command sequence. It
+ % causes the existing prompt string to be discarded and replaced by the
+ % specified string. The specified string may be empty to indicate that the
+ % new command sequence has no initial prompt. The prompt string will be
+ % output immediately upon the next request for terminal input.
+
+ (setf nmode-prompt-string prompt-string)
+ (setf nmode-prompt-immediately T)
+ )
+
+(de nmode-set-delayed-prompt (prompt-string)
+
+ % This function is used to specify the beginning of a command sequence. It
+ % causes the existing prompt string to be discarded and replaced by the
+ % specified string. The specified string may be empty to indicate that the
+ % new command sequence has no initial prompt. The prompt string will be
+ % output when terminal input is next requested, provided that the user has
+ % paused.
+
+ (setf nmode-prompt-string prompt-string)
+ (setf nmode-prompt-immediately NIL)
+ )
+
+(de nmode-append-delayed-prompt (prompt-string)
+
+ % This function is used to specify an additional prompt for the current
+ % command sequence. The prompt string will be appended to the existing prompt
+ % string. The prompt string will be output when terminal input is next
+ % requested, provided that the user has paused within the current command
+ % sequence. If the prompt string is currently empty, then the user must pause
+ % at some future input request to cause the prompt to be displayed.
+
+ (setf nmode-prompt-string (string-concat nmode-prompt-string prompt-string))
+ )
+
+(de nmode-append-separated-prompt (prompt-string)
+
+ % This function is the same as NMODE-APPEND-DELAYED-PROMPT, except that if the
+ % existing prompt string is non-null, an extra space is appended before the
+ % new prompt-string is appended.
+
+ (nmode-append-delayed-prompt
+ (if (not (string-empty? nmode-prompt-string))
+ (string-concat " " prompt-string)
+ prompt-string
+ )))
+
+(de nmode-complete-prompt (prompt-string)
+
+ % This function is used to specify an additional prompt for the current
+ % command sequence. The prompt string will be appended to the existing prompt
+ % string. The prompt string will be output immediately, if the current prompt
+ % has already been output. This function is to be used for "completion" or
+ % "echoing" of previously read input.
+
+ (setf nmode-prompt-string (string-concat nmode-prompt-string prompt-string))
+ (if nmode-prompt-immediately (write-prompt nmode-prompt-string))
+ )
+
+(de input-available? ()
+
+ % Return Non-NIL if and only if new terminal input is available. Note: this
+ % function might be somewhat expensive.
+
+ (or (and nmode-terminal-input-buffer
+ (not (=> nmode-terminal-input-buffer at-buffer-end?)))
+ nmode-terminal-input-string
+ (~= (CharsInInputBuffer) 0)))
+
+(de input-direct-terminal-character ()
+
+ % Prompt for (but do not echo) a single character from the terminal. The
+ % above functions are used to specify the prompt string. Avoid displaying the
+ % prompt string if the user has already typed a character or types a character
+ % right away. Within a sequence of related prompts, once a non-empty prompt
+ % is output, further prompting is done immediately.
+
+ (cond
+ (nmode-terminal-input-buffer (&input-character-from-buffer))
+ (nmode-terminal-input-string (&input-character-from-string))
+ (t (&input-character-from-terminal))
+ ))
+
+(de &input-character-from-buffer ()
+
+ % Internal function for reading from a buffer.
+
+ (cond ((=> nmode-terminal-input-buffer at-buffer-end?)
+ (setf nmode-terminal-input-buffer NIL)
+ (setf nmode-allow-refresh-breakout T)
+ (input-direct-terminal-character)
+ )
+ ((=> nmode-terminal-input-buffer at-line-end?)
+ (=> nmode-terminal-input-buffer move-to-next-line)
+ (input-direct-terminal-character)
+ )
+ (t
+ (prog1
+ (=> nmode-terminal-input-buffer next-character)
+ (=> nmode-terminal-input-buffer move-forward)
+ ))
+ ))
+
+(de &input-character-from-string ()
+
+ % Internal function for reading from a string.
+
+ (let ((upper-bound (string-upper-bound nmode-terminal-input-string))
+ (pos nmode-terminal-input-string-pos)
+ )
+ (cond ((= pos upper-bound)
+ (let ((ch (string-fetch nmode-terminal-input-string pos)))
+ (setf nmode-terminal-input-string NIL)
+ (setf nmode-allow-refresh-breakout T)
+ ch
+ ))
+ (t
+ (let ((ch (string-fetch nmode-terminal-input-string pos)))
+ (setf nmode-terminal-input-string-pos (+ pos 1))
+ ch
+ ))
+ )))
+
+(de &input-character-from-terminal ()
+
+ % Internal function for reading from the terminal.
+
+ (let ((prompt-is-empty (string-empty? nmode-prompt-string)))
+ (if (not nmode-prompt-immediately)
+ (sleep-until-timeout-or-input
+ (if prompt-is-empty 120 30) % don't rush to erase the prompt line
+ ))
+ (if (or nmode-prompt-immediately (not (input-available?)))
+ (progn
+ (write-prompt nmode-prompt-string)
+ (setf nmode-prompt-immediately (not prompt-is-empty))
+ ))
+ (let ((ch (=> nmode-physical-screen get-character)))
+ (if nmode-terminal-script-buffer (nmode-script-character ch))
+ ch
+ )))
+
+(de pause-until-terminal-input ()
+
+ % Return when the user has typed a character. The character is eaten.
+ % No refresh is performed.
+
+ (=> nmode-physical-screen get-character)
+ )
+
+(de sleep-until-timeout-or-input (n-60ths)
+ (wait-timeout 'input-available? n-60ths)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-script-terminal-input (b)
+
+ % Make a script of all terminal (command) input by appending characters to the
+ % specified buffer. Supercedes any previous such request. If B is NIL, then
+ % no scripting is performed. Note: to keep the lines of reasonable length,
+ % free Newlines will be inserted from time to time. Because of this, and
+ % because many file systems cannot represent stray Newlines, the Newline
+ % character is itself scripted as a CR followed by a TAB, since this is its
+ % normal definition. Someday, perhaps, this hack will be replaced by a better
+ % one.
+
+ (setf nmode-terminal-script-buffer b)
+ )
+
+(de nmode-execute-buffer (b)
+
+ % Take input from the specified buffer. Supercedes any previous such request.
+ % If B is NIL, then input is taken from the terminal. Newline characters are
+ % ignored when reading from a buffer!
+
+ (setf nmode-terminal-input-buffer b)
+ (if b (=> b move-to-buffer-start))
+ )
+
+(de nmode-execute-string (s)
+
+ % Take input from the specified string. Supercedes any previous such request.
+ % If S is NIL or empty, then input is taken from the terminal.
+
+ (if (string-empty? s) (setf s NIL))
+ (setf nmode-terminal-input-string s)
+ (setf nmode-terminal-input-string-pos 0)
+ )
+
+(de nmode-script-character (ch)
+ % Write CH to the script buffer.
+ (let* ((b nmode-terminal-script-buffer)
+ (old-pos (=> b position))
+ )
+ (=> b move-to-buffer-end)
+ (cond ((= ch #\LF)
+ (=> b insert-character #\CR)
+ (=> b insert-character #\TAB)
+ )
+ (t (=> b insert-character ch))
+ )
+ (if (>= (=> b current-line-length) 60)
+ (=> b insert-eol)
+ )
+ (=> b set-position old-pos)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor nmode-terminal-input-buffer nmode-terminal-script-buffer)
+(undeclare-flavor nmode-physical-screen)
ADDED psl-1983/3-1/nmode/text-buffer.sl
Index: psl-1983/3-1/nmode/text-buffer.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/text-buffer.sl
@@ -0,0 +1,758 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Text-Buffer.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 20 August 1982
+% Revised: 29 March 1983
+%
+% A text buffer. Supports the primitive editing functions. The strings in a
+% text buffer are never modified. This allows EQ to be used to minimize
+% redisplay.
+%
+% 29-Mar-83 Alan Snyder
+% Removed extra definition of with-current-line (compiler bug seems to have
+% gone away).
+% 14-Mar-83 Alan Snyder
+% Change comment to indicate that a buffer's name may be NIL. Add
+% label-string attribute for display in window-label.
+% 3-Mar-83 Alan Snyder
+% Add option to read from input stream using GETL.
+% 23-Feb-83 Alan Snyder
+% Revise stream operations to work with any type of object.
+% 15-Feb-83 Alan Snyder
+% Revise insertion code to reduce unnecessary consing.
+% Remove char-blank? macro (NMODE has a function char-blank?).
+% 19-Jan-83 Jeff Soreff
+% Name made settable in text buffer.
+% 3-Dec-82 Alan Snyder
+% Added cleanup method.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load numeric-operators fast-vectors fast-strings))
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de create-text-buffer (name) % not for direct use in NMODE
+ (let ((buffer (make-instance 'text-buffer 'name name)))
+ buffer))
+
+(defflavor text-buffer (
+ (last-line 0) % index of last line in buffer (n >= 0)
+ (line-pos 0) % index of "current" line (0 <= n <= last-line)
+ (char-pos 0) % index of "current" character in current line
+ % (0 <= n <= linelength)
+ lines % vector of strings
+ name % string name of buffer (or NIL)
+ (file-name NIL) % string name of attached file (or NIL)
+ (modified? NIL) % T => buffer is different than file
+ (label-string NIL) % optional string for display in window label
+ marks % ring buffer of marks
+ (mode NIL) % the buffer's Mode
+ (previous-buffer NIL) % (optional) previous buffer
+ (p-list NIL) % association list of properties
+ )
+ ()
+ (gettable-instance-variables line-pos char-pos)
+ (settable-instance-variables file-name modified? mode previous-buffer name
+ label-string)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private Macros:
+
+(CompileTime (progn
+
+(defmacro with-current-line ((var) . forms)
+ `(let ((,var (vector-fetch lines line-pos)))
+ ,@forms
+ ))
+
+(defmacro with-current-line-copied ((var) . forms)
+ `(let ((**LINES** lines) (**LINE-POS** line-pos))
+ (let ((,var (copystring (vector-fetch **LINES** **line-pos**))))
+ (vector-store **LINES** **line-pos** ,var)
+ ,@forms
+ )))
+
+)) % End of CompileTime
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (text-buffer position) ()
+ % Return the "current position" in the buffer as a BUFFER-POSITION object.
+
+ (buffer-position-create line-pos char-pos)
+ )
+
+(defmethod (text-buffer set-position) (bp)
+ % Set the "current position" in the buffer from the specified
+ % BUFFER-POSITION object. Clips the line-position and char-position.
+
+ (=> self goto (buffer-position-line bp) (buffer-position-column bp))
+ )
+
+(defmethod (text-buffer buffer-end-position) ()
+ % Return the BUFFER-POSITION object corresponding to the end of the buffer.
+ (buffer-position-create
+ last-line
+ (string-length (vector-fetch lines last-line))
+ ))
+
+(defmethod (text-buffer goto) (lpos cpos)
+ % Set the "current position" in the buffer. Clips the line-position and
+ % char-position.
+
+ (if (< lpos 0) (setf lpos 0))
+ (if (> lpos last-line) (setf lpos last-line))
+ (setf line-pos lpos)
+ (=> self set-char-pos cpos)
+ )
+
+(defmethod (text-buffer set-line-pos) (lpos)
+ % Set the "current line position" in the buffer. Clips the line-position
+ % and char-position.
+
+ (when (~= lpos line-pos)
+ (if (< lpos 0) (setf lpos 0))
+ (if (> lpos last-line) (setf lpos last-line))
+ (setf line-pos lpos)
+ (with-current-line (l)
+ (if (> char-pos (string-length l))
+ (setf char-pos (string-length l))
+ ))
+ ))
+
+(defmethod (text-buffer set-char-pos) (cpos)
+ % Set the "current character position" in the buffer. Clips the specified
+ % position to lie in the range 0..line-length.
+
+ (if (< cpos 0) (setf cpos 0))
+ (with-current-line (l)
+ (if (> cpos (string-length l))
+ (setf cpos (string-length l))
+ ))
+ (setf char-pos cpos)
+ )
+
+(defmethod (text-buffer clip-position) (bp)
+ % Return BP if BP is a valid position for this buffer, otherwise return a new
+ % buffer-position with clipped values.
+
+ (let ((lpos (buffer-position-line bp))
+ (cpos (buffer-position-column bp))
+ (clipped NIL)
+ )
+ (cond ((< lpos 0) (setf lpos 0) (setf clipped T))
+ ((> lpos last-line) (setf lpos last-line) (setf clipped T))
+ )
+ (cond ((< cpos 0) (setf cpos 0) (setf clipped T))
+ ((> cpos (string-length (vector-fetch lines lpos)))
+ (setf cpos (string-length (vector-fetch lines lpos)))
+ (setf clipped T)
+ ))
+ (if clipped
+ (buffer-position-create lpos cpos)
+ bp
+ )))
+
+(defmethod (text-buffer size) ()
+ % Return the actual size of the buffer (number of lines). This number will
+ % include the "fake" empty line at the end of the buffer, should it exist.
+
+ (+ last-line 1)
+ )
+
+(defmethod (text-buffer visible-size) ()
+ % Return the apparent size of the buffer (number of lines). This number
+ % will NOT include the "fake" empty line at the end of the buffer, should it
+ % exist.
+
+ (if (>= (string-upper-bound (vector-fetch lines last-line)) 0)
+ (+ last-line 1) % The last line is real!
+ last-line % The last line is fake!
+ ))
+
+(defmethod (text-buffer contents) ()
+ % Return the text contents of the buffer (a copy thereof) as a vector of
+ % strings (the last string is implicitly without a terminating NewLine).
+ (sub lines 0 last-line)
+ )
+
+(defmethod (text-buffer current-line) ()
+ % Return the current line (as a string).
+ (with-current-line (l)
+ l))
+
+(defmethod (text-buffer fetch-line) (n)
+ % Fetch the specified line (as a string). Lines are indexed from 0.
+ (if (or (< n 0) (> n last-line))
+ (ContinuableError
+ 0
+ (BldMsg "Line index %w out of range." n)
+ "")
+ (vector-fetch lines n)
+ ))
+
+(defmethod (text-buffer store-line) (n new-line)
+ % Replace the specified line with a new string.
+ (if (or (< n 0) (> n last-line))
+ (ContinuableError
+ 0
+ (BldMsg "Line index %w out of range." n)
+ "")
+ % else
+ (setf modified? T)
+ (vector-store lines n new-line)
+ (if (= line-pos n)
+ (let ((len (string-length new-line)))
+ (if (> char-pos len)
+ (setf char-pos len)
+ )))
+ ))
+
+(defmethod (text-buffer select) ()
+ % Attach the buffer to the current window, making it the current buffer.
+ (buffer-select self)
+ )
+
+(defmethod (text-buffer set-mark) (bp)
+ % PUSH the specified position onto the ring buffer of marks.
+ % The specified position thus becomes the current "mark".
+ (ring-buffer-push marks bp)
+ )
+
+(defmethod (text-buffer set-mark-from-point) ()
+ % PUSH the current position onto the ring buffer of marks.
+ % The current position thus becomes the current "mark".
+ (ring-buffer-push marks (buffer-position-create line-pos char-pos))
+ )
+
+(defmethod (text-buffer mark) ()
+ % Return the current "mark".
+ (ring-buffer-top marks)
+ )
+
+(defmethod (text-buffer previous-mark) ()
+ % POP the current mark off the ring buffer of marks.
+ % Return the new current mark.
+ (ring-buffer-pop marks)
+ (ring-buffer-top marks)
+ )
+
+(defmethod (text-buffer get) (property-name)
+ % Return the object associated with the specified property name (ID).
+ % Returns NIL if named property has not been defined.
+ (let ((pair (atsoc property-name p-list)))
+ (if (PairP pair) (cdr pair))))
+
+(defmethod (text-buffer put) (property-name property)
+ % Associate the specified object with the specified property name (ID).
+ % GET on that property-name will henceforth return the object.
+ (let ((pair (atsoc property-name p-list)))
+ (if (PairP pair)
+ (rplacd pair property)
+ (setf p-list (cons (cons property-name property) p-list))
+ )))
+
+(defmethod (text-buffer reset) ()
+ % Reset the contents of the buffer to empty and "not modified".
+
+ (setf lines (MkVect 1))
+ (vector-store lines 0 "")
+ (setf last-line 0)
+ (setf line-pos 0)
+ (setf char-pos 0)
+ (setf modified? NIL)
+ )
+
+(defmethod (text-buffer extract-region) (delete-it bp1 bp2)
+
+ % Delete (if delete-it is non-NIL) or copy (otherwise) the text between
+ % position BP1 and position BP2. Return the deleted (or copied) text as a
+ % pair (CONS direction-of-deletion vector-of-strings). The returned
+ % direction is +1 if BP1 <= BP2, and -1 otherwise. The current position is
+ % set to the beginning of the region if deletion is performed.
+
+ (setf bp1 (=> self clip-position bp1))
+ (setf bp2 (=> self clip-position bp2))
+ (prog (dir text text-last l1 c1 l2 c2 line1 line2)
+ (setf dir 1) % the default case
+ % ensure that BP1 is not beyond BP2
+ (let ((comparison (buffer-position-compare bp1 bp2)))
+ (if (> comparison 0)
+ (psetq dir -1 bp1 bp2 bp2 bp1))
+ (if (and delete-it (~= comparison 0))
+ (setf modified? T))
+ )
+ (setf l1 (buffer-position-line bp1))
+ (setf c1 (buffer-position-column bp1))
+ (setf l2 (buffer-position-line bp2))
+ (setf c2 (buffer-position-column bp2))
+ % Ensure the continued validity of the current position.
+ (if delete-it (=> self set-position bp1))
+ % Create a vector for the extracted text.
+ (setf text-last (- l2 l1)) % highest index in TEXT vector
+ (setf text (MkVect text-last))
+ (setf line1 (vector-fetch lines l1)) % first line (partially) in region
+ (cond
+ ((= l1 l2) % region lies within a single line (easy!)
+ (vector-store text 0 (substring line1 c1 c2))
+ (if delete-it
+ (vector-store lines l1 (string-concat
+ (substring line1 0 c1)
+ (string-rest line1 c2)
+ )))
+ (return (cons dir text))))
+ % Here if region spans multiple lines.
+ (setf line2 (vector-fetch lines l2)) % last line (partially) in region
+ (vector-store text 0 (string-rest line1 c1))
+ (vector-store text text-last (substring line2 0 c2))
+ % Copy remaining text from region.
+ (for (from i 1 (- text-last 1))
+ (do (vector-store text i (vector-fetch lines (+ l1 i)))))
+ (when delete-it
+ (vector-store lines l1 (string-concat
+ (substring line1 0 c1)
+ (string-rest line2 c2)))
+ (=> self &delete-lines (+ l1 1) text-last)
+ )
+ (return (cons dir text))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% The following methods are not really primitive, but are provided as
+% a public service.
+
+(defmethod (text-buffer current-line-length) ()
+ % Return the number of characters in the current line.
+ (with-current-line (l)
+ (string-length l)))
+
+(defmethod (text-buffer current-line-empty?) ()
+ % Return T if the current line contains no characters.
+ (with-current-line (l)
+ (string-empty? l)))
+
+(defmethod (text-buffer current-line-blank?) ()
+ % Return T if the current line contains no non-blank characters.
+ (with-current-line (l)
+ (for (from i 0 (string-upper-bound l))
+ (always (char-blank? (string-fetch l i)))
+ )))
+
+(defmethod (text-buffer at-line-start?) ()
+ % Return T if we are positioned at the start of the current line.
+ (= char-pos 0))
+
+(defmethod (text-buffer at-line-end?) ()
+ % Return T if we are positioned at the end of the current line.
+ (with-current-line (l)
+ (> char-pos (string-upper-bound l))))
+
+(defmethod (text-buffer at-buffer-start?) ()
+ % Return T if we are positioned at the start of the buffer.
+ (and (= line-pos 0) (= char-pos 0)))
+
+(defmethod (text-buffer at-buffer-end?) ()
+ % Return T if we are positioned at the end of the buffer.
+ (and
+ (>= line-pos last-line)
+ (> char-pos (string-upper-bound (vector-fetch lines last-line)))))
+
+(defmethod (text-buffer current-line-is-first?) ()
+ % Return T if the current line is the first line in the buffer.
+ (= line-pos 0))
+
+(defmethod (text-buffer current-line-is-last?) ()
+ % Return T if the current line is the last line in the buffer.
+ (>= line-pos last-line))
+
+(defmethod (text-buffer current-line-fetch) (n)
+ % Return the character at character position N within the current line.
+ % An error is generated if N is out of range.
+ (with-current-line (l)
+ (if (and (>= n 0) (<= n (string-upper-bound l)))
+ (string-fetch l n)
+ (ContinuableError
+ 0
+ (BldMsg "Character index %w out of range." n)
+ "")
+ )))
+
+(defmethod (text-buffer current-line-store) (n c)
+ % Store the character C at char position N within the current line.
+ % An error is generated if N is out of range.
+ (with-current-line-copied (l)
+ (if (and (>= n 0) (<= n (string-upper-bound l)))
+ (progn
+ (string-store l n c)
+ (vector-store lines line-pos l)
+ (setf modified? T)
+ )
+ (ContinuableError
+ 0
+ (BldMsg "Character index %w out of range." n)
+ "")
+ )))
+
+(defmethod (text-buffer move-to-buffer-start) ()
+ % Move to the beginning of the buffer.
+ (setf line-pos 0)
+ (setf char-pos 0)
+ )
+
+(defmethod (text-buffer move-to-buffer-end) ()
+ % Move to the end of the buffer.
+ (setf line-pos last-line)
+ (with-current-line (l)
+ (setf char-pos (string-length l)))
+ )
+
+(defmethod (text-buffer move-to-start-of-line) ()
+ % Move to the beginning of the current line.
+ (setf char-pos 0))
+
+(defmethod (text-buffer move-to-end-of-line) ()
+ % Move to the end of the current line.
+ (with-current-line (l)
+ (setf char-pos (string-length l))))
+
+(defmethod (text-buffer move-to-next-line) ()
+ % Move to the beginning of the next line.
+ % If already at the last line, move to the end of the line.
+ (cond ((< line-pos last-line)
+ (setf line-pos (+ line-pos 1))
+ (setf char-pos 0))
+ (t (=> self move-to-end-of-line))))
+
+(defmethod (text-buffer move-to-previous-line) ()
+ % Move to the beginning of the previous line.
+ % If already at the first line, move to the beginning of the line.
+ (if (> line-pos 0)
+ (setf line-pos (- line-pos 1)))
+ (setf char-pos 0))
+
+(defmethod (text-buffer move-forward) ()
+ % Move to the next character in the current buffer.
+ % Do nothing if already at the end of the buffer.
+ (if (=> self at-line-end?)
+ (=> self move-to-next-line)
+ (setf char-pos (+ char-pos 1))
+ ))
+
+(defmethod (text-buffer move-backward) ()
+ % Move to the previous character in the current buffer.
+ % Do nothing if already at the start of the buffer.
+ (if (> char-pos 0)
+ (setf char-pos (- char-pos 1))
+ (when (> line-pos 0)
+ (setf line-pos (- line-pos 1))
+ (=> self move-to-end-of-line)
+ )))
+
+(defmethod (text-buffer next-character) ()
+ % Return the character to the right of the current position.
+ % Return NIL if at the end of the buffer.
+ (with-current-line (l)
+ (if (>= char-pos (string-length l))
+ (if (= line-pos last-line)
+ NIL
+ (char EOL)
+ )
+ (string-fetch l char-pos)
+ )))
+
+(defmethod (text-buffer previous-character) ()
+ % Return the character to the left of the current position.
+ % Return NIL if at the beginning of the buffer.
+ (if (= char-pos 0)
+ (if (= line-pos 0) NIL #\EOL)
+ (with-current-line (l)
+ (string-fetch l (- char-pos 1)))
+ ))
+
+(defmethod (text-buffer insert-character) (c)
+ % Insert character C at the current position in the buffer and advance past
+ % that character. Implementation note: some effort is made here to avoid
+ % unnecessary consing.
+
+ (if (= c #\EOL)
+ (=> self insert-eol)
+ % else
+ (with-current-line (l)
+ (let* ((current-length (string-length l))
+ (head-string
+ (when (> char-pos 0)
+ (if (= char-pos current-length) l (substring l 0 char-pos))))
+ (tail-string
+ (when (< char-pos current-length)
+ (if (= char-pos 0) l (substring l char-pos current-length))))
+ (s (string c))
+ )
+ (when head-string (setf s (string-concat head-string s)))
+ (when tail-string (setf s (string-concat s tail-string)))
+ (vector-store lines line-pos s)
+ (setf char-pos (+ char-pos 1))
+ (setf modified? T)
+ ))))
+
+(defmethod (text-buffer insert-eol) ()
+ % Insert a line-break at the current position in the buffer and advance to
+ % the beginning of the newly-formed line. Implementation note: some effort
+ % is made here to avoid unnecessary consing.
+
+ (with-current-line (l)
+ (=> self &insert-gap line-pos 1)
+ (let* ((current-length (string-length l))
+ (head-string
+ (when (> char-pos 0)
+ (if (= char-pos current-length) l (substring l 0 char-pos))))
+ (tail-string
+ (when (< char-pos current-length)
+ (if (= char-pos 0) l (substring l char-pos current-length))))
+ )
+ (vector-store lines line-pos (or head-string ""))
+ (setf line-pos (+ line-pos 1))
+ (vector-store lines line-pos (or tail-string ""))
+ (setf char-pos 0)
+ (setf modified? T)
+ )))
+
+(defmethod (text-buffer insert-line) (l)
+ % Insert the specified string as a new line in front of the current line.
+ % Advance past the newly inserted line. Note: L henceforth must never be
+ % modified.
+
+ (=> self &insert-gap line-pos 1)
+ (vector-store lines line-pos l)
+ (setf line-pos (+ line-pos 1))
+ (setf modified? T)
+ )
+
+(defmethod (text-buffer insert-string) (s)
+ % Insert the string S at the current position. Advance past the
+ % newly-inserted string. Note: S must not contain EOL characters! Note: S
+ % henceforth must never be modified. Implementation note: some effort is
+ % made here to avoid unnecessary consing.
+
+ (let ((insert-length (string-length s)))
+ (when (> insert-length 0)
+ (with-current-line (l)
+ (let* ((current-length (string-length l))
+ (head-string
+ (when (> char-pos 0)
+ (if (= char-pos current-length) l (substring l 0 char-pos))))
+ (tail-string
+ (when (< char-pos current-length)
+ (if (= char-pos 0) l (substring l char-pos current-length))))
+ )
+ (when head-string (setf s (string-concat head-string s)))
+ (when tail-string (setf s (string-concat s tail-string)))
+ (vector-store lines line-pos s)
+ (setf char-pos (+ char-pos insert-length))
+ (setf modified? T)
+ )))))
+
+(defmethod (text-buffer insert-text) (v)
+ % V is a vector of strings similar to LINES (e.g., the last string in V is
+ % considered to be an unterminated line). Thus, V must have at least one
+ % element. Insert this stuff at the current position and advance past it.
+
+ (with-current-line (l)
+ (let ((v-last (vector-upper-bound v)))
+ (=> self &insert-gap line-pos v-last)
+ (let ((vec lines)
+ (prefix-text (substring l 0 char-pos))
+ (suffix-text (string-rest l char-pos))
+ )
+ (vector-store vec line-pos
+ (string-concat prefix-text (vector-fetch v 0)))
+ (for (from i 1 v-last)
+ (do (setf line-pos (+ line-pos 1))
+ (vector-store vec line-pos (vector-fetch v i))))
+ (setf char-pos (string-length (vector-fetch vec line-pos)))
+ (vector-store vec line-pos
+ (string-concat (vector-fetch vec line-pos) suffix-text))
+ (setf modified? T)
+ ))))
+
+(defmethod (text-buffer delete-next-character) ()
+ % Delete the next character.
+ % Do nothing if at the end of the buffer.
+
+ (with-current-line (l)
+ (if (= char-pos (string-length l))
+ (if (= line-pos last-line)
+ NIL
+ % else (at end of line other than last)
+ (vector-store lines line-pos
+ (string-concat l (vector-fetch lines (+ line-pos 1))))
+ (=> self &delete-lines (+ line-pos 1) 1)
+ (setf modified? T)
+ )
+ % else (not at the end of a line)
+ (vector-store lines line-pos
+ (string-concat
+ (substring l 0 char-pos)
+ (string-rest l (+ char-pos 1))
+ ))
+ (setf modified? T)
+ )))
+
+(defmethod (text-buffer delete-previous-character) ()
+ % Delete the previous character.
+ % Do nothing if at the beginning of the buffer.
+
+ (if (not (=> self at-buffer-start?))
+ (progn
+ (=> self move-backward)
+ (=> self delete-next-character)
+ (setf modified? T)
+ )))
+
+(defmethod (text-buffer read-from-stream) (s)
+ (if (and (object-get-handler-quietly s 'getl)
+ (object-get-handler-quietly s 'last-line-is-terminated?)
+ )
+ (=> self read-from-stream-using-getl s)
+ (=> self read-from-stream-using-getc s)
+ ))
+
+(defmethod (text-buffer read-from-stream-using-getl) (s)
+ (=> self reset)
+ (let* ((getl-method (object-get-handler s 'getl))
+ line
+ )
+ (while (setf line (apply getl-method (list s)))
+ (=> self insert-line line)
+ )
+ (if (and (not (at-buffer-start?))
+ (not (=> s last-line-is-terminated?))
+ )
+ (=> self delete-previous-character)
+ )
+ (=> self move-to-buffer-start)
+ (=> self set-modified? NIL)
+ ))
+
+(defmethod (text-buffer read-from-stream-using-getc) (s)
+ (=> self reset)
+ (let* ((line-buffer (make-string 200 0))
+ (buffer-top 200)
+ (getc-method (object-get-handler s 'getc))
+ line-size
+ ch
+ )
+ (while T
+ (setf line-size 0)
+ (setf ch (apply getc-method (list s)))
+ (while (not (or (null ch) (= ch #\LF)))
+ (cond ((>= line-size buffer-top)
+ (setf line-buffer (concat line-buffer (make-string 200 0)))
+ (setf buffer-top (+ buffer-top 200))
+ ))
+ (string-store line-buffer line-size ch)
+ (setf line-size (+ line-size 1))
+ (setf ch (apply getc-method (list s)))
+ )
+ (if (not (and (null ch) (= line-size 0)))
+ (=> self insert-line (sub line-buffer 0 (- line-size 1)))
+ )
+ (when (null ch)
+ (if (> line-size 0) (=> self delete-previous-character))
+ (exit)
+ ))
+ (=> self move-to-buffer-start)
+ (=> self set-modified? NIL)
+ ))
+
+(defmethod (text-buffer write-to-stream) (s)
+ (let* ((vec lines)
+ (putl-method (object-get-handler s 'putl))
+ )
+ (for (from i 0 (- last-line 1))
+ (do (apply putl-method (list s (vector-fetch vec i)))))
+ (=> s puts (vector-fetch vec last-line))
+ ))
+
+(defmethod (text-buffer cleanup) ()
+ % Discard any unused storage.
+ (if (and previous-buffer (not (buffer-is-selectable? previous-buffer)))
+ (setf previous-buffer NIL))
+ (TruncateVector lines last-line)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private methods:
+
+(defmethod (text-buffer init) (init-plist)
+ (setf lines (MkVect 0))
+ (vector-store lines 0 "")
+ (setf marks (ring-buffer-create 16))
+ (ring-buffer-push marks (buffer-position-create 0 0))
+ )
+
+(defmethod (text-buffer &insert-gap) (lpos n-lines)
+
+ % Insert N-LINES lines at position LPOS, moving the remaining lines upward
+ % (if any). LPOS may range from 0 (insert at beginning of buffer) to
+ % LAST-LINE + 1 (insert at end of buffer). The new lines are not
+ % specifically initialized (they retain their old values).
+
+ (when (> n-lines 0)
+ (=> self &ensure-room n-lines)
+ (let ((vec lines))
+ (for (from i last-line lpos -1)
+ (do (vector-store vec (+ i n-lines) (vector-fetch vec i)))
+ )
+ (setf last-line (+ last-line n-lines))
+ )))
+
+(defmethod (text-buffer &ensure-room) (lines-needed)
+ % Ensure that the LINES vector is large enough to add the specified number
+ % of additional lines.
+
+ (let* ((current-bound (vector-upper-bound lines))
+ (lines-available (- current-bound last-line))
+ (lines-to-add (- lines-needed lines-available))
+ )
+ (when (> lines-to-add 0)
+ (let ((minimum-incr (>> current-bound 2))) % Increase by at least 25%
+ (if (< minimum-incr 64) (setf minimum-incr 64))
+ (if (< lines-to-add minimum-incr) (setf lines-to-add minimum-incr))
+ )
+ (let ((new-lines (make-vector (+ current-bound lines-to-add) NIL)))
+ (for (from i 0 current-bound)
+ (do (vector-store new-lines i (vector-fetch lines i))))
+ (setf lines new-lines)
+ ))))
+
+(defmethod (text-buffer &delete-lines) (lpos n-lines)
+
+ % Remove N-LINES lines starting at position LPOS, moving the remaining lines
+ % downward (if any) and NILing out the obsoleted lines at the end of the
+ % LINES vector (to allow the strings to be reclaimed). LPOS may range from
+ % 0 to LAST-LINE.
+
+ (when (> n-lines 0)
+ (let ((vec lines))
+ (for (from i (+ lpos n-lines) last-line)
+ (do (vector-store vec (- i n-lines) (vector-fetch vec i)))
+ )
+ (setf last-line (- last-line n-lines))
+ (for (from i 1 n-lines)
+ (do (vector-store vec (+ last-line i) NIL))
+ )
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/nmode/text-commands.sl
Index: psl-1983/3-1/nmode/text-commands.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/text-commands.sl
@@ -0,0 +1,738 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% TEXT-COMMANDS.SL - NMODE Sentence, Paragraph, Filling, and Formatting
+%
+% Author: Jeff Soreff
+% Hewlett-Packard/CRC
+% Date: 8 December 1982
+% Revised: 1 February 1983
+% Revised: 2 March 1983
+%
+% 2-Mar-83 Jeff Soreff
+% Mark-paragraph-command was altered to push the current position
+% onto the ring of marks before marking the paragraph.
+% 15-Feb-83 Jeff Soreff
+% Bugs were removed from fill-comment-command and from next-char-list.
+% A test for arriving at a line end was added to fill-comment-command
+% in the while loop which locates the fill prefix to be used. It fixed an
+% infinite loop in this while which occurred when one did a
+% fill-comment-command while on the last line in the buffer, if the
+% prefix-finding loop got to the buffer's end. An at-line-end? test was used
+% instead of an at-buffer-end? test since the fill prefix found should never
+% go over a line.
+% In next-char-list the initialization of final-char-pos was changed
+% from 0 to char-count. This removed a bug that led to setting the point
+% at the start of a prefixed line after a fill which moved point to the first
+% availible position on that new line. Point should have been left AFTER the
+% prefix. Changing the initialization of final-char-position allows
+% next-char-list to accurately account for the spaces taken up by the prefix,
+% since this count is passed to its char-count argument.
+% 1-Feb-83 Alan Snyder
+% Changed literal ^L in source to #\FF.
+% 30-Dec-82 Alan Snyder
+% Extended C-X = to set the current line number if a command number is
+% given.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load extended-char fast-strings fast-int))
+
+(fluid '(nmode-current-buffer text-mode fill-prefix fill-column
+nmode-command-argument nmode-command-argument-given nmode-command-number-given
+nmode-command-killed sentence-terminators sentence-extenders))
+
+(setf sentence-terminators '(#/! #/. #/?))
+(setf sentence-extenders '(#/' #/" #/) #/]))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% User/Enhancer option sensitive function:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% The text-justifier function may be altered if one wishes to have the
+% same flexibility as EMACS'S TECO search strings provide.
+
+(de text-justifier-command? ()
+ % This function checks to see if the rest of the line is a text
+ % justifier command. It returns a boolean and leaves point alone.
+ (= (next-character) #/.))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Start of Sentence Functions and Associated Support Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de valid-sentence-end? ()
+ % This function checks that a sentence is followed by two blanks, a
+ % newline or a blank and a newline. It advances point one space.
+ % It returns a boolean value.
+ (if (at-line-end?) t
+ (move-forward)
+ (and (= (previous-character) #\blank)
+ (or (at-line-end?)(= (next-character) #\blank)))))
+
+(de move-to-end-of-last-sentence ()
+ % This function moves point to the end of the preceding sentence,
+ % after extenders. This function does not return a useful value
+ (while (not
+ (or (at-buffer-start?)
+ (when
+ % This when returns true if it hits a valid sentence end.
+ (member (previous-character) sentence-terminators)
+ (let ((scan-place (buffer-get-position)))
+ (while
+ (member (next-character) sentence-extenders)
+ (move-forward))
+ (let* ((tentative-sentence-end (buffer-get-position))
+ (true-end (valid-sentence-end?)))
+ (buffer-set-position
+ (if true-end tentative-sentence-end scan-place))
+ true-end)))))
+ (move-backward)))
+
+(de start-of-last-sentence ()
+ % This function restores point to its former place. It returns the
+ % location of the start of the preceding sentence.
+ (let ((place (buffer-get-position))(start nil)(end nil))
+ (move-to-end-of-last-sentence)
+ (setf end (buffer-get-position))
+ (skip-forward-blanks) % possibly past starting position this time
+ (setf start (buffer-get-position))
+ (when (buffer-position-lessp place start)
+ (buffer-set-position end) % end of last sentence, after extenders
+ (while % push back past extenders
+ (member (previous-character) sentence-extenders)
+ (move-backward))
+ (move-backward) % push back past sentence terminator character
+ (move-to-end-of-last-sentence)
+ (skip-forward-blanks)
+ (setf start (buffer-get-position)))
+ (buffer-set-position place)
+ start))
+
+(de end-of-next-sentence ()
+ % This function restores point to its former place. It returns the
+ % location of the end of the next sentence.
+ (let ((place (buffer-get-position)))
+ (while (not
+ % the next sexp detects sentence ends and moves point to them
+ (or (at-buffer-end?)
+ (when % note that this returns (valid-sentence-end?)'s value
+ (member (next-character) sentence-terminators)
+ (move-forward)
+ (while
+ (member (next-character) sentence-extenders)
+ (move-forward))
+ (let ((tentative-sentence-end (buffer-get-position)))
+ (if (valid-sentence-end?)
+ (buffer-set-position tentative-sentence-end))))))
+ (move-forward))
+ (prog1
+ (buffer-get-position)
+ (buffer-set-position place))))
+
+(de forward-one-sentence ()
+ % This function moves point to the end of the next sentence or
+ % paragraph, whichever one is closer, and does not return a useful
+ % value.
+ (let ((sentence-end (end-of-next-sentence)))
+ (if (at-line-end?)(move-forward)) % kludge to get around xtra newline
+ (forward-one-paragraph)
+ (if (at-line-start?)(move-backward)) % kludge to get around xtra newline
+ (let ((paragraph-end (buffer-get-position)))
+ (buffer-set-position
+ (if (buffer-position-lessp sentence-end paragraph-end)
+ % "closer" is "earlier" or "before", in this case
+ sentence-end paragraph-end)))))
+
+(de backward-one-sentence ()
+ % This function moves point to the start of the preceding sentence
+ % or paragraph, whichever one is closer. It does not return a useful
+ % value
+ (let ((sentence-start (start-of-last-sentence)))
+ (skip-backward-blanks)
+ (backward-one-paragraph)
+ (skip-forward-blanks)
+ (let ((paragraph-start (buffer-get-position)))
+ (buffer-set-position
+ (if (buffer-position-lessp sentence-start paragraph-start)
+ % "closer" is "later" or "after", in this case
+ paragraph-start sentence-start)))))
+
+(de forward-sentence-command ()
+ % If nmode-command-argument is positive this function moves point
+ % forward by nmode-command-argument sentences , leaving it at the
+ % end of a sentence. If nmode-command-argument is negative it moves
+ % backwards by abs(nmode-command-argument) sentences, leaving it at
+ % the start of a sentence. This function does not return a useful
+ % value.
+ (if (minusp nmode-command-argument)
+ (for (from i 1 (- nmode-command-argument) 1)
+ (do (backward-one-sentence)))
+ (for (from i 1 nmode-command-argument 1)
+ (do (forward-one-sentence)))))
+
+(de backward-sentence-command ()
+ % If nmode-command-argument is positive this function moves point
+ % backward by nmode-command-argument sentences , leaving it at the
+ % start of a sentence. If nmode-command-argument is negative it
+ % moves forwards by abs(nmode-command-argument) sentences, leaving
+ % it at the end of a sentence. This function does not return a
+ % useful value.
+ (if (minusp nmode-command-argument)
+ (for (from i 1 (- nmode-command-argument) 1)
+ (do (forward-one-sentence)))
+ (for (from i 1 nmode-command-argument 1)
+ (do (backward-one-sentence)))))
+
+(de kill-sentence-command ()
+ % This function kills whatever forward-sentence-command jumps over.
+ % It leaves point after the killed text. This function is sensitive
+ % to the nmode command argument through forward-sentence-command.
+ (let ((place (buffer-get-position)))
+ (forward-sentence-command)
+ (update-kill-buffer (extract-region t place (buffer-get-position)))
+ (setf nmode-command-killed t)))
+
+(de backward-kill-sentence-command ()
+ % This function kills whatever backward-sentence-command jumps over.
+ % It leaves point after the killed text. This function is sensitive
+ % to the nmode command argument through forward-sentence-command.
+ (let ((place (buffer-get-position)))
+ (backward-sentence-command)
+ (update-kill-buffer (extract-region t place (buffer-get-position)))
+ (setf nmode-command-killed t)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Start of Paragraph Functions and Associated Support Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de rest-of-current-line-blank? ()
+ % This function detects if the rest of the line is blank. It
+ % returns a boolean value. It restores point.
+ (let ((last-position (buffer-get-position)))
+ (while (and (not (at-line-end?))
+ (char-blank? (next-character)))
+ (move-forward))
+ (prog1 (at-line-end?)
+ (buffer-get-position last-position))))
+
+(de mismatched-prefix? ()
+ % This function checks to see if there is a fill prefix which
+ % doesn't match the start of the current line. It leaves point at
+ % the start of the current line if there is a mismatch, or just
+ % after the prefix if matched. It returns t if there is a fill
+ % prefix which does NOT match the line's start.
+ (move-to-start-of-line)
+ (when fill-prefix
+ (let ((start-line (buffer-get-position)))
+ (move-over-characters
+ (string-length % count of characters in fill-prefix
+ (getv fill-prefix 0)))
+ (when (not (text-equal
+ (extract-text nil
+ start-line
+ (buffer-get-position))
+ fill-prefix))
+ (buffer-set-position start-line)
+ t))))
+
+(de pseudo-blank-line? ()
+ % This function tests to see if the current line should be kept out
+ % of paragraphs. It tests for: lines which don't match an existing
+ % fill prefix, blank lines, lines with only the fill prefix present,
+ % text justifier commands, and properly prefixed text justifier
+ % commands. It only checks for the text justifier commands in text
+ % mode. It leaves point at the start of the current line and
+ % returns a boolean value.
+ (or (mismatched-prefix?)
+ (prog1
+ (or (and (text-justifier-command?)
+ (eq text-mode (=> nmode-current-buffer mode)))
+ (rest-of-current-line-blank?))
+ (move-to-start-of-line))))
+
+(de pseudo-indented-line? ()
+ % This function looks for page break characters or (in text mode)
+ % indentation (after a fill prefix, if present) which signal the
+ % start of a real paragraph. It always leaves point at the start of
+ % the current line and returns a boolean.
+ (prog1 (or
+ (= #\FF (next-character)) % page break character
+ (progn (mismatched-prefix?)
+ (and (char-blank? (next-character))
+ (eq text-mode (=> nmode-current-buffer mode)))))
+ (move-to-start-of-line)))
+
+(de start-line-paragraph? ()
+ % This function tests the current line to see if it is the first
+ % line (not counting an empty line) in a paragraph. It leaves point
+ % at the start of line and returns a boolean value.
+ (and (not (pseudo-blank-line?))
+ (or (pseudo-indented-line?)
+ % next sexp checks for a previous blank line
+ (if (current-line-is-first?)
+ t
+ (move-to-previous-line)
+ (prog1
+ (pseudo-blank-line?)
+ (move-to-next-line))))))
+
+(de end-line-paragraph? ()
+ % This function tests the current line to see if it is the last line
+ % in a paragraph. It leaves point at the start of line and returns
+ % a boolean value.
+ (and (not (pseudo-blank-line?))
+ % The next sexp checks for the two things on the next line of
+ % text that can end a paragraph: a blank line or an indented
+ % line which would start a new paragraph.
+ (if (current-line-is-last?)
+ t
+ (move-to-next-line)
+ (prog1
+ (or (pseudo-indented-line?)
+ (pseudo-blank-line?))
+ (move-to-previous-line)))))
+
+(de forward-one-paragraph ()
+ % This function moves point to the end of the next or current
+ % paragraph, as EMACS defines it. This is either start of the line
+ % after the last line with any characters or, if the paragraph
+ % extends to the end of the buffer, then the end of the last line
+ % with characters. This function returns a boolean which is true if
+ % the function was stopped by a real paragraph end, rather than by
+ % the buffer's end.
+ (let ((true-end nil))
+ (while (not (or (setf true-end (end-line-paragraph?))
+ (current-line-is-last?)))
+ (move-to-next-line))
+ (move-to-next-line)
+ true-end))
+
+(de forward-paragraph-command ()
+ % If nmode-command-argument is positive this function moves point
+ % forward by nmode-command-argument paragraphs , leaving it at the
+ % end of a paragraph. If nmode-command-argument is negative it moves
+ % backwards by abs(nmode-command-argument) paragraphs, leaving it at
+ % the start of a paragraph. This function does not return a useful
+ % value.
+ (if (minusp nmode-command-argument)
+ (for (from i 1 (- nmode-command-argument) 1)
+ (do (backward-one-paragraph)))
+ (for (from i 1 nmode-command-argument 1)
+ (do (forward-one-paragraph)))))
+
+(de backward-one-paragraph ()
+ % This function moves point backward to the start of the previous
+ % paragraph. It returns a boolean which is true if the function was
+ % stopped by a real paragraph's start, instead of by the buffer's
+ % start.
+ (if (and (at-line-start?) % if past start of start line, don't miss
+ (start-line-paragraph?)) % start of current paragraph
+ (move-to-previous-line))
+ (let ((real-start nil))
+ (while (not (or (setf real-start (start-line-paragraph?))
+ (current-line-is-first?)))
+ (move-to-previous-line))
+ (unless (current-line-is-first?) % this sexp gets previous empty line on
+ (move-to-previous-line)
+ (unless (current-line-empty?)
+ (move-to-next-line)))
+ real-start))
+
+(de backward-paragraph-command ()
+ % If nmode-command-argument is positive this function moves point
+ % backward by nmode-command-argument paragraphs , leaving it at the
+ % start of a paragraph. If nmode-command-argument is negative it
+ % moves forwards by abs(nmode-command-argument) paragraphs, leaving
+ % it at the end of a paragraph. This function does not return a
+ % useful value.
+ (if (minusp nmode-command-argument)
+ (for (from i 1 (- nmode-command-argument) 1)
+ (do (forward-one-paragraph)))
+ (for (from i 1 nmode-command-argument 1)
+ (do (backward-one-paragraph)))))
+
+(de paragraph-limits ()
+ % This function returns a list of positions marking the next
+ % paragraph. Only real paragraph limits are returned. If there is
+ % only stuff that should be excluded from a paragraph between point
+ % and the end or the start of the buffer, then the appropriate limit
+ % of the paragraph is filled with the current buffer position. This
+ % function restores point.
+ (let* ((temp (buffer-get-position))(top temp)(bottom temp))
+ (when (forward-one-paragraph)
+ (setf bottom (buffer-get-position)))
+ (when (backward-one-paragraph)
+ (setf top (buffer-get-position)))
+ (buffer-set-position temp)
+ (list top bottom)))
+
+(de mark-paragraph-command ()
+ % This function sets the mark to the end of the next paragraph, and
+ % moves point to its start. It returns nothing useful.
+ (let ((pair (paragraph-limits)))
+ (set-mark-from-point)
+ (buffer-set-position (first pair))
+ (set-mark (second pair))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Start of Fill Functions and Associated Support Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de next-char-list (end char-count init-pos)
+ % This function returns a list, the first element of which is a list
+ % of characters, with their order the reverse of that in the
+ % original text, spaces squeezed to a single space between words,
+ % and with two spaces between sentences. The second element on the
+ % list returned is how far along the new line the position
+ % corresponding to "init-pos" wound up. Point is left after the
+ % last character packed in but before "end" or the next nonblank
+ % character.
+ (let* ((from-end-last-blanks 0)
+ (from-start-last-blanks 0)
+ (final-char-pos char-count)
+ (line-not-full (lessp char-count fill-column))
+ (first-end (buffer-get-position))
+ (next-sentence-wont-exhaust-region
+ (not (buffer-position-lessp end first-end)))
+ (new-char (next-character))
+ (line-list ()))
+ % start of loop for successive sentences
+ (while (and next-sentence-wont-exhaust-region line-not-full)
+ % The next sexp checks to see if the next sentence fits within
+ % the main region (from initial "point" to "end") with a
+ % character to spare for the next sentence iteration.
+ (let* ((next-sentence-end (end-of-next-sentence)))
+ (setf next-sentence-wont-exhaust-region
+ (not (buffer-position-lessp end next-sentence-end)))
+ (setf first-end (if next-sentence-wont-exhaust-region
+ next-sentence-end end)))
+ (skip-forward-blanks) % ignore blanks just before next sentence
+ % start of loop for successive characters
+ (while (and (setf line-not-full (or (lessp char-count fill-column)
+ % next sexp allows oversize words
+ (eq char-count from-end-last-blanks)))
+ (not (buffer-position-lessp first-end
+ (buffer-get-position))))
+ (setf new-char
+ % character compression sexp
+ (let ((next (next-character)))
+ (if (not (= (skip-forward-blanks)
+ next))
+ #\blank
+ (move-forward)
+ next)))
+ (setq line-list (cons new-char line-list))
+ (incr char-count)
+ (when (buffer-position-lessp (buffer-get-position) init-pos)
+ (setf final-char-pos char-count))
+ (cond ((= new-char #\blank)
+ (setf from-end-last-blanks 0)
+ (setf from-start-last-blanks 1))
+ (t % normal character
+ (incr from-end-last-blanks)
+ (incr from-start-last-blanks))))
+ % The next sexp terminates sentences properly.
+ (when (and line-not-full next-sentence-wont-exhaust-region)
+ (setf line-list (append '(#\blank #\blank) line-list))
+ (incr char-count 2)
+ (setf from-end-last-blanks 0)
+ (setf from-start-last-blanks 2)))
+ % The next sexp trims off the last partial word or extra blank(s).
+ (when (or (char-blank? (car line-list)) % extra blank(s)
+ (not (or line-not-full % last partial word
+ (at-line-end?)
+ (char-blank? (next-character)))))
+ (for (from i 1 from-start-last-blanks 1)
+ (do (setf line-list (cdr line-list))))
+ (move-over-characters (- from-end-last-blanks)))
+ % guarantee that buffer-position is left at or before end
+ (if (buffer-position-lessp end (buffer-get-position))
+ (buffer-set-position end))
+ (list line-list final-char-pos)))
+
+(de justify (input desired-length)
+ % This function pads its input with blanks and reverses it. It
+ % leaves point alone.
+ (let*
+ ((input-length (length input))
+ (output ())
+ (needed-blanks (- desired-length input-length))
+ % total number needed to fill out line
+ (input-blanks % count preexisting blanks in input
+ (for (in char input)
+ (with blanks)
+ (count (= char #\blank) blanks)
+ (returns blanks))))
+ (for (in char input)
+ (with (added-blanks 0) % number of new blanks added so far
+ (handled-blanks 0)) % number of input blanks considered so far
+ (do
+ (setf output (cons char output))
+ (when (= char #\blank)
+ (incr handled-blanks)
+ % calculate number of new blanks needed here
+ % fraction of original blanks passed=handled-blanks/input-blanks
+ % blanks needed here~fraction*[needed-blanks(for whole line)]-(added-blanks)
+ (let ((new-blanks (- (/ (* needed-blanks handled-blanks)
+ input-blanks)
+ added-blanks)))
+ (when (> new-blanks 0)
+ (for (from new 1 new-blanks 1)
+ (do
+ (setf output (cons #\blank output))))
+ (incr added-blanks new-blanks))))))
+ output))
+
+(de position-adjusted-for-prefix (position)
+ % This is a pure function which returns a position, corrected for
+ % the length of the prefix on the position's line.
+ (let ((current-place (buffer-get-position)))
+ (buffer-set-position position)
+ (mismatched-prefix?)
+ (let ((prefix-length-or-zero (current-char-pos)))
+ (buffer-set-position current-place)
+ (let ((adjusted-char-pos (- (buffer-position-column position)
+ prefix-length-or-zero)))
+ (if (< adjusted-char-pos 0)(setf adjusted-char-pos 0))
+ (buffer-position-create (buffer-position-line position)
+ adjusted-char-pos)))))
+
+(de remove-prefix-from-region (start end)
+ % The main effect of this function is to strip the fill prefix off a
+ % region in the buffer. this function does not return a useful value
+ % or move point.
+ (let ((current-place (buffer-get-position)))
+ (buffer-set-position start)
+ (if (current-line-empty?)(move-to-next-line))
+ (while (not (buffer-position-lessp end (buffer-get-position)))
+ (setf start (buffer-get-position))
+ (unless (or
+ (mismatched-prefix?)
+ (buffer-position-lessp end (buffer-get-position)))
+ (extract-text t start (buffer-get-position)))
+ (move-to-next-line))
+ (buffer-set-position current-place)))
+
+(de fill-directed-region (start end init-pos)
+ % The main effect of this function is to replace text with filled or
+ % justified text. This function returns a list. The first element
+ % is the increase in the number of lines in the text due to filling.
+ % The second element is the filled position equivalent to "init-pos"
+ % in the original text. The point is left at the end of the new
+ % text
+ (let ((modified-flag (=> nmode-current-buffer modified?))
+ (old-text (extract-text nil start end))
+ (final-pos init-pos)
+ (adj-end (position-adjusted-for-prefix end))
+ (adj-init-pos (position-adjusted-for-prefix init-pos)))
+ (when fill-prefix (remove-prefix-from-region start end))
+ (setf end adj-end)
+ (buffer-set-position start)
+ (let*
+ ((list-of-new-lines (when % handles first blank line
+ (current-line-empty?)
+ (move-to-next-line)
+ '("")))
+ (new-packed-line '(nil 0))
+ (prefix-list
+ (if fill-prefix
+ (string-to-list
+ (getv fill-prefix 0))))
+ (prefix-column (map-char-to-column
+ (list2string prefix-list)
+ (length prefix-list)))
+ (new-line nil)
+ (place (buffer-get-position)) % handles indentation
+ (junk (skip-forward-blanks)) % handles indentation
+ (start-char-pos (+ (current-display-column) % handles indentation
+ prefix-column)) % and first time switch
+ (indent-list (string-to-list % handles indentation
+ (getv (extract-text
+ nil place (buffer-get-position)) 0))))
+ (while
+ (let* ((after-line-start (buffer-position-lessp
+ (buffer-get-position) adj-init-pos))
+ (new-packed-line
+ (next-char-list end start-char-pos adj-init-pos))
+ (before-line-end (buffer-position-lessp
+ adj-init-pos (buffer-get-position))))
+ (when (and after-line-start before-line-end)
+ (setf final-pos (buffer-position-create
+ (+ (buffer-position-line start)
+ (length list-of-new-lines))
+ (second new-packed-line))))
+ % test that anything is left in the region, as well as getting line
+ (setf new-line (first new-packed-line)))
+ (setf new-line
+ (list2string
+ (append % add in fill prefix and indentation
+ (append prefix-list
+ (unless (= start-char-pos prefix-column) indent-list))
+ (if (and nmode-command-argument-given % triggers justification
+ (not (or % don't justify the last line in a paragraph
+ (buffer-position-lessp end (buffer-get-position))
+ (at-buffer-end?))))
+ (justify new-line (- fill-column start-char-pos))
+ (reverse new-line)))))
+ (setf list-of-new-lines (cons new-line list-of-new-lines))
+ % only the first line in a paragraph is indented
+ (setf start-char-pos prefix-column))
+ (setf list-of-new-lines (cons (list2string nil) list-of-new-lines))
+ % The last line in the new paragraph is added in last setf.
+ (let ((line-change 0)
+ (new-text (list2vector (reverse list-of-new-lines))))
+ (when list-of-new-lines
+ (extract-text t start end)
+ (setf line-change
+ (- (size new-text)
+ (size old-text)))
+ (insert-text new-text)
+ (if (and (not modified-flag)
+ (text-equal new-text old-text))
+ (=> nmode-current-buffer set-modified? nil)))
+ (list line-change final-pos)))))
+
+(de clip-region (limits region)
+ % This is a pure function with no side effects. It returns the
+ % "region" position pair, sorted so that first buffer position is
+ % the first element, and clipped so that the region returned is
+ % between the buffer-positions in "limits".
+ (let ((limit-pair (if (buffer-position-lessp (cadr limits) (car limits))
+ (reverse limits) limits))
+ (region-pair (copy
+ (if (buffer-position-lessp (cadr region) (car region))
+ (reverse region) region))))
+ (if (buffer-position-lessp (car region-pair) (car limit-pair))
+ (setf (car region-pair) (car limit-pair)))
+ (if (buffer-position-lessp (cadr region-pair) (car limit-pair))
+ (setf (cadr region-pair) (car limit-pair)))
+ (if (buffer-position-lessp (cadr limit-pair) (car region-pair))
+ (setf (car region-pair) (cadr limit-pair)))
+ (if (buffer-position-lessp (cadr limit-pair) (cadr region-pair))
+ (setf (cadr region-pair) (cadr limit-pair)))
+ region-pair))
+
+(de fill-region-command ()
+ % This function replaces the text between point and the current mark
+ % with a filled version of the same text. It leaves the
+ % buffer-position at the end of the new text. It does not return
+ % anything useful.
+ (let* ((current-place (buffer-get-position))
+ (limits (list (current-mark) current-place)))
+ (setf limits
+ (if (buffer-position-lessp (car limits) (cadr limits))
+ limits (reverse limits)))
+ (buffer-set-position (car limits))
+ (let ((at-limits nil)(new-region nil)(lines-advance 0))
+ (while (not at-limits) % paragraph loop
+ (setf new-region (paragraph-limits))
+ (setf new-region (clip-region limits new-region))
+ (setf at-limits (= (car new-region) (cadr new-region)))
+ (unless at-limits
+ (setf lines-advance
+ (first (fill-directed-region % expansion-of-text-information used
+ (car new-region) (cadr new-region) current-place)))
+ (setf limits % compensate for expansion of filled text
+ (list (first limits)
+ (let ((bottom (second limits)))
+ (buffer-position-create
+ (+ lines-advance (buffer-position-line bottom))
+ (buffer-position-column bottom))))))
+ (setf limits % guarantee that no text is filled twice
+ (list (buffer-get-position)(second limits)))))))
+
+(de fill-paragraph-command ()
+ % This function replaces the next paragraph with filled version. It
+ % leaves point at the a point bearing the same relation to the
+ % filled text that the old point did to the old text. It does not
+ % return a useful value.
+ (let* ((current-place (buffer-get-position))
+ (pos-list (paragraph-limits)))
+ (buffer-set-position (second (fill-directed-region
+ (first pos-list)
+ (second pos-list)
+ current-place)))))
+
+(de fill-comment-command ()
+ % This function creates a temporary fill prefix from the start of
+ % the current line. It replaces the surrounding paragraph
+ % (determined using fill-prefix) with a filled version. It leaves
+ % point at the a position bearing the same relation to the filled
+ % text that the old point did to the old text. It does not return a
+ % useful value.
+ (let ((current-place (buffer-get-position)))
+ (move-to-start-of-line)
+ (let ((place (buffer-get-position))) % get fill prefix ends set up
+ (skip-forward-blanks-in-line)
+ (while (not (or (alphanumericp (next-character))
+ (at-line-end?)
+ (char-blank? (next-character))))
+ (move-forward))
+ (skip-forward-blanks-in-line)
+ (let* ((fill-prefix (extract-text nil place (buffer-get-position)))
+ (pos-list (paragraph-limits)))
+ (if (buffer-position-lessp (first pos-list) current-place)
+ (buffer-set-position (second (fill-directed-region
+ (first pos-list)
+ (second pos-list)
+ current-place)))
+ (buffer-set-position current-place))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Start of Misc Functions and Associated Support Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de center-current-line ()
+ % This function trims and centers the current line. It does not
+ % return a useful value. It leaves point at a point in the text
+ % equivalent to that before centering.
+ (current-line-strip-indent)
+ (let ((current-place (buffer-get-position)))
+ (move-to-end-of-line)
+ (strip-previous-blanks)
+ (buffer-set-position current-place))
+ (let ((needed-blanks (/ (- fill-column (current-display-column)) 2)))
+ (unless (minusp needed-blanks)
+ (indent-current-line needed-blanks))))
+
+(de center-line-command ()
+ % This function centers a number of lines, depending on the
+ % argument. It leaves point at the end of the last line centered.
+ % It does not return a useful value.
+ (center-current-line)
+ (when (> (abs nmode-command-argument) 1)
+ (if (minusp nmode-command-argument)
+ (for (from i 2 (- nmode-command-argument) 1)
+ (do (move-to-previous-line)
+ (center-current-line)))
+ (for (from i 2 nmode-command-argument 1)
+ (do (move-to-next-line)
+ (center-current-line))))))
+
+(de what-cursor-position-command ()
+ % This function tells the user where they are in the buffer or sets
+ % point to the specified line number. It does not return a useful
+ % value.
+ (cond
+ (nmode-command-number-given
+ (set-line-pos nmode-command-argument)
+ )
+ (t
+ (write-message
+ (if (at-buffer-end?)
+ (bldmsg "X=%w Y=%w line=%w (%w percent of %w lines)"
+ (current-display-column)
+ (- (current-line-pos)(current-window-top-line))
+ (current-line-pos)
+ (/ (* 100 (current-line-pos))
+ (current-buffer-visible-size))
+ (current-buffer-visible-size))
+ (bldmsg "X=%w Y=%w CH=%w line=%w (%w percent of %w lines)"
+ (current-display-column)
+ (- (current-line-pos)(current-window-top-line))
+ (next-character) % omitted at end of buffer
+ (current-line-pos)
+ (/ (* 100 (current-line-pos))
+ (current-buffer-visible-size))
+ (current-buffer-visible-size))))
+ )))
ADDED psl-1983/3-1/nmode/wait.sl
Index: psl-1983/3-1/nmode/wait.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/wait.sl
@@ -0,0 +1,34 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Wait.SL - Wait Primitive (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% 19-June-1983 Mark R. Swanson
+% Changed timeout-wait to accept a third argument: a list of args for F, its
+% first arg. This routine is nearly identical to WAIT-TIMEOUT, found in
+% P20U:WAIT.SL and could replace it if calls on WAIT-TIMEOUT are converted to
+% three args.
+
+(CompileTime (load fast-int))
+(BothTimes (load jsys))
+
+(de timeout-wait (f args n-60ths)
+
+ % Return when either of two conditions are met: (1) The function F (of no
+ % arguments) returns non-NIL; (2) The specified elapsed time (in units of
+ % 1/60th second) has elapsed. Don't waste CPU cycles! Return the last
+ % value returned by F (which is always invoked at least once).
+
+ (let (result)
+ (while (and (not (setf result (apply f args)))
+ (> n-60ths 0))
+ (Jsys0 250 0 0 0 (const jsDISMS))
+ (setf n-60ths (- n-60ths 15))
+ )
+ result
+ ))
ADDED psl-1983/3-1/nmode/window-label-rewrite.sl
Index: psl-1983/3-1/nmode/window-label-rewrite.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/window-label-rewrite.sl
@@ -0,0 +1,96 @@
+% Some people desire a different date format on the status line. By
+% setting *DateSelect* to the appropriate value (see Clockdatetime in
+% exec), this will be done.
+(Global '(*DateSelect*))
+
+(defmethod (window-label &rewrite) ()
+ % Unconditionally rewrite the entire label.
+ (let ((buffer (=> window buffer)))
+ (setf screen (=> window screen))
+ (setf buffer-name (=> buffer name))
+ (setf buffer-mode (=> buffer mode))
+ (setf minor-modes nmode-minor-modes)
+ (setf buffer-file (=> buffer file-name))
+ (setf buffer-top (=> window buffer-top))
+ (setf buffer-left (=> window buffer-left))
+ (setf buffer-size (=> buffer visible-size))
+ (setf buffer-modified (=> buffer modified?))
+ (setf current-window nmode-major-window)
+ (if PromptString* (setf prompt-string PromptString*))
+ (let ((old-enhancement (=> screen default-enhancement)))
+ (=> screen set-default-enhancement label-enhancement)
+ (setf pos 0)
+ (if (eq window current-window)
+ (progn
+ (cond ((telerayp) (=> self &write-char 132)))
+ (=> self &write-string "NMODE ")
+ (cond ((telerayp) (=> self &write-char 136))))
+ (progn
+ (cond ((telerayp) (=> self &write-char 136)))
+ (=> self &write-string " ")
+ (cond ((telerayp) (=> self &write-char 136)))))
+ (=> self &write-string (concat (clocktimedate *DateSelect*)
+ " "))
+ (=> self &write-string (getloadaverage))
+ (=> self &write-string (=> buffer-mode name))
+ (if (and minor-modes (eq window current-window))
+ (let ((leader-string " ("))
+ (for (in minor-mode minor-modes)
+ (do
+ (=> self &write-string leader-string)
+ (setf leader-string " ")
+ (=> self &write-string (=> minor-mode name))
+ ))
+ (=> self &write-string ")")
+ ))
+ % Omit the buffer name if it is directly derived from the file name.
+ (cond ((or (not buffer-file)
+ (not (string= buffer-name
+ (filename-to-buffername buffer-file))))
+ (=> self &write-string " [")
+ (=> self &write-string buffer-name)
+ (=> self &write-string "]")
+ ))
+ (when buffer-file
+ (=> self &write-string " ")
+ (=> self &write-string buffer-file)
+ )
+ (when (> buffer-left 0)
+ (=> self &write-string " >")
+ (=> self &write-string (BldMsg "%d" buffer-left))
+ )
+ (cond
+ ((and (= buffer-top 0) (<= buffer-size (=> window height)))
+ % The entire buffer is showing on the screen.
+ % Do nothing.
+ )
+ ((= buffer-top 0)
+ % The window is showing the top end of the buffer.
+ (=> self &write-string " --TOP--")
+ )
+ ((>= buffer-top (- buffer-size (=> window height)))
+ % The window is showing the bottom end of the buffer.
+ (=> self &write-string " --BOT--")
+ )
+ (t % Otherwise...
+ (let ((percentage (/ (* buffer-top 100) buffer-size)))
+ (=> self &write-string " --")
+ (=> self &write-char (+ #/0 (/ percentage 10)))
+ (=> self &write-char (+ #/0 (// percentage 10)))
+ (=> self &write-string "%--")
+ )))
+ (if buffer-modified
+ (=> self &write-string " *"))
+ (when (and (StringP prompt-string) (eq buffer nmode-output-buffer))
+ (=> self &write-string " ")
+ (=> self &advance-pos (- width (string-length prompt-string)))
+ (=> screen set-default-enhancement prompt-enhancement)
+ (=> self &write-string prompt-string)
+ )
+ (=> screen clear-to-eol maxrow pos)
+ (=> screen set-default-enhancement old-enhancement)
+ )))
+
+(de telerayp nil (eq terminal-type 7))
+
+
ADDED psl-1983/3-1/nmode/window-label.sl
Index: psl-1983/3-1/nmode/window-label.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/window-label.sl
@@ -0,0 +1,247 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Window-Label.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 31 January 1983
+% Revised: 14 March 1983
+%
+% A Window-Label object maintains the "label" portion of a buffer-window.
+% This always occupies the lowermost "n" lines of the virtual screen,
+% where "n" is 1 by default in this implementation.
+%
+% 14-Mar-83 Alan Snyder
+% Extend to handle buffers with no name. Extend to display label-string
+% attribute of buffers.
+% 16-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 10-Feb-83 Alan Snyder
+% Fix bug: minor modes did not display.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors fast-strings display-char))
+
+(de create-window-label (w)
+ % Create a window-label object that will maintain the label portion
+ % of the specified buffer-window.
+ (make-instance 'window-label 'window w))
+
+(defflavor window-label
+ (window % the buffer-window object
+
+ (height 1) % number of screen rows occupied by the label
+ minrow % location of top row of the label
+ maxrow % location of the bottom row of the label
+ width % width of the screen
+ maxcol % highest numbered screen column
+
+ pos % current position while writing label
+ screen % output screen while writing label
+
+ (label-enhancement (dc-make-enhancement-mask INVERSE-VIDEO))
+ (prompt-enhancement (dc-make-enhancement-mask INVERSE-VIDEO INTENSIFY))
+
+ % The following instance variables store the various information used
+ % in the construction of the label as currently displayed. This information
+ % is saved so that it can be compared against the current information
+ % to determine whether the displayed label needs to be recomputed.
+
+ (buffer-name NIL) % name of buffer (as displayed)
+ (buffer-mode NIL) % buffer's mode (as displayed)
+ (minor-modes NIL) % minor mode list (as displayed)
+ (buffer-file NIL) % buffer's filename (as displayed)
+ (buffer-top NIL) % buffer-top (as used in label)
+ (buffer-left NIL) % buffer-left (as used in label)
+ (buffer-size NIL) % current buffer size (as used in label)
+ (buffer-modified NIL) % buffer-modified flag (as used in label)
+ (current-window NIL) % current-window (at time label was written)
+ (prompt-string NIL) % PromptString* (at time label was written)
+ (label-string NIL) % label-string attribute of buffer
+ (browser-filter-count NIL) % filter count for browser buffer
+ )
+ ()
+ (gettable-instance-variables
+ height
+ )
+ (settable-instance-variables
+ label-enhancement
+ prompt-enhancement
+ )
+ (initable-instance-variables
+ window
+ height
+ )
+ )
+
+(fluid '(nmode-major-window nmode-output-buffer nmode-minor-modes))
+
+(declare-flavor text-buffer buffer)
+(declare-flavor buffer-window window)
+(declare-flavor virtual-screen screen)
+(declare-flavor browser browser)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Public methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (window-label refresh) ()
+
+ % Update the label are to correspond to the
+ % current state of the attached buffer window.
+ % Conditionally rewrite the entire label, if any relevant
+ % information has changed.
+
+ (let* ((buffer (=> window buffer))
+ (browser (=> buffer get 'browser))
+ )
+ (if (not (and (eq buffer-name (=> buffer name))
+ (eq buffer-mode (=> buffer mode))
+ (eq minor-modes nmode-minor-modes)
+ (eq buffer-file (=> buffer file-name))
+ (= buffer-top (=> window buffer-top))
+ (= buffer-left (=> window buffer-left))
+ (= buffer-size (=> buffer visible-size))
+ (eq buffer-modified (=> buffer modified?))
+ (eq current-window nmode-major-window)
+ (eq prompt-string PromptString*)
+ (eq label-string (=> buffer label-string))
+ (eq browser-filter-count
+ (when browser (=> browser filter-count)))
+ ))
+ (=> self &rewrite)
+ )))
+
+(defmethod (window-label resize) ()
+ % This method must be invoked whenever the window's size may have changed.
+ (setf screen (=> window screen))
+ (setf width (=> screen width))
+ (setf maxrow (- (=> screen height) 1))
+ (setf minrow (- maxrow (- height 1)))
+ (setf maxcol (- width 1))
+ (setf buffer-name T) % force complete rewrite
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Private methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (window-label init) (init-plist)
+ (=> self resize)
+ )
+
+(defmethod (window-label &rewrite) ()
+ % Unconditionally rewrite the entire label.
+ (let* ((buffer (=> window buffer))
+ (browser (=> buffer get 'browser))
+ )
+ (setf screen (=> window screen))
+ (setf buffer-name (=> buffer name))
+ (setf buffer-mode (=> buffer mode))
+ (setf minor-modes nmode-minor-modes)
+ (setf buffer-file (=> buffer file-name))
+ (setf buffer-top (=> window buffer-top))
+ (setf buffer-left (=> window buffer-left))
+ (setf buffer-size (=> buffer visible-size))
+ (setf buffer-modified (=> buffer modified?))
+ (setf current-window nmode-major-window)
+ (if PromptString* (setf prompt-string PromptString*))
+ (setf label-string (=> buffer label-string))
+ (setf browser-filter-count (when browser (=> browser filter-count)))
+ (let ((old-enhancement (=> screen default-enhancement)))
+ (=> screen set-default-enhancement label-enhancement)
+ (setf pos 0)
+ (if (eq window current-window)
+ (=> self &write-string "NMODE ")
+ (=> self &write-string " "))
+ (=> self &write-string (=> buffer-mode name))
+ (if (and minor-modes (eq window current-window))
+ (let ((leader-string " ("))
+ (for (in minor-mode minor-modes)
+ (do
+ (=> self &write-string leader-string)
+ (setf leader-string " ")
+ (=> self &write-string (=> minor-mode name))
+ ))
+ (=> self &write-string ")")
+ ))
+ % Omit the buffer name if it is directly derived from the file name.
+ (cond ((and buffer-name
+ (or (not buffer-file)
+ (not (string= buffer-name
+ (filename-to-buffername buffer-file)))
+ ))
+ (=> self &write-string " [")
+ (=> self &write-string buffer-name)
+ (=> self &write-string "]")
+ ))
+ (when buffer-file
+ (=> self &write-string " ")
+ (=> self &write-string buffer-file)
+ )
+ (when (and label-string (not (string-empty? label-string)))
+ (=> self &write-string " ")
+ (=> self &write-string label-string)
+ )
+ (when (and browser-filter-count (> browser-filter-count 0))
+ (=> self &write-string
+ (bldmsg " <%w %w>"
+ browser-filter-count
+ (if (~= browser-filter-count 1) "filters" "filter")
+ ))
+ )
+ (when (> buffer-left 0)
+ (=> self &write-string (bldmsg " >%d" buffer-left))
+ )
+ (cond
+ ((and (= buffer-top 0) (<= buffer-size (=> window height)))
+ % The entire buffer is showing on the screen.
+ % Do nothing.
+ )
+ ((= buffer-top 0)
+ % The window is showing the top end of the buffer.
+ (=> self &write-string " --TOP--")
+ )
+ ((>= buffer-top (- buffer-size (=> window height)))
+ % The window is showing the bottom end of the buffer.
+ (=> self &write-string " --BOT--")
+ )
+ (t % Otherwise...
+ (let ((percentage (/ (* buffer-top 100) buffer-size)))
+ (=> self &write-string " --")
+ (=> self &write-char (+ #/0 (/ percentage 10)))
+ (=> self &write-char (+ #/0 (// percentage 10)))
+ (=> self &write-string "%--")
+ )))
+ (if buffer-modified
+ (=> self &write-string " *"))
+ (when (and (StringP prompt-string) (eq buffer nmode-output-buffer))
+ (=> self &write-string " ")
+ (=> self &advance-pos (- width (string-length prompt-string)))
+ (=> screen set-default-enhancement prompt-enhancement)
+ (=> self &write-string prompt-string)
+ )
+ (=> screen clear-to-eol maxrow pos)
+ (=> screen set-default-enhancement old-enhancement)
+ )))
+
+(defmethod (window-label &write-string) (string)
+ (for (from i 0 (string-upper-bound string))
+ (do (=> screen write (string-fetch string i) maxrow pos)
+ (setf pos (+ pos 1))
+ )))
+
+(defmethod (window-label &write-char) (ch)
+ (=> screen write ch maxrow pos)
+ (setf pos (+ pos 1))
+ )
+
+(defmethod (window-label &advance-pos) (col)
+ (while (< pos col) (=> self &write-char #\space))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor buffer screen window browser)
ADDED psl-1983/3-1/nmode/window.sl
Index: psl-1983/3-1/nmode/window.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nmode/window.sl
@@ -0,0 +1,193 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Window.SL - Commands and Functions for manipulating windows.
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 24 August 1982
+% Revised: 30 December 1982
+%
+% 30-Dec-82 Alan Snyder
+% Change scrolling commands to Ding if no scrolling is actually done. Fix bug
+% in backwards scroll by pages that failed to preserve relative cursor
+% position. Change behavior of scroll-by-pages upon excessive request.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load objects fast-int))
+
+(fluid '(nmode-current-window
+ nmode-command-argument
+ nmode-command-number-given
+ nmode-command-argument-given
+ nmode-layout-mode
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de current-window-height ()
+ % Return the number of text lines displayable on the current window.
+ (=> nmode-current-window height))
+
+(de current-window-top-line ()
+ % Return the index of the buffer line at the top of the current window.
+ (=> nmode-current-window buffer-top)
+ )
+
+(de current-window-set-top-line (new-top-line)
+ % Change which buffer line displays at the top of the current window.
+ (=> nmode-current-window set-buffer-top new-top-line)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Window Scrolling Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de scroll-window-according-to-command (w)
+ % Scroll the contents of the specified window according to the command
+ % argument. If the command argument was set by C-U or C-U -, then scroll the
+ % contents of the window up or down one page. Otherwise, scroll the window up
+ % or down the specified number of lines.
+
+ (if (and (or (= nmode-command-argument 1) (= nmode-command-argument -1))
+ (not nmode-command-number-given))
+ (scroll-window-by-pages w nmode-command-argument)
+ (scroll-window-by-lines w nmode-command-argument)
+ ))
+
+(de scroll-window-by-lines (w n)
+ % Scroll the contents of the window up (n > 0) or down (n < 0) by |n| lines.
+ % The "window position" may be adjusted to keep it within the window. Ding if
+ % the window contents does not move.
+
+ (let* ((old-top-line (=> w buffer-top))
+ (new-top-line (+ old-top-line n))
+ )
+
+ % adjust to keep something in the window
+ (let ((buffer-last-line (- (=> (=> w buffer) visible-size) 1)))
+ (cond
+ ((< new-top-line 0) (setf new-top-line 0))
+ ((> new-top-line buffer-last-line) (setf new-top-line buffer-last-line))
+ ))
+
+ % adjust "window position" if no longer in window
+ (let ((line (=> w line-position))
+ (max (+ new-top-line (- (=> w height) 1)))
+ )
+ (cond
+ ((< line new-top-line) (=> w set-line-position new-top-line))
+ ((> line max) (=> w set-line-position max))
+ ))
+
+ (if (~= old-top-line new-top-line)
+ (=> w set-buffer-top new-top-line)
+ (Ding)
+ )))
+
+(de scroll-window-by-pages (w n)
+ % Scroll the contents of the window up (n > 0) or down (n < 0) by |n|
+ % screenfuls. The "window position" may be adjusted to keep it within the
+ % window. Ding if the window contents does not move.
+
+ (let* ((old-top-line (=> w buffer-top))
+ (window-height (=> w height))
+ (buffer-last-line (- (=> (=> w buffer) visible-size) 1))
+ (new-top-line old-top-line)
+ )
+ (if (>= n 0)
+ % moving towards the end of the buffer
+ (for (from i 1 n) % do as many complete screenfuls as possible
+ (do (let ((next-top-line (+ new-top-line window-height)))
+ (if (<= next-top-line buffer-last-line)
+ (setf new-top-line next-top-line)
+ (exit)
+ ))))
+ % moving towards the beginning of the buffer
+ (setf new-top-line (max 0 (+ new-top-line (* n window-height))))
+ )
+ (if (~= new-top-line old-top-line)
+ % keep the cursor at the same relative location in the window!
+ (let ((delta (- new-top-line old-top-line)))
+ (=> w set-line-position
+ (min (+ (=> w line-position) delta) (+ buffer-last-line 1)))
+ (=> w set-buffer-top new-top-line)
+ )
+ % otherwise (no change)
+ (Ding)
+ )))
+
+(de scroll-window-horizontally (w n)
+
+ % Scroll the contents of the specified window left (n > 0) or right (n < 0)
+ % by |n| columns.
+
+ (let ((old-buffer-left (=> w buffer-left)))
+ (=> w set-buffer-left (+ old-buffer-left n))
+ (if (= old-buffer-left (=> w buffer-left)) (Ding))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Window Scrolling Commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de next-screen-command ()
+ (scroll-window-according-to-command nmode-current-window)
+ )
+
+(de previous-screen-command ()
+ (setf nmode-command-argument (- 0 nmode-command-argument))
+ (scroll-window-according-to-command nmode-current-window)
+ )
+
+(de scroll-other-window-command ()
+ (selectq nmode-layout-mode
+ (1 (Ding))
+ (2 (scroll-window-according-to-command (nmode-other-window)))
+ ))
+
+(de scroll-window-up-line-command ()
+ (scroll-window-by-lines nmode-current-window nmode-command-argument)
+ )
+
+(de scroll-window-down-line-command ()
+ (scroll-window-by-lines nmode-current-window (- nmode-command-argument))
+ )
+
+(de scroll-window-up-page-command ()
+ (scroll-window-by-pages nmode-current-window nmode-command-argument)
+ )
+
+(de scroll-window-down-page-command ()
+ (scroll-window-by-pages nmode-current-window (- nmode-command-argument))
+ )
+
+(de scroll-window-right-command ()
+ (scroll-window-horizontally nmode-current-window nmode-command-argument)
+ )
+
+(de scroll-window-left-command ()
+ (scroll-window-horizontally nmode-current-window (- nmode-command-argument))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Window Adjusting Commands
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de nmode-adjust-window (w)
+ % Adjust BUFFER-TOP to show current position.
+
+ (=> w adjust-window)
+ )
+
+(de move-to-screen-edge-command ()
+ (let* ((n nmode-command-argument)
+ (line (current-line-pos))
+ (top (current-window-top-line))
+ (height (current-window-height))
+ )
+ (set-line-pos (+ top
+ (cond ((not nmode-command-argument-given) (/ height 2))
+ ((>= n 0) n)
+ (t (+ height n))
+ )))))
ADDED psl-1983/3-1/nonkernel/char-macro.b
Index: psl-1983/3-1/nonkernel/char-macro.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/nonkernel/char-macro.b
cannot compute difference between binary files
ADDED psl-1983/3-1/nonkernel/char-macro.sl
Index: psl-1983/3-1/nonkernel/char-macro.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/nonkernel/char-macro.sl
@@ -0,0 +1,64 @@
+%
+% CHAR-MACRO.SL - Character constant macro
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Edit by Cris Perdue, 1 Feb 1983 1355-PST
+% pk:char.red merged with the version in USEFUL. Some symbolic names
+% for characters removed (not needed, I hope).
+
+(dm Char (U) %. Character constant macro
+ (DoChar (cadr U)))
+
+% Table driven char macro expander
+(de DoChar (u)
+ (cond
+ ((idp u) (or
+ (get u 'CharConst)
+ ((lambda (n) (cond ((lessp n 128) n))) (id2int u))
+ (CharError u)))
+ ((pairp u) % Here's the real change -- let users add "functions"
+ ((lambda (fn)
+ (cond
+ (fn (apply fn (list (dochar (cadr u)))))
+ (t (CharError u))))
+ (cond ((idp (car u)) (get (car u) 'char-prefix-function)))))
+ ((and (fixp u) (geq u 0) (leq u 9)) (plus u #\!0))
+ (t (CharError u))))
+
+(deflist
+ `((lower ,(function (lambda(x) (lor x 2#100000))))
+ (quote ,(function (lambda(x) x)))
+ (control ,(function (lambda(x) (land x 2#11111))))
+ (cntrl ,(function (lambda(x) (land x 2#11111))))
+ (meta ,(function (lambda(x) (lor x 2#10000000)))))
+ 'char-prefix-function)
+
+(de CharError (u)
+ (ErrorPrintF "*** Unknown character constant: %r" u)
+ 0)
+
+(DefList '((NULL 0)
+ (BELL 7)
+ (BACKSPACE 8)
+ (TAB 8#11)
+ (LF 8#12)
+ % (RETURN 8#12) % RETURN is LF: it's end-of-line. Out! /csp
+ (EOL 8#12)
+ (FF 8#14)
+ (CR 8#15)
+ (ESC 27)
+ (ESCAPE 27)
+ (BLANK 32)
+ (SPACE 32)
+ (RUB 8#177)
+ (RUBOUT 8#177)
+ (DEL 8#177)
+ (DELETE 8#177)
+ ) 'CharConst)
ADDED psl-1983/3-1/psl/news-28-aug-82.txt
Index: psl-1983/3-1/psl/news-28-aug-82.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/news-28-aug-82.txt
@@ -0,0 +1,120 @@
+30-Jul-82 17:06:17-PDT,2293;000000000001
+Date: 30 Jul 1982 1706-PDT
+From: Alan Snyder <AS>
+Subject: NEW EMODE
+To: PSL-News: ;, PSL-Users: ;
+cc: AS
+
+------------------------------ EMODE Changes ------------------------------
+
+A new PSL has been installed with the following changes made to EMODE:
+
+1. C-X C-R (Read File) now replaces the contents of the current buffer
+ with the contents of the file, instead of inserting the contents
+ of the file at the current location in the buffer. This is an
+ INCOMPATIBLE change. (If you want to insert a file, you can first
+ read it into an auxiliary buffer.)
+2. File INPUT and OUTPUT have been speeded up greatly (by a factor of 5).
+ Still noticably slower than EMACS, however.
+3. Three bugs in file I/O have been fixed: (a) EMODE no longer treats a ^Z
+ in a file as an end-of-file mark; (b) EMODE will no longer lose the
+ last line of a file should it lack a terminating CRLF; (c) EMODE no
+ longer appends a spurious blank line when writing to a file.
+4. Many more EMACS commands have been implemented (see list below).
+ Please note that Lisp Indentation (available using TAB, LineFeed,
+ and C-M-Q) makes many bad choices. These deficiencies are known, but
+ it was decided that in this case something was better than nothing.
+ Complaints about indentation are considered redundant.
+
+Send bug reports to "PSL@Hulk".
+
+New EMODE commands:
+
+ C-Q (Quoted Insert)
+ M-\ (Delete Horizontal Space)
+ C-X C-O (Delete Blank Lines)
+ M-M and C-M-M (Back to Indentation)
+ M-^ (Delete Indentation)
+ M-@ (Mark Word)
+ C-X H (Mark Whole Buffer)
+ C-M-@ (Mark Sexp)
+ Tab (Indent for Lisp)
+ LineFeed (Indent New Line)
+ C-M-U (Backward Up List) [ should also be C-M-( ]
+ C-M-O (Forward Up List) [ should be C-M-) ]
+ C-M-A and C-M-[ (Beginning of Defun)
+ C-M-D (Down List)
+ C-M-E and C-M-] (End of Defun)
+ C-M-H (Mark Defun)
+ C-M-N (Next List)
+ C-M-P (Previous List)
+ C-M-Q (Indent Sexp)
+ M-( (Insert Parens)
+ M-) (Move over Paren)
+
+-------------------------------------------------------------------------------
+-------
+10-Aug-82 17:02:41-PDT,1652;000000000001
+Date: 10 Aug 1982 1702-PDT
+From: Cris Perdue <Perdue>
+Subject: Latest, hottest PSL news
+To: PSL-News: ;, PSL-Users: ;
+
+PSL NEWS FLASH!! -- August 10, 1982
+
+
+CATCH
+
+An implementation of CATCH with "correct" semantics is on its
+way. Eric Benson has an implementation that allows code for the
+body of the CATCH to be compiled in line. Variables used free
+inside the body will not have to be declared fluid. Unhandled
+exceptions will, unfortunately, continue to result in abort to
+the top level.
+
+BUG FIXES
+
+Be sure to peruse PSL:BUGS.TXT. In addition to an invaluable
+compilation of commentary, bug reports and just plain flaming,
+this file contains reports of some fixes to bugs!
+
+TOKEN SCANNER FOUND WANTING
+
+The current PSL token scanner has been tried in the balance and
+found wanting. Eric Benson says it was ripped off from some
+other token scanner in rather a hurry and needs to be replaced.
+
+PACKAGE SYSTEM ALSO FOUND WANTING
+
+Sources close to Doug Lanam report that the PSL "package system"
+is not adequate. We asked Martin Griss, "What about the package
+system?". He admitted the inadequacy, calling the package system
+"experimental" and saying that the fasloader needs to know about
+packages.
+
+EMODE IMPROVED AND DOCUMENTED
+
+Some improvements to EMODE are described in the key documentation
+file PSL:HP-PSL.IBM (and .LPT). Enhancements continue at a rapid
+pace, leading one experienced observer to comment, "Looks like
+Alan has really been tearing into EMODE -- impressive!". The
+file PE:DISPATCH.DOC contains some key information on
+customization of EMODE. More reports to come.
+-------
+16-Aug-82 09:59:32-PDT,520;000000000001
+Date: 16 Aug 1982 0959-PDT
+From: Alan Snyder <AS>
+Subject: New PSL
+To: PSL-News: ;, PSL-Users: ;
+cc: AS
+
+A new version of "NPSL" has been installed with the following
+changes:
+
+ * EMODE now uses clear-EOL for faster redisplay.
+ * EMODE's start-up glitches have been removed. EMODE will
+ now start up in 1-window mode.
+ * A "compile" command has been added; you can now say
+ "PSL compile foo" to EXEC to compile the file "foo.sl".
+ (This feature has been added to both PSL and NPSL.)
+-------
ADDED psl-1983/3-1/psl/news.txt
Index: psl-1983/3-1/psl/news.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/news.txt
@@ -0,0 +1,925 @@
+28-Sep-82 17:50:20-PDT,3097;000000000000
+Date: 28 Sep 1982 1750-PDT
+From: Alan Snyder <AS>
+Subject: new PSL!!!!
+To: PSL-News: ;, PSL-Users: ;
+cc: AS
+
+Important Change to PSL!
+
+We have installed a new version of PSL on HULK. It contains a number of
+significant changes which are described here. In addition, you must change
+your LOGIN.CMD file to TAKE PSL:LOGICAL-NAMES.CMD instead of
+<PSL>LOGICAL-NAMES.CMD. The <PSL> directory will disappear soon, so make this
+change right away!
+
+[These changes, except for NMODE, will appear on THOR and HEWEY shortly. There
+are no immediate plans to move NMODE to the Vax.]
+
+Summary of changes:
+
+* If you run "PSL", you will now get a PSL that contains the NMODE editor,
+which is a replacement for EMODE. PSL will start up in the editor, instead of
+the PSL listen loop. You can easily get back to the PSL listen loop from NMODE
+by typing C-] L. NMODE is a decent subset of EMACS, so if you are familiar
+with EMACS you should be able to use NMODE without too much difficulty. If you
+are familiar with EMODE, you should read the file PSL:NMODE-GUIDE.TXT, which
+explains the differences between NMODE and EMODE. A printed copy of this memo,
+including the NMODE command chart, is available in the documentation area next
+to Helen Asakawa's office.
+
+* The "PSL" program (what you get when you say "PSL" to EXEC) no longer
+contains the PSL compiler. Instead, there is a separate program for compiling
+(Lisp) files. To compile a file "FOO.SL", give the command "PSLCOMP FOO" to
+EXEC. PSLCOMP will produce a binary file "FOO.B" that can then be LOADed or
+FASLINed. To run the compiler interactively, just say "PSLCOMP" to EXEC.
+
+* The PSL directories that contain the source and binaries for all PSL modules
+have been moved to a private structure called SS: (the directories are now
+SS:<PSL*>). The old PSL directories (PS:<PSL*>) will disappear soon. In
+addition, the new directories have been reorganized somewhat to better reflect
+the structure of the implementation. The file PSL:-THIS-.DIRECTORY contains a
+brief description of the new structure. If you have used logical names to
+refer to PSL directories, then this change should not cause too many problems.
+
+* A number of small bug fixes and improvements have been made. The most
+notable improvements are (1) a more readable backtrace, (2) a better
+prettyprinter, and (3) the definition of a "complete" set of I/O functions
+taking an explicit channel argument (these functions all have names like
+ChannelTerpri, where Terpri is an example of an I/O function that uses the
+default I/O channels). The file PSL:BUG-FIX.LOG contains an exhaustive listing
+of the recent changes.
+
+The documentation has been updated to reflect these changes. The following new
+or revised documents are available in the documentation area next to Helen
+Asakawa's office:
+
+ Notes on PSL at HP
+ DEC-20 PSL New Users' Guide
+ NMODE for EMODE Users
+ How to customize NMODE
+
+We have made "documentation packets" containing copies of these documents.
+Users are encouraged to pick up a copy!
+-------
+11-Oct-82 15:55:41-PDT,5771;000000000000
+Date: 11 Oct 1982 1555-PDT
+From: Alan Snyder <AS>
+Subject: new PSL installed
+To: PSL-News: ;, PSL-Users: ;
+cc: AS
+
+PSL NEWS - 11 October 1982
+
+A new PSL has been installed on Hulk and Hewey. There are a number of
+improvements, plus some INCOMPATIBLE changes (see below). A most noticable
+change (on Hulk) is that PSL no longer automatically starts up in the NMODE
+editor. However, if you want PSL to start up in the editor, you can still make
+this happen using another new feature, INIT files (see below). Otherwise, you
+can explicitly enter NMODE by invoking the function NMODE, with no arguments.
+In addtion, NMODE now supports the extended VT52 emulator on the 9836 (get the
+latest version from Tracy). (No, NMODE is not yet installed on Hewey.)
+
+-------------------------------------------------------------------------------
+INCOMPATIBLE CHANGES TO PSL:
+-------------------------------------------------------------------------------
+This latest version of PSL has 3 changes which may require some application
+programs to be changed:
+
+1. SAVESYSTEM
+
+SaveSystem now takes 3 arguments. The first argument is the banner, the second
+is the file to be written, and the third is a list of forms to evaluated when
+the new core image is started. For example:
+
+ (SaveSystem "PSL 3.1" "PSL.EXE" '((InitializeInterrupts)))
+
+2. DUMPLISP
+
+Dumplisp now takes 1 argument, the file to be written. For example:
+
+ (Dumplisp "PSL.EXE")
+
+3. DSKIN
+
+Dskin has been changed from a FEXPR to a single-argument EXPR. This should
+only affect calls to DSKIN with multiple arguments. They will have to be
+changed to several calls, each with one argument.
+
+4. BR and UNBR
+
+The functions BR and UNBR are no longer part of PSL. These functions provided
+a facility for breaking on entry and exit to specific functions. However,
+they didn't work very well and no one has figured out how to make them work,
+so they have been removed. Send complaints to PSL.
+
+-------------------------------------------------------------------------------
+MAJOR IMPROVEMENTS TO PSL:
+-------------------------------------------------------------------------------
+The following features have been added to PSL:
+
+1. Init files
+
+When PSL, RLISP, or PSLCOMP (note: not BARE-PSL) is executed, if a file
+PSL.INIT, RLISP.INIT, or PSLCOMP.INIT, respectively, is in your home (login)
+directory, it will be read and evaluated. This allows you to automatically
+customize your Lisp environment. (The init files are .pslrc, .rlisprc, and
+.pslcomprc on the Vax.) If you want PSL to come up in NMODE, include the
+statement
+
+ (setf nmode-auto-start T)
+
+in your PSL.INIT file.
+
+2. Prinlevel and Prinlength
+
+The variables PRINLEVEL and PRINLENGTH now exist, as described in the Common
+Lisp Reference Manual. These variables allow you to limit the depth of
+printing of nested structures and the number of elements of structured objects
+printed. These variables affect Prin1 and Prin2 (Princ) and those functions
+that use them (Printf, Print). They do not currently affect Prettyprint,
+although this may be done in the future. The Printx function now properly
+handles circular vectors.
+
+-------------------------------------------------------------------------------
+CHANGES TO NMODE:
+-------------------------------------------------------------------------------
+
+* NMODE also supports init files (this isn't new, but wasn't stressed in
+ previous documentation). When NMODE starts up, it will read and execute the
+ file NMODE.INIT in the user's home (login) directory. This file should
+ contain PSL (Lisp) forms.
+
+* NMODE now reads a default init file if the user has no personal init file.
+ The name of this default init file is "PSL:NMODE.INIT". If you make your
+ own NMODE.INIT file, you should consider including in it the statement
+ "(nmode-read-and-evaluate-file nmode-default-init-file-name)", which will
+ execute the default init file.
+
+* NMODE now supports the 9836 VT52 emulator (which has recently been extended
+ to accept commands to change the display enhancement). The default NMODE
+ init file will set up the NMODE VT52 driver if the system terminal type is
+ VT52.
+
+* NMODE no longer always starts up in the editor after it is RESET, ABORTed,
+ or ^C'ed and STARTed. It will only restart in the editor if it was in the
+ editor beforehand.
+
+* NMODE will now read and write files containing stray CRs.
+
+* M-X command completion is more like EMACS.
+
+* Typing an undefined command now tells you what command you typed.
+
+* New commands:
+
+ C-X C-L (Lowercase Region)
+ C-X C-U (Uppercase Region)
+ C-X E (Exchange Windows)
+ C-X ^ (Grow Window)
+ M-' (Upcase Digit)
+ M-C (Uppercase Initial)
+ M-L (Lowercase Word)
+ M-U (Uppercase Word)
+ M-X Append to File
+ M-X DIRED
+ M-X Delete File
+ M-X Delete and Expunge File
+ M-X Edit Directory
+ M-X Find File
+ M-X Insert Buffer
+ M-X Insert File
+ M-X Kill Buffer
+ M-X Kill File
+ M-X List Buffers
+ M-X Prepend to File
+ M-X Query Replace
+ M-X Replace String
+ M-X Save All Files
+ M-X Select Buffer
+ M-X Undelete File
+ M-X Visit File
+ M-X Write File
+ M-X Write Region
+(Case conversion commands contributed by Jeff Soreff)
+
+* Some bugs relating to improper window adjustment have been fixed.
+ For example, when the bottom window "pops up", the top window will now
+ be adjusted. Also, C-X O now works properly in 1-window mode when the
+ two windows refer to the same buffer (i.e., it switches between two
+ independent buffer positions).
+
+* Bug fix: It should no longer be possible to find a "killed" buffer in
+ a previously unexposed window.
+-------
+ 9-Nov-82 08:17:56-PST,4505;000000000000
+Date: 9 Nov 1982 0817-PST
+From: Alan Snyder <AS>
+Subject: new PSL installed
+To: PSL-News: ;, PSL-Users: ;
+
+A new version of PSL has been installed on Hulk.
+Here are the details:
+
+New PSL Changes (9 November 1982)
+
+---- PSL Changes -------------------------------------------------------------
+
+* The major change in PSL is that CATCH/THROW has been reimplemented to
+ conform to the Common Lisp definition (see Section 7.10 of the Common
+ Lisp manual). In particular, CATCH has been changed to a special form
+ so that its second argument is evaluated only once, instead of twice.
+ THIS IS AN INCOMPATIBLE CHANGE: if you use CATCH, you must change your
+ programs. For example, if you wrote:
+
+ (catch 'foo (list 'frobnicate x y z))
+
+ you should change it to:
+
+ (catch 'foo (frobnicate x y z))
+
+ One aspect of this change is that an "unhandled" throw is now reported
+ as an error in the context of the throw, rather than (as before) aborting
+ to top-level and restarting the job.
+
+ Also implemented are UNWIND-PROTECT, CATCH-ALL, and UNWIND-ALL, as
+ described in the Common Lisp manual, with the exception that the
+ catch-function in CATCH-ALL and UNWIND-ALL should expect exactly 2 arguments.
+
+ Note that in Common Lisp, the proper way to catch any throw is to
+ use CATCH-ALL, not CATCH with a tag of NIL.
+
+* A related change is that the RESET function is now implemented by
+ THROWing 'RESET, which is caught at the top-level. Thus, UNWIND-PROTECTs
+ cannot be circumvented by RESET.
+
+---- NMODE Changes -----------------------------------------------------------
+
+New Features:
+
+* C-X C-B now enters a DIRED-like "Buffer Browser" that allows you to
+ select a buffer, delete buffers, etc.
+* DIRED and the Buffer Browser can now operate in a split-screen mode, where
+ the upper window is used for displaying the buffer/file list and the bottom
+ window is used to examine a particular buffer/file. This mode is enabled
+ by setting the variable BROWSER-SPLIT-SCREEN to T. If this variable is
+ NIL, then DIRED and the Buffer Browser will automatically start up in
+ one window mode.
+* M-X Apropos has been implemented. It will show you all commands whose
+ corresponding function names contain a given string. Thus, if you
+ enter "window", you will see all commands whose names include the string
+ "window", such as "ONE-WINDOW-COMMAND".
+* M-X Auto Fill Mode has been implemented by Jeff Soreff, along with
+ C-X . (Set Fill Prefix) and C-X F (Set Fill Column). If you want NMODE
+ to start up in Auto Fill mode, put the following in your NMODE.INIT file:
+ (activate-minor-mode auto-fill-mode)
+* NMODE now attempts to display a message whenever PSL is garbage-collecting.
+ This feature is not 100% reliable: sometimes a garbage collect will happen
+ and no message will be displayed.
+
+Minor Improvements:
+
+* C-N now extends the buffer (like EMACS) if typed without a command argument
+ while on the last line of the buffer.
+* Lisp break handling has been made more robust. In particular, NMODE now
+ ensures that IN* and OUT* are set to reasonable values.
+* The OUTPUT buffer now starts out with the "modified" attribute ("*") off.
+* The implementation of command prefix characters (i.e., C-X, M-X, C-], and
+ Escape) and command arguments (i.e., C-U, etc.) has changed. The most
+ visible changes are that C-U, etc. echo differently, and that Escape can
+ now be followed by bit-prefix characters. (In other words, NMODE will
+ recognize "Escape ^\ E" as Esc-M-E, rather than "Esc-C-\ E"; the 9836
+ terminal emulator has been modified to generate such escape sequences
+ under some circumstances.) NMODE customizers may be interested to know
+ that all of these previously-magic characters can now be redefined (on a
+ per-mode basis, even), just like any other character.
+* If you are at or near the end of the buffer, NMODE will put the current
+ line closer to the bottom of the screen when it adjusts the window.
+* C-X C-F (Find File) and the Dired 'E' command will no longer "find" an
+ incorrect version of the specified file, should one happen to already be in
+ a buffer.
+* The 'C' (continue) command to the PSL break loop now works again.
+* The "NMODE" indicator on the current window's mode line no longer
+ disappears when the user is entering string input.
+* The command C-X 4 F (Find File in Other Window) now sets the buffer's
+ file name properly.
+-------
+ 6-Dec-82 18:41:19-PST,1969;000000000000
+Date: 6 Dec 1982 1841-PST
+From: Cris Perdue <Perdue>
+Subject: LOADable modules, and HELP for them
+To: PSL-News: ;, PSL-Users: ;
+
+NEW PACKAGES:
+
+Some relatively new packages have been made available by various
+people here. These belong in PU: (loadable utilities) at some
+point, but for now they are all on PNEW:, both the source code
+and the object code. See below for an explanation of PNEW:.
+
+Documentation for each of these is either in the source file or
+in PH:<file>.DOC, which has been greatly cleaned up.
+
+HASH.SL
+HISTORY.SL
+IF.SL
+MAN.SL
+NEWPP.SL
+STRING-INPUT.SL
+STRING-SEARCH.SL
+TIME-FNC.SL
+
+DOCUMENTATION ON PH: (the HELP directory):
+
+PH: has been greatly cleaned up. It should now be reasonable to
+browse through PH: for information on packages not described in
+the PSL reference manual.
+
+TO THE USERS:
+
+These files are intended to be IMPORTed or LOADed. If you wish
+to use modules from PNEW:, you must put PNEW: into your
+definition of the "logical device" PL:.
+
+The command "INFO LOGICAL PL:" to the EXEC will tell you what the
+current definition of PL: is. Put a line of the form:
+"DEFINE PL: <directory>,<directory>, ..., PNEW:" into your LOGIN.CMD
+file, including the same directories that are given when you ask
+the EXEC, with PNEW: added at the end as shown.
+
+GETTING MOST RECENT VERSIONS OF MODULES:
+
+PNEW: also contains the object files for new versions of existing
+modules where the latest version is more recent than the latest
+"release" of PSL. In particular, where PSL.EXE includes the
+module preloaded in it, PSL.EXE will not include the version in
+PNEW:. If you want the latest version when you LOAD or IMPORT,
+put PNEW: at the front of the list defining PL:.
+
+TO THE IMPLEMENTORS:
+
+If one of these is your product and you feel it is well tried and
+no longer experimental, please send a note to Nancy K. asking her
+to move the source to PU: and the object file to PL:.
+
+-------
+ 4-Jan-83 14:37:11-PST,1577;000000000000
+Date: 4 Jan 1983 1437-PST
+From: Cris Perdue <Perdue>
+Subject: PSL NEWS
+To: PSL-News: ;, PSL-Users: ;
+
+FILES THAT DESCRIBE OTHER FILES
+
+If you need to look at the PSL directories on HULK or find
+something in those directories, look for files with names that
+start with "-", such as -THIS-.DIRECTORY or -FILE-NOTES.TXT.
+These files appear at the beginning of an ordinary directory
+listing and they describe the directory they are in, plus the
+files and/or subdirectories of that directory.
+
+PSL directories likely to be of interest to users are:
+ PSL: (PSL root directory),
+ PU: (source code for libraries),
+ PNEW: (place to keep revisions of source files),
+ PH: (help files and documentation for libraries).
+
+LIBRARY MODULES NOW LISTED
+
+PU: is the repository for the source code of library modules,
+generally contributed by users. The file PU:-FILE-NOTES.TXT
+contains a listing of available library modules, in most cases
+with a one-line description of each module. Please look here for
+interesting utilities. If no documentation appears to exist, bug
+the author of the module, also listed. (Documentation may appear
+in PH: or in the source file itself on PU:.)
+
+SAVESYSTEM
+
+The function SAVESYSTEM, which used to take one argument, now takes
+three arguments. The first is the banner, the second is the file to be
+written, and the third is a list of forms to be evaluated when the new
+core image is started.
+
+PSL.TAGS
+
+For those of you who browse through PSL source code, the file
+PSL.TAGS moved to p20sup: from psl:.
+-------
+11-Jan-83 13:09:13-PST,1516;000000000000
+Date: 11 Jan 1983 1309-PST
+From: Cris Perdue <Perdue>
+Subject: PSL NEWS
+To: PSL-News: ;, PSL-Users: ;
+
+When compiled code calls a function that is undefined, the error
+is now continuable. If the error is continued, the function call
+is repeated.
+
+The function EXITLISP is now available in DEC-20 PSL, where it is
+currently a synonym for QUIT. Both functions cause PSL to return
+to a command interpreter. If the operating system permits a
+choice, QUIT is a continuable exit, and EXITLISP is a permanent
+exit (that terminates the PSL process).
+
+The functions LPOSN and CHANNELLPOSN now exist. These return a
+meaningful value for channels that are open for output, giving
+the number of the current line within the current output page.
+To be precise, the value is the number of newlines output since
+the most recent formfeed.
+
+People have been using the undocumented STRING-CONCAT function.
+This function is NOT actually compatible with Common LISP. It
+should be used as a function that applies only to string
+arguments, and is otherwise like CONCAT.
+
+Various bugs have been fixed, notably in the compiler and
+debugging facilities.
+
+A new directory of possible interest is PSYS:. This contains
+executable files. Executables already documented as being on
+PSL: will stay there for some time, but new ones are on PSYS:.
+
+DOCUMENTATION
+
+The reference manual has been significantly revised and a new
+version will be made available to all PSL users within a week or
+two.
+-------
+11-Jan-83 13:20:09-PST,4950;000000000000
+Date: 11 Jan 1983 1319-PST
+From: Alan Snyder <AS>
+Subject: NMODE news
+To: PSL-News: ;, PSL-Users: ;
+cc: AS
+
+
+NMODE changes (10-Nov-1982 through 5-Jan-1983):
+
+* Bug fix: In the previous version of NMODE, digits and hyphen would insert
+ themselves in the buffer even in "read-only" modes like Dired. They now act
+ to specify command arguments in those modes.
+
+* Bug fix: control characters are now displayed properly in the message lines
+ at the bottom of the screen.
+
+* Some bugs in auto fill mode have been fixed.
+
+* C-S and C-R now get you an incremental search, very much like that in
+ EMACS. [Incremental search was implemented by Jeff Soreff.]
+
+* The window scrolling commands have been changed to ring the bell if no
+ actual scrolling takes place (because you are already at the end of the
+ buffer, etc.). In addition, some bugs in the scroll-by-pages commands have
+ been fixed: (1) Previously, a request to scroll by too many pages was ignored;
+ now it will scroll by as many pages as possible. (2) Previously, a backwards
+ scroll near the beginning of the buffer could fail to leave the cursor in the
+ same relative position on the screen.
+
+* A number of changes have been made that improve the efficiency of refresh,
+ input completion (on buffer names and M-X command names), and Lisp I/O
+ to and from buffers (Lisp-E).
+
+* Jeff Soreff has implemented the following commands:
+
+ M-A (Backward Sentence)
+ M-E (Forward Sentence)
+ M-K (Kill Sentence)
+ C-X Rubout (Backward Kill Sentence)
+ M-[ (Backward Paragraph)
+ M-] (Forward Paragraph)
+ M-H (Mark Paragraph)
+ M-Q (Fill Paragraph)
+ M-G (Fill Region)
+ M-Z (Fill Comment)
+ M-S (Center Line)
+ C-X = and C-= (What Cursor Position)
+
+ These are basically the same as EMACS, except for M-Z, which is new. M-Z
+ (Fill Comment) is like M-Q (Fill Paragraph), except that it first scans the
+ beginning of the current line for a likely prefix and temporarily sets the
+ fill prefix to that string. The prefix is determined to be any string of
+ indentation, followed by zero or more non-alphanumeric, non-blank characters,
+ followed by any indentation. The Fill Prefix works somewhat better than
+ EMACS: lines not containing the fill prefix delimit paragraphs.
+
+* New EMACS commands implemented:
+ C-M-\ (Indent Region) (for both Text and Lisp modes)
+ C-M-C (inserts a ^C)
+
+* Defined C-? same as M-?, C-( same as C-M-(, C-) same as C-M-), for the
+ convenience of 9836 users.
+
+* The following commands have been enhanced to obey the C-U argument as in
+ EMACS:
+
+ C-Y (Insert Kill Buffer)
+ M-Y (Unkill Previous)
+ M-^ (Delete Indentation)
+ C-M-(, C-M-U, and C-( (Backward Up List)
+ C-M-) and C-) (Forward Up List)
+ C-M-N (Move Forward List)
+ C-M-P (Move Backward List)
+ C-M-A and C-M-[ (Move Backward Defun)
+ C-M-E and C-M-] (End of Defun)
+
+* The C-X = command has been extended: if you give it a numeric argument,
+ it will go to the specified line number.
+
+* NMODE's Lisp parsing has been vastly improved. It now recognizes the
+ following: lists, vectors, comments, #/ character constants, string literals,
+ ! as the escape character, and prefixes (including quote, backquote, comma,
+ comma-atsign, and #-quote). The only restriction is that parsing is always
+ done from the beginning of the line; thus newline cannot appear in string
+ literals or be quoted in any way.
+
+* NMODE's Lisp indenting has also been improved. It now recognizes special
+ cases of indenting under functional forms, and indents to match the leftmost
+ (rather than the rightmost) of a sequence of forms on a line. It also knows
+ about prefixes, like quote.
+
+* Inserting a right bracket in Lisp mode now displays the matching bracket, just
+ as inserting a right paren does.
+
+* Inserting a right paren (or right bracket) now will avoid trying to display
+ the "matching" left paren (or left bracket) when inside a comment, etc.
+
+* Changed multi-line Lisp indenting commands to avoid indenting (in fact, remove
+ any indentation from) blank lines.
+
+* The indenting commands now avoid modifying the buffer if the indentation
+ remains unchanged.
+
+* When a command (such as C-X K) asks for the name of an existing buffer,
+ CR will now complete the name, if possible, and terminate if the name
+ uniquely specifies one existing buffer. This behavior is more similar
+ to EMACS than the previous behavior, where CR did no completion.
+
+* String input is now confirmed by moving the cursor to the beginning of
+ the input line.
+-------
+11-Jan-83 17:19:31-PST,1032;000000000001
+Date: 11 Jan 1983 1719-PST
+From: Cris Perdue <Perdue>
+Subject: More PSL News
+To: PSL-News: ;, PSL-Users: ;
+
+The behavior of LOAD has been modified so it is possible to use LOAD
+to load in ".SL" files. As in the past, LOAD searches in two places
+for a file to load: first in the connected directory (DSK: for the
+DEC-20 cognoscenti), then on PL: (or the equivalent on other machines).
+
+On each of these directories it searches through a list of file
+extensions (.b, .lap, and .sl) for a file with the right name and
+that extension. Thus LOAD looks first for <file>.b, then <file>.lap,
+then <file>.sl, then pl:<file>.b, then pl:<file>.lap, finally pl:<file>.sl.
+
+Until the latest version of PSL, LOAD would only search for .b and .lap
+files. The extended behavior should help people who often do not
+compile files. The main thing to remember is to either keep any
+.b file in the same directory with the .sl, or else make sure that
+the .b file's directory is searched before the .sl file's directory.
+-------
+19-Jan-83 18:28:27-PST,1437;000000000003
+Date: 19 Jan 1983 1826-PST
+From: PERDUE at HP-HULK
+Subject: PSL News Update
+To: psl-news
+
+LOADing files
+
+The LOAD function uses two lists in searching for a file to actually
+load. The lists are:
+
+loaddirectories*
+
+This initially has the value: ("" "pl:"). It is a list of strings
+which indicate the directory to look in. Directories are searched in
+order of the list.
+
+loadextensions*
+
+This initially has the value: ((".b" . FASLIN) (".lap" . LAPIN)
+(".sl" . LAPIN)). It is an association list. Each element is a pair
+whose CAR is a string representing a file extension and whose CDR is a
+function to apply to LOAD a file of this extension. Within each
+directory of loaddirectories*, the members of loadextensions* are used
+in order in searching for a file to load.
+
+NOTES: The value of loadextensions* has recently changed. Removal of
+the last element of loadextensions* will restore the old behavior. Do
+not expect the exact strings that appear in these lists to remain
+identical across machines or across time, but it is reasonable to
+believe that the lists and their use will be stable for some time.
+
+DEBUGGING: BR and UNBR
+
+BR and UNBR were removed from the PSL system some time ago. To
+satisfy their devotees, they have been resurrected in a library named
+BR-UNBR. A bug has also been fixed and very soon the system library
+file will have the fix (if in a hurry see pnew:).
+-------
+24-Jan-83 09:42:10-PST,703;000000000000
+Date: 21 Jan 1983 1909-PST
+From: PERDUE at HP-HULK
+Subject: Documentation directories
+To: psl-news
+
+The PSL documentation directory "pd:" has been cleaned up and
+there are now also machine-dependent directories p20d:, pvd:,
+phpd:, and pad: (Apollo). No great news of yet concerning the
+contents of these directories, though they do contain some rather
+new documents in source and final form.
+
+Note that some of these logical names are new, and there are some
+other new logical names as well: the group based on the root name
+"pdist" has been filled out, and the group based on the name
+"psup:" has also been filled out with a couple of new directories
+and their logical names.
+-------
+ 9-Feb-83 13:22:20-PST,4442;000000000000
+Date: 9 Feb 1983 1317-PST
+From: AS at HP-HULK
+Subject: NMODE changes
+To: psl-news
+
+The following recent changes are available in PSL:NMODE.EXE on Hulk,
+and on the 9836 (except for Dired).
+
+Recent NMODE changes (20-Jan-1983 through 9-Feb-1983):
+
+Changes:
+
+* The Buffer Browser (C-X C-B) has changed in a number of ways. It has three
+ new commands:
+
+ F Saves the buffer in a file, if there are unsaved changes.
+ M-~ Turns off the buffer-modified flag.
+ N Restores all Ignored files to the display list.
+
+ In addition, Backspace has been made equivalent to Rubout. Also, the
+ commands D,U,K,I,Rubout,Backspace,F,N, and M-~ all obey a numeric argument
+ of either sign. The Buffer Browser now starts up pointing at the
+ previously-current buffer. After performing a sort command, the cursor now
+ continues to point at the same buffer.
+
+* DIRED (the File browser) has been changed in a number of ways. One
+ SIGNIFICANT INCOMPATIBLE change is that the K and C-K commands now delete
+ the file immediately and remove the file from the display (instead of just
+ marking them for later deletion). In addition, there are two new commands:
+
+ I (Ignore File) Removes the file from the display list, without
+ any effect on the actual file.
+ N Restores all Ignored files to the display list.
+
+ In addition, Backspace has been made equivalent to Rubout. Also, the
+ commands D,U,K,I,Rubout,Backspace,and N all obey a numeric argument of
+ either sign. The sort-by-filename procedure has been changed to sort
+ version numbers in numerical, rather than lexicographic order. When Dired
+ starts, the files are sorted using this procedure, instead of leaving them
+ in the order returned by the file system. After performing a sort command,
+ the cursor now continues to point at the same file. Dired will now
+ automatically kill any buffer it had created for viewing a file as soon as
+ you view a new file or exit Dired, unless the buffer contains unsaved
+ changes.
+
+* M-X Insert File now takes as its default the file name used in the previous
+ M-X Insert File command. This behavior matches EMACS.
+
+* Lisp-E (and Lisp-D, a new command) now insert a free EOL at the end of the
+ buffer, if needed, whenever the buffer-modified flag is set. Previously the
+ free EOL was inserted only when the current position was at the end of the
+ buffer, regardless of the state of the buffer-modified flag.
+
+New commands:
+
+ M-X Count Occurrences (aka M-X How Many)
+ M-X Delete Matching Lines (aka M-X Flush Lines)
+ M-X Delete Non-Matching Lines (aka M-X Keep Lines)
+ M-X Insert Date (not on 9836 yet)
+ M-X Kill Some Buffers
+ M-X Rename Buffer
+ M-X Revert File
+ M-X Set Key
+ M-X Set Visited Filename
+
+ Lisp-D (in Lisp mode) executes the current defun (if the current position is
+ within a defun) or executes from the current position (otherwise).
+
+Improvements:
+
+* NMODE now checks the system's terminal type every time it is restarted.
+ This change allows you to use an NMODE that was detached from one kind
+ of terminal and later attached on another kind of terminal.
+
+* Fixed bug in Dec-20 version: Find File could leave around an empty file if
+ you tried to find a nonexistent file in a directory that allows you to
+ create new files but whose default file protection does not allow you to
+ delete them. (On the Dec-20, Find File determines the name of a new file by
+ writing an empty file and immediately deleting it.)
+
+* A soft-key feature has been added, intended primarily for use on the 9836.
+ The command Esc-/ will read a soft-key designator (a single character in the
+ range '0' to 'W') and execute the definition of the corresponding softkey
+ (numbered 0 through 39). Softkeys are defined using the function
+ (nmode-define-softkey n fcn label-string), where n is the softkey number and
+ fcn is either NIL (for undefined), a function ID (which will be invoked), or a
+ string (which will be executed as if typed at the keyboard). NMODE on the
+ 9836 sets up the keyboard so that the function keys K0 through K9 send an
+ appropriate Esc-/ sequence (using shift and control as modifiers).
+
+* The two message/prompt lines at the bottom of the screen are now sometimes
+ updated independently of the rest of the screen. This change makes writing
+ messages and prompts more efficient.
+-------
+25-Feb-83 11:03:02-PST,2247;000000000000
+Date: 25 Feb 1983 1059-PST
+From: AS at HP-HULK
+Subject: recent NMODE changes
+To: psl-news
+
+Recent NMODE changes (14-Feb-1983 through 24-Feb-1983):
+
+Bugs fixed:
+
+* Dired wasn't garbage collecting old buffers used to view files, as had been
+ intended.
+* M-Z would enter an infinite loop on a paragraph at the end of the buffer
+ whose last line had no terminating Newline character.
+* When filling with a fill prefix, the cursor would sometimes be placed
+ improperly.
+* M-X Rename Buffer didn't convert the new buffer name to upper case.
+* The Permanent Goal Column feature (Set by C-X C-N) didn't work.
+* The incremental search commands did not handle bit-prefix characters
+ (e.g., the Meta prefix) properly. Typing a bit-prefix character would
+ terminate the search, but then the bit-prefix character would not be
+ recognized as such.
+* When executing Lisp from the OUTPUT buffer in one-window mode, the window
+ would not be adjusted if the other (unexposed) window also was attached to
+ the OUTPUT buffer.
+* The cursor was being positioned improperly when the window was scrolled
+ horizontally.
+
+Performance Improvements:
+
+* The efficiency of Lisp printing to the OUTPUT buffer has been improved
+ significantly through the use of internal buffering. One visible change is
+ that the screen is updated only after an entire line is written.
+* Insertion into text buffers has been speeded up by eliminating some
+ unnecessary string consing that occurred when inserting at the beginning or
+ end of a line (which is very common).
+
+EMACS Compatibility Enhancements:
+
+* M-X Set Visited Filename now converts the new name to the true name of the
+ file, if possible.
+* M-X Rename Buffer now checks for attempts to use the name of an existing
+ buffer.
+* Query-Replace now terminates when you type a character that is not a
+ query-replace command and rereads that character.
+* C-M-D has been extended to obey the command argument (either positive
+ or negative). It still differs from the EMACS C-M-D command in that it
+ always stays within the current enclosing list.
+* M-( has been extended to obey the command argument.
+* The M-) command (Move Over Paren) has been implemented.
+-------
+18-Mar-83 16:29:39-PST,6873;000000000000
+Date: 18 Mar 1983 1626-PST
+From: AS at HP-HULK
+Subject: recent NMODE changes
+To: psl-news
+cc: AS
+
+Recent NMODE changes (28-Feb-1983 through 16-Mar-1983):
+
+(Not all of these changes have been installed on all systems.)
+
+Bugs Fixed:
+
+* NMODE will now refresh the display and clear the message line when it
+ is interrupted and restarted.
+
+* The C-X D command would list the connected directory, rather than
+ the directory of the current file, if the current file name contained a
+ device specification but no directory specification (e.g., "FOO:BAR.TXT").
+
+* The 9836 color screen driver would crash if it tried to display a buffer
+ containing characters with integer values greater than 127.
+
+* The command to write the contents of the current screen to a file would
+ always write the main screen, even when NMODE was using multiple screens.
+
+* NMODE would crash if it encountered a file (on the 9836) with an
+ "invalid" file name (e.g., "FOO.BAR.TEXT").
+
+Performance Improvements:
+
+* File I/O on the 9836 has been speeded up greatly.
+
+* The 9836 color screen driver has been modified to speed up refresh.
+
+* Keyboard interaction has been speeded up significantly following the
+ discovery that certain keyboard input functions were not compiled.
+
+New Commands:
+
+* DIRED is now available on the 9836.
+
+* There is a new command, M-X List Browsers, which brings up a Browser Browser
+ showing all existing browsers (i.e., the Buffers browser and, on the 9836,
+ the NMODE Documentation browser), as well as all potential browsers (i.e.,
+ File Directory browsers). Potential browsers are displayed as prototype
+ browsers. Commands are provided to view documentation on a browser (or
+ prototype) and to enter a browser (or instantiate a prototype).
+
+* There is a new command, M-X Print Buffer, also available as C-X C-P,
+ which prints the contents of the current buffer in a format suitable for
+ printing devices. A file/device name is requested from the user; the
+ default is LPT: on the Dec-20 and PRINTER: on the 9836. This command
+ translates tabs to spaces and control characters to ^X form. Note: using
+ C-X C-W on the 9836 to write the buffer to PRINTER: does not work.
+
+* A Browse command has been added to Dired. This command allows one to
+ browse thru a subdirectory.
+
+* A Create command has been added to the Buffer Browser to create
+ new buffers. A Create command has been added to Dired to create
+ new files.
+
+Changes:
+
+* The command to write the contents of the current screen to a file has
+ been changed from C-X P to M-X Write Screen. In addition, this
+ command now has its own default file name.
+
+* The Buffer Browser (C-X C-B) now always displays all named buffers.
+ Previously, it would ignore buffers whose names began with a "+", unless an
+ argument was specified to the C-X C-B command. The use of "+" to name
+ "internal" buffers has been replaced by the use of "unnamed" buffers.
+
+* A number of changes have been made to the common browser mechanism, which
+ affect the behavior of all browsers (Buffers, Files, Documentation,
+ and the Browser Browser):
+
+ Browsers now use "unnamed" buffers (a new NMODE feature) to display the
+ lists of items. This change means that browsers no longer appear in the
+ Buffer Browser list of buffers and cannot be selected using C-X B. Instead,
+ the Browser Browser (M-X List Browsers) can be used to display all existing
+ browsers and to select an existing browser.
+
+ The Buffer Browser and the Browser Browser now update themselves
+ automatically under various circumstances, most notably when you enter or
+ select them, to take account of any items created or deleted since the
+ browser was last updated. The File Directory Browser (DIRED) does not
+ update itself automatically, since that operation would be too
+ time-consuming. However, it supports a new command, Look (L), which causes
+ it to re-read the specified directory.
+
+ When you attempt to create a browser, NMODE will first look for an existing
+ browser with the desired information. If an existing browser is found, it
+ will be reentered. As described above, the Buffers and Browser browsers
+ update themselves automatically when they are entered. When a File
+ Directory browser is reused, it also updates itself automatically.
+
+ Quitting a browser no longer kills the browser, but merely returns the
+ display to its previous state. This change encourages reentering existing
+ browsers instead of unnecessarily creating new ones. It is possible to kill
+ a browser using the Kill (K) command of the Browser Browser, if you
+ desperately need to reclaim the space taken up by a browser.
+
+ Quitting a browser now does a better job of restoring the previous screen
+ contents.
+
+ The help line at the bottom of the screen is now automatically maintained.
+ Previously, it was displayed only when the browser was entered and would not
+ be restored when returning to the browser from another window or buffer.
+ The ? command (which used to refresh the help line) now displays a buffer
+ of documentation about the browser.
+
+ Browsers now do a better job of managing the screen, especially when the
+ split-screen option is enabled. (When the split-screen option is enabled,
+ the top window is used to display the list of items, and the bottom window
+ is used to display a particular item. The split-screen option is enabled by
+ including the statement (SETF BROWSER-SPLIT-SCREEN T) in your NMODE.INIT
+ file. Split-screen will probably become the default soon.) When the
+ split-screen option is enabled, each browser will endeavor to ensure that
+ the bottom window displays the most-recently selected item. When there is
+ no selected item, the browser will display documentation in the bottom
+ window (using an "unnamed" buffer).
+
+ The window label line for a browser now displays additional information
+ about the browser. For example, the label line for a File Directory Browser
+ displays the name of the directory. In addition, the label line for a
+ browser documentation buffer displays a descriptive sentence.
+
+* A number of incompatible changes have been made to the common browser
+ mechanism to support the above changes. If you have written your own
+ browser using these mechanisms, you should consult the sources of the
+ standard browsers to see the kinds of changes you should make. (See
+ Buffer-Browser.SL, Dired.SL, Doc.SL, Browser.SL, and Browser-Support.SL, all
+ in the PN: directory.)
+
+* Another incompatible change: the function buffer-create-unselectable
+ has been replaced by the function create-unnamed-buffer, which (as the name
+ suggests) does not take a name-of-buffer argument. (See PN:Buffers.SL.)
+-------
ADDED psl-1983/3-1/psl/nmode-chart.txt
Index: psl-1983/3-1/psl/nmode-chart.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/nmode-chart.txt
@@ -0,0 +1,252 @@
+NMODE command list (Lisp mode) - 25 January 1983
+--------------------------------------------------------
+) INSERT-CLOSING-BRACKET
+Backspace DELETE-BACKWARD-HACKING-TABS-COMMAND
+C-% REPLACE-STRING-COMMAND
+C-( BACKWARD-UP-LIST-COMMAND
+C-) FORWARD-UP-LIST-COMMAND
+C-- NEGATIVE-ARGUMENT
+C-0 ARGUMENT-DIGIT
+C-1 ARGUMENT-DIGIT
+C-2 ARGUMENT-DIGIT
+C-3 ARGUMENT-DIGIT
+C-4 ARGUMENT-DIGIT
+C-5 ARGUMENT-DIGIT
+C-6 ARGUMENT-DIGIT
+C-7 ARGUMENT-DIGIT
+C-8 ARGUMENT-DIGIT
+C-9 ARGUMENT-DIGIT
+C-< MARK-BEGINNING-COMMAND
+C-= WHAT-CURSOR-POSITION-COMMAND
+C-> MARK-END-COMMAND
+C-? HELP-DISPATCH
+C-@ SET-MARK-COMMAND
+C-A MOVE-TO-START-OF-LINE-COMMAND
+C-B MOVE-BACKWARD-CHARACTER-COMMAND
+C-D DELETE-FORWARD-CHARACTER-COMMAND
+C-E MOVE-TO-END-OF-LINE-COMMAND
+C-F MOVE-FORWARD-CHARACTER-COMMAND
+C-G NMODE-ABORT-COMMAND
+C-K KILL-LINE
+C-L NMODE-REFRESH-COMMAND
+C-M-( BACKWARD-UP-LIST-COMMAND
+C-M-) FORWARD-UP-LIST-COMMAND
+C-M-- NEGATIVE-ARGUMENT
+C-M-0 ARGUMENT-DIGIT
+C-M-1 ARGUMENT-DIGIT
+C-M-2 ARGUMENT-DIGIT
+C-M-3 ARGUMENT-DIGIT
+C-M-4 ARGUMENT-DIGIT
+C-M-5 ARGUMENT-DIGIT
+C-M-6 ARGUMENT-DIGIT
+C-M-7 ARGUMENT-DIGIT
+C-M-8 ARGUMENT-DIGIT
+C-M-9 ARGUMENT-DIGIT
+C-M-@ MARK-FORM-COMMAND
+C-M-A MOVE-BACKWARD-DEFUN-COMMAND
+C-M-B MOVE-BACKWARD-FORM-COMMAND
+C-M-Backspace MARK-DEFUN-COMMAND
+C-M-D DOWN-LIST
+C-M-E END-OF-DEFUN-COMMAND
+C-M-F MOVE-FORWARD-FORM-COMMAND
+C-M-H MARK-DEFUN-COMMAND
+C-M-I LISP-TAB-COMMAND
+C-M-K KILL-FORWARD-FORM-COMMAND
+C-M-L SELECT-PREVIOUS-BUFFER-COMMAND
+C-M-M BACK-TO-INDENTATION-COMMAND
+C-M-N MOVE-FORWARD-LIST-COMMAND
+C-M-O SPLIT-LINE-COMMAND
+C-M-P MOVE-BACKWARD-LIST-COMMAND
+C-M-Q LISP-INDENT-SEXPR
+C-M-R REPOSITION-WINDOW-COMMAND
+C-M-Return BACK-TO-INDENTATION-COMMAND
+C-M-Rubout KILL-BACKWARD-FORM-COMMAND
+C-M-T TRANSPOSE-FORMS
+C-M-Tab LISP-TAB-COMMAND
+C-M-U BACKWARD-UP-LIST-COMMAND
+C-M-V SCROLL-OTHER-WINDOW-COMMAND
+C-M-W APPEND-NEXT-KILL-COMMAND
+C-M-X M-X-PREFIX
+C-M-[ MOVE-BACKWARD-DEFUN-COMMAND
+C-M-\ LISP-INDENT-REGION-COMMAND
+C-M-] END-OF-DEFUN-COMMAND
+C-N MOVE-DOWN-EXTENDING-COMMAND
+C-O OPEN-LINE-COMMAND
+C-P MOVE-UP-COMMAND
+C-Q INSERT-NEXT-CHARACTER-COMMAND
+C-R REVERSE-SEARCH-COMMAND
+C-Rubout DELETE-BACKWARD-HACKING-TABS-COMMAND
+C-S INCREMENTAL-SEARCH-COMMAND
+C-Space SET-MARK-COMMAND
+C-T TRANSPOSE-CHARACTERS-COMMAND
+C-U UNIVERSAL-ARGUMENT
+C-V NEXT-SCREEN-COMMAND
+C-W KILL-REGION
+C-X C-X-PREFIX
+C-X . SET-FILL-PREFIX-COMMAND
+C-X 1 ONE-WINDOW-COMMAND
+C-X 2 TWO-WINDOWS-COMMAND
+C-X 3 VIEW-TWO-WINDOWS-COMMAND
+C-X 4 VISIT-IN-OTHER-WINDOW-COMMAND
+C-X < SCROLL-WINDOW-LEFT-COMMAND
+C-X = WHAT-CURSOR-POSITION-COMMAND
+C-X > SCROLL-WINDOW-RIGHT-COMMAND
+C-X A APPEND-TO-BUFFER-COMMAND
+C-X B SELECT-BUFFER-COMMAND
+C-X C-B BUFFER-BROWSER-COMMAND
+C-X C-F FIND-FILE-COMMAND
+C-X C-L LOWERCASE-REGION-COMMAND
+C-X C-N SET-GOAL-COLUMN-COMMAND
+C-X C-O DELETE-BLANK-LINES-COMMAND
+C-X C-S SAVE-FILE-COMMAND
+C-X C-T TRANSPOSE-LINES
+C-X C-U UPPERCASE-REGION-COMMAND
+C-X C-V VISIT-FILE-COMMAND
+C-X C-W WRITE-FILE-COMMAND
+C-X C-X EXCHANGE-POINT-AND-MARK
+C-X C-Z NMODE-EXIT-TO-SUPERIOR
+C-X D DIRED-COMMAND
+C-X E EXCHANGE-WINDOWS-COMMAND
+C-X F SET-FILL-COLUMN-COMMAND
+C-X G GET-REGISTER-COMMAND
+C-X H MARK-WHOLE-BUFFER-COMMAND
+C-X K KILL-BUFFER-COMMAND
+C-X O OTHER-WINDOW-COMMAND
+C-X P WRITE-SCREEN-PHOTO-COMMAND
+C-X Rubout BACKWARD-KILL-SENTENCE-COMMAND
+C-X T TRANSPOSE-REGIONS
+C-X V NMODE-INVERT-VIDEO
+C-X X PUT-REGISTER-COMMAND
+C-X ^ GROW-WINDOW-COMMAND
+C-Y INSERT-KILL-BUFFER
+C-] LISP-PREFIX
+Esc-4 MOVE-BACKWARD-WORD-COMMAND
+Esc-5 MOVE-FORWARD-WORD-COMMAND
+Esc-A MOVE-UP-COMMAND
+Esc-B MOVE-DOWN-COMMAND
+Esc-C MOVE-FORWARD-CHARACTER-COMMAND
+Esc-D MOVE-BACKWARD-CHARACTER-COMMAND
+Esc-F MOVE-TO-BUFFER-END-COMMAND
+Esc-J NMODE-FULL-REFRESH
+Esc-L OPEN-LINE-COMMAND
+Esc-M KILL-LINE
+Esc-P DELETE-FORWARD-CHARACTER-COMMAND
+Esc-S SCROLL-WINDOW-UP-LINE-COMMAND
+Esc-T SCROLL-WINDOW-DOWN-LINE-COMMAND
+Esc-U SCROLL-WINDOW-UP-PAGE-COMMAND
+Esc-V SCROLL-WINDOW-DOWN-PAGE-COMMAND
+Esc-h MOVE-TO-BUFFER-START-COMMAND
+Escape ESC-PREFIX
+Lisp-? LISP-HELP-COMMAND
+Lisp-A LISP-ABORT-COMMAND
+Lisp-B LISP-BACKTRACE-COMMAND
+Lisp-C LISP-CONTINUE-COMMAND
+Lisp-E EXECUTE-FORM-COMMAND
+Lisp-L EXIT-NMODE
+Lisp-Q LISP-QUIT-COMMAND
+Lisp-R LISP-RETRY-COMMAND
+Lisp-Y YANK-LAST-OUTPUT-COMMAND
+M-% QUERY-REPLACE-COMMAND
+M-' UPCASE-DIGIT-COMMAND
+M-( INSERT-PARENS
+M-- NEGATIVE-ARGUMENT
+M-/ HELP-DISPATCH
+M-0 ARGUMENT-DIGIT
+M-1 ARGUMENT-DIGIT
+M-2 ARGUMENT-DIGIT
+M-3 ARGUMENT-DIGIT
+M-4 ARGUMENT-DIGIT
+M-5 ARGUMENT-DIGIT
+M-6 ARGUMENT-DIGIT
+M-7 ARGUMENT-DIGIT
+M-8 ARGUMENT-DIGIT
+M-9 ARGUMENT-DIGIT
+M-; INSERT-COMMENT-COMMAND
+M-< MOVE-TO-BUFFER-START-COMMAND
+M-> MOVE-TO-BUFFER-END-COMMAND
+M-? HELP-DISPATCH
+M-@ MARK-WORD-COMMAND
+M-A BACKWARD-SENTENCE-COMMAND
+M-B MOVE-BACKWARD-WORD-COMMAND
+M-Backspace MARK-DEFUN-COMMAND
+M-C UPPERCASE-INITIAL-COMMAND
+M-D KILL-FORWARD-WORD-COMMAND
+M-E FORWARD-SENTENCE-COMMAND
+M-F MOVE-FORWARD-WORD-COMMAND
+M-G FILL-REGION-COMMAND
+M-H MARK-PARAGRAPH-COMMAND
+M-I TAB-TO-TAB-STOP-COMMAND
+M-K KILL-SENTENCE-COMMAND
+M-L LOWERCASE-WORD-COMMAND
+M-M BACK-TO-INDENTATION-COMMAND
+M-Q FILL-PARAGRAPH-COMMAND
+M-R MOVE-TO-SCREEN-EDGE-COMMAND
+M-Return BACK-TO-INDENTATION-COMMAND
+M-Rubout KILL-BACKWARD-WORD-COMMAND
+M-S CENTER-LINE-COMMAND
+M-T TRANSPOSE-WORDS
+M-Tab TAB-TO-TAB-STOP-COMMAND
+M-U UPPERCASE-WORD-COMMAND
+M-V PREVIOUS-SCREEN-COMMAND
+M-W COPY-REGION
+M-X M-X-PREFIX
+M-X Append to File APPEND-TO-FILE-COMMAND
+M-X Apropos APROPOS-COMMAND
+M-X Auto Fill Mode AUTO-FILL-MODE-COMMAND
+M-X Count Occurrences COUNT-OCCURRENCES-COMMAND
+M-X DIRED EDIT-DIRECTORY-COMMAND
+M-X Delete File DELETE-FILE-COMMAND
+M-X Delete Matching Lines DELETE-MATCHING-LINES-COMMAND
+M-X Delete Non-Matching Lines DELETE-NON-MATCHING-LINES-COMMAND
+M-X Delete and Expunge File DELETE-AND-EXPUNGE-FILE-COMMAND
+M-X Edit Directory EDIT-DIRECTORY-COMMAND
+M-X Execute Buffer EXECUTE-BUFFER-COMMAND
+M-X Execute File EXECUTE-FILE-COMMAND
+M-X Find File FIND-FILE-COMMAND
+M-X Flush Lines DELETE-MATCHING-LINES-COMMAND
+M-X How Many COUNT-OCCURRENCES-COMMAND
+M-X Insert Buffer INSERT-BUFFER-COMMAND
+M-X Insert Date INSERT-DATE-COMMAND
+M-X Insert File INSERT-FILE-COMMAND
+M-X Keep Lines DELETE-NON-MATCHING-LINES-COMMAND
+M-X Kill Buffer KILL-BUFFER-COMMAND
+M-X Kill File DELETE-FILE-COMMAND
+M-X Kill Some Buffers KILL-SOME-BUFFERS-COMMAND
+M-X Lisp Mode LISP-MODE-COMMAND
+M-X List Buffers BUFFER-BROWSER-COMMAND
+M-X Make Space NMODE-GC
+M-X Prepend to File PREPEND-TO-FILE-COMMAND
+M-X Query Replace QUERY-REPLACE-COMMAND
+M-X Rename Buffer RENAME-BUFFER-COMMAND
+M-X Replace String REPLACE-STRING-COMMAND
+M-X Revert File REVERT-FILE-COMMAND
+M-X Save All Files SAVE-ALL-FILES-COMMAND
+M-X Select Buffer SELECT-BUFFER-COMMAND
+M-X Set Key SET-KEY-COMMAND
+M-X Set Visited Filename SET-VISITED-FILENAME-COMMAND
+M-X Start Scripting START-SCRIPTING-COMMAND
+M-X Start Timing NMODE START-TIMING-COMMAND
+M-X Stop Scripting STOP-SCRIPTING-COMMAND
+M-X Stop Timing NMODE STOP-TIMING-COMMAND
+M-X Text Mode TEXT-MODE-COMMAND
+M-X Undelete File UNDELETE-FILE-COMMAND
+M-X Visit File VISIT-FILE-COMMAND
+M-X Write File WRITE-FILE-COMMAND
+M-X Write Region WRITE-REGION-COMMAND
+M-Y UNKILL-PREVIOUS
+M-Z FILL-COMMENT-COMMAND
+M-[ BACKWARD-PARAGRAPH-COMMAND
+M-\ DELETE-HORIZONTAL-SPACE-COMMAND
+M-] FORWARD-PARAGRAPH-COMMAND
+M-^ DELETE-INDENTATION-COMMAND
+M-~ BUFFER-NOT-MODIFIED-COMMAND
+Newline INDENT-NEW-LINE-COMMAND
+Return RETURN-COMMAND
+Rubout DELETE-BACKWARD-HACKING-TABS-COMMAND
+Tab LISP-TAB-COMMAND
+] INSERT-CLOSING-BRACKET
+
+C-\ "Meta" prefix on Dec-20
+C-[ (Escape) "Meta" prefix on 9836
+C-^ "Control" prefix
+C-Z "Control-Meta" prefix
ADDED psl-1983/3-1/psl/nmode-customizing.txt
Index: psl-1983/3-1/psl/nmode-customizing.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/nmode-customizing.txt
@@ -0,0 +1,153 @@
+How to customize NMODE
+Alan Snyder
+24 September 1982
+-------------------------------------------------------------------------------
+
+This memo explains how to customize NMODE by redefining the effect of input
+keystrokes. NMODE is customized by executing Lisp forms. These forms may be
+executed directly within NMODE (using Lisp-E), or may be stored in an INIT
+file, which is read by NMODE when it first starts up. The name of the INIT
+file read by NMODE is "NMODE.INIT" in the user's home directory.
+
+There are three concepts that must be understood to customize NMODE: Commands,
+Functions, and Modes.
+
+1) Commands. The effect of given keystroke or sequence of keystrokes in
+NMODE is based on a mapping between "commands" and "functions".
+A "command" may be either a single "extended character" or a sequence
+of characters. An extended character is a 9-bit character with
+distinct "Control" and "Meta" bits. Thus "C-M-A" is a single "extended
+character", even though on many terminals you have to use two keystrokes
+to enter it. Extended characters are specified using the macro X-CHAR,
+for example:
+
+ (x-char A) the letter "A" (upper case)
+ (x-char C-F) Control-F
+ (x-char C-M-Z) Control-Meta-Z
+ (x-char CR) Carriage-Return
+ (x-char TAB) Tab
+ (x-char BACKSPACE) Backspace
+ (x-char NEWLINE) Newline
+ (x-char RUBOUT) Rubout
+ (x-char C-M-RUBOUT) Control-Meta-Rubout
+
+(The macros described in this section are defined in the load module
+EXTENDED-CHAR.) It is important to note that on most terminals, some Ascii
+control characters are mapped to extended "Control" characters and some aren't.
+Those that aren't are: Backspace, CR, Newline, Tab, and Escape. Even if you
+type "CNTL-I" on the keyboard, you will get "Tab" and not "Control-I". The
+remaining Ascii control characters are mapped to extended "Control" characters,
+thus typing "CNTL-A" on the keyboard gives "Control-A".
+
+As mentioned above, a command can be a sequence of characters. There are two
+forms: Prefix commands and Extended commands.
+
+Prefix commands: A prefix command consists of two characters, the first of
+which is a defined "prefix character". In NMODE, there are 3 predefined prefix
+characters: C-X, ESC, and C-]. Prefix commands are specified using the X-CHARS
+macro, for example:
+
+ (x-chars C-X C-F)
+ (x-chars ESC A)
+ (x-chars C-] E)
+
+Extended commands: An extended command consists of the character M-X and a
+string. Extended commands are defined using the M-X macro, for example:
+
+ (M-X "Lisp Mode")
+ (M-X "Revert File")
+
+The case of the letters in the string is irrelevant, except to specify how the
+command name will be displayed when "completion" is used by the user. By
+convention, the first letter of each word in an extended command name is
+capitalized.
+
+2) Functions. NMODE commands are implemented by PSL functions. By convention,
+most (but not all) PSL functions that implement NMODE commands have names
+ending with "-COMMAND", for example, MOVE-FORWARD-CHARACTER-COMMAND.
+
+An NMODE command function should take no arguments. The function can perform
+its task using a large number of existing support functions; see PN:BUFFER.SL
+and PN:MOVE-COMMANDS.SL for examples. A command function can determine the
+command argument (given by C-U) by inspecting global variables:
+
+ nmode-command-argument: the numeric value (default: 1)
+ nmode-command-argument-given: T if the user specified an argument
+ nmode-command-number-given: T if the user typed digits in the argument
+
+See the files PN:MOVE-COMMANDS.SL, PN:LISP-COMMANDS.SL, and PN:COMMANDS.SL for
+many examples of NMODE command functions.
+
+3) Modes. The mapping between commands and functions is dependent on the
+current "mode". Examples of existing modes are "Text Mode", which is the basic
+mode for text editing, "Lisp Mode", which is an extension of "Text Mode" for
+editing and executing Lisp code, and "Dired Mode", which is a specialized mode
+for the Directory Editor Subsystem.
+
+A mode is defined by a list of Lisp forms which are evaluated to determine the
+state of a Dispatch Table. The Dispatch Table is what is actually used to map
+from commands to functions. Every time the user selects a new buffer, the
+Dispatch Table is cleared and the Lisp forms defining the mode for the new
+buffer are evaluated to fill the Dispatch Table. The forms are evaluated in
+reverse order, so that the first form is evaluated last. Thus, any command
+definitions made by one form supercede those made by forms appearing after it
+in the list.
+
+Two functions are commonly invoked by mode-defining forms: NMODE-ESTABLISH-MODE
+and NMODE-DEFINE-COMMANDS. NMODE-ESTABLISH-MODE takes one argument, a list of
+mode defining forms, and evaluates those forms. Thus, NMODE-ESTABLISH-MODE can
+be used to define one mode in terms of (as an extension of or a modification
+to) another mode.
+
+NMODE-DEFINE-COMMANDS takes one argument, a list of pairs, where each pair
+consists of a COMMAND and a FUNCTION. This form of list is called a "command
+list". Command lists are not used directly to map from commands to functions.
+Instead, NMODE-DEFINE-COMMANDS reads the command list it is given and for each
+COMMAND-FUNCTION pair in the command list (in order), it alters the Dispatch
+Table to map the specified COMMAND to the corresponding FUNCTION.
+
+Note that as a convenience, whenever you define an "upper case" command, the
+corresponding "lower case" command is also defined to map to the same function.
+Thus, if you define C-M-A, you automatically define C-M-a to map to the same
+function. If you want the lower case command to map to a different function,
+you must define the lower case command "after" defining the upper case command.
+
+The usual technique for modifying one or more existing modes is to modify one
+of the command lists given to NMODE-DEFINE-COMMANDS. The file PN:MODE-DEFS.SL
+contains the definition of most predefined NMODE command lists, as well as the
+definition of most predefined modes. To modify a mode or modes, you must alter
+one or more command lists by adding (or perhaps removing) entries. Command
+lists are manipulated using two functions:
+
+ (add-to-command-list list-name command func)
+ (remove-from-command-list list-name command)
+
+Here are some examples:
+
+(add-to-command-list
+ 'text-command-list (x-char BACKSPACE) 'delete-backward-character-command)
+
+(add-to-command-list
+ 'lisp-command-list (x-char BACKSPACE) 'delete-backward-hacking-tabs-command)
+
+(remove-from-command-list
+ 'read-only-text-command-list (x-char BACKSPACE))
+
+ [The above forms change BACKSPACE from being the same as C-B to being
+ the same as RUBOUT.]
+
+(add-to-command-list
+ 'read-only-text-command-list (x-char M-@) 'set-mark-command)
+
+ [The above form makes M-@ set the mark.]
+
+(add-to-command-list
+ 'read-only-terminal-command-list (x-chars ESC Y) 'print-buffer-names-command)
+
+ [The above form makes Esc-Y print a list of all buffer names. Esc-Y is
+ sent by HP264X terminals when the "Display Functions" key is hit.]
+
+Note that these functions change only the command lists, not the Dispatch Table
+which is actually used to map from commands to functions. To cause the
+Dispatch Table to be updated to reflect any changes in the command lists, you
+must invoke the function NMODE-ESTABLISH-CURRENT-MODE.
ADDED psl-1983/3-1/psl/nmode-emacs.txt
Index: psl-1983/3-1/psl/nmode-emacs.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/nmode-emacs.txt
@@ -0,0 +1,207 @@
+NMODE for EMACS users - A quick comparison
+Alan Snyder (2 February 1983)
+--------------------------------------------------------------------------------
+Introduction
+
+If you are familiar with EMACS on the Dec-20, then you should have little
+trouble using NMODE, since NMODE is largely compatible with EMACS. If you are
+using an HP terminal or the 9836 VT52 emulator, then you can use the cursor
+keys and other special function keys with NMODE. There are some differences
+between NMODE and EMACS, and these are described below. What you are most
+likely to find is that there are some EMACS commands that have not (yet) been
+implemented in NMODE; section I below lists the most significant of these. (We
+are not promising to implement all EMACS commands, but if there is some command
+you just can't live without, let us know, or volunteer to implement it
+yourself!) Section II describes areas of inconsistency between NMODE and
+EMACS; some of these are deficiencies in NMODE that may someday be fixed,
+others are regarded as features of NMODE, and others are just plain differences
+which are not likely to go away. Section III lists other known deficiencies in
+NMODE, many of which we hope to fix. Section IV summarizes those features of
+NMODE that EMACS doesn't have.
+
+--------------------------------------------------------------------------------
+I. Things that EMACS has that NMODE doesn't (an incomplete list)
+
+* Auto Save
+* Help Character (C-_)
+* Many 'options' variables (NMODE has almost none)
+* Most Minor Modes, including:
+ Word Abbrev Mode
+ Auto Arg Mode
+ Atom Word Mode
+ Overwrite Mode
+ Indent Tabs Mode
+* The Tags Package
+ M-. (find tag)
+ M-X Visit Tag Table
+ M-X Tags Search
+* Local Modes specification in files
+* Syntax Table
+* Miscellaneous commands:
+ C-M-G (grind form)
+ M-= (count lines region)
+ C-M-Z (exit recursive edit)
+ M-Esc (Execute Minibuffer)
+ C-X Esc (ReExecute Minibuffer)
+* Mail Commands:
+ C-X M (Send Mail)
+ C-X R (Read Mail)
+ M-X Check Mail
+* Comment commands:
+ C-; (indent for comment)
+ C-M-; (kill comment)
+ Return (skip trailing comment terminator)
+ C-X ; (set comment column)
+ M-N (down comment line)
+ M-P (up comment line)
+ M-J or M-Linefeed (indent new comment line)
+* Indentation commands:
+ C-X Tab (indent rigidly)
+* Text-Processor commands:
+ M-# (change font word)
+ M-_ (underline word)
+ C-X # (change font region)
+ C-X _ (underline region)
+* File commands:
+ C-X C-D (directory display)
+ C-X C-Q (set file read only)
+ M-X Clean Directory
+ M-X Copy File
+ M-X List Files
+ M-X Reap File
+ M-X Rename File
+ M-X View Directory
+ M-X View File
+* Page commands:
+ C-X [ (previous page)
+ C-X ] (next page)
+ C-X L (count lines page)
+ C-X C-P (mark page)
+ M-X What Page
+* Many M-X commands, including:
+ M-X Compare Windows
+ M-X List Matching Lines
+ M-X Occur
+ M-X Tabify
+ M-X Untabify
+ M-X View Buffer
+* Keyboard macros
+ C-X (
+ C-X )
+ C-X E
+ C-X Q
+ M-X Name Kbd Macro
+ M-X Write Kbd Macro
+* Command Libraries
+ M-X Kill Libraries
+ M-X List Library
+ M-X List Loaded Libraries
+ M-X Load Library
+ M-X Run Library
+* Spelling Correction (M-$)
+* Narrowing:
+ C-X N (Narrow Bounds to Region)
+ C-X P (Narrow Bounds to Page)
+ C-X W (Widen Bounds)
+
+--------------------------------------------------------------------------------
+II. Inconsistencies between NMODE and EMACS
+
+ A. NMODE Features
+
+* NMODE DIRED 'E' and 'V' commands allow editing of the file. These commands
+ do not use "recursive editing": arbitrary switching between buffers and
+ windows is allowed; C-M-L returns to the previous buffer (not C-M-Z).
+* NMODE has a separate ring of marks for each buffer.
+* NMODE C-X C-B brings up a buffer browser, instead of just listing the buffers.
+* NMODE's Lisp parsing commands recognize comments, string literals,
+ character literals, etc. For this reason, the commands C-M-N (Forward
+ List) and C-M-P (Backward List) are not really needed, although they
+ are presently still provided.
+* When the fill prefix is non-null, NMODE treats lines not beginning with the
+ fill prefix as delimiting a paragraph (ZMACS does this, too). EMACS will
+ treat a single preceding line without the fill prefix as the first line of the
+ paragraph and will insert the prefix onto that line when you do M-Q.
+* NMODE's incremental search allows you to rubout the old search string
+ (inserted by an immediate C-S or C-R) one character at a time, instead of
+ all at once (like EMACS).
+
+ B. NMODE Deficiencies (may be fixed someday)
+
+* NMODE Query-Replace does not alter the case of the replacement string,
+ does not support word search, does not support recursive edit.
+* NMODE does not have a ring buffer of buffers; the default buffer for C-X B
+ may be different than in EMACS.
+* NMODE's incremental search does not escape to a non-incremental search,
+ does not do word searches, always ignores case.
+* No completion on File Name input.
+* NMODE doesn't set the Mode from the first line of a file.
+* In NMODE, M-digit does not enter autoarg mode (i.e., if you then type a
+ digit (without Meta), the digit is inserted.
+* NMODE search commands never set the Mark.
+* NMODE lacks true read-only buffers.
+* NMODE's Dired does not support C, H, or N. Dired commands do not take
+ a command argument.
+* NMODE's Kill Buffer commands ask for confirmation rather than offering
+ to write out the buffer.
+* NMODE's C-M-Q command does not use the command argument.
+* NMODE's C-X H command does not use the command argument.
+* NMODE's M-< command does not use the command argument.
+* NMODE's M-> command does not use the command argument.
+* NMODE's C-X C-Z command does not save any files.
+* NMODE's M-X Make Space command does not offer to delete buffers, kill
+ rings, etc.
+* NMODE's C-M-R command works only in Lisp mode (it doesn't do paragraphs).
+* NMODE's Return command doesn't delete blanks and tabs when moving onto
+ a new line.
+* NMODE's Return command is not changed in Auto Fill mode.
+* NMODDE's LineFeed command is quite a bit different: (1) it doesn't delete
+ spaces before the inserted CRLF; (2) it doesn't use the fill prefix to
+ indent; (3) it passes the command argument to the Return command, rather
+ than to the Tab command.
+* NMODE's C-X T command doesn't try to readjust the marks.
+* NMODE's C-X 4 command recognizes only B and F as options (not C-B or C-F).
+
+ C. Just Plain Differences
+
+* NMODE customization is completely different than EMACS customization.
+* NMODE M-X commands always prompt for their arguments; Escape is not a
+ terminator for the command name.
+* Find File in NMODE creates a buffer whose name is of the form "foo.bar",
+ rather than "foo".
+* In NMODE, the various Lisp-related commands (C-M-B, etc.) are defined
+ only in Lisp mode.
+* NMODE's "defun" commands don't set the mark.
+* C-M-L means "return to previous buffer" instead of "insert formfeed".
+* C-] is a prefix character (in Lisp mode) instead of meaning "abort".
+* C-X P means "write screen photo" instead of "narrow bounds to page".
+* NMODEs text filling commands compress non-leading tabs into spaces;
+ EMACS leaves them alone.
+
+--------------------------------------------------------------------------------
+III. Known deficiencies of NMODE
+
+* During prompted character input, the cursor remains in the edit window.
+* Printing to the OUTPUT buffer is slow.
+* Quitting out of NMODE to the standard break handler won't restore echoing.
+* NMODE does not provide a good way to interrupt a Lisp-E execution or printout.
+ (The only way is to ^C NMODE and then START it.)
+* "Typeout" is clumsy.
+* If you type ^^x to get C-X, the prompt string is sort of strange.
+
+--------------------------------------------------------------------------------
+IV. Things that NMODE has that EMACS doesn't
+
+* Miscellaneous Commands:
+ M-Z - format comment (automatically sets the fill prefix)
+ C-X V - toggle between normal and inverse-video
+ C-X < - scroll window left
+ C-X > - scroll window right
+ C-X P - write screen photograph to file
+ C-X E - exchange windows
+* Lisp Interface Commands
+* Buffer Browser
+* Split Screen option for Dired (and the Buffer Browser)
+* Two-Screen option (on 9836 with auxiliary color monitor)
+
+-------------------------------------------------------------------------------
ADDED psl-1983/3-1/psl/nmode-guide.txt
Index: psl-1983/3-1/psl/nmode-guide.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/nmode-guide.txt
@@ -0,0 +1,255 @@
+NMODE for EMODE users
+Alan Snyder
+28 October 1982
+-------------------------------------------------------------------------------
+
+NMODE is a new PSL text editor installed at HP.
+
+This note describes the NMODE editor in terms of its differences from EMODE,
+the previous PSL text editor. NMODE is a new editor that retains much of the
+basic structure and algorithms of EMODE. However, there are many differences
+between NMODE and EMODE, of interest to both users and experts.
+
+For experts, the differences can be summed up very easily: NMODE is a complete
+rewrite of EMODE. Virtually no EMODE function or fluid variable is present in
+NMODE. Thus, any code that interacts with the insides of EMODE must be
+rewritten to run in NMODE. Even code to define new function keys must be
+changed. In many cases, it is only necessary to change function names.
+However, code that accesses EMODE fluid variables probably requires greater
+revision, since many EMODE fluid variables have no counterparts in NMODE. In
+particular, there are no fluid variables containing information about the
+current buffer or the current window. Information describing how to customize
+NMODE by redefining keys or defining new commands may be found in the file
+"PSL:NMODE-CUSTOMIZING.TXT".
+
+For users, the differences between NMODE and EMODE can be divided into a number
+of categories:
+
+ * New Lisp Interaction
+ * Incompatible Changes
+ * Limitations
+ * Extension of existing commands to conform to EMACS
+ * New EMACS commands implemented
+ * Bug Fixes
+ * Miscellaneous Improvements
+
+These categories are described below:
+
+-------------------------------------------------------------------------------
+* New Lisp Interaction
+
+NMODE provides a new set of editor commands for executing forms from a buffer
+and interacting with the Break Handler. These commands use a new prefix
+character, C-], which echoes as "Lisp-". In the remainder of this document,
+the notation "Lisp-X" will be used to refer to the command sequence C-] X
+(where X is an arbitrary character). The "Lisp-" commands are available only
+in Lisp Mode.
+
+Three "Lisp-" commands are always available in Lisp mode:
+
+ Lisp-E executes a form in the current buffer beginning at the start of the
+current line. (This command was invoked as M-E in EMODE.) Output produced by
+the execution of a Lisp form is written to an output buffer (called "OUTPUT" in
+NMODE), which will pop up automatically in the "other" window if it is not
+exposed when output occurs. As in EMODE, this automatic pop-up can be
+suppressed by setting the global variable *OutWindow to NIL; however, in NMODE,
+this flag will be ignored when a Break occurs. In NMODE, output is always
+written at the END of the output buffer, even if the input is coming from the
+same buffer. Thus, when you execute a form from the output buffer, the cursor
+will jump to the end of the buffer when the output is printed. However, the
+mark is set at the point where you did the Lisp-E, so you can get back using
+C-X C-X.
+
+ Lisp-Y will yank the output from the previous Lisp-E into the current buffer.
+(This command was invoked as C-M-Y in EMODE.) The output is obtained from the
+output buffer. Only the starting and ending positions of the last output text
+are saved, so that if the output buffer has been modified, Lisp-Y may get the
+wrong text.
+
+ Lisp-L will transfer to a "normal" PSL Lisp Listener. (This command was
+invoked as C-M-Z in EMODE.) To return to NMODE, evaluate the form (NMODE).
+
+In NMODE, the Lisp prompt is displayed as part of the window label when the
+OUTPUT buffer is displayed, as opposed to permanently reserving a separate line
+on the screen for the Lisp prompt as EMODE does.
+
+NMODE does not use a break menu. However, NMODE does provide a set of special
+commands that can be used when a Lisp evaluation has entered a break loop.
+These commands are:
+
+ Lisp-B: print a backtrace
+ Lisp-Q: quit out of current break loop
+ Lisp-A: abort to top-level (restarts NMODE)
+ Lisp-R: retry (from a continuable error)
+ (existing ErrorForm is re-evaluated)
+ Lisp-C: continue (from a continuable error)
+ (value of the last form executed is used for the value)
+ Lisp-?: Brief help on above commands.
+
+Lisp-C is used to return a new value as the result value of the offending form
+(in the case of a continuable error). The value is specified by executing a
+form using Lisp-E; Lisp-C then "returns" the most recent result of execution.
+
+Lisp-B by itself prints the normal backtrace. C-U Lisp-B will in addition
+print the names of "interpreter" functions, such as COND and PROG. C-U C-U
+Lisp-B will print a verbose backtrace that displays the entire contents of the
+stack.
+
+The PSL function YesP has been redefined in NMODE to use NMODE prompted string
+input. It requires that the user type "Yes" or "No".
+
+-------------------------------------------------------------------------------
+* Incompatible Changes
+
+A number of existing EMODE functions are performed using different commands
+in NMODE, leaving their original commands either undefined or doing something
+different. These are:
+
+C-X C-R (Visit File): now C-X C-V (to conform with EMACS)
+M-E (Execute Form): now Lisp-E (typed as: C-] E)
+C-M-Y (Yank Last Output): now Lisp-Y (typed as: C-] Y)
+C-M-Z (Exit NMode): now Lisp-L (typed as: C-] L)
+C-X 2 (View Two Windows): now C-X 3 (to conform with EMACS)
+C-M-O (Forward Up List): now C-M-) (same as EMACS)
+
+-------------------------------------------------------------------------------
+* Limitations
+
+There are limitations imposed by NMODE that are not present in EMODE:
+
+* Currently, NMODE can be used only with HP terminals and with the 9836
+ running an extended VT52 emulator (the extensions are to support display
+ enhancements).
+
+* Currently, NMODE runs only on TOPS-20.
+
+-------------------------------------------------------------------------------
+* Extension of existing commands to conform to EMACS
+
+A large number of existing EMODE commands have been extended in NMODE to
+conform either exactly or more closely to the EMACS definitions. Many of these
+changes relate to the use of command arguments (specified by C-U). In EMODE,
+C-U simply defines a positive repetition count and repetitively executes the
+definition of the following command character. In NMODE, C-U works as in
+EMACS: it can accept either a positive or negative argument, which is
+interpreted in arbitrary ways by the following command.
+
+The following EMODE commands have been extended in notable ways:
+
+C-@ With an argument, pops a ring of marks (which is per-buffer).
+C-K Is unaffected by trailing white space at the end of the line.
+C-L Now repositions the current window. Accepts C-U argument.
+C-N and C-P Now remember the "goal column".
+C-V and M-V Scroll by lines or screenfuls, according to C-U argument.
+C-X 1 With an argument, expands the bottom window instead of the top.
+C-X 2 Now makes the bottom window current (use C-X 3 for top window).
+C-X C-S Now won't save an unmodified buffer.
+C-X C-V Now offers to save a modified buffer.
+C-X D Obeys command argument (without arg, uses current directory).
+C-X K Now asks for the name of the buffer to kill.
+C-X O Now works even in 1-window mode.
+M-< and M-> Now set the mark.
+Return Now will move "into" a region of blank lines.
+
+-------------------------------------------------------------------------------
+* New EMACS commands implemented
+
+The following EMACS commands are newly implemented in NMODE:
+
+BackSpace Move Backward Character
+C-% Replace String
+C-< Mark Beginning
+C-> Mark End
+C-G Aborts commands that request string input
+C-M-( Backward Up List
+C-M-) Forward Up List
+C-M-O Split Line
+C-M-R Reposition Window (for Lisp DEFUNs only)
+C-M-Return Same as M-M
+C-M-T Transpose Forms
+C-M-Tab Lisp Tab (also C-M-I)
+C-M-V Scroll other window
+C-M-W Append Next Kill
+C-Rubout Delete Backward Hacking Tabs
+C-Space Same as C-@
+C-X 3 View Two Windows
+C-X 4 Visit in Other Window (Find File or Select Buffer)
+C-X A Append to Buffer
+C-X C-N Set Goal Column
+C-X C-T Transpose Lines
+C-X G Get Register
+C-X T Transpose Regions
+C-X X Put Register
+C-^ The "control prefix" (used to type things like C-%)
+M-0 thru M-9 Define a numeric argument (also C-0, C-M-0, etc.)
+M-Hyphen Defines a numeric argument (also C-Hyphen, C-M-Hyphen, etc.)
+M-R Move to Screen Edge
+M-Return Same as M-M
+M-T Transpose Words
+M-Tab inserts a "Tab" (also M-I)
+M-~ Buffer Not Modified
+
+-------------------------------------------------------------------------------
+* Bug Fixes
+
+In the process of writing NMODE, a number of bugs in EMODE were fixed.
+These include:
+
+* M-Y has been made "safe". It checks that the contents of the region equal
+ the contents of the current kill buffer before killing the region.
+* Dired SORT commands no longer throw away all user-specified changes.
+* The interaction between NMODE and the Lisp Environment is much more
+ robust. It is much more difficult to get NMODE "screwed up".
+ In NMODE, it is possible to Quit out of an "Unexpected EOF" error.
+* NMODE does not allow the user to select one of its internal buffers.
+* In NMODE, string input can be terminated only by Return or C-G (C-G
+ aborts the command).
+* The M-? command now accepts any syntactically valid command, including
+ character sequences using prefix characters.
+* NMODE will not screw up if the cursor is moved into a part of a line that
+ does not show on the display.
+* The window position indicator ("--68%--") now works reasonably.
+* EMODE always advances to the next line after a M-E; NMODE suppresses
+ this action in two cases where it is spurious: (1) when NMODE is starting
+ up, (2) when the buffer pointer is at the beginning of the line, such as
+ after "executing" a number.
+
+-------------------------------------------------------------------------------
+ * Miscellaneous Improvements
+
+* NMODE supports INIT files. When first started up, NMODE will execute
+ the file "NMODE.INIT" on the user's home directory, if the file exists.
+ The file should contain a sequence of Lisp forms.
+* Completion of buffer names is implemented in NMODE. Completion is
+ requested using the Space character.
+* File names now always expand to the full "true" file name (as in EMACS).
+ As a result, Find File will always find a file in an existing buffer if
+ possible, regardless of the exact string typed by the user. In addition,
+ file names specified by the user now MERGE with the default file name.
+* Find File now creates a reasonable buffer name, instead of using the
+ exact string typed by the user. The buffer name will not be displayed
+ on the mode line, if it is completely redundant.
+* "Lisp" and "Text" modes are now available; the choice is based on file name.
+ In "Text" mode, the Lisp related commands (both C-M-* and Lisp-*) are
+ undefined, Tab is self-inserting, and Rubout does not "hack tabs".
+* The M-X extended command interface has been implemented. The following
+ M-X commands are defined: "M-X Lisp Mode" and "M-X Text Mode", which
+ set the mode of the current buffer.
+* Display Refresh is interruptible, allowing faster type-ahead. Parenthesis
+ matching is also interruptible, which is especially important in the case
+ of inserting an unmatched parenthesis.
+* Prompting has been improved.
+* Horizontal scrolling is supported. Two new commands, C-X < and C-X >,
+ are provided to scroll the window horizontally. They accept a C-U argument.
+* The buffer display now shows a '!' at the end of any line that extends
+ past the right edge of the screen.
+* Displaying one buffer in two windows now works reasonably.
+* Each buffer has a modified flag which indicates whether the contents of
+ the buffer have been changed since the buffer was last read or written.
+* The "mode line" now uses inverse video and is much more like EMACS.
+* Display enhancements are supported in a general fashion. A new command
+ C-X V has been implemented to switch between normal and inverse video.
+* When entering string input, C-R will yank the default string into the input
+ buffer.
+
+-------------------------------------------------------------------------------
ADDED psl-1983/3-1/psl/nmode.exe
Index: psl-1983/3-1/psl/nmode.exe
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/nmode.exe
cannot compute difference between binary files
ADDED psl-1983/3-1/psl/nmode.init
Index: psl-1983/3-1/psl/nmode.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/nmode.init
@@ -0,0 +1,39 @@
+% This is the "default" NMODE.INIT file. It will be evaluated when NMODE starts
+% up, unless the file *NMODE.INIT exists, in which case that file will be
+% evaluated instead. It is recommended that any personal NMODE.INIT file begin
+% with the form:
+%
+% (nmode-read-and-evaluate-file nmode-default-init-file-name)
+%
+% which will cause this file to be evaluated first.
+
+% Make the BACKSPACE key behave like Rubout!
+% Make M-BACKSPACE behave like M-Rubout!
+
+(remove-from-command-list 'Read-Only-Text-Command-List (x-char BACKSPACE))
+(remove-from-command-list 'Lisp-Command-List (x-char M-BACKSPACE))
+(add-to-command-list 'Text-Command-List
+ (x-char BACKSPACE)
+ 'delete-backward-character-command)
+(add-to-command-list 'Text-Command-List
+ (x-char M-BACKSPACE)
+ 'kill-backward-word-command)
+(add-to-command-list 'Lisp-Command-List
+ (x-char BACKSPACE)
+ 'delete-backward-hacking-tabs-command)
+(nmode-establish-current-mode)
+
+(when (not (funboundp 'nmode-define-softkey))
+ (nmode-define-softkey 0 'exit-nmode "Exit")
+ (nmode-define-softkey 1 'buffer-browser-command "Buffers")
+ (nmode-define-softkey 2 'find-file-command "Find File")
+ (nmode-define-softkey 3 'save-file-command "Save File")
+ (if (not (funboundp 'browser-browser-command))
+ (nmode-define-softkey 4 'browser-browser-command "Browsers")
+ (nmode-define-softkey 4 'fill-paragraph-command "Fill Para")
+ )
+ (nmode-define-softkey 5 'pasemulate "Hulk")
+ (nmode-define-softkey 6 'pasfiler "Filer")
+ (nmode-define-softkey 8 (string (x-char ^!])) "Lisp-")
+ (nmode-define-softkey 9 (string (x-char ^!\) #/X) "M-X")
+ )
ADDED psl-1983/3-1/psl/psl.exe
Index: psl-1983/3-1/psl/psl.exe
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/psl.exe
cannot compute difference between binary files
ADDED psl-1983/3-1/psl/pslcomp.exe
Index: psl-1983/3-1/psl/pslcomp.exe
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/pslcomp.exe
cannot compute difference between binary files
ADDED psl-1983/3-1/psl/rlisp.exe
Index: psl-1983/3-1/psl/rlisp.exe
==================================================================
--- /dev/null
+++ psl-1983/3-1/psl/rlisp.exe
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/16mhz-hp9836.tim
Index: psl-1983/3-1/tests/16mhz-hp9836.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/16mhz-hp9836.tim
@@ -0,0 +1,22 @@
+(
+("PSL 3.1, Faster 16Mhz with cache HP9836" . " 5-Mar-83")
+(EmptyTest-10000 . 30)
+(GEmptyTest-10000 . 740)
+(Cdr1Test-100 . 1050)
+(Cdr2Test-100 . 440)
+(CddrTest-100 . 340)
+(ListOnlyCdrTest1 . 2520)
+(ListOnlyCddrTest1 . 4160)
+(ListOnlyCdrTest2 . 6160)
+(ListOnlyCddrTest2 . 7790)
+(ReverseTest-10 . 640)
+(MyReverse1Test-10 . 650)
+(MyReverse2Test-10 . 580)
+(LengthTest-100 . 1230)
+(ArithmeticTest-10000 . 2690)
+(EvalTest-10000 . 7220)
+(tak-18-12-6 . 1240)
+(gtak-18-12-6 . 5190)
+(gtsta-g0 . 2350)
+(gtsta-g1 . 2400)
+)
ADDED psl-1983/3-1/tests/20/008lnk.exe
Index: psl-1983/3-1/tests/20/008lnk.exe
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/008lnk.exe
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/20-test-global-data.red
Index: psl-1983/3-1/tests/20/20-test-global-data.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/20-test-global-data.red
@@ -0,0 +1,45 @@
+% 20-TEST-GLOBAL-DATA - Data used by everyone, test version
+%
+% Author: Eric Benson, M Griss, S Lowder
+% Computer Science Dept.
+% University of Utah
+% Date: 1 September 1981
+% Copyright (c) 1981 University of Utah
+
+on SysLisp;
+
+% For testing with MAINn, see P20T:XXX-HEADER.RED
+% Want a small SYMTAB and HEAP
+
+exported WConst MaxSymbols = 800, % Use 500 upto MAIN7
+ MaxChannels = 31,
+ MaxObArray = 800, % Use 500 upto MAIN7
+ MaxRealRegs = 5,
+ MaxArgs = 15;
+
+% BitPositions for testing, etc:
+
+exported Wconst BitsPerWord=36;
+
+% The STACK stuff
+external WVAR ST, StackLowerBound, StackUpperBound;
+
+% "standard" Symbol table Data structures, handled
+% specially in Compiler
+
+external Warray Symnam,SymVal,SymFnc,SymPrp;
+external WVar NextSymbol;
+
+% For extra arguments not in Real registers
+external WArray ArgumentBlock;
+
+% For the Foreign Function Calling Protocol
+
+external Wvar Arg1,Arg2,Arg3,Arg4,Arg5,Arg6,Arg7,Arg8,Arg9,
+ Arg10,Arg11,Arg12,Arg13,Arg14,Arg15;
+
+external Warray HashTable;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/tests/20/20-test.output
Index: psl-1983/3-1/tests/20/20-test.output
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/20-test.output
@@ -0,0 +1,259 @@
+@@ex @@main1
+LINK: Loading
+[LNKXCT MAIN1 execution]
+Call on Init
+AB
+9
+10
+8
+90
+7
+720
+6
+5040
+5
+30240
+4
+151200
+3
+604800
+2
+1814400
+1
+3628800
+3628800
+
+Ctime: 98662 ms, 98662 ms
+
+
+Ctime: 99412 ms, 750 ms
+
+
+Ctime: 99450 ms, 38 ms
+ 7
+
+Ctime: 99913 ms, 463 ms
+
+Quitting
+@NEWPAGE()
+@@ex @@main2
+LINK: Loading
+[LNKXCT MAIN2 execution]
+Call on Init
+StrInf
+55688 55688
+Strlen
+51 51
+Byte
+0 65 A
+1 97 a
+2 66 B
+3 98 b
+4 67 C
+5 99 c
+6 68 D
+7 100 d
+8 69 E
+9 101 e
+10 70 F
+String
+AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUnVvWwXxYyZz
+"----- Now input characters until #"
+
+11223344556677
+
+aaaabbbbccddeeffgg
+
+#"----- First Print Called"
+1
+ANATOM
+(1 . 2)
+(AA (B1 . B2 ) . B3 )
+(AA (B1 ) )
+
+Quitting
+@NEWPAGE()
+@@ex @@main3
+LINK: Loading
+[LNKXCT MAIN3 execution]
+Call on Init
+"MAIN3: Casetest"
+Test case from -1 to 11
+Will classify argument
+Show for N=-1, expect default case
+Show for N=0, expect 0 case
+Show for N=1, expect 1,2,3 case
+Show for N=2, expect 1,2,3 case
+Show for N=3, expect 1,2,3 case
+Show for N=4, expect default case
+Show for N=5, expect default case
+Show for N=6, expect 6 ... 10 case
+Show for N=7, expect 6 ... 10 case
+Show for N=8, expect 6 ... 10 case
+Show for N=9, expect 6 ... 10 case
+Show for N=10, expect 6 ... 10 case
+Show for N=11, expect default case
+Show for N=12, expect default case
+"MAIN3: test CONS"
+(2 . 1)
+(3 2 . 1)
+(4 3 2 . 1)
+(5 4 3 2 . 1)
+(6 5 4 3 2 . 1)
+(7 6 5 4 3 2 . 1)
+(8 7 6 5 4 3 2 . 1)
+(9 8 7 6 5 4 3 2 . 1)
+
+Quitting
+@NEWPAGE()
+@@ex @@main4
+LINK: Loading
+[LNKXCT MAIN4 execution]
+1. --- Test EQSTR
+----- For EqStr(AB,AB) T should be T OK ------
+----- For EqStr(AB,AB) T should be T OK ------
+----- For EqStr(AB,Ab) NIL should be NIL OK ------
+----- For EqStr(AB,ABC) NIL should be NIL OK ------
+2. --- Test FindId on existing ID's
+Lookup string="A"
+Found In LookUpId=65
+----- For FindId(A) A should be A OK ------
+Lookup string="AB"
+Found In LookUpId=190
+----- For FindId(AB) AB should be AB OK ------
+3. --- Test FindId on new ID, make sure same place
+Lookup string="ABC"
+Not Found in LookupId
+New ID# 192
+Lookup string="ABC"
+Found In LookUpId=192
+----- For FindId(ABC) ABC should be ABC OK ------
+Lookup string="FOO"
+Not Found in LookupId
+New ID# 193
+Lookup string="ABC"
+Found In LookUpId=192
+----- For FindId(ABC) again ABC should be ABC OK ------
+4. --- Test RATOM loop. Type various ID's, STRING's and INTEGER's
+ Move to next part of test by typing the id Q
+ Inspect printout carefully
+NextSymbol =194
+1
+Item read= <0:1> 1
+"123"Item read= <4:5890> "123"
+A
+Lookup string="A"
+Found In LookUpId=65
+Item read= <30:65> A
+a
+Lookup string="a"
+Found In LookUpId=97
+Item read= <30:97> a
+AA
+Lookup string="AA"
+Not Found in LookupId
+New ID# 194
+Item read= <30:194> AA
+aa
+Lookup string="aa"
+Not Found in LookupId
+New ID# 195
+Item read= <30:195> aa
+abc
+Lookup string="abc"
+Not Found in LookupId
+New ID# 196
+Item read= <30:196> abc
+ABC
+Lookup string="ABC"
+Found In LookUpId=192
+Item read= <30:192> ABC
+abc
+Lookup string="abc"
+Found In LookUpId=196
+Item read= <30:196> abc
+Q
+Lookup string="Q"
+Found In LookUpId=81
+Item read= <30:81> Q
+5. --- Test READ loop. Type various S-expressions
+ Move to next part of test by typing the id Q
+ Inspect printout carefully
+'A
+ Item read= <9:5912> (QUOTE A )
+(12 '(34) (5 (6))) Item read= <9:5930> (12 (QUOTE (34) ) (5 (6) ) )
+
+Q
+ Item read= <30:81> Q
+
+Quitting
+@NEWPAGE()
+@@ex @@main5
+LINK: Loading
+[LNKXCT MAIN5 execution]
+(very) MINI-PSL: A Read-Eval-Print Loop, terminate with Q
+1 lisp> 1
+
+1
+2 lisp> 'A
+
+A
+3 lisp> (SETQ A 3)
+3
+4 lisp> A
+
+3
+5 lisp> (PRINT (CONS A A))
+(3 . 3)
+(3 . 3)
+6 lisp> (QUIT)
+
+Quitting
+@NEWPAGE()
+@@ex @@main6
+LINK: Loading
+%LNKFTH Fullword value RESET being truncated to halfword
+%LNKMDS Multiply-defined global symbol RESET
+ Detected in module .MAIN from file DSK:SUB6.REL
+ Defined value = 104000000147, this value = 163306
+[LNKXCT MAIN6 execution]
+Test BINDING Primitives
+----- For 3rd bound AA 3 should be 3 OK ------
+----- For 2rd bound AA NIL should be NIL OK ------
+----- For Original AA 1 should be 1 OK ------
+MINI-PSL: A Read-Eval-Print Loop, terminate with Q
+1 lisp> (DE FOO (X) (COND ((NULL X) 2) (T 3)))
+FOO
+2 lisp> (FOO NIL)
+2
+3 lisp> (FOO 2)
+3
+4 lisp> (DF E (TIM) (TIMEEVAL TIM))
+E
+5 lisp> (TESTSETUP)
+(SETQ FOO (CADR (QUOTE (1 2 3) ) ) )
+6 lisp> (E EMPTYTEST 10000)
+
+Ctime: 118090 ms, 118090 ms
+
+Ctime: 118127 ms, 37 ms
+ 37
+7 lisp> (E SLOWEMPTYTEST 10000)
+
+Ctime: 118259 ms, 132 ms
+
+Ctime: 118413 ms, 154 ms
+ 154
+8 lisp> (E LISTONLYCDRTEST1)
+
+Ctime: 118534 ms, 121 ms
+
+Ctime: 120275 ms, 1741 ms
+ 1741
+9 lisp> (FUM)
+ **** Uncompiled function in APPLY: FUM NIL
+NIL
+10 lisp> (QUIT)
+
+Quitting
+
ADDED psl-1983/3-1/tests/20/20io.mac
Index: psl-1983/3-1/tests/20/20io.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/20io.mac
@@ -0,0 +1,81 @@
+; 20IO: simple 20 Support routines
+TITLE 20IO
+SEARCH MONSYM
+RADIX ^D10
+ENTRY GETC20,PUTC20,INIT20,QUIT20,TIMC20,ERR20,PUTI20
+
+ST=15
+INIT20: HRROI 1,[Asciz/
+Call on Init
+/]
+ PSOUT
+ JFCL
+ POPJ ST,0
+
+GETC20: PBIN
+ JFCL
+ POPJ ST,0
+
+PUTC20: PBOUT
+ JFCL
+ CAIE 1,10 ; Is it EOL
+ POPJ ST,0 ; No
+ MOVEI 1,13
+ PBOUT
+ JFCL
+ MOVEI 1,10
+ POPJ ST,0
+
+PUTI20: MOVEM 1,JUNK
+ MOVE 2,1
+ MOVEI 1,^O101
+ MOVEI 3,^D10
+ NOUT
+ JFCL
+ MOVE 1,JUNK
+ POPJ ST,0
+
+ERR20: MOVEM 1,Junk
+ HRROI 1,[ASCIZ/
+*** ERR20: /]
+ PSOUT
+ MOVE 1,Junk
+ PUSHJ ST,PUTI20
+ MOVEI 1,10
+ PBOUT
+ HALTF
+ HALTF
+ POPJ ST,0
+
+Junk: Block 1
+
+QUIT20: Hrroi 1,[ASCIZ/
+Quitting
+/]
+ PSOUT
+ HALTF
+
+TIMC20: MOVEI 1,-5
+ RUNTM
+ JFCL
+ MOVEM 1,NTIME
+; Hrroi 1,[ASCIZ/
+;Ctime: /]
+; PSOUT
+; MOVE 1,NTIME
+; PUSHJ ST,PutI20
+; Hrroi 1,[ASCIZ/ ms, /]
+; PSOUT
+ MOVE 1,NTIME
+; SUB 1,OTIME
+; PUSHJ ST,PutI20
+; Hrroi 1,[ASCIZ/ ms
+; /]
+; PSOUT
+ MOVE 1,NTIME
+ MOVEM 1,OTIME
+ POPJ ST,0
+Otime: 0
+Ntime: 0
+ END
+
ADDED psl-1983/3-1/tests/20/20io.rel
Index: psl-1983/3-1/tests/20/20io.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/20io.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/20main.mac
Index: psl-1983/3-1/tests/20/20main.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/20main.mac
@@ -0,0 +1,15 @@
+; 20-main: simple driver to test MACRO version of 20 tests
+TITLE MAIN
+SEARCH MONSYM
+RADIX ^D10
+EXTERN INIT20,MAIN20,QUIT20
+
+ST=15
+MAIN: RESET
+ MOVE ST,[-1000,Stack]
+ PUSHJ ST,INIT20
+ PUSHJ ST,MAIN20
+ PUSHJ ST,QUIT20
+
+stack: block 1000
+ END MAIN
ADDED psl-1983/3-1/tests/20/20test.mac
Index: psl-1983/3-1/tests/20/20test.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/20test.mac
@@ -0,0 +1,57 @@
+; 20-TEST SIMPLE I/O TESTS, HANDCODED
+TITLE 20TEST
+; MLG, 20 JULY 1982
+
+SEARCH MONSYM
+RADIX ^D10
+EXTERN GETC20,PUTC20,PUTI20,ERR20,TIMC20,QUIT20
+ENTRY MAIN20
+ST=15
+MAIN20: MOVEI 1,1
+ PUSHJ ST, PUTI20 ; Print a 1 for first test
+ MOVEI 1,10
+ PUSHJ ST, PUTC20 ; EOL to flush line
+
+ MOVEI 1,2
+ PUSHJ ST, PUTI20 ; Second test
+ MOVEI 1,65
+ PUSHJ ST, PUTC20 ; A capital A
+ MOVEI 1,66
+ PUSHJ ST, PUTC20 ; A capital B
+ MOVEI 1,10
+ PUSHJ ST, PUTC20 ; EOL to flush line
+
+ MOVEI 1,3
+ PUSHJ ST, PUTI20 ; Third test, type in AB <cr>
+ PUSHJ ST, GETC20
+ PUSHJ ST, PUTC20 ; Should print A65
+ PUSHJ ST, PUTI20
+ MOVEI 1,10
+ PUSHJ ST,PUTC20
+
+ PUSHJ ST, GETC20
+ PUSHJ ST, PUTC20 ; Should print B66
+ PUSHJ ST, PUTI20
+ MOVEI 1,10
+ PUSHJ ST,PUTC20
+
+ PUSHJ ST, GETC20
+ PUSHJ ST, PUTI20 ; should print 10 and EOL
+ PUSHJ ST, PUTC20
+ MOVEI 1,10
+ PUSHJ ST,PUTC20
+
+ movei 1,4
+ pushj st, puti20 ; last test
+ Pushj st,timc20
+ PushJ st, puti20
+
+ movei 1,100
+ pushj st, err20
+
+ movei 1,26
+ pushj st, putc20 ; eof to flush buffer
+ movei 1,0
+ pushj st, quit20
+ POPJ ST,
+ END
ADDED psl-1983/3-1/tests/20/dec20-patches.sl
Index: psl-1983/3-1/tests/20/dec20-patches.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dec20-patches.sl
@@ -0,0 +1,118 @@
+% DEC20-PATCHES.SL
+% to convert to Portable, 2 reg for LINK model
+% From DEC20-Asm.RED
+% These will now be simpler than 20, just JRST
+% Should even be InternalEntry for efficiency, avoid circular defns
+% Right now, expect same as !%Store!-JCALL would install
+
+(SETQ UndefinedFunctionCellInstructions!*
+ '((!*JCALL UndefinedFunction)))
+
+(SETQ LambdaFunctionCellInstructions!*
+ '((!*JCALL CompiledCallingInterpreted)))
+
+(Put 'LinkReg 'RegisterName 12)
+(Put 'NargReg 'RegisterName 13)
+
+% From PC:Common-Cmacros.sl
+
+(de MakeLinkRegs(Fn Nargs)
+ (cond ((FlagP Fn 'NoLinkage) NIL)
+ (T (list (list '!*Move (list 'IdLoc FunctionName) '(reg LinkReg) )
+ (list '!*Move (list 'Wconst NumberofArguments) '(reg NargReg) )
+ ))))
+
+(FLAG '(IDapply0 IDapply1 IDapply2 IDapply3 IDapply4) 'NoLinkage)
+
+(de !*Link (FunctionName FunctionType NumberOfArguments)
+ (cond ((FlagP FunctionName 'ForeignFunction)
+ (list (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments)))
+ (t (append (MakeLinkRegs FunctionName NumberofArguments)
+ (list (list '!*Call FunctionName))))))
+
+
+(de !*LinkE (DeAllocCount FunctionName FunctionType NumberOfArguments)
+ (cons (list '!*DeAlloc DeAllocCount)
+ (cond ((FlagP FunctionName 'ForeignFunction)
+ (list (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments)
+ '(!*Exit 0)))
+ (t (Append (MakeLinkRegs FunctionName NumberofArguments)
+ (list (list '!*JCall FunctionName)))))))
+
+(DefList '((IDApply0 (
+ (!*move (Wconst 0) (reg NargReg))
+ (!*move (reg 1) (reg LinkReg))
+ % (!*Wtimes2 (reg 1) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 (
+ (!*move (Wconst 1) (reg NargReg))
+ (!*move (reg 2) (reg LinkReg))
+ % (!*Wtimes2 (reg 2) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 (
+ (!*move (Wconst 2) (reg NargReg))
+ (!*move (reg 3) (reg LinkReg))
+ % (!*Wtimes2 (reg 3) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 (
+ (!*move (Wconst 3) (reg NargReg))
+ (!*move (reg 4) (reg LinkReg))
+ % (!*Wtimes2 (reg 4) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 (
+ (!*move (Wconst 4) (reg NargReg))
+ (!*move (reg 5) (reg LinkReg))
+ % (!*Wtimes2 (reg 5) (Wconst AddressingUnitsPerFunctionCell))
+ (pushj (reg st) (Indexed (reg 5) (WArray SymFnc)))))
+) 'OpenCode)
+
+
+(DefList '((IDApply0 (
+ (!*move (Wconst 0) (reg NargReg))
+ (!*move (reg 1) (reg LinkReg))
+ % (!*wtimes2 (reg 1) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 1) (WArray SymFnc)))))
+ (IDApply1 (
+ (!*move (Wconst 1) (reg NargReg))
+ (!*move (reg 2) (reg LinkReg))
+ % (!*wtimes2 (reg 2) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 2) (WArray SymFnc)))))
+ (IDApply2 (
+ (!*move (Wconst 2) (reg NargReg))
+ (!*move (reg 3) (reg LinkReg))
+ % (!*wtimes2 (reg 3) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 3) (WArray SymFnc)))))
+ (IDApply3 (
+ (!*move (Wconst 3) (reg NargReg))
+ (!*move (reg 4) (reg LinkReg))
+ % (!*wtimes2 (reg 4) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 4) (WArray SymFnc)))))
+ (IDApply4 (
+ (!*move (Wconst 4) (reg NargReg))
+ (!*move (reg 5) (reg LinkReg))
+ % (!*wtimes2 (reg 5) (Wconst AddressingUnitsPerFunctionCell))
+ (jrst (Indexed (reg 5) (WArray SymFnc)))))
+) 'ExitOpenCode)
+
+% From PC:lap-to-asm.red
+
+(de DataPrintUndefinedFunctionCell ()
+ (Prog (OldOut)
+ (setq OldOut (WRS DataOut!*))
+ (foreach X in (Pass1Lap UndefinedFunctionCellInstructions!*) do
+ (ASMOutLap1 X))
+ (WRS OldOut)))
+
+(DSKIN "PT:P-LAMBIND.SL")
+
+% new SYSLISP bug, perhaps useful refefined it?
+
+(off usermode)
+
+(dm for(u) ( MkFor1 u))
ADDED psl-1983/3-1/tests/20/dfield.mac
Index: psl-1983/3-1/tests/20/dfield.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dfield.mac
@@ -0,0 +1,875 @@
+ radix 10
+STACK: block 301
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+300
+ intern L0002
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <29_31>+133
+ <29_31>+134
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <29_31>+150
+ block 50
+SYMNAM: intern SYMNAM
+ extern L0063
+ <4_31>+L0063
+ extern L0064
+ <4_31>+L0064
+ extern L0065
+ <4_31>+L0065
+ extern L0066
+ <4_31>+L0066
+ extern L0067
+ <4_31>+L0067
+ extern L0068
+ <4_31>+L0068
+ extern L0069
+ <4_31>+L0069
+ extern L0070
+ <4_31>+L0070
+ extern L0071
+ <4_31>+L0071
+ extern L0072
+ <4_31>+L0072
+ extern L0073
+ <4_31>+L0073
+ extern L0074
+ <4_31>+L0074
+ extern L0075
+ <4_31>+L0075
+ extern L0076
+ <4_31>+L0076
+ extern L0077
+ <4_31>+L0077
+ extern L0078
+ <4_31>+L0078
+ extern L0079
+ <4_31>+L0079
+ extern L0080
+ <4_31>+L0080
+ extern L0081
+ <4_31>+L0081
+ extern L0082
+ <4_31>+L0082
+ extern L0083
+ <4_31>+L0083
+ extern L0084
+ <4_31>+L0084
+ extern L0085
+ <4_31>+L0085
+ extern L0086
+ <4_31>+L0086
+ extern L0087
+ <4_31>+L0087
+ extern L0088
+ <4_31>+L0088
+ extern L0089
+ <4_31>+L0089
+ extern L0090
+ <4_31>+L0090
+ extern L0091
+ <4_31>+L0091
+ extern L0092
+ <4_31>+L0092
+ extern L0093
+ <4_31>+L0093
+ extern L0094
+ <4_31>+L0094
+ extern L0095
+ <4_31>+L0095
+ extern L0096
+ <4_31>+L0096
+ extern L0097
+ <4_31>+L0097
+ extern L0098
+ <4_31>+L0098
+ extern L0099
+ <4_31>+L0099
+ extern L0100
+ <4_31>+L0100
+ extern L0101
+ <4_31>+L0101
+ extern L0102
+ <4_31>+L0102
+ extern L0103
+ <4_31>+L0103
+ extern L0104
+ <4_31>+L0104
+ extern L0105
+ <4_31>+L0105
+ extern L0106
+ <4_31>+L0106
+ extern L0107
+ <4_31>+L0107
+ extern L0108
+ <4_31>+L0108
+ extern L0109
+ <4_31>+L0109
+ extern L0110
+ <4_31>+L0110
+ extern L0111
+ <4_31>+L0111
+ extern L0112
+ <4_31>+L0112
+ extern L0113
+ <4_31>+L0113
+ extern L0114
+ <4_31>+L0114
+ extern L0115
+ <4_31>+L0115
+ extern L0116
+ <4_31>+L0116
+ extern L0117
+ <4_31>+L0117
+ extern L0118
+ <4_31>+L0118
+ extern L0119
+ <4_31>+L0119
+ extern L0120
+ <4_31>+L0120
+ extern L0121
+ <4_31>+L0121
+ extern L0122
+ <4_31>+L0122
+ extern L0123
+ <4_31>+L0123
+ extern L0124
+ <4_31>+L0124
+ extern L0125
+ <4_31>+L0125
+ extern L0126
+ <4_31>+L0126
+ extern L0127
+ <4_31>+L0127
+ extern L0128
+ <4_31>+L0128
+ extern L0129
+ <4_31>+L0129
+ extern L0130
+ <4_31>+L0130
+ extern L0131
+ <4_31>+L0131
+ extern L0132
+ <4_31>+L0132
+ extern L0133
+ <4_31>+L0133
+ extern L0134
+ <4_31>+L0134
+ extern L0135
+ <4_31>+L0135
+ extern L0136
+ <4_31>+L0136
+ extern L0137
+ <4_31>+L0137
+ extern L0138
+ <4_31>+L0138
+ extern L0139
+ <4_31>+L0139
+ extern L0140
+ <4_31>+L0140
+ extern L0141
+ <4_31>+L0141
+ extern L0142
+ <4_31>+L0142
+ extern L0143
+ <4_31>+L0143
+ extern L0144
+ <4_31>+L0144
+ extern L0145
+ <4_31>+L0145
+ extern L0146
+ <4_31>+L0146
+ extern L0147
+ <4_31>+L0147
+ extern L0148
+ <4_31>+L0148
+ extern L0149
+ <4_31>+L0149
+ extern L0150
+ <4_31>+L0150
+ extern L0151
+ <4_31>+L0151
+ extern L0152
+ <4_31>+L0152
+ extern L0153
+ <4_31>+L0153
+ extern L0154
+ <4_31>+L0154
+ extern L0155
+ <4_31>+L0155
+ extern L0156
+ <4_31>+L0156
+ extern L0157
+ <4_31>+L0157
+ extern L0158
+ <4_31>+L0158
+ extern L0159
+ <4_31>+L0159
+ extern L0160
+ <4_31>+L0160
+ extern L0161
+ <4_31>+L0161
+ extern L0162
+ <4_31>+L0162
+ extern L0163
+ <4_31>+L0163
+ extern L0164
+ <4_31>+L0164
+ extern L0165
+ <4_31>+L0165
+ extern L0166
+ <4_31>+L0166
+ extern L0167
+ <4_31>+L0167
+ extern L0168
+ <4_31>+L0168
+ extern L0169
+ <4_31>+L0169
+ extern L0170
+ <4_31>+L0170
+ extern L0171
+ <4_31>+L0171
+ extern L0172
+ <4_31>+L0172
+ extern L0173
+ <4_31>+L0173
+ extern L0174
+ <4_31>+L0174
+ extern L0175
+ <4_31>+L0175
+ extern L0176
+ <4_31>+L0176
+ extern L0177
+ <4_31>+L0177
+ extern L0178
+ <4_31>+L0178
+ extern L0179
+ <4_31>+L0179
+ extern L0180
+ <4_31>+L0180
+ extern L0181
+ <4_31>+L0181
+ extern L0182
+ <4_31>+L0182
+ extern L0183
+ <4_31>+L0183
+ extern L0184
+ <4_31>+L0184
+ extern L0185
+ <4_31>+L0185
+ extern L0186
+ <4_31>+L0186
+ extern L0187
+ <4_31>+L0187
+ extern L0188
+ <4_31>+L0188
+ extern L0189
+ <4_31>+L0189
+ extern L0190
+ <4_31>+L0190
+ extern L0191
+ <4_31>+L0191
+ extern L0192
+ <4_31>+L0192
+ extern L0193
+ <4_31>+L0193
+ extern L0194
+ <4_31>+L0194
+ extern L0195
+ <4_31>+L0195
+ extern L0196
+ <4_31>+L0196
+ extern L0197
+ <4_31>+L0197
+ extern L0198
+ <4_31>+L0198
+ extern L0199
+ <4_31>+L0199
+ extern L0200
+ <4_31>+L0200
+ extern L0201
+ <4_31>+L0201
+ extern L0202
+ <4_31>+L0202
+ extern L0203
+ <4_31>+L0203
+ extern L0204
+ <4_31>+L0204
+ extern L0205
+ <4_31>+L0205
+ extern L0206
+ <4_31>+L0206
+ extern L0207
+ <4_31>+L0207
+ extern L0208
+ <4_31>+L0208
+ extern L0209
+ <4_31>+L0209
+ extern L0210
+ <4_31>+L0210
+ extern L0211
+ <4_31>+L0211
+ extern L0212
+ <4_31>+L0212
+ extern L0213
+ <4_31>+L0213
+ block 50
+SYMFNC: intern SYMFNC
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ JSP 10,SYMFNC+137
+ extern MAIN.
+ jrst MAIN.##
+ extern L0008
+ jrst L0008##
+ extern INIT
+ jrst INIT##
+ extern GETC
+ jrst GETC##
+ extern TIMC
+ jrst TIMC##
+ extern PUTC
+ jrst PUTC##
+ extern QUIT
+ jrst QUIT##
+ extern PUTINT
+ jrst PUTINT##
+ extern L0006
+ jrst L0006##
+ extern FLAG
+ jrst FLAG##
+ extern L0007
+ jrst L0007##
+ extern MSG5
+ jrst MSG5##
+ extern TESTOK
+ jrst TESTOK##
+ extern L0059
+ jrst L0059##
+ JSP 10,SYMFNC+137
+ extern L0014
+ jrst L0014##
+ extern L0028
+ jrst L0028##
+ extern L0043
+ jrst L0043##
+ extern L0061
+ jrst L0061##
+ extern L0058
+ jrst L0058##
+ extern L0060
+ jrst L0060##
+ extern L0062
+ jrst L0062##
+ block 50
+L0003: intern L0003
+ 151
+ end
ADDED psl-1983/3-1/tests/20/dfoo.rel
Index: psl-1983/3-1/tests/20/dfoo.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dfoo.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain0.mac
Index: psl-1983/3-1/tests/20/dmain0.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain0.mac
@@ -0,0 +1,1539 @@
+ radix 10
+STACK: block 5001
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+5000
+ intern L0002
+HEAP: block 150001
+ intern HEAP
+L0006: HEAP+0
+ intern L0006
+L0007: HEAP+150000
+ intern L0007
+L0008: 0
+ intern L0008
+L0009: 0
+ intern L0009
+L0010: 0
+ intern L0010
+L0011: 0
+ intern L0011
+L0012: block 20
+ intern L0012
+BPS: block 501
+ intern BPS
+L0013: BPS+0
+ intern L0013
+L0014: BPS+0
+ intern L0014
+L0015: BPS+500
+ intern L0015
+L0016: BPS+500
+ intern L0016
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+L0005: block 401
+ intern L0005
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <30_31>+128
+ <30_31>+128
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <30_31>+128
+ <30_31>+128
+ <29_31>+152
+ <29_31>+153
+ <29_31>+154
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ block 641
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 641
+SYMNAM: intern SYMNAM
+ extern L0037
+ <4_31>+L0037
+ extern L0038
+ <4_31>+L0038
+ extern L0039
+ <4_31>+L0039
+ extern L0040
+ <4_31>+L0040
+ extern L0041
+ <4_31>+L0041
+ extern L0042
+ <4_31>+L0042
+ extern L0043
+ <4_31>+L0043
+ extern L0044
+ <4_31>+L0044
+ extern L0045
+ <4_31>+L0045
+ extern L0046
+ <4_31>+L0046
+ extern L0047
+ <4_31>+L0047
+ extern L0048
+ <4_31>+L0048
+ extern L0049
+ <4_31>+L0049
+ extern L0050
+ <4_31>+L0050
+ extern L0051
+ <4_31>+L0051
+ extern L0052
+ <4_31>+L0052
+ extern L0053
+ <4_31>+L0053
+ extern L0054
+ <4_31>+L0054
+ extern L0055
+ <4_31>+L0055
+ extern L0056
+ <4_31>+L0056
+ extern L0057
+ <4_31>+L0057
+ extern L0058
+ <4_31>+L0058
+ extern L0059
+ <4_31>+L0059
+ extern L0060
+ <4_31>+L0060
+ extern L0061
+ <4_31>+L0061
+ extern L0062
+ <4_31>+L0062
+ extern L0063
+ <4_31>+L0063
+ extern L0064
+ <4_31>+L0064
+ extern L0065
+ <4_31>+L0065
+ extern L0066
+ <4_31>+L0066
+ extern L0067
+ <4_31>+L0067
+ extern L0068
+ <4_31>+L0068
+ extern L0069
+ <4_31>+L0069
+ extern L0070
+ <4_31>+L0070
+ extern L0071
+ <4_31>+L0071
+ extern L0072
+ <4_31>+L0072
+ extern L0073
+ <4_31>+L0073
+ extern L0074
+ <4_31>+L0074
+ extern L0075
+ <4_31>+L0075
+ extern L0076
+ <4_31>+L0076
+ extern L0077
+ <4_31>+L0077
+ extern L0078
+ <4_31>+L0078
+ extern L0079
+ <4_31>+L0079
+ extern L0080
+ <4_31>+L0080
+ extern L0081
+ <4_31>+L0081
+ extern L0082
+ <4_31>+L0082
+ extern L0083
+ <4_31>+L0083
+ extern L0084
+ <4_31>+L0084
+ extern L0085
+ <4_31>+L0085
+ extern L0086
+ <4_31>+L0086
+ extern L0087
+ <4_31>+L0087
+ extern L0088
+ <4_31>+L0088
+ extern L0089
+ <4_31>+L0089
+ extern L0090
+ <4_31>+L0090
+ extern L0091
+ <4_31>+L0091
+ extern L0092
+ <4_31>+L0092
+ extern L0093
+ <4_31>+L0093
+ extern L0094
+ <4_31>+L0094
+ extern L0095
+ <4_31>+L0095
+ extern L0096
+ <4_31>+L0096
+ extern L0097
+ <4_31>+L0097
+ extern L0098
+ <4_31>+L0098
+ extern L0099
+ <4_31>+L0099
+ extern L0100
+ <4_31>+L0100
+ extern L0101
+ <4_31>+L0101
+ extern L0102
+ <4_31>+L0102
+ extern L0103
+ <4_31>+L0103
+ extern L0104
+ <4_31>+L0104
+ extern L0105
+ <4_31>+L0105
+ extern L0106
+ <4_31>+L0106
+ extern L0107
+ <4_31>+L0107
+ extern L0108
+ <4_31>+L0108
+ extern L0109
+ <4_31>+L0109
+ extern L0110
+ <4_31>+L0110
+ extern L0111
+ <4_31>+L0111
+ extern L0112
+ <4_31>+L0112
+ extern L0113
+ <4_31>+L0113
+ extern L0114
+ <4_31>+L0114
+ extern L0115
+ <4_31>+L0115
+ extern L0116
+ <4_31>+L0116
+ extern L0117
+ <4_31>+L0117
+ extern L0118
+ <4_31>+L0118
+ extern L0119
+ <4_31>+L0119
+ extern L0120
+ <4_31>+L0120
+ extern L0121
+ <4_31>+L0121
+ extern L0122
+ <4_31>+L0122
+ extern L0123
+ <4_31>+L0123
+ extern L0124
+ <4_31>+L0124
+ extern L0125
+ <4_31>+L0125
+ extern L0126
+ <4_31>+L0126
+ extern L0127
+ <4_31>+L0127
+ extern L0128
+ <4_31>+L0128
+ extern L0129
+ <4_31>+L0129
+ extern L0130
+ <4_31>+L0130
+ extern L0131
+ <4_31>+L0131
+ extern L0132
+ <4_31>+L0132
+ extern L0133
+ <4_31>+L0133
+ extern L0134
+ <4_31>+L0134
+ extern L0135
+ <4_31>+L0135
+ extern L0136
+ <4_31>+L0136
+ extern L0137
+ <4_31>+L0137
+ extern L0138
+ <4_31>+L0138
+ extern L0139
+ <4_31>+L0139
+ extern L0140
+ <4_31>+L0140
+ extern L0141
+ <4_31>+L0141
+ extern L0142
+ <4_31>+L0142
+ extern L0143
+ <4_31>+L0143
+ extern L0144
+ <4_31>+L0144
+ extern L0145
+ <4_31>+L0145
+ extern L0146
+ <4_31>+L0146
+ extern L0147
+ <4_31>+L0147
+ extern L0148
+ <4_31>+L0148
+ extern L0149
+ <4_31>+L0149
+ extern L0150
+ <4_31>+L0150
+ extern L0151
+ <4_31>+L0151
+ extern L0152
+ <4_31>+L0152
+ extern L0153
+ <4_31>+L0153
+ extern L0154
+ <4_31>+L0154
+ extern L0155
+ <4_31>+L0155
+ extern L0156
+ <4_31>+L0156
+ extern L0157
+ <4_31>+L0157
+ extern L0158
+ <4_31>+L0158
+ extern L0159
+ <4_31>+L0159
+ extern L0160
+ <4_31>+L0160
+ extern L0161
+ <4_31>+L0161
+ extern L0162
+ <4_31>+L0162
+ extern L0163
+ <4_31>+L0163
+ extern L0164
+ <4_31>+L0164
+ extern L0165
+ <4_31>+L0165
+ extern L0166
+ <4_31>+L0166
+ extern L0167
+ <4_31>+L0167
+ extern L0168
+ <4_31>+L0168
+ extern L0169
+ <4_31>+L0169
+ extern L0170
+ <4_31>+L0170
+ extern L0171
+ <4_31>+L0171
+ extern L0172
+ <4_31>+L0172
+ extern L0173
+ <4_31>+L0173
+ extern L0174
+ <4_31>+L0174
+ extern L0175
+ <4_31>+L0175
+ extern L0176
+ <4_31>+L0176
+ extern L0177
+ <4_31>+L0177
+ extern L0178
+ <4_31>+L0178
+ extern L0179
+ <4_31>+L0179
+ extern L0180
+ <4_31>+L0180
+ extern L0181
+ <4_31>+L0181
+ extern L0182
+ <4_31>+L0182
+ extern L0183
+ <4_31>+L0183
+ extern L0184
+ <4_31>+L0184
+ extern L0185
+ <4_31>+L0185
+ extern L0186
+ <4_31>+L0186
+ extern L0187
+ <4_31>+L0187
+ extern L0188
+ <4_31>+L0188
+ extern L0189
+ <4_31>+L0189
+ extern L0190
+ <4_31>+L0190
+ extern L0191
+ <4_31>+L0191
+ extern L0192
+ <4_31>+L0192
+ extern L0193
+ <4_31>+L0193
+ extern L0194
+ <4_31>+L0194
+ extern L0195
+ <4_31>+L0195
+ extern L0196
+ <4_31>+L0196
+ 161
+ 162
+ 163
+ 164
+ 165
+ 166
+ 167
+ 168
+ 169
+ 170
+ 171
+ 172
+ 173
+ 174
+ 175
+ 176
+ 177
+ 178
+ 179
+ 180
+ 181
+ 182
+ 183
+ 184
+ 185
+ 186
+ 187
+ 188
+ 189
+ 190
+ 191
+ 192
+ 193
+ 194
+ 195
+ 196
+ 197
+ 198
+ 199
+ 200
+ 201
+ 202
+ 203
+ 204
+ 205
+ 206
+ 207
+ 208
+ 209
+ 210
+ 211
+ 212
+ 213
+ 214
+ 215
+ 216
+ 217
+ 218
+ 219
+ 220
+ 221
+ 222
+ 223
+ 224
+ 225
+ 226
+ 227
+ 228
+ 229
+ 230
+ 231
+ 232
+ 233
+ 234
+ 235
+ 236
+ 237
+ 238
+ 239
+ 240
+ 241
+ 242
+ 243
+ 244
+ 245
+ 246
+ 247
+ 248
+ 249
+ 250
+ 251
+ 252
+ 253
+ 254
+ 255
+ 256
+ 257
+ 258
+ 259
+ 260
+ 261
+ 262
+ 263
+ 264
+ 265
+ 266
+ 267
+ 268
+ 269
+ 270
+ 271
+ 272
+ 273
+ 274
+ 275
+ 276
+ 277
+ 278
+ 279
+ 280
+ 281
+ 282
+ 283
+ 284
+ 285
+ 286
+ 287
+ 288
+ 289
+ 290
+ 291
+ 292
+ 293
+ 294
+ 295
+ 296
+ 297
+ 298
+ 299
+ 300
+ 301
+ 302
+ 303
+ 304
+ 305
+ 306
+ 307
+ 308
+ 309
+ 310
+ 311
+ 312
+ 313
+ 314
+ 315
+ 316
+ 317
+ 318
+ 319
+ 320
+ 321
+ 322
+ 323
+ 324
+ 325
+ 326
+ 327
+ 328
+ 329
+ 330
+ 331
+ 332
+ 333
+ 334
+ 335
+ 336
+ 337
+ 338
+ 339
+ 340
+ 341
+ 342
+ 343
+ 344
+ 345
+ 346
+ 347
+ 348
+ 349
+ 350
+ 351
+ 352
+ 353
+ 354
+ 355
+ 356
+ 357
+ 358
+ 359
+ 360
+ 361
+ 362
+ 363
+ 364
+ 365
+ 366
+ 367
+ 368
+ 369
+ 370
+ 371
+ 372
+ 373
+ 374
+ 375
+ 376
+ 377
+ 378
+ 379
+ 380
+ 381
+ 382
+ 383
+ 384
+ 385
+ 386
+ 387
+ 388
+ 389
+ 390
+ 391
+ 392
+ 393
+ 394
+ 395
+ 396
+ 397
+ 398
+ 399
+ 400
+ 401
+ 402
+ 403
+ 404
+ 405
+ 406
+ 407
+ 408
+ 409
+ 410
+ 411
+ 412
+ 413
+ 414
+ 415
+ 416
+ 417
+ 418
+ 419
+ 420
+ 421
+ 422
+ 423
+ 424
+ 425
+ 426
+ 427
+ 428
+ 429
+ 430
+ 431
+ 432
+ 433
+ 434
+ 435
+ 436
+ 437
+ 438
+ 439
+ 440
+ 441
+ 442
+ 443
+ 444
+ 445
+ 446
+ 447
+ 448
+ 449
+ 450
+ 451
+ 452
+ 453
+ 454
+ 455
+ 456
+ 457
+ 458
+ 459
+ 460
+ 461
+ 462
+ 463
+ 464
+ 465
+ 466
+ 467
+ 468
+ 469
+ 470
+ 471
+ 472
+ 473
+ 474
+ 475
+ 476
+ 477
+ 478
+ 479
+ 480
+ 481
+ 482
+ 483
+ 484
+ 485
+ 486
+ 487
+ 488
+ 489
+ 490
+ 491
+ 492
+ 493
+ 494
+ 495
+ 496
+ 497
+ 498
+ 499
+ 500
+ 501
+ 502
+ 503
+ 504
+ 505
+ 506
+ 507
+ 508
+ 509
+ 510
+ 511
+ 512
+ 513
+ 514
+ 515
+ 516
+ 517
+ 518
+ 519
+ 520
+ 521
+ 522
+ 523
+ 524
+ 525
+ 526
+ 527
+ 528
+ 529
+ 530
+ 531
+ 532
+ 533
+ 534
+ 535
+ 536
+ 537
+ 538
+ 539
+ 540
+ 541
+ 542
+ 543
+ 544
+ 545
+ 546
+ 547
+ 548
+ 549
+ 550
+ 551
+ 552
+ 553
+ 554
+ 555
+ 556
+ 557
+ 558
+ 559
+ 560
+ 561
+ 562
+ 563
+ 564
+ 565
+ 566
+ 567
+ 568
+ 569
+ 570
+ 571
+ 572
+ 573
+ 574
+ 575
+ 576
+ 577
+ 578
+ 579
+ 580
+ 581
+ 582
+ 583
+ 584
+ 585
+ 586
+ 587
+ 588
+ 589
+ 590
+ 591
+ 592
+ 593
+ 594
+ 595
+ 596
+ 597
+ 598
+ 599
+ 600
+ 601
+ 602
+ 603
+ 604
+ 605
+ 606
+ 607
+ 608
+ 609
+ 610
+ 611
+ 612
+ 613
+ 614
+ 615
+ 616
+ 617
+ 618
+ 619
+ 620
+ 621
+ 622
+ 623
+ 624
+ 625
+ 626
+ 627
+ 628
+ 629
+ 630
+ 631
+ 632
+ 633
+ 634
+ 635
+ 636
+ 637
+ 638
+ 639
+ 640
+ 641
+ 642
+ 643
+ 644
+ 645
+ 646
+ 647
+ 648
+ 649
+ 650
+ 651
+ 652
+ 653
+ 654
+ 655
+ 656
+ 657
+ 658
+ 659
+ 660
+ 661
+ 662
+ 663
+ 664
+ 665
+ 666
+ 667
+ 668
+ 669
+ 670
+ 671
+ 672
+ 673
+ 674
+ 675
+ 676
+ 677
+ 678
+ 679
+ 680
+ 681
+ 682
+ 683
+ 684
+ 685
+ 686
+ 687
+ 688
+ 689
+ 690
+ 691
+ 692
+ 693
+ 694
+ 695
+ 696
+ 697
+ 698
+ 699
+ 700
+ 701
+ 702
+ 703
+ 704
+ 705
+ 706
+ 707
+ 708
+ 709
+ 710
+ 711
+ 712
+ 713
+ 714
+ 715
+ 716
+ 717
+ 718
+ 719
+ 720
+ 721
+ 722
+ 723
+ 724
+ 725
+ 726
+ 727
+ 728
+ 729
+ 730
+ 731
+ 732
+ 733
+ 734
+ 735
+ 736
+ 737
+ 738
+ 739
+ 740
+ 741
+ 742
+ 743
+ 744
+ 745
+ 746
+ 747
+ 748
+ 749
+ 750
+ 751
+ 752
+ 753
+ 754
+ 755
+ 756
+ 757
+ 758
+ 759
+ 760
+ 761
+ 762
+ 763
+ 764
+ 765
+ 766
+ 767
+ 768
+ 769
+ 770
+ 771
+ 772
+ 773
+ 774
+ 775
+ 776
+ 777
+ 778
+ 779
+ 780
+ 781
+ 782
+ 783
+ 784
+ 785
+ 786
+ 787
+ 788
+ 789
+ 790
+ 791
+ 792
+ 793
+ 794
+ 795
+ 796
+ 797
+ 798
+ 799
+ 800
+ 0
+SYMFNC: intern SYMFNC
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ extern L0017
+ jrst L0017##
+ extern L0035
+ jrst L0035##
+ extern MAIN.
+ jrst MAIN.##
+ extern INIT
+ jrst INIT##
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ extern GETC
+ jrst GETC##
+ extern TIMC
+ jrst TIMC##
+ JRST SYMFNC+149
+ extern PUTC
+ jrst PUTC##
+ extern QUIT
+ jrst QUIT##
+ extern L0021
+ jrst L0021##
+ JRST SYMFNC+149
+ extern RESET
+ jrst RESET##
+ extern DATE
+ jrst DATE##
+ extern L0028
+ jrst L0028##
+ extern PUTINT
+ jrst PUTINT##
+ extern L0029
+ jrst L0029##
+ extern L0030
+ jrst L0030##
+ extern L0031
+ jrst L0031##
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ extern L0032
+ jrst L0032##
+ JRST SYMFNC+149
+ extern L0033
+ jrst L0033##
+ JRST SYMFNC+149
+ extern L0034
+ jrst L0034##
+ extern TERPRI
+ jrst TERPRI##
+ extern L0036
+ jrst L0036##
+ block 641
+L0003: intern L0003
+ 160
+ end
ADDED psl-1983/3-1/tests/20/dmain0.rel
Index: psl-1983/3-1/tests/20/dmain0.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain0.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain1.mac
Index: psl-1983/3-1/tests/20/dmain1.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain1.mac
@@ -0,0 +1,1575 @@
+ radix 10
+STACK: block 5001
+ intern STACK
+L0001: STACK+0
+ intern L0001
+L0002: STACK+5000
+ intern L0002
+HEAP: block 150001
+ intern HEAP
+L0006: HEAP+0
+ intern L0006
+L0007: HEAP+150000
+ intern L0007
+L0008: 0
+ intern L0008
+L0009: 0
+ intern L0009
+L0010: 0
+ intern L0010
+L0011: 0
+ intern L0011
+L0012: block 20
+ intern L0012
+BPS: block 501
+ intern BPS
+L0013: BPS+0
+ intern L0013
+L0014: BPS+0
+ intern L0014
+L0015: BPS+500
+ intern L0015
+L0016: BPS+500
+ intern L0016
+L0004: block 10
+ intern L0004
+ARG1: 0
+ intern ARG1
+ARG2: 0
+ intern ARG2
+ARG3: 0
+ intern ARG3
+ARG4: 0
+ intern ARG4
+ARG5: 0
+ intern ARG5
+ARG6: 0
+ intern ARG6
+ARG7: 0
+ intern ARG7
+ARG8: 0
+ intern ARG8
+ARG9: 0
+ intern ARG9
+ARG10: 0
+ intern ARG10
+ARG11: 0
+ intern ARG11
+ARG12: 0
+ intern ARG12
+ARG13: 0
+ intern ARG13
+ARG14: 0
+ intern ARG14
+ARG15: 0
+ intern ARG15
+L0005: block 401
+ intern L0005
+SYMVAL: intern SYMVAL
+ <29_31>+0
+ <29_31>+1
+ <29_31>+2
+ <29_31>+3
+ <29_31>+4
+ <29_31>+5
+ <29_31>+6
+ <29_31>+7
+ <29_31>+8
+ <29_31>+9
+ <29_31>+10
+ <29_31>+11
+ <29_31>+12
+ <29_31>+13
+ <29_31>+14
+ <29_31>+15
+ <29_31>+16
+ <29_31>+17
+ <29_31>+18
+ <29_31>+19
+ <29_31>+20
+ <29_31>+21
+ <29_31>+22
+ <29_31>+23
+ <29_31>+24
+ <29_31>+25
+ <29_31>+26
+ <29_31>+27
+ <29_31>+28
+ <29_31>+29
+ <29_31>+30
+ <29_31>+31
+ <29_31>+32
+ <29_31>+33
+ <29_31>+34
+ <29_31>+35
+ <29_31>+36
+ <29_31>+37
+ <29_31>+38
+ <29_31>+39
+ <29_31>+40
+ <29_31>+41
+ <29_31>+42
+ <29_31>+43
+ <29_31>+44
+ <29_31>+45
+ <29_31>+46
+ <29_31>+47
+ <29_31>+48
+ <29_31>+49
+ <29_31>+50
+ <29_31>+51
+ <29_31>+52
+ <29_31>+53
+ <29_31>+54
+ <29_31>+55
+ <29_31>+56
+ <29_31>+57
+ <29_31>+58
+ <29_31>+59
+ <29_31>+60
+ <29_31>+61
+ <29_31>+62
+ <29_31>+63
+ <29_31>+64
+ <29_31>+65
+ <29_31>+66
+ <29_31>+67
+ <29_31>+68
+ <29_31>+69
+ <29_31>+70
+ <29_31>+71
+ <29_31>+72
+ <29_31>+73
+ <29_31>+74
+ <29_31>+75
+ <29_31>+76
+ <29_31>+77
+ <29_31>+78
+ <29_31>+79
+ <29_31>+80
+ <29_31>+81
+ <29_31>+82
+ <29_31>+83
+ <30_31>+84
+ <29_31>+85
+ <29_31>+86
+ <29_31>+87
+ <29_31>+88
+ <29_31>+89
+ <29_31>+90
+ <29_31>+91
+ <29_31>+92
+ <29_31>+93
+ <29_31>+94
+ <29_31>+95
+ <29_31>+96
+ <29_31>+97
+ <29_31>+98
+ <29_31>+99
+ <29_31>+100
+ <29_31>+101
+ <29_31>+102
+ <29_31>+103
+ <29_31>+104
+ <29_31>+105
+ <29_31>+106
+ <29_31>+107
+ <29_31>+108
+ <29_31>+109
+ <29_31>+110
+ <29_31>+111
+ <29_31>+112
+ <29_31>+113
+ <29_31>+114
+ <29_31>+115
+ <29_31>+116
+ <29_31>+117
+ <29_31>+118
+ <29_31>+119
+ <29_31>+120
+ <29_31>+121
+ <29_31>+122
+ <29_31>+123
+ <29_31>+124
+ <29_31>+125
+ <29_31>+126
+ <29_31>+127
+ <30_31>+128
+ <29_31>+129
+ <29_31>+130
+ <29_31>+131
+ <29_31>+132
+ <30_31>+128
+ <30_31>+128
+ <29_31>+135
+ <29_31>+136
+ <29_31>+137
+ <29_31>+138
+ <29_31>+139
+ <29_31>+140
+ <29_31>+141
+ <29_31>+142
+ <29_31>+143
+ <29_31>+144
+ <29_31>+145
+ <29_31>+146
+ <29_31>+147
+ <29_31>+148
+ <29_31>+149
+ <30_31>+128
+ <30_31>+128
+ <29_31>+152
+ <29_31>+153
+ <29_31>+154
+ <29_31>+155
+ <29_31>+156
+ <29_31>+157
+ <29_31>+158
+ <29_31>+159
+ <29_31>+160
+ <29_31>+161
+ <29_31>+162
+ <29_31>+163
+ <29_31>+164
+ <29_31>+165
+ <29_31>+166
+ block 634
+SYMPRP: intern SYMPRP
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ <30_31>+128
+ block 634
+SYMNAM: intern SYMNAM
+ extern L0055
+ <4_31>+L0055
+ extern L0056
+ <4_31>+L0056
+ extern L0057
+ <4_31>+L0057
+ extern L0058
+ <4_31>+L0058
+ extern L0059
+ <4_31>+L0059
+ extern L0060
+ <4_31>+L0060
+ extern L0061
+ <4_31>+L0061
+ extern L0062
+ <4_31>+L0062
+ extern L0063
+ <4_31>+L0063
+ extern L0064
+ <4_31>+L0064
+ extern L0065
+ <4_31>+L0065
+ extern L0066
+ <4_31>+L0066
+ extern L0067
+ <4_31>+L0067
+ extern L0068
+ <4_31>+L0068
+ extern L0069
+ <4_31>+L0069
+ extern L0070
+ <4_31>+L0070
+ extern L0071
+ <4_31>+L0071
+ extern L0072
+ <4_31>+L0072
+ extern L0073
+ <4_31>+L0073
+ extern L0074
+ <4_31>+L0074
+ extern L0075
+ <4_31>+L0075
+ extern L0076
+ <4_31>+L0076
+ extern L0077
+ <4_31>+L0077
+ extern L0078
+ <4_31>+L0078
+ extern L0079
+ <4_31>+L0079
+ extern L0080
+ <4_31>+L0080
+ extern L0081
+ <4_31>+L0081
+ extern L0082
+ <4_31>+L0082
+ extern L0083
+ <4_31>+L0083
+ extern L0084
+ <4_31>+L0084
+ extern L0085
+ <4_31>+L0085
+ extern L0086
+ <4_31>+L0086
+ extern L0087
+ <4_31>+L0087
+ extern L0088
+ <4_31>+L0088
+ extern L0089
+ <4_31>+L0089
+ extern L0090
+ <4_31>+L0090
+ extern L0091
+ <4_31>+L0091
+ extern L0092
+ <4_31>+L0092
+ extern L0093
+ <4_31>+L0093
+ extern L0094
+ <4_31>+L0094
+ extern L0095
+ <4_31>+L0095
+ extern L0096
+ <4_31>+L0096
+ extern L0097
+ <4_31>+L0097
+ extern L0098
+ <4_31>+L0098
+ extern L0099
+ <4_31>+L0099
+ extern L0100
+ <4_31>+L0100
+ extern L0101
+ <4_31>+L0101
+ extern L0102
+ <4_31>+L0102
+ extern L0103
+ <4_31>+L0103
+ extern L0104
+ <4_31>+L0104
+ extern L0105
+ <4_31>+L0105
+ extern L0106
+ <4_31>+L0106
+ extern L0107
+ <4_31>+L0107
+ extern L0108
+ <4_31>+L0108
+ extern L0109
+ <4_31>+L0109
+ extern L0110
+ <4_31>+L0110
+ extern L0111
+ <4_31>+L0111
+ extern L0112
+ <4_31>+L0112
+ extern L0113
+ <4_31>+L0113
+ extern L0114
+ <4_31>+L0114
+ extern L0115
+ <4_31>+L0115
+ extern L0116
+ <4_31>+L0116
+ extern L0117
+ <4_31>+L0117
+ extern L0118
+ <4_31>+L0118
+ extern L0119
+ <4_31>+L0119
+ extern L0120
+ <4_31>+L0120
+ extern L0121
+ <4_31>+L0121
+ extern L0122
+ <4_31>+L0122
+ extern L0123
+ <4_31>+L0123
+ extern L0124
+ <4_31>+L0124
+ extern L0125
+ <4_31>+L0125
+ extern L0126
+ <4_31>+L0126
+ extern L0127
+ <4_31>+L0127
+ extern L0128
+ <4_31>+L0128
+ extern L0129
+ <4_31>+L0129
+ extern L0130
+ <4_31>+L0130
+ extern L0131
+ <4_31>+L0131
+ extern L0132
+ <4_31>+L0132
+ extern L0133
+ <4_31>+L0133
+ extern L0134
+ <4_31>+L0134
+ extern L0135
+ <4_31>+L0135
+ extern L0136
+ <4_31>+L0136
+ extern L0137
+ <4_31>+L0137
+ extern L0138
+ <4_31>+L0138
+ extern L0139
+ <4_31>+L0139
+ extern L0140
+ <4_31>+L0140
+ extern L0141
+ <4_31>+L0141
+ extern L0142
+ <4_31>+L0142
+ extern L0143
+ <4_31>+L0143
+ extern L0144
+ <4_31>+L0144
+ extern L0145
+ <4_31>+L0145
+ extern L0146
+ <4_31>+L0146
+ extern L0147
+ <4_31>+L0147
+ extern L0148
+ <4_31>+L0148
+ extern L0149
+ <4_31>+L0149
+ extern L0150
+ <4_31>+L0150
+ extern L0151
+ <4_31>+L0151
+ extern L0152
+ <4_31>+L0152
+ extern L0153
+ <4_31>+L0153
+ extern L0154
+ <4_31>+L0154
+ extern L0155
+ <4_31>+L0155
+ extern L0156
+ <4_31>+L0156
+ extern L0157
+ <4_31>+L0157
+ extern L0158
+ <4_31>+L0158
+ extern L0159
+ <4_31>+L0159
+ extern L0160
+ <4_31>+L0160
+ extern L0161
+ <4_31>+L0161
+ extern L0162
+ <4_31>+L0162
+ extern L0163
+ <4_31>+L0163
+ extern L0164
+ <4_31>+L0164
+ extern L0165
+ <4_31>+L0165
+ extern L0166
+ <4_31>+L0166
+ extern L0167
+ <4_31>+L0167
+ extern L0168
+ <4_31>+L0168
+ extern L0169
+ <4_31>+L0169
+ extern L0170
+ <4_31>+L0170
+ extern L0171
+ <4_31>+L0171
+ extern L0172
+ <4_31>+L0172
+ extern L0173
+ <4_31>+L0173
+ extern L0174
+ <4_31>+L0174
+ extern L0175
+ <4_31>+L0175
+ extern L0176
+ <4_31>+L0176
+ extern L0177
+ <4_31>+L0177
+ extern L0178
+ <4_31>+L0178
+ extern L0179
+ <4_31>+L0179
+ extern L0180
+ <4_31>+L0180
+ extern L0181
+ <4_31>+L0181
+ extern L0182
+ <4_31>+L0182
+ extern L0183
+ <4_31>+L0183
+ extern L0184
+ <4_31>+L0184
+ extern L0185
+ <4_31>+L0185
+ extern L0186
+ <4_31>+L0186
+ extern L0187
+ <4_31>+L0187
+ extern L0188
+ <4_31>+L0188
+ extern L0189
+ <4_31>+L0189
+ extern L0190
+ <4_31>+L0190
+ extern L0191
+ <4_31>+L0191
+ extern L0192
+ <4_31>+L0192
+ extern L0193
+ <4_31>+L0193
+ extern L0194
+ <4_31>+L0194
+ extern L0195
+ <4_31>+L0195
+ extern L0196
+ <4_31>+L0196
+ extern L0197
+ <4_31>+L0197
+ extern L0198
+ <4_31>+L0198
+ extern L0199
+ <4_31>+L0199
+ extern L0200
+ <4_31>+L0200
+ extern L0201
+ <4_31>+L0201
+ extern L0202
+ <4_31>+L0202
+ extern L0203
+ <4_31>+L0203
+ extern L0204
+ <4_31>+L0204
+ extern L0205
+ <4_31>+L0205
+ extern L0206
+ <4_31>+L0206
+ extern L0207
+ <4_31>+L0207
+ extern L0208
+ <4_31>+L0208
+ extern L0209
+ <4_31>+L0209
+ extern L0210
+ <4_31>+L0210
+ extern L0211
+ <4_31>+L0211
+ extern L0212
+ <4_31>+L0212
+ extern L0213
+ <4_31>+L0213
+ extern L0214
+ <4_31>+L0214
+ extern L0215
+ <4_31>+L0215
+ extern L0216
+ <4_31>+L0216
+ extern L0217
+ <4_31>+L0217
+ extern L0218
+ <4_31>+L0218
+ extern L0219
+ <4_31>+L0219
+ extern L0220
+ <4_31>+L0220
+ extern L0221
+ <4_31>+L0221
+ 168
+ 169
+ 170
+ 171
+ 172
+ 173
+ 174
+ 175
+ 176
+ 177
+ 178
+ 179
+ 180
+ 181
+ 182
+ 183
+ 184
+ 185
+ 186
+ 187
+ 188
+ 189
+ 190
+ 191
+ 192
+ 193
+ 194
+ 195
+ 196
+ 197
+ 198
+ 199
+ 200
+ 201
+ 202
+ 203
+ 204
+ 205
+ 206
+ 207
+ 208
+ 209
+ 210
+ 211
+ 212
+ 213
+ 214
+ 215
+ 216
+ 217
+ 218
+ 219
+ 220
+ 221
+ 222
+ 223
+ 224
+ 225
+ 226
+ 227
+ 228
+ 229
+ 230
+ 231
+ 232
+ 233
+ 234
+ 235
+ 236
+ 237
+ 238
+ 239
+ 240
+ 241
+ 242
+ 243
+ 244
+ 245
+ 246
+ 247
+ 248
+ 249
+ 250
+ 251
+ 252
+ 253
+ 254
+ 255
+ 256
+ 257
+ 258
+ 259
+ 260
+ 261
+ 262
+ 263
+ 264
+ 265
+ 266
+ 267
+ 268
+ 269
+ 270
+ 271
+ 272
+ 273
+ 274
+ 275
+ 276
+ 277
+ 278
+ 279
+ 280
+ 281
+ 282
+ 283
+ 284
+ 285
+ 286
+ 287
+ 288
+ 289
+ 290
+ 291
+ 292
+ 293
+ 294
+ 295
+ 296
+ 297
+ 298
+ 299
+ 300
+ 301
+ 302
+ 303
+ 304
+ 305
+ 306
+ 307
+ 308
+ 309
+ 310
+ 311
+ 312
+ 313
+ 314
+ 315
+ 316
+ 317
+ 318
+ 319
+ 320
+ 321
+ 322
+ 323
+ 324
+ 325
+ 326
+ 327
+ 328
+ 329
+ 330
+ 331
+ 332
+ 333
+ 334
+ 335
+ 336
+ 337
+ 338
+ 339
+ 340
+ 341
+ 342
+ 343
+ 344
+ 345
+ 346
+ 347
+ 348
+ 349
+ 350
+ 351
+ 352
+ 353
+ 354
+ 355
+ 356
+ 357
+ 358
+ 359
+ 360
+ 361
+ 362
+ 363
+ 364
+ 365
+ 366
+ 367
+ 368
+ 369
+ 370
+ 371
+ 372
+ 373
+ 374
+ 375
+ 376
+ 377
+ 378
+ 379
+ 380
+ 381
+ 382
+ 383
+ 384
+ 385
+ 386
+ 387
+ 388
+ 389
+ 390
+ 391
+ 392
+ 393
+ 394
+ 395
+ 396
+ 397
+ 398
+ 399
+ 400
+ 401
+ 402
+ 403
+ 404
+ 405
+ 406
+ 407
+ 408
+ 409
+ 410
+ 411
+ 412
+ 413
+ 414
+ 415
+ 416
+ 417
+ 418
+ 419
+ 420
+ 421
+ 422
+ 423
+ 424
+ 425
+ 426
+ 427
+ 428
+ 429
+ 430
+ 431
+ 432
+ 433
+ 434
+ 435
+ 436
+ 437
+ 438
+ 439
+ 440
+ 441
+ 442
+ 443
+ 444
+ 445
+ 446
+ 447
+ 448
+ 449
+ 450
+ 451
+ 452
+ 453
+ 454
+ 455
+ 456
+ 457
+ 458
+ 459
+ 460
+ 461
+ 462
+ 463
+ 464
+ 465
+ 466
+ 467
+ 468
+ 469
+ 470
+ 471
+ 472
+ 473
+ 474
+ 475
+ 476
+ 477
+ 478
+ 479
+ 480
+ 481
+ 482
+ 483
+ 484
+ 485
+ 486
+ 487
+ 488
+ 489
+ 490
+ 491
+ 492
+ 493
+ 494
+ 495
+ 496
+ 497
+ 498
+ 499
+ 500
+ 501
+ 502
+ 503
+ 504
+ 505
+ 506
+ 507
+ 508
+ 509
+ 510
+ 511
+ 512
+ 513
+ 514
+ 515
+ 516
+ 517
+ 518
+ 519
+ 520
+ 521
+ 522
+ 523
+ 524
+ 525
+ 526
+ 527
+ 528
+ 529
+ 530
+ 531
+ 532
+ 533
+ 534
+ 535
+ 536
+ 537
+ 538
+ 539
+ 540
+ 541
+ 542
+ 543
+ 544
+ 545
+ 546
+ 547
+ 548
+ 549
+ 550
+ 551
+ 552
+ 553
+ 554
+ 555
+ 556
+ 557
+ 558
+ 559
+ 560
+ 561
+ 562
+ 563
+ 564
+ 565
+ 566
+ 567
+ 568
+ 569
+ 570
+ 571
+ 572
+ 573
+ 574
+ 575
+ 576
+ 577
+ 578
+ 579
+ 580
+ 581
+ 582
+ 583
+ 584
+ 585
+ 586
+ 587
+ 588
+ 589
+ 590
+ 591
+ 592
+ 593
+ 594
+ 595
+ 596
+ 597
+ 598
+ 599
+ 600
+ 601
+ 602
+ 603
+ 604
+ 605
+ 606
+ 607
+ 608
+ 609
+ 610
+ 611
+ 612
+ 613
+ 614
+ 615
+ 616
+ 617
+ 618
+ 619
+ 620
+ 621
+ 622
+ 623
+ 624
+ 625
+ 626
+ 627
+ 628
+ 629
+ 630
+ 631
+ 632
+ 633
+ 634
+ 635
+ 636
+ 637
+ 638
+ 639
+ 640
+ 641
+ 642
+ 643
+ 644
+ 645
+ 646
+ 647
+ 648
+ 649
+ 650
+ 651
+ 652
+ 653
+ 654
+ 655
+ 656
+ 657
+ 658
+ 659
+ 660
+ 661
+ 662
+ 663
+ 664
+ 665
+ 666
+ 667
+ 668
+ 669
+ 670
+ 671
+ 672
+ 673
+ 674
+ 675
+ 676
+ 677
+ 678
+ 679
+ 680
+ 681
+ 682
+ 683
+ 684
+ 685
+ 686
+ 687
+ 688
+ 689
+ 690
+ 691
+ 692
+ 693
+ 694
+ 695
+ 696
+ 697
+ 698
+ 699
+ 700
+ 701
+ 702
+ 703
+ 704
+ 705
+ 706
+ 707
+ 708
+ 709
+ 710
+ 711
+ 712
+ 713
+ 714
+ 715
+ 716
+ 717
+ 718
+ 719
+ 720
+ 721
+ 722
+ 723
+ 724
+ 725
+ 726
+ 727
+ 728
+ 729
+ 730
+ 731
+ 732
+ 733
+ 734
+ 735
+ 736
+ 737
+ 738
+ 739
+ 740
+ 741
+ 742
+ 743
+ 744
+ 745
+ 746
+ 747
+ 748
+ 749
+ 750
+ 751
+ 752
+ 753
+ 754
+ 755
+ 756
+ 757
+ 758
+ 759
+ 760
+ 761
+ 762
+ 763
+ 764
+ 765
+ 766
+ 767
+ 768
+ 769
+ 770
+ 771
+ 772
+ 773
+ 774
+ 775
+ 776
+ 777
+ 778
+ 779
+ 780
+ 781
+ 782
+ 783
+ 784
+ 785
+ 786
+ 787
+ 788
+ 789
+ 790
+ 791
+ 792
+ 793
+ 794
+ 795
+ 796
+ 797
+ 798
+ 799
+ 800
+ 0
+SYMFNC: intern SYMFNC
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ extern L0017
+ jrst L0017##
+ extern L0035
+ jrst L0035##
+ extern MAIN.
+ jrst MAIN.##
+ extern INIT
+ jrst INIT##
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ extern GETC
+ jrst GETC##
+ extern TIMC
+ jrst TIMC##
+ JRST SYMFNC+149
+ extern PUTC
+ jrst PUTC##
+ extern QUIT
+ jrst QUIT##
+ extern L0021
+ jrst L0021##
+ JRST SYMFNC+149
+ extern RESET
+ jrst RESET##
+ extern DATE
+ jrst DATE##
+ extern L0028
+ jrst L0028##
+ extern PUTINT
+ jrst PUTINT##
+ extern L0029
+ jrst L0029##
+ extern L0030
+ jrst L0030##
+ extern L0031
+ jrst L0031##
+ JRST SYMFNC+149
+ JRST SYMFNC+149
+ extern L0053
+ jrst L0053##
+ extern L0032
+ jrst L0032##
+ JRST SYMFNC+149
+ extern L0033
+ jrst L0033##
+ JRST SYMFNC+149
+ extern L0034
+ jrst L0034##
+ extern IFACT
+ jrst IFACT##
+ extern TERPRI
+ jrst TERPRI##
+ extern L0036
+ jrst L0036##
+ extern L0042
+ jrst L0042##
+ extern L0038
+ jrst L0038##
+ extern FACT
+ jrst FACT##
+ extern L0049
+ jrst L0049##
+ extern TAK
+ jrst TAK##
+ extern L0054
+ jrst L0054##
+ block 634
+L0003: intern L0003
+ 167
+ end
ADDED psl-1983/3-1/tests/20/dmain1.rel
Index: psl-1983/3-1/tests/20/dmain1.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain1.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain2.rel
Index: psl-1983/3-1/tests/20/dmain2.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain2.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain3.rel
Index: psl-1983/3-1/tests/20/dmain3.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain3.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain4.rel
Index: psl-1983/3-1/tests/20/dmain4.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain4.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain5.rel
Index: psl-1983/3-1/tests/20/dmain5.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain5.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain6.rel
Index: psl-1983/3-1/tests/20/dmain6.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain6.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain7.rel
Index: psl-1983/3-1/tests/20/dmain7.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain7.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dmain9.rel
Index: psl-1983/3-1/tests/20/dmain9.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dmain9.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub2.rel
Index: psl-1983/3-1/tests/20/dsub2.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub2.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub3.rel
Index: psl-1983/3-1/tests/20/dsub3.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub3.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub4.rel
Index: psl-1983/3-1/tests/20/dsub4.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub4.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub5a.rel
Index: psl-1983/3-1/tests/20/dsub5a.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub5a.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub5b.rel
Index: psl-1983/3-1/tests/20/dsub5b.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub5b.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub6.rel
Index: psl-1983/3-1/tests/20/dsub6.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub6.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub7.rel
Index: psl-1983/3-1/tests/20/dsub7.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub7.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub8.rel
Index: psl-1983/3-1/tests/20/dsub8.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub8.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/dsub9.rel
Index: psl-1983/3-1/tests/20/dsub9.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/dsub9.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/fiddle.bar
Index: psl-1983/3-1/tests/20/fiddle.bar
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/fiddle.bar
@@ -0,0 +1,1 @@
+THIS IS A STRING OF N
ADDED psl-1983/3-1/tests/20/field.init
Index: psl-1983/3-1/tests/20/field.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/field.init
@@ -0,0 +1,1 @@
+(FLAG '(INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20) 'INTERNALFUNCTION)
ADDED psl-1983/3-1/tests/20/fresh.init
Index: psl-1983/3-1/tests/20/fresh.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/fresh.init
ADDED psl-1983/3-1/tests/20/fresh.mic
Index: psl-1983/3-1/tests/20/fresh.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/fresh.mic
@@ -0,0 +1,28 @@
+;; Independant compilation of a PSL program
+;
+; DO FRESH modulename
+;
+; Initialize for new sequence of builds
+;
+@delete 'a.SYM
+@copy pc:bare-psl.sym 'A.sym
+@define DSK:, DSK:, PT:, P20:, PI:
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@get s:test-DEC20-cross.exe
+@st
+off break; %kill obnoxious break loops
+off USERMODE ;
+InputSymFile!* := "'A.sym"$
+OutputSymFile!* := "'A.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''NIL;
+ ModName!*:='''A;
+ASMOUT "FRESH"$
+ASMEnd$
+quit$
+@reset .
+@terminal length 24
+@delete Fresh.mac
+@delete DFresh.mac
ADDED psl-1983/3-1/tests/20/init7
Index: psl-1983/3-1/tests/20/init7
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/init7
@@ -0,0 +1,10 @@
+(de mkquote(x) (list 'quote x))
+(de flag(x y) NIL)
+(prin2t "sub2.init")(lapin "sub2.init")
+(prin2t "sub3.init")(lapin "sub3.init")
+(prin2t "sub4.init")(lapin "sub4.init")
+(prin2t "sub5a.init")(lapin "sub5a.init")
+(prin2t "sub5b.init")(lapin "sub5b.init")
+(prin2t "sub6.init")(lapin "sub6.init")
+(prin2t "sub7.init")(lapin "sub7.init")
+(prin2t "main7.init")(lapin "main7.init")
ADDED psl-1983/3-1/tests/20/init8
Index: psl-1983/3-1/tests/20/init8
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/init8
@@ -0,0 +1,13 @@
+(setq !*pval nil)
+(de mkquote(x) (list 'quote x))
+(de flag(x y) NIL)
+(prin2t "sub2.init")(lapin "sub2.init")
+(prin2t "sub3.init")(lapin "sub3.init")
+(prin2t "sub4.init")(lapin "sub4.init")
+(prin2t "sub5a.init")(lapin "sub5a.init")
+(prin2t "sub5b.init")(lapin "sub5b.init")
+(prin2t "sub6.init")(lapin "sub6.init")
+(prin2t "sub7.init")(lapin "sub7.init")
+(prin2t "sub8.init")(lapin "sub8.init")
+(prin2t "main8.init")(lapin "main8.init")
+(setq !*pval T)
ADDED psl-1983/3-1/tests/20/init9
Index: psl-1983/3-1/tests/20/init9
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/init9
@@ -0,0 +1,10 @@
+(prin2t "sub2.init")(lapin "sub2.init")
+(prin2t "sub3.init")(lapin "sub3.init")
+(prin2t "sub4.init")(lapin "sub4.init")
+(prin2t "sub5a.init")(lapin "sub5a.init")
+(prin2t "sub5b.init")(lapin "sub5b.init")
+(prin2t "sub6.init")(lapin "sub6.init")
+(prin2t "sub7.init")(lapin "sub7.init")
+(prin2t "sub8.init")(lapin "sub8.init")
+(prin2t "sub9.init")(lapin "sub9.init")
+(prin2t "main9.init")(lapin "main9.init")
ADDED psl-1983/3-1/tests/20/junk.it
Index: psl-1983/3-1/tests/20/junk.it
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/junk.it
@@ -0,0 +1,3 @@
+This is the Test.It file.
+It has 3 lines (this is Line 2)
+This is the last line.
ADDED psl-1983/3-1/tests/20/junk.junk
Index: psl-1983/3-1/tests/20/junk.junk
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/junk.junk
@@ -0,0 +1,3 @@
+Line 1
+Line 2
+Line 3 (last)
ADDED psl-1983/3-1/tests/20/main0.cmd
Index: psl-1983/3-1/tests/20/main0.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main0.cmd
@@ -0,0 +1,2 @@
+main0,Dmain0,20io
+
ADDED psl-1983/3-1/tests/20/main0.init
Index: psl-1983/3-1/tests/20/main0.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main0.init
@@ -0,0 +1,4 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/3-1/tests/20/main0.mac
Index: psl-1983/3-1/tests/20/main0.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main0.mac
@@ -0,0 +1,987 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern L0001
+ extern L0002
+ extern HEAP
+ extern L0006
+ extern L0007
+ extern L0008
+ extern L0009
+ extern L0010
+ extern L0011
+ extern L0012
+ extern BPS
+ extern L0013
+ extern L0014
+ extern L0015
+ extern L0016
+; (!*ENTRY INITHEAP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR HEAPLOWERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPLOWERBOUND))
+; (MOVEM (REG T1) (WVAR HEAPLAST))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*MOVE (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (MOVEM (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INITHEAP EXPR 0)
+L0017: intern L0017
+ MOVE 6,L0006
+ MOVEM 6,L0008
+ SETZM 1
+ MOVEM 1,L0010
+ POPJ 15,0
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ extern L0005
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (MOVE (REG NIL) (FLUID NIL))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (HRRZI (REG LINKREG) 130)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L0018
+ MOVE 0,SYMVAL+128
+ HRRZI 12,130
+ SETZM 13
+ JRST SYMFNC+130
+L0018: byte(18)-5000,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK INIT20 EXPR 1)
+ extern INIT20
+; (PUSHJ (REG ST) (INTERNALENTRY INIT20))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ PUSHJ 15,INIT20
+ SETZM SYMVAL+133
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+134
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 0) (!$FLUID IN!*))
+; (SKIPE (!$FLUID IN!*))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+ extern GETC20
+; (PUSHJ (REG ST) (INTERNALENTRY GETC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID IN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID IN!*))
+; (!*LINKE 0 INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 135)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTREADCHAR))
+ 0
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SKIPE SYMVAL+133
+ JRST L0019
+ SETZM 1
+ PUSHJ 15,GETC20
+ POPJ 15,0
+L0019: MOVE 1,SYMVAL+133
+ HRRZI 12,135
+ HRRZI 13,1
+ JRST SYMFNC+135
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+ extern TIMC20
+; (PUSHJ (REG ST) (INTERNALENTRY TIMC20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ PUSHJ 15,TIMC20
+ POPJ 15,0
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 1) (!$FLUID OUT!*))
+; (MOVE (REG T2) (!$FLUID OUT!*))
+; (CAIE (REG T2) 1)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PUTC20 EXPR 1)
+ extern PUTC20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID OUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ MOVE 7,SYMVAL+134
+ CAIE 7,1
+ JRST L0020
+ PUSHJ 15,PUTC20
+ POPJ 15,0
+L0020: MOVE 2,1
+ MOVE 1,SYMVAL+134
+ HRRZI 12,138
+ HRRZI 13,2
+ JRST SYMFNC+138
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+ extern QUIT20
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY EXITLISP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY EXITLISP EXPR 0)
+L0021: intern L0021
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY RESET EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Should RESET here, but will QUIT") (REG 1))
+; (MOVE (REG 1) (QUOTE "Should RESET here, but will QUIT"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 140)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0023: 31
+ byte(7)83,104,111,117,108,100,32,82,69,83,69,84,32,104,101,114,101,44,32,98,117,116,32,119,105,108,108,32,81,85,73,84,0
+ 0
+; (!*ENTRY RESET EXPR 0)
+RESET: intern RESET
+ MOVE 1,L0022
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ HRRZI 12,140
+ SETZM 13
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ POPJ 15,0
+L0022: <4_31>+L0023
+; (!*ENTRY DATE EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "No-Date-Yet") (REG 1))
+; (MOVE (REG 1) (QUOTE "No-Date-Yet"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0025: 10
+ byte(7)78,111,45,68,97,116,101,45,89,101,116,0
+ 0
+; (!*ENTRY DATE EXPR 0)
+DATE: intern DATE
+ MOVE 1,L0024
+ POPJ 15,0
+L0024: <4_31>+L0025
+; (!*ENTRY VERSIONNAME EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "DEC-20 test system") (REG 1))
+; (MOVE (REG 1) (QUOTE "DEC-20 test system"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0027: 17
+ byte(7)68,69,67,45,50,48,32,116,101,115,116,32,115,121,115,116,101,109,0
+ 0
+; (!*ENTRY VERSIONNAME EXPR 0)
+L0028: intern L0028
+ MOVE 1,L0026
+ POPJ 15,0
+L0026: <4_31>+L0027
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+ extern PUTI20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTI20))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ PUSHJ 15,PUTI20
+ POPJ 15,0
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*WOR (REG 1) 23085449216)
+; (IOR (REG 1) 23085449216)
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+L0029: intern L0029
+ IOR 1,[23085449216]
+ MOVEM 1,0(2)
+ POPJ 15,0
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (MEMORY (REG 1) (WCONST 0)) (MEMORY (REG 2) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG 1) 0))
+; (MOVEM (REG T1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+L0030: intern L0030
+ MOVE 6,0(1)
+ MOVEM 6,0(2)
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+; (!*MOVE (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (MOVEM (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (!*MOVE (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (MOVEM (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (!*JCALL UNDEFINEDFUNCTIONAUX)
+; (JRST (ENTRY UNDEFINEDFUNCTIONAUX))
+ 0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+L0031: intern L0031
+ MOVEM 12,SYMVAL+150
+ MOVEM 13,SYMVAL+151
+ JRST SYMFNC+152
+; (!*ENTRY LONGTIMES EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGTIMES EXPR 2)
+L0032: intern L0032
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY LONGDIV EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 154)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGDIV EXPR 2)
+L0033: intern L0033
+ HRRZI 12,154
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+; (!*ENTRY LONGREMAINDER EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 156)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (MOVE (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGREMAINDER EXPR 2)
+L0034: intern L0034
+ HRRZI 12,156
+ HRRZI 13,2
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK INIT EXPR 0)
+; (HRRZI (REG LINKREG) 132)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INIT))
+; (!*MOVE (QUOTE 65) (REG 1))
+; (HRRZI (REG 1) 65)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (QUOTE 66) (REG 1))
+; (HRRZI (REG 1) 66)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 158)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 158)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE 2) (REG 1))
+; (HRRZI (REG 1) 2)
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 158)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 137)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 158)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 137)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 158)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 140)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY FIRSTCALL EXPR 0)
+L0035: intern L0035
+ HRRZI 12,132
+ SETZM 13
+ PUSHJ 15,SYMFNC+132
+ HRRZI 1,65
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,66
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 12,158
+ SETZM 13
+ PUSHJ 15,SYMFNC+158
+ HRRZI 1,1
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,158
+ SETZM 13
+ PUSHJ 15,SYMFNC+158
+ HRRZI 1,2
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,158
+ SETZM 13
+ PUSHJ 15,SYMFNC+158
+ HRRZI 12,137
+ SETZM 13
+ PUSHJ 15,SYMFNC+137
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,158
+ SETZM 13
+ PUSHJ 15,SYMFNC+158
+ HRRZI 12,137
+ SETZM 13
+ PUSHJ 15,SYMFNC+137
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,158
+ SETZM 13
+ PUSHJ 15,SYMFNC+158
+ HRRZI 12,140
+ SETZM 13
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY TERPRI EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINKE 0 PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+ 0
+; (!*ENTRY TERPRI EXPR 0)
+TERPRI: intern TERPRI
+ HRRZI 1,10
+ HRRZI 12,139
+ HRRZI 13,1
+ JRST SYMFNC+139
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L0036: intern L0036
+ MOVE 1,0
+ POPJ 15,0
+ extern SYMVAL
+ extern SYMPRP
+ extern SYMNAM
+L0037: 0
+ byte(7)0,0
+ intern L0037
+L0038: 0
+ byte(7)1,0
+ intern L0038
+L0039: 0
+ byte(7)2,0
+ intern L0039
+L0040: 0
+ byte(7)3,0
+ intern L0040
+L0041: 0
+ byte(7)4,0
+ intern L0041
+L0042: 0
+ byte(7)5,0
+ intern L0042
+L0043: 0
+ byte(7)6,0
+ intern L0043
+L0044: 0
+ byte(7)7,0
+ intern L0044
+L0045: 0
+ byte(7)8,0
+ intern L0045
+L0046: 0
+ byte(7)9,0
+ intern L0046
+L0047: 0
+ byte(7)10,0
+ intern L0047
+L0048: 0
+ byte(7)11,0
+ intern L0048
+L0049: 0
+ byte(7)12,0
+ intern L0049
+L0050: 0
+ byte(7)13,0
+ intern L0050
+L0051: 0
+ byte(7)14,0
+ intern L0051
+L0052: 0
+ byte(7)15,0
+ intern L0052
+L0053: 0
+ byte(7)16,0
+ intern L0053
+L0054: 0
+ byte(7)17,0
+ intern L0054
+L0055: 0
+ byte(7)18,0
+ intern L0055
+L0056: 0
+ byte(7)19,0
+ intern L0056
+L0057: 0
+ byte(7)20,0
+ intern L0057
+L0058: 0
+ byte(7)21,0
+ intern L0058
+L0059: 0
+ byte(7)22,0
+ intern L0059
+L0060: 0
+ byte(7)23,0
+ intern L0060
+L0061: 0
+ byte(7)24,0
+ intern L0061
+L0062: 0
+ byte(7)25,0
+ intern L0062
+L0063: 0
+ byte(7)26,0
+ intern L0063
+L0064: 0
+ byte(7)27,0
+ intern L0064
+L0065: 0
+ byte(7)28,0
+ intern L0065
+L0066: 0
+ byte(7)29,0
+ intern L0066
+L0067: 0
+ byte(7)30,0
+ intern L0067
+L0068: 0
+ byte(7)31,0
+ intern L0068
+L0069: 0
+ byte(7)32,0
+ intern L0069
+L0070: 0
+ byte(7)33,0
+ intern L0070
+L0071: 0
+ byte(7)34,0
+ intern L0071
+L0072: 0
+ byte(7)35,0
+ intern L0072
+L0073: 0
+ byte(7)36,0
+ intern L0073
+L0074: 0
+ byte(7)37,0
+ intern L0074
+L0075: 0
+ byte(7)38,0
+ intern L0075
+L0076: 0
+ byte(7)39,0
+ intern L0076
+L0077: 0
+ byte(7)40,0
+ intern L0077
+L0078: 0
+ byte(7)41,0
+ intern L0078
+L0079: 0
+ byte(7)42,0
+ intern L0079
+L0080: 0
+ byte(7)43,0
+ intern L0080
+L0081: 0
+ byte(7)44,0
+ intern L0081
+L0082: 0
+ byte(7)45,0
+ intern L0082
+L0083: 0
+ byte(7)46,0
+ intern L0083
+L0084: 0
+ byte(7)47,0
+ intern L0084
+L0085: 0
+ byte(7)48,0
+ intern L0085
+L0086: 0
+ byte(7)49,0
+ intern L0086
+L0087: 0
+ byte(7)50,0
+ intern L0087
+L0088: 0
+ byte(7)51,0
+ intern L0088
+L0089: 0
+ byte(7)52,0
+ intern L0089
+L0090: 0
+ byte(7)53,0
+ intern L0090
+L0091: 0
+ byte(7)54,0
+ intern L0091
+L0092: 0
+ byte(7)55,0
+ intern L0092
+L0093: 0
+ byte(7)56,0
+ intern L0093
+L0094: 0
+ byte(7)57,0
+ intern L0094
+L0095: 0
+ byte(7)58,0
+ intern L0095
+L0096: 0
+ byte(7)59,0
+ intern L0096
+L0097: 0
+ byte(7)60,0
+ intern L0097
+L0098: 0
+ byte(7)61,0
+ intern L0098
+L0099: 0
+ byte(7)62,0
+ intern L0099
+L0100: 0
+ byte(7)63,0
+ intern L0100
+L0101: 0
+ byte(7)64,0
+ intern L0101
+L0102: 0
+ byte(7)65,0
+ intern L0102
+L0103: 0
+ byte(7)66,0
+ intern L0103
+L0104: 0
+ byte(7)67,0
+ intern L0104
+L0105: 0
+ byte(7)68,0
+ intern L0105
+L0106: 0
+ byte(7)69,0
+ intern L0106
+L0107: 0
+ byte(7)70,0
+ intern L0107
+L0108: 0
+ byte(7)71,0
+ intern L0108
+L0109: 0
+ byte(7)72,0
+ intern L0109
+L0110: 0
+ byte(7)73,0
+ intern L0110
+L0111: 0
+ byte(7)74,0
+ intern L0111
+L0112: 0
+ byte(7)75,0
+ intern L0112
+L0113: 0
+ byte(7)76,0
+ intern L0113
+L0114: 0
+ byte(7)77,0
+ intern L0114
+L0115: 0
+ byte(7)78,0
+ intern L0115
+L0116: 0
+ byte(7)79,0
+ intern L0116
+L0117: 0
+ byte(7)80,0
+ intern L0117
+L0118: 0
+ byte(7)81,0
+ intern L0118
+L0119: 0
+ byte(7)82,0
+ intern L0119
+L0120: 0
+ byte(7)83,0
+ intern L0120
+L0121: 0
+ byte(7)84,0
+ intern L0121
+L0122: 0
+ byte(7)85,0
+ intern L0122
+L0123: 0
+ byte(7)86,0
+ intern L0123
+L0124: 0
+ byte(7)87,0
+ intern L0124
+L0125: 0
+ byte(7)88,0
+ intern L0125
+L0126: 0
+ byte(7)89,0
+ intern L0126
+L0127: 0
+ byte(7)90,0
+ intern L0127
+L0128: 0
+ byte(7)91,0
+ intern L0128
+L0129: 0
+ byte(7)92,0
+ intern L0129
+L0130: 0
+ byte(7)93,0
+ intern L0130
+L0131: 0
+ byte(7)94,0
+ intern L0131
+L0132: 0
+ byte(7)95,0
+ intern L0132
+L0133: 0
+ byte(7)96,0
+ intern L0133
+L0134: 0
+ byte(7)97,0
+ intern L0134
+L0135: 0
+ byte(7)98,0
+ intern L0135
+L0136: 0
+ byte(7)99,0
+ intern L0136
+L0137: 0
+ byte(7)100,0
+ intern L0137
+L0138: 0
+ byte(7)101,0
+ intern L0138
+L0139: 0
+ byte(7)102,0
+ intern L0139
+L0140: 0
+ byte(7)103,0
+ intern L0140
+L0141: 0
+ byte(7)104,0
+ intern L0141
+L0142: 0
+ byte(7)105,0
+ intern L0142
+L0143: 0
+ byte(7)106,0
+ intern L0143
+L0144: 0
+ byte(7)107,0
+ intern L0144
+L0145: 0
+ byte(7)108,0
+ intern L0145
+L0146: 0
+ byte(7)109,0
+ intern L0146
+L0147: 0
+ byte(7)110,0
+ intern L0147
+L0148: 0
+ byte(7)111,0
+ intern L0148
+L0149: 0
+ byte(7)112,0
+ intern L0149
+L0150: 0
+ byte(7)113,0
+ intern L0150
+L0151: 0
+ byte(7)114,0
+ intern L0151
+L0152: 0
+ byte(7)115,0
+ intern L0152
+L0153: 0
+ byte(7)116,0
+ intern L0153
+L0154: 0
+ byte(7)117,0
+ intern L0154
+L0155: 0
+ byte(7)118,0
+ intern L0155
+L0156: 0
+ byte(7)119,0
+ intern L0156
+L0157: 0
+ byte(7)120,0
+ intern L0157
+L0158: 0
+ byte(7)121,0
+ intern L0158
+L0159: 0
+ byte(7)122,0
+ intern L0159
+L0160: 0
+ byte(7)123,0
+ intern L0160
+L0161: 0
+ byte(7)124,0
+ intern L0161
+L0162: 0
+ byte(7)125,0
+ intern L0162
+L0163: 0
+ byte(7)126,0
+ intern L0163
+L0164: 0
+ byte(7)127,0
+ intern L0164
+L0165: 2
+ byte(7)78,73,76,0
+ intern L0165
+L0166: 7
+ byte(7)73,78,73,84,72,69,65,80,0
+ intern L0166
+L0167: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L0167
+L0168: 4
+ byte(7)77,65,73,78,46,0
+ intern L0168
+L0169: 3
+ byte(7)73,78,73,84,0
+ intern L0169
+L0170: 2
+ byte(7)73,78,42,0
+ intern L0170
+L0171: 3
+ byte(7)79,85,84,42,0
+ intern L0171
+L0172: 18
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,82,69,65,68,67,72,65,82,0
+ intern L0172
+L0173: 3
+ byte(7)71,69,84,67,0
+ intern L0173
+L0174: 3
+ byte(7)84,73,77,67,0
+ intern L0174
+L0175: 19
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,87,82,73,84,69,67,72,65,82,0
+ intern L0175
+L0176: 3
+ byte(7)80,85,84,67,0
+ intern L0176
+L0177: 3
+ byte(7)81,85,73,84,0
+ intern L0177
+L0178: 7
+ byte(7)69,88,73,84,76,73,83,80,0
+ intern L0178
+L0179: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L0179
+L0180: 4
+ byte(7)82,69,83,69,84,0
+ intern L0180
+L0181: 3
+ byte(7)68,65,84,69,0
+ intern L0181
+L0182: 10
+ byte(7)86,69,82,83,73,79,78,78,65,77,69,0
+ intern L0182
+L0183: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L0183
+L0184: 11
+ byte(7)37,83,84,79,82,69,45,74,67,65,76,76,0
+ intern L0184
+L0185: 18
+ byte(7)37,67,79,80,89,45,70,85,78,67,84,73,79,78,45,67,69,76,76,0
+ intern L0185
+L0186: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L0186
+L0187: 10
+ byte(7)85,78,68,69,70,78,67,79,68,69,42,0
+ intern L0187
+L0188: 10
+ byte(7)85,78,68,69,70,78,78,65,82,71,42,0
+ intern L0188
+L0189: 19
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,0
+ intern L0189
+L0190: 8
+ byte(7)76,79,78,71,84,73,77,69,83,0
+ intern L0190
+L0191: 8
+ byte(7)87,81,85,79,84,73,69,78,84,0
+ intern L0191
+L0192: 6
+ byte(7)76,79,78,71,68,73,86,0
+ intern L0192
+L0193: 9
+ byte(7)87,82,69,77,65,73,78,68,69,82,0
+ intern L0193
+L0194: 12
+ byte(7)76,79,78,71,82,69,77,65,73,78,68,69,82,0
+ intern L0194
+L0195: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L0195
+L0196: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L0196
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/3-1/tests/20/main0.red
Index: psl-1983/3-1/tests/20/main0.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main0.red
@@ -0,0 +1,25 @@
+% Simple 1 file test
+% This is program MAIN1.RED
+
+On SYSLISP;
+
+IN "XXX-HEADER.RED"$
+
+Procedure FirstCall;
+ <<Init();
+ PutC Char A;
+ PutC Char B;
+ Terpri();
+ PutInt 1;
+ Terpri();
+ PutInt 2;
+ Terpri();
+ Putint Timc(); Terpri();
+ Putint Timc(); Terpri();
+ Quit;>>;
+
+procedure terpri();
+ PutC Char EOL;
+
+end;
+
ADDED psl-1983/3-1/tests/20/main0.rel
Index: psl-1983/3-1/tests/20/main0.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main0.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main0.sym
Index: psl-1983/3-1/tests/20/main0.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main0.sym
@@ -0,0 +1,98 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE NIL))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 129))
+(SETQ STRINGGENSYM!* (QUOTE "L0005"))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
ADDED psl-1983/3-1/tests/20/main1.cmd
Index: psl-1983/3-1/tests/20/main1.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main1.cmd
@@ -0,0 +1,2 @@
+main1,Dmain1,20io
+
ADDED psl-1983/3-1/tests/20/main1.init
Index: psl-1983/3-1/tests/20/main1.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main1.init
@@ -0,0 +1,4 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/3-1/tests/20/main1.mac
Index: psl-1983/3-1/tests/20/main1.mac
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main1.mac
@@ -0,0 +1,1696 @@
+ search monsym
+ radix 10
+ extern STACK
+ extern L0001
+ extern L0002
+ extern HEAP
+ extern L0006
+ extern L0007
+ extern L0008
+ extern L0009
+ extern L0010
+ extern L0011
+ extern L0012
+ extern BPS
+ extern L0013
+ extern L0014
+ extern L0015
+ extern L0016
+; (!*ENTRY INITHEAP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WVAR HEAPLOWERBOUND) (WVAR HEAPLAST))
+; (MOVE (REG T1) (WVAR HEAPLOWERBOUND))
+; (MOVEM (REG T1) (WVAR HEAPLAST))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*MOVE (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (MOVEM (REG 1) (WVAR HEAPPREVIOUSLAST))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INITHEAP EXPR 0)
+L0017: intern L0017
+ MOVE 6,L0006
+ MOVEM 6,L0008
+ SETZM 1
+ MOVEM 1,L0010
+ POPJ 15,0
+ extern L0004
+ extern ARG1
+ extern ARG2
+ extern ARG3
+ extern ARG4
+ extern ARG5
+ extern ARG6
+ extern ARG7
+ extern ARG8
+ extern ARG9
+ extern ARG10
+ extern ARG11
+ extern ARG12
+ extern ARG13
+ extern ARG14
+ extern ARG15
+ extern L0005
+; (!*ENTRY MAIN!. EXPR 0)
+; (RESET)
+; (MOVE (REG ST) (LIT (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))))
+; (MOVE (REG NIL) (FLUID NIL))
+; (!*LINKE 0 FIRSTCALL EXPR 0)
+; (HRRZI (REG LINKREG) 130)
+; (SETZM (REG NARGREG))
+; (JRST (ENTRY FIRSTCALL))
+; (HALFWORD (MINUS (WCONST STACKSIZE)) (DIFFERENCE (WCONST STACK) 1))
+ 0
+; (!*ENTRY MAIN!. EXPR 0)
+ intern MAIN.
+MAIN.: RESET
+ MOVE 15,L0018
+ MOVE 0,SYMVAL+128
+ HRRZI 12,130
+ SETZM 13
+ JRST SYMFNC+130
+L0018: byte(18)-5000,STACK-1
+; (!*ENTRY INIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINK INIT20 EXPR 1)
+ extern INIT20
+; (PUSHJ (REG ST) (INTERNALENTRY INIT20))
+; (!*MOVE (WCONST 0) (!$FLUID IN!*))
+; (SETZM (!$FLUID IN!*))
+; (!*MOVE (WCONST 1) (!$FLUID OUT!*))
+; (HRRZI (REG T1) 1)
+; (MOVEM (REG T1) (!$FLUID OUT!*))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY INIT EXPR 0)
+INIT: intern INIT
+ SETZM 1
+ PUSHJ 15,INIT20
+ SETZM SYMVAL+133
+ HRRZI 6,1
+ MOVEM 6,SYMVAL+134
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY GETC EXPR 0)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 0) (!$FLUID IN!*))
+; (SKIPE (!$FLUID IN!*))
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 GETC20 EXPR 1)
+ extern GETC20
+; (PUSHJ (REG ST) (INTERNALENTRY GETC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (!$FLUID IN!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID IN!*))
+; (!*LINKE 0 INDEPENDENTREADCHAR EXPR 1)
+; (HRRZI (REG LINKREG) 135)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY INDEPENDENTREADCHAR))
+ 0
+; (!*ENTRY GETC EXPR 0)
+GETC: intern GETC
+ SKIPE SYMVAL+133
+ JRST L0019
+ SETZM 1
+ PUSHJ 15,GETC20
+ POPJ 15,0
+L0019: MOVE 1,SYMVAL+133
+ HRRZI 12,135
+ HRRZI 13,1
+ JRST SYMFNC+135
+; (!*ENTRY TIMC EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 TIMC20 EXPR 1)
+ extern TIMC20
+; (PUSHJ (REG ST) (INTERNALENTRY TIMC20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TIMC EXPR 0)
+TIMC: intern TIMC
+ SETZM 1
+ PUSHJ 15,TIMC20
+ POPJ 15,0
+; (!*ENTRY PUTC EXPR 1)
+; (!*ALLOC 0)
+; (!*JUMPNOTEQ (LABEL G0004) (WCONST 1) (!$FLUID OUT!*))
+; (MOVE (REG T2) (!$FLUID OUT!*))
+; (CAIE (REG T2) 1)
+; (JRST (LABEL G0004))
+; (!*LINKE 0 PUTC20 EXPR 1)
+ extern PUTC20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTC20))
+; (POPJ (REG ST) 0)
+; (!*LBL (LABEL G0004))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (!$FLUID OUT!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID OUT!*))
+; (!*LINKE 0 INDEPENDENTWRITECHAR EXPR 2)
+; (HRRZI (REG LINKREG) 138)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY INDEPENDENTWRITECHAR))
+ 1
+; (!*ENTRY PUTC EXPR 1)
+PUTC: intern PUTC
+ MOVE 7,SYMVAL+134
+ CAIE 7,1
+ JRST L0020
+ PUSHJ 15,PUTC20
+ POPJ 15,0
+L0020: MOVE 2,1
+ MOVE 1,SYMVAL+134
+ HRRZI 12,138
+ HRRZI 13,2
+ JRST SYMFNC+138
+; (!*ENTRY QUIT EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+ extern QUIT20
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY QUIT EXPR 0)
+QUIT: intern QUIT
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY EXITLISP EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 0) (REG 1))
+; (SETZM (REG 1))
+; (!*LINKE 0 QUIT20 EXPR 1)
+; (PUSHJ (REG ST) (INTERNALENTRY QUIT20))
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY EXITLISP EXPR 0)
+L0021: intern L0021
+ SETZM 1
+ PUSHJ 15,QUIT20
+ POPJ 15,0
+; (!*ENTRY RESET EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "Should RESET here, but will QUIT") (REG 1))
+; (MOVE (REG 1) (QUOTE "Should RESET here, but will QUIT"))
+; (!*LINK PRIN2T EXPR 1)
+; (HRRZI (REG LINKREG) 142)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PRIN2T))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 140)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0023: 31
+ byte(7)83,104,111,117,108,100,32,82,69,83,69,84,32,104,101,114,101,44,32,98,117,116,32,119,105,108,108,32,81,85,73,84,0
+ 0
+; (!*ENTRY RESET EXPR 0)
+RESET: intern RESET
+ MOVE 1,L0022
+ HRRZI 12,142
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+142
+ HRRZI 12,140
+ SETZM 13
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ POPJ 15,0
+L0022: <4_31>+L0023
+; (!*ENTRY DATE EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "No-Date-Yet") (REG 1))
+; (MOVE (REG 1) (QUOTE "No-Date-Yet"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0025: 10
+ byte(7)78,111,45,68,97,116,101,45,89,101,116,0
+ 0
+; (!*ENTRY DATE EXPR 0)
+DATE: intern DATE
+ MOVE 1,L0024
+ POPJ 15,0
+L0024: <4_31>+L0025
+; (!*ENTRY VERSIONNAME EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE "DEC-20 test system") (REG 1))
+; (MOVE (REG 1) (QUOTE "DEC-20 test system"))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+L0027: 17
+ byte(7)68,69,67,45,50,48,32,116,101,115,116,32,115,121,115,116,101,109,0
+ 0
+; (!*ENTRY VERSIONNAME EXPR 0)
+L0028: intern L0028
+ MOVE 1,L0026
+ POPJ 15,0
+L0026: <4_31>+L0027
+; (!*ENTRY PUTINT EXPR 1)
+; (!*ALLOC 0)
+; (!*LINKE 0 PUTI20 EXPR 1)
+ extern PUTI20
+; (PUSHJ (REG ST) (INTERNALENTRY PUTI20))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY PUTINT EXPR 1)
+PUTINT: intern PUTINT
+ PUSHJ 15,PUTI20
+ POPJ 15,0
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+; (!*ALLOC 0)
+; (!*WOR (REG 1) 23085449216)
+; (IOR (REG 1) 23085449216)
+; (!*MOVE (REG 1) (MEMORY (REG 2) (WCONST 0)))
+; (MOVEM (REG 1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%STORE!-JCALL EXPR 2)
+L0029: intern L0029
+ IOR 1,[23085449216]
+ MOVEM 1,0(2)
+ POPJ 15,0
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+; (!*ALLOC 0)
+; (!*MOVE (MEMORY (REG 1) (WCONST 0)) (MEMORY (REG 2) (WCONST 0)))
+; (MOVE (REG T1) (INDEXED (REG 1) 0))
+; (MOVEM (REG T1) (INDEXED (REG 2) 0))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY !%COPY!-FUNCTION!-CELL EXPR 2)
+L0030: intern L0030
+ MOVE 6,0(1)
+ MOVEM 6,0(2)
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+; (!*MOVE (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (MOVEM (REG LINKREG) (FLUID UNDEFNCODE!*))
+; (!*MOVE (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (MOVEM (REG NARGREG) (FLUID UNDEFNNARG!*))
+; (!*JCALL UNDEFINEDFUNCTIONAUX)
+; (JRST (ENTRY UNDEFINEDFUNCTIONAUX))
+ 0
+; (!*ENTRY UNDEFINEDFUNCTION EXPR 0)
+L0031: intern L0031
+ MOVEM 12,SYMVAL+150
+ MOVEM 13,SYMVAL+151
+ JRST SYMFNC+152
+; (!*ENTRY LONGTIMES EXPR 2)
+; (!*ALLOC 0)
+; (!*WTIMES2 (REG 1) (REG 2))
+; (IMUL (REG 1) (REG 2))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGTIMES EXPR 2)
+L0032: intern L0032
+ IMUL 1,2
+ POPJ 15,0
+; (!*ENTRY LONGDIV EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WQUOTIENT EXPR 2)
+; (HRRZI (REG LINKREG) 154)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGDIV EXPR 2)
+L0033: intern L0033
+ HRRZI 12,154
+ HRRZI 13,2
+ IDIV 1,2
+ POPJ 15,0
+; (!*ENTRY LONGREMAINDER EXPR 2)
+; (!*ALLOC 0)
+; (!*LINKE 0 WREMAINDER EXPR 2)
+; (HRRZI (REG LINKREG) 156)
+; (HRRZI (REG NARGREG) 2)
+; (IDIV (REG 1) (REG 2))
+; (MOVE (REG 1) (REG 2))
+; (POPJ (REG ST) 0)
+ 2
+; (!*ENTRY LONGREMAINDER EXPR 2)
+L0034: intern L0034
+ HRRZI 12,156
+ HRRZI 13,2
+ IDIV 1,2
+ MOVE 1,2
+ POPJ 15,0
+; (!*ENTRY FIRSTCALL EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK INIT EXPR 0)
+; (HRRZI (REG LINKREG) 132)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY INIT))
+; (!*MOVE (WCONST 70) (REG 1))
+; (HRRZI (REG 1) 70)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 97) (REG 1))
+; (HRRZI (REG 1) 97)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 99) (REG 1))
+; (HRRZI (REG 1) 99)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 61) (REG 1))
+; (HRRZI (REG 1) 61)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINK IFACT EXPR 1)
+; (HRRZI (REG LINKREG) 158)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY IFACT))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (WCONST 84) (REG 1))
+; (HRRZI (REG 1) 84)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 101) (REG 1))
+; (HRRZI (REG 1) 101)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 115) (REG 1))
+; (HRRZI (REG 1) 115)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 116) (REG 1))
+; (HRRZI (REG 1) 116)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 70) (REG 1))
+; (HRRZI (REG 1) 70)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 97) (REG 1))
+; (HRRZI (REG 1) 97)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 99) (REG 1))
+; (HRRZI (REG 1) 99)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 116) (REG 1))
+; (HRRZI (REG 1) 116)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TESTFACT EXPR 0)
+; (HRRZI (REG LINKREG) 160)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TESTFACT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (WCONST 84) (REG 1))
+; (HRRZI (REG 1) 84)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 101) (REG 1))
+; (HRRZI (REG 1) 101)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 115) (REG 1))
+; (HRRZI (REG 1) 115)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 116) (REG 1))
+; (HRRZI (REG 1) 116)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 84) (REG 1))
+; (HRRZI (REG 1) 84)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 97) (REG 1))
+; (HRRZI (REG 1) 97)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (WCONST 107) (REG 1))
+; (HRRZI (REG 1) 107)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TESTTAK EXPR 0)
+; (HRRZI (REG LINKREG) 161)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TESTTAK))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 140)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY FIRSTCALL EXPR 0)
+L0035: intern L0035
+ HRRZI 12,132
+ SETZM 13
+ PUSHJ 15,SYMFNC+132
+ HRRZI 1,70
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,97
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,99
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,61
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,10
+ HRRZI 12,158
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+158
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 1,84
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,101
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,115
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,116
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,70
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,97
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,99
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,116
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 12,160
+ SETZM 13
+ PUSHJ 15,SYMFNC+160
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 1,84
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,101
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,115
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,116
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,84
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,97
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,107
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 12,161
+ SETZM 13
+ PUSHJ 15,SYMFNC+161
+ HRRZI 12,140
+ SETZM 13
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY TERPRI EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (WCONST 10) (REG 1))
+; (HRRZI (REG 1) 10)
+; (!*LINKE 0 PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (JRST (ENTRY PUTC))
+ 0
+; (!*ENTRY TERPRI EXPR 0)
+TERPRI: intern TERPRI
+ HRRZI 1,10
+ HRRZI 12,139
+ HRRZI 13,1
+ JRST SYMFNC+139
+; (!*ENTRY TESTFACT EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 137)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (WCONST 10000) (REG 1))
+; (HRRZI (REG 1) 10000)
+; (!*LINK ARITHMETICTEST EXPR 1)
+; (HRRZI (REG LINKREG) 162)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY ARITHMETICTEST))
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 137)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TESTFACT EXPR 0)
+L0036: intern L0036
+ HRRZI 12,137
+ SETZM 13
+ PUSHJ 15,SYMFNC+137
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 1,10000
+ HRRZI 12,162
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+162
+ HRRZI 12,137
+ SETZM 13
+ PUSHJ 15,SYMFNC+137
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY ARITHMETICTEST EXPR 1)
+; (!*PUSH (WCONST 0))
+; (PUSH (REG ST) (LIT (FULLWORD 0)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPWLEQ (LABEL G0005) (FRAME 2) (FRAME 1))
+; (MOVE (REG T1) (INDEXED (REG ST) -1))
+; (CAMG (REG T1) (INDEXED (REG ST) 0))
+; (JRST (LABEL G0005))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (WCONST 9) (REG 1))
+; (HRRZI (REG 1) 9)
+; (!*LINK FACT EXPR 1)
+; (HRRZI (REG LINKREG) 163)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY FACT))
+; (!*WPLUS2 (FRAME 2) (WCONST 1))
+; (AOS (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 0)
+ 1
+; (!*ENTRY ARITHMETICTEST EXPR 1)
+L0038: intern L0038
+ PUSH 15,L0037
+ PUSH 15,1
+L0039: MOVE 6,-1(15)
+ CAMG 6,0(15)
+ JRST L0040
+ MOVE 1,0
+ JRST L0041
+L0040: HRRZI 1,9
+ HRRZI 12,163
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+163
+ AOS -1(15)
+ JRST L0039
+L0041: ADJSP 15,-2
+ POPJ 15,0
+L0037: 0
+; (!*ENTRY TESTTAK EXPR 0)
+; (!*ALLOC 0)
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 137)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (WCONST 6) (REG 3))
+; (HRRZI (REG 3) 6)
+; (!*MOVE (WCONST 12) (REG 2))
+; (HRRZI (REG 2) 12)
+; (!*MOVE (WCONST 18) (REG 1))
+; (HRRZI (REG 1) 18)
+; (!*LINK TOPLEVELTAK EXPR 3)
+; (HRRZI (REG LINKREG) 164)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (ENTRY TOPLEVELTAK))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK TIMC EXPR 0)
+; (HRRZI (REG LINKREG) 137)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TIMC))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY TESTTAK EXPR 0)
+L0042: intern L0042
+ HRRZI 12,137
+ SETZM 13
+ PUSHJ 15,SYMFNC+137
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 3,6
+ HRRZI 2,12
+ HRRZI 1,18
+ HRRZI 12,164
+ HRRZI 13,3
+ PUSHJ 15,SYMFNC+164
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 12,137
+ SETZM 13
+ PUSHJ 15,SYMFNC+137
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ MOVE 1,0
+ POPJ 15,0
+; (!*ENTRY FACT EXPR 1)
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*JUMPWGEQ (LABEL G0004) (REG 1) (WCONST 2))
+; (CAIL (REG 1) 2)
+; (JRST (LABEL G0004))
+; (!*MOVE (WCONST 1) (REG 1))
+; (HRRZI (REG 1) 1)
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK FACT EXPR 1)
+; (HRRZI (REG LINKREG) 163)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (INTERNALENTRY FACT))
+; (!*MOVE (REG 1) (REG 2))
+; (MOVE (REG 2) (REG 1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINKE 1 LONGTIMES EXPR 2)
+; (ADJSP (REG ST) (MINUS 1))
+; (HRRZI (REG LINKREG) 153)
+; (HRRZI (REG NARGREG) 2)
+; (JRST (ENTRY LONGTIMES))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 1)
+; (ADJSP (REG ST) (MINUS 1))
+; (POPJ (REG ST) 0)
+ 1
+; (!*ENTRY FACT EXPR 1)
+FACT: intern FACT
+ PUSH 15,1
+ CAIL 1,2
+ JRST L0043
+ HRRZI 1,1
+ JRST L0044
+L0043: SOS 1
+ HRRZI 12,163
+ HRRZI 13,1
+ PUSHJ 15,FACT
+ MOVE 2,1
+ MOVE 1,0(15)
+ ADJSP 15,-1
+ HRRZI 12,153
+ HRRZI 13,2
+ JRST SYMFNC+153
+L0044: ADJSP 15,-1
+ POPJ 15,0
+; (!*ENTRY IFACT EXPR 1)
+; (!*PUSH (WCONST 1))
+; (PUSH (REG ST) (LIT (FULLWORD 1)))
+; (!*PUSH (REG 1))
+; (PUSH (REG ST) (REG 1))
+; (!*LBL (LABEL G0004))
+; (!*JUMPNOTEQ (LABEL G0005) (FRAME 1) (WCONST 1))
+; (MOVE (REG T1) (INDEXED (REG ST) 0))
+; (CAIE (REG T1) 1)
+; (JRST (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0005))
+; (!*MOVE (FRAME 2) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK LONGTIMES EXPR 2)
+; (HRRZI (REG LINKREG) 153)
+; (HRRZI (REG NARGREG) 2)
+; (PUSHJ (REG ST) (ENTRY LONGTIMES))
+; (!*MOVE (REG 1) (FRAME 2))
+; (MOVEM (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (FRAME 1) (WCONST -1))
+; (SOS (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 1) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) 0))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*JUMP (LABEL G0004))
+; (JRST (LABEL G0004))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 2)
+; (ADJSP (REG ST) (MINUS 2))
+; (POPJ (REG ST) 0)
+; (FULLWORD 1)
+ 1
+; (!*ENTRY IFACT EXPR 1)
+IFACT: intern IFACT
+ PUSH 15,L0045
+ PUSH 15,1
+L0046: MOVE 6,0(15)
+ CAIE 6,1
+ JRST L0047
+ MOVE 1,-1(15)
+ JRST L0048
+L0047: MOVE 2,-1(15)
+ MOVE 1,0(15)
+ HRRZI 12,153
+ HRRZI 13,2
+ PUSHJ 15,SYMFNC+153
+ MOVEM 1,-1(15)
+ SOS 0(15)
+ MOVE 1,0(15)
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ MOVE 1,-1(15)
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ JRST L0046
+L0048: ADJSP 15,-2
+ POPJ 15,0
+L0045: 1
+; (!*ENTRY TOPLEVELTAK EXPR 3)
+; (!*ALLOC 0)
+; (!*LINKE 0 TAK EXPR 3)
+; (HRRZI (REG LINKREG) 165)
+; (HRRZI (REG NARGREG) 3)
+; (JRST (ENTRY TAK))
+ 3
+; (!*ENTRY TOPLEVELTAK EXPR 3)
+L0049: intern L0049
+ HRRZI 12,165
+ HRRZI 13,3
+ JRST SYMFNC+165
+; (!*ENTRY TAK EXPR 3)
+; (!*ALLOC 5)
+; (ADJSP (REG ST) 5)
+; (!*LBL (LABEL G0002))
+; (!*MOVE (REG 1) (FRAME 1))
+; (MOVEM (REG 1) (INDEXED (REG ST) 0))
+; (!*MOVE (REG 2) (FRAME 2))
+; (MOVEM (REG 2) (INDEXED (REG ST) -1))
+; (!*MOVE (REG 3) (FRAME 3))
+; (MOVEM (REG 3) (INDEXED (REG ST) -2))
+; (!*JUMPWLESSP (LABEL G0004) (REG 2) (REG 1))
+; (CAMGE (REG 2) (REG 1))
+; (JRST (LABEL G0004))
+; (!*MOVE (REG 3) (REG 1))
+; (MOVE (REG 1) (REG 3))
+; (!*JUMP (LABEL G0001))
+; (JRST (LABEL G0001))
+; (!*LBL (LABEL G0004))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 165)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (FRAME 4))
+; (MOVEM (REG 1) (INDEXED (REG ST) -3))
+; (!*MOVE (FRAME 1) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -2))
+; (!*MOVE (FRAME 2) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -1))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 165)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (FRAME 5))
+; (MOVEM (REG 1) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 2) (REG 3))
+; (MOVE (REG 3) (INDEXED (REG ST) -1))
+; (!*MOVE (FRAME 1) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) 0))
+; (!*MOVE (FRAME 3) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -2))
+; (!*WPLUS2 (REG 1) (WCONST -1))
+; (SOS (REG 1))
+; (!*LINK TAK EXPR 3)
+; (HRRZI (REG LINKREG) 165)
+; (HRRZI (REG NARGREG) 3)
+; (PUSHJ (REG ST) (INTERNALENTRY TAK))
+; (!*MOVE (REG 1) (REG 3))
+; (MOVE (REG 3) (REG 1))
+; (!*MOVE (FRAME 5) (REG 2))
+; (MOVE (REG 2) (INDEXED (REG ST) -4))
+; (!*MOVE (FRAME 4) (REG 1))
+; (MOVE (REG 1) (INDEXED (REG ST) -3))
+; (!*JUMP (LABEL G0002))
+; (JRST (LABEL G0002))
+; (!*LBL (LABEL G0001))
+; (!*EXIT 5)
+; (ADJSP (REG ST) (MINUS 5))
+; (POPJ (REG ST) 0)
+ 3
+; (!*ENTRY TAK EXPR 3)
+TAK: intern TAK
+ ADJSP 15,5
+L0050: MOVEM 1,0(15)
+ MOVEM 2,-1(15)
+ MOVEM 3,-2(15)
+ CAMGE 2,1
+ JRST L0051
+ MOVE 1,3
+ JRST L0052
+L0051: SOS 1
+ HRRZI 12,165
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVEM 1,-3(15)
+ MOVE 3,0(15)
+ MOVE 2,-2(15)
+ MOVE 1,-1(15)
+ SOS 1
+ HRRZI 12,165
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVEM 1,-4(15)
+ MOVE 3,-1(15)
+ MOVE 2,0(15)
+ MOVE 1,-2(15)
+ SOS 1
+ HRRZI 12,165
+ HRRZI 13,3
+ PUSHJ 15,TAK
+ MOVE 3,1
+ MOVE 2,-4(15)
+ MOVE 1,-3(15)
+ JRST L0050
+L0052: ADJSP 15,-5
+ POPJ 15,0
+; (!*ENTRY UNDEFINEDFUNCTIONAUX EXPR 0)
+; (!*ALLOC 0)
+; (!*MOVE (QUOTE 85) (REG 1))
+; (HRRZI (REG 1) 85)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (QUOTE 110) (REG 1))
+; (HRRZI (REG 1) 110)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (QUOTE 100) (REG 1))
+; (HRRZI (REG 1) 100)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (QUOTE 101) (REG 1))
+; (HRRZI (REG 1) 101)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (QUOTE 102) (REG 1))
+; (HRRZI (REG 1) 102)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (QUOTE 32) (REG 1))
+; (HRRZI (REG 1) 32)
+; (!*LINK PUTC EXPR 1)
+; (HRRZI (REG LINKREG) 139)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTC))
+; (!*MOVE (!$FLUID UNDEFNCODE!*) (REG 1))
+; (MOVE (REG 1) (!$FLUID UNDEFNCODE!*))
+; (!*LINK PUTINT EXPR 1)
+; (HRRZI (REG LINKREG) 146)
+; (HRRZI (REG NARGREG) 1)
+; (PUSHJ (REG ST) (ENTRY PUTINT))
+; (!*LINK TERPRI EXPR 0)
+; (HRRZI (REG LINKREG) 159)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY TERPRI))
+; (!*LINK QUIT EXPR 0)
+; (HRRZI (REG LINKREG) 140)
+; (SETZM (REG NARGREG))
+; (PUSHJ (REG ST) (ENTRY QUIT))
+; (!*MOVE (QUOTE NIL) (REG 1))
+; (MOVE (REG 1) (REG NIL))
+; (!*EXIT 0)
+; (POPJ (REG ST) 0)
+ 0
+; (!*ENTRY UNDEFINEDFUNCTIONAUX EXPR 0)
+L0053: intern L0053
+ HRRZI 1,85
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,110
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,100
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,101
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,102
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ HRRZI 1,32
+ HRRZI 12,139
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+139
+ MOVE 1,SYMVAL+150
+ HRRZI 12,146
+ HRRZI 13,1
+ PUSHJ 15,SYMFNC+146
+ HRRZI 12,159
+ SETZM 13
+ PUSHJ 15,SYMFNC+159
+ HRRZI 12,140
+ SETZM 13
+ PUSHJ 15,SYMFNC+140
+ MOVE 1,0
+ POPJ 15,0
+ 0
+; (!*ENTRY INITCODE EXPR 0)
+L0054: intern L0054
+ MOVE 1,0
+ POPJ 15,0
+ extern SYMVAL
+ extern SYMPRP
+ extern SYMNAM
+L0055: 0
+ byte(7)0,0
+ intern L0055
+L0056: 0
+ byte(7)1,0
+ intern L0056
+L0057: 0
+ byte(7)2,0
+ intern L0057
+L0058: 0
+ byte(7)3,0
+ intern L0058
+L0059: 0
+ byte(7)4,0
+ intern L0059
+L0060: 0
+ byte(7)5,0
+ intern L0060
+L0061: 0
+ byte(7)6,0
+ intern L0061
+L0062: 0
+ byte(7)7,0
+ intern L0062
+L0063: 0
+ byte(7)8,0
+ intern L0063
+L0064: 0
+ byte(7)9,0
+ intern L0064
+L0065: 0
+ byte(7)10,0
+ intern L0065
+L0066: 0
+ byte(7)11,0
+ intern L0066
+L0067: 0
+ byte(7)12,0
+ intern L0067
+L0068: 0
+ byte(7)13,0
+ intern L0068
+L0069: 0
+ byte(7)14,0
+ intern L0069
+L0070: 0
+ byte(7)15,0
+ intern L0070
+L0071: 0
+ byte(7)16,0
+ intern L0071
+L0072: 0
+ byte(7)17,0
+ intern L0072
+L0073: 0
+ byte(7)18,0
+ intern L0073
+L0074: 0
+ byte(7)19,0
+ intern L0074
+L0075: 0
+ byte(7)20,0
+ intern L0075
+L0076: 0
+ byte(7)21,0
+ intern L0076
+L0077: 0
+ byte(7)22,0
+ intern L0077
+L0078: 0
+ byte(7)23,0
+ intern L0078
+L0079: 0
+ byte(7)24,0
+ intern L0079
+L0080: 0
+ byte(7)25,0
+ intern L0080
+L0081: 0
+ byte(7)26,0
+ intern L0081
+L0082: 0
+ byte(7)27,0
+ intern L0082
+L0083: 0
+ byte(7)28,0
+ intern L0083
+L0084: 0
+ byte(7)29,0
+ intern L0084
+L0085: 0
+ byte(7)30,0
+ intern L0085
+L0086: 0
+ byte(7)31,0
+ intern L0086
+L0087: 0
+ byte(7)32,0
+ intern L0087
+L0088: 0
+ byte(7)33,0
+ intern L0088
+L0089: 0
+ byte(7)34,0
+ intern L0089
+L0090: 0
+ byte(7)35,0
+ intern L0090
+L0091: 0
+ byte(7)36,0
+ intern L0091
+L0092: 0
+ byte(7)37,0
+ intern L0092
+L0093: 0
+ byte(7)38,0
+ intern L0093
+L0094: 0
+ byte(7)39,0
+ intern L0094
+L0095: 0
+ byte(7)40,0
+ intern L0095
+L0096: 0
+ byte(7)41,0
+ intern L0096
+L0097: 0
+ byte(7)42,0
+ intern L0097
+L0098: 0
+ byte(7)43,0
+ intern L0098
+L0099: 0
+ byte(7)44,0
+ intern L0099
+L0100: 0
+ byte(7)45,0
+ intern L0100
+L0101: 0
+ byte(7)46,0
+ intern L0101
+L0102: 0
+ byte(7)47,0
+ intern L0102
+L0103: 0
+ byte(7)48,0
+ intern L0103
+L0104: 0
+ byte(7)49,0
+ intern L0104
+L0105: 0
+ byte(7)50,0
+ intern L0105
+L0106: 0
+ byte(7)51,0
+ intern L0106
+L0107: 0
+ byte(7)52,0
+ intern L0107
+L0108: 0
+ byte(7)53,0
+ intern L0108
+L0109: 0
+ byte(7)54,0
+ intern L0109
+L0110: 0
+ byte(7)55,0
+ intern L0110
+L0111: 0
+ byte(7)56,0
+ intern L0111
+L0112: 0
+ byte(7)57,0
+ intern L0112
+L0113: 0
+ byte(7)58,0
+ intern L0113
+L0114: 0
+ byte(7)59,0
+ intern L0114
+L0115: 0
+ byte(7)60,0
+ intern L0115
+L0116: 0
+ byte(7)61,0
+ intern L0116
+L0117: 0
+ byte(7)62,0
+ intern L0117
+L0118: 0
+ byte(7)63,0
+ intern L0118
+L0119: 0
+ byte(7)64,0
+ intern L0119
+L0120: 0
+ byte(7)65,0
+ intern L0120
+L0121: 0
+ byte(7)66,0
+ intern L0121
+L0122: 0
+ byte(7)67,0
+ intern L0122
+L0123: 0
+ byte(7)68,0
+ intern L0123
+L0124: 0
+ byte(7)69,0
+ intern L0124
+L0125: 0
+ byte(7)70,0
+ intern L0125
+L0126: 0
+ byte(7)71,0
+ intern L0126
+L0127: 0
+ byte(7)72,0
+ intern L0127
+L0128: 0
+ byte(7)73,0
+ intern L0128
+L0129: 0
+ byte(7)74,0
+ intern L0129
+L0130: 0
+ byte(7)75,0
+ intern L0130
+L0131: 0
+ byte(7)76,0
+ intern L0131
+L0132: 0
+ byte(7)77,0
+ intern L0132
+L0133: 0
+ byte(7)78,0
+ intern L0133
+L0134: 0
+ byte(7)79,0
+ intern L0134
+L0135: 0
+ byte(7)80,0
+ intern L0135
+L0136: 0
+ byte(7)81,0
+ intern L0136
+L0137: 0
+ byte(7)82,0
+ intern L0137
+L0138: 0
+ byte(7)83,0
+ intern L0138
+L0139: 0
+ byte(7)84,0
+ intern L0139
+L0140: 0
+ byte(7)85,0
+ intern L0140
+L0141: 0
+ byte(7)86,0
+ intern L0141
+L0142: 0
+ byte(7)87,0
+ intern L0142
+L0143: 0
+ byte(7)88,0
+ intern L0143
+L0144: 0
+ byte(7)89,0
+ intern L0144
+L0145: 0
+ byte(7)90,0
+ intern L0145
+L0146: 0
+ byte(7)91,0
+ intern L0146
+L0147: 0
+ byte(7)92,0
+ intern L0147
+L0148: 0
+ byte(7)93,0
+ intern L0148
+L0149: 0
+ byte(7)94,0
+ intern L0149
+L0150: 0
+ byte(7)95,0
+ intern L0150
+L0151: 0
+ byte(7)96,0
+ intern L0151
+L0152: 0
+ byte(7)97,0
+ intern L0152
+L0153: 0
+ byte(7)98,0
+ intern L0153
+L0154: 0
+ byte(7)99,0
+ intern L0154
+L0155: 0
+ byte(7)100,0
+ intern L0155
+L0156: 0
+ byte(7)101,0
+ intern L0156
+L0157: 0
+ byte(7)102,0
+ intern L0157
+L0158: 0
+ byte(7)103,0
+ intern L0158
+L0159: 0
+ byte(7)104,0
+ intern L0159
+L0160: 0
+ byte(7)105,0
+ intern L0160
+L0161: 0
+ byte(7)106,0
+ intern L0161
+L0162: 0
+ byte(7)107,0
+ intern L0162
+L0163: 0
+ byte(7)108,0
+ intern L0163
+L0164: 0
+ byte(7)109,0
+ intern L0164
+L0165: 0
+ byte(7)110,0
+ intern L0165
+L0166: 0
+ byte(7)111,0
+ intern L0166
+L0167: 0
+ byte(7)112,0
+ intern L0167
+L0168: 0
+ byte(7)113,0
+ intern L0168
+L0169: 0
+ byte(7)114,0
+ intern L0169
+L0170: 0
+ byte(7)115,0
+ intern L0170
+L0171: 0
+ byte(7)116,0
+ intern L0171
+L0172: 0
+ byte(7)117,0
+ intern L0172
+L0173: 0
+ byte(7)118,0
+ intern L0173
+L0174: 0
+ byte(7)119,0
+ intern L0174
+L0175: 0
+ byte(7)120,0
+ intern L0175
+L0176: 0
+ byte(7)121,0
+ intern L0176
+L0177: 0
+ byte(7)122,0
+ intern L0177
+L0178: 0
+ byte(7)123,0
+ intern L0178
+L0179: 0
+ byte(7)124,0
+ intern L0179
+L0180: 0
+ byte(7)125,0
+ intern L0180
+L0181: 0
+ byte(7)126,0
+ intern L0181
+L0182: 0
+ byte(7)127,0
+ intern L0182
+L0183: 2
+ byte(7)78,73,76,0
+ intern L0183
+L0184: 7
+ byte(7)73,78,73,84,72,69,65,80,0
+ intern L0184
+L0185: 8
+ byte(7)70,73,82,83,84,67,65,76,76,0
+ intern L0185
+L0186: 4
+ byte(7)77,65,73,78,46,0
+ intern L0186
+L0187: 3
+ byte(7)73,78,73,84,0
+ intern L0187
+L0188: 2
+ byte(7)73,78,42,0
+ intern L0188
+L0189: 3
+ byte(7)79,85,84,42,0
+ intern L0189
+L0190: 18
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,82,69,65,68,67,72,65,82,0
+ intern L0190
+L0191: 3
+ byte(7)71,69,84,67,0
+ intern L0191
+L0192: 3
+ byte(7)84,73,77,67,0
+ intern L0192
+L0193: 19
+ byte(7)73,78,68,69,80,69,78,68,69,78,84,87,82,73,84,69,67,72,65,82,0
+ intern L0193
+L0194: 3
+ byte(7)80,85,84,67,0
+ intern L0194
+L0195: 3
+ byte(7)81,85,73,84,0
+ intern L0195
+L0196: 7
+ byte(7)69,88,73,84,76,73,83,80,0
+ intern L0196
+L0197: 5
+ byte(7)80,82,73,78,50,84,0
+ intern L0197
+L0198: 4
+ byte(7)82,69,83,69,84,0
+ intern L0198
+L0199: 3
+ byte(7)68,65,84,69,0
+ intern L0199
+L0200: 10
+ byte(7)86,69,82,83,73,79,78,78,65,77,69,0
+ intern L0200
+L0201: 5
+ byte(7)80,85,84,73,78,84,0
+ intern L0201
+L0202: 11
+ byte(7)37,83,84,79,82,69,45,74,67,65,76,76,0
+ intern L0202
+L0203: 18
+ byte(7)37,67,79,80,89,45,70,85,78,67,84,73,79,78,45,67,69,76,76,0
+ intern L0203
+L0204: 16
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,0
+ intern L0204
+L0205: 10
+ byte(7)85,78,68,69,70,78,67,79,68,69,42,0
+ intern L0205
+L0206: 10
+ byte(7)85,78,68,69,70,78,78,65,82,71,42,0
+ intern L0206
+L0207: 19
+ byte(7)85,78,68,69,70,73,78,69,68,70,85,78,67,84,73,79,78,65,85,88,0
+ intern L0207
+L0208: 8
+ byte(7)76,79,78,71,84,73,77,69,83,0
+ intern L0208
+L0209: 8
+ byte(7)87,81,85,79,84,73,69,78,84,0
+ intern L0209
+L0210: 6
+ byte(7)76,79,78,71,68,73,86,0
+ intern L0210
+L0211: 9
+ byte(7)87,82,69,77,65,73,78,68,69,82,0
+ intern L0211
+L0212: 12
+ byte(7)76,79,78,71,82,69,77,65,73,78,68,69,82,0
+ intern L0212
+L0213: 4
+ byte(7)73,70,65,67,84,0
+ intern L0213
+L0214: 5
+ byte(7)84,69,82,80,82,73,0
+ intern L0214
+L0215: 7
+ byte(7)84,69,83,84,70,65,67,84,0
+ intern L0215
+L0216: 6
+ byte(7)84,69,83,84,84,65,75,0
+ intern L0216
+L0217: 13
+ byte(7)65,82,73,84,72,77,69,84,73,67,84,69,83,84,0
+ intern L0217
+L0218: 3
+ byte(7)70,65,67,84,0
+ intern L0218
+L0219: 10
+ byte(7)84,79,80,76,69,86,69,76,84,65,75,0
+ intern L0219
+L0220: 2
+ byte(7)84,65,75,0
+ intern L0220
+L0221: 7
+ byte(7)73,78,73,84,67,79,68,69,0
+ intern L0221
+ extern SYMFNC
+ extern L0003
+ end MAIN.
ADDED psl-1983/3-1/tests/20/main1.rel
Index: psl-1983/3-1/tests/20/main1.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main1.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main1.sym
Index: psl-1983/3-1/tests/20/main1.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main1.sym
@@ -0,0 +1,98 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE NIL))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 129))
+(SETQ STRINGGENSYM!* (QUOTE "L0005"))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
ADDED psl-1983/3-1/tests/20/main2.cmd
Index: psl-1983/3-1/tests/20/main2.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main2.cmd
@@ -0,0 +1,2 @@
+main2,Dmain2,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main2.init
Index: psl-1983/3-1/tests/20/main2.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main2.init
@@ -0,0 +1,5 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/3-1/tests/20/main2.rel
Index: psl-1983/3-1/tests/20/main2.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main2.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main2.sym
Index: psl-1983/3-1/tests/20/main2.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main2.sym
@@ -0,0 +1,198 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 180))
+(SETQ STRINGGENSYM!* (QUOTE "L0135"))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
ADDED psl-1983/3-1/tests/20/main3.cmd
Index: psl-1983/3-1/tests/20/main3.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main3.cmd
@@ -0,0 +1,2 @@
+main3,Dmain3,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main3.init
Index: psl-1983/3-1/tests/20/main3.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main3.init
@@ -0,0 +1,5 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/3-1/tests/20/main3.rel
Index: psl-1983/3-1/tests/20/main3.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main3.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main3.sym
Index: psl-1983/3-1/tests/20/main3.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main3.sym
@@ -0,0 +1,274 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 207))
+(SETQ STRINGGENSYM!* (QUOTE "L0189"))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
ADDED psl-1983/3-1/tests/20/main4.cmd
Index: psl-1983/3-1/tests/20/main4.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main4.cmd
@@ -0,0 +1,2 @@
+main4,Dmain4,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main4.init
Index: psl-1983/3-1/tests/20/main4.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main4.init
@@ -0,0 +1,7 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(PUT (QUOTE SYMFNCBASE) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (CODEPTR!* CODEFORM!* CODENARG!*)))
+(FLUID (QUOTE (CODEPTR!* CODEFORM!* CODENARG!*)))
ADDED psl-1983/3-1/tests/20/main4.rel
Index: psl-1983/3-1/tests/20/main4.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main4.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main4.sym
Index: psl-1983/3-1/tests/20/main4.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main4.sym
@@ -0,0 +1,358 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING EQSTR INITREAD !*RAISE CH!*
+TOK!* TOKTYPE!* DEBUG SETRAISE CLEARWHITE CLEARCOMMENT READSTR DIGITP
+READINT ALPHAESCP READID RATOM WHITEP GETC LONGTIMES BUFFERTOSTRING
+RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP LOWERCASEP UPPERCASEP ALPHANUMP
+LOOKUPSTRING NEWID INITNEWID MAKEFUNBOUND PUTHALFWORD MAPOBL PRINTFEXPRS
+PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION FUNBOUNDP INITOBLIST READ1
+READ READLIST QUOTE)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 252))
+(SETQ STRINGGENSYM!* (QUOTE "L0307"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0285"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0212"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0206"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0221"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0254"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0256"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L0292"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0242"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0273"))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0265"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0289"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE PUTHALFWORD) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0288"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0197"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0284"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0199"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0216"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0250"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0304"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0227"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 216))
ADDED psl-1983/3-1/tests/20/main5.cmd
Index: psl-1983/3-1/tests/20/main5.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main5.cmd
@@ -0,0 +1,2 @@
+main5,Dmain5,sub5a,Dsub5a,sub5b,dsub5b,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main5.init
Index: psl-1983/3-1/tests/20/main5.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main5.init
@@ -0,0 +1,5 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
ADDED psl-1983/3-1/tests/20/main5.rel
Index: psl-1983/3-1/tests/20/main5.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main5.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main5.sym
Index: psl-1983/3-1/tests/20/main5.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main5.sym
@@ -0,0 +1,642 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING EQSTR INITREAD !*RAISE CH!*
+TOK!* TOKTYPE!* DEBUG SETRAISE CLEARWHITE CLEARCOMMENT READSTR DIGITP
+READINT ALPHAESCP READID RATOM WHITEP GETC LONGTIMES BUFFERTOSTRING
+RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP LOWERCASEP UPPERCASEP ALPHANUMP
+LOOKUPSTRING NEWID INITNEWID MAKEFUNBOUND PUTHALFWORD MAPOBL PRINTFEXPRS
+PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION FUNBOUNDP INITOBLIST READ1
+READ READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED !%COPY!-FUNCTION!-CELL
+COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL MAKEFLAMBDALINK
+FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!* SAVEREGISTERS
+CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL CODEPRIMITIVEWGETV BINDEVALAUX
+BINDEVAL LBIND1 GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK EVPROGN
+UNBINDN SYS2INT PLUS2 MINUS ELSE ADD1 SUB1 GREATERP LESSP DIFFERENCE TIMES2
+CAAAR CAAAAR CAAADR CAADR CAADAR CAADDR CADAR CADAAR CADADR CADDR CADDAR
+CADDDR CDAAR CDAAAR CDAADR CDADR CDADAR CDADDR CDDAR CDDAAR CDDADR CDDDR
+CDDDAR CDDDDR CAAR CADR CDAR CDDR SAFECAR CAR CDR ATOM CONSTANTP NULL LIST
+PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO SET SETQ PROGN EVCOND COND NOT
+APPEND MEMQ REVERSE EVLIS ATSOC GEQ LEQ EQCAR GETD COPYD DELATQ PUT INITEVAL
+WHILE TYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY GETFNTYPE LAMBDAAPPLY APPLY
+DOLAMBDA LENGTH CODEP EQ FLOATP BIGP IDP PAIRP STRINGP VECTORP RPLACA RPLACD
+LENGTH1 FLUID FLUIDP GLOBAL GLOBALP UNFLUID PROP REMPROP SYS2FIXN)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 393))
+(SETQ STRINGGENSYM!* (QUOTE "L1338"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0285"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0212"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0315"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0319"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0685"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L0779"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0749"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0625"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0349"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0354"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0206"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0353"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0430"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0437")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0369"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0221"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0583"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0392"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0254"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0805"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0256"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 270))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0363"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0364"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0791"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L0292"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0419"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0752"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0242"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0273"))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0265"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE CODEPRIMITIVEWGETV) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0772"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0719"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0465"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0289"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0588"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0324"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 271))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE PUTHALFWORD) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0796"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0736"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0288"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0730"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0396"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0809"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0723"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0197"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0333"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0284"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0720"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0431"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0611"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0477"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0423"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0199"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0645"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0328"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0216"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0250"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0344"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L0777"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0304"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 268))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0227"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 216))
ADDED psl-1983/3-1/tests/20/main6.cmd
Index: psl-1983/3-1/tests/20/main6.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main6.cmd
@@ -0,0 +1,2 @@
+main6,Dmain6,sub6,Dsub6,sub5a,Dsub5a,sub5b,Dsub5b,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main6.init
Index: psl-1983/3-1/tests/20/main6.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main6.init
@@ -0,0 +1,6 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(GLOBAL (QUOTE (LAMBDA1 LAMBDA2 CODEFORM!*)))
ADDED psl-1983/3-1/tests/20/main6.rel
Index: psl-1983/3-1/tests/20/main6.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main6.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main6.sym
Index: psl-1983/3-1/tests/20/main6.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main6.sym
@@ -0,0 +1,680 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (SETQ LAMBINDARGS!* (GTWARRAY 15)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING EQSTR INITREAD !*RAISE CH!*
+TOK!* TOKTYPE!* DEBUG SETRAISE CLEARWHITE CLEARCOMMENT READSTR DIGITP
+READINT ALPHAESCP READID RATOM WHITEP GETC LONGTIMES BUFFERTOSTRING
+RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP LOWERCASEP UPPERCASEP ALPHANUMP
+LOOKUPSTRING NEWID INITNEWID MAKEFUNBOUND PUTHALFWORD MAPOBL PRINTFEXPRS
+PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION FUNBOUNDP INITOBLIST READ1
+READ READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED !%COPY!-FUNCTION!-CELL
+COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL MAKEFLAMBDALINK
+FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!* SAVEREGISTERS
+CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL CODEPRIMITIVEWGETV BINDEVALAUX
+BINDEVAL LBIND1 GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK EVPROGN
+UNBINDN SYS2INT PLUS2 MINUS ELSE ADD1 SUB1 GREATERP LESSP DIFFERENCE TIMES2
+CAAAR CAAAAR CAAADR CAADR CAADAR CAADDR CADAR CADAAR CADADR CADDR CADDAR
+CADDDR CDAAR CDAAAR CDAADR CDADR CDADAR CDADDR CDDAR CDDAAR CDDADR CDDDR
+CDDDAR CDDDDR CAAR CADR CDAR CDDR SAFECAR CAR CDR ATOM CONSTANTP NULL LIST
+PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO SET SETQ PROGN EVCOND COND NOT
+APPEND MEMQ REVERSE EVLIS ATSOC GEQ LEQ EQCAR GETD COPYD DELATQ PUT INITEVAL
+WHILE TYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY GETFNTYPE LAMBDAAPPLY APPLY
+DOLAMBDA LENGTH CODEP EQ FLOATP BIGP IDP PAIRP STRINGP VECTORP RPLACA RPLACD
+LENGTH1 FLUID FLUIDP GLOBAL GLOBALP UNFLUID PROP REMPROP SYS2FIXN RESET
+BSTACKOVERFLOW ERROUT!* BSTACKUNDERFLOW CAPTUREENVIRONMENT
+RESTOREENVIRONMENT !%CLEAR!-CATCH!-STACK CLEARBINDINGS PBIND1 LAMBIND
+LAMBINDARGS!* PROGBIND CODE!-NUMBER!-OF!-ARGUMENTS)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 406))
+(SETQ STRINGGENSYM!* (QUOTE "L1409"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0285"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0212"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0315"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1340"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0319"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0685"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBIND) (QUOTE ENTRYPOINT) (QUOTE "L1363"))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L0779"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0749"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0625"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0349"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0354"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0206"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0353"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0430"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0437")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0369"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0221"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L1352"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0583"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0392"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0254"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0805"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0256"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 270))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0363"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0364"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0791"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L0292"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0419"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0752"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0242"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0273"))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0265"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE CODEPRIMITIVEWGETV) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1341"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE PROGBIND) (QUOTE ENTRYPOINT) (QUOTE "L1366"))
+(PUT (QUOTE PROGBIND) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0772"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0719"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0465"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0289"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0588"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0324"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 271))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE ENTRYPOINT) (QUOTE "L1407"))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1349"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE PUTHALFWORD) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1348"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0796"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0736"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1344"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0288"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0730"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0396"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0809"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0723"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1347"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0197"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0333"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0284"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0720"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0431"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0611"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0477"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0423"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0199"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L1353"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0645"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0328"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0216"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0250"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0344"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L0777"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1339"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0304"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 268))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0227"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 216))
ADDED psl-1983/3-1/tests/20/main7.cmd
Index: psl-1983/3-1/tests/20/main7.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main7.cmd
@@ -0,0 +1,2 @@
+main7,dmain7,sub7,Dsub7,sub6,Dsub6,sub5a,Dsub5a,sub5b,Dsub5b,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main7.init
Index: psl-1983/3-1/tests/20/main7.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main7.init
@@ -0,0 +1,7 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (TESTLIST TESTLIST2 LONGLIST EVALFORM)))
+(GLOBAL (QUOTE (TESTGLOBALVAR)))
ADDED psl-1983/3-1/tests/20/main7.rel
Index: psl-1983/3-1/tests/20/main7.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main7.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main7.sym
Index: psl-1983/3-1/tests/20/main7.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main7.sym
@@ -0,0 +1,821 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (SETQ LAMBINDARGS!* (GTWARRAY 15)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING EQSTR INITREAD !*RAISE CH!*
+TOK!* TOKTYPE!* DEBUG SETRAISE CLEARWHITE CLEARCOMMENT READSTR DIGITP
+READINT ALPHAESCP READID RATOM WHITEP GETC LONGTIMES BUFFERTOSTRING
+RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP LOWERCASEP UPPERCASEP ALPHANUMP
+LOOKUPSTRING NEWID INITNEWID MAKEFUNBOUND PUTHALFWORD MAPOBL PRINTFEXPRS
+PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION FUNBOUNDP INITOBLIST READ1
+READ READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED !%COPY!-FUNCTION!-CELL
+COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL MAKEFLAMBDALINK
+FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!* SAVEREGISTERS
+CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL CODEPRIMITIVEWGETV BINDEVALAUX
+BINDEVAL LBIND1 GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK EVPROGN
+UNBINDN SYS2INT PLUS2 MINUS ELSE ADD1 SUB1 GREATERP LESSP DIFFERENCE TIMES2
+CAAAR CAAAAR CAAADR CAADR CAADAR CAADDR CADAR CADAAR CADADR CADDR CADDAR
+CADDDR CDAAR CDAAAR CDAADR CDADR CDADAR CDADDR CDDAR CDDAAR CDDADR CDDDR
+CDDDAR CDDDDR CAAR CADR CDAR CDDR SAFECAR CAR CDR ATOM CONSTANTP NULL LIST
+PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO SET SETQ PROGN EVCOND COND NOT
+APPEND MEMQ REVERSE EVLIS ATSOC GEQ LEQ EQCAR GETD COPYD DELATQ PUT INITEVAL
+WHILE TYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY GETFNTYPE LAMBDAAPPLY APPLY
+DOLAMBDA LENGTH CODEP EQ FLOATP BIGP IDP PAIRP STRINGP VECTORP RPLACA RPLACD
+LENGTH1 FLUID FLUIDP GLOBAL GLOBALP UNFLUID PROP REMPROP SYS2FIXN RESET
+BSTACKOVERFLOW ERROUT!* BSTACKUNDERFLOW CAPTUREENVIRONMENT
+RESTOREENVIRONMENT !%CLEAR!-CATCH!-STACK CLEARBINDINGS PBIND1 LAMBIND
+LAMBINDARGS!* PROGBIND CODE!-NUMBER!-OF!-ARGUMENTS SYSCLEARIO DEC20OPEN
+CONTOPENERROR SYSOPENREAD INPUT SYSOPENWRITE OUTPUT DEC20READCHAR SYSREADREC
+IOERROR DEC20WRITECHAR SYSWRITEREC SYSCLOSE CHANNELERROR SYSMAXBUFFER
+TERMINALINPUTHANDLER WRITEONLYCHANNEL COMPRESSREADCHAR CHANNELNOTOPEN
+READONLYCHANNEL TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR
+ILLEGALSTANDARDCHANNELCLOSE !$EOL!$ RDS WRS OPEN CLOSE TYPEFILE DSKIN !$EOF!$
+!*PVAL !*ECHO LAPIN SYSTEMOPENFILEFORINPUT SYSTEMOPENFILEFOROUTPUT
+INDEPENDENTCLOSECHANNEL IN!* STDIN!* STDOUT!* PROMPTOUT!* FINDFREECHANNEL
+IOBUFFER INDEPENDENTREADCHAR SYSTEMOPENFILESPECIAL TESTLEGALCHANNEL
+FLUSHBUFFER SYSTEMMARKASCLOSEDCHANNEL CLEARONECHANNEL CLEARIO
+CHANNELWRITESTRING PROMPTSTRING!*)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 459))
+(SETQ STRINGGENSYM!* (QUOTE "L1530"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0285"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0212"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0315"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1340"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1455"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 415))
+(PUT (QUOTE MAXBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1451"))
+(PUT (QUOTE MAXBUFFER) (QUOTE WARRAY) (QUOTE MAXBUFFER))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 432))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE ENTRYPOINT) (QUOTE "L1490"))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 441))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0319"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L1415"))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE IDNUMBER) (QUOTE 411))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0685"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBIND) (QUOTE ENTRYPOINT) (QUOTE "L1363"))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L0779"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0749"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 410))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0625"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1444"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0349"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE DSKIN) (QUOTE ENTRYPOINT) (QUOTE DSKIN))
+(PUT (QUOTE DSKIN) (QUOTE IDNUMBER) (QUOTE 436))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE IDNUMBER) (QUOTE 447))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE INITIALVALUE) (QUOTE 6))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0354"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0206"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0353"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 444))
+(PUT (QUOTE IN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0430"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0437")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE SYSCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1440"))
+(PUT (QUOTE SYSCLOSE) (QUOTE IDNUMBER) (QUOTE 418))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1502"))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE IDNUMBER) (QUOTE 450))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE SYSREADREC) (QUOTE ENTRYPOINT) (QUOTE "L1420"))
+(PUT (QUOTE SYSREADREC) (QUOTE IDNUMBER) (QUOTE 414))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 431))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0369"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0221"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L1352"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 457))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0583"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE SYSWRITEREC) (QUOTE ENTRYPOINT) (QUOTE "L1432"))
+(PUT (QUOTE SYSWRITEREC) (QUOTE IDNUMBER) (QUOTE 417))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE IOBUFFER) (QUOTE IDNUMBER) (QUOTE 449))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0392"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0254"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0805"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 458))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 426))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0256"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 434))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 270))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0363"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 430))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE !*ECHO) (QUOTE IDNUMBER) (QUOTE 439))
+(FLAG (QUOTE (!*ECHO)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE !*PVAL) (QUOTE IDNUMBER) (QUOTE 438))
+(FLAG (QUOTE (!*PVAL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SYSCLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1410"))
+(PUT (QUOTE SYSCLEARIO) (QUOTE IDNUMBER) (QUOTE 406))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0364"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE ASMSYMBOL) (QUOTE "L1450"))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE WARRAY) (QUOTE CHANNELSTATUS))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0791"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L0292"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0419"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE CLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1520"))
+(PUT (QUOTE CLEARIO) (QUOTE IDNUMBER) (QUOTE 456))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE NEXTPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1453"))
+(PUT (QUOTE NEXTPOSITION) (QUOTE WARRAY) (QUOTE NEXTPOSITION))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0752"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 429))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 427))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0242"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0273"))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0265"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE CODEPRIMITIVEWGETV) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 437))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1341"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE PROGBIND) (QUOTE ENTRYPOINT) (QUOTE "L1366"))
+(PUT (QUOTE PROGBIND) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1511"))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 454))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE SYSOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L1412"))
+(PUT (QUOTE SYSOPENREAD) (QUOTE IDNUMBER) (QUOTE 409))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0772"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE LAPIN) (QUOTE ENTRYPOINT) (QUOTE LAPIN))
+(PUT (QUOTE LAPIN) (QUOTE IDNUMBER) (QUOTE 440))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0719"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0465"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 422))
+(PUT (QUOTE FLUSHBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1509"))
+(PUT (QUOTE FLUSHBUFFER) (QUOTE IDNUMBER) (QUOTE 453))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE CHANNELTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELTABLE) (QUOTE ASMSYMBOL) (QUOTE "L1452"))
+(PUT (QUOTE CHANNELTABLE) (QUOTE WARRAY) (QUOTE CHANNELTABLE))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0289"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE ENTRYPOINT) (QUOTE "L1495"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 451))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1512"))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE IDNUMBER) (QUOTE 443))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE ENTRYPOINT) (QUOTE "L1526"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 421))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE OUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 446))
+(PUT (QUOTE STDOUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1483"))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE IDNUMBER) (QUOTE 448))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1506"))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0588"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0324"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 271))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1445"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1514"))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE IDNUMBER) (QUOTE 455))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE ENTRYPOINT) (QUOTE "L1407"))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1436"))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 416))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1442"))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE IDNUMBER) (QUOTE 420))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1349"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE PUTHALFWORD) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE ASMSYMBOL) (QUOTE "L1454"))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE WARRAY) (QUOTE BUFFERLENGTH))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1348"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0796"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 428))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0736"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1344"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1447"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0288"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1448"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1443"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0730"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0396"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0809"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 419))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0723"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1347"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0197"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE TYPEFILE) (QUOTE ENTRYPOINT) (QUOTE "L1462"))
+(PUT (QUOTE TYPEFILE) (QUOTE IDNUMBER) (QUOTE 435))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0333"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 423))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE DEC20READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1427"))
+(PUT (QUOTE DEC20READCHAR) (QUOTE IDNUMBER) (QUOTE 413))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE ERROUT!*) (QUOTE INITIALVALUE) (QUOTE 5))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0284"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0720"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0431"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L1449"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0611"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0477"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0423"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1446"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 425))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0199"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L1353"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0645"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0328"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0216"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 445))
+(PUT (QUOTE STDIN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 412))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 424))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE ENTRYPOINT) (QUOTE "L1494"))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 442))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0250"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE CONTOPENERROR) (QUOTE ENTRYPOINT) (QUOTE "L1460"))
+(PUT (QUOTE CONTOPENERROR) (QUOTE IDNUMBER) (QUOTE 408))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0344"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L0777"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1339"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1498"))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE IDNUMBER) (QUOTE 452))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 433))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0304"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 268))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE DEC20OPEN) (QUOTE ENTRYPOINT) (QUOTE "L1417"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 407))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0227"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 216))
ADDED psl-1983/3-1/tests/20/main8.cmd
Index: psl-1983/3-1/tests/20/main8.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main8.cmd
@@ -0,0 +1,2 @@
+main8,dmain8,sub8,dsub8,sub7,Dsub7,sub6,Dsub6,sub5a,Dsub5a,sub5b,Dsub5b,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main8.sym
Index: psl-1983/3-1/tests/20/main8.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main8.sym
@@ -0,0 +1,882 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (SETQ LAMBINDARGS!* (GTWARRAY 15)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING EQSTR INITREAD !*RAISE CH!*
+TOK!* TOKTYPE!* DEBUG SETRAISE CLEARWHITE CLEARCOMMENT READSTR DIGITP
+READINT ALPHAESCP READID RATOM WHITEP GETC LONGTIMES BUFFERTOSTRING
+RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP LOWERCASEP UPPERCASEP ALPHANUMP
+LOOKUPSTRING NEWID INITNEWID MAKEFUNBOUND PUTHALFWORD MAPOBL PRINTFEXPRS
+PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION FUNBOUNDP INITOBLIST READ1
+READ READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED !%COPY!-FUNCTION!-CELL
+COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL MAKEFLAMBDALINK
+FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!* SAVEREGISTERS
+CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL CODEPRIMITIVEWGETV BINDEVALAUX
+BINDEVAL LBIND1 GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK EVPROGN
+UNBINDN SYS2INT PLUS2 MINUS ELSE ADD1 SUB1 GREATERP LESSP DIFFERENCE TIMES2
+CAAAR CAAAAR CAAADR CAADR CAADAR CAADDR CADAR CADAAR CADADR CADDR CADDAR
+CADDDR CDAAR CDAAAR CDAADR CDADR CDADAR CDADDR CDDAR CDDAAR CDDADR CDDDR
+CDDDAR CDDDDR CAAR CADR CDAR CDDR SAFECAR CAR CDR ATOM CONSTANTP NULL LIST
+PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO SET SETQ PROGN EVCOND COND NOT
+APPEND MEMQ REVERSE EVLIS ATSOC GEQ LEQ EQCAR GETD COPYD DELATQ PUT INITEVAL
+WHILE TYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY GETFNTYPE LAMBDAAPPLY APPLY
+DOLAMBDA LENGTH CODEP EQ FLOATP BIGP IDP PAIRP STRINGP VECTORP RPLACA RPLACD
+LENGTH1 FLUID FLUIDP GLOBAL GLOBALP UNFLUID PROP REMPROP SYS2FIXN RESET
+BSTACKOVERFLOW ERROUT!* BSTACKUNDERFLOW CAPTUREENVIRONMENT
+RESTOREENVIRONMENT !%CLEAR!-CATCH!-STACK CLEARBINDINGS PBIND1 LAMBIND
+LAMBINDARGS!* PROGBIND CODE!-NUMBER!-OF!-ARGUMENTS SYSCLEARIO DEC20OPEN
+CONTOPENERROR SYSOPENREAD INPUT SYSOPENWRITE OUTPUT DEC20READCHAR SYSREADREC
+IOERROR DEC20WRITECHAR SYSWRITEREC SYSCLOSE CHANNELERROR SYSMAXBUFFER
+TERMINALINPUTHANDLER WRITEONLYCHANNEL COMPRESSREADCHAR CHANNELNOTOPEN
+READONLYCHANNEL TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR
+ILLEGALSTANDARDCHANNELCLOSE !$EOL!$ RDS WRS OPEN CLOSE TYPEFILE DSKIN !$EOF!$
+!*PVAL !*ECHO LAPIN SYSTEMOPENFILEFORINPUT SYSTEMOPENFILEFOROUTPUT
+INDEPENDENTCLOSECHANNEL IN!* STDIN!* STDOUT!* PROMPTOUT!* FINDFREECHANNEL
+IOBUFFER INDEPENDENTREADCHAR SYSTEMOPENFILESPECIAL TESTLEGALCHANNEL
+FLUSHBUFFER SYSTEMMARKASCLOSEDCHANNEL CLEARONECHANNEL CLEARIO
+CHANNELWRITESTRING PROMPTSTRING!* BEFOREGCSYSTEMHOOK AFTERGCSYSTEMHOOK !*GC
+GCTIME!* GCKNT!* HEAP!-WARN!-LEVEL TIMC MARKFROMALLBASES MAKEIDFREELIST
+BUILDRELOCATIONFIELDS UPDATEALLBASES COMPACTHEAP GCMESSAGE KNOWN!-FREE!-SPACE
+CONTINUABLEERROR MARKFROMSYMBOLS MARKFROMRANGE MARKFROMBASE
+MARKFROMONESYMBOL HALFWORD MARKFROMVECTOR GCERROR UPDATESYMBOLS UPDATEREGION
+UPDATEITEM UPDATEHEAP)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 485))
+(SETQ STRINGGENSYM!* (QUOTE "L1714"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0285"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0212"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0315"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1340"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1455"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 415))
+(PUT (QUOTE MAXBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1451"))
+(PUT (QUOTE MAXBUFFER) (QUOTE WARRAY) (QUOTE MAXBUFFER))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 432))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE ENTRYPOINT) (QUOTE "L1490"))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 441))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0319"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L1415"))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE IDNUMBER) (QUOTE 411))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0685"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBIND) (QUOTE ENTRYPOINT) (QUOTE "L1363"))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L0779"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0749"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 410))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0625"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE GCARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE GCARRAY) (QUOTE ASMSYMBOL) (QUOTE "L1542"))
+(PUT (QUOTE GCARRAY) (QUOTE WARRAY) (QUOTE GCARRAY))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1444"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0349"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE KNOWN!-FREE!-SPACE) (QUOTE IDNUMBER) (QUOTE 472))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE DSKIN) (QUOTE ENTRYPOINT) (QUOTE DSKIN))
+(PUT (QUOTE DSKIN) (QUOTE IDNUMBER) (QUOTE 436))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE IDNUMBER) (QUOTE 447))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE INITIALVALUE) (QUOTE 6))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE MARKFROMSYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1564"))
+(PUT (QUOTE MARKFROMSYMBOLS) (QUOTE IDNUMBER) (QUOTE 474))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0354"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0206"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE GCERROR) (QUOTE ENTRYPOINT) (QUOTE "L1708"))
+(PUT (QUOTE GCERROR) (QUOTE IDNUMBER) (QUOTE 480))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0353"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 444))
+(PUT (QUOTE IN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0430"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0437")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE SYSCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1440"))
+(PUT (QUOTE SYSCLOSE) (QUOTE IDNUMBER) (QUOTE 418))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1502"))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE IDNUMBER) (QUOTE 450))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE SYSREADREC) (QUOTE ENTRYPOINT) (QUOTE "L1420"))
+(PUT (QUOTE SYSREADREC) (QUOTE IDNUMBER) (QUOTE 414))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 431))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0369"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0221"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L1352"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 457))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0583"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE SYSWRITEREC) (QUOTE ENTRYPOINT) (QUOTE "L1432"))
+(PUT (QUOTE SYSWRITEREC) (QUOTE IDNUMBER) (QUOTE 417))
+(PUT (QUOTE MARKFROMALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1557"))
+(PUT (QUOTE MARKFROMALLBASES) (QUOTE IDNUMBER) (QUOTE 466))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE IOBUFFER) (QUOTE IDNUMBER) (QUOTE 449))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0392"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE UPDATEREGION) (QUOTE ENTRYPOINT) (QUOTE "L1646"))
+(PUT (QUOTE UPDATEREGION) (QUOTE IDNUMBER) (QUOTE 482))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0254"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0805"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 458))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 426))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0256"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 434))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 270))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0363"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 430))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE !*ECHO) (QUOTE IDNUMBER) (QUOTE 439))
+(FLAG (QUOTE (!*ECHO)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE !*PVAL) (QUOTE IDNUMBER) (QUOTE 438))
+(FLAG (QUOTE (!*PVAL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SYSCLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1410"))
+(PUT (QUOTE SYSCLEARIO) (QUOTE IDNUMBER) (QUOTE 406))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0364"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE ASMSYMBOL) (QUOTE "L1450"))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE WARRAY) (QUOTE CHANNELSTATUS))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0791"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L0292"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0419"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE CLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1520"))
+(PUT (QUOTE CLEARIO) (QUOTE IDNUMBER) (QUOTE 456))
+(PUT (QUOTE BUILDRELOCATIONFIELDS) (QUOTE ENTRYPOINT) (QUOTE "L1612"))
+(PUT (QUOTE BUILDRELOCATIONFIELDS) (QUOTE IDNUMBER) (QUOTE 468))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE UPDATEITEM) (QUOTE ENTRYPOINT) (QUOTE "L1677"))
+(PUT (QUOTE UPDATEITEM) (QUOTE IDNUMBER) (QUOTE 483))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE NEXTPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1453"))
+(PUT (QUOTE NEXTPOSITION) (QUOTE WARRAY) (QUOTE NEXTPOSITION))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0752"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE IDNUMBER) (QUOTE 464))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE INITIALVALUE) (QUOTE 1000))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 429))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 427))
+(PUT (QUOTE HALFWORD) (QUOTE IDNUMBER) (QUOTE 478))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE MARKFROMBASE) (QUOTE ENTRYPOINT) (QUOTE "L1580"))
+(PUT (QUOTE MARKFROMBASE) (QUOTE IDNUMBER) (QUOTE 476))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0242"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0273"))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0265"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE MARKFROMRANGE) (QUOTE ENTRYPOINT) (QUOTE "L1573"))
+(PUT (QUOTE MARKFROMRANGE) (QUOTE IDNUMBER) (QUOTE 475))
+(PUT (QUOTE UPDATESYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1641"))
+(PUT (QUOTE UPDATESYMBOLS) (QUOTE IDNUMBER) (QUOTE 481))
+(PUT (QUOTE GCMESSAGE) (QUOTE ENTRYPOINT) (QUOTE "L1714"))
+(PUT (QUOTE GCMESSAGE) (QUOTE IDNUMBER) (QUOTE 471))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE CODEPRIMITIVEWGETV) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 437))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1341"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE PROGBIND) (QUOTE ENTRYPOINT) (QUOTE "L1366"))
+(PUT (QUOTE PROGBIND) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1511"))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 454))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE ASMSYMBOL) (QUOTE "L1541"))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE WVAR) (QUOTE HEAPTRAPPED))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE SYSOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L1412"))
+(PUT (QUOTE SYSOPENREAD) (QUOTE IDNUMBER) (QUOTE 409))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0772"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE LAPIN) (QUOTE ENTRYPOINT) (QUOTE LAPIN))
+(PUT (QUOTE LAPIN) (QUOTE IDNUMBER) (QUOTE 440))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0719"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0465"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 422))
+(PUT (QUOTE FLUSHBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1509"))
+(PUT (QUOTE FLUSHBUFFER) (QUOTE IDNUMBER) (QUOTE 453))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE CHANNELTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELTABLE) (QUOTE ASMSYMBOL) (QUOTE "L1452"))
+(PUT (QUOTE CHANNELTABLE) (QUOTE WARRAY) (QUOTE CHANNELTABLE))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE !*GC) (QUOTE IDNUMBER) (QUOTE 461))
+(PUT (QUOTE !*GC) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0289"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE ENTRYPOINT) (QUOTE "L1495"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 451))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1512"))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE IDNUMBER) (QUOTE 443))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE ENTRYPOINT) (QUOTE "L1526"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 421))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE OUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 446))
+(PUT (QUOTE STDOUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1483"))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE IDNUMBER) (QUOTE 448))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1506"))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0588"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0324"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 473))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 271))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE AFTERGCSYSTEMHOOK) (QUOTE ENTRYPOINT) (QUOTE "L1539"))
+(PUT (QUOTE AFTERGCSYSTEMHOOK) (QUOTE IDNUMBER) (QUOTE 460))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1445"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1514"))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE IDNUMBER) (QUOTE 455))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE ENTRYPOINT) (QUOTE "L1407"))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE BEFOREGCSYSTEMHOOK) (QUOTE ENTRYPOINT) (QUOTE "L1534"))
+(PUT (QUOTE BEFOREGCSYSTEMHOOK) (QUOTE IDNUMBER) (QUOTE 459))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE TIMC) (QUOTE IDNUMBER) (QUOTE 465))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1436"))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 416))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1442"))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE IDNUMBER) (QUOTE 420))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1349"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE PUTHALFWORD) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE ASMSYMBOL) (QUOTE "L1454"))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE WARRAY) (QUOTE BUFFERLENGTH))
+(PUT (QUOTE MARKFROMVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1592"))
+(PUT (QUOTE MARKFROMVECTOR) (QUOTE IDNUMBER) (QUOTE 479))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1348"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0796"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 428))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0736"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1344"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1447"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0288"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1448"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1443"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0730"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0396"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0809"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 419))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0723"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE !%RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1553"))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1347"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0197"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE TYPEFILE) (QUOTE ENTRYPOINT) (QUOTE "L1462"))
+(PUT (QUOTE TYPEFILE) (QUOTE IDNUMBER) (QUOTE 435))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0333"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 423))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE DEC20READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1427"))
+(PUT (QUOTE DEC20READCHAR) (QUOTE IDNUMBER) (QUOTE 413))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE ERROUT!*) (QUOTE INITIALVALUE) (QUOTE 5))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0284"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0720"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0431"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L1449"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE UPDATEALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1635"))
+(PUT (QUOTE UPDATEALLBASES) (QUOTE IDNUMBER) (QUOTE 469))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0611"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE GCTIME!*) (QUOTE IDNUMBER) (QUOTE 462))
+(PUT (QUOTE GCTIME!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0477"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0423"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1446"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 425))
+(PUT (QUOTE GCKNT!*) (QUOTE IDNUMBER) (QUOTE 463))
+(PUT (QUOTE GCKNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0199"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L1353"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0645"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0328"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1548"))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0216"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 445))
+(PUT (QUOTE STDIN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 412))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 424))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE ENTRYPOINT) (QUOTE "L1494"))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 442))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0250"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE CONTOPENERROR) (QUOTE ENTRYPOINT) (QUOTE "L1460"))
+(PUT (QUOTE CONTOPENERROR) (QUOTE IDNUMBER) (QUOTE 408))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0344"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L0777"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1339"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1498"))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE IDNUMBER) (QUOTE 452))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 433))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE UPDATEHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1656"))
+(PUT (QUOTE UPDATEHEAP) (QUOTE IDNUMBER) (QUOTE 484))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE ENTRYPOINT) (QUOTE "L1597"))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE IDNUMBER) (QUOTE 467))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0304"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 268))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE DEC20OPEN) (QUOTE ENTRYPOINT) (QUOTE "L1417"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 407))
+(PUT (QUOTE COMPACTHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1688"))
+(PUT (QUOTE COMPACTHEAP) (QUOTE IDNUMBER) (QUOTE 470))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0227"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE MARKFROMONESYMBOL) (QUOTE ENTRYPOINT) (QUOTE "L1572"))
+(PUT (QUOTE MARKFROMONESYMBOL) (QUOTE IDNUMBER) (QUOTE 477))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 216))
ADDED psl-1983/3-1/tests/20/main9.cmd
Index: psl-1983/3-1/tests/20/main9.cmd
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main9.cmd
@@ -0,0 +1,2 @@
+main9,Dmain9,sub9,Dsub9,sub8,dsub8,sub7,Dsub7,sub6,Dsub6,sub5a,Dsub5a,sub5b,Dsub5b,sub4,Dsub4,sub3,Dsub3,sub2,Dsub2,20io
+
ADDED psl-1983/3-1/tests/20/main9.init
Index: psl-1983/3-1/tests/20/main9.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main9.init
@@ -0,0 +1,8 @@
+(FLAG (QUOTE (INIT20 PUTC20 GETC20 TIMC20 QUIT20 ERR20 PUTI20)) (QUOTE
+FOREIGNFUNCTION))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (UNDEFNCODE!* UNDEFNNARG!*)))
+(FLUID (QUOTE (TESTLIST TESTLIST2 LONGLIST EVALFORM)))
+(GLOBAL (QUOTE (TESTGLOBALVAR)))
+(FLUID (QUOTE (HEAP!-WARN!-LEVEL)))
ADDED psl-1983/3-1/tests/20/main9.rel
Index: psl-1983/3-1/tests/20/main9.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main9.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/main9.sym
Index: psl-1983/3-1/tests/20/main9.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/main9.sym
@@ -0,0 +1,938 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN (SETQ LAMBINDARGS!* (GTWARRAY 15)))))
+(SETQ ORDEREDIDLIST!* (QUOTE (PUTC CHANNELWRITECHAR INDEPENDENTWRITECHAR
+WRITECHAR OUT!* PRIN1ID PRIN1INT PRIN1STRING PRIN1PAIR PRTITM PRIN1 PRIN2ID
+PRIN2STRING PRIN2PAIR PRIN2 TERPRI PRINT PRIN2T PBLANK PRIN1INTX LONGDIV
+LONGREMAINDER BYTE CHANNELPRIN2 PRINTF ERRORPRINTF LIST5 XCONS BLDMSG
+ERRPRIN ERRORHEADER ERRORTRAILER ERROR PRIN2L QUIT FATALERROR STDERROR
+TYPEERROR USAGETYPEERROR INDEXERROR NONPAIRERROR NONIDERROR NONNUMBERERROR
+NONINTEGERERROR NONPOSITIVEINTEGERERROR NONCHARACTERERROR NONSTRINGERROR
+NONVECTORERROR NONWORDS NONSEQUENCEERROR NONIOCHANNELERROR WQUOTIENT
+!%RECLAIM GTHEAP DELHEAP GTSTR GTBPS GTCONSTSTR GTHALFWORDS GTVECT GTEVECT
+GTWRDS GTFIXN GTFLTN RECLAIM GTID DELBPS GTWARRAY DELWARRAY HARDCONS CONS
+NCONS MKVECT LIST4 LIST3 LIST2 PUTBYTE MKSTRING EQSTR INITREAD !*RAISE CH!*
+TOK!* TOKTYPE!* DEBUG SETRAISE CLEARWHITE CLEARCOMMENT READSTR DIGITP
+READINT ALPHAESCP READID RATOM WHITEP GETC LONGTIMES BUFFERTOSTRING
+RAISECHAR ALPHANUMESCP INTERN ESCAPEP ALPHAP LOWERCASEP UPPERCASEP ALPHANUMP
+LOOKUPSTRING NEWID INITNEWID MAKEFUNBOUND PUTHALFWORD MAPOBL PRINTFEXPRS
+PRINT1FEXPR FEXPRP PRINTFUNCTIONS PRINT1FUNCTION FUNBOUNDP INITOBLIST READ1
+READ READLIST QUOTE SAFECDR SYMFNCBASE WPLUS2 SYMFNC WTIMES2
+ADDRESSINGUNITSPERFUNCTIONCELL SHOULDBEUNDEFINED !%COPY!-FUNCTION!-CELL
+COMPILEDCALLINGINTERPRETED FLAMBDALINKP !%STORE!-JCALL MAKEFLAMBDALINK
+FCODEP MAKEFCODE GETFCODEPOINTER CODEPRIMITIVE CODEPTR!* SAVEREGISTERS
+CODEFORM!* CODENARG!* COMPILEDCALLINGINTERPRETEDAUX FASTAPPLY
+FASTLAMBDAAPPLY LAMBDA UNDEFINEDFUNCTIONAUX UNDEFINEDFUNCTIONAUXAUX
+CODEAPPLY CODEEVALAPPLY CODEEVALAPPLYAUX EVAL CODEPRIMITIVEWGETV BINDEVALAUX
+BINDEVAL LBIND1 GET COMPILEDCALLINGINTERPRETEDAUXAUX !*LAMBDALINK EVPROGN
+UNBINDN SYS2INT PLUS2 MINUS ELSE ADD1 SUB1 GREATERP LESSP DIFFERENCE TIMES2
+CAAAR CAAAAR CAAADR CAADR CAADAR CAADDR CADAR CADAAR CADADR CADDR CADDAR
+CADDDR CDAAR CDAAAR CDAADR CDADR CDADAR CDADDR CDDAR CDDAAR CDDADR CDDDR
+CDDDAR CDDDDR CAAR CADR CDAR CDDR SAFECAR CAR CDR ATOM CONSTANTP NULL LIST
+PUTD DE EXPR DF FEXPR DN NEXPR DM MACRO SET SETQ PROGN EVCOND COND NOT
+APPEND MEMQ REVERSE EVLIS ATSOC GEQ LEQ EQCAR GETD COPYD DELATQ PUT INITEVAL
+WHILE TYPE LAMBDAP GETLAMBDA LAMBDAEVALAPPLY GETFNTYPE LAMBDAAPPLY APPLY
+DOLAMBDA LENGTH CODEP EQ FLOATP BIGP IDP PAIRP STRINGP VECTORP RPLACA RPLACD
+LENGTH1 FLUID FLUIDP GLOBAL GLOBALP UNFLUID PROP REMPROP SYS2FIXN RESET
+BSTACKOVERFLOW ERROUT!* BSTACKUNDERFLOW CAPTUREENVIRONMENT
+RESTOREENVIRONMENT !%CLEAR!-CATCH!-STACK CLEARBINDINGS PBIND1 LAMBIND
+LAMBINDARGS!* PROGBIND CODE!-NUMBER!-OF!-ARGUMENTS SYSCLEARIO DEC20OPEN
+CONTOPENERROR SYSOPENREAD INPUT SYSOPENWRITE OUTPUT DEC20READCHAR SYSREADREC
+IOERROR DEC20WRITECHAR SYSWRITEREC SYSCLOSE CHANNELERROR SYSMAXBUFFER
+TERMINALINPUTHANDLER WRITEONLYCHANNEL COMPRESSREADCHAR CHANNELNOTOPEN
+READONLYCHANNEL TOSTRINGWRITECHAR EXPLODEWRITECHAR FLATSIZEWRITECHAR
+ILLEGALSTANDARDCHANNELCLOSE !$EOL!$ RDS WRS OPEN CLOSE TYPEFILE DSKIN !$EOF!$
+!*PVAL !*ECHO LAPIN SYSTEMOPENFILEFORINPUT SYSTEMOPENFILEFOROUTPUT
+INDEPENDENTCLOSECHANNEL IN!* STDIN!* STDOUT!* PROMPTOUT!* FINDFREECHANNEL
+IOBUFFER INDEPENDENTREADCHAR SYSTEMOPENFILESPECIAL TESTLEGALCHANNEL
+FLUSHBUFFER SYSTEMMARKASCLOSEDCHANNEL CLEARONECHANNEL CLEARIO
+CHANNELWRITESTRING PROMPTSTRING!* BEFOREGCSYSTEMHOOK AFTERGCSYSTEMHOOK !*GC
+GCTIME!* GCKNT!* HEAP!-WARN!-LEVEL TIMC MARKFROMALLBASES MAKEIDFREELIST
+BUILDRELOCATIONFIELDS UPDATEALLBASES COMPACTHEAP GCMESSAGE KNOWN!-FREE!-SPACE
+CONTINUABLEERROR MARKFROMSYMBOLS MARKFROMRANGE MARKFROMBASE
+MARKFROMONESYMBOL HALFWORD MARKFROMVECTOR GCERROR UPDATESYMBOLS UPDATEREGION
+UPDATEITEM UPDATEHEAP !&!&VALUE!&!& THROWTAG!* CATCH!-ALL CATCH THROWSIGNAL!*
+AND UNWIND!-ALL !&!&THROWN!&!& !$UNWIND!-PROTECT!$ !&!&TAG!&!& !%THROW
+UNWIND!-PROTECT CATCHSETUP !%UNCATCH !*CATCH THROW !*THROW EMSG!* THROWAUX
+FINDCATCHMARKANDTHROW MKQUOTE !$ERROR!$ PROG PROGBODY!* PROGJUMPTABLE!*
+!$PROG!$ GO RETURN FREERSTRSAVE!*)))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 514))
+(SETQ STRINGGENSYM!* (QUOTE "L2289"))
+(PUT (QUOTE CADR) (QUOTE ENTRYPOINT) (QUOTE CADR))
+(PUT (QUOTE CADR) (QUOTE IDNUMBER) (QUOTE 326))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE ENTRYPOINT) (QUOTE "L0285"))
+(PUT (QUOTE PRINT1FEXPR) (QUOTE IDNUMBER) (QUOTE 242))
+(PUT (QUOTE GTWRDS) (QUOTE ENTRYPOINT) (QUOTE GTWRDS))
+(PUT (QUOTE GTWRDS) (QUOTE IDNUMBER) (QUOTE 190))
+(PUT (QUOTE THROWSIGNAL!*) (QUOTE IDNUMBER) (QUOTE 489))
+(FLAG (QUOTE (THROWSIGNAL!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE READINT) (QUOTE ENTRYPOINT) (QUOTE "L0212"))
+(PUT (QUOTE READINT) (QUOTE IDNUMBER) (QUOTE 219))
+(PUT (QUOTE SYMFNCBASE) (QUOTE ENTRYPOINT) (QUOTE "L0315"))
+(PUT (QUOTE SYMFNCBASE) (QUOTE IDNUMBER) (QUOTE 253))
+(PUT (QUOTE GEQ) (QUOTE ENTRYPOINT) (QUOTE GEQ))
+(PUT (QUOTE GEQ) (QUOTE IDNUMBER) (QUOTE 356))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1340"))
+(PUT (QUOTE BNDSTKUPPERBOUND) (QUOTE WVAR) (QUOTE BNDSTKUPPERBOUND))
+(PUT (QUOTE IOERROR) (QUOTE ENTRYPOINT) (QUOTE "L1455"))
+(PUT (QUOTE IOERROR) (QUOTE IDNUMBER) (QUOTE 415))
+(PUT (QUOTE MAXBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1451"))
+(PUT (QUOTE MAXBUFFER) (QUOTE WARRAY) (QUOTE MAXBUFFER))
+(PUT (QUOTE DELHEAP) (QUOTE ENTRYPOINT) (QUOTE "L0147"))
+(PUT (QUOTE DELHEAP) (QUOTE IDNUMBER) (QUOTE 183))
+(PUT (QUOTE WRS) (QUOTE ENTRYPOINT) (QUOTE WRS))
+(PUT (QUOTE WRS) (QUOTE IDNUMBER) (QUOTE 432))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE ENTRYPOINT) (QUOTE "L1490"))
+(PUT (QUOTE SYSTEMOPENFILEFORINPUT) (QUOTE IDNUMBER) (QUOTE 441))
+(PUT (QUOTE FUNBOUNDP) (QUOTE ENTRYPOINT) (QUOTE "L0319"))
+(PUT (QUOTE FUNBOUNDP) (QUOTE IDNUMBER) (QUOTE 246))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE ENTRYPOINT) (QUOTE "L1415"))
+(PUT (QUOTE SYSOPENWRITE) (QUOTE IDNUMBER) (QUOTE 411))
+(PUT (QUOTE FATALERROR) (QUOTE ENTRYPOINT) (QUOTE "L0078"))
+(PUT (QUOTE FATALERROR) (QUOTE IDNUMBER) (QUOTE 164))
+(PUT (QUOTE WHILE) (QUOTE ENTRYPOINT) (QUOTE WHILE))
+(PUT (QUOTE WHILE) (QUOTE IDNUMBER) (QUOTE 364))
+(PUT (QUOTE ST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ST) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE ST) (QUOTE WVAR) (QUOTE ST))
+(PUT (QUOTE PRIN2L) (QUOTE ENTRYPOINT) (QUOTE PRIN2L))
+(PUT (QUOTE PRIN2L) (QUOTE IDNUMBER) (QUOTE 162))
+(PUT (QUOTE ARG14) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG14) (QUOTE ASMSYMBOL) (QUOTE ARG14))
+(PUT (QUOTE ARG14) (QUOTE WVAR) (QUOTE ARG14))
+(PUT (QUOTE SYMFNC) (QUOTE IDNUMBER) (QUOTE 255))
+(PUT (QUOTE SYMFNC) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMFNC) (QUOTE ASMSYMBOL) (QUOTE SYMFNC))
+(PUT (QUOTE SYMFNC) (QUOTE WARRAY) (QUOTE SYMFNC))
+(PUT (QUOTE PRIN2ID) (QUOTE ENTRYPOINT) (QUOTE "L0028"))
+(PUT (QUOTE PRIN2ID) (QUOTE IDNUMBER) (QUOTE 140))
+(PUT (QUOTE TERPRI) (QUOTE ENTRYPOINT) (QUOTE TERPRI))
+(PUT (QUOTE TERPRI) (QUOTE IDNUMBER) (QUOTE 144))
+(PUT (QUOTE MAXOBARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXOBARRAY) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE NEXPR) (QUOTE IDNUMBER) (QUOTE 342))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE ENTRYPOINT) (QUOTE "L1779"))
+(PUT (QUOTE !%CLEAR!-CATCH!-STACK) (QUOTE IDNUMBER) (QUOTE 399))
+(PUT (QUOTE LAMBINDARGS!*) (QUOTE IDNUMBER) (QUOTE 403))
+(PUT (QUOTE SETQ) (QUOTE ENTRYPOINT) (QUOTE SETQ))
+(PUT (QUOTE SETQ) (QUOTE IDNUMBER) (QUOTE 346))
+(PUT (QUOTE INITEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0685"))
+(PUT (QUOTE INITEVAL) (QUOTE IDNUMBER) (QUOTE 363))
+(PUT (QUOTE TOK!*) (QUOTE IDNUMBER) (QUOTE 211))
+(PUT (QUOTE LAMBIND) (QUOTE ENTRYPOINT) (QUOTE "L1363"))
+(PUT (QUOTE LAMBIND) (QUOTE IDNUMBER) (QUOTE 402))
+(PUT (QUOTE CDADR) (QUOTE ENTRYPOINT) (QUOTE CDADR))
+(PUT (QUOTE CDADR) (QUOTE IDNUMBER) (QUOTE 316))
+(PUT (QUOTE ARG10) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG10) (QUOTE ASMSYMBOL) (QUOTE ARG10))
+(PUT (QUOTE ARG10) (QUOTE WVAR) (QUOTE ARG10))
+(PUT (QUOTE UNFLUID) (QUOTE ENTRYPOINT) (QUOTE "L0779"))
+(PUT (QUOTE UNFLUID) (QUOTE IDNUMBER) (QUOTE 389))
+(PUT (QUOTE !$PROG!$) (QUOTE IDNUMBER) (QUOTE 510))
+(PUT (QUOTE STRINGP) (QUOTE ENTRYPOINT) (QUOTE "L0749"))
+(PUT (QUOTE STRINGP) (QUOTE IDNUMBER) (QUOTE 380))
+(PUT (QUOTE LIST2) (QUOTE ENTRYPOINT) (QUOTE LIST2))
+(PUT (QUOTE LIST2) (QUOTE IDNUMBER) (QUOTE 204))
+(PUT (QUOTE INPUT) (QUOTE IDNUMBER) (QUOTE 410))
+(PUT (QUOTE !*THROW) (QUOTE ENTRYPOINT) (QUOTE "L1767"))
+(PUT (QUOTE !*THROW) (QUOTE IDNUMBER) (QUOTE 501))
+(PUT (QUOTE EVPROGN) (QUOTE ENTRYPOINT) (QUOTE "L0625"))
+(PUT (QUOTE EVPROGN) (QUOTE IDNUMBER) (QUOTE 289))
+(PUT (QUOTE LONGDIV) (QUOTE IDNUMBER) (QUOTE 149))
+(PUT (QUOTE GCARRAY) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE GCARRAY) (QUOTE ASMSYMBOL) (QUOTE "L1542"))
+(PUT (QUOTE GCARRAY) (QUOTE WARRAY) (QUOTE GCARRAY))
+(PUT (QUOTE WHITEP) (QUOTE ENTRYPOINT) (QUOTE WHITEP))
+(PUT (QUOTE WHITEP) (QUOTE IDNUMBER) (QUOTE 223))
+(PUT (QUOTE LBIND1) (QUOTE ENTRYPOINT) (QUOTE LBIND1))
+(PUT (QUOTE LBIND1) (QUOTE IDNUMBER) (QUOTE 285))
+(PUT (QUOTE CAAR) (QUOTE ENTRYPOINT) (QUOTE CAAR))
+(PUT (QUOTE CAAR) (QUOTE IDNUMBER) (QUOTE 325))
+(PUT (QUOTE READFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE READFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1444"))
+(PUT (QUOTE READFUNCTION) (QUOTE WARRAY) (QUOTE READFUNCTION))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE ENTRYPOINT) (QUOTE "L0349"))
+(PUT (QUOTE GETFCODEPOINTER) (QUOTE IDNUMBER) (QUOTE 266))
+(PUT (QUOTE KNOWN!-FREE!-SPACE) (QUOTE IDNUMBER) (QUOTE 472))
+(PUT (QUOTE NCONS) (QUOTE ENTRYPOINT) (QUOTE NCONS))
+(PUT (QUOTE NCONS) (QUOTE IDNUMBER) (QUOTE 200))
+(PUT (QUOTE DSKIN) (QUOTE ENTRYPOINT) (QUOTE DSKIN))
+(PUT (QUOTE DSKIN) (QUOTE IDNUMBER) (QUOTE 436))
+(PUT (QUOTE CDDADR) (QUOTE ENTRYPOINT) (QUOTE CDDADR))
+(PUT (QUOTE CDDADR) (QUOTE IDNUMBER) (QUOTE 321))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE IDNUMBER) (QUOTE 447))
+(PUT (QUOTE PROMPTOUT!*) (QUOTE INITIALVALUE) (QUOTE 6))
+(PUT (QUOTE PUTC) (QUOTE IDNUMBER) (QUOTE 129))
+(PUT (QUOTE MARKFROMSYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1564"))
+(PUT (QUOTE MARKFROMSYMBOLS) (QUOTE IDNUMBER) (QUOTE 474))
+(PUT (QUOTE SYMNAM) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMNAM) (QUOTE ASMSYMBOL) (QUOTE SYMNAM))
+(PUT (QUOTE SYMNAM) (QUOTE WARRAY) (QUOTE SYMNAM))
+(PUT (QUOTE MAPOBL) (QUOTE ENTRYPOINT) (QUOTE MAPOBL))
+(PUT (QUOTE MAPOBL) (QUOTE IDNUMBER) (QUOTE 240))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE ENTRYPOINT) (QUOTE "L0354"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETED) (QUOTE IDNUMBER) (QUOTE 260))
+(PUT (QUOTE WTIMES2) (QUOTE IDNUMBER) (QUOTE 256))
+(PUT (QUOTE RPLACA) (QUOTE ENTRYPOINT) (QUOTE RPLACA))
+(PUT (QUOTE RPLACA) (QUOTE IDNUMBER) (QUOTE 382))
+(PUT (QUOTE CLEARWHITE) (QUOTE ENTRYPOINT) (QUOTE "L0206"))
+(PUT (QUOTE CLEARWHITE) (QUOTE IDNUMBER) (QUOTE 215))
+(PUT (QUOTE SUB1) (QUOTE ENTRYPOINT) (QUOTE SUB1))
+(PUT (QUOTE SUB1) (QUOTE IDNUMBER) (QUOTE 296))
+(PUT (QUOTE GCERROR) (QUOTE ENTRYPOINT) (QUOTE "L1708"))
+(PUT (QUOTE GCERROR) (QUOTE IDNUMBER) (QUOTE 480))
+(PUT (QUOTE MAXREALREGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXREALREGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXREALREGS) (QUOTE WCONST) (QUOTE 5))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE ENTRYPOINT) (QUOTE "L0353"))
+(PUT (QUOTE CODEPRIMITIVE) (QUOTE IDNUMBER) (QUOTE 267))
+(PUT (QUOTE SET) (QUOTE ENTRYPOINT) (QUOTE SET))
+(PUT (QUOTE SET) (QUOTE IDNUMBER) (QUOTE 345))
+(PUT (QUOTE IN!*) (QUOTE IDNUMBER) (QUOTE 444))
+(PUT (QUOTE IN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE PRIN2STRING) (QUOTE ENTRYPOINT) (QUOTE "L0031"))
+(PUT (QUOTE PRIN2STRING) (QUOTE IDNUMBER) (QUOTE 141))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE ENTRYPOINT) (QUOTE "L0430"))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUX) (QUOTE IDNUMBER) (QUOTE 272))
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE ENTRYPOINT) (QUOTE "L0437")
+)
+(PUT (QUOTE COMPILEDCALLINGINTERPRETEDAUXAUX) (QUOTE IDNUMBER) (QUOTE 287))
+(PUT (QUOTE CONS) (QUOTE ENTRYPOINT) (QUOTE CONS))
+(PUT (QUOTE CONS) (QUOTE IDNUMBER) (QUOTE 199))
+(PUT (QUOTE CAAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAAR))
+(PUT (QUOTE CAAAAR) (QUOTE IDNUMBER) (QUOTE 302))
+(PUT (QUOTE SYSCLOSE) (QUOTE ENTRYPOINT) (QUOTE "L1440"))
+(PUT (QUOTE SYSCLOSE) (QUOTE IDNUMBER) (QUOTE 418))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1502"))
+(PUT (QUOTE INDEPENDENTREADCHAR) (QUOTE IDNUMBER) (QUOTE 450))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0136"))
+(PUT (QUOTE HEAPLOWERBOUND) (QUOTE WVAR) (QUOTE HEAPLOWERBOUND))
+(PUT (QUOTE GTSTR) (QUOTE ENTRYPOINT) (QUOTE GTSTR))
+(PUT (QUOTE GTSTR) (QUOTE IDNUMBER) (QUOTE 184))
+(PUT (QUOTE TOKTYPE!*) (QUOTE IDNUMBER) (QUOTE 212))
+(PUT (QUOTE SYSREADREC) (QUOTE ENTRYPOINT) (QUOTE "L1420"))
+(PUT (QUOTE SYSREADREC) (QUOTE IDNUMBER) (QUOTE 414))
+(PUT (QUOTE RDS) (QUOTE ENTRYPOINT) (QUOTE RDS))
+(PUT (QUOTE RDS) (QUOTE IDNUMBER) (QUOTE 431))
+(PUT (QUOTE GTHEAP) (QUOTE ENTRYPOINT) (QUOTE GTHEAP))
+(PUT (QUOTE GTHEAP) (QUOTE IDNUMBER) (QUOTE 182))
+(PUT (QUOTE CDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDR))
+(PUT (QUOTE CDDDR) (QUOTE IDNUMBER) (QUOTE 322))
+(PUT (QUOTE FEXPR) (QUOTE IDNUMBER) (QUOTE 340))
+(PUT (QUOTE CODEAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0369"))
+(PUT (QUOTE CODEAPPLY) (QUOTE IDNUMBER) (QUOTE 278))
+(PUT (QUOTE QUOTE) (QUOTE ENTRYPOINT) (QUOTE QUOTE))
+(PUT (QUOTE QUOTE) (QUOTE IDNUMBER) (QUOTE 251))
+(PUT (QUOTE READSTR) (QUOTE ENTRYPOINT) (QUOTE "L0221"))
+(PUT (QUOTE READSTR) (QUOTE IDNUMBER) (QUOTE 217))
+(PUT (QUOTE ERRPRIN) (QUOTE ENTRYPOINT) (QUOTE "L0062"))
+(PUT (QUOTE ERRPRIN) (QUOTE IDNUMBER) (QUOTE 158))
+(PUT (QUOTE HEAPLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPLAST) (QUOTE ASMSYMBOL) (QUOTE "L0138"))
+(PUT (QUOTE HEAPLAST) (QUOTE WVAR) (QUOTE HEAPLAST))
+(PUT (QUOTE NEXTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0141"))
+(PUT (QUOTE NEXTBPS) (QUOTE WVAR) (QUOTE NEXTBPS))
+(PUT (QUOTE ERRORPRINTF) (QUOTE ENTRYPOINT) (QUOTE "L0058"))
+(PUT (QUOTE ERRORPRINTF) (QUOTE IDNUMBER) (QUOTE 154))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE ENTRYPOINT) (QUOTE "L1352"))
+(PUT (QUOTE CLEARBINDINGS) (QUOTE IDNUMBER) (QUOTE 400))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0137"))
+(PUT (QUOTE HEAPUPPERBOUND) (QUOTE WVAR) (QUOTE HEAPUPPERBOUND))
+(PUT (QUOTE SYMPRP) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMPRP) (QUOTE ASMSYMBOL) (QUOTE SYMPRP))
+(PUT (QUOTE SYMPRP) (QUOTE WARRAY) (QUOTE SYMPRP))
+(PUT (QUOTE CHANNELWRITESTRING) (QUOTE IDNUMBER) (QUOTE 457))
+(PUT (QUOTE SAFECAR) (QUOTE ENTRYPOINT) (QUOTE "L0583"))
+(PUT (QUOTE SAFECAR) (QUOTE IDNUMBER) (QUOTE 329))
+(PUT (QUOTE CDDR) (QUOTE ENTRYPOINT) (QUOTE CDDR))
+(PUT (QUOTE CDDR) (QUOTE IDNUMBER) (QUOTE 328))
+(PUT (QUOTE SYSWRITEREC) (QUOTE ENTRYPOINT) (QUOTE "L1432"))
+(PUT (QUOTE SYSWRITEREC) (QUOTE IDNUMBER) (QUOTE 417))
+(PUT (QUOTE MARKFROMALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1557"))
+(PUT (QUOTE MARKFROMALLBASES) (QUOTE IDNUMBER) (QUOTE 466))
+(PUT (QUOTE PUTBYTE) (QUOTE IDNUMBER) (QUOTE 205))
+(PUT (QUOTE IOBUFFER) (QUOTE IDNUMBER) (QUOTE 449))
+(PUT (QUOTE CDAADR) (QUOTE ENTRYPOINT) (QUOTE CDAADR))
+(PUT (QUOTE CDAADR) (QUOTE IDNUMBER) (QUOTE 315))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0392"))
+(PUT (QUOTE CODEEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 279))
+(PUT (QUOTE EQSTR) (QUOTE ENTRYPOINT) (QUOTE EQSTR))
+(PUT (QUOTE EQSTR) (QUOTE IDNUMBER) (QUOTE 207))
+(PUT (QUOTE MEMQ) (QUOTE ENTRYPOINT) (QUOTE MEMQ))
+(PUT (QUOTE MEMQ) (QUOTE IDNUMBER) (QUOTE 352))
+(PUT (QUOTE PRIN2) (QUOTE ENTRYPOINT) (QUOTE PRIN2))
+(PUT (QUOTE PRIN2) (QUOTE IDNUMBER) (QUOTE 143))
+(PUT (QUOTE !%STORE!-JCALL) (QUOTE IDNUMBER) (QUOTE 262))
+(PUT (QUOTE UPDATEREGION) (QUOTE ENTRYPOINT) (QUOTE "L1646"))
+(PUT (QUOTE UPDATEREGION) (QUOTE IDNUMBER) (QUOTE 482))
+(PUT (QUOTE GTCONSTSTR) (QUOTE ENTRYPOINT) (QUOTE "L0149"))
+(PUT (QUOTE GTCONSTSTR) (QUOTE IDNUMBER) (QUOTE 186))
+(PUT (QUOTE THROWAUX) (QUOTE ENTRYPOINT) (QUOTE "L1783"))
+(PUT (QUOTE THROWAUX) (QUOTE IDNUMBER) (QUOTE 503))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0140"))
+(PUT (QUOTE HEAPTRAPBOUND) (QUOTE WVAR) (QUOTE HEAPTRAPBOUND))
+(PUT (QUOTE !%THROW) (QUOTE ENTRYPOINT) (QUOTE !%THROW))
+(PUT (QUOTE !%THROW) (QUOTE IDNUMBER) (QUOTE 495))
+(PUT (QUOTE ALPHANUMP) (QUOTE ENTRYPOINT) (QUOTE "L0254"))
+(PUT (QUOTE ALPHANUMP) (QUOTE IDNUMBER) (QUOTE 234))
+(PUT (QUOTE SYS2INT) (QUOTE ENTRYPOINT) (QUOTE "L0805"))
+(PUT (QUOTE SYS2INT) (QUOTE IDNUMBER) (QUOTE 291))
+(PUT (QUOTE RATOM) (QUOTE ENTRYPOINT) (QUOTE RATOM))
+(PUT (QUOTE RATOM) (QUOTE IDNUMBER) (QUOTE 222))
+(PUT (QUOTE !*RAISE) (QUOTE IDNUMBER) (QUOTE 209))
+(PUT (QUOTE PROMPTSTRING!*) (QUOTE IDNUMBER) (QUOTE 458))
+(PUT (QUOTE TOSTRINGWRITECHAR) (QUOTE IDNUMBER) (QUOTE 426))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE ENTRYPOINT) (QUOTE "L0256"))
+(PUT (QUOTE ALPHANUMESCP) (QUOTE IDNUMBER) (QUOTE 228))
+(PUT (QUOTE CLOSE) (QUOTE ENTRYPOINT) (QUOTE CLOSE))
+(PUT (QUOTE CLOSE) (QUOTE IDNUMBER) (QUOTE 434))
+(PUT (QUOTE LEQ) (QUOTE ENTRYPOINT) (QUOTE LEQ))
+(PUT (QUOTE LEQ) (QUOTE IDNUMBER) (QUOTE 357))
+(PUT (QUOTE CODEFORM!*) (QUOTE IDNUMBER) (QUOTE 270))
+(FLAG (QUOTE (CODEFORM!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE CODEARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CODEARGS) (QUOTE ASMSYMBOL) (QUOTE "L0363"))
+(PUT (QUOTE CODEARGS) (QUOTE WARRAY) (QUOTE CODEARGS))
+(PUT (QUOTE ALPHAP) (QUOTE ENTRYPOINT) (QUOTE ALPHAP))
+(PUT (QUOTE ALPHAP) (QUOTE IDNUMBER) (QUOTE 231))
+(PUT (QUOTE LONGTIMES) (QUOTE IDNUMBER) (QUOTE 225))
+(PUT (QUOTE BITSPERWORD) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BITSPERWORD) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE BITSPERWORD) (QUOTE WCONST) (QUOTE 36))
+(PUT (QUOTE GTHALFWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0150"))
+(PUT (QUOTE GTHALFWORDS) (QUOTE IDNUMBER) (QUOTE 187))
+(PUT (QUOTE !$EOL!$) (QUOTE IDNUMBER) (QUOTE 430))
+(PUT (QUOTE !$EOL!$) (QUOTE INITIALVALUE) (QUOTE !
+))
+(PUT (QUOTE CAADR) (QUOTE ENTRYPOINT) (QUOTE CAADR))
+(PUT (QUOTE CAADR) (QUOTE IDNUMBER) (QUOTE 304))
+(PUT (QUOTE !*ECHO) (QUOTE IDNUMBER) (QUOTE 439))
+(FLAG (QUOTE (!*ECHO)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE MINUS) (QUOTE ENTRYPOINT) (QUOTE MINUS))
+(PUT (QUOTE MINUS) (QUOTE IDNUMBER) (QUOTE 293))
+(PUT (QUOTE LIST5) (QUOTE ENTRYPOINT) (QUOTE LIST5))
+(PUT (QUOTE LIST5) (QUOTE IDNUMBER) (QUOTE 155))
+(PUT (QUOTE !$UNWIND!-PROTECT!$) (QUOTE IDNUMBER) (QUOTE 493))
+(PUT (QUOTE STDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0079"))
+(PUT (QUOTE STDERROR) (QUOTE IDNUMBER) (QUOTE 165))
+(PUT (QUOTE PROG) (QUOTE ENTRYPOINT) (QUOTE PROG))
+(PUT (QUOTE PROG) (QUOTE IDNUMBER) (QUOTE 507))
+(PUT (QUOTE ERRORHEADER) (QUOTE ENTRYPOINT) (QUOTE "L0065"))
+(PUT (QUOTE ERRORHEADER) (QUOTE IDNUMBER) (QUOTE 159))
+(PUT (QUOTE CDAR) (QUOTE ENTRYPOINT) (QUOTE CDAR))
+(PUT (QUOTE CDAR) (QUOTE IDNUMBER) (QUOTE 327))
+(PUT (QUOTE CADDDR) (QUOTE ENTRYPOINT) (QUOTE CADDDR))
+(PUT (QUOTE CADDDR) (QUOTE IDNUMBER) (QUOTE 312))
+(PUT (QUOTE ARG13) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG13) (QUOTE ASMSYMBOL) (QUOTE ARG13))
+(PUT (QUOTE ARG13) (QUOTE WVAR) (QUOTE ARG13))
+(PUT (QUOTE GTFLTN) (QUOTE ENTRYPOINT) (QUOTE GTFLTN))
+(PUT (QUOTE GTFLTN) (QUOTE IDNUMBER) (QUOTE 192))
+(PUT (QUOTE CDDAAR) (QUOTE ENTRYPOINT) (QUOTE CDDAAR))
+(PUT (QUOTE CDDAAR) (QUOTE IDNUMBER) (QUOTE 320))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXSYMBOLS) (QUOTE WCONST) (QUOTE 800))
+(PUT (QUOTE !*LAMBDALINK) (QUOTE IDNUMBER) (QUOTE 288))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0120"))
+(PUT (QUOTE NONCHARACTERERROR) (QUOTE IDNUMBER) (QUOTE 174))
+(PUT (QUOTE !*PVAL) (QUOTE IDNUMBER) (QUOTE 438))
+(FLAG (QUOTE (!*PVAL)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SYSCLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1410"))
+(PUT (QUOTE SYSCLEARIO) (QUOTE IDNUMBER) (QUOTE 406))
+(PUT (QUOTE PRIN2PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0045"))
+(PUT (QUOTE PRIN2PAIR) (QUOTE IDNUMBER) (QUOTE 142))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE ENTRYPOINT) (QUOTE "L0364"))
+(PUT (QUOTE SAVEREGISTERS) (QUOTE IDNUMBER) (QUOTE 269))
+(PUT (QUOTE ARG9) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG9) (QUOTE ASMSYMBOL) (QUOTE ARG9))
+(PUT (QUOTE ARG9) (QUOTE WVAR) (QUOTE ARG9))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE ASMSYMBOL) (QUOTE "L1450"))
+(PUT (QUOTE CHANNELSTATUS) (QUOTE WARRAY) (QUOTE CHANNELSTATUS))
+(PUT (QUOTE MKQUOTE) (QUOTE ENTRYPOINT) (QUOTE "L2225"))
+(PUT (QUOTE MKQUOTE) (QUOTE IDNUMBER) (QUOTE 505))
+(PUT (QUOTE ERROR) (QUOTE ENTRYPOINT) (QUOTE ERROR))
+(PUT (QUOTE ERROR) (QUOTE IDNUMBER) (QUOTE 161))
+(PUT (QUOTE RESET) (QUOTE IDNUMBER) (QUOTE 393))
+(PUT (QUOTE !&!&VALUE!&!&) (QUOTE IDNUMBER) (QUOTE 485))
+(PUT (QUOTE REMPROP) (QUOTE ENTRYPOINT) (QUOTE "L0791"))
+(PUT (QUOTE REMPROP) (QUOTE IDNUMBER) (QUOTE 391))
+(PUT (QUOTE INITOBLIST) (QUOTE ENTRYPOINT) (QUOTE "L0292"))
+(PUT (QUOTE INITOBLIST) (QUOTE IDNUMBER) (QUOTE 247))
+(PUT (QUOTE BINDEVAL) (QUOTE ENTRYPOINT) (QUOTE "L0419"))
+(PUT (QUOTE BINDEVAL) (QUOTE IDNUMBER) (QUOTE 284))
+(PUT (QUOTE CLEARIO) (QUOTE ENTRYPOINT) (QUOTE "L1520"))
+(PUT (QUOTE CLEARIO) (QUOTE IDNUMBER) (QUOTE 456))
+(PUT (QUOTE BUILDRELOCATIONFIELDS) (QUOTE ENTRYPOINT) (QUOTE "L1612"))
+(PUT (QUOTE BUILDRELOCATIONFIELDS) (QUOTE IDNUMBER) (QUOTE 468))
+(PUT (QUOTE HARDCONS) (QUOTE ENTRYPOINT) (QUOTE "L0167"))
+(PUT (QUOTE HARDCONS) (QUOTE IDNUMBER) (QUOTE 198))
+(PUT (QUOTE GTBPS) (QUOTE ENTRYPOINT) (QUOTE GTBPS))
+(PUT (QUOTE GTBPS) (QUOTE IDNUMBER) (QUOTE 185))
+(PUT (QUOTE UPDATEITEM) (QUOTE ENTRYPOINT) (QUOTE "L1677"))
+(PUT (QUOTE UPDATEITEM) (QUOTE IDNUMBER) (QUOTE 483))
+(PUT (QUOTE CADDR) (QUOTE ENTRYPOINT) (QUOTE CADDR))
+(PUT (QUOTE CADDR) (QUOTE IDNUMBER) (QUOTE 310))
+(PUT (QUOTE FEXPRP) (QUOTE IDNUMBER) (QUOTE 243))
+(PUT (QUOTE ARG7) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG7) (QUOTE ASMSYMBOL) (QUOTE ARG7))
+(PUT (QUOTE ARG7) (QUOTE WVAR) (QUOTE ARG7))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE ENTRYPOINT) (QUOTE "L0055"))
+(PUT (QUOTE CHANNELPRIN2) (QUOTE IDNUMBER) (QUOTE 152))
+(PUT (QUOTE THROW) (QUOTE ENTRYPOINT) (QUOTE THROW))
+(PUT (QUOTE THROW) (QUOTE IDNUMBER) (QUOTE 500))
+(PUT (QUOTE NEXTPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1453"))
+(PUT (QUOTE NEXTPOSITION) (QUOTE WARRAY) (QUOTE NEXTPOSITION))
+(PUT (QUOTE VECTORP) (QUOTE ENTRYPOINT) (QUOTE "L0752"))
+(PUT (QUOTE VECTORP) (QUOTE IDNUMBER) (QUOTE 381))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE IDNUMBER) (QUOTE 464))
+(PUT (QUOTE HEAP!-WARN!-LEVEL) (QUOTE INITIALVALUE) (QUOTE 1000))
+(PUT (QUOTE DELWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0165"))
+(PUT (QUOTE DELWARRAY) (QUOTE IDNUMBER) (QUOTE 197))
+(PUT (QUOTE CODEP) (QUOTE ENTRYPOINT) (QUOTE CODEP))
+(PUT (QUOTE CODEP) (QUOTE IDNUMBER) (QUOTE 374))
+(PUT (QUOTE FLUID) (QUOTE ENTRYPOINT) (QUOTE FLUID))
+(PUT (QUOTE FLUID) (QUOTE IDNUMBER) (QUOTE 385))
+(PUT (QUOTE EQ) (QUOTE ENTRYPOINT) (QUOTE EQ))
+(PUT (QUOTE EQ) (QUOTE IDNUMBER) (QUOTE 375))
+(PUT (QUOTE PAIRP) (QUOTE ENTRYPOINT) (QUOTE PAIRP))
+(PUT (QUOTE PAIRP) (QUOTE IDNUMBER) (QUOTE 379))
+(PUT (QUOTE CH!*) (QUOTE IDNUMBER) (QUOTE 210))
+(PUT (QUOTE ILLEGALSTANDARDCHANNELCLOSE) (QUOTE IDNUMBER) (QUOTE 429))
+(PUT (QUOTE EXPLODEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 427))
+(PUT (QUOTE HALFWORD) (QUOTE IDNUMBER) (QUOTE 478))
+(PUT (QUOTE CAADDR) (QUOTE ENTRYPOINT) (QUOTE CAADDR))
+(PUT (QUOTE CAADDR) (QUOTE IDNUMBER) (QUOTE 306))
+(PUT (QUOTE TYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0086"))
+(PUT (QUOTE TYPEERROR) (QUOTE IDNUMBER) (QUOTE 166))
+(PUT (QUOTE DE) (QUOTE ENTRYPOINT) (QUOTE DE))
+(PUT (QUOTE DE) (QUOTE IDNUMBER) (QUOTE 337))
+(PUT (QUOTE ELSE) (QUOTE IDNUMBER) (QUOTE 294))
+(PUT (QUOTE ARG5) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG5) (QUOTE ASMSYMBOL) (QUOTE ARG5))
+(PUT (QUOTE ARG5) (QUOTE WVAR) (QUOTE ARG5))
+(PUT (QUOTE ADDRESSINGUNITSPERFUNCTIONCELL) (QUOTE IDNUMBER) (QUOTE 257))
+(PUT (QUOTE MARKFROMBASE) (QUOTE ENTRYPOINT) (QUOTE "L1580"))
+(PUT (QUOTE MARKFROMBASE) (QUOTE IDNUMBER) (QUOTE 476))
+(PUT (QUOTE UPPERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0242"))
+(PUT (QUOTE UPPERCASEP) (QUOTE IDNUMBER) (QUOTE 233))
+(PUT (QUOTE NONWORDS) (QUOTE ENTRYPOINT) (QUOTE "L0129"))
+(PUT (QUOTE NONWORDS) (QUOTE IDNUMBER) (QUOTE 177))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0273"))
+(PUT (QUOTE LOOKUPSTRING) (QUOTE IDNUMBER) (QUOTE 235))
+(PUT (QUOTE INDEXERROR) (QUOTE ENTRYPOINT) (QUOTE "L0102"))
+(PUT (QUOTE INDEXERROR) (QUOTE IDNUMBER) (QUOTE 168))
+(PUT (QUOTE INITNEWID) (QUOTE ENTRYPOINT) (QUOTE "L0265"))
+(PUT (QUOTE INITNEWID) (QUOTE IDNUMBER) (QUOTE 237))
+(PUT (QUOTE MARKFROMRANGE) (QUOTE ENTRYPOINT) (QUOTE "L1573"))
+(PUT (QUOTE MARKFROMRANGE) (QUOTE IDNUMBER) (QUOTE 475))
+(PUT (QUOTE UPDATESYMBOLS) (QUOTE ENTRYPOINT) (QUOTE "L1641"))
+(PUT (QUOTE UPDATESYMBOLS) (QUOTE IDNUMBER) (QUOTE 481))
+(PUT (QUOTE GCMESSAGE) (QUOTE ENTRYPOINT) (QUOTE "L1714"))
+(PUT (QUOTE GCMESSAGE) (QUOTE IDNUMBER) (QUOTE 471))
+(PUT (QUOTE ATOM) (QUOTE ENTRYPOINT) (QUOTE ATOM))
+(PUT (QUOTE ATOM) (QUOTE IDNUMBER) (QUOTE 332))
+(PUT (QUOTE CODEPRIMITIVEWGETV) (QUOTE IDNUMBER) (QUOTE 282))
+(PUT (QUOTE PROGN) (QUOTE ENTRYPOINT) (QUOTE PROGN))
+(PUT (QUOTE PROGN) (QUOTE IDNUMBER) (QUOTE 347))
+(PUT (QUOTE MKVECT) (QUOTE ENTRYPOINT) (QUOTE MKVECT))
+(PUT (QUOTE MKVECT) (QUOTE IDNUMBER) (QUOTE 201))
+(PUT (QUOTE !$EOF!$) (QUOTE IDNUMBER) (QUOTE 437))
+(PUT (QUOTE DIGITP) (QUOTE ENTRYPOINT) (QUOTE DIGITP))
+(PUT (QUOTE DIGITP) (QUOTE IDNUMBER) (QUOTE 218))
+(PUT (QUOTE ARG3) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG3) (QUOTE ASMSYMBOL) (QUOTE ARG3))
+(PUT (QUOTE ARG3) (QUOTE WVAR) (QUOTE ARG3))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0114"))
+(PUT (QUOTE NONINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 172))
+(PUT (QUOTE BNDSTKPTR) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKPTR) (QUOTE ASMSYMBOL) (QUOTE "L1341"))
+(PUT (QUOTE BNDSTKPTR) (QUOTE WVAR) (QUOTE BNDSTKPTR))
+(PUT (QUOTE FASTAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0359"))
+(PUT (QUOTE FASTAPPLY) (QUOTE IDNUMBER) (QUOTE 273))
+(PUT (QUOTE PROGBIND) (QUOTE ENTRYPOINT) (QUOTE "L1366"))
+(PUT (QUOTE PROGBIND) (QUOTE IDNUMBER) (QUOTE 404))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1511"))
+(PUT (QUOTE SYSTEMMARKASCLOSEDCHANNEL) (QUOTE IDNUMBER) (QUOTE 454))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0006"))
+(PUT (QUOTE CHANNELWRITECHAR) (QUOTE IDNUMBER) (QUOTE 130))
+(PUT (QUOTE PRIN1) (QUOTE ENTRYPOINT) (QUOTE PRIN1))
+(PUT (QUOTE PRIN1) (QUOTE IDNUMBER) (QUOTE 139))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE ASMSYMBOL) (QUOTE "L1541"))
+(PUT (QUOTE HEAPTRAPPED) (QUOTE WVAR) (QUOTE HEAPTRAPPED))
+(PUT (QUOTE CDAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAR))
+(PUT (QUOTE CDAAR) (QUOTE IDNUMBER) (QUOTE 313))
+(PUT (QUOTE SHOULDBEUNDEFINED) (QUOTE IDNUMBER) (QUOTE 258))
+(PUT (QUOTE SYSOPENREAD) (QUOTE ENTRYPOINT) (QUOTE "L1412"))
+(PUT (QUOTE SYSOPENREAD) (QUOTE IDNUMBER) (QUOTE 409))
+(PUT (QUOTE PUTD) (QUOTE ENTRYPOINT) (QUOTE PUTD))
+(PUT (QUOTE PUTD) (QUOTE IDNUMBER) (QUOTE 336))
+(PUT (QUOTE DF) (QUOTE ENTRYPOINT) (QUOTE DF))
+(PUT (QUOTE DF) (QUOTE IDNUMBER) (QUOTE 339))
+(PUT (QUOTE CDAAAR) (QUOTE ENTRYPOINT) (QUOTE CDAAAR))
+(PUT (QUOTE CDAAAR) (QUOTE IDNUMBER) (QUOTE 314))
+(PUT (QUOTE COPYD) (QUOTE ENTRYPOINT) (QUOTE COPYD))
+(PUT (QUOTE COPYD) (QUOTE IDNUMBER) (QUOTE 360))
+(PUT (QUOTE ARG1) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG1) (QUOTE ASMSYMBOL) (QUOTE ARG1))
+(PUT (QUOTE ARG1) (QUOTE WVAR) (QUOTE ARG1))
+(PUT (QUOTE LENGTH1) (QUOTE ENTRYPOINT) (QUOTE "L0772"))
+(PUT (QUOTE LENGTH1) (QUOTE IDNUMBER) (QUOTE 384))
+(PUT (QUOTE LAPIN) (QUOTE ENTRYPOINT) (QUOTE LAPIN))
+(PUT (QUOTE LAPIN) (QUOTE IDNUMBER) (QUOTE 440))
+(PUT (QUOTE !*CATCH) (QUOTE ENTRYPOINT) (QUOTE "L1766"))
+(PUT (QUOTE !*CATCH) (QUOTE IDNUMBER) (QUOTE 499))
+(PUT (QUOTE GETC) (QUOTE IDNUMBER) (QUOTE 224))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0117"))
+(PUT (QUOTE NONPOSITIVEINTEGERERROR) (QUOTE IDNUMBER) (QUOTE 173))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0719"))
+(PUT (QUOTE LAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 370))
+(PUT (QUOTE !%UNCATCH) (QUOTE ENTRYPOINT) (QUOTE "L1778"))
+(PUT (QUOTE !%UNCATCH) (QUOTE IDNUMBER) (QUOTE 498))
+(PUT (QUOTE NONVECTORERROR) (QUOTE ENTRYPOINT) (QUOTE "L0126"))
+(PUT (QUOTE NONVECTORERROR) (QUOTE IDNUMBER) (QUOTE 176))
+(PUT (QUOTE CADDAR) (QUOTE ENTRYPOINT) (QUOTE CADDAR))
+(PUT (QUOTE CADDAR) (QUOTE IDNUMBER) (QUOTE 311))
+(PUT (QUOTE NOT) (QUOTE ENTRYPOINT) (QUOTE NOT))
+(PUT (QUOTE NOT) (QUOTE IDNUMBER) (QUOTE 350))
+(PUT (QUOTE GREATERP) (QUOTE ENTRYPOINT) (QUOTE "L0465"))
+(PUT (QUOTE GREATERP) (QUOTE IDNUMBER) (QUOTE 297))
+(PUT (QUOTE EVCOND) (QUOTE ENTRYPOINT) (QUOTE EVCOND))
+(PUT (QUOTE EVCOND) (QUOTE IDNUMBER) (QUOTE 348))
+(PUT (QUOTE WRITEONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 422))
+(PUT (QUOTE FLUSHBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1509"))
+(PUT (QUOTE FLUSHBUFFER) (QUOTE IDNUMBER) (QUOTE 453))
+(PUT (QUOTE CDDDDR) (QUOTE ENTRYPOINT) (QUOTE CDDDDR))
+(PUT (QUOTE CDDDDR) (QUOTE IDNUMBER) (QUOTE 324))
+(PUT (QUOTE WQUOTIENT) (QUOTE IDNUMBER) (QUOTE 180))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0097"))
+(PUT (QUOTE USAGETYPEERROR) (QUOTE IDNUMBER) (QUOTE 167))
+(PUT (QUOTE PBIND1) (QUOTE ENTRYPOINT) (QUOTE PBIND1))
+(PUT (QUOTE PBIND1) (QUOTE IDNUMBER) (QUOTE 401))
+(PUT (QUOTE CHANNELTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CHANNELTABLE) (QUOTE ASMSYMBOL) (QUOTE "L1452"))
+(PUT (QUOTE CHANNELTABLE) (QUOTE WARRAY) (QUOTE CHANNELTABLE))
+(PUT (QUOTE CDR) (QUOTE ENTRYPOINT) (QUOTE CDR))
+(PUT (QUOTE CDR) (QUOTE IDNUMBER) (QUOTE 331))
+(PUT (QUOTE LIST4) (QUOTE ENTRYPOINT) (QUOTE LIST4))
+(PUT (QUOTE LIST4) (QUOTE IDNUMBER) (QUOTE 202))
+(PUT (QUOTE !*GC) (QUOTE IDNUMBER) (QUOTE 461))
+(PUT (QUOTE !*GC) (QUOTE INITIALVALUE) (QUOTE T))
+(PUT (QUOTE PRIN1INTX) (QUOTE ENTRYPOINT) (QUOTE "L0024"))
+(PUT (QUOTE PRIN1INTX) (QUOTE IDNUMBER) (QUOTE 148))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE ENTRYPOINT) (QUOTE "L0289"))
+(PUT (QUOTE PRINT1FUNCTION) (QUOTE IDNUMBER) (QUOTE 245))
+(PUT (QUOTE MAXCHANNELS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXCHANNELS) (QUOTE WCONST) (QUOTE 31))
+(PUT (QUOTE ARG12) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG12) (QUOTE ASMSYMBOL) (QUOTE ARG12))
+(PUT (QUOTE ARG12) (QUOTE WVAR) (QUOTE ARG12))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE ENTRYPOINT) (QUOTE "L1495"))
+(PUT (QUOTE SYSTEMOPENFILESPECIAL) (QUOTE IDNUMBER) (QUOTE 451))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE ENTRYPOINT) (QUOTE "L0123"))
+(PUT (QUOTE NONSTRINGERROR) (QUOTE IDNUMBER) (QUOTE 175))
+(PUT (QUOTE !$ERROR!$) (QUOTE IDNUMBER) (QUOTE 506))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1512"))
+(PUT (QUOTE INDEPENDENTCLOSECHANNEL) (QUOTE IDNUMBER) (QUOTE 443))
+(PUT (QUOTE MACRO) (QUOTE IDNUMBER) (QUOTE 344))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE ENTRYPOINT) (QUOTE "L1526"))
+(PUT (QUOTE TERMINALINPUTHANDLER) (QUOTE IDNUMBER) (QUOTE 421))
+(PUT (QUOTE OUT!*) (QUOTE IDNUMBER) (QUOTE 133))
+(PUT (QUOTE OUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE GO) (QUOTE ENTRYPOINT) (QUOTE GO))
+(PUT (QUOTE GO) (QUOTE IDNUMBER) (QUOTE 511))
+(PUT (QUOTE STDOUT!*) (QUOTE IDNUMBER) (QUOTE 446))
+(PUT (QUOTE STDOUT!*) (QUOTE INITIALVALUE) (QUOTE 1))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE ASMSYMBOL) (QUOTE "L0139"))
+(PUT (QUOTE HEAPPREVIOUSLAST) (QUOTE WVAR) (QUOTE HEAPPREVIOUSLAST))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1483"))
+(PUT (QUOTE FINDFREECHANNEL) (QUOTE IDNUMBER) (QUOTE 448))
+(PUT (QUOTE !&!&TAG!&!&) (QUOTE IDNUMBER) (QUOTE 494))
+(PUT (QUOTE TYPE) (QUOTE IDNUMBER) (QUOTE 365))
+(PUT (QUOTE CDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDAR))
+(PUT (QUOTE CDDAR) (QUOTE IDNUMBER) (QUOTE 319))
+(PUT (QUOTE EMSG!*) (QUOTE IDNUMBER) (QUOTE 502))
+(FLAG (QUOTE (EMSG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1506"))
+(PUT (QUOTE INDEPENDENTWRITECHAR) (QUOTE IDNUMBER) (QUOTE 131))
+(PUT (QUOTE PRIN1PAIR) (QUOTE ENTRYPOINT) (QUOTE "L0037"))
+(PUT (QUOTE PRIN1PAIR) (QUOTE IDNUMBER) (QUOTE 137))
+(PUT (QUOTE PRINTF) (QUOTE ENTRYPOINT) (QUOTE PRINTF))
+(PUT (QUOTE PRINTF) (QUOTE IDNUMBER) (QUOTE 153))
+(PUT (QUOTE PROGBODY!*) (QUOTE IDNUMBER) (QUOTE 508))
+(FLAG (QUOTE (PROGBODY!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE ENTRYPOINT) (QUOTE "L1763"))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE IDNUMBER) (QUOTE 496))
+(PUT (QUOTE PRINT) (QUOTE ENTRYPOINT) (QUOTE PRINT))
+(PUT (QUOTE PRINT) (QUOTE IDNUMBER) (QUOTE 145))
+(PUT (QUOTE SAFECDR) (QUOTE ENTRYPOINT) (QUOTE "L0588"))
+(PUT (QUOTE SAFECDR) (QUOTE IDNUMBER) (QUOTE 252))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE ENTRYPOINT) (QUOTE "L0324"))
+(PUT (QUOTE MAKEFUNBOUND) (QUOTE IDNUMBER) (QUOTE 238))
+(PUT (QUOTE DELATQ) (QUOTE ENTRYPOINT) (QUOTE DELATQ))
+(PUT (QUOTE DELATQ) (QUOTE IDNUMBER) (QUOTE 361))
+(PUT (QUOTE HASHTABLE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE HASHTABLE) (QUOTE ASMSYMBOL) (QUOTE "L0005"))
+(PUT (QUOTE HASHTABLE) (QUOTE WARRAY) (QUOTE HASHTABLE))
+(PUT (QUOTE !%COPY!-FUNCTION!-CELL) (QUOTE IDNUMBER) (QUOTE 259))
+(PUT (QUOTE GTEVECT) (QUOTE ENTRYPOINT) (QUOTE "L0151"))
+(PUT (QUOTE GTEVECT) (QUOTE IDNUMBER) (QUOTE 189))
+(PUT (QUOTE PROP) (QUOTE ENTRYPOINT) (QUOTE PROP))
+(PUT (QUOTE PROP) (QUOTE IDNUMBER) (QUOTE 390))
+(PUT (QUOTE CONTINUABLEERROR) (QUOTE IDNUMBER) (QUOTE 473))
+(PUT (QUOTE CODENARG!*) (QUOTE IDNUMBER) (QUOTE 271))
+(FLAG (QUOTE (CODENARG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE BIGP) (QUOTE ENTRYPOINT) (QUOTE BIGP))
+(PUT (QUOTE BIGP) (QUOTE IDNUMBER) (QUOTE 377))
+(PUT (QUOTE AFTERGCSYSTEMHOOK) (QUOTE ENTRYPOINT) (QUOTE "L1539"))
+(PUT (QUOTE AFTERGCSYSTEMHOOK) (QUOTE IDNUMBER) (QUOTE 460))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1445"))
+(PUT (QUOTE WRITEFUNCTION) (QUOTE WARRAY) (QUOTE WRITEFUNCTION))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1514"))
+(PUT (QUOTE CLEARONECHANNEL) (QUOTE IDNUMBER) (QUOTE 455))
+(PUT (QUOTE CDADDR) (QUOTE ENTRYPOINT) (QUOTE CDADDR))
+(PUT (QUOTE CDADDR) (QUOTE IDNUMBER) (QUOTE 318))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE ENTRYPOINT) (QUOTE "L1407"))
+(PUT (QUOTE CODE!-NUMBER!-OF!-ARGUMENTS) (QUOTE IDNUMBER) (QUOTE 405))
+(PUT (QUOTE BEFOREGCSYSTEMHOOK) (QUOTE ENTRYPOINT) (QUOTE "L1534"))
+(PUT (QUOTE BEFOREGCSYSTEMHOOK) (QUOTE IDNUMBER) (QUOTE 459))
+(PUT (QUOTE GTWARRAY) (QUOTE ENTRYPOINT) (QUOTE "L0162"))
+(PUT (QUOTE GTWARRAY) (QUOTE IDNUMBER) (QUOTE 196))
+(PUT (QUOTE TIMC) (QUOTE IDNUMBER) (QUOTE 465))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L1436"))
+(PUT (QUOTE DEC20WRITECHAR) (QUOTE IDNUMBER) (QUOTE 416))
+(PUT (QUOTE ALPHAESCP) (QUOTE ENTRYPOINT) (QUOTE "L0252"))
+(PUT (QUOTE ALPHAESCP) (QUOTE IDNUMBER) (QUOTE 220))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE ENTRYPOINT) (QUOTE "L1442"))
+(PUT (QUOTE SYSMAXBUFFER) (QUOTE IDNUMBER) (QUOTE 420))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1349"))
+(PUT (QUOTE RESTOREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 398))
+(PUT (QUOTE PUTHALFWORD) (QUOTE IDNUMBER) (QUOTE 239))
+(PUT (QUOTE EVLIS) (QUOTE ENTRYPOINT) (QUOTE EVLIS))
+(PUT (QUOTE EVLIS) (QUOTE IDNUMBER) (QUOTE 354))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE ENTRYPOINT) (QUOTE "L0111"))
+(PUT (QUOTE NONNUMBERERROR) (QUOTE IDNUMBER) (QUOTE 171))
+(PUT (QUOTE APPLY) (QUOTE ENTRYPOINT) (QUOTE APPLY))
+(PUT (QUOTE APPLY) (QUOTE IDNUMBER) (QUOTE 371))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE ASMSYMBOL) (QUOTE "L1454"))
+(PUT (QUOTE BUFFERLENGTH) (QUOTE WARRAY) (QUOTE BUFFERLENGTH))
+(PUT (QUOTE MARKFROMVECTOR) (QUOTE ENTRYPOINT) (QUOTE "L1592"))
+(PUT (QUOTE MARKFROMVECTOR) (QUOTE IDNUMBER) (QUOTE 479))
+(PUT (QUOTE LOWERCASEP) (QUOTE ENTRYPOINT) (QUOTE "L0246"))
+(PUT (QUOTE LOWERCASEP) (QUOTE IDNUMBER) (QUOTE 232))
+(PUT (QUOTE LENGTH) (QUOTE ENTRYPOINT) (QUOTE LENGTH))
+(PUT (QUOTE LENGTH) (QUOTE IDNUMBER) (QUOTE 373))
+(PUT (QUOTE PRTITM) (QUOTE ENTRYPOINT) (QUOTE PRTITM))
+(PUT (QUOTE PRTITM) (QUOTE IDNUMBER) (QUOTE 138))
+(PUT (QUOTE READ) (QUOTE ENTRYPOINT) (QUOTE READ))
+(PUT (QUOTE READ) (QUOTE IDNUMBER) (QUOTE 249))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE ENTRYPOINT) (QUOTE "L1348"))
+(PUT (QUOTE CAPTUREENVIRONMENT) (QUOTE IDNUMBER) (QUOTE 397))
+(PUT (QUOTE GETFNTYPE) (QUOTE ENTRYPOINT) (QUOTE "L0796"))
+(PUT (QUOTE GETFNTYPE) (QUOTE IDNUMBER) (QUOTE 369))
+(PUT (QUOTE FLATSIZEWRITECHAR) (QUOTE IDNUMBER) (QUOTE 428))
+(PUT (QUOTE PUT) (QUOTE ENTRYPOINT) (QUOTE PUT))
+(PUT (QUOTE PUT) (QUOTE IDNUMBER) (QUOTE 362))
+(PUT (QUOTE GETLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0736"))
+(PUT (QUOTE GETLAMBDA) (QUOTE IDNUMBER) (QUOTE 367))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1344"))
+(PUT (QUOTE BSTACKOVERFLOW) (QUOTE IDNUMBER) (QUOTE 394))
+(PUT (QUOTE CAADAR) (QUOTE ENTRYPOINT) (QUOTE CAADAR))
+(PUT (QUOTE CAADAR) (QUOTE IDNUMBER) (QUOTE 305))
+(PUT (QUOTE XCONS) (QUOTE ENTRYPOINT) (QUOTE XCONS))
+(PUT (QUOTE XCONS) (QUOTE IDNUMBER) (QUOTE 156))
+(PUT (QUOTE UNREADBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE UNREADBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1447"))
+(PUT (QUOTE UNREADBUFFER) (QUOTE WARRAY) (QUOTE UNREADBUFFER))
+(PUT (QUOTE BYTE) (QUOTE IDNUMBER) (QUOTE 151))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE ENTRYPOINT) (QUOTE "L0288"))
+(PUT (QUOTE PRINTFUNCTIONS) (QUOTE IDNUMBER) (QUOTE 244))
+(PUT (QUOTE PRIN1INT) (QUOTE ENTRYPOINT) (QUOTE "L0020"))
+(PUT (QUOTE PRIN1INT) (QUOTE IDNUMBER) (QUOTE 135))
+(PUT (QUOTE LINEPOSITION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LINEPOSITION) (QUOTE ASMSYMBOL) (QUOTE "L1448"))
+(PUT (QUOTE LINEPOSITION) (QUOTE WARRAY) (QUOTE LINEPOSITION))
+(PUT (QUOTE TOKENBUFFER) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE TOKENBUFFER) (QUOTE ASMSYMBOL) (QUOTE "L1443"))
+(PUT (QUOTE TOKENBUFFER) (QUOTE WSTRING) (QUOTE TOKENBUFFER))
+(PUT (QUOTE INTERN) (QUOTE ENTRYPOINT) (QUOTE INTERN))
+(PUT (QUOTE INTERN) (QUOTE IDNUMBER) (QUOTE 229))
+(PUT (QUOTE LAMBDAP) (QUOTE ENTRYPOINT) (QUOTE "L0730"))
+(PUT (QUOTE LAMBDAP) (QUOTE IDNUMBER) (QUOTE 366))
+(PUT (QUOTE LIST) (QUOTE ENTRYPOINT) (QUOTE LIST))
+(PUT (QUOTE LIST) (QUOTE IDNUMBER) (QUOTE 335))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE ENTRYPOINT) (QUOTE "L0396"))
+(PUT (QUOTE CODEEVALAPPLYAUX) (QUOTE IDNUMBER) (QUOTE 280))
+(PUT (QUOTE SYS2FIXN) (QUOTE ENTRYPOINT) (QUOTE "L0809"))
+(PUT (QUOTE SYS2FIXN) (QUOTE IDNUMBER) (QUOTE 392))
+(PUT (QUOTE CATCH) (QUOTE ENTRYPOINT) (QUOTE CATCH))
+(PUT (QUOTE CATCH) (QUOTE IDNUMBER) (QUOTE 488))
+(PUT (QUOTE CHANNELERROR) (QUOTE IDNUMBER) (QUOTE 419))
+(PUT (QUOTE DOLAMBDA) (QUOTE ENTRYPOINT) (QUOTE "L0723"))
+(PUT (QUOTE DOLAMBDA) (QUOTE IDNUMBER) (QUOTE 372))
+(PUT (QUOTE TIMES2) (QUOTE ENTRYPOINT) (QUOTE TIMES2))
+(PUT (QUOTE TIMES2) (QUOTE IDNUMBER) (QUOTE 300))
+(PUT (QUOTE !%RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1553"))
+(PUT (QUOTE !%RECLAIM) (QUOTE IDNUMBER) (QUOTE 181))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE ENTRYPOINT) (QUOTE "L1347"))
+(PUT (QUOTE BSTACKUNDERFLOW) (QUOTE IDNUMBER) (QUOTE 396))
+(PUT (QUOTE CDDDAR) (QUOTE ENTRYPOINT) (QUOTE CDDDAR))
+(PUT (QUOTE CDDDAR) (QUOTE IDNUMBER) (QUOTE 323))
+(PUT (QUOTE NULL) (QUOTE ENTRYPOINT) (QUOTE NULL))
+(PUT (QUOTE NULL) (QUOTE IDNUMBER) (QUOTE 334))
+(PUT (QUOTE INITREAD) (QUOTE ENTRYPOINT) (QUOTE "L0197"))
+(PUT (QUOTE INITREAD) (QUOTE IDNUMBER) (QUOTE 208))
+(PUT (QUOTE APPEND) (QUOTE ENTRYPOINT) (QUOTE APPEND))
+(PUT (QUOTE APPEND) (QUOTE IDNUMBER) (QUOTE 351))
+(PUT (QUOTE CAR) (QUOTE ENTRYPOINT) (QUOTE CAR))
+(PUT (QUOTE CAR) (QUOTE IDNUMBER) (QUOTE 330))
+(PUT (QUOTE AND) (QUOTE IDNUMBER) (QUOTE 490))
+(PUT (QUOTE TYPEFILE) (QUOTE ENTRYPOINT) (QUOTE "L1462"))
+(PUT (QUOTE TYPEFILE) (QUOTE IDNUMBER) (QUOTE 435))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE ENTRYPOINT) (QUOTE "L0333"))
+(PUT (QUOTE MAKEFLAMBDALINK) (QUOTE IDNUMBER) (QUOTE 263))
+(PUT (QUOTE !&!&THROWN!&!&) (QUOTE IDNUMBER) (QUOTE 492))
+(PUT (QUOTE COMPRESSREADCHAR) (QUOTE IDNUMBER) (QUOTE 423))
+(PUT (QUOTE DEBUG) (QUOTE IDNUMBER) (QUOTE 213))
+(PUT (QUOTE FLUIDP) (QUOTE ENTRYPOINT) (QUOTE FLUIDP))
+(PUT (QUOTE FLUIDP) (QUOTE IDNUMBER) (QUOTE 386))
+(PUT (QUOTE DEC20READCHAR) (QUOTE ENTRYPOINT) (QUOTE "L1427"))
+(PUT (QUOTE DEC20READCHAR) (QUOTE IDNUMBER) (QUOTE 413))
+(PUT (QUOTE ERROUT!*) (QUOTE IDNUMBER) (QUOTE 395))
+(PUT (QUOTE ERROUT!*) (QUOTE INITIALVALUE) (QUOTE 5))
+(PUT (QUOTE CADADR) (QUOTE ENTRYPOINT) (QUOTE CADADR))
+(PUT (QUOTE CADADR) (QUOTE IDNUMBER) (QUOTE 309))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE ENTRYPOINT) (QUOTE "L0284"))
+(PUT (QUOTE PRINTFEXPRS) (QUOTE IDNUMBER) (QUOTE 241))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0001"))
+(PUT (QUOTE STACKLOWERBOUND) (QUOTE WVAR) (QUOTE STACKLOWERBOUND))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1739"))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE IDNUMBER) (QUOTE 491))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE ENTRYPOINT) (QUOTE "L0135"))
+(PUT (QUOTE NONIOCHANNELERROR) (QUOTE IDNUMBER) (QUOTE 179))
+(PUT (QUOTE RPLACD) (QUOTE ENTRYPOINT) (QUOTE RPLACD))
+(PUT (QUOTE RPLACD) (QUOTE IDNUMBER) (QUOTE 383))
+(PUT (QUOTE PRIN1ID) (QUOTE ENTRYPOINT) (QUOTE "L0027"))
+(PUT (QUOTE PRIN1ID) (QUOTE IDNUMBER) (QUOTE 134))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0720"))
+(PUT (QUOTE LAMBDAEVALAPPLY) (QUOTE IDNUMBER) (QUOTE 368))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE ENTRYPOINT) (QUOTE "L0431"))
+(PUT (QUOTE FASTLAMBDAAPPLY) (QUOTE IDNUMBER) (QUOTE 274))
+(PUT (QUOTE BLDMSG) (QUOTE ENTRYPOINT) (QUOTE BLDMSG))
+(PUT (QUOTE BLDMSG) (QUOTE IDNUMBER) (QUOTE 157))
+(PUT (QUOTE EXPR) (QUOTE IDNUMBER) (QUOTE 338))
+(PUT (QUOTE MAXARGS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXARGS) (QUOTE ASMSYMBOL) (QUOTE NIL))
+(PUT (QUOTE MAXARGS) (QUOTE WCONST) (QUOTE 15))
+(PUT (QUOTE MAXLINE) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE MAXLINE) (QUOTE ASMSYMBOL) (QUOTE "L1449"))
+(PUT (QUOTE MAXLINE) (QUOTE WARRAY) (QUOTE MAXLINE))
+(PUT (QUOTE WPLUS2) (QUOTE IDNUMBER) (QUOTE 254))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE ENTRYPOINT) (QUOTE "L0365"))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUX) (QUOTE IDNUMBER) (QUOTE 276))
+(PUT (QUOTE EQCAR) (QUOTE ENTRYPOINT) (QUOTE EQCAR))
+(PUT (QUOTE EQCAR) (QUOTE IDNUMBER) (QUOTE 358))
+(PUT (QUOTE ARG15) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG15) (QUOTE ASMSYMBOL) (QUOTE ARG15))
+(PUT (QUOTE ARG15) (QUOTE WVAR) (QUOTE ARG15))
+(PUT (QUOTE ATSOC) (QUOTE ENTRYPOINT) (QUOTE ATSOC))
+(PUT (QUOTE ATSOC) (QUOTE IDNUMBER) (QUOTE 355))
+(PUT (QUOTE LASTBPS) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE LASTBPS) (QUOTE ASMSYMBOL) (QUOTE "L0142"))
+(PUT (QUOTE LASTBPS) (QUOTE WVAR) (QUOTE LASTBPS))
+(PUT (QUOTE MKSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0184"))
+(PUT (QUOTE MKSTRING) (QUOTE IDNUMBER) (QUOTE 206))
+(PUT (QUOTE LONGREMAINDER) (QUOTE IDNUMBER) (QUOTE 150))
+(PUT (QUOTE UPDATEALLBASES) (QUOTE ENTRYPOINT) (QUOTE "L1635"))
+(PUT (QUOTE UPDATEALLBASES) (QUOTE IDNUMBER) (QUOTE 469))
+(PUT (QUOTE CONSTANTP) (QUOTE ENTRYPOINT) (QUOTE "L0611"))
+(PUT (QUOTE CONSTANTP) (QUOTE IDNUMBER) (QUOTE 333))
+(PUT (QUOTE THROWTAG!*) (QUOTE IDNUMBER) (QUOTE 486))
+(FLAG (QUOTE (THROWTAG!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE SYMVAL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE SYMVAL) (QUOTE ASMSYMBOL) (QUOTE SYMVAL))
+(PUT (QUOTE SYMVAL) (QUOTE WARRAY) (QUOTE SYMVAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE ASMSYMBOL) (QUOTE "L0004"))
+(PUT (QUOTE ARGUMENTBLOCK) (QUOTE WARRAY) (QUOTE ARGUMENTBLOCK))
+(PUT (QUOTE ERRORTRAILER) (QUOTE ENTRYPOINT) (QUOTE "L0067"))
+(PUT (QUOTE ERRORTRAILER) (QUOTE IDNUMBER) (QUOTE 160))
+(PUT (QUOTE GET) (QUOTE ENTRYPOINT) (QUOTE GET))
+(PUT (QUOTE GET) (QUOTE IDNUMBER) (QUOTE 286))
+(PUT (QUOTE GCTIME!*) (QUOTE IDNUMBER) (QUOTE 462))
+(PUT (QUOTE GCTIME!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE GLOBAL) (QUOTE ENTRYPOINT) (QUOTE GLOBAL))
+(PUT (QUOTE GLOBAL) (QUOTE IDNUMBER) (QUOTE 387))
+(PUT (QUOTE ARG11) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG11) (QUOTE ASMSYMBOL) (QUOTE ARG11))
+(PUT (QUOTE ARG11) (QUOTE WVAR) (QUOTE ARG11))
+(PUT (QUOTE GTFIXN) (QUOTE ENTRYPOINT) (QUOTE GTFIXN))
+(PUT (QUOTE GTFIXN) (QUOTE IDNUMBER) (QUOTE 191))
+(PUT (QUOTE DIFFERENCE) (QUOTE ENTRYPOINT) (QUOTE "L0477"))
+(PUT (QUOTE DIFFERENCE) (QUOTE IDNUMBER) (QUOTE 299))
+(PUT (QUOTE CAAAR) (QUOTE ENTRYPOINT) (QUOTE CAAAR))
+(PUT (QUOTE CAAAR) (QUOTE IDNUMBER) (QUOTE 301))
+(PUT (QUOTE ARG8) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG8) (QUOTE ASMSYMBOL) (QUOTE ARG8))
+(PUT (QUOTE ARG8) (QUOTE WVAR) (QUOTE ARG8))
+(PUT (QUOTE WRITECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0007"))
+(PUT (QUOTE WRITECHAR) (QUOTE IDNUMBER) (QUOTE 132))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE ENTRYPOINT) (QUOTE "L0132"))
+(PUT (QUOTE NONSEQUENCEERROR) (QUOTE IDNUMBER) (QUOTE 178))
+(PUT (QUOTE ADD1) (QUOTE ENTRYPOINT) (QUOTE ADD1))
+(PUT (QUOTE ADD1) (QUOTE IDNUMBER) (QUOTE 295))
+(PUT (QUOTE NEWID) (QUOTE ENTRYPOINT) (QUOTE NEWID))
+(PUT (QUOTE NEWID) (QUOTE IDNUMBER) (QUOTE 236))
+(PUT (QUOTE BINDEVALAUX) (QUOTE ENTRYPOINT) (QUOTE "L0423"))
+(PUT (QUOTE BINDEVALAUX) (QUOTE IDNUMBER) (QUOTE 283))
+(PUT (QUOTE DELBPS) (QUOTE ENTRYPOINT) (QUOTE DELBPS))
+(PUT (QUOTE DELBPS) (QUOTE IDNUMBER) (QUOTE 195))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE ASMSYMBOL) (QUOTE "L1446"))
+(PUT (QUOTE CLOSEFUNCTION) (QUOTE WARRAY) (QUOTE CLOSEFUNCTION))
+(PUT (QUOTE FINDCATCHMARKANDTHROW) (QUOTE ENTRYPOINT) (QUOTE "L1784"))
+(PUT (QUOTE FINDCATCHMARKANDTHROW) (QUOTE IDNUMBER) (QUOTE 504))
+(PUT (QUOTE LIST3) (QUOTE ENTRYPOINT) (QUOTE LIST3))
+(PUT (QUOTE LIST3) (QUOTE IDNUMBER) (QUOTE 203))
+(PUT (QUOTE READ1) (QUOTE ENTRYPOINT) (QUOTE READ1))
+(PUT (QUOTE READ1) (QUOTE IDNUMBER) (QUOTE 248))
+(PUT (QUOTE EVAL) (QUOTE ENTRYPOINT) (QUOTE EVAL))
+(PUT (QUOTE EVAL) (QUOTE IDNUMBER) (QUOTE 281))
+(PUT (QUOTE GTID) (QUOTE ENTRYPOINT) (QUOTE GTID))
+(PUT (QUOTE GTID) (QUOTE IDNUMBER) (QUOTE 194))
+(PUT (QUOTE READONLYCHANNEL) (QUOTE IDNUMBER) (QUOTE 425))
+(PUT (QUOTE CATCHSETUPAUX) (QUOTE ENTRYPOINT) (QUOTE "L1771"))
+(PUT (QUOTE GCKNT!*) (QUOTE IDNUMBER) (QUOTE 463))
+(PUT (QUOTE GCKNT!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE SETRAISE) (QUOTE ENTRYPOINT) (QUOTE "L0199"))
+(PUT (QUOTE SETRAISE) (QUOTE IDNUMBER) (QUOTE 214))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE ASMSYMBOL) (QUOTE "L0003"))
+(PUT (QUOTE NEXTSYMBOL) (QUOTE WVAR) (QUOTE NEXTSYMBOL))
+(PUT (QUOTE DM) (QUOTE ENTRYPOINT) (QUOTE DM))
+(PUT (QUOTE DM) (QUOTE IDNUMBER) (QUOTE 343))
+(PUT (QUOTE READID) (QUOTE ENTRYPOINT) (QUOTE READID))
+(PUT (QUOTE READID) (QUOTE IDNUMBER) (QUOTE 221))
+(PUT (QUOTE PRIN1STRING) (QUOTE ENTRYPOINT) (QUOTE "L0029"))
+(PUT (QUOTE PRIN1STRING) (QUOTE IDNUMBER) (QUOTE 136))
+(PUT (QUOTE FREERSTRSAVE!*) (QUOTE IDNUMBER) (QUOTE 513))
+(PUT (QUOTE CAAADR) (QUOTE ENTRYPOINT) (QUOTE CAAADR))
+(PUT (QUOTE CAAADR) (QUOTE IDNUMBER) (QUOTE 303))
+(PUT (QUOTE UNBINDN) (QUOTE ENTRYPOINT) (QUOTE "L1353"))
+(PUT (QUOTE UNBINDN) (QUOTE IDNUMBER) (QUOTE 290))
+(PUT (QUOTE IDP) (QUOTE ENTRYPOINT) (QUOTE IDP))
+(PUT (QUOTE IDP) (QUOTE IDNUMBER) (QUOTE 378))
+(PUT (QUOTE ARG6) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG6) (QUOTE ASMSYMBOL) (QUOTE ARG6))
+(PUT (QUOTE ARG6) (QUOTE WVAR) (QUOTE ARG6))
+(PUT (QUOTE NONPAIRERROR) (QUOTE ENTRYPOINT) (QUOTE "L0105"))
+(PUT (QUOTE NONPAIRERROR) (QUOTE IDNUMBER) (QUOTE 169))
+(PUT (QUOTE REVERSE) (QUOTE ENTRYPOINT) (QUOTE "L0645"))
+(PUT (QUOTE REVERSE) (QUOTE IDNUMBER) (QUOTE 353))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE ENTRYPOINT) (QUOTE "L0328"))
+(PUT (QUOTE FLAMBDALINKP) (QUOTE IDNUMBER) (QUOTE 261))
+(PUT (QUOTE PROGJUMPTABLE!*) (QUOTE IDNUMBER) (QUOTE 509))
+(FLAG (QUOTE (PROGJUMPTABLE!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE RECLAIM) (QUOTE ENTRYPOINT) (QUOTE "L1548"))
+(PUT (QUOTE RECLAIM) (QUOTE IDNUMBER) (QUOTE 193))
+(PUT (QUOTE LAMBDA) (QUOTE IDNUMBER) (QUOTE 275))
+(PUT (QUOTE GETD) (QUOTE ENTRYPOINT) (QUOTE GETD))
+(PUT (QUOTE GETD) (QUOTE IDNUMBER) (QUOTE 359))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE ENTRYPOINT) (QUOTE "L0216"))
+(PUT (QUOTE BUFFERTOSTRING) (QUOTE IDNUMBER) (QUOTE 226))
+(PUT (QUOTE NONIDERROR) (QUOTE ENTRYPOINT) (QUOTE "L0108"))
+(PUT (QUOTE NONIDERROR) (QUOTE IDNUMBER) (QUOTE 170))
+(PUT (QUOTE STDIN!*) (QUOTE IDNUMBER) (QUOTE 445))
+(PUT (QUOTE STDIN!*) (QUOTE INITIALVALUE) (QUOTE 0))
+(PUT (QUOTE OUTPUT) (QUOTE IDNUMBER) (QUOTE 412))
+(PUT (QUOTE PBLANK) (QUOTE ENTRYPOINT) (QUOTE PBLANK))
+(PUT (QUOTE PBLANK) (QUOTE IDNUMBER) (QUOTE 147))
+(PUT (QUOTE CDADAR) (QUOTE ENTRYPOINT) (QUOTE CDADAR))
+(PUT (QUOTE CDADAR) (QUOTE IDNUMBER) (QUOTE 317))
+(PUT (QUOTE ARG4) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG4) (QUOTE ASMSYMBOL) (QUOTE ARG4))
+(PUT (QUOTE ARG4) (QUOTE WVAR) (QUOTE ARG4))
+(PUT (QUOTE CATCH!-ALL) (QUOTE ENTRYPOINT) (QUOTE "L1727"))
+(PUT (QUOTE CATCH!-ALL) (QUOTE IDNUMBER) (QUOTE 487))
+(PUT (QUOTE CHANNELNOTOPEN) (QUOTE IDNUMBER) (QUOTE 424))
+(PUT (QUOTE PLUS2) (QUOTE ENTRYPOINT) (QUOTE PLUS2))
+(PUT (QUOTE PLUS2) (QUOTE IDNUMBER) (QUOTE 292))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE ENTRYPOINT) (QUOTE "L1494"))
+(PUT (QUOTE SYSTEMOPENFILEFOROUTPUT) (QUOTE IDNUMBER) (QUOTE 442))
+(PUT (QUOTE CATCHSETUP) (QUOTE ENTRYPOINT) (QUOTE "L1770"))
+(PUT (QUOTE CATCHSETUP) (QUOTE IDNUMBER) (QUOTE 497))
+(PUT (QUOTE ESCAPEP) (QUOTE ENTRYPOINT) (QUOTE "L0250"))
+(PUT (QUOTE ESCAPEP) (QUOTE IDNUMBER) (QUOTE 230))
+(PUT (QUOTE CONTOPENERROR) (QUOTE ENTRYPOINT) (QUOTE "L1460"))
+(PUT (QUOTE CONTOPENERROR) (QUOTE IDNUMBER) (QUOTE 408))
+(PUT (QUOTE FCODEP) (QUOTE ENTRYPOINT) (QUOTE FCODEP))
+(PUT (QUOTE FCODEP) (QUOTE IDNUMBER) (QUOTE 264))
+(PUT (QUOTE MAKEFCODE) (QUOTE ENTRYPOINT) (QUOTE "L0344"))
+(PUT (QUOTE MAKEFCODE) (QUOTE IDNUMBER) (QUOTE 265))
+(PUT (QUOTE DN) (QUOTE ENTRYPOINT) (QUOTE DN))
+(PUT (QUOTE DN) (QUOTE IDNUMBER) (QUOTE 341))
+(PUT (QUOTE PRIN2T) (QUOTE ENTRYPOINT) (QUOTE PRIN2T))
+(PUT (QUOTE PRIN2T) (QUOTE IDNUMBER) (QUOTE 146))
+(PUT (QUOTE GLOBALP) (QUOTE ENTRYPOINT) (QUOTE "L0777"))
+(PUT (QUOTE GLOBALP) (QUOTE IDNUMBER) (QUOTE 388))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L1339"))
+(PUT (QUOTE BNDSTKLOWERBOUND) (QUOTE WVAR) (QUOTE BNDSTKLOWERBOUND))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE ENTRYPOINT) (QUOTE "L1498"))
+(PUT (QUOTE TESTLEGALCHANNEL) (QUOTE IDNUMBER) (QUOTE 452))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE ASMSYMBOL) (QUOTE "L0002"))
+(PUT (QUOTE STACKUPPERBOUND) (QUOTE WVAR) (QUOTE STACKUPPERBOUND))
+(PUT (QUOTE CADAR) (QUOTE ENTRYPOINT) (QUOTE CADAR))
+(PUT (QUOTE CADAR) (QUOTE IDNUMBER) (QUOTE 307))
+(PUT (QUOTE COND) (QUOTE ENTRYPOINT) (QUOTE COND))
+(PUT (QUOTE COND) (QUOTE IDNUMBER) (QUOTE 349))
+(PUT (QUOTE OPEN) (QUOTE ENTRYPOINT) (QUOTE OPEN))
+(PUT (QUOTE OPEN) (QUOTE IDNUMBER) (QUOTE 433))
+(PUT (QUOTE UPDATEHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1656"))
+(PUT (QUOTE UPDATEHEAP) (QUOTE IDNUMBER) (QUOTE 484))
+(PUT (QUOTE ARG2) (QUOTE SCOPE) (QUOTE EXTERNAL))
+(PUT (QUOTE ARG2) (QUOTE ASMSYMBOL) (QUOTE ARG2))
+(PUT (QUOTE ARG2) (QUOTE WVAR) (QUOTE ARG2))
+(PUT (QUOTE RETURN) (QUOTE ENTRYPOINT) (QUOTE RETURN))
+(PUT (QUOTE RETURN) (QUOTE IDNUMBER) (QUOTE 512))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE ENTRYPOINT) (QUOTE "L1597"))
+(PUT (QUOTE MAKEIDFREELIST) (QUOTE IDNUMBER) (QUOTE 467))
+(PUT (QUOTE GTVECT) (QUOTE ENTRYPOINT) (QUOTE GTVECT))
+(PUT (QUOTE GTVECT) (QUOTE IDNUMBER) (QUOTE 188))
+(PUT (QUOTE READLIST) (QUOTE ENTRYPOINT) (QUOTE "L0304"))
+(PUT (QUOTE READLIST) (QUOTE IDNUMBER) (QUOTE 250))
+(PUT (QUOTE CODEPTR!*) (QUOTE IDNUMBER) (QUOTE 268))
+(FLAG (QUOTE (CODEPTR!*)) (QUOTE NILINITIALVALUE))
+(PUT (QUOTE UNDEFINEDFUNCTIONAUXAUX) (QUOTE IDNUMBER) (QUOTE 277))
+(PUT (QUOTE DEC20OPEN) (QUOTE ENTRYPOINT) (QUOTE "L1417"))
+(PUT (QUOTE DEC20OPEN) (QUOTE IDNUMBER) (QUOTE 407))
+(PUT (QUOTE COMPACTHEAP) (QUOTE ENTRYPOINT) (QUOTE "L1688"))
+(PUT (QUOTE COMPACTHEAP) (QUOTE IDNUMBER) (QUOTE 470))
+(PUT (QUOTE QUIT) (QUOTE IDNUMBER) (QUOTE 163))
+(PUT (QUOTE FLOATP) (QUOTE ENTRYPOINT) (QUOTE FLOATP))
+(PUT (QUOTE FLOATP) (QUOTE IDNUMBER) (QUOTE 376))
+(PUT (QUOTE CADAAR) (QUOTE ENTRYPOINT) (QUOTE CADAAR))
+(PUT (QUOTE CADAAR) (QUOTE IDNUMBER) (QUOTE 308))
+(PUT (QUOTE RAISECHAR) (QUOTE ENTRYPOINT) (QUOTE "L0227"))
+(PUT (QUOTE RAISECHAR) (QUOTE IDNUMBER) (QUOTE 227))
+(PUT (QUOTE LESSP) (QUOTE ENTRYPOINT) (QUOTE LESSP))
+(PUT (QUOTE LESSP) (QUOTE IDNUMBER) (QUOTE 298))
+(PUT (QUOTE MARKFROMONESYMBOL) (QUOTE ENTRYPOINT) (QUOTE "L1572"))
+(PUT (QUOTE MARKFROMONESYMBOL) (QUOTE IDNUMBER) (QUOTE 477))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE ENTRYPOINT) (QUOTE "L0209"))
+(PUT (QUOTE CLEARCOMMENT) (QUOTE IDNUMBER) (QUOTE 216))
ADDED psl-1983/3-1/tests/20/mini-known-to-comp-sl.red
Index: psl-1983/3-1/tests/20/mini-known-to-comp-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/mini-known-to-comp-sl.red
@@ -0,0 +1,28 @@
+% MINI-KNOWN-TO-COMP-SL.RED
+
+
+Procedure Car x;
+ if Pairp x then car x else NonPairError(x,'CAR);
+
+Procedure Cdr x;
+ if Pairp x then cdr x else NonPairError(x,'CDR);
+
+procedure CodeP x;
+ CodeP x;
+
+Procedure Pairp x;
+ Pairp x;
+
+Procedure Idp x;
+ Idp x;
+
+procedure Eq(x,y);
+ eq(x,y);
+
+procedure Null x;
+ x eq 'NIL;
+
+procedure Not x;
+ x eq 'NIL;
+
+End;
ADDED psl-1983/3-1/tests/20/module.mic
Index: psl-1983/3-1/tests/20/module.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/module.mic
@@ -0,0 +1,32 @@
+;; independant compilation a program for the 20
+; MIC MODULE modulename,symbolmname
+@define DSK:, DSK:, PT:, P20:, PI:
+@delete 'A.mac,'A.rel,'A.init
+@delete D'A.mac,D'A.rel
+@exp
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@get s:TEST-DEC20-cross
+@st
+off break; %kill obnoxious break loops
+off USERMODE ;
+InputSymFile!* := "'B.sym"$
+OutputSymFile!* := "'B.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''NIL;
+ ModName!*:='''A;
+ASMOUT "'A"$
+off StandAlone$ % Should emit SYMFNC inits
+IN "'A.red"$
+off pcmac,pgwd; % Suppress echo before INIT
+ASMEnd$
+quit$
+@reset .
+@terminal length 24
+@get sys:macro.exe
+@st
+*'A.rel='A.mac
+*D'A.rel=D'A.mac
+
+@reset .
ADDED psl-1983/3-1/tests/20/p
Index: psl-1983/3-1/tests/20/p
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/p
@@ -0,0 +1,36 @@
+(de errorprintf(a1 a2 a3 a4 a5)
+ (prin2 a1)
+ (prin2 " ")
+ (prin2 a2)
+ (prin2 " ")
+ (prin2 a3)
+ (prin2 " ")
+ (prin2 a4)
+ (prin2 " ")
+ (prin2t a5))
+
+(setq knt 0)
+(df tr (z)
+ (setq old (car z))
+ (setq new (cadr z))
+ (setq args (cddr z))
+ (copyd new old)
+ (putd old 'expr (list 'lambda args
+ '(setq knt (add1 knt))
+ (list 'print (list 'list ">>>>" (list 'quote old) 'knt))
+ (list 'setq 'ans (cons new args))
+ (list 'print (list 'list " <" (list 'quote old) 'knt))
+ '(setq knt (sub1 knt))
+ 'ans)))
+
+(df m (z)
+ (setq old (car z))
+ (setq new (cadr z))
+ (setq args (cddr z))
+ (copyd new old)
+ (print (list old (inf old)))
+ (putd old 'expr (list 'lambda args
+ (list 'print (list 'inf old))
+ (cons new args))))
+
+
ADDED psl-1983/3-1/tests/20/pk-red.dir
Index: psl-1983/3-1/tests/20/pk-red.dir
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/pk-red.dir
@@ -0,0 +1,66 @@
+
+ SS:<PSL.KERNEL>
+ ALLOCATORS.RED.4
+ ARITHMETIC.RED.2
+ AUTOLOAD.RED.3
+ AUTOLOAD-TRACE.RED.7
+ BACKTRACE.RED.18
+ BINDING.RED.2
+ BREAK.RED.4
+ CARCDR.RED.1
+ CATCH-THROW.RED.14
+ CHAR-IO.RED.2,3
+ COMP-SUPPORT.RED.1
+ COMPACTING-GC.RED.9
+ CONS-MKVECT.RED.2
+ CONT-ERROR.RED.1
+ COPIERS.RED.2
+ COPYING-GC.RED.9
+ DEFCONST.RED.1
+ DEFINE-SMACRO.RED.3
+ DSKIN.RED.3
+ EASY-NON-SL.RED.5
+ EASY-SL.RED.3
+ EQUAL.RED.2
+ ERROR-ERRORSET.RED.5
+ ERROR-HANDLERS.RED.4
+ EVAL-APPLY.RED.5
+ EVAL-WHEN.RED.1
+ EXPLODE-COMPRESS.RED.3
+ FASL-INCLUDE.RED.1
+ FASLIN.RED.2
+ FAST-BINDER.RED.1
+ FLUID-GLOBAL.RED.1
+ IO-ERRORS.RED.1
+ IO-EXTENSIONS.RED.1
+ KNOWN-TO-COMP-SL.RED.1
+ LISP-MACROS.RED.1
+ LOAD.RED.12
+ LOOP-MACROS.RED.1
+ MINI-EDITOR.RED.3
+ MINI-TRACE.RED.2
+ OBLIST.RED.3
+ OLD-STRING-GENSYM.RED.1
+ ONOFF.RED.1
+ OPEN-CLOSE.RED.1,2
+ OTHER-IO.RED.5
+ OTHERS-SL.RED.1
+ P-APPLY-LAP.RED.1
+ PRINTERS.RED.15
+ PRINTF.RED.3
+ PROG-AND-FRIENDS.RED.2
+ PROPERTY-LIST.RED.1
+ PUTD-GETD.RED.3
+ RDS-WRS.RED.1
+ READ.RED.6
+ SEQUENCE.RED.2
+ SETS.RED.1
+ STRING-GENSYM.RED.2
+ SYMBOL-VALUES.RED.1
+ TOKEN-SCANNER.RED.4
+ TOP-LOOP.RED.12
+ TYPE-CONVERSIONS.RED.1
+ TYPE-ERRORS.RED.1,3
+ VECTORS.RED.2
+
+ Total of 140 pages in 65 files
ADDED psl-1983/3-1/tests/20/program.mic
Index: psl-1983/3-1/tests/20/program.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/program.mic
@@ -0,0 +1,33 @@
+;; Independent compilation a program for the 20
+;; MAIN module and data_segement, do last
+; do PROGRAM modulename
+; modulename=symboltablename
+@define DSK:, DSK:, PT:, P20:, PV:, PI:
+@delete 'A.mac,'A.rel,'A.init
+@delete D'A.mac,D'A.rel
+@exp
+;avoid obnoixous ^Q halts...
+@terminal length 0
+@get s:TEST-DEC20-CROSS.EXE
+@st
+off break; % avoid obnoxios breaks
+InputSymFile!* := "'A.sym"$
+OutputSymFile!* := "'A.sym"$
+GlobalDataFileName!* := "20-test-global-data.red"$
+ON PCMAC, PGWD$ % see macro expansion
+ !*MAIN := ''T;
+ ModName!*:='' 'A;
+ASMOUT "'A"$
+off StandAlone$ % Should emit SYMFNC inits
+IN "'A.red"$
+off pcmac,pgwd; % Suppress echo before INIT
+ASMEnd$
+quit$
+@reset .
+@terminal length 24
+@get sys:macro
+@st
+*'A.rel='A.mac
+*D'A.rel=D'A.mac
+
+@reset .
ADDED psl-1983/3-1/tests/20/rand-psl.times
Index: psl-1983/3-1/tests/20/rand-psl.times
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/rand-psl.times
@@ -0,0 +1,25 @@
+RAND-RELAY (VAX 11/750-1Mb) RAND-UNIX (VAX 11/780 4Mb )
+
+*** GC 5: time 1122 ms,
+EmptyTest 10000 85 0
+SlowEmptyTest 10000 1122 663
+Cdr1Test 100 2074 1632
+Cdr2Test 100 1598 1224
+CddrTest 100 1326 1071
+ListOnlyCdrTest1 9435 7208
+ListOnlyCddrTest1 15283 12410
+ListOnlyCdrTest2 12189 9418
+ListOnlyCddrTest2 18105 15164
+ReverseTest 10 1054 748
+*** GC 6: time 1139 ms, 782 ms,
+MyReverse1Test 10 1156 697
+*** GC 7: time 1224 ms, 646ms
+MyReverse2Test 10 1003 629
+*** GC 8: time 1190 ms, 765 ms
+LengthTest 100 2210 1700
+ArithmeticTest 10000 1938 867
+EvalTest 10000 8687 5083
+tak 18 12 6 1326 765
+gtak 18 12 6 7361 4267
+gtsta g0 5253 2533
+gtsta g1 5355 2465
ADDED psl-1983/3-1/tests/20/sub2.init
Index: psl-1983/3-1/tests/20/sub2.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub2.init
ADDED psl-1983/3-1/tests/20/sub2.rel
Index: psl-1983/3-1/tests/20/sub2.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub2.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub3.init
Index: psl-1983/3-1/tests/20/sub3.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub3.init
ADDED psl-1983/3-1/tests/20/sub3.rel
Index: psl-1983/3-1/tests/20/sub3.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub3.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub4.init
Index: psl-1983/3-1/tests/20/sub4.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub4.init
ADDED psl-1983/3-1/tests/20/sub4.rel
Index: psl-1983/3-1/tests/20/sub4.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub4.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub5a.init
Index: psl-1983/3-1/tests/20/sub5a.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub5a.init
@@ -0,0 +1,2 @@
+(PUT (QUOTE SYMFNCBASE) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (CODEPTR!* CODEFORM!* CODENARG!*)))
ADDED psl-1983/3-1/tests/20/sub5a.rel
Index: psl-1983/3-1/tests/20/sub5a.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub5a.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub5b.init
Index: psl-1983/3-1/tests/20/sub5b.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub5b.init
@@ -0,0 +1,10 @@
+(PUT (QUOTE LIST) (QUOTE TYPE) (QUOTE NEXPR))
+(PUT (QUOTE DE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DF) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DN) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE DM) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE SETQ) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE PROGN) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE COND) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE QUOTE) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE WHILE) (QUOTE TYPE) (QUOTE FEXPR))
ADDED psl-1983/3-1/tests/20/sub5b.rel
Index: psl-1983/3-1/tests/20/sub5b.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub5b.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub6.init
Index: psl-1983/3-1/tests/20/sub6.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub6.init
ADDED psl-1983/3-1/tests/20/sub6.rel
Index: psl-1983/3-1/tests/20/sub6.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub6.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub7.init
Index: psl-1983/3-1/tests/20/sub7.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub7.init
@@ -0,0 +1,5 @@
+(GLOBAL (QUOTE (!$EOL!$)))
+(FLUID (QUOTE (!*ECHO !*PVAL)))
+(FLUID (QUOTE (IN!* OUT!*)))
+(GLOBAL (QUOTE (IN!* OUT!*)))
+(FLUID (QUOTE (STDIN!* STDOUT!* ERROUT!* PROMPTOUT!* !*ECHO)))
ADDED psl-1983/3-1/tests/20/sub7.rel
Index: psl-1983/3-1/tests/20/sub7.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub7.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub8.init
Index: psl-1983/3-1/tests/20/sub8.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub8.init
@@ -0,0 +1,3 @@
+(PUT (QUOTE BEFOREGCSYSTEMHOOK) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE AFTERGCSYSTEMHOOK) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (!*GC GCTIME!* GCKNT!* HEAP!-WARN!-LEVEL)))
ADDED psl-1983/3-1/tests/20/sub8.rel
Index: psl-1983/3-1/tests/20/sub8.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub8.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/sub9.init
Index: psl-1983/3-1/tests/20/sub9.init
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub9.init
@@ -0,0 +1,10 @@
+(FLUID (QUOTE (THROWSIGNAL!* THROWTAG!*)))
+(GLOBAL (QUOTE (EMSG!*)))
+(PUT (QUOTE CATCH!-ALL) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE UNWIND!-ALL) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE UNWIND!-PROTECT) (QUOTE TYPE) (QUOTE MACRO))
+(PUT (QUOTE CATCH) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE !*CATCH) (QUOTE TYPE) (QUOTE MACRO))
+(FLUID (QUOTE (PROGJUMPTABLE!* PROGBODY!*)))
+(PUT (QUOTE PROG) (QUOTE TYPE) (QUOTE FEXPR))
+(PUT (QUOTE GO) (QUOTE TYPE) (QUOTE FEXPR))
ADDED psl-1983/3-1/tests/20/sub9.rel
Index: psl-1983/3-1/tests/20/sub9.rel
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/sub9.rel
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/20/test-dec20-cross.mic
Index: psl-1983/3-1/tests/20/test-dec20-cross.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/test-dec20-cross.mic
@@ -0,0 +1,15 @@
+
+@ren home:rlisp.init home:saved-rlisp.init
+@get PSL:RLISP
+@st
+*Options!* := nil; % Force reload
+*load(zboot, syslisp, if!-system, lap!-to!-asm);
+*load(dec20!-comp,dec20!-cmac,dec20!-asm);
+*remflag(''(extrareg),''terminaloperand);
+*off usermode;
+*in "p20t:dec20-patches.sl"$
+*Date!* := concat("Dec 20 cross compiler",date());
+*Dumplisp "S:TEST-DEC20-CROSS.EXE";
+*Quit;
+@reset .
+@ren home:saved-rlisp.init home:rlisp.init
ADDED psl-1983/3-1/tests/20/test-guide.err
Index: psl-1983/3-1/tests/20/test-guide.err
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/test-guide.err
@@ -0,0 +1,5 @@
+@Comment{ErrLog of TEST-GUIDE.MSS.17 by Scribe 3C(1254) on 24 July 1982 at 13:19}
+
+Error in MAINN command found while processing the manuscript.
+TEST-GUIDE.MSS.17 line 287: @@EX @MAINn.CMD
+The name @MAINN is not defined in document type article.
ADDED psl-1983/3-1/tests/20/test-guide.otl
Index: psl-1983/3-1/tests/20/test-guide.otl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/test-guide.otl
@@ -0,0 +1,10 @@
+@Comment{OUTLINE of TEST-GUIDE.MSS.17 by Scribe 3C(1254) on 24 July 1982 at 13:19}
+1. Introduction 1 TEST-GUIDE.MSS.17 line 51
+2. Basic I/O Support 1 TEST-GUIDE.MSS.17 line 64
+3. LAP and CMACRO Tests 4 TEST-GUIDE.MSS.17 line 181
+4. SysLisp Tests 4 TEST-GUIDE.MSS.17 line 189
+5. Mini PSL Tests 7 TEST-GUIDE.MSS.17 line 295
+6. Full PSL Tests 7 TEST-GUIDE.MSS.17 line 306
+7. References 8 TEST-GUIDE.MSS.17 line 322
+I. Sample DEC-20 Output 9 TEST-GUIDE.MSS.17 line 325
+ Table of Contents 1 <PSL.TESTS.20>-SCRIBE-SCRATCH-.15-3-1.100015 line 3
ADDED psl-1983/3-1/tests/20/time-psl.out
Index: psl-1983/3-1/tests/20/time-psl.out
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/time-psl.out
@@ -0,0 +1,25 @@
+PSL Spectral Tests, DEC-20 test system, No-Date-Yet
+---------------------------------------------------------------
+*** Dummy RECLAIM: 9772 Items used, 140228 Items left.
+EmptyTest 10000 18
+SlowEmptyTest 10000 187
+Cdr1Test 100 521
+Cdr2Test 100 365
+CddrTest 100 268
+ListOnlyCdrTest1 1764
+ListOnlyCddrTest1 3207
+ListOnlyCdrTest2 2708
+ListOnlyCddrTest2 4127
+ReverseTest 10 458
+*** Dummy RECLAIM: 46868 Items used, 103132 Items left.
+MyReverse1Test 10 463
+*** Dummy RECLAIM: 83532 Items used, 66468 Items left.
+MyReverse2Test 10 447
+*** Dummy RECLAIM: 120196 Items used, 29804 Items left.
+LengthTest 100 554
+ArithmeticTest 10000 644
+EvalTest 10000 2680
+tak 18 12 6 477
+gtak 18 12 6 1378
+gtsta g0 1133
+gtsta g1 1196
ADDED psl-1983/3-1/tests/20/time-psl.out8
Index: psl-1983/3-1/tests/20/time-psl.out8
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/time-psl.out8
@@ -0,0 +1,33 @@
+PSL Spectral Tests, DEC-20 test system, No-Date-Yet, test8
+---------------------------------------------------------------
+*** Garbage collection starting NIL 3191 193 69
+*** GC %w: time %d ms 2 489 18 6
+*** %d recovered, %d stable, %d active, %d free 204 157 9413 1
+EmptyTest 10000 18
+SlowEmptyTest 10000 187
+Cdr1Test 100 527
+Cdr2Test 100 372
+CddrTest 100 274
+ListOnlyCdrTest1 1769
+ListOnlyCddrTest1 3194
+ListOnlyCdrTest2 2790
+ListOnlyCddrTest2 4083
+ReverseTest 10 458
+*** Garbage collection starting NIL 3191 193 77
+*** GC %w: time %d ms 3 1071 5669 5656
+*** %d recovered, %d stable, %d active, %d free 37096 9533 37 1
+MyReverse1Test 10 458
+*** Garbage collection starting NIL 3191 193 77
+*** GC %w: time %d ms 4 1064 5237 5224
+*** %d recovered, %d stable, %d active, %d free 36664 9533 37 1
+MyReverse2Test 10 441
+*** Garbage collection starting NIL 3191 193 76
+*** GC %w: time %d ms 5 1063 5237 5224
+*** %d recovered, %d stable, %d active, %d free 36664 9533 37 1
+LengthTest 100 560
+ArithmeticTest 10000 643
+EvalTest 10000 2434
+tak 18 12 6 476
+gtak 18 12 6 1378
+gtsta g0 1132
+gtsta g1 1195
ADDED psl-1983/3-1/tests/20/xxx-gc.red
Index: psl-1983/3-1/tests/20/xxx-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/xxx-gc.red
@@ -0,0 +1,5 @@
+% XXX-GC.RED for 20
+
+IN "XXX-SYSTEM-GC.RED"$
+IN "PT:P-COMP-GC.RED"$
+END;
ADDED psl-1983/3-1/tests/20/xxx-header.red
Index: psl-1983/3-1/tests/20/xxx-header.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/xxx-header.red
@@ -0,0 +1,171 @@
+% XXX-HEADER.RED for DEC20
+% Defines Data spaces, MAIN!. for 20 and I/O interface
+%
+% Revisions: MLG, 18 Feb 1983
+% Move HEAP declarations from PT:SUB3
+% and P20T:20-TEST-GLOBAL-DATA.RED
+% Add dummy DATE and VersionName routines
+on syslisp;
+% -----Allocate the stack area
+
+Internal WConst StackSize = 5000;
+Internal WArray Stack[StackSize];
+
+exported WVar StackLowerBound = &Stack[0],
+ StackUpperBound = &Stack[StackSize];
+
+external WVar ST;
+
+%--- Allocate HEAP and BPS areas
+
+Internal Wconst HeapSize = 150000; % Enough for PSL-TIMER
+Internal Warray HEAP[HeapSize]; % Could do a Dynamic alloc
+
+exported Wvar HeapLowerBound = &Heap[0], % bottom of heap
+ HeapUpperBound = &Heap[HeapSize],
+ HeapLast, % next free slot in heap
+ HeapTrapBound, % To catch impending HEAP full
+ HeapPreviousLast; % save start of new block
+
+CommentOutcode << % If Copying GC
+Internal Warray OtherHeap[HeapSize];
+exported WVar OldHeapLast,
+ OldHeapLowerBound = &OtherHeap[0];
+ OldHeapUpperBound = &OtherHeap[HeapSize];
+>>;
+
+% Stuff for Compacting GC
+
+exported Wvar HeapTrapped;
+
+internal WConst BitsInsegment=13,
+ GCArraySize = LShift(HeapSize, -BitsInSegment) + 1;
+
+exported WArray GCArray[GCArraySize];
+
+Internal Wconst BPSSize = 500;
+internal Warray BPS[BPSsize]; % Could do a Dynamic alloc
+
+exported WVar FirstBPS=&BPS[0], % Base of BPS, for info
+ NextBPS = &BPS[0], % allocate CODE up
+ LastBPS = &BPS[BPSSize], % allocate Warray down
+ FinalBPS= &BPS[BPSSize]; % For info purposes
+
+syslsp procedure InitHeap();
+% Set up Heap base etc.
+ <<HeapLast:=HeapLowerBound;
+ HeapPreviousLast := 0>>;
+
+
+
+% allocate for the "extra" arguments
+% 0..MaxArgBlock are arguments (MaxRealRegs + 1)..MaxArgs
+
+internal WConst MaxArgBlock = (MaxArgs - MaxRealRegs) - 1;
+exported WArray ArgumentBlock[MaxArgBlock];
+
+% For the ForeignFunction calling protocol
+exported Wvar Arg1,Arg2,Arg3,ARg4,Arg5,Arg6,Arg7,Arg8,
+ Arg9, Arg10,Arg11,Arg12,Arg13,Arg14,Arg15;
+
+
+% The hashtable
+exported WArray HashTable[MaxObArray/2];
+
+%--- End of Data Definitions ----------
+%--- Now do 20 Specific MAIN!. and I/O Interface:
+
+lap '((!*entry Main!. expr 0)
+ (reset)
+ (move (reg st) (lit (halfword (minus (WConst StackSize))
+ (difference (WConst Stack) 1))))
+ (move (reg NIL) (fluid NIL))
+ (!*LINKE 0 FirstCall Expr 0) % Call the MAINn firstroutine
+);
+
+% Define "standard" LISP equivalents for the DEC20-MACRO foreign
+% functions defined in 20IO.MAC
+
+FLAG('(
+ Init20 % Initialize I/O, Timer, etc
+ PutC20 % Print Ascii Character, use 10=EOL to get end of line
+ GetC20 % Return Ascii Character
+ Timc20 % Return CPU time (can also print time check)
+ Quit20 % Terminate execution, finalize
+ Err20 % Print error message
+ PutI20 % print an Integer
+),'ForeignFunction);
+
+
+Global '(IN!* OUT!*);
+
+Procedure Init();
+ <<Init20 0;
+ LispVar IN!*:=0;
+ LispVar Out!*:=1;
+ >>; % Always need one dummy argument
+
+Procedure GetC();
+ If LispVar IN!* eq 0 then Getc20 0 % Always need one dummy argument
+ else IndependentReadChar LispVar IN!*;
+
+Procedure TimC();
+ TimC20 0; % Always need one dummy argument
+
+procedure PutC x;
+ If LispVar Out!* eq 1 then Putc20 x
+ else IndependentWriteChar(LispVar Out!*,x);
+
+procedure Quit;
+ Quit20 0; % always need 1 argument
+
+procedure ExitLisp;
+ Quit20 0;
+
+Procedure Reset();
+ <<Prin2T "Should RESET here, but will QUIT";
+ Quit;>>;
+
+procedure Date;
+ '"No-Date-Yet";
+
+Procedure VersionName;
+ '"DEC-20 test system";
+
+procedure PutInt I;
+ PutI20 I;
+
+% SYMFNC storage routine:
+LAP '((!*entry !%Store!-Jcall Expr 2) % CodeAddress, Storage Address
+ (!*alloc 0)
+ (!*WOR (reg 1) 8#254000000000) % Load a JRST in higher-bits
+ (!*MOVE (reg 1) (memory (reg 2) (wconst 0)))
+ (!*EXIT 0));
+
+LAP '((!*entry !%copy!-function!-cell Expr 2) % from to
+ (!*alloc 0)
+ (!*move (memory (reg 1) (Wconst 0)) (memory (reg 2) (wconst 0)))
+ (!*exit 0));
+
+FLUID '(UndefnCode!* UndefnNarg!*);
+
+LAP '((!*ENTRY UndefinedFunction expr 0) % For missing Function
+ % No alloc 0 ? and no LINKE because dont want to change LinkReg
+ (!*MOVE (reg LinkReg) (Fluid UndefnCode!*))
+ (!*Move (reg NargReg) (Fluid UndefnNarg!*))
+ (!*JCALL UndefinedFunctionAux)
+);
+
+procedure LongTimes(x,y);
+ x*y;
+
+procedure LongDiv(x,y);
+ x/y;
+
+procedure LongRemainder(x,y);
+ Remainder(x,y);
+
+off syslisp;
+
+end;
+
ADDED psl-1983/3-1/tests/20/xxx-system-gc.red
Index: psl-1983/3-1/tests/20/xxx-system-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/xxx-system-gc.red
@@ -0,0 +1,27 @@
+%
+% XXX-SYSTEM-GC.RED - System dependent before and after GC hooks, stubs
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 5 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Do nothing on the Dec-20
+
+on Syslisp;
+
+syslsp smacro procedure BeforeGCSystemHook();
+ NIL;
+
+syslsp smacro procedure AfterGCSystemHook();
+ NIL;
+
+
+off Syslisp;
+
+END;
+
+
ADDED psl-1983/3-1/tests/20/xxx-system-io.red
Index: psl-1983/3-1/tests/20/xxx-system-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/20/xxx-system-io.red
@@ -0,0 +1,163 @@
+%==============================================================================
+%
+% PT20:XXX-SYSTEM-IO.RED - 20 specific IO routines for PSL
+%
+% Author: Modified by Robert R. Kessler and MLG
+% From System-io.red for the 20 by Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: Modified 16 August 1982
+% Original Date 16 September 1981
+%
+% Copyright (c) 1982 University of Utah
+%
+%==============================================================================
+
+ON Syslisp;
+
+% Each individual system must have the following routines defined.
+% SysClearIo, SysOpenRead, SysOpenWrite, SysReadRec, SysWriteRec, SysClose,
+% SysMaxBuffer
+%
+% The following definitions are used in the routines:
+% FileDescriptor - A machine dependent word that references a file once
+% opened.
+% FileName - A Lisp string of the file name.
+%
+% ---------- SysClearIo:
+% called by Cleario for system dep extras
+
+lap '((!*entry SysClearIO expr 0)
+%
+% ^C from RDTTY and restart causes trouble, but we don't want a full RESET
+% (don't want to close files or kill forks), so we'll just do the
+% part of RESET that we want, for terminal input
+%
+ (!*MOVE (WConst 8#100) (reg 1)) % .priin
+ (rfmod)
+ (tro 2 2#001111100001000000) % tt%wak + tt%eco + .ttasi, like RESET
+ (sfmod)
+ (!*EXIT 0)
+);
+
+
+syslsp procedure SysOpenRead(Channel,FileName);
+% % Open FileName for input and
+% % return a file descriptor used
+% % in later references to the
+% % file.
+ Begin scalar Jfn;
+ Jfn:=Dec20Open(FileName,
+ % gj%old gj%sht
+ 2#001000000000000001000000000000000000,
+ % 7*of%bsz of%rd
+ 2#000111000000000000010000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'INPUT);
+ return Jfn;
+End;
+
+syslsp procedure SysOpenWrite(Channel,FileName);
+ Begin scalar Jfn;
+ Jfn:=Dec20Open(FileName,
+ % gj%fou gj%new gj%sht
+ 2#110000000000000001000000000000000000,
+ % 7*of%bsz of%wr
+ 2#000111000000000000001000000000000000);
+ if JFN eq 0 then return ContOpenError(FileName, 'OUTPUT);
+ return Jfn;
+ End;
+
+lap '((!*entry Dec20Open expr 3)
+%
+% Dec20Open(Filename string, GTJFN bits, OPENF bits)
+%
+ (!*WPLUS2 (reg 1) (WConst 1)) % increment r1 to point to characters
+ (hrli (reg 1) 8#440700) % turn r1 into a byte pointer
+ (!*MOVE (reg 1) (reg 4)) % save filename string in r4
+ (!*MOVE (reg 2) (reg 1)) % GTJFN flag bits in r1
+ (!*MOVE (reg 4) (reg 2)) % string in r2
+ (gtjfn)
+ (!*JUMP (Label CantOpen))
+ (!*MOVE (reg 3) (reg 2)) % OPENF bits in r2, JFN in r1
+ (openf)
+CantOpen
+ (!*MOVE (WConst 0) (reg 1)) % return 0 on error
+ (!*EXIT 0) % else return the JFN
+);
+
+
+syslsp procedure SysReadRec(FileDescriptor,StringBuffer);
+% % Read from the FileDescriptor, a
+% % record into the StringBuffer.
+% % Return the length of the
+% % string read.
+ Begin scalar N,Ch;
+ N:=0;
+ Loop: Ch:=Dec20ReadChar(FileDescriptor);
+ StrByt(StringBuffer,N):=Ch;
+ If Ch eq Char EOL or Ch eq Char EOF then return N;
+ N:=N+1;
+ % Check buffer size here
+ goto Loop;
+ End;
+
+lap '((!*entry Dec20ReadChar expr 1)
+Loop
+ (bin) % read a character
+ (erjmp CheckEOF) % check for end-of-file on error
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 0))% try again if it's null char
+ (!*JUMPEQ (Label Loop) (reg 2) (WConst 8#15))% or carriage return
+ (!*MOVE (reg 2) (reg 1)) % move char to reg 1
+%/ (camn (reg nil) (fluid !*ECHO)) % is echo on?
+ (!*EXIT 0) % no, just return char
+%/ (!*PUSH (reg 1)) % yes, save char
+%/ (!*CALL WriteChar) % and write it
+%/ (!*POP (reg 1)) % restore it
+%/ (!*EXIT 0) % and return
+CheckEOF
+ (gtsts) % check file status
+ (tlnn (reg 2) 2#000000001000000000) % gs%eof
+ (!*JUMP (Label ReadError))
+ (!*MOVE (WConst 26) (reg 1)) % return EOF char
+ (!*EXIT 0)
+ReadError
+ (!*MOVE (QUOTE "Attempt to read from file failed") (reg 1))
+ (!*JCALL IoError)
+);
+
+
+syslsp procedure SysWriteRec (FileDescriptor, StringToWrite, StringLength);
+% % Write StringLength characters
+% % from StringToWrite from the
+% % first position.
+ for i:=0:StringLength do
+ Dec20WriteChar(FileDescriptor,strbyt(StringToWrite,i));
+
+lap '((!*entry Dec20WriteChar expr 2)
+ % Jfn,Chr
+ (!*JUMPEQ (Label CRLF) (reg 2) (WConst 8#12)) % if LF, echo CRLF
+ (bout) % no, just echo char
+ (!*EXIT 0) % return
+CRLF
+ (!*MOVE (WConst 8#15) (reg 2)) % write carriage-return
+ (bout)
+ (!*MOVE (WConst 8#12) (reg 2)) % write linefeed
+ (bout)
+ (!*EXIT 0) % return
+);
+
+% SysClose (FileDescriptor); % Close FileDescriptor, allowing
+% % it to be reused.
+lap '((!*entry SysClose expr 1)
+ (closf)
+ (!*JUMP (Label CloseError))
+ (!*EXIT 0)
+CloseError
+ (!*MOVE (QUOTE "Channel could not be closed") (reg 1))
+ (!*JCALL ChannelError)
+);
+
+syslsp procedure SysMaxBuffer(FileDesc);
+ 200;
+
+End;
ADDED psl-1983/3-1/tests/all-test.headers
Index: psl-1983/3-1/tests/all-test.headers
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/all-test.headers
@@ -0,0 +1,319 @@
+"XXX-HEADER.RED"$ MAIN2 6/1
+FIRSTCALL; MAIN2 14/2
+UNDEFINEDFUNCTIONAUX; MAIN2 77/3
+"PT:MINI-CHAR-IO.RED"$ SUB2 3/1
+"PT:MINI-PRINTERS.RED"$ SUB2 4/2
+"PT:MINI-ERROR-ERRORSET.RED"$ SUB2 5/3
+"PT:MINI-ERROR-HANDLERS.RED"$ SUB2 6/4
+"PT:MINI-TYPE-ERRORS.RED"$ SUB2 7/5
+"XXX-HEADER.RED"$ MAIN3 6/1
+"PT:STUBS3.RED"$ MAIN3 7/2
+FIRSTCALL; MAIN3 12/3
+CASETEST; MAIN3 23/4
+CTEST N; MAIN3 41/5
+SHOW(N,S); MAIN3 49/6
+CONSTEST(); MAIN3 56/7
+UNDEFINEDFUNCTIONAUX; MAIN3 68/8
+"PT:P-ALLOCATORS.RED"$ SUB3 3/1
+"PT:MINI-CONS-MKVECT.RED"$ SUB3 4/2
+"PT:MINI-COMP-SUPPORT.RED"$ SUB3 5/3
+"PT:MINI-SEQUENCE.RED"$ SUB3 7/4
+"PT:MINI-GC.RED"$ STUBS3 4/1
+"XXX-HEADER.RED"$ MAIN4 5/1
+"PT:P-FUNCTION-PRIMITIVES.RED"$ MAIN4 6/2
+"PT:STUBS4.RED"$ MAIN4 7/3
+"PT:STUBS3.RED"$ MAIN4 8/4
+FIRSTCALL; MAIN4 15/5
+MORESTUFF; MAIN4 68/6
+FUNCTIONTEST(); MAIN4 74/7
+COMPILED1; MAIN4 124/8
+COMPILED2; MAIN4 128/9
+COMPILED3(A1,A2,A3,A4); MAIN4 132/10
+UNDEFINEDFUNCTIONAUXAUX ; MAIN4 142/11
+COMPILEDCALLINGINTERPRETEDAUX(); MAIN4 155/12
+"PT:MINI-EQUAL.RED"$ SUB4 6/1
+"PT:MINI-TOKEN.RED"$ SUB4 7/2
+"PT:MINI-READ.RED"$ SUB4 8/3
+SPACED(M); STUBS4 3/1
+DASHED(M); STUBS4 7/2
+DOTTED(M); STUBS4 12/3
+SHOULDBE(M,V,E); STUBS4 18/4
+"XXX-HEADER.RED"$ MAIN5 4/1
+"PT:STUBS3.RED"$ MAIN5 5/2
+"PT:STUBS4.RED"$ MAIN5 6/3
+"PT:STUBS5.RED"$ MAIN5 7/4
+FIRSTCALL; MAIN5 13/5
+TESTSERIES(); MAIN5 45/6
+TESTGET(); MAIN5 49/7
+TESTUNDEFINED; MAIN5 59/8
+UNBINDN N; MAIN5 64/9
+LBIND1(X,Y); MAIN5 67/10
+"PT:P-FUNCTION-PRIMITIVES.RED"$ SUB5 5/1
+"PT:P-APPLY-LAP.RED"$ SUB5 6/2
+"PT:MINI-ARITHMETIC.RED"$ SUB5 8/3
+"PT:MINI-CARCDR.RED"$ SUB5 9/4
+"PT:MINI-EASY-SL.RED"$ SUB5 10/5
+"PT:MINI-EASY-NON-SL.RED"$ SUB5 11/6
+"PT:MINI-EVAL-APPLY.RED"$ SUB5 12/7
+"PT:MINI-KNOWN-TO-COMP.RED"$ SUB5 13/8
+"PT:MINI-LOOP-MACROS.RED"$ SUB5 14/9
+"PT:MINI-OTHERS-SL.RED"$ SUB5 15/10
+"PT:MINI-OBLIST.RED"$ SUB5 16/11
+"PT:MINI-PROPERTY-LIST.RED"$ SUB5 17/12
+"PT:MINI-SYMBOL-VALUES.RED"$ SUB5 18/13
+"PT:MINI-TYPE-CONVERSIONS.RED"$ SUB5 19/14
+UNDEFINEDFUNCTIONAUXAUX; STUBS5 6/1
+INF X; STUBS5 22/2
+TAG X; STUBS5 25/3
+MKITEM(X,Y); STUBS5 28/4
+"XXX-HEADER.RED"$ MAIN6 5/1
+"PT:STUBS3.RED"$ MAIN6 6/2
+"PT:STUBS4.RED"$ MAIN6 7/3
+"PT:STUBS5.RED"$ MAIN6 8/4
+"PT:STUBS6.RED"$ MAIN6 9/5
+FIRSTCALL; MAIN6 15/6
+TESTSERIES(); MAIN6 48/7
+BINDINGTEST; MAIN6 55/8
+INTERPTEST(); MAIN6 71/9
+TESTFASTAPPLY EXPR 0) MAIN6 102/10
+TESTAPPLY(MSG,FN,ANSWER); MAIN6 107/11
+COMPILED1(XXX,YYY); MAIN6 117/12
+COMPILED2(XXX,YYY); MAIN6 122/13
+COMPBINDTEST(); MAIN6 129/14
+CBIND1(X,CFL1,CFL2); MAIN6 139/15
+CBIND2(); MAIN6 149/16
+"PK:BINDING.RED"$ SUB6 3/1
+"PT:P-FAST-BINDER.RED"$ SUB6 4/2
+"PT:MINI-PUTD-GETD.RED"$ SUB6 6/3
+RESET(); SUB6 8/4
+"PT:MINI-PRINTF.RED"$ STUBS6 3/1
+"PT:MINI-TOP-LOOP.RED"$ STUBS6 4/2
+FUNCALL(FN,I); STUBS6 8/3
+"XXX-HEADER.RED"$ MAIN7 5/1
+"PT:STUBS3.RED"$ MAIN7 6/2
+"PT:STUBS4.RED"$ MAIN7 7/3
+"PT:STUBS5.RED"$ MAIN7 8/4
+"PT:STUBS6.RED"$ MAIN7 9/5
+"PT:STUBS7.RED"$ MAIN7 10/6
+"PT:PSL-TIMER.SL"$ MAIN7 11/7
+FIRSTCALL; MAIN7 17/8
+IOTEST; MAIN7 61/9
+"XXX-SYSTEM-IO.RED"$ SUB7 5/1
+"PT:IO-DATA.RED"$ SUB7 6/2
+"PT:MINI-IO-ERRORS.RED"$ SUB7 7/3
+"PT:MINI-DSKIN.RED"$ SUB7 8/4
+"PT:MINI-OPEN-CLOSE.RED"$ SUB7 9/5
+"PT:MINI-RDS-WRS.RED"$ SUB7 10/6
+"PT:SYSTEM-IO.RED"$ SUB7 11/7
+GTHEAP N; MINI-ALLOCATOR 14/1
+GTSTR N; MINI-ALLOCATOR 27/2
+GTVECT N; MINI-ALLOCATOR 36/3
+GTWARRAY N; MINI-ALLOCATOR 44/4
+GTID(); MINI-ALLOCATOR 48/5
+PLUS2(X,Y); MINI-ARITHMETI 4/1
+MINUS(X); MINI-ARITHMETI 8/2
+ADD1 N; MINI-ARITHMETI 12/3
+SUB1 N; MINI-ARITHMETI 16/4
+GREATERP(N1,N2); MINI-ARITHMETI 21/5
+LESSP(N1,N2); MINI-ARITHMETI 24/6
+DIFFERENCE(N1,N2); MINI-ARITHMETI 27/7
+TIMES2(N1,N2); MINI-ARITHMETI 31/8
+CAR X; MINI-CARCDR 5/1
+CDR X; MINI-CARCDR 8/2
+CAAR X; MINI-CARCDR 13/3
+CADR X; MINI-CARCDR 16/4
+CDAR X; MINI-CARCDR 19/5
+CDDR X; MINI-CARCDR 22/6
+CHANNELWRITECHAR(CHN,X); MINI-CHAR-IO 3/1
+WRITECHAR CH; MINI-CHAR-IO 6/2
+LIST2(A1,A2); MINI-COMP-SUPP 4/1
+LIST3(A1,A2,A3); MINI-COMP-SUPP 7/2
+LIST4(A1,A2,A3,A4); MINI-COMP-SUPP 10/3
+LIST5(A1,A2,A3,A4,A5); MINI-COMP-SUPP 13/4
+HARDCONS(X,Y); MINI-CONS-MKVE 6/1
+CONS(X,Y); MINI-CONS-MKVE 14/2
+XCONS(X,Y); MINI-CONS-MKVE 17/3
+NCONS X; MINI-CONS-MKVE 20/4
+MKVECT N; MINI-CONS-MKVE 23/5
+TYPEFILE F; MINI-DSKIN 3/1
+DSKIN F; MINI-DSKIN 12/2
+LAPIN F; MINI-DSKIN 25/3
+ATSOC(X,Y); MINI-EASY-NON- 3/1
+GEQ(N1,N2); MINI-EASY-NON- 9/2
+LEQ(N1,N2); MINI-EASY-NON- 12/3
+EQCAR(X,Y); MINI-EASY-NON- 15/4
+COPYD(NEWID,OLDID); MINI-EASY-NON- 18/5
+DELATQ(X,Y); MINI-EASY-NON- 28/6
+ATOM X; MINI-EASY-SL 8/1
+APPEND(U,V); MINI-EASY-SL 13/2
+MEMQ(X,Y); MINI-EASY-SL 17/3
+REVERSE U; MINI-EASY-SL 22/4
+EVLIS X; MINI-EASY-SL 31/5
+EVPROGN FL; MINI-EASY-SL 35/6
+PROGN X; MINI-EASY-SL 42/7
+EVCOND FL; MINI-EASY-SL 45/8
+COND X; MINI-EASY-SL 51/9
+QUOTE A; MINI-EASY-SL 54/10
+SETQ A; MINI-EASY-SL 57/11
+DE(X); MINI-EASY-SL 60/12
+DF(X); MINI-EASY-SL 63/13
+DN(X); MINI-EASY-SL 66/14
+DM(X); MINI-EASY-SL 69/15
+LIST X; MINI-EASY-SL 73/16
+EQSTR(S1,S2); MINI-EQUAL 5/1
+ERRORHEADER; MINI-ERROR-ERR 4/1
+ERROR S; MINI-ERROR-ERR 7/2
+ERRORTRAILER S; MINI-ERROR-ERR 11/3
+FATALERROR S; MINI-ERROR-HAN 5/1
+STDERROR M; MINI-ERROR-HAN 8/2
+INITEVAL; MINI-EVAL-APPL 5/1
+EVAL X; MINI-EVAL-APPL 19/2
+APPLY(FN,A); MINI-EVAL-APPL 43/3
+LAMBDAAPPLY(X,A); MINI-EVAL-APPL 60/4
+LAMBDAEVALAPPLY(X,Y); MINI-EVAL-APPL 68/5
+DOLAMBDA(VARS,BODY,ARGS); MINI-EVAL-APPL 71/6
+LAMBDAP(X); MINI-EVAL-APPL 86/7
+GETLAMBDA(FN); MINI-EVAL-APPL 89/8
+!%RECLAIM(); MINI-GC 9/1
+RECLAIM(); MINI-GC 13/2
+HEAPINFO(); MINI-GC 17/3
+IOERROR M; MINI-IO-ERRORS 3/1
+CODEP X; MINI-KNOWN-TO- 3/1
+PAIRP X; MINI-KNOWN-TO- 6/2
+IDP X; MINI-KNOWN-TO- 9/3
+EQ(X,Y); MINI-KNOWN-TO- 12/4
+NULL X; MINI-KNOWN-TO- 15/5
+NOT X; MINI-KNOWN-TO- 18/6
+WHILE FL; MINI-LOOP-MACR 3/1
+MAPOBL(FN); MINI-OBLIST 6/1
+PRINTFEXPRS; MINI-OBLIST 9/2
+PRINT1FEXPR(X); MINI-OBLIST 12/3
+PRINTFUNCTIONS; MINI-OBLIST 15/4
+PRINT1FUNCTION(X); MINI-OBLIST 18/5
+OPEN(FILENAME,HOW); MINI-OPEN-CLOS 3/1
+CLOSE N; MINI-OPEN-CLOS 8/2
+LENGTH U; MINI-OTHERS-SL 4/1
+LENGTH1(U, N); MINI-OTHERS-SL 8/2
+PRIN1 X; MINI-PRINTERS 8/1
+PRIN2 X; MINI-PRINTERS 15/2
+PRINT X; MINI-PRINTERS 22/3
+PRIN2T X; MINI-PRINTERS 25/4
+PBLANK; MINI-PRINTERS 30/5
+PRIN1INT X; MINI-PRINTERS 33/6
+PRIN1INTX X; MINI-PRINTERS 40/7
+PRIN1ID X; MINI-PRINTERS 45/8
+PRIN2ID X; MINI-PRINTERS 50/9
+PRIN1STRING X; MINI-PRINTERS 53/10
+PRIN2STRING X; MINI-PRINTERS 60/11
+PRIN1PAIR X; MINI-PRINTERS 67/12
+PRIN2PAIR X; MINI-PRINTERS 78/13
+TERPRI(); MINI-PRINTERS 89/14
+PRTITM X; MINI-PRINTERS 92/15
+CHANNELPRIN2(CHN,X); MINI-PRINTERS 102/16
+BLDMSG(FMT,A1,A2,A3,A4,A5,A6); MINI-PRINTF 3/1
+PROP X; MINI-PROPERTY- 5/1
+GET(X,Y); MINI-PROPERTY- 9/2
+PUT(X,Y,Z); MINI-PROPERTY- 17/3
+REMPROP(X,Y); MINI-PROPERTY- 28/4
+GETFNTYPE X; MINI-PROPERTY- 38/5
+GETD(FN); MINI-PUTD-GETD 6/1
+PUTD(FN,TYPE,BODY); MINI-PUTD-GETD 21/2
+RDS N; MINI-RDS-WRS 5/1
+WRS N; MINI-RDS-WRS 13/2
+READ; MINI-READ 6/1
+READ1(X); MINI-READ 10/2
+READLIST(X); MINI-READ 15/3
+MKSTRING(L, C); MINI-SEQUENCE 5/1
+SET(X,Y); MINI-SYMBOL-VA 3/1
+INITREAD; MINI-TOKEN 11/1
+SETRAISE X; MINI-TOKEN 21/2
+RATOM; MINI-TOKEN 24/3
+CLEARWHITE(); MINI-TOKEN 41/4
+CLEARCOMMENT(); MINI-TOKEN 45/5
+READINT; MINI-TOKEN 50/6
+BUFFERTOSTRING N; MINI-TOKEN 59/7
+READSTR; MINI-TOKEN 67/8
+READID; MINI-TOKEN 77/9
+RAISECHAR C; MINI-TOKEN 88/10
+INTERN S; MINI-TOKEN 95/11
+INITNEWID(D,S); MINI-TOKEN 105/12
+LOOKUPID(S); MINI-TOKEN 115/13
+WHITEP X; MINI-TOKEN 131/14
+DIGITP X; MINI-TOKEN 135/15
+ALPHAP(X); MINI-TOKEN 138/16
+UPPERCASEP X; MINI-TOKEN 141/17
+LOWERCASEP X; MINI-TOKEN 144/18
+ESCAPEP X; MINI-TOKEN 147/19
+ALPHAESCP X; MINI-TOKEN 150/20
+ALPHANUMP X; MINI-TOKEN 153/21
+ALPHANUMESCP X; MINI-TOKEN 156/22
+TIME(); MINI-TOP-LOOP 3/1
+SYS2INT N; %. CONVERT WORD TO LISP NUMBER MINI-TYPE-CONV 5/1
+SYS2FIXN N; MINI-TYPE-CONV 9/2
+TYPEERROR(OFFENDER, FN, TYP); MINI-TYPE-ERRO 3/1
+USAGETYPEERROR(OFFENDER, FN, TYP, USAGE); MINI-TYPE-ERRO 14/2
+NONIDERROR(X,Y); MINI-TYPE-ERRO 28/3
+NONNUMBERERROR(OFFENDER, FN); MINI-TYPE-ERRO 31/4
+NONINTEGERERROR(OFFENDER, FN); MINI-TYPE-ERRO 34/5
+NONPOSITIVEINTEGERERROR(OFFENDER, FN); MINI-TYPE-ERRO 37/6
+CODEAPPLY(CODEPTR, ARGLIST); P-APPLY-LAP 53/1
+CODEEVALAPPLY EXPR 2) P-APPLY-LAP 206/2
+CODEEVALAPPLYAUX(CODEPTR, ARGLIST, P); P-APPLY-LAP 213/3
+BINDEVAL(FORMALS, ARGS); P-APPLY-LAP 363/4
+BINDEVALAUX(FORMALS, ARGS, N); P-APPLY-LAP 366/5
+COMPILEDCALLINGINTERPRETEDAUX(); P-APPLY-LAP 381/6
+FASTLAMBDAAPPLY(); P-APPLY-LAP 387/7
+COMPILEDCALLINGINTERPRETEDAUXAUX FN; P-APPLY-LAP 391/8
+LAMBIND V; P-FAST-BINDER 23/1
+PROGBIND V; P-FAST-BINDER 32/2
+SYMFNCBASE D; % THE ADDRESS OF CELL, P-FUNCTION-PRI 57/1
+FUNBOUNDP FN; P-FUNCTION-PRI 65/2
+MAKEFUNBOUND(D); P-FUNCTION-PRI 73/3
+FLAMBDALINKP FN; P-FUNCTION-PRI 79/4
+MAKEFLAMBDALINK D; P-FUNCTION-PRI 85/5
+FCODEP FN; P-FUNCTION-PRI 91/6
+MAKEFCODE(U, CODEPTR); P-FUNCTION-PRI 96/7
+GETFCODEPOINTER U; P-FUNCTION-PRI 106/8
+CODEPRIMITIVE EXPR 15) P-FUNCTION-PRI 121/9
+COMPILEDCALLINGINTERPRETED EXPR 15) P-FUNCTION-PRI 136/10
+FASTAPPLY EXPR 0) P-FUNCTION-PRI 153/11
+SAVEREGISTERS(A1, A2, A3, A4, A5, P-FUNCTION-PRI 193/12
+UNDEFINEDFUNCTIONAUX EXPR 0) P-FUNCTION-PRI 214/13
+ERNAL WCONST STACKSIZE = 5000; P20T:XXX-HEADE 11/1
+ERNAL WARRAY STACK[STACKSIZE]; P20T:XXX-HEADE 12/2
+ERNAL WCONST HEAPSIZE = 150000; % ENOUGH FOR PSL-TIM P20T:XXX-HEADE 21/3
+ERNAL WARRAY HEAP[HEAPSIZE]; % COULD DO A DYNAMIC A P20T:XXX-HEADE 22/4
+ERNAL WARRAY OTHERHEAP[HEAPSIZE]; P20T:XXX-HEADE 30/5
+ERNAL WCONST BPSSIZE = 500; P20T:XXX-HEADE 36/6
+ERNAL WARRAY BPS[BPSSIZE]; % COULD DO A DYNAMIC ALL P20T:XXX-HEADE 37/7
+INITHEAP(); P20T:XXX-HEADE 44/8
+ERNAL WCONST MAXARGBLOCK = (MAXARGS - MAXREALREGS) - P20T:XXX-HEADE 54/9
+MAIN!. EXPR 0) P20T:XXX-HEADE 68/10
+INIT(); P20T:XXX-HEADE 92/11
+GETC(); P20T:XXX-HEADE 98/12
+TIMC(); P20T:XXX-HEADE 102/13
+PUTC X; P20T:XXX-HEADE 105/14
+QUIT; P20T:XXX-HEADE 109/15
+DATE; P20T:XXX-HEADE 112/16
+VERSIONNAME; P20T:XXX-HEADE 115/17
+PUTINT I; P20T:XXX-HEADE 118/18
+!%STORE!-JCALL EXPR 2) % CODEADDRESS, STORAGE ADDRESS P20T:XXX-HEADE 122/19
+!%COPY!-FUNCTION!-CELL EXPR 2) % FROM TO P20T:XXX-HEADE 128/20
+UNDEFINEDFUNCTION EXPR 0) % FOR MISSING FUNCTION P20T:XXX-HEADE 135/21
+FLAG EXPR 2) % DUMMY FOR INIT P20T:XXX-HEADE 142/22
+LONGTIMES(X,Y); P20T:XXX-HEADE 148/23
+LONGDIV(X,Y); P20T:XXX-HEADE 151/24
+LONGREMAINDER(X,Y); P20T:XXX-HEADE 154/25
+SYSCLEARIO EXPR 0) P20T:XXX-SYSTE 30/1
+SYSOPENREAD(CHANNEL,FILENAME); P20T:XXX-SYSTE 44/2
+SYSOPENWRITE(CHANNEL,FILENAME); P20T:XXX-SYSTE 56/3
+DEC20OPEN EXPR 3) P20T:XXX-SYSTE 64/4
+SYSREADREC(FILEDESCRIPTOR,STRINGBUFFER); P20T:XXX-SYSTE 83/5
+DEC20READCHAR EXPR 1) P20T:XXX-SYSTE 98/6
+ SYSWRITEREC (FILEDESCRIPTOR, STRINGTOWRITE, STRINGLE P20T:XXX-SYSTE 123/7
+DEC20WRITECHAR EXPR 2) P20T:XXX-SYSTE 130/8
+SYSCLOSE EXPR 1) P20T:XXX-SYSTE 145/9
+SYSMAXBUFFER(FILEDESC); P20T:XXX-SYSTE 154/10
+
+
+ 2964 lines, 316 procedures found
ADDED psl-1983/3-1/tests/all-test.sorted
Index: psl-1983/3-1/tests/all-test.sorted
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/all-test.sorted
@@ -0,0 +1,317 @@
+ 2964 lines, 316 procedures found
+ SYSWRITEREC (FILEDESCRIPTOR, STRINGTOWRITE, STRINGLE P20T:XXX-SYSTE 123/7
+!%COPY!-FUNCTION!-CELL EXPR 2) % FROM TO P20T:XXX-HEADE 128/20
+!%RECLAIM(); MINI-GC 9/1
+!%STORE!-JCALL EXPR 2) % CODEADDRESS, STORAGE ADDRESS P20T:XXX-HEADE 122/19
+"PK:BINDING.RED"$ SUB6 3/1
+"PT:IO-DATA.RED"$ SUB7 6/2
+"PT:MINI-ARITHMETIC.RED"$ SUB5 8/3
+"PT:MINI-CARCDR.RED"$ SUB5 9/4
+"PT:MINI-CHAR-IO.RED"$ SUB2 3/1
+"PT:MINI-COMP-SUPPORT.RED"$ SUB3 5/3
+"PT:MINI-CONS-MKVECT.RED"$ SUB3 4/2
+"PT:MINI-DSKIN.RED"$ SUB7 8/4
+"PT:MINI-EASY-NON-SL.RED"$ SUB5 11/6
+"PT:MINI-EASY-SL.RED"$ SUB5 10/5
+"PT:MINI-EQUAL.RED"$ SUB4 6/1
+"PT:MINI-ERROR-ERRORSET.RED"$ SUB2 5/3
+"PT:MINI-ERROR-HANDLERS.RED"$ SUB2 6/4
+"PT:MINI-EVAL-APPLY.RED"$ SUB5 12/7
+"PT:MINI-GC.RED"$ STUBS3 4/1
+"PT:MINI-IO-ERRORS.RED"$ SUB7 7/3
+"PT:MINI-KNOWN-TO-COMP.RED"$ SUB5 13/8
+"PT:MINI-LOOP-MACROS.RED"$ SUB5 14/9
+"PT:MINI-OBLIST.RED"$ SUB5 16/11
+"PT:MINI-OPEN-CLOSE.RED"$ SUB7 9/5
+"PT:MINI-OTHERS-SL.RED"$ SUB5 15/10
+"PT:MINI-PRINTERS.RED"$ SUB2 4/2
+"PT:MINI-PRINTF.RED"$ STUBS6 3/1
+"PT:MINI-PROPERTY-LIST.RED"$ SUB5 17/12
+"PT:MINI-PUTD-GETD.RED"$ SUB6 6/3
+"PT:MINI-RDS-WRS.RED"$ SUB7 10/6
+"PT:MINI-READ.RED"$ SUB4 8/3
+"PT:MINI-SEQUENCE.RED"$ SUB3 7/4
+"PT:MINI-SYMBOL-VALUES.RED"$ SUB5 18/13
+"PT:MINI-TOKEN.RED"$ SUB4 7/2
+"PT:MINI-TOP-LOOP.RED"$ STUBS6 4/2
+"PT:MINI-TYPE-CONVERSIONS.RED"$ SUB5 19/14
+"PT:MINI-TYPE-ERRORS.RED"$ SUB2 7/5
+"PT:P-ALLOCATORS.RED"$ SUB3 3/1
+"PT:P-APPLY-LAP.RED"$ SUB5 6/2
+"PT:P-FAST-BINDER.RED"$ SUB6 4/2
+"PT:P-FUNCTION-PRIMITIVES.RED"$ MAIN4 6/2
+"PT:P-FUNCTION-PRIMITIVES.RED"$ SUB5 5/1
+"PT:PSL-TIMER.SL"$ MAIN7 11/7
+"PT:STUBS3.RED"$ MAIN3 7/2
+"PT:STUBS3.RED"$ MAIN4 8/4
+"PT:STUBS3.RED"$ MAIN5 5/2
+"PT:STUBS3.RED"$ MAIN6 6/2
+"PT:STUBS3.RED"$ MAIN7 6/2
+"PT:STUBS4.RED"$ MAIN4 7/3
+"PT:STUBS4.RED"$ MAIN5 6/3
+"PT:STUBS4.RED"$ MAIN6 7/3
+"PT:STUBS4.RED"$ MAIN7 7/3
+"PT:STUBS5.RED"$ MAIN5 7/4
+"PT:STUBS5.RED"$ MAIN6 8/4
+"PT:STUBS5.RED"$ MAIN7 8/4
+"PT:STUBS6.RED"$ MAIN6 9/5
+"PT:STUBS6.RED"$ MAIN7 9/5
+"PT:STUBS7.RED"$ MAIN7 10/6
+"PT:SYSTEM-IO.RED"$ SUB7 11/7
+"XXX-HEADER.RED"$ MAIN2 6/1
+"XXX-HEADER.RED"$ MAIN3 6/1
+"XXX-HEADER.RED"$ MAIN4 5/1
+"XXX-HEADER.RED"$ MAIN5 4/1
+"XXX-HEADER.RED"$ MAIN6 5/1
+"XXX-HEADER.RED"$ MAIN7 5/1
+"XXX-SYSTEM-IO.RED"$ SUB7 5/1
+ADD1 N; MINI-ARITHMETI 12/3
+ALPHAESCP X; MINI-TOKEN 150/20
+ALPHANUMESCP X; MINI-TOKEN 156/22
+ALPHANUMP X; MINI-TOKEN 153/21
+ALPHAP(X); MINI-TOKEN 138/16
+APPEND(U,V); MINI-EASY-SL 13/2
+APPLY(FN,A); MINI-EVAL-APPL 43/3
+ATOM X; MINI-EASY-SL 8/1
+ATSOC(X,Y); MINI-EASY-NON- 3/1
+BINDEVAL(FORMALS, ARGS); P-APPLY-LAP 363/4
+BINDEVALAUX(FORMALS, ARGS, N); P-APPLY-LAP 366/5
+BINDINGTEST; MAIN6 55/8
+BLDMSG(FMT,A1,A2,A3,A4,A5,A6); MINI-PRINTF 3/1
+BUFFERTOSTRING N; MINI-TOKEN 59/7
+CAAR X; MINI-CARCDR 13/3
+CADR X; MINI-CARCDR 16/4
+CAR X; MINI-CARCDR 5/1
+CASETEST; MAIN3 23/4
+CBIND1(X,CFL1,CFL2); MAIN6 139/15
+CBIND2(); MAIN6 149/16
+CDAR X; MINI-CARCDR 19/5
+CDDR X; MINI-CARCDR 22/6
+CDR X; MINI-CARCDR 8/2
+CHANNELPRIN2(CHN,X); MINI-PRINTERS 102/16
+CHANNELWRITECHAR(CHN,X); MINI-CHAR-IO 3/1
+CLEARCOMMENT(); MINI-TOKEN 45/5
+CLEARWHITE(); MINI-TOKEN 41/4
+CLOSE N; MINI-OPEN-CLOS 8/2
+CODEAPPLY(CODEPTR, ARGLIST); P-APPLY-LAP 53/1
+CODEEVALAPPLY EXPR 2) P-APPLY-LAP 206/2
+CODEEVALAPPLYAUX(CODEPTR, ARGLIST, P); P-APPLY-LAP 213/3
+CODEP X; MINI-KNOWN-TO- 3/1
+CODEPRIMITIVE EXPR 15) P-FUNCTION-PRI 121/9
+COMPBINDTEST(); MAIN6 129/14
+COMPILED1(XXX,YYY); MAIN6 117/12
+COMPILED1; MAIN4 124/8
+COMPILED2(XXX,YYY); MAIN6 122/13
+COMPILED2; MAIN4 128/9
+COMPILED3(A1,A2,A3,A4); MAIN4 132/10
+COMPILEDCALLINGINTERPRETED EXPR 15) P-FUNCTION-PRI 136/10
+COMPILEDCALLINGINTERPRETEDAUX(); MAIN4 155/12
+COMPILEDCALLINGINTERPRETEDAUX(); P-APPLY-LAP 381/6
+COMPILEDCALLINGINTERPRETEDAUXAUX FN; P-APPLY-LAP 391/8
+COND X; MINI-EASY-SL 51/9
+CONS(X,Y); MINI-CONS-MKVE 14/2
+CONSTEST(); MAIN3 56/7
+COPYD(NEWID,OLDID); MINI-EASY-NON- 18/5
+CTEST N; MAIN3 41/5
+DASHED(M); STUBS4 7/2
+DATE; P20T:XXX-HEADE 112/16
+DE(X); MINI-EASY-SL 60/12
+DEC20OPEN EXPR 3) P20T:XXX-SYSTE 64/4
+DEC20READCHAR EXPR 1) P20T:XXX-SYSTE 98/6
+DEC20WRITECHAR EXPR 2) P20T:XXX-SYSTE 130/8
+DELATQ(X,Y); MINI-EASY-NON- 28/6
+DF(X); MINI-EASY-SL 63/13
+DIFFERENCE(N1,N2); MINI-ARITHMETI 27/7
+DIGITP X; MINI-TOKEN 135/15
+DM(X); MINI-EASY-SL 69/15
+DN(X); MINI-EASY-SL 66/14
+DOLAMBDA(VARS,BODY,ARGS); MINI-EVAL-APPL 71/6
+DOTTED(M); STUBS4 12/3
+DSKIN F; MINI-DSKIN 12/2
+EQ(X,Y); MINI-KNOWN-TO- 12/4
+EQCAR(X,Y); MINI-EASY-NON- 15/4
+EQSTR(S1,S2); MINI-EQUAL 5/1
+ERNAL WARRAY BPS[BPSSIZE]; % COULD DO A DYNAMIC ALL P20T:XXX-HEADE 37/7
+ERNAL WARRAY HEAP[HEAPSIZE]; % COULD DO A DYNAMIC A P20T:XXX-HEADE 22/4
+ERNAL WARRAY OTHERHEAP[HEAPSIZE]; P20T:XXX-HEADE 30/5
+ERNAL WARRAY STACK[STACKSIZE]; P20T:XXX-HEADE 12/2
+ERNAL WCONST BPSSIZE = 500; P20T:XXX-HEADE 36/6
+ERNAL WCONST HEAPSIZE = 150000; % ENOUGH FOR PSL-TIM P20T:XXX-HEADE 21/3
+ERNAL WCONST MAXARGBLOCK = (MAXARGS - MAXREALREGS) - P20T:XXX-HEADE 54/9
+ERNAL WCONST STACKSIZE = 5000; P20T:XXX-HEADE 11/1
+ERROR S; MINI-ERROR-ERR 7/2
+ERRORHEADER; MINI-ERROR-ERR 4/1
+ERRORTRAILER S; MINI-ERROR-ERR 11/3
+ESCAPEP X; MINI-TOKEN 147/19
+EVAL X; MINI-EVAL-APPL 19/2
+EVCOND FL; MINI-EASY-SL 45/8
+EVLIS X; MINI-EASY-SL 31/5
+EVPROGN FL; MINI-EASY-SL 35/6
+FASTAPPLY EXPR 0) P-FUNCTION-PRI 153/11
+FASTLAMBDAAPPLY(); P-APPLY-LAP 387/7
+FATALERROR S; MINI-ERROR-HAN 5/1
+FCODEP FN; P-FUNCTION-PRI 91/6
+FIRSTCALL; MAIN2 14/2
+FIRSTCALL; MAIN3 12/3
+FIRSTCALL; MAIN4 15/5
+FIRSTCALL; MAIN5 13/5
+FIRSTCALL; MAIN6 15/6
+FIRSTCALL; MAIN7 17/8
+FLAG EXPR 2) % DUMMY FOR INIT P20T:XXX-HEADE 142/22
+FLAMBDALINKP FN; P-FUNCTION-PRI 79/4
+FUNBOUNDP FN; P-FUNCTION-PRI 65/2
+FUNCALL(FN,I); STUBS6 8/3
+FUNCTIONTEST(); MAIN4 74/7
+GEQ(N1,N2); MINI-EASY-NON- 9/2
+GET(X,Y); MINI-PROPERTY- 9/2
+GETC(); P20T:XXX-HEADE 98/12
+GETD(FN); MINI-PUTD-GETD 6/1
+GETFCODEPOINTER U; P-FUNCTION-PRI 106/8
+GETFNTYPE X; MINI-PROPERTY- 38/5
+GETLAMBDA(FN); MINI-EVAL-APPL 89/8
+GREATERP(N1,N2); MINI-ARITHMETI 21/5
+GTHEAP N; MINI-ALLOCATOR 14/1
+GTID(); MINI-ALLOCATOR 48/5
+GTSTR N; MINI-ALLOCATOR 27/2
+GTVECT N; MINI-ALLOCATOR 36/3
+GTWARRAY N; MINI-ALLOCATOR 44/4
+HARDCONS(X,Y); MINI-CONS-MKVE 6/1
+HEAPINFO(); MINI-GC 17/3
+IDP X; MINI-KNOWN-TO- 9/3
+INF X; STUBS5 22/2
+INIT(); P20T:XXX-HEADE 92/11
+INITEVAL; MINI-EVAL-APPL 5/1
+INITHEAP(); P20T:XXX-HEADE 44/8
+INITNEWID(D,S); MINI-TOKEN 105/12
+INITREAD; MINI-TOKEN 11/1
+INTERN S; MINI-TOKEN 95/11
+INTERPTEST(); MAIN6 71/9
+IOERROR M; MINI-IO-ERRORS 3/1
+IOTEST; MAIN7 61/9
+LAMBDAAPPLY(X,A); MINI-EVAL-APPL 60/4
+LAMBDAEVALAPPLY(X,Y); MINI-EVAL-APPL 68/5
+LAMBDAP(X); MINI-EVAL-APPL 86/7
+LAMBIND V; P-FAST-BINDER 23/1
+LAPIN F; MINI-DSKIN 25/3
+LBIND1(X,Y); MAIN5 67/10
+LENGTH U; MINI-OTHERS-SL 4/1
+LENGTH1(U, N); MINI-OTHERS-SL 8/2
+LEQ(N1,N2); MINI-EASY-NON- 12/3
+LESSP(N1,N2); MINI-ARITHMETI 24/6
+LIST X; MINI-EASY-SL 73/16
+LIST2(A1,A2); MINI-COMP-SUPP 4/1
+LIST3(A1,A2,A3); MINI-COMP-SUPP 7/2
+LIST4(A1,A2,A3,A4); MINI-COMP-SUPP 10/3
+LIST5(A1,A2,A3,A4,A5); MINI-COMP-SUPP 13/4
+LONGDIV(X,Y); P20T:XXX-HEADE 151/24
+LONGREMAINDER(X,Y); P20T:XXX-HEADE 154/25
+LONGTIMES(X,Y); P20T:XXX-HEADE 148/23
+LOOKUPID(S); MINI-TOKEN 115/13
+LOWERCASEP X; MINI-TOKEN 144/18
+MAIN!. EXPR 0) P20T:XXX-HEADE 68/10
+MAKEFCODE(U, CODEPTR); P-FUNCTION-PRI 96/7
+MAKEFLAMBDALINK D; P-FUNCTION-PRI 85/5
+MAKEFUNBOUND(D); P-FUNCTION-PRI 73/3
+MAPOBL(FN); MINI-OBLIST 6/1
+MEMQ(X,Y); MINI-EASY-SL 17/3
+MINUS(X); MINI-ARITHMETI 8/2
+MKITEM(X,Y); STUBS5 28/4
+MKSTRING(L, C); MINI-SEQUENCE 5/1
+MKVECT N; MINI-CONS-MKVE 23/5
+MORESTUFF; MAIN4 68/6
+NCONS X; MINI-CONS-MKVE 20/4
+NONIDERROR(X,Y); MINI-TYPE-ERRO 28/3
+NONINTEGERERROR(OFFENDER, FN); MINI-TYPE-ERRO 34/5
+NONNUMBERERROR(OFFENDER, FN); MINI-TYPE-ERRO 31/4
+NONPOSITIVEINTEGERERROR(OFFENDER, FN); MINI-TYPE-ERRO 37/6
+NOT X; MINI-KNOWN-TO- 18/6
+NULL X; MINI-KNOWN-TO- 15/5
+OPEN(FILENAME,HOW); MINI-OPEN-CLOS 3/1
+PAIRP X; MINI-KNOWN-TO- 6/2
+PBLANK; MINI-PRINTERS 30/5
+PLUS2(X,Y); MINI-ARITHMETI 4/1
+PRIN1 X; MINI-PRINTERS 8/1
+PRIN1ID X; MINI-PRINTERS 45/8
+PRIN1INT X; MINI-PRINTERS 33/6
+PRIN1INTX X; MINI-PRINTERS 40/7
+PRIN1PAIR X; MINI-PRINTERS 67/12
+PRIN1STRING X; MINI-PRINTERS 53/10
+PRIN2 X; MINI-PRINTERS 15/2
+PRIN2ID X; MINI-PRINTERS 50/9
+PRIN2PAIR X; MINI-PRINTERS 78/13
+PRIN2STRING X; MINI-PRINTERS 60/11
+PRIN2T X; MINI-PRINTERS 25/4
+PRINT X; MINI-PRINTERS 22/3
+PRINT1FEXPR(X); MINI-OBLIST 12/3
+PRINT1FUNCTION(X); MINI-OBLIST 18/5
+PRINTFEXPRS; MINI-OBLIST 9/2
+PRINTFUNCTIONS; MINI-OBLIST 15/4
+PROGBIND V; P-FAST-BINDER 32/2
+PROGN X; MINI-EASY-SL 42/7
+PROP X; MINI-PROPERTY- 5/1
+PRTITM X; MINI-PRINTERS 92/15
+PUT(X,Y,Z); MINI-PROPERTY- 17/3
+PUTC X; P20T:XXX-HEADE 105/14
+PUTD(FN,TYPE,BODY); MINI-PUTD-GETD 21/2
+PUTINT I; P20T:XXX-HEADE 118/18
+QUIT; P20T:XXX-HEADE 109/15
+QUOTE A; MINI-EASY-SL 54/10
+RAISECHAR C; MINI-TOKEN 88/10
+RATOM; MINI-TOKEN 24/3
+RDS N; MINI-RDS-WRS 5/1
+READ1(X); MINI-READ 10/2
+READ; MINI-READ 6/1
+READID; MINI-TOKEN 77/9
+READINT; MINI-TOKEN 50/6
+READLIST(X); MINI-READ 15/3
+READSTR; MINI-TOKEN 67/8
+RECLAIM(); MINI-GC 13/2
+REMPROP(X,Y); MINI-PROPERTY- 28/4
+RESET(); SUB6 8/4
+REVERSE U; MINI-EASY-SL 22/4
+SAVEREGISTERS(A1, A2, A3, A4, A5, P-FUNCTION-PRI 193/12
+SET(X,Y); MINI-SYMBOL-VA 3/1
+SETQ A; MINI-EASY-SL 57/11
+SETRAISE X; MINI-TOKEN 21/2
+SHOULDBE(M,V,E); STUBS4 18/4
+SHOW(N,S); MAIN3 49/6
+SPACED(M); STUBS4 3/1
+STDERROR M; MINI-ERROR-HAN 8/2
+SUB1 N; MINI-ARITHMETI 16/4
+SYMFNCBASE D; % THE ADDRESS OF CELL, P-FUNCTION-PRI 57/1
+SYS2FIXN N; MINI-TYPE-CONV 9/2
+SYS2INT N; %. CONVERT WORD TO LISP NUMBER MINI-TYPE-CONV 5/1
+SYSCLEARIO EXPR 0) P20T:XXX-SYSTE 30/1
+SYSCLOSE EXPR 1) P20T:XXX-SYSTE 145/9
+SYSMAXBUFFER(FILEDESC); P20T:XXX-SYSTE 154/10
+SYSOPENREAD(CHANNEL,FILENAME); P20T:XXX-SYSTE 44/2
+SYSOPENWRITE(CHANNEL,FILENAME); P20T:XXX-SYSTE 56/3
+SYSREADREC(FILEDESCRIPTOR,STRINGBUFFER); P20T:XXX-SYSTE 83/5
+TAG X; STUBS5 25/3
+TERPRI(); MINI-PRINTERS 89/14
+TESTAPPLY(MSG,FN,ANSWER); MAIN6 107/11
+TESTFASTAPPLY EXPR 0) MAIN6 102/10
+TESTGET(); MAIN5 49/7
+TESTSERIES(); MAIN5 45/6
+TESTSERIES(); MAIN6 48/7
+TESTUNDEFINED; MAIN5 59/8
+TIMC(); P20T:XXX-HEADE 102/13
+TIME(); MINI-TOP-LOOP 3/1
+TIMES2(N1,N2); MINI-ARITHMETI 31/8
+TYPEERROR(OFFENDER, FN, TYP); MINI-TYPE-ERRO 3/1
+TYPEFILE F; MINI-DSKIN 3/1
+UNBINDN N; MAIN5 64/9
+UNDEFINEDFUNCTION EXPR 0) % FOR MISSING FUNCTION P20T:XXX-HEADE 135/21
+UNDEFINEDFUNCTIONAUX EXPR 0) P-FUNCTION-PRI 214/13
+UNDEFINEDFUNCTIONAUX; MAIN2 77/3
+UNDEFINEDFUNCTIONAUX; MAIN3 68/8
+UNDEFINEDFUNCTIONAUXAUX ; MAIN4 142/11
+UNDEFINEDFUNCTIONAUXAUX; STUBS5 6/1
+UPPERCASEP X; MINI-TOKEN 141/17
+USAGETYPEERROR(OFFENDER, FN, TYP, USAGE); MINI-TYPE-ERRO 14/2
+VERSIONNAME; P20T:XXX-HEADE 115/17
+WHILE FL; MINI-LOOP-MACR 3/1
+WHITEP X; MINI-TOKEN 131/14
+WRITECHAR CH; MINI-CHAR-IO 6/2
+WRS N; MINI-RDS-WRS 13/2
+XCONS(X,Y); MINI-CONS-MKVE 17/3
ADDED psl-1983/3-1/tests/block-dolphin.tim
Index: psl-1983/3-1/tests/block-dolphin.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/block-dolphin.tim
@@ -0,0 +1,22 @@
+(
+("Block Compiled, Dolphin, InterLISP D, Jed Marti, 10-March-83, Rand")
+(EmptyTest-10000 . 360)
+(GEmptyTest-10000 . 360)
+(Cdr1Test-100 . 6497)
+(Cdr2Test-100 . 2919)
+(CddrTest-100 . 2411)
+(ListOnlyCdrTest1 . 20525)
+(ListOnlyCddrTest1 . 31736)
+(ListOnlyCdrTest2 . 38786)
+(ListOnlyCddrTest2 . 49978)
+(ReverseTest-10 . 4095)
+(MyReverse1Test-10 . 5087)
+(MyReverse2Test-10 . 4417)
+(LengthTest-100 . 8570)
+(ArithmeticTest-10000 . 12759)
+(EvalTest-10000 . 15782)
+(tak-18-12-6 . 4817)
+(gtak-18-12-6 . 4737)
+(gtsta-g0 . 79000)
+(gtsta-g1 . 93854)
+)
ADDED psl-1983/3-1/tests/boot-list
Index: psl-1983/3-1/tests/boot-list
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/boot-list
@@ -0,0 +1,100 @@
+ Cross-compiler Test and Bootstrap series page 1
+
+PK: modules/files PT: status
+
+ALLOC
+ Allocators P-allocators sub3 cleaned up
+ Copiers
+ Cons-mkvect m-cons-mkvect sub3 almost same
+ Comp-support PK:comp-support sub3 same
+ P20:System-gc xxx-system-gc sub8 same
+ P20:Gc m-gc stubs3 STUB until test 8
+ xxx-gc sub8
+ compacting-gc p-comp-gc sub8 cleaned up
+ARITH
+ Arithmetic m-arithmetic sub5 simpler
+DEBG
+ p20:Mini-trace
+ Mini-editor
+ Backtrace
+ERROR
+ Error-handlers m-error-handlers sub2 simple subset
+ Type-errors m-type-errors sub2 same, with
+ fake StdError,Bldmsg
+ Error-errorset m-error-errorset sub2 trivial subset
+ Io-errors m-io-errors sub2 simple subset
+EVAL
+ P20:Apply-lap p-apply-lap sub5a less efficient
+ Eval-apply m-eval-apply sub5a simpler
+ Catch-throw PK:catch-throw sub9 same
+ Prog-and-friends PK:prog-and-friends sub9 same
+EXTRA
+ p20:Timc xxx-header
+ p20:System-extras xxx-header
+ p20:Trap
+ P20:Dumplisp
+FASL
+ p20:System-faslout
+ p20:System-faslin
+ Faslin
+ Load
+ Autoload
+P20:HEAP
+ [Declare HEAP,BPS] xxx-header
+ Cross-compiler Test and Bootstrap series page 2
+
+IO
+ P20:Io-data io-data sub7 same?
+ Char-io m-char-io sub7 simple subset
+ Open-close m-open-close sub7 simpler
+ Rds-wrs m-rds-wrs sub7 simpler
+ Other-io
+ Read m-read sub4 simpler
+ Token-scanner m-token sub4 simpler
+ Printers m-printers sub2 simpler
+ p20:Write-float
+ Printf m-printf sub2 trivial subset
+ Explode-compress
+ Io-extensions
+MACRO
+ Eval-when
+ Cont-error
+ Lisp-macros
+ Onoff
+ Define-smacro
+ Defconst
+ String-gensym
+ Loop-macros m-loop-macros sub5 simpler
+MAIN
+ P20:Main-start xxx-header simpler
+PROP
+ P20:Function-primitives
+ p-function-primitives sub5b less efficient
+ Property-list m-property-list sub5b simpler?
+ Fluid-global m-fluid-global sub5b trivial
+ Putd-getd m-putd-getd sub6 simpler?
+RANDM
+ Known-to-comp-sl PK:known-to-comp-sl sub5b same
+ Others-sl M-others-sl sub5b subset
+ Equal m-equal sub5b subset
+ Carcdr PK:carcdr sub5b same
+ Easy-sl M-easy-sl sub5b subset
+ Easy-non-sl M-easy-non-sl sub5b subset
+ Sets
+SYMBL
+ Binding PK:binding sub6 same
+ P20:Fast-binder P-fast-binder sub6 less-efficient
+ Symbol-values m-symbol-values sub5b subset
+ Oblist m-oblist sub5b subset
+SYSIO
+ p20:System-io system-io,
+ xxx-system-io sub7 same?
+ P20:Scan-table
+TLOOP
+ Break
+ Top-loop m-top-loop sub7 trivial subset
+ Dskin m-dskin sub7 simpler
+TYPES
+ Type-conversions m-type-conversions sub5b simpler
+ Vectors
+ Sequence m-sequence sub3 simpler
ADDED psl-1983/3-1/tests/catch.tst
Index: psl-1983/3-1/tests/catch.tst
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/catch.tst
@@ -0,0 +1,14 @@
+% Some interpreted tests of CATCH and THROW for MAIN 9
+
+(Dashed "Expect an Error, that FOO uncaught")
+(THROW 'FOO 1)
+
+(shouldbe "Catch should return argument "
+ (CATCH 'FOO 1)
+ 1)
+
+(Dashed "Expect 1 to be printed, and 2 returned, no 3")
+(Shouldbe "Catch the Thrown value"
+ (CATCH 'FOO (PROGN (print 1) (throw 'foo 2) (print 3)))
+ 2)
+
ADDED psl-1983/3-1/tests/cray-time.red
Index: psl-1983/3-1/tests/cray-time.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/cray-time.red
@@ -0,0 +1,24 @@
+% A small timing test to compare DEC-20, VAX and Cray
+% in syslisp and FORTRAN and C
+% An iterative FACTORIAL
+
+on comp;
+on syslisp;
+
+syslsp procedure IFAC n;
+ begin scalar m;
+ m:=1;
+ while n >0 do <<m:=m*n; n := n-1>>;
+ return m;
+ end;
+
+procedure NCALL(N,M);
+ begin scalar tim1,tim2,i;
+ tim1:=time();
+ while N>0 do <<i:=Ifac(m);n:=n-1>>;
+ tim2:=time()-tim1; %/had bug if same tim
+ printf(" took %p ms%n",tim2);
+ end;
+
+
+off syslisp;
ADDED psl-1983/3-1/tests/extended-20.tim
Index: psl-1983/3-1/tests/extended-20.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/extended-20.tim
@@ -0,0 +1,24 @@
+(
+("DEC-20, extended 3.1 PSL" . "2-Apr-83 ")
+(EmptyTest-10000 . 18)
+(GEmptyTest-10000 . 298)
+(Cdr1Test-100 . 572)
+(Cdr2Test-100 . 385)
+(CddrTest-100 . 274)
+(ListOnlyCdrTest1 . 1801)
+(ListOnlyCddrTest1 . 3237)
+(ListOnlyCdrTest2 . 2997)
+(ListOnlyCddrTest2 . 4520)
+(ReverseTest-10 . 341)
+(MyReverse1Test-10 . 602)
+(MyReverse2Test-10 . 316)
+(LengthTest-100 . 613)
+(ArithmeticTest-10000 . 617)
+(EvalTest-10000 . 2096)
+(tak-18-12-6 . 468)
+(gtak-18-12-6 . 2011)
+(gtsta-g0 . 900)
+(gtsta-g1 . 970)
+)
+
+% GC average about 680ms per
ADDED psl-1983/3-1/tests/extended-test-20.tim
Index: psl-1983/3-1/tests/extended-test-20.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/extended-test-20.tim
@@ -0,0 +1,22 @@
+(("Extended Test 20 ". " 20 Feb 1983")
+
+(EmptyTest-10000 . 27)
+(SlowEmptyTest-10000 . 83)
+(Cdr1Test-100 . 579)
+(Cdr2Test-100 . 381 )
+(CddrTest-100 . 299 )
+(ListOnlyCdrTest1 . 1762 )
+(ListOnlyCddrTest1 . 3483 )
+(ListOnlyCdrTest2 . 3005 )
+(ListOnlyCddrTest2 . 4704 )
+(ReverseTest-10 . 620 )
+(MyReverse1Test-10 . 594 )
+(MyReverse2Test-10 . 523 )
+(LengthTest-100 . 624 )
+(ArithmeticTest-10000 . 661 )
+(EvalTest-10000 . 3118 )
+(tak-18-12-6 . 477 )
+(gtak-18-12-6 . 705 )
+(gtsta-g0 . 1249)
+(gtsta-g1 . 1308)
+)
ADDED psl-1983/3-1/tests/fast-780.tim
Index: psl-1983/3-1/tests/fast-780.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/fast-780.tim
@@ -0,0 +1,22 @@
+(
+("PSL 3.1, Faster VAX 780 " . " 31-Mar-83")
+(EmptyTest-10000 . 34)
+(GEmptyTest-10000 . 630)
+(Cdr1Test-100 . 1309)
+(Cdr2Test-100 . 850)
+(CddrTest-100 . 663)
+(ListOnlyCdrTest1 . 5219)
+(ListOnlyCddrTest1 . 8262)
+(ListOnlyCdrTest2 . 7616)
+(ListOnlyCddrTest2 . 11866)
+(ReverseTest-10 . 714)
+(MyReverse1Test-10 . 612)
+(MyReverse2Test-10 . 442)
+(LengthTest-100 . 1650)
+(ArithmeticTest-10000 . 833)
+(EvalTest-10000 . 6200)
+(tak-18-12-6 . 714)
+(gtak-18-12-6 . 4029)
+(gtsta-g0 . 2227)
+(gtsta-g1 . 2329)
+)
ADDED psl-1983/3-1/tests/field.red
Index: psl-1983/3-1/tests/field.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/field.red
@@ -0,0 +1,130 @@
+% FIELD.RED - Exhaustively Test the Field Operator
+
+On SYSLISP;
+
+In "XXX-Header.red"$
+
+Procedure FirstCall;
+ Begin Scalar X,BPW;
+ Msg5(Char M, Char S, Char G, Char '! ,Char EOL);
+ TestOK Char '!?; %/ Confirm the test message
+ TestErr Char '!?;
+
+% Set up test pattern
+ %0001122233444556 % Bit Number T
+ %0482604826048260 U
+
+BPW:=BitsPerWord; % For bug in !*JUMPxx
+ If BPW eq 64 then
+ X:=16#0123456789ABCDEF % 16 nibbles=8 bytes
+ else if BPW eq 32 then
+ X:=16#01234567 % 8 nibbles=4 bytes
+ else if BPW eq 36 then
+ X:=16#012345678 % 9 nibbles=4.5 bytes
+ else ERR 99;
+
+ AShiftTest(X); %/ Arithmetic Test
+ FieldTest(X); %/ FieldExtract
+ LshiftTest(X); %/ Shift and Masks with Field
+ Quit;
+ End;
+
+% Ashift can only be tested by a multiply of a 2 to a power. Therefore
+% it is only used in the left shift case.
+Procedure AShiftTest TestVal;
+ Begin Scalar X, Y;
+ Msg5(Char A,Char S,Char H,Char I,Char F);
+ Msg5(Char T,Char '! ,Char '! ,Char '! , Char EOL);
+ Y := 10;
+ Y := Y*4;
+ If Y NEQ 40 Then TestErr Char 1 Else TestOk Char 1;
+ Y := -5;
+ Y := Y*16;
+ If Y NEQ -80 Then TestErr Char 2 Else TestOk Char 2;
+ Y := 6;
+ X := 4;
+ Y := Y * 4;
+ If Y NEQ 6*X Then TestErr Char 3 Else TestOk Char 3;
+ End;
+
+
+Procedure FieldTest(x);
+% Extract a field from a variable and see if it works.
+ Begin scalar Y;
+ Msg5(Char F,Char I,Char E,Char L,Char D);
+ PutC Char EOL;
+ Y:=Field(X, 0, BitsPerWord);% FullWord
+ If Y NEQ X Then TestErr Char 1 Else TestOk Char 1;
+ Y:=Field(X, 0, 8); % First Byte
+ If Y NEQ 16#01 Then TestErr Char 2 Else TestOk Char 2;
+ Y:=Field(X, 8, 8); % Second Byte
+ If Y NEQ 16#23 Then TestErr Char 3 Else TestOk Char 3;
+ Y:=Field(X, 16, 8); % Third Byte
+ If Y NEQ 16#45 Then TestErr Char 4 Else TestOk Char 4;
+ Y:=Field(X, 24, 8 ); % Fourth Byte
+ If Y NEQ 16#67 Then TestErr Char 5 Else TestOk Char 5;
+ Y:=Field(X, 0, 16); % First 16 bit
+ If Y NEQ 16#0123 Then TestErr Char 6 Else TestOk Char 6;
+ Y:=Field(X, 16, 16); % Second 16 bit
+ If Y NEQ 16#4567 Then TestErr Char 7 Else TestOk Char 7;
+ End;
+
+Procedure LshiftTest x;
+ Begin Scalar Y;
+ Msg5(Char L,Char S,Char H,Char I,Char F);
+ Msg5(Char T ,Char '! ,Char '! ,Char '! , Char EOL);
+ Y:=Extract(X, 0, BitsPerWord); % FullWord
+ If Y NEQ X Then TestErr Char 1 Else TestOk Char 1;
+ Y:=Extract(X, 0, 8); % First Byte
+ If Y NEQ 16#01 Then TestErr Char 2 Else TestOk Char 2;
+ Y:=Extract(X, 8, 8); % Second Byte
+ If Y NEQ 16#23 Then TestErr Char 3 Else TestOk Char 3;
+ Y:=Extract(X, 16, 8); % Third Byte
+ If Y NEQ 16#45 Then TestErr Char 4 Else TestOk Char 4;
+ Y:=Extract(X, 24, 8 ); % Fourth Byte
+ If Y NEQ 16#67 Then TestErr Char 5 Else TestOk Char 5;
+ Y:=Extract(X, 0, 16); % First 16 bit
+ If Y NEQ 16#0123 Then TestErr Char 6 Else TestOk Char 6;
+ Y:=Extract(X, 16, 16); % Second 16 bit
+ If Y NEQ 16#4567 Then TestErr Char 7 Else TestOk Char 7;
+ End;
+
+%%% Signals that Test OK or Error %%%%%
+
+Procedure Msg5(C1,C2,C3,C4,C5);
+ <<PutC C1;
+ PutC C2;
+ PutC C3;
+ PutC C4;
+ PutC C5>>;
+
+Procedure TestNum X;
+ <<Msg5(Char T,Char Lower e,Char Lower s,Char lower t, Char '! );
+ PutC X;
+ PutC Char '! ;>>;
+
+Procedure TestErr X;
+ <<TestNum X;
+ Msg5(Char E, Char lower r,Char Lower r,Char '! , Char Eol)>>;
+
+Procedure TestOk X;
+ <<TestNum X;
+ Msg5(Char O, Char lower k,Char '! ,Char '! , Char Eol)>>;
+
+%%% Dynamic Field Extracts %%%%%
+
+Procedure MakeMask(N);
+ % Make a mask of N 1's
+ LSH(1,N)-1;
+
+Procedure Extract(Z,sbit,lfld);
+ % Dynamic Field Extract
+ Begin scalar m,s;
+ m:=MakeMask(Lfld);
+ s:=Sbit+Lfld-BitsPerWord;
+ Return LAnd(m,Lsh(Z,s));
+ end;
+
+
+End;
+
ADDED psl-1983/3-1/tests/foo.headers
Index: psl-1983/3-1/tests/foo.headers
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/foo.headers
@@ -0,0 +1,19 @@
+
+SYSLSP PROCEDURE CODEAPPLY(CODEPTR, ARGLIST); P-APPLY-LAP 53/1
+
+LAP '((!*ENTRY CODEEVALAPPLY EXPR 2) P-APPLY-LAP 206/2
+
+SYSLSP PROCEDURE CODEEVALAPPLYAUX(CODEPTR, ARGLIST, PP-APPLY-LAP 213/3
+
+SYSLSP PROCEDURE BINDEVAL(FORMALS, ARGS); P-APPLY-LAP 363/4
+
+SYSLSP PROCEDURE BINDEVALAUX(FORMALS, ARGS, N); P-APPLY-LAP 366/5
+
+SYSLSP PROCEDURE COMPILEDCALLINGINTERPRETEDAUX(); P-APPLY-LAP 381/6
+
+SYSLSP PROCEDURE FASTLAMBDAAPPLY(); P-APPLY-LAP 387/7
+
+SYSLSP PROCEDURE COMPILEDCALLINGINTERPRETEDAUXAUX FN;P-APPLY-LAP 391/8
+
+
+ 409 lines, 8 procedures found
ADDED psl-1983/3-1/tests/franz-750.tim
Index: psl-1983/3-1/tests/franz-750.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/franz-750.tim
@@ -0,0 +1,22 @@
+(
+("Franz Opus 38, Utah Cs VAX 750 " . " 20-Feb-82")
+(EmptyTest-10000 . 391)
+(GEmptyTest-10000 . 3451)
+(Cdr1Test-100 . 3740)
+(Cdr2Test-100 . 1309)
+(CddrTest-100 . 867)
+(ListOnlyCdrTest1 . 6953)
+(ListOnlyCddrTest1 . 9435)
+(ListOnlyCdrTest2 . 21556)
+(ListOnlyCddrTest2 . 24361)
+(ReverseTest-10 . 680)
+(MyReverse1Test-10 . 952)
+(MyReverse2Test-10 . 714)
+(LengthTest-100 . 5287)
+(ArithmeticTest-10000 . 7667)
+(EvalTest-10000 . 9486)
+(tak-18-12-6 . 1887)
+(gtak-18-12-6 . 18853)
+(gtsta-g0 . 14280) % Use GTSTB
+(gtsta-g1 . 24956) % GC
+)
ADDED psl-1983/3-1/tests/franz-780.tim
Index: psl-1983/3-1/tests/franz-780.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/franz-780.tim
@@ -0,0 +1,22 @@
+(
+("Franz Opus 37, Mars VAX 780 " . " 30-Mar-83")
+(EmptyTest-10000 . 230)
+(GEmptyTest-10000 . 2200)
+(Cdr1Test-100 . 2280)
+(Cdr2Test-100 . 910)
+(CddrTest-100 . 610)
+(ListOnlyCdrTest1 . 3420)
+(ListOnlyCddrTest1 . 6900)
+(ListOnlyCdrTest2 . 12150)
+(ListOnlyCddrTest2 . 15100)
+(ReverseTest-10 . 462)
+(MyReverse1Test-10 . 605)
+(MyReverse2Test-10 . 490)
+(LengthTest-100 . 3026)
+(ArithmeticTest-10000 . 4830)
+(EvalTest-10000 . 5510)
+(tak-18-12-6 . 1105)
+(gtak-18-12-6 . 11696)
+(gtsta-g0 . 13000) % Estimate from KIM
+(gtsta-g1 . 18000) % GC overflow
+)
ADDED psl-1983/3-1/tests/gc-test.red
Index: psl-1983/3-1/tests/gc-test.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/gc-test.red
@@ -0,0 +1,176 @@
+% GC-TEST.RED - Test of P-COMP-GC Marking primitives
+% M. L. Griss, 17 June 1983
+% MAcros extracted for file, P-COMP-GC.RED
+
+On Syslisp;
+
+internal WConst GCMarkValue = 8#777,
+ HSkip = Forward;
+
+CompileTime <<
+syslsp smacro procedure Mark X; % Get GC mark bits in item X points to
+ GCField @X;
+
+syslsp smacro procedure SetMark X; % Set GC mark bits in item X points to
+ GCField @X := GCMarkValue;
+
+syslsp smacro procedure ClearMark X; % Clear GC mark bits in item X points to
+ GCField @X := if NegIntP @X then -1 else 0;
+
+syslsp smacro procedure Marked X; % Is item pointed to by X marked?
+ Mark X eq GCMarkValue;
+
+syslsp smacro procedure MarkID X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := Forward;
+
+syslsp smacro procedure MarkedID X;
+ Tag SymNam X eq Forward;
+
+syslsp smacro procedure ClearIDMark X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := STR;
+
+
+% Relocation primitives
+
+syslsp smacro procedure SkipLength X; % Stored in heap header
+ Inf @X;
+
+syslsp smacro procedure PutSkipLength(X, L); % Store in heap header
+ Inf @X := L;
+
+put('SkipLength, 'Assign!-Op, 'PutSkipLength);
+>>;
+
+internal WConst BitsInSegment = 13,
+ SegmentLength = LShift(1, BitsInSegment),
+ SegmentMask = SegmentLength - 1;
+
+%/ External WArray GCArray;
+
+
+CompileTime <<
+syslsp smacro procedure SegmentNumber X; % Get segment part of pointer
+ LShift(X - HeapLowerBound, -BitsInSegment);
+
+syslsp smacro procedure OffsetInSegment X; % Get offset part of pointer
+ LAnd(X - HeapLowerBound, SegmentMask);
+
+syslsp smacro procedure MovementWithinSegment X; % Reloc field in item
+ GCField @X;
+
+syslsp smacro procedure PutMovementWithinSegment(X, M); % Store reloc field
+ GCField @X := M;
+
+syslsp smacro procedure ClearMovementWithinSegment X; % Clear reloc field
+ GCField @X := if NegIntP @X then -1 else 0;
+
+put('MovementWithinSegment, 'Assign!-Op, 'PutMovementWithinSegment);
+
+syslsp smacro procedure SegmentMovement X; % Segment table
+ GCArray[X];
+
+syslsp smacro procedure PutSegmentMovement(X, M); % Store in seg table
+ GCArray[X] := M;
+
+put('SegmentMovement, 'Assign!-Op, 'PutSegmentMovement);
+
+syslsp smacro procedure Reloc X; % Compute pointer adjustment
+ X - (SegmentMovement SegmentNumber X + MovementWithinSegment X);
+>>;
+
+syslsp procedure testmarking;
+ begin
+ Prin2T "---- Test GC MARK of various HEAP structures ----";
+ Prin2T " Examine each case carefully, see MARK go on and back off";
+ Test1Mark cons(1 , 2); % Build a fresh one
+ Test1Mark cons(- 1 , -2); % testing sign extend
+ Test1Mark cons('A, 'B);
+ Test1Mark '[0 1 2 3];
+ Test1Mark "01234";
+ TestIdmark 'A;
+ TestIdmark 'JUNK;
+ TestIdmark 'NIL;
+ Prin2T "---- Mark tests all done --- ";
+ End;
+
+syslsp procedure Test1Mark X;
+ Begin scalar P;
+ Prin2 ".... Object to mark: "; Print X;
+ P:=Inf X;
+ Prin2 " MARK field: "; Print Mark P;
+ Prin2 " MARKED should be NIL: "; Print Marked P;
+ PrintBits @P;
+ Prin2 " .. SETMARK : "; Print SetMark P;
+ Prin2 " MARK field now: "; Print Mark P;
+ Prin2 " MARKED should be T: "; Print Marked P;
+ PrintBits @P;
+ Prin2 " .. CLEARMARK: "; Print ClearMark P;
+ Prin2 " MARK field finally: "; Print Mark P;
+ Prin2 " MARKED should be NIL: "; Print Marked P;
+ PrintBits @P;
+ Prin2 " .. Object again legal: "; Print X;
+ End;
+
+syslsp procedure TestIDMark X;
+ Begin scalar P;
+ Prin2 ".... ID to mark: "; Print X;
+ P:=IDInf X;
+ Prin2 " MARKEDID should be NIL: "; Print MARKEDID P;
+ PrintBits SYMNAM P;
+ Prin2 " .. MARKID : "; Print MarkId P;
+ Prin2 " MARKEDID should be T: "; Print MARKEDID P;
+ PrintBits SYMNAM P;
+ Prin2 " .. CLEARIDMARK: "; Print Clearidmark P;
+ Prin2 " MARKEDID should be NIL: "; Print MARKEDID P;
+ PrintBits SYMNAM P;
+ Prin2 " .. ID again legal: "; Print X;
+ End;
+
+syslsp procedure PrintBits x;
+ <<Prin2 " BitPattern: ";
+ Prin2 Tag x;
+ Prin2 ": ";
+ Prin2 Inf x;
+ Terpri();
+ >>;
+off syslisp;
+
+procedure GCTEST;
+Begin scalar X,N,M;
+ Prin2T "---- GTEST series -----";
+ Prin2T ".... Try individual Types first ...";
+ Prin2 " Reclaim called: "; Reclaim();
+ Prin2 " .. Allocate a PAIR: "; Print (x:=cons(1,2));
+ Prin2 " Reclaim called: "; Reclaim();
+ Prin2 " .. Release the PAIR: "; Print (X:=NIL);
+
+ Prin2 " Reclaim called: "; Reclaim();
+
+ Prin2 " .. Allocate a VECTOR: "; Print (x:=Mkvect(4));
+ Prin2 " Reclaim called: "; Reclaim();
+ Prin2 " .. Release the VECTOR: "; Print (X:=NIL);
+
+ Prin2 " Reclaim called: "; Reclaim();
+
+ Prin2 " .. Allocate a STRING: "; Print (x:=Mkstring(5,65));
+ Prin2 " Reclaim called: "; Reclaim();
+ Prin2 " .. Release the STRING: "; Print (X:=NIL);
+
+ Prin2 " Reclaim called: "; Reclaim();
+ M:=2;
+ Prin2 ".... Loop until RECLAIM automatically called :";
+ Prin2 M; Prin2t " times";
+ N:=GCknt!*+M;
+ Prin2T " .. Loop on PAIRs: ";
+ While GCKnt!* <=N do list(1,2,3,4,5,6,7,8,9,10);
+ N:=GCknt!*+M;
+ Prin2T " .. Loop on VECTORs: ";
+ While GCknt!* <=N do MkVect 5;
+ N:=GCknt!*+M;
+ Prin2T " .. Loop on STRINGs: ";
+ While GCKnt!* <=N do Mkstring(20,65);
+End;
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/init8
Index: psl-1983/3-1/tests/init8
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/init8
@@ -0,0 +1,11 @@
+(de mkquote(x) (list 'quote x))
+(de flag(x y) NIL)
+(prin2t "sub2.init")(lapin "sub2.init")
+(prin2t "sub3.init")(lapin "sub3.init")
+(prin2t "sub4.init")(lapin "sub4.init")
+(prin2t "sub5a.init")(lapin "sub5a.init")
+(prin2t "sub5b.init")(lapin "sub5b.init")
+(prin2t "sub6.init")(lapin "sub6.init")
+(prin2t "sub7.init")(lapin "sub7.init")
+(prin2t "sub8.init")(lapin "sub8.init")
+(prin2t "main8.init")(lapin "main8.init")
ADDED psl-1983/3-1/tests/init9
Index: psl-1983/3-1/tests/init9
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/init9
@@ -0,0 +1,10 @@
+(prin2t "sub2.init")(lapin "sub2.init")
+(prin2t "sub3.init")(lapin "sub3.init")
+(prin2t "sub4.init")(lapin "sub4.init")
+(prin2t "sub5a.init")(lapin "sub5a.init")
+(prin2t "sub5b.init")(lapin "sub5b.init")
+(prin2t "sub6.init")(lapin "sub6.init")
+(prin2t "sub7.init")(lapin "sub7.init")
+(prin2t "sub8.init")(lapin "sub8.init")
+(prin2t "sub9.init")(lapin "sub9.init")
+(prin2t "main9.init")(lapin "main9.init")
ADDED psl-1983/3-1/tests/interlisp.tim
Index: psl-1983/3-1/tests/interlisp.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/interlisp.tim
@@ -0,0 +1,194 @@
+15-Apr-83 17:10:22-MST,2596;000000000001
+Return-path: <marti@rand-unix>
+Received: from RAND-UNIX by UTAH-20; Fri 15 Apr 83 17:10:03-MST
+Date: Friday, 15 Apr 1983 16:02-PST
+To: Masinter at PARC-MAXC, hearn at RAND-RELAY, griss at UTAH-20,
+ kessler at UTAH-20
+Cc: marti at rand-unix, henry at rand-unix
+Subject: New Dolphin timinings.
+From: marti at rand-unix
+
+Larry Masinter at Xerox as kindly suggested a number of changes in the
+Griss timing suite which resulted in the tests running more than 1.4
+times faster than previously. Significant speedups resulted from the
+use of NLISTP rather than ATOM, and APPLY* rather than APPLY. This
+brings the Dolphin to not quite 1/4 the speed of the Rand Vax 780
+running PSL 3.1c.
+
+The following are timings for the Griss test suite under various
+conditions. All times are in milliseconds.
+
+
+
+Machine: Dolphin, 1.5 megabytes, InterLisp-D
+
+
+ Block Standard Improved
+
+
+EmptyTest 10000 360 360 360
+SlowEmptyTest 10000 360 360 361
+Cdr1Test 100 6497 6497 3884*
+Cdr2Test 100 2919 2919 2917
+CddrTest 100 2411 2410 2404
+ListOnlyCdrTest1 20525 20519 20524
+ListOnlyCddrTest1 31736 31733 31713
+ListOnlyCdrTest2 38786 38778 26295*
+ListOnlyCddrTest2 49978 49949 37489*
+ReverseTest 10 4095 6360 6465
+MyReverse1Test 10 5087 5405 5023
+MyReverse2Test 10 4417 5390 5493
+LengthTest 100 8570 8568 8562
+ArithmeticTest 10000 12759 14542 14228
+EvalTest 10000 15782 15837 15491
+tak 18 12 6 4817 4817 4814
+gtak 18 12 6 4737 4737 4729
+gtsta g0 79000 80874 26708+
+gtsta g1 93854 94149 40291+
+MKVECT 1000 52630 51850 51047
+GETV 10000 432 432 431
+PUTV 10000 3807 3808 3807
+
+Total: 443559 450294 313036
+
+Block Compilation: Used (bcompl ...) on standard test file with
+ declarations of local variables and block apply.
+Standard Compilation: Used (tcompl ...) on standard test file.
+Improved: * means use of NLISTP rather than ATOM. + means use of
+ APPLY* rather than APPLY.
+
+
+Machine: VAX 11/780, 4 megabytes, PSL V3.1c
+
+
+
+EmptyTest 10000 34
+SlowEmptyTest 10000 646
+Cdr1Test 100 1649
+Cdr2Test 100 1173
+CddrTest 100 1003
+ListOnlyCdrTest1 7174
+ListOnlyCddrTest1 12869
+ListOnlyCdrTest2 9622
+ListOnlyCddrTest2 15878
+ReverseTest 10 680
+MyReverse1Test 10 612
+MyReverse2Test 10 697
+LengthTest 100 1615
+ArithmeticTest 10000 850
+EvalTest 10000 5967
+tak 18 12 6 714
+gtak 18 12 6 4165
+gtsta g0 2244
+gtsta g1 2397
+MKVECT 1000 119
+GETV 10000 425
+PUTV 10000 442
+
+Total 70975
+24-Apr-83 14:13:22-MDT,3391;000000000001
+Return-path: <Masinter.PA@PARC-MAXC>
+Received: from PARC-MAXC by UTAH-20; Sun 24 Apr 83 14:10:12-MDT
+Date: 24 Apr 83 13:08:50 PDT (Sunday)
+From: Masinter.PA@PARC-MAXC.ARPA
+Subject: Re: New Dolphin timinings.
+In-reply-to: marti's message of Fri, 15 Apr 83 16:02 PST
+To: marti@rand-unix.ARPA
+cc: Masinter.PA@PARC-MAXC.ARPA, hearn@RAND-RELAY.ARPA,
+ griss@UTAH-20.ARPA, kessler@UTAH-20.ARPA, henry@rand-unix.ARPA
+
+I haven't had a lot of time to spend on this, and I am going to be out
+of town for the next two weeks. I will comment on your revised figures,
+and hope that I can get through. To summarize: Averaging the figures for
+a set of simple benchmarks is nonsense. If you are planning to write a
+summary of performance of Lisp systems, I suggest you read the paper
+Dick Gabriel and I put together for the last Lisp conference, and then
+attempt to measure some of the more important dimensions at the various
+levels to get an accurate picture of total system performance. You
+should be careful (by analyzing the compiled code of your benchmarks) to
+use examples that scale appropriately. Thus, the series of CDR1TEST and
+CDDRTEST is incomplete until you complete the suite with enough
+instances to exceed the available register space.
+
+Finally, at the very least, you should report a range of performance
+data, rather than an average, since averages depend so heavily on the
+weighting you give to each end of the range. You should also be careful
+to identify the version number of the software and the date when you ran
+the test.
+
+Some minor additional comments about the nature of the "Griss suite":
+
+The "Arithmetic Test" is configured such that it operates in the range
+which is outside of the "small number range" of Interlisp-D (+/- 2^16)
+but still inside the "small number range" of PSL on the VAX and 9836
+(+/- 2^31, no?). Ether larger or smaller would have given figures which
+were more comperable.
+
+On storage allocation: Interlisp-D has two kinds of allocation, of
+"fixed size" blocks (i.e., DATATYPES which you declare) and of "variable
+size" blocks. While ARRAY is the allocator for variable sized blocks,
+you create the fixed size ones with "create". Thus, one 'might'
+translate MKVECT and PUTV for some applications into the equivalents of
+(create DATATYPE) and (fetch FIELD --) and (replace FIELD --). I think
+you will get dramaticly different results if you use those instead.
+
+Is the "reverse" in REVERSETEST handcoded? Why is ReverseTest slower on
+the VAX/PSL than MyReverse?
+
+In Interlisp-D, you cannot "turn off" the overhead for the reference
+count GC: every operation, including CONS, does reference counting.
+There is in addition some time associated with "RECLAIM" which is the
+time to thread items onto the free list. However, we've found for most
+serious programs which have resident large address space data (e.g., AI
+systems which might have a "knowledge base" or a set of theorems or some
+reformulation rules rather than simple benchmarks) that it was important
+that GC time be proportional to the amount of garbage rather than the
+size of the address space. Several of the benchmarks you quote do
+significant amounts of CONSing however, do not include GC time. Of
+course, GC time can be highly variable under most GC algorithms because
+it is proportional to the size of the address space.
+
+Larry
+26-Apr-83 20:58:56-MDT,1436;000000000001
+Return-path: <@UTAH-CS:GRISS@HP-HULK>
+Received: from UTAH-CS by UTAH-20; Tue 26 Apr 83 20:58:35-MDT
+Date: 25 Apr 1983 2005-PDT
+From: GRISS@HP-HULK
+Subject: Marti's latest
+Message-Id: <420175670.20672.hplabs@HP-VENUS>
+Received: by HP-VENUS via CHAOSNET; 25 Apr 1983 20:27:49-PDT
+Received: by UTAH-CS.ARPA (3.320.6/3.7.8)
+ id AA03294; 26 Apr 83 20:53:59 MDT (Tue)
+To: kessler@HP-VENUS, griss@HP-VENUS
+
+NIL
+
+RATIO FASTDOLPHIN STD20
+EMPTYTEST-10000 20.000
+GEMPTYTEST-10000 1.286
+CDR1TEST-100 7.398
+CDR2TEST-100 7.847
+CDDRTEST-100 8.799
+LISTONLYCDRTEST1 11.531
+LISTONLYCDDRTEST1 9.356
+LISTONLYCDRTEST2 9.664
+LISTONLYCDDRTEST2 9.113
+REVERSETEST-10 15.453
+MYREVERSE1TEST-10 18.813
+MYREVERSE2TEST-10 17.955
+LENGTHTEST-100 15.088
+ARITHMETICTEST-10000 21.516
+EVALTEST-10000 8.224
+TAK-18-12-6 9.771
+GTAK-18-12-6 2.398
+GTSTA-G0 36.437
+GTSTA-G1 50.427
+NIL
+(TOTAL (RATIO FASTDOLPHIN STD20)):
+ Tot 281.075, avg 14.793, dev 11.423 , 19.000 tests
+NIL
+
+As you see, variation tremendous.
+-------
+
+
ADDED psl-1983/3-1/tests/io-data.red
Index: psl-1983/3-1/tests/io-data.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/io-data.red
@@ -0,0 +1,168 @@
+%
+% IO-DATA.RED - Data structures used by input and output
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 21 September 1981
+% Copyright (c) 1981 Eric Benson
+%
+
+on SysLisp;
+WConst ChannelClosed = 0,
+ ChannelOpenRead = 1,
+ ChannelOpenWrite = 2,
+ ChannelOpenSpecial = 3;
+
+internal WConst MaxTokenSize = 5000;
+
+exported WString TokenBuffer[MaxTokenSize];
+
+exported WConst MaxChannels = 31;
+
+exported WArray ReadFunction = ['TerminalInputHandler,
+ 'WriteOnlyChannel,
+ 'WriteOnlyChannel,
+ 'CompressReadChar,
+ 'WriteOnlyChannel,
+ 'WriteOnlyChannel,
+ 'WriteOnlyChannel,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ WriteFunction = ['ReadOnlyChannel,
+ 'IndependentWriteChar,
+ 'ToStringWriteChar,
+ 'ExplodeWriteChar,
+ 'FlatSizeWriteChar,
+ 'IndependentWriteChar,
+ 'IndependentWriteChar,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ CloseFunction = ['IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'IllegalStandardChannelClose,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen,
+ 'ChannelNotOpen],
+ UnReadBuffer[MaxChannels],
+ LinePosition[MaxChannels],
+ MaxLine = [0, 80,80, 10000, 10000,
+ 80, 80, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+ ChannelStatus = [ChannelOpenRead,
+ ChannelOpenWrite,
+ ChannelOpenSpecial,
+ ChannelOpenSpecial,
+ ChannelOpenSpecial,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed,
+ ChannelClosed],
+ MaxBuffer [MaxChannels],
+ ChannelTable [MaxChannels],
+ NextPosition [MaxChannels],
+ BufferLength [MaxChannels];
+
+off SysLisp;
+
+
+global '(!$EOL!$);
+LoadTime(!$EOL!$ := '!
+);
+
+END;
ADDED psl-1983/3-1/tests/irewrite.sl
Index: psl-1983/3-1/tests/irewrite.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/irewrite.sl
@@ -0,0 +1,582 @@
+
+% {DSK}IREWRITE.PSL;2 6-JAN-83 10:08:06
+(FLUID '(unify-subst))
+(FLAG '(
+ADD-LEMMA
+ADD-LEMMA-LST
+Apply-subst
+Apply-subst-lst
+false
+one-way-unify
+one-way-unify1
+one-way-unify1-lst
+ptime
+rewrite
+rewrite-with-lemmas
+tautologyP
+tautp
+trans-of-implies
+trans-of-implies1
+truep
+
+) 'InternalFunction)
+
+
+(DE ADD-LEMMA (TERM)
+(COND ((AND (NOT (ATOM TERM))
+ (EQ (CAR TERM)
+ 'EQUAL)
+ (NOT (ATOM (CADR TERM))))
+ (PUT (CAR (CADR TERM))
+ 'LEMMAS
+ (CONS TERM (GET (CAR (CADR TERM))
+ 'LEMMAS))))
+ (T (ERROR 0 (LIST 'ADD-LEMMA-DID-NOT-LIKE-TERM
+ TERM)))))
+
+
+(DE ADD-LEMMA-LST (LST)
+(COND ((NULL LST)
+ T)
+ (T (ADD-LEMMA (CAR LST))
+ (ADD-LEMMA-LST (CDR LST)))))
+
+
+% lmm 7-JUN-81 10:07
+(DE APPLY-SUBST (ALIST TERM)
+(COND ((NOT (PAIRP TERM))
+ ((LAMBDA (TEM)
+ (COND
+ (TEM (CDR TEM))
+ (T TERM)))
+ (ASSOC TERM ALIST)))
+ (T (CONS (CAR TERM)
+ (MAPCAR (CDR TERM)
+ (FUNCTION (LAMBDA (X)
+ (APPLY-SUBST ALIST X))))))))
+
+
+(DE APPLY-SUBST-LST (ALIST LST)
+(COND ((NULL LST)
+ NIL)
+ (T (CONS (APPLY-SUBST ALIST (CAR LST))
+ (APPLY-SUBST-LST ALIST (CDR LST))))))
+
+
+(DE FALSEP (X LST)
+(OR (EQUAL X '(F))
+ (MEMBER X LST)))
+
+
+(DE ONE-WAY-UNIFY (TERM1 TERM2)
+(PROGN (SETQ UNIFY-SUBST NIL)
+ (ONE-WAY-UNIFY1 TERM1 TERM2)))
+
+
+% lmm 7-JUN-81 09:47
+(DE ONE-WAY-UNIFY1 (TERM1 TERM2)
+(COND ((NOT (PAIRP TERM2))
+ ((LAMBDA (TEM)
+ (COND
+ (TEM (EQUAL TERM1 (CDR TEM)))
+ (T (SETQ UNIFY-SUBST (CONS (CONS TERM2 TERM1)
+ UNIFY-SUBST))
+ T)))
+ (ASSOC TERM2 UNIFY-SUBST)))
+ ((NOT (PAIRP TERM1))
+ NIL)
+ ((EQ (CAR TERM1)
+ (CAR TERM2))
+ (ONE-WAY-UNIFY1-LST (CDR TERM1)
+ (CDR TERM2)))
+ (T NIL)))
+
+
+(DE ONE-WAY-UNIFY1-LST (LST1 LST2)
+(COND ((NULL LST1)
+ T)
+ ((ONE-WAY-UNIFY1 (CAR LST1)
+ (CAR LST2))
+ (ONE-WAY-UNIFY1-LST (CDR LST1)
+ (CDR LST2)))
+ (T NIL)))
+
+
+(DE PTIME NIL
+(PROG (GCTM)
+ (SETQ GCTM 0)
+ (RETURN (CONS (time)
+ GCTM))))
+
+
+% lmm 7-JUN-81 10:04
+(DE REWRITE (TERM)
+(COND ((NOT (PAIRP TERM))
+ TERM)
+ (T (REWRITE-WITH-LEMMAS (CONS (CAR TERM)
+ (MAPCAR (CDR TERM)
+ (FUNCTION REWRITE)))
+ (GET (CAR TERM)
+ 'LEMMAS)))))
+
+
+(DE REWRITE-WITH-LEMMAS (TERM LST)
+(COND ((NULL LST)
+ TERM)
+ ((ONE-WAY-UNIFY TERM (CADR (CAR LST)))
+ (REWRITE (APPLY-SUBST UNIFY-SUBST (CADDR (CAR LST)))))
+ (T (REWRITE-WITH-LEMMAS TERM (CDR LST)))))
+
+
+(DE SETUP NIL
+(ADD-LEMMA-LST
+ '((EQUAL (COMPILE FORM)
+ (REVERSE (CODEGEN (OPTIMIZE FORM)
+ (NIL))))
+ (EQUAL (EQP X Y)
+ (EQUAL (FIX X)
+ (FIX Y)))
+ (EQUAL (GREATERP X Y)
+ (LESSP Y X))
+ (EQUAL (LESSEQP X Y)
+ (NOT (LESSP Y X)))
+ (EQUAL (GREATEREQP X Y)
+ (NOT (LESSP X Y)))
+ (EQUAL (BOOLEAN X)
+ (OR (EQUAL X (T))
+ (EQUAL X (F))))
+ (EQUAL (IFF X Y)
+ (AND (IMPLIES X Y)
+ (IMPLIES Y X)))
+ (EQUAL (EVEN1 X)
+ (IF (ZEROP X)
+ (T)
+ (ODD (SUB1 X))))
+ (EQUAL (COUNTPS- L PRED)
+ (COUNTPS-LOOP L PRED (ZERO)))
+ (EQUAL (FACT- I)
+ (FACT-LOOP I 1))
+ (EQUAL (REVERSE- X)
+ (REVERSE-LOOP X (NIL)))
+ (EQUAL (DIVIDES X Y)
+ (ZEROP (REMAINDER Y X)))
+ (EQUAL (ASSUME-TRUE VAR ALIST)
+ (CONS (CONS VAR (T))
+ ALIST))
+ (EQUAL (ASSUME-FALSE VAR ALIST)
+ (CONS (CONS VAR (F))
+ ALIST))
+ (EQUAL (TAUTOLOGY-CHECKER X)
+ (TAUTOLOGYP (NORMALIZE X)
+ (NIL)))
+ (EQUAL (FALSIFY X)
+ (FALSIFY1 (NORMALIZE X)
+ (NIL)))
+ (EQUAL (PRIME X)
+ (AND (NOT (ZEROP X))
+ (NOT (EQUAL X (ADD1 (ZERO))))
+ (PRIME1 X (SUB1 X))))
+ (EQUAL (AND P Q)
+ (IF P (IF Q (T)
+ (F))
+ (F)))
+ (EQUAL (OR P Q)
+ (IF P (T)
+ (IF Q (T)
+ (F))
+ (F)))
+ (EQUAL (NOT P)
+ (IF P (F)
+ (T)))
+ (EQUAL (IMPLIES P Q)
+ (IF P (IF Q (T)
+ (F))
+ (T)))
+ (EQUAL (FIX X)
+ (IF (NUMBERP X)
+ X
+ (ZERO)))
+ (EQUAL (IF (IF A B C)
+ D E)
+ (IF A (IF B D E)
+ (IF C D E)))
+ (EQUAL (ZEROP X)
+ (OR (EQUAL X (ZERO))
+ (NOT (NUMBERP X))))
+ (EQUAL (PLUS (PLUS X Y)
+ Z)
+ (PLUS X (PLUS Y Z)))
+ (EQUAL (EQUAL (PLUS A B)
+ (ZERO))
+ (AND (ZEROP A)
+ (ZEROP B)))
+ (EQUAL (DIFFERENCE X X)
+ (ZERO))
+ (EQUAL (EQUAL (PLUS A B)
+ (PLUS A C))
+ (EQUAL (FIX B)
+ (FIX C)))
+ (EQUAL (EQUAL (ZERO)
+ (DIFFERENCE X Y))
+ (NOT (LESSP Y X)))
+ (EQUAL (EQUAL X (DIFFERENCE X Y))
+ (AND (NUMBERP X)
+ (OR (EQUAL X (ZERO))
+ (ZEROP Y))))
+ (EQUAL (MEANING (PLUS-TREE (APPEND X Y))
+ A)
+ (PLUS (MEANING (PLUS-TREE X)
+ A)
+ (MEANING (PLUS-TREE Y)
+ A)))
+ (EQUAL (MEANING (PLUS-TREE (PLUS-FRINGE X))
+ A)
+ (FIX (MEANING X A)))
+ (EQUAL (APPEND (APPEND X Y)
+ Z)
+ (APPEND X (APPEND Y Z)))
+ (EQUAL (REVERSE (APPEND A B))
+ (APPEND (REVERSE B)
+ (REVERSE A)))
+ (EQUAL (TIMES X (PLUS Y Z))
+ (PLUS (TIMES X Y)
+ (TIMES X Z)))
+ (EQUAL (TIMES (TIMES X Y)
+ Z)
+ (TIMES X (TIMES Y Z)))
+ (EQUAL (EQUAL (TIMES X Y)
+ (ZERO))
+ (OR (ZEROP X)
+ (ZEROP Y)))
+ (EQUAL (EXEC (APPEND X Y)
+ PDS ENVRN)
+ (EXEC Y (EXEC X PDS ENVRN)
+ ENVRN))
+ (EQUAL (MC-FLATTEN X Y)
+ (APPEND (FLATTEN X)
+ Y))
+ (EQUAL (MEMBER X (APPEND A B))
+ (OR (MEMBER X A)
+ (MEMBER X B)))
+ (EQUAL (MEMBER X (REVERSE Y))
+ (MEMBER X Y))
+ (EQUAL (LENGTH (REVERSE X))
+ (LENGTH X))
+ (EQUAL (MEMBER A (INTERSECT B C))
+ (AND (MEMBER A B)
+ (MEMBER A C)))
+ (EQUAL (NTH (ZERO)
+ I)
+ (ZERO))
+ (EQUAL (EXP I (PLUS J K))
+ (TIMES (EXP I J)
+ (EXP I K)))
+ (EQUAL (EXP I (TIMES J K))
+ (EXP (EXP I J)
+ K))
+ (EQUAL (REVERSE-LOOP X Y)
+ (APPEND (REVERSE X)
+ Y))
+ (EQUAL (REVERSE-LOOP X (NIL))
+ (REVERSE X))
+ (EQUAL (COUNT-LIST Z (SORT-LP X Y))
+ (PLUS (COUNT-LIST Z X)
+ (COUNT-LIST Z Y)))
+ (EQUAL (EQUAL (APPEND A B)
+ (APPEND A C))
+ (EQUAL B C))
+ (EQUAL (PLUS (REMAINDER X Y)
+ (TIMES Y (QUOTIENT X Y)))
+ (FIX X))
+ (EQUAL (POWER-EVAL (BIG-PLUS1 L I BASE)
+ BASE)
+ (PLUS (POWER-EVAL L BASE)
+ I))
+ (EQUAL (POWER-EVAL (BIG-PLUS X Y I BASE)
+ BASE)
+ (PLUS I (PLUS (POWER-EVAL X BASE)
+ (POWER-EVAL Y BASE))))
+ (EQUAL (REMAINDER Y 1)
+ (ZERO))
+ (EQUAL (LESSP (REMAINDER X Y)
+ Y)
+ (NOT (ZEROP Y)))
+ (EQUAL (REMAINDER X X)
+ (ZERO))
+ (EQUAL (LESSP (QUOTIENT I J)
+ I)
+ (AND (NOT (ZEROP I))
+ (OR (ZEROP J)
+ (NOT (EQUAL J 1)))))
+ (EQUAL (LESSP (REMAINDER X Y)
+ X)
+ (AND (NOT (ZEROP Y))
+ (NOT (ZEROP X))
+ (NOT (LESSP X Y))))
+ (EQUAL (POWER-EVAL (POWER-REP I BASE)
+ BASE)
+ (FIX I))
+ (EQUAL (POWER-EVAL (BIG-PLUS (POWER-REP I BASE)
+ (POWER-REP J BASE)
+ (ZERO)
+ BASE)
+ BASE)
+ (PLUS I J))
+ (EQUAL (GCD X Y)
+ (GCD Y X))
+ (EQUAL (NTH (APPEND A B)
+ I)
+ (APPEND (NTH A I)
+ (NTH B (DIFFERENCE I (LENGTH A)))))
+ (EQUAL (DIFFERENCE (PLUS X Y)
+ X)
+ (FIX Y))
+ (EQUAL (DIFFERENCE (PLUS Y X)
+ X)
+ (FIX Y))
+ (EQUAL (DIFFERENCE (PLUS X Y)
+ (PLUS X Z))
+ (DIFFERENCE Y Z))
+ (EQUAL (TIMES X (DIFFERENCE C W))
+ (DIFFERENCE (TIMES C X)
+ (TIMES W X)))
+ (EQUAL (REMAINDER (TIMES X Z)
+ Z)
+ (ZERO))
+ (EQUAL (DIFFERENCE (PLUS B (PLUS A C))
+ A)
+ (PLUS B C))
+ (EQUAL (DIFFERENCE (ADD1 (PLUS Y Z))
+ Z)
+ (ADD1 Y))
+ (EQUAL (LESSP (PLUS X Y)
+ (PLUS X Z))
+ (LESSP Y Z))
+ (EQUAL (LESSP (TIMES X Z)
+ (TIMES Y Z))
+ (AND (NOT (ZEROP Z))
+ (LESSP X Y)))
+ (EQUAL (LESSP Y (PLUS X Y))
+ (NOT (ZEROP X)))
+ (EQUAL (GCD (TIMES X Z)
+ (TIMES Y Z))
+ (TIMES Z (GCD X Y)))
+ (EQUAL (VALUE (NORMALIZE X)
+ A)
+ (VALUE X A))
+ (EQUAL (EQUAL (FLATTEN X)
+ (CONS Y (NIL)))
+ (AND (NLISTP X)
+ (EQUAL X Y)))
+ (EQUAL (LISTP (GOPHER X))
+ (LISTP X))
+ (EQUAL (SAMEFRINGE X Y)
+ (EQUAL (FLATTEN X)
+ (FLATTEN Y)))
+ (EQUAL (EQUAL (GREATEST-FACTOR X Y)
+ (ZERO))
+ (AND (OR (ZEROP Y)
+ (EQUAL Y 1))
+ (EQUAL X (ZERO))))
+ (EQUAL (EQUAL (GREATEST-FACTOR X Y)
+ 1)
+ (EQUAL X 1))
+ (EQUAL (NUMBERP (GREATEST-FACTOR X Y))
+ (NOT (AND (OR (ZEROP Y)
+ (EQUAL Y 1))
+ (NOT (NUMBERP X)))))
+ (EQUAL (TIMES-LIST (APPEND X Y))
+ (TIMES (TIMES-LIST X)
+ (TIMES-LIST Y)))
+ (EQUAL (PRIME-LIST (APPEND X Y))
+ (AND (PRIME-LIST X)
+ (PRIME-LIST Y)))
+ (EQUAL (EQUAL Z (TIMES W Z))
+ (AND (NUMBERP Z)
+ (OR (EQUAL Z (ZERO))
+ (EQUAL W 1))))
+ (EQUAL (GREATEREQPR X Y)
+ (NOT (LESSP X Y)))
+ (EQUAL (EQUAL X (TIMES X Y))
+ (OR (EQUAL X (ZERO))
+ (AND (NUMBERP X)
+ (EQUAL Y 1))))
+ (EQUAL (REMAINDER (TIMES Y X)
+ Y)
+ (ZERO))
+ (EQUAL (EQUAL (TIMES A B)
+ 1)
+ (AND (NOT (EQUAL A (ZERO)))
+ (NOT (EQUAL B (ZERO)))
+ (NUMBERP A)
+ (NUMBERP B)
+ (EQUAL (SUB1 A)
+ (ZERO))
+ (EQUAL (SUB1 B)
+ (ZERO))))
+ (EQUAL (LESSP (LENGTH (DELETE X L))
+ (LENGTH L))
+ (MEMBER X L))
+ (EQUAL (SORT2 (DELETE X L))
+ (DELETE X (SORT2 L)))
+ (EQUAL (DSORT X)
+ (SORT2 X))
+ (EQUAL (LENGTH (CONS X1 (CONS X2 (CONS X3 (CONS X4
+ (CONS X5 (CONS X6 X7)))))))
+ (PLUS 6 (LENGTH X7)))
+ (EQUAL (DIFFERENCE (ADD1 (ADD1 X))
+ 2)
+ (FIX X))
+ (EQUAL (QUOTIENT (PLUS X (PLUS X Y))
+ 2)
+ (PLUS X (QUOTIENT Y 2)))
+ (EQUAL (SIGMA (ZERO)
+ I)
+ (QUOTIENT (TIMES I (ADD1 I))
+ 2))
+ (EQUAL (PLUS X (ADD1 Y))
+ (IF (NUMBERP Y)
+ (ADD1 (PLUS X Y))
+ (ADD1 X)))
+ (EQUAL (EQUAL (DIFFERENCE X Y)
+ (DIFFERENCE Z Y))
+ (IF (LESSP X Y)
+ (NOT (LESSP Y Z))
+ (IF (LESSP Z Y)
+ (NOT (LESSP Y X))
+ (EQUAL (FIX X)
+ (FIX Z)))))
+ (EQUAL (MEANING (PLUS-TREE (DELETE X Y))
+ A)
+ (IF (MEMBER X Y)
+ (DIFFERENCE (MEANING (PLUS-TREE Y)
+ A)
+ (MEANING X A))
+ (MEANING (PLUS-TREE Y)
+ A)))
+ (EQUAL (TIMES X (ADD1 Y))
+ (IF (NUMBERP Y)
+ (PLUS X (TIMES X Y))
+ (FIX X)))
+ (EQUAL (NTH (NIL)
+ I)
+ (IF (ZEROP I)
+ (NIL)
+ (ZERO)))
+ (EQUAL (LAST (APPEND A B))
+ (IF (LISTP B)
+ (LAST B)
+ (IF (LISTP A)
+ (CONS (CAR (LAST A))
+ B)
+ B)))
+ (EQUAL (EQUAL (LESSP X Y)
+ Z)
+ (IF (LESSP X Y)
+ (EQUAL T Z)
+ (EQUAL F Z)))
+ (EQUAL (ASSIGNMENT X (APPEND A B))
+ (IF (ASSIGNEDP X A)
+ (ASSIGNMENT X A)
+ (ASSIGNMENT X B)))
+ (EQUAL (CAR (GOPHER X))
+ (IF (LISTP X)
+ (CAR (FLATTEN X))
+ (ZERO)))
+ (EQUAL (FLATTEN (CDR (GOPHER X)))
+ (IF (LISTP X)
+ (CDR (FLATTEN X))
+ (CONS (ZERO)
+ (NIL))))
+ (EQUAL (QUOTIENT (TIMES Y X)
+ Y)
+ (IF (ZEROP Y)
+ (ZERO)
+ (FIX X)))
+ (EQUAL (GET J (SET I VAL MEM))
+ (IF (EQP J I)
+ VAL
+ (GET J MEM))))))
+
+
+% lmm 7-JUN-81 09:44
+(DE TAUTOLOGYP (X TRUE-LST FALSE-LST)
+(COND ((TRUEP X TRUE-LST)
+ T)
+ ((FALSEP X FALSE-LST)
+ NIL)
+ ((NOT (PAIRP X))
+ NIL)
+ ((EQ (CAR X)
+ 'IF)
+ (COND ((TRUEP (CADR X)
+ TRUE-LST)
+ (TAUTOLOGYP (CADDR X)
+ TRUE-LST FALSE-LST))
+ ((FALSEP (CADR X)
+ FALSE-LST)
+ (TAUTOLOGYP (CADDDR X)
+ TRUE-LST FALSE-LST))
+ (T (AND (TAUTOLOGYP (CADDR X)
+ (CONS (CADR X)
+ TRUE-LST)
+ FALSE-LST)
+ (TAUTOLOGYP (CADDDR X)
+ TRUE-LST
+ (CONS (CADR X)
+ FALSE-LST))))))
+ (T NIL)))
+
+
+(DE TAUTP (X)
+(TAUTOLOGYP (REWRITE X)
+ NIL NIL))
+
+
+(DE TEST NIL
+(PROG (TM1 TM2 ANS TERM)
+ (SETQ TM1 (PTIME))
+ (SETQ TERM (APPLY-SUBST '((X F (PLUS (PLUS A B)
+ (PLUS C (ZERO))))
+ (Y F (TIMES (TIMES A B)
+ (PLUS C D)))
+ (Z F (REVERSE (APPEND (APPEND A B)
+ (NIL))))
+ (U EQUAL (PLUS A B)
+ (DIFFERENCE X Y))
+ (W LESSP (REMAINDER A B)
+ (MEMBER A (LENGTH B))))
+ '(IMPLIES (AND (IMPLIES X Y)
+ (AND (IMPLIES Y Z)
+ (AND (IMPLIES Z U)
+ (IMPLIES U W))))
+ (IMPLIES X W))))
+ (SETQ ANS (TAUTP TERM))
+ (SETQ TM2 (PTIME))
+ (RETURN (LIST ANS (DIFFERENCE (CAR TM2)
+ (CAR TM1))
+ (DIFFERENCE (CDR TM2)
+ (CDR TM1))))))
+
+
+(DE TRANS-OF-IMPLIES (N)
+(LIST 'IMPLIES
+ (TRANS-OF-IMPLIES1 N)
+ (LIST 'IMPLIES
+ 0 N)))
+
+
+(DE TRANS-OF-IMPLIES1 (N)
+(COND ((EQUAL N 1)
+ (LIST 'IMPLIES
+ 0 1))
+ (T (LIST 'AND
+ (LIST 'IMPLIES
+ (SUB1 N)
+ N)
+ (TRANS-OF-IMPLIES1 (SUB1 N))))))
+
+
+(DE TRUEP (X LST)
+(OR (EQUAL X '(T))
+ (MEMBER X LST)))
ADDED psl-1983/3-1/tests/laptest-alm.lap
Index: psl-1983/3-1/tests/laptest-alm.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/laptest-alm.lap
@@ -0,0 +1,77 @@
+(LAP '(
+(*ENTRY FOO1 EXPR 1)
+(*ALLOC 0)
+(*EXIT 0)
+))
+(LAP '(
+(*ENTRY FOO2 EXPR 1)
+(*ALLOC 0)
+(*MOVE (QUOTE 1) (REG 1))
+(*EXIT 0)
+))
+(LAP '(
+(*ENTRY FOO3 EXPR 1)
+(*ALLOC 0)
+(*MOVE (QUOTE 3) (REG 2))
+(*LINKE 0 PLUS2 EXPR 2)
+))
+(LAP '(
+(*ENTRY FOO4 EXPR 1)
+(*ALLOC 0)
+(*MOVE (QUOTE 4) (REG 2))
+(*LINK PLUS2 EXPR 2)
+(*LINKE 0 PRINT EXPR 1)
+))
+(LAP '(
+(*ENTRY FOO5 EXPR 1)
+(*ALLOC 0)
+(*JUMPNOTEQ (LABEL G0004) (REG 1) (QUOTE 1))
+(*MOVE (QUOTE ONE) (REG 1))
+(*EXIT 0)
+(*LBL (LABEL G0004))
+(*MOVE (QUOTE NOT-ONE) (REG 1))
+(*EXIT 0)
+))
+(FLUID (QUOTE (FLU1 FLU2)))
+(LAP '(
+(*ENTRY FOO6A EXPR 2)
+(*ALLOC 0)
+(*LAMBIND (REGISTERS (REG 2) (REG 1)) (NONLOCALVARS ($FLUID FLU2) ($FLUID FLU1))
+)
+(*MOVE ($FLUID FLU2) (REG 3))
+(*MOVE ($FLUID FLU1) (REG 2))
+(*MOVE (QUOTE BEFORE) (REG 1))
+(*LINK LIST3 EXPR 3)
+(*LINK PRINT EXPR 1)
+(*MOVE (QUOTE 10) ($FLUID FLU1))
+(*MOVE (QUOTE 20) ($FLUID FLU2))
+(*MOVE ($FLUID FLU2) (REG 3))
+(*MOVE ($FLUID FLU1) (REG 2))
+(*MOVE (QUOTE AFTER) (REG 1))
+(*LINK LIST3 EXPR 3)
+(*LINK PRINT EXPR 1)
+(*MOVE (QUOTE NIL) (REG 1))
+(*FREERSTR (NONLOCALVARS ($FLUID FLU2) ($FLUID FLU1)))
+(*EXIT 0)
+))
+(LAP '(
+(*ENTRY FOO6 EXPR 0)
+(*ALLOC 0)
+(*MOVE (QUOTE 1) ($FLUID FLU1))
+(*MOVE (QUOTE 2) ($FLUID FLU2))
+(*MOVE ($FLUID FLU2) (REG 3))
+(*MOVE ($FLUID FLU1) (REG 2))
+(*MOVE (QUOTE BEFORE) (REG 1))
+(*LINK LIST3 EXPR 3)
+(*LINK PRINT EXPR 1)
+(*MOVE (QUOTE B) (REG 2))
+(*MOVE (QUOTE A) (REG 1))
+(*LINK FOO6A EXPR 2)
+(*MOVE ($FLUID FLU2) (REG 3))
+(*MOVE ($FLUID FLU1) (REG 2))
+(*MOVE (QUOTE AFTER) (REG 1))
+(*LINK LIST3 EXPR 3)
+(*LINK PRINT EXPR 1)
+(*MOVE (QUOTE NIL) (REG 1))
+(*EXIT 0)
+))
ADDED psl-1983/3-1/tests/laptest-tlm-20.lap
Index: psl-1983/3-1/tests/laptest-tlm-20.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/laptest-tlm-20.lap
@@ -0,0 +1,100 @@
+(LAP '(
+(FULLWORD 1)
+(*ENTRY FOO1 EXPR 1)
+(POPJ (REG ST) 0)
+))
+(LAP '(
+(FULLWORD 1)
+(*ENTRY FOO2 EXPR 1)
+(HRRZI (REG 1) 1)
+(POPJ (REG ST) 0)
+))
+(LAP '(
+(FULLWORD 1)
+(*ENTRY FOO3 EXPR 1)
+(HRRZI (REG 2) 3)
+(JRST (ENTRY PLUS2))
+))
+(LAP '(
+(FULLWORD 1)
+(*ENTRY FOO4 EXPR 1)
+(HRRZI (REG 2) 4)
+(PUSHJ (REG ST) (ENTRY PLUS2))
+(JRST (ENTRY PRINT))
+))
+(LAP '(
+(FULLWORD 1)
+(*ENTRY FOO5 EXPR 1)
+(CAIE (REG 1) 1)
+(JRST G0004)
+(MOVE (REG 1) L0001)
+(POPJ (REG ST) 0)
+G0004
+(MOVE (REG 1) L0002)
+(POPJ (REG ST) 0)
+L0002
+(FULLWORD (MKITEM 30 (IDLOC NOT-ONE)))
+L0001
+(FULLWORD (MKITEM 30 (IDLOC ONE)))
+))
+(FLUID (QUOTE (FLU1 FLU2)))
+(LAP '(
+(FULLWORD 2)
+(*ENTRY FOO6A EXPR 2)
+(JSP (REG T5) (ENTRY FASTBIND))
+(HALFWORD 2 (IDLOC FLU2))
+(HALFWORD 1 (IDLOC FLU1))
+(MOVE (REG 3) ($FLUID FLU2))
+(MOVE (REG 2) ($FLUID FLU1))
+(MOVE (REG 1) L0003)
+(PUSHJ (REG ST) (ENTRY LIST3))
+(PUSHJ (REG ST) (ENTRY PRINT))
+(HRRZI (REG T1) 10)
+(MOVEM (REG T1) ($FLUID FLU1))
+(HRRZI (REG T1) 20)
+(MOVEM (REG T1) ($FLUID FLU2))
+(MOVE (REG 3) ($FLUID FLU2))
+(MOVE (REG 2) ($FLUID FLU1))
+(MOVE (REG 1) L0004)
+(PUSHJ (REG ST) (ENTRY LIST3))
+(PUSHJ (REG ST) (ENTRY PRINT))
+(MOVE (REG 1) (REG NIL))
+(JSP (REG T5) (ENTRY FASTUNBIND))
+(FULLWORD 2)
+(POPJ (REG ST) 0)
+L0004
+(FULLWORD (MKITEM 30 (IDLOC AFTER)))
+L0003
+(FULLWORD (MKITEM 30 (IDLOC BEFORE)))
+))
+(LAP '(
+(FULLWORD 0)
+(*ENTRY FOO6 EXPR 0)
+(HRRZI (REG T1) 1)
+(MOVEM (REG T1) ($FLUID FLU1))
+(HRRZI (REG T1) 2)
+(MOVEM (REG T1) ($FLUID FLU2))
+(MOVE (REG 3) ($FLUID FLU2))
+(MOVE (REG 2) ($FLUID FLU1))
+(MOVE (REG 1) L0005)
+(PUSHJ (REG ST) (ENTRY LIST3))
+(PUSHJ (REG ST) (ENTRY PRINT))
+(MOVE (REG 2) L0006)
+(MOVE (REG 1) L0007)
+(PUSHJ (REG ST) (ENTRY FOO6A))
+(MOVE (REG 3) ($FLUID FLU2))
+(MOVE (REG 2) ($FLUID FLU1))
+(MOVE (REG 1) L0008)
+(PUSHJ (REG ST) (ENTRY LIST3))
+(PUSHJ (REG ST) (ENTRY PRINT))
+(MOVE (REG 1) (REG NIL))
+(POPJ (REG ST) 0)
+L0008
+(FULLWORD (MKITEM 30 (IDLOC AFTER)))
+L0007
+(FULLWORD (MKITEM 30 (IDLOC A)))
+L0006
+(FULLWORD (MKITEM 30 (IDLOC B)))
+L0005
+(FULLWORD (MKITEM 30 (IDLOC BEFORE)))
+))
ADDED psl-1983/3-1/tests/laptest.red
Index: psl-1983/3-1/tests/laptest.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/laptest.red
@@ -0,0 +1,38 @@
+% LAPTEST.RED - A selection of small procedures for testing LAP
+% MLG
+% Run through LAPOUT for CMACRO (ALM) level,
+% and turn on DOPASS1LAP for TLM level.
+
+procedure foo1 x;
+ x;
+
+procedure foo2 x;
+ 1;
+
+procedure foo3 x;
+ x+3;
+
+procedure foo4 x;
+ print(x+4);
+
+procedure foo5 x;
+ if x=1 then 'one else 'not!-one;
+
+FLUID '(FLU1 FLU2);
+
+procedure foo6a(Flu1,Flu2);
+ begin Print List('before,FLU1,Flu2);
+ Flu1:=10;
+ Flu2:=20;
+ Print List('after,FLU1,Flu2);
+ end;
+
+procedure foo6();
+ <<Flu1:=1; Flu2 :=2;
+ Print List('before,FLU1,Flu2);
+ Foo6a('a,'b);
+ Print List('after,FLU1,Flu2);
+ >>;
+
+
+End;
ADDED psl-1983/3-1/tests/lm2-hp.tim
Index: psl-1983/3-1/tests/lm2-hp.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/lm2-hp.tim
@@ -0,0 +1,22 @@
+(
+("LM2, by Letsinger at HP, 25 February")
+(EmptyTest-10000 . 171)
+(GEmptyTest-10000 . 171)
+(Cdr1Test-100 . 2096)
+(Cdr2Test-100 . 2063)
+(CddrTest-100 . 1338)
+(ListOnlyCdrTest1 . 10826)
+(ListOnlyCddrTest1 . 15442)
+(ListOnlyCdrTest2 . 10877)
+(ListOnlyCddrTest2 . 15486)
+(ReverseTest-10 . 1027)
+(MyReverse1Test-10 . 995)
+(MyReverse2Test-10 . 950)
+(LengthTest-100 . 671)
+(ArithmeticTest-10000 . 5845)
+(EvalTest-10000 . 13468)
+(tak-18-12-6 . 3190)
+(gtak-18-12-6 . 3186)
+(gtsta-g0 . 5333)
+(gtsta-g1 . 5836)
+)
ADDED psl-1983/3-1/tests/main0.red
Index: psl-1983/3-1/tests/main0.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main0.red
@@ -0,0 +1,9 @@
+% MAIN0.RED - A "trivial" file of ALM level LAP to test basic set of
+% tools: LAP-TO-ASM mostly, and CMACROs
+
+LAP '((!*ENTRY DummyFunctionDefinition Expr 1)
+ (!*ALLOC 0)
+ (!*MOVE (REG 1) (REG 2))
+ (!*EXIT 0));
+
+END;
ADDED psl-1983/3-1/tests/main1.red
Index: psl-1983/3-1/tests/main1.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main1.red
@@ -0,0 +1,99 @@
+% Simple 1 file test
+% This is program MAIN1.RED
+
+
+IN "XXX-HEADER.RED"$
+
+On SYSLISP;
+
+Procedure FirstCall;
+ <<Init();
+ PutC Char F;
+ PutC Char !a;
+ PutC Char !c;
+ PutC Char !=;
+ PutInt Ifact 10;
+ Terpri();
+ PutC Char T;
+ PutC Char !e;
+ PutC Char !s;
+ PutC Char !t;
+ PutC Char F;
+ PutC Char !a;
+ PutC Char !c;
+ PutC Char !t;
+ Terpri();
+ TestFact();
+ Terpri();
+ PutC Char T;
+ PutC Char !e;
+ PutC Char !s;
+ PutC Char !t;
+ PutC Char T;
+ PutC Char !a;
+ PutC Char !k;
+ Terpri();
+ TestTak();
+ Quit;>>;
+
+procedure terpri();
+ PutC Char EOL;
+
+Procedure TestFact();
+<< PutInt Timc();
+ Terpri();
+ ArithmeticTest 10000;
+ PutInt Timc();
+ Terpri();
+>>;
+
+Procedure ArithmeticTest (N);
+ begin scalar I;
+ I:= 0;
+loop:
+ if Igreaterp(I,N) then return NIL;
+ Fact 9;
+ I := iadd1 I;
+ goto loop
+end;
+
+procedure TestTak();
+ <<PutInt Timc();
+ Terpri();
+ PutInt TopLevelTak (18,12,6);
+ Terpri();
+ PutInt Timc();
+ Terpri();>>;
+
+syslsp procedure Fact (N);
+ If ilessp(N,2) then 1 else LongTimes(N,Fact isub1 N);
+
+syslsp procedure Ifact u;
+ Begin scalar m;
+ m:=1;
+ L1: if u eq 1 then return M;
+ M:=LongTimes(U,M);
+ u:=u-1;
+ PutInt(u);
+ Terpri();
+ PutInt(M);
+ Terpri();
+ goto L1;
+ end;
+
+in "pt:tak.sl"$
+
+off syslisp;
+
+procedure UndefinedFunctionAux;
+ <<Putc Char U;
+ Putc Char !n;
+ Putc Char !d;
+ Putc Char !e;
+ Putc Char !f;
+ Putc Char Blank;
+ Putint UndefnCode!*;
+ Terpri();
+ Quit;>>;
+ end;
+
ADDED psl-1983/3-1/tests/main2.red
Index: psl-1983/3-1/tests/main2.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main2.red
@@ -0,0 +1,91 @@
+% MAIN2.RED - Test Byte and String I/O, some PRINT ing
+% Need: SUB2.RED simple print routines
+
+
+
+IN "XXX-HEADER.RED"$
+
+on SysLisp;
+
+% some strings to work with
+WString TestString = "AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUnVvWwXxYyZz";
+Wstring Buffer[100];
+
+syslsp Procedure FirstCall;
+ begin scalar X, Y;
+ init();
+ % test STRINF
+ Putc Char S;
+ PutC Char Lower t;
+ PutC Char Lower r;
+ Putc Char I;
+ Putc Char Lower n ;
+ Putc Char Lower f;
+ Putc Char Eol;
+ X:=TestString;
+ Y:=StrInf(X);
+ PutInt X; PutC Char '! ; PutInt Y;PutC Char EOL;
+% test STrlen
+ Putc Char S;
+ PutC Char Lower t;
+ PutC Char Lower r;
+ Putc Char Lower l;
+ Putc Char Lower e;
+ Putc Char Lower n;
+ Putc Char Eol;
+X:=StrLen(testString);
+PutInt X;PutC Char '! ;PutInt 51;PutC Char EOL;
+% test Byte access.
+ X:=TestString+AddressingUnitsPerItem;
+ Putc Char B;
+ PutC Char Lower y;
+ PutC Char Lower t;
+ Putc Char Lower e;
+ Putc Char Eol;
+ For i:=0:10 do
+ <<Y:=Byte(X,i);
+ PutInt i; PutC Char '! ;
+ PutInt Y; PutC Char '! ;
+ PutC Y; PutC Char EOL>>;
+% Now a string:
+ Putc Char S;
+ PutC Char Lower t;
+ PutC Char Lower r;
+ Putc Char Lower i;
+ Putc Char Lower n;
+ Putc Char Lower g;
+ Putc Char Eol;
+ Prin2String TestString;
+ Terpri();
+ Prin1String "----- Now input characters until #";
+ Terpri();
+ while (X := GetC X) neq char !# do PutC X;
+ Print '"----- First Print Called";
+ Print '1;
+ Print 'ANATOM;
+ Print '( 1 . 2 );
+ Print '(AA (B1 . B2) . B3);
+ Print '(AA (B1 . NIL) . NIL);
+ Prin2T
+ "Expect UNDEFINED FUNCTION MESSAGE for a function of 3 arguments";
+ ShouldNotBeThere(1,2,3);
+ quit;
+end;
+
+Fluid '(UndefnCode!* UndefnNarg!*);
+
+syslsp procedure UndefinedFunctionAux;
+% Should preserve all regs
+ <<Terpri();
+ Prin2String "**** Undefined Function: ";
+ Prin1ID LispVar UndefnCode!*;
+ Prin2String " , called with ";
+ Prin2 LispVar UndefnNarg!*;
+ Prin2T " arguments";
+ Quit;>>;
+
+
+Off syslisp;
+
+
+End;
ADDED psl-1983/3-1/tests/main3.red
Index: psl-1983/3-1/tests/main3.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main3.red
@@ -0,0 +1,80 @@
+% MAIN3.RED - Test CASE and CONS
+% Need: SUB2.RED simple print routines
+% SUB3.RED simple allocator
+
+
+IN "XXX-HEADER.RED"$
+IN "PT:STUBS3.RED"$
+
+on syslisp;
+
+
+syslsp Procedure FirstCall;
+ begin scalar X, Y;
+ Init();
+ Print '"MAIN3: Casetest"$
+ CaseTest();
+ Print '"MAIN3: test CONS"$
+ InitHeap();
+ ConsTest();
+ quit;
+end;
+
+syslsp procedure CaseTest;
+ <<Prin2t '"Test case from -1 to 11";
+ Prin2t '"Will classify argument";
+ Ctest (-1);
+ Ctest 0;
+ Ctest 1;
+ Ctest 2;
+ Ctest 3;
+ Ctest 4;
+ Ctest 5;
+ Ctest 6;
+ Ctest 7;
+ Ctest 8;
+ Ctest 9;
+ Ctest 10;
+ Ctest 11;
+ Ctest 12>>;
+
+syslsp procedure CTest N;
+ Case N of
+ 0: Show(N,"0 case");
+ 1,2,3: Show(N,"1,2,3 case");
+ 6 to 10:Show(N,"6 ... 10 case");
+ default:Show(N,"default case");
+ end;
+
+syslsp procedure Show(N,S);
+ <<Prin2String "Show for N=";
+ Prin1Int N;
+ Prin2String ", expect ";
+ Prin2String S;
+ Terpri()>>;
+
+Procedure CONStest();
+ Begin scalar Z,N;
+ Z:='1;
+ N:='2;
+ While N<10 do
+ <<z:=cons(N,z);
+ Print z;
+ N:=N+1>>;
+ End;
+
+FLUID '(UndefnCode!* UndefnNarg!*);
+
+syslsp procedure UndefinedFunctionAux;
+% Should preserve all regs
+ <<Terpri();
+ Prin2String "**** Undefined Function: ";
+ Prin1ID LispVar UndefnCode!*;
+ Prin2String " , called with ";
+ Prin2 LispVar UndefnNarg!*;
+ Prin2T " arguments";
+ Quit;>>;
+
+Off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/main4.red
Index: psl-1983/3-1/tests/main4.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main4.red
@@ -0,0 +1,172 @@
+% MAIN4.RED : Test Mini reader and function primitives,
+% needs IO, SUB2, SUB3 and SUB4
+
+
+IN "xxx-header.red"$
+In "PT:P-function-primitives.red"$
+IN "PT:STUBS4.RED"$
+IN "PT:STUBS3.RED"$
+
+on syslisp;
+
+Compiletime GLOBAL '(DEBUG);
+
+
+Procedure FirstCall;
+Begin scalar x,s1,s2,s3, Done,D1,D2;
+ Init();
+ InitHeap();
+ InitObList();
+ LispVar(DEBUG) := 'T; % To get ID stuff out
+
+ Dashed "Test EQSTR";
+ s1:='"AB";
+ s2:='"Ab";
+ s3:='"ABC";
+ ShouldBe("EqStr(AB,AB)",EqStr(s1,s1),'T);
+ ShouldBe("EqStr(AB,AB)",EqStr(s1,"AB"),'T);
+ ShouldBe("EqStr(AB,Ab)",EqStr(s1,s2),'NIL);
+ ShouldBe("EqStr(AB,ABC)",EqStr(s1,s3),'NIL);
+
+ Dashed "Test Intern on existing ID's";
+ ShouldBe("Intern(A)",Intern "A", 'A);
+ ShouldBe("Intern(AB)",Intern S1, 'AB);
+
+ Dashed "Test Intern on new ID, make sure same place";
+ D1:=Intern S3;
+ ShouldBe("Intern(ABC)",Intern("ABC"),D1);
+
+ D2:=Intern "FOO";
+ ShouldBe("Intern(ABC) again",Intern("ABC"),D1);
+
+ Dashed "Test RATOM loop. Type various ID's, STRING's and INTEGER's";
+ MoreStuff();
+ InitRead();
+ While Not Done do
+ <<x:=Ratom();
+ prin2 "Item read=";
+ Prtitm x;
+ Print x;
+ if x eq 'Q then Done := 'T;>>;
+
+ LispVar(DEBUG) := 'NIL; % Turn off PRINT
+
+ Dashed "Test READ loop. Type various S-expressions";
+ MoreStuff();
+ Done:= 'NIL;
+ While Not Done do
+ <<x:=READ();
+ Prin2 '" Item read=";
+ Prtitm x;
+ Print x;
+ if x eq 'Q then Done := 'T;>>;
+
+ Functiontest();
+ Quit;
+ End;
+
+
+Procedure MoreStuff;
+ <<Spaced "Move to next part of test by typing the id Q";
+ Spaced "Inspect printout carefully">>;
+
+Fluid '(CodePtr!* CodeForm!* CodeNarg!*);
+
+procedure FunctionTest();
+ Begin scalar c1,c2,ID1,x;
+ Dashed "Tests of FUNCTION PRIMITIVES ";
+
+ ShouldBe("FunBoundP(Compiled1)",FunBoundP 'Compiled1,NIL);
+ ShouldBe("FunBoundP(ShouldBeUnbound)",FunBoundP 'ShouldBeUnBound,T);
+
+ ShouldBe("FCodeP(Compiled1)",FCodeP 'Compiled1,T);
+ ShouldBe("FCodeP(ShouldBeUnbound)",FcodeP 'ShouldBeUnBound,NIL);
+
+ ShouldBe("FCodeP(Compiled2)",FCodeP 'Compiled2,T);
+
+ Dashed "Now MakeFunBound";
+ MakeFunBound('Compiled2);
+ ShouldBe("FCodeP(Compiled2)",FCodeP 'Compiled2,NIL);
+ ShouldBe("FUnBoundP(Compiled2)",FUnBoundP 'Compiled2,T);
+
+ Dashed "Now copy CODEPTR of Compiled1 to Compiled2 ";
+ C1:=GetFCodePointer('Compiled1);
+ C2:=GetFCodePointer('Compiled2);
+
+ ShouldBe("CodeP(C1)",CodeP C1,T);
+ ShouldBe("CodeP(C2)",CodeP C2,NIL);
+
+ MakeFcode('Compiled2,C1);
+ ShouldBe("C1=GetFcodePointer 'Compiled2",
+ C1=GetFCodePointer 'Compiled2,T);
+ ShouldBe("Compiled2()",Compiled2(),12345);
+
+ Dashed "Now test CodePrimitive";
+ CodePtr!* := GetFCodePointer 'Compiled3;
+ X:= CodePrimitive(10,20,30,40);
+ Shouldbe(" X=1000",1000,X);
+
+ Dashed "Test CompiledCallingInterpreted hook";
+ CompiledCallingInterpreted();
+
+ Dashed "Now Create PRETENDINTERPRETIVE";
+ MakeFlambdaLink 'PretendInterpretive;
+ Shouldbe("FlambdaLinkP",FlambdaLinkP 'PretendInterpretive,T);
+ Shouldbe("Fcodep",FCodeP 'PretendInterpretive,NIL);
+ Shouldbe("FUnBoundP",FUnBoundP 'PretendInterpretive,NIL);
+
+ Dashed "Now call PRETENDINTERPRETIVE";
+ x:=PretendInterpretive(500,600);
+ ShouldBe("PretendInterpretive",x,1100);
+ End;
+
+% Auxilliary Compiled routines for CodeTests:
+
+Procedure Compiled1;
+ << Dotted "Compiled1 called";
+ 12345>>;
+
+Procedure Compiled2;
+ << Dotted"Compiled2 called";
+ 67890>>;
+
+Procedure Compiled3(A1,A2,A3,A4);
+ <<Dotted "Compiled3 called with 4 arguments , expect 10,20,30,40";
+ Prin2 " A1=";Prin2T A1;
+ Prin2 " A2=";Prin2T A2;
+ Prin2 " A3=";Prin2T A3;
+ Prin2 " A4=";Prin2T A4;
+ Prin2t "Now return 1000 to caller";
+ 1000>>;
+
+
+syslsp procedure UndefinedFunctionAuxAux ;
+ Begin scalar FnId;
+ FnId := MkID UndefnCode!*;
+ Prin2 "Undefined Function ";
+ Prin1 FnId;
+ Prin2 " called with ";
+ Prin2 LispVar UndefnNarg!*;
+ prin2T " args from compiled code";
+ Quit;
+ End;
+
+% some primitives use by FastApply
+
+syslsp procedure CompiledCallingInterpretedAux();
+ Begin scalar FnId,Nargs;
+ Prin2t "COMPILED Calling INTERPRETED";
+ Prin2 "CODEFORM!*= "; Print LispVar CodeForm!*;
+ Nargs:=LispVar CodeNarg!*;
+ FnId := MkID LispVar CodeForm!*;
+ Prin2 "Function: ";
+ Prin1 FnId;
+ Prin2 " called with ";
+ Prin2 Nargs;
+ prin2T " args from compiled code";
+ Return 1100;
+ End;
+
+Off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/main4.sym
Index: psl-1983/3-1/tests/main4.sym
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main4.sym
@@ -0,0 +1,5 @@
+(SAVEFORCOMPILATION (QUOTE (PROGN)))
+(SETQ ORDEREDIDLIST!* (QUOTE NIL))
+(SETQ ORDEREDIDLIST!* (CONS ORDEREDIDLIST!* (LASTPAIR ORDEREDIDLIST!*)))
+(SETQ NEXTIDNUMBER!* (QUOTE 129))
+(SETQ STRINGGENSYM!* (QUOTE "L0000"))
ADDED psl-1983/3-1/tests/main5.red
Index: psl-1983/3-1/tests/main5.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main5.red
@@ -0,0 +1,76 @@
+% MAIN5.RED : Small READ-EVAL-PRINT Loop
+% Needs IO, SUB2, SUB3, SUB4, SUB5
+
+IN "xxx-header.red"$
+IN "PT:STUBS3.RED"$
+IN "PT:STUBS4.RED"$
+IN "PT:STUBS5.RED"$
+
+on syslisp;
+
+Compiletime FLUID '(DEBUG FnTypeList !*RAISE !$EOF!$ !*PVAL !*ECHO);
+
+Procedure FirstCall;
+Begin scalar x, Done, Hcount;
+ Init();
+ InitHeap();
+ InitObList();
+ TestGet();
+ InitEval();
+ Prin2t '"(very) MINI-PSL: A Read-Eval-Print Loop, terminate with Q";
+ Prin2T '" !*RAISE and !*PVAL have been set T";
+ Prin2T '" Should be able to execute any COMPILED expressions";
+ Prin2T '" typed in. Run (TESTSERIES) when ready";
+ LispVar(DEBUG) := 'NIL; % For nice I/O
+ InitRead();
+ LispVar(!$EOF!$) := MkID Char EOF$
+ Hcount :=0;
+ LispVar(!*RAISE) := 'T; % Upcase input IDs
+ While Not Done do
+ <<Hcount:=Hcount+1;
+ Prin2 Hcount; Prin2 '" lisp> ";
+ x:=READ();
+ if x eq 'Q then Done := 'T
+ else if x eq !$EOF!$ then
+ <<terpri();
+ Prin2T " **** Top Level EOF ****">>
+ else <<Terpri();
+ x:=EVAL x;
+ If LISPVAR(!*PVAL) then Print x>>;
+ >>;
+ Quit;
+ End;
+
+% ---- Test Routines:
+
+syslsp procedure TestSeries();
+ <<Dashed "TESTs called by TESTSERIES";
+ TestUndefined()>>;
+
+syslsp procedure TestGet();
+Begin
+ Dashed "Tests of GET and PUT";
+ Shouldbe("GET('FOO,'FEE)",GET('FOO,'FEE),NIL);
+ Shouldbe("PUT('FOO,'FEE,'FUM)",PUT('FOO,'FEE,'FUM),'FUM);
+ Shouldbe("GET('FOO,'FEE)",GET('FOO,'FEE),'FUM);
+ Shouldbe("REMPROP('FOO,'FEE)",REMPROP('FOO,'FEE),'FUM);
+ Shouldbe("GET('FOO,'FEE)",GET('FOO,'FEE),NIL);
+ end;
+
+syslsp procedure TestUndefined;
+ <<Print "Calling SHOULDBEUNDEFINED";
+ ShouldBeUndefined(1)>>;
+% Some dummies:
+
+procedure UnbindN N;
+ Stderror '"UNBIND only added at MAIN6";
+
+procedure Lbind1(x,y);
+ StdError '"LBIND1 only added at MAIN6";
+
+Off syslisp;
+
+End;
+
+
+
ADDED psl-1983/3-1/tests/main6.red
Index: psl-1983/3-1/tests/main6.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main6.red
@@ -0,0 +1,175 @@
+% MAIN6.RED : Small READ-EVAL-PRINT Loop, Binding test
+% Needs IO, SUB2, SUB3, SUB4, SUB5, SUB6
+% Added REsult after FREErstr check
+
+IN "xxx-header.red"$
+IN "PT:STUBS3.RED"$
+IN "PT:STUBS4.RED"$
+IN "PT:STUBS5.RED"$
+IN "PT:STUBS6.RED"$
+
+on syslisp;
+
+Compiletime GLOBAL '(DEBUG !*RAISE !$EOF!$);
+
+Procedure FirstCall;
+Begin scalar x, Done, Hcount;
+ Init();
+ InitHeap();
+ InitObList();
+ InitEval();
+ Prin2t '"MINI-PSL: A Read-Eval-Print Loop, terminate with Q";
+ Prin2T '" !*RAISE has been set T";
+ Prin2T '" Run (TESTSERIES) to check BINDING etc";
+ LispVar(DEBUG) := 'NIL; % For nice I/O
+ InitRead();
+ LispVar(!*RAISE) := 'T; % Upcase Input IDs
+ LispVar(!$EOF!$) := MKID Char EOF; % Check for EOF
+ Hcount :=0;
+ Prin2t " .... Now Call INITCODE";
+ InitCode();
+ Prin2t " .... Return from INITCode, Now toploop";
+ While Not Done do
+ <<Hcount:=Hcount+1;
+ Prin2 Hcount; Prin2 '" lisp> ";
+ x:=READ();
+ if x eq 'Q then Done := 'T
+ else if x = !$EOF!$ then
+ <<Terpri();
+ Prin2T " **** Top Level EOF **** ">>
+ else <<Terpri();
+ x:=EVAL x;
+ Print x>>;
+ >>;
+ Quit;
+ End;
+
+
+CompileTime FLUID '(AA);
+
+Procedure TESTSERIES();
+ Begin
+ BindingTest();
+ InterpTest();
+ CompBindTest();
+ End;
+
+Procedure BindingTest;
+Begin
+ Dashed "Test BINDING Primitives"$
+ LispVar(AA):=1;
+ PBIND1('AA); % Save the 1, insert a NIL
+ LBIND1('AA,3); % save the NIL, insert a 3
+ ShouldBe('"3rd bound AA",LispVar(AA),3);
+ UnBindN 1;
+ ShouldBe('"2rd bound AA",LispVar(AA),NIL);
+ UnBindN 1;
+ ShouldBe('"Original AA",LispVar(AA),1);
+End;
+
+
+Global '(Lambda1 Lambda2 CodeForm!*);
+
+Procedure InterpTest();
+Begin
+ Dashed "TEST of Interpreter Primitives for LAMBDA's ";
+ Lambda1:='(LAMBDA (X1 X2) (PRINT (LIST 'LAMBDA1 X1 X2)) 'L1);
+ Lambda2:='(LAMBDA (Y1 Y2) (PRINT (LIST 'LAMBDA2 Y1 Y2)) 'L2);
+
+
+ Spaced "LAMBDA1: "; Print Lambda1;
+ Dashed "FastLambdaApply on Lambda1";
+
+ CodeForm!*:=Lambda1;
+ ShouldBe("FastLambdaApply", FastLambdaApply(10,20),'L1);
+
+ Dashed "Now Test FASTAPPLY";
+ TestApply(" Compiled ID 1 ", 'Compiled1,'C1);
+ TestApply(" CodePointer 2 ", GetFcodePointer 'Compiled2,'C2);
+ TestApply(" Lambda Expression 1 ", Lambda1,'L1);
+
+ Dashed "Test a compiled call on Interpreted code ";
+ PutD('Interpreted3,'Expr,
+ '(LAMBDA (ag1 ag2 ag3) (Print (list 'Interpreted3 Ag1 Ag2 Ag3)) 'L3));
+
+ ShouldBe(" FlambdaLinkP",FlambdaLinkP 'Interpreted3,T);
+
+ ShouldBe(" Interp3", Interpreted3(300,310,320),'L3);
+
+ PutD('Interpreted2,'Expr,Lambda2);
+ TestApply(" Interpreted ID 2 ", 'Interpreted2,'L2);
+
+End;
+
+LAP '((!*entry TestFastApply expr 0)
+ (!*alloc 0)
+% Args loaded so move to fluid and go
+ (!*Move (FLUID TestCode!*) (reg t1))
+ (!*dealloc 0)
+ (!*JCALL FastApply));
+
+Procedure TestApply(Msg,Fn,Answer);
+ Begin scalar x;
+ Prin2 " Testapply case "; prin2 Msg;
+ Prin2 " given ";
+ Print Fn;
+ TestCode!* := Fn;
+ x:=TestFastApply('A,'B);
+ Return ShouldBe(" answer",x,Answer);
+ End;
+
+Procedure Compiled1(xxx,yyy);
+ <<Prin2 " Compiled1(";
+ Prin1 xxx; Prin2 " "; Prin1 yyy; Prin2T ")";
+ 'C1>>;
+
+Procedure Compiled2(xxx,yyy);
+ <<Prin2 " Compiled2(";
+ Prin1 xxx; Prin2 " "; Prin1 yyy; Prin2T ")";
+ 'C2>>;
+
+CompileTime Fluid '(CFL1 CFL2 CFL3);
+
+Procedure CompBindTest();
+Begin
+ Dashed "Test LAMBIND and PROGBIND in compiled code";
+ CFL1:='TOP1;
+ CFL2:='TOP2;
+ Shouldbe("After Cbind1, result ",
+ Cbind1('Mid0,'Mid1,'Mid2), 'Result!-Cbind1);
+ Shouldbe("CFL1",CFL1,'Top1);
+ Shouldbe("CFL2",CFL2,'Top2);
+End;
+
+procedure Cbind1(x,CFL1,CFL2);
+ Begin
+ Shouldbe("x ",x ,'Mid0);
+ Shouldbe("CFL1",CFL1,'Mid1);
+ Shouldbe("CFL2",CFL2,'Mid2);
+ Shouldbe("After Cbind2, result ",
+ Cbind2(),'Result!-Cbind2);
+ Shouldbe("CFL1",CFL1,'Bot1);
+ Shouldbe("CFL2",CFL2,'Mid2);
+ Return 'Result!-Cbind1;
+ End;
+
+Procedure Cbind2();
+ Begin scalar zz;
+ Shouldbe("CFL1",CFL1,'Mid1);
+ Shouldbe("CFL2",CFL2,'Mid2);
+ zz:=Begin scalar x,CFL2;
+ CFL1:='Bot1;
+ CFL2:='Bot2;
+ Shouldbe("CFL1",CFL1,'Bot1);
+ Shouldbe("CFL2",CFL2,'Bot2);
+ Return 'Inner!-Cbind2;
+ End;
+ Shouldbe("After inner BEGIN ",zz,'Inner!-Cbind2);
+ Shouldbe("CFL1",CFL1,'Bot1);
+ Shouldbe("CFL2",CFL2,'Mid2);
+ Return 'Result!-Cbind2;
+ End;
+
+End;
+
+
ADDED psl-1983/3-1/tests/main7.red
Index: psl-1983/3-1/tests/main7.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main7.red
@@ -0,0 +1,101 @@
+% main7.red : Small READ-EVAL-PRINT Loop WITH IO
+% Needs IO, SUB2, SUB3, SUB4, SUB5, SUB6,SUB7
+
+
+IN "xxx-header.red"$
+in "pt:stubs3.red"$
+in "pt:stubs4.red"$
+in "pt:stubs5.red"$
+in "pt:stubs6.red"$
+in "pt:stubs7.red"$
+in "pt:psl-timer.sl"$
+
+on syslisp;
+
+Compiletime GLOBAL '(DEBUG IN!* OUT!* !$EOF!$ !*PVAL);
+
+Procedure FirstCall;
+Begin scalar x, Done, Hcount;
+ INIT();
+ InitHeap();
+ InitObList();
+ InitEval();
+ Prin2t '"MINI-PSL with File I/O";
+ Prin2T '" Type (IOTEST) to test basic file I/O";
+ Prin2T '" Future tests will be READ in this way";
+ Prin2T '" !*RAISE and !*PVAL set T";
+ LispVar(DEBUG) := 'NIL; % For nice I/O
+ InitRead();
+ LispVar(!*RAISE) := 'T; % Upcase Input IDs
+ LispVar(!*PVAL) := 'T; % Print VALUEs
+ LispVar(!$EOF!$) := MKID Char EOF; % Check for EOF
+ Hcount :=0;
+ Prin2t " .... Now we test INITCODE";
+ InitCode();
+ LISPVAR(IN!*):=0;
+ LISPVAR(OUT!*):=1;
+ Hcount :=0;
+ ClearIo();
+ While Not Done do
+ <<Hcount:=Hcount+1;
+ Prin2 Hcount; Prin2 '" lisp> ";
+ x:=READ();
+ if x EQ !$EOF!$ then
+ <<Terpri();
+ Prin2T " *** Top Level EOF *** ">>
+ else if x eq 'QUIT then Done := 'T
+ else <<Terpri();
+ x:=EVAL x;
+ if Lispvar(!*PVAL) then Print x>>;
+ >>;
+ Quit;
+ End;
+
+
+
+
+
+%---- File Io tests ----
+
+Off syslisp;
+
+Procedure Iotest;
+ Begin scalar InFile, OutFile,Ch,S,InString,OutString;
+ Prin2T "---- Test of File IO";
+ IN!*:=0;
+ Out!*:=1;
+ Prin2T " Test CLEARIO";
+A: Prin2T " Input String for Input File";
+ Instring:=Read();
+ Terpri();
+ If not StringP Instring then goto A;
+
+B: Prin2T " Input String for OutPut File";
+ OutString:=Read();
+ Terpri();
+ If not StringP Outstring then goto B;
+
+ Infile:=Open(InString,'Input);
+ prin2 " Input File Opened on ";
+ Prin2 Infile;
+ PRIN2T ", copy to TTY ";
+ While Not ((ch:=IndependentReadChar(InFILE)) eq 26) do PutC Ch;
+ Close Infile;
+ Prin2T " File Closed, Input test done";
+
+ Infile:=Open(InString,'Input);
+ OutFile:=Open(OutString,'OutPut);
+ prin2 " Input File on ";
+ Prin2 Infile;
+ PRIN2 ", copy to Output File on";
+ Prin2T OutFile;
+ While Not ((ch:=IndependentReadChar(InFILE)) eq 26)
+ do IndependentWriteChar(outFile,Ch);
+ Close Infile;
+ Close OutFile;
+ Prin2 "Both Files Closed, Inspect File:";
+ Prin2T OutString;
+ End;
+
+
+End;
ADDED psl-1983/3-1/tests/main8.red
Index: psl-1983/3-1/tests/main8.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main8.red
@@ -0,0 +1,64 @@
+% MAIN8.RED Small READ-EVAL-PRINT Loop WITH IO
+% Needs IO, SUB2, SUB3, SUB4, SUB5, SUB6,SUB7
+
+
+IN "xxx-header.red"$
+%/ in "pt:stubs3.red" real gc installed$
+in "pt:stubs4.red"$
+in "pt:stubs5.red"$
+in "pt:stubs6.red"$
+in "pt:stubs7.red"$
+in "pt:stubs8.red"$
+in "pt:psl-timer.sl"$
+in "PT:GC-TEST.RED"$
+
+on syslisp;
+
+Compiletime GLOBAL '(DEBUG IN!* OUT!* !$EOF!$ !*PVAL);
+FLUID '(Heap!-Warn!-Level);
+
+
+Procedure FirstCall;
+Begin scalar x, Done, Hcount;
+ INIT();
+ InitHeap();
+ InitObList();
+ InitEval();
+ InitRead();
+ LispVar(DEBUG) := 'NIL; % For nice I/O
+ Lispvar(Heap!-Warn!-Level) := 0; % Set for Non-trap
+ LispVar(!*GC) :=T;
+ LispVar(GCKnt!*) :=0;
+ LispVar(GCTime!*) :=0;
+ LispVar(!*RAISE) := 'T; % Upcase Input IDs
+ LispVar(!*PVAL) := 'T; % Print VALUEs
+ LispVar(!$EOF!$) := MKID Char EOF; % Check for EOF
+ Hcount :=0;
+ Prin2t "Invoke STARTUP Code";
+ InitCode();
+ LISPVAR(IN!*):=0;
+ LISPVAR(OUT!*):=1;
+ Hcount :=0;
+ ClearIo();
+ Prin2T "Reading Init Files";
+ Lapin "INIT8";
+ Prin2t '"MINI-PSL with File I/O and RECLAIM";
+ Prin2T "Invoke (TESTMARKING) and then (GCTEST)";
+ While Not Done do
+ <<Hcount:=Hcount+1;
+ Prin2 Hcount; Prin2 '" lisp> ";
+ x:=READ();
+ if x EQ !$EOF!$ then
+ <<Terpri();
+ Prin2T " *** Top Level EOF *** ">>
+ else if x eq 'QUIT then Done := 'T
+ else <<Terpri();
+ x:=EVAL x;
+ if Lispvar(!*PVAL) then Print x>>;
+ >>;
+ Quit;
+ End;
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/main9.red
Index: psl-1983/3-1/tests/main9.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/main9.red
@@ -0,0 +1,64 @@
+% MAIN9.RED READ-EVAL-PRINT, RECLAIM, CATCH and PROG
+
+
+IN "xxx-header.red"$
+%/ in "pt:stubs3.red" % -- real gc installed as SUB8
+in "pt:stubs4.red"$
+in "pt:stubs5.red"$
+in "pt:stubs6.red"$
+in "pt:stubs7.red"$
+in "pt:stubs8.red"$
+in "pt:stubs9.red"$
+
+in "pt:psl-timer.sl"$
+
+on syslisp;
+
+Compiletime GLOBAL '(DEBUG IN!* OUT!* !$EOF!$ !*PVAL);
+FLUID '(Heap!-Warn!-Level);
+
+
+Procedure FirstCall;
+Begin scalar x, Done, Hcount;
+ INIT();
+ InitHeap();
+ InitObList();
+ InitEval();
+ InitRead();
+ LispVar(DEBUG) := 'NIL; % For nice I/O
+ Lispvar(Heap!-Warn!-Level) := 0; % Set for Non-trap
+ LispVar(!*GC) :=T;
+ LispVar(GCKnt!*) :=0;
+ LispVar(GCTime!*) :=0;
+ LispVar(!*RAISE) := 'T; % Upcase Input IDs
+ LispVar(!*PVAL) := 'T; % Print VALUEs
+ LispVar(!$EOF!$) := MKID Char EOF; % Check for EOF
+ Hcount :=0;
+ Prin2t "Invoking STARTUP Code";
+ InitCode();
+ LISPVAR(IN!*):=0;
+ LISPVAR(OUT!*):=1;
+ Hcount :=0;
+ ClearIo();
+ Prin2T "Reading the INIT files";
+ Lapin "INIT9";
+ Prin2t '"MINI-PSL with File I/O, RECLAIM and CATCH/THROW";
+ While Not Done do
+ <<Hcount:=Hcount+1;
+ Prin2 Hcount; Prin2 '" lisp> ";
+ x:=READ();
+ if x EQ !$EOF!$ then
+ <<Terpri();
+ Prin2T " *** Top Level EOF *** ">>
+ else if x eq 'QUIT then Done := 'T
+ else <<Terpri();
+ x:=EVAL x;
+ if Lispvar(!*PVAL) then Print x>>;
+ >>;
+ Quit;
+ End;
+
+Off syslisp;
+
+End;
+
ADDED psl-1983/3-1/tests/make-headers.mic
Index: psl-1983/3-1/tests/make-headers.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/make-headers.mic
@@ -0,0 +1,66 @@
+@conn pt:
+@get psl:rlisp
+@st
+*load "g:proc-headers";
+*on nocomment, noprefix; % Set up for smallest output
+*remd ''ImportantLine;
+*copyd(''ImportantLine,''ImportantLine2);
+
+*Manyheaders(''(main2 sub2 stubs2
+ main3 sub3 stubs3
+ main4 sub4 stubs4
+ main5 sub5a sub5b stubs5
+ main6 sub6 stubs6
+ main7 sub7 stubs7
+ main8 sub8 stubs8
+ main9 sub9 stubs9
+ mini!-allocators
+ mini!-arithmetic
+ pk!:carcdr
+ pk!:catch!-throw
+ mini!-char!-io
+ pk!:comp!-support
+ mini!-cons!-mkvect
+ mini!-dskin
+ mini!-easy!-non!-sl
+ mini!-easy!-sl
+ mini!-equal
+ mini!-error!-errorset
+ mini!-error!-handlers
+ mini!-eval!-apply
+ mini!-fluid!-global
+ mini!-gc
+ mini!-io!-errors
+ pk!:known!-to!-comp!-sl
+ mini!-loop!-macros
+ mini!-oblist
+ mini!-open!-close
+ mini!-others!-sl
+ mini!-printers
+ mini!-printf
+ mini!-property-list
+ mini!-putd!-getd
+ mini!-rds!-wrs
+ mini!-read
+ mini!-sequence
+ mini!-symbol!-values
+ mini!-token
+ mini!-top!-loop
+ mini!-type!-conversions
+ mini!-type!-errors
+ p!-apply!-lap
+ p!-fast!-binder
+ pk!:binding
+ p!-function!-primitives
+ p!-comp!-gc
+ p20t!:xxx!-gc
+ p20t!:xxx!-header
+ p20t!:xxx!-system!-gc
+ p20t!:xxx!-system!-io
+ p20t!:20!-test!-global!-data
+ ), ''all!-test);
+
+*load "g:sort-file";
+*sort!-file("all-test.headers","all-test.sorted");
+*quit;
+@reset .
ADDED psl-1983/3-1/tests/mathlib.tst
Index: psl-1983/3-1/tests/mathlib.tst
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mathlib.tst
@@ -0,0 +1,108 @@
+%. MATHLIB.TST
+
+% A simple set of tests for MAthLIB
+
+LOAD MATHLIB$
+
+Global '(EPS);
+
+EPS:=1.0/(1.0E6);
+
+Fexpr procedure TS L$ % (Function,Arg,Expected Value)
+ Begin scalar Fn,Arg,Val,x,y;
+ Fn:=car L$
+ Arg:=EVAL cadr L$
+ Val:=EVAL Caddr L$
+ x:=Apply(fn, list arg)$
+ PrintF(" %r(%p) = %p, expect %p%n",Fn,arg,x,val)$
+ y:=abs(x-val);
+ if y>=EPS then PrintF(" ***** %p exceeds EPS%n",y);
+ End$
+
+TS(Ceiling,3,3);
+TS(Ceiling,3.1,4);
+TS(Ceiling,3.7,4);
+TS(Ceiling,-3,-3);
+TS(Ceiling,-3.5,-2);
+
+TS(Round,3,3);
+TS(Round,3.1,3);
+TS(Round,3.5,4);
+TS(Round,3.7,4);
+TS(Round,-3,-3);
+TS(Round,-3.4,-2);
+TS(Round,-3.7,-3);
+
+TwoPI := 6.2831853;
+PI:=TwoPI/2;
+PI2:=PI/2;
+PI4:=PI/4;
+PI8:=PI/8;
+
+Root2:=1.4142136;
+Root2**2 - 2.0;
+
+TS(sin, 0.0, 0.0)$
+TS(cos, 0.0, 1.0)$
+TS(sin, PI4, Root2/2)$
+TS(cos, PI4, Root2/2)$
+TS(sin, PI2, 1.0)$
+TS(cos, PI2, 0.0)$
+TS(sin, 3*PI4, Root2/2)$
+TS(cos, 3*PI4, -Root2/2)$
+TS(sin, PI, 0.0)$
+TS(cos, PI, -1.0)$
+
+
+procedure SC2 x;
+ sin(x)**2+cos(x)**2;
+
+TS(SC2,0.0,1)$
+TS(SC2,0.25,1)$
+TS(SC2,0.5,1)$
+TS(SC2,0.75,1)$
+TS(SC2,1.0,1)$
+TS(SC2,1.25,1)$
+TS(SC2,1.5,1)$
+TS(SC2,1.75,1)$
+TS(SC2,2.0,1)$
+TS(SC2,2.25,1)$
+TS(SC2,2.5,1)$
+TS(SC2,2.75,1)$
+TS(SC2,3.0,1)$
+
+TS(TAN,0.0,0.0)$
+TS(TAN,PI8,SIN(PI8)/COS(PI8))$
+TS(TAN,PI4,1.0)$
+
+TS(COT,PI8,COS(pi8)/SIN(pi8))$
+TS(COT,PI4,1.0)$
+
+TS(SIND,30.0,0.5)$
+TS(ASIND,0.5,30.0)$
+
+TS(SQRT,2.0,Root2)$
+TS(SQRT,9.0,3.0)$
+TS(SQRT,100.0,10.0)$
+
+NaturalE:=2.718281828$
+
+TS(EXP,1.0,NaturalE)$
+
+TS(LOG,SQRT(NaturalE),0.5)$
+TS(LOG,NaturalE,1.0)$
+TS(LOG,NaturalE**2,2.0)$
+TS(LOG,1.0/NaturalE**2, -2.0)$
+
+
+TS(LOG2,Root2,0.5)$
+TS(LOG2,2.0,1.0)$
+TS(LOG2,4.0,2.0)$
+TS(LOG2,0.5, -1.0)$
+
+TS(LOG10,SQRT(10.0),0.5)$
+TS(LOG10,10.0,1.0)$
+TS(LOG10,100.0,2.0)$
+TS(LOG10, 1.0E30, 30.0)$
+TS(LOG10, 1.0E-30, -30.0)$
+End$
ADDED psl-1983/3-1/tests/mini-allocators.red
Index: psl-1983/3-1/tests/mini-allocators.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-allocators.red
@@ -0,0 +1,58 @@
+% MINI-ALLOC.RED : Crude Mini Allocator and support
+% See PT:P-ALLOCATORS.RED
+% Revisions: MLG, 18 Feb,1983
+% Moved HEAP declaration to XXX-HEADER
+% Had to provide an InitHeap routine
+% (or will be LoadTime :=)
+on syslisp;
+
+external Wvar HeapLowerBound, HeapUpperBound;
+
+external WVar HeapLast, % next free slot in heap
+ HeapPreviousLast; % save start of new block
+
+syslsp procedure GtHEAP N;
+% get heap block of N words
+if null N then (HeapUpperBound - HeapLast) / AddressingUnitsPerItem else
+<< HeapPreviousLast := HeapLast;
+ HeapLast := HeapLast + N*AddressingUnitsPerItem;
+ if HeapLast > HeapUpperBound then
+ << !%Reclaim();
+ HeapPreviousLast := HeapLast;
+ HeapLast := HeapLast + N*AddressingUnitsPerItem;
+ if HeapLast > HeapUpperBound then
+ FatalError "Heap space exhausted" >>;
+ HeapPreviousLast >>;
+
+syslsp procedure GtSTR N;
+% Allocate space for a string N chars
+begin scalar S, NW;
+ S := GtHEAP((NW := STRPack N) + 1);
+ @S := MkItem(HBytes, N);
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtVECT N;
+% Allocate space for a vector N items
+begin scalar V;
+ V := GtHEAP(VECTPack N + 1);
+ @V := MkItem(HVECT, N);
+ return V;
+end;
+
+Procedure GtWarray N;
+% Dummy for Now, since no GC
+ GtVect N;
+
+Procedure GtID();
+% Simple ID Allocator
+ Begin scalar D;
+ D:=NextSymbol;
+ NextSymbol:=NextSymbol+1;
+ return D;
+ End;
+
+Off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-arithmetic.red
Index: psl-1983/3-1/tests/mini-arithmetic.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-arithmetic.red
@@ -0,0 +1,35 @@
+% MINI-ARITHMETIC.RED simple ARITHmetic functions
+
+
+Procedure Plus2(x,y);
+ if numberp x and numberp y then sys2int(wplus2(intinf x,intinf y))
+ else NonNumberError(cons(x,y),'Plus2);
+
+Procedure Minus(x);
+ if numberp x then sys2int wminus intinf x
+ else NonNumberError(x,'Minus);
+
+Procedure Add1 N;
+ If Numberp N then sys2int wplus2(N,1) else
+ else NonNumberError(N,'Add1);
+
+Procedure SUB1 N;
+ If Numberp N then sys2int wdifference(N,1)
+ else NonNumberError(N,'SUB1);
+
+
+Procedure GreaterP(N1,N2);
+ If NumberP N1 and NumberP N2 then wGreaterp(intinf N1,intinf N2) else NIL;
+
+Procedure LessP(N1,N2);
+ If NumberP N1 and NumberP N2 then Wlessp(intinf N1,intinf N2) else NIL;
+
+Procedure DIFFERENCE(N1,N2);
+ If NumberP N1 and NumberP N2 then sys2int wdifference(intinf N1,intinf N2)
+ else NonNumberError(cons(N1,N2),'Difference);
+
+Procedure TIMES2(N1,N2);
+ If NumberP N1 and NumberP N2 then sys2int Wtimes2(intinf N1,intinf N2)
+ else NonNumberError(cons(N1,N2),'TIMES2);
+
+End;
ADDED psl-1983/3-1/tests/mini-carcdr.red
Index: psl-1983/3-1/tests/mini-carcdr.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-carcdr.red
@@ -0,0 +1,19 @@
+% MINI-CARCDR.RED
+
+% ---- Some Basic LIST support Functions
+
+% -- CxxR -- may need in EVAL if not open coded
+
+Procedure Caar x;
+ Car Car x;
+
+Procedure Cadr x;
+ Car Cdr x;
+
+Procedure Cdar x;
+ Cdr Car x;
+
+Procedure Cddr x;
+ Cdr Cdr x;
+
+end;
ADDED psl-1983/3-1/tests/mini-char-io.red
Index: psl-1983/3-1/tests/mini-char-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-char-io.red
@@ -0,0 +1,9 @@
+% MINI-CHAR-IO.RED
+
+Procedure ChannelWriteChar(chn,x);
+ PutC x;
+
+Procedure WriteChar Ch;
+ IndependentWriteChar(Out!*,Ch);
+
+End;
ADDED psl-1983/3-1/tests/mini-comp-support.red
Index: psl-1983/3-1/tests/mini-comp-support.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-comp-support.red
@@ -0,0 +1,16 @@
+% MINI-COMP-SUPPORT.RED - Support for LIST etc
+%/ Identical to PK:COMP-SUPPORT?
+
+procedure List2(A1,A2);
+ Cons(A1,Ncons A2);
+
+procedure List3(A1,A2,A3);
+ Cons(A1,List2(A2,A3));
+
+procedure List4(A1,A2,A3,A4);
+ Cons(A1,List3(A2,A3,A4));
+
+procedure List5(A1,A2,A3,A4,A5);
+ Cons(A1,List4(A2,A3,A4,A5));
+
+end;
ADDED psl-1983/3-1/tests/mini-cons-mkvect.red
Index: psl-1983/3-1/tests/mini-cons-mkvect.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-cons-mkvect.red
@@ -0,0 +1,39 @@
+% MINI-CONS.RED : Cons, MkVect etc for testing
+%/Almost identical to PK:CONS-MKVECT
+
+on syslisp;
+
+procedure HardCons(x,y);
+ Begin scalar c;
+ c:=GtHeap PairPack();
+ c[0]:=x;
+ c[1]:=y;
+ Return MkPAIR(c);
+ End;
+
+procedure Cons(x,y);
+ HardCons(x,y);
+
+procedure Xcons(x,y);
+ HardCons(y,x);
+
+procedure Ncons x;
+ HardCons(x,'NIL);
+
+syslsp procedure MkVect N;
+% Allocate vector, init all to NIL
+ if IntP N then
+ << N := IntInf N;
+ if N < (-1) then
+ StdError
+ '"A vector with fewer than zero elements cannot be allocated"
+ else begin scalar V;
+ V := GtVect N;
+ for I := 0 step 1 until N do VecItm(V, I) := NIL;
+ return MkVEC V; % Tag it
+ end >>
+ else NonIntegerError(N, 'MkVect);
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-dskin.red
Index: psl-1983/3-1/tests/mini-dskin.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-dskin.red
@@ -0,0 +1,30 @@
+% MINI-DSKIN.RED
+
+Procedure TypeFile F;
+Begin Scalar InChan,OldChan,c;
+ InChan:=Open(F,'Input);
+ OldChan:=Rds InChan;
+ While Not ((c:=Getc()) eq 26) do PutC(c);
+ rds OldChan;
+ close InChan;
+ end;
+
+Procedure DskIn F;
+ Begin scalar Infile, OldFile,x;
+ Infile:=Open(F,'Input);
+ OldFile:=RDS Infile;
+ While not ((x:=Read()) eq !$eof!$) do
+ << x:=Eval x;
+ If !*Pval then Print x>>;
+ RDS OldFile;
+ Close InFile;
+End;
+
+FLUID '(!*Echo !*PVAL);
+
+procedure Lapin F;
+ Begin scalar !*echo, !*pval;
+ Return Dskin F;
+ End;
+
+End;
ADDED psl-1983/3-1/tests/mini-easy-non-sl.red
Index: psl-1983/3-1/tests/mini-easy-non-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-easy-non-sl.red
@@ -0,0 +1,37 @@
+% MINI-NON-SL.RED Simple non sl functions
+
+Procedure Atsoc(x,y);
+ If Not PAIRP y then NIL
+ else if Not PAIRP car y then Atsoc(x,cdr y)
+ else if x EQ car car y then car y
+ else Atsoc(x, cdr y);
+
+Procedure GEQ(N1,N2);
+ not(N1< N2);
+
+Procedure LEQ(N1,N2);
+ not(N1 > N2);
+
+Procedure EqCar(x,y);
+ PairP x and (Car(x) eq y);
+
+procedure COPYD(newId,OldId);
+ Begin scalar x;
+ x:=Getd OldId;
+ If not Pairp x
+ then return <<Print List(OLDID, " has no definition in COPYD ");
+ NIL>>;
+ Return PUTD(newId,car x,cdr x);
+ End;
+
+
+Procedure Delatq(x,y);
+ If not Pairp y then NIL
+ else if not Pairp car y then CONS(car y,Delatq(x,cdr y))
+ else if x eq caar y then cdr y
+ else CONS(car y,Delatq(x,cdr y));
+
+procedure MkQuote x;
+ List('quote,x);
+
+End;
ADDED psl-1983/3-1/tests/mini-easy-sl.red
Index: psl-1983/3-1/tests/mini-easy-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-easy-sl.red
@@ -0,0 +1,96 @@
+% MINI-EASY-SL.RED --- Simple functions
+
+% 3.1 -- Some basic predicates
+% Note that the bodies open compile, so this is just for
+% interpreter entries
+
+Procedure Atom x;
+ Atom x;
+
+procedure ConstantP U;
+ Not PairP U and not IDP U;
+
+Procedure Null U;
+ U eq NIL;
+
+% 3.2 -- Simple LIST stuff
+
+nexpr procedure List x;
+ x;
+
+
+% 3.5 -- Function definition
+
+fexpr Procedure De(x);
+ PutD(car x,'Expr,'LAMBDA . cdr x);
+
+fexpr Procedure Df(x);
+ PutD(car x,'Fexpr,'LAMBDA . Cdr x);
+
+fexpr Procedure Dn(x);
+ PutD(car x,'NExpr,'LAMBDA . cdr x);
+
+fexpr Procedure Dm(x);
+ PutD(car x,'Macro,'LAMBDA . Cdr x);
+
+% 3.6 -- Variables and Binding
+
+Fexpr Procedure SETQ a;
+ Set(car a,Eval Cadr a);
+
+% 3.7 -- Program function features
+
+fexpr procedure Progn x;
+ EvProgn x;
+
+
+procedure EvProgn fl;
+ Begin scalar x;
+ While PairP fl do <<x:=Eval Car fl;
+ fl:=Cdr fl>>;
+ Return x;
+ End;
+
+% 3.10 -- Boolean functions
+
+procedure EvCond fl;
+ if not PairP fl then 'NIL
+ else if not PairP car fl then EvCond cdr fl
+ else if Eval car car fl then EvProgn cdr car fl
+ else EvCond cdr fl;
+
+fexpr procedure Cond x;
+ EvCond x;
+
+procedure Not U;
+ U eq NIL;
+
+% 3.13 -- Composite
+
+Procedure append(U,V);
+ if not PairP U then V
+ else Cons(Car U,Append(Cdr U,V));
+
+Procedure MemQ(x,y);
+ If Not PAIRP y then NIL
+ else if x EQ car y then T
+ else MemQ(x, cdr y);
+
+Procedure REVERSE U;
+ Begin Scalar V;
+ While PairP U do <<V:=CONS(Car U,V);
+ U:=CDR U>>;
+ Return V;
+ End;
+
+% Simple EVAL support
+
+procedure Evlis x;
+ if Not Pairp x then x
+ else Eval(car x) . Evlis(cdr x);
+
+Fexpr Procedure Quote a;
+ Car a;
+
+End;
+
ADDED psl-1983/3-1/tests/mini-equal.red
Index: psl-1983/3-1/tests/mini-equal.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-equal.red
@@ -0,0 +1,18 @@
+% MINI-EQUAL.RED
+
+on syslisp;
+
+Procedure EqStr(s1,S2);
+ Begin scalar n;
+ s1:=strinf(s1); s2:=strinf(s2);
+ n:=strlen(s1);
+ if n neq strlen(s2) then return 'NIL;
+ L:if n<0 then return 'T;
+ if strbyt(s1,n) neq strbyt(s2,n) then return 'NIL;
+ n:=n-1;
+ goto L;
+ End;
+
+off syslisp;
+
+end;
ADDED psl-1983/3-1/tests/mini-error-errorset.red
Index: psl-1983/3-1/tests/mini-error-errorset.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-error-errorset.red
@@ -0,0 +1,21 @@
+% MINI-ERROR-ERRORSET
+on syslisp;
+
+syslsp procedure ErrorHeader;
+ Prin2String "*** ERROR *** ";
+
+syslsp procedure Error s;
+ <<ErrorHeader();
+ ErrorTrailer s>>;
+
+syslsp procedure ErrorTrailer s;
+ <<If pairp s then Prin2L s else Prin2T s;
+ Quit;>>;
+
+syslsp procedure Prin2L s;
+% Should be in PrintF?
+ <<While Pairp s do <<prin2 car s; s:=cdr s; prin2 " ">>;
+ Terpri()>>;
+
+off syslisp;
+End;
ADDED psl-1983/3-1/tests/mini-error-handlers.red
Index: psl-1983/3-1/tests/mini-error-handlers.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-error-handlers.red
@@ -0,0 +1,12 @@
+% MINI-ERROR-HANDLERS.RED - Error Handler stubs
+on syslisp;
+
+syslsp procedure FatalError s;
+ <<ErrorHeader(); Prin2 " FATAL "; ErrorTrailer s>>;
+
+syslsp procedure StdError m;
+ Error m;
+
+off syslisp;
+
+end;
ADDED psl-1983/3-1/tests/mini-eval-apply.red
Index: psl-1983/3-1/tests/mini-eval-apply.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-eval-apply.red
@@ -0,0 +1,94 @@
+% MINI-EVAL-APPLY.RED - A small EVAL, uses P-APPLY-LAP
+
+On syslisp;
+
+Procedure InitEval;
+ Begin
+ Put('Quote,'TYPE,'FEXPR);
+ Put('Setq,'TYPE,'FEXPR);
+ Put('Cond,'TYPE,'FEXPR);
+ Put('Progn,'TYPE,'FEXPR);
+ Put('While,'TYPE,'FEXPR);
+ Put('List,'TYPE,'NEXPR);
+ Put('De,'TYPE,'FEXPR);
+ Put('Df,'TYPE,'FEXPR);
+ Put('Dn,'TYPE,'FEXPR);
+ Put('Dm,'TYPE,'FEXPR);
+ End;
+
+syslsp procedure Eval x;
+ If IDP x then SYMVAL(IdInf x)
+ else if not PairP x then x
+ else begin scalar fn,a,FnType;
+ fn:=car x; a:=cdr x;
+ if LambdaP fn then Return LambdaEvalApply(GetLambda fn, a);
+ if CodeP fn then Return CodeEvalApply(fn,a);
+ if not Idp fn then Return <<Prin2('"**** Non-ID function in EVAL: ");
+ Print fn;
+ NIL>>;
+ if FunBoundP fn then Return <<Prin2('"**** UnBound Function in EVAL: ");
+ Print fn;
+ NIL>>;
+ FnType :=GetFnType Fn;
+
+ if FnType = 'FEXPR then return IDApply1(a, Fn);
+ if FnType = 'NEXPR then return IDApply1(Evlis a, Fn);
+ if FnType = 'MACRO then return Eval IDApply1(x, Fn);
+
+ if FLambdaLinkP fn then return LambdaEvalApply(GetLambda fn,a);
+ return CodeEvalApply(GetFcodePointer fn, a);
+ end;
+
+
+procedure Apply(fn,a);
+ Begin scalar N;
+ If LambdaP fn then return LambdaApply(fn,a);
+ If CodeP fn then CodeApply(fn,a);
+ If Not Idp Fn then return
+ <<prin2 '" **** Non-ID function in APPLY: ";
+ prin1 fn; prin2 " "; Print a;
+ NIL>>;
+ if FLambdaLinkP fn then return LambdaApply(GetLambda fn,a);
+ If FunBoundP Fn then return
+ <<prin2 '" **** Unbound function in APPLY: ";
+ prin1 fn; prin2 " "; Print a;
+ NIL>>;
+ Return CodeApply(GetFcodePointer Fn,a);
+End;
+
+% -- User Function Hooks ---
+Procedure LambdaApply(x,a);
+ Begin scalar v,b;
+ x:=cdr x;
+ v:=car x;
+ b:=cdr x;
+ Return DoLambda(v,b,a)
+ End;
+
+Procedure LambdaEvalApply(x,y);
+ LambdaApply(x,Evlis y);
+
+Procedure DoLambda(vars,body,args);
+% Args already EVAL'd as appropriate
+ Begin scalar N,x,a;
+ N:=Length vars;
+ For each v in VARS do
+ <<if pairp args then <<a:=car args; args:=cdr args>>
+ else a:=Nil;
+ LBIND1(v,a)>>;
+%/ Should try BindEVAL here
+ x:=EvProgn Body;
+ UnBindN N;
+ Return x;
+End;
+
+
+Procedure LambdaP(x);
+ EqCar(x,'LAMBDA);
+
+Procedure GetLambda(fn);
+ Get(fn,'!*LambdaLink);
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-fluid-global.red
Index: psl-1983/3-1/tests/mini-fluid-global.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-fluid-global.red
@@ -0,0 +1,19 @@
+% MINI-FLUID-GLOBAL.RED
+% Stubs
+
+procedure fluid u;
+ list ('fluid, u);
+
+procedure FluidP U;
+ NIL;
+
+procedure global u;
+ list ('global, u);
+
+procedure GlobalP u;
+ NIL;
+
+procedure Unfluid U;
+ list('Unfluid,U);
+
+End;
ADDED psl-1983/3-1/tests/mini-gc.red
Index: psl-1983/3-1/tests/mini-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-gc.red
@@ -0,0 +1,26 @@
+% MINI-RECLAIM.RED - RECLAIM stubs for TEST series
+
+on syslisp;
+
+External Wvar HeapLowerBound,
+ HeapUpperBound,
+ HeapLast;
+
+Procedure !%Reclaim();
+ <<Prin2 '" *** Dummy !%RECLAIM: ";
+ HeapInfo()>>;
+
+Procedure Reclaim();
+ <<Prin2 '"*** Dummy RECLAIM: ";
+ HeapInfo()>>;
+
+Procedure HeapInfo();
+<< Prin1 ((HeapLast-HeapLowerBound)/AddressingUnitsPerItem);
+ Prin2 '" Items used, ";
+ Prin1 ((HeapUpperBound -HeapLast)/AddressingUnitsPerItem);
+ Prin2t '" Items left.";
+ 0>>;
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-io-errors.red
Index: psl-1983/3-1/tests/mini-io-errors.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-io-errors.red
@@ -0,0 +1,14 @@
+% MINI-IO-ERRORS.RED
+
+Procedure IoError M;
+ <<terpri();
+ ErrorHeader();
+ Prin2t M;
+ RDS 0;
+ WRS 1;
+ NIL>>;
+
+procedure ContOpenError(fil,how);
+ IoError List("Cant Open file ",fil," for ",how);
+
+End;
ADDED psl-1983/3-1/tests/mini-loop-macros.red
Index: psl-1983/3-1/tests/mini-loop-macros.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-loop-macros.red
@@ -0,0 +1,9 @@
+% MINI-LOOP-MACROS.RED
+
+fexpr procedure While fl;
+ Begin
+ if not PairP fl then return 'NIL;
+ While Eval Car fl do EvProgn cdr fl;
+ End;
+
+End;
ADDED psl-1983/3-1/tests/mini-oblist.red
Index: psl-1983/3-1/tests/mini-oblist.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-oblist.red
@@ -0,0 +1,80 @@
+%F PT MINI-OBLIST RED 18-MAR-83
+
+on syslisp;
+
+internal WConst DeletedSlotValue = -1,
+ EmptySlotValue = 0;
+
+
+syslsp procedure Intern s;
+ % Lookup string, find old ID or return a new one
+ Begin scalar D;
+ If IDP s then s :=SymNam IdInf s;
+ If (D:=LookupString( s)) then return MkItem(ID,D);
+ Return NewId s;
+End;
+
+syslsp procedure NewId S;
+ InitNewId(GtId(),s);
+
+Syslsp procedure InitNewId(D,s);
+Begin
+ If LispVar(DEBUG) then <<Prin2 '"New ID# "; Print D>>;
+ Symval(D):=NIL;
+ SymPrp(D):=NIL;
+ SymNam(D):=s;
+ D:=MkItem(ID,D);
+ MakeFUnBound(D); % Machine dependent, in XXX-HEADER
+ Obarray(D):=D; % For GC hook
+ Return D;
+ End;
+
+
+Syslsp procedure LookupString(s);
+ % Linear scan of SYMNAM field to find string s
+ Begin scalar D;
+ D:=NextSymbol;
+ If LispVar(DEBUG) then
+ <<Prin2 '"Lookup string=";Prin1String s; Terpri()>>;
+ L: If D<=0 then return
+ <<If LispVar(DEBUG) then Prin2T '"Not Found in LookupString";
+ NIL>>;
+ D:=D-1;
+ If EqStr(SymNam(D),s) then return
+ <<If LispVar(DEBUG) then <<Prin2 '"Found In LookupString="; print D>>;
+ D>>;
+ goto L
+ End;
+
+
+% ---- Small MAPOBL and printers
+
+
+Syslsp procedure MapObl(Fn);
+ For i:=0:NextSymbol-1 do IdApply1(MkItem(ID,I),Fn);
+
+Syslsp procedure PrintFexprs;
+ MapObl 'Print1Fexpr;
+
+Syslsp procedure Print1Fexpr(x);
+ If FexprP x then Print x;
+
+Syslsp procedure PrintFunctions;
+ MapObl 'Print1Function;
+
+Syslsp procedure Print1Function(x);
+ If Not FUnboundP x then Print x;
+
+syslisp procedure InitObList();
+% Dummy, non hashed version
+ Begin scalar Tmp;
+ For i:=0 step 1 until MaxObarray do
+ ObArray I := EmptySlotValue;
+ Tmp:= NextSymbol -1;
+ For I := 128 step 1 until Tmp do
+ ObArray I := I;
+ End;
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-open-close.red
Index: psl-1983/3-1/tests/mini-open-close.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-open-close.red
@@ -0,0 +1,11 @@
+% MINI-OPEN-CLOSE.RED Some minimal User Level I/O routines:
+
+Procedure Open(FileName,How);
+ If how eq 'Input then SystemOpenFileForInput FileName
+ else if how eq 'OutPut then SystemOpenFileForOutPut FileName
+ else IoError "Cant Open";
+
+Procedure Close N;
+ IndependentCloseChannel N;
+
+end;
ADDED psl-1983/3-1/tests/mini-others-sl.red
Index: psl-1983/3-1/tests/mini-others-sl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-others-sl.red
@@ -0,0 +1,12 @@
+% MINI-OTHERS-SL.RED
+on syslisp;
+
+procedure Length U;
+% Length of list U, fast version
+ Length1(U, 0);
+
+procedure Length1(U, N);
+ if PairP U then Length1(cdr U, N+1) else N;
+
+off syslisp;
+end;
ADDED psl-1983/3-1/tests/mini-printers.red
Index: psl-1983/3-1/tests/mini-printers.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-printers.red
@@ -0,0 +1,108 @@
+% MINI-PRINT.RED - More comprehensive Mini I/O
+
+% A mini Print routine
+% uses PutC and PutInt
+
+On syslisp;
+
+syslsp procedure Prin1 x;
+ if IDP x then Prin1ID x
+ else if IntP x then Prin1Int x
+ else if StringP x then Prin1String x
+ else if PairP x then Prin1Pair x
+ else PrtItm x;
+
+syslsp procedure Prin2 x;
+ if IDP x then Prin2ID x
+ else if IntP x then Prin1Int x
+ else if StringP x then Prin2String x
+ else if PairP x then Prin2Pair x
+ else PrtItm x;
+
+syslsp procedure Print x;
+ <<Prin1 X; Terpri(); x>>;
+
+syslsp procedure Prin2t x;
+ <<Prin2 X; Terpri(); x>>;
+
+% Support
+
+syslsp procedure Pblank;
+ PutC Char '! ;
+
+syslsp procedure Prin1Int x;
+<<if x=0 then PutC Char 0
+ else if x<0 then <<PutC Char '!-;
+ Prin1Int (-x)>>
+ else Prin1IntX x;
+ x>>;
+
+Procedure Prin1IntX x;
+ If x=0 then NIL
+ else <<Prin1IntX LongDiv(x,10);
+ PutC (LongRemainder(x,10)+Char 0)>>;
+
+syslsp procedure Prin1ID x;
+ <<Prin2String Symnam IdInf x;
+ PBlank();
+ x>>;
+
+syslsp procedure Prin2Id x;
+ prin1Id x;
+
+syslsp procedure Prin1String x;
+<<PutC Char '!";
+ Prin2String x;
+ PutC Char '!";
+ Pblank();
+ x>>;
+
+syslsp procedure Prin2String x;
+ Begin scalar s;
+ s:=StrInf x;
+ For i:=0:StrLen(s) do PutC StrByt(S,I);
+ return x
+ End;
+
+syslsp procedure Prin1Pair x;
+ <<PutC Char '!(;
+ Prin1 Car x;
+ x:=Cdr X;
+ While Pairp X do <<Pblank(); Prin1 Car X; X:=Cdr x>>;
+ If Not NULL X then <<Prin2String " . ";
+ Prin1 x>>;
+ PutC Char '!) ;
+ Pblank();
+ x>>;
+
+syslsp procedure Prin2Pair x;
+ <<PutC Char '!(;
+ Prin2 Car x;
+ x:=Cdr X;
+ While Pairp X do <<Pblank(); Prin2 Car X; X:=Cdr x>>;
+ If Not NULL X then <<Prin2String " . ";
+ Prin2 x>>;
+ PutC Char '!) ;
+ Pblank();
+ x>>;
+
+syslsp procedure terpri();
+ Putc Char EOL;
+
+syslsp procedure PrtItm x;
+ <<Prin2String " <";
+ Prin1Int Tag x;
+ PutC Char '!:;
+ Prin1Int Inf x;
+ Prin2String "> ";
+ x>>;
+
+% Some stubs for later stuff
+
+Procedure ChannelPrin2(chn,x);
+ Prin2 x;
+
+Off syslisp;
+
+
+End;
ADDED psl-1983/3-1/tests/mini-printf.red
Index: psl-1983/3-1/tests/mini-printf.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-printf.red
@@ -0,0 +1,28 @@
+% MINI-PRINTF.RED
+
+procedure PrintF(FMT, A1,A2,A3,A4,A5,A6);
+% Dummy PRINTF
+<< Prin2 FMT;
+ Prin2 " ";
+ Prin2 A1;
+ Prin2 " ";
+ Prin2 A2;
+ Prin2 " ";
+ Prin2 A3;
+ Prin2 " ";
+ Prin2T A4;
+ >>;
+
+procedure errorprintf(FMT,a1,a2,a3,a4);
+% Dummy ErrorPrintf
+ PrintF(FMT,A1,A2,A3,A4);
+
+procedure BLDMSG(FMT,A1,A2,A3,A4,A5,A6);
+% Dummy BLDMSG
+ LIST ('BLDMSG, FMT,A1,A2,A3,A4);
+
+
+procedure ErrPrin U;
+ <<Prin2 '!`; Prin1 U; Prin2 '!' >>;
+
+End;
ADDED psl-1983/3-1/tests/mini-property-list.red
Index: psl-1983/3-1/tests/mini-property-list.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-property-list.red
@@ -0,0 +1,43 @@
+% MINI-PROPERTY-LIST.RED - Small GET and PUT
+
+on syslisp;
+
+Procedure Prop x;
+ If not IDP x then NIL
+ else SYMPRP IDINF x;
+
+Procedure Get(x,y);
+ Begin scalar z,L;
+ If Not IDP x then return NIL;
+ L:=SYMPRP IDINF x;
+ If (Z:=Atsoc(y,L)) then return CDR Z;
+ Return NIL;
+ End;
+
+Procedure Put(x,y,z);
+ Begin scalar P,L;
+ If Not IDP x then return NIL;
+ L:=SYMPRP IDINF x;
+ If (P:=Atsoc(y,L)) then return %
+ <<CDR(PairInf P):=z; z>>;
+ L:=CONS(CONS(y,z),L);
+ SYMPRP(IDINF x):=L;
+ Return z;
+ End;
+
+Procedure RemProp(x,y);
+ Begin scalar P,L;
+ If Not IDP x then return NIL;
+ L:=SYMPRP IDINF x;
+ If not(P:=Atsoc(y,L)) then return NIL;
+ L:=Delatq(y,L);
+ SYMPRP(IDINF x):=L;
+ Return CDR P;
+ End;
+
+Procedure GetFnType x;
+ Get(x,'TYPE);
+
+off syslisp;
+
+end;
ADDED psl-1983/3-1/tests/mini-putd-getd.red
Index: psl-1983/3-1/tests/mini-putd-getd.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-putd-getd.red
@@ -0,0 +1,57 @@
+
+% MINI-PUTD-GETD.RED Small COPYD, GETD, PUTD
+
+on syslisp;
+
+Procedure Getd(fn);
+ Begin scalar type;
+ if Not IDP fn then return
+ <<Prin2 "*** Can only GETD off ID's: ";
+ Print fn;
+ NIL>>;
+ if FunBoundP fn then return NIL;
+ if null(type:=Get(fn,'TYPE)) then type:='Expr;
+ if FCodeP fn then return ( type . GetFcodePointer fn);
+ If FLambdaLinkP fn then return (type .Get(fn,'!*LambdaLink));
+ Prin2 "*** GETD should find a LAMBDA or CODE";
+ print fn;
+ return NIL;
+ End;
+
+Procedure PutD(fn,type,body);
+ Begin
+ if Not IDP fn then return
+ <<Prin2 "*** Can only define ID's as functions: ";
+ Print fn;
+ NIL>>;
+ if FCodeP fn then
+ <<Prin2 "*** Redefining a COMPILED function: ";
+ Print fn>>
+ else if not FunBoundP fn then
+ <<prin2 " Redefining function ";
+ print fn>>;
+ Remprop(fn,'!*LambdaLink);
+ Remprop(fn,'TYPE);
+ MakeFUnBound fn;
+ If LambdaP body then
+ << Put(fn,'!*LambdaLink,body);
+ MakeFlambdaLink fn>>
+ else if CodeP body then
+ MakeFcode(fn,body)
+ else return <<Prin2 "*** Body must be a LAMBDA or CODE";
+ prin1 fn; prin2 " "; print body; NIL>>;
+ If not(type eq 'expr) then Put(fn,'TYPE,type);
+ return fn;
+ End;
+
+syslsp procedure code!-number!-of!-arguments cp;
+begin scalar n;
+ return if codep cp then
+ << n := !%code!-number!-of!-arguments CodeInf cp;
+ if n >= 0 and n <= MaxArgs then n >>;
+end;
+
+off syslisp;
+
+End;
+
ADDED psl-1983/3-1/tests/mini-rds-wrs.red
Index: psl-1983/3-1/tests/mini-rds-wrs.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-rds-wrs.red
@@ -0,0 +1,21 @@
+% MINI-RDS-WRS.RED
+
+Fluid '(IN!* Out!*);
+
+Procedure RDS N;
+ If NULL N then RDS 0
+ else begin scalar K;
+ K:=IN!*;
+ IN!*:=N;
+ Return K
+ end;
+
+Procedure WRS N;
+ If NULL N then WRS 1
+ else begin scalar K;
+ K:=Out!*;
+ Out!*:=N;
+ Return K
+ end;
+
+End;
ADDED psl-1983/3-1/tests/mini-read.red
Index: psl-1983/3-1/tests/mini-read.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-read.red
@@ -0,0 +1,25 @@
+% MINI-READ.RED - A small reader
+
+CompileTime <<GLOBAL '(DEBUG);
+ FLUID '(TOK!* TOKTYPE!* CH!* !*RAISE);>>;
+
+Procedure READ;
+% start RATOM, get first fresh token
+ Read1(Ratom());
+
+Procedure READ1(x);
+ If x eq '!( then READLIST(RATOM()) % Skip the (
+ else if x eq '!' then CONS('QUOTE, NCONS READ())
+ else x;
+
+Procedure ReadList(x);
+% read LIST, starting at token x
+ Begin scalar y;
+ If x eq '!) then Return NIL;
+ y:=Read1(x); % Finish read CAR of pair
+ x:=Ratom(); % Check dot
+ If x eq '!. then return CONS(y,car READLIST(RATOM()));
+ Return CONS(y , READLIST(x))
+End;
+
+End;
ADDED psl-1983/3-1/tests/mini-sequence.red
Index: psl-1983/3-1/tests/mini-sequence.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-sequence.red
@@ -0,0 +1,16 @@
+% MINI-SEQUENCE.RED: Susbet of Strings, sequence etc for testing
+
+on syslisp;
+
+syslsp procedure MkString(L, C);
+% Make str with upb L, all chars C
+begin scalar L1, S;
+ if IntP L then L1 := IntInf L else return NonIntegerError(L, 'MkString);
+ if L1 < -1 then return NonPositiveIntegerError(L, 'MkString);
+ S := GtStr L1;
+ for I := 0 step 1 until L1 do
+ StrByt(S, I) := C;
+ return MkSTR S;
+end;
+off syslisp;
+End;
ADDED psl-1983/3-1/tests/mini-symbol-values.red
Index: psl-1983/3-1/tests/mini-symbol-values.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-symbol-values.red
@@ -0,0 +1,10 @@
+% MINI-SYMBOL-VALUES.RED
+
+Procedure Set(x,y);
+ Begin
+ If IDP x then SYMVAL(IDINF x):=y
+ else <<prin2 '"**** Non-ID in SET: ";Print x>>;
+ return y;
+ End;
+
+End;
ADDED psl-1983/3-1/tests/mini-token.red
Index: psl-1983/3-1/tests/mini-token.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-token.red
@@ -0,0 +1,124 @@
+% MINI-TOKEN.RED - Small Token scanner for testing
+
+CompileTime <<GLOBAL '(DEBUG);
+ FLUID '(TOK!* TOKTYPE!* CH!* !*RAISE);>>;
+
+ON SYSLISP;
+
+Wstring Buffer[100];
+ % Will hold characters as they are parsed for ID, INT and string
+
+Procedure InitRead;
+ % Initialize various RATOM and READ properties
+ Begin
+ LISPVAR(!*RAISE) := 'NIL;
+ LISPVAR(CH!*) := Char '! ;
+ LispVar(Tok!*):= 'NIL;
+ LispVar(TokType!*) := 2;
+ If LispVar(DEBUG) then <<Prin2 '"NextSymbol ="; Print Nextsymbol>>;
+ End;
+
+Procedure SetRaise x;
+ LISPVAR(!*RAISE) := x;
+
+Procedure Ratom;
+ % Read a single ATOM: ID, POSINT, STRING or SPECIAL
+ Begin
+ L: ClearWhite();
+ If LispVar(CH!*) eq Char '!% then <<ClearComment(); goto L>>;
+ If LISPVAR(CH!*) eq Char '!"
+ then Return <<LispVar(TokType!*):=0;LispVar(Tok!*):=ReadStr()>>;
+ If DigitP LISPVAR(CH!*)
+ then Return <<LispVar(TokType!*):=1;LispVar(Tok!*):=ReadInt()>>;
+ If AlphaEscP LISPVAR(CH!*)
+ then Return <<LispVar(TokType!*):=2;LispVar(Tok!*):=ReadId()>>;
+ LispVar(TokType!*):=3;
+ LispVar(Tok!*):=MkItem(ID,LISPVAR(CH!*));
+ LISPVAR(CH!*):=Char '! ; % For read Ahead
+ Return LispVar(Tok!*)
+ End;
+
+Procedure ClearWhite();
+% Clear out white space
+ While WhiteP LISPVAR(CH!*) do LISPVAR(CH!*):=GetC();
+
+Procedure ClearComment();
+% Scan for Comment EOL
+ While LispVar(CH!*) neq char EOL do LISPVAR(CH!*):=GetC();
+
+Procedure ReadInt;
+% Parse NUMERIC characters into a POSITIVE integer
+ Begin scalar N;
+ N:=LISPVAR(CH!*)-Char 0;
+ While DigitP(LISPVAR(CH!*):=GetC())
+ do N:=LongTimes(10,N)+(LISPVAR(CH!*)-Char 0);
+ Return Mkitem(POSINT,N);
+ End;
+
+Procedure BufferToString n;
+% Convert first n chars of Buffer into a heap string
+ Begin scalar s;
+ s:=GtStr(n);
+ for i:=0:n do strbyt(s,i):=strbyt(Buffer,i);
+ return MkStr s;
+ End;
+
+Procedure ReadStr;
+% Parse "...." into a heap string
+ Begin scalar n;
+ n:=-1;
+ While ((LISPVAR(CH!*):=Getc())neq Char '!")
+ do <<N:=N+1;Strbyt(Buffer,n):=LISPVAR(CH!*)>>;
+ LISPVAR(CH!*):=char '! ;
+ Return BufferToString(n);
+ End;
+
+Procedure ReadID;
+% Parse Characters into Buffer, Make into an ID
+ Begin scalar n,s,D;
+ n:=0;
+ StrByt(Buffer,0):=RaiseChar LISPVAR(CH!*);
+ While AlphaNumEscP(LISPVAR(CH!*):=Getc())
+ do <<N:=N+1;Strbyt(Buffer,n):=RaiseChar LISPVAR(CH!*)>>;
+ Return Intern BufferToString(n);
+ End;
+
+
+Procedure RaiseChar c;
+ If EscapeP c then Getc()
+ else if not LispVar !*Raise then c
+ else if not AlphaP c then c
+ else if LowerCaseP c then Char A +(c-Char Lower a)
+ else c;
+
+Procedure WhiteP x;
+ x=CHAR(BLANK) or x=CHAR(EOL) or x=CHAR(TAB) or x=CHAR(LF)
+ or x=CHAR(FF) or x =CHAR(CR);
+
+Procedure DigitP x;
+ Char(0) <=x and x <=Char(9);
+
+Procedure AlphaP(x);
+ UpperCaseP x or LowerCaseP x;
+
+Procedure UpperCaseP x;
+ Char(A)<=x and x<=Char(Z);
+
+Procedure LowerCaseP x;
+ Char(Lower A)<=x and x<=Char(Lower Z);
+
+Procedure EscapeP x;
+ x eq Char '!!;
+
+Procedure AlphaEscP x;
+ EscapeP x or AlphaP x;
+
+Procedure AlphaNumP x;
+ DigitP(x) or AlphaP(x);
+
+Procedure AlphaNumEscP x;
+ EscapeP x or AlphaNumP x;
+
+Off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-top-loop.red
Index: psl-1983/3-1/tests/mini-top-loop.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-top-loop.red
@@ -0,0 +1,6 @@
+% MINI-TOP-LOOP.RED
+
+Procedure Time();
+ Timc();
+
+End;
ADDED psl-1983/3-1/tests/mini-type-conversions.red
Index: psl-1983/3-1/tests/mini-type-conversions.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-type-conversions.red
@@ -0,0 +1,14 @@
+% MINI-TYPE-CONVERSIONS.RED
+
+on syslisp;
+
+syslsp procedure Sys2Int N; %. Convert word to Lisp number
+ if SignedField(N, InfStartingBit - 1, InfBitLength + 1) eq N then N
+ else Sys2FIXN N;
+
+syslsp procedure SYS2FIXN N;
+ STDerror LIST(N, "too big for mini arith");
+
+off syslisp;
+
+End;
ADDED psl-1983/3-1/tests/mini-type-errors.red
Index: psl-1983/3-1/tests/mini-type-errors.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/mini-type-errors.red
@@ -0,0 +1,68 @@
+% MINI-TYPE-ERRORS.RED
+
+% Almost identical, just faked StdError and Bldmsg
+
+procedure TypeError(Offender, Fn, Typ);
+ <<Errorheader();
+ Prin2 "An attempt was made to do ";
+ prin1 Fn;
+ prin2 " on `";
+ prin1 Offender;
+ prin2 "', which is not ";
+ print Typ;
+ quit;
+>>;
+
+procedure UsageTypeError(Offender, Fn, Typ, Usage);
+<<Errorheader();
+ Prin2 "An attempt was made to use ";
+ prin1 Offender;
+ Prin2 " as ";
+ Prin1 Usage;
+ prin2 " in `";
+ prin1 Fn;
+ prin2 "`, where ";
+ prin1 Typ;
+ prin2t " is needed";
+ quit;
+>>;
+
+procedure IndexError(Offender, Fn);
+ UsageTypeError(Offender, Fn, "an integer", "an index");
+
+procedure NonPairError(Offender, Fn);
+ TypeError(Offender, Fn, "a pair");
+
+procedure NonIdError(Offender, Fn);
+ TypeError(Offender, Fn, "an identifier");
+
+procedure NonNumberError(Offender, Fn);
+ TypeError(Offender, Fn, "a number");
+
+procedure NonIntegerError(Offender, Fn);
+ TypeError(Offender, Fn, "an integer");
+
+procedure NonPositiveIntegerError(Offender, Fn);
+ TypeError(Offender, Fn, "a non-negative integer");
+
+procedure NonCharacterError(Offender, Fn);
+ TypeError(Offender, Fn, "a character");
+
+procedure NonStringError(Offender, Fn);
+ TypeError(Offender, Fn, "a string");
+
+procedure NonVectorError(Offender, Fn);
+ TypeError(Offender, Fn, "a vector");
+
+procedure NonWords(Offender, Fn);
+ TypeError(Offender, Fn, "a words vector");
+
+procedure NonSequenceError(Offender, Fn);
+ TypeError(Offender, Fn, "a sequence");
+
+procedure NonIOChannelError(Offender, Fn);
+ TypeError(Offender, Fn, "a legal I/O channel");
+
+End;
+
+
ADDED psl-1983/3-1/tests/nbigtest.doc
Index: psl-1983/3-1/tests/nbigtest.doc
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/nbigtest.doc
@@ -0,0 +1,25 @@
+15-Mar-83 08:09:34-MST,000000728;000000000001
+Date: 15 Mar 1983 0809-MST
+From: Martin.Griss <Griss@UTAH-20>
+To: kessLER
+cc: griss
+
+Need to experiment with NBIG0 on Apollo. There may be still a small bug.
+
+Test as follows. Ship that latest NBIG0.RED that I sent you, rebuild it.
+Then ship and built PT:nbtest stuff.
+
+Load NBIG.LAP and NBTEST.B, call NTEST1 40; show1 40.
+
+This should work, and you should see a smooth range of INTEGERS, NEG intergers
+and correspnding floats (good test of WRUTE-FLOAT)
+
+
+Then call SETBITS 32; rerun NTEST1 40; SHOW1 40; I get signs incorrectly
+flipping at FIXNUM/BIGNUM transition points.
+
+I belive its related to a possibel BUG in 32-bit arith.
+
+Also compare <griss>32-bit.red with what lowder is running.
+M
+-------
ADDED psl-1983/3-1/tests/nbtest.b
Index: psl-1983/3-1/tests/nbtest.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/nbtest.b
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/nbtest.build
Index: psl-1983/3-1/tests/nbtest.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/nbtest.build
@@ -0,0 +1,1 @@
+in "nbtest.red"$
ADDED psl-1983/3-1/tests/nbtest.red
Index: psl-1983/3-1/tests/nbtest.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/nbtest.red
@@ -0,0 +1,90 @@
+% NBTEST.RED - Test Bignum Numeric transition points
+% And other numeric tests
+% M. L. Griss, 6 Feb 1983
+
+procedure fact N;
+ Begin scalar m;
+ m:=1;
+ while n>0 do <<m:=m*n; n:=n-1>>;
+ return m;
+ End;
+
+on syslisp;
+
+syslsp procedure Ifact N;
+ Begin scalar m;
+ m:=1;
+ while n>0 do <<m:=m*n; n:=n-1>>;
+ return m;
+ End;
+
+syslsp procedure ftest(n,m);
+ for i:=1:n do fact m;
+
+syslsp procedure Iftest(n,m);
+ for i:=1:n do ifact m;
+
+off syslisp;
+
+procedure Ntest0;
+ Begin scalar n;
+ N:=36;
+ pos:=mkvect n;
+ neg:=mkvect n;
+ pos[0]:=1; neg[0]:=-1;
+ for i:=1:N do <<pos[i]:=2*pos[i-1];
+ neg[i]:=(-pos[i])>>;
+end;
+
+procedure show0 n;
+<<show(n,pos,'ntype0);
+ show(n,neg,'ntype0)>>;
+
+procedure Ntest1;
+ Begin scalar n;
+ N:=40;
+ newpos:=mkvect n;
+ newneg:=mkvect n;
+ newpos[0]:=1; newneg[0]:=-1;
+ for i:=1:n do <<newpos[i]:=2*newpos[i-1];
+ newneg[i]:=(-newpos[i])>>;
+end;
+
+procedure show1 n;
+<<show(n,newpos,'ntype1);
+ show(n,newneg,'ntype1)>>;
+
+on syslisp;
+
+procedure NType0 x;
+ case tag x of
+ posint: 'POSINT;
+ negint: 'negint;
+ fixn: 'FIXN;
+ bign: 'BIGN;
+ fltn: 'fltn;
+ default: 'NIL;
+ end;
+
+procedure NType1 x;
+ if Betap x and x>=0 then 'POSBETA
+ else if Betap x and x<0 then 'NEGBETA
+ else case tag x of
+ posint: 'POSINT;
+ negint: 'negint;
+ fixn: 'FIXN;
+ bign: 'BIGN;
+ fltn: 'fltn;
+ default: 'NIL;
+ end;
+
+off syslisp;
+
+procedure show(N,v,pred);
+ for i:=0:N do
+ printf("%p%t%p%t%p%t%p%n",i,5,apply(pred,list(v[i])),20,v[i],40,float v[i]);
+
+end;
+
+
+
ADDED psl-1983/3-1/tests/new-sym.red
Index: psl-1983/3-1/tests/new-sym.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/new-sym.red
@@ -0,0 +1,59 @@
+% Replacements for functions in usual xxx-CROSS.EXE which only read/write
+% xxx.SYM if flags !*symread/!*symwrite are T; otherwise symbols are
+% assumed to be already loaded (read case) or the cross-compiler is to
+% be saved intact with symbols (write case).
+
+
+lisp procedure ASMEnd;
+<< off SysLisp;
+ if !*MainFound then
+ << CompileUncompiledExpressions();
+% WriteInitFile();
+ InitializeSymbolTable() >>
+ else WriteSymFile();
+ CodeFileTrailer();
+ Close CodeOut!*;
+ DataFileTrailer();
+ Close DataOut!*;
+ Close InitOut!*;
+ RemD 'Lap;
+ PutD('Lap, 'EXPR, cdr GetD 'OldLap);
+ DFPRINT!* := NIL;
+ !*DEFN := NIL;
+ WriteSaveFile()
+ >>;
+
+lisp procedure ReadSymFile();
+ if !*symread then
+ LapIN InputSymFile!*
+ else off usermode;
+
+lisp procedure WriteSymFile();
+begin scalar NewOut, OldOut;
+ if !*symwrite then <<
+ OldOut := WRS(NewOut := Open(OutputSymFile!*, 'OUTPUT));
+ print list('SaveForCompilation,
+ MkQuote('progn . car ToBeCompiledExpressions!*));
+ SaveIDList();
+ SetqPrint 'NextIDNumber!*;
+ SetqPrint 'StringGenSym!*;
+ MapObl function PutPrintEntryAndSym;
+ WRS OldOut;
+ Close NewOut; >>;
+end;
+
+lisp procedure WriteSaveFile();
+ if !*symsave and (null !*mainfound) then
+% restore some initial conditions
+ <<!*usermode := nil;
+ DataExporteds!* := DataExternals!* := nil;
+ CodeExporteds!* := CodeExternals!* := nil;
+ !*MainFound:= nil;
+% save the cross-compiler with symbol tables intact
+ dumplisp(cross!-compiler!-name)
+ >>;
+!*symwrite := !*symread := nil;
+!*symsave := T;
+
+
+
ADDED psl-1983/3-1/tests/new-test-case.red
Index: psl-1983/3-1/tests/new-test-case.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/new-test-case.red
@@ -0,0 +1,263 @@
+ 5-Apr-83 07:45:58-MST,6502;000000000001
+Return-path: <@UTAH-CS:GRISS@HP-HULK>
+Received: from UTAH-CS by UTAH-20; Tue 5 Apr 83 07:43:05-MST
+Date: 5 Apr 1983 0633-PST
+From: GRISS@HP-HULK
+Subject: New-test-case.red
+Message-Id: <418401289.19796.hplabs@HP-VENUS>
+Received: by HP-VENUS via CHAOSNET; 5 Apr 1983 06:34:46-PST
+Received: by UTAH-CS.ARPA (3.320.5/3.7.6)
+ id AA04736; 5 Apr 83 07:41:40 MST (Tue)
+To: kessler@HP-VENUS, griss@HP-VENUS
+
+
+% Tools to analyse the standard timing tests
+Fluid '(TestNames Fullnames Tests);
+imports '(mathlib);
+
+procedure readtest(name,fil);
+ Begin scalar chan,body;
+ chan := open(fil,'input);
+ body:=channelread chan;
+ put(name,'fullname,car body);
+ body:=list(name) . cdr body;
+ set(name,body);
+ TestNames := name . TestNames;
+ close chan;
+ return body;
+ End;
+
+procedure readalltests;
+ Begin TestNames:=nil;
+ Readtest('TestCray,"test-cray.tim");
+ Readtest('Std20,"standard-20.tim");
+ Readtest('Test20,"test-20.tim");
+ Readtest('Ext20,"extended-20.tim");
+ Readtest('TestExt20,"extended-test-20.tim");
+ Readtest('Fasthp9836,"16mhz-hp9836.tim");
+ Readtest('Std780,"standard-vax-780.tim");
+ Readtest('Fast780,"fast-780.tim");
+ Readtest('Franz780,"Franz-780.tim");
+ Readtest('Std750,"standard-vax-750.tim");
+ Readtest('Franz750,"Franz-750.tim");
+ Readtest('Stdhp9836,"standard-hp9836.tim");
+ Readtest('StdApollo,"standard-Apollo.tim");
+% Non PSL
+ Readtest('LM2,"LM2-hp.tim");
+ Readtest('BlkDolphin,"Block-dolphin.tim");
+ Print Testnames;
+ Tests :=Evlis TestNames;
+ return TestNames;
+ End;
+
+Procedure Show body;
+Begin scalar HDR,fn;
+ HDR:=car body;
+ If (fn:=Get(car HDR,'ShowFn)) then return Apply(fn,list body);
+% Default Case
+ Terpri();
+ prin2l car body; % Header
+ Terpri();
+ While (body:=cdr body) do
+ printf("%w%t%w%n",trimblanks caar body,Tab!*,NiceNum cdar body);
+End;
+
+procedure Lookup(Body,Facet);
+ Begin scalar value;
+ If pairp(value:=assoc(Facet,cdr Body)) then return cdr value;
+ return 0.0;
+ End;
+
+procedure ShowTotal Body;
+Begin scalar Hdr;
+ Hdr:=car Body;
+ printf("%p: %tTot%w, avg%w, dev %w , %w tests%n",
+ Hdr, 10, Nicenum Lookup(Body,'total),
+ nicenum Lookup(Body,'Average),
+ nicenum Lookup(Body,'Deviation),
+ Nicenum Lookup(Body,'Number));
+End;
+
+put('total, 'showfn,' ShowTotal);
+
+Procedure Total body;
+ Begin scalar Hdr,knt,tot,avg,dev,b;
+ Knt:=0;
+ Tot:=0;
+ Dev:=0;
+ Hdr:=car Body;
+ While body:=cdr body do
+ <<knt:=knt+1;
+ b:=cdar body;
+ tot:=tot + b;
+ dev := b*b+dev;
+ >>;
+ Avg:=float(Tot)/knt;
+ dev:=float(dev)/knt;
+ dev:=dev-(avg*avg);
+ dev:=sqrt(dev);
+ b:=list('Total . Hdr,
+ 'Total . tot,
+ 'Average . avg,
+ 'Deviation . dev,
+ 'Number .knt);
+ return b
+ End;
+
+procedure Ratio(Body1,Body2);
+% Divide elements of Body1 by Elements of Body2
+ Begin scalar Hdr1,Hdr2,Rat,b1,b2,r,knt,avg,dev;
+ Hdr1:=car body1; Hdr2:= car Body2;
+ Body1:=cdr body1; Body2:=cdr Body2;
+ If length body1 neq length body2 Then return "Length mismatch";
+ knt:=0; avg:=0; dev:=0;
+ While Body1 do
+ <<b1:=cdar body1; c:= caar body1; body1:=cdr body1;
+ b2:=cdar body2; body2:=cdr body2;
+ r:=float(b1)/b2;
+ avg:=r + avg;
+ dev:=r*r +dev;
+ knt:=knt+1;
+ rat := (c . r) . rat;
+ >>;
+ avg:=float(avg)/knt;
+ dev:=float(dev)/knt;
+ dev:=dev-(avg*avg);
+ dev:=sqrt dev;
+ rat := list('ratio,hdr1,hdr2) . reverse rat;
+ return rat;
+end;
+
+procedure ratio20 body;
+ Ratio(Body,std20);
+
+procedure Ratio780 body;
+ Ratio(Body,std780);
+
+procedure Ratio750 body;
+ Ratio(body,std780);
+
+procedure Ratiohp9836 body;
+ Ratio(body,stdhp9836);
+
+procedure MapTest(Fns,TestList);
+% Apply each Fn in Fns to each test in list
+ for each Test in TestList
+ collect applyFns(Reverse FnS,list Test);
+
+Procedure ApplyFns(Fns,Args);
+ If Not Pairp Fns then Car Args % Pass back
+ else ApplyFns(cdr Fns, List Apply(car Fns,Args));
+
+procedure MapBody(Fns,Body);
+% Apply series of Fns to each Element in Body of test
+ Begin
+ For each Fn in Fns do
+ Body:=(Fn . car Body) . MapBody1(Fn, cdr body);
+ return Body;
+ End;
+
+procedure MapBody1(Fn,Body);
+ If Null Body then NIL
+ else ( caar body . Apply(Fn,list cdar body)) . MapBody1 (fn,cdr Body);
+
+%standard Maps
+
+Procedure Invert Body;
+ MapBody('(Inverted), Body);
+
+Procedure Inverted x;
+ 1.0/x;
+
+procedure Logarithm Body;
+ MapBody('(LOG),Body);
+
+procedure summary();
+ <<readalltests();
+ wrs open("summary.tim",'output);
+ printf("%n%n SUMMARY TESTS on %w%n%n",DATE());
+ mapall();
+ close wrs nil>>;
+
+Procedure MapAll;
+ Begin scalar t20;
+
+ T20:=Total Std20;
+
+ Printf "%n Total Times %n";
+ MapTest('(show total),Tests);
+
+ Printf "%n Ratio of Total Times to STD20%n";
+ for each test in Tests do
+ showtotal ratio(Total test,t20);
+
+ Printf "%n Average Each test Ratios to STD20%n";
+ MapTest('(show total ratio20),Tests);
+
+ PrintF "%n 68000 Total times%n";
+ showtotal ratio(total StdHp9836,total FastHp9836);
+ showtotal ratio(total StdApollo,total StdHp9836);
+
+ PrintF "%n 68000 average ratios%n";
+ show total ratio(StdHp9836,FastHp9836);
+ show total ratio(StdApollo,StdHp9836);
+ End;
+
+procedure MapFileAll(fil,Fns);
+ Begin scalar chan;
+ chan:=open(fil,'output);
+ wrs chan;
+ MapTest(Fns,Tests);
+ wrs nil;
+ close chan;
+ End;
+
+% Nicer printing
+
+procedure MakePowers(Base,M);
+ Begin scalar V;
+ V:=Mkvect M;
+ v[0]:=1;
+ for i:=1:M do V[i]:=Base* V[i-1];
+ return V;
+ End;
+
+Tens!* := MakePowers(10,10);
+
+Procedure FLTRND(N,fld);
+ If floatp N then Fix(FLD*N+.5)/float(fld) else N;
+
+Procedure NiceNum N;
+ PadNM(N,nice!*,Fld!*);
+
+FLD!*:=3;
+Nice!*:=7;
+Tab!*:=30;
+
+Procedure PADNM(Num,n,m);
+% LeftPAD number in Field of N;
+ Begin scalar m1,m2,FixPart;
+ FixPart :=Fix Num;
+ m1:=BLDMSG("%p",FIXPART);
+ N:=N-Size(m1)-1; % Number of Blanks
+ if n>0 then m1:=Concat(MkString(n-1,32),m1);
+ if m>0 then <<NUM := NUM-Fixpart;
+ m2:=BLDMSG("%p",FIX(num*Tens!*[m]+0.5));
+ M:=M-size(m2)-1; % Number of 0s
+ if m>0 then m2:=Concat(MkString(m-1,48),m2);
+ m1:=Concat(m1,concat(".",m2))>>;
+ return m1;
+ End;
+
+procedure TrimBlanks S;
+ Begin scalar N;
+ if not stringp s then return s;
+ n:=Size s;
+ While n>0 and (s[n]=char BLANK or s[n] = char TAB) do n:=n-1;
+ return sub(s,0,n);
+ End;
+
+End;
+-------
+
+
ADDED psl-1983/3-1/tests/new-time-psl.sl
Index: psl-1983/3-1/tests/new-time-psl.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/new-time-psl.sl
@@ -0,0 +1,49 @@
+% NEW-TIME.SL Driver of PSL "spectral" tests
+% After loading psl-timer.b, LAPIN this file
+
+(de test(x y)
+ (prin2 x)
+ (setq y (timeeval y))
+ (print y)
+ (setq Cases!* (cons (cons x y) Cases!*))
+ 0)
+
+(de rtest(x y)
+ (reclaim)
+ (test x y))
+
+(de printcases (fil)
+ (wrs (open fil 'output))
+ (setq c (reverse Cases!*))
+ (prin2t "(")
+ (while (pairp c) (print (car c)) (setq c (cdr c)))
+ (prin2t ")")
+ (close (wrs NIL))
+)
+(TestSetup)
+(setq Cases!* (cons (cons (versionname) (date)) NIL))
+(prin2 '!")
+(prin2 "PSL Spectral Tests, ") (prin2 (versionname))
+ (prin2 ", ") (prin2 (date))
+(prin2t '!")
+(rtest "EmptyTest-10000 " '(EmptyTest 10000))
+(test "GEmptyTest-10000 " '(SlowEmptyTest 10000))
+(test "Cdr1Test-100 " '(Cdr1Test 100))
+(test "Cdr2Test-100 " '(Cdr2Test 100))
+(test "CddrTest-100 " '(CddrTest 100))
+(test "ListOnlyCdrTest1 " '(ListOnlyCdrTest1))
+(test "ListOnlyCddrTest1 " '(ListOnlyCddrTest1))
+(test "ListOnlyCdrTest2 " '(ListOnlyCdrTest2))
+(test "ListOnlyCddrTest2 " '(ListOnlyCddrTest2))
+(test "ReverseTest-10 " '(ReverseTest 10))
+(rtest "MyReverse1Test-10 " '(MyReverse1Test 10))
+(rtest "MyReverse2Test-10 " '(MyReverse2Test 10))
+(rtest "LengthTest-100 " '(LengthTest 100))
+(test "ArithmeticTest-10000 " '(ArithmeticTest 10000))
+(test "EvalTest-10000 " '(EvalTest 10000))
+(test "tak-18-12-6 " '(topleveltak 18 12 6))
+(test "gtak-18-12-6 " '(toplevelgtak 18 12 6))
+(test "gtsta-g0 " '(gtsta 'g0))
+(test "gtsta-g1 " '(gtsta 'g1))
+
+
ADDED psl-1983/3-1/tests/old-time-psl.sl
Index: psl-1983/3-1/tests/old-time-psl.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/old-time-psl.sl
@@ -0,0 +1,47 @@
+% TIME-PSL.SL Driver of PSL "spectral" tests
+% After loading psl-timer.b, LAPIN this file
+
+(TestSetup)
+
+(progn (reclaim)
+ (prin2 "EmptyTest 10000 ")
+ (print (TimeEval '(EmptyTest 10000))) 0)
+(progn (prin2 "SlowEmptyTest 10000 ")
+ (print (TimeEval '(SlowEmptyTest 10000))) 0)
+(progn (prin2 "Cdr1Test 100 ")
+ (print (TimeEval '(Cdr1Test 100))) 0)
+(progn (prin2 "Cdr2Test 100 ")
+ (print (TimeEval '(Cdr2Test 100))) 0)
+(progn (prin2 "CddrTest 100 ")
+ (print (TimeEval '(CddrTest 100))) 0)
+(progn (prin2 "ListOnlyCdrTest1 ")
+ (print (TimeEval '(ListOnlyCdrTest1))) 0)
+(progn (prin2 "ListOnlyCddrTest1 ")
+ (print (TimeEval '(ListOnlyCddrTest1))) 0)
+(progn (prin2 "ListOnlyCdrTest2 ")
+ (print (TimeEval '(ListOnlyCdrTest2))) 0)
+(progn (prin2 "ListOnlyCddrTest2 ")
+ (print (TimeEval '(ListOnlyCddrTest2))) 0)
+(progn (prin2 "ReverseTest 10 ")
+ (print (TimeEval '(ReverseTest 10))) 0)
+(progn (reclaim)
+ (prin2 "MyReverse1Test 10 ")
+ (print (TimeEval '(MyReverse1Test 10))) 0)
+(progn (reclaim)
+ (prin2 "MyReverse2Test 10 ")
+ (print (TimeEval '(MyReverse2Test 10))) 0)
+(progn (reclaim)
+ (prin2 "LengthTest 100 ")
+ (print (TimeEval '(LengthTest 100))) 0)
+(progn (prin2 "ArithmeticTest 10000 ")
+ (print (TimeEval '(ArithmeticTest 10000))) 0)
+(progn (prin2 "EvalTest 10000 ")
+ (print (TimeEval '(EvalTest 10000))) 0)
+(progn (prin2 "tak 18 12 6 ")
+ (print (TimeEval '(topleveltak 18 12 6))) 0)
+(progn (prin2 "gtak 18 12 6 ")
+ (print (TimeEval '(toplevelgtak 18 12 6))) 0)
+(progn (prin2 "gtsta g0 ")
+ (print (TimeEval '(gtsta 'g0))) 0)
+(progn (prin2 "gtsta g1 ")
+ (print (TimeEval '(gtsta 'g1))) 0)
ADDED psl-1983/3-1/tests/other-machine.tim
Index: psl-1983/3-1/tests/other-machine.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/other-machine.tim
@@ -0,0 +1,41 @@
+12-Apr-83 10:11:22-MST,1358;000000000001
+Return-path: <marti@rand-unix>
+Received: from RAND-UNIX by UTAH-20; Tue 12 Apr 83 10:09:52-MST
+Date: Tuesday, 12 Apr 1983 09:05-PST
+To: griss at UTAH-20, kessler at UTAH-20
+Subject: Timing test foul up.
+From: marti at rand-unix
+
+Yes, you are right, they are for the 780. Corrected table is:
+
+ a b c d e
+
+Empty 10000 360 360 432 51 85
+Slow 10000 360 360 1072 629 1258
+CDR 1 (100) 6496 6497 5632 1700 2142
+CDR 2 (100) 2919 2918 1296 1292 1734
+CDDR (100) 2410 2410 912 1088 1377
+ListOnlyCDR1 20253 20522 5264 6630 9656
+ListOnlyCDDR 31733 31741 8080 13940 15708
+ListOnlyCDR2 38784 38784 30368 9299 10761
+ListOnlyCDDR2 49969 49978 33328 14569 18139
+REVERSE (10) 4402 4443 976 714 1156
+MyREVERSE (10) 5353 4340 2640 782 1139
+MyREVERSE2 (10) 4965 4861 1472 612 1479
+LENGTH (100) 8569 8570 5872 1734 2380
+Arithmetic (10000) 12694 13083 23808 952 1632
+EVAL (10000) 15374 15783 19616 6511 10200
+TAK 18 12 6 4813 4818 4880 765 1377
+GTAK 18 12 6 4732 4738 7408 4454 7463
+gtsta g0 77765 80279 66656 2363 4573
+gtsta g1 92125 93813 74544 2431 4505
+
+a = Dolphin 1.5 meg, Interlisp-D.
+b = Dolphin 1 meg, Interlisp-D.
+c = VAX Interlisp (not newest??).
+d = VAX 780 PSL RAND (tests by JBM).
+e = VAX 750 PSL RAND (tests by JBM).
+
+Heaven only knows where I got those from. I can't find them in the
+newsletters.
+Jed.
ADDED psl-1983/3-1/tests/p-allocators.red
Index: psl-1983/3-1/tests/p-allocators.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/p-allocators.red
@@ -0,0 +1,168 @@
+% P-ALLOCATORS.RED - Low level storage management
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+
+% Revisions:
+% MLG, 19 June 1983
+% Reset HeapLast to HeapPreviousLast in GTheap.
+% MLG, 20 Feb 1983
+% Moved space declarations to XXX-HEADER.RED
+% Duplicated code body for GtEvect
+% Added InitHeap in XXX-HEADER.RED
+% Modified comments
+% <PSL.KERNEL>ALLOCATORS.RED.4, 10-Jan-83 15:50:50, Edit by PERDUE
+% Added GtEVect
+
+on SysLisp;
+
+external Wvar HeapLowerBound,
+ HeapUpperBound,
+ HeapLast,
+ HeapPreviousLast,
+ HeapTrapBound,
+ NextBPS,
+ LastBPS;
+
+
+syslsp procedure GtHEAP N;
+% get heap block of N words
+if null N then (HeapUpperBound - HeapLast) / AddressingUnitsPerItem else
+<< HeapPreviousLast := HeapLast;
+ HeapLast := HeapLast + N*AddressingUnitsPerItem;
+ if HeapLast > HeapUpperBound then
+ << HeapLast:=HeapPreviousLast; % Reset pointer before RECLAIM
+ !%Reclaim();
+ HeapPreviousLast := HeapLast;
+ HeapLast := HeapLast + N*AddressingUnitsPerItem;
+ if HeapLast > HeapUpperBound then
+ FatalError "Heap space exhausted" >>;
+ HeapPreviousLast >>;
+
+syslsp procedure DelHeap(LowPointer, HighPointer);
+ if HighPointer eq HeapLast then HeapLast := LowPointer;
+
+syslsp procedure GtSTR N;
+% Allocate space for a string N chars
+begin scalar S, NW;
+ S := GtHEAP((NW := STRPack N) + 1);
+ @S := MkItem(HBytes, N);
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtConstSTR N;
+% allocate un-collected string for print name
+begin scalar S, NW; % same as GtSTR, but uses BPS, not heap
+ S := GtBPS((NW := STRPack N) + 1);
+ @S := N;
+ S[NW] := 0; % clear last word, including last byte
+ return S;
+end;
+
+syslsp procedure GtHalfWords N;
+% Allocate space for N halfwords
+begin scalar S, NW;
+ S := GtHEAP((NW := HalfWordPack N) + 1);
+ @S := MkItem(HHalfWords, N);
+ return S;
+end;
+
+syslsp procedure GtVECT N;
+% Allocate space for a vector N items
+begin scalar V;
+ V := GtHEAP(VECTPack N + 1);
+ @V := MkItem(HVECT, N);
+ return V;
+end;
+
+syslsp procedure GtEVECT N;
+% Allocate space for a Evector N items
+begin scalar V;
+ V := GtHEAP(VECTPack N + 1);
+ @V := MkItem(HVECT, N);
+ return V;
+end;
+
+
+syslsp procedure GtWRDS N;
+% Allocate space for N untraced words
+begin scalar W;
+ W := GtHEAP(WRDPack N + 1);
+ @W := MkItem(HWRDS, N);
+ return W;
+end;
+
+
+syslsp procedure GtFIXN();
+% allocate space for a fixnum
+begin scalar W;
+ W := GtHEAP(WRDPack 0 + 1);
+ @W := MkItem(HWRDS, 0);
+ return W;
+end;
+
+syslsp procedure GtFLTN();
+% allocate space for a float
+begin scalar W;
+ W := GtHEAP(WRDPack 1 + 1);
+ @W := MkItem(HWRDS, 1);
+ return W;
+end;
+
+
+
+syslsp procedure GtID();
+% Allocate a new ID
+% NextSymbol and HashTable are globally declared
+% IDs are allocated as a linked free list through the SymNam cell,
+% with a 0 to indicate the end of the list.
+begin scalar U;
+ if NextSymbol = 0 then
+ << Reclaim();
+ if NextSymbol = 0 then
+ return FatalError "Ran out of ID space" >>;
+ U := NextSymbol;
+ NextSymbol := SymNam U;
+ return U;
+end;
+
+
+syslsp procedure GtBPS N;
+% Allocate N words for binary code
+begin scalar B;
+ if null N then return((LastBPS - NextBPS)/AddressingUnitsPerItem);
+ % GTBPS NIL returns # left
+ B := NextBPS;
+ NextBPS := NextBPS + N*AddressingUnitsPerItem;
+ return if NextBPS > LastBPS then
+ StdError '"Ran out of binary program space"
+ else B;
+end;
+
+syslsp procedure DelBPS(Bottom, Top);
+% Return space to BPS
+ if NextBPS eq Top then NextBPS := Bottom;
+
+syslsp procedure GtWArray N;
+% Allocate N words for WVar/WArray/WString
+begin scalar B;
+ if null N then return((LastBPS - NextBPS)/AddressingUnitsPerItem);
+ % GtWArray NIL returns # left
+ B := LastBPS - N*AddressingUnitsPerItem;
+ return if NextBPS > B then
+ StdError '"Ran out of WArray space"
+ else
+ LastBPS := B;
+end;
+
+syslsp procedure DelWArray(Bottom, Top);
+% Return space for WArray
+ if LastBPS eq Bottom then LastBPS := Top;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/tests/p-apply-lap.red
Index: psl-1983/3-1/tests/p-apply-lap.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/p-apply-lap.red
@@ -0,0 +1,253 @@
+%
+% P-APPLY-LAP.RED - Inefficient, portable version of APPLY-LAP
+%
+% Author: Eric Benson and M. L. Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 29 July 1982
+% Copyright (c) 1982 University of Utah
+%
+% Modifications by M.L. Griss 25 October, 1982.
+% Added J. MacDonalds Mods of 29 January (for IBM, non neg stack index)
+% In CODEEVALAPLY
+% Functions which must be written non-portably,
+% "portable" versions defined in PT:TEST-FUNCTION-PRIMITIVES.RED
+
+% CodePrimitive
+% Takes the code pointer stored in the fluid variable CodePtr!*
+% and jumps to its address, without distubing any of the argument
+% registers. This can be flagged 'InternalFunction for compilation
+% before this file is compiled or done as an 'OpenCode and 'ExitOpenCode
+% property for the compiler.
+% CompiledCallingInterpreted
+% Called by some convention from the function cell of an ID which
+% has an interpreted function definition. It should store the ID
+% in the fluid variable CodeForm!* without disturbing the argument
+% registers, then finish with
+% (!*JCALL CompiledCallingInterpretedAux)
+% (CompiledCallingInterpretedAux may be flagged 'InternalFunction).
+% FastApply
+% Called with a functional form in (reg t1) and argument registers
+% loaded. If it is a code pointer or an ID, the function address
+% associated with either should be jumped to. If it is anything else
+% except a lambda form, an error should be signaled. If it is a lambda
+% form, store (reg t1) in the fluid variable CodeForm!* and
+% (!*JCALL FastLambdaApply)
+% (FastLambdaApply may be flagged 'InternalFunction).
+% UndefinedFunction
+% Called by some convention from the function cell of an ID (probably
+% the same as CompiledCallingInterpreted) for an undefined function.
+% Should call Error with the ID as part of the error message.
+
+Compiletime <<
+
+fluid '(CodePtr!* % gets code pointer used by CodePrimitive
+ CodeForm!* % gets fn to be called from code
+);
+>>;
+
+on Syslisp;
+
+external WArray CodeArgs;
+
+syslsp procedure CodeApply(CodePtr, ArgList);
+begin scalar I;
+ I := 0;
+ LispVar CodePtr!* := CodePtr;
+ while PairP ArgList and ILessP(I, 15) do
+ << WPutV(CodeArgs , I, first ArgList);
+ I := IAdd1 I;
+ ArgList := rest ArgList >>;
+ if IGEQ(I, 15)
+ then return StdError List("Too many arguments to function",I,CodePtr);
+ return case I of
+ 0: CodePrimitive();
+ 1: CodePrimitive WGetV(CodeArgs, 0);
+ 2: CodePrimitive(WGetV(CodeArgs, 0), WGetV(CodeArgs, 1));
+ 3: CodePrimitive(WGetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2));
+ 4: CodePrimitive(WGetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2), WgetV(CodeArgs, 3));
+ 5: CodePrimitive(WGetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4));
+ 6: CodePrimitive(WGetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WGetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WGetV(CodeArgs, 4), WgetV(CodeArgs, 5));
+ 7: CodePrimitive(WGetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6));
+ 8: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7));
+ 9: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8));
+ 10: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8), WgetV(CodeArgs, 9));
+ 11: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8), WgetV(CodeArgs, 9),
+ WgetV(CodeArgs, 10));
+ 12: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8), WgetV(CodeArgs, 9),
+ WgetV(CodeArgs, 10), WgetV(CodeArgs, 11));
+ 13: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8), WgetV(CodeArgs, 9),
+ WgetV(CodeArgs, 10), WgetV(CodeArgs, 11),
+ WgetV(CodeArgs, 12));
+ 14: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8), WgetV(CodeArgs, 9),
+ WgetV(CodeArgs, 10), WgetV(CodeArgs, 11),
+ WgetV(CodeArgs, 12), WgetV(CodeArgs, 13));
+ 15: CodePrimitive(WgetV(CodeArgs, 0), WgetV(CodeArgs, 1),
+ WgetV(CodeArgs, 2), WgetV(CodeArgs, 3),
+ WgetV(CodeArgs, 4), WgetV(CodeArgs, 5),
+ WgetV(CodeArgs, 6), WgetV(CodeArgs, 7),
+ WgetV(CodeArgs, 8), WgetV(CodeArgs, 9),
+ WgetV(CodeArgs, 10), WgetV(CodeArgs, 11),
+ WgetV(CodeArgs, 12), WgetV(CodeArgs, 13),
+ WgetV(CodeArgs, 14));
+ end;
+end;
+
+%lisp procedure CodeEvalApply(CodePtr, ArgList);
+% CodeApply(CodePtr, EvLis ArgList);
+
+lap '((!*entry CodeEvalApply expr 2)
+ (!*ALLOC 15)
+ (!*LOC (reg 3) (frame 15)) %/jim really wrong/
+% (!*LOC (reg 3) (frame 1)) %/jim: for non-neg stack indices on IBM/
+ % But must be base of a block of ascending
+ % addresses, check cmacros
+ (!*CALL CodeEvalApplyAux)
+ (!*EXIT 15)
+);
+
+syslsp procedure CodeEvalApplyAux(CodePtr, ArgList, P);
+begin scalar N;
+ N := 0;
+ while PairP ArgList and ILessP(N, 15) do
+ %/ << WPutV(P, ITimes2(StackDirection, N), Eval first ArgList); %/jim/
+ << WPutV(P, N, Eval first ArgList); %/jim/
+ ArgList := rest ArgList;
+ N := IAdd1 N >>;
+ if IGEQ(N, 15)
+ then return StdError list("Too many arguments to function",N,CodePtr);
+ LispVar CodePtr!* := CodePtr;
+ return case N of
+ 0: CodePrimitive();
+ 1: CodePrimitive(WgetV(P, 0));
+ 2: CodePrimitive(WgetV(P, 0), WgetV(P, 1));
+ 3: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2));
+ 4: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3));
+ 5: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4));
+ 6: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5));
+ 7: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6));
+ 8: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7));
+ 9: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8));
+ 10: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8),
+ WgetV(P, 9));
+ 11: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8),
+ WgetV(P, 9), WgetV(P, 10));
+ 12: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8),
+ WgetV(P, 9), WgetV(P, 10), WgetV(P, 11));
+ 13: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8),
+ WgetV(P, 9), WgetV(P, 10), WgetV(P, 11),
+ WgetV(P, 12));
+ 14: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8),
+ WgetV(P, 9), WgetV(P, 10), WgetV(P, 11),
+ WgetV(P, 12), WgetV(P, 13));
+ 15: CodePrimitive(WgetV(P, 0), WgetV(P, 1), WgetV(P, 2),
+ WgetV(P, 3), WgetV(P, 4), WgetV(P, 5),
+ WgetV(P, 6), WgetV(P, 7), WgetV(P, 8),
+ WgetV(P, 9), WgetV(P, 10), WgetV(P, 11),
+ WgetV(P, 12), WgetV(P, 13), WgetV(P, 14));
+ end;
+end;
+
+syslsp procedure BindEval(Formals, Args);
+ BindEvalAux(Formals, Args, 0);
+
+syslsp procedure BindEvalAux(Formals, Args, N);
+begin scalar F, A;
+ return if PairP Formals then
+ if PairP Args then
+ << F := first Formals;
+ A := Eval first Args;
+ N := BindEvalAux(rest Formals, rest Args, IAdd1 N);
+ if N = -1 then -1 else
+ << LBind1(F, A);
+ N >> >>
+ else -1
+ else if PairP Args then -1
+ else N;
+end;
+
+syslsp procedure CompiledCallingInterpretedAux();
+<< %Later Use NARGS also
+ % Recall that ID# in CODEFORM
+ CompiledCallingInterpretedAuxAux
+ get(MkID(LispVar CodeForm!*), '!*LambdaLink)>>;
+
+syslsp procedure FastLambdaApply();
+<< SaveRegisters();
+ CompiledCallingInterpretedAuxAux LispVar CodeForm!* >>;
+
+syslsp procedure CompiledCallingInterpretedAuxAux Fn;
+ if not (PairP Fn and car Fn = 'LAMBDA) then
+ StdError BldMsg("Ill-formed functional expression %r for %r",
+ Fn, LispVar CodeForm!*)
+ else begin scalar Formals, N, Result;
+ Formals := cadr Fn;
+ N := 0;
+ while PairP Formals do
+ << LBind1(car Formals,WgetV(CodeArgs, N));
+ Formals := cdr Formals;
+ N := IAdd1 N >>;
+ Result := EvProgN cddr Fn;
+ if N neq 0 then UnBindN N;
+ return Result;
+ end;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/tests/p-comp-gc.red
Index: psl-1983/3-1/tests/p-comp-gc.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/p-comp-gc.red
@@ -0,0 +1,472 @@
+%
+% p-comp-GC.RED - Compacting garbage collector for PSL
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% WARNING! This file has not been parameterized using
+% AddressingUnitsPerItem. It will not work on machines that
+% address bytes. /csp 3-1-83
+
+% All data types have either explicit header tag in first item,
+% or are assumed to be 1st element of pair.
+
+% Revision History:
+% Edit by Griss, 17 March 1983.
+% Move major data structures to XXX-HEADER: GCArray
+% Edit by Cris Perdue, 16 Feb 1983 1407-PST
+% Fixed GtHeap and collector(s) to use only HeapLast, not HeapPreviousLast
+% Sets HeapTrapped to NIL now.
+% Using known-free-space function
+% Added check of Heap-Warn-Level after %Reclaim
+% Defined and used known-free-space function
+% <PSL.KERNEL>COMPACTING-GC.RED.9, 4-Oct-82 17:59:55, Edit by BENSON
+% Added GCTime!*
+% <PSL.KERNEL>COMPACTING-GC.RED.3, 21-Sep-82 10:43:21, Edit by BENSON
+% Flagged most functions internal
+% (M.L. Griss, March, 1977).
+% (Update to speed up, July 1978)
+% Converted to Syslisp July 1980
+% En-STRUCT-ed, Eric Benson April 1981
+% Added EVECT tag, M. Griss, 3 July 1982
+fluid '(!*GC % Controls printing of statistics
+ GCTime!* % Total amount of time spent in GC
+ GCKnt!* % count of # of GC's since system build
+ heap!-warn!-level); % Continuable error if this much not
+ % free after %Reclaim.
+
+LoadTime <<
+ !*GC := T; % Do print GC messages (SL Rep says no)
+ GCTime!* := 0;
+ GCKnt!* := 0; % Initialize to zero
+ Heap!-Warn!-Level := 1000;
+>>;
+
+on Syslisp;
+
+
+% Predicates for whether to follow pointers
+
+external WVar HeapLowerBound, % Bottom of heap
+ HeapUpperBound, % Top of heap
+ HeapLast, % Last item allocated
+ HeapTrapped; % Boolean: has trap occurred since GC?
+
+CompileTime <<
+
+flag('(MarkFromAllBases BuildRelocationFields UpdateAllBases CompactHeap
+ MarkFromOneSymbol MakeIDFreeList
+ GCMessage MarkFromSymbols MarkFromRange MarkFromBase MarkFromVector
+ GCError UpdateSymbols UpdateRegion UpdateItem UpdateHeap),
+ 'NotYetInternalFunction);
+
+syslsp smacro procedure PointerTagP X;
+ X > PosInt and X < Code;
+
+syslsp smacro procedure WithinHeapPointer X;
+ X >= HeapLowerBound and X <= HeapLast;
+
+>>;
+
+% Marking primitives
+
+internal WConst GCMarkValue = 8#777,
+ HSkip = Forward;
+
+CompileTime <<
+syslsp smacro procedure Mark X; % Get GC mark bits in item X points to
+ GCField @X;
+
+syslsp smacro procedure SetMark X; % Set GC mark bits in item X points to
+ GCField @X := GCMarkValue;
+
+syslsp smacro procedure ClearMark X; % Clear GC mark bits in item X points to
+ GCField @X := if NegIntP @X then -1 else 0;
+
+syslsp smacro procedure Marked X; % Is item pointed to by X marked?
+ Mark X eq GCMarkValue;
+
+
+syslsp smacro procedure MarkID X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := Forward;
+
+syslsp smacro procedure MarkedID X;
+ Tag SymNam X eq Forward;
+
+syslsp smacro procedure ClearIDMark X;
+ Field(SymNam X, TagStartingBit, TagBitLength) := STR;
+
+
+% Relocation primitives
+
+syslsp smacro procedure SkipLength X; % Stored in heap header
+ Inf @X;
+
+syslsp smacro procedure PutSkipLength(X, L); % Store in heap header
+ Inf @X := L;
+
+put('SkipLength, 'Assign!-Op, 'PutSkipLength);
+>>;
+
+internal WConst BitsInSegment = 13,
+ SegmentLength = LShift(1, BitsInSegment),
+ SegmentMask = SegmentLength - 1;
+
+External WArray GCArray;
+
+
+CompileTime <<
+syslsp smacro procedure SegmentNumber X; % Get segment part of pointer
+ LShift(X - HeapLowerBound, -BitsInSegment);
+
+syslsp smacro procedure OffsetInSegment X; % Get offset part of pointer
+ LAnd(X - HeapLowerBound, SegmentMask);
+
+syslsp smacro procedure MovementWithinSegment X; % Reloc field in item
+ GCField @X;
+
+syslsp smacro procedure PutMovementWithinSegment(X, M); % Store reloc field
+ GCField @X := M;
+
+syslsp smacro procedure ClearMovementWithinSegment X; % Clear reloc field
+ GCField @X := if NegIntP @X then -1 else 0;
+
+put('MovementWithinSegment, 'Assign!-Op, 'PutMovementWithinSegment);
+
+syslsp smacro procedure SegmentMovement X; % Segment table
+ GCArray[X];
+
+syslsp smacro procedure PutSegmentMovement(X, M); % Store in seg table
+ GCArray[X] := M;
+
+put('SegmentMovement, 'Assign!-Op, 'PutSegmentMovement);
+
+syslsp smacro procedure Reloc X; % Compute pointer adjustment
+ X - (SegmentMovement SegmentNumber X + MovementWithinSegment X);
+>>;
+
+external WVar ST, % stack pointer
+ StackLowerBound; % bottom of stack
+
+% Base registers marked from by collector
+
+% SymNam, SymPrp and SymVal are declared for all
+
+external WVar NextSymbol; % next ID number to be allocated
+
+external WVar BndStkLowerBound, % Bottom of binding stack
+ BndStkPtr; % Binding stack pointer
+
+internal WVar StackEnd, % Holds address of bottom of stack
+ StackStart, % Holds address of top of stack
+ MarkTag, % Used by MarkFromBase only
+ Hole, % First location moved in heap
+ HeapShrink, % Total amount reclaimed
+ StartingRealTime;
+
+syslsp procedure Reclaim(); %. User call to garbage collector
+<< !%Reclaim();
+ NIL >>;
+
+syslsp procedure !%Reclaim(); % Garbage collector
+<< StackEnd := MakeAddressFromStackPointer ST - FrameSize();
+ StackStart := StackLowerBound;
+ if LispVar !*GC then ErrorPrintF "*** Garbage collection starting";
+ StartingRealTime := TimC();
+ LispVar GCKnt!* := LispVar GCKnt!* + 1; % must be INUM > 0, so needn't chk
+ MarkFromAllBases();
+ MakeIDFreeList();
+ BuildRelocationFields();
+ UpdateAllBases();
+ CompactHeap();
+ HeapLast := HeapLast - HeapShrink;
+ StartingRealTime := TimC() - StartingRealTime;
+ LispVar GCTime!* := Plus2(LispVar GCTime!*, StartingRealTime);
+ if LispVar !*GC then GCMessage();
+ HeapTrapped := NIL;
+ if IntInf known!-free!-space() < IntInf (LispVar Heap!-Warn!-Level) then
+ ContinuableError(99, "Heap space low", NIL);
+>>;
+
+syslsp procedure MarkFromAllBases();
+begin scalar B;
+ MarkFromSymbols();
+ MarkFromRange(StackStart, StackEnd);
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+ MarkFromBase @B;
+end;
+
+syslsp procedure MarkFromSymbols();
+begin scalar B;
+ MarkFromOneSymbol 128; % mark NIL first
+ for I := 0 step 1 until 127 do
+ if not MarkedID I then MarkFromOneSymbol I;
+ for I := 0 step 1 until MaxObArray do
+ << B := ObArray I;
+ if B > 0 and not MarkedID B then MarkFromOneSymbol B >>;
+end;
+
+syslsp procedure MarkFromOneSymbol X;
+% SymNam has to be marked from before marking ID, since the mark uses its tag
+% No problem since it's only a string, can't reference itself.
+<< MarkFromBase SymNam X;
+ MarkID X;
+ MarkFromBase SymPrp X;
+ MarkFromBase SymVal X >>;
+
+syslsp procedure MarkFromRange(Low, High);
+ for Ptr := Low step 1 until High do MarkFromBase @Ptr;
+
+syslsp procedure MarkFromBase Base;
+begin scalar MarkInfo;
+ MarkTag := Tag Base;
+ if not PointerTagP MarkTag then return
+ << if MarkTag = ID and not null Base then
+ << MarkInfo := IDInf Base;
+ if not MarkedID MarkInfo then MarkFromOneSymbol MarkInfo >> >>;
+ MarkInfo := Inf Base;
+ if not WithinHeapPointer MarkInfo
+ or Marked MarkInfo then return;
+ SetMark MarkInfo;
+CommentOutCode CheckAndSetMark MarkInfo;
+ return if MarkTag eq VECT or MarkTag eq EVECT then
+ MarkFromVector MarkInfo
+ else if MarkTag eq PAIR then
+ << MarkFromBase car Base;
+ MarkFromBase cdr Base >>;
+end;
+
+CommentOutCode <<
+syslsp procedure CheckAndSetMark P;
+begin scalar HeadAtP;
+ HeadAtP := Tag @P;
+ case MarkTag of
+ STR:
+ if HeadAtP eq HBYTES then SetMark P;
+ FIXN, FLTN, BIGN, WRDS:
+ if HeadAtP eq HWRDS then SetMark P;
+ VECT, EVECT:
+ if HeadAtP eq HVECT then SetMark P;
+ PAIR:
+ SetMark P;
+ default:
+ GCError("Internal error in marking phase, at %o", P)
+ end;
+end;
+>>;
+
+syslsp procedure MarkFromVector Info;
+begin scalar Uplim;
+CommentOutCode if Tag @Info neq HVECT then return;
+ Uplim := &VecItm(Info, VecLen Info);
+ for Ptr := &VecItm(Info, 0) step 1 until Uplim do
+ MarkFromBase @Ptr;
+end;
+
+syslsp procedure MakeIDFreeList();
+begin scalar Previous;
+ for I := 0 step 1 until 128 do
+ ClearIDMark I;
+ Previous := 129;
+ while MarkedID Previous and Previous <= MaxSymbols do
+ << ClearIDMark Previous;
+ Previous := Previous + 1 >>;
+ if Previous >= MaxSymbols then
+ NextSymbol := 0
+ else
+ NextSymbol := Previous; % free list starts here
+ for I := Previous + 1 step 1 until MaxSymbols do
+ if MarkedID I then ClearIDMark I
+ else
+ << SymNam Previous := I;
+ Previous := I >>;
+ SymNam Previous := 0; % end of free list
+end;
+
+syslsp procedure BuildRelocationFields();
+%
+% Pass 2 - Turn off GC marks and Build SEGKNTs
+%
+begin scalar CurrentItem, SGCurrent, IGCurrent, TmpIG, DCount, SegLen;
+ SGCurrent := IGCurrent := 0;
+ SegmentMovement SGCurrent := 0; % Dummy
+ Hole := HeapLowerBound - 1; % will be first hole
+ DCount := HeapShrink := 0; % holes in current segment, total holes
+ CurrentItem := HeapLowerBound;
+ while CurrentItem < HeapLast do
+ begin scalar Incr;
+ SegLen := case Tag @CurrentItem of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND,
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ 2; % must be first of pair
+ HBYTES:
+ 1 + StrPack StrLen CurrentItem;
+ HHalfwords:
+ 1 + HalfWordPack StrLen CurrentItem;
+ HWRDS:
+ 1 + WrdPack WrdLen CurrentItem;
+ HVECT:
+ 1 + VectPack VecLen CurrentItem;
+ HSKIP:
+ SkipLength CurrentItem;
+ default:
+ GCError("Illegal item in heap at %o", CurrentItem)
+ end; % case
+ if Marked CurrentItem then % a hole
+ if HeapShrink = 0 then
+ ClearMark CurrentItem
+ else % segment also clears mark
+ << MovementWithinSegment CurrentItem := DCount; % incremental shift
+ Incr := 0 >> % no shift
+ else
+ << @CurrentItem := MkItem(HSKIP, SegLen); % a skip mark
+ Incr := 1; % more shift
+ if Hole < HeapLowerBound then Hole := CurrentItem >>;
+ TmpIG := IGCurrent + SegLen; % set SEG size
+ CurrentItem := CurrentItem + SegLen;
+ while TmpIG >= SegmentLength do
+ begin scalar Tmp;
+ Tmp := SegmentLength - IGCurrent; % Expand to next SEGMENT
+ SegLen := SegLen - Tmp;
+ if Incr eq 1 then HeapShrink := HeapShrink + Tmp;
+ DCount := IGCurrent := 0;
+ SGCurrent := SGCurrent + 1;
+ SegmentMovement SGCurrent := HeapShrink; % Store Next Base
+ TmpIG := TmpIG - SegmentLength;
+ end;
+ IGCurrent := TmpIG;
+ if Incr eq 1 then
+ << HeapShrink := HeapShrink + SegLen;
+ DCount := DCount + SegLen >>; % Add in Hole Size
+ end;
+ SegmentMovement(SGCurrent + 1) := HeapShrink;
+end;
+
+syslsp procedure UpdateAllBases();
+begin scalar B;
+ UpdateSymbols();
+ UpdateRegion(StackStart, StackEnd);
+ B := BndStkLowerBound;
+ while << B := AdjustBndStkPtr(B, 1);
+ B <= BndStkPtr >> do
+ UpdateItem B;
+ UpdateHeap() >>;
+
+syslsp procedure UpdateSymbols();
+ for I := 0 step 1 until MaxSymbols do
+ begin scalar NameLoc;
+ NameLoc := &SymNam I;
+ if StringP @NameLoc then
+ << UpdateItem NameLoc;
+ UpdateItem &SymVal I;
+ UpdateItem &SymPrp I >>;
+ end;
+
+syslsp procedure UpdateRegion(Low, High);
+ for Ptr := Low step 1 until High do UpdateItem Ptr;
+
+syslsp procedure UpdateHeap();
+begin scalar CurrentItem;
+ CurrentItem := HeapLowerBound;
+ while CurrentItem < HeapLast do
+ begin
+ case Tag @CurrentItem of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND:
+ CurrentItem := CurrentItem + 1;
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ << if Inf @CurrentItem >= Hole and Inf @CurrentItem <= HeapLast then
+ Inf @CurrentItem := Reloc Inf @CurrentItem;
+ CurrentItem := CurrentItem + 1 >>;
+ HBYTES:
+ CurrentItem := CurrentItem + 1 + StrPack StrLen CurrentItem;
+ HHalfwords:
+ CurrentItem := CurrentItem + 1 + HalfwordPack StrLen CurrentItem;
+ HWRDS:
+ CurrentItem := CurrentItem + 1 + WrdPack WrdLen CurrentItem;
+ HVECT:
+ begin scalar Tmp;
+ Tmp := VecLen CurrentItem;
+ CurrentItem := CurrentItem + 1; % Move over header
+ for I := 0 step 1 until Tmp do % VecLen + 1 items
+ begin scalar Tmp2, Tmp3;
+ Tmp2 := @CurrentItem;
+ Tmp3 := Tag Tmp2;
+ if PointerTagP Tmp3
+ and Inf Tmp2 >= Hole and Inf Tmp2 <= HeapLast then
+ Inf @CurrentItem := Reloc Inf Tmp2;
+ CurrentItem := CurrentItem + 1;
+ end;
+ end;
+ HSKIP:
+ CurrentItem := CurrentItem + SkipLength CurrentItem;
+ default:
+ GCError("Internal error in updating phase at %o", CurrentItem)
+ end; % case
+ end
+end;
+
+syslsp procedure UpdateItem Ptr;
+begin scalar Tg, Info;
+ Tg := Tag @Ptr;
+ if not PointerTagP Tg then return;
+ Info := INF @Ptr;
+ if Info < Hole or Info > HeapLast then return;
+ Inf @Ptr := Reloc Info;
+end;
+
+syslsp procedure CompactHeap();
+begin scalar OldItemPtr, NewItemPtr, SegLen;
+ if Hole < HeapLowerBound then return;
+ NewItemPtr := OldItemPtr := Hole;
+ while OldItemPtr < HeapLast do
+ begin;
+ case Tag @OldItemPtr of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND,
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ SegLen := PairPack OldItemPtr;
+ HBYTES:
+ SegLen := 1 + StrPack StrLen OldItemPtr;
+ HHalfwords:
+ SegLen := 1 + HalfWordPack HalfwordLen OldItemPtr;
+ HWRDS:
+ SegLen := 1 + WrdPack WrdLen OldItemPtr;
+ HVECT:
+ SegLen := 1 + VectPack VecLen OldItemPtr;
+ HSKIP:
+ << OldItemPtr := OldItemPtr + SkipLength OldItemPtr;
+ goto WhileNext >>;
+ default:
+ GCError("Internal error in compaction at %o", OldItemPtr)
+ end; % case
+ ClearMovementWithinSegment OldItemPtr;
+ for I := 1 step 1 until SegLen do
+ << @NewItemPtr := @OldItemPtr;
+ NewItemPtr := NewItemPtr + 1;
+ OldItemPtr := OldItemPtr + 1 >>;
+ WhileNext:
+ end;
+end;
+
+syslsp procedure GCError(Message, P);
+<< ErrorPrintF("***** Fatal error during garbage collection");
+ ErrorPrintF(Message, P);
+ while T do Quit; >>;
+
+syslsp procedure GCMessage();
+<< ErrorPrintF("*** GC %w: time %d ms",
+ LispVar GCKnt!*, StartingRealTime);
+ ErrorPrintF("*** %d recovered, %d stable, %d active, %d free",
+ HeapShrink, Hole - HeapLowerBound,
+ HeapLast - Hole,
+ intinf known!-free!-space() ) >>;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/tests/p-fast-binder.red
Index: psl-1983/3-1/tests/p-fast-binder.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/p-fast-binder.red
@@ -0,0 +1,42 @@
+
+% P-FAST-BINDER.RED - Portable version of binding from compiled code
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 6 August 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% This file is for use with *LAMBIND and *PROGBIND in
+% PC:P-LAMBIND.SL
+
+StartupTime <<
+
+LambindArgs!* := GtWArray 15;
+
+>>;
+
+on Syslisp;
+
+syslsp procedure LamBind V;
+% V is vector of IDs
+begin scalar N;
+ V := VecInf V;
+ N := VecLen V;
+ for I := 0 step 1 until N do
+ LBind1(VecItm(V, I), (LispVar LambindArgs!*)[I]);
+end;
+
+syslsp procedure ProgBind V;
+begin scalar N;
+ V := VecInf V;
+ N := VecLen V;
+ for I := 0 step 1 until N do
+ PBind1 VecItm(V, I);
+end;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/tests/p-function-primitives.red
Index: psl-1983/3-1/tests/p-function-primitives.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/p-function-primitives.red
@@ -0,0 +1,245 @@
+% P-FUNCTION-PRIMITIVES Machine Independent for Test 5 and 6
+%
+% Author: M. L. Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 October 1982
+% Copyright (c) 1982 University of Utah
+%
+% Based on P20:Function-Primitives.Red
+% <PSL.TESTS>P-FUNCTION-PRIMITIVES.RED.4, 2-Mar-83 11:46:30, Edit by KESSLER
+% Put in Dealloc's before jump and jcall (search rrk)
+
+% Every ID has a "function cell". It does not necessarily contain a legal
+% Lisp item, and therefore should not be accessed directly by Lisp functions.
+% In this implementation the function cell contains an instruction to be
+% executed. There are 3 possibilites for this instruction, for which the
+% following predicates and updating functions exist:
+%
+% FUnBoundP(ID) -- the function is not defined
+% FLambdaLinkP(ID) -- the function is interpreted
+% FCodeP(ID) -- the function is compiled
+%
+% MakeFUnBound(ID) -- undefine the function
+% MakeFLambdaLink(ID) -- specify that the function is interpreted
+% MakeFCode(ID, CodePtr) -- specify that the function is compiled,
+% and that the code resides at the address
+% associated with CodePtr
+%
+% GetFCodePointer(ID) -- returns the contents of the function cell as a
+% code pointer
+%
+% See the templates in XXX-ASM.RED:
+%
+% DefinedFunctionCellFormat!*
+% UndefinedFunctionCellFormat!*
+
+
+% These functions currently check that they have proper arguments,
+% but this may change since they are only used by functions that
+% have checked them already.
+
+% Note that on some machines, SYMFNC(x) is entire SYMFNC cell.
+% on others it points into the cell, at the "address" part.
+%
+% Fairly Portable versions, based on assumption that
+% Starts with OPCODE, probably !*JCALL
+% !*Jcall SymfncBase UndefinedFunction in ShouldBeUndefined cell
+
+% Needs the machine-dependent procedures in XXX-HEADER:
+
+% !%Store!-JCALL(CodeAddress,StoreAddress)
+% to Create a !*Jcall(CodeAddress) at StoreAddress
+
+% !%Copy!-Function!-Cell(From,to)
+% to copy appropriate # words or bytes of Function cell
+on syslisp;
+
+smacro procedure SymFncBase D; % The Address of CELL,
+ % to which !*JCALL and !*CALL jump
+ Symfnc + AddressingUnitsPerFunctionCell*D;
+
+
+% Unbound Functions have a JCALL UndefinedFunction:
+% in the function cell, installed by the template
+
+syslsp procedure FUnBoundP Fn;
+% Check If undefn or Not
+ If not IDP Fn then NonIdError(Fn,'FunboundP)
+ else if (SymFnc IdLoc ShouldBeUndefined eq SymFnc IdInf Fn)
+ % Instead of SYMFNCBASE Idloc UndefinedFunction, since its
+ % of course DEFINED, and has to agree with the KernelTime template
+ then 'T else 'NIL;
+
+syslsp procedure MakeFUnBound(D);
+% Install the correct Bit Pattern in SYMFNC cell
+ If not IDP D then NonIdError(D,'MakeFUnbound)
+ else !%copy!-function!-cell(symfncbase Idloc ShouldBeUndefined,
+ symfncbase IdInf D);
+
+syslsp procedure FLambdaLinkP fn;
+ If not IDP Fn then NonIdError(Fn,'FunboundP)
+ else if (SymFnc IdLoc CompiledCallingInterpreted eq SymFnc(IdInf Fn))
+ % This installed by MakeFlambdaLink
+ then 'T else 'NIL;
+
+syslsp procedure MakeFlambdaLink D;
+% Install the correct Bit Pattern in SYMFNC cell
+ If not IDP D then NonIdError(D,'MakeFUnbound)
+ else !%store!-JCALL(symfnc Idloc CompiledCallingInterpreted,
+ Symfncbase IdInf D); % SetUp as above
+
+syslsp procedure FcodeP Fn;
+% Check if Code or Interp
+ If not IDP Fn then NonIdError(Fn,'FcodeP)
+ else if FUnboundP Fn or FLambdaLinkP Fn then NIL else T;
+
+syslsp procedure MakeFCode(U, CodePtr);
+% Make U a compiled function
+ if IDP U then
+ if CodeP CodePtr then
+ <<!%Store!-JCALL(CodeInf Codeptr,
+ SymfncBase IdInf U);
+ NIL >>
+ else NonIDError(U, 'MakeFCode);
+
+
+syslsp procedure GetFCodePointer U;
+% Get code pointer for U
+ if IDP U then if FCodeP U then MkCODE SymFnc U % do we want Fcodep check
+ else NIL
+ else NonIDError(U, 'GetFCodePointer);
+ %/Check that IS codeP?
+
+
+% Code Calling Primitives
+
+% See PI: P-APPLY-LAP.RED by BENSON
+% See also Pxxx:APPLY-LAP.RED
+
+Fluid '(CodePtr!* CodeForm!* CodeNarg!*);
+
+LAP '((!*entry CodePrimitive expr 15)
+% Takes the code pointer stored in the fluid variable CodePtr!*
+% and jumps to its address, without disturbing any of the argument
+% registers. This can be flagged 'InternalFunction for compilation
+% before this file is compiled or done as an 'OpenCode and 'ExitOpenCode
+% property for the compiler.
+ (!*ALLOC 0)
+ (!*MOVE (Fluid CodePtr!*) (reg t1))
+ (!*FIELD (reg t1) (reg t1) % get CodeINF
+ (WConst InfStartingBit) (WConst InfBitLength))
+% rrk - 03/02/83 If alloc did anything we need to get rid of it before the jump
+ (!*Dealloc 0)
+ (!*JUMP (memory (reg t1) (Wconst 0)))
+ (!*EXIT 0)
+);
+
+
+LAP '((!*entry CompiledCallingInterpreted expr 15)
+% Called by some convention from the function cell of an ID which
+% has an interpreted function definition. It should store the
+% Linkreg into
+% the fluid variable CodeForm!* without disturbing the argument
+% registers
+%
+%
+ (!*ALLOC 0)
+ (!*CALL SaveRegisters) % !*CALL to avoid resetting LinkInfo
+ (!*Move (reg LinkReg) (fluid CodeForm!*))
+ (!*Move (reg NargReg) (fluid CodeNarg!*))
+% rrk - 03/02/83 If alloc did anything we need to get rid of it before the jump
+ (!*Dealloc 0)
+ (!*JCALL CompiledCallingInterpretedAux)
+ (!*Exit 0)
+);
+
+
+LAP '((!*entry FastApply expr 0)
+% Called with a functional form in (reg t1) and argument registers
+% loaded. If it is a code pointer or an ID, the function address
+% associated with either should be jumped to. If it is anything else
+% except a lambda form, an error should be signaled. If it is a lambda
+% form, store (reg t1) in the fluid variable CodeForm!* and
+% (!*JCALL FastLambdaApply)
+% (FastLambdaApply may be flagged 'InternalFunction).
+ (!*ALLOC 0)
+ (!*MOVE (reg t1) (FLUID CodeForm!*)) % save input form
+ (!*FIELD (reg t2) (reg t1)
+ (WConst TagStartingBit) (WConst TagBitLength))
+ (!*FIELD (reg t1) (reg t1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*JUMPNOTEQ (Label NotAnID) (reg t2) (WConst ID))
+ (!*MOVE (reg t1) (reg LinkReg)) % Reset IDLOC name
+ % NargReg is OK
+ (!*WTIMES2 (reg t1) (WConst AddressingUnitsPerFunctionCell))
+% rrk 03/03/83
+ (!*Dealloc 0)
+ (!*JUMP (MEMORY (reg t1) (WArray SymFnc)))
+NotAnID
+ (!*JUMPNOTEQ (Label NotACodePointer) (reg t2) (WConst CODE))
+% rrk 03/03/83
+ (!*Dealloc 0)
+ (!*JUMP (MEMORY (reg t1) (WConst 0)))
+NotACodePointer
+ (!*JUMPNOTEQ (Label IllegalFunctionalForm) (reg t2) (WConst PAIR))
+ (!*MOVE (MEMORY (reg t1) (WConst 0)) (reg t2))
+ % CAR with pair already untagged
+ (!*JUMPNOTEQ (Label IllegalFunctionalForm) (reg t2) (QUOTE LAMBDA))
+% rrk 03/03/83
+ (!*Dealloc 0)
+ % Note that t1 is INF of the PAIR
+ (!*JCALL FastLambdaApply) % CodeForm!*
+ % Already Loaded
+IllegalFunctionalForm
+ (!*MOVE (QUOTE "Illegal functional form in Apply") (reg 1))
+ (!*MOVE (FLUID CodeForm!*) (reg 2))
+ (!*CALL List2)
+% rrk 03/03/83
+ (!*Dealloc 0)
+ (!*JCALL StdError)
+% (!*EXIT 0) --> what is this!
+);
+
+Exported Warray CodeArgs[15];
+
+syslsp procedure SaveRegisters(A1, A2, A3, A4, A5,
+% Duplicate in P-APPLY
+ A6, A7, A8, A9, A10,
+ A11, A12, A13, A14, A15);
+<< CodeArgs[14] := A15;
+ CodeArgs[13] := A14;
+ CodeArgs[12] := A13;
+ CodeArgs[11] := A12;
+ CodeArgs[10] := A11;
+ CodeArgs[9] := A10;
+ CodeArgs[8] := A9;
+ CodeArgs[7] := A8;
+ CodeArgs[6] := A7;
+ CodeArgs[5] := A6;
+ CodeArgs[4] := A5;
+ CodeArgs[3] := A4;
+ CodeArgs[2] := A3;
+ CodeArgs[1] := A2;
+ CodeArgs[0] := A1 >>;
+
+
+LAP '((!*ENTRY UndefinedFunctionAux expr 0)
+% Called by some convention from the function cell of an ID (probably
+% the same as CompiledCallingInterpreted) for an undefined function.
+% Should call Error with the ID as part of the error message.
+ (!*ALLOC 0)
+ (!*CALL SaveRegisters) % !*CALL so as not to change LinkInfo
+ % Was stored in UndefnCode!* UndefnNarg!*
+% rrk 03/03/83
+ (!*Dealloc 0)
+ (!*JCALL UndefinedFunctionAuxAux)
+% (!*EXIT 0)
+);
+
+off syslisp;
+
+ End;
+
+
ADDED psl-1983/3-1/tests/p-lambind.sl
Index: psl-1983/3-1/tests/p-lambind.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/p-lambind.sl
@@ -0,0 +1,62 @@
+%
+% P-LAMBIND.SL - Portable cmacro definitions *LAMBIND, *PROGBIND and *FREERSTR
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 6 August 1982
+% Copyright (c) 1982 University of Utah
+%
+% Modification by MLG to preserve REG 1 across FREERSTR
+% 19 March,1983
+(compiletime (load useful))
+
+(imports '(syslisp)) % requires SYSLISP for AddrUnitsPerItem
+
+(de *lambind (regs fluids)
+ (prog (n firstreg)
+ (setq n 0)
+ (setq regs (rest regs)) % remove REGISTERS at the front
+ (setq fluids (rest fluids)) % remove NONLOCALVARS at the front
+ (setq fluids % convert fluids list into vector
+ (list2vector (foreach x in fluids collect (second x))))
+ (setq firstreg (first regs))
+ (setq regs (rest regs))
+ (return (if (null regs) % only one to bind
+ `((*move ,firstreg (reg 2))
+ (*move `,',(getv fluids 0) (reg 1))
+ (*call lbind1))
+ `((*move ,firstreg (memory (fluid LambindArgs*) (wconst 0)))
+ (*move (fluid LambindArgs*) ,firstreg)
+ ,@(foreach x in regs collect
+ (progn (setq n (add1 n))
+ `(*move ,x
+ (memory ,firstreg
+ (wconst (wtimes2 (wconst AddressingUnitsPerItem)
+ (wconst ,n)))))))
+ (*move `,',fluids (reg 1))
+ (*call lambind))))))
+
+(defcmacro *lambind)
+
+(de *progbind (fluids)
+ (if (null (rest (rest fluids)))
+ `((*move `,',(second (first (rest fluids))) (reg 1))
+ (*call pbind1))
+ `((*move `,',(list2vector (foreach x in (rest fluids) collect
+ (second x)))
+ (reg 1))
+ (*call progbind))))
+
+(defcmacro *progbind)
+
+(de *freerstr (fluids)
+ `((*move (reg 1) (Fluid FreeRstrSave!*))
+ (*move `,',(length (rest fluids)) (reg 1))
+ (*call UnBindN)
+ (*move (Fluid FreeRstrSave!*) (reg 1))))
+
+(defcmacro *freerstr)
+
+(setq *unsafebinder t) % has to save registers across calls
ADDED psl-1983/3-1/tests/pascal-support.red
Index: psl-1983/3-1/tests/pascal-support.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/pascal-support.red
@@ -0,0 +1,52 @@
+{ XXX Support Routines, Test Version
+ M. L. Griss, and S. Lowder 9 July 1982
+}
+
+ Var Ctime:Integer; { For CPU Time }
+
+ Procedure XXX_Init(var c:integer);
+ begin
+ WriteLn(Output, ' Init the XXX package ',c);
+ Ctime :=10*SysClock; { First Call on Timer }
+ end;
+
+ Procedure XXX_PutC(var c:integer);
+ begin
+ Write(Output,chr(c));
+ end;
+
+ Procedure XXX_GetC(var c:integer);
+ var ch:char;
+ begin
+ read(keyboard,ch);
+ c := ord(ch);
+ end;
+
+ Procedure XXX_TimC(var c:integer);
+ var i:integer;
+ begin
+ i:=10* SysClock; {Call timer again}
+ c := i-Ctime;
+ Writeln(Output,' Ctime ', i, c);
+ Ctime := i;
+ end;
+
+ Procedure XXX_Quit(var c:integer); { close files, cleanup and exit }
+ begin
+ Writeln(Output,' Quitting ');
+ ESCAPE(0); { "normal" exit, ie HALT}
+ end;
+
+ Procedure XXX_Err(var c:integer);
+ begin
+ Writeln(Output,' XXX Error call Number: ', c);
+ ESCAPE(c);
+ end;
+
+ Procedure XXX_PutI(var c:integer); { Print an Integer }
+ begin
+ Writeln(Output,' PutI: ', c);
+ end;
+
+
+end.
ADDED psl-1983/3-1/tests/pk-modules.list
Index: psl-1983/3-1/tests/pk-modules.list
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/pk-modules.list
@@ -0,0 +1,91 @@
+PK: modules/files
+
+ALLOC
+ Allocators
+ Copiers
+ Cons-mkvect
+ Comp-support
+ System-gc
+ Gc
+ARITH
+ Arithmetic
+DEBG
+ Mini-trace
+ Mini-editor
+ Backtrace
+ERROR
+ Error-handlers
+ Type-errors
+ Error-errorset
+ Io-errors
+EVAL
+ Apply-lap
+ Eval-apply
+ Catch-throw
+ Prog-and-friends
+EXTRA
+ Timc
+ System-extras
+ Trap
+ Dumplisp
+FASL
+ System-faslout
+ System-faslin
+ Faslin
+ Load
+ Autoload
+P20:HEAP
+ [Declare HEAP,BPS]
+IO
+ Io-data
+ Char-io
+ Open-close
+ Rds-wrs
+ Other-io
+ Read
+ Token-scanner
+ Printers
+ Write-float
+ Printf
+ Explode-compress
+ Io-extensions
+MACRO
+ Eval-when
+ Cont-error
+ Lisp-macros
+ Onoff
+ Define-smacro
+ Defconst
+ String-gensym
+ Loop-macros
+MAIN
+ Main-start
+PROP
+ Function-primitives
+ Property-list
+ Fluid-global
+ Putd-getd
+RANDM
+ Known-to-comp-sl
+ Others-sl
+ Equal
+ Carcdr
+ Easy-sl
+ Easy-non-sl
+ Sets
+SYMBL
+ Binding
+ Fast-binder
+ Symbol-values
+ Oblist
+SYSIO
+ System-io
+ Scan-table
+TLOOP
+ Break
+ Top-loop
+ Dskin
+TYPES
+ Type-conversions
+ Vectors
+ Sequence
ADDED psl-1983/3-1/tests/prog.tst
Index: psl-1983/3-1/tests/prog.tst
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/prog.tst
@@ -0,0 +1,54 @@
+% Some interpreted tests of PROG for MAIN9
+
+(Dashed "Expect 1 printed")
+(shouldbe "Prog Value" (PROG NIL (print 1)) NIL)
+
+(Dashed "Expect 1 and 2 printed")
+(shouldbe "Prog value" (PROG NIL (print 1) (print 2) (return 3)) 3)
+
+(Dashed "Test 1 var PROG binding")
+(ShouldBe "Before PROG, x=" (setq x 2) 2)
+(Shouldbe "Prog value"
+ (PROG (X)
+ (ShouldBe "Inside prog, x=" x NIL)
+ (setq x 3)
+ (ShouldBe "After setq, x=" x 3)
+ )
+ NIL)
+(ShouldBe "after exit, x=" x 2)
+
+(Dashed "Test 2 var PROG binding")
+(ShouldBe "Before PROG, x=" (setq x 2) 2)
+(ShouldBe "Before PROG, y=" (setq y 20) 20)
+(Shouldbe "Prog value"
+ (PROG (X Y)
+ (ShouldBe "Inside prog, x=" x NIL)
+ (ShouldBe "Inside prog, y=" y NIL)
+ (setq x 3)
+ (setq y 30)
+ (ShouldBe "After setq, x=" x 3)
+ (ShouldBe "After setq, y=" y 30)
+ )
+ NIL)
+(ShouldBe "after exit, x=" x 2)
+(ShouldBe "after exit, y=" y 20)
+
+(dashed "Test simple loop in prog")
+(shouldbe "Return 0 after 5 loops"
+(prog (x)
+ (setq x 6)
+ (prin2t "Expect x to decrease from 5 to 1")
+ L (setq x (sub1 x))
+ (prin2 " In loop x=")(prin2T x)
+ (cond ((greaterp x 1) (go L)))
+ (return 0))
+ 0)
+(shouldbe "Return 1 after 5 loops"
+(prog (x)
+ (setq x 5)
+ (prin2T "Expect x to decrease from 5 to 1")
+ L (cond ((lessp x 1) (return 1)))
+ (prin2 " In loop, x=") (Prin2t x)
+ (setq x (sub1 x))
+ (go L))
+ 1)
ADDED psl-1983/3-1/tests/psl-timer.b
Index: psl-1983/3-1/tests/psl-timer.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/psl-timer.b
cannot compute difference between binary files
ADDED psl-1983/3-1/tests/psl-timer.sl
Index: psl-1983/3-1/tests/psl-timer.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/psl-timer.sl
@@ -0,0 +1,291 @@
+% PSL-TIMER.SL Source of PSL "spectral" tests
+
+% Compile this file to produce psl-timer.b
+% then LAPIN the file "time-psl.sl"
+'(
+(sstatus translink t)
+(declare (localf tak gtak))
+(def de (macro (x) (cons 'defun (cdr x))))
+(def igreaterp (macro (x) (cons '> (cdr x))))
+(def ilessp (macro (x) (cons '< (cdr x))))
+(def iadd1 (macro (x) (cons '1+ (cdr x))))
+(def isub1 (macro (x) (cons '1- (cdr x))))
+(def itimes2 (macro (x) (cons '* (cdr x))))
+(allocate 'fixnum 2000)
+(allocate 'list 500)
+(setq $gcprint t)
+(defun time () (* (car (ptime)) 17))
+(defun reclaim () (gc))
+)
+
+(fluid '(TestList TestList2 LongList EvalForm))
+
+(de TestSetup ()
+(progn
+ (setq TestList (PrepareTest 1000))
+ (setq TestList2 (PrepareTest 2000))
+ (MakeLongList)
+ (setq EvalForm '(setq Foo (cadr '(1 2 3))))))
+
+(de MakeLongList ()
+(prog (I)
+ (setq LongList '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
+ (setq I 0)
+loop
+ (cond ((igreaterp I 5) (return nil)))
+ (setq LongList (append LongList LongList))
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de PrepareTest (n)
+ (prog (l i)
+ (setq i -1 l nil)
+ top
+ (cond ((ilessp n i) (return l)))
+ (setq i (iadd1 i)
+ l (cons nil l))
+ (go top)))
+
+(de Cdr1Test (N)
+(prog (I L)
+ (setq I -1)
+loop
+ (setq I (iadd1 I))
+ (setq L LongList)
+ (cond ((igreaterp I N) (return nil)))
+loop1
+ (cond ((atom (setq L (cdr L))) (go loop)))
+ (go loop1)))
+
+(de Cdr2Test (N)
+(prog (I L)
+ (setq I -1)
+loop
+ (setq I (iadd1 I))
+ (setq L LongList)
+ (cond ((igreaterp I N) (return nil)))
+loop1
+ (cond ((null (setq L (cdr L))) (go loop)))
+ (go loop1)))
+
+(de CddrTest (N)
+(prog (I L)
+ (setq I -1)
+loop
+ (setq I (iadd1 I))
+ (setq L LongList)
+ (cond ((igreaterp I N) (return nil)))
+loop1
+ (cond ((null (setq L (cddr L))) (go loop)))
+ (go loop1)))
+
+(de ListOnlyCdrTest1 ()
+ (prog (l1 l2)
+ (setq l1 TestList)
+ top
+ (setq l2 TestList)
+ again
+ (cond ((null (setq l2 (cdr l2)))
+ (cond ((null (setq l1 (cdr l1)))
+ (return nil))
+ (t (go top))))
+ (t (go again)))))
+
+(de ListOnlyCddrTest1 ()
+ (prog (l1 l2)
+ (setq l1 TestList2)
+ top
+ (setq l2 TestList2)
+ again
+ (cond ((null (setq l2 (cddr l2)))
+ (cond ((null (setq l1 (cddr l1)))
+ (return nil))
+ (t (go top))))
+ (t (go again)))))
+
+(de ListOnlyCdrTest2 ()
+ (prog (l1 l2)
+ (setq l1 TestList)
+ top
+ (setq l2 TestList)
+ again
+ (cond ((atom (setq l2 (cdr l2)))
+ (cond ((atom (setq l1 (cdr l1)))
+ (return nil))
+ (t (go top))))
+ (t (go again)))))
+
+(de ListOnlyCddrTest2 ()
+ (prog (l1 l2)
+ (setq l1 TestList2)
+ top
+ (setq l2 TestList2)
+ again
+ (cond ((atom (setq l2 (cddr l2)))
+ (cond ((atom (setq l1 (cddr l1)))
+ (return nil))
+ (t (go top))))
+ (t (go again)))))
+
+(de EmptyTest (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de SlowEmptyTest (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((greaterp I N) (return nil)))
+ (setq I (add1 I))
+ (go loop)))
+
+(de ReverseTest (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (reverse LongList)
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de MyReverse1Test (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (myreverse1 LongList)
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de myreverse1 (L)
+(prog (M)
+loop
+ (cond ((atom L) (return M)))
+ (setq M (cons (car L) M))
+ (setq L (cdr L))
+ (go loop)))
+
+(de MyReverse2Test (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (myreverse2 LongList)
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de myreverse2 (L)
+(prog (M)
+loop
+ (cond ((null L) (return M)))
+ (setq M (cons (car L) M))
+ (setq L (cdr L))
+ (go loop)))
+
+(de LengthTest (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (length LongList)
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de Fact (N)
+ (cond ((ilessp N 2) 1) (t (itimes2 N (Fact (isub1 N))))))
+
+(de ArithmeticTest (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (Fact 9)
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de EvalTest (N)
+(prog (I)
+ (setq I 0)
+loop
+ (cond ((igreaterp I N) (return nil)))
+ (eval EvalForm)
+ (setq I (iadd1 I))
+ (go loop)))
+
+(de TimeEval (Form)
+(prog (I)
+ (setq I (time))
+ (eval Form)
+ (return (difference (time) I))))
+
+(de topleveltak (x y z) (tak x y z))
+
+(de tak (x y z)
+ (cond ((null (ilessp y x)) z)
+ (t (tak (tak (isub1 x) y z)
+ (tak (isub1 y) z x)
+ (tak (isub1 z) x y)))))
+
+(de toplevelgtak (x y z) (gtak x y z))
+
+(de gtak (x y z)
+ (cond ((null (lessp y x)) z)
+ (t (gtak (gtak (sub1 x) y z)
+ (gtak (sub1 y) z x)
+ (gtak (sub1 z) x y)))))
+
+(de gtsta (F)
+ (prog (I)
+ (setq I 1)
+Loop
+ (cond ((igreaterp I 100000) (return nil)))
+ (apply F (list I))
+ (setq I (iadd1 I))
+ (go Loop)))
+
+(de gtstb (F)
+ (prog (I)
+ (setq I 1)
+Loop
+ (cond ((igreaterp I 100000) (return nil)))
+ (funcall F I)
+ (setq I (iadd1 I))
+ (go Loop)))
+
+(de g0 (X) X)
+(de g1 (X) (iadd1 X))
+
+(de nreverse (x)
+ (nreconc x nil))
+
+(de nreconc (x y)
+ (prog (z)
+ L (cond ((atom x) (return y)))
+ (setq z x)
+ (setq x (cdr x))
+ (setq y (rplacd z y))
+ (go L)))
+
+(de nnils (N)
+ (prog (LST i)
+ (setq i 0)
+loop
+ (cond ((igreaterp i N) (return LST)))
+ (setq LST (cons nil LST))
+ (setq i (iadd1 i))
+ (go loop)))
+
+(global '(TestGlobalVar))
+
+(de nils (N)
+ (setq TESTGLOBALVAR (nnils N))
+ N)
+
+(de nr ()
+ (setq TESTGLOBALVAR (nreverse TESTGLOBALVAR))
+ nil)
+
ADDED psl-1983/3-1/tests/psl-times.lpt
Index: psl-1983/3-1/tests/psl-times.lpt
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/psl-times.lpt
@@ -0,0 +1,57 @@
+PSL 3.1 times in ms, taken at HP Computer Research Center, 5 Dec 1982
+---------------------------------------------------------------------
+
+ DEC-20 VAX-780 HP9836
+
+Empty 20 34 70
+SlowEmpty 284 612 1930
+Cdr1 531 1632 2660
+Cdr2 385 1241 1120
+Cddr 304 986 850
+ListOnlyCdr1 1806 5695 6700
+ListOnlyCddr1 3703 11832 10090
+ListOnlyCdr2 2804 8806 15960
+ListOnlyCddr2 4599 14875 19270
+Reverse 273 646 1480
+MyReverse1 270 629 1470
+MyReverse2 253 680 1310
+Length 567 1632 3080
+Arithmetic 605 833 6560
+Eval 1901 5865 17650
+tak(18,12,6) 446 697 2770
+gtak(18,12,6) 1882 4029 13130
+gtsta g0 727 2363 5810
+gtsta g1 789 2397 5980
+
+
+
+PSL 3.0 Times in ms taken at Utah and RAND, July-Aug 1982 or earlier
+--------------------------------------------------------------------
+
+
+ PSL PSL PSL FRANZ APOLLO APOLLO
+TEST 20 750 780 OPUS 38 8 Mhz 10 Mhz
+
+Empty 25 68 0 391 105 56
+SlowEmpty 344 1139 663 3587 2330 1289
+Cdr1 576 2023 1632 3791 3281 1886
+Cdr2 367 1581 1224 1326 1449 648
+Cddr 293 1275 1071 867 1068 851
+ListOnlyCdr1 1754 9367 7208 6902 8658 4975
+ListOnlyCddr1 3487 15232 12410 9027 12761 7734
+ListOnlyCdr2 2864 12206 9418 21590 19611 11159
+ListOnlyCddr2 4644 18003 15164 24106 23696 13933
+Reverse 335 1037 748 663 3102 1806
+MyReverse1 269 1071 697 867 3094 1826
+MyReverse2 249 1020 629 697 2746 984
+Length 585 2142 1700 4811 3847 2203
+Arithmetic 589 1887 867 7667 3007 1852
+Eval 1857 9384 5083 10098 15759 9509
+tak(18,12,6) 442 1292 765 1887 2644 1627
+gtak(18,12,6) 1902 7344 4267 18479 15140 8433
+gtsta g0 829 4675 2533 13617 7720 4284
+gtsta g1 890 4709 2465 25143 7888 4371
+
+[The initial HP9836 times are uniformly between those of the small 8Mz and
+ large 10Mz Apollo, Wicat was slightly slower]
+
ADDED psl-1983/3-1/tests/psltest.sl
Index: psl-1983/3-1/tests/psltest.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/psltest.sl
@@ -0,0 +1,1203 @@
+%%%%%%%%%%%% Standard - LISP Verification file. %%%%%%%%%%%%%%%%%%%%%%%
+%
+% Copyright (C) M. Griss and J. Marti, February 1981
+% Adapted to test PSL by M. L. Griss and E. Benson
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Set ECHO In caller, as desired
+
+(SETQ !*RAISE NIL) % Checks in ID tests
+(SETQ !*BREAK NIL) % So error messages proceed
+
+(DE MSG(X) % Prints general message
+ (COND (!*ECHO NIL)
+ (T (PROGN (PRIN2T X) NIL))))
+
+(DE EXPECT(X) % Prints message about values
+ (COND (!*ECHO NIL)
+ (T (PROGN (PRIN2 " ----- Expect the following to Return: ")
+ (PRIN2T X) NIL))))
+
+(EXPECT "T T T T")
+T
+(NULL NIL)
+(COND (T T))
+(COND (NIL NIL) (T T))
+
+(EXPECT "NIL NIL NIL NIL")
+NIL
+(NULL T)
+(COND (T NIL))
+(COND (NIL T)
+ (T NIL))
+
+(EXPECT "0 0")
+0 (QUOTE 0)
+
+(MSG "Test the following minimum set of functions:")
+(MSG "PUTD, PROG, SET, QUOTE, COND, NULL, RETURN, LIST, CAR, CDR,")
+(MSG "EVAL, PRINT, PRIN1, TERPRI, PROGN, GO.")
+
+(MSG "Check PUTD, GETD, LAMBDA ")
+(PUTD (QUOTE FOO) (QUOTE EXPR) (QUOTE (LAMBDA (X) 3)))
+
+(EXPECT "(EXPR LAMBDA (X) 3)")
+(GETD (QUOTE FOO))
+
+(EXPECT "3 3")
+(FOO 1)
+(FOO 2)
+
+(EXPECT "1 1")
+(SET (QUOTE A) 1)
+A
+
+(EXPECT "2 2")
+(SET (QUOTE B) 2)
+B
+(MSG "test LIST, CAR, CDR ")
+(EXPECT "(1 2 3 4) 1 and (2 3 4)" )
+(SET (QUOTE A) (LIST 1 2 3 4))
+(CAR A)
+(CDR A)
+
+(MSG "Test REDEFINITION in PUTD, PROGN, PRIN1, TERPRI")
+(PUTD (QUOTE FOO) (QUOTE EXPR)
+ (QUOTE (LAMBDA (X) (PROGN (PRIN1 X) (TERPRI)))))
+
+(EXPECT "1 2 NIL")
+(FOO 1)
+(FOO 2)
+
+(EXPECT "Test simple PROG, GO, RETURN: expect 1 2 NIL 1")
+(PROG NIL (PRINT 1) (PRINT 2))
+(PROG (A) (PRINT A) (PRINT 1))
+
+(MSG "Now test GO, RETURN, PROG binding")
+(SET 'A 'AA) (SET 'B 'BB)
+(PROG (A B) (PRINT "test binding of A, B expect NIL")
+ (PRIN1 A) (PRINT B)
+ (PRINT "Reset to 1,2")
+ (SET 'A 1) (SET 'B 2)
+ (PRIN1 A) (PRINT B)
+ (PRINT "test forward GO")
+ (GO LL)
+ (PRINT "forward GO failed")
+LL (PRINT "Forward GO ok")
+ (GO L2)
+L1 (PRINT " Should be after BACKWARD go ")
+ (PRINT " now return 3")
+ (RETURN 3)
+L2 (PRINT "Test backward GO")
+ (GO L1) )
+
+(MSG "Test that A,B correctly rebound, expect AA and BB")
+A B
+
+(MSG "Redefine FOO as simple FEXPR")
+(PUTD (QUOTE FOO) (QUOTE FEXPR) (QUOTE (LAMBDA (X) (PRINT X))))
+
+(EXPECT "(FEXPR LAMBDA (X) (PRINT X))")
+(GETD (QUOTE FOO))
+
+(EXPECT "FOO calls to return (1) (1 2) and (1 2 3)")
+(FOO 1)
+(FOO 1 2)
+(FOO 1 2 3)
+
+(MSG "Finally, TEST EVAL inside an FEXPR")
+(PUTD (QUOTE FOO) (QUOTE FEXPR)
+ (QUOTE (LAMBDA (XX) (PRINT (EVAL (CAR XX))))))
+(EXPECT "1 T")
+(FOO 1)
+(FOO (NULL NIL))
+
+
+%---- The main tester -----
+% PUTD is being used here to define a function !$TEST.
+(PUTD (QUOTE !$TEST) (QUOTE FEXPR) (QUOTE
+ (LAMBDA (!$X)
+ (PROG (A B)
+ (SETQ A (CDR !$X))
+ % Space for test set
+ (TERPRI)
+ (PRIN2 "------ Beginning ") (PRIN1 (CAR !$X)) (PRIN2T " tests -----")
+
+LOOP (COND ((NULL (PAIRP A)) (RETURN
+ (PROGN
+ (PRIN2 "------ Finished ")
+ (PRIN1 (CAR !$X))
+ (PRIN2T " tests -----")
+ 0))))
+
+ (PRIN2 " try: ") (PRINT (CAR A))
+ (SETQ B (EVAL (CAR A)))
+ (COND ( (NULL (EQ B 'T))
+ (PROGN (PRIN2 "****** ") (PRINT A)
+ (PRIN2 " -> ") (PRINT B))))
+ (SETQ A (CDR A))
+ (GO LOOP)
+))))
+
+(EXPECT "T and T if $TEST correctly defined")
+(PAIRP (GETD (QUOTE !$TEST)))
+(EQCAR (GETD (QUOTE !$TEST)) (QUOTE FEXPR))
+
+% Global, vector, function-pointer partial test.
+(!$TEST "GLOBAL,VECTOR" (NULL (GLOBAL (QUOTE (!$VECTOR !$CODE TEMP))))
+ (GLOBALP (QUOTE !$VECTOR))
+ (GLOBALP (QUOTE !$CODE))
+ (SET (QUOTE !$VECTOR) (MKVECT 4))
+ (SET (QUOTE !$CODE) (CDR (GETD (QUOTE CDR)))) )
+
+
+(!$TEST LIST (EQUAL (LIST 1 (QUOTE A) "STRING" )
+ (QUOTE (1 A "STRING"))))
+
+% -----3.1 Elementary Predicates-----%
+% This section tests the elementary predicates of section 3.1 of
+% the Standard LISP Report. In general they will test that the
+% predicate returns non-NIL for the correct case, and NIL for all
+% others.
+
+% CODEP should not return T for numbers as function
+% pointers must not be implemented in this way.
+(!$TEST CODEP (CODEP !$CODE) (NULL (CODEP 1))
+ (NULL (CODEP T)) (NULL (CODEP NIL))
+ (NULL (CODEP (QUOTE IDENTIFIER)))
+ (NULL (CODEP "STRING")) (NULL (CODEP (QUOTE (A . B))))
+ (NULL (CODEP (QUOTE (A B C))))
+ (NULL (CODEP !$VECTOR)) )
+
+% PAIRP must not return T for vectors even if vectors are
+% implemented as lists.
+(!$TEST PAIRP
+ (PAIRP (QUOTE (A . B))) (PAIRP (QUOTE (NIL)))
+ (PAIRP (QUOTE (A B C))) (NULL (PAIRP 0))
+ (NULL (PAIRP (QUOTE IDENTIFIER)))
+ (NULL (PAIRP "STRING"))
+ (NULL (PAIRP !$VECTOR)) )
+
+(!$TEST FIXP (FIXP 1)
+ (NULL (FIXP (QUOTE IDENTIFIER)))
+ (NULL (FIXP (QUOTE "STRING")))
+ (NULL (FIXP (QUOTE (A . B))))
+ (NULL (FIXP (QUOTE (A B C))))
+ (NULL (FIXP !$VECTOR))
+ (NULL (FIXP !$CODE)) )
+
+% T and NIL must test as identifiers as must specially
+% escaped character identifiers.
+(!$TEST IDP (IDP (QUOTE IDENTIFIER))
+ (IDP NIL) (IDP T)
+ (IDP (QUOTE !1)) (IDP (QUOTE !A)) (IDP (QUOTE !!))
+ (IDP (QUOTE !()) (IDP (QUOTE !))) (IDP (QUOTE !.))
+ (IDP (QUOTE !')) (IDP (QUOTE !*)) (IDP (QUOTE !/))
+ (IDP (QUOTE !+)) (IDP (QUOTE !-)) (IDP (QUOTE !#))
+ (IDP (QUOTE ! )) (IDP (QUOTE !1!2!3)) (IDP (QUOTE !*!*!*))
+ (IDP (QUOTE !"ID!"))
+ (NULL (IDP 1))
+ (NULL (IDP "STRING"))
+ (NULL (IDP (QUOTE (A . B))))
+ (NULL (IDP (QUOTE (A B C))))
+ (NULL (IDP !$VECTOR))
+ (NULL (IDP !$CODE)) )
+
+% STRINGP should answer T to strings only and not things
+% that might look like strings if the system implements them as
+% identifiers.
+(!$TEST STRINGP (STRINGP "STRING")
+ (NULL (STRINGP (QUOTE (STRING NOTASTRING))))
+ (NULL (STRINGP 1))
+ (NULL (STRINGP (QUOTE A)))
+ (NULL (STRINGP (QUOTE (A . B))))
+ (NULL (STRINGP (QUOTE (A B C))))
+ (NULL (STRINGP !$VECTOR))
+ (NULL (STRINGP !$CODE)) )
+
+% VECTORP should not answer T to pairs if vectors are
+% implemented as pairs.
+(!$TEST VECTORP (VECTORP !$VECTOR)
+ (NULL (VECTORP 1))
+ (NULL (VECTORP (QUOTE A)))
+ (NULL (VECTORP "STRING"))
+ (NULL (VECTORP (QUOTE (A . B))))
+ (NULL (VECTORP (QUOTE (A B C))))
+ (NULL (VECTORP !$CODE)) )
+
+% Vectors are constants in Standard LISP. However T and NIL
+% are special global variables with the values T and NIL.
+(!$TEST CONSTANTP (CONSTANTP 1)
+ (CONSTANTP "STRING")
+ (CONSTANTP !$VECTOR)
+ (CONSTANTP !$CODE)
+ (NULL (CONSTANTP NIL))
+ (NULL (CONSTANTP T))
+ (NULL (CONSTANTP (QUOTE A)))
+ (NULL (CONSTANTP (QUOTE (A . B))))
+ (NULL (CONSTANTP (QUOTE (A B C)))) )
+
+% An ATOM is anything that is not a pair, thus vectors are
+% atoms.
+(!$TEST ATOM (ATOM T) (ATOM NIL) (ATOM 1) (ATOM 0)
+ (ATOM "STRING") (ATOM (QUOTE IDENTIFIER))
+ (ATOM !$VECTOR)
+ (NULL (ATOM (QUOTE (A . B))))
+ (NULL (ATOM (QUOTE (A B C)))) )
+
+
+(!$TEST EQ (EQ NIL NIL) (EQ T T)
+ (EQ !$VECTOR !$VECTOR)
+ (EQ !$CODE !$CODE)
+ (EQ (QUOTE A) (QUOTE A))
+ (NULL (EQ NIL T))
+ (NULL (EQ NIL !$VECTOR))
+ (NULL (EQ (QUOTE (A . B)) (QUOTE (A . B)))) )
+
+% Function pointers are not numbers, therefore the function
+% pointer $CODE is not EQN to the fixed number 0. Numbers must have
+% the same type to be EQN.
+(!$TEST EQN (EQN 1 1) (EQN 0 0)
+ (EQN 1.0 1.0) (EQN 0.0 0.0)
+ (NULL (EQN 1.0 0.0)) (NULL (EQN 0.0 1.0))
+ (NULL (EQN 1 1.0)) (NULL (EQN 0 0.0))
+ (NULL (EQN 1 0)) (NULL (EQN 0 1))
+ (NULL (EQN 0 !$CODE))
+ (NULL (EQN NIL 0))
+ (EQN NIL NIL) (EQN T T) (EQN !$VECTOR !$VECTOR)
+ (EQN !$CODE !$CODE) (EQN (QUOTE A) (QUOTE A))
+ (NULL (EQN (QUOTE (A . B)) (QUOTE (A . B))))
+ (NULL (EQN (QUOTE (A B C)) (QUOTE (A B C)))) )
+
+% EQUAL checks for general equality rather than specific, so
+% it must check all elements of general expressions and all elements
+% of vectors for equality. This test assumes that CAR does not have
+% the function pointer value EQUAL to 0. Further tests of EQUAL
+% are in the vector section 3.9.
+(!$TEST EQUAL (EQUAL NIL NIL)
+ (EQUAL T T)
+ (NULL (EQUAL NIL T))
+ (EQUAL !$CODE !$CODE)
+ (NULL (EQUAL !$CODE (CDR (GETD (QUOTE CAR)))))
+ (EQUAL (QUOTE IDENTIFIER) (QUOTE IDENTIFIER))
+ (NULL (EQUAL (QUOTE IDENTIFIER1) (QUOTE IDENTIFIER2)))
+ (EQUAL "STRING" "STRING")
+ (NULL (EQUAL "STRING1" "STRING2"))
+ (EQUAL 0 0)
+ (NULL (EQUAL 0 1))
+ (EQUAL (QUOTE (A . B)) (QUOTE (A . B)))
+ (NULL (EQUAL (QUOTE (A . B)) (QUOTE (A . C))))
+ (NULL (EQUAL (QUOTE (A . B)) (QUOTE (C . B))))
+ (EQUAL (QUOTE (A B)) (QUOTE (A B)))
+ (NULL (EQUAL (QUOTE (A B)) (QUOTE (A C))))
+ (NULL (EQUAL (QUOTE (A B)) (QUOTE (C B))))
+ (EQUAL !$VECTOR !$VECTOR)
+ (NULL (EQUAL 0 NIL))
+ (NULL (EQUAL "T" T))
+ (NULL (EQUAL "NIL" NIL)) )
+
+% -----3.2 Functions on Dotted-Pairs-----%
+% Test the C....R functions by simply verifying that they select
+% correct part of a structure.
+(!$TEST CAR (EQ (CAR (QUOTE (A . B))) (QUOTE A))
+ (EQUAL (CAR (QUOTE ((A) . B))) (QUOTE (A))) )
+
+(!$TEST CDR (EQ (CDR (QUOTE (A . B))) (QUOTE B))
+ (EQUAL (CDR (QUOTE (A B))) (QUOTE (B))) )
+
+(!$TEST CAAR (EQ (CAAR (QUOTE ((A)))) (QUOTE A)))
+(!$TEST CADR (EQ (CADR (QUOTE (A B))) (QUOTE B)))
+(!$TEST CDAR (EQ (CDAR (QUOTE ((A . B)))) (QUOTE B)))
+(!$TEST CDDR (EQ (CDDR (QUOTE (A . (B . C)))) (QUOTE C)))
+
+(!$TEST CAAAR (EQ (CAAAR (QUOTE (((A))))) (QUOTE A)))
+(!$TEST CAADR (EQ (CAADR (QUOTE (A (B)))) (QUOTE B)))
+(!$TEST CADAR (EQ (CADAR (QUOTE ((A B)))) (QUOTE B)))
+(!$TEST CADDR (EQ (CADDR (QUOTE (A B C))) (QUOTE C)))
+(!$TEST CDAAR (EQ (CDAAR (QUOTE (((A . B)) C))) (QUOTE B)))
+(!$TEST CDADR (EQ (CDADR (QUOTE (A (B . C)))) (QUOTE C)))
+(!$TEST CDDAR (EQ (CDDAR (QUOTE ((A . (B . C))))) (QUOTE C)))
+(!$TEST CDDDR (EQ (CDDDR (QUOTE (A . (B . (C . D))))) (QUOTE D)))
+
+(!$TEST CAAAAR (EQ (CAAAAR (QUOTE ((((A)))))) (QUOTE A)))
+(!$TEST CAAADR (EQ (CAAADR (QUOTE (A ((B))))) (QUOTE B)))
+(!$TEST CAADAR (EQ (CAADAR (QUOTE ((A (B))))) (QUOTE B)))
+(!$TEST CAADDR (EQ (CAADDR (QUOTE (A . (B (C))))) (QUOTE C)))
+(!$TEST CADAAR (EQ (CADAAR (QUOTE (((A . (B)))))) (QUOTE B)))
+(!$TEST CADADR (EQ (CADADR (QUOTE (A (B . (C))))) (QUOTE C)))
+(!$TEST CADDAR (EQ (CADDAR (QUOTE ((A . (B . (C)))))) (QUOTE C)))
+(!$TEST CADDDR (EQ (CADDDR (QUOTE (A . (B . (C . (D)))))) (QUOTE D)))
+(!$TEST CDAAAR (EQ (CDAAAR (QUOTE ((((A . B)))))) (QUOTE B)))
+(!$TEST CDAADR (EQ (CDAADR (QUOTE (A ((B . C))))) (QUOTE C)))
+(!$TEST CDADAR (EQ (CDADAR (QUOTE ((A (B . C))))) (QUOTE C)))
+(!$TEST CDADDR (EQ (CDADDR (QUOTE (A . (B . ((C . D)))))) (QUOTE D)))
+(!$TEST CDDAAR (EQ (CDDAAR (QUOTE (((A . (B . C)))))) (QUOTE C)))
+(!$TEST CDDADR (EQ (CDDADR (QUOTE (A . ((B . (C . D)))))) (QUOTE D)))
+(!$TEST CDDDAR (EQ (CDDDAR (QUOTE ((A . (B . (C . D)))))) (QUOTE D)))
+(!$TEST CDDDDR (EQ (CDDDDR (QUOTE (A . (B . (C . (D . E)))))) (QUOTE E)))
+
+% CONS should return a unique cell when invoked. Also test that
+% the left and right parts are set correctly.
+(!$TEST CONS (NULL (EQ (CONS (QUOTE A) (QUOTE B)) (QUOTE (A . B))))
+ (EQ (CAR (CONS (QUOTE A) (QUOTE B))) (QUOTE A))
+ (EQ (CDR (CONS (QUOTE A) (QUOTE B))) (QUOTE B)) )
+
+% Veryify that RPLACA doesn't modify the binding of a list, and
+% that only the CAR part of the cell is affected.
+(!$TEST RPLACA
+ (SET (QUOTE TEMP) (QUOTE (A)))
+ (EQ (RPLACA TEMP 1) TEMP)
+ (EQ (CAR (RPLACA TEMP (QUOTE B))) (QUOTE B))
+ (EQ (CDR TEMP) NIL) )
+
+(!$TEST RPLACD
+ (SET (QUOTE TEMP) (QUOTE (A . B)))
+ (EQ (RPLACD TEMP (QUOTE A)) TEMP)
+ (EQ (CDR (RPLACD TEMP (QUOTE C))) (QUOTE C))
+ (EQ (CAR TEMP) (QUOTE A)) )
+
+% -----3.3 Identifiers-----%
+% Verify that COMPRESS handles the various types of lexemes
+% correctly.
+(!$TEST COMPRESS
+ (NULL (EQ (COMPRESS (QUOTE (A B))) (COMPRESS (QUOTE (A B)))))
+ (EQN (COMPRESS (QUOTE (!1 !2))) 12)
+ (EQN (COMPRESS (QUOTE (!+ !1 !2))) 12)
+ (EQN (COMPRESS (QUOTE (!- !1 !2))) -12)
+ (EQUAL (COMPRESS (QUOTE (!" S T R I N G !"))) "STRING")
+ (EQ (INTERN (COMPRESS (QUOTE (A B)))) (QUOTE AB))
+ (EQ (INTERN (COMPRESS (QUOTE (!! !$ A)))) (QUOTE !$A)) )
+
+% Verify that EXPLODE returns the expected lists and that COMPRESS
+% and explode are inverses of each other.
+(!$TEST EXPLODE
+ (EQUAL (EXPLODE 12) (QUOTE (!1 !2)))
+ (EQUAL (EXPLODE -12) (QUOTE (!- !1 !2)))
+ (EQUAL (EXPLODE "STRING") (QUOTE (!" S T R I N G !")))
+ (EQUAL (EXPLODE (QUOTE AB)) (QUOTE (A B)) )
+ (EQUAL (EXPLODE (QUOTE !$AB)) (QUOTE (!! !$ A B)))
+ (EQUAL (COMPRESS (EXPLODE 12)) 12)
+ (EQUAL (COMPRESS (EXPLODE -12)) -12)
+ (EQUAL (COMPRESS (EXPLODE "STRING")) "STRING")
+ (EQ (INTERN (COMPRESS (EXPLODE (QUOTE AB)))) (QUOTE AB))
+ (EQ (INTERN (COMPRESS (EXPLODE (QUOTE !$AB)))) (QUOTE !$AB)) )
+
+% Test that GENSYM returns identifiers and that they are different.
+(!$TEST GENSYM
+ (IDP (GENSYM))
+ (NULL (EQ (GENSYM) (GENSYM))) )
+
+% Test that INTERN works on strings to produce identifiers the same
+% as those read in. Try ID's with special characters in them (more
+% will be tested with READ).
+(!$TEST INTERN
+ (EQ (INTERN "A") (QUOTE A))
+ (EQ (INTERN "A12") (QUOTE A12))
+ (EQ (INTERN "A*") (QUOTE A!*))
+ (NULL (EQ (INTERN "A") (INTERN "B"))) )
+
+% Just test that REMOB returns the ID removed.
+(!$TEST REMOB
+ (EQ (REMOB (QUOTE AAAA)) (QUOTE AAAA)) )
+
+% ----- 3.4 Property List Functions-----%
+% Test that FLAG always returns NIL. More testing is done in FLAGP.
+(!$TEST FLAG
+ (NULL (FLAG NIL (QUOTE W)))
+ (NULL (FLAG (QUOTE (U V T NIL)) (QUOTE X)))
+ (NULL (FLAG (QUOTE (U)) NIL)) )
+
+% Test that FLAG worked only on a list. Test all items in a flagged
+% list were flagged and that those that weren't aren't.
+(!$TEST FLAGP
+ (NULL (FLAGP NIL (QUOTE W)))
+ (FLAGP (QUOTE U) (QUOTE X))
+ (FLAGP (QUOTE V) (QUOTE X))
+ (FLAGP T (QUOTE X))
+ (FLAGP NIL (QUOTE X))
+ (FLAGP (QUOTE U) NIL) )
+
+% Test that REMFLAG always returns NIL and that flags removed are
+% gone. Test that unremoved flags are still present.
+(!$TEST REMFLAG
+ (NULL (REMFLAG NIL (QUOTE X)))
+ (NULL (REMFLAG (QUOTE (U T NIL)) (QUOTE X)))
+ (NULL (FLAGP (QUOTE U) (QUOTE X)))
+ (FLAGP (QUOTE V) (QUOTE X))
+ (NULL (FLAGP T (QUOTE X)))
+ (NULL (FLAGP NIL (QUOTE X))) )
+
+(!$TEST PUT
+ (EQ (PUT (QUOTE U) (QUOTE IND1) (QUOTE PROP)) (QUOTE PROP))
+ (EQN (PUT (QUOTE U) (QUOTE IND2) 0) 0)
+ (EQ (PUT (QUOTE U) (QUOTE IND3) !$VECTOR) !$VECTOR)
+ (EQ (PUT (QUOTE U) (QUOTE IND4) !$CODE) !$CODE) )
+
+(!$TEST GET
+ (EQ (GET (QUOTE U) (QUOTE IND1)) (QUOTE PROP))
+ (EQN (GET (QUOTE U) (QUOTE IND2)) 0)
+ (EQ (GET (QUOTE U) (QUOTE IND3)) !$VECTOR)
+ (EQ (GET (QUOTE U) (QUOTE IND4)) !$CODE) )
+
+(!$TEST REMPROP
+ (NULL (REMPROP !$CODE !$CODE))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND1)) (QUOTE PROP))
+ (NULL (GET (QUOTE U) (QUOTE IND1)))
+ (EQN (REMPROP (QUOTE U) (QUOTE IND2)) (QUOTE 0))
+ (NULL (GET (QUOTE U) (QUOTE IND2)))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND3)) !$VECTOR)
+ (NULL (GET (QUOTE U) (QUOTE IND3)))
+ (GET (QUOTE U) (QUOTE IND4))
+ (EQ (REMPROP (QUOTE U) (QUOTE IND4)) !$CODE)
+ (NULL (GET (QUOTE U) (QUOTE IND4))) )
+
+
+% -----3.5 Function Definition-----%
+(!$TEST DE
+ (EQ (DE FIE (X) (PLUS2 X 1)) (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQN (FIE 1) 2)
+)
+% Expect (FIE 1) to return 2%
+(FIE 1)
+% Expect FIE redefined in DF test%
+(!$TEST DF
+ (EQ (DF FIE (X) (PROGN (PRINT X) (CAR X))) (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQN (FIE 1) 1)
+ (EQN (FIE 2 3) 2)
+)
+% Expect (FIE 1) to return 1, and print (1)%
+(FIE 1)
+% Expect (FIE 1 2) to return 1, and print (1 2)%
+(FIE 1 2)
+% Expect FIE redefined in DM%
+(!$TEST DM
+ (EQ (DM FIE (X)
+ (LIST (QUOTE LIST)
+ (LIST (QUOTE QUOTE) X)
+ (LIST (QUOTE QUOTE) X) ))
+ (QUOTE FIE))
+ (GETD (QUOTE FIE))
+ (EQUAL (FIE 1) (QUOTE ((FIE 1) (FIE 1))))
+)
+% Expect (FIE 1) to return ((FIE 1) (FIE 1))%
+(FIE 1)
+(!$TEST GETD
+ (PAIRP (GETD (QUOTE FIE)))
+ (NULL (PAIRP (GETD (QUOTE FIEFIEFIE))))
+ (EQ (CAR (GETD (QUOTE FIE))) (QUOTE MACRO))
+)
+
+(!$TEST PUTD
+ (GLOBALP (QUOTE FIE))
+ )
+% Should check that a FLUID variable not PUTDable;
+(!$TEST REMD
+ (PAIRP (REMD (QUOTE FIE)))
+ (NULL (GETD (QUOTE FIE)))
+ (NULL (REMD (QUOTE FIE)))
+ (NULL (REMD (QUOTE FIEFIEFIE)))
+)
+% -----3.6 Variables and Bindings------%
+% Make FLUIDVAR1 and FLUIDVAR2 fluids%
+(FLUID (QUOTE (FLUIDVAR1 FLUIDVAR2)))
+% Check that FLUIDVAR1 and FLUIDVAR2 are fluid,expect T, T%
+(FLUIDP (QUOTE FLUIDVAR1))
+(FLUIDP (QUOTE FLUIDVAR2))
+% Give FLUIDVAR1 and FLUIDVAR2 initial values%
+(SETQ FLUIDVAR1 1)
+(SETQ FLUIDVAR2 2)
+
+(!$TEST "FLUID and FLUIDP"
+ (NULL (FLUID (QUOTE (FLUIDVAR3 FLUIDVAR1 FLUIDVAR2 FLUIDVAR4))))
+ (FLUIDP (QUOTE FLUIDVAR3))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (FLUIDP (QUOTE FLUIDVAR2))
+ (FLUIDP (QUOTE FLUIDVAR4))
+ (NULL (GLOBALP (QUOTE FLUIDVAR3)))
+ (NULL (GLOBALP (QUOTE FLUIDVAR1)))
+ (NULL FLUIDVAR3)
+ (EQN FLUIDVAR1 1)
+ (NULL (FLUIDP (QUOTE CAR)))
+)
+(GLOBAL (QUOTE (FLUIDGLOBAL1)))
+% Expect ERROR that FLUIDGLOBAL1 already FLUID%
+(FLUID (QUOTE (FLUIDGLOBAL2)))
+
+% Expect ERROR that cant change FLUID%
+(GLOBAL (QUOTE (FLUIDVAR1 FLUIDVAR2 GLOBALVAR1 GLOBALVAR2)))
+% Does error cause GLOBALVAR1, GLOBALVAR2 to be declared ;
+
+(!$TEST "GLOBAL and GLOBALP"
+ (NULL (GLOBAL (QUOTE (GLOBALVAR1 GLOBALVAR2))))
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (GLOBALP (QUOTE GLOBALVAR2))
+ (NULL (GLOBALP (QUOTE FLUIDVAR1)))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (NULL (FLUIDP (QUOTE GLOBALVAR1)))
+ (NULL (FLUIDP (QUOTE GLOBALVAR2)))
+ (GLOBALP (QUOTE CAR))
+)
+
+% Set SETVAR1 to have an ID value%
+(SET (QUOTE SETVAR1) (QUOTE SETVAR2))
+
+% Expect SETVAR3 to be declared FLUID%
+(!$TEST SET
+ (NULL (FLUIDP (QUOTE SETVAR3)))
+ (EQN 3 (SET (QUOTE SETVAR3) 3))
+ (EQN 3 SETVAR3)
+ (FLUIDP (QUOTE SETVAR3))
+ (EQN (SET SETVAR1 4) 4)
+ (NULL (EQN SETVAR1 4))
+ (EQ SETVAR1 (QUOTE SETVAR2))
+ (EQN SETVAR2 4)
+)
+% Expect ERROR if try to set non ID%
+(SET 1 2)
+(SET (QUOTE SETVAR1) 1)
+(SET SETVAR1 2)
+
+% Expect ERROR if try to SET T or NIL%
+(SET (QUOTE SAVENIL) NIL)
+(SET (QUOTE SAVET) T)
+(!$TEST "Special SET value"
+ (SET (QUOTE NIL) 1)
+ (NULL (EQN NIL 1))
+ (SET (QUOTE NIL) SAVENIL)
+ (SET (QUOTE T) 2)
+ (NULL (EQN T 2))
+ (SET (QUOTE T) SAVET)
+)
+
+
+% Expect SETVAR3 to be declared FLUID%
+(!$TEST SETQ
+ (NULL (FLUIDP (QUOTE SETVAR3)))
+ (EQN 3 (SETQ SETVAR3 3))
+ (EQN 3 SETVAR3)
+ (FLUIDP (QUOTE SETVAR3))
+)
+
+% Expect ERROR if try to SETQ T or NIL%
+(SET (QUOTE SAVENIL) NIL)
+(SET (QUOTE SAVET) T)
+(!$TEST "Special SETQ value"
+ (SETQ NIL 1)
+ (NULL (EQN NIL 1))
+ (SETQ NIL SAVENIL)
+ (SETQ T 2)
+ (NULL (EQN T 2))
+ (SETQ T SAVET)
+)
+
+(!$TEST UNFLUID
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (FLUIDP (QUOTE FLUIDVAR1))
+ (NULL (UNFLUID (QUOTE (GLOBALVAR1 FLUIDVAR1))))
+ (GLOBALP (QUOTE GLOBALVAR1))
+ (NULL (FLUIDP (QUOTE FLUIDVAR1)))
+)
+
+
+% ----- 3.7 Program Feature Functions -----%
+
+% These have been tested as part of BASIC tests;
+
+% Check exact GO and RETURN scoping rules ;
+
+% ----- 3.8 Error Handling -----%
+
+(!$TEST EMSG!* (GLOBALP (QUOTE EMSG!*)))
+
+(!$TEST ERRORSET
+ (EQUAL (ERRORSET 1 T T) (QUOTE (1)))
+ (NULL (PAIRP (ERRORSET (QUOTE (CAR 1)) T T)))
+)
+
+% Display ERRORSET range of messages and features%
+
+% First with primitive (CAR 1) error%
+
+(SETQ ERRORVAR1 (QUOTE (CAR 1)))
+
+% Expect MSG and BACKTRACE %
+(ERRORSET ERRORVAR1 T T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect MSG, no backtrace %
+(ERRORSET ERRORVAR1 T NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect no MSG, but BACKTRACE %
+(ERRORSET ERRORVAR1 NIL T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect neither MSG nor Backtrace%
+(ERRORSET ERRORVAR1 NIL NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+
+% Test with CALL on ERROR, with num=789, (A MESSAGE)%
+
+(SETQ ERRORVAR2 (QUOTE (ERROR 789 (LIST (QUOTE A) (QUOTE MESSAGE)))))
+% Expect MSG and BACKTRACE %
+(ERRORSET ERRORVAR2 T T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect MSG, no backtrace %
+(ERRORSET ERRORVAR2 T NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect no MSG, but BACKTRACE %
+(ERRORSET ERRORVAR2 NIL T)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+% Expect neither MSG nor Backtrace%
+(ERRORSET ERRORVAR2 NIL NIL)
+(PRINT (LIST (QUOTE EMSG!*) EMSG!*))
+
+% Test of Rebinding/Unbinding%
+
+(FLUID (QUOTE (ERRORVAR3 ERRORVAR4)))
+(SETQ ERRORVAR3 3)
+(SETQ ERRORVAR4 4)
+
+(DE ERRORFN1 (X ERRORVAR3)
+ (PROGN (PRINT (LIST (QUOTE ERRORVAR3) ERRORVAR3))
+ (SETQ ERRORVAR3 33)
+ (PROG (Y ERRORVAR4)
+ (PRINT (LIST (QUOTE ERRORVAR3) ERRORVAR3))
+ (PRINT (LIST (QUOTE ERRORVAR4) ERRORVAR4))
+ (SETQ ERRORVAR3 333)
+ (SETQ ERRORVAR4 444)
+ (ERROR 555 "Error Inside ERRORFN1")
+ (RETURN "Error Failed"))))
+
+% Expect to see 3333 33 44 printed%
+% Followed by ERROR 555 messgae%
+(ERRORSET (QUOTE (ERRORFN1 3333 4444)) T T)
+% Expect 3 and 4 as Final values of ERRORVAR3 and ERRORVAR4%
+ERRORVAR3
+ERRORVAR4
+(!$TEST ERRORVARS
+ (EQN ERRORVAR3 3)
+ (EQN ERRORVAR4 4)
+)
+% ----- 3.9 Vectors -----%
+% Create a few variables that may be vectors %
+(SETQ VECTVAR1 NIL)
+(SETQ VECTVAR2 (QUOTE (VECTOR 1 2 3)))
+(SETQ VECTVAR3 (QUOTE [1 2 3 4]))
+
+% Expect Type mismatch Error for next 2%
+(GETV VECTVAR1 1)
+(GETV VECTVAR2 1)
+% Expect 1 2 for next 2%
+(GETV VECTVAR3 0)
+(GETV VECTVAR3 1)
+% Expect Index error for next 2%
+(GETV VECVAR3 -1)
+(GETV VECTVAR3 4)
+
+
+(!$TEST MKVECT
+ (VECTORP (SETQ VECTVAR3 (MKVECT 5)))
+ (EQN 5 (UPBV VECTVAR3))
+ (NULL (GETV VECTVAR3 0))
+ (NULL (GETV VECTVAR3 5))
+ (EQN 10 (PUTV VECTVAR3 0 10))
+ (EQN 10 (GETV VECTVAR3 0))
+ (EQN 20 (PUTV VECTVAR3 5 20))
+ (EQN 20 (GETV VECTVAR3 5))
+)
+% Expect VECTVAR3 to be [ 10 nil nil nil nil 20 ]%
+(PRINT VECTVAR3)
+
+% Expect MKVECT error for index less than 0%
+(MKVECT -1)
+% Expect length 1 vector%
+(MKVECT 0)
+% Expect type error%
+(MKVECT NIL)
+% Expect 2 TYPE errors%
+(PUTV VECTVAR1 0 1)
+(PUTV VECTVAR1 -1 1)
+
+(!$TEST UPBV
+ (NULL (UPBV VECTVAR1))
+ (EQN (UPBV VECTVAR3 5) 5 )
+)
+% ----- 3.10 Booleans and Conditionals -----%
+(!$TEST AND
+ (EQ T (AND))
+ (EQ T (AND T))
+ (EQ T (AND T T))
+ (EQN 1 (AND T 1))
+ (EQ T (AND 1 T))
+ (EQ T (AND T T 1 1 T T))
+ (NULL (AND NIL))
+ (NULL (AND T NIL))
+ (NULL (AND NIL T))
+ (NULL (AND T T T T NIL T T))
+)
+% The next should not ERROR, else AND is evaluating all args%
+(AND T T NIL (ERROR 310 "AND Failed") T)
+
+(!$TEST COND
+ (EQN 1 (COND (T 1)))
+ (NULL (COND))
+ (NULL (COND (NIL 1)))
+ (EQN 1 (COND (T 1) (T 2)))
+ (EQN 2 (COND (NIL 1) (T 2)))
+ (NULL (COND (NIL 1) (NIL 2)))
+)
+% Test COND with GO and RETURN%
+(PROG NIL
+ (COND (T (GO L1)))
+ (ERROR 310 "COND fell through")
+ L1 (PRINT "GO in cond worked")
+ (COND (T (RETURN (PRINT "Return 2"))))
+ (ERROR 310 "COND did not RETURN")
+)
+% Certain Extensions to COND might fail%
+%/(COND 1 2)
+%/(COND (T))
+%/(COND (T 1 2 3))
+
+(!$TEST NOT
+ (NULL (NOT T))
+ (EQ T (NOT NIL))
+)
+
+(!$TEST OR
+ (NULL (OR))
+ (EQ T (OR T))
+ (EQ T (OR T T))
+ (EQN T (OR T 1))
+ (EQ 1 (OR 1 T))
+ (EQ T (OR T T 1 1 T T))
+ (NULL (OR NIL))
+ (EQ T (OR T NIL))
+ (EQ T (OR NIL T))
+ (EQ T (OR T T T T NIL T T))
+)
+% The next should not ERROR, else OR is evaluating all args%
+(OR T NIL NIL (ERROR 310 "OR Failed") T)
+
+% -----3.11 Arithmetic Functions-----%
+
+(!$TEST ABS
+ (EQN 0 (ABS 0))
+ (EQN 1 (ABS 1))
+ (EQN 1 (ABS -1))
+ (EQN 0.0 (ABS 0.0))
+ (EQN 1.0 (ABS 1.0))
+ (EQN 1.0 (ABS (MINUS 1.0)))
+)
+
+(!$TEST ADD1
+ (EQN 1 (ADD1 0))
+ (EQN 0 (ADD1 -1))
+ (EQN 2 (ADD1 1))
+ (EQN 1.0 (ADD1 0.0))
+ (EQN 2.0 (ADD1 1.0))
+)
+
+(!$TEST DIFFERENCE
+ (EQN 0 (DIFFERENCE 1 1))
+ (EQN 0.0 (DIFFERENCE 1.0 1.0))
+ (EQN 0.0 (DIFFERENCE 1 1.0))
+ (EQN 0.0 (DIFFERENCE 1.0 1))
+ (EQN 1 (DIFFERENCE 2 1))
+ (EQN -1 (DIFFERENCE 1 2))
+)
+
+(!$TEST DIVIDE
+ (EQUAL (CONS 1 2) (DIVIDE 7 5))
+ (EQUAL (CONS -1 -2) (DIVIDE -7 5))
+ (EQUAL (CONS -1 2) (DIVIDE 7 -5))
+ (EQUAL (CONS 1 -2) (DIVIDE -7 -5))
+)
+(!$TEST EXPT
+ (EQN (EXPT 2 0) 1)
+ (EQN (EXPT 2 1) 2)
+ (EQN (EXPT 2 2) 4)
+ (EQN (EXPT 2 3) 8)
+ (EQN (EXPT -2 2) 4)
+ (EQN (EXPT -2 3) -8)
+)
+
+(!$TEST FIX
+ (NUMBERP (FIX 1.0))
+ (FIXP (FIX 1.0))
+ (NULL (FLOATP (FIX 1.0)))
+ (EQN (FIX 1.0 ) 1)
+ (NUMBERP (FIX 1))
+ (FIXP (FIX 1))
+)
+
+(!$TEST FLOAT
+ (NUMBERP (FLOAT 1))
+ (FLOATP (FLOAT 1))
+ (NULL (FIXP (FLOAT 1)))
+ (EQN 1.0 (FLOAT 1))
+)
+
+(!$TEST GREATERP
+ (GREATERP 2 1)
+ (GREATERP 1 0)
+ (GREATERP 0 -1)
+ (NULL (GREATERP 2 2))
+ (NULL (GREATERP 1 1))
+ (NULL (GREATERP 0 0))
+ (NULL (GREATERP 0 1))
+ (NULL (GREATERP -1 0))
+)
+(!$TEST LESSP
+ (NULL (LESSP 2 1))
+ (NULL (LESSP 1 0))
+ (NULL (LESSP 0 -1))
+ (NULL (LESSP 2 2))
+ (NULL (LESSP 1 1))
+ (NULL (LESSP 0 0))
+ (LESSP 0 1)
+ (LESSP -1 0)
+)
+(!$TEST MAX
+ (EQN (MAX 1 2 3) 3)
+ (EQN (MAX 3 2 1) 3)
+ (EQN 1 (MAX 1 0))
+ (EQN 1 (MAX 1))
+)
+% What is (MAX) ;
+(MAX)
+
+(!$TEST MAX2
+ (EQN (MAX2 1 2) 2)
+ (EQN (MAX2 2 1) 2)
+ (EQN 1 (MAX2 1 0))
+ (EQN 1 (MAX2 0 1))
+ (EQN -1 (MAX2 -1 -2))
+)
+(!$TEST MIN
+ (EQN (MIN 1 2 3) 1)
+ (EQN (MIN 3 2 1) 1)
+ (EQN 0 (MIN 1 0))
+ (EQN 1 (MIN 1))
+)
+% What is (MIN) ;
+(MIN)
+
+(!$TEST MIN2
+ (EQN (MIN2 1 2) 1)
+ (EQN (MIN2 2 1) 1)
+ (EQN 0 (MIN2 1 0))
+ (EQN 0 (MIN2 0 1))
+ (EQN -2 (MIN2 -1 -2))
+)
+(!$TEST MINUS
+ (EQN 0 (MINUS 0))
+ (EQN -1 (MINUS 1))
+ (MINUSP (MINUS 1))
+ (MINUSP -1)
+ (LESSP -1 0)
+ (EQN 1 (MINUS -1))
+)
+
+(!$TEST PLUS
+ (EQN 6 (PLUS 1 2 3))
+ (EQN 10 (PLUS 1 2 3 4))
+ (EQN 0 (PLUS 1 2 3 -6))
+ (EQN 3 (PLUS 1 2))
+ (EQN 1 (PLUS 1))
+)
+% What is (PLUS) ;
+(PLUS)
+
+(!$TEST PLUS2
+ (EQN 3 (PLUS2 1 2))
+ (EQN 0 (PLUS2 1 -1))
+ (EQN 1 (PLUS2 -2 3))
+)
+
+(!$TEST QUOTIENT
+ (EQN 1 (QUOTIENT 3 3))
+ (EQN 1 (QUOTIENT 4 3))
+ (EQN 1 (QUOTIENT 5 3))
+ (EQN 2 (QUOTIENT 6 3))
+ (EQN -1 (QUOTIENT -3 3))
+ (EQN -1 (QUOTIENT 3 -3))
+ (EQN -1 (QUOTIENT 4 -3))
+ (EQN -1 (QUOTIENT -4 3))
+)
+
+% Expect 2 ZERO DIVISOR error messages%
+(QUOTIENT 1 0)
+(QUOTIENT 0 0)
+
+(!$TEST REMAINDER
+ (EQN 0 (REMAINDER 3 3))
+ (EQN 1 (REMAINDER 4 3))
+ (EQN 2 (REMAINDER 5 3))
+ (EQN 0 (REMAINDER 6 3))
+ (EQN 0 (REMAINDER -3 3))
+ (EQN 0 (REMAINDER 3 -3))
+ (EQN -1 (REMAINDER 4 -3))
+ (EQN -1 (REMAINDER -4 3))
+)
+
+% Expect 2 ZERO DIVISOR error messages%
+(REMAINDER 1 0)
+(REMAINDER 0 0)
+
+(!$TEST SUB1
+ (EQN 1 (SUB1 2))
+ (EQN 0 (SUB1 1))
+ (EQN -1 (SUB1 0))
+)
+
+(!$TEST TIMES
+ (EQN 6 (TIMES 1 2 3))
+ (EQN 1 (TIMES 1))
+ (EQN 2 (TIMES 1 2))
+)
+% What is (TIMES) ;
+(TIMES)
+
+(!$TEST TIMES2
+ (EQN 0 (TIMES2 1 0))
+ (EQN 0 (TIMES2 0 1))
+ (EQN 10 (TIMES2 5 2))
+ (EQN -10 (TIMES2 5 -2))
+)
+
+% -----3.12 MAP composite functions ------%
+
+(SETQ LST (QUOTE (1 2 3)))
+(DE LISTX (X) (LIST X (QUOTE X)))
+(DE PRNTX (X) (PRINT (LISTX X)))
+
+% MAP: Expect 3 lines of output, equivalent to:%
+% ((1 2 3) X)%
+% ((2 3) X)%
+% ((3) X)%
+(!$TEST MAP (NULL (MAP LST (FUNCTION PRNTX))))
+
+% MAPC: Expect 3 lines of output, equivalent to:%
+% (1 X)%
+% (2 X)%
+% (3 X)%
+(!$TEST MAPC (NULL (MAPC LST (FUNCTION PRNTX))))
+
+% MAPCAN: Expect 3 lines of output, equivalent to:%
+% (1 X)%
+% (2 X)%
+% (3 X)%
+(!$TEST MAPCAN
+ (EQUAL (MAPCAN LST (FUNCTION PRNTX))
+ (QUOTE (1 X 2 X 3 X)))
+)
+
+% MAPCAR: Expect 3 Lines of output, equivalent to:%
+% (1 X)%
+% (2 X)%
+% (3 X)%
+(!$TEST MAPCAR
+ (EQUAL (MAPCAR LST (FUNCTION PRNTX))
+ (QUOTE ((1 X) (2 X) (3 X))))
+)
+
+% MAPCON: Expect 3 lines of output, equivalent to:%
+% ((1 2 3) X)%
+% ((2 3) X)%
+% ((3) X)%
+(!$TEST MAPCON
+ (EQUAL (MAPCON LST (FUNCTION PRNTX))
+ (QUOTE ((1 2 3) X (2 3) X (3) X)))
+)
+
+% MAPLIST: Expect 3 lines of output, equivalent to:%
+% ((1 2 3) X)%
+% ((2 3) X)%
+% ((3) X)%
+
+(!$TEST MAPLIST
+ (EQUAL (MAPLIST LST (FUNCTION PRNTX))
+ (QUOTE (((1 2 3) X) ((2 3) X) ((3) X))))
+)
+
+% ----- 3 . 13 Composite Functions -----%
+(SETQ APPVAR1 (QUOTE (1 2 3)))
+
+(!$TEST APPEND
+ (NULL (APPEND NIL NIL))
+ (EQUAL APPVAR1 (SETQ APPVAR2 (APPEND APPVAR1 NIL)))
+ (NULL (EQ APPVAR1 APPVAR2))
+ (EQUAL APPVAR1 (SETQ APPVAR2 (APPEND NIL APPVAR1)))
+ (EQ APPVAR1 APPVAR2)
+ (EQUAL APPVAR1 (APPEND (QUOTE (1)) (QUOTE (2 3))))
+ (EQUAL APPVAR1 (APPEND (QUOTE (1 2)) (QUOTE (3))))
+)
+
+(SETQ ASSVAR
+ (QUOTE ( ((1 . 1) . ONE) ((2 . 2) . TWO) ((3 . 3) . THREE) ) ) )
+(!$TEST ASSOC
+ (NULL (ASSOC NIL NIL))
+ (NULL (ASSOC 1 NIL))
+ (NULL (ASSOC 1 ASSVAR))
+ (EQUAL (QUOTE ((1 . 1) . ONE)) (ASSOC (QUOTE (1 . 1)) ASSVAR))
+ (EQUAL (QUOTE ((2 . 2) . TWO)) (ASSOC (QUOTE (2 . 2)) ASSVAR))
+)
+% Expect Error MSG on poor ALIST%
+(ASSOC (QUOTE (1)) (QUOTE (1 2 3)))
+
+(SETQ DLIST (QUOTE ((AA BB) (EE FF))))
+
+(!$TEST DEFLIST
+ (EQUAL (QUOTE (AA EE)) (DEFLIST DLIST (QUOTE DEFLIST)))
+ (EQ (QUOTE BB) (GET (QUOTE AA) (QUOTE DEFLIST)))
+ (EQ (QUOTE FF) (GET (QUOTE EE) (QUOTE DEFLIST)))
+)
+
+(!$TEST DELETE
+ (EQUAL (QUOTE ((1 . 1) (2 . 2)))
+ (DELETE (QUOTE (0 . 0)) (QUOTE ((0 . 0) (1 . 1) (2 . 2)))))
+ (EQUAL (QUOTE ((0 . 0) (2 . 2)))
+ (DELETE (QUOTE (1 . 1)) (QUOTE ((0 . 0) (1 . 1) (2 . 2)))))
+ (EQUAL (QUOTE ((0 . 0) (2 . 2) (1 . 1)))
+ (DELETE (QUOTE (1 . 1))
+ (QUOTE ((0 . 0) (1 . 1) (2 . 2) (1 . 1)))))
+)
+
+(SETQ DIGITLST (QUOTE (!0 !1 !2 !3 !4 !5 !6 !7 !8 !9)))
+
+(DE TESTEACH (LST FN)
+ (PROG (X)
+ L1 (COND ((NULL (PAIRP LST)) (RETURN T)))
+ (SETQ X (APPLY FN (LIST (CAR LST)))) % Not (FN (CAR LST)) ?
+ (COND ((NULL X)
+ (PRINT (LIST "*** TESTEACH " (CAR LST) " failed"))))
+ (SETQ LST (CDR LST))
+ (GO L1)))
+(!$TEST DIGIT
+ (TESTEACH DIGITLST (FUNCTION DIGIT))
+ (NULL (DIGIT 1))
+ (NULL (DIGIT (QUOTE A)))
+ (NULL (DIGIT "1"))
+)
+
+(!$TEST LENGTH
+ (EQN 0 (LENGTH (QUOTE A)))
+ (EQN 0 (LENGTH 1))
+ (EQN 1 (LENGTH (QUOTE (A))))
+ (EQN 1 (LENGTH (QUOTE (A . B))))
+ (EQN 2 (LENGTH (QUOTE (A B))))
+)
+
+(SETQ UPVAR
+ (QUOTE (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z)))
+(SETQ DNVAR
+ (QUOTE (a b c d e f g h i j k l m n o p q r s t u v w x y z)))
+
+(!$TEST LITER
+ (TESTEACH UPVAR (FUNCTION LITER))
+ (TESTEACH DNVAR (FUNCTION LITER))
+ (NULL (LITER "A"))
+ (NULL (LITER 1))
+ (NULL (LITER (QUOTE AA)))
+)
+
+(SETQ MEMBVAR (QUOTE ((1 . 1) ( 2 . 2) (3 . 3))))
+
+(!$TEST MEMBER
+ (NULL (MEMBER NIL NIL))
+ (NULL (MEMBER NIL MEMBVAR))
+ (NULL (MEMBER (QUOTE (4 . 4)) MEMBVAR))
+ (EQ (CDR MEMBVAR) (MEMBER (QUOTE (2 . 2)) MEMBVAR))
+)
+
+(!$TEST MEMQ
+ (NULL (MEMQ NIL NIL))
+ (EQ MEMBVAR (MEMQ (CAR MEMBVAR) MEMBVAR))
+ (NULL (MEMQ (QUOTE (1 . 1)) MEMBVAR))
+ (EQ (CDR MEMBVAR) (MEMQ (CADR MEMBVAR) MEMBVAR))
+)
+
+
+(SETQ NCONCVAR1 (LIST 1 2 3))
+
+(!$TEST NCONC
+ (EQUAL (QUOTE (1 2 3 4 5))
+ (SETQ NCONCVAR2 (NCONC NCONCVAR1 (QUOTE ( 4 5)))))
+ (EQ NCONCVAR1 NCONCVAR2)
+ (EQUAL NCONCVAR1 (QUOTE (1 2 3 4 5)))
+)
+
+(!$TEST PAIR
+ (EQUAL NIL (PAIR NIL NIL))
+ (EQUAL (QUOTE ((1 . ONE) (2 . TWO)))
+ (PAIR (QUOTE (1 2)) (QUOTE (ONE TWO))))
+)
+
+% expect 2 PAIR mismatch errors%
+
+(PAIR (QUOTE (1)) (QUOTE ( ONE TWO)))
+(PAIR (QUOTE (1)) NIL)
+
+(!$TEST REVERSE
+ (NULL (REVERSE NIL))
+ (EQUAL (QUOTE (1)) (REVERSE (QUOTE (1))))
+ (EQUAL (QUOTE (1 2 3)) (REVERSE (QUOTE (3 2 1))))
+ (EQUAL (QUOTE ((1 . 2) (2 . 3) (3 4 5)))
+ (REVERSE (QUOTE ((3 4 5) (2 . 3) (1 . 2)))))
+)
+
+(DE SASSFN NIL
+ (PROG2 (PRINT "Sassfn Called") 99))
+
+(SETQ SASSVAR (QUOTE ((1 . ONE) (2 . TWO))))
+
+(!$TEST SASSOC
+ (EQN 99 (SASSOC NIL NIL (FUNCTION SASSFN)))
+ (EQN 99 (SASSOC NIL SASSVAR (FUNCTION SASSFN)))
+ (EQUAL (QUOTE (2 . TWO))
+ (SASSOC 2 SASSVAR (FUNCTION SASSFN)))
+)
+
+% Expect ERROR for poor alist:
+(SASSOC (QUOTE A) (QUOTE (B (A . 1))) (FUNCTION SASSFN))
+% Set up SUBLIS values
+(SETQ SUBLVAR1 (QUOTE ((X . 1) ((X . X) . 2))))
+(SETQ SUBLVAR2 (QUOTE (X X (X . 1) (X . X) ((X . X)))))
+(SETQ SUBLVAR3 (QUOTE (1 1 (1 . 1) 2 (2))))
+
+(!$TEST SUBLIS
+ (NULL (SUBLIS NIL NIL))
+ (EQN 1 (SUBLIS NIL 1))
+ (EQ SUBLVAR2 (SUBLIS NIL SUBLVAR2))
+ (EQUAL SUBLVAR2 (SUBLIS NIL SUBLVAR2))
+ (EQ SUBLVAR2 (SUBLIS (QUOTE ((Y . 3))) SUBLVAR2))
+% Will fail, but nice opt if no action;
+ (EQUAL SUBLVAR2 (SUBLIS (QUOTE ((Y . 3))) SUBLVAR2))
+ (EQUAL SUBLVAR3 (SUBLIS SUBLVAR1 SUBLVAR2))
+)
+
+(!$TEST SUBST
+ (NULL (SUBST NIL 1 NIL))
+ (EQ (QUOTE A) (SUBST NIL 1 (QUOTE A)))
+ (EQN 1 (SUBST 1 2 2))
+ (EQUAL (CONS 2 2) (SUBST 2 1 (CONS 1 1)))
+ (EQUAL (QUOTE (1 1 (1 . 1) (1 . 1) ((1 . 1))))
+ (SUBST 1 (QUOTE X) SUBLVAR2))
+)
+% ----- 3.14 The Interpreter ----%
+
+% To be done ;
+
+% ----- 3.15 IO -----%
+% ----- 3.16 The Standard LISP Reader ----%
+% To be done ;
+
+% ----- 4.0 Globals ----%
+
+% To be done ;
+
+% ----- 5.0 Miscellaneous functions -----%
+
+% to be done ;
ADDED psl-1983/3-1/tests/reduce-timing.txt
Index: psl-1983/3-1/tests/reduce-timing.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/reduce-timing.txt
@@ -0,0 +1,53 @@
+ 6-Apr-83 12:04:55-MST,1641;000000000001
+Return-path: <@UTAH-CS:GRISS@HP-HULK>
+Received: from UTAH-CS by UTAH-20; Wed 6 Apr 83 12:03:19-MST
+Date: 6 Apr 1983 1049-PST
+From: GRISS@HP-HULK
+Subject: Latest REDUCE-TIMES.DOC
+Message-Id: <418503140.11433.hplabs@HP-VENUS>
+Received: by HP-VENUS via CHAOSNET; 6 Apr 1983 10:52:19-PST
+Received: by UTAH-CS.ARPA (3.320.5/3.7.6)
+ id AA16318; 6 Apr 83 12:00:03 MST (Wed)
+To: kessler@HP-VENUS, griss@HP-VENUS
+
+ Standard Reduce Test file, as of 6 April 1983
+
+ This is IN "RTEST:REDUCE.TST"; which echoes to the terminal. MATR
+
+and HIPHYS modules autoload. Includes NBIG module. Need LISP ON GC;
+before IN of REDUCE.TST.
+
+ System Heap Run GC time #GC Sys Total Time Date
+
+PSL 3.1 based:
+ DEC-20/60, Utah 90K 24.4 7.0 3 ? 31.4 3/6/83
+ Extended DEC-20/60, Utah 260K 25.9 1.0 1 ? 26.9 3/6/83
+ VAX-780, Unix 4.1, HP 400K 48.3 0 0 ~12 ~60 3/6/83
+ VAX-750, Unix 4.1a, Utah
+ VAX-750, Unix 4.1a, Rand ~90
+ HP9836, 8Mhz MC68000, HP ~120
+ Apollo, 8Mhz MC68000, Utah ~175
+
+[We still need to include some SYSTEM or I/O time, on VAX it is quite high.
+ Ie, need TIMS() and TIMR() calls for load, paging, etc.
+ What is equivalent on other machines?.
+
+
+ Memory sizes
+ Utah 20/60
+ HP DEC-20/60 5.625 Mb (1.25M 36 bit words)
+ HP VAX-780 4.0 Mb
+ Utah Vax 750
+ Rand Vax 750
+ HP9836 4.5 Mb
+ Apollo 1 Mb
+
+LISP 1.6
+
+
+
+IBM Standard LISP
+
+-------
+
+
ADDED psl-1983/3-1/tests/seive.tst
Index: psl-1983/3-1/tests/seive.tst
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/seive.tst
@@ -0,0 +1,186 @@
+27-Mar-83 09:09:18-MST,4778;000000000001
+Return-path: <GRISS@HP-HULK>
+Received: from UTAH-CS by UTAH-20; Sun 27 Mar 83 09:07:41-MST
+Date: 27 Mar 1983 0753-PST
+From: GRISS@HP-HULK
+Subject: String and vector
+Message-Id: <417628520.17208.hplabs@HP-VENUS>
+Received: by HP-VENUS via CHAOSNET; 27 Mar 1983 07:55:19-PST
+Received: by UTAH-CS.ARPA (3.320.3/3.7.4)
+ id AA28476; 27 Mar 83 08:59:13 MST (Sun)
+To: kessler@HP-VENUS, griss@HP-VENUS
+
+I was doing some timings on SIEVE.RED (attached) on VAX and 20.
+Havent yet done for 68000. Compared with C on VAX:
+
+a) Proportionately, VECTOR much slower on VAX; due to need to multiply
+ by 4 to convert VECITM(V,i)=> V+4*(i+1) on VAX; if I work with P4=4*P,
+ (CheatVtest), am getting code about as fast as C on the VAX for Vectors.
+
+
+b) On VAX, string pointer of course just byte address, while on 20 have to
+ unpack bytes, using LDB and ADJBP, so that STRING much slower than
+ even on VAX!
+
+26 March, tests of SIEVE.C and SIEVE.RED on MARS, vax-790
+---------------------------------------------------------
+
+100 loops of sieve of Eratosthenes, on 1000 length sieve.
+This is a set of LOOPs with no procedure calls (in C or SYSLISP).
+
+Test C Fast C PSL SYSLISP SYSLISP/fast C
+
+STRING 3264 2941 66130 3519 1.2
+VECTOR 3077 2720 26520 4284 (a) 1.6
+
+
+On DEC-20, String 33970 5970 (b)
+ Vector 11370 1896 (c)
+
+
+Notes:
+
+(a) on VAX, use 4*index as pointer, get 2618, and code similar to C.
+(b) notice that this slower than VAX, since using LDB and ADJBP on 20
+ but direct BYTE address on VAX.
+(c) on 20, if we use pointer rather than index, get 1541 which is not as
+ dramatic as on the VAx, since not saving the 4* to convert index
+ to BYTE address
+(d) Fast-C uses the -O code improvment option, and some loops seem to use
+ a AOBLEQ (on VAX, like AOBJN on 20).
+
+
+May want to start thinking about Code-Gen improvments, and source to
+source improvements to catch these and similar constructs. Discuss
+with Mark, Jed, Bobbie
+
+% sieve.red -----
+on comp;
+Fluid '(Tim1 Tim2);
+
+on syslisp;
+
+procedure start();
+ Lispvar(tim1) :=timc();
+
+procedure done s;
+ <<lispvar(tim2):=timc();
+ printf(" ---- %p ---%p%n",s,lispvar(tim2)-lispvar(tim1));
+>>;
+
+procedure TestSL n;
+begin scalar primes;
+ primes := Mkstring(1000,1);
+ start();
+ for i:=1:n do Lsieve primes;
+ done "lsieve, string";
+ end;
+
+procedure TestVL n;
+begin scalar primes;
+ primes := MkVect(1000);
+ start();
+ for i:=1:n do Lsieve primes;
+ done "lsieve, vector";
+ end;
+
+procedure TestV n;
+begin scalar primes;
+ primes := Mkvect 1000;
+ start();
+ for i:=1:n do Vsieve primes;
+ done "Vsieve";
+ end;
+
+procedure TestCheatV n;
+begin scalar primes;
+ primes := Mkvect 1000;
+ start();
+ for i:=1:n do CheatVsieve primes;
+ done "CheatVsieve";
+ end;
+
+procedure TestS n;
+begin scalar primes;
+ primes := Mkstring(1000,1);
+ start();
+ for i:=1:n do Ssieve primes;
+ done "Ssieve";
+ end;
+
+off syslisp;
+
+lisp procedure lsieve(primes);
+ begin
+ scalar p, mp;
+ for i:=0:1000 do setindx(primes,1);
+% printf("Primes%n");
+ for p := 2:1000 do
+ if indx(primes, p) eq 1 then
+ <<
+% printf(" %d%n", p);
+ for mp := 2*p step p until 1000 do
+ setindx(primes, mp, 0)
+ >>
+end;
+
+on syslisp;
+
+syslisp procedure ssieve(primes);
+begin
+ scalar p, mp;
+ primes := strinf primes;
+ for i:=0:1000 do strbyt(primes,i):=1;
+% printf("Primes%n");
+ for p := 2:1000 do
+ if strbyt(primes, p) eq 1 then
+ <<
+% printf(" %d%n", p);
+ for mp := 2*p step p until 1000 do
+ strbyt(primes, mp) := 0
+ >>
+end;
+
+syslisp procedure vsieve(primes);
+begin
+ scalar p, mp;
+ primes := vecinf(primes);
+ for p:=0:1000 do vecitm(vecinf primes,p):=1;
+% printf("Primes%n");
+ for p := 2:1000 do
+ if vecitm(primes, p) eq 1 then
+ <<
+% printf(" %d%n", p);
+ for mp := 2*p step p until 1000 do
+ vecitm(primes, mp) := 0
+ >>
+
+end;
+
+syslisp procedure Cheatvsieve(primes);
+begin
+ scalar p, p4, mp,mp4, base;
+ primes := vecinf(primes);
+ base := primes +addressingunitsperitem;
+ p4:= base +0;
+ for p:=0:1000 do <<putmem(p4,1); p4:=p4+addressingunitsperitem>>;
+% printf("Primes%n");
+ p4:=base+2*addressingunitsperitem;
+ for p := 2:1000 do
+ << if getmem( p4) eq 1 then
+ <<
+% printf(" %d%n", p);
+ mp4 := base +2*addressingunitsperitem*p;
+ for mp := 2*p step p until 1000 do
+ <<putmem(mp4,0); mp4:=mp4+addressingunitsperitem >> >>;
+ p4 :=p4 +addressingunitsperitem>>
+
+end;
+
+
+off syslisp;
+end;
+
+-------
+
+
ADDED psl-1983/3-1/tests/simpler-time.sl
Index: psl-1983/3-1/tests/simpler-time.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/simpler-time.sl
@@ -0,0 +1,20 @@
+(TESTSETUP) % USE after each fresh start
+(TIMEEVAL '(EMPTYTEST 10000))
+(TIMEEVAL '(SLOWEMPTYTEST 10000))
+(TIMEEVAL '(CDR1TEST 100))
+(TIMEEVAL '(CDR2TEST 100))
+(TIMEEVAL '(CDDRTEST 100))
+(TIMEEVAL '(LISTONLYCDRTEST1))
+(TIMEEVAL '(LISTONLYCDDRTEST1))
+(TIMEEVAL '(LISTONLYCDRTEST2))
+(TIMEEVAL '(LISTONLYCDDRTEST2))
+(TIMEEVAL '(REVERSETEST 10))
+(TIMEEVAL '(MYREVERSE1TEST 10))
+(TIMEEVAL '(MYREVERSE2TEST 10))
+(TIMEEVAL '(LENGTHTEST 100))
+(TIMEEVAL '(ARITHMETICTEST 10000))
+(TIMEEVAL '(EVALTEST 10000))
+(TIMEEVAL '(TOPLEVELTAK 18 12 6))
+(TIMEEVAL '(TOPLEVELGTAK 18 12 6))
+(TIMEEVAL '(GTSTB 'G0))
+(TIMEEVAL '(GTSTB 'G1))
ADDED psl-1983/3-1/tests/standard-20.tim
Index: psl-1983/3-1/tests/standard-20.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/standard-20.tim
@@ -0,0 +1,22 @@
+(
+("DEC-20, standard 3.1 PSL" . "5-Mar-83 ")
+(EmptyTest-10000 . 18)
+(GEmptyTest-10000 . 280)
+(Cdr1Test-100 . 525)
+(Cdr2Test-100 . 372)
+(CddrTest-100 . 274)
+(ListOnlyCdrTest1 . 1780)
+(ListOnlyCddrTest1 . 3392)
+(ListOnlyCdrTest2 . 2721)
+(ListOnlyCddrTest2 . 4114)
+(ReverseTest-10 . 265)
+(MyReverse1Test-10 . 267)
+(MyReverse2Test-10 . 246)
+(LengthTest-100 . 568)
+(ArithmeticTest-10000 . 593)
+(EvalTest-10000 . 1919)
+(tak-18-12-6 . 493)
+(gtak-18-12-6 . 1975)
+(gtsta-g0 . 733)
+(gtsta-g1 . 799)
+)
ADDED psl-1983/3-1/tests/standard-apollo.tim
Index: psl-1983/3-1/tests/standard-apollo.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/standard-apollo.tim
@@ -0,0 +1,45 @@
+% improved PAIRP added
+(("standard Apollo 3.1 PSL 29-mar-83")
+(EmptyTest-10000 . 75)
+(SlowEmptyTest-10000 . 1939)
+(Cdr1Test-100 . 1806)
+(Cdr2Test-100 . 1268)
+(CddrTest-100 . 943)
+(ListOnlyCdrTest1 . 7629)
+(ListOnlyCddrTest1 . 11280)
+(ListOnlyCdrTest2 . 10843)
+(ListOnlyCddrTest2 . 14615)
+(ReverseTest-10 . 1532)
+(MyReverse1Test-10 . 1517) % slower 2492
+(MyReverse2Test-10 . 1438)
+(LengthTest-100 . 2261)
+(ArithmeticTest-10000 . 6832)
+(EvalTest-10000 . 16336)
+(tak-18-12-6 . 2318)
+(gtak-18-12-6 . 12644)
+(gtsta-g0 . 6658) % slower 7098
+(gtsta-g1 . 6880) % slower 7150
+)
+
+%(EmptyTest-10000 . 0.803816)
+%(SlowEmptyTest-10000 . 2.1205428)
+%(Cdr1Test-100 . 2.9690535)
+%(Cdr2Test-100 . 1.2983992)
+%(CddrTest-100 . 0.9800398)
+%(ListOnlyCdrTest1 . 7.7453597)
+%(ListOnlyCddrTest1 . 11.5986295)
+%(ListOnlyCdrTest2 . 17.7415738)
+%(ListOnlyCddrTest2 . 21.4907193)
+%(ReverseTest-10 . 2.9006324)
+%(MyReverse1Test-10 . 2.7918677)
+%(MyReverse2Test-10 . 1.5556617)
+%(LengthTest-100 . 3.4324918)
+%(ArithmeticTest-10000 . 7.2217984)
+%(EvalTest-10000 . 19.1918912)
+%(tak-18-12-6 . 2.4505582)
+%(gtak-18-12-6 . 13.8012662)
+%(gtsta-g0 . 6.8267789)
+%(gtsta-g1 . 7.385675)
+)
+-------
+
ADDED psl-1983/3-1/tests/standard-cray.tim
Index: psl-1983/3-1/tests/standard-cray.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/standard-cray.tim
@@ -0,0 +1,25 @@
+PSL Spectral Tests, Cray test system, No-Date-Yet
+---------------------------------------------------------------
+*** Dummy RECLAIM: 19587 Items used, 130413 Items left.
+EmptyTest 10000 2414
+SlowEmptyTest 10000 35791
+Cdr1Test 100 58905
+Cdr2Test 100 50505
+CddrTest 100 38961
+ListOnlyCdrTest1 301698
+ListOnlyCddrTest1 439219
+ListOnlyCdrTest2 352000
+ListOnlyCddrTest2 489314
+ReverseTest 10 91640
+*** Dummy RECLAIM: 56645 Items used, 93355 Items left.
+MyReverse1Test 10 92964
+*** Dummy RECLAIM: 93304 Items used, 56696 Items left.
+MyReverse2Test 10 85904
+*** Dummy RECLAIM: 129963 Items used, 20037 Items left.
+LengthTest 100 54925
+ArithmeticTest 10000 87468
+EvalTest 10000 533178
+tak 18 12 6 49782
+gtak 18 12 6 237455
+gtsta g0 280169
+gtsta g1 282683
ADDED psl-1983/3-1/tests/standard-hp9836.tim
Index: psl-1983/3-1/tests/standard-hp9836.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/standard-hp9836.tim
@@ -0,0 +1,22 @@
+(
+("PSL 3.1, Standard 8Mhz HP9836" . " 5-Mar-83")
+(EmptyTest-10000 . 70)
+(GEmptyTest-10000 . 1930)
+(Cdr1Test-100 . 2660)
+(Cdr2Test-100 . 1120)
+(CddrTest-100 . 850)
+(ListOnlyCdrTest1 . 6700)
+(ListOnlyCddrTest1 . 10090)
+(ListOnlyCdrTest2 . 15960)
+(ListOnlyCddrTest2 . 19270)
+(ReverseTest-10 . 1480)
+(MyReverse1Test-10 . 1470)
+(MyReverse2Test-10 . 1310)
+(LengthTest-100 . 3080)
+(ArithmeticTest-10000 . 6560)
+(EvalTest-10000 . 17650)
+(tak-18-12-6 . 2770)
+(gtak-18-12-6 . 13130)
+(gtsta-g0 . 5810)
+(gtsta-g1 . 5980)
+)
ADDED psl-1983/3-1/tests/standard-vax-750.tim
Index: psl-1983/3-1/tests/standard-vax-750.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/standard-vax-750.tim
@@ -0,0 +1,22 @@
+(
+("PSL 3.1, Standard VAX 750, Utah-cs, 6-Mar-83")
+(EmptyTest-10000 . 51)
+(GEmptyTest-10000 . 1224)
+(Cdr1Test-100 . 2074)
+(Cdr2Test-100 . 1530)
+(CddrTest-100 . 1411)
+(ListOnlyCdrTest1 . 9860)
+(ListOnlyCddrTest1 . 15793)
+(ListOnlyCdrTest2 . 12937)
+(ListOnlyCddrTest2 . 19023)
+(ReverseTest-10 . 1139)
+(MyReverse1Test-10 . 1207)
+(MyReverse2Test-10 . 1088)
+(LengthTest-100 . 2482)
+(ArithmeticTest-10000 . 1972)
+(EvalTest-10000 . 10268)
+(tak-18-12-6 . 1326)
+(gtak-18-12-6 . 7565)
+(gtsta-g0 . 4539)
+(gtsta-g1 . 4879)
+)
ADDED psl-1983/3-1/tests/standard-vax-780.tim
Index: psl-1983/3-1/tests/standard-vax-780.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/standard-vax-780.tim
@@ -0,0 +1,22 @@
+(
+("PSL 3.1, Standard VAX 780 " . " 5-Mar-83")
+(EmptyTest-10000 . 51)
+(GEmptyTest-10000 . 646)
+(Cdr1Test-100 . 1564)
+(Cdr2Test-100 . 1105)
+(CddrTest-100 . 969)
+(ListOnlyCdrTest1 . 6749)
+(ListOnlyCddrTest1 . 12070)
+(ListOnlyCdrTest2 . 9384)
+(ListOnlyCddrTest2 . 14824)
+(ReverseTest-10 . 714)
+(MyReverse1Test-10 . 697)
+(MyReverse2Test-10 . 612)
+(LengthTest-100 . 1666)
+(ArithmeticTest-10000 . 833)
+(EvalTest-10000 . 6562)
+(tak-18-12-6 . 816)
+(gtak-18-12-6 . 5627)
+(gtsta-g0 . 2720)
+(gtsta-g1 . 3077)
+)
ADDED psl-1983/3-1/tests/stubs2.red
Index: psl-1983/3-1/tests/stubs2.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs2.red
@@ -0,0 +1,7 @@
+% STUBS2.RED
+% just a dummy for now
+
+procedure Flag(x, y);
+ List('dummy, 'flag, x,y);
+
+END;
ADDED psl-1983/3-1/tests/stubs3.red
Index: psl-1983/3-1/tests/stubs3.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs3.red
@@ -0,0 +1,6 @@
+% STUBS3.RED - Mini RECLAIM called
+% MLG, 18 Feb 1983
+
+in "pt:mini-gc.red"$
+
+End;
ADDED psl-1983/3-1/tests/stubs4.red
Index: psl-1983/3-1/tests/stubs4.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs4.red
@@ -0,0 +1,25 @@
+% STUBS4.RED - Stubs to support more automatic testing from TEST4 and on
+
+procedure SpaceD(M);
+<<Prin2 " ";
+ Prin2t M>>;
+
+procedure DasheD(M);
+<<Terpri();
+ Prin2 "---------- ";
+ Prin2T M>>;
+
+procedure DotteD(M);
+<<Terpri();
+ Prin2 " ....... ";
+ Prin2T M>>;
+
+
+Procedure ShouldBe(M,v,e);
+% test if V eq e;
+ <<Prin2 " ....... For ";Prin2 M; Prin2 '" ";
+ Prin1 v; Prin2 '" should be "; Prin1 e;
+ if v eq e then Prin2T '" [OK ]"
+ else Prin2T '" [BAD] *******">>;
+
+End;
ADDED psl-1983/3-1/tests/stubs5.red
Index: psl-1983/3-1/tests/stubs5.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs5.red
@@ -0,0 +1,35 @@
+% STUBS5.RED - Stubs for TEST5 and Above
+
+Fluid '(UndefnCode!* UndefnNarg!*);
+on syslisp;
+
+syslsp procedure UndefinedFunctionAuxAux;
+% Interim version of UndefinedFunctionAux;
+ Begin scalar FnId,Nargs;
+ Nargs:=LispVar UndefnNarg!*;
+ FnId := MkID (LispVar UndefnCode!*);
+ Prin2 "Undefined Function ";
+ Prin1 FnId;
+ Prin2 " called with ";
+ Prin2 Nargs;
+ prin2T " args from compiled code";
+ Quit;
+ End;
+
+
+% Some SYSLISP tools for debugging:
+
+syslsp procedure INF x;
+ Inf x;
+
+syslsp procedure TAG x;
+ TAG x;
+
+syslsp procedure MKITEM(x,y);
+ MkItem(X,y);
+
+off syslisp;
+
+End;
+
+
ADDED psl-1983/3-1/tests/stubs6.red
Index: psl-1983/3-1/tests/stubs6.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs6.red
@@ -0,0 +1,15 @@
+% STUBS6.RED -Stubs introduced for TEST6 and up
+
+in "PT:mini-top-loop.red"$
+
+On syslisp;
+
+Procedure FUNCALL(FN,I);
+ IDApply1(I,FN);
+
+off syslisp;
+
+
+END;
+
+
ADDED psl-1983/3-1/tests/stubs7.red
Index: psl-1983/3-1/tests/stubs7.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs7.red
@@ -0,0 +1,5 @@
+% STUBS7.RED
+
+% none yet
+
+End;
ADDED psl-1983/3-1/tests/stubs8.red
Index: psl-1983/3-1/tests/stubs8.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs8.red
@@ -0,0 +1,12 @@
+% STUBS8.RED - Stubs as GC is installed
+
+procedure Known!-free!-space();
+ 1;
+
+procedure ContinuableError(x,y);
+ <<print list ("Continuable Error ",x,y);
+ y>>;
+
+END;
+
+
ADDED psl-1983/3-1/tests/stubs9.red
Index: psl-1983/3-1/tests/stubs9.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/stubs9.red
@@ -0,0 +1,9 @@
+% STUBS9.RED
+
+procedure MkQuote x;
+ List('quote,x);
+
+procedure flag(x,y);
+ NIL;
+
+End;
ADDED psl-1983/3-1/tests/sub2.red
Index: psl-1983/3-1/tests/sub2.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub2.red
@@ -0,0 +1,10 @@
+% SUB2.RED - More comprehensive Mini I/O
+
+in "pt:mini-char-io.red"$
+In "pt:mini-printers.red"$
+In "pt:mini-printf.red"$
+In "pt:mini-error-errorset.red"$
+In "pt:mini-error-handlers.red"$
+In "pt:mini-type-errors.red"$
+
+End;
ADDED psl-1983/3-1/tests/sub3.red
Index: psl-1983/3-1/tests/sub3.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub3.red
@@ -0,0 +1,9 @@
+% SUB3.RED : Crude Mini Allocator and CONS
+
+In "pt:P-allocators.red"$
+In "pt:mini-cons-mkvect.red"$
+in "pk:comp-support.red"$
+
+In "pt:mini-sequence.red"$
+
+End;
ADDED psl-1983/3-1/tests/sub4.red
Index: psl-1983/3-1/tests/sub4.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub4.red
@@ -0,0 +1,14 @@
+% SUB4.RED - Mini RATOM and READ. Requires SUB3, SUB2 and IO
+% Note setting of DEBUG to get diagnostic output
+% Revisions: MLG, 18 Feb 1983
+% ADD %..EOL as comment for test files
+
+in "pt:mini-equal.red"$
+in "pt:mini-token.red"$
+in "pt:mini-oblist.red"$
+in "pt:mini-read.red"$
+
+End;
+
+
+
ADDED psl-1983/3-1/tests/sub5a.red
Index: psl-1983/3-1/tests/sub5a.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub5a.red
@@ -0,0 +1,7 @@
+% SUB5a.RED, part 1, EVAL part
+
+in "pt:p-function-primitives.red"$
+in "pt:p-apply-lap.red"$
+in "pt:mini-eval-apply.red"$
+
+End;
ADDED psl-1983/3-1/tests/sub5b.red
Index: psl-1983/3-1/tests/sub5b.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub5b.red
@@ -0,0 +1,21 @@
+% SUB5b.RED : EVAL and support functions
+% Needs SUB4, SUB3, SUB2, IO modules
+
+
+in "pt:mini-arithmetic.red"$
+in "pk:carcdr.red"$
+in "pt:mini-easy-sl.red"$
+in "pt:mini-easy-non-sl.red"$
+in "pk:known-to-comp-sl.red"$
+in "pt:mini-loop-macros.red"$
+in "pt:mini-others-sl.red"$
+in "pt:mini-fluid-global.red"$
+in "pt:mini-property-list.red"$
+in "pt:mini-symbol-values.red"$
+in "pt:mini-type-conversions.red"$
+
+off syslisp;
+
+end;
+
+
ADDED psl-1983/3-1/tests/sub6.red
Index: psl-1983/3-1/tests/sub6.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub6.red
@@ -0,0 +1,8 @@
+% SUB6.RED - User defined LAMBDAs and BINDING, etc.
+
+in "pk:binding.red"$
+in "pt:p-fast-binder.red"$
+
+in "pt:mini-putd-getd.red"$
+
+End;
ADDED psl-1983/3-1/tests/sub7.red
Index: psl-1983/3-1/tests/sub7.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub7.red
@@ -0,0 +1,13 @@
+% SUB7.RED - Support and tests of File I/O
+% Will Also test BINARY I/O for FASL
+
+
+in "xxx-system-io.red"$
+in "pt:io-data.red"$
+In "pt:mini-io-errors.red"$
+in "pt:mini-dskin.red"$
+in "pt:mini-open-close.red"$
+in "pt:mini-rds-wrs.red"$
+in "pt:system-io.red"$
+
+End;
ADDED psl-1983/3-1/tests/sub8.red
Index: psl-1983/3-1/tests/sub8.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub8.red
@@ -0,0 +1,3 @@
+% SUB8.RED - Install GC for machine
+IN "xxx-GC.RED";
+End;
ADDED psl-1983/3-1/tests/sub9.red
Index: psl-1983/3-1/tests/sub9.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/sub9.red
@@ -0,0 +1,6 @@
+% SUB9.RED - Catch and throw stuff
+
+in "pk:catch-throw.red"$
+in "pk:prog-and-friends.red"$
+
+end;
ADDED psl-1983/3-1/tests/summary.tim
Index: psl-1983/3-1/tests/summary.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/summary.tim
@@ -0,0 +1,127 @@
+ 5-Apr-83 07:45:56-MST,6095;000000000001
+Return-path: <@UTAH-CS:GRISS@HP-HULK>
+Received: from UTAH-CS by UTAH-20; Tue 5 Apr 83 07:42:55-MST
+Date: 5 Apr 1983 0632-PST
+From: GRISS@HP-HULK
+Subject: summary.tim
+Message-Id: <418401264.19777.hplabs@HP-VENUS>
+Received: by HP-VENUS via CHAOSNET; 5 Apr 1983 06:34:23-PST
+Received: by UTAH-CS.ARPA (3.320.5/3.7.6)
+ id AA04724; 5 Apr 83 07:41:25 MST (Tue)
+To: kessler@HP-VENUS, griss@HP-VENUS
+
+
+
+ SUMMARY TESTS on 2-Apr-83
+
+
+ Total Times
+(TOTAL BLKDOLPHIN):
+ Tot 386690.000, avg 20352.105, dev 26417.830 , 19.000 tests
+(TOTAL LM2):
+ Tot 98971.000, avg 5209.000, dev 5183.557 , 19.000 tests
+(TOTAL STDAPOLLO):
+ Tot 108814.000, avg 5727.053, dev 5053.535 , 19.000 tests
+(TOTAL STDHP9836):
+ Tot 117890.000, avg 6204.737, dev 5954.895 , 19.000 tests
+(TOTAL FRANZ750):
+ Tot 156825.000, avg 8253.947, dev 8252.232 , 19.000 tests
+(TOTAL STD750):
+ Tot 100368.000, avg 5282.526, dev 5518.533 , 19.000 tests
+(TOTAL FRANZ780):
+ Tot 102524.000, avg 5396.000, dev 5561.586 , 19.000 tests
+(TOTAL FAST780):
+ Tot 56199.000, avg 2957.842, dev 3255.864 , 19.000 tests
+(TOTAL STD780):
+ Tot 70686.000, avg 3720.316, dev 4218.948 , 19.000 tests
+(TOTAL FASTHP9836):
+ Tot 47420.000, avg 2495.789, dev 2380.819 , 19.000 tests
+(TOTAL TESTEXT20):
+ Tot 24202.000, avg 1273.789, dev 1291.616 , 19.000 tests
+(TOTAL EXT20):
+ Tot 23036.000, avg 1212.421, dev 1204.962 , 19.000 tests
+(TOTAL TEST20):
+ Tot 23300.000, avg 1226.316, dev 1211.688 , 19.000 tests
+(TOTAL STD20):
+ Tot 21334.000, avg 1122.842, dev 1158.361 , 19.000 tests
+(TOTAL TESTCRAY):
+ Tot 3511.080, avg 184.794, dev 166.001 , 19.000 tests
+
+ Ratio of Total Times to STD20
+(RATIO (TOTAL BLKDOLPHIN) (TOTAL STD20)):
+ Tot 18.126, avg 18.126, dev 22.806 , 1.000 tests
+(RATIO (TOTAL LM2) (TOTAL STD20)):
+ Tot 4.639, avg 4.639, dev 4.475 , 1.000 tests
+(RATIO (TOTAL STDAPOLLO) (TOTAL STD20)):
+ Tot 5.100, avg 5.100, dev 4.363 , 1.000 tests
+(RATIO (TOTAL STDHP9836) (TOTAL STD20)):
+ Tot 5.526, avg 5.526, dev 5.141 , 1.000 tests
+(RATIO (TOTAL FRANZ750) (TOTAL STD20)):
+ Tot 7.351, avg 7.351, dev 7.124 , 1.000 tests
+(RATIO (TOTAL STD750) (TOTAL STD20)):
+ Tot 4.705, avg 4.705, dev 4.764 , 1.000 tests
+(RATIO (TOTAL FRANZ780) (TOTAL STD20)):
+ Tot 4.806, avg 4.806, dev 4.801 , 1.000 tests
+(RATIO (TOTAL FAST780) (TOTAL STD20)):
+ Tot 2.634, avg 2.634, dev 2.811 , 1.000 tests
+(RATIO (TOTAL STD780) (TOTAL STD20)):
+ Tot 3.313, avg 3.313, dev 3.642 , 1.000 tests
+(RATIO (TOTAL FASTHP9836) (TOTAL STD20)):
+ Tot 2.223, avg 2.223, dev 2.055 , 1.000 tests
+(RATIO (TOTAL TESTEXT20) (TOTAL STD20)):
+ Tot 1.134, avg 1.134, dev 1.115 , 1.000 tests
+(RATIO (TOTAL EXT20) (TOTAL STD20)):
+ Tot 1.080, avg 1.080, dev 1.040 , 1.000 tests
+(RATIO (TOTAL TEST20) (TOTAL STD20)):
+ Tot 1.092, avg 1.092, dev 1.046 , 1.000 tests
+(RATIO (TOTAL STD20) (TOTAL STD20)):
+ Tot 1.000, avg 1.000, dev 1.000 , 1.000 tests
+(RATIO (TOTAL TESTCRAY) (TOTAL STD20)):
+ Tot 0.165, avg 0.165, dev 0.143 , 1.000 tests
+
+ Average Each test Ratios to STD20
+(TOTAL RATIO (BLKDOLPHIN) (STD20)):
+ Tot 432.295, avg 22.752, dev 31.310 , 19.000 tests
+(TOTAL RATIO (LM2) (STD20)):
+ Tot 95.112, avg 5.006, dev 2.463 , 19.000 tests
+(TOTAL RATIO (STDAPOLLO) (STD20)):
+ Tot 106.651, avg 5.613, dev 2.300 , 19.000 tests
+(TOTAL RATIO (STDHP9836) (STD20)):
+ Tot 109.025, avg 5.738, dev 2.072 , 19.000 tests
+(TOTAL RATIO (FRANZ750) (STD20)):
+ Tot 168.689, avg 8.878, dev 7.563 , 19.000 tests
+(TOTAL RATIO (STD750) (STD20)):
+ Tot 85.098, avg 4.479, dev 0.923 , 19.000 tests
+(TOTAL RATIO (FRANZ780) (STD20)):
+ Tot 112.513, avg 5.922, dev 5.652 , 19.000 tests
+(TOTAL RATIO (FAST780) (STD20)):
+ Tot 46.153, avg 2.429, dev 0.517 , 19.000 tests
+(TOTAL RATIO (STD780) (STD20)):
+ Tot 56.645, avg 2.981, dev 0.672 , 19.000 tests
+(TOTAL RATIO (FASTHP9836) (STD20)):
+ Tot 44.557, avg 2.345, dev 0.849 , 19.000 tests
+(TOTAL RATIO (TESTEXT20) (STD20)):
+ Tot 24.473, avg 1.288, dev 0.539 , 19.000 tests
+(TOTAL RATIO (EXT20) (STD20)):
+ Tot 21.802, avg 1.147, dev 0.279 , 19.000 tests
+(TOTAL RATIO (TEST20) (STD20)):
+ Tot 22.377, avg 1.178, dev 0.336 , 19.000 tests
+(TOTAL RATIO (STD20) (STD20)):
+ Tot 19.000, avg 1.000, dev 0.000 , 19.000 tests
+(TOTAL RATIO (TESTCRAY) (STD20)):
+ Tot 3.605, avg 0.190, dev 0.095 , 19.000 tests
+
+ 68000 Total times
+(RATIO (TOTAL STDHP9836) (TOTAL FASTHP9836)):
+ Tot 2.486, avg 2.486, dev 2.501 , 1.000 tests
+(RATIO (TOTAL STDAPOLLO) (TOTAL STDHP9836)):
+ Tot 0.923, avg 0.923, dev 0.849 , 1.000 tests
+
+ 68000 average ratios
+(TOTAL RATIO (STDHP9836) (FASTHP9836)):
+ Tot 46.617, avg 2.454, dev 0.119 , 19.000 tests
+(TOTAL RATIO (STDAPOLLO) (STDHP9836)):
+ Tot 18.653, avg 0.982, dev 0.160 , 19.000 tests
+-------
+
+
ADDED psl-1983/3-1/tests/system-io.red
Index: psl-1983/3-1/tests/system-io.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/system-io.red
@@ -0,0 +1,247 @@
+%==============================================================================
+%
+% SYSTEM-IO.RED - System independent IO routines for PSL
+%
+% Author: Modified by Robert R. Kessler
+% From System-io.red for the VAX by Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: Modified 16 August 1982
+% Original Date 16 September 1981
+%
+% Copyright (c) 1982 University of Utah
+%
+%==============================================================================
+
+% Each individual system must have the following routines defined.
+%
+% The following definitions are used in the routines:
+% FileDescriptor - A machine dependent word that references a file once
+% opened; generated by the Open
+% FileName - A Lisp string of the file name.
+%
+% FileDescriptor := SysOpenRead (Channel,FileName);
+% % Open FileName for input and
+% % return a file descriptor used
+% % in later references to the
+% % file. Channel used only
+% % if needed to generate FileDesc
+% FileDescriptor := SysOpenWrite (Channel,FileName);
+% % Open FileName for output and
+% % return a file descriptor used
+% % in later references to the
+% % file. Channel used only
+% % if needed to generate FileDesc
+% SysWriteRec (FileDescriptor, StringToWrite, StringLength);
+% % Write StringLength characters
+% % from StringToWrite from the
+% % first position.
+% LengthRead := SysReadRec (FileDescriptor, StringBuffer);
+% % Read from the FileDescriptor, a
+% % record into the StringBuffer.
+% % Return the length of the
+% % string read.
+% SysClose (FileDescriptor); % Close FileDescriptor, allowing
+% % it to be reused.
+% TerminalInputHandler (FileDescriptor); % Input from the terminal, on
+% % FileDescriptor. This routine
+% % is expected to use the prompt
+% % in PromptString!*.
+%
+%==============================================================================
+
+CompileTime Load Fast!-Vector;
+
+global '(IN!* OUT!*);
+LoadTime <<
+IN!* := 0;
+OUT!* := 1;
+>>;
+
+fluid '(StdIN!* StdOUT!* ErrOUT!* PromptOUT!* !*Echo);
+LoadTime <<
+StdIN!* := 0;
+StdOUT!* := 1;
+ErrOUT!* := 5;
+PromptOUT!* := 6;
+>>;
+
+%==============================================================================
+%
+on SysLisp;
+
+% The channel table contains the actual file descriptor as returned from
+% the open routines. Since the file descriptor may be any value, it
+% may not be used in finding a free channel. Therefore, we now have a
+% warray ChannelStatus that is the current status of the channel.
+% NOTE: ChannelStatus must be initialized to all closed.
+
+% The following constants are used to indicate the status of the Channel.
+WConst ChannelClosed = 0,
+ ChannelOpenRead = 1,
+ ChannelOpenWrite = 2,
+ ChannelOpenSpecial = 3;
+
+% Look into the ChannelStatus array for a free channel.
+syslsp procedure FindFreeChannel();
+begin scalar Channel;
+ Channel := 0;
+ while ChannelStatus [Channel] neq ChannelClosed do
+ << if Channel >= MaxChannels then
+ IOError "No free channels left";
+ Channel := Channel + 1 >>;
+ return Channel;
+end;
+
+CompileTime fluid '(IOBuffer);
+
+% Open the argument filename as a read only file.
+syslsp procedure SystemOpenFileForInput FileName;
+begin scalar Channel;
+ Channel := FindFreeChannel();
+ ChannelTable [Channel] := SysOpenRead (Channel,FileName);
+ ChannelStatus[Channel] := ChannelOpenRead;
+ MaxBuffer [Channel] := SysMaxBuffer (ChannelTable [Channel]);
+ ReadFunction [Channel] := 'IndependentReadChar;
+ WriteFunction [Channel] := 'ReadOnlyChannel;
+ CloseFunction [Channel] := 'IndependentCloseChannel;
+ IGetV (LispVar IOBuffer, Channel) :=
+ MkString (MaxBuffer [Channel], 32);
+ NextPosition [Channel] := 0; % Will be post Incremented
+ BufferLength [Channel] := -1;
+ return Channel;
+end;
+
+syslsp procedure SystemOpenFileForOutput FileName;
+begin scalar Channel;
+ Channel := FindFreeChannel();
+ ChannelTable [Channel] := SysOpenWrite (Channel,FileName);
+ ChannelStatus[Channel] := ChannelOpenWrite;
+ MaxBuffer [Channel] := SysMaxBuffer (ChannelTable [Channel]);
+ ReadFunction [Channel] := 'WriteOnlyChannel;
+ WriteFunction [Channel] := 'IndependentWriteChar;
+ CloseFunction [Channel] := 'IndependentCloseChannel;
+ Igetv(LispVar IOBuffer,Channel) := MkString (MaxBuffer [Channel], 32);
+ NextPosition [Channel] := -1; % Will be set pre-incremented
+ BufferLength [Channel] := MaxBuffer [Channel];
+ return Channel;
+end;
+
+% Mark a channel as open for a special purpose.
+syslsp procedure SystemOpenFileSpecial FileName;
+begin scalar Channel;
+ ChannelStatus [Channel] := ChannelOpenSpecial;
+ return Channel
+end;
+
+syslsp procedure TestLegalChannel Channel;
+ If not( PosIntP Channel and Channel <=MaxChannels)
+ then IoError List(Channel," is not a legal channel ");
+
+% This function will read in a character from the buffer. It will read
+% the record on buffer length overflow only. Thus when an EOL character
+% is read, it is processed as any other character, except, if it is the last
+% one, in the record, it will do the read automatically.
+% Note, this will not read the next record until after the final character
+% has been processed.
+syslsp procedure IndependentReadChar Channel;
+begin scalar Chr;
+ TestLegalChannel Channel;
+ if NextPosition [Channel] > BufferLength [Channel] then
+ << BufferLength [Channel] :=
+ SysReadRec (ChannelTable[Channel],
+ IGetV(LispVar IOBuffer, Channel));
+ NextPosition [Channel] := 0 >>;
+ Chr := StrByt (IGetV (LispVar IOBuffer, Channel),
+ NextPosition [Channel]);
+ NextPosition [Channel] := NextPosition [Channel] + 1;
+ if LispVar !*Echo then WriteChar Chr;
+ return Chr;
+end;
+
+% Write a character into the buffer. Actually dump the buffer when the
+% EOL character is found, or when the buffer is full. This happens
+% immediately upon meeting this condition, not waiting for the
+% next character. Note, that this places the EOL character into the
+% buffer for machine dependent treatment as CR/LF etc
+syslsp procedure IndependentWriteChar (Channel, Chr);
+ Begin
+ TestLegalChannel Channel;
+ NextPosition [Channel] := NextPosition [Channel] + 1;
+ StrByt (IGetV (LispVar IOBuffer, Channel), NextPosition [Channel])
+ := Chr;
+ if (Chr eq char EOL) or
+ (NextPosition [Channel] >= BufferLength [Channel]) then
+% 12/13/82 - rrk Placed code in FlushBuffer and added a call.
+ FlushBuffer Channel;
+ End;
+
+% 12/13/82 - rrk Added FlushBuffer procedure.
+% Flush out the buffer whether or not we have an EOL character.
+Procedure FlushBuffer Channel;
+<< SysWriteRec (ChannelTable[Channel],
+ IGetV (LispVar IOBuffer, Channel),
+ NextPosition [Channel]);
+ NextPosition[Channel] :=-1 >>; % Start Fresh Buffer
+
+% Mark the argument channel as closed and update the read, write and
+% close functions likewise. Careful, if the caller does this first
+% and then trys to access a read, write or close function we are
+% in big trouble. Is it correct to do this????? Or is a marking of
+% the channel status table sufficient.
+syslsp procedure SystemMarkAsClosedChannel Channel;
+<< TestLegalChannel Channel;
+ ChannelStatus [Channel] := ChannelClosed;
+ ReadFunction [Channel] := WriteFunction [Channel] :=
+ CloseFunction [Channel] := 'ChannelNotOpen >>;
+
+% Actually close the argument channel.
+syslsp procedure IndependentCloseChannel Channel;
+ << TestLegalChannel Channel;
+ SysClose ChannelTable [Channel]>>;
+
+% Initialize Channel Tables etc
+Syslsp procedure ClearOneChannel(Chn,Bufflen,How);
+ << MaxBuffer [Chn] := Bufflen;
+ NextPosition [Chn] := 0;
+ % SAL - Next two not properly initialized.
+ LinePosition [Chn] := 0;
+ UnreadBuffer [Chn] := 0;
+ If how eq 'Input then BufferLength [Chn] := -1
+ else BufferLength [Chn] := 0;
+ IGetV (LispVar IOBuffer, Chn) := MkString(Bufflen,32)>>;
+
+syslsp procedure ClearIO();
+<< SysClearIo();
+ If not VectorP LispVar Iobuffer then
+ <<LispVar IOBuffer := MkVect (MaxChannels);
+ ClearOneChannel(LispVar StdIn!*,200,'Input);
+ ClearOneChannel(LispVar StdOut!*,200,'Output);
+ ClearOneChannel(LispVar ErrOut!*,200,'OutPut);
+ ClearOneChannel(LispVar PromptOut!*,200,'Output)>>;
+ LispVar IN!* := LispVar StdIN!*;
+ LispVar OUT!* := LispVar StdOUT!* >>;
+
+syslsp procedure TerminalInputHandler Channel;
+begin scalar Chr;
+ TestLegalChannel Channel;
+ if NextPosition [Channel] > BufferLength [Channel] then
+ << ChannelWriteString(LispVar PromptOUT!*,
+ if StringP LispVar PromptString!*
+ then LispVar PromptString!*
+ else ">");
+% 12/13/82 - rrk Flush out the Prompt character.
+ FlushBuffer LispVar PromptOut!*;
+ BufferLength [Channel] := SysReadRec (ChannelTable[Channel],
+ IGetV (LispVar IOBuffer, Channel));
+ NextPosition [Channel] := 0 >>;
+ Chr := StrByt (IGetV (LispVar IOBuffer, Channel),
+ NextPosition [Channel]);
+ NextPosition [Channel] := NextPosition [Channel] + 1;
+ if LispVar !*Echo then WriteChar Chr;
+ return Chr;
+end;
+
+off SysLisp;
+
+END;
ADDED psl-1983/3-1/tests/tak.sl
Index: psl-1983/3-1/tests/tak.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/tak.sl
@@ -0,0 +1,9 @@
+
+(de topleveltak (x y z) (tak x y z))
+
+(de tak (x y z)
+ (cond ((null (ilessp y x)) z)
+ (t (tak (tak (isub1 x) y z)
+ (tak (isub1 y) z x)
+ (tak (isub1 z) x y)))))
+
ADDED psl-1983/3-1/tests/test
Index: psl-1983/3-1/tests/test
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/test
@@ -0,0 +1,3 @@
+Line 1
+Line 2
+Line 3 (last)
ADDED psl-1983/3-1/tests/test-20.tim
Index: psl-1983/3-1/tests/test-20.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/test-20.tim
@@ -0,0 +1,22 @@
+(
+("DEC-20 test system" . "No-Date-Yet" )
+(EmptyTest-10000 . 18)
+(GEmptyTest-10000 . 187)
+(Cdr1Test-100 . 525)
+(Cdr2Test-100 . 370)
+(CddrTest-100 . 295)
+(ListOnlyCdrTest1 . 1772)
+(ListOnlyCddrTest1 . 3487)
+(ListOnlyCdrTest2 . 2735)
+(ListOnlyCddrTest2 . 4443)
+(ReverseTest-10 . 461)
+(MyReverse1Test-10 . 468)
+(MyReverse2Test-10 . 452)
+(LengthTest-100 . 560)
+(ArithmeticTest-10000 . 647)
+(EvalTest-10000 . 2676)
+(tak-18-12-6 . 482)
+(gtak-18-12-6 . 1390)
+(gtsta-g0 . 1137)
+(gtsta-g1 . 1195)
+)
ADDED psl-1983/3-1/tests/test-cray.tim
Index: psl-1983/3-1/tests/test-cray.tim
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/test-cray.tim
@@ -0,0 +1,22 @@
+(
+("CRAY D test system" "12-mar-83")
+(EmptyTest-10000 . 2.16)
+(GEmptyTest-10000 . 39.82)
+(Cdr1Test-100 . 58.89)
+(Cdr2Test-100 . 50.50)
+(CddrTest-100 . 36.84)
+(ListOnlyCdrTest1 . 301.76)
+(ListOnlyCddrTest1 . 439.14)
+(ListOnlyCdrTest2 . 352.00)
+(ListOnlyCddrTest2 . 489.39)
+(ReverseTest-10 . 84.53)
+(MyReverse1Test-10 . 83.94)
+(MyReverse2Test-10 . 84.99)
+(LengthTest-100 . 54.92)
+(ArithmeticTest-10000 . 87.46)
+(EvalTest-10000 . 538.16)
+(tak-18-12-6 . 49.75)
+(gtak-18-12-6 . 226.23)
+(gtsta-g0 . 264.09)
+(gtsta-g1 . 266.51)
+)
ADDED psl-1983/3-1/tests/test-guide.mss
Index: psl-1983/3-1/tests/test-guide.mss
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/test-guide.mss
@@ -0,0 +1,408 @@
+
+@Make(article)
+@device(LPT)
+@style(Spacing 1)
+@use(Bibliography "<griss.docs>mtlisp.bib")
+@modify(enumerate,numbered=<@a. @,@i. >, spread 1)
+@modify(itemize,spread 1)
+@modify(description,leftmargin +2.0 inch,indent -2.0 inch)
+
+@LibraryFile(PSLMacrosNames)
+@comment{ The logos and other fancy macros }
+
+@pageheading(Left "Utah Symbolic Computation Group",
+ Right "July 1982",
+ Line "Operating Note No. 71"
+ )
+@set(page=1)
+@newpage()
+@Begin(TitlePage)
+@begin(TitleBox)
+@center[
+
+@b(The PSL Bootstrap Test Files)
+
+
+M. L. Griss, S. Lowder, E. Gibson, E. Benson,
+R. R. Kessler, and G. Q. Maguire Jr.
+
+Utah Symbolic Computation Group
+Computer Science Department
+University of Utah
+Salt Lake City, Utah 84112
+(801)-581-5017
+
+@value(date)]
+@end(TitleBox)
+@begin(abstract)
+
+This note describes how use a suite of tests designed to exhaustively
+exercise all facets of the PSL bootstrap sequence. Each test is a step
+towards boostrapping a complete mini-LISP and then complete PSL.
+@end(abstract)
+@begin(ResearchCredit)
+Work supported in part by the National Science Foundation
+under Grant No. MCS-8204247, and by Lawrence Livermore Laboratories under
+Subcontract No. 7752601.
+@end(ResearchCredit)
+@end(TitlePage)
+@pageheading(Left "PSL Testing",
+ Right "Page @Value(Page)"
+ )
+@set(Page=1)
+@newpage()
+@section(Introduction)
+In order to accomplish the PSL bootstrap with a minimum of fuss, a carefully
+graded set of tests is being developed, to help pinpoint each error as
+rapidly as possible. This preliminary note describes the current status
+of the test files. The first phase requires the coding of an initial
+machine dependent I/O package and its testing using a familar system language.
+Then the code-generator macros can be succesively tested, making calls on this
+I/O package as needed. Following this is a series of graded SYSLISP files,
+each relying on the correct working of a large set of SYSLISP constructs.
+At the end of this sequence, a fairly complete "mini-LISP" is obtained.
+At last the complete PSL interpreter is bootstrapped, and a variety of
+PSL functional and timing tests are run.
+
+@section(Basic I/O Support)
+The test suite requires a package of I/O routines to read and print
+characters, and print integers. These support routines are usually written
+in a "foreign" language (call it "F"), such as PASCAL, C or FORTRAN; they
+could also be coded in LAP, using CMACROs to call operating system
+commands, if simple enough. (E.g., JSYS's on DEC-20, Traps on 68000, etc.).
+These routines typically are limited to using the user's terminal/console
+for input and output. Later steps in the bootstraping sequence introduce a
+more complete stream based I/O module, with file-IO.
+
+On some systems, it is appropriate to have a main routine written in "F"
+which initializes various things, and then calls the "LISP" entry point; on
+others, it is better to have "LISP" as the main routine, and have it call
+the initialization routines itself. In any event, it is best to first write
+a MAIN routine in "F", have it call a subroutine (called, say TEST), which
+then calls the basic I/O routines to test them. The documentation for the
+operating system should be consulted to determine the subroutine calling
+conventions. Often, the "F" compiler has an "ASSEMBLY Listing switch",
+which can be turned on to see how the standard "F" to "F" calling sequence
+is constructed, and to give some useful guidance to writing correct
+assembly code. This can also be misleading, if the assembler switch only
+shows part of the assembly code, thus the user is cautioned to examine
+both the code and the documentation.
+
+On directory PT: (which stands for /psl/tests or <PSL.TESTS>), or its
+subdirectories, we have a number of sample I/O packages, written in various
+languages: PASCAL, FORTRAN, C and DEC20 assembly code. Each has been used
+successfully with some PSL bootstrap. The primitives provided in these
+files are often named XXX-yyyy, where XXX is the machine name, and yyyy is
+the primitive, provided that these are legal symbols. Of course, the name
+XXX-yyyy may have to be changed to conform to "F" and the associated linker
+symbol conventions. Each name XXX-yyyy will be flagged as a
+"ForeignFunction", and called by a non-LISP convention.
+
+The following is a brief description of each primitive, and its use. For
+uniformity we assume each "foreign" primitive gets a single integer
+argument, which it may use, ignore, or change (VAR c:integer in PASCAL).
+@Comment{Is this assumed to be a WORD size quantity, i.e. on the 68000 a 32
+bit quantity or can it be a small integer???}
+The following routines ("yyyy") in LISP, will be associated with the
+corresponding "foreign" routine "XXX-yyyy" in an appropriate way:
+@begin(description)
+init(C)@\Called once to set up I/O channels, open devices, print welcome
+message, initialize timer. Ignores the argument C.
+
+Quit()@\Called to terminate execution; may close all open files. C is
+ignored.
+
+PutC(C)@\C is the ASCII equivalent of a character, and is printed out
+without line termination (I/O buffering may be needed). C=EOL=10 (ASCII LF)
+@Comment{does this mean that the character should appear right away, or can
+it wait till the EOL is sent???}
+will be used to signal end-of-line, C=EOF=26 (ASCII SUB) will be used to
+signal end of file.
+
+GetC()@\Returns the ASCII equivalent of the next input character;
+C=EOL=10 for end of line, and C=EOF=26 for end of file. Note it is
+assumed that GetC does not echo the character.
+
+TimC()@\Returns the runtime since the start of this program, in
+milli-seconds, unless micro-seconds is more appropriate. For testing
+purposes this routine could also print out the time since last called.
+
+PutI(C)@\Print C as an integer, until a SYSLISP based Integer printer that
+calls XXX-PutC works. This function is used to print integers in the
+initial tests before the full I/O implementation is ready.
+
+Err(C)@\Called in test code if an error occurs, and prints C as an
+error number. It should then call Quit() .
+@end(description)
+
+As a simple test of these routines implement in "F" the following. Based on
+the "MainEntryPointName!*" set in XXX-ASM.RED, and the decision as to
+whether the Main toutine is in "F" or in "LISP", XXX-MAIN() is the main
+routine or first subroutine called:
+@begin(verbatim)
+% MAIN-ROUTINE:
+ CALL XXX-INIT(0);
+ CALL XXX-MAIN(0);
+ CALL XXX-QUIT(0);
+
+% XXX-MAIN(DUMMY):
+ INTEGER DUMMY,C;
+
+ CALL XXX-PUTI(1); % Print a 1 for first test
+ CALL XXX-PUTC(10); % EOL to flush line
+
+ CALL XXX-PUTI(2); % Second test
+ CALL XXX-PUTC(65); % A capital "A"
+ CALL XXX-PUTC(66); % A capital "B"
+ CALL XXX-PUTC(97); % A lowercase "a"
+ CALL XXX-PUTC(98); % A lowercase "b"
+ CALL XXX-PUTC(10); % EOL to flush line
+
+ CALL XXX-PUTI(3); % Third test, type in "AB<cr>"
+ CALL XXX-GETC(C);
+ CALL XXX-PUTC(C); % Should print A65
+ CALL XXX-PUTI(C);
+ CALL XXX-GETC(C);
+ CALL XXX-PUTC(C); % Should print B66
+ CALL XXX-PUTI(C);
+ CALL XXX-GETC(C);
+ CALL XXX-PUTI(C); % should print 10 and EOL
+ CALL XXX-PUTC(C);
+
+ CALL XXX-PUTI(4); % Last Test
+ CALL XXX-ERR(100);
+
+ CALL XXX-PUTC(26); % EOF to flush buffer
+ CALL XXX-QUIT(0);
+% END
+
+@end(verbatim)
+
+For examples, see PT20:20IO.MAC for DEC-20 version, PHP:HP.TEXT for HP9836
+PASCAL version, PCR:shell for CRAY fortran version.
+
+@section(LAP and CMACRO Tests)
+After the basic XXX-ASM.RED file has been written and the XXX-CROSS.EXE has
+been built, and seems to be working, an exhastive set of CMACRO tests
+should be run. The emitted code should be carefully examined, and the
+XXX-CMAC.SL adjusted as seems necessary. Part of the CMACRO tests are to
+ensure that !*MOVEs in and out of the registers, and the ForeignFunction
+calling mechanism work.
+
+@section(SysLisp Tests)
+This set of tests involve the compilation to target assmbly code, the
+linking and execution of a series of increasingly more complex tests. The
+tests are organized as a set of modules, called by a main driver. Two of
+these files are machine dependent, associating convenient LISP names and
+calling conventions with the "Foreign" XXX-yyyy function, define
+basic data-spaces, define external definitions of them for inclusion, and
+also provide the appropriate MAIN routine, if needed. These files
+should probably be put on a separte subdirectory of PT: (e.g., PT20:,
+PT68:, etc.)
+
+The machine dependent files are:
+@begin(description)
+
+XXX-HEADER.RED@\Is a machine dependent "main" include file, read into each
+MAINn.RED file, to define the data-spaces needed, and perhaps define a main
+routine in LAP, and have the appropriate XXX-MAIN call the "FirstCall"
+function, used to start the body of the test. Also included are the
+interface routines to the "F" coded I/O package. providing a set of LISP
+entry-points to the XXX-yyy functions. This should be copied and edited
+for the new target machine as needed. Notice that in most cases, it simply
+defines "procedure yyyy(x); XXX-yyyy(x);", relying on "ForeignFunction"
+declaration of XXX-yyyy. Notice that "UndefinedFunction" is defined in
+LAP, to call Err, as appropriate. This will trap some erroneous calls,
+since a call to it is planted in all "unused" SYMFNC cells. Some effort to
+make it pick up the ID number of the offending undefined function (by
+carefully choosing the instructions to be planted in the function cell),
+will be a great help. Once coded and tested by running MAIN1, it need not
+be changed for the subsequent MAINn/SUBn combinations to work.
+
+XXX-TEST-GLOBAL-DATA.RED@\This contains a series of external declarations
+to correspond to the Global Data definitions in the above header file
+file. It is automatically included in all but the MAINn module via the
+"GlobalDataFileName!*" option of XXX-ASM.RED.
+
+@end(description)
+The machine independent test files and drivers are:
+@begin(description)
+MAIN1.RED@\Is a very simple driver, that calls Getc and Putc, does a few
+tests. It does an 'IN "XXX-HEADER.RED";'. The "FirstCall" procedure
+then calls "init", uses "putc" to print AB on one
+line. It should then print factorial 10, and some timings for 1000 calls
+on Factorial 9 and Tak(18,12,6). Build by iteself, and run with IO.
+@Comment{This seems to hide the assumption that 10! can be done in the
+integer size of the test implementation.??? }
+
+SUB2.RED@\Defines a simple print function, to print ID's, Integer's,
+Strings and Dotted pairs in terms of repeated calls on PutC. Defines
+TERPRI, PRIN1, PRIN2, PRINT, PRIN2T and a few other auxilliary print functions
+used in other tests. Tries to print "nice" list notation.
+
+MAIN2.RED@\Uses Prin2String to print a welcome message, solicit a sequence of
+characters to be input, terminated by "#". Watch how end-of-line is handled.
+Then Print is called, to check that TAG's are correctly recognized,
+by printing a LISP integer, an ID and 2 dotted pairs. Requires SUB2 and IO modules.
+
+SUB3.RED@\Defines a mini-allocator, with the functions CONS, XCONS and NCONS,
+GTHEAP, GTSTR. Requires primitives in SUB2 module.
+
+MAIN3.RED@\First Executes a Casetest, trying a variety of Branches and
+Defaults in the case staement. There a number of calls on Ctest with an
+integer from -1 to 12; Ctest tries to classify its argument using a case
+statement. ConsTest simply calls the mini-allocator version of CONS to build
+up a list and then prints it. Requires SUB2, SUB3 and IO modules.
+
+SUB4.RED@\Defines a mini-reader, with RATOM and READ. This mini-READ
+does not read vectors, and does not know about the escape character, ! .
+Requires SUB3, SUB2, and IO modules.
+
+MAIN4.RED@\The test loop calls
+RATOM, printing the internal representation of each token.
+Type in a series of id's, integer's, string'ss etc. Watch that same ID goes
+to same place. After typing a Q, goes into a READ-PRINT loop, until Q is
+again input. Requires SUB3, SUB2 and IO modules.
+
+SUB5.RED@\Defines a mini-EVAL. Does not permit user define functions.
+Can eval ID's, numbers, and simple forms. No LAMBDA expressions.
+FEXPR Functions known are: QUOTE, SETQ and LIST.
+Can call any compiled EXPR, with upto 4 arguments. Rather inefficient, but
+could be used for quick bootstrap.
+Requires SUB4, SUB3, SUB2 and I/O.
+
+MAIN5.RED@\Tests the IDAPPLY constructs, and FUNBOUNDP. Then starts a
+mini-READ-EVAL-PRINT loop. Requires SUB5, SUB4, SUB3, SUB2 and IO modules.
+Note that input ID's are not case raised, so input should be in UPPERCASE
+for builtin functions. Terminates on Q input.
+
+SUB6.RED@\Defines a more extensive set of primitives to support the
+mini-EVAL, including LAMBDA expressions, and user defined EXPR and FEXPR
+functions. Can call any compiled EXPR, with up to 4 arguments. COND,
+WHILE, etc. are defined. Requires SUB5, SUB4, SUB3, SUB2 and I/O.
+
+MAIN6.RED@\Tests the full PSL BINDING module (PI:BINDING.RED).
+Also includes the standard PSL-TIMER.RED (describd below), which must be
+driven by hand, since file I/O is not yet present.
+Requires SUB6,SUB5, SUB4, SUB3, SUB2 and IO modules.
+Note that input ID's are not case raised, so input should be in UPPERCASE
+for builtin functions. Terminates on Q input.
+
+SUB7.RED@\A set of routines to define a minimal file-io package, loading
+the machine independent files: PT:SYSTEM-IO.RED and PT:IO-DATA.RED, and a
+machine dependent file XXX-SYSTEM-IO.RED. The latter file defines
+primitives to OPEN and CLOSE files, and read and write RECORDS of some
+size. The following definitions are used in the routines:
+@begin(verbatim)
+FileDescriptor: A machine dependent word to
+ references an open file.
+FileName: A Lisp string
+@end(verbatim)
+@begin(description)
+SYSCLEARIO()@\Called by Cleario to do any machine specific initialization
+needed, such as clearing buffers, initialization tables, setting interrupt
+characters, etc.
+
+SysOpenRead(Channel,FileName)@\Open FileName for input and return a file
+descriptor used in later references to the file. Channel may be used to
+index a table of "unit" numbers in FORTRAN-like systems.
+
+SysOpenWrite(Channel,FileName)@\Open FileName for Output and return a file
+descriptor used in later references to the file. Channel may be used to
+index a table of "unit" numbers in FORTRAN-like systems.
+
+SysReadRec(FileDescriptor,StringBuffer)@\Read from the FileDescriptor, a
+record into the StringBuffer. Return the length of the string read.
+
+SysWriteRec (FileDescriptor, StringToWrite, StringLength)@\ StringLength
+characters from StringToWrite from the first position.
+
+SysClose (FileDescriptor)@\Close FileDescriptor, allowing
+it to be reused.
+
+SysMaxBuffer(FileDesc)@\Return a number to allocate the file-buffer
+as a string; this should be maximum for this descriptor.
+@end(description)
+
+MAIN7.RED@\Is an interface to the Mini-Eval in SUB5.RED and SUB6.RED
+and defines an (IOTEST) function that should be called. Other functions to
+try are (OPEN "foo" 'OUTPUT), (WRS n), (RDS n) etc. Note also that
+XXX-HEADER will have to be changed at this point to have GETC and PUTC
+use the IndependentReadChar and IndependentWriteChar.
+
+FIELD.RED@\A a set of extensive tests of the Field and Shift functions.
+Needs a WCONST BitsPerWord defined in XXX-HEADER.RED. Build by itself,
+and execute with the IO support.
+@end(description)
+
+Test set "n" is run by using a set of command files to set up
+a multi-module program. These files are stored on the
+approriate subdirectory (PT20: for the DEC20). Note that each module
+usually produces 2-3 files ("code", "data" and "init")
+@begin(Enumerate)
+First Connect to the Test subdirectory for XXX:
+@verbatim[
+@@CONN PTxxx:]
+
+Then initialize a fresh symbol table for program MAINn, MAINn.SYM:
+@verbatim[
+
+@@MIC FRESH MAINn]
+
+Now successively compile each module, SUB2..SUBn
+@verbatim[
+@@MIC MODULE SUB2,MAINn
+@@MIC MODULE SUB3,MAINn
+
+@@MIC MODULE SUBn,MAINn]
+
+Now compile the MAIN program itself
+@verbatim[
+@@MIC MAIN MAINn]
+
+As appropriate, compile or assemble the output "F" language modules
+(after shipping to the remote machine, removing tabs, etc..). Then
+"link" the modules, with the XXX-IO support, and execute. On the
+DEC-20, the
+@verbatim[
+@@EX @@MAINn.CMD
+
+command files are provided as a guide]
+
+See the Appendix (file PT20:20-TEST.OUTPUT) for an example of the
+output on the DEC-20.
+@end(enumerate)
+@section(Mini PSL Tests)
+
+The next step is to start incorporating portions of the PSL kernel into the
+test series (the "full" Printer, the "full" reader, the "full" Allocator,
+the "full" Eval, etc.), driving each with more comprehensive tests. Most of
+these should just "immediately" run. There some peices of Machine specific
+code that have to be written (in LAP or SYSLISP), to do channel I/O,
+replacing the simple XXX-IO; to do fast APPLY; Fluid Binding and
+Arithmetic. This set of tests will help check these peices out before
+getting involved with large files.
+
+@section(Full PSL Tests)
+Now that PSL seems to be running, a spectrum of functional tests and timing
+tests should be run to catch any oversights, missing modules or bugs, and as a
+guide to optimization. The following tests exist:
+@Description[
+PSLTEST.SL@\A fairly comprehensive test of the Standard LISP subset of PSL.
+Do (DSKIN "pt:psltest.sl"). There are a few tests of the error mechanism that
+have to be "pushed" through for a full test.
+
+MATHLIB.TST@\A series of tests of MATHLIB. First LAOD MATHLIB; into RLISP,
+then do IN "MATHLIB.TST"; .
+
+PSL-TIMER.SL, TIME-PSL.SL@\A standard timimg test covering PSL basics.
+Compile PSL-TIMER.SL into kernel, or with resident compiler, then
+(LAPIN "PT:TIME-PSL.TEST").
+]
+@section(References)
+@bibliography
+@NewPage()
+@appendix(Sample DEC-20 Output)
+@begin(verbatim)
+@include(PT20:20-TEST.OUTPUT)
+@end(verbatim)
ADDED psl-1983/3-1/tests/test-guide.otl
Index: psl-1983/3-1/tests/test-guide.otl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/test-guide.otl
@@ -0,0 +1,10 @@
+@Comment{OUTLINE of TEST-GUIDE.MSS.32 by Scribe 3C(1254) on 22 August 1982 at 08:54}
+1. Introduction 1 TEST-GUIDE.MSS.32 line 54
+2. Basic I/O Support 1 TEST-GUIDE.MSS.32 line 67
+3. LAP and CMACRO Tests 4 TEST-GUIDE.MSS.32 line 184
+4. SysLisp Tests 4 TEST-GUIDE.MSS.32 line 192
+5. Mini PSL Tests 10 TEST-GUIDE.MSS.32 line 375
+6. Full PSL Tests 10 TEST-GUIDE.MSS.32 line 386
+7. References 10 TEST-GUIDE.MSS.32 line 402
+I. Sample DEC-20 Output 11 TEST-GUIDE.MSS.32 line 405
+ Table of Contents 1 -SCRIBE-SCRATCH-.15-5-1.100015 line 3
ADDED psl-1983/3-1/tests/time-psl.sl
Index: psl-1983/3-1/tests/time-psl.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/time-psl.sl
@@ -0,0 +1,52 @@
+% TIME-PSL.SL Driver of PSL "spectral" tests
+% After loading psl-timer.b, LAPIN this file
+
+(wrs (open "time-psl.out" 'output))
+(prin2 "PSL Spectral Tests, ") (prin2 (versionname))
+ (prin2 ", ") (prin2T (date))
+(prin2t
+"---------------------------------------------------------------")
+(TestSetup)
+(progn (reclaim)
+ (prin2 "EmptyTest 10000 ")
+ (print (TimeEval '(EmptyTest 10000))) 0)
+(progn (prin2 "SlowEmptyTest 10000 ")
+ (print (TimeEval '(SlowEmptyTest 10000))) 0)
+(progn (prin2 "Cdr1Test 100 ")
+ (print (TimeEval '(Cdr1Test 100))) 0)
+(progn (prin2 "Cdr2Test 100 ")
+ (print (TimeEval '(Cdr2Test 100))) 0)
+(progn (prin2 "CddrTest 100 ")
+ (print (TimeEval '(CddrTest 100))) 0)
+(progn (prin2 "ListOnlyCdrTest1 ")
+ (print (TimeEval '(ListOnlyCdrTest1))) 0)
+(progn (prin2 "ListOnlyCddrTest1 ")
+ (print (TimeEval '(ListOnlyCddrTest1))) 0)
+(progn (prin2 "ListOnlyCdrTest2 ")
+ (print (TimeEval '(ListOnlyCdrTest2))) 0)
+(progn (prin2 "ListOnlyCddrTest2 ")
+ (print (TimeEval '(ListOnlyCddrTest2))) 0)
+(progn (prin2 "ReverseTest 10 ")
+ (print (TimeEval '(ReverseTest 10))) 0)
+(progn (reclaim)
+ (prin2 "MyReverse1Test 10 ")
+ (print (TimeEval '(MyReverse1Test 10))) 0)
+(progn (reclaim)
+ (prin2 "MyReverse2Test 10 ")
+ (print (TimeEval '(MyReverse2Test 10))) 0)
+(progn (reclaim)
+ (prin2 "LengthTest 100 ")
+ (print (TimeEval '(LengthTest 100))) 0)
+(progn (prin2 "ArithmeticTest 10000 ")
+ (print (TimeEval '(ArithmeticTest 10000))) 0)
+(progn (prin2 "EvalTest 10000 ")
+ (print (TimeEval '(EvalTest 10000))) 0)
+(progn (prin2 "tak 18 12 6 ")
+ (print (TimeEval '(topleveltak 18 12 6))) 0)
+(progn (prin2 "gtak 18 12 6 ")
+ (print (TimeEval '(toplevelgtak 18 12 6))) 0)
+(progn (prin2 "gtsta g0 ")
+ (print (TimeEval '(gtsta 'g0))) 0)
+(progn (prin2 "gtsta g1 ")
+ (print (TimeEval '(gtsta 'g1))) 0)
+(close (wrs NIL))
ADDED psl-1983/3-1/tests/timer.notes
Index: psl-1983/3-1/tests/timer.notes
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/timer.notes
@@ -0,0 +1,97 @@
+ Some notes on the PSL "spectral" timing Tests
+
+ Martin L. Griss
+
+ March 17 1982
+
+
+The tests in the file PT:PSL-TIMER.SL (which is compiled and then
+driven by calls in PT:TIME-PSL.SL) have been gathered by us, with
+assistance/requests/suggestions from Fateman and Foderaro at Berkeley,
+JONL White and George Charrette at MIT, and Gabriel at Stanford as
+part of hist tests for the analysis of different LISP systems. They
+range over a number of LISP fundamentals, such as function calling
+speed, compiler quality, simple EVAL speed, INUM/FIXNUM arithmetic,
+CAR/CDR speeds, CONS speed, Type-testing predicates, etc. In most
+cases, the times quoted are for N iterations of some basic loop, with
+N fixed at some convenient quantity; the current N is given.
+
+The tests first set up some lists, which are then used for CDR'ing
+and counting loops. These are:
+
+ LONGLIST 1664 elements
+ TESTLIST 1002 elements
+ TESTLIST2 2002 elements
+
+TEST N Description and comments
+
+Empty 10k Fastest Empty loop, using INUM or FIXNUM arithmetic
+ as measure of overhead.
+
+SlowEmpty 10k Empty loop using generic arithmetic, usually
+ much slower than Empty because of subroutine call.
+ The loop indices are still in INUM range, and some
+ implementations may opencode part of the arithmetic.
+
+Cdr1 100 Cdr down LONGLIST N times, using ATOM to terminate.
+ The loop is done using INUM arithmetic
+ If there is no INUM/FIXNUM arithmetic, this time is
+ swamped by arithmetic time.
+
+ In PSL, ATOM test requires TAG extraction, while
+ NULL test is just an EQ with NIL. In some implementations
+ CAR and CDR require the TAG to be masked off with an
+ extra instruction, while in others the hardware ignores
+ the tag field in addressing operations, speed this up.
+
+Cdr2 100 Cdr down LONGLIST N times, using NULL to terminate.
+ Compare with CDR1 tests.
+
+Cddr 100 Cddr down LONGLIST N times, using NULL to terminate
+ Note that some time CDDR is done better than just CDR
+ since addressing modes may help.
+
+
+ListOnlyCdr1 Cdr down TESTLIST, length TESTLIST times, using NULL
+ These LISTONLY... tests do not use arithmetic to loop.
+
+ListOnlyCddr Cddr down TESTLIST, length TESTLIST times, using NULL
+
+ListOnlyCdr2 Cdr down TESTLIST, length TESTLIST, using ATOM
+ This does not use arithmetic to loop.
+
+ListOnlyCddr Cddr down TESTLIST2, length TESTLIST times, using ATOM.
+
+
+
+
+Reverse 10 Call system reverse on LONGLIST, N times.
+ This CONS's a lot, also some SYSTEM reverse's
+ handcoded, e.g. LISP 1.6.
+
+MyReverse1 10 Reverse compiled, using ATOM to terminate
+
+MyReverse2 10 Reverse compiled, using NULL to terminate
+
+Length 100 Built-in length, on LONGLIST.
+
+Arithmetic 10k Call FACTORIAL 9, N times, generic arithmetic.
+ Looping as in EMPTYtest.
+
+Eval 10k EVAL EvalForm N times.
+ EvalForm is (SETQ FOO (CADR '(1 2 3))) .
+
+tak 18 12 6 Gabriel's test function that has been used
+ on MANY LISP systems. Using INUM/FIXNUM arithmetic.
+
+gtak 18 12 6 As above, using Generic arithmetic.
+
+gtsta g0 Charrete's FUNCALL/APPLY test. 100000 loops on
+ (APPLY F (list I)) or (FUNCALL F I), whichever
+ exists and is fastest in system. [PSL converts
+ (APPLY F (list I)) into a fast-apply].
+ g0 is a NOOP.
+
+gtsta g1 g1 calls ADD1
+
+
ADDED psl-1983/3-1/tests/todo.txt
Index: psl-1983/3-1/tests/todo.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/todo.txt
@@ -0,0 +1,18 @@
+Improvement to Test Series and Boot Sequence
+
+Start using the LinkReg in Link, LinkE
+ [See PT20:dec20-patches.sl]
+
+Improve portability of FUNCTION-PRIMITIVES.RED
+ [See TEST-FUNCTION-PRIMITIVES, using *JCALL for all.
+ Maybe go to SYMFNC=ADDRESS table ?]
+
+May need to add a new CMACRO or two, or expand CMACRO's, to permit
+indirect JUMP via a register/location, to define CodePrimitive().
+
+Modify TEST5 and TEST6 to use the various portable APPLY etc.
+
+Add BINARY IO tests to I/O. Perhaps as a file of LAP to read in?
+
+Define a FASLIN/FASLOUT tester.
+
ADDED psl-1983/3-1/tests/write-real-in-psl.red
Index: psl-1983/3-1/tests/write-real-in-psl.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/tests/write-real-in-psl.red
@@ -0,0 +1,182 @@
+
+% WRITE-REAL.RED - Procedure to write a floating point number
+% Author: Martin Griss
+% Date: ~July 1982.
+
+% Notes by Maguire on 27.7.82:
+% Original version will use ~18K bytes for it's tables on the Apollo
+% due to the large exponent allowed.
+
+% See the common lisp manual, for names for base-B operations;
+% and constants for a re-write of this, to handle rounding etc.
+
+% Algorithm: By searching a table of powers of 10, previously
+% set up in a vector, determine
+% the Exponent and Mantissa of the given Float.
+% Then convert the mantissa to a pair of integers
+% and finally assembly the printed form as a string
+
+
+Fluid '(FltZero!* % Representation of 0.0
+ FltTen!* % 10.0
+ FltExponents % vector of (10^n)
+ MinFltExponent % range of Exponents in table
+ MaxFltExponent
+ MaxFlt
+ MinFlt
+ MaxFltDigits % Maximum number of digits of precision
+ FltDigits % Digits 0.0 ... 9.0
+);
+
+Procedure InitWriteFloats(MinEx,MaxEx,NDig);
+ % Declare Maximum Number of Exponents and Digits
+ Begin scalar Flt1,Flt!.1;
+ FltZero!* := Float(0);
+ Flt1 := Float(1);
+ FltTen!* :=Float(10);
+ Flt!.1 := Flt1/FltTen!*;
+ MinFltExponent :=MinEx;
+ MaxFltExponent:=MaxEx;
+ NumberOfExponents := MaxEx-MinEx; % For UpLim on vector.
+ MaxFltDigits:=Ndig;
+ FltDigits:=MkVect 9;
+ For I:=0:9 do FltDigits[I]:=Float I;
+ FltExponents:=MkVect(NumberOfExponents);
+ FltExponents[-MinEx]:=Flt1;
+ FltExponents[1-Minex]:=FltTen!*;
+ FltExponents[-1-Minex]:=Flt!.1;
+ For i:=2-Minex:NumberOfExponents
+ do FltExponents[i] := FltTen!* * FltExponents[i-1];
+ For i:=-2-MinEx Step -1 Until 0
+ do FltExponents[i] := Flt!.1 * FltExponents[i+1];
+ MinFlt := FltExponents[0];
+ MaxFlt := FltExponents[NumberOfExponents];
+end;
+
+InitWriteFloats(-10,10,10);
+
+Procedure FindExponent(Flt);
+% return Exponent as Integer
+% First reduce Flt to table range then search.
+% Should Be Primitive, and done in Appropriate Float Base (2, or 16?)
+If Flt=FltZero!* then 0
+ else if Flt <FltZero!* then FindExponent(-Flt)
+ else
+ Begin scalar N;
+ If Flt >= MaxFlt then
+ return(MaxFltExponent+FindExponent(Flt/MaxFlt));
+ If Flt <= MinFlt then
+ return(MinFltExponent+FindExponent(Flt/MinFlt));
+ N:=0;
+ While N < NumberOfExponents and FltExponents[N] < Flt do N:=N+1;
+ Return (N+MinFltExponent);
+ End;
+
+Procedure FindMantissa(Flt);
+% return Mantissa as a (signed)float in [0.0 ..1.0)
+ Flt/FloatPower10(FindExponent(Flt));
+
+Procedure FloatPower10(n);
+ % Returns 1FltZero!*^n, using table
+ If N>MaxFltExponent
+ then MaxFlt*FloatPower10(n-MaxFltExponent)
+ else if N<MinFltExponent then MinFlt*FloatPower10(n-MinFltExponent)
+ else FltExponents[n-MinFltExponent];
+
+Procedure Flt2String(Flt);
+ ScaledFloat2String(Flt,MaxFltDigits,0,-3,3);
+
+Procedure ScaledFloat2String(Flt,Ndigits,Scale, MinNice,MaxNice);
+ % "print" a float, either in IIII.FFFF format, or SS.FFFFFeN
+ % First format, if MinNice <=N<=MaxNice
+ % ss controlled by Scale if second chosen
+ %
+ Begin Scalar Fsign,Fex,Fdigits,K,N,Flist,Ilist;
+ If Flt = FltZero!* then return "0.0";
+ If Flt < FltZero!* then <<Fsign:='T; Flt:=-Flt>>;
+ Fex:=FindExponent(Flt);
+ Flt:=Flt/FloatPower10(Fex); % Ie, FindMantissa
+
+ % At this point,
+ % FEX is an integer
+ % and 0.0 =< Flt <1.0
+
+ % Now we can move the Point and adjust the Exponent by a scale
+ % factor for "nicety", or to eliminate En
+
+ If Fex>=MinNice and Fex<=maxNice then
+ <<Flt:=Flt*FloatPower10(Fex);
+ Fex:=0>>
+ else if scale neq 0 then
+ <<Flt:=Flt*FloatPower10(Scale);
+ Fex:=Fex-Scale>>;
+
+ % Remove and convert the Integer Part (0 if scale=0 and not-nice).
+
+ Ilist:=Fix(Flt);
+ Flt:=Flt-Float(Ilist);
+ If Fsign then Ilist:=-Ilist;
+ Ilist:=Char('!.) . Reverse Int2List Ilist; % Reverse
+
+ % Start shifting off digits in fraction by multiplying by 10
+ % Also Round here.
+ % Should we adjust Ndigits if "nice/scale" ??
+
+ Flist:=Ilist; % Add in fraction digits, remember point for trailing
+ % Zero Removal
+
+ For K:=1:NDigits do
+ << Flt := Flt * FltTen!*;
+ N:=Fix(Flt);
+ Flt:=Flt-FltDigits[N];
+ Flist := (N + Char '0) . Flist;
+ >>;
+
+ % Truncate excess trailing 0's
+ While PairP Flist and Not (Cdr Flist eq Ilist)
+ and Car(Flist)=Char '0
+ do Flist:=cdr Flist;
+
+% Now Optimize format, omitting En if 0
+ If Fex=0 then Return List2String Reverse Flist;
+
+% Now convert the Exponent and Insert
+ Fex:=Int2List Fex;
+ Flist := Char('E) . Flist; % The "E"
+
+ For each x in Fex do Flist:= x . Flist;
+ Return List2String Reverse Flist;
+ end;
+
+procedure Int2String N;
+% Convert signed integer into a string
+ List2String Int2List N;
+
+Procedure Int2List N;
+ % Return "exploded" number, forward order
+ Begin scalar L,Nsign;
+ If N=0 then return List Char '0;
+ If N<0 then <<N := -N; Nsign :=T>>;
+ While N>0 do
+ <<L := (Remainder(N,10) + Char '!0 ) . L;
+ N := N / 10>>;
+ If Nsign then L := Char('!-) . L;
+ Return L;
+ End;
+
+
+%Syslsp Procedure WriteFloat(Buffer,Fbase);
+% Buffer is Wstring[0..40],
+% Fbase is FloatBase FltInf Flt
+% Begin Scalar s,flt,i,ss;
+% flt := MKFLTN (Fbase-4); %/4 or 1
+% s:=Flt2String flt;
+% ss:=strinf(s);
+% i:=strlen(ss);
+% strlen(Buffer):=i;
+% i:=i+1;
+% while i>=0 do <<strbyt(Buffer,i) := StrByt(ss,i);
+% i:=i-1>>;
+% end;
+
+End;
ADDED psl-1983/3-1/util/-file-notes.txt
Index: psl-1983/3-1/util/-file-notes.txt
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/-file-notes.txt
@@ -0,0 +1,139 @@
+
+ NOTES ON THE FILES IN PU:
+ Cris Perdue
+ 12/17/82
+ -------------------
+
+PACKAGES BY LOCAL AUTHORS
+
+File Author Synopsis
+----------------------------------------------------------------------------
+extended-char.sl AS 9-bit characters, notably "x-char"
+fast-int.sl AS In lieu of declarations
+fast-strings.sl AS In lieu of declarations
+fast-vectors.sl AS In lieu of declarations
+format.red Benson Subset of Common LISP "format"
+hash.sl Perdue General hash table pkg.
+history.sl Lanam Fancy user-level history pkg.
+if.sl Perdue Fancy if-then-else compatible w. "if"
+man.sl Perdue Experimental ref. manual browser
+objects.sl AS Subset of "flavors"
+program-command-interpreter.sl AS
+pslcomp-main.sl AS
+ring-buffer.sl AS
+slow-strings.sl AS In lieu of declarations
+slow-vectors.sl AS In lieu of declarations
+string-input.sl Perdue Fns. for input from strings, e.g. READ
+string-search.sl Perdue Functions for searching in strings
+stringx.sl AS Miscellaneous string functions
+util.sl Nancy K Miscellaneous useful functions
+
+
+"WELL-KNOWN" FILES
+
+The following files implement facilities described in the
+reference manual, except for a few exceptions. BUILD.MIC is a
+support file to aid building of modules in PU:. It is in PU: for
+the system maintainer's convenience.
+
+Other exceptions are cryptically noted by mention of the logical
+name of the directory they appear to belong in.
+
+addr2id.sl pnk (autoload)
+backquote.sl In the USEFUL library
+bigbig.red
+bigface.red
+bind-macros.sl In the USEFUL library
+build.mic support for rebuilding modules
+build.red
+chars.lsp part of strings
+clcomp1.sl incompatible common lisp fns + reader
+common.sl
+cond-macros.sl In the USEFUL library
+debug.red
+defstruct.examples-red defstruct
+defstruct.red
+demo-defstruct.red defstruct
+destructure.sl
+evalhook.lsp used by step
+fast-struct.lsp ???
+fast-vector.red
+filedate.mic p20sup
+find.red
+for-macro.sl
+graph-tree.sl
+gsort.red
+hcons.sl
+help.red pnk?
+if-system.red pnk?
+init-file.sl pnk? => bare-psl
+iter-macros.sl
+kernel.sl psup
+macroexpand.sl
+mathlib.red
+mini.demo
+mini.fix
+mini.min
+mini.red
+mini.sl
+mini-patch.red
+misc-macros.sl
+nstruct.ctl
+nstruct.lsp
+package.red
+pathin.sl pc?
+pr-driv.red
+pr-main.red
+pr2d-driv.red
+pr2d-main.red
+pr2d-text.red
+prettyprint.sl
+prlisp.demo
+prlisp-driver.red
+psl-cref.red
+psl-crefio.red
+read-macros.sl
+read-utils.red change to read-table-utils?
+rlisp-parser.red
+rlisp-support.red
+rprint.red
+set-macros.sl
+step.lsp
+strings.lsp
+struct.initial bootstrap for nstruct
+sysbuild.mic like build, but to connected directory
+test-arith.red generates pl:arith.b for use in big.
+useful.ctl
+vector-fix.red pnk -- document this!
+zbasic.lsp used by zpedit
+zboot.lsp used by zpedit
+zmacro.lsp used by zpedit
+zpedit.lsp
+
+"LESS WELL-KNOWN FILES"
+
+The following files are also in PU:, but without documentation
+that appears in the reference manual. Some have documentation in
+a file on PH:, some have documentation included in the source
+file, some have no documentation.
+
+association.sl
+f-dstruct.red
+inspect.red
+inum.red
+loop.lsp
+parse-command-string.sl
+pathnamex.sl
+pcheck.red
+poly.red
+zfiles.lsp Obsolete
+zsys.lsp Obsolete
+
+"MARTIN GRISS'S FILES"
+
+The following are thought to be creations of Martin Griss and we
+need to talk with him about whether or not they belong in PU:.
+
+datetime.red
+parser-fix.red
+sm.red
ADDED psl-1983/3-1/util/20/20-interrupt.red
Index: psl-1983/3-1/util/20/20-interrupt.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/20-interrupt.red
@@ -0,0 +1,299 @@
+%
+% 20-INTERRUPT.RED -- Crude Interrupt Handler for DEC-20
+% Author: M. L. Griss and D. Morrison
+% Utah Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 20 May 1981
+% Copyright (c) University of Utah
+
+%
+% 9-June-1983 Mark R. Swanson
+% Changes for extended addressing
+%
+% It is assumed that the system dependent portion of an implementation will
+%supply the following 3 functions:
+%
+% InitializeInterrupts
+% EnableInterrupts
+% DisableInterrupts
+% DismissInterrupt
+%
+% While these are machine dependent, the interrupt handlers themselves are
+% are expected to generally be machine independent, simply calling
+% DismissInterrupt when done. The assignment of terminal-initiated interrupts
+% to keys is machine dependent.
+
+imports '(Addr2ID); % for code-address-to-symbol
+
+on Syslisp;
+
+%internal WARRAY InterruptLevelTable[2],
+% InterruptPCStorage[2],
+% InterruptChannelTable[35];
+
+FLUID '(InterruptLevelTable
+ LoadAverageStore
+ InterruptPCStorage
+ InterruptArgBlock
+ InterruptChannelTable
+);
+
+compiletime << WCONST !.FHSLF=8#400000;>>;
+
+if FUnBoundP 'XJsysError then <<
+syslsp procedure XJsysError(); % autoloading stub
+<< Load JSYS;
+ Apply(function XJsysError, '()) >>;
+>>;
+
+syslsp procedure InitializeInterrupts();
+% Initializes interrupt handlers for both machine- and terminal-initiated
+% interrupts. Most cases should dispatch to machine-independent handlers.
+% Leaves the interrupt system enabled.
+% In this Tops-20 (machine-code) version we currently handle:
+% just playing, for now
+begin
+ (LispVar InterruptArgBlock):=GtWarray 3;
+ (LispVar InterruptLevelTable):=GtWarray 3;
+ (LispVar InterruptPCStorage):=GtWarray 6;
+ (LispVar InterruptChannelTable):=GtWarray 36;
+ (LispVar LoadAverageStore) := MkString(4, char BLANK);
+ ClearInterrupts();
+
+ (LispVar InterruptArgBlock)[0]:=3; % block length
+ (LispVar InterruptArgBlock)[1]:=(LispVar InterruptLevelTable);
+ (LispVar InterruptArgBlock)[2]:=(LispVar InterruptChannelTable);
+ % set up interrupt tables -- see Monitor Calls Manual for details
+ For i := 0:35 do %/ Some bug, wiped out next one when after
+ (LispVar InterruptChannelTable)[i]:=0;
+
+ for i := 0:2 do
+ (LispVar InterruptLevelTable)[i]:=(LispVar InterruptPCStorage) +
+ (i * 2); % each entry is 2 words
+
+ % Terminal Interupts (Procedure on channel/level)
+ % Note LEVEL is 1,2,3
+ PutInterrupt(0,1,'DoControlG);
+ PutInterrupt(1,1,'SaveAndCallControlT); % control T not working yet
+ PutInterrupt(2,1,'SaveAndBreak);
+ % special channels
+ PutInterrupt(6,1,'ArithOverflow);
+ PutInterrupt(7,1,'FloatArithOverflow);
+ PutInterrupt(9,1,'PushDownOverflow);
+
+ % Now Install tables
+ Xjsys0(!.FHSLF,
+ (LispVar InterruptArgBlock),0,0,const jsXSIR!%);
+ EnableInterrupts();
+ ActivateChannel(0);
+ ActivateChannel(1);
+ ActivateChannel(2);
+ ActivateChannel(6);
+ ActivateChannel(7);
+ ActivateChannel(9);
+ PutTerminalInterrupt(7,0); % Char CNTRL-G on 0
+ PutTerminalInterrupt(4,0); % Char CNTRL-D on 2
+ PutTerminalInterrupt(20,1); % Char cntrl-t on 1, not working yet
+ PutTerminalInterrupt(0,2); % Char BREAK on 2
+ PutTerminalInterrupt(2,2); % Char cntrl-B on 2
+
+ ClearInterrupts();
+end;
+
+syslsp procedure SetContinueAddress(Level,Address);
+begin scalar x;
+ x:=(LispVar InterruptLevelTable)[Level-1];
+ x[1]:=address; % second word is for PC
+ end;
+
+% FunctionCellLocation is used by LAP
+
+off Syslisp;
+
+fluid '(!*WritingFaslFile);
+
+lisp procedure SetContinueFunction(Level,FunctionName);
+begin scalar !*WritingFaslFile;
+ % assume all function cells in section 1 for global addressing
+ SetContinueAddress(Level, 8#1000000 + FunctionCellLocation FunctionName);
+end;
+
+lisp procedure PutInterrupt(Channel,Level,ActionId);
+begin scalar !*WritingFaslFile;
+ % assume all function cells in section 1 for global addressing
+ WPutV(InterruptChannelTable,
+ Channel,
+ MkItem(Level,8#1000000 + FunctionCellLocation ActionId));
+end;
+
+on Syslisp;
+
+syslsp procedure XWD(a,b);
+ Lor(Lsh(a,18),b);
+
+syslsp procedure PutTerminalInterrupt(CntrlChar,Channel);
+ Xjsys0(XWD(CntrlChar,Channel),0,0,0,const jsATI);
+
+syslsp procedure RemoveTerminalInterrupt(CntrlChar,Channel);
+ Xjsys0(XWD(CntrlChar,Channel),0,0,0,const jsDTI);
+
+syslsp procedure ReadTerminalWord;
+ Xjsys1(0,0,0,0,Const jsRTIW);
+
+syslsp procedure SetTerminalWordBit(n);
+ <<XJsys0(Lor(ReadTerminalLWord(),Dec20Bit n),0,0,const jsSTIW);
+ ReadTerminalWord()>>;
+
+syslsp procedure SetTerminalWord(MSK);
+ <<Xjsys0(Lor(ReadTerminalWord(),MSK),0,0,0,const jsSTIW);
+ ReadTerminalWord()>>;
+
+syslsp procedure ClearInterrupts;
+ Xjsys0(0,0,0,0,const jsCIS); % clear any pending interrupts
+
+syslsp procedure SignalChannel n; %. Test on channel n
+ Xjsys0(!.FHSLF,Dec20Bit n,0,0,const jsIIC);
+
+syslsp procedure EnableInterrupts;
+ Xjsys0(!.FHSLF,0,0,0,const jsEIR);
+
+syslsp procedure DisableInterrupts;
+ Xjsys0(!.FHSLF,0,0,0,const jsDIR);
+
+syslsp procedure ActivateChannel(n); %. Inform OS of channel
+ Xjsys0(!.FHSLF,Dec20Bit n,0,0,const jsAIC);
+
+syslsp procedure DeActivateChannel(n); %. Inform OS of channel
+ Xjsys0(!.FHSLF,Dec20Bit n,0,0,const jsDIC);
+
+syslsp procedure Dec20Bit n; %. Bits [0 to 35]
+ Dec20Fld(1,35-n);
+
+syslsp procedure Dec20Fld(x,y);
+ LSH(x,y);
+
+syslsp procedure DismissInterrupt;
+% Warning: an interrupt handler should not attempt to resume if may have
+% caused a garbage collection.
+Xjsys0(0,0,0,0,const jsDEBRK);
+
+
+% ----- Some default handlers ----------
+
+syslsp procedure DoControlG;
+<< ClearTerminalInputBuffer(); % CFIBF
+ ClearIO(); % also clear internal buffer, etc.
+ ChannelWriteChar(LispVAR StdOUT!*, Char BELL);
+ ErrorPrintF "*** Restarting";
+ SetContinueFunction(1,'Reset);
+ DismissInterrupt()>>;
+
+syslsp procedure ClearTerminalInputBuffer();
+ Xjsys0(8#100,0,0,0,const jsCFIBF);
+
+syslsp procedure ArithOverflow;
+ <<SetContinueFunction(1,'ArithOverFlowError);
+ DismissInterrupt()>>;
+
+syslsp procedure ArithOverFlowError;
+ StdError('"Integer overflow");
+
+syslsp procedure FloatArithOverflow;
+ <<SetContinueFunction(1,'FloatArithOverFlowError);
+ DismissInterrupt()>>;
+
+syslsp procedure FloatArithOverFlowError;
+ StdError('"Floating point overflow");
+
+lap '((!*entry PushDownOverflow expr 0)
+ (sub (reg st) (lit (halfword 1000 1000))) % move the stack back
+ (!*MOVE (WConst 1) (REG 1))
+ (xmovei 2 ErrorAddress)
+ (!*CALL SetContinueAddress)
+ (!*JCALL DismissInterrupt)
+ErrorAddress
+ (!*MOVE '"Stack overflow" (reg 1))
+ (!*JCALL StdError) % normal error
+);
+
+lap '((!*entry FindLoadAverage expr 0)
+ (move 1 (lit (fullword 8#000014000014))) % 1 min avg, .systa
+ (getab)
+ (!*EXIT 0)
+ (move 2 (fluid LoadAverageStore))
+ (tlz 2 8#770000)
+ (tlo 2 8#660000) % make a byte pointer
+ (exch 1 2)
+ (move 3 (lit (fullword 8#024037020200)))
+ (flout)
+ (!*EXIT 0)
+ (!*EXIT 0)
+);
+
+syslsp procedure DoControlT();
+begin scalar RunningFunctionID, CameFrom;
+% ClearTerminalInputBuffer();
+ FindLoadAverage();
+ CameFrom := LowHalfWord ((LispVar InterruptPCStorage)[1]);
+ RunningFunctionID := code!-address!-to!-symbol CameFrom or 'UNKNOWN;
+ ErrorPrintF("^T: in %p at %o, load %w",
+ RunningFunctionID, CameFrom, LispVar LoadAverageStore);
+end;
+>>;
+
+syslsp procedure DoBreak();
+begin scalar RunningFunctionID, CameFrom, CurrentChannel;
+ ClearTerminalInputBuffer();
+ ClearIO();
+ CameFrom := LowHalfWord ((LispVar InterruptPCStorage)[1]);
+ RunningFunctionID := code!-address!-to!-symbol CameFrom or 'UNKNOWN;
+ CurrentChannel := WRS NIL;
+ ErrorPrintF("*** Break in %p at %o", RunningFunctionID, CameFrom);
+ ErrorSet(quote Break(), NIL, NIL);
+ WRS CurrentChannel;
+end;
+
+
+lap '((!*Entry SaveAndCallControlT expr 0)
+%
+% Save all regs, call DoControlT and dismiss
+%
+ (adjsp (reg st) 14) % allocate 14 slots on the stack
+ (hrri (reg nil) (indexed (reg st) -13)) % set up BLT pointer
+ (hrli (reg nil) 1) % move regs 1..14 onto the stack
+ (blt (reg nil) (indexed (reg st) 0))
+ (move (reg nil) (fluid nil)) % fix reg nil
+ (!*CALL DoControlT) % call the function
+ (hrli (reg nil) (indexed (reg st) -13))
+ (hrri (reg nil) 1)
+ (blt (reg nil) 14) % move the registers back off the stack
+ (move (reg nil) (fluid nil)) % restore reg nil again
+ (adjsp (reg st) -14)
+ (debrk)
+);
+>>;
+
+lap '((!*Entry SaveAndBreak expr 0)
+%
+% Save all regs, call DoBreak and dismiss
+%
+ (adjsp (reg st) 14) % allocate 14 slots on the stack
+ (hrri (reg nil) (indexed (reg st) -13)) % set up BLT pointer
+ (hrli (reg nil) 1) % move regs 1..14 onto the stack
+ (blt (reg nil) (indexed (reg st) 0))
+ (move (reg nil) (fluid nil)) % fix reg nil
+ (!*CALL DoBreak) % call the function
+ (hrli (reg nil) (indexed (reg st) -13))
+ (hrri (reg nil) 1)
+ (blt (reg nil) 14) % move the registers back off the stack
+ (move (reg nil) (fluid nil)) % restore reg nil again
+ (adjsp (reg st) -14)
+ (debrk)
+);
+
+InitializeInterrupts();
+
+off syslisp;
+
+END;
ADDED psl-1983/3-1/util/20/bug.sl
Index: psl-1983/3-1/util/20/bug.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/bug.sl
@@ -0,0 +1,26 @@
+% BUG.SL - Send bug reports
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 11 December 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PERDUE.PSL>BUG.SL.2, 7-Jan-83 16:52:07, Edit by PERDUE
+% Changed to LISP syntax, added bug-mail-to variable.
+% Each site may set bug-mail-to as desired.
+
+(imports '(exec))
+
+(fluid '(bug-mail-to))
+
+(cond ((null bug-mail-to) (setq bug-mail-to "")))
+
+(defun bug ()
+ (printf "*** PSL Bug reporter, ^N to abort%n")
+ (putrescan (bldmsg "mail %w%n" bug-mail-to))
+ (mm)
+ (terpri)
+ t)
ADDED psl-1983/3-1/util/20/dir-stuff.build
Index: psl-1983/3-1/util/20/dir-stuff.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/dir-stuff.build
@@ -0,0 +1,1 @@
+in "p20:dir-stuff.red"$
ADDED psl-1983/3-1/util/20/dir-stuff.red
Index: psl-1983/3-1/util/20/dir-stuff.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/dir-stuff.red
@@ -0,0 +1,166 @@
+
+% MLG, 6:01am Thursday, 10 June 1982
+% Utilities to read and process DIR files
+%
+
+IMPORTS '(EXEC);
+
+% -------- Basic File Reader -------------
+
+Fluid '(File);
+
+procedure ReadOneLine;
+% Read a single line, return as string
+ begin scalar c,l;
+ while ((c:=ReadCh()) NEQ !$EOL!$) do
+ If c EQ !$EOF!$ then Throw('Filer,'Done)
+ else l:=c . l;
+ Return list2string reverse l;
+end;
+
+procedure ReadDirFile F;
+% Read in a file as vector of strings
+ begin scalar oldF,x;
+ OldF:=Rds(F:=Open(F,'input));
+ File:=NIL;
+ Catch('Filer,'(ReadAllFile1));
+ Rds OldF;
+ Close F;
+ Return List2vector Reverse File;
+ end;
+
+procedure ReadAllFile1;
+% support for Read Dir File
+ begin scalar l;
+ While (l:=ReadOneLine()) do
+ if Size(l)>=0 then file:= segmentstring(l,char '! ) . file;
+ return List2Vector reverse file;
+ end;
+
+%---------------------------------------------------
+procedure ReadCleanDir F;
+% read in a Dir File without dates, and clean up
+ Begin scalar x;
+ x:=ReadDirFile F; % As a vector of strings
+%/ x:=ExpandNames x; % Handle .xxx case
+ x:=RemoveAllVersionNumbers x;
+%/ x:=RemoveDuplicates x; % Assume ordered
+ Return x;
+ End;
+
+%---- Now take apart the fields
+
+Procedure GetFileName(S); % Find part before dot
+ begin scalar N,I;
+ n:=Size S;
+ i:=0;
+ While i<=n and S[i] neq Char '!. do i:=i+1;
+ return Sub(S,0,i-1);
+ end;
+
+procedure GetExtension(S); % Find second part, after dot
+ begin scalar N,I;
+ n:=Size S;
+ i:=n;
+ While i>=0 and S[i] neq Char '!. do i:=i-1;
+ return Sub(S,i+1,n-i-1);
+ end;
+
+% Dont need to expand names anymore
+CommentOutCode <<
+
+procedure ExpandNames(Fvector); % replace .xxxx with yyy.xxx from previous
+ Begin scalar F;
+ for i:=1:Size(Fvector) do
+ <<F:=Fvector[I];
+ if F[0] EQ char '!.
+ then Fvector[I]:=concat(GetFileName Fvector[I-1],F)>>;
+ return Fvector;
+ end;
+>>;
+
+procedure RemoveVersionNumber F; % replace xxxx.yyyy.nnn with xxxx.yyyy
+ Begin scalar I;
+ i:=Size(F);
+ While i>=0 and F[i] NEQ char '!. do i:=i-1;
+ Return Sub(F,0,i-1);
+ end;
+
+procedure RemoveAllVersionNumbers(Fvector); % replace xxxx.yyy.nnn with xxx.yyy
+ Begin
+ For i:=0:Size(Fvector)
+ do Fvector[I]:=RemoveVersionNumber Car Fvector[I];
+ return Fvector;
+ end;
+
+procedure GetDirInFile(Dstring,FileName);
+ Docmds List("Dir ",Dstring,",",crlf,
+ "out ",Filename,crlf,
+ "no heading ",crlf,
+ "separate ",crlf,
+ "no summary ",crlf,
+ crlf,"pop");
+
+procedure GetCleanDir Dstring;
+ Begin Scalar x;
+ GetDirInFile(Dstring,"Junk.Dir");
+ x:=ReadCleanDir "junk.Dir";
+ DoCmds List("Del junk.dir,",crlf,
+ "exp ",crlf,crlf,"pop");
+ return x
+ End;
+
+procedure GetDatedDirInFile(Dstring,FileName);
+ Docmds List("Dir ",Dstring,",",crlf,
+ "out ",Filename,crlf,
+ "no heading ",crlf,
+ "separate ",crlf,
+ "no summary ",crlf,
+ "time write ",crlf,
+ crlf,"pop");
+
+procedure GetCleanDatedDir Dstring;
+ Begin Scalar x;
+ GetDatedDirInFile(Dstring,"Junk.Dir");
+ x:=ReadCleanDatedDir "junk.Dir";
+ DoCmds List("Del junk.dir,",crlf,
+ "exp ",crlf,crlf,"pop");
+ return x
+ End;
+
+procedure ReadCleanDatedDir F;
+ begin scalar x;
+ x:=ReadDirFile F;
+%/ x:=ExpandNames x; % Handle .xxx case
+ For i:=0:Size(x)
+ do Rplaca(x[i],RemoveVersionNumber Car x[I]);
+ return x
+ end;
+
+% Segment a string into fields:
+
+Procedure SegmentString(S,ch); % "parse" string in pieces at CH
+ Begin scalar s0,sN,sN1, Parts, sa,sb;
+ s0:=0;
+ sn:=Size(S);
+ sN1:=sN+1;
+ L1:If s0>sn then goto L2;
+ sa:=NextNonCh(Ch,S,s0,sN);
+ if sa>sN then goto L2;
+ sb:=NextCh(Ch,S,sa+1,sN);
+ if sb>SN1 then goto L2;
+ Parts:=SubSeq(S,sa,sb) . Parts;
+ s0:=sb;
+ goto L1;
+ L2:Return Reverse Parts;
+ End;
+
+Procedure NextCh(Ch,S,s1,s2);
+ <<While (S1<=S2) and not(S[S1] eq Ch) do s1:=s1+1;
+ S1>>;
+
+Procedure NextNonCh(Ch,S,s1,s2);
+ <<While (S1<=S2) and (S[S1] eq Ch) do s1:=s1+1;
+ S1>>;
+
+End;
ADDED psl-1983/3-1/util/20/directory.sl
Index: psl-1983/3-1/util/20/directory.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/directory.sl
@@ -0,0 +1,91 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Directory.SL - File Directory Primitives (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 13 July 1982
+% Revised: 4 March 1983
+%
+% 4-Mar-83 Alan Snyder
+% Revised to accept FOO.DIRECTORY as the name of a subdirectory.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common jsys pathnames file-primitives))
+
+(de find-matching-files (filename include-deleted-files)
+
+ % Return a list describing all files that match the specified filename. The
+ % filename may specify a directory and/or may contain wildcard characters.
+ % Each element of the returned list corresponds to one matching file. The
+ % format of each list element is:
+
+ % (file-name full file name string
+ % deleted-flag T or NIL
+ % file-size integer count of pages in file
+ % write-date integer representing date/time of last write
+ % read-date integer representing date/time of last read
+ % )
+
+ (setf filename (fixup-directory-name filename))
+ (let (jfn-word jfn file-name deleted-flag file-size write-date read-date)
+ (cond
+ ((and (stringp filename)
+ (setf jfn-word (attempt-to-get-jfn
+ filename
+ (if include-deleted-files
+ #.(bits 2 8 11 13 17)
+ #.(bits 2 11 13 17)
+ )
+ )))
+ (for*
+ (while (>= jfn-word 0))
+ (do (setf jfn (lowhalfword jfn-word))
+ (setf file-name (MkString 100 (char space)))
+ (jsys1 file-name jfn
+ #.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
+ (setf file-name (recopystringtonull file-name))
+ (setf deleted-flag (jfn-deleted? jfn))
+ (setf file-size (jfn-page-count jfn))
+ (setf write-date (jfn-write-date jfn))
+ (setf read-date (jfn-read-date jfn))
+ )
+ (collect (list
+ file-name
+ deleted-flag
+ file-size
+ write-date
+ read-date
+ ))
+ (do (if (FixP (ErrorSet
+ (list 'jsys1 jfn-word 0 0 0 (const jsGNJFN))
+ NIL NIL)) (setf jfn-word -1)))
+ ))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Auxiliary Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de fixup-directory-name (pn)
+
+ % Replace all missing Name, Type, and Version components of the specified
+ % filename with "*". Recognize FOO.DIRECTORY as the name of a subdirectory.
+
+ (let ((wild-name (make-pathname 'name 'wild)))
+ (setf pn (pathname pn))
+ (when (and (equal (pathname-host pn) "LOCAL")
+ (stringp (pathname-type pn))
+ (string-equal (pathname-type pn) "DIRECTORY")
+ (stringp (pathname-name pn))
+ (stringp (pathname-directory pn))
+ )
+ (setf pn (make-pathname
+ 'host (pathname-host pn)
+ 'device (pathname-device pn)
+ 'directory (string-concat
+ (pathname-directory pn) "." (pathname-name pn))
+ )))
+ (namestring (merge-pathname-defaults pn wild-name 'wild 'wild))
+ ))
ADDED psl-1983/3-1/util/20/exec.build
Index: psl-1983/3-1/util/20/exec.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/exec.build
@@ -0,0 +1,1 @@
+in "exec.red"$
ADDED psl-1983/3-1/util/20/exec.red
Index: psl-1983/3-1/util/20/exec.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/exec.red
@@ -0,0 +1,258 @@
+%
+% EXEC.RED - Simple TOPS20 Interfaces, "EXEC Fork", etc
+%
+% Author: Martin L. Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 8 March 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.UTIL.20>EXEC.RED.6, 25-Mar-83 14:32:06, Edit by BARBOUR
+% Updated clocktimedate to return the string with nulls stripped off
+% Edit by Cris Perdue, 23 Mar 1983 1453-PST
+% Changed from clocktime to ClockTimeDate
+% Edit by Cris Perdue, 21 Mar 1983 1003-PST
+% Added Kessler's clocktime and getloadaverage from CLOCKTIME.RED
+% <PERDUE>EXEC.RED.2, 21-Mar-83 11:02:46, Edit by PERDUE
+% Put JSYS names in const(<name>) form to match current JSYS module
+% <PSL.UTIL>EXEC.RED.5, 24-May-82 13:01:50, Edit by BENSON
+% Changed <EDITORS> and <SUBSYS> to SYS: in filenames
+%/ Changed FILNAM->FileName, due to GLOBAL conflict
+%/ Changed JSYS calls, so LIST(..) rather than '(..) used
+%/ Changed for V3:JSYS
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Simple JSYS interfaces
+
+CompileTime load(Syslisp, Jsys, Monsym);
+imports '(JSYS);
+
+GLOBAL '(ForkNAMES!* EXECFork EMacsFork MMFork);
+
+Lisp procedure GetOLDJfn FileName; %. test If file OLD and return Jfn
+ Begin scalar Jfn;
+ If NULL StringP FileName then return NIL;
+ Jfn := JSYS1(Bits(2,3,17),FileName,0,0,const(jsGTJfn));
+ % OLD!MSG!SHORT
+ If Jfn<0 then return NIL;
+ return Jfn
+ END;
+
+Lisp procedure GetNEWJfn FileName; %. test If file NEW and return Jfn
+ Begin scalar Jfn;
+ If NULL StringP FileName then return NIL;
+ Jfn := JSYS1(Bits(0,1,3,17),FileName,0,0,const(jsGTJfn));
+ % GEN!NEW!MSG!SHORT
+ If Jfn<0 then return NIL;
+ return Jfn
+ END;
+
+Lisp procedure RELJfn Jfn; %. return Jfn to system
+ JSYS0(Jfn,0,0,0,const(jsRLJfn));
+
+Lisp procedure OPENOLDJfn Jfn; %. OPEN to READ
+ JSYS0(Jfn,Bits( (7 . 5),19),0,0,const(jsOPENF));
+
+Lisp procedure OPENNEWJfn Jfn; %. Open to WRITE
+ JSYS0(Jfn,Bits( (7 . 5),20),0,0,const(jsOPENF));
+
+Lisp procedure GetFork Jfn; %. Create Fork, READ File on Jfn
+ Begin scalar FH;
+ FH := JSYS1(Bits(1),0,0,0,const(jsCFork));
+ JSYS0(Xword(FH ,Jfn),0,0,0,const(jsGet));
+ return FH
+ END;
+
+Lisp procedure STARTFork FH; %. Start (Restart) a Fork
+ JSYS0(FH, 0,0,0,const(jsSFRKV));
+
+Lisp procedure WAITFork FH; %. Wait for completion
+ JSYS0(FH,0,0,0,const(jsWFork));
+
+Lisp procedure RUNFork FH; %. Normal use, to run a Fork
+ <<STARTFork FH; WAITFork FH>>;
+
+Lisp procedure KILLFork FH; %. Kill a Fork
+ JSYS0(FH,0,0,0,const(jsKFork));
+
+Lisp procedure SETPRIMARYJfnS(FH,INJfn,OUTJfn);
+ JSYS0(FH,Xword(INJfn , OUTJfn),0,0,const(JSSPJfn)); %. Change PRIMARY Jfns (BAD?)
+
+Lisp procedure OPENFork FileName; %. Get a File into a Fork
+ Begin scalar FH,Jfn;
+ If NULL FileP FileName then StdError CONCAT("Cant find File ",FileName);
+ Jfn := GetOLDJfn FileName;
+ FH := GetFork Jfn;
+ return FH
+ END;
+
+Lisp procedure RUN FileName; %. Run A File
+ Begin scalar FH; FH := OPENFork FileName; RUNFork FH; KILLFork FH END;
+
+Lisp Procedure ForkP FH; %. test if Valid Fork Handle
+ FixP FH and not Zerop FH; %/Kludge
+
+Lisp procedure EXEC;
+ <<If Not ForkP EXECFork then EXECFork := OPENFork "SYSTEM:EXEC.EXE";
+ RUNFork EXECFork>>;
+
+Lisp procedure EMACS;
+ <<If Not ForkP EMacsFork then EMACSFork := OPENFork "SYS:EMACS.EXE";
+ RUNFork EMACSFork>>;
+
+Lisp procedure MM;
+ <<If Not ForkP MMFork then MMFork := OPENFork "SYS:MM.EXE";
+ RUNFork MMFork>>;
+
+Lisp procedure GetUNAME; %. USER name
+ Begin Scalar S;
+ S:=Mkstring 80;
+ JSYS0(s,JSYS1(0,0,0,0,const(JSGJINF)),0,0,const(JSDIRST));
+ Return RecopyStringToNULL S
+ End;
+
+Lisp procedure GetCDIR; %. Connected DIRECTORY
+ Begin scalar s;
+ S:=Mkstring 80;
+ JSYS0(S,JSYS2(0,0,0,0,const(jsGJINF)),0,0,const(jsDIRST));
+ return RecopyStringToNULL S
+ end;
+
+% Determine the current time or date or both and stripped off trailing
+% nulls, with ONE blank Char concatenated on the end of the returned string.
+%
+% RETURNS STRING FORMS ARE SHOWN BELOW:
+% 1 -> Returns Date & Time .. Day Date First & 24 hr format
+% 2 -> Returns Date & Time .. Day Date First & 12 hr format
+% 3 -> Returns Date & Time .. Month first & 24 hr format
+% 4 -> Returns Date & Time .. Month first & 12 hr format
+% 5 -> Returns Weekday,Date, & Time .. Month first & 24 hr format
+% 6 -> Returns Weekday,Date, & Time .. Month first & 12 hr format
+% 7 -> Returns Weekday,Date, & Time .. Month first & 12 hr format
+% day-3 letters and no seconds
+% 8 -> Returns time only ... hh:mm:ss 12 hr format
+%Otherwise -> Returns time only ... hh:mm:ss 24 hr format
+%
+%
+ PROCEDURE ClockTimeDate (Time_Selector); % old ClockTime
+ BEGIN SCALAR Ret_String ;
+ Ret_String := MKSTRING 30;
+ CASE Time_Selector OF
+ 1: << JSYS1( Ret_String,-1,bits(2),0,const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 17 ) >>;
+ 2: << JSYS1(Ret_String, -1,bits(2,11),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 19 ) >> ;
+ 3: << JSYS1(Ret_String, -1,bits(6),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 17 ) >> ;
+ 4: << JSYS1(Ret_String, -1,bits(6,11),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 19 ) >> ;
+ 5: << JSYS1(Ret_String, -1,bits(1,2,6),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 27 ) >> ;
+ 6: << JSYS1(Ret_String, -1,bits(1,2,6,11),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 29 ) >> ;
+ 7: << JSYS1(Ret_String, -1,bits(1,6,10,11),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 20 ) >> ;
+ 8: << JSYS1(Ret_String, -1,bits(0,11),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 9 ) >> ;
+ Otherwise: << JSYS1(Ret_String, -1,bits(0),0, const jsODTIM) ;
+ Ret_String := SUB(Ret_String, 0, 7 ) >> ;
+ END ; %end for case
+ Ret_String := ConCat( Ret_String, " ") ;
+ RETURN Ret_String ;
+ END;
+
+% Determine the current 1 minute load average and return as a string.
+procedure GetLoadAverage;
+begin scalar s;
+ s:=mkstring 6;
+ jsys1(s,Jsys1(8#000014000014, 0, 0, 0, const jsGETAB),8#024037020200,
+ 0, const jsFLOUT);
+ return s
+end;
+
+Lisp procedure PSOUT S; %. Print String
+ JSYS0(S,0,0,0,const(jsPSOUT));
+
+Lisp procedure GTJfn L; %. Get a Jfn
+ JSYS1(L,0,0,0,const(jsGTJFN));
+
+Lisp procedure NAMEFROMJfn J; %. name of File on a Jfn
+ Begin scalar S;
+ s:=Mkstring 100;
+ JSYS0(S,J,0,0,const(JSJfnS));
+ return RecopyStringToNULL S;
+ end;
+
+Fexpr Procedure InFile(U); %. INPUT FILE, (prompt for name too?)
+ If StringP U then DskIn EVAL CAR U
+ else
+ Begin scalar Jfn,Fname;
+ PSOUT "Input file:";
+ Jfn:=Jsys1(BITS(2,3,4,16,17),Xword(8#100,8#101),0,0,const(jsGTJFN));
+ Fname:= NAMEFROMJFN JFN;
+ RELJFN JFN;
+ PRINTF("reading file %r %n", FNAME);
+ DSKIN Fname;
+ end;
+
+%-- Command string processor and take
+
+Lisp procedure PutRescan(S); %. Enter String
+ <<JSYS0(S,0,0,0,const(jsRSCAN));
+ JSYS0(0,0,0,0,const(jsRSCAN))>>;
+
+On SYSLISP;
+
+syslsp procedure GetRescan(); %. Return as String
+ Begin scalar N,S;
+ XJSYS1(0,0,0,0,const(jsRSCAN)); % Announce to Get
+ N:=XJSYS1(1,0,0,0,const(jsRSCAN)); % How Many
+ IF N=0 then return 'Nil;
+ S:=GtStr N-1; % To Drop Trailing EOL
+ For I:=0:N-2 do
+ StrByt(S,I):=XJsys1(0,0,0,0,const(JsPBIN));
+ Return MkSTR S; % Will include Program name
+ end;
+
+
+OFF SYSLISP;
+
+Global '(CRLF BL);
+
+CRLF :=STRING(8#15,8#12); %. CR-LF
+BL :=STRING(8#40); %. Blank
+
+Lisp procedure CONCATS (L); %. Combine list of strings
+ If PAIRP L then CONCAT(CAR L,CONCATS CDR L)
+ else CRLF;
+
+Lisp Fexpr Procedure CMDS (!%L); %. user COMMAND submit
+ DOCMDS EVLIS !%L;
+
+Lisp procedure DOCMDS (L); %. Submit via PutRescan
+ <<PutRescan CONCATS L; % Add CR, plant in RSCAN
+ EXEC()>>; % Run 'em
+
+%. -------- Sample Commands
+
+Lisp procedure VDIR (L);
+ DOCMDS LIST("VDIR ",L,CRLF,"POP");
+
+Lisp procedure HelpDir();
+ DOCMDS LIST("DIR PH:*.HLP",CRLF,"POP");
+
+Lisp procedure Take (FileName);
+ If FileP FileName then DOCMDS LIST("Take ",FileName,CRLF,"POP");
+
+Lisp procedure SYS (L);
+ DOCMDS LIST("SYS ", L, CRLF, "POP");
+
+Lisp procedure TALK (L);
+ DOCMDS LIST("TALK ",L,CRLF);
+
+Lisp procedure TYPE (L);
+ DOCMDS LIST("TYPE ",L,CRLF,"POP");
+
+END;
ADDED psl-1983/3-1/util/20/file-primitives.sl
Index: psl-1983/3-1/util/20/file-primitives.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/file-primitives.sl
@@ -0,0 +1,217 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% File-Primitives - File System primitive functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 September 1982
+% Revised: 22 November 1982
+%
+% *** THIS FILE IS TOPS-20 SPECIFIC ***
+%
+% This file contains the TOPS-20 implementation of a set of "common"
+% file system primitives.
+%
+% 22-Nov-82 Alan Snyder
+% Added error handling.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common))
+(CompileTime (load jsys))
+(load file-support)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% File Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de file-deleted-status (file-name)
+
+ % This function will return T if the specified file exists and is not
+ % marked as "deleted"; it will return 'DELETED if the file exists and
+ % is marked as "deleted"; it will return NIL otherwise. (On a system
+ % that does not support "deleted" files, this function will return
+ % either T or NIL.)
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-deleted? jfn) nil)))
+ (if (pairp result)
+ (if (car result) 'DELETED T)
+ ))
+ (jfn-release jfn)
+ ))))
+
+(de file-delete (file-name)
+
+ % This function attempts to delete the specified file. (This action may
+ % be undone using the FILE-UNDELETE function, if the system supports it.)
+ % If the attempt fails, NIL is returned (no error is reported).
+ % Otherwise, a string is returned which is the true name of the file
+ % that was deleted (as best as can be determined).
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 17))))
+ (when jfn
+ (let ((fn (jfn-truename jfn)))
+ (if (pairp (errset (jfn-delete jfn) nil)) fn)
+ ))))
+
+(de file-delete-and-expunge (file-name)
+
+ % This function attempts to delete the specified file and reclaim its
+ % storage. (On systems that do not support UNDELETE, this function is the
+ % same as FILE-DELETE.)
+ % If the attempt fails, NIL is returned (no error is reported).
+ % Otherwise, a string is returned which is the true name of the file
+ % that was deleted (as best as can be determined).
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 17))))
+ (when jfn
+ (let ((fn (jfn-truename jfn)))
+ (if (pairp (errset (jfn-delete-and-expunge jfn) nil)) fn)
+ ))))
+
+(de file-undelete (file-name)
+
+ % This function attempts to undelete the specified file.
+ % If the attempt fails, NIL is returned (no error is reported).
+ % Otherwise, a string is returned which is the true name of the file
+ % that was undeleted (as best as can be determined).
+ % (On systems that do not support UNDELETE, this function always returns NIL.)
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((fn (jfn-truename jfn)))
+ (if (pairp (errset (jfn-undelete jfn) nil)) fn)
+ )
+ (jfn-release jfn)
+ ))))
+
+(de file-read-date (file-name)
+
+ % This function returns an integer representing the date and time at
+ % which the specified file was last read. It returns NIL if it is
+ % unable to obtain that information.
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-read-date jfn) nil)))
+ (if (pairp result) (car result))
+ )
+ (jfn-release jfn)
+ ))))
+
+(de file-write-date (file-name)
+
+ % This function returns an integer representing the date and time at
+ % which the specified file was last written. It returns NIL if it is
+ % unable to obtain that information.
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-write-date jfn) nil)))
+ (if (pairp result) (car result))
+ )
+ (jfn-release jfn)
+ ))))
+
+(de file-byte-count (file-name)
+
+ % This function returns an integer representing the number of bytes
+ % in the specified file (without necessarily converting CRLF's into
+ % LFs). It returns NIL if it is unable to obtain that information.
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-byte-count jfn) nil)))
+ (if (pairp result) (car result))
+ )
+ (jfn-release jfn)
+ ))))
+
+(de file-page-count (file-name)
+
+ % This function returns an integer representing the number of "pages"
+ % in the specified file. (The notion of a "page" is system-dependent.)
+ % It returns NIL if it is unable to obtain that information.
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-page-count jfn) nil)))
+ (if (pairp result) (car result))
+ )
+ (jfn-release jfn)
+ ))))
+
+(de file-original-author (file-name)
+
+ % This function returns the name of the user who created the specified
+ % file. It returns NIL if it is unable to obtain that information.
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-original-author jfn) nil)))
+ (if (pairp result) (car result))
+ )
+ (jfn-release jfn)
+ ))))
+
+(de file-author (file-name)
+
+ % This function returns the name of the user who last modified the specified
+ % file. It returns NIL if it is unable to obtain that information.
+
+ (let ((jfn (attempt-to-get-jfn file-name #.(bits 2 8 17))))
+ (when jfn
+ (unwind-protect
+ (let ((result (errset (jfn-author jfn) nil)))
+ (if (pairp result) (car result))
+ )
+ (jfn-release jfn)
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Auxiliary Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de file-date-to-string (fdate)
+
+ % Convert a file date as returned by FILE-READ-DATE and FILE-WRITE-DATE to
+ % a meaningful string. Note that 0 is converted to the string "Never".
+
+ (if (or (not (integerp fdate)) (= fdate 0))
+ "Never"
+ (let ((buf (make-string 30 0)))
+ (Jsys0 buf fdate 0 0 (const jsODTIM))
+ (recopystringtonull buf))))
+
+(de fixup-file-name (name)
+
+ % Make the specified file name nice to print, e.g. by removing escape
+ % prefix characters. In this case, simply remove all control characters
+ % (^V is the TOPS-20 escape prefix character).
+
+ (for (in ch (String2List name))
+ (with the-list)
+ (when (GraphicP ch))
+ (collect ch the-list)
+ (returns (List2String the-list))
+ ))
+
+(de trim-filename-to-prefix (s)
+ % Remove trailing characters until the string ends with
+ % a device or directory prefix. (Used to determine a
+ % "meaningful" common prefix of a collection of file names.)
+
+ (for (from i (size s) 0 -1)
+ (until (let ((ch (indx s i)))
+ (or (= ch #\:) (= ch #\>))))
+ (returns (substring s 0 (+ i 1)))
+ ))
ADDED psl-1983/3-1/util/20/file-support.sl
Index: psl-1983/3-1/util/20/file-support.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/file-support.sl
@@ -0,0 +1,93 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% File-Support.SL - System-Dependent Support for File Primitives (TOPS-20)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 September 1982
+%
+% This file contains support functions used in the implementation of file
+% primitives for TOPS-20. The existence of the functions in this file should
+% be ignored when writing system-independent code.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load jsys common pathnames))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% JFN Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de jfn-truename (jfn)
+ (let ((file-name (make-string 200 #\space)))
+ (jsys1 file-name jfn #.(bits 2 5 8 11 14 35) 0 (const jsJFNS))
+ (recopystringtonull file-name)
+ ))
+
+(de jfn-deleted? (jfn)
+ (if (integerp jfn)
+ (not (= (LAnd (Jsys4 jfn #.(xword 1 1) 4 0 (const jsGTFDB))
+ (bits 3)) 0))))
+
+(de jfn-write-date (jfn)
+ (if (integerp jfn)
+ (Jsys4 jfn #.(xword 1 8#14) 4 0 (const jsGTFDB))))
+
+(de jfn-read-date (jfn)
+ (if (integerp jfn)
+ (Jsys4 jfn #.(xword 1 8#15) 4 0 (const jsGTFDB))))
+
+(de jfn-byte-count (jfn)
+ (if (integerp jfn)
+ (Jsys4 jfn #.(xword 1 8#12) 4 0 (const jsGTFDB))))
+
+(de jfn-page-count (jfn)
+ (if (integerp jfn)
+ (lowhalfword (Jsys4 jfn #.(xword 1 8#11) 4 0 (const jsGTFDB)))))
+
+(de jfn-original-author (jfn)
+ (if (integerp jfn)
+ (let ((str (make-string 100 0)))
+ (Jsys0 (xword 0 jfn) str 0 0 (const jsGFUST))
+ (recopystringtonull str)
+ )))
+
+(de jfn-author (jfn)
+ (if (integerp jfn)
+ (let ((str (make-string 100 0)))
+ (Jsys0 (xword 1 jfn) str 0 0 (const jsGFUST))
+ (recopystringtonull str)
+ )))
+
+(de jfn-delete (jfn)
+ (if (integerp jfn)
+ (jsys0 jfn 0 0 0 (const jsDELF))
+ ))
+
+(de jfn-delete-and-expunge (jfn)
+ (if (integerp jfn)
+ (jsys0 (xword 2#010000000000000000 jfn) 0 0 0 (const jsDELF))
+ ))
+
+(de jfn-undelete (jfn)
+ (if (integerp jfn)
+ (jsys0 (xword 1 jfn) #.(bits 3) 0 0 (const jsCHFDB))
+ ))
+
+(de jfn-release (jfn)
+ (if (integerp jfn)
+ (jsys0 jfn 0 0 0 (const jsRLJFN))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% GTJFN Functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de attempt-to-get-jfn (file-name the-bits)
+ (setf file-name (namestring file-name))
+ (let ((jfn (ErrorSet
+ (list 'jsys1 the-bits file-name 0 0 (const jsGTJFN)) nil nil)
+ ))
+ (cond
+ ((listp jfn) (car jfn))
+ )))
ADDED psl-1983/3-1/util/20/get-command-args.sl
Index: psl-1983/3-1/util/20/get-command-args.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/get-command-args.sl
@@ -0,0 +1,15 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% GET-COMMAND-ARGS -- get command line arguments
+%%%
+%%% Author: Cris Perdue
+%%% 5 Apr 1983 1320-PST
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(load parse-command-string get-command-string)
+
+%%% Returns a list of strings which are the command line
+%%% arguments to the program that was run. Program name is not
+%%% included. The code per se is not machine-dependent, but the
+%%% idea of getting a "command string" is so.
+(de get-command-args ()
+ (parse-command-string (get-command-string)))
ADDED psl-1983/3-1/util/20/get-command-string.sl
Index: psl-1983/3-1/util/20/get-command-string.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/get-command-string.sl
@@ -0,0 +1,74 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Get-Command-String.SL (TOPS-20 Version) - Get Program Command String
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 August 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common jsys))
+(load strings)
+
+% The function GET-COMMAND-STRING returns the string argument given
+% to the program when it was invoked.
+
+(de char-blank? (ch)
+ (or (= ch (char space)) (= ch (char tab))))
+
+(fluid '(command-string*))
+
+(de get-command-string ()
+ (or command-string* (setq command-string* (dec20-get-command-string))))
+
+(de dec20-get-command-string ()
+
+ % Read the process command string. This function should only be invoked once
+ % in a given fork, and should be invoked as soon as possible. The process
+ % command string is massaged to remove the program name and any trailing
+ % CRLF.
+
+ (prog (s high i j)
+ (setq s (dec20-read-process-arg))
+ (setq high (size s))
+ (if (< high 0) (return ""))
+ (setq i 0)
+ (while (and (<= i high) (char-blank? (igets s i)))
+ (setq i (+ i 1)))
+ (setq j i)
+ (while (and (<= j high) (not (char-blank? (igets s j))))
+ (setq j (+ j 1)))
+ (if (string-equal (substring s i j) "run") (return ""))
+ (while (and (<= j high) (char-blank? (igets s j)))
+ (setq j (+ j 1)))
+ (while (and (> high j) (not (graphicp (igets s high))))
+ (setq high (- high 1)))
+ (return (substring s j (+ high 1)))
+ ))
+
+(CompileTime (put 'prarg 'OpenCode '((jsys 357) (move (reg 1) (reg 3)))))
+(CompileTime (put 'rscan 'OpenCode '((jsys 320) (move (reg 1) (reg 1)))))
+(CompileTime (put 'sin 'OpenCode '((jsys 42) (move (reg 1) (reg 3)))))
+
+(de dec20-read-process-arg ()
+
+ % On TOPS-20, the command argument can be passed to an inferior fork in two
+ % ways. The first (and better) way is to pass a string in the process
+ % argument block. The second (and more popular) way is to pass a string in
+ % the RESCAN buffer (what a crock!). We will use the process argument block,
+ % if it is nonempty, otherwise we will read from the RESCAN buffer.
+
+ (prog (arg-len str)
+ (setq arg-len (prarg #.(int2sys (xword 1 8#400000)) 4 0))
+ (cond ((> arg-len 0)
+ (setq str (MkString arg-len))
+ (prarg #.(int2sys (xword 1 8#400000)) (jconv str) arg-len)
+ (return (recopystringtonull str))
+ ))
+ (setq arg-len (rscan 0))
+ (if (= arg-len 0) (return "")) % no input string
+ (setq str (MkString arg-len))
+ (sin 8#777777 (jconv str) (- arg-len))
+ (return str)
+ ))
ADDED psl-1983/3-1/util/20/get-heap-bounds.sl
Index: psl-1983/3-1/util/20/get-heap-bounds.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/get-heap-bounds.sl
@@ -0,0 +1,27 @@
+%%%% GET-HEAP-BOUNDS - looks up the addresses of the Syslisp variables
+%%% HeapLast and HeapLowerBound and makes it so that the Lisp function
+%%% HeapLast() returns the value of the variable HeapLast and the
+%%% Lisp function HeapLowerBound() returns the value of the variable
+%%% HeapLowerBound. Dec-20 only.
+
+(compiletime (load if-system syslisp))
+
+% This depends on exactly the code generated for the CONS function
+% on the Dec-20. Very, very brittle code!
+
+(fluid '(!%heaplast-address))
+
+(if_system PDP10
+(de get-heap-bounds ()
+ (setq !%heaplast-address (inf (wgetv (getfcodepointer 'cons) 2)))))
+
+(de heaplast ()
+ (getmem !%heaplast-address))
+
+% This depends on the order of declarations in PI:ALLOCATORS.RED and the
+% way storage is assigned for Syslisp variables.
+
+(de heaplowerbound ()
+ (wgetv !%heaplast-address 2))
+
+(get-heap-bounds)
ADDED psl-1983/3-1/util/20/homedir.build
Index: psl-1983/3-1/util/20/homedir.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/homedir.build
@@ -0,0 +1,1 @@
+in "homedir.sl"$
ADDED psl-1983/3-1/util/20/homedir.sl
Index: psl-1983/3-1/util/20/homedir.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/homedir.sl
@@ -0,0 +1,61 @@
+%
+% HOMEDIR.SL - USER-HOMEDIR-STRING function for Tops-20
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 September 1982
+% Copyright (c) 1982 University of Utah
+%
+% 6 June 1983 Mark R. Swanson
+% Changes for extended addressing.
+
+(compiletime (progn
+ (load monsym syslisp)
+ (put 'get-user-number 'opencode '((gjinf)))
+ (flag '(user-homedir-string-aux get-dir-string)
+ 'internalfunction)))
+
+% Returns a string which is the init file for program-name.
+% Optional HOST is not supported.
+(de init-file-string (program-name)
+ (concat (user-homedir-string) (concat program-name ".INIT")))
+
+% Returns a string which is the users home directory name.
+% Optional HOST is not supported.
+(lap '((*entry user-homedir-string expr 0)
+ (xmovei (reg 1) (indexed (reg st) 1)) % Pointer into the stack
+ (*alloc 20) % allocate space
+ (*call user-homedir-string-aux) % call the real function
+ (*exit 20))) % deallocate and return
+
+(de user-homedir-string-aux (p)
+ (concat "PS:<" (mkstr (get-dir-string p (get-user-number)))))
+
+(lap '((*entry get-dir-string expr 2)
+ (*move (reg 1) (reg 5)) % save original addr in ac5
+% (tlz (reg 1) 8#770000) % mask out old TAG (which
+ % isn't there)
+ (tlo (reg 1) 8#660000) % make it a global byte
+ % pointer which will start
+ % with next word
+ (*move (reg 1) (reg 3)) % save it in ac3
+ (dirst)
+ (erjmp cant-get-dir)
+ (movei (reg 4) 62) % put a closing > on it
+ (idpb (reg 4) (reg 1))
+ (setz (reg 4) 0) % put a null char on the end
+ (idpb (reg 4) (reg 1))
+ (seto (reg 4) 0) % initialize length to -1
+string-length-loop
+ (ildb (reg 2) (reg 3))
+ (jumpe (reg 2) done-computing-length)
+ (aoja (reg 4) string-length-loop)
+done-computing-length
+ (movem (reg 4) (indexed (reg 5) 0)) % put len in string header
+ (*move (reg 5) (reg 1)) % return original pointer
+ (*exit 0)
+cant-get-dir
+ (*move (reg 1) '"UNKNOWN>")
+ (*exit 0)))
ADDED psl-1983/3-1/util/20/input-stream.sl
Index: psl-1983/3-1/util/20/input-stream.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/input-stream.sl
@@ -0,0 +1,382 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Input-Stream.SL (TOPS-20 Version) - File Input Stream Objects
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 29 July 1982
+%
+% This package is 6.6 times faster than the standard unbuffered I/O.
+% (Using message passing, it is only 1.7 times faster.)
+%
+% Note: this code will only run COMPILED.
+%
+% See TESTING code at the end of this file for examples of use.
+% Be sure to include "(CompileTime (load objects))" at the beginning
+% of any file that uses this package.
+%
+% Summary of public functions:
+%
+% (setf s (open-input "file name")) % generates error on failure
+% (setf s (attempt-to-open-input "file name")) % returns NIL on failure
+% (setf ch (=> s getc)) % read character (map CRLF to LF)
+% (setf ch (=> s getc-image)) % read character (don't map CRLF to LF)
+% (setf ch (=> s peekc)) % peek at next character
+% (setf ch (=> s peekc-image)) % peek at next character (don't map CRLF to LF)
+% (setf str (=> s getl)) % Read a line; return string without terminating LF.
+% (=> s empty?) % Are there no more characters?
+% (=> s close) % Close the file.
+% (setf fn (=> s file-name)) % Return "true" name of file.
+% (setf date (=> s read-date)) % Return date that file was last read.
+% (setf date (=> s write-date)) % Return date that file was last written.
+% (=> s delete-file) % Delete the associated file.
+% (=> s undelete-file) % Undelete the associated file.
+% (=> s delete-and-expunge) % Delete and expunge the associated file.
+% (setf name (=> s author)) % Return the name of the file's author.
+% (setf name (=> s original-author)) % Return the original author's name.
+% (setf count (=> s file-length)) % Return the byte count of the file.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Changes:
+%
+% 9/29/82 Alan Snyder
+% Changed GETC to return stray CRs.
+% Now uses (=> self ...) form (produces same object code).
+% Added operations PEEKC-IMAGE, GETL, TELL-POSITION, SEEK-POSITION
+% (written by Nancy Kendzierski).
+%
+% 11/22/82 Alan Snyder
+% Changed SEEK-POSITION to work with large byte pointers (> 256K).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-strings))
+(BothTimes (load objects jsys))
+(load directory file-support)
+
+(de attempt-to-open-input (file-name)
+ (let ((p (ErrorSet (list 'open-input file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de open-input (file-name)
+ (let ((s (make-instance 'input-stream)))
+ (=> s open file-name)
+ s))
+
+(DefConst FILE-BUFFER-SIZE #.(* 5 512))
+
+(defflavor input-stream ((jfn NIL) % TOPS-20 file number
+ ptr % "pointer" to next char in buffer
+ count % number of valid chars in buffer
+ eof-flag % T => this bufferfull is the last
+ file-name % full name of actual file
+ buffer % input buffer
+ )
+ ()
+ (gettable-instance-variables file-name)
+ )
+
+% Note: The JSYS function can't be used for the 'SIN' JSYS because the JSYS
+% function handles errors. The 'SIN' JSYS will report an error on end-of-file
+% if errors are being handled. We don't want that to happen!
+
+(CompileTime (progn
+ (put 'SIN 'OpenCode '((jsys 8#52) (move (reg 1) (reg 3))))
+ (put 'BIN 'OpenCode '((jsys 8#50) (move (reg 1) (reg 2))))
+ (put 'CLOSF 'OpenCode '((jsys 8#22) (move (reg 1) (reg 1))))
+ (put 'RFPTR 'OpenCode '((jsys 8#43) (jfcl) (move (reg 1) (reg 2))))
+ (put 'SFPTR 'OpenCode '((jsys 8#27) (jfcl) (move (reg 1) (reg 1))))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (input-stream getc) ()
+
+ % Return the next character from the file. Line termination is represented
+ % by a single NEWLINE (LF) character. Returns NIL on end of file.
+
+ % Implementation note: It was determined by experiment that the PSL
+ % compiler produces much better code if there are no function calls other
+ % than tail-recursive ones. That's why this function is written the way
+ % it is.
+
+ (if (< ptr count)
+ (let ((ch (prog1
+ (string-fetch buffer ptr)
+ (setf ptr (+ ptr 1))
+ )))
+ % Ignore CR followed by LF
+ (if (= ch #\CR)
+ (=> self &getc-after-CR)
+ ch
+ ))
+ (=> self &fill-buffer-and-getc)
+ ))
+
+(defmethod (input-stream &getc-after-CR) () % Internal method.
+ % We have just read a CR from the buffer. If the next character
+ % is a LF, then we should ignore the CR and return the LF.
+ % Otherwise, we should return the CR.
+
+ (if (= (=> self peekc-image) #\LF)
+ (=> self getc-image)
+ #\CR
+ ))
+
+(defmethod (input-stream &fill-buffer-and-getc) () % Internal method.
+ (and (=> self &fill-buffer) (=> self getc)))
+
+(defmethod (input-stream getc-image) ()
+
+ % Return the next character from the file. Do not perform any translation.
+ % In particular, return all <CR>s. Returns NIL on end of file.
+
+ (if (< ptr count)
+ (prog1
+ (string-fetch buffer ptr)
+ (setf ptr (+ ptr 1))
+ )
+ (=> self &fill-buffer-and-getc-image)
+ ))
+
+(defmethod (input-stream &fill-buffer-and-getc-image) () % Internal method.
+ (and (=> self &fill-buffer) (=> self getc-image)))
+
+(defmethod (input-stream empty?) ()
+ (null (=> self peekc-image)))
+
+(defmethod (input-stream peekc) ()
+
+ % Return the next character from the file, but don't advance to the next
+ % character. Returns NIL on end of file. Maps CRLF to LF.
+
+ (if (< ptr count)
+ (let ((ch (string-fetch buffer ptr)))
+ % Ignore CR if followed by LF
+ (if (and (= ch #\CR)
+ (= (=> self &peek2) #\LF)
+ )
+ #\LF
+ ch
+ ))
+ (=> self &fill-buffer-and-peekc)
+ ))
+
+(defmethod (input-stream &fill-buffer-and-peekc) () % Internal method.
+ (and (=> self &fill-buffer) (=> self peekc)))
+
+(defmethod (input-stream peekc-image) ()
+
+ % Return the next character from the file, but don't advance to the next
+ % character. Returns NIL on end of file.
+
+ (if (< ptr count)
+ (string-fetch buffer ptr)
+ (=> self &fill-buffer-and-peekc-image)
+ ))
+
+(defmethod (input-stream &fill-buffer-and-peekc-image) () % Internal method.
+ (and (=> self &fill-buffer) (=> self peekc-image)))
+
+(defmethod (input-stream &peek2) () % Internal method.
+
+ % Return the character after the next character in the file, but don't
+ % advance. Does not map CRLF. Returns Ascii NUL on end of file. Requires
+ % that the buffer contain at least one character. This is a hack required
+ % to implement PEEKC.
+
+ (let ((next-ptr (+ ptr 1)))
+ (cond ((>= next-ptr count)
+ % The next character has not yet been read into the buffer.
+ (let* ((old-pos (RFPTR jfn))
+ (ch (BIN jfn))
+ )
+ (SFPTR jfn old-pos)
+ ch
+ ))
+ (t (string-fetch buffer next-ptr))
+ )))
+
+(defmethod (input-stream &fill-buffer) () % Internal method.
+ % Return NIL iff there are no more characters.
+ (if eof-flag
+ NIL
+ (let ((n (SIN jfn (jconv buffer) (- (const FILE-BUFFER-SIZE)))))
+ (if (~= n 0) (setf eof-flag T))
+ (setf count (+ (const FILE-BUFFER-SIZE) n))
+ (setf ptr 0)
+ (~= count 0))))
+
+(defmethod (input-stream getl) ()
+ % Read and return (the remainder of) the current input line.
+ % Read, but don't return the terminating EOL (if any).
+ % (EOL is interpreted as LF or CRLF)
+ % Return NIL if no characters and end-of-file detected.
+
+ (if (and (>= ptr count) (not (=> self &fill-buffer)))
+ NIL
+ % Else
+ (let ((start ptr) (save-buffer NIL) (eof? NIL))
+ (while (and (not eof?) (~= (string-fetch buffer ptr) #\LF))
+ (setf ptr (+ ptr 1))
+ (cond ((>= ptr count)
+ (setf save-buffer
+ (concat save-buffer (subseq buffer start ptr)))
+ (setf eof? (not (=> self &fill-buffer)))
+ (setf start ptr)
+ ))
+ )
+ (if eof?
+ save-buffer
+ % Else
+ (setf ptr (+ ptr 1))
+ (if (= ptr 1)
+ (if save-buffer
+ (if (= (string-fetch save-buffer (size save-buffer)) #\CR)
+ (subseq save-buffer 0 (size save-buffer))
+ (sub save-buffer 0 (size save-buffer)))
+ (subseq buffer start ptr))
+ (if (= (string-fetch buffer (- ptr 2)) #\CR)
+ (concat save-buffer (subseq buffer start (- ptr 2)))
+ (concat save-buffer (subseq buffer start (- ptr 1)))
+ )))
+ )))
+
+(defmethod (input-stream tell-position) ()
+ % Return an integer representing the current "position" of the stream. About
+ % all we can guarantee about this integer is (1) it will be 0 at the
+ % beginning of the file and (2) if you later SEEK-POSITION to this integer,
+ % the stream will be reset to its current position. The reason for this
+ % fuzziness is that the translation of CRLF into LF performed by the "normal"
+ % input operations makes it impossible to predict the relationship between
+ % the apparent file position and the actual file position.
+
+ (- (RFPTR jfn) (- count ptr))
+ )
+
+(defmethod (input-stream seek-position) (p)
+ (setf p (int2sys p))
+ (let* ((buffer-end (RFPTR jfn))
+ (buffer-start (- buffer-end count)))
+ (if (and (>= p buffer-start) (< p buffer-end))
+ (setf ptr (- p buffer-start))
+ % Else
+ (SFPTR jfn p)
+ (setf ptr 0)
+ (setf count 0)
+ (setf eof-flag NIL)
+ )
+ ))
+
+(defmethod (input-stream open) (name-of-file)
+
+ % Open the specified file for input via SELF. If the file cannot be opened,
+ % a Continuable Error is generated.
+
+ (if jfn (=> self close))
+ (setf buffer (MkString (const FILE-BUFFER-SIZE) #\space))
+ (setf ptr 0)
+ (setf count 0)
+ (setf eof-flag NIL)
+ (setf jfn (Dec20Open name-of-file
+ (int2sys 2#001000000000000001000000000000000000)
+ (int2sys 2#000111000000000000010000000000100000)
+ ))
+ (if (= jfn 0) (setf jfn NIL))
+ (if (null jfn)
+ (=> self open
+ (ContinuableError
+ 0
+ (BldMsg "Unable to Open '%w' for Input." name-of-file)
+ name-of-file))
+ % Else
+ (setf file-name (jfn-truename jfn))
+ ))
+
+(defmethod (input-stream close) ()
+ (when jfn
+ (CLOSF jfn)
+ (setf jfn NIL)
+ (setf buffer NIL)
+ (setf count 0)
+ (setf ptr 0)
+ (setf eof-flag T)
+ ))
+
+(defmethod (input-stream read-date) ()
+ (jfn-read-date jfn))
+
+(defmethod (input-stream write-date) ()
+ (jfn-write-date jfn))
+
+(defmethod (input-stream delete-file) ()
+ (jfn-delete jfn))
+
+(defmethod (input-stream undelete-file) ()
+ (jfn-undelete jfn))
+
+(defmethod (input-stream delete-and-expunge-file) ()
+ (jfn-delete-and-expunge jfn))
+
+(defmethod (input-stream author) ()
+ (jfn-author jfn))
+
+(defmethod (input-stream original-author) ()
+ (jfn-original-author jfn))
+
+(defmethod (input-stream file-length) ()
+ (jfn-byte-count jfn))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% TESTING CODE
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CommentOutCode (progn
+
+(de test-buffered-input (name-of-file)
+ (setf s (open-input name-of-file))
+ (while (setf ch (input-stream$getc s))
+ (WriteChar ch)
+ )
+ (=> s close)
+ (Prin2 "---EOF---")
+ NIL
+ )
+
+(de time-buffered-input (name-of-file)
+ (setf start-time (time))
+ (setf s (open-input name-of-file))
+ (while (setf ch (input-stream$getc s))
+ )
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-buffered-input-1 (name-of-file)
+ (setf start-time (time))
+ (setf s (open-input name-of-file))
+ (while (setf ch (=> s getc))
+ )
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-standard-input (name-of-file)
+ (setf start-time (time))
+ (setf chan (open name-of-file 'INPUT))
+ (while (not (= (setf ch (ChannelReadChar chan)) $EOF$))
+ )
+ (close chan)
+ (- (time) start-time)
+ )
+
+(de time-input (name-of-file)
+ (list
+ (time-buffered-input name-of-file)
+ (time-buffered-input-1 name-of-file)
+ (time-standard-input name-of-file)
+ ))
+
+)) % End CommentOutCode
ADDED psl-1983/3-1/util/20/interrupt.build
Index: psl-1983/3-1/util/20/interrupt.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/interrupt.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp, Monsym, Jsys;
+in "20-interrupt.red"$
ADDED psl-1983/3-1/util/20/jsys.build
Index: psl-1983/3-1/util/20/jsys.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/jsys.build
@@ -0,0 +1,2 @@
+CompileTime load Monsym;
+in "jsys.red"$
ADDED psl-1983/3-1/util/20/jsys.red
Index: psl-1983/3-1/util/20/jsys.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/jsys.red
@@ -0,0 +1,469 @@
+%
+% JSYS.RED - Simple XJSYS function
+%
+% Author: Martin L. Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 8 March 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% <PSL.UTIL>JSYS.RED.9, 18-May-82 13:24:36, Edit by BENSON
+% Made XJSYSn OpenCode'ed
+%/ Changed FILNAM->FileName, due to GLOBAL conflict
+%/ Changed JSYS calls, so LIST(..) rather than '(..) used
+%/ Changed for V3:JSYS
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% <PSL.UTIL>JSYS.RED.2, 18-Mar-82 21:49:32, Edit by GRISS
+% Converted to V3
+%. M. Griss 3:32pm Saturday, 7 November 1981
+%. MLG: Fixed GetErrorString and BITS macro, 8:57am Friday, 25 December 1981
+on syslisp;
+
+% Modeled after the IDapply to avoid CONS, register reloads
+% could easily be done Opencoded
+% SYSLSP calls, expect W value, return appropriate register
+
+%. syslsp procedure XJsys0(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys1(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys2(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys3(Jr1,Jr2,Jr3,Jr4,Jnum)
+%. syslsp procedure XJsys4(Jr1,Jr2,Jr3,Jr4,Jnum)
+
+lap '((!*entry xjsys0 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (wconst 0) (reg 1))
+ (!*exit 0))$
+
+BothTimes put('xjsys0, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (setzm (reg 1))));
+
+lap '((!*entry xjsys1 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*exit 0))$
+
+BothTimes put('xjsys1, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))));
+
+lap '((!*entry xjsys2 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (reg 2) (reg 1))
+ (!*exit 0))$
+
+BothTimes put('xjsys2, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (move (reg 1) (reg 2))));
+
+lap '((!*entry xjsys3 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (reg 3) (reg 1))
+ (!*exit 0))$
+
+BothTimes put('xjsys3, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (move (reg 1) (reg 3))));
+
+lap '((!*entry xjsys4 expr 5)
+ (jsys (indirect (reg 5)))
+ (erjmp (entry xjsyserror))
+ (!*move (reg 4) (reg 1))
+ (!*exit 0))$
+
+
+BothTimes put('xjsys4, 'OpenCode, '((jsys (indexed (reg 5) 0))
+ (jump 8#16 (entry xjsyserror))
+ (move (reg 1) (reg 4))));
+
+lap '((!*entry geterrorstring expr 1)
+ (!*move (wconst -1) (reg 2)) % most recent error
+ (hrli (reg 2) 8#400000) % self process
+ (!*move (wconst 0) (reg 3)) % all string
+ (erstr) % get the error string to a1 buffer
+ (jfcl)
+ (jfcl)
+ (!*exit 0))$
+
+syslsp procedure xjsyserror$ %/ should load up errstr
+ begin scalar s;
+ s:=gtstr 200;
+ geterrorstring lor(lsh(8#660700,18), s)$
+ return stderror recopystringtonull s;
+ end;
+
+% --- conversions for lisp level calls
+
+syslsp procedure str2int s;
+ sys2int strinf s;
+
+syslsp procedure int2str i;
+ mkstr int2sys i;
+
+syslsp procedure jconv j; %. handle untagging
+ if fixp j then int2sys j
+ else if stringp j
+ then lor(lsh(8#660000,18),strinf(j)) % Bug in LONG const
+ else stderror list(j,'" not known in jconv");
+
+% lisp calls. untag args, then tag result as integer
+% user has to convert result from xword, stringbase, etc
+
+syslsp procedure jsys0(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys0(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys1(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys1(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys2(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys2(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys3(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys3(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure jsys4(jr1,jr2,jr3,jr4,jnum);
+ sys2int xjsys4(jconv jr1,jconv jr2,jconv jr3,jconv jr4,int2sys jnum)$
+
+syslsp procedure checknum(x,y);
+ if intp x then intinf x else nonintegererror(x,y);
+
+CommentOutCode<<
+syslsp procedure insertstringsize s;
+ begin scalar l,s1; % this must not be done to a string
+ l:=0; s1:=strinf(s); % in the heap!
+ while not (strbyt(s1,l)= char null) do l:=l+1;
+ @s1:=mkitem(hstr,l-1);
+ return s;
+ end;
+>>;
+
+syslsp procedure recopystringtonull s;
+ begin scalar l,s1,s2,ch;
+ l:=0; s1:=strinf(s);
+ while not (strbyt(s1,l)= char null) do l:=l+1;
+ s2:=gtstr(l-1);
+ l:=0;
+ while not ((ch:=strbyt(s1,l))= char null)
+ do <<strbyt(s2,l):= ch; l:=l+1>>;
+ return mkstr s2;
+ end;
+
+% ------------ useful bit, byte and word utilities
+
+syslsp procedure swap(x); %. swap half words
+ xword(lowhalfword x,highhalfword x);
+
+syslsp procedure lowhalfword n;
+ sys2int land(int2sys n,8#777777);
+
+compiletime <<
+syslsp smacro procedure rsh(x,y);
+ lsh(x,-y);
+>>;
+
+syslsp procedure highhalfword n;
+ sys2int land(rsh(int2sys n,18),8#777777);
+
+syslsp procedure xword(x,y); %. build word from half-words
+% sys2int lor(lsh(lowhalfword(int2sys x),18),
+% lowhalfword int2sys y); %/Compiler error
+begin scalar Tmp;
+ Tmp := lowhalfword int2sys x;
+ Tmp := lsh(Tmp, 18);
+ Tmp := lor(Tmp, lowhalfword int2sys y);
+ return sys2int Tmp;
+end;
+
+syslsp procedure jbits l; %. convert bit and byte fields
+% l is list of bitpos or (fieldvalue . rightbitpos)
+% msb is #0, lsb is #35 on dec-20
+ begin scalar wd,x,fldpos,fldval;
+ wd:=0;
+ lb: if not pairp l then return sys2int wd;
+ x:=car l; l := cdr l;
+ if pairp x then <<fldpos:=cdr x; fldval:=car x>>
+ else <<fldpos:=x; fldval:=1>>;
+ if not (fixp fldval and fixp fldpos) then goto lb;
+ if fldpos <0 or fldpos > 35 then goto lb;
+ wd := lor(wd,lsh(fldval,35-fldpos));
+ goto lb;
+ end;
+
+macro procedure bits l;
+ list('jbits, 'list . cdr l);
+
+
+%. load jSYS Names
+
+procedure MakeJsys(Name, Number);
+ EvDefConst(Name, Number);
+
+off syslisp;
+
+MakeJsys( 'jsJSYS , 8#0)$
+MakeJsys( 'jsLOGIN , 8#1)$
+MakeJsys( 'jsCRJOB , 8#2)$
+MakeJsys( 'jsLGOUT , 8#3)$
+MakeJsys( 'jsCACCT , 8#4)$
+MakeJsys( 'jsEFACT , 8#5)$
+MakeJsys( 'jsSMON , 8#6)$
+MakeJsys( 'jsTMON , 8#7)$
+MakeJsys( 'jsGETAB , 8#10)$
+MakeJsys( 'jsERSTR , 8#11)$
+MakeJsys( 'jsGETER , 8#12)$
+MakeJsys( 'jsGJINF , 8#13)$
+MakeJsys( 'jsTIME , 8#14)$
+MakeJsys( 'jsRUNTM , 8#15)$
+MakeJsys( 'jsSYSGT , 8#16)$
+MakeJsys( 'jsGNJFN , 8#17)$
+MakeJsys( 'jsGTJFN , 8#20)$
+MakeJsys( 'jsOPENF , 8#21)$
+MakeJsys( 'jsCLOSF , 8#22)$
+MakeJsys( 'jsRLJFN , 8#23)$
+MakeJsys( 'jsGTSTS , 8#24)$
+MakeJsys( 'jsSTSTS , 8#25)$
+MakeJsys( 'jsDELF , 8#26)$
+MakeJsys( 'jsSFPTR , 8#27)$
+MakeJsys( 'jsJFNS , 8#30)$
+MakeJsys( 'jsFFFFP , 8#31)$
+MakeJsys( 'jsRDDIR , 8#32)$
+MakeJsys( 'jsCPRTF , 8#33)$
+MakeJsys( 'jsCLZFF , 8#34)$
+MakeJsys( 'jsRNAMF , 8#35)$
+MakeJsys( 'jsSIZEF , 8#36)$
+MakeJsys( 'jsGACTF , 8#37)$
+MakeJsys( 'jsSTDIR , 8#40)$
+MakeJsys( 'jsDIRST , 8#41)$
+MakeJsys( 'jsBKJFN , 8#42)$
+MakeJsys( 'jsRFPTR , 8#43)$
+MakeJsys( 'jsCNDIR , 8#44)$
+MakeJsys( 'jsRFBSZ , 8#45)$
+MakeJsys( 'jsSFBSZ , 8#46)$
+MakeJsys( 'jsSWJFN , 8#47)$
+MakeJsys( 'jsBIN , 8#50)$
+MakeJsys( 'jsBOUT , 8#51)$
+MakeJsys( 'jsSIN , 8#52)$
+MakeJsys( 'jsSOUT , 8#53)$
+MakeJsys( 'jsRIN , 8#54)$
+MakeJsys( 'jsROUT , 8#55)$
+MakeJsys( 'jsPMAP , 8#56)$
+MakeJsys( 'jsRPACS , 8#57)$
+MakeJsys( 'jsSPACS , 8#60)$
+MakeJsys( 'jsRMAP , 8#61)$
+MakeJsys( 'jsSACTF , 8#62)$
+MakeJsys( 'jsGTFDB , 8#63)$
+MakeJsys( 'jsCHFDB , 8#64)$
+MakeJsys( 'jsDUMPI , 8#65)$
+MakeJsys( 'jsDUMPO , 8#66)$
+MakeJsys( 'jsDELDF , 8#67)$
+MakeJsys( 'jsASND , 8#70)$
+MakeJsys( 'jsRELD , 8#71)$
+MakeJsys( 'jsCSYNO , 8#72)$
+MakeJsys( 'jsPBIN , 8#73)$
+MakeJsys( 'jsPBOUT , 8#74)$
+MakeJsys( 'jsPSIN , 8#75)$
+MakeJsys( 'jsPSOUT , 8#76)$
+MakeJsys( 'jsMTOPR , 8#77)$
+MakeJsys( 'jsCFIBF , 8#100)$
+MakeJsys( 'jsCFOBF , 8#101)$
+MakeJsys( 'jsSIBE , 8#102)$
+MakeJsys( 'jsSOBE , 8#103)$
+MakeJsys( 'jsDOBE , 8#104)$
+MakeJsys( 'jsGTABS , 8#105)$
+MakeJsys( 'jsSTABS , 8#106)$
+MakeJsys( 'jsRFMOD , 8#107)$
+MakeJsys( 'jsSFMOD , 8#110)$
+MakeJsys( 'jsRFPOS , 8#111)$
+MakeJsys( 'jsRFCOC , 8#112)$
+MakeJsys( 'jsSFCOC , 8#113)$
+MakeJsys( 'jsSTI , 8#114)$
+MakeJsys( 'jsDTACH , 8#115)$
+MakeJsys( 'jsATACH , 8#116)$
+MakeJsys( 'jsDVCHR , 8#117)$
+MakeJsys( 'jsSTDEV , 8#120)$
+MakeJsys( 'jsDEVST , 8#121)$
+MakeJsys( 'jsMOUNT , 8#122)$
+MakeJsys( 'jsDSMNT , 8#123)$
+MakeJsys( 'jsINIDR , 8#124)$
+MakeJsys( 'jsSIR , 8#125)$
+MakeJsys( 'jsEIR , 8#126)$
+MakeJsys( 'jsSKPIR , 8#127)$
+MakeJsys( 'jsDIR , 8#130)$
+MakeJsys( 'jsAIC , 8#131)$
+MakeJsys( 'jsIIC , 8#132)$
+MakeJsys( 'jsDIC , 8#133)$
+MakeJsys( 'jsRCM , 8#134)$
+MakeJsys( 'jsRWM , 8#135)$
+MakeJsys( 'jsDEBRK , 8#136)$
+MakeJsys( 'jsATI , 8#137)$
+MakeJsys( 'jsDTI , 8#140)$
+MakeJsys( 'jsCIS , 8#141)$
+MakeJsys( 'jsSIRCM , 8#142)$
+MakeJsys( 'jsRIRCM , 8#143)$
+MakeJsys( 'jsRIR , 8#144)$
+MakeJsys( 'jsGDSTS , 8#145)$
+MakeJsys( 'jsSDSTS , 8#146)$
+MakeJsys( 'jsRESET , 8#147)$
+MakeJsys( 'jsRPCAP , 8#150)$
+MakeJsys( 'jsEPCAP , 8#151)$
+MakeJsys( 'jsCFORK , 8#152)$
+MakeJsys( 'jsKFORK , 8#153)$
+MakeJsys( 'jsFFORK , 8#154)$
+MakeJsys( 'jsRFORK , 8#155)$
+MakeJsys( 'jsRFSTS , 8#156)$
+MakeJsys( 'jsSFORK , 8#157)$
+MakeJsys( 'jsSFACS , 8#160)$
+MakeJsys( 'jsRFACS , 8#161)$
+MakeJsys( 'jsHFORK , 8#162)$
+MakeJsys( 'jsWFORK , 8#163)$
+MakeJsys( 'jsGFRKH , 8#164)$
+MakeJsys( 'jsRFRKH , 8#165)$
+MakeJsys( 'jsGFRKS , 8#166)$
+MakeJsys( 'jsDISMS , 8#167)$
+MakeJsys( 'jsHALTF , 8#170)$
+MakeJsys( 'jsGTRPW , 8#171)$
+MakeJsys( 'jsGTRPI , 8#172)$
+MakeJsys( 'jsRTIW , 8#173)$
+MakeJsys( 'jsSTIW , 8#174)$
+MakeJsys( 'jsSOBF , 8#175)$
+MakeJsys( 'jsRWSET , 8#176)$
+MakeJsys( 'jsGETNM , 8#177)$
+MakeJsys( 'jsGET , 8#200)$
+MakeJsys( 'jsSFRKV , 8#201)$
+MakeJsys( 'jsSAVE , 8#202)$
+MakeJsys( 'jsSSAVE , 8#203)$
+MakeJsys( 'jsSEVEC , 8#204)$
+MakeJsys( 'jsGEVEC , 8#205)$
+MakeJsys( 'jsGPJFN , 8#206)$
+MakeJsys( 'jsSPJFN , 8#207)$
+MakeJsys( 'jsSETNM , 8#210)$
+MakeJsys( 'jsFFUFP , 8#211)$
+MakeJsys( 'jsDIBE , 8#212)$
+MakeJsys( 'jsFDFRE , 8#213)$
+MakeJsys( 'jsGDSKC , 8#214)$
+MakeJsys( 'jsLITES , 8#215)$
+MakeJsys( 'jsTLINK , 8#216)$
+MakeJsys( 'jsSTPAR , 8#217)$
+MakeJsys( 'jsODTIM , 8#220)$
+MakeJsys( 'jsIDTIM , 8#221)$
+MakeJsys( 'jsODCNV , 8#222)$
+MakeJsys( 'jsIDCNV , 8#223)$
+MakeJsys( 'jsNOUT , 8#224)$
+MakeJsys( 'jsNIN , 8#225)$
+MakeJsys( 'jsSTAD , 8#226)$
+MakeJsys( 'jsGTAD , 8#227)$
+MakeJsys( 'jsODTNC , 8#230)$
+MakeJsys( 'jsIDTNC , 8#231)$
+MakeJsys( 'jsFLIN , 8#232)$
+MakeJsys( 'jsFLOUT , 8#233)$
+MakeJsys( 'jsDFIN , 8#234)$
+MakeJsys( 'jsDFOUT , 8#235)$
+MakeJsys( 'jsCRDIR , 8#240)$
+MakeJsys( 'jsGTDIR , 8#241)$
+MakeJsys( 'jsDSKOP , 8#242)$
+MakeJsys( 'jsSPRIW , 8#243)$
+MakeJsys( 'jsDSKAS , 8#244)$
+MakeJsys( 'jsSJPRI , 8#245)$
+MakeJsys( 'jsSTO , 8#246)$
+MakeJsys( 'jsBBNIIT , 8#247)$
+MakeJsys( 'jsARCF , 8#247)$
+MakeJsys( 'jsASNDP , 8#260)$
+MakeJsys( 'jsRELDP , 8#261)$
+MakeJsys( 'jsASNDC , 8#262)$
+MakeJsys( 'jsRELDC , 8#263)$
+MakeJsys( 'jsSTRDP , 8#264)$
+MakeJsys( 'jsSTPDP , 8#265)$
+MakeJsys( 'jsSTSDP , 8#266)$
+MakeJsys( 'jsRDSDP , 8#267)$
+MakeJsys( 'jsWATDP , 8#270)$
+MakeJsys( 'jsATNVT , 8#274)$
+MakeJsys( 'jsCVSKT , 8#275)$
+MakeJsys( 'jsCVHST , 8#276)$
+MakeJsys( 'jsFLHST , 8#277)$
+MakeJsys( 'jsGCVEC , 8#300)$
+MakeJsys( 'jsSCVEC , 8#301)$
+MakeJsys( 'jsSTTYP , 8#302)$
+MakeJsys( 'jsGTTYP , 8#303)$
+MakeJsys( 'jsBPT , 8#304)$
+MakeJsys( 'jsGTDAL , 8#305)$
+MakeJsys( 'jsWAIT , 8#306)$
+MakeJsys( 'jsHSYS , 8#307)$
+MakeJsys( 'jsUSRIO , 8#310)$
+MakeJsys( 'jsPEEK , 8#311)$
+MakeJsys( 'jsMSFRK , 8#312)$
+MakeJsys( 'jsESOUT , 8#313)$
+MakeJsys( 'jsSPLFK , 8#314)$
+MakeJsys( 'jsADVIS , 8#315)$
+MakeJsys( 'jsJOBTM , 8#316)$
+MakeJsys( 'jsDELNF , 8#317)$
+MakeJsys( 'jsSWTCH , 8#320)$
+MakeJsys( 'jsOPRFN , 8#326)$
+MakeJsys( 'jsCGRP , 8#327)$
+MakeJsys( 'jsVACCT , 8#330)$
+MakeJsys( 'jsGDACC , 8#331)$
+MakeJsys( 'jsATGRP , 8#332)$
+MakeJsys( 'jsGACTJ , 8#333)$
+MakeJsys( 'jsGPSGN , 8#334)$
+MakeJsys( 'jsRSCAN , 8#500)$
+MakeJsys( 'jsHPTIM , 8#501)$
+MakeJsys( 'jsCRLNM , 8#502)$
+MakeJsys( 'jsINLNM , 8#503)$
+MakeJsys( 'jsLNMST , 8#504)$
+MakeJsys( 'jsRDTXT , 8#505)$
+MakeJsys( 'jsSETSN , 8#506)$
+MakeJsys( 'jsGETJI , 8#507)$
+MakeJsys( 'jsMSEND , 8#510)$
+MakeJsys( 'jsMRECV , 8#511)$
+MakeJsys( 'jsMUTIL , 8#512)$
+MakeJsys( 'jsENQ , 8#513)$
+MakeJsys( 'jsDEQ , 8#514)$
+MakeJsys( 'jsENQC , 8#515)$
+MakeJsys( 'jsSNOOP , 8#516)$
+MakeJsys( 'jsSPOOL , 8#517)$
+MakeJsys( 'jsALLOC , 8#520)$
+MakeJsys( 'jsCHKAC , 8#521)$
+MakeJsys( 'jsTIMER , 8#522)$
+MakeJsys( 'jsRDTTY , 8#523)$
+MakeJsys( 'jsTEXTI , 8#524)$
+MakeJsys( 'jsUFPGS , 8#525)$
+MakeJsys( 'jsSFPOS , 8#526)$
+MakeJsys( 'jsSYERR , 8#527)$
+MakeJsys( 'jsDIAG , 8#530)$
+MakeJsys( 'jsSINR , 8#531)$
+MakeJsys( 'jsSOUTR , 8#532)$
+MakeJsys( 'jsRFTAD , 8#533)$
+MakeJsys( 'jsSFTAD , 8#534)$
+MakeJsys( 'jsTBDEL , 8#535)$
+MakeJsys( 'jsTBADD , 8#536)$
+MakeJsys( 'jsTBLUK , 8#537)$
+MakeJsys( 'jsSTCMP , 8#540)$
+MakeJsys( 'jsSETJB , 8#541)$
+MakeJsys( 'jsGDVEC , 8#542)$
+MakeJsys( 'jsSDVEC , 8#543)$
+MakeJsys( 'jsCOMND , 8#544)$
+MakeJsys( 'jsPRARG , 8#545)$
+MakeJsys( 'jsGACCT , 8#546)$
+MakeJsys( 'jsLPINI , 8#547)$
+MakeJsys( 'jsGFUST , 8#550)$
+MakeJsys( 'jsSFUST , 8#551)$
+MakeJsys( 'jsACCES , 8#552)$
+MakeJsys( 'jsRCDIR , 8#553)$
+MakeJsys( 'jsRCUSR , 8#554)$
+MakeJsys( 'jsXRIR!% , 8#601)$
+MakeJsys( 'jsXSIR!% , 8#602)$
+MakeJsys( 'jsSNDIM , 8#750)$
+MakeJsys( 'jsRCVIM , 8#751)$
+MakeJsys( 'jsASNSQ , 8#752)$
+MakeJsys( 'jsRELSQ , 8#753)$
+MakeJsys( 'jsTHIBR , 8#770)$
+MakeJsys( 'jsTWAKE , 8#771)$
+MakeJsys( 'jsMRPAC , 8#772)$
+MakeJsys( 'jsSETPV , 8#773)$
+MakeJsys( 'jsMTALN , 8#774)$
+MakeJsys( 'jsTTMSG , 8#775)$
+
+End$
ADDED psl-1983/3-1/util/20/monsym.build
Index: psl-1983/3-1/util/20/monsym.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/monsym.build
@@ -0,0 +1,1 @@
+in "monsym.red"$
ADDED psl-1983/3-1/util/20/monsym.red
Index: psl-1983/3-1/util/20/monsym.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/monsym.red
@@ -0,0 +1,323 @@
+%
+% MONSYM.RED - Support for Dec-20 system LAP code
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 19 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+CompileTime <<
+
+macro procedure DefineJSYSRangeFrom X;
+begin scalar Start, L;
+ Start := Sub1 second X;
+ L := third X;
+ return ('progn
+ . for each Name in second L collect
+ list('progn, list('put, MkQuote Name,'(quote JSYSValue),
+ Start := Add1 Start),
+ list('put,MkQuote Name,
+ '(quote InstructionDepositFunction),
+ '(quote JSYSDeposit))));
+end;
+
+>>;
+
+lisp procedure JSYSDeposit X;
+<< if !*WritingFaslFile then UpdateBitTable(1, 0);
+ DepositAllFields(8#104, 0, get(car X, 'JSYSValue)) >>;
+
+flag('(ERJMP ERCAL), 'MC);
+
+lisp procedure ERJMP Address;
+ list list('jump, 8#16, Address);
+
+lisp procedure ERCAL Address;
+ list list('jump, 8#17, Address);
+
+DefineJSYSRangeFrom(1, '(
+ LOGIN
+ CRJOB
+ LGOUT
+ CACCT
+ EFACT
+ SMON
+ TMON
+ GETAB
+ ERSTR
+ GETER
+ GJINF
+ TIME
+ RUNTM
+ SYSGT
+ GNJFN
+ GTJFN
+ OPENF
+ CLOSF
+ RLJFN
+ GTSTS
+ STSTS
+ DELF
+ SFPTR
+ JFNS
+ FFFFP
+ RDDIR
+ CPRTF
+ CLZFF
+ RNAMF
+ SIZEF
+ GACTF
+ STDIR
+ DIRST
+ BKJFN
+ RFPTR
+ CNDIR
+ RFBSZ
+ SFBSZ
+ SWJFN
+ BIN
+ BOUT
+ SIN
+ SOUT
+ RIN
+ ROUT
+ PMAP
+ RPACS
+ SPACS
+ RMAP
+ SACTF
+ GTFDB
+ CHFDB
+ DUMPI
+ DUMPO
+ DELDF
+ ASND
+ RELD
+ CSYNO
+ PBIN
+ PBOUT
+ PSIN
+ PSOUT
+ MTOPR
+ CFIBF
+ CFOBF
+ SIBE
+ SOBE
+ DOBE
+ GTABS
+ STABS
+ RFMOD
+ SFMOD
+ RFPOS
+ RFCOC
+ SFCOC
+ STI
+ DTACH
+ ATACH
+ DVCHR
+ STDEV
+ DEVST
+ MOUNT
+ DSMNT
+ INIDR
+ SIR
+ EIR
+ SKPIR
+ DIR
+ AIC
+ IIC
+ DIC
+ RCM
+ RWM
+ DEBRK
+ ATI
+ DTI
+ CIS
+ SIRCM
+ RIRCM
+ RIR
+ GDSTS
+ SDSTS
+ RESET
+ RPCAP
+ EPCAP
+ CFORK
+ KFORK
+ FFORK
+ RFORK
+ RFSTS
+ SFORK
+ SFACS
+ RFACS
+ HFORK
+ WFORK
+ GFRKH
+ RFRKH
+ GFRKS
+ DISMS
+ HALTF
+ GTRPW
+ GTRPI
+ RTIW
+ STIW
+ SOBF
+ RWSET
+ GETNM
+ GET
+ SFRKV
+ SAVE
+ SSAVE
+ SEVEC
+ GEVEC
+ GPJFN
+ SPJFN
+ SETNM
+ FFUFP
+ DIBE
+ FDFRE
+ GDSKC
+ LITES
+ TLINK
+ STPAR
+ ODTIM
+ IDTIM
+ ODCNV
+ IDCNV
+ NOUT
+ NIN
+ STAD
+ GTAD
+ ODTNC
+ IDTNC
+ FLIN
+ FLOUT
+ DFIN
+ DFOUT
+));
+
+DefineJSYSRangeFrom(160, '(
+ CRDIR
+ GTDIR
+ DSKOP
+ SPRIW
+ DSKAS
+ SJPRI
+ STO
+ ARCF
+));
+
+%define(jsASNDP,8%260) # NOT IMPLEMENTED
+%define(jsRELDP,8%261) # NOT IMPLEMENTED
+%define(jsASNDC,8%262) # NOT IMPLEMENTED
+%define(jsRELDC,8%263) # NOT IMPLEMENTED
+%define(jsSTRDP,8%264) # NOT IMPLEMENTED
+%define(jsSTPDP,8%265) # NOT IMPLEMENTED
+%define(jsSTSDP,8%266) # NOT IMPLEMENTED
+%define(jsRDSDP,8%267) # NOT IMPLEMENTED
+%define(jsWATDP,8%270) # NOT IMPLEMENTED
+
+DefineJSYSRangeFrom(188, '(
+ ATNVT
+ CVSKT
+ CVHST
+ FLHST
+ GCVEC
+ SCVEC
+ STTYP
+ GTTYP
+ BPT
+ GTDAL
+ WAIT
+ HSYS
+ USRIO
+ PEEK
+ MSFRK
+ ESOUT
+ SPLFK
+ ADVIS
+ JOBTM
+ DELNF
+ SWTCH
+ TFORK
+ RTFRK
+ UTFRK
+));
+
+DefineJSYSRangeFrom(214, '(
+ OPRFN
+ CGRP
+ VACCT
+ GDACC
+ ATGRP
+ GACTJ
+ GPSGN
+));
+
+DefineJSYSRangeFrom(320, '(
+ RSCAN
+ HPTIM
+ CRLNM
+ INLNM
+ LNMST
+ RDTXT
+ SETSN
+ GETJI
+ MSEND
+ MRECV
+ MUTIL
+ ENQ
+ DEQ
+ ENQC
+ SNOOP
+ SPOOL
+ ALLOC
+ CHKAC
+ TIMER
+ RDTTY
+ TEXTI
+ UFPGS
+ SFPOS
+ SYERR
+ DIAG
+ SINR
+ SOUTR
+ RFTAD
+ SFTAD
+ TBDEL
+ TBADD
+ TBLUK
+ STCMP
+ SETJB
+ GDVEC
+ SDVEC
+ COMND
+ PRARG
+ GACCT
+ LPINI
+ GFUST
+ SFUST
+ ACCES
+ RCDIR
+ RCUSR
+));
+
+DefineJSYSRangeFrom(488, '(
+ SNDIM
+ RCVIM
+ ASNSQ
+ RELSQ
+));
+
+DefineJSYSRangeFrom(504, '(
+ THIBR
+ TWAKE
+ MRPAC
+ SETPV
+ MTALN
+ TTMSG
+));
+
+END;
ADDED psl-1983/3-1/util/20/output-stream.sl
Index: psl-1983/3-1/util/20/output-stream.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/output-stream.sl
@@ -0,0 +1,263 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Output-Stream.SL (TOPS-20 Version) - File Output Stream Objects
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 29 July 1982
+%
+% This package is 6.7 times faster than the standard unbuffered I/O.
+% (Using message passing, it is only 1.9 times faster.)
+%
+% Note: this code will only run COMPILED.
+%
+% See TESTING code at the end of this file for examples of use.
+% Be sure to include "(CompileTime (load objects))" at the beginning
+% of any file that uses this package.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-vectors fast-strings))
+(BothTimes (load objects jsys))
+
+(de attempt-to-open-output (file-name)
+ (let ((p (ErrorSet (list 'open-output file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de attempt-to-open-append (file-name)
+ (let ((p (ErrorSet (list 'open-append file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de open-output (file-name)
+ (let ((s (make-instance 'output-stream)))
+ (=> s open file-name)
+ s))
+
+(de open-append (file-name)
+ (let ((s (make-instance 'output-stream)))
+ (=> s open-append file-name)
+ s))
+
+(defconst FILE-BUFFER-SIZE #.(* 5 512))
+
+(defflavor output-stream ((jfn NIL) % TOPS-20 file number
+ ptr % "pointer" to next free slot in buffer
+ file-name % full name of actual file
+ buffer % output buffer
+ )
+ ()
+ (gettable-instance-variables file-name)
+ )
+
+(CompileTime (put 'SOUT 'OpenCode '((jsys 43) (move (reg 1) (reg 3)))))
+(CompileTime (put 'CLOSF 'OpenCode '((jsys 18) (move (reg 1) (reg 1)))))
+
+(defmethod (output-stream putc) (ch)
+
+ % Append the character CH to the file. Line termination is indicated by
+ % writing a single NEWLINE (LF) character.
+
+ % Implementation note: It was determined by experiment that the PSL
+ % compiler produces much better code if there are no function calls other
+ % than tail-recursive ones. That's why this function is written the way
+ % it is.
+
+ (if (= ch #\LF)
+ (=> self put-newline)
+ % Otherwise:
+ (string-store buffer ptr ch)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ ))
+
+(defmethod (output-stream put-newline) ()
+
+ % Output a line terminator.
+
+ (string-store buffer ptr #\CR)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ (string-store buffer ptr #\LF)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ )
+
+(defmethod (output-stream putc-image) (ch)
+
+ % Append the character CH to the file. No translation of LF character.
+
+ (string-store buffer ptr ch)
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ )
+
+(defmethod (output-stream puts) (str)
+
+ % Write string to output stream (highly optimized!)
+
+ (let ((i 0)
+ (high (string-upper-bound str))
+ )
+ (while (<= i high)
+ (string-store buffer ptr (string-fetch str i))
+ (if (>= (setf ptr (+ ptr 1)) (const FILE-BUFFER-SIZE))
+ (=> self flush))
+ (setf i (+ i 1))
+ )))
+
+(defmethod (output-stream putl) (str)
+
+ % Write string followed by line terminator to output stream.
+
+ (=> self puts str)
+ (=> self put-newline)
+ )
+
+(defmethod (output-stream open) (name-of-file)
+
+ % Open the specified file for output via SELF. If the file cannot
+ % be opened, a Continuable Error is generated.
+
+ (if jfn (=> self close))
+ (setf jfn (Dec20Open name-of-file
+ (int2sys 2#100000000000000001000000000000000000)
+ (int2sys 2#000111000000000000001000000000000000)
+ ))
+ (if (= jfn 0) (setf jfn NIL))
+ (if (null JFN)
+ (=> self open
+ (ContinuableError 0
+ (BldMsg "Unable to Open '%w' for Output" name-of-file)
+ name-of-file))
+ (=> self &fixup)
+ ))
+
+(defmethod (output-stream open-append) (name-of-file)
+
+ % Open the specified file for append output via SELF. If the file cannot
+ % be opened, a Continuable Error is generated.
+
+ (if jfn (=> self close))
+ (setf jfn (Dec20Open name-of-file
+ (int2sys 2#000000000000000001000000000000000000)
+ (int2sys 2#000111000000000000000010000000000000)
+ ))
+ (if (= jfn 0) (setf jfn NIL))
+ (if (null JFN)
+ (=> self open-append
+ (ContinuableError 0
+ (BldMsg "Unable to Open '%w' for Append" name-of-file)
+ name-of-file))
+ (=> self &fixup)
+ ))
+
+(defmethod (output-stream attach-to-jfn) (new-jfn)
+
+ % Attach the output-stream to the specified JFN.
+
+ (if jfn (=> self close))
+ (setf jfn new-jfn)
+ (=> self &fixup)
+ )
+
+(defmethod (output-stream &fixup) ()
+ % Internal method for initializing instance variables after setting JFN.
+
+ (setf buffer (make-string (const FILE-BUFFER-SIZE) #\space))
+ % It is necessary to clear out the low-order bit, lest some programs
+ % think we are writing "line numbers" (what a crock!).
+ (for (from i 0 (- (/ (const FILE-BUFFER-SIZE) 5) 1))
+ (do (vector-store buffer i 0)))
+ (setf ptr 0)
+ (setf file-name (jfn-truename jfn))
+ )
+
+(defmethod (output-stream close) ()
+ (when jfn
+ (=> self flush)
+ (CLOSF jfn)
+ (setf jfn NIL)
+ (setf buffer NIL)
+ ))
+
+(defmethod (output-stream flush) ()
+ (when (> ptr 0)
+ (SOUT jfn (jconv buffer) (- ptr))
+ (setf ptr 0)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% TESTING CODE
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (setf time-output-test-string "This is a line of text for testing."))
+
+(CommentOutCode (progn
+
+(de time-buffered-output (n-lines)
+ % This is the FAST way to do buffered output.
+
+ (setf start-time (time))
+ (setf s (open-output "test.output"))
+ (for (from i 1 n-lines 1)
+ (do (for (in ch '#.(String2List time-output-test-string))
+ (do (output-stream$putc s ch))
+ )
+ (output-stream$put-newline s)
+ ))
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-buffered-output-1 (n-lines)
+ % This is the SLOW (but GENERAL) way to do buffered output.
+
+ (setf start-time (time))
+ (setf s (open-output "test.output"))
+ (for (from i 1 n-lines 1)
+ (do (for (in ch '#.(String2List time-output-test-string))
+ (do (=> s putc ch))
+ )
+ (=> s put-newline)
+ ))
+ (=> s close)
+ (- (time) start-time)
+ )
+
+(de time-standard-output (n-lines)
+ (setf start-time (time))
+ (setf chan (open "test.output" 'OUTPUT))
+ (for (from i 1 n-lines 1)
+ (do (for (in ch '#.(String2List time-output-test-string))
+ (do (ChannelWriteChar chan ch))
+ )
+ (ChannelWriteChar chan #\LF)
+ ))
+ (close chan)
+ (- (time) start-time)
+ )
+
+(de time-output (n-lines)
+ (list
+ (time-buffered-output-string n-lines)
+ (time-buffered-output n-lines)
+ (time-buffered-output-1 n-lines)
+ (time-standard-output n-lines)
+ ))
+
+(de time-buffered-output-string (n-lines)
+ % This is the FAST way to do buffered output from strings.
+
+ (setf start-time (time))
+ (setf s (open-output "test.output"))
+ (for (from i 1 n-lines 1)
+ (do (output-stream$putl s #.time-output-test-string))
+ )
+ (=> s close)
+ (- (time) start-time)
+ )
+
+)) % End CommentOutCode
ADDED psl-1983/3-1/util/20/pathnames.sl
Index: psl-1983/3-1/util/20/pathnames.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/pathnames.sl
@@ -0,0 +1,352 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PathNames.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 14 September 1982
+% Revised: 9 February 1983
+%
+% DEC-20 implementation of some Common Lisp pathname functions.
+%
+% 9-Feb-83 Alan Snyder
+% Revise conversion to string to omit the dot if there is no type or version.
+% Revise conversion from string to interpret trailing dot as specifying
+% an empty type or version. Change home-directory to specify PS:
+% Fix bug in make-pathname. Convert to using fast-strings stuff.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-vector fast-strings))
+(BothTimes (load objects))
+
+(when (funboundp 'string2integer)
+ (de string2integer (s)
+ (makestringintolispinteger s 10 1)
+ ))
+
+% The following function is an NEXPR: be sure this module is loaded at
+% compile-time if you use this function in code to be compiled!
+
+(dn make-pathname (keyword-arg-list)
+ (let ((pn (make-instance 'pathname)))
+ (while (not (null keyword-arg-list))
+ (let ((keyword (car keyword-arg-list)))
+ (setf keyword-arg-list (cdr keyword-arg-list))
+ (cond (keyword-arg-list
+ (let ((value (car keyword-arg-list)))
+ (setf keyword-arg-list (cdr keyword-arg-list))
+ (selectq keyword
+ (host (=> pn set-host value))
+ (device (=> pn set-device value))
+ (directory (=> pn set-directory value))
+ (name (=> pn set-name value))
+ (type (=> pn set-type value))
+ (version (=> pn set-version value))
+ ))))))
+ pn
+ ))
+
+(de pathname-host (pn)
+ (=> (pathname pn) host))
+
+(de pathname-device (pn)
+ (=> (pathname pn) device))
+
+(de pathname-directory (pn)
+ (=> (pathname pn) directory))
+
+(de pathname-name (pn)
+ (=> (pathname pn) name))
+
+(de pathname-type (pn)
+ (=> (pathname pn) type))
+
+(de pathname-version (pn)
+ (=> (pathname pn) version))
+
+(de PathnameP (x)
+ (and (VectorP x) (eq (getv x 0) 'pathname)))
+
+(de StreamP (x)
+ (and (VectorP x) (object-get-handler-quietly x 'file-name)))
+
+(de truename (x) (pathname x))
+
+(de pathname (x)
+ (cond
+ ((PathnameP x) x)
+ ((StringP x) (string-to-pathname x))
+ ((IdP x) (string-to-pathname (id2string x)))
+ ((StreamP x) (string-to-pathname (=> x file-name)))
+ (t (TypeError x "PathName" "convertible to a pathname"))
+ ))
+
+(de namestring (x)
+ (setf x (pathname x))
+ (let ((dev (pathname-device x))
+ (dir (pathname-directory x))
+ (name (pathname-name x))
+ (type (pathname-type x))
+ (vers (pathname-version x))
+ )
+ (string-concat
+ (if dev (string-concat (pathname-field-to-string dev) ":") "")
+ (if dir (string-concat "<" (pathname-field-to-string dir) ">") "")
+ (if name (pathname-field-to-string name) "")
+ (if (or (not (pathname-empty-field? type))
+ (not (pathname-empty-field? vers)))
+ (string-concat "." (pathname-field-to-string type)) "")
+ (if (not (pathname-empty-field? vers))
+ (string-concat "." (pathname-field-to-string vers)) "")
+ )))
+
+(de file-namestring (x)
+ (setf x (pathname x))
+ (let ((name (pathname-name x))
+ (type (pathname-type x))
+ (vers (pathname-version x))
+ )
+ (string-concat
+ (if name (pathname-field-to-string name) "")
+ (if type (string-concat "." (pathname-field-to-string type)) "")
+ (if vers (string-concat "." (pathname-field-to-string vers)) "")
+ )))
+
+(de directory-namestring (x)
+ (setf x (pathname x))
+ (let ((dir (pathname-directory x))
+ )
+ (if dir (string-concat "<" (pathname-field-to-string dir) ">") "")
+ ))
+
+(de user-homedir-pathname ()
+ (let ((pn (make-instance 'pathname))
+ (user-number (Jsys1 0 0 0 0 (const jsGJINF)))
+ (dir-name (MkString 100 (char space)))
+ )
+ (Jsys1 dir-name user-number 0 0 (const jsDIRST))
+ (setf dir-name (recopystringtonull dir-name))
+ (=> pn set-device "PS")
+ (=> pn set-directory dir-name)
+ pn
+ ))
+
+(de init-file-pathname (program-name)
+ (let ((pn (user-homedir-pathname)))
+ (=> pn set-name program-name)
+ (=> pn set-type "INIT")
+ pn
+ ))
+
+(de merge-pathname-defaults (pn defaults-pn default-type default-version)
+ (setf pn (pathname pn))
+ (setf defaults-pn (pathname defaults-pn))
+ (setf pn (CopyVector pn))
+ (if (not (=> pn host))
+ (=> pn set-host (=> defaults-pn host)))
+ (cond ((not (=> pn device))
+ (=> pn set-device (=> defaults-pn device))
+ (if (not (=> pn directory))
+ (=> pn set-directory (=> defaults-pn directory)))
+ ))
+ (cond ((not (=> pn name))
+ (=> pn set-name (=> defaults-pn name))
+ (if (not (=> pn type)) (=> pn set-type (=> defaults-pn type)))
+ (if (not (=> pn version)) (=> pn set-version (=> defaults-pn version)))
+ ))
+ (if (not (=> pn type))
+ (=> pn set-type default-type))
+ (if (not (=> pn version))
+ (=> pn set-version default-version))
+ pn
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal functions:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defflavor pathname
+ ((host "LOCAL")
+ (device NIL)
+ (directory NIL)
+ (name NIL)
+ (type NIL)
+ (version NIL)
+ )
+ ()
+ gettable-instance-variables
+ )
+
+(defmethod (pathname set-host) (new-host)
+ (cond ((StringP new-host) (setf host (string-upcase new-host)))
+ ((and (ListP new-host)
+ (not (null new-host))
+ (StringP (car new-host)))
+ (setf host (string-upcase (car new-host))))
+ (t (StdError "Invalid host specified for pathname."))
+ ))
+
+(defmethod (pathname set-device) (new-device)
+ (cond ((StringP new-device) (setf device (string-upcase new-device)))
+ ((null new-device) (setf device NIL))
+ ((and (ListP new-device)
+ (StringP (car new-device)))
+ (setf device (string-upcase (car new-device))))
+ ((and (IdP new-device)
+ (or (eq new-device 'unspecific)
+ (eq new-device 'wild)))
+ (setf device new-device))
+ (t (StdError "Invalid device specified for pathname."))
+ ))
+
+(defmethod (pathname set-directory) (new-directory)
+ (cond ((StringP new-directory) (setf directory (string-upcase new-directory)))
+ ((null new-directory) (setf directory NIL))
+ ((and (ListP new-directory)
+ (StringP (car new-directory)))
+ (setf directory (string-upcase (car new-directory))))
+ ((and (IdP new-directory)
+ (or (eq new-directory 'unspecific)
+ (eq new-directory 'wild)))
+ (setf directory new-directory))
+ (t (StdError "Invalid directory specified for pathname."))
+ ))
+
+(defmethod (pathname set-name) (new-name)
+ (cond ((StringP new-name) (setf name (string-upcase new-name)))
+ ((null new-name) (setf name NIL))
+ ((and (ListP new-name)
+ (StringP (car new-name)))
+ (setf name (string-upcase (car new-name))))
+ ((and (IdP new-name)
+ (or (eq new-name 'unspecific)
+ (eq new-name 'wild)))
+ (setf name new-name))
+ (t (StdError "Invalid name specified for pathname."))
+ ))
+
+(defmethod (pathname set-type) (new-type)
+ (cond ((StringP new-type) (setf type (string-upcase new-type)))
+ ((null new-type) (setf type NIL))
+ ((and (IdP new-type)
+ (or (eq new-type 'unspecific)
+ (eq new-type 'wild)))
+ (setf type new-type))
+ (t (StdError "Invalid type specified for pathname."))
+ ))
+
+(defmethod (pathname set-version) (new-version)
+ (cond ((and (FixP new-version) (>= new-version 0))
+ (setf version new-version))
+ ((null new-version) (setf version NIL))
+ ((and (IdP new-version)
+ (or (eq new-version 'unspecific)
+ (eq new-version 'wild)
+ (eq new-version 'newest)
+ (eq new-version 'oldest)
+ ))
+ (setf version new-version))
+ (t (StdError "Invalid version specified for pathname."))
+ ))
+
+(de string-to-pathname (s)
+ (let ((pn (make-instance 'pathname))
+ (i 0)
+ j
+ ch
+ (len (string-length s))
+ (name-count 0)
+ field
+ )
+ (while (< i len)
+ (setf j (pathname-bite s i))
+ (selectq
+ (string-fetch s (- j 1))
+ (#\: (=> pn set-device (pathname-field-from-string
+ (substring s i (- j 1)))))
+ (#\> (=> pn set-directory (pathname-field-from-string
+ (substring s (+ i 1) (- j 1)))))
+ (#\. (setf name-count (+ name-count 1))
+ (setf field (substring s i (- j 1)))
+ (selectq
+ name-count
+ (1 (=> pn set-name (pathname-field-from-string field))
+ (if (>= j len) (=> pn set-type 'UNSPECIFIC))
+ )
+ (2 (=> pn set-type (pathname-field-from-string field))
+ (if (>= j len) (=> pn set-version 'UNSPECIFIC))
+ )
+ (3 (=> pn set-version (pathname-version-from-string field)))
+ ))
+ (t (setf name-count (+ name-count 1))
+ (setf field (substring s i j))
+ (selectq
+ name-count
+ (1 (=> pn set-name (pathname-field-from-string field)))
+ (2 (=> pn set-type (pathname-field-from-string field)))
+ (3 (=> pn set-version (pathname-version-from-string field)))
+ )))
+ (setf i j)
+ )
+ pn
+ ))
+
+(de pathname-bite (pn i)
+ (let* ((len (string-length pn))
+ (ch (string-fetch pn i))
+ )
+ (cond ((= ch #\<)
+ (setf i (+ i 1))
+ (while (< i len)
+ (setf ch (string-fetch pn i))
+ (setf i (+ i 1))
+ (if (= ch #\>) (exit))
+ )
+ )
+ (t
+ (while (< i len)
+ (setf ch (string-fetch pn i))
+ (setf i (+ i 1))
+ (if (= ch #\:) (exit))
+ (if (= ch #\.) (exit))
+ )))
+ i
+ ))
+
+(de pathname-field-from-string (s)
+ (cond ((StringP s)
+ (cond ((string-empty? s) 'UNSPECIFIC)
+ ((string= s "*") 'WILD)
+ (t s)
+ ))
+ (t s)))
+
+(de pathname-version-from-string (s)
+ (cond ((StringP s)
+ (cond ((string-empty? s) NIL)
+ ((string= s "-2") 'OLDEST)
+ ((string= s "0") 'NEWEST)
+ ((string= s "*") 'WILD)
+ ((string-is-integer s) (string2integer s))
+ (t s)
+ ))
+ (t s)))
+
+(de pathname-empty-field? (x)
+ (string-empty? (pathname-field-to-string x))
+ )
+
+(de pathname-field-to-string (x)
+ (cond ((StringP x) x)
+ ((eq x 'OLDEST) "-2")
+ ((eq x 'NEWEST) "0")
+ ((eq x 'UNSPECIFIC) "")
+ ((eq x 'WILD) "*")
+ ((null x) "")
+ (t (BldMsg "%w" x))))
+
+(de string-is-integer (s)
+ (for (from i 0 (string-upper-bound s))
+ (always (DigitP (string-fetch s i)))
+ ))
ADDED psl-1983/3-1/util/20/processor-time.sl
Index: psl-1983/3-1/util/20/processor-time.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/processor-time.sl
@@ -0,0 +1,16 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Processor-Time.SL (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 22 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (put 'hptim 'OpenCode '((jsys 8#501) (jfcl))))
+
+(de processor-time ()
+ % Return accumulated processor time for the current process in microseconds.
+ (WTimes2 (hptim 1) 10)
+ )
ADDED psl-1983/3-1/util/20/wait.sl
Index: psl-1983/3-1/util/20/wait.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/wait.sl
@@ -0,0 +1,28 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Wait.SL - Wait Primitive (TOPS-20 Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int))
+(BothTimes (load jsys))
+
+(de wait-timeout (f n-60ths)
+
+ % Return when either of two conditions are met: (1) The function F (of no
+ % arguments) returns non-NIL; (2) The specified elapsed time (in units of
+ % 1/60th second) has elapsed. Don't waste CPU cycles! Return the last
+ % value returned by F (which is always invoked at least once).
+
+ (let (result)
+ (while (and (not (setf result (apply f nil)))
+ (> n-60ths 0))
+ (Jsys0 250 0 0 0 (const jsDISMS))
+ (setf n-60ths (- n-60ths 15))
+ )
+ result
+ ))
ADDED psl-1983/3-1/util/20/whereis.red
Index: psl-1983/3-1/util/20/whereis.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/20/whereis.red
@@ -0,0 +1,33 @@
+% Scan the *.ins files
+% for a special Token
+Loadtime Load DIR!-STUFF$
+
+InsList!*:=Vector2List GetCleanDir "<psl.util.ins>*.ins"$
+
+Procedure ShowAllIns();
+Begin scalar R,C,OldC;
+ For each F in InsList!* do
+ <<C:=OPEN(F,'input);
+ OldC:=RDS C; R:=READ(); RDS OldC;
+ Close C;
+ Print F;
+ Print R>>;
+End;
+
+Procedure LoadAllIns();
+Begin scalar R,C,OldC;
+ For each F in InsList!* do
+ <<C:=OPEN(F,'input);
+ OldC:=RDS C; R:=READ(); RDS OldC;
+ Close C;
+ For Each x in R do Put(x,'DefinedIn,F);
+ PrintF(" %r loaded %n",F)>>
+End;
+
+Procedure WhereIs X;
+ Begin scalar y;
+ if(y:=get(x,'DefinedIn)) then Return y;
+ if getd x then return "In The Kernel ";
+ return NIL;
+ end;
+
ADDED psl-1983/3-1/util/addr2id.build
Index: psl-1983/3-1/util/addr2id.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/addr2id.build
@@ -0,0 +1,1 @@
+in "addr2id.sl"$
ADDED psl-1983/3-1/util/addr2id.sl
Index: psl-1983/3-1/util/addr2id.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/addr2id.sl
@@ -0,0 +1,28 @@
+%
+% ADDR2ID.RED - Attempt to find out what function an address is in
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+(compiletime (load syslisp useful))
+
+(compiletime (fluid '(code-address* closest-address* closest-symbol*)))
+
+(de code-address-to-symbol (code-address*)
+ (let ((closest-symbol* ()) (closest-address* 0))
+ (mapobl #'(lambda (symbol)
+ (when (fcodep symbol)
+ (let ((address (inf (getfcodepointer symbol))))
+ (when (and (ileq address
+ code-address*)
+ (igreaterp address
+ closest-address*))
+ (setq closest-address*
+ address)
+ (setq closest-symbol* symbol))))))
+ closest-symbol*))
ADDED psl-1983/3-1/util/arith.build
Index: psl-1983/3-1/util/arith.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/arith.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp;
+in "test-arith.red"$
ADDED psl-1983/3-1/util/association.build
Index: psl-1983/3-1/util/association.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/association.build
@@ -0,0 +1,1 @@
+in "association.sl"$
ADDED psl-1983/3-1/util/association.sl
Index: psl-1983/3-1/util/association.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/association.sl
@@ -0,0 +1,53 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Association.SL - Mutable Association Lists
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 21 July 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common))
+
+(defun association-create ()
+ % Create an empty association list (that is mutable!).
+ (list (cons '*DUMMY* '*DUMMY*)))
+
+(defun association-bind (alist indicator value)
+ % Change or extend the ALIST to map INDICATOR to VALUE.
+ (let ((pair (atsoc indicator alist)))
+ (if pair
+ (rplacd pair value)
+ % ELSE
+ (aconc alist (cons indicator value))
+ (setq pair (car alist))
+ (if (and (eq (car pair) '*DUMMY*)
+ (eq (cdr pair) '*DUMMY*))
+ (progn (rplacw pair (cadr alist)) (rplacd alist (cddr alist)))
+ )
+ )))
+
+(defun association-lookup (alist indicator)
+ % Return the value attached to the given indicator (using EQ for
+ % comparing indicators). If there is no attached value, return NIL.
+
+ (let ((pair (atsoc indicator alist)))
+ (if pair (cdr pair) NIL)))
+
+(defmacro map-over-association ((alist indicator-var value-var) . body)
+ % Execute the body once for each indicator in the alist, binding
+ % the specified indicator-var to the indicator and the specified
+ % value-var to the attached value. Return the result of the body
+ % (implicit PROGN).
+
+ `(for (in ***PAIR*** ,alist)
+ (with ***RESULT***)
+ (do (let ((,indicator-var (car ***PAIR***))
+ (,value-var (cdr ***PAIR***))
+ )
+ (cond ((not (eq ,indicator-var '*DUMMY*))
+ (setf ***RESULT*** (progn ,@body))
+ ))))
+ (returns ***RESULT***)
+ ))
ADDED psl-1983/3-1/util/backquote.sl
Index: psl-1983/3-1/util/backquote.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/backquote.sl
@@ -0,0 +1,144 @@
+% BACKQUOTE.SL - tool for building partially quoted lists
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% Backquote is similar to MACLISP's ` (that's backwards!) mechanism. In
+% essence the body of the backquote is quoted, except for those things
+% surrounded by unquote, which are evaluated at macro expansion time. UNQUOTEL
+% splices in a list, and unquoted splices in a list destructively. Mostly
+% useful for defining macro's.
+
+(dm backquote (u) (backquote-form (cadr u)))
+
+(de backquote-form (u)
+ (cond
+ ((vectorp u) (backquote-vector u))
+ ((atom u)
+ (cond
+ ((and (idp u) (not (memq u '(t nil)))) (mkquote u))
+ (t u)))
+ ((eq (car u) 'unquote) (cadr u))
+ ((eq (car u) 'backquote) (backquote-form (backquote-form (cadr u))))
+ ((memq (car u) '(unquotel unquoted))
+ (ContinuableError 99 (BldMsg "%r can't be spliced in here." u)) u)
+ ((eqcar (car u) 'unquotel)
+ (cond
+ ((cdr u) (list 'append (cadar u) (backquote-form (cdr u))))
+ (t (cadar u))))
+ ((eqcar (car u) 'unquoted)
+ (cond
+ ((cdr u) (list 'nconc (cadar u) (backquote-form (cdr u))))
+ (t (cadar u))))
+ (t (backquote-list u))))
+
+(de backquote-vector (u)
+ ((lambda (n rslt all-quoted) % can't use LET 'cause it ain't defined yet
+ ((lambda (i)
+ (while (not (minusp i)) % can't use FOR or DO for the same reason
+ ((lambda (x)
+ (setq all-quoted (and all-quoted (backquote-constantp x)))
+ (setq rslt (cons x rslt)))
+ (backquote-form (getv u i)))
+ (setq i (sub1 i))))
+ n)
+ (cond
+ (all-quoted
+ ((lambda (i vec)
+ (while (not (greaterp i n))
+ (putv vec i (backquote-constant-value (car rslt)))
+ (setq rslt (cdr rslt))
+ (setq i (add1 i)))
+ vec)
+ 0
+ (mkvect n)))
+ (t (cons 'vector rslt))))
+ (upbv u)
+ nil
+ t))
+
+(de backquote-list (u)
+ ((lambda (car-u cdr-u) % can't use LET 'cause it ain't defined yet
+ (cond
+ ((null cdr-u)
+ (cond
+ ((backquote-constantp car-u)
+ (list 'quoted-list (backquote-constant-value car-u)))
+ (t (list 'list car-u))))
+ ((constantp cdr-u)
+ (cond
+ ((backquote-constantp car-u)
+ (list 'quoted-list* (backquote-constant-value car-u) cdr-u))
+ (t (list 'list* car-u cdr-u))))
+ ((and (pairp cdr-u) (memq (car cdr-u) '(list list*)))
+ (cons (car cdr-u) (cons car-u (cdr cdr-u))))
+ ((and
+ (pairp cdr-u)
+ (memq (car cdr-u) '(quoted-list quoted-list*)))
+ (cond
+ ((backquote-constantp car-u)
+ (cons
+ (car cdr-u)
+ (cons (backquote-constant-value car-u) (cdr cdr-u))))
+ (t (list
+ 'list*
+ car-u
+ (mkquote (backquote-constant-value cdr-u))))))
+ ((eqcar cdr-u 'quote)
+ (cond
+ ((backquote-constantp car-u)
+ (list
+ 'quoted-list*
+ (backquote-constant-value car-u)
+ (cadr cdr-u)))
+ (t (list 'list* car-u cdr-u))))
+ (t (list 'list* car-u cdr-u))))
+ (backquote-form (car u))
+ (backquote-form (cdr u))))
+
+(de backquote-constantp (u)
+ (cond
+ ((pairp u) (memq (car u) '(quote quoted-list quoted-list*)))
+ (t (not (idp u)))))
+
+(de backquote-constant-value (x)
+ (cond
+ ((eqcar x 'quote) (cadr x))
+ ((eqcar x 'quoted-list) (cdr x))
+ ((eqcar x 'quoted-list*)
+ (cadr (apply 'quoted-list* (list x))))
+ (t x)))
+
+% The following, while possibly useful in themselves, are mostly included
+% for use by backquote and friends.
+
+(dm quoted-list (u) (mkquote (cdr u)))
+
+(dm list* (u) (expand (cdr u) 'cons))
+
+(dm quoted-list* (u)
+ (cond
+ ((pairp (cdr u))
+ (setq u (reverse (cdr u)))
+ ((lambda (a)
+ (foreach elem in (cdr u) do
+ (setq a (cons elem a)))
+ (mkquote a))
+ (car u)))))
+% (t (error ... ?
+
+% Since unquote and friends should be completely stripped out by backquote,
+% make it an error to try and evaluate them. These could be much better...
+
+(dm unquote (u) (ContinuableError
+ 99
+ (BldMsg "%r is not within backquote." u)
+ u))
+
+(copyd 'unquotel 'unquote)
+
+(copyd 'unquoted 'unquote)
ADDED psl-1983/3-1/util/bigbig.build
Index: psl-1983/3-1/util/bigbig.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/bigbig.build
@@ -0,0 +1,8 @@
+% MLG, move BUILD info
+imports '(vector!-fix arith);
+
+Compiletime<<load syslisp;
+ Load Fast!-Vector;
+ load inum;
+ load if!-system>>;
+in "bigbig.red"$
ADDED psl-1983/3-1/util/bigbig.red
Index: psl-1983/3-1/util/bigbig.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/bigbig.red
@@ -0,0 +1,835 @@
+% BIGBIG.RED - Vector based BIGNUM package with INUM operations
+% M. L. Griss & B Morrison
+% 25 June 1982.
+%
+% Revision log:
+% 20 Dec:
+% MLG, changed TrimBigNUM to TrimBigNum1 in BhardDivide
+
+% 14 Dec:
+% Changed by MLG to put LOAD and IMPORTS in BUILD file
+
+% A. C . Norman - adjstments to many routines!
+% in particular corrections to BHardDivide (case D6 utterly wrong),
+% and adjustments to BExpt (for performance) and all logical
+% operators (for treatment of negative inputs);
+% 31 August 1982:
+% Copyright (C) 1982, A. C. Norman, B. Morrison, M. Griss
+% ---------------------------------------------------------------
+
+% -----------------------
+% A bignum will be a VECTOR of Bigits: (digits in base BigBase):
+% [BIGPOS b1 ... bn] or [BIGNEG b1 ... bn]. BigZero is thus [BIGPOS]
+% All numbers are positive, with BIGNEG as 0 element to indicate negatives.
+
+Fluid '(BBase!* BBits!* LogicalBits!* WordHi!* WordLow!* Digit2Letter!*
+ FloatHi!* FloatLow!* SysHi!* SysLo!* Carry!* OutputBase!*);
+
+% --------------------------------------------------------------------------
+% --------------------------------------------------------------------------
+% Support functions:
+%
+% U, V, V1, V2 for arguments are Bignums. Other arguments are usually
+% fix/i-nums.
+
+lisp procedure setbits x;
+%
+% This function sets the globals for big bignum package.
+% "x" should be total # of bits per word.
+ <<BBits!*:=iquotient(isub1 x,2); % Total number of bits per word used.
+ BBase!*:=TwoPower BBits!*; % "Beta", where n=A0 + A1*beta + A2*(beta^2)...
+ WordHi!*:=BNum Isub1 BBase!*; % Highest value of Ai
+ WordLow!*:=BMinus WordHi!*; % Lowest value of Ai
+ LogicalBits!*:=ISub1 BBase!*; % Used in LAnd,Lor, etc.
+ SysHi!*:=bsub1 btwopower isub1 x; % Largest representable Syslisp integer.
+ SysLo!*:=BMinus BAdd1 SysHi!*; % Smallest representable Syslisp integer.
+ BBase!*>>;
+
+lisp procedure BignumP (V);
+ VectorP V and ((V[0] eq 'BIGPOS) or (V[0] eq 'BIGNEG));
+
+lisp procedure NonBigNumError(V,L);
+ StdError BldMsg(" Expect a BIGNUM in %r, given %p%n",L,V);
+
+lisp procedure BSize V;
+ (BignumP V and UpbV V) or 0;
+
+lisp procedure GtPOS N; % Creates a positive Bignum with N "Bigits".
+ Begin Scalar B;
+ B:=MkVect N;
+ IPutV(B,0,'BIGPOS);
+ Return B;
+ End;
+
+lisp procedure GtNeg N; % Creates a negative Bignum with N "Bigits".
+ Begin Scalar B;
+ B:=MkVect N;
+ IPutV(B,0,'BIGNEG);
+ Return B;
+ End;
+
+lisp procedure TrimBigNum V3; % Truncate trailing 0.
+ If Not BignumP V3 then NonBigNumError(V3,'TrimBigNum)
+ else TrimBigNum1(V3,BSize V3);
+
+lisp procedure TrimBigNum1(V3,L3);
+ % V3 is a bignum and L3 is the position in it of the highest
+ % possible non-zero digit. Truncate V3 to remove leading zeros,
+ % and if this leaves V3 totally zero make its sign positive;
+ Begin
+ While IGreaterP(L3,0) and IZeroP IGetV(V3,L3) do L3:=ISub1 L3;
+ If IZerop Bsize TruncateVector(V3,L3) then IPutV(V3,0,'BIGPOS);
+ return V3;
+ end;
+
+lisp procedure big2sys U;
+ if BLessP(U, SysLo!*) or BGreaterP(U, SysHi!*) then
+ Error(99,list(U," is too large to be a Syslisp integer for BIG2SYS"))
+ else begin scalar L,Sn,res,I;
+ L:=BSize U;
+ if IZeroP L then return 0;
+ Sn:=BMinusP U;
+ res:=IGetV(U,L);
+ I:=ISub1 L;
+ while not IZeroP I do <<res:=ITimes2(res, bbase!*);
+ res:=IPlus2(res, IGetV(U,I));
+ I:=ISub1 I>>;
+ if Sn then Res:=IMinus Res;
+ return Res;
+ end;
+
+lisp procedure TwoPower N; %fix/i-num 2**n
+ 2**n;
+
+lisp procedure BTwoPower N; % gives 2**n; n is fix/i-num; result BigNum
+ if not (fixp N or BignumP N) then NonIntegerError(N, 'BTwoPower)
+ else begin scalar quot, rem, V;
+ if bignump N then n:=big2sys n;
+ quot:=Quotient(N,Bbits!*);
+ rem:=Remainder(N,Bbits!*);
+ V:=GtPOS(IAdd1 quot);
+ IFor i:=1:quot do IPutV(v,i,0);
+ IPutV(V,IAdd1 quot,twopower rem);
+ return TrimBigNum1(V,IAdd1 quot);
+ end;
+
+lisp procedure BZeroP V1;
+ IZerop BSize V1 and not BMinusP V1;
+
+lisp procedure BOneP V1;
+ Not BMinusP V1 and IOneP (BSize V1) and IOneP IGetV(V1,1);
+
+lisp procedure BAbs V1;
+ if BMinusP V1 then BMinus V1 else V1;
+
+lisp procedure BMax(V1,V2);
+ if BGreaterP(V2,V1) then V2 else V1;
+
+lisp procedure BMin(V1,V2);
+ if BLessP(V2,V1) then V2 else V1;
+
+lisp procedure BExpt(V1,N); % V1 is Bignum, N is fix/i-num
+ if not fixp N then NonIntegerError(N,'BEXPT)
+ else if IZeroP N then int2B 1
+ else if IOneP N then V1
+ else if IMinusP N then BQuotient(int2B 1,BExpt(V1,IMinus N))
+ else begin scalar V2;
+ V2 := BExpt(V1,IQuotient(N,2));
+ if IZeroP IRemainder(N,2) then return BTimes2(V2,V2)
+ else return BTimes2(BTimes2(V2,V1),V2)
+ end;
+
+
+% ---------------------------------------
+% Logical Operations
+%
+% All take Bignum arguments
+
+
+lisp procedure BLOr(V1,V2);
+% The main body of the OR code is only obeyed when both arguments
+% are positive, and so the result will be positive;
+ if BMinusp V1 or BMinusp V2 then BLnot BLand(BLnot V1,BLnot V2)
+ else begin scalar L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ IF L2>L1 then <<L3:=L2; L2:=L1;L1:=L3;
+ V3:=V2; V2:=V1;V1:=V3>>;
+ V3:=GtPOS L1;
+ IFor I:=1:L2 do IPutV(V3,I,ILor(IGetV(V1,I),IGetV(V2,I)));
+ IFor I:=(IAdd1 L2):L1 do IPutV(V3,i,IGetV(V1,I));
+ Return V3
+ end;
+
+lisp procedure BLXor(V1,V2);
+% negative arguments are coped with using the identity
+% LXor(a,b) = LNot LXor(Lnot a,b) = LNor LXor(a,Lnot b);
+ begin scalar L1,L2,L3,V3,S;
+ if BMinusp V1 then << V1 := BLnot V1; S := t >>;
+ if BMinusp V2 then << V2 := BLnot V2; S := not S >>;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ IF L2>L1 then <<L3:=L2; L2:=L1;L1:=L3;
+ V3:=V2; V2:=V1;V1:=V3>>;
+ V3:=GtPOS L1;
+ IFor I:=1:L2 do IPutV(V3,I,ILXor(IGetV(V1,I),IGetV(V2,I)));
+ IFor I:=(IAdd1 L2):L1 do IPutV(V3,i,IGetV(V1,I));
+ V1:=TrimBigNum1(V3,L1);
+ if S then V1:=BLnot V1;
+ return V1
+ end;
+
+% Not Used Currently:
+%
+% lisp Procedure BLDiff(V1,V2);
+% ***** STILL NEEDS ADJUSTING WRT -VE ARGS *****
+% begin scalar V3,L1,L2;
+% L1:=BSize V1;
+% L2:=BSize V2;
+% V3:=GtPOS(max(L1,L2));
+% IFor i:=1:min(L1,L2) do
+% IPutV(V3,i,ILAnd(IGetV(V1,i),ILXor(LogicalBits!*,IGetV(V2,i))));
+% if IGreaterP(L1,L2) then IFor i:=(IAdd1 L2):L1 do IPutV(V3,i,IGetV(V1,i));
+% if IGreaterP(L2,L1) then IFor i:=(IAdd1 L1):L2 do IPutV(V3,i,0);
+% return TrimBigNum1(V3,max(L1,L2));
+% end;
+
+lisp procedure BLAnd(V1,V2);
+% If both args are -ve the result will be too. Otherwise result will
+% be positive;
+ if BMinusp V1 and BMinusp V2 then BLnot BLor(BLnot V1,BLnot v2)
+ else begin scalar L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ L3:=Min(L1,L2);
+ V3:=GtPOS L3;
+ if BMinusp V1 then
+ IFor I:=1:L3 do IPutV(V3,I,ILand(ILXor(Logicalbits!*,IGetV(V1,I)),
+ IGetV(V2,I)))
+ else if BMinusp V2 then
+ IFor I:=1:L3 do IPutV(V3,I,ILand(IGetV(V1,I),
+ ILXor(Logicalbits!*,IGetV(V2,I))))
+ else IFor I:=1:L3 do IPutV(V3,I,ILand(IGetV(V1,I),IGetV(V2,I)));
+ return TrimBigNum1(V3,L3);
+ End;
+
+lisp procedure BLNot(V1);
+ BMinus BSmallAdd(V1,1);
+
+lisp procedure BLShift(V1,V2);
+% This seems a grimly inefficient way of doing things given that
+% the representation of big numbers uses a base that is a power of 2.
+% However it will do for now;
+if BMinusP V2 then BQuotient(V1, BTwoPower BMinus V2)
+ else BTimes2(V1, BTwoPower V2);
+
+
+
+% -----------------------------------------
+% Arithmetic Functions:
+%
+% U, V, V1, V2 are Bignum arguments.
+
+lisp procedure BMinus V1; % Negates V1.
+ if BZeroP V1 then V1
+ else begin scalar L1,V2;
+ L1:=BSize V1;
+ if BMinusP V1 then V2 := GtPOS L1
+ else V2 := GtNEG L1;
+ IFor I:=1:L1 do IPutV(V2,I,IGetV(V1,I));
+ return V2;
+ end;
+
+% Returns V1 if V1 is strictly less than 0, NIL otherwise.
+%
+lisp procedure BMinusP V1;
+ if (IGetV(V1,0) eq 'BIGNEG) then V1 else NIL;
+
+% To provide a conveninent ADD with CARRY.
+lisp procedure AddCarry A;
+ begin scalar S;
+ S:=IPlus2(A,Carry!*);
+ if IGeq(S,BBase!*) then <<Carry!*:= 1; S:=IDifference(S,BBase!*)>>
+ else Carry!*:=0;
+ return S;
+ end;
+
+lisp procedure BPlus2(V1,V2);
+ begin scalar Sn1,Sn2;
+ Sn1:=BMinusP V1;
+ Sn2:=BMinusP V2;
+ if Sn1 and Not Sn2 then return BDifference2(V2,BMinus V1,Nil);
+ if Sn2 and Not Sn1 then return BDifference2(V1,BMinus V2,Nil);
+ return BPlusA2(V1,V2,Sn1);
+ end;
+
+lisp procedure BPlusA2(V1,V2,Sn1); % Plus with signs pre-checked and
+ begin scalar L1,L2,L3,V3,temp; % identical.
+ L1:=BSize V1;
+ L2:=BSize V2;
+ If IGreaterP(L2,L1) then <<L3:=L2; L2:=L1;L1:=L3;
+ V3:=V2; V2:=V1;V1:=V3>>;
+ L3:=IAdd1 L1;
+ If Sn1 then V3:=GtNeg L3
+ else V3:=GtPOS L3;
+ Carry!*:=0;
+ IFor I:=1:L2 do <<temp:=IPlus2(IGetV(V1,I),IGetV(V2,I));
+ IPutV(V3,I,AddCarry temp)>>;
+ temp:=IAdd1 L2;
+ IFor I:=temp:L1 do IPutV(V3,I,AddCarry IGetV(V1,I));
+ IPutV(V3,L3,Carry!*); % Carry Out
+ Return TrimBigNum1(V3,L3);
+ end;
+
+lisp procedure BDifference(V1,V2);
+ if BZeroP V2 then V1
+ else if BZeroP V1 then BMinus V2
+ else begin scalar Sn1,Sn2;
+ Sn1:=BMinusP V1;
+ Sn2:=BMinusP V2;
+ if (Sn1 and Not Sn2) or (Sn2 and Not Sn1)
+ then return BPlusA2(V1,BMinus V2,Sn1);
+ return BDifference2(V1,V2,Sn1);
+ end;
+
+lisp procedure SubCarry A;
+ begin scalar S;
+ S:=IDifference(A,Carry!*);
+ if ILessP(S,0) then <<Carry!*:=1; S:=IPlus2(BBase!*,S)>> else Carry!*:=0;
+ return S;
+ end;
+
+Lisp procedure BDifference2(V1,V2,Sn1); % Signs pre-checked and identical.
+ begin scalar i,L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ if IGreaterP(L2,L1) then <<L3:=L1;L1:=L2;L2:=L3;
+ V3:=V1;V1:=V2;V2:=V3; Sn1:=not Sn1>>
+ else if L1 Eq L2 then <<i:=L1;
+ while (IGetV(V2,i) Eq IGetV(V1,i) and IGreaterP(i,1))
+ do i:=ISub1 i;
+ if IGreaterP(IGetV(V2,i),IGetV(V1,i))
+ then <<L3:=L1;L1:=L2;L2:=L3;
+ V3:=V1;V1:=V2;V2:=V3;Sn1:=not Sn1>> >>;
+ if Sn1 then V3:=GtNEG L1
+ else V3:=GtPOS L1;
+ carry!*:=0;
+ IFor I:=1:L2 do IPutV(V3,I,SubCarry IDifference(IGetV(V1,I),IGetV(V2,I)));
+ IFor I:=(IAdd1 L2):L1 do IPutV(V3,I,SubCarry IGetV(V1,I));
+ return TrimBigNum1(V3,L1);
+ end;
+
+lisp procedure BTimes2(V1,V2);
+ begin scalar L1,L2,L3,Sn1,Sn2,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ if IGreaterP(L2,L1)
+ then <<V3:=V1; V1:=V2; V2:=V3; % If V1 is larger, will be fewer
+ L3:=L1; L1:=L2; L2:=L3>>; % iterations of BDigitTimes2.
+ L3:=IPlus2(L1,L2);
+ Sn1:=BMinusP V1;
+ Sn2:=BMinusP V2;
+ If (Sn1 and Sn2) or not(Sn1 or Sn2) then V3:=GtPOS L3 else V3:=GtNEG L3;
+ IFor I:=1:L3 do IPutV(V3,I,0);
+ IFor I:=1:L2 do BDigitTimes2(V1,IGetV(V2,I),L1,I,V3);
+ return TrimBigNum1(V3,L3);
+ end;
+
+Lisp procedure BDigitTimes2(V1,V2,L1,I,V3);
+% V1 is a bignum, V2 a fixnum, L1=BSize L1, I=position of V2 in a bignum,
+% and V3 is bignum receiving result. I affects where in V3 the result of
+% a calculation goes; the relationship is that positions I:I+(L1-1)
+% of V3 receive the products of V2 and positions 1:L1 of V1.
+% V3 is changed as a side effect here.
+ begin scalar J,carry,temp1,temp2;
+ if zerop V2 then return V3
+ else <<
+ carry:=0;
+ IFor H:=1:L1 do <<
+ temp1:=ITimes2(IGetV(V1,H),V2);
+ temp2:=IPlus2(H,ISub1 I);
+ J:=IPlus2(IPlus2(temp1,IGetV(V3,temp2)),carry);
+ IPutV(V3,temp2,IRemainder(J,BBase!*));
+ carry:=IQuotient(J,BBase!*)>>;
+ IPutV(V3,IPlus2(L1,I),carry)>>; % carry should be < BBase!* here
+ return V3;
+ end;
+
+Lisp procedure BSmallTimes2(V1,C); % V1 is a BigNum, C a fixnum.
+ % Assume C positive, ignore sign(V1)
+ % also assume V1 neq 0.
+ if ZeroP C then return GtPOS 0 % Only used from BHardDivide, BReadAdd.
+ else begin scalar J,carry,L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=IPlus2(IQuotient(C,BBase!*),L1);
+ L3:=IAdd1 L2;
+ V3:=GtPOS L3;
+ carry:=0;
+ IFor H:=1:L1 do <<
+ J:=IPlus2(ITimes2(IGetV(V1,H),C),carry);
+ IPutV(V3,H,IRemainder(J,BBase!*));
+ carry:=IQuotient(J,BBase!*)>>;
+ IFor H:=(IAdd1 L1):L3 do <<
+ IPutV(V3,H,IRemainder(J:=carry,BBase!*));
+ carry:=IQuotient(J,BBase!*)>>;
+ return TrimBigNum1(V3,L3);
+ end;
+
+lisp procedure BQuotient(V1,V2);
+ car BDivide(V1,V2);
+
+lisp procedure BRemainder(V1,V2);
+ cdr BDivide(V1,V2);
+
+% BDivide returns a dotted pair, (Q . R). Q is the quotient and R is
+% the remainder. Both are bignums. R is of the same sign as V1.
+%;
+
+smacro procedure BSimpleQuotient(V1,L1,C,SnC);
+ car BSimpleDivide(V1,L1,C,SnC);
+
+smacro procedure BSimpleRemainder(V1,L1,C,SnC);
+ cdr BSimpleDivide(V1,L1,C,SnC);
+
+lisp procedure BDivide(V1,V2);
+ begin scalar L1,L2,Q,R,V3;
+ L2:=BSize V2;
+ If IZerop L2 then error(99, "Attempt to divide by 0 in BDIVIDE");
+ L1:=BSize V1;
+ If ILessP(L1,L2) or (L1 Eq L2 and ILessP(IGetV(V1,L1),IGetV(V2,L2)))
+ % This also takes care of case
+ then return (GtPOS 0 . V1); % when V1=0.
+ if IOnep L2 then return BSimpleDivide(V1,L1,IGetV(V2,1),BMinusP V2);
+ return BHardDivide(V1,L1,V2,L2);
+ end;
+
+
+% C is a fixnum (inum?); V1 is a bignum and L1 is its length.
+% SnC is T if C (which is positive) should be considered negative.
+% Returns quotient . remainder; each is a bignum.
+%
+lisp procedure BSimpleDivide(V1,L1,C,SnC);
+ begin scalar I,P,R,RR,Sn1,V2;
+ Sn1:=BMinusP V1;
+ if (Sn1 and SnC) or not(Sn1 or SnC) then V2:=GtPOS L1 else V2:=GtNEG L1;
+ R:=0;
+ I:=L1;
+ While not IZeroP I do <<P:=IPlus2(ITimes2(R,BBase!*),IGetV(V1,I));
+ % Overflow.
+ IPutV(V2,I,IQuotient(P, C));
+ R:=IRemainder(P, C);
+ I:=ISub1 I>>;
+ If Sn1 then RR:=GtNeg 1 else RR:=GtPOS 1;
+ IPutV(RR,1,R);
+ return (TrimBigNum1(V2,L1) . TrimBigNum1(RR,1));
+ end;
+
+
+lisp procedure BHardDivide(U,Lu,V,Lv);
+% This is an algorithm taken from Knuth.
+ begin scalar U1,V1,A,D,LCV,LCV1,f,f2,J,K,Lq,carry,temp,
+ LL,M,N,N1,P,Q,QBar,SnU,SnV,U2;
+ N:=Lv;
+ N1:=IAdd1 N;
+ M:=IDifference(Lu,Lv);
+ Lq:=IAdd1 M;
+
+ % Deal with signs of inputs;
+
+ SnU:=BMinusP U;
+ SnV:=BMinusp V; % Note that these are not extra-boolean, i.e.
+ % for positive numbers MBinusP returns nil, for
+ % negative it returns its argument. Thus the
+ % test (SnU=SnV) does not reliably compare the signs of
+ % U and V;
+ if SnU then if SnV then Q := GtPOS Lq else Q := GtNEG Lq
+ else if SnV then Q := GtNEG Lq else Q := GtPOS Lq;
+
+ U1 := GtPOS IAdd1 Lu; % U is ALWAYS stored as if one digit longer;
+
+ % Compute a scale factor to normalize the long division;
+ D:=IQuotient(BBase!*,IAdd1 IGetV(V,Lv));
+ % Now, at the same time, I remove the sign information from U and V
+ % and scale them so that the leading coefficeint in V is fairly large;
+
+ carry := 0;
+ IFor i:=1:Lu do <<
+ temp := IPlus2(ITimes2(IGetV(U,I),D),carry);
+ IPutV(U1,I,IRemainder(temp,BBase!*));
+ carry := IQuotient(temp,BBase!*) >>;
+ Lu := IAdd1 Lu;
+ IPutV(U1,Lu,carry);
+
+ V1:=BSmallTimes2(V,D); % So far all variables contain safe values,
+ % i.e. numbers < BBase!*;
+ IPutV(V1,0,'BIGPOS);
+
+ if ILessp(Lv,2) then NonBigNumError(V,'BHARDDIVIDE); % To be safe;
+
+ LCV := IGetV(V1,Lv);
+ LCV1 := IGetv(V1,ISub1 Lv); % Top two digits of the scaled V accessed once
+ % here outside the main loop;
+
+ % Now perform the main long division loop;
+
+ IFor I:=0:M do <<
+ J:=IDifference(Lu,I); % J>K; working on U1[K:J]
+ K:=IDifference(J,N1); % in this loop.
+ A:=IGetV(U1,J);
+
+ P := IPlus2(ITimes2(A,BBase!*),IGetv(U1,Isub1 J));
+ % N.B. P is up to 30 bits long. Take care! ;
+
+ if A Eq LCV then QBar := ISub1 BBase!*
+ else QBar := Iquotient(P,LCV); % approximate next digit;
+
+ f:=ITimes2(QBar,LCV1);
+ f2:=IPlus2(ITimes2(IDifference(P,ITimes2(QBar,LCV)),BBase!*),
+ IGetV(U1,IDifference(J,2)));
+
+ while IGreaterP(f,f2) do << % Correct most overshoots in Qbar;
+ QBar:=ISub1 QBar;
+ f:=IDifference(f,LCV1);;
+ f2:=IPlus2(f2,ITimes2(LCV,BBase!*)) >>;
+
+ carry := 0; % Ready to subtract QBar*V1 from U1;
+
+ IFor L:=1:N do <<
+ temp := IPlus2(
+ Idifference(
+ IGetV(U1,IPlus2(K,L)),
+ ITimes2(QBar,IGetV(V1,L))),
+ carry);
+ carry := IQuotient(temp,BBase!*);
+ temp := IRemainder(temp,BBase!*);
+ if IMinusp temp then <<
+ carry := ISub1 carry;
+ temp := IPlus2(temp,BBase!*) >>;
+ IPutV(U1,IPlus2(K,L),temp) >>;
+
+ % Now propagate borrows up as far as they go;
+
+ LL := IPlus2(K,N);
+ while (not IZeroP carry) and ILessp(LL,J) do <<
+ LL := IAdd1 LL;
+ temp := IPlus2(IGetV(U1,LL),carry);
+ carry := IQuotient(temp,BBase!*);
+ temp := IRemainder(temp,BBase!*);
+ if IMinusP temp then <<
+ carry := ISub1 carry;
+ temp := IPlus2(temp,BBase!*) >>;
+ IPutV(U1,LL,temp) >>;
+
+ if not IZerop carry then <<
+ % QBar was still wrong - correction step needed.
+ % This should not happen very often;
+ QBar := ISub1 QBar;
+
+ % Add V1 back into U1;
+ carry := 0;
+
+ IFor L := 1:N do <<
+ carry := IPlus2(
+ IPlus2(IGetV(U1,Iplus2(K,L)),
+ IGetV(V1,L)),
+ carry);
+ IPutV(U1,IPlus2(K,L),IRemainder(carry,BBase!*));
+ carry := IQuotient(carry,BBase!*) >>;
+
+ LL := IPlus2(K,N);
+ while ILessp(LL,J) do <<
+ LL := IAdd1 LL;
+ carry := IPlus2(IGetv(U1,LL),carry);
+ IPutV(U1,LL,IRemainder(carry,BBase!*));
+ carry := IQuotient(carry,BBase!*) >> >>;
+
+ IPutV(Q,IDifference(Lq,I),QBar)
+
+ >>; % End of main loop;
+
+
+ U1 := TrimBigNum1(U1,IDifference(Lu,M));
+
+ f := 0; f2 := 0; % Clean up potentially wild values;
+
+ if not BZeroP U1 then <<
+ % Unnormalize the remainder by dividing by D
+
+ if SnU then IPutV(U1,0,'BIGNEG);
+ if not IOnep D then <<
+ Lu := BSize U1;
+ carry := 0;
+ IFor L:=Lu step -1 until 1 do <<
+ P := IPlus2(ITimes2(carry,BBase!*),IGetV(U1,L));
+ IPutv(U1,L,IQuotient(P,D));
+ carry := IRemainder(P,D) >>;
+
+ P := 0;
+ if not IZeroP carry then BHardBug("remainder when unscaling",
+ U,V,TrimBigNum1(U1,Lu),TrimBigNum1(Q,Lq));
+
+ U1 := TrimBigNum1(U1,Lu) >> >>;
+
+ Q := TrimBigNum1(Q,Lq); % In case leading digit happened to be zero;
+ P := 0; % flush out a 30 bit number;
+
+% Here, for debugging purposes, I will try to validate the results I
+% have obtained by testing if Q*V+U1=U and 0<=U1<V. I Know this slows things
+% down, but I will remove it when my confidence has improved somewhat;
+
+% if not BZerop U1 then <<
+% if (BMinusP U and not BMinusP U1) or
+% (BMinusP U1 and not BMinusP U) then
+% BHardBug("remainder has wrong sign",U,V,U1,Q) >>;
+% if not BAbs U1<BAbs V then BHardBug("remainder out of range",U,V,U1,Q)
+% else if not BZerop(BDifference(BPlus2(BTimes2(Q,V),U1),U)) then
+% BHardBug("quotient or remainder incorrect",U,V,U1,Q);
+
+ return (Q . U1)
+ end;
+
+lisp procedure BHardBug(msg,U,V,R,Q);
+% Because the inputs to BHardDivide are probably rather large, I am not
+% going to rely on BldMsg to display them;
+ << Prin2T "***** Internal error in BHardDivide";
+ Prin2 "arg1="; Prin2T U;
+ Prin2 "arg2="; Prin2T V;
+ Prin2 "computed quotient="; Prin2T Q;
+ Prin2 "computed remainder="; Prin2T R;
+ StdError msg >>;
+
+
+lisp procedure BGreaterP(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGreaterP(V,U)
+ else nil
+ else if BMinusP V then U
+ else BUnsignedGreaterP(U,V);
+
+lisp procedure BLessp(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGreaterP(U,V)
+ else U
+ else if BMinusP V then nil
+ else BUnsignedGreaterP(V,U);
+
+lisp procedure BGeq(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGeq(V,U)
+ else nil
+ else if BMinusP V then U
+ else BUnsignedGeq(U,V);
+
+lisp procedure BLeq(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGeq(U,V)
+ else U
+ else if BMinusP V then nil
+ else BUnsignedGeq(V,U);
+
+lisp procedure BUnsignedGreaterP(U,V);
+% Compare magnitudes of two bignums;
+ begin
+ scalar Lu,Lv,I;
+ Lu := BSize U;
+ Lv := BSize V;
+ if not (Lu eq Lv) then <<
+ if IGreaterP(Lu,Lv) then return U
+ else return nil >>;
+ while IGetV(U,Lv) eq IGetV(V,Lv) and IGreaterP(Lv,1) do Lv := ISub1 Lv;
+ if IGreaterP(IGetV(U,Lv),IGetV(V,Lv)) then return U
+ else return nil
+ end;
+
+symbolic procedure BUnsignedGeq(U,V);
+% Compare magnitudes of two unsigned bignums;
+ begin
+ scalar Lu,Lv;
+ Lu := BSize U;
+ Lv := BSize V;
+ if not (Lu eq Lv) then <<
+ if IGreaterP(Lu,Lv) then return U
+ else return nil >>;
+ while IGetV(U,Lv) eq IGetV(V,Lv) and IGreaterP(Lv,1) do Lv := ISub1 Lv;
+ If IGreaterP(IGetV(V,Lv),IGetV(U,Lv)) then return nil
+ else return U
+ end;
+
+
+
+lisp procedure BAdd1 V;
+ BSmallAdd(V,1);
+
+lisp procedure BSub1 U;
+ BSmallDiff(U,1);
+
+% ------------------------------------------------
+% Conversion to Float:
+
+lisp procedure FloatFromBigNum V;
+ if BZeroP V then 0.0
+ else if BGreaterP(V, FloatHi!*) or BLessp(V, FloatLow!*)
+ then Error(99,list("Argument, ",V," to FLOAT is too large"))
+ else begin scalar L,Res,Sn,I;
+ L:=BSize V;
+ Sn:=BMinusP V;
+ Res:=float IGetv(V,L);
+ I:=ISub1 L;
+ While not IZeroP I do << Res:=res*BBase!*;
+ Res:=Res +IGetV(V,I);
+ I:=ISub1 I>>;
+ if Sn then Res:=minus res;
+ return res;
+ end;
+
+
+% ------------------------------------------------
+% Input and Output:
+Digit2Letter!* := % Ascii values of digits and characters.
+'[48 49 50 51 52 53 54 55 56 57 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+80 81 82 83 84 85 86 87 88 89 90];
+
+% OutputBase!* is assumed to be positive and less than 37.
+
+lisp procedure BChannelPrin2(Channel,V);
+ If not BignumP V then NonBigNumError(V, 'BPrin) %need?
+ else begin scalar quot, rem, div, result, resultsign, myobase;
+ myobase:=OutputBase!*;
+ resultsign:=BMinusP V;
+ div:=BSimpleDivide(V,Bsize V,OutputBase!*,nil);
+ quot:=car div;
+ rem:=cdr div;
+ if Bzerop rem then rem:=0 else rem:=IGetV(rem,1);
+ result:=rem . result;
+ while Not BZeroP quot do
+ <<div:=BSimpleDivide(quot,Bsize quot,OutputBase!*,nil);
+ quot:=car div;
+ rem:=cdr div;
+ if Bzerop rem then rem:=0 else rem:=IGetV(rem,1);
+ result:=rem . result>>;
+ if resultsign then channelwritechar(Channel,char !-);
+ if myobase neq 10 then <<ChannelWriteSysInteger(channel,myobase,10);
+ ChannelWriteChar(Channel, char !#)>>;
+ For each u in result do ChannelWriteChar(Channel, IGetV(digit2letter!*,u));
+ OutputBase!*:=myobase;
+ return;
+ end;
+
+lisp procedure BRead(s,radix,sn); % radix is < Bbase!*
+ %s=string of digits, radix=base, sn=1 or -1
+ begin scalar sz, res, ch;
+ sz:=size s;
+ res:=GtPOS 1;
+ ch:=indx(s,0);
+ if IGeq(ch,char A) and ILeq(ch,char Z)
+ then ch:=IPlus2(IDifference(ch,char A),10);
+ if IGeq(ch,char 0) and ILeq(ch,char 9)
+ then ch:=IDifference(ch,char 0);
+ IPutV(res,1,ch);
+ IFor i:=1:sz do <<ch:=indx(s,i);
+ if IGeq(ch,char A) and ILeq(ch,char Z)
+ then ch:=IDifference(ch,IDifference(char A,10));
+ if IGeq(ch,char 0) and ILeq(ch,char 9)
+ then ch:=IDifference(ch,char 0);
+ res:=BReadAdd(res, radix, ch)>>;
+ if iminusp sn then res:=BMinus res;
+ return res;
+ end;
+
+lisp procedure BReadAdd(V, radix, ch);
+ << V:=BSmallTimes2(V, radix);
+ V:=BSmallAdd(V,ch)>>;
+
+lisp procedure BSmallAdd(V,C); %V big, C fix.
+ if IZerop C then return V
+ else if Bzerop V then return int2B C
+ else if BMinusp V then BMinus BSmallDiff(BMinus V, C)
+ else if IMinusP C then BSmallDiff(V, IMinus C)
+ else begin scalar V1,L1;
+ Carry!*:=C;
+ L1:=BSize V;
+ V1:=GtPOS(IAdd1 L1);
+ IFor i:=1:L1 do IPutV(V1,i,addcarry IGetV(V,i));
+ if IOneP carry!* then IPutV(V1,IAdd1 L1,1) else return TrimBigNum1(V1,L1);
+ return V1
+ end;
+
+lisp procedure BNum N; % temporary? Creates a Bignum of one digit, value N.
+ begin scalar B;
+ if IZerop n then return GtPOS 0
+ else if IMinusp N then <<b:=GtNEG 1; n:= IMinus n>> else b:=GtPos 1;
+ IPutV(b,1,N);
+ Return b;
+ end;
+
+lisp procedure BSmallDiff(V,C); %V big, C fix
+ if IZerop C then V
+ else if BZeroP V then int2B IMinus C
+ else if BMinusP V then BMinus BSmallAdd(BMinus V, C)
+ else if IMinusP C then BSmallAdd(V, IMinus C)
+ else begin scalar V1,L1;
+ Carry!*:=C;
+ L1:=BSize V;
+ V1:=GtPOS L1;
+ IFor i:=1:L1 do IPuTV(V1,i,subcarry IGetV(V,i));
+ if not IZeroP carry!* then
+ StdError BldMsg(" BSmallDiff V<C %p %p%n",V,C);
+ return TrimBigNum1(V1,L1);
+ end;
+
+lisp procedure int2B n; % Temporary? Creates BigNum of value N.
+ if not fixp n then NonIntegerError(n, 'int2B)
+ else if ILessP(n,Bbase!*) then BNum n
+ else begin scalar Str,ind,rad,Sn,r;
+ Str:=bldmsg("%w",n); % like an "int2string"
+ if indx(str,0)=char '!- then <<Sn:=-1;
+ str:=sub(str,1,ISub1 (size str))>>
+ else Sn:=1;
+ IFor i:=0:size str do
+ if indx(str,i)=char '!# then ind:=i;
+ if ind then <<r:=sub(str,0,ISub1 ind);
+ rad:=0;
+ IFor i:=0:size r do
+ rad:=IPlus2(ITimes2(rad,10),IDifference(indx(r,i),char 0));
+ str:=sub(str,IAdd1 ind,IDifference(size str,IAdd1 ind))>>
+ else rad:=10;
+ return Bread(str,rad,sn);
+ end;
+
+%-----------------------------------------------------
+% "Fix" for Bignums
+
+lisp procedure bigfromfloat X;
+ if fixp x or bigp x then x
+ else begin scalar bigpart,floatpart,power,sign,thispart;
+ if minusp X then <<sign:=-1; X:=minus X>> else sign:=1;
+ bigpart:=bnum 0;
+ while neq(X, 0) and neq(x,0.0) do <<
+ if X < bbase!* then << bigpart:=bplus2(bigpart, bnum fix x);
+ X:=0 >>
+ else <<floatpart:=x;
+ power:=0;
+ while floatpart>=bbase!* do % get high end of number.
+ <<floatpart:=floatpart/bbase!*;
+ power:=power + bbits!* >>;
+ thispart:=btimes2(btwopower power, bnum fix floatpart);
+ X:=X- floatfrombignum thispart;
+ bigpart:=bplus2(bigpart, thispart) >> >>;
+ if minusp sign then bigpart := bminus bigpart;
+ return bigpart;
+ end;
+
+if_system(VAX,
+ <<setbits 32;
+ FloatHi!*:=btimes2(bdifference(btwopower 67, btwopower 11),
+ btwopower 60);% Largest representable float.
+ FloatLow!*:=BMinus FloatHi!*>>);
+
+if_system(PDP10,
+ <<setbits 36;
+ FloatHi!*:=btimes2(bsub1 btwopower 62, btwopower 65);
+ FloatLow!*:=BMinus FloatHi!*>>);
+
+% End of BIGBIG.RED ;
+
+
ADDED psl-1983/3-1/util/bigface.build
Index: psl-1983/3-1/util/bigface.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/bigface.build
@@ -0,0 +1,1 @@
+in "bigface.red"$
ADDED psl-1983/3-1/util/bigface.red
Index: psl-1983/3-1/util/bigface.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/bigface.red
@@ -0,0 +1,233 @@
+
+%. BIGFACE.RED - Bignum Interfacing
+% M.L. Griss and B Morrison
+% 25 June 1982
+% --------------------------------------------------------------------------
+% Revision History:
+% 21 December, 82: MLG
+% Change PRIN1 and PRIN2 hooks to refer to RecursiveChannelprinx
+% which changed in PK:PRINTERS.RED for prinlevel stuff
+% November: Variety of Bug Fixes by A. Norman
+
+off usermode;
+
+% Use the BIGN tag for better Interface
+
+imports '(vector!-fix arith bigbig);
+
+compiletime<<load syslisp;
+ load fast!-vector;
+ load inum;
+ load if!-system>>;
+
+on comp;
+
+fluid '(WordHi!* WordLow!* BBase!* FloatHi!* FloatLow!*);
+
+
+smacro procedure PutBig(b,i,val);
+ IputV(b,i,val);
+
+smacro procedure GetBig(b,i);
+ IgetV(B,i);
+
+% on syslisp;
+%
+% procedure BigP x;
+% Tag(x) eq BIGN;
+%
+% off syslisp;
+
+lisp procedure BignumP (V);
+ BigP V and ((GetBig(V,0) eq 'BIGPOS) or (GetBig(V,0) eq 'BIGNEG));
+
+lisp procedure NonBigNumError(V,L);
+ StdError BldMsg(" Expect a BIGNUM in %r, given %p%n",L,V);
+
+lisp procedure BSize V;
+ (BignumP V and VecLen VecInf V) or 0;
+
+lisp procedure GtPOS N;
+ Begin Scalar B;
+ B:=MkVect N;
+ IPutV(B,0,'BIGPOS);
+ Return MkBigN Vecinf B;
+ End;
+
+lisp procedure GtNeg N;
+ Begin Scalar B;
+ B:=MkVect N;
+ IPutV(B,0,'BIGNEG);
+ Return MkBigN VecInf B;
+ End;
+
+lisp procedure TrimBigNum V3; % truncate trailing 0
+ If Not BignumP V3 then NonBigNumError(V3,'TrimBigNum)
+ else TrimBigNum1(V3,BSize V3);
+
+lisp procedure TrimBigNum1(B,L3);
+ Begin scalar v3;
+ V3:=BigAsVec B;
+ While IGreaterP(L3,0) and IZeroP IGetV(V3,L3) do L3:=ISub1 L3;
+ If IZerop UpBv TruncateVector(V3,L3) then return GtPOS 0
+ else return B;
+ end;
+
+lisp procedure BigAsVec B;
+ MkVec Inf B;
+
+lisp procedure VecAsBig V;
+ MkBig Inf V;
+% -- Output---
+
+if_system(VAX,
+ <<setbits 32;
+ FloatHi!*:=btimes2(bdifference(btwopower 67, btwopower 11),
+ btwopower 60);% Largest representable float.
+ FloatLow!*:=BMinus FloatHi!*>>);
+
+if_system(PDP10,
+ <<setbits 36;
+ FloatHi!*:=btimes2(bsub1 btwopower 62, btwopower 65);
+ FloatLow!*:=BMinus FloatHi!*>>);
+
+% MLG Change to interface to Recursive hooks, added for
+% Prinlevel stuff
+CopyD('OldChannelPrin1,'RecursiveChannelPrin1);
+CopyD('OldChannelPrin2,'RecursiveChannelPrin2);
+
+Lisp Procedure RecursiveChannelPrin1(Channel,U,Level);
+ <<if BigNumP U then BChannelPrin2(Channel,U)
+ else OldChannelPrin1(Channel, U,Level);U>>;
+
+Lisp Procedure RecursiveChannelPrin2(Channel,U,level);
+ <<If BigNumP U then BChannelPrin2(Channel, U)
+ else OldChannelPrin2(Channel, U,level);U>>;
+
+lisp procedure big2sys U;
+ begin scalar L,Sn,res,I;
+ L:=BSize U;
+ if IZeroP L then return 0;
+ Sn:=BMinusP U;
+ res:=IGetV(U,L);
+ I:=ISub1 L;
+ while I neq 0 do <<res:=ITimes2(res, bbase!*);
+ res:=IPlus2(res, IGetV(U,I));
+ I:=ISub1 I>>;
+ if Sn then Res:=IMinus Res;
+ return Res;
+ end;
+
+smacro procedure checkifreallybig U;
+ (lambda UU; % This construction needed to avoid repeated evaluation;
+ if BLessP(UU, WordLow!*) or BGreaterp(UU,WordHi!*) then UU
+ else sys2int big2sys UU)(U);
+
+smacro procedure checkifreallybigpair U;
+ (lambda VV;
+ checkifreallybig car VV . checkifreallybig cdr VV)(U);
+
+smacro procedure checkifreallybigornil U;
+ (lambda UU;
+ if Null UU or BLessp(UU, WordLow!*) or BGreaterP(UU,WordHi!*) then UU
+ else sys2int big2sys UU)(U);
+
+lisp procedure BigPlus2(U,V);
+ CheckIfReallyBig BPlus2(U,V);
+
+lisp procedure BigDifference(U,V);
+ CheckIfReallyBig BDifference(U,V);
+
+lisp procedure BigTimes2(U,V);
+ CheckIfReallyBig BTimes2(U,V);
+
+lisp procedure BigDivide(U,V);
+ CheckIfReallyBigPair BDivide(U,V);
+
+lisp procedure BigQuotient(U,V);
+ CheckIfReallyBig BQuotient(U,V);
+
+lisp procedure BigRemainder(U,V);
+ CheckIfReallyBig BRemainder(U,V);
+
+lisp procedure BigLAnd(U,V);
+ CheckIfReallyBig BLand(U,V);
+
+lisp procedure BigLOr(U,V);
+ CheckIfReallyBig BLOr(U,V);
+
+lisp procedure BigLXOr(U,V);
+ CheckIfReallyBig BLXor(U,V);
+
+lisp procedure BigLShift(U,V);
+ CheckIfReallyBig BLShift(U,V);
+
+lisp procedure BigGreaterP(U,V);
+ CheckIfReallyBigOrNil BGreaterP(U,V);
+
+lisp procedure BigLessP(U,V);
+ CheckIfReallyBigOrNil BLessP(U,V);
+
+lisp procedure BigAdd1 U;
+ CheckIfReallyBig BAdd1 U;
+
+lisp procedure BigSub1 U;
+ CheckIfReallyBig BSub1 U;
+
+lisp procedure BigLNot U;
+ CheckIfReallyBig BLNot U;
+
+lisp procedure BigMinus U;
+ CheckIfReallyBig BMinus U;
+
+lisp procedure FloatBigArg U;
+ FloatFromBigNum U;
+
+lisp procedure BigMinusP U;
+ CheckIfReallyBigOrNil BMinusP U;
+
+
+% ---- Input ----
+
+lisp procedure MakeStringIntoLispInteger(Str,Radix,Sn);
+ CheckIfReallyBig BRead(Str,Radix,Sn);
+
+% Coercion/Transfer Functions
+
+copyd('oldFloatFix,'FloatFix);
+
+procedure floatfix U;
+ if U < BBase!* then OldFloatFix U
+ else bigfromfloat U;
+
+copyd('oldMakeFixNum, 'MakeFixNum);
+
+procedure MakeFixNum N; % temporary; check range?
+ Begin;
+ n:=oldMakeFixNum N;
+ return int2b N;
+ end;
+
+syslsp procedure StaticIntBig Arg; % Convert an INT to a BIG
+ int2b Arg;
+
+syslsp procedure StaticBigFloat Arg; % Convert a BigNum to a FLOAT;
+ FloatFromBignum Arg;
+
+copyd('oldInt2Sys, 'Int2Sys);
+
+procedure Int2Sys N;
+ if BigP N then Big2Sys N
+ else OldInt2Sys n;
+
+
+on syslisp;
+
+ syslsp procedure IsInum U;
+ U < lispvar bbase!* and U > minus lispvar bbase!*;
+
+off syslisp;
+
+
+on usermode;
+
ADDED psl-1983/3-1/util/bind-macros.sl
Index: psl-1983/3-1/util/bind-macros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/bind-macros.sl
@@ -0,0 +1,50 @@
+%
+% BIND-MACROS.SL - convenient macros for binding variables
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% <PSL.UTIL>BIND-MACROS.SL.2, 18-Oct-82 14:31:17, Edit by BENSON
+% Reversed vars and vals after collecting them in LET, so that the order
+% of things in the LAMBDA is the same as the LET. Not necessary,
+% but it makes it easier to follow macroexpanded things.
+
+(defmacro prog1 (first . body)
+ (if (null body)
+ first
+ `((lambda (***PROG1-VAR***) ,@body ***PROG1-VAR***) ,first)))
+
+(defmacro let (specs . body)
+ (if (null specs)
+ (cond
+ ((null body) nil)
+ ((and (pairp body) (null (cdr body))) (car body))
+ (t `(progn ,@body)))
+ (prog (vars vals)
+ (foreach U in specs do
+ (cond ((atom U)
+ (setq vars (cons U vars))
+ (setq vals (cons nil vals)))
+ (t
+ (setq vars (cons (car U) vars))
+ (setq vals (cons (and (cdr U) (cadr U)) vals)))))
+ (return `((lambda ,(reversip vars) ,@body ) ,@(reversip vals))))))
+
+(defmacro let* (specs . body)
+ (if (null specs)
+ (cond
+ ((null body) nil)
+ ((and (pairp body) (null (cdr body))) (car body))
+ (t `(progn ,@body)))
+ (let*1 specs body)))
+
+(de let*1 (specs body)
+ (let ((s (car specs))(specs (cdr specs)))
+ `((lambda (,(if (atom s) s (car s)))
+ ,@(if specs (list (let*1 specs body)) body))
+ ,(if (and (pairp s) (cdr s)) (cadr s) nil))))
+
ADDED psl-1983/3-1/util/br-unbr.red
Index: psl-1983/3-1/util/br-unbr.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/br-unbr.red
@@ -0,0 +1,123 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Just stuff for BR and UNBR from MINI-TRACE.RED
+%%% This code also appears in MINI-TRACE.RED
+%%% Cris Perdue
+%%% 1/6/83
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% <PSL.UTIL>BR-UNBR.RED.2, 19-Jan-83 13:29:43, Edit by PERDUE
+% Fixed problem with the value returned from a broken function
+
+fluid '(ArgLst!* % Default names for args in traced code
+ TrSpace!* % Number spaces to indent
+ !*NoTrArgs % Control arg-trace
+);
+
+CompileTime flag('(TrMakeArgList), 'InternalFunction);
+
+lisp procedure TrMakeArgList N; % Get Arglist for N args
+ cdr Assoc(N, ArgLst!*);
+
+LoadTime
+<< ArgLst!* := '((0 . ())
+ (1 . (X1))
+ (2 . (X1 X2))
+ (3 . (X1 X2 X3))
+ (4 . (X1 X2 X3 X4))
+ (5 . (X1 X2 X3 X4 X5))
+ (6 . (X1 X2 X3 X4 X5 X6))
+ (7 . (X1 X2 X3 X4 X5 X6 X7))
+ (8 . (X1 X2 X3 X4 X5 X6 X7 X8))
+ (9 . (X1 X2 X3 X4 X5 X6 X7 X8 X9))
+ (10 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10))
+ (11 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11))
+ (12 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12))
+ (13 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13))
+ (14 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14))
+ (15 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15)));
+ TrSpace!* := 0;
+ !*NoTrArgs := NIL >>;
+
+Fluid '(ErrorForm!* !*ContinuableError);
+
+lisp procedure Br!.Prc(PN, B, A); % Called in place of "Broken" code
+%
+% Called by BREAKFN for proc nam PN, body B, args A;
+%
+begin scalar K, SvArgs, VV, Numb, Ans;
+ TrSpace!* := TrSpace!* + 1;
+ Numb := Min(TrSpace!*, 15);
+ Tab Numb;
+ PrintF("%p %w:", PN, TrSpace!*);
+ if not !*NoTrArgs then
+ << SvArgs := A;
+ K := 1;
+ while SvArgs do
+ << PrintF(" Arg%w:=%p, ", K, car SvArgs);
+ SvArgs := cdr SvArgs;
+ K := K + 1 >> >>;
+ TerPri();
+ ErrorForm!* := NIL;
+ PrintF(" BREAK before entering %r%n",PN);
+ !*ContinuableError:=T;
+ Break();
+ VV := Apply(B, A);
+ PrintF(" BREAK after call %r, value %r%n",PN,VV);
+ ErrorForm!* := MkQuote VV;
+ !*ContinuableError:=T;
+ Ans := Break();
+ Tab Numb;
+ PrintF("%p %w:=%p%n", PN, TrSpace!*, Ans);
+ TrSpace!* := TrSpace!* - 1;
+ return Ans
+end;
+
+fluid '(!*Comp PromptString!*);
+
+lisp procedure Br!.1 Nam; % Called To Trace a single function
+begin scalar PN, X, Y, Bod, Args, N, OldIn, OldPrompt, !*Comp;
+ if not (Y:=GetD Nam) then
+ << ErrorPrintF("*** %r is not a defined function and cannot be BROKEN",
+ Nam);
+ return >>;
+ PN := GenSym();
+ PutD(PN, car Y, cdr Y);
+ put(Nam, 'OldCod, Y . get(Nam, 'OldCod));
+ if EqCar(cdr Y, 'LAMBDA) then Args := cadr cdr Y else
+ << OldPrompt := PromptString!*;
+ PromptString!* := BldMsg("How many arguments for %r?", Nam);
+ OldIn := RDS NIL;
+ while not NumberP(N := Read()) or N < 0 or N > 15 do ;
+ PromptString!* := OldPrompt;
+ RDS OldIn;
+ Args := TrMakeArgList N >>;
+ Bod:= list('LAMBDA, Args,
+ list('Br!.prc, MkQuote Nam,
+ MkQuote PN, 'LIST . Args));
+ PutD(Nam, car Y, Bod);
+ put(Nam, 'BreakCode, cdr GetD Nam);
+end;
+
+lisp procedure UnBr!.1 Nam;
+begin scalar X, Y, !*Comp;
+ if not IDP Nam or not PairP(X := get(Nam, 'OldCod))
+ or not PairP(Y := GetD Nam)
+ or not (cdr Y eq get(Nam, 'BreakCode)) then
+ << ErrorPrintF("*** %r cannot be unbroken", Nam);
+ return >>;
+ PutD(Nam, caar X, cdar X);
+ put(Nam, 'OldCod, cdr X)
+end;
+
+macro procedure Br L; %. Break functions in L
+ list('EvBr, MkQuote cdr L);
+
+expr procedure EvBr L;
+ for each X in L do Br!.1 X;
+
+macro procedure UnBr L; %. Unbreak functions in L
+ list('EvUnBr, MkQuote cdr L);
+
+expr procedure EvUnBr L;
+ for each X in L do UnBr!.1 X;
+
+END;
ADDED psl-1983/3-1/util/build.build
Index: psl-1983/3-1/util/build.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/build.build
@@ -0,0 +1,2 @@
+CompileTime load(If!-System, Syslisp);
+in "build.red"$
ADDED psl-1983/3-1/util/build.mic
Index: psl-1983/3-1/util/build.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/build.mic
@@ -0,0 +1,7 @@
+get PSL:RLISP.EXE
+START
+load Build;
+BuildFileFormat!* := "%w";
+Build '''A;
+quit;
+RESET .
ADDED psl-1983/3-1/util/build.red
Index: psl-1983/3-1/util/build.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/build.red
@@ -0,0 +1,74 @@
+%
+% BUILD.RED - Compile a module from .BUILD or .RED file
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 March 1982
+% Copyright (c) 1982 University of Utah
+%
+% Edit by MLG, 9 April 1983
+% added MakeBuildFilename, and ERRSET, so Build more robust
+% and more like Compile-file. Also turned off break,
+% and do closing FASLEND in case of error.
+% Edit by Cris Perdue, 23 Mar 1983 0856-PST
+% Added BuildFileFormat for Apollo as requested by Kessler
+% 07-Mar-83 Nancy Kendzierski
+% Added load if-system, since many .build files use the if_system macro.
+% 09-Feb-83 MLG
+% Changed Buildformat to use $pl/
+% <PSL.UTIL>BUILD.RED.3, 1-Dec-82 16:12:33, Edit by BENSON
+% Added if_system(HP9836, ... )
+
+Compiletime load if!-system;
+Imports '(If!-system); % useful for most "built" systems
+
+fluid '(!*quiet_faslout % turns off welcome message in faslout
+ !*Lower % lowercase ids on output
+ !*UserMode % query on redefinition
+ BuildFileFormat!*
+);
+
+if_system(Tops20,
+ BuildFileFormat!* := "pl:%w");
+if_system(Unix,
+ BuildFileFormat!* := "$pl/%w");
+if_system(HP9836,
+ BuildFileFormat!* := "pl:%w");
+if_system(Apollo,
+ BuildFileFormat!* := "~p/l/%w");
+
+Lisp Procedure MakeBuildFileName(ModuleName,ExtList);
+% Try to construct Filename form Modulename
+ Begin scalar y;
+ If Null ExtList then return StdError
+ BldMsg("Cant find a complete filename for %r",ModuleName);
+ If FileP(y:=BldMsg("%w.%w",ModuleName,car Extlist)) then
+ return <<ErrorPrintF("--- Building %w%n",Y); Y>>;
+ Return MakeBuildFileName(ModuleName,Cdr ExtList);
+ End;
+
+lisp procedure Build X;
+ Begin scalar result;
+ result:=Errset(BuildAux X, T);
+ if fixp Result then
+ <<if !*WritingFaslFile then faslend;
+ Errorprintf("***** Error during build of %w%n",X)>>;
+ End;
+
+Lisp Procedure BuildAux X;
+begin scalar !*UserMode, !*quiet_faslout,y,!*break,result;
+ !*quiet_faslout := T;
+ (lambda (!*Lower);
+ << y:=MakeBuildFileName(X,'(build red sl));
+ faslout BldMsg(BuildFileFormat!*, X) >>)(T);
+ EvIn list y; % Examines .RED, .SL
+ FaslEnd;
+end;
+
+END;
+
+
+
+
ADDED psl-1983/3-1/util/chars.build
Index: psl-1983/3-1/util/chars.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/chars.build
@@ -0,0 +1,5 @@
+CompileTime <<
+load(Useful, CLComp);
+put('Space, 'CharConst, 32); % temporary patch
+>>;
+in "chars.lsp"$
ADDED psl-1983/3-1/util/chars.lsp
Index: psl-1983/3-1/util/chars.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/chars.lsp
@@ -0,0 +1,168 @@
+;;;
+;;; CHARS.LSP - Common Lisp operations on characters
+;;;
+;;; Author: Eric Benson
+;;; Symbolic Computation Group
+;;; Computer Science Dept.
+;;; University of Utah
+;;; Date: 7 April 1982
+;;; Copyright (c) 1982 University of Utah
+;;;
+
+; <PSL.UTIL>CHARS.LSP.4, 2-Sep-82 14:22:45, Edit by BENSON
+; Fixed bug in CHAR-UPCASE and CHAR-DOWNCASE
+
+(defvar char-code-limit 128 "Upper bound of character code values")
+
+(defvar char-font-limit 1 "Upper bound on supported fonts")
+
+(defvar char-bits-limit 1 "Upper bound on values produces by char-bits")
+
+;;;; STANDARD-CHARP - ASCII definition
+(defun standard-charp (c)
+ (and (characterp c)
+ (or (not (or (char< c #\Space) (char> c #\Rubout)))
+ (eq c #\Eol)
+ (eq c #\Tab)
+ (eq c #\FF))))
+
+;;;; GRAPHICP - printable character
+(defun graphicp (c)
+ (and (characterp c)
+ (not (char< c #\Space))
+ (char< c #\Rubout)))
+
+;;;; STRING-CHARP - a character that can be an element of a string
+(defun string-charp (c)
+ (and (characterp c)
+ (>= (char-int c) 0)
+ (<= (char-int c) #\Rubout)))
+
+;;;; ALPHAP - an alphabetic character
+(defun alphap (c)
+ (or (uppercasep c)
+ (lowercasep c)))
+
+;;;; UPPERCASEP - an uppercase letter
+(defun uppercasep (c)
+ (and (characterp c)
+ (not (char< c #\A))
+ (not (char> c #\Z))))
+
+;;;; LOWERCASEP - a lowercase letter
+(defun lowercasep (c)
+ (and (characterp c)
+ (not (char< c #\\a))
+ (not (char> c #\\z))))
+
+;;;; BOTHCASEP - same as ALPHAP
+(fset 'bothcasep (fsymeval 'alphap))
+
+;;;; DIGITP - a digit character (optional radix not supported)
+(defun digitp (c)
+ (when (and (characterp c)
+ (not (char< c #\0))
+ (not (char> c #\9)))
+ (- (char-int c) (char-int #\0))))
+
+;;;; ALPHANUMERICP - a digit or an alphabetic
+(defun alphanumericp (c)
+ (or (alphap c) (digitp c)))
+
+;;;; CHAR= - strict character comparison
+(defun char= (c1 c2)
+ (eql (char-int c1) (char-int c2)))
+
+;;;; CHAR-EQUAL - similar character objects
+(defun char-equal (c1 c2)
+ (or (char= c1 c2)
+ (and (string-charp c1)
+ (string-charp c2)
+ (or (char< c1 #\Space) (char> c1 #\?))
+ (or (char< c2 #\Space) (char> c2 #\?))
+ (eql (logand (char-int c1) (char-int #\ ))
+ (logand (char-int c2) (char-int #\ ))))))
+
+;;;; CHAR< - strict character comparison
+(defun char< (c1 c2)
+ (< (char-int c1) (char-int c2)))
+
+;;;; CHAR> - strict character comparison
+(defun char> (c1 c2)
+ (> (char-int c1) (char-int c2)))
+
+;;;; CHAR-LESSP - ignore case and bits for CHAR<
+(defun char-lessp (c1 c2)
+ (or (char< c1 c2)
+ (and (string-charp c1)
+ (string-charp c2)
+ (or (char< c1 #\Space) (char> c1 #\?))
+ (or (char< c2 #\Space) (char> c2 #\?))
+ (< (logand (char-int c1) (char-int #\ ))
+ (logand (char-int c2) (char-int #\ ))))))
+
+;;;; CHAR-GREATERP - ignore case and bits for CHAR>
+(defun char-greaterp (c1 c2)
+ (or (char> c1 c2)
+ (and (string-charp c1)
+ (string-charp c2)
+ (or (char< c1 #\Space) (char> c1 #\?))
+ (or (char< c2 #\Space) (char> c2 #\?))
+ (> (logand (char-int c1) (char-int #\ ))
+ (logand (char-int c2) (char-int #\ ))))))
+
+;;;; CHAR-CODE - character to integer conversion
+(defmacro char-code (c)
+ c)
+
+;;;; CHAR-BITS - bits attribute of a character
+(defmacro char-bits (c)
+ 0)
+
+;;;; CHAR-FONT - font attribute of a character
+(defmacro char-font (c)
+ 0)
+
+;;;; CODE-CHAR - integer to character conversion, optional bits, font ignored
+(defmacro code-char (c)
+ c)
+
+;;;; CHARACTER - character plus bits and font, which are ignored
+(defun character (c)
+ (cond ((characterp c) c)
+ ((stringp c) (char c 0))
+ ((symbolp c) (char (get-pname c) 0))
+ (t (stderror (bldmsg "%r cannot be coerced to a character" c)))))
+
+;;;; CHAR-UPCASE - raise a character
+(defun char-upcase (c)
+ (if (not (or (char< c #\\a)
+ (char> c #\\z)))
+ (int-char (+ (char-int #\A)
+ (- (char-int c)
+ (char-int #\\a))))
+ c))
+
+;;;; CHAR-DOWNCASE - lower a character
+(defun char-downcase (c)
+ (if (not (or (char< c #\A)
+ (char> c #\Z)))
+ (int-char (+ (char-int #\\a)
+ (- (char-int c)
+ (char-int #\A))))
+ c))
+
+;;;; DIGIT-CHAR - convert character to digit (optional radix, bits, font NYI)
+(defun digit-char (i)
+ (when (and (>= i 0) (<= i 10))
+ (int-char (+ (char-int #\0) i))))
+
+;;;; CHAR-INT - convert character to integer
+(defmacro char-int (c)
+ ;; Identity operation in PSL
+ c)
+
+;;;; INT-CHAR - convert integer to character
+(defmacro int-char (c)
+ ;; Identity operation in PSL
+ c)
ADDED psl-1983/3-1/util/clcomp1.build
Index: psl-1983/3-1/util/clcomp1.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/clcomp1.build
@@ -0,0 +1,5 @@
+CompileTime <<
+load Useful, Common;
+off UserMode;
+>>;
+in "clcomp1.sl"$
ADDED psl-1983/3-1/util/clcomp1.sl
Index: psl-1983/3-1/util/clcomp1.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/clcomp1.sl
@@ -0,0 +1,69 @@
+%
+% CLCOMP.SL - Incompatible Common Lisp compatibility
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 12 April 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% These are Common Lisp compatiblity definitions that cause Standard Lisp
+% to break. Changes character definitions and redefines functions.
+
+(imports '(useful common fast-vector))
+
+(defmacro prog2 (first second . others)
+ `(progn ,first (prog1 ,second ,@others)))
+
+(remprop 'prog2 'compfn)
+
+(defun char (s i) (igets s i))
+
+(put 'char 'cmacro '(lambda (s i) (igets s i)))
+
+% NTH is a problem, hasn't been dealt with yet
+% Also MAP functions...
+
+(comment "make backslash the escape character")
+
+(setf IDEscapeChar* #\!\)
+(setf (elt lispscantable* #\!\) 14)
+
+(comment "Make percent a letter")
+
+(setf (elt lispscantable* #\!%) 10)
+
+(comment "Make semicolon start comments")
+
+(setf (elt lispscantable* #\;) 12)
+
+(comment "make bang a letter")
+
+(setf (elt lispscantable* #\!!) 10)
+
+(comment "Make colon the package character")
+
+(setf PackageCharacter* #\:)
+(setf (elt lispscantable* #\:) 16)
+
+(comment "Add vertical bars for reading IDs")
+
+(setf (elt lispscantable* #\|) 21)
+
+(comment "#M and #Q mean if_maclisp and if_lispm")
+
+(defun throw-away-next-form (channel qt)
+ (ChannelReadTokenWithHooks channel)
+ (ChannelReadTokenWithHooks channel))
+
+(put '!#M 'LispReadMacro 'throw-away-next-form)
+(put '!#Q 'LispReadMacro 'throw-away-next-form)
+
+(push '(M . !#M) (get '!# (getv LispScanTable* 128)))
+(push '(Q . !#Q) (get '!# (getv LispScanTable* 128)))
+
+(comment "So we can add #+psl to maclisp code")
+
+(push 'psl system_list*)
ADDED psl-1983/3-1/util/common.build
Index: psl-1983/3-1/util/common.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/common.build
@@ -0,0 +1,5 @@
+CompileTime <<
+load Useful;
+off UserMode;
+>>;
+in "common.sl"$
ADDED psl-1983/3-1/util/common.sl
Index: psl-1983/3-1/util/common.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/common.sl
@@ -0,0 +1,463 @@
+%
+% COMMON.SL - Compile- and read-time support for Common Lisp compatibility.
+% In a few cases, actually LISP Machine Lisp compatibility?
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 31 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% Edit by Lon Willett, 24 May 1984
+% Fixed bug in MakUnBound and FMakUnBound (misplaced parens)
+%
+% Edit by Cris Perdue, 7 Mar 1983 1335-PST
+% Left-expand is now available outside this module. (No longer flagged
+% as internalfunction.)
+% Edit by Cris Perdue, 4 Feb 1983 1047-PST
+% Removed ERRSET (redundant and not COMMON Lisp) and MOD (incorrect).
+% <PSL.UTIL.NEWVERSIONS>COMMON.SL.2, 13-Dec-82 21:30:58, Edit by GALWAY
+% Fixed bugs in copylist and copyalist that copied the first element
+% twice. Also fixed bug in copyalist where it failed to copy first pair
+% in the list.
+% Also started commenting the functions defined here.
+
+% These are only the Common Lisp definitions that do not conflict with
+% Standard Lisp or other PSL functions. Currently growing on a daily basis
+
+(imports '(useful fast-vector))
+
+(compiletime
+(defmacro cl-alias (sl-name cl-name)
+ `(defmacro ,cl-name form
+ `(,',sl-name . ,form)))
+
+(flag '(expand-funcall* butlast-aux nbutlast-aux
+ left-expand-aux) 'internalfunction)
+
+)
+
+(cl-alias de defun)
+
+(defmacro defvar (name . other)
+ (if *defn (fluid (list name)))
+ (if (atom other)
+ `(fluid `(,',name))
+ `(progn (fluid `(,',name))
+ (setq ,name ,(car other)))))
+
+(cl-alias idp symbolp)
+
+(cl-alias pairp consp)
+
+(defun listp (x) (or (null x) (consp x)))
+
+(put 'listp 'cmacro '(lambda (x) ((lambda (y) (or (null y) (consp y))) x)))
+
+(cl-alias fixp integerp)
+
+(cl-alias fixp characterp)
+
+(put 'characterp 'cmacro '(lambda (x) (posintp x)))
+
+(cl-alias vectorp arrayp)
+
+(cl-alias codep subrp)
+
+(defun functionp (x)
+ (or (symbolp x) (codep x) (and (consp x) (eq (car x) 'lambda))))
+
+(cl-alias eqn eql)
+
+(cl-alias equal equalp)
+
+(cl-alias valuecell symeval)
+
+(defmacro fsymeval (symbol)
+ `((lambda (***fsymeval***)
+ (or (cdr (getd ***fsymeval***))
+ (stderror (bldmsg "%r has no function definition"
+ ***fsymeval***))))
+ ,symbol))
+
+(defmacro boundp (name)
+ `(not (unboundp ,name)))
+
+(defmacro fboundp (name)
+ `(not (funboundp ,name)))
+
+(defmacro macro-p (x)
+ `(let ((y (getd ,x)))
+ (if (and (consp y) (equal (car y) 'macro)) (cdr y) nil)))
+
+(defmacro special-form-p (x)
+ `(let ((y (getd ,x)))
+ (if (and (consp y) (equal (car y) 'fexpr)) (cdr y) nil)))
+
+(defmacro fset (symbol value)
+ `(putd ,symbol 'expr ,value))
+
+(defmacro makunbound (x)
+ `(let ((y ,x)) (makunbound y) y))
+
+(defmacro fmakunbound (x)
+ `(let ((y ,x)) (remd y) y))
+
+(defmacro funcall* (fn . args)
+ `(apply ,fn ,(expand-funcall* args)))
+
+(defun expand-funcall* (args)
+ (if (null (cdr args))
+ (car args)
+ `(cons ,(car args) ,(expand-funcall* (cdr args)))))
+
+(cl-alias funcall* lexpr-funcall)
+
+% only works when calls are compiled right now
+% need to make a separate special form and compiler macro prop.
+(defmacro progv (symbols values . body)
+ `(let ((***bindmark*** (captureenvironment)))
+ (do ((symbols ,symbols (cdr symbols))
+ (values ,values (cdr values)))
+ ((null symbols) nil)
+ (lbind1 (car symbols) (car values)))
+ (prog1 (progn ,@body)
+ (restoreenvironment ***bindmark***))))
+
+(defmacro dolist (bindspec . progbody)
+ `(prog (***do-list*** ,(first bindspec))
+ (setq ***do-list*** ,(second bindspec))
+$loop$
+ (if (null ***do-list***)
+ (return ,(if (not (null (cddr bindspec)))
+ (third bindspec)
+ ())))
+ (setq ,(first bindspec) (car ***do-list***))
+ ,@progbody
+ (setq ***do-list*** (cdr ***do-list***))
+ (go $loop$)))
+
+(defmacro dotimes (bindspec . progbody)
+ `(prog (***do-times*** ,(first bindspec))
+ (setq ,(first bindspec) 0)
+ (setq ***do-times*** ,(second bindspec))
+$loop$
+ (if (= ,(first bindspec) ***do-times***)
+ (return ,(if (not (null (cddr bindspec)))
+ (third bindspec)
+ ())))
+ (setq ,(first bindspec) (+ ,(first bindspec) 1))
+ ,@progbody
+ (go $loop$)))
+
+(cl-alias map mapl)
+
+% neither PROG or PROG* supports initialization yet
+(cl-alias prog prog*)
+
+(cl-alias dm macro)
+
+% DECLARE, LOCALLY ignored now
+(defmacro declare forms
+ ())
+
+(defmacro locally forms
+ `(let () ,forms))
+
+% version of THE which does nothing
+(defmacro the (type form)
+ form)
+
+(cl-alias get getpr)
+
+(cl-alias put putpr)
+
+(cl-alias remprop rempr)
+
+(cl-alias prop plist)
+
+(cl-alias id2string get-pname)
+
+(defun samepnamep (x y)
+ (equal (get-pname x) (get-pname y)))
+
+(cl-alias newid make-symbol)
+
+(cl-alias internp internedp)
+
+(defun plusp (x)
+ (and (not (minusp x)) (not (zerop x))))
+
+(defun oddp (x)
+ (and (integerp x) (equal (remainder x 2) 1)))
+
+(defun evenp (x)
+ (and (integerp x) (equal (remainder x 2) 0)))
+
+(cl-alias eqn =)
+
+(cl-alias lessp <)
+
+(cl-alias greaterp >)
+
+(cl-alias leq <=)
+
+(cl-alias geq >=)
+
+(cl-alias neq /=)
+
+(cl-alias plus +)
+
+(defmacro - args
+ (cond ((null (cdr args))
+ `(minus ,@args))
+ ((null (cddr args))
+ `(difference ,@args))
+ (t (left-expand args 'difference))))
+
+(cl-alias times *)
+
+(defmacro / args
+ (cond ((null (cdr args))
+ `(recip ,(car args)))
+ ((null (cddr args))
+ `(quotient ,@args))
+ (t (left-expand args 'quotient))))
+
+(defun left-expand (arglist op)
+ (left-expand-aux `(,op ,(first arglist) ,(second arglist))
+ (rest (rest arglist))
+ op))
+
+(defun left-expand-aux (newform arglist op)
+ (if (null arglist) newform
+ (left-expand-aux `(,op ,newform ,(first arglist))
+ (rest arglist)
+ op)))
+
+(cl-alias add1 !1+)
+
+(cl-alias sub1 !1-)
+
+(cl-alias incr incf)
+
+(cl-alias decr decf)
+
+(defmacro logior args
+ (robustexpand args 'lor 0))
+
+(defmacro logxor args
+ (robustexpand args 'lxor 0))
+
+(defmacro logand args
+ (robustexpand args 'land -1))
+
+(cl-alias lnot lognot)
+
+(cl-alias lshift ash)
+
+(put 'ldb 'assign-op 'dpb) % Not defined, but used in NSTRUCT
+
+(put 'rplachar 'cmacro '(lambda (s i x) (iputs s i x)))
+
+(put 'char-int 'cmacro '(lambda (x) x))
+
+(put 'int-char 'cmacro '(lambda (x) x))
+
+(put 'char= 'cmacro '(lambda (x y) (eq x y)))
+
+(put 'char< 'cmacro '(lambda (x y) (ilessp x y)))
+
+(put 'char> 'cmacro '(lambda (x y) (igreaterp x y)))
+
+(cl-alias indx elt)
+
+(cl-alias setindx setelt)
+
+(defun copyseq (seq)
+ (subseq seq 0 (+ (size seq) 1)))
+
+(defun endp (x)
+ (cond ((consp x) ())
+ ((null x) t)
+ (t (stderror (bldmsg "%r is not null at end of list" x)))))
+
+(cl-alias length list-length)
+
+(cl-alias reversip nreverse)
+
+(cl-alias getv vref)
+
+(cl-alias putv vset)
+
+(put 'string= 'cmacro '(lambda (x y) (eqstr x y)))
+
+(put 'string-length 'cmacro '(lambda (x) (iadd1 (isizes x))))
+
+(put 'string-to-list 'cmacro '(lambda (x) (string2list x)))
+
+(put 'list-to-string 'cmacro '(lambda (x) (list2string x)))
+
+(put 'string-to-vector 'cmacro '(lambda (x) (string2vector x)))
+
+(put 'vector-to-string 'cmacro '(lambda (x) (vector2string x)))
+
+(put 'substring
+ 'cmacro
+ '(lambda (s low high) (sub s low (idifference high (iadd1 low)))))
+
+(defun nthcdr (n l)
+ (do ((n n (isub1 n))
+ (l l (cdr l)))
+ ((izerop n) l)))
+
+(cl-alias copy copytree)
+
+(cl-alias pair pairlis)
+
+(put 'make-string 'cmacro '(lambda (i c) (mkstring (isub1 i) c)))
+
+(defmacro putprop (symbol value indicator)
+ `(put ,symbol ,indicator ,value))
+
+(defmacro defprop (symbol value indicator)
+ `(putprop `,',symbol `,',value `,',indicator))
+
+(defmacro eval-when (time . forms)
+ (if *defn
+ (progn (when (memq 'compile time) (evprogn forms))
+ (when (memq 'load time) `(progn ,@forms)))
+ (when (memq 'eval time) `(progn ,@forms))))
+
+% This name is already used by PSL /csp
+% (defmacro case tail
+% (cons 'selectq tail)
+
+% Selectq is actually a LISP Machine LISP name /csp
+(defmacro selectq (on . s-forms)
+ (if (atom on)
+ `(cond ,@(expand-select s-forms on))
+ `((lambda (***selectq-arg***)
+ (cond ,@(expand-select s-forms '***selectq-arg***)))
+ ,on)))
+
+(defun expand-select (s-forms formal)
+ (cond ((null s-forms) ())
+ (t `((,(let ((selector (first (first s-forms))))
+ (cond ((consp selector)
+ `(memq ,formal `,',selector))
+ ((memq selector '(otherwise t))
+ t)
+ (t `(eq ,formal `,',selector))))
+ ,@(rest (first s-forms)))
+ ,@(expand-select (rest s-forms) formal)))))
+
+(defmacro comment form
+ ())
+
+(defmacro special args
+ `(fluid `,',args))
+
+(defmacro unspecial args
+ `(unfluid `,',args))
+
+(cl-alias atsoc assq)
+
+(cl-alias lastpair last)
+
+(cl-alias flatsize2 flatc)
+
+(cl-alias explode2 explodec)
+
+% swapf, exchf ...?
+
+
+(defun nthcdr (n l)
+ (do ((n n (isub1 n))
+ (l l (cdr l)))
+ ((izerop n) l)))
+
+
+(defun tree-equal (x y)
+ (if (atom x)
+ (eql x y)
+ (and (tree-equal (car x) (car y))
+ (tree-equal (cdr x) (cdr y)))))
+
+% Return a "top level copy" of a list.
+(defun copylist (x)
+ (if (atom x)
+ x
+ (let* ((x1 (cons (car x) ()))
+ (x (cdr x)))
+ (do ((x2 x1 (cdr x2)))
+ ((atom x) (rplacd x2 x) x1)
+ (rplacd x2 (cons (car x) ()))
+ (setq x (cdr x))))))
+
+% Return a copy of an a-list (copy down to the pairs but no deeper).
+(defun copyalist (x)
+ (if (atom x)
+ x
+ (let* ((x1 (cons (cons (caar x) (cdar x)) ()))
+ (x (cdr x)))
+ (do ((x2 x1 (cdr x2)))
+ ((atom x) (rplacd x2 x) x1)
+ (rplacd x2 (cons (cons (caar x) (cdar x)) ()))
+ (setq x (cdr x))))))
+
+(defun revappend (x y)
+ (if (atom x) y
+ (revappend (cdr x) (cons (car x) y))))
+
+(defun nreconc (x y)
+ (if (atom x) y
+ (let ((z (cdr x)))
+ (rplacd x y)
+ (nreconc z x))))
+
+(defun butlast (x)
+ (if (or (atom x) (atom (cdr x))) x
+ (butlast-aux x ())))
+
+(defun butlast-aux (x y)
+ (let ((z (cons (car x) y)))
+ (if (atom (cddr x)) z
+ (butlast-aux (cdr x) z))))
+
+(defun nbutlast (x)
+ (if (or (atom x) (atom (cdr x)))
+ x
+ (do ((y x (cdr y)))
+ ((atom (cddr y)) (rplacd y ())))
+ x))
+
+(defun buttail (list sublist)
+ (if (atom list)
+ list
+ (let ((list1 (cons (car list) ())))
+ (setq list (cdr list))
+ (do ((list2 list1 (cdr list2)))
+ ((or (atom list) (eq list sublist)) list1)
+ (rplacd list2 (cons (car list) ()))
+ (setq list (cdr list))))))
+
+(cl-alias substip nsubst)
+
+(defmacro ouch (char . maybe-channel)
+ (if maybe-channel
+ `(channelwritechar ,(car maybe-channel) ,char)
+ `(writechar ,char)))
+
+(defmacro inch maybe-channel
+ (if maybe-channel
+ `(channelreadchar ,(car maybe-channel))
+ `(readchar)))
+
+(defmacro uninch (char . maybe-channel)
+ (if maybe-channel
+ `(channelunreadchar ,(car maybe-channel) ,char)
+ `(unreadchar ,char)))
+
ADDED psl-1983/3-1/util/cond-macros.sl
Index: psl-1983/3-1/util/cond-macros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/cond-macros.sl
@@ -0,0 +1,21 @@
+% COND-MACROS.SL - convenient macros for conditional expressions
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+(defmacro if (predicate then . else)
+ (cond ((null else) `(cond (,predicate ,then)))
+ (t `(cond (,predicate ,then) (t . ,else)))))
+
+(defmacro xor (u v)
+% done this way to both "semi-open-code" but not repeat the code for either
+% arg; also evaluates args in the correct (left to right) order.
+ `((lambda (***XOR-ARG***) (if ,v (not ***XOR-ARG***) ***XOR-ARG***)) ,u))
+
+(defmacro when (p . c) `(cond (,p . ,c)))
+
+(defmacro unless (p . c) `(cond ((not ,p) . ,c)))
ADDED psl-1983/3-1/util/datetime.build
Index: psl-1983/3-1/util/datetime.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/datetime.build
@@ -0,0 +1,1 @@
+in "datetime.red"$
ADDED psl-1983/3-1/util/datetime.red
Index: psl-1983/3-1/util/datetime.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/datetime.red
@@ -0,0 +1,75 @@
+% MAKE.RED
+
+% Will read in two directories and compare them for DATE and TIME
+
+% Segment a string into fields:
+
+Procedure SegmentString(S,ch); % "parse" string in pieces at CH
+ Begin scalar s0,sN,sN1, Parts, sa,sb;
+ s0:=0;
+ sn:=Size(S);
+ sN1:=sN+1;
+ L1:If s0>sn then goto L2;
+ sa:=NextNonCh(Ch,S,s0,sN);
+ if sa>sN then goto L2;
+ sb:=NextCh(Ch,S,sa+1,sN);
+ if sb>SN1 then goto L2;
+ Parts:=SubSeq(S,sa,sb) . Parts;
+ s0:=sb;
+ goto L1;
+ L2:Return Reverse Parts;
+ End;
+
+Procedure NextCh(Ch,S,s1,s2);
+ <<While (S1<=S2) and not(S[S1] eq Ch) do s1:=s1+1;
+ S1>>;
+
+Procedure NextNonCh(Ch,S,s1,s2);
+ <<While (S1<=S2) and (S[S1] eq Ch) do s1:=s1+1;
+ S1>>;
+
+Fluid '(Months!*);
+
+Months!*:='(
+ ("JAN" . 1) ("FEB" . 2) ("MAR" . 3)
+ ("APR" . 4) ("MAY" . 5) ("JUN" . 6)
+ ("JUL" . 7) ("AUG" . 8) ("SEP" . 9)
+ ("OCT" . 10) ("NOV" . 11) ("DEC" . 12)
+ ("Jan" . 1) ("Feb" . 2) ("Mar" . 3)
+ ("Apr" . 4) ("May" . 5) ("Jun" . 6)
+ ("Jul" . 7) ("Aug" . 8) ("Sep" . 9)
+ ("Oct" . 10) ("Nov" . 11) ("Dec" . 12)
+);
+
+Procedure Month2Integer m;
+ cdr assoc(m,Months!*);
+
+Procedure DateTime2IntegerList(wdate,wtime);
+ Begin Scalar V;
+ V:=0;
+ wdate:=SegmentString(wdate,char '!-);
+ wtime:=SegmentString(wtime,char '!:);
+ Rplaca(cdr WDate,Month2Integer Cadr Wdate);
+ wdate:=MakeNumeric(wdate);
+ wtime:=MakeNumeric(wtime);
+ return append(wdate , wtime);
+ end;
+
+ procedure MakeNumeric(L);
+ If null L then NIL
+ else
+ String2Integer(car L) . MakeNumeric(cdr L);
+
+ procedure String2Integer S;
+ if numberP s then s
+ else if stringp s then MakeStringIntoLispInteger(s,10,1)
+ else StdError "Non-string in String2Integer";
+
+procedure CompareIntegerLists(L1,L2); % L1 <= L2
+ If Null L1 then T
+ else if Null L2 then Nil
+ else if Car L1 < Car L2 then T
+ else if Car L1 > Car L2 then NIL
+ else CompareIntegerLists(cdr L1, cdr L2);
+
+end;
ADDED psl-1983/3-1/util/debug.build
Index: psl-1983/3-1/util/debug.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/debug.build
@@ -0,0 +1,1 @@
+in "debug.red"$
ADDED psl-1983/3-1/util/debug.red
Index: psl-1983/3-1/util/debug.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/debug.red
@@ -0,0 +1,1746 @@
+% DEBUG.RED - General tracing capabilities
+% Norman and Morisson
+%---------
+% Revision History:
+% <PSL.UTIL>DEBUG.RED.21, 4-Feb-83 13:01:05, Edit by OTHMER
+% Added Br - UnBr from Mini-Trace.Red
+% Added functions UnBrAll, UnTrAll
+% Added globals TracedFns!*, BrokenFns!*
+% Changed Restr to be a macro that can take a list of file names
+% as argument
+% Removed many lines of code that had been commented out
+% <PSL.UTIL>DEBUG.RED.20, 3-Feb-83 11:00:06, Edit by KESSLER
+% Remove fluid defintion of !*mode
+% Edit by Griss, 25 January 1983, fix !*MODE and DEFINEROP
+% for REDUCE
+% <PSL.NEW>DEBUG.RED.2, 29-Dec-82 15:28:13, Edit by PERDUE
+% In the fix of 12-december, changed > to !-greaterp
+% Also added a << >> pair to !-findentries
+% <PSL.UTIL>DEBUG.RED.16, 28-Dec-82 13:50:19, Edit by PERDUE
+% Added !-TRSTCOND to handle COND correctly
+% <PSL.UTIL>DEBUG.RED, 12-Dec-82 15:59:45, Edit by GRISS
+% Fixed printx to handle 0 SIZE (i.e. one-element) vectors
+
+CompileTime flag('(!-LPRIE !-LPRIM
+ !-PAD !-IDLISTP !-CIRLIST !-FIRSTN !-LISTOFATOMS !-!-PUTD
+ !-LABELNAME !-FINDENTRIES !-PRINTPASS !-PRINS
+ !-TRGET !-TRGETX !-TRFLAGP !-TRPUT !-TRPUTX !-TRPUTX1
+ !-TRFLAG !-TRFLAG1 !-TRREMPROP !-TRREMPROPX
+ !-TRREMFLAG !-TRREMFLAG1
+ !-TRINSTALL !-ARGNAMES
+ !-TRRESTORE !-OUTRACE1 !-DUMPTRACEBUFF
+ !-ERRAPPLY
+ !-ENTERPRI !-EXITPRI !-TRINDENT !-TRACEPRI1
+ !-TRACENTRYPRI1 !-TRACEXPANDPRI
+ !-MKTRST !-MKTRST1
+ !-BTRPUSH !-BTRPOP !-BTRDUMP
+ !-EMBSUBST
+ !-TR1 !-MKSTUB
+ !-PLIST1 !-PPF1 !-GETC),
+ 'InternalFunction);
+
+%********************* Implementation dependent procedures ***********
+
+fluid '(IgnoredInBacktrace!*);
+
+IgnoredInBacktrace!* := Append('(!-TRACEDCALL !-APPLY !-GET),
+ IgnoredInBacktrace!*);
+
+%ON NOUUO; % Slow links
+
+PUTD('!-!%PROP,'EXPR,CDR GETD 'PROP);
+
+SYMBOLIC PROCEDURE !-GETPROPERTYLIST U;
+% U is an id. Returns a list of all the flags (id's) and property-values
+% (dotted pairs) of U.
+ !-!%PROP U;
+
+%DEFINE !-GETPROPERTYLIST=!-!%CDR;
+%
+%PUTD('!-ATOM,'EXPR,CDR GETD 'ATOM);
+%
+% SYMBOLIC PROCEDURE !-ATOM U;
+% A safe version of ATOM.
+% !-!%PATOM U;
+%
+%DEFINE !-ATOM=!-!%PATOM;
+%
+%GLOBAL '(!*NOUUO);
+%
+CompileTime <<
+SYMBOLIC SMACRO PROCEDURE !-SLOWLINKS;
+% Suppresses creation of fast-links
+% No-op in PSL
+ NIL;
+>>;
+%******************************************************************
+
+% Needs REDIO for sorting routine. If compiled without it only
+% the printing under the influence of COUNT will be affected.
+
+% I systematically use names starting with a '-' within this
+% package for internal routines that must not interfere with the
+% user. This means that the debug package may behave incorrectly
+% if user functions or variables have names starting with a '-';
+
+ %******************** Globals declarations ************************
+
+GLOBAL '(
+% Boolean valued flags
+ !*BTR % T -> stack traced function calls for backtrace
+ !*BTRSAVE % T -> bactrace things which fail in errorsets
+ !*INSTALL % T -> "install" trace info on all PUTD'd functions
+ !*SAVENAMES % controlls saving of substructure names in PRINTX
+ !*TRACE % T -> print trace information at run time
+ !*TRACEALL % T -> trace all functions defined with PUTD
+ !*TRSTEXPANDMACROS % T -> expand macros before embedding SETQs to print
+ !*TRUNKNOWN % T -> never ask for the number of args
+ !*TRCOUNT % T -> count # of invocations of traced functions
+% Other globals intended to be accessed outside of DEBUG
+ !*MSG %
+ BROKENFNS!* % List of functions that have been broken
+ TRACEDFNS!* % List of functions that have been traced
+ EMSG!* %
+ ERFG!* % Reduce flag
+ MSGCHNL!* % Channel to output trace information
+ PPFPRINTER!* % Used by PPF to print function bodies
+ PROPERTYPRINTER!* % Used by PLIST to print property values
+ PUTDHOOK!* % User hook run after a successful PUTD
+ STUBPRINTER!* % For printing arguments in calls on stubs
+ STUBREADER!* % For reading the return value in calls on stubs
+ TRACEMINLEVEL!* % Minimum recursive depth at which to trace
+ TRACEMAXLEVEL!* % Maximum " " " " " "
+ TRACENTRYHOOK!* % User hook into traced functions
+ TRACEXITHOOK!* % " " " " "
+ TRACEXPANDHOOK!* % " " " " "
+ TREXPRINTER!* % Function used to print args/values in traced fns
+ TRINSTALLHOOK!* % User hook called when a function is first traced
+ TRPRINTER!* % Function used to print macro expansions
+% Globals principally for internal use
+ !-ARBARGNAMES!* % List of ids to be used for unspecified names
+ !-ARGINDENT!* % Number of spaces to indent when printing args
+ !-BTRSAVEDINTERVALS!* % Saved BTR frames from within errorsets
+ !-BTRSTK!* % Stack for bactrace info
+% !-COLONERRNUM!* % Error number used by failing :CAR,:CDR, etc.
+ !-FUNCTIONFLAGS!* % Flags which PPF considers printing
+ !-GLOBALNAMES!* % Used by PRINTX to store common substructure names
+ !-INDENTCUTOFF!* % Furthest right to indent trace output
+ !-INDENTDEPTH!* % Number of spaces to indent each level trace output
+ !-INVISIBLEPROPS!* % Properties which PLIST should ignore
+ !-INVISIBLEFLAGS!* % Flags which PLIST should ignore
+ !-INSTALLEDFNS!* % Functions which have had information installed
+ !-NONSTANDARDFNS!* % Properties under which special MACRO's are stored
+% !-SAFEFNSINSTALLED!* % T -> :CAR, etc have replaced CAR, etc
+ !-TRACEBUFF!* % Ringbuffer to save recent trace output
+ !-TRACECOUNT!* % Decremented -- if >0 it may suppresses tracing
+ !-TRACEFLAG!* % Enables tracing
+ );
+
+FLUID '(
+ !*COMP % Standard Lisp flag
+ !*BACKTRACE % Reduce flag
+ !*DEFN % Reduce flag
+ !-ENTRYPOINTS!* % for PRINTX
+ !-ORIGINALFN!* % fluid argument in EMBed function calls
+ !-PRINTXCOUNT!* % Used by PRINTX for making up names for EQ structures
+ !-TRINDENT!* % Current level of indentation of trace output
+ !-VISITED!* % for PRINTX
+ );
+
+!*BTR := T;
+!*BTRSAVE := T;
+!*TRACE := T;
+!*TRCOUNT := T;
+!*TRSTEXPANDMACROS := T;
+!-ARBARGNAMES!* := '(A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 A11 A12 A13 A14 A15);
+!-ARGINDENT!* := 3;
+%!-COLONERRNUM!* := 993; % Any ideas of anything particularly appropriate?
+!-FUNCTIONFLAGS!* := '(EVAL IGNORE LOSE NOCHANGE EXPAND NOEXPAND OPFN DIRECT);
+!-INDENTCUTOFF!* := 12;
+!-INDENTDEPTH!* := 2;
+!-INVISIBLEPROPS!*:= '(TYPE !*LAMBDALINK);
+!-NONSTANDARDFNS!*:= '(SMACRO NMACRO CMACRO);
+!-TRACECOUNT!* := 0;
+!-TRINDENT!* := -1; % It's always incremented BEFORE use
+!-TRACEFLAG!* := T;
+!*MSG := T;
+PPFPRINTER!* := IF GETD 'RPRINT THEN 'RPRINT ELSE 'PRETTYPRINT;
+PROPERTYPRINTER!* := IF GETD 'PRETTYPRINT THEN 'PRETTYPRINT ELSE 'PRINT;
+STUBPRINTER!* := 'PRINTX;
+STUBREADER!* := IF GETD 'XREAD THEN '!-REDREADER ELSE '!-READ;
+TRACEMAXLEVEL!* := 10000; % Essentially no limit
+TRACEMINLEVEL!* := 0;
+TREXPRINTER!* := IF GETD 'RPRINT THEN 'RPRINT ELSE 'PRETTYPRINT;
+TRPRINTER!* := 'PRINTX;
+BrokenFns!* := Nil;
+TracedFns!* := Nil;
+
+% Let TRST know about the behaviour of some common FEXPRs
+
+FLAG('( % common FEXPRs which never pass back an unEVALed argument
+ AND
+ LIST
+ MAX
+ MIN
+ OR
+ PLUS
+ PROGN
+ REPEAT
+ TIMES
+ WHILE
+ ),'TRSTINSIDE);
+
+DEFLIST ('( % special sorts of FEXPRs
+ (LAMBDA !-TRSTPROG) % Not really a function, but handled by TRST as such
+ (PROG !-TRSTPROG)
+ (SETQ !-TRSTSETQ)
+ (COND !-TRSTCOND)
+ ),'TRSTINSIDEFN);
+
+ %****************** Utility functions ********************************
+
+% Copy the entrypoints of various key functions so that
+% nobody gets muddled by trying to trace or redefine them;
+
+PUTD('!-APPEND,'EXPR,CDR GETD 'APPEND);
+PUTD('!-APPLY,'EXPR,CDR GETD 'APPLY);
+PUTD('!-ATSOC,'EXPR,CDR GETD 'ATSOC);
+%PUTD('!-CAR,'EXPR,CDR GETD 'CAR);
+%PUTD('!-CDR,'EXPR,CDR GETD 'CDR);
+%PUTD('!-CODEP,'EXPR,CDR GETD 'CODEP);
+PUTD('!-COMPRESS,'EXPR,CDR GETD 'COMPRESS);
+%PUTD('!-CONS,'EXPR,CDR GETD 'CONS);
+PUTD('!-EQUAL,'EXPR,CDR GETD 'EQUAL);
+PUTD('!-ERRORSET,'EXPR,CDR GETD 'ERRORSET);
+PUTD('!-EVAL,'EXPR,CDR GETD 'EVAL);
+%PUTD('!-EVLIS,'EXPR,CDR GETD 'EVLIS);
+PUTD('!-EXPLODE,'EXPR,CDR GETD 'EXPLODE);
+PUTD('!-FLAG,'EXPR,CDR GETD 'FLAG);
+PUTD('!-FLAGP,'EXPR,CDR GETD 'FLAGP);
+PUTD('!-FLUID,'EXPR,CDR GETD 'FLUID);
+PUTD('!-GET,'EXPR,CDR GETD 'GET);
+PUTD('!-GETD,'EXPR,CDR GETD 'GETD);
+%PUTD('!-IDP,'EXPR,CDR GETD 'IDP);
+PUTD('!-INTERN,'EXPR,CDR GETD 'INTERN);
+PUTD('!-LENGTH,'EXPR,CDR GETD 'LENGTH);
+PUTD('!-MAX2,'EXPR,CDR GETD 'MAX2);
+PUTD('!-MEMQ,'EXPR,CDR GETD 'MEMQ);
+PUTD('!-MIN2,'EXPR,CDR GETD 'MIN2);
+PUTD('!-OPEN,'EXPR,CDR GETD 'OPEN);
+%PUTD('!-PATOM,'EXPR,CDR GETD 'PATOM);
+PUTD('!-PLUS2,'EXPR,CDR GETD 'PLUS2);
+PUTD('!-POSN,'EXPR,CDR GETD 'POSN);
+PUTD('!-PRIN1,'EXPR,CDR GETD 'PRIN1);
+PUTD('!-PRIN2,'EXPR,CDR GETD 'PRIN2);
+PUTD('!-PRINC,'EXPR,CDR GETD 'PRINC);
+PUTD('!-PRINT,'EXPR,CDR GETD 'PRINT);
+%PUTD('!-PROG,'FEXPR,CDR GETD 'PROG);
+PUTD('!-PUT,'EXPR,CDR GETD 'PUT);
+PUTD('!-PUTD,'EXPR,CDR GETD 'PUTD);
+PUTD('!-READ,'EXPR,CDR GETD 'READ);
+PUTD('!-REMD,'EXPR,CDR GETD 'REMD);
+PUTD('!-REMPROP,'EXPR,CDR GETD 'REMPROP);
+%PUTD('!-RETURN,'EXPR,CDR GETD 'RETURN);
+PUTD('!-REVERSE,'EXPR,CDR GETD 'REVERSE);
+%PUTD('!-RPLACA,'EXPR,CDR GETD 'RPLACA);
+%PUTD('!-RPLACD,'EXPR,CDR GETD 'RPLACD);
+PUTD('!-SET,'EXPR,CDR GETD 'SET);
+PUTD('!-TERPRI,'EXPR,CDR GETD 'TERPRI);
+PUTD('!-WRS,'EXPR,CDR GETD 'WRS);
+%PUTD('!-ZEROP,'EXPR,CDR GETD 'ZEROP);
+
+
+
+CompileTime <<
+
+smacro procedure alias(x, y);
+ macro procedure x u; 'y . cdr u;
+
+alias(!-DIFFERENCE, IDifference);
+alias(!-GREATERP, IGreaterP);
+alias(!-LESSP, ILessP);
+alias(!-SUB1, ISub1);
+alias(!-TIMES2, ITimes2);
+
+load Fast!-Vector;
+alias(!-GETV, IGetV);
+alias(!-UPBV, ISizeV);
+
+%alias(!-ADD1, IAdd1);
+put('!-add1, 'cmacro , '(lambda (x) (iadd1 x)));
+>>;
+
+lisp procedure !-ADD1 X; % because it gets called from EVAL
+ IAdd1 X;
+
+SYMBOLIC PROCEDURE !-LPRIE U;
+<< ERRORPRINTF("***** %L", U);
+ ERFG!* := T >>;
+
+SYMBOLIC PROCEDURE !-LPRIM U;
+ !*MSG AND ERRORPRINTF("*** %L", U);
+
+
+PUTD('!-REVERSIP, 'EXPR, CDR GETD 'REVERSIP);
+PUTD('!-MKQUOTE, 'EXPR, CDR GETD 'MKQUOTE);
+PUTD('!-EQCAR, 'EXPR, CDR GETD 'EQCAR);
+PUTD('!-SPACES, 'EXPR, CDR GETD 'SPACES);
+PUTD('!-SPACES2, 'EXPR, CDR GETD 'SPACES2);
+PUTD('!-PRIN2T, 'EXPR, CDR GETD 'PRIN2T);
+
+SYMBOLIC PROCEDURE !-PAD(L, N);
+IF FIXP N THEN
+ IF N < !-LENGTH L THEN
+ !-PAD(!-REVERSIP CDR !-REVERSE L, N)
+ ELSE IF N > !-LENGTH L THEN
+ !-PAD(!-APPEND(L, LIST NIL), N)
+ ELSE
+ L
+ELSE
+ REDERR "!-PAD given nonintegral second arg";
+
+SYMBOLIC PROCEDURE !-IDLISTP L;
+NULL L OR IDP CAR L AND !-IDLISTP CDR L;
+
+SYMBOLIC PROCEDURE !-CIRLIST(U,N);
+% Returns a circular list consisting of N U's.
+BEGIN SCALAR A,B;
+ IF NOT !-GREATERP(N,0) THEN
+ RETURN NIL;
+ B := A := U . NIL;
+ FOR I := 2:N DO
+ B := U . B;
+ RETURN RPLACD(A,B)
+END !-CIRCLIST;
+
+SYMBOLIC PROCEDURE !-FIRSTN(N,L);
+ IF N=0 THEN NIL
+ ELSE IF NULL L THEN !-FIRSTN(N,LIST GENSYM())
+ ELSE CAR L . !-FIRSTN(!-DIFFERENCE(N,1),CDR L);
+
+SYMBOLIC PROCEDURE !-LISTOFATOMS L;
+ IF NULL L THEN T
+ ELSE IF IDP CAR L THEN !-LISTOFATOMS CDR L
+ ELSE NIL;
+
+SYMBOLIC PROCEDURE !-!-PUTD(NAME,TYPE,BODY);
+% as PUTD but never compiles, and preserves TRACE property;
+ BEGIN
+ SCALAR COMP,SAVER,BOL;
+ COMP:=!*COMP; % REMEMBER STATE OF !*COMP FLAG;
+ !*COMP:=NIL; % TURN OFF COMPILATION;
+ SAVER:=!-GET(NAME,'TRACE);
+ BOL:=FLAGP(NAME,'LOSE);
+ REMFLAG(LIST NAME,'LOSE); % IGNORE LOSE FLAG;
+ !-REMD NAME; % TO MAKE THE NEXT PUTD QUIET EVEN IF I AM REDEFINING;
+ BODY:=!-PUTD(NAME,TYPE,BODY);
+ IF NOT NULL SAVER THEN !-PUT(NAME,'TRACE,SAVER);
+ !*COMP:=COMP; % RESTORE COMPILATION FLAG;
+ IF BOL THEN FLAG(LIST NAME,'LOSE);
+ RETURN BODY
+ END;
+
+
+ %******* Routines for printing looped and shared structures ******
+%
+% MAIN ENTRYPOINT:
+%
+% PRINTX (A)
+%
+% !-PRINTS THE LIST A. IF !*SAVENAMES IS TRUE CYCLES ARE PRESERVED
+% BETWEEN CALLS TO !-PRINTS;
+% PRINTX RETURNS NIL;
+
+%VARIABLES USED -
+%
+% !-ENTRYPOINTS!* ASSOCIATION LIST OF POINTS WHERE THE LIST
+% RE-ENTERS ITSELF. VALUE PART OF A-LIST ENTRY
+% IS NIL IF NODE HAS NOT YET BEEN GIVEN A NAME,
+% OTHERWISE IT IS THE NAME USED.
+%
+% !-VISITED!* LIST OF NODES THAT HAVE BEEN ENCOUNTERED DURING
+% CURRENT SCAN OF LIST
+%
+% !-GLOBALNAMES!* LIKE !-ENTRYPOINTS!*, BUT STAYS ACTIVE BETWEEN CALLS
+% TO PRINTX
+%
+% !-PRINTXCOUNT!* USED TO DECIDE ON A NAME FOR THE NEXT NODE;
+
+
+SYMBOLIC PROCEDURE !-LABELNAME();
+ BldMsg("%%L%W", !-PRINTXCOUNT!* := !-PLUS2(!-PRINTXCOUNT!*,1));
+
+SYMBOLIC PROCEDURE !-FINDENTRIES A;
+ IF NOT (PAIRP A OR VECTORP A) THEN NIL
+ ELSE IF !-ATSOC(A,!-ENTRYPOINTS!*) THEN NIL
+ ELSE IF !-MEMQ(A,!-VISITED!*) THEN
+ !-ENTRYPOINTS!*:=(A . NIL) . !-ENTRYPOINTS!*
+ ELSE
+ << !-VISITED!*:=A . !-VISITED!*;
+ IF VECTORP A THEN
+ BEGIN SCALAR N, I;
+ I := 0;
+ N := !-UPBV A;
+ WHILE NOT !-GREATERP(I, N) DO
+ << !-FINDENTRIES !-GETV(A,I);
+ I := !-ADD1 I >>;
+ END ELSE
+ << !-FINDENTRIES CAR A;
+ !-FINDENTRIES CDR A >> >>;
+
+SYMBOLIC PROCEDURE !-PRINTPASS A;
+ IF NOT (PAIRP A OR VECTORP A) THEN !-PRIN1 A
+ ELSE BEGIN SCALAR W, N, I;
+ IF !-GREATERP(!-POSN(),50) THEN !-TERPRI();
+ W:=!-ATSOC(A,!-ENTRYPOINTS!*);
+ IF NULL W THEN GO TO ORDINARY;
+ IF CDR W THEN RETURN !-PRIN2 CDR W;
+ RPLACD(W,!-PRIN2 !-LABELNAME());
+ !-PRIN2 ": ";
+ORDINARY:
+ IF VECTORP A THEN RETURN
+ << N := !-UPBV A;
+ !-PRINC '![;
+ IF !-GREATERP(N,-1) THEN % perdue fix
+ << !-PRINTPASS !-GETV(A, 0);
+ I := 1;
+ WHILE NOT !-GREATERP(I, N) DO
+ << !-PRINC '! ;
+ !-PRINTPASS !-GETV(A, I);
+ I := !-ADD1 I >> >>;
+ !-PRINC '!] >>;
+ !-PRINC '!(;
+LOOP:
+ !-PRINTPASS CAR A;
+ A:=CDR A;
+ IF NULL A THEN GOTO NILEND
+ ELSE IF ATOM A THEN GO TO ATOMEND
+ ELSE IF (W:=!-ATSOC(A,!-ENTRYPOINTS!*)) THEN GOTO LABELED;
+BLANKIT:
+ !-PRINC '! ;
+ GO TO LOOP;
+LABELED:
+ IF CDR W THEN GOTO REFER;
+ !-PRINC '! ;
+ RPLACD(W,!-PRIN2 !-LABELNAME());
+ !-PRIN2 ", ";
+ GO TO LOOP;
+REFER:
+ !-PRIN2 " . ";
+ !-PRIN2 CDR W;
+ GO TO NILEND;
+ATOMEND:
+ !-PRIN2 " . ";
+ !-PRIN1 A;
+NILEND:
+ !-PRINC '!);
+ RETURN NIL
+ END;
+
+SYMBOLIC PROCEDURE !-PRINS(A,L);
+ BEGIN
+ SCALAR !-VISITED!*,!-ENTRYPOINTS!*,!-PRINTXCOUNT!*;
+ IF ATOM L THEN !-PRINTXCOUNT!*:=0
+ ELSE << !-PRINTXCOUNT!*:=CAR L; !-ENTRYPOINTS!*:=CDR L >>;
+ !-FINDENTRIES A;
+ !-PRINTPASS A;
+ RETURN (!-PRINTXCOUNT!* . !-ENTRYPOINTS!*)
+ END;
+
+SYMBOLIC PROCEDURE PRINTX A;
+ <<IF !*SAVENAMES THEN !-GLOBALNAMES!*:=!-PRINS(A,!-GLOBALNAMES!*)
+ ELSE !-PRINS(A,NIL);
+ !-TERPRI();
+ NIL >>;
+
+
+ %****************** Trace sub-property-list functions ******************
+
+% The property TRACE is removed from any function that is subject
+% to definition or redefinition by PUTD, and so it represents
+% a good place to hide information about the function. The following
+% set of functions run a sub-property-list stored under this
+% indicator;
+
+SYMBOLIC PROCEDURE !-TRGET(ID,IND);
+ !-TRGETX(!-GET(ID,'TRACE),IND);
+
+SYMBOLIC PROCEDURE !-TRGETX(L,IND);
+% L IS A 'PROPERTY LIST' AND IND IS AN INDICATOR;
+ IF NULL L THEN NIL
+ ELSE IF !-EQCAR(CAR L,IND) THEN CDAR L
+ ELSE !-TRGETX(CDR L,IND);
+
+SYMBOLIC PROCEDURE !-TRFLAGP(ID,IND);
+ !-MEMQ(IND,!-GET(ID,'TRACE));
+
+SYMBOLIC PROCEDURE !-TRPUT(ID,IND,VAL);
+ !-PUT(ID,'TRACE,!-TRPUTX(!-GET(ID,'TRACE),IND,VAL));
+
+SYMBOLIC PROCEDURE !-TRPUTX(L,IND,VAL);
+IF !-TRPUTX1(L,IND,VAL) THEN L
+ELSE (IND . VAL) . L;
+
+SYMBOLIC PROCEDURE !-TRPUTX1(L,IND,VAL);
+BEGIN
+ L: IF NULL L THEN
+ RETURN NIL;
+ IF !-EQCAR(CAR L,IND) THEN <<
+ RPLACD(CAR L,VAL);
+ RETURN T >>;
+ L := CDR L;
+ GO TO L
+END;
+
+SYMBOLIC PROCEDURE !-TRFLAG(L,IND);
+FOR EACH ID IN L DO
+ !-TRFLAG1(ID,IND);
+
+SYMBOLIC PROCEDURE !-TRFLAG1(ID,IND);
+BEGIN SCALAR A;
+ A:=!-GET(ID,'TRACE);
+ IF NOT !-MEMQ(IND,A) THEN
+ !-PUT(ID,'TRACE,IND . A)
+END;
+
+SYMBOLIC PROCEDURE !-TRREMPROP(ID,IND);
+ << IND:=!-TRREMPROPX(!-GET(ID,'TRACE),IND);
+ IF NULL IND THEN !-REMPROP(ID,'TRACE)
+ ELSE !-PUT(ID,'TRACE,IND) >>;
+
+SYMBOLIC PROCEDURE !-TRREMPROPX(L,IND);
+ IF NULL L THEN NIL
+ ELSE IF !-EQCAR(CAR L,IND) THEN CDR L
+ ELSE CAR L . !-TRREMPROPX(CDR L,IND);
+
+SYMBOLIC PROCEDURE !-TRREMFLAG(L,IND);
+ FOR EACH ID IN L DO !-TRREMFLAG1(ID,IND);
+
+SYMBOLIC PROCEDURE !-TRREMFLAG1(ID,IND);
+ << IND:=DELETE(IND,!-GET(ID,'TRACE));
+ IF NULL IND THEN !-REMPROP(ID,'TRACE)
+ ELSE !-PUT(ID,'TRACE,IND) >>;
+
+
+ %******************* Basic functions for TRACE and friends ***********
+
+SYMBOLIC PROCEDURE !-TRINSTALL(NAM,ARGNUM);
+% Sets up TRACE properties for function NAM. This is common to all TRACE-like
+% actions. Function NAM is redefined to dispatch through !-TRACEDCALL which
+% takes various actions (which may simply be to run the original function).
+% Important items stored under the TRACE property include ORIGINALFN, which is
+% the original definition, FNTYPE, the original function "type" (e.g. EXPR,
+% MACRO ...), and ARGNAMES, a list of the names of the arguments to NAM.
+% arguments to the function. Runs TRINSTALLHOOK!* if non-nil. Returns non-nil
+% if it succeeds, nil if for some reason it fails.
+BEGIN SCALAR DEFN,CNTR,ARGS,TYP;
+ if Memq (Nam,BrokenFns!*) then
+ << EvUnBr List Nam;
+ BrokenFns!* := DelQ(Nam,BrokenFns!*) >>;
+ DEFN := !-GETD NAM;
+ IF NULL DEFN THEN <<
+ !-LPRIM LIST("Function",NAM,"is not defined.");
+ RETURN NIL >>;
+ TYP := CAR DEFN;
+ DEFN := CDR DEFN;
+ IF !-GET(NAM,'TRACE) THEN
+ IF NUMBERP ARGNUM AND TYP EQ 'FEXPR AND
+ !-TRGET(NAM,'FNTYPE) EQ 'EXPR THEN <<
+ TYP := 'EXPR;
+ !-TRREMFLAG(LIST NAM,'UNKNOWNARGS);
+ DEFN := !-TRGET(NAM,'ORIGINALFN) >>
+ ELSE
+ RETURN T
+ ELSE IF TRINSTALLHOOK!* AND
+ NOT !-ERRAPPLY(TRINSTALLHOOK!*,LIST NAM,'TRINSTALLHOOK) THEN
+ RETURN NIL;
+ !-TRPUT(NAM,'ORIGINALFN,DEFN);
+ !-TRPUT(NAM,'FNTYPE,TYP);
+ ARGS := !-ARGNAMES(NAM,DEFN,TYP,ARGNUM);
+ IF ARGS EQ 'UNKNOWN THEN <<
+ !-TRPUT(NAM,'ARGNAMES,!-ARBARGNAMES!*);
+ !-TRFLAG(LIST NAM,'UNKNOWNARGS) >>
+ ELSE
+ !-TRPUT(NAM,'ARGNAMES,ARGS);
+ CNTR := GENSYM();
+ !-FLUID LIST CNTR;
+ !-TRPUT(NAM,'LEVELVAR,CNTR);
+ !-SET(CNTR,0);
+ !-TRPUT(NAM,'COUNTER,0);
+ IF ARGS EQ 'UNKNOWN THEN
+ !-!-PUTD(NAM,
+ 'FEXPR,
+ LIST('LAMBDA,
+ '(!-L),
+ LIST(LIST('LAMBDA,
+ LIST(CNTR,'!-TRINDENT!*),
+ LIST('!-TRACEDCALL,
+ !-MKQUOTE NAM,
+ '(!-EVLIS !-L) ) ),
+ LIST('!-ADD1,CNTR),
+ '!-TRINDENT!*) ) )
+ ELSE
+ !-!-PUTD(NAM,
+ TYP,
+ LIST('LAMBDA,
+ ARGS,
+ LIST(LIST('LAMBDA,
+ LIST(CNTR,'!-TRINDENT!*),
+ LIST('!-TRACEDCALL,
+ !-MKQUOTE NAM,
+ 'LIST . ARGS) ),
+ LIST('!-ADD1,CNTR),
+ '!-TRINDENT!*) ) );
+ IF NOT !-MEMQ(NAM,!-INSTALLEDFNS!*) THEN
+ !-INSTALLEDFNS!* := NAM . !-INSTALLEDFNS!*;
+ RETURN T
+END !-TRINSTALL;
+
+SYMBOLIC PROCEDURE !-TRINSTALLIST U;
+FOR EACH V IN U DO !-TRINSTALL(V,NIL);
+
+SYMBOLIC PROCEDURE !-ARGNAMES(FN,DEFN,TYPE,NM);
+% Tries to discover the names of the arguments of FN. NM is a good guess, as
+% for instance based on the arguments to an EMB procedure. Returns UNKNOWN if
+% it can't find out. ON TRUNKNOWN will cause it to return UNKNOWN rather than
+% asking the user.
+IF !-EQCAR(DEFN,'LAMBDA) THEN % otherwise it must be a code pointer
+ CADR DEFN
+ELSE IF NOT TYPE EQ 'EXPR THEN
+ LIST CAR !-ARBARGNAMES!*
+ELSE IF (TYPE:=!-GET(FN,'ARGUMENTS!*))
+ or (TYPE := code!-number!-of!-arguments DEFN) THEN
+ IF NUMBERP TYPE THEN
+ !-FIRSTN(TYPE,!-ARBARGNAMES!*)
+ ELSE
+ CAR TYPE
+ELSE IF NUMBERP NM THEN
+ !-FIRSTN(NM,!-ARBARGNAMES!*)
+ELSE IF !*TRUNKNOWN THEN
+ 'UNKNOWN
+ELSE !-ARGNAMES1 FN;
+% BEGIN SCALAR RESULT;
+% RESULT := ERRORSET(LIST('!-ARGNAMES1,!-MKQUOTE FN),NIL,NIL);
+% IF PAIRP RESULT THEN
+% RETURN CAR RESULT
+% ELSE
+% ERROR(RESULT,EMSG!*)
+% END;
+
+FLUID '(PROMPTSTRING!*);
+
+SYMBOLIC PROCEDURE !-ARGNAMES1 FN;
+BEGIN SCALAR N, PROMPTSTRING!*;
+ PROMPTSTRING!* := BLDMSG("How many arguments does %r take? ", FN);
+AGAIN:
+ N:=READ();
+ IF N='!? THEN <<
+ !-TERPRI(); %EXPLAIN OPTIONS;
+ !-PRIN2 "Give a number, a list of atoms (for the names of";
+ !-TERPRI();
+ !-PRIN2 "the arguments) or the word 'UNKNOWN'. System security";
+ !-TERPRI();
+ !-PRIN2 "will not be good if you say UNKNOWN, but LISP will";
+ !-TERPRI();
+ !-PRIN2 "at least try to help you";
+ !-TERPRI();
+% !-PRIN2 "Number of arguments";
+ GO TO AGAIN >>
+ ELSE IF N='UNKNOWN THEN
+ RETURN N
+ ELSE IF FIXP N AND NOT !-LESSP(N,0) THEN
+ RETURN !-FIRSTN(N,!-ARBARGNAMES!*)
+ ELSE IF !-LISTOFATOMS N THEN
+ RETURN N;
+ !-TERPRI();
+ !-PRIN2 "*** Please try again, ? will explain options ";
+ GO TO AGAIN
+END !-ARGNAMES1;
+
+SYMBOLIC PROCEDURE !-TRRESTORE U;
+BEGIN SCALAR BOD,TYP;
+ IF NOT !-GET(U,'TRACE) THEN
+ RETURN;
+ BOD := !-TRGET(U,'ORIGINALFN);
+ TYP := !-TRGET(U,'FNTYPE);
+ IF NULL BOD OR NULL TYP THEN <<
+ !-LPRIM LIST("Can't restore",U);
+ RETURN >>;
+ !-REMD U;
+ !-PUTD(U,TYP,BOD);
+ !-REMPROP(U,'TRACE)
+END !-TRRESTORE;
+
+SYMBOLIC PROCEDURE REDEFINED!-PUTD(NAM,TYP,BOD);
+BEGIN SCALAR ANSWER;
+ REMPROP(NAM,'TRACE);
+ ANSWER := !-PUTD(NAM,TYP,BOD);
+ IF NULL ANSWER THEN
+ RETURN NIL;
+ IF !*TRACEALL OR !*INSTALL THEN
+ !-TRINSTALL(NAM,NIL);
+ IF !*TRACEALL THEN
+ << !-TRFLAG(LIST NAM,'TRPRINT);
+ If Not Memq (NAM, TracedFns!*) then
+ TracedFns!* := NAM . TracedFns!*>>;
+ IF PUTDHOOK!* THEN
+ APPLY(PUTDHOOK!*,LIST NAM);
+ RETURN ANSWER
+END;
+
+PUTD('PUTD, 'EXPR, CDR GETD 'REDEFINED!-PUTD);
+
+%FEXPR PROCEDURE DE U;
+%PUTD(CAR U,'EXPR,'LAMBDA . CADR U . CDDR U);
+%
+%FEXPR PROCEDURE DF U;
+%PUTD(CAR U,'FEXPR,'LAMBDA . CADR U . CDDR U);
+%
+%FEXPR PROCEDURE DM U;
+%PUTD(CAR U,'MACRO,'LAMBDA . CADR U . CDDR U);
+
+PUT('TRACEALL,'SIMPFG,'((T (SETQ !*INSTALL T))(NIL (SETQ !*INSTALL NIL))));
+PUT('INSTALL,'SIMPFG,'((NIL (SETQ !*TRACEALL NIL))));
+
+ %*********************************************************************
+
+SYMBOLIC PROCEDURE TROUT U;
+% U is a filename. Redirects trace output there.
+<< IF MSGCHNL!* THEN
+ CLOSE MSGCHNL!*;
+ MSGCHNL!* := !-OPEN(U,'OUTPUT) >>;
+
+SYMBOLIC PROCEDURE STDTRACE;
+<< IF MSGCHNL!* THEN
+ CLOSE MSGCHNL!*;
+ MSGCHNL!* := NIL >>;
+
+CompileTime <<
+SYMBOLIC MACRO PROCEDURE !-OUTRACE U;
+% Main trace output handler. !-OUTRACE(fn,arg1,...argn) calls fn(arg1,...argn)
+% as appropriate to print trace information.
+LIST('!-OUTRACE1,
+ 'LIST . MKQUOTE CADR U . FOR EACH V IN CDDR U COLLECT
+ LIST('!-MKQUOTE,V) );
+>>;
+
+SYMBOLIC PROCEDURE !-OUTRACE1 !-U;
+BEGIN SCALAR !-STATE;
+ IF !-TRACEBUFF!* THEN <<
+ RPLACA(!-TRACEBUFF!*,!-U);
+ !-TRACEBUFF!* := CDR !-TRACEBUFF!* >>;
+ IF !*TRACE THEN <<
+ !-STATE := !-ENTERPRI();
+ !-EVAL !-U;
+ !-EXITPRI !-STATE >>
+END !-OUTRACE;
+
+SYMBOLIC PROCEDURE !-DUMPTRACEBUFF DELFLG;
+% Prints the ring buffer of saved trace output stored by OUTRACE.
+% DELFLG non-nil wipes it clean as well.
+BEGIN SCALAR PTR;
+ IF NOT !-EQUAL(!-POSN(),0) THEN
+ !-TERPRI();
+ IF NULL !-TRACEBUFF!* THEN <<
+ !-PRIN2T "*** No trace information has been saved ***";
+ RETURN >>;
+ !-PRIN2T "*** Start of saved trace information ***";
+ PTR := !-TRACEBUFF!*;
+ REPEAT <<
+ !-EVAL CAR PTR;
+ IF DELFLG THEN
+ RPLACA(PTR,NIL);
+ PTR := CDR PTR >>
+ UNTIL PTR EQ !-TRACEBUFF!*;
+ !-PRIN2T "*** End of saved trace information ***";
+END !-DUMPTRACEBUFF;
+
+SYMBOLIC PROCEDURE NEWTRBUFF N;
+% Makes a new ring buffer for trace output with N entries.
+<< !-TRACEBUFF!* := !-CIRLIST(NIL,N);
+ NIL >>;
+
+!-FLAG('(NEWTRBUFF),'OPFN);
+
+NEWTRBUFF 5;
+
+SYMBOLIC PROCEDURE !-TRACEDCALL(!-NAM,!-ARGS);
+% Main routine for handling traced functions. Currently saves the number of
+% invocations of the function, prints trace information, causes EMB and TRST
+% functions to be handled correctly, calls several hooks, and stacks and
+% unstacks information in the BTR stack, if appropriate. Examines several
+% state variables and a number of function specific flags to determine what
+% must be done.
+BEGIN SCALAR !-A,!-BOD,!-VAL,!-FLG,!-LOCAL,!-STATE,!-BTRTOP,!-TYP,!-LEV,!-EMB;
+ IF !*TRCOUNT THEN
+ IF !-A := !-TRGET(!-NAM,'COUNTER) THEN
+ !-TRPUT(!-NAM,'COUNTER,!-ADD1 !-A);
+ !-TRACECOUNT!* := !-SUB1 !-TRACECOUNT!*;
+ IF !-LESSP(!-TRACECOUNT!*,1) THEN <<
+ !-TRACEFLAG!* := T;
+ IF !-EQUAL(!-TRACECOUNT!*,0) THEN <<
+ !-STATE := !-ENTERPRI();
+ !-PRIN2 "*** TRACECOUNT reached ***";
+ !-EXITPRI !-STATE >> >>;
+ IF NOT !-TRACEFLAG!* AND !-TRFLAGP(!-NAM,'TRACEWITHIN) THEN <<
+ !-TRACEFLAG!* := !-LOCAL := T;
+ !-STATE := !-ENTERPRI();
+ !-LPRIM LIST("TRACECOUNT =",!-TRACECOUNT!*);
+ !-EXITPRI !-STATE >>;
+ IF TRACENTRYHOOK!* THEN
+ !-FLG := !-ERRAPPLY(TRACENTRYHOOK!*,
+ LIST(!-NAM,!-ARGS),
+ 'TRACENTRYHOOK)
+ ELSE
+ !-FLG := T;
+ !-LEV := !-EVAL !-TRGET(!-NAM,'LEVELVAR);
+ !-FLG := !-FLG AND !-TRACEFLAG!* AND !-TRFLAGP(!-NAM,'TRPRINT) AND
+ NOT(!-LESSP(!-LEV,TRACEMINLEVEL!*) OR
+ !-GREATERP(!-LEV,TRACEMAXLEVEL!*) );
+ IF !-FLG AND !-TRFLAGP(!-NAM,'TRST) THEN
+ !-BOD := !-TRGET(!-NAM,'TRSTFN) OR !-TRGET(!-NAM,'ORIGINALFN)
+ ELSE
+ !-BOD := !-TRGET(!-NAM,'ORIGINALFN);
+ IF !-FLG THEN <<
+ !-TRINDENT!* := !-ADD1 !-TRINDENT!*;
+ !-OUTRACE(!-TRACENTRYPRI,!-NAM,!-ARGS,!-LEV,!-TRINDENT!*) >>;
+ IF !*BTR THEN
+ !-BTRTOP := !-BTRPUSH(!-NAM,!-ARGS);
+ !-TYP := !-TRGET(!-NAM,'FNTYPE);
+ IF NOT(!-TYP EQ 'EXPR) THEN
+ !-ARGS := LIST CAR !-ARGS;
+ IF !-TRFLAGP(!-NAM,'EMB) AND (!-EMB := !-TRGET(!-NAM,'EMBFN)) THEN
+ !-VAL := !-APPLY(!-EMB,!-BOD . !-ARGS)
+ ELSE
+ !-VAL := !-APPLY(!-BOD,!-ARGS);
+ IF !-TYP EQ 'MACRO THEN <<
+ IF TRACEXPANDHOOK!* THEN
+ !-ERRAPPLY(TRACEXPANDHOOK!*,
+ LIST(!-NAM,!-VAL),
+ 'TRACEXPANDHOOK);
+% IF !-FLG THEN
+% !-OUTRACE(!-TRACEXPANDPRI,!-NAM,!-VAL,!-LEV,!-TRINDENT!*);
+% !-VAL := !-EVAL !-VAL
+ >>;
+ IF !*BTR THEN
+ !-BTRPOP !-BTRTOP;
+ IF !-FLG THEN
+ !-OUTRACE(!-TRACEXITPRI,!-NAM,!-VAL,!-LEV,!-TRINDENT!*);
+ IF !-LOCAL AND !-GREATERP(!-TRACECOUNT!*,0) THEN
+ !-TRACEFLAG!* := NIL;
+ IF TRACEXITHOOK!* THEN
+ !-ERRAPPLY(TRACEXITHOOK!*,LIST(!-NAM,!-VAL),'TRACEXITHOOK);
+ RETURN !-VAL
+END !-TRACEDCALL;
+
+SYMBOLIC PROCEDURE !-ERRAPPLY(!-FN,!-ARGS,!-NAM);
+BEGIN SCALAR !-ANS,!-CHN;
+ !-ANS := !-ERRORSET(LIST('!-APPLY,!-FN,!-ARGS),T,!*BACKTRACE);
+ IF ATOM !-ANS THEN <<
+ !-CHN := !-WRS MSGCHNL!*;
+ !-PRIN2 "***** Error occured evaluating ";
+ !-PRIN2 !-NAM;
+ !-PRIN2 " *****";
+ !-TERPRI();
+ !-WRS !-CHN;
+ RETURN !-ANS >>
+ ELSE
+ RETURN CAR !-ANS
+END !-ERRAPPLY;
+
+ %************ Routines for printing trace information ***************
+
+SYMBOLIC PROCEDURE TRACECOUNT N;
+% Suppresses TRACE output until N traced function invocations have passed.
+BEGIN
+ SCALAR OLD;
+ OLD:=!-TRACECOUNT!*;
+ IF NUMBERP N THEN <<
+ !-TRACECOUNT!*:=N;
+ IF !-GREATERP(N,0) THEN
+ !-TRACEFLAG!*:=NIL
+ ELSE
+ !-TRACEFLAG!*:=T >>;
+ RETURN OLD
+END;
+
+!-FLAG('(TRACECOUNT),'OPFN);
+
+SYMBOLIC PROCEDURE TRACEWITHIN L;
+% L is a list of function names. Forces tracing to be enabled within them.
+<< !-TRFLAG(L,'TRACEWITHIN);
+ IF NOT !-GREATERP(!-TRACECOUNT!*,0) THEN <<
+ !-TRACECOUNT!*:=100000;
+ !-TRACEFLAG!*:=NIL;
+ !-LPRIM "TRACECOUNT set to 100000" >>;
+ FOR EACH U IN L CONC
+ IF !-TRINSTALL(U,NIL) THEN
+ LIST U >>;
+
+SYMBOLIC PROCEDURE TRACE L;
+% Enables tracing on each function in the list L.
+FOR EACH FN IN L CONC
+ IF !-TRINSTALL(FN,NIL) THEN <<
+ !-TRFLAG(LIST FN,'TRPRINT);
+ If Not Memq (FN, TracedFns!*) then
+ TracedFns!* := FN . TracedFns!*;
+ LIST FN >>;
+
+SYMBOLIC PROCEDURE UNTRACE L;
+% Disables tracing for each function in the list L.
+FOR EACH FN IN L CONC <<
+ !-TRREMFLAG(LIST FN,'TRACEWITHIN);
+ !-TRREMFLAG(LIST FN,'TRST);
+ IF !-TRFLAGP(FN,'TRPRINT) THEN <<
+ !-TRREMFLAG(LIST FN,'TRPRINT);
+ FN >>
+ ELSE <<
+ !-LPRIM LIST("Function",FN,"was not traced.");
+ NIL >> >>;
+
+SYMBOLIC PROCEDURE !-ENTERPRI;
+BEGIN SCALAR !-CHN,!-PSN;
+ !-CHN := !-WRS MSGCHNL!*;
+ !-PSN := !-POSN();
+ IF !-GREATERP(!-PSN,0) THEN <<
+ !-PRIN2 '!< ;
+ !-TERPRI() >>;
+ RETURN !-CHN . !-PSN
+END !-ENTERPRI;
+
+SYMBOLIC PROCEDURE !-EXITPRI !-STATE;
+BEGIN SCALAR !-PSN;
+ !-PSN := CDR !-STATE;
+ IF !-GREATERP(!-PSN,0) THEN <<
+ IF NOT !-LESSP(!-POSN(),!-PSN) THEN
+ !-TERPRI();
+ !-SPACES2 !-SUB1 !-PSN;
+ !-PRIN2 '!> >>
+ ELSE IF !-GREATERP(!-POSN(),0) THEN
+ !-TERPRI();
+ !-WRS CAR !-STATE
+END;
+
+SYMBOLIC PROCEDURE !-TRINDENT !-INDNT;
+BEGIN SCALAR !-N;
+ !-N := !-TIMES2(!-INDNT,!-INDENTDEPTH!*);
+ IF NOT !-GREATERP(!-N,!-INDENTCUTOFF!*) THEN
+ !-SPACES2 !-N
+ ELSE <<
+ !-SPACES2 !-INDENTCUTOFF!*;
+ !-PRIN2 '!* >>
+END !-TRINDENT;
+
+SYMBOLIC PROCEDURE !-TRACEPRI1(!-NAM,!-LEV,!-INDNT);
+<< !-TRINDENT !-INDNT;
+ !-PRIN1 !-NAM;
+ IF !-GREATERP(!-LEV,1) THEN <<
+ !-PRIN2 " (level ";
+ !-PRIN2 !-LEV;
+ !-PRIN2 '!) >> >>;
+
+SYMBOLIC PROCEDURE !-TRACENTRYPRI(!-NAM,!-ARGS,!-LEV,!-INDNT);
+% Handles printing trace information at entry to a function.
+!-TRACENTRYPRI1(!-NAM,!-ARGS,!-LEV,!-INDNT," being entered");
+
+SYMBOLIC PROCEDURE !-TRACENTRYPRI1(!-NAM,!-ARGS,!-LEV,!-INDNT,!-S);
+BEGIN SCALAR !-ARGNAMS;
+ !-TRACEPRI1(!-NAM,!-LEV,!-INDNT);
+ !-PRIN2 !-S;
+ !-TERPRI();
+ !-ARGNAMS := !-TRGET(!-NAM,'ARGNAMES);
+ WHILE !-ARGS DO <<
+ !-TRINDENT !-INDNT;
+ !-SPACES !-ARGINDENT!*;
+ IF !-ARGNAMS THEN <<
+ !-PRIN2 CAR !-ARGNAMS;
+ !-ARGNAMS := CDR !-ARGNAMS >>
+ ELSE
+ !-PRIN2 '!?!?!?!? ;
+ !-PRIN2 ": ";
+ APPLY(TRPRINTER!*,LIST CAR !-ARGS);
+ !-ARGS := CDR !-ARGS;
+ IF !-ARGS AND NOT !-POSN() = 0 THEN
+ !-TERPRI() >>;
+END !-TRACENTRYPRI;
+
+SYMBOLIC PROCEDURE !-TRACEXPANDPRI(!-NAM,!-EXP,!-LEV,!-INDNT);
+% Prints macro expansions.
+<< !-TRACEPRI1(!-NAM,!-LEV,!-INDNT);
+ !-PRIN2 " MACRO expansion = ";
+ APPLY(TREXPRINTER!*,LIST !-EXP) >>;
+
+SYMBOLIC PROCEDURE !-TRACEXITPRI(!-NAM,!-VAL,!-LEV,!-INDNT);
+% Prints information upon exiting a function.
+<< !-TRACEPRI1(!-NAM,!-LEV,!-INDNT);
+ !-PRIN2 " = ";
+ APPLY(TRPRINTER!*,LIST !-VAL) >>;
+
+ %*************** TRST functions ***********************************
+
+SYMBOLIC PROCEDURE TRACESET L;
+BEGIN SCALAR DFN;
+ RETURN FOR EACH FN IN L CONC
+ IF !-TRINSTALL(FN,NIL) THEN <<
+ !-TRFLAG(LIST FN,'TRPRINT);
+ If Not Memq (FN, TracedFns!*) then
+ TracedFns!* := FN . TracedFns!*;
+ DFN := !-TRGET(FN,'ORIGINALFN);
+ IF CODEP DFN THEN <<
+ !-LPRIM LIST("Function",FN,"is compiled. It cannot be traceset.");
+ NIL >>
+ ELSE <<
+ !-TRFLAG(LIST FN,'TRST);
+ IF NOT !-TRGET(FN,'TRSTFN) THEN
+ !-TRPUT(FN,'TRSTFN,!-MKTRST DFN);
+ LIST FN >> >>
+END TRACESET;
+
+SYMBOLIC PROCEDURE UNTRACESET L;
+FOR EACH FN IN L CONC
+ IF !-TRFLAGP(FN,'TRST) THEN <<
+ !-TRREMFLAG(LIST FN,'TRST);
+ LIST FN >>
+ ELSE <<
+ !-LPRIM LIST("Function",FN,"was not traceset.");
+ NIL >>;
+
+SYMBOLIC PROCEDURE !-TRSTPRI(!-NAM,!-VAL);
+<< !-OUTRACE(!-TRSTPRI1,!-NAM,!-VAL,!-TRINDENT!*);
+ !-VAL >>;
+
+SYMBOLIC PROCEDURE !-TRSTPRI1(!-NAM,!-VAL,!-INDNT);
+BEGIN SCALAR !-STATE;
+ !-STATE := !-ENTERPRI();
+ !-TRINDENT !-INDNT;
+ !-PRIN2 !-NAM;
+ !-PRIN2 " := ";
+ APPLY(TRPRINTER!*,LIST !-VAL);
+ !-EXITPRI !-STATE;
+END !-TRSTPRI;
+
+SYMBOLIC PROCEDURE !-MKTRST U;
+BEGIN SCALAR V;
+ IF ATOM U THEN
+ RETURN U;
+ IF !-FLAGP(CAR U,'TRSTINSIDE) THEN
+ RETURN !-MKTRST1 U;
+ IF V := !-GET(CAR U,'TRSTINSIDEFN) THEN
+ RETURN APPLY(V,LIST U);
+ IF IDP CAR U AND (V := !-GETD CAR U) THEN <<
+ V := CAR V;
+ IF V EQ 'FEXPR THEN
+ RETURN U;
+ IF V EQ 'MACRO THEN
+ IF !*TRSTEXPANDMACROS THEN
+ RETURN !-MKTRST APPLY(CAR U,LIST U)
+ ELSE
+ RETURN U >>;
+ RETURN !-MKTRST1 U
+END;
+
+SYMBOLIC PROCEDURE !-MKTRST1 U;
+FOR EACH V IN U COLLECT !-MKTRST V;
+
+% Functions for TRSTing certain special functions
+
+SYMBOLIC PROCEDURE !-TRSTSETQ U;
+IF ATOM CDR U OR ATOM CDDR U THEN
+ !-LPRIE LIST("Malformed expression",U)
+ELSE
+ LIST(CAR U,CADR U,LIST('!-TRSTPRI,!-MKQUOTE CADR U,!-MKTRST CADDR U));
+
+symbolic procedure !-TrstCond u;
+cons(car u,
+ for each v in cdr u collect !-MkTrST1 v);
+
+SYMBOLIC PROCEDURE !-TRSTPROG U;
+IF ATOM CDR U THEN
+ !-LPRIE LIST("Malformed expression",U)
+ELSE
+ CAR U . CADR U . !-MKTRST1 CDDR U;
+
+ %****************** Heavy handed backtrace routines *******************
+
+SYMBOLIC PROCEDURE !-BTRPUSH(!-NAM,!-ARGS);
+BEGIN SCALAR !-OSTK;
+ !-OSTK := !-BTRSTK!*;
+ !-BTRSTK!* := (!-NAM . !-ARGS) . !-OSTK;
+ RETURN !-OSTK
+END !-BTRPUSH;
+
+SYMBOLIC PROCEDURE !-BTRPOP !-PTR;
+BEGIN SCALAR !-A;
+ IF !*BTRSAVE AND NOT(!-PTR EQ CDR !-BTRSTK!*) THEN <<
+ WHILE !-BTRSTK!* AND NOT(!-PTR EQ !-BTRSTK!*) DO <<
+ !-A := CAR !-BTRSTK!* . !-A;
+ !-BTRSTK!* := CDR !-BTRSTK!* >>;
+ IF NOT(!-PTR EQ !-BTRSTK!*) THEN <<
+ !-TERPRI();
+ !-PRIN2 "***** Internal error in DEBUG: BTR stack underflow *****";
+ !-TERPRI() >>;
+ !-BTRSAVEDINTERVALS!* := !-A . !-BTRSAVEDINTERVALS!* >>
+ ELSE
+ !-BTRSTK!* := !-PTR
+END !-BTRPOP;
+
+SYMBOLIC PROCEDURE !-BTRDUMP;
+BEGIN SCALAR STK;
+ STK := !-BTRSTK!*;
+ IF NOT (!-POSN() = 0) THEN
+ !-TERPRI();
+ IF NULL STK AND NOT(!*BTRSAVE AND !-BTRSAVEDINTERVALS!*) THEN <<
+ !-PRIN2T "*** No traced functions were left abnormally ***";
+ RETURN >>;
+ !-PRIN2T "*** Backtrace: ***";
+ IF STK THEN <<
+ !-PRIN2T "These functions were left abnormally:";
+ REPEAT <<
+ !-TRACENTRYPRI1(CAAR STK,CDAR STK,1,1,"");
+ STK := CDR STK >>
+ UNTIL NULL STK >>;
+ IF !*BTRSAVE THEN
+ FOR EACH U IN !-BTRSAVEDINTERVALS!* DO <<
+ !-PRIN2T "These functions were left abnormally, but without";
+ !-PRIN2T "returning to top level:";
+ FOR EACH V IN U DO
+ !-TRACENTRYPRI1(CAR V,CDR V,1,1,"") >>;
+ !-PRIN2T "*** End of backtrace ***"
+END !-BTRDUMP;
+
+SYMBOLIC PROCEDURE BTRACE L;
+<< !*BTR := T;
+ !-BTRNEWSTK();
+ FOR EACH U IN L CONC
+ IF !-TRINSTALL(U,NIL) THEN LIST U >>;
+
+SYMBOLIC PROCEDURE !-BTRNEWSTK;
+!-BTRSTK!* := !-BTRSAVEDINTERVALS!* := NIL;
+
+!-BTRNEWSTK();
+
+PUT('BTR,'SIMPFG,'((NIL (!-BTRNEWSTK))(T (!-BTRNEWSTK))));
+
+ %********************* Embed functions ****************************
+
+SYMBOLIC PROCEDURE !-EMBSUBST(NAM,FN,NEW);
+IF ATOM FN OR CAR FN EQ 'QUOTE THEN
+ FN
+ELSE IF CAR FN EQ NAM THEN
+ NEW . '!-ORIGINALFN!* . CDR FN
+ELSE
+ FOR EACH U IN FN COLLECT !-EMBSUBST(NAM,U,NEW);
+
+SYMBOLIC MACRO PROCEDURE !-EMBCALL !-U;
+LIST('!-APPLY,CADR !-U,'LIST . CDDR !-U);
+
+SYMBOLIC PROCEDURE EMBFN(NAM,VARS,BOD);
+BEGIN SCALAR EMBF;
+ IF !*DEFN THEN << % For REDUCE;
+ OUTDEF LIST('EMBFN,!-MKQUOTE NAM,!-MKQUOTE VARS,!-MKQUOTE BOD);
+ RETURN >>;
+ IF !-TRINSTALL(NAM,!-LENGTH VARS) THEN <<
+ EMBF := !-TRGET(NAM,'EMBFN);
+ EMBF := LIST('LAMBDA,
+ '!-ORIGINALFN!* . VARS,
+ !-EMBSUBST(NAM,BOD,IF EMBF THEN EMBF ELSE '!-EMBCALL) );
+ !-TRPUT(NAM,'EMBFN,EMBF);
+ !-TRFLAG(LIST NAM,'EMB);
+ RETURN !-MKQUOTE NAM >>
+END;
+
+SYMBOLIC PROCEDURE EMBEDFNS U;
+FOR EACH X IN U CONC
+ IF !-TRGET(X,'EMBFN) THEN <<
+ X := LIST X;
+ !-TRFLAG(X,'EMB);
+ X >>
+ ELSE <<
+ !-LPRIM LIST("Procedure",X,"has no EMB definition");
+ NIL >>;
+
+SYMBOLIC PROCEDURE UNEMBEDFNS U;
+FOR EACH X IN U CONC
+ IF !-TRFLAGP(X,'EMB) THEN <<
+ X := LIST X;
+ !-TRREMFLAG(X,'EMB);
+ X >>;
+
+ %***************** Function call histogram routines *************
+
+SYMBOLIC PROCEDURE !-HISTOGRAM;
+% Simplistic histogram routine for number of function calls.
+BEGIN INTEGER M,N,NM; SCALAR NAM,NMS,NEW;
+ IF !-GETD 'TREESORT THEN % If REDIO is available
+ !-INSTALLEDFNS!* := MSORT !-INSTALLEDFNS!*;
+ !-TERPRI();
+ !-TERPRI();
+ N := 0;
+ FOR EACH U IN !-INSTALLEDFNS!* DO
+ IF !-GET(U,'TRACE) THEN <<
+ N := !-MAX2(!-TRGET(U,'COUNTER),N);
+ NEW := U . NEW >>;
+ !-INSTALLEDFNS!* := NEW;
+ N := FLOAT(LINELENGTH NIL - 21) / FLOAT N;
+ FOR EACH U IN !-INSTALLEDFNS!* DO <<
+ NAM := !-EXPLODE U;
+ NM := !-TRGET(U,'COUNTER);
+ NMS := !-EXPLODE NM;
+ M := !-MIN2(LENGTH NAM,17-LENGTH NMS);
+ FOR I := 1:M DO <<
+ !-PRINC CAR NAM;
+ NAM := CDR NAM >>;
+ !-PRINC '!( ;
+ WHILE NMS DO <<
+ !-PRINC CAR NMS;
+ NMS := CDR NMS >>;
+ !-PRINC '!) ;
+ !-SPACES2 20;
+ FOR I := FIX(NM*N) STEP -1 UNTIL 1 DO
+ !-PRINC '!* ;
+ !-TERPRI() >>;
+ !-TERPRI();
+ !-TERPRI()
+END !-HISTOGRAM;
+
+SYMBOLIC PROCEDURE !-CLEARCOUNT;
+BEGIN SCALAR NEWVAL;
+ FOR EACH U IN !-INSTALLEDFNS!* DO
+ IF !-GET(U,'TRACE) THEN <<
+ !-TRPUT(U,'COUNTER,0);
+ NEWVAL := U . NEWVAL >>;
+ !-INSTALLEDFNS!* := NEWVAL
+END !-CLEARCOUNT;
+
+% SIMPFG so ON/OFF TRCOUNT will do a histogram
+
+PUT('TRCOUNT,'SIMPFG,'((T (!-CLEARCOUNT)) (NIL (!-HISTOGRAM))));
+
+
+ %************************ TRACE related statements *********************
+
+%SYMBOLIC PROCEDURE TRSTAT;
+%% Nearly the same as RLIS2, but allows zero or more args rather than one or
+%% more.
+%BEGIN SCALAR NAM,ARGS;
+% NAM := CURSYM!*;
+% IF FLAGP!*!*(SCAN(),'DELIM) THEN
+% RETURN LIST(NAM,NIL);
+% RETURN LOOP <<
+% ARGS := MKQUOTE CURSYM!* . ARGS;
+% IF FLAGP!*!*(SCAN(),'DELIM) THEN
+% EXIT LIST(NAM,'LIST . REVERSIP ARGS)
+% ELSE IF CURSYM!* NEQ '!*COMMA!* THEN
+% SYMERR("Syntax Error",NIL);
+% SCAN() >>
+%END TRSTAT;
+
+SYMBOLIC PROCEDURE !-TR1(L,FN);
+BEGIN SCALAR X;
+ !-SLOWLINKS();
+ X := APPLY(FN,LIST L);
+ IF !*MODE EQ 'ALGEBRAIC THEN << % For REDUCE;
+ !-TERPRI();
+ !-PRINT X >>
+ ELSE
+ RETURN X
+END;
+
+MACRO PROCEDURE TR U;
+ LIST('EVTR, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVTR U;
+IF U THEN
+ !-TR1(U,'TRACE)
+ELSE
+ !-DUMPTRACEBUFF NIL;
+
+MACRO PROCEDURE UNTR U;
+ LIST('EVUNTR, MKQUOTE CDR U);
+
+procedure UnTrAll();
+ <<EvUnTr TracedFns!*;
+ TracedFns!* := Nil>>;
+
+SYMBOLIC PROCEDURE EVUNTR U;
+BEGIN SCALAR L;
+IF U THEN
+ <<!-TR1(U,'UNTRACE);
+ Foreach L in U do
+ TracedFns!*:=DelQ(L,TracedFns!*)>>
+ELSE <<
+ !-TRACEFLAG!* := NIL;
+ !-LPRIM "TRACECOUNT set to 10000";
+ !-TRACECOUNT!* := 10000 >>;
+END;
+
+MACRO PROCEDURE RESTR U;
+ LIST ('EVRESTR, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVRESTR U;
+BEGIN SCALAR L;
+ IF U THEN
+ <<FOR EACH L IN U DO
+ !-TRRESTORE L;
+ !-INSTALLEDFNS!* := DELQ (L,!-INSTALLEDFNS!*);
+ TRACEDFNS!* := DELQ (L,TRACEDFNS!*)>>
+ ELSE
+ << FOR EACH U IN !-INSTALLEDFNS!* DO
+ !-TRRESTORE U;
+ !-INSTALLEDFNS!* := NIL;
+ TRACEDFNS!* := NIL>>;
+END;
+
+MACRO PROCEDURE TRIN U;
+ LIST('EVTRIN, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVTRIN U; !-TR1(U,'TRACEWITHIN);
+
+MACRO PROCEDURE TRST U;
+ LIST('EVTRST, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVTRST U; !-TR1(U,'TRACESET);
+
+MACRO PROCEDURE UNTRST U;
+ LIST('EVUNTRST, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVUNTRST U; !-TR1(U,'UNTRACESET);
+
+MACRO PROCEDURE BTR U;
+ LIST('EVBTR, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVBTR U;
+IF U THEN
+ !-TR1(U,'BTRACE)
+ELSE
+ !-BTRDUMP();
+
+SYMBOLIC PROCEDURE RESBTR; !-BTRNEWSTK();
+
+MACRO PROCEDURE EMBED U;
+ LIST('EVEMBED, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVEMBED U; !-TR1(U,'EMBEDFNS);
+
+MACRO PROCEDURE UNEMBED U;
+ LIST('EVUNEMBED, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVUNEMBED U; !-TR1(U,'UNEMBEDFNS);
+
+MACRO PROCEDURE TRCNT U;
+ LIST('EVTRCNT, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVTRCNT U; !-TR1(U,'!-TRINSTALLIST);
+
+IF NOT FUNBOUNDP 'DEFINEROP THEN <<
+RLISTAT('(TR UNTR TRIN TRST UNTRST BTR
+ EMBED UNEMBED TRCNT RESTR FSTUB STUB PLIST PPF), 'NOQUOTE);
+RLISTAT('(TROUT), 'NOQUOTE);
+DEFINEROP('RESBTR,NIL,ESTAT('RESBTR));
+DEFINEROP('STDTRACE,NIL,ESTAT('STDTRACE));
+>>;
+
+%DEFLIST('(
+% (TR TRSTAT)
+% (UNTR RLIS2)
+% (TRIN RLIS2)
+% (TRST RLIS2)
+% (UNTRST RLIS2)
+% (BTR TRSTAT)
+% (EMBED RLIS2)
+% (UNEMBED RLIS2)
+% (TRCNT RLIS2)
+% (RESBTR ENDSTAT)
+% (RESTR RLIS2)
+% (STDTRACE ENDSTAT)
+% (TROUT IOSTAT)
+% ), 'STAT);
+
+FLAG('(TR UNTR BTR),'GO);
+
+FLAG('(TR TRIN UNTR TRST UNTRST BTR EMBED UNEMBED RESBTR RESTR TRCNT
+ TROUT STDTRACE),
+ 'IGNORE);
+
+%******************Break Functions***********************************
+
+fluid '(ArgLst!* % Default names for args in traced code
+ TrSpace!* % Number spaces to indent
+ !*NoTrArgs % Control arg-trace
+);
+
+CompileTime flag('(TrMakeArgList), 'InternalFunction);
+
+lisp procedure TrMakeArgList N; % Get Arglist for N args
+ cdr Assoc(N, ArgLst!*);
+LoadTime
+<< ArgLst!* := '((0 . ())
+ (1 . (X1))
+ (2 . (X1 X2))
+ (3 . (X1 X2 X3))
+ (4 . (X1 X2 X3 X4))
+ (5 . (X1 X2 X3 X4 X5))
+ (6 . (X1 X2 X3 X4 X5 X6))
+ (7 . (X1 X2 X3 X4 X5 X6 X7))
+ (8 . (X1 X2 X3 X4 X5 X6 X7 X8))
+ (9 . (X1 X2 X3 X4 X5 X6 X7 X8 X9))
+ (10 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10))
+ (11 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11))
+ (12 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12))
+ (13 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13))
+ (14 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14))
+ (15 . (X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15)));
+ TrSpace!* := 0;
+ !*NoTrArgs := NIL >>;
+
+Fluid '(ErrorForm!* !*ContinuableError);
+
+lisp procedure Br!.Prc(PN, B, A); % Called in place of "Broken" code
+%
+% Called by BREAKFN for proc nam PN, body B, args A;
+%
+begin scalar K, SvArgs, VV, Numb, Result;
+ TrSpace!* := TrSpace!* + 1;
+ Numb := Min(TrSpace!*, 15);
+ Tab Numb;
+ PrintF("%p %w:", PN, TrSpace!*);
+ if not !*NoTrArgs then
+ << SvArgs := A;
+ K := 1;
+ while SvArgs do
+ << PrintF(" Arg%w:=%p, ", K, car SvArgs);
+ SvArgs := cdr SvArgs;
+ K := K + 1 >> >>;
+ TerPri();
+ ErrorForm!* := NIL;
+ PrintF(" BREAK before entering %r%n",PN);
+ !*ContinuableError:=T;
+ Break();
+ VV := Apply(B, A);
+ PrintF(" BREAK after call %r, value %r%n",PN,VV);
+ ErrorForm!* := MkQuote VV;
+ !*ContinuableError:=T;
+ Result:=Break();
+ Tab Numb;
+ PrintF("%p %w:=%p%n", PN, TrSpace!*, Result);
+ TrSpace!* := TrSpace!* - 1;
+ return Result
+end;
+
+fluid '(!*Comp PromptString!*);
+
+lisp procedure Br!.1 Nam; % Called To Break a single function
+begin scalar PN, X, Y, Bod, Args, N, OldIn, OldPrompt, !*Comp;
+ if not (Y:=GetD Nam) then
+ << ErrorPrintF("*** %r is not a defined function and cannot be BROKEN",
+ Nam);
+ return >>;
+ if Memq (Nam,TracedFns!*) or Memq (Nam,!-InstalledFns!*) then
+ <<!-TrRestore Nam;
+ Y:=GetD Nam;
+ !-InstalledFns!*:=DelQ(Nam,!-InstalledFns!*);
+ TracedFns!*:=DelQ(Nam,TracedFns!*)>>;
+ if Not Memq (Nam,BrokenFns!*) then
+ BrokenFns!*:=Cons(Nam, BrokenFns!*);
+ PN := GenSym();
+ !-!-PutD(PN, car Y, cdr Y);
+ put(Nam, 'OldCod, Y . get(Nam, 'OldCod));
+ if EqCar(cdr Y, 'LAMBDA) then
+ Args := cadr cdr Y
+ else if (N:=Code!-Number!-Of!-Arguments Cdr Y) then
+ Args := TrMakeArgList N
+ else
+ << OldPrompt := PromptString!*;
+ PromptString!* := BldMsg("How many arguments for %r?", Nam);
+ OldIn := RDS NIL;
+ while not NumberP(N := Read()) or N < 0 or N > 15 do ;
+ PromptString!* := OldPrompt;
+ RDS OldIn;
+ Args := TrMakeArgList N >>;
+ Bod:= list('LAMBDA, Args,
+ list('Br!.prc, MkQuote Nam,
+ MkQuote PN, 'LIST . Args));
+ !-!-PutD(Nam, car Y, Bod);
+ put(Nam, 'BreakCode, cdr GetD Nam);
+end;
+
+lisp procedure UnBr!.1 Nam;
+begin scalar X, Y, !*Comp;
+ if not IDP Nam or not PairP(X := get(Nam, 'OldCod))
+ or not PairP(Y := GetD Nam)
+ or not (cdr Y eq get(Nam, 'BreakCode)) then
+ << ErrorPrintF("*** %r cannot be unbroken", Nam);
+ return >>;
+ !-!-PutD(Nam, caar X, cdar X);
+ RemProp(Nam, 'OldCod);
+ RemProp(Nam, 'Breakcode);
+ BrokenFns!*:=DelQ(Nam,BrokenFns!*);
+end;
+
+macro procedure Br L; %. Break functions in L
+ list('EvBr, MkQuote cdr L);
+
+expr procedure EvBr L;
+ Begin;
+ for each X in L do Br!.1 X;
+ Return L
+ end;
+
+macro procedure UnBr L; %. Unbreak functions in L
+ list('EvUnBr, MkQuote cdr L);
+
+expr procedure EvUnBr L;
+ for each X in L do UnBr!.1 X;
+
+expr procedure UnBrAll();
+ <<EvUnBr BrokenFns!*;
+ BrokenFns!* := Nil>>;
+
+ %************************ Stubs *************************************
+
+% These procedures implement stubs for Rlisp/Reduce. Usage is "STUB
+% <model function invocation> [,<model function invocation>]*
+% <semicol>". For example, to declare function FOO, BAR, and BLETCH
+% with formal parameters X,Y,Z for FOO, U for BAR, and none for BLETCH
+% do "STUB FOO(X,Y,Z),BAR U, BLETCH();". When a stub is executed it
+% announces its invocation, prettyprints its arguments, and asks for
+% the value to return. Fexpr stubs may be declared with the analogous
+% statement FSTUB.
+
+MACRO PROCEDURE STUB U;
+ LIST('EVSTUB, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVSTUB FNLIS;
+FOR EACH Y IN FNLIS DO
+ IF NOT PAIRP Y THEN
+ IF NOT IDP Y THEN
+ !-LPRIE "Function name must be an ID"
+ ELSE <<
+ !-LPRIM LIST("Stub",Y,"declared as a function of zero arguments");
+ !-MKSTUB(Y,NIL,'EXPR) >>
+ ELSE IF NOT IDP CAR Y THEN
+ !-LPRIE "Function name must be an ID"
+ ELSE IF NOT !-IDLISTP CDR Y THEN
+ !-LPRIE "Formal parameter must be an ID"
+ ELSE
+ !-MKSTUB(CAR Y,CDR Y,'EXPR);
+
+MACRO PROCEDURE FSTUB U;
+ LIST('EVFSTUB, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVFSTUB FNLIS;
+FOR EACH Y IN FNLIS DO
+ IF NOT PAIRP Y THEN
+ !-LPRIE "Arguments to FSTUB must be model function calls"
+ ELSE IF NOT IDP CAR Y THEN
+ !-LPRIE "Function name must be an ID"
+ ELSE IF NOT !-IDLISTP CDR Y THEN
+ !-LPRIE "Formal parameter must be an ID"
+ ELSE IF !-LENGTH CDR Y NEQ 1 THEN
+ !-LPRIE "An FEXPR must have exactly one formal parameter"
+ ELSE
+ !-MKSTUB(CAR Y, CDR Y, 'FEXPR);
+
+
+SYMBOLIC PROCEDURE !-MKSTUB(NAME, VARLIS, TYPE);
+PUTD(NAME,
+ TYPE,
+ LIST('LAMBDA,
+ VARLIS,
+ LIST('!-STUB1,
+ !-MKQUOTE NAME,
+ !-MKQUOTE VARLIS,
+ 'LIST . VARLIS,
+ !-MKQUOTE TYPE) ) );
+
+SYMBOLIC PROCEDURE !-STUB1(!-PNAME, !-ANAMES, !-AVALS, !-TYPE);
+% Weird variable names because of call to EVAL.
+BEGIN INTEGER !-I;
+ IF !-TYPE NEQ 'EXPR THEN
+ !-PRIN2 !-TYPE;
+ !-PRIN2 " Stub ";
+ !-PRIN2 !-PNAME;
+ !-PRIN2 " called";
+ !-TERPRI();
+ !-TERPRI();
+ !-I := 1;
+ FOR EACH !-U IN PAIR(!-PAD(!-ANAMES,!-LENGTH !-AVALS),!-AVALS) DO <<
+ IF CAR !-U THEN
+ !-PRIN2 CAR !-U
+ ELSE <<
+ !-SET(!-INTERN !-COMPRESS !-APPEND('(A R G),!-EXPLODE !-I),
+ CDR !-U);
+ !-PRIN2 "Arg #";
+ !-PRIN2 !-I >>;
+ !-PRIN2 ": ";
+ APPLY(STUBPRINTER!*, LIST CDR !-U);
+ !-I := !-I + 1 >>;
+ !-PRIN2T "Return? :";
+ RETURN !-EVAL APPLY(STUBREADER!*,NIL)
+END;
+
+SYMBOLIC PROCEDURE !-REDREADER;
+XREAD NIL;
+
+%*************** Functions for printing useful information *************
+
+MACRO PROCEDURE PLIST U;
+ LIST('EVPLIST, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVPLIST U;
+% Prints the property list and flags of U in a descent format,
+% prettyprinting nasty things. Does not print properties in the
+% global list !-INVISIBLEPROPS!* or flags in !-INVISIBLEFLAGS!*. Usage is
+% "PLIST <id> [,<id>]* <semicol>".
+<< !-TERPRI();
+ FOR EACH V IN U CONC
+ IF V := !-PLIST1 V THEN
+ LIST V >>;
+
+
+SYMBOLIC PROCEDURE !-PLIST1 U;
+BEGIN SCALAR PLST,FLGS,HASPROPS;
+ !-TERPRI();
+ IF NOT IDP U THEN <<
+ !-LPRIE LIST(U,"is not an ID");
+ RETURN NIL >>;
+ PLST := !-GETPROPERTYLIST U; % System dependent kludge
+ FOR EACH V IN PLST DO
+ IF ATOM V AND NOT !-MEMQ(V,!-INVISIBLEFLAGS!*) THEN
+ FLGS := V . FLGS
+ ELSE IF NOT !-MEMQ(CAR V,!-INVISIBLEPROPS!*) THEN <<
+ IF NOT HASPROPS THEN <<
+ HASPROPS := T;
+ !-PRIN2 "Properties for ";
+ !-PRIN1 U;
+ !-PRIN2T ":";
+ !-TERPRI() >>;
+ !-SPACES 4;
+ !-PRIN1 CAR V;
+ !-PRIN2 ":";
+ !-SPACES 2;
+ !-SPACES2 15;
+ APPLY(PROPERTYPRINTER!*,LIST CDR V) >>;
+ IF FLGS THEN <<
+ IF HASPROPS THEN
+ !-PRIN2 "Flags: "
+ ELSE <<
+ !-PRIN2 "Flags for ";
+ !-PRIN1 U;
+ !-PRIN2 ": " >>;
+ FOR EACH V IN FLGS DO <<
+ !-PRIN1 V;
+ !-SPACES 1 >>;
+ !-TERPRI();
+ !-TERPRI() >>
+ ELSE IF NOT HASPROPS THEN <<
+ !-PRIN2 "No Flags or Properties for ";
+ !-PRINT U;
+ !-TERPRI() >>;
+ IF HASPROPS OR FLGS THEN
+ RETURN U
+END !-PLIST1;
+
+MACRO PROCEDURE PPF U;
+ LIST('EVPPF, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVPPF FLIS;
+% Pretty prints one or more function definitions, from their
+% names. Usage is "PPF <name> [,<name>]* <semicol>".
+<< !-TERPRI();
+ FOR EACH FN IN FLIS CONC
+ IF FN := !-PPF1 FN THEN
+ LIST FN >>;
+
+SYMBOLIC PROCEDURE !-PPF1 FN;
+BEGIN SCALAR BOD,TYP,ARGS,TRC,FLGS;
+ IF !-GET(FN,'TRACE) THEN <<
+ BOD := !-TRGET(FN,'ORIGINALFN);
+ IF NOT CODEP BOD THEN
+ BOD := CADDR BOD;
+ TYP := !-TRGET(FN,'FNTYPE);
+ IF NOT !-TRFLAGP(FN,'UNKNOWNARGS) THEN
+ ARGS := !-TRGET(FN,'ARGNAMES);
+ IF !-TRFLAGP(FN,'TRST) THEN
+ TRC := 'TraceSet . TRC
+ ELSE IF !-TRFLAGP(FN,'TRPRINT) THEN
+ TRC := 'Traced . TRC;
+ IF !-TRFLAGP(FN,'TRACEWITHIN) THEN
+ TRC := 'TracedWithin . TRC;
+ IF !-TRFLAGP(FN,'EMB) THEN
+ TRC := 'Embeded . TRC;
+ IF NULL TRC THEN
+ TRC := '(Installed) >>
+ ELSE IF BOD := !-GETC FN THEN <<
+ TYP := CAR BOD;
+ BOD := CDR BOD;
+ IF NOT CODEP BOD THEN <<
+ ARGS := CADR BOD;
+ BOD := CDDR BOD >> >>
+ ELSE <<
+ !-LPRIE LIST("Procedure",FN,"is not defined.");
+ RETURN NIL >>;
+ FOR EACH U IN !-FUNCTIONFLAGS!* DO
+ IF !-FLAGP(FN,U) THEN
+ FLGS := U . FLGS;
+ IF NOT (!-POSN() = 0) THEN
+ !-TERPRI();
+ !-TERPRI();
+ !-PRIN2 TYP;
+ !-PRIN2 " procedure ";
+ !-PRIN1 FN;
+ IF ARGS THEN <<
+ !-PRIN2 '!( ;
+ FOR EACH U ON ARGS DO <<
+ !-PRIN1 CAR U;
+ IF CDR U THEN
+ !-PRIN2 '!, >>;
+ !-PRIN2 '!) >>;
+ IF TRC OR FLGS THEN <<
+ !-PRIN2 " [";
+ FOR EACH U IN !-REVERSIP TRC DO <<
+ !-PRIN2 U;
+ !-PRIN2 '!; >>;
+ IF TRC THEN <<
+ !-PRIN2 "Invoked ";
+ !-PRIN2 !-TRGET(FN,'COUNTER);
+ !-PRIN2 " times";
+ IF FLGS THEN
+ !-PRIN2 '!; >>;
+ IF FLGS THEN <<
+ !-PRIN2 "Flagged: ";
+ FOR EACH U ON FLGS DO <<
+ !-PRIN1 CAR U;
+ IF CDR U THEN
+ !-PRIN2 '!, >> >>;
+ !-PRIN2 '!] >>;
+ IF CODEP BOD THEN <<
+ !-PRIN2 " is compiled (";
+ !-PRIN2 BOD;
+ !-PRIN2T ")." >>
+ ELSE <<
+ !-PRIN2T '!: ;
+ FOR EACH FORM IN BOD DO APPLY(PPFPRINTER!*,LIST FORM);
+ !-TERPRI() >>;
+ RETURN FN
+END !-PPF1;
+
+
+SYMBOLIC PROCEDURE !-GETC U;
+% Like GETD, but also looks for non-standard functions, such as
+% SMACROs. The only non-standard functions looked for are those whose
+% tags appear in the list NONSTANDARDFNS!*.
+BEGIN SCALAR X,Y;
+ X := !-NONSTANDARDFNS!*;
+ Y := !-GETD U;
+ WHILE X AND NOT Y DO <<
+ Y := !-GET(U,CAR X);
+ IF Y THEN
+ Y := CAR X . Y;
+ X := CDR X >>;
+ RETURN Y
+END !-GETC;
+
+FLAG('(PPF PLIST), 'IGNORE);
+
+END;
ADDED psl-1983/3-1/util/defstruct.build
Index: psl-1983/3-1/util/defstruct.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/defstruct.build
@@ -0,0 +1,5 @@
+CompileTime <<
+load Defstruct;
+off UserMode;
+>>;
+in "defstruct.red"$
ADDED psl-1983/3-1/util/defstruct.examples-red
Index: psl-1983/3-1/util/defstruct.examples-red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/defstruct.examples-red
@@ -0,0 +1,67 @@
+% (Do definitions twice to see what functions were defined.)
+macro procedure TWICE u; list( 'PROGN, second u, second u );
+
+% A definition of Complex, structure with Real and Imaginary parts.
+% Give 0 Init values.
+TWICE
+Defstruct( Complex( !:Creator(Complex) ), R(0), I(0) );
+
+C0 := MakeComplex(); % Constructor with default inits.
+
+ComplexP C0; % Predicate.
+
+C1:=MakeComplex( R 1, I 2 ); % Constructor with named values.
+
+R(C1); I(C1); % Named selectors.
+
+C2:=Complex(3,4); % Creator with positional values.
+
+AlterComplex( C1, R(2), I(3) ); % Alterant with named values.
+
+C1;
+
+R(C1):=5; I(C1):=6; % Named depositors.
+
+C1;
+
+% Show use of Include Option. (Again, redef to show fns defined.)
+TWICE
+Defstruct( MoreComplex( !:Include(Complex) ), Z(99) );
+
+M0 := MakeMoreComplex();
+
+M1 := MakeMoreComplex( R 1, I 2, Z 3 );
+
+R C1;
+
+R M1;
+
+% A more complicated example: The structures which are used in the
+% Defstruct facility to represent defstructs. (The EX prefix has
+% been added to the names to protect the innocent...)
+TWICE % Redef to show fns generated.
+Defstruct(
+ EXDefstructDescriptor( !:Prefix(EXDsDesc), !:Creator ),
+ DsSize( !:Type int ), % (Upper Bound of vector.)
+ Prefix( !:Type string ),
+ SlotAlist( !:Type alist ), % (Cdrs are SlotDescriptors.)
+ ConsName( !:Type fnId ),
+ AltrName( !:Type fnId ),
+ PredName( !:Type fnId ),
+ CreateName( !:Type fnId ),
+ Include( !:Type typeid ),
+ InclInit( !:Type alist )
+);
+
+TWICE % Redef to show fns generated.
+Defstruct(
+ EXSlotDescriptor( !:Prefix(EXSlotDesc), !:Creator ),
+ SlotNum( !:Type int ),
+ InitForm( !:Type form ),
+ SlotFn( !:Type fnId ), % Selector/Depositor id.
+ SlotType( !:Type type ), % Hm...
+ UserGet( !:Type boolean ),
+ UserPut( !:Type boolean )
+);
+
+END;
ADDED psl-1983/3-1/util/defstruct.red
Index: psl-1983/3-1/util/defstruct.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/defstruct.red
@@ -0,0 +1,413 @@
+%
+% DEFSTRUCT.RED - Interim structure definition facility.
+%
+% Author: Russ Fish
+% Computer Science Dept.
+% University of Utah
+% Date: 18 December 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% See files Defstruct.{Hlp,Doc} for description of usage.
+
+%%%% To compile this code, it must first be loaded interpretively. %%%%
+
+%%%% Bootstrap is necessary because defstructs are used internally %%%%
+%%%% to record the descriptions of structures, including the %%%%
+%%%% descriptions of the defstruct descriptors themselves. %%%%
+
+% First, an aside to the compiler.
+CompileTime % Compiler needs to know about LHS forms which will be used.
+ put( 'SlotDescInitForm, 'Assign!-Op, 'PUTSlotDescInitForm );
+
+BothTimes % Declare lists of fluids used for binding options.
+<<
+ fluid '( DefstructOptions SlotOptions );
+
+ fluid (
+ DefstructOptions :=
+ '( !:Constructor !:Alterant !:Predicate !:Creator
+ !:Prefix !:Include !:IncludeInit ) );
+
+ fluid (
+ SlotOptions := '( !:Type !:UserGet !:UserPut ) );
+
+ flag('(defstruct), 'Eval);
+
+>>;
+
+% ////////////// Externally known fns //////////////////////////
+
+% Struct type predicate.
+lisp procedure DefstructP( Name );
+ get( Name, 'Defstruct );
+
+% Access to "struct type name" field of structure.
+lisp procedure DefstructType( Struct );
+ if VectorP Struct then % Minimal checking.
+ getv( Struct, 0 )
+ else
+ NIL;
+
+% Type inclusion predicate.
+lisp procedure SubTypeP( I1, I2 ); % T if I1 is a subtype of I2.
+begin scalar Incl;
+ return
+ I1 eq I2 % Type is subtype of itself. (LEQ.)
+ or
+ (Incl := DsDescInclude GetDefstruct I2) % Done if no subtype.
+ and
+ ( I1 eq Incl % Proper subtype.
+ or SubTypeP( I1, Incl ) ) % Or a subsubtype, or...
+end;
+
+% ////////////// Defstruct /////////////////////////////////////
+
+fexpr procedure Defstruct( Spec );
+begin scalar StructName, Init, NameValue, Desc, DsSize, SlotSpec, SlotAlist;
+
+ if atom Spec then % Spec must be a list.
+ TypeError( Spec, 'Defstruct, "a spec list" );
+
+ StructName := if atom first Spec then
+ first Spec % Grab the struct id.
+ else
+ first first Spec;
+
+ if not idp StructName then % Struct id better be one.
+ UsageTypeError( StructName, 'Defstruct, "an id", "a StructName" );
+
+ % Defaults for options.
+ !:Constructor := !:Alterant := !:Predicate := T;
+ !:Creator := !:Include := !:IncludeInit := NIL;
+ !:Prefix := "";
+
+ % Process option list if present.
+ if pairp first Spec then
+ ProcessOptions( rest first Spec, DefstructOptions );
+
+ if !:Prefix = T then % Default prefix is StructName.
+ !:Prefix := id2string StructName;
+
+ if idp !:Prefix then % Convert id to printname string.
+ !:Prefix := id2string !:Prefix
+ else
+ if not stringp !:Prefix then % Error if not id or string.
+ UsageTypeError( !:Prefix, 'Defstruct,
+ "an id or a string", "a SlotName prefix" );
+
+ % Construct macro names in default pattern if necessary.
+ if !:Constructor eq T then !:Constructor := IdConcat( 'MAKE, StructName );
+ if !:Alterant eq T then !:Alterant := IdConcat( 'ALTER, StructName );
+ if !:Predicate eq T then !:Predicate := IdConcat( StructName, 'P );
+ if !:Creator eq T then !:Creator := IdConcat( 'CREATE, StructName );
+
+ % Define the constructor, alterant, predicate, and creator, if desired.
+ MkStructMac( !:Constructor, 'Make, StructName );
+ MkStructMac( !:Alterant, 'Alter, StructName );
+ MkStructPred( !:Predicate, StructName );
+ MkStructMac( !:Creator, 'Create, StructName );
+
+ DsSize := 0; % Accumulate size, starting with the DefstructType.
+ SlotAlist := NIL;
+ if !:Include then % If including another struct, start after it.
+ if Desc := GetDefstruct( !:Include ) then
+ <<
+ DsSize := DsDescDsSize( Desc );
+
+ % Get slots of included type, modified by !:IncludeInit.
+ SlotAlist := for each Init in DsDescSlotAlist( Desc ) collect
+ <<
+ if !:IncludeInit and
+ (NameValue := atsoc( car Init, !:IncludeInit )) then
+ <<
+ Init := TotalCopy Init;
+ SlotDescInitForm cdr Init := second NameValue
+ >>;
+ Init
+ >>
+ >>
+ else
+ TypeError( !:Include, "Defstruct !:Include", "a type id" );
+
+ % Define the Selector macros, and build the alist of slot ids.
+ SlotAlist := append( SlotAlist,
+ for each SlotSpec in rest Spec collect
+ ProcessSlot( SlotSpec, !:Prefix, DsSize := DsSize+1 ) );
+
+ if Defstructp Structname then
+ ErrorPrintF("*** Defstruct %r has been redefined", StructName);
+
+ Put( StructName, 'Defstruct, % Stash the Structure Descriptor.
+
+ CreateDefstructDescriptor(
+ DsSize, !:Prefix, SlotAlist, !:Constructor, !:Alterant,
+ !:Predicate, !:Creator, !:Include, !:IncludeInit )
+ );
+
+ return StructName
+end;
+
+% Turn slot secifications into (SlotName . SlotDescriptor) pairs.
+lisp procedure ProcessSlot( SlotSpec, Prefix, SlotNum );
+begin scalar SlotName, SlotFn, It, OptList, InitForm;
+
+ % Got a few possibilities to unravel.
+ InitForm := OptList := NIL; % Only slot-name required.
+ if atom SlotSpec then
+ SlotName := SlotSpec % Bare slot-name, no default-init or options.
+ else
+ <<
+ SlotName := first SlotSpec;
+
+ if It := rest SlotSpec then % Default-init and/or options provided.
+ <<
+ % See if option immediately after name.
+ while pairp It do It := first It; % Down to first atom.
+ if idp It and memq( It, SlotOptions ) then % Option keyword?
+ OptList := rest SlotSpec % Yes, no init-form.
+ else
+ <<
+ InitForm := second SlotSpec; % Init-form after keyword.
+ OptList := rest rest SlotSpec % Options or NIL.
+ >>
+ >>
+ >>;
+
+ if not idp SlotName then % Slot id better be one.
+ UsageTypeError( SlotName, 'Defstruct, "an id", "a SlotName" );
+
+ SlotFn := if Prefix eq "" then % Slot fns may have a prefix.
+ SlotName
+ else
+ IdConcat( Prefix, Slotname );
+
+ % Defaults for options.
+ !:Type := !:UserGet := !:UserPut := NIL;
+
+ if OptList then % Process option list
+ ProcessOptions( OptList, SlotOptions );
+
+ % Make Selector and Depositor unless overridden.
+ if not !:UserGet then MkSelector( SlotFn, SlotNum );
+ if not !:UserPut then MkDepositor( SlotFn, SlotNum );
+
+ % Return the ( SlotName . SlotDescriptor ) pair.
+ return SlotName .
+
+ CreateSlotDescriptor(
+ SlotNum, InitForm, SlotFn, !:Type, !:UserGet, !:UserPut )
+end;
+
+% ////////////// Internal fns //////////////////////////////////
+
+% Process defstruct and slot options, binding values of valid options.
+lisp procedure ProcessOptions( OptList, OptVarList );
+begin scalar OptSpec, Option, OptArg;
+
+ for each OptSpec in OptList do
+ <<
+ if atom OptSpec then % Bare option id.
+ <<
+ Option := OptSpec;
+ OptArg := T
+ >>
+ else
+ <<
+ Option := first OptSpec;
+ OptArg := rest OptSpec; % List of args to option.
+ if not rest OptArg then % Single arg, unlist it.
+ OptArg := first OptArg
+ >>;
+
+ if memq( Option, OptVarList ) then
+ set( Option, OptArg )
+ else
+ UsageTypeError( Option, 'ProcessOptions,
+ ("one of" . OptVarList . "is needed"), "an option id" )
+ >>
+end;
+
+lisp procedure GetDefstruct( StructId ); % Yank struct defn from id.
+begin scalar Desc;
+ if Desc := get( StructId, 'Defstruct )
+ then return Desc % Return Struct defn.
+ else
+ TypeError( StructId, 'GetDefstruct, "a defstruct id" )
+end;
+
+lisp procedure IdConcat( I1, I2 ); % Make two-part names.
+<<
+ if idp I1 then I1 := id2String I1;
+ if idp I2 then I2 := id2String I2;
+ intern concat( I1, I2 )
+>>;
+
+% ////////////// Fn building fns ///////////////////////////////
+
+% Fn to build specific Structure Fns as macros which use generic macros.
+% The generic macro is called with the StructName and the original
+% list of arguments.
+% MacName( arg1, arg2, ... )
+% => GenericMac( StructName, arg1, arg2, ... )
+lisp procedure MkStructMac( MacName, GenericMac, StructName );
+ if MacName then % No macro if NIL name.
+ putd( MacName, 'macro,
+ list( 'lambda,
+ '(MacroArgs),
+ list( 'append,
+ list( 'quote,
+ list( GenericMac, StructName )
+ ),
+ '(rest MacroArgs)
+ )
+ )
+ );
+
+
+% Fn to build specific Structure Predicates.
+lisp procedure MkStructPred( FnName, StructName );
+ putd( FnName, 'expr,
+ list( 'lambda, '(PredArg),
+ list( 'and,
+ '(vectorp PredArg),
+ list( 'eq,
+ list('quote,StructName),
+ '(DefstructType PredArg) )
+ )
+ )
+ );
+
+% RHS selector (get fn) constructor.
+lisp procedure MkSelector( Name, Slotnum );
+ putd( Name, 'expr,
+ list( 'lambda, '(Struct), List( 'getV, 'Struct, SlotNum ) ) );
+
+% LHS depositor (put fn) constructor.
+lisp procedure MkDepositor( Name, Slotnum );
+begin scalar PutName;
+ PutName := intern concat( "PUT", id2string Name );
+
+ putd( PutName, 'expr,
+ list( 'lambda, '(Struct Val),
+ List( 'putV, 'Struct, SlotNum, 'Val ) ) );
+
+ put( Name, 'Assign!-Op, PutName );
+
+ return PutName
+end;
+
+% ////////////// Fns used by macros. ///////////////////////////
+
+% Generic macro for constructors, called with structure name and list
+% of slot-name:value-form pairs to merge with default-inits.
+% Returns vector constructor.
+macro procedure Make( ArgList );
+begin scalar StructName, OverrideAlist, Slot, NameValue;
+ StructName := second ArgList;
+ OverrideAlist := rest rest ArgList;
+
+ return append( % Return vector constructor.
+ list( 'vector,
+ list('quote,StructName) ), % Mark struct type as first element.
+
+ % Build list of init forms for vector constructor.
+ for each Slot in DsDescSlotAlist GetDefstruct StructName collect
+ if NameValue := atsoc( car Slot, OverrideAlist ) then
+ second NameValue
+ else
+ SlotDescInitForm cdr Slot
+ )
+
+end;
+
+% Generic Alterant macro, called with structure name, struct instance and
+% slot name:value alist. A list of depositor calls is returned, with a
+% PROGN wrapped around it and the struct instance at the end for a return
+% value.
+macro procedure Alter( ArgList );
+begin scalar StructName, StructInstance, SlotValueDlist, SlotAlist,
+ NameValue, Slot;
+ StructName := second ArgList;
+ StructInstance := third ArgList;
+ SlotValueDlist := rest rest rest ArgList;
+ SlotAlist := DsDescSlotAList GetDefstruct StructName;
+
+ return append( append(
+ '(PROGN), % wraparound PROGN.
+
+ % List of depositor calls.
+ for each NameValue in SlotValueDlist collect
+ if Slot := atsoc( first NameValue, SlotAlist) then
+ list(
+ % Use depositors, which may be user fns, rather than PutV.
+ IdConCat( 'PUT, SlotDescSlotFn cdr Slot ),
+ StructInstance,
+ second NameValue )
+ else
+ TypeError( car NameValue, 'Alter,
+ concat( "a slot of ", id2string StructName ) )
+
+ ), list( StructInstance ) ) % Value of PROGN is altered instance.
+end;
+
+% Generic Create macro, called with struct name and list of positional args
+% which are slot value forms. Returns struct vector constructor.
+macro procedure Create( ArgList );
+begin scalar StructName, SlotValues, DsSize;
+ StructName := second ArgList;
+ SlotValues := rest rest ArgList;
+ DsSize := DsDescDsSize GetDefstruct StructName;
+
+ if DsSize = Length SlotValues then
+ return append(
+ list( 'VECTOR,
+ list( 'quote, StructName ) ), % Mark with struct id.
+ SlotValues )
+ else
+ UsageTypeError( SlotValues, 'Create,
+ BldMsg( "a list of length %p", DsSize ),
+ concat( "an initializer for ", id2string StructName) )
+end;
+
+% ////////////// Boot Defstruct structs. ///////////////////////
+
+% Chicken-and-egg problem, need some knowledge of Defstruct descriptor
+% structures before they are defined, in order to define them.
+
+CompileTime <<
+MkSelector( 'DsDescDsSize, 1 );
+MkStructMac( 'CreateDefstructDescriptor, 'Create, 'DefstructDescriptor );
+MkStructMac( 'CreateSlotDescriptor, 'Create, 'SlotDescriptor );
+
+put( 'DefstructDescriptor, 'Defstruct, % Abbreviated struct defns for boot.
+ '[ DefstructDescriptor 9 ] ); % Just DsSize, for Create Fns.
+put( 'SlotDescriptor, 'Defstruct,
+ '[ SlotDescriptor 6 ] );
+>>;
+
+% Now really declare the Defstruct Descriptor structs.
+Defstruct(
+ DefstructDescriptor( !:Prefix(DsDesc), !:Creator ),
+ DsSize( !:Type int ), % (Upper Bound of vector.)
+ Prefix( !:Type string ),
+ SlotAlist( !:Type alist ), % (Cdrs are SlotDescriptors.)
+ ConsName( !:Type fnId ),
+ AltrName( !:Type fnId ),
+ PredName( !:Type fnId ),
+ CreateName( !:Type fnId ),
+ Include( !:Type typeid ),
+ InclInit( !:Type alist )
+);
+
+Defstruct(
+ SlotDescriptor( !:Prefix(SlotDesc), !:Creator ),
+ SlotNum( !:Type int ),
+ InitForm( !:Type form ),
+ SlotFn( !:Type fnId ), % Selector/Depositor id.
+ SlotType( !:Type type ), % Hm...
+ UserGet( !:Type boolean ),
+ UserPut( !:Type boolean )
+);
+
+END;
ADDED psl-1983/3-1/util/demo-defstruct.red
Index: psl-1983/3-1/util/demo-defstruct.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/demo-defstruct.red
@@ -0,0 +1,31 @@
+% Sample of use of <Fish.iact>DefStruct.RED
+% See <fish.iact>Defstruct.HLP
+
+Defstruct(Complex, R, I);
+
+Defstruct(Complex, R(0), I(0)); % Redefine to see what functions defined
+ % Give 0 Inits
+C0:=MakeComplex();
+ComplexP C0;
+
+C1:=MakeComplex(('R . 1), ('I . 2));
+
+AlterComplex(C1,'(R . 2), '(I . 3));
+
+Put('R,'Assign!-op,'PutR); % for LHS.
+
+R(C1):=3; I(C1):=4;
+
+C1;
+
+% Show use of Include Option.
+
+Defstruct(MoreComplex(!:Include(Complex)),Z(99));
+Defstruct(MoreComplex(!:Include(Complex)),Z(99));
+
+M0 := MakeMoreComplex();
+M1:=MakeMoreComplex('R . 1, 'I . 2, ' Z . 3);
+
+R C1;
+
+R M1;
ADDED psl-1983/3-1/util/destructure.sl
Index: psl-1983/3-1/util/destructure.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/destructure.sl
@@ -0,0 +1,78 @@
+% DESTRUCTURE.SL - Tools for destructuring and macro definition
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+(de destructure-form (target path)
+ (cond ((null target) nil)
+ ((idp target)
+ `((setq ,target ,path)))
+ ((atom target)
+ (destructure-form
+ (ContinuableError 99 (BldMsg "Can't assign to %r" target) target)
+ path))
+ (t (nconc
+ (destructure-form (car target) `(car ,path))
+ (destructure-form (cdr target) `(cdr ,path))))))
+
+(de flatten (U)
+ (cond ((null U) nil)
+ ((atom U) (list U))
+ ((null (car U)) (cons nil (flatten (cdr U))))
+ (t (append (flatten (car U)) (flatten (cdr U))))))
+
+(fluid '(*defmacro-displaces))
+
+((lambda (ub-flg)
+ (fluid '(*macro-displace))
+ (cond (ub-flg (setq *macro-displace t)))) % Only do if not already set
+ (unboundp '*macro-displace))
+
+(de defmacro-1 (U)
+% This, too, can be made more efficient if desired. Seems unnecessary, though.
+ `(dm ,(cadr U) (***DEFMACRO-ARG***)
+ (prog ,(flatten (caddr U))
+ ,.(destructure-form (caddr U) '(cdr ***DEFMACRO-ARG***))
+ (return ,(cond
+ (*defmacro-displaces
+ `(macro-displace ***DEFMACRO-ARG*** (progn ,@(cdddr U))))
+ (t `(progn ,@(cdddr U))))))))
+
+(de macro-displace (u v)
+ (cond
+ (*macro-displace
+ (rplacw u `(!%displaced-macro
+ ',(cons (car u) (cdr u))
+ ,(macroexpand v))))
+ (t v)))
+
+(dm defmacro (u) (defmacro-1 u))
+
+(dm defmacro-displace (u)
+ ((lambda (*defmacro-displaces) (defmacro-1 u)) t))
+
+(dm defmacro-no-displace (u)
+ ((lambda (*defmacro-displaces) (defmacro-1 u)) nil))
+
+(copyd '!%displaced-macro 'prog2)
+
+(setf (get '!%displaced-macro 'compfn) #'&comprogn)
+
+(defmacro desetq (U V)
+% a destructuring setq - should be made more efficient and robust
+ `((lambda (***DESETQ-VAR***)
+ ,.(destructure-form U '***DESETQ-VAR***)
+ ***DESETQ-VAR***)
+ ,V))
+
+(fluid '(*macro-debug))
+
+(defmacro-no-displace deflambda (nam vars . bod)
+ (if *macro-debug % T => deflambdas are functions and can be traced, etc.
+ `(de ,nam ,vars ,@bod)
+ `(defmacro ,nam ,vars
+ `((lambda ,',vars ,.',bod) ,.(list ,@vars)))))
ADDED psl-1983/3-1/util/evalhook.build
Index: psl-1983/3-1/util/evalhook.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/evalhook.build
@@ -0,0 +1,2 @@
+CompileTime load(Useful, CLComp);
+in "evalhook.lsp"$
ADDED psl-1983/3-1/util/evalhook.lsp
Index: psl-1983/3-1/util/evalhook.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/evalhook.lsp
@@ -0,0 +1,25 @@
+;;;
+;;; EVALHOOK.LSP - Support for special evaluation
+;;;
+;;; Author: Eric Benson
+;;; Symbolic Computation Group
+;;; Computer Science Dept.
+;;; University of Utah
+;;; Date: 30 March 1982
+;;; Copyright (c) 1982 University of Utah
+;;;
+
+(defvar evalhook () "Variable to be funcalled if not () when Eval is called")
+
+(fset 'old-eval (fsymeval 'eval)) ; Redefine Eval
+
+(defun eval (form)
+ (if evalhook
+ (let ((outer-evalhook evalhook)) ; Bind evalhook to (), then funcall it
+ (let ((evalhook ())) (funcall outer-evalhook form)))
+ (old-eval form)))
+
+;;;; EVALHOOKFN - outer evaluation uses old-eval, inner evaluations use hook
+(defun evalhookfn (form hook)
+ (let ((evalhook hook))
+ (old-eval form)))
ADDED psl-1983/3-1/util/extended-char.sl
Index: psl-1983/3-1/util/extended-char.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/extended-char.sl
@@ -0,0 +1,192 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Extender-Char.SL - 9-bit terminal input characters
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 31 August 1982
+%
+% Changes:
+% 10/15/82: added M-X macro, for convenience
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Note: this file defines MACROS, so you may need to load it at compile-time.
+% Note: this file loads FAST-INT.
+
+(load fast-int common strings)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Extended Character Manipulation Functions (or Macros)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(ds X-Base (chr)
+ % Return the base character corresponding to CHR. In other words, clear the
+ % Meta and Control bits.
+ (& chr 2#001111111))
+
+(ds X-Zero-Base (chr)
+ % Return the given character with its base code set to 0.
+ (& chr 2#110000000))
+
+(ds X-UnMeta (chr)
+ % Turn off the Meta bit in the given character.
+ (& chr 2#101111111))
+
+(ds X-UnControl (chr)
+ % Turn off the Control bit in the given character.
+ (& chr 2#011111111))
+
+(ds X-Meta? (chr)
+ % Does CHR have the Meta bit set?
+ (not (= (& chr 2#010000000) 0)))
+
+(ds X-Control? (chr)
+ % Does CHR have the Control bit set?
+ (not (= (& chr 2#100000000) 0)))
+
+(ds X-Set-Meta (chr)
+ % Set the Meta bit in CHR.
+ (| chr 2#010000000))
+
+(ds X-Set-Control (chr)
+ % Set the Control bit in CHR.
+ (| chr 2#100000000))
+
+% This version of "UpperCaseP" handles extended characters.
+(de X-UpperCaseP (chr)
+ (UpperCaseP (X-Base chr)))
+
+% This version of "LowerCaseP" handles extended characters.
+(de X-LowerCaseP (chr)
+ (LowerCaseP (X-Base chr)))
+
+(de X-Char-DownCase (chr)
+ (let ((bits (X-Zero-Base chr))
+ (base (X-Base chr))
+ )
+ (| bits (Char-DownCase base))))
+
+(de X-Char-UpCase (chr)
+ (let ((bits (X-Zero-Base chr))
+ (base (X-Base chr))
+ )
+ (| bits (Char-UpCase base))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Extended Character Creation Macro
+%
+% Examples of legal uses:
+% (x-char a) => A
+% (x-char lower a) => a
+% (x-char control a) => C-A
+% (x-char c-a) => C-A
+% (x-char ^A) => (ascii control A - code 1)
+% (x-char meta control TAB) => C-M-Tab
+% (x-char control ^A) => C-^A (^A is ASCII code 1)
+% (x-char C-M-^A) => C-M-^A (^A is ASCII code 1)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(dm X-Char (form)
+ (Create-Extended-Character (cdr form)))
+
+(de Create-Extended-Character (L)
+ (let ((plist (gensym)))
+ (for (in x L)
+ (do (cond ((IdP x) (X-Char-process-id x plist))
+ ((FixP x) (X-Char-process-fix x plist))
+ (t (put plist 'error T))
+ )))
+ (let ((base (get plist 'base)))
+ (if (or (get plist 'error) (null base))
+ (StdError (BldMsg "Invalid X-CHAR: %p" (cons 'X-CHAR L))))
+ (if (and (get plist 'Lower) (>= base #\A) (<= base #\Z))
+ (setf base (+ base 2#100000)))
+ (if (get plist 'Control)
+ (setf base (X-Set-Control base)))
+ (if (get plist 'Meta)
+ (setf base (X-Set-Meta base)))
+ base
+ )))
+
+(de X-char-process-id (id plist)
+ (prog (temp id2)
+ (cond ((eq id 'Meta) (put plist 'Meta T))
+ ((eq id 'Control) (put plist 'Control T))
+ ((eq id 'Lower) (put plist 'Lower T))
+ ((eq id 'Return) (put plist 'base 13))
+ ((< (setf temp (ID2Int id)) 128) (put plist 'base temp))
+ ((setf temp (get id 'CharConst)) (put plist 'base temp))
+ ((and (>= (size (setf temp (id2string id))) 2)
+ (= (indx temp 1) #\-))
+ (setf id2 (intern (substring temp 2 (+ 1 (size temp)))))
+ (selectq (indx temp 0)
+ (#\M (put plist 'Meta T) (X-char-process-id id2 plist))
+ (#\C (put plist 'Control T) (X-char-process-id id2 plist))
+ (t (put plist 'error T))
+ ))
+ ((and (= (size temp) 1) (= (indx temp 0) #\^))
+ (put plist 'Ascii-Control T)
+ (put plist 'base (& (indx temp 1) 2#11111))
+ )
+ (t (put plist 'error T))
+ )))
+
+(de X-Char-process-fix (x plist)
+ (cond ((and (>= x 0) (<= x 9)) (put plist 'base (+ x #\0)))
+ (t (put plist 'error T))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% X-Chars
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Generate a list of character codes from a list of "character descriptors",
+% which are argument lists to the X-CHAR macro.
+
+(dm x-chars (chlist)
+ (cons 'list
+ (for (in x (cdr chlist))
+ (collect (cons 'x-char (if (pairp x) x (list x)))))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Printable names for extended characters:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(character-name-table))
+
+% An association list of (character code . name), used by x-char-name.
+
+(setf character-name-table '(
+ (8#0 . "Null")
+ (8#7 . "Bell")
+ (8#10 . "Backspace")
+ (8#11 . "Tab")
+ (8#12 . "Newline")
+ (8#15 . "Return")
+ (8#33 . "Escape")
+ (8#40 . "Space")
+ (8#177 . "Rubout")
+ ))
+
+(de x-char-name (ch)
+ % Return a string giving the name for an extended character.
+
+ (cond
+ ((not (FixP ch)) (BldMsg "<%o>" ch))
+ ((atsoc ch character-name-table) (cdr (atsoc ch character-name-table)))
+ ((X-Control? ch) (string-concat "C-" (x-char-name (X-UnControl ch))))
+ ((X-Meta? ch) (string-concat "M-" (x-char-name (X-UnMeta ch))))
+ ((GraphicP ch) (string ch))
+ ((and (>= ch 0) (< ch (char space)))
+ (string-concat "^" (x-char-name (LXor ch 8#100))))
+ (t (BldMsg "<%o>" ch))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% M-X Macro
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro m-x (command-string)
+ `(list (x-char M-X) ,command-string))
ADDED psl-1983/3-1/util/f-dstruct.build
Index: psl-1983/3-1/util/f-dstruct.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/f-dstruct.build
@@ -0,0 +1,2 @@
+CompileTime LOAD(DEFSTRUCT,SYSLISP,INUM,FAST!-VECTOR);
+in "f-dstruct.red"$
ADDED psl-1983/3-1/util/f-dstruct.red
Index: psl-1983/3-1/util/f-dstruct.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/f-dstruct.red
@@ -0,0 +1,43 @@
+% Fast Defstruct Improvements;
+% M.L. Griss
+% Load after Defstruct to redefine basic Selectors
+
+FLUID '(DefGetFn!* DefPutFn!* !*DefFnAsExpr);
+
+LoadTime <<
+ DefGetFn!*:='IGetv;
+ DefPutFn!*:='IPutv;
+ !*DefFnAsExpr:=NIL;>>;
+
+% RHS selector (get fn) constructor.
+lisp procedure MkSelector( Name, Slotnum );
+ If !*DefFnAsExpr then
+ putd( Name, 'expr,
+ list( 'lambda, '(Struct), List( DefGetFn!*, 'Struct, SlotNum ) ) )
+ else Putd(name,'macro,
+ list('lambda,'(struct),
+ List('LIST,MkQuote DefGetFn!*,'(Cadr Struct),MkQuote SlotNum)));
+
+% LHS depositor (put fn) constructor.
+lisp procedure MkDepositor( Name, Slotnum );
+begin scalar PutName;
+ PutName := intern concat( "PUT", id2string Name );
+ If !*DefFnAsExpr then
+ putd( PutName, 'expr,
+ list( 'lambda, '(Struct Val),
+ List( DefPutFn!*, 'Struct, SlotNum, 'Val ) ) )
+ else Putd(PutName,'macro,
+ list('lambda,'(struct),
+ List('List,MkQuote DefPutFn!*,
+ '(Cadr Struct),
+ MkQuote SlotNum,
+ '(Caddr Struct)
+))
+ );
+
+ put( Name, 'Assign!-Op, PutName );
+
+ return PutName
+end;
+
+END;
ADDED psl-1983/3-1/util/fast-arith.build
Index: psl-1983/3-1/util/fast-arith.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-arith.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp;
+in "fast-arith.red"$
ADDED psl-1983/3-1/util/fast-arith.red
Index: psl-1983/3-1/util/fast-arith.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-arith.red
@@ -0,0 +1,89 @@
+% speed up generic arith for V3
+% MLG, 9:25pm Friday, 21 May 1982
+
+ON SYSLISP;
+
+SYSLSP PROCEDURE FASTPLUS2(I1,I2);
+ Begin Scalar x;
+ IF INTP(I1) AND INTP(I2)
+ AND (X:= WPLUS2(I1,I2)) EQ X
+ THEN RETURN X;
+ Return Oldplus2(I1,I2);
+ End;
+
+SYSLSP PROCEDURE FASTTIMES2(I1,I2);
+Begin Scalar x;
+ IF INTP(I1) AND INTP(I2)
+ AND (X:= WTIMES2(I1,I2)) EQ X
+ Then return X;
+ RETURN OLDTimes2(I1,I2);
+END;
+
+SYSLSP PROCEDURE FASTDIFFERENCE(I1,I2);
+Begin Scalar x;
+ IF INTP(I1) AND INTP(I2)
+ AND (X:=WDIFFERENCE(I1,I2)) EQ X
+ Then return x;
+ RETURN OldDifference(I1,I2);
+END;
+
+SYSLSP PROCEDURE FASTADD1 I1;
+Begin Scalar x;
+ IF INTP(I1)
+ AND (x:= IADD1 I1) EQ x
+ then Return x;
+ RETURN OldAdd1 I1;
+END;
+
+SYSLSP PROCEDURE FASTSUB1 I1;
+Begin Scalar x;
+ IF INTP(I1)
+ AND (X:= ISUB1 I1) EQ X
+ then Return x;
+ RETURN OldSub1 I1;
+ end;
+
+SYSLSP PROCEDURE FASTZerop I1;
+ IF INTP(I1) THEN WEQ(I1, 0)
+ else OldZerop I1;
+
+SYSLSP PROCEDURE FASTMinusp I1;
+ IF INTP(I1) THEN WLESSP(I1, 0)
+ ELSE OldMinusp I1;
+
+SYSLSP PROCEDURE FASTGreaterp(I1,I2);
+ IF INTP(I1) AND INTP(I2) THEN WGREATERP(I1,I2)
+ ELSE OldGreaterp I1;
+
+SYSLSP PROCEDURE FASTlessP(I1,I2);
+ IF INTP(I1) AND INTP(I2) THEN WLESSP(I1,I2)
+ ELSE OldLessP I1;
+
+off syslisp;
+
+lisp procedure Faster;
+Begin
+!*usermode:=NIL;
+
+COPYD('OLDPlus2,'Plus2);
+COPYD('OLDTimes2,'Times2);
+COPYD('OLDDifference,'Difference);
+COPYD('OLDZeroP,'Zerop);
+
+COPYD('OLDLessP,'LessP);
+COPYD('OLDGreaterP,'GreaterP);
+COPYD('OLDAdd1,'Add1);
+COPYD('OLDSub1,'Sub1);
+
+COPYD('Plus2,'FastPlus2);
+COPYD('Times2,'FastTimes2);
+COPYD('Difference,'FastDifference);
+COPYD('ZeroP,'FastZerop);
+
+COPYD('LessP,'FastLessP);
+COPYD('GreaterP,'FastGreaterP);
+COPYD('Add1,'FastAdd1);
+COPYD('Sub1,'FastSub1);
+end;
+
+END;
ADDED psl-1983/3-1/util/fast-evectors.sl
Index: psl-1983/3-1/util/fast-evectors.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-evectors.sl
@@ -0,0 +1,42 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Fast-EVectors.sl -- Fast compiled EVector operations
+%%% Author: Cris Perdue
+%%% Date: 8 Apr 1983
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% This is a facility so the user can generate code to access
+%%% evectors that runs fast. To use this facility, LOAD (don't
+%%% IMPORT) it at compiletime. It does an (on fast-evectors),
+%%% turning on the generation of faster code. The feature may be
+%%% turned off and on by the user. The affected evector
+%%% functions are EGetV, EPutV, and ESizeV.
+
+(compiletime (load if-system data-machine))
+
+(put 'fast-evectors 'simpfg '((t (enable-fast-evectors))
+ (nil (disable-fast-evectors))))
+
+(if_system VAX
+(de enable-fast-evectors ()
+ (DefList '((EGetV (lambda (V I) (EVecItm (EVecInf V) I)))
+ (EPutV (lambda (V I X) (PutEVecItm (EVecInf V) I X)))
+ (ESizeV (lambda (V) (EVecLen (EVecInf V))))) 'CMacro)))
+
+(if_system PDP10 % tags don't need to be stripped on the PDP10
+(de enable-fast-evectors ()
+ (DefList '((EGetV (lambda (V I) (EVecItm V I)))
+ (EPutV (lambda (V I X) (PutEVecItm V I X)))
+ (ESizeV (lambda (V) (EVecLen V)))) 'CMacro)))
+
+(if_system MC68000 % tags don't need to be stripped on the 68000
+(de enable-fast-evectors ()
+ (DefList '((EGetV (lambda (V I) (EVecItm V I)))
+ (EPutV (lambda (V I X) (PutEVecItm V I X)))
+ (ESizeV (lambda (V) (EVecLen V)))) 'CMacro)))
+
+(de disable-fast-evectors ()
+ (remprop 'egetv 'cmacro)
+ (remprop 'eputv 'cmacro)
+ (remprop 'esizev 'cmacro))
+
+(loadtime (on fast-evectors))
ADDED psl-1983/3-1/util/fast-int.sl
Index: psl-1983/3-1/util/fast-int.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-int.sl
@@ -0,0 +1,16 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Fast-Int.SL - Integer Operators (Compiled "Open")
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 24 September 1982
+% Revised: 11 January 1983
+%
+% This file survives only for backward compatibility.
+% It has been replaced by NUMERIC-OPERATORS.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(load numeric-operators)
+(bothtimes (on fast-integers))
ADDED psl-1983/3-1/util/fast-strings.sl
Index: psl-1983/3-1/util/fast-strings.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-strings.sl
@@ -0,0 +1,27 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% FAST-STRINGS - Fast (unchecked) version of String Functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 September 1982
+%
+% Load this at compile-time to make compiled invocations of the following
+% functions fast (and unchecked):
+%
+% (string-fetch s i)
+% (string-store s i ch)
+% (string-length s)
+% (string-upper-bound s)
+% (string-empty? s)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(load slow-strings) % for the interpreted versions
+(CompileTime (load fast-vector)) % for machine-dependent primitives
+
+(put 'string-fetch 'cmacro '(lambda (s i) (igets s i)))
+(put 'string-store 'cmacro '(lambda (s i c) (iputs s i c)))
+(put 'string-length 'cmacro '(lambda (s) (Wplus2 (isizes s) 1)))
+(put 'string-upper-bound 'cmacro '(lambda (s) (isizes s)))
+(put 'string-empty? 'cmacro '(lambda (s) (WLessP (isizes s) 0)))
ADDED psl-1983/3-1/util/fast-struct.lsp
Index: psl-1983/3-1/util/fast-struct.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-struct.lsp
@@ -0,0 +1,148 @@
+(defstruct-define-type :fast-vector
+ (:named :named-fast-vector) ; but probably not much point
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(vector ,@arg))
+ (:defstruct (x) (let ((*insideload t)) (load fast-vector) nil))
+ (:ref
+ (n description arg)
+ description ;ignored
+ `(igetv ,arg ,n)))
+
+;added for PSL
+
+(defstruct-define-type :named-fast-vector
+ (:keywords :make-vector)
+ :named (:overhead 1)
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(vector ',(defstruct-description-name) ,@arg))
+ (:defstruct (x) (let ((*insideload t)) (load fast-vector) nil))
+ (:ref
+ (n description arg)
+ description ;ignored
+ `(igetv ,arg ,(add1 n))))
+
+(defstruct-define-type hashed-list
+ (:named :named-hashed-list)
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(hlist . ,arg))
+ (:ref
+ (n description arg)
+ description ;ignored
+ #+Multics `(,(let ((i (\ n 4)))
+ (cond ((= i 0) 'car)
+ ((= i 1) 'cadr)
+ ((= i 2) 'caddr)
+ (t 'cadddr)))
+ ,(do ((a arg `(cddddr ,a))
+ (i (// n 4) (1- i)))
+ ((= i 0) a)))
+; PSL change incompatible NTH
+ #-Multics `(nth ,arg ,(add1 n))))
+; #-Multics `(nth ,n ,arg)))
+
+(defstruct-define-type :named-hashed-list
+ :named (:overhead 1)
+ (:cons
+ (arg description etc) :list
+ etc ;ignored
+ `(hlist ',(defstruct-description-name) . ,arg))
+ (:ref
+ (n description arg)
+ description ;ignored
+; #+Multics `(,(let ((i (\ (1+ n) 4)))
+; (cond ((= i 0) 'car)
+; ((= i 1) 'cadr)
+; ((= i 2) 'caddr)
+; (t 'cadddr)))
+; ,(do ((a arg `(cddddr ,a))
+; (i (// (1+ n) 4) (1- i)))
+; ((= i 0) a)))
+; PSL change incompatible NTH
+ #-Multics `(nth ,arg ,(+ n 2))))
+; #-Multics `(nth ,(1+ n) ,arg)))
+
+(defstruct-define-type :hashed-list*
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(hcons . ,arg))
+ (:ref
+ (n description arg)
+; PSL change 1- ==> sub1
+ (let ((size (sub1 (defstruct-description-size))))
+; (let ((size (1- (defstruct-description-size))))
+ #+Multics (do ((a arg `(cddddr ,a))
+ (i (// n 4) (1- i)))
+ ((= i 0)
+ (let* ((i (\ n 4))
+ (a (cond ((= i 0) a)
+ ((= i 1) `(cdr ,a))
+ ((= i 2) `(cddr ,a))
+ (t `(cdddr ,a)))))
+ (if (< n size) `(car ,a) a))))
+ #-Multics (if (< n size)
+; PSL change incompatible NTH
+ `(nth ,arg ,(add1 n))
+ `(pnth ,arg ,(add1 n)))))
+; `(nth ,n ,arg)
+; `(nthcdr ,n ,arg))))
+ (:defstruct (description)
+ (and (defstruct-description-include)
+ (defstruct-error
+ "Structure of type hashed-list* cannot include another"
+ (defstruct-description-name)))
+ nil))
+
+(defstruct-define-type :hashed-tree
+ (:cons
+ (arg description etc) :list
+ etc ;ignored
+ (if (null arg) (defstruct-error
+ "defstruct cannot make an empty tree"
+ (defstruct-description-name)))
+ (make-hashed-tree-for-defstruct arg (defstruct-description-size)))
+ (:ref
+ (n description arg)
+ (do ((size (defstruct-description-size))
+ (a arg)
+ (tem))
+ (())
+ (cond ((= size 1) (return a))
+; PSL change // ==> /
+ ((< n (setq tem (/ size 2)))
+; ((< n (setq tem (// size 2)))
+ (setq a `(car ,a))
+ (setq size tem))
+ (t (setq a `(cdr ,a))
+ (setq size (- size tem))
+ (setq n (- n tem))))))
+ (:defstruct (description)
+ (and (defstruct-description-include)
+ (defstruct-error
+ "Structure of type tree cannot include another"
+ (defstruct-description-name)))
+ nil))
+
+(defun make-hashed-tree-for-defstruct (arg size)
+ (cond ((= size 1) (car arg))
+ ((= size 2) `(hcons ,(car arg) ,(cadr arg)))
+ (t (do ((a (cdr arg) (cdr a))
+; PSL change // ==> /, 1- ==> sub1
+ (m (/ size 2))
+ (n (sub1 (/ size 2)) (sub1 n)))
+; (m (// size 2))
+; (n (1- (// size 2)) (1- n)))
+ ((zerop n)
+ `(hcons
+ ,(make-hashed-tree-for-defstruct arg m)
+ ,(make-hashed-tree-for-defstruct a (- size m))))))))
ADDED psl-1983/3-1/util/fast-vector.build
Index: psl-1983/3-1/util/fast-vector.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-vector.build
@@ -0,0 +1,5 @@
+CompileTime <<
+load If!-System;
+load Syslisp;
+>>;
+in "fast-vector.red"$
ADDED psl-1983/3-1/util/fast-vector.red
Index: psl-1983/3-1/util/fast-vector.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-vector.red
@@ -0,0 +1,46 @@
+% <PSL.UTIL>FAST-VECTOR.RED.1, 18-Mar-82 21:26:35, Edit by GRISS
+% Fast Vector operations
+
+imports '(Syslisp); % Uses syslisp macros
+
+CopyD('IGetV, 'GetV);
+
+CopyD('IPutV, 'PutV);
+
+CopyD('ISizeV, 'Size);
+
+Put('IGetV, 'Assign!-Op, 'IPutV);
+
+CopyD('IGetS, 'Indx);
+
+CopyD('IPutS, 'SetIndx);
+
+CopyD('ISizeS, 'Size);
+
+Put('IGetS, 'Assign!-Op, 'IPutS);
+
+if_system(VAX,
+DefList('((IGetV (lambda (V I) (VecItm (VecInf V) I)))
+ (IPutV (lambda (V I X) (PutVecItm (VecInf V) I X)))
+ (IGetS (lambda (S I) (StrByt (StrInf S) I)))
+ (IPutS (lambda (S I X) (PutStrByt (StrInf S) I X)))
+ (ISizeV (lambda (V) (VecLen (VecInf V))))
+ (ISizeS (lambda (V) (StrLen (StrInf V))))), 'CMacro));
+
+if_system(PDP10, % tags don't need to be stripped on the PDP10
+DefList('((IGetV (lambda (V I) (VecItm V I)))
+ (IPutV (lambda (V I X) (PutVecItm V I X)))
+ (IGetS (lambda (S I) (StrByt S I)))
+ (IPutS (lambda (S I X) (PutStrByt S I X)))
+ (ISizeV (lambda (V) (VecLen V)))
+ (ISizeS (lambda (S) (StrLen S)))), 'CMacro));
+
+if_system(MC68000, % tags don't need to be stripped on the 68000
+DefList('((IGetV (lambda (V I) (VecItm V I)))
+ (IPutV (lambda (V I X) (PutVecItm V I X)))
+ (IGetS (lambda (S I) (StrByt S I)))
+ (IPutS (lambda (S I X) (PutStrByt S I X)))
+ (ISizeV (lambda (V) (VecLen V)))
+ (ISizeS (lambda (S) (StrLen S)))), 'CMacro));
+
+END;
ADDED psl-1983/3-1/util/fast-vectors.sl
Index: psl-1983/3-1/util/fast-vectors.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/fast-vectors.sl
@@ -0,0 +1,27 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% FAST-VECTORS - Fast (unchecked) version of Vector Functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 September 1982
+%
+% Load this at compile-time to make compiled invocations of the following
+% functions fast (and unchecked):
+%
+% (vector-fetch v i)
+% (vector-store v i x)
+% (vector-size v)
+% (vector-upper-bound v)
+% (vector-empty? v)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(load slow-vectors) % for the interpreted versions
+(CompileTime (load fast-vector)) % for machine-dependent primitives
+
+(put 'vector-fetch 'cmacro '(lambda (v i) (igetv v i)))
+(put 'vector-store 'cmacro '(lambda (v i x) (iputv v i x)))
+(put 'vector-size 'cmacro '(lambda (v) (Wplus2 (isizev v) 1)))
+(put 'vector-upper-bound 'cmacro '(lambda (v) (isizev v)))
+(put 'vector-empty? 'cmacro '(lambda (v) (WLessP (isizev v) 0)))
ADDED psl-1983/3-1/util/find.build
Index: psl-1983/3-1/util/find.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/find.build
@@ -0,0 +1,3 @@
+% Build the FIND utility
+Imports '(Gsort);
+in "find.red"$
ADDED psl-1983/3-1/util/find.red
Index: psl-1983/3-1/util/find.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/find.red
@@ -0,0 +1,112 @@
+%. FIND.RED - Start of recognition and search OBLIST functions
+%. M. L. Griss
+
+% 30 Dec 1982, Mlg
+% Move IMPORTS etc to BUILD file
+
+Fluid '(CollectID!* TestString!*);
+
+Lisp Procedure FindPrefix(TestString!*); %. Scan ObLIST for prefix
+ Begin
+ CollectId!*:=NIL;
+ If IDp TestString!* then TestString!*:=ID2String TestString!*;
+ If Not StringP TestString!*
+ then StdError "Expect String or ID in FindPrefix";
+ MapObl Function FindPrefix1;
+ Return IDSort CollectId!*
+ end;
+
+Lisp procedure FindPrefix1 x;
+ If IsPrefixString(TestString!*,ID2String x)
+ then CollectId!* := x . CollectId!*;
+
+Lisp Procedure FindSuffix(TestString!*); %. Scan ObLIST for prefix
+ Begin
+ CollectId!*:=NIL;
+ If IDp TestString!* then TestString!*:=ID2String TestString!*;
+ If Not StringP TestString!*
+ then StdError "Expect String or ID in FindPrefix";
+ MapObl Function FindSuffix1;
+ Return IDSort CollectId!*
+ end;
+
+Lisp procedure FindSuffix1 x;
+ If IsSuffixString(TestString!*,ID2String x)
+ then CollectId!* := x . CollectId!*;
+
+Lisp procedure IsPrefixString(s1,s2); %. test if exact string prefix
+ begin scalar l1,l2,L;
+ l1:=size s1;
+ l2:=size s2;
+ L:=0;
+ if l1> l2 then return NIL;
+ Loop: if not( s1[L] eq s2[L] ) then return NIL;
+ if (L:=add1 L)> L1 then return T;
+ goto loop;
+ end;
+
+Lisp procedure IsSuffixString(s1,s2); %. test if exact string prefix
+ begin scalar l1,l2,L;
+ l1:=size s1;
+ l2:=size s2;
+ if l1> l2 then return NIL;
+ Loop: if not( s1[L1] eq s2[L2] ) then return NIL;
+ if L1<=0 then return T;
+ l1:=L1-1;
+ L2:=L2-1;
+ goto loop;
+ end;
+
+% More extensive String matcher
+
+procedure StringMatch(p,s);
+ StringMatch1(p,0,size(p),s,0,size(s));
+
+procedure StringMatch1(p,p1,p2,s,s1,s2);
+ Begin scalar c;
+ L1: % test Range
+ if p1>p2 then
+ return (if s1>s2 then T else NIL)
+ else if s1>s2 then return NIL;
+
+ % test if % something
+ if (c:=p[p1]) eq char !% then goto L3;
+
+ L2: % exact match
+ if c eq s[s1] then <<p1:=p1+1;
+ s1:=s1+1;
+ goto L1>>;
+ return NIL;
+
+ L3: % special cases
+ p1:=p1+1;
+ if p1>p2 then return stderror "pattern ran out in % case of StringMatch";
+ c:=p[p1];
+ if c eq char !% then goto L2;
+ if c eq char !? then <<p1:=p1+1;
+ s1:=s1+1;
+ goto L1>>;
+
+ if c eq char !* then % 0 or more vs 1 or more
+ return <<while not(c:=StringMatch1(p,p1+1,p2,s,s1,s2)) and s1<=s2
+ do s1:=s1+1;
+ c>>;
+ Return Stderror Bldmsg(" %% %r not known in StringMatch",int2id c);
+ end;
+
+Lisp Procedure Find(TestString!*); %. Scan ObLIST for prefix
+ Begin
+ CollectId!*:=NIL;
+ If IDp TestString!* then TestString!*:=ID2String TestString!*;
+ If Not StringP TestString!*
+ then StdError "Expect String or ID in FindPrefix";
+ MapObl Function FindStringMatch;
+ Return IDSort CollectId!*
+ end;
+
+Lisp procedure FindStringMatch x;
+ If StringMatch(TestString!*,ID2String x)
+ then CollectId!* := x . CollectId!*;
+
+
+End;
ADDED psl-1983/3-1/util/for-macro.sl
Index: psl-1983/3-1/util/for-macro.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/for-macro.sl
@@ -0,0 +1,344 @@
+% FOR-MACRO.SL - fancy FOR loop
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% <PSL.UTIL>FOR-MACRO.SL.3, 7-Oct-82 15:46:11, Edit by BENSON
+% Changed NULL tests to ATOM tests
+
+% Fancy for loop. Similar to MACLISP and clones' loop function, but with
+% LISPier "syntax" and slightly reduced functionality and concommitant hair.
+
+(fluid '(for-vars* for-outside-vars* for-tests* for-prologue* for-conditions*
+ for-body* for-epilogue* for-result*))
+
+(dm for (U) (for-build-loop (cdr U) 'do-loop 'let))
+
+(defmacro for* U
+ (for-build-loop U 'do-loop* 'let*))
+
+(de for-build-loop (U loop-fn let-fn)
+% Simply calls the function stored under the for-function property of the
+% keyword at the begining of each clause, and then builds the DO form from
+% the fluids below. These are in TCONC format. The clause specific
+% functions should do their stuff by TCONC/LCONCing onto these variables.
+% The clause specific functions take one argument, the list of arguments to
+% the clause keyword.
+ (let ((for-outside-vars* (list nil))
+ (for-vars* (list nil))
+ (for-tests* (list nil))
+ (for-prologue* (list nil))
+ (for-conditions* (list nil))
+ (for-body* (list nil))
+ (for-epilogue* (list nil))
+ (for-result* (list nil)))
+ (foreach clause in U do (process-for-clause clause))
+ % "UnTCONCify" everybody
+ (setf
+ for-outside-vars* (car for-outside-vars*)
+ for-vars* (car for-vars*)
+ for-tests* (car for-tests*)
+ for-prologue* (car for-prologue*)
+ for-conditions* (car for-conditions*)
+ for-body* (car for-body*)
+ for-epilogue* (car for-epilogue*)
+ for-result* (car for-result*))
+ % Now, back to work...
+ (if for-tests* (setf for-tests* (if (cdr for-tests*)
+ (cons 'or for-tests*)
+ (car for-tests*))))
+ (when for-conditions*
+ (setf for-conditions* (if (cdr for-conditions*)
+ (cons 'and for-conditions*)
+ (car for-conditions*)))
+ (setf for-body* `((when ,for-conditions* ,.for-body*))))
+ (if (and for-result* (cdr for-result*))
+ (StdError "For loops may only return one value")) % msg needs improving
+ % Finally build up the form to return
+ (let ((form `(,loop-fn ,for-vars*
+ ,for-prologue*
+ (,for-tests* ,.for-epilogue* ,.for-result*)
+ ,.for-body*)))
+ (if for-outside-vars* `(,let-fn ,for-outside-vars* ,form) form))))
+
+(de process-for-clause (clause)
+ (let ((op (car clause)) fn)
+ (cond
+ ((atom clause)
+ (process-for-clause
+ (ContinuableError
+ 99
+ (BldMsg "For clauses may not be atomic: %r." clause)
+ clause)))
+ ((setf fn (get op 'for-function))
+ (call fn (cdr clause)))
+ (t
+ (ContinuableError
+ 99
+ (BldMsg "Unknown for clause operator: %r." op)
+ op)))))
+
+(de for-in-function (clause)
+ (let ((var (car clause))
+ (lst (cadr clause))
+ (fn (and (cddr clause) (caddr clause)))
+ (dummy (gensym)))
+ (tconc for-outside-vars* dummy)
+ (tconc for-vars* `(,var
+ (progn
+ (setf ,dummy ,lst)
+ (if (pairp ,dummy)
+ ,(if fn `(,fn (car ,dummy)) `(car ,dummy))
+ ()))
+ (progn
+ (setf ,dummy (cdr ,dummy))
+ (if (pairp ,dummy)
+ ,(if fn `(,fn (car ,dummy)) `(car ,dummy))
+ ()))))
+ (tconc for-tests* `(atom ,dummy))))
+
+(de for-on-function (clause)
+ (let ((var (car clause))
+ (lst (cadr clause)))
+ (tconc for-vars* `(,var ,lst (cdr ,var)))
+ (tconc for-tests* `(atom ,var))))
+
+(de for-from-function (clause)
+ (let* ((var (car clause))
+ (var1 (if (pairp var) (car var) var))
+ (clause (cdr clause))
+ (init (if (pairp clause) (or (pop clause) 1) 1))
+ (fin (if (pairp clause) (pop clause) nil))
+ (fin-var (if (and fin (not (numberp fin))) (gensym) nil))
+ (step (if (pairp clause) (car clause) 1))
+ (step-var (if (and step (not (numberp step))) (gensym) nil)))
+ (tconc
+ for-vars*
+ (list* var init (cond
+ (step-var `((plus2 ,var1 ,step-var)))
+ ((zerop step) nil)
+ ((onep step) `((add1 ,var1)))
+ ((eqn step -1) `((sub1 ,var1)))
+ (t `((plus ,var1 ,step))))))
+ (if fin-var (tconc for-vars* `(,fin-var ,fin)))
+ (if step-var (tconc for-vars* `(,step-var ,step)))
+ (cond (step-var
+ (tconc for-tests* `(if (minusp ,step-var)
+ (lessp ,var1 ,(or fin-var fin))
+ (greaterp ,var1 ,(or fin-var fin)))))
+ ((null fin))
+ ((minusp step) (tconc for-tests* `(lessp ,var1 ,(or fin-var fin))))
+ (t (tconc for-tests* `(greaterp ,var1 ,(or fin-var fin)))))))
+
+(de for-for-function (clause) (tconc for-vars* clause))
+
+(de for-with-function (clause)
+ (lconc for-vars* (append clause nil))) % copy it for safety
+
+(de for-initially-function (clause)
+ (lconc for-prologue* (append clause nil))) % copy it for safety
+
+(de for-finally-function (clause)
+ (lconc for-epilogue* (append clause nil))) % copy it for safety
+
+(de for-do-function (clause)
+ (lconc for-body* (append clause nil))) % copy it for safety
+
+(de for-collect-function (clause)
+ (let ((tail (gensym))(reslt))
+ (if (cdr clause)
+ (progn
+ (setf reslt (cadr clause))
+ (tconc for-prologue* `(setf ,reslt nil)))
+ (setf reslt (gensym))
+ (tconc for-vars* reslt)
+ (tconc for-result* reslt))
+ (tconc for-vars* tail)
+ (tconc for-body* `(if ,tail
+ (setf ,tail (cdr (rplacd ,tail (ncons ,(car clause)))))
+ (setf ,reslt (setf ,tail (ncons ,(car clause))))))))
+
+(de for-conc-function (clause)
+ (let ((reslt)(tail (gensym)))
+ (if (cdr clause)
+ (progn
+ (setf reslt (cadr clause))
+ (tconc for-prologue* `(setf ,reslt nil)))
+ (setf reslt (gensym))
+ (tconc for-vars* reslt)
+ (tconc for-result* reslt))
+ (tconc for-vars* tail)
+ (tconc for-body* `(if ,tail
+ (setf ,tail (LastPair (rplacd ,tail ,(car clause))))
+ (setf ,reslt ,(car clause))
+ (setf ,tail (LastPair ,reslt))))))
+
+(de for-join-function (clause)
+ (let ((reslt)(tail (gensym)))
+ (if (cdr clause)
+ (progn
+ (setf reslt (cadr clause))
+ (tconc for-prologue* `(setf ,reslt nil)))
+ (setf reslt (gensym))
+ (tconc for-vars* reslt)
+ (tconc for-result* reslt))
+ (tconc for-vars* tail)
+ (tconc for-body* `(if ,tail
+ (setf
+ ,tail
+ (LastPair (rplacd ,tail (append ,(car clause) nil))))
+ (setf ,reslt (append ,(car clause) nil))
+ (setf ,tail (LastPair ,reslt))))))
+
+(defmacro-no-displace def-for-basic-return-function (name var init exp bod)
+ `(de ,name (clause)
+ (let ((reslt))
+ (if (cdr clause)
+ (progn
+ (setf reslt (cadr clause))
+ (tconc for-prologue* `(setf ,reslt ,,init)))
+ (setf reslt (gensym))
+ (tconc for-vars* `(,reslt ,,init))
+ (tconc for-result* reslt))
+ (tconc for-body* ,(subst 'reslt var (subst '(car clause) exp bod))))))
+
+(def-for-basic-return-function for-union-function
+ reslt nil exp `(setf ,reslt (union ,reslt ,exp)))
+
+(def-for-basic-return-function for-unionq-function
+ reslt nil exp `(setf ,reslt (unionq ,reslt ,exp)))
+
+(de for-intersection-function (clause)
+ (let ((reslt)(flg (gensym)))
+ (if (cdr clause)
+ (progn
+ (setf reslt (cadr clause))
+ (tconc for-prologue* `(setf ,reslt nil)))
+ (setf reslt (gensym))
+ (tconc for-vars* reslt)
+ (tconc for-result* reslt))
+ (tconc for-vars* flg)
+ (tconc for-body* `(setf ,reslt (if ,flg
+ (intersection ,reslt ,(car clause))
+ (setf ,flg t)
+ ,(car clause))))))
+
+(de for-intersectionq-function (clause)
+ (let ((reslt)(flg (gensym)))
+ (if (cdr clause)
+ (progn
+ (setf reslt (cadr clause))
+ (tconc for-prologue* `(setf ,reslt nil)))
+ (setf reslt (gensym))
+ (tconc for-vars* reslt)
+ (tconc for-result* reslt))
+ (tconc for-vars* flg)
+ (tconc for-body* `(setf ,reslt (if ,flg
+ (intersectionq ,reslt ,(car clause))
+ (setf ,flg t)
+ ,(car clause))))))
+
+(def-for-basic-return-function for-adjoin-function
+ reslt nil exp `(setf ,reslt (adjoin ,exp ,reslt)))
+
+(def-for-basic-return-function for-adjoinq-function
+ reslt nil exp `(setf ,reslt (adjoinq ,exp ,reslt)))
+
+(def-for-basic-return-function for-count-function
+ reslt 0 exp `(if ,exp (incr ,reslt)))
+
+(def-for-basic-return-function for-sum-function
+ reslt 0 exp `(incr ,reslt ,exp))
+
+(def-for-basic-return-function for-product-function
+ reslt 1 exp `(setf ,reslt (times ,reslt ,exp)))
+
+(def-for-basic-return-function for-maximize-function
+ reslt nil exp `(setf ,reslt (if ,reslt
+ (max ,reslt ,(car clause))
+ ,(car clause))))
+
+(def-for-basic-return-function for-minimize-function
+ reslt nil exp `(setf ,reslt (if ,reslt
+ (min ,reslt ,(car clause))
+ ,(car clause))))
+
+
+(de for-always-function (clause)
+ (tconc for-body*
+ `(if (null ,(if (cdr clause) `(and ,@clause) (car clause))) (return nil)))
+ (tconc for-result* t))
+
+(de for-never-function (clause)
+ (tconc for-body*
+ `(if ,(if (cdr clause) `(or ,@clause) (car clause)) (return nil)))
+ (tconc for-result* t))
+
+(de for-thereis-function (clause)
+ (let ((temp (gensym)))
+ (tconc for-result* nil)
+ (tconc for-vars* temp)
+ (tconc for-body* `(if (setf ,temp ,(car clause)) (return ,temp)))))
+
+(de for-returns-function (clause)
+ (tconc for-result* (if (cdr clause) (cons 'progn clause) (car clause))))
+
+(de for-while-function (clause)
+ (lconc for-tests* (foreach u in clause collect `(null ,u))))
+
+(de for-until-function (clause)
+ (lconc for-tests* (append clause nil))) % copy for safety
+
+(de for-when-function (clause)
+ (lconc for-conditions* (append clause nil))) % copy for safety
+
+(de for-unless-function (clause)
+ (lconc for-conditions* (foreach u in clause collect `(not ,u))))
+
+(deflist `(
+ (in ,#'for-in-function)
+ (on ,#'for-on-function)
+ (from ,#'for-from-function)
+ (for ,#'for-for-function)
+ (as ,#'for-for-function)
+ (with ,#'for-with-function)
+ (initially ,#'for-initially-function)
+ (finally ,#'for-finally-function)
+ (do ,#'for-do-function)
+ (doing ,#'for-do-function)
+ (collect ,#'for-collect-function)
+ (collecting ,#'for-collect-function)
+ (conc ,#'for-conc-function)
+ (concing ,#'for-conc-function)
+ (join ,#'for-join-function)
+ (joining ,#'for-join-function)
+ (count ,#'for-count-function)
+ (counting ,#'for-count-function)
+ (sum ,#'for-sum-function)
+ (summing ,#'for-sum-function)
+ (product ,#'for-product-function)
+ (maximize ,#'for-maximize-function)
+ (maximizing ,#'for-maximize-function)
+ (minimize ,#'for-minimize-function)
+ (minimizing ,#'for-minimize-function)
+ (union ,#'for-union-function)
+ (unionq ,#'for-unionq-function)
+ (intersection ,#'for-intersection-function)
+ (intersectionq ,#'for-intersectionq-function)
+ (adjoin ,#'for-adjoin-function)
+ (adjoinq ,#'for-adjoinq-function)
+ (always ,#'for-always-function)
+ (never ,#'for-never-function)
+ (thereis ,#'for-thereis-function)
+ (returns ,#'for-returns-function)
+ (returning ,#'for-returns-function)
+ (while ,#'for-while-function)
+ (until ,#'for-until-function)
+ (when ,#'for-when-function)
+ (unless ,#'for-unless-function)
+ ) 'for-function)
+
ADDED psl-1983/3-1/util/format.red
Index: psl-1983/3-1/util/format.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/format.red
@@ -0,0 +1,172 @@
+%
+% Format.RED - Formatted print routine
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 27 August 1981
+% Copyright (c) 1981 University of Utah
+%
+
+
+CompileTime <<
+
+load(Syslisp, Fast!-Vector);
+
+flag('(format!-freshline format1 format2 clear!-string!-write
+ return!-string!-write), 'internalfunction);
+
+fluid '(FormatForFormat!* string!-write!-channel next!-string!-write!-char
+ string!-write!-buffer);
+
+>>;
+
+% First, lambda-bind FormatForFormat!*
+
+lisp procedure Format(Stream, FormatForFormat!*, A1, A2, A3, A4, A5,
+ A6, A7, A8, A9, A10,
+ A11, A12, A13);
+ Format1(Stream, FormatForFormat!*, A1, A2, A3, A4, A5,
+ A6, A7, A8, A9, A10,
+ A11, A12, A13);
+
+
+% Then, push all the registers on the stack and set up a pointer to them
+
+lap '((!*entry Format1 expr 15)
+ (!*PUSH (reg 3))
+ (!*LOC (reg 2) (frame 1))
+ (!*PUSH (reg 4))
+ (!*PUSH (reg 5))
+ (!*PUSH (reg 6))
+ (!*PUSH (reg 7))
+ (!*PUSH (reg 8))
+ (!*PUSH (reg 9))
+ (!*PUSH (reg 10))
+ (!*PUSH (reg 11))
+ (!*PUSH (reg 12))
+ (!*PUSH (reg 13))
+ (!*PUSH (reg 14))
+ (!*PUSH (reg 15))
+ (!*CALL Format2)
+ (!*EXIT 14)
+);
+
+on SysLisp;
+
+% Finally, actual Format, with 2 arguments, stream and
+% pointer to array of parameters
+
+syslsp procedure Format2(Stream, FormatArgs); %. Formatted print
+%
+% If the character is not one of these (either upper or lower case), then an
+% error occurs.
+%
+begin scalar UpLim, I, Ch, UpCh;
+ if Stream eq NIL then
+ << Stream := lispvar string!-write!-channel;
+ clear!-string!-write() >>
+ else if Stream eq T then
+ Stream := LispVar OUT!*;
+ UpLim := StrLen StrInf LispVar FormatForFormat!*;
+ I := 0;
+ while I <= UpLim do
+ << Ch := StrByt(StrInf LispVar FormatForFormat!*, I);
+ if Ch neq char !~ then
+ ChannelWriteChar(Stream, Ch)
+ else
+ begin
+ I := I + 1;
+ Ch := StrByt(StrInf LispVar FormatForFormat!*, I);
+ UpCh := if Ch >= char lower A and Ch <= char lower Z
+ then IPlus2(IDifference(Ch, char lower A), char A)
+ else Ch;
+ case UpCh of
+ char A:
+ << ChannelPrin2(Stream, FormatArgs[0]);
+ FormatArgs := &FormatArgs[StackDirection] >>;
+ char S:
+ << ChannelPrin1(Stream, FormatArgs[0]);
+ FormatArgs := &FormatArgs[StackDirection] >>;
+ char D:
+ << ChannelWriteSysInteger(Stream,
+ Int2Sys FormatArgs[0],
+ 10);
+ FormatArgs := &FormatArgs[StackDirection] >>;
+ char B:
+ << ChannelWriteSysInteger(Stream,
+ Int2Sys FormatArgs[0],
+ 2);
+ FormatArgs := &FormatArgs[StackDirection] >>;
+ char O:
+ << ChannelWriteSysInteger(Stream,
+ Int2Sys FormatArgs[0],
+ 8);
+ FormatArgs := &FormatArgs[StackDirection] >>;
+ char X:
+ << ChannelWriteSysInteger(Stream,
+ Int2Sys FormatArgs[0],
+ 16);
+ FormatArgs := &FormatArgs[StackDirection] >>;
+ char !~:
+ ChannelWriteChar(Stream, char !~);
+ char !%:
+ ChannelWriteChar(Stream, char EOL);
+ char '!&:
+ format!-freshline Stream;
+ default:
+ StdError BldMsg('"Unknown character code for Format: %r",
+ MkID Ch);
+ end;
+ end;
+ I := I + 1 >>;
+ if Stream eq LispVar string!-write!-channel then return
+ return!-string!-write();
+end;
+
+off SysLisp;
+
+lisp procedure format!-freshline Stream;
+(lambda out!*;
+ if IGreaterP(Posn(), 0) then
+ ChannelWriteChar(Stream, char EOL))(Stream);
+
+
+lisp procedure Ferror(Condition, FMT, A1, A2, A3, A4, A5, A6,
+ A7, A8, A9, A10, A11, A12, A13);
+ Error(Condition, Format(NIL, FMT, A1, A2, A3, A4, A5, A6,
+ A7, A8, A9, A10, A11, A12, A13));
+
+lisp procedure string!-write!-char(stream, ch);
+ if IGEQ(next!-string!-write!-char, 5000) then
+ StdError "String overflow in FORMAT"
+ else
+ << next!-string!-write!-char := iadd1 next!-string!-write!-char;
+ iputs(string!-write!-buffer, next!-string!-write!-char, ch) >>;
+
+lisp procedure clear!-string!-write();
+<< channelwritechar(string!-write!-channel, char EOL);
+ next!-string!-write!-char := -1 >>;
+
+lisp procedure return!-string!-write();
+begin scalar x, y;
+ y := 0;
+ next!-string!-write!-char := iadd1 next!-string!-write!-char;
+ x := make!-string(next!-string!-write!-char, char NULL);
+ while ILEQ(y, next!-string!-write!-char) do
+ << iputs(x, y, igets(string!-write!-buffer, y));
+ y := iadd1 y >>;
+ return x;
+end;
+
+string!-write!-buffer := make!-string(5000, char NULL);
+specialreadfunction!* := 'WriteOnlyChannel;
+specialwritefunction!* := 'string!-write!-char;
+specialclosefunction!* := 'IllegalStandardChannelClose;
+string!-write!-channel := open("", 'special);
+(lambda (x);
+<< LineLength 10000;
+ WRS x >> )(WRS string!-write!-channel);
+
+END;
ADDED psl-1983/3-1/util/graph-tree.build
Index: psl-1983/3-1/util/graph-tree.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/graph-tree.build
@@ -0,0 +1,2 @@
+compiletime <<load useful>>;
+in "graph-tree.sl"$
ADDED psl-1983/3-1/util/graph-tree.sl
Index: psl-1983/3-1/util/graph-tree.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/graph-tree.sl
@@ -0,0 +1,33 @@
+% Needs USEFUL at compile time
+
+(fluid '(graph-nodes* node-index*))
+
+(de graph-to-tree (u)
+ (let ((graph-nodes* nil)(node-index* 0))
+ (graph-to-tree-1 u)))
+
+(de graph-to-tree-1 (u)
+ (let ((x))
+ (cond
+ ((not (or (pairp u) (vectorp u))) u)
+ ((setf x (atsoc u graph-nodes*))
+ (when (null (cdr x))
+ (setf (cdr x) (incr node-index*)))
+ (newid (bldmsg "<%w>" (cdr x))))
+ (t (let* ((p (ncons u))
+ (graph-nodes* (cons p graph-nodes*))
+ (v (if (vectorp u)
+ (for (from i 0 (upbv u)) (with (v (mkvect (upbv u))))
+ (do (setf (getv v i) (graph-to-tree-1 (getv u i))))
+ (returns v))
+ (cons
+ (graph-to-tree-1 (car u))
+ (graph-to-tree-1 (cdr u))))))
+ (if (cdr p)
+ (list (newid (bldmsg "<%w>:" (cdr p))) v)
+ v))))))
+
+(de cprint (u)
+ (let ((currentscantable* lispscantable*))
+ (prettyprint (graph-to-tree u))
+ nil))
ADDED psl-1983/3-1/util/gsort.build
Index: psl-1983/3-1/util/gsort.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/gsort.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp;
+in "gsort.red"$
ADDED psl-1983/3-1/util/gsort.red
Index: psl-1983/3-1/util/gsort.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/gsort.red
@@ -0,0 +1,308 @@
+%===================================================================
+% Simple sorting functions for PSL strings and Ids
+% use with FindPrefix and FindSuffix
+
+% MLG, 8:16pm Monday, 14 December 1981
+%===================================================================
+
+% Revision History
+%
+% Edit by Cris Perdue, 26 Jan 1983 1343-PST
+% Fixed the order of arguments in one call to make GMergeSort stable.
+% MLG, 2 Jan 1983
+% Changed IDSORT form Macro to procedure, so that
+% it could be redefined for experiments with alternate GSORT
+% Affected RCREF and FIND
+
+
+lisp procedure StringCompare(S1,S2);
+% Returns 1,0,-1 for S1<S2,S1=S2,S1>S2
+% String Comparison
+ Begin scalar L1,L2,I,L;
+ L1:=Size(S1); L2:=Size(S2);
+ L:=MIN2(L1,L2);
+ I:=0;
+ loop: If I>L then return(If L1 <L2 then 1
+ else if L1 > L2 then -1
+ else 0);
+ if S1[I] < S2[I] then return 1;
+ if S1[I] > S2[I] then return (-1);
+ I:=I+1;
+ goto loop;
+ End;
+
+lisp procedure IdCompare(D1,D2);
+% Compare IDs via print names
+ %/ What of case
+ StringCompare(Id2String D1,Id2String D2);
+
+lisp procedure SlowIdSort DList;
+% Worst Possible Sort;
+ If Null DList then NIL
+ else InsertId(car Dlist, SlowIdSort Cdr Dlist);
+
+lisp procedure InsertId(D,DL);
+ If Null DL then D . Nil
+ else if IdCompare(D,Car DL)>=0 then D . DL
+ else Car Dl . InsertId(D,Cdr Dl);
+
+% ======= Tree based ALPHA-SORT package, derived from CREF
+
+% routines modified from FUNSTR for alphabetic sorting
+%
+% Tree Sort of list of ELEM
+%
+% Tree is NIL or STRUCT(VAL:value,SONS:Node-pair)
+% Node-pair=STRUCT(LNode:tree,RNode:tree);
+
+lisp smacro procedure NewNode(Elem); %/ use A vector?
+ LIST(Elem,NIL);
+
+lisp smacro procedure VAL Node;
+% Access the VAL in node
+ CAR Node;
+
+lisp smacro procedure LNode Node;
+ CADR Node;
+
+lisp smacro procedure RNode Node;
+ CDDR Node;
+
+lisp smacro procedure NewLeftNode(Node,Elem);
+ RPLACA(CDR Node,NewNode Elem);
+
+lisp smacro procedure NewRightNode(Node,Elem);
+ RPLACD(CDR Node,NewNode Elem);
+
+lisp procedure IdSort LST;
+% Sort a LIST of ID's. Do not remove Dups
+% Build Tree then collapse;
+ Tree2LST(IdTreeSort(LST),NIL);
+
+lisp procedure IdTreeSort LST;
+% Uses insert of Element to Tree;
+ Begin scalar Tree;
+ If NULL LST then Return NIL;
+ Tree:=NewNode CAR LST; % First Element
+ While PAIRP(LST:=CDR LST) DO IdPutTree(CAR LST,Tree);
+ Return Tree;
+ END;
+
+lisp smacro procedure IdPlaceToLeft (Elem1,Elem2);
+% ReturnS T If Elem to go to left of Node
+ IdCompare(Elem1,Elem2)>=0;
+
+lisp procedure IdPutTree(Elem,Node);
+% Insert Elements into Tree
+ Begin
+ DWN: If Not IdPlaceToLeft(Elem,VAL Node) then GOTO RGT;
+ If LNode Node then <<Node:=LNode Node;GO TO DWN>>;
+ NewLeftNode(Node,Elem);
+ Return;
+ RGT: If RNode Node then <<Node:=RNode Node;GO TO DWN>>;
+ NewRightNode(Node,Elem);
+ Return;
+ END;
+
+lisp procedure Tree2LST(Tree,LST);
+% Collapse Tree to LIST
+ Begin
+ While Tree DO
+ <<LST:=VAL(Tree) .Tree2LST(RNode Tree,LST);
+ Tree:=LNode Tree>>;
+ Return LST;
+ END;
+
+% More General Sorting, given Fn=PlaceToRight(a,b);
+
+lisp procedure GenSort(LST,Fn);
+% Sort a LIST of elems
+% Build Tree then collapse;
+ Tree2LST(GenTreeSort(LST,Fn),NIL);
+
+lisp procedure GenTreeSort(LST,Fn);
+% Uses insert of Element to Tree;
+ Begin scalar Tree;
+ If NULL LST then Return NIL;
+ Tree:=NewNode CAR LST; % First Element
+ While PAIRP(LST:=CDR LST) DO GenPutTree(CAR LST,Tree,Fn);
+ Return Tree;
+ END;
+
+lisp procedure GenPutTree(Elem,Node,SortFn);
+% Insert Elements into Tree
+ Begin
+ DWN: If Not Apply(SortFn,list(Elem,VAL Node)) then GOTO RGT;
+ If LNode Node then <<Node:=LNode Node;GO TO DWN>>;
+ NewLeftNode(Node,Elem);
+ Return;
+ RGT: If RNode Node then <<Node:=RNode Node;GO TO DWN>>;
+ NewRightNode(Node,Elem);
+ Return;
+ END;
+
+
+% More General Sorting, given SortFn=PlaceToLeft(a,b);
+
+lisp procedure GSort(LST,SortFn);
+% Sort a LIST of elems
+% Build Tree then collapse;
+Begin
+ CopyD('GsortFn!*,SortFn);
+ LST:= Tree2LST(GTreeSort LST,NIL);
+ RemD('GsortFn!*);
+ Return LST;
+ End;
+
+
+lisp procedure GTreeSort LST;
+% Uses insert of Element to Tree;
+ Begin scalar Tree;
+ If NULL LST then Return NIL;
+ Tree:=NewNode CAR LST; % First Element
+ While PAIRP(LST:=CDR LST) DO GPutTree(CAR LST,Tree);
+ Return Tree;
+ END;
+
+lisp procedure GPutTree(Elem,Node);
+% Insert Elements into Tree
+ Begin
+ DWN: If Not GSortFn!*(Elem,VAL Node) then GOTO RGT;
+ If LNode Node then <<Node:=LNode Node;GO TO DWN>>;
+ NewLeftNode(Node,Elem);
+ Return;
+ RGT: If RNode Node then <<Node:=RNode Node;GO TO DWN>>;
+ NewRightNode(Node,Elem);
+ Return;
+ END;
+
+% Standard Comparison Functions:
+
+lisp procedure IdSortFn(Elem1,Elem2);
+% ReturnS T If Elem1 to go to right of Elem 2;
+ IdCompare(Elem1,Elem2)>=0;
+
+lisp procedure NumberSortFn(Elem1,Elem2);
+ Elem1 <= Elem2;
+
+lisp procedure NumberSort Lst;
+ Gsort(Lst,'NumberSortFn);
+
+lisp procedure StringSortFn(Elem1,Elem2);
+ StringCompare(Elem1,Elem2)>=0;
+
+lisp procedure StringSort Lst;
+ Gsort(Lst,'StringSortFn);
+
+lisp procedure NoSortFn(Elem1,Elem2);
+ NIL;
+
+lisp procedure AtomSortFn(E1,E2);
+ % Ids, Numbers, then strings;
+ If IdP E1 then
+ If IdP E2 then IdSortFn(E1,E2)
+ else NIL
+ else if Numberp E1
+ then if IdP E2 then T
+ else if NumberP E2 then NumberSortFn (E1,E2)
+ else NIL
+ else if StringP(E1)
+ then if IDP(E2) then T
+ else if Numberp E2 then T
+ else StringSortFn(E1,E2)
+ else NIL;
+
+lisp procedure AtomSort Lst;
+ Gsort(Lst,'AtomSortFn);
+
+lisp procedure StringLengthFn(S1,S2);
+% For string length
+% String Length Comparison
+ Size(S1)<=Size(S2);
+
+procedure IdLengthFn(e1,e2);
+ StringLengthFn(Id2string e1,Id2string e2);
+
+On syslisp;
+
+syslsp procedure SC1(S1,S2);
+% Returns T if S1<=S2
+% String Comparison
+ Begin scalar L1,L2,I,L;
+ S1:=Strinf s1; S2:=Strinf S2;
+ L1:=StrLen(S1); L2:=StrLen(S2);
+ If L1>L2 then L:=L2 else L:=L1;
+ I:=0;
+ loop: If I>L then return(If L1 <=L2 then T else NIL);
+ if StrByt(S1,I) < StrByt(S2,I) then return T;
+ if StrByt(S1,I) > StrByt(S2,I) then return NIL;
+ I:=I+1;
+ goto loop;
+ End;
+
+syslsp procedure IdC1(e1,e2);
+ Sc1(ID2String e1, ID2String e2);
+
+syslsp procedure SC2(S1,S2);
+% Returns T if S1<=S2
+% String Comparison done via packed word compare, may glitch
+ Begin scalar L1,L2,I,L;
+ S1:=Strinf s1; S2:=Strinf S2;
+ L1:=Strpack StrLen(S1); L2:=strpack StrLen(S2);
+ S1:=S1+1; S2:=S2+1;
+ If L1>L2 then L:=L2 else L:=L1;
+ I:=0; %/ May be off by one?
+ loop: If I>L then return(If L1 <=L2 then T else NIL);
+ if S1[I] < S2[I] then return T;
+ if S1[I] > S2[I] then return NIL;
+ I:=I+1;
+ goto loop;
+ End;
+
+syslsp procedure IdC2(e1,e2);
+ Sc2(ID2String e1,ID2String e2);
+
+Off syslisp;
+
+Lisp procedure GsortP(Lst,SortFn);
+Begin
+ If Not PairP Lst then return T;
+ L: If Not PairP Cdr Lst then Return T;
+ If Not Apply(SortFn,list(Car Lst, Cadr Lst)) then return NIL;
+ Lst :=Cdr Lst;
+ goto L;
+END;
+
+Lisp procedure GMergeLists(L1,L2,SortFn);
+ If Not PairP L1 then L2
+ else if Not PairP L2 then L1
+ else if Apply(SortFn,list(Car L1, Car L2))
+ then Car(L1) . GMergeLists(cdr L1, L2,SortFn)
+ else car(L2) . GmergeLists(L1, cdr L2,SortFn);
+
+Lisp procedure MidPoint(Lst1,Lst2,M); % Set MidPointer List at M
+ Begin
+ While Not (Lst1 eq Lst2) and M>0 do
+ <<Lst1 := cdr Lst1;
+ M:=M-1>>;
+ return Lst1;
+ End;
+
+Lisp procedure GMergeSort(Lst,SortFn);
+ GMergeSort1(Lst,NIL,Length Lst,SortFn);
+
+Lisp procedure GMergeSort1(Lst1,Lst2,M,SortFn);
+ If M<=0 then NIL
+ else if M =1 then if null cdr Lst1 then Lst1 else List Car lst1
+ else if M=2 then
+ (if Apply(SortFn,list(Car Lst1,Cadr Lst1)) then List(Car Lst1, Cadr Lst1)
+ else List(Cadr Lst1,Car lst1))
+ else begin scalar Mid,M1;
+ M1:=M/2;
+ Mid :=MidPoint(Lst1,Lst2,M1);
+ Lst1 :=GMergeSort1(Lst1,Mid, M1,SortFn);
+ Lst2 :=GmergeSort1(Mid,Lst2, M-M1,SortFn);
+ Return GmergeLists(Lst1,Lst2,SortFn);
+ end;
+
+end;
ADDED psl-1983/3-1/util/h-stats-1.red
Index: psl-1983/3-1/util/h-stats-1.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/h-stats-1.red
@@ -0,0 +1,153 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% "SysLisp" part of the HEAP-STATS package.
+%%%
+%%% Author: Cris Perdue
+%%% December 1982
+%%% Documented January 1983
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+on SysLisp;
+
+compiletime <<
+put('igetv,'assign!-op,'iputv);
+>>;
+
+%%% Magic constants defining the layout of a "heap-stats" object.
+compiletime <<
+Internal WConst TemplateX = 2,
+ StringTabX = 3,
+ StringSpaceX = 4,
+ VectTabX = 5,
+ VectSpaceX = 6,
+ WordTabX = 7,
+ WordSpaceX = 8,
+ Pairs = 9,
+ Strings = 10,
+ HalfWords = 11,
+ WordVecs = 12,
+ Vectors = 13;
+>>;
+
+%%% This procedure sweeps the heap and collects statistics into
+%%% its argument, which is a heap-stats object. This routine may
+%%% be called as part of a garbage collection, so it may not do
+%%% any allocation whatsoever from the heap. Moderate size
+%%% integers are assumed to have in effect no tag.
+syslsp procedure HeapStats(Results);
+begin
+ scalar CurrentItem,
+ ObjLen,
+ Last,
+ HistoSize,
+ StdTemplate,
+ StringHTab,
+ StringSpaceTab,
+ VectHTab,
+ VectSpaceTab,
+ WordHTab,
+ WordSpaceTab,
+ Len;
+
+ %% Check that the argument looks reasonable.
+ if neq(isizev(Results), 13) then
+ return nil;
+
+ StdTemplate := igetv(Results,TemplateX);
+
+ StringHTab := igetv(Results,StringTabX);
+ StringSpaceTab := igetv(Results,StringSpaceX);
+ VectHTab := igetv(Results,VectTabX);
+ VectSpaceTab := igetv(Results,VectSpaceX);
+ WordHTab := igetv(Results,WordTabX);
+ WordSpaceTab := igetv(Results,WordSpaceX);
+
+ %% Check the various subobjects of the argument to see that
+ %% they look reasonable. The returns are all errors effectively.
+ HistoSize := isizev(StdTemplate) + 1;
+ if neq(isizev(StringHTab),HistoSize) then return 1;
+ if neq(isizev(StringSpaceTab),HistoSize) then return 2;
+ if neq(isizev(VectHTab),HistoSize) then return 3;
+ if neq(isizev(VectSpaceTab),HistoSize) then return 4;
+ if neq(isizev(WordHTab),HistoSize) then return 5;
+ if neq(isizev(WordSpaceTab),HistoSize) then return 6;
+
+ igetv(Results,Pairs) := 0;
+ igetv(Results,Strings) := 0;
+ igetv(Results,HalfWords) := 0;
+ igetv(Results,WordVecs) := 0;
+ igetv(Results,Vectors) := 0;
+
+ FillVector(StringHTab,0);
+ FillVector(StringSpaceTab,0);
+ FillVector(VectHTab,0);
+ FillVector(VectSpaceTab,0);
+ FillVector(WordHTab,0);
+ FillVector(WordSpaceTab,0);
+
+ Last := HeapLast();
+ CurrentItem := HeapLowerBound();
+ while CurrentItem < Last do
+ begin
+ case Tag @CurrentItem of
+ BTRTAG, CODE, NEGINT, POSINT, ID, UNBOUND,
+ STR, BYTES, FIXN, FLTN, BIGN, WRDS, Halfwords, PAIR, VECT, EVECT:
+ << ObjLen := 2; % must be first of pair
+ igetv(Results,Pairs) := igetv(Results,Pairs) + 1;
+ >>;
+ HBYTES:
+ << Len := StrLen CurrentItem;
+ ObjLen := 1 + StrPack Len;
+ igetv(Results,Strings) := igetv(Results,Strings) + 1;
+ Histo(StdTemplate,StringHTab,Len+1,StringSpaceTab,ObjLen);
+ >>;
+ HHalfwords:
+ << ObjLen := 1 + HalfWordPack HalfWordLen CurrentItem;
+ igetv(Results,HalfWords) := igetv(Results,HalfWords) + 1;
+ >>;
+ HWRDS:
+ << Len := WrdLen CurrentItem;
+ ObjLen := 1 + WrdPack Len;
+ igetv(Results,WordVecs) := igetv(Results,WordVecs) + 1;
+ Histo(StdTemplate,WordHTab,Len+1,WordSpaceTab,ObjLen);
+ >>;
+ HVECT:
+ << Len := VecLen CurrentItem;
+ ObjLen := 1 + VectPack Len;
+ igetv(Results,Vectors) := igetv(Results,Vectors) + 1;
+ Histo(StdTemplate,VectHTab,Len+1,VectSpaceTab,ObjLen);
+ >>;
+ default:
+ Error(0,"Illegal item in heap at %o", CurrentItem);
+ end; % case
+ CurrentItem := CurrentItem + ObjLen;
+ end;
+
+ Results;
+ end;
+
+%%% Internal utility routine used by heapstats to accumulate
+%%% values into the statistics tables. The template is a
+%%% histogram template. The table is a histogram table. The
+%%% "value" is tallied into the appropriate bucket of the table
+%%% based on the template. Spacetab is similar to "table", but
+%%% the value of "space" will be added rather than tallied into
+%%% spacetab.
+Syslsp procedure Histo(Template,Table,Value,SpaceTab,Space);
+begin
+ for i := 0 step 1 until isizev(Template) do
+ if igetv(Template,i) >= Value then
+ << igetv(Table,i) := igetv(Table,i) + 1;
+ igetv(SpaceTab,i) := igetv(SpaceTab,i) + Space;
+ return;
+ >>;
+ if Value > igetv(Template,isizev(Template)) then
+ << igetv(Table,isizev(Template)+1)
+ := igetv(Table,isizev(Template)+1) + 1;
+ igetv(SpaceTab,isizev(Template)+1)
+ := igetv(SpaceTab,isizev(Template)+1) + Space;
+ >>;
+end;
+
+SysLsp procedure FillVector(v,k);
+ for i := 0 step 1 until isizev(v) do
+ igetv(v,i) := k;
ADDED psl-1983/3-1/util/hash.sl
Index: psl-1983/3-1/util/hash.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/hash.sl
@@ -0,0 +1,199 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Hash table package, rather general purpose.
+%%% Author: Cris Perdue 8/25/82
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Edit by Cris Perdue, 9 Apr 1983 1159-PST
+% Now uses fast, open-coded operations.
+% Edit by Cris Perdue, 25 Feb 1983 1408-PST
+% Cleaned up code and documentation for demo.
+% Added NBuckets as an INITable variable.
+
+(compiletime (load if data-machine numeric-operators
+ fast-vector))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Hash table flavor.
+%%%
+%%% This is an external chaining hash table. Thus the table can never
+%%% overflow and collision path length grows slowly, though search time
+%%% can theoretically grow large. The implementation includes ability
+%%% to delete an association plus several other bells and whistles.
+%%%
+%%% Hash table instantiation can be as simple as:
+%%% (make-instance 'hash).
+%%%
+%%% Options to make-instance are:
+%%% NBuckets: Number of hash buckets to create initially. Defaults
+%%% to 100.
+%%% HashFn: Given a key, must return a fairly large pseudo-random
+%%% integer. Defaults to StrHash, for string keys.
+%%% NullValue: A value for Lookup to return if no association is found.
+%%% Defaults to NIL.
+%%% MaxFillRatio: A floating point number which is the maximum ratio of
+%%% the number of associations to the number of buckets.
+%%% If this ratio is reached, the table will be enlarged
+%%% to make the ratio about .5. Defaults to 2.0.
+%%% KeyCopyFn: Used by PutAssn. In some cases when a new association
+%%% is created one may want to copy the key so that it
+%%% will be guaranteed not to be modified. Defaults to
+%%% a function that returns its argument without any copying.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Gettable state:
+%%%
+%%% Usage: Number of associations currently in the table.
+%%% NullValue: Value for Lookup to return if no association found.
+%%%
+%%% The following relate specifically to associations made via
+%%% hash table:
+%%% MaxFillRatio
+%%% NBuckets
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Operations:
+%%%
+%%% Present?(key)
+%%%
+%%% Returns T or NIL depending on whether there is an association with
+%%% the given key.
+%%%
+%%% Lookup(key)
+%%%
+%%% Returns the value associated with the key, or the NullValue for the
+%%% table if no association exists.
+%%%
+%%% PutAssn(key value)
+%%%
+%%% Makes an association between the key and value, replacing any old
+%%% association. The key may be copied if a new association is created,
+%%% otherwise the copy of the key already stored continues to be used.
+%%% Returns the value.
+%%%
+%%% DeleteAssn(key)
+%%%
+%%% Deletes any association that may exist for the key. Returns a value
+%%% in the manner of Lookup.
+%%%
+%%% ReSize(size)
+%%%
+%%% Rehashes the table into "size" buckets. This operation is specific
+%%% to associations made with hash tables.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Preliminaries: definitions, etc.
+
+%(setq bitsperword 32) % Hack to use from LISP.
+ % Available as constant in SYSLISP.
+ % In this package need only be no
+ % greater than actual bits per word.
+
+(defmacro funcall (fn . args)
+ `(apply ,fn (list ,@args)))
+
+%%% Hash flavor definition.
+
+(defflavor Hash
+ (Table (NBuckets 100) (Usage 0) OverFlowLevel (MaxFillRatio 2.0)
+ (HashFn 'StrHash) (NullValue NIL) (CompareFn 'String=)
+ (KeyCopyFn 'no-op))
+ ()
+ (gettable-instance-variables NBuckets Usage NullValue MaxFillRatio)
+ (initable-instance-variables
+ NBuckets MaxFillRatio HashFn NullValue KeyCopyFn)
+ )
+
+(defmethod (Hash init) (init-plist)
+
+ %% Perhaps the table size should be prime . . .
+ (setf Table
+ (MkVect (- NBuckets 1)))
+ (while (leq MaxFillRatio .5)
+ (ContinuableError
+ 0 "Set MaxFillRatio greater than .5 before continuing" t))
+ (setf OverFlowLevel (Fix (* NBuckets MaxFillRatio))))
+
+(defmethod (Hash Present?) (key)
+ (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
+ (if (Ass CompareFn Key (igetv Table i))
+ then t else nil)))
+
+(defmethod (Hash Lookup) (key)
+ (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
+ (let ((Entry (Ass CompareFn Key (igetv Table i))))
+ (if Entry then (cdr Entry) else NullValue))))
+
+(defmethod (Hash PutAssn) (key value)
+ (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
+ (let ((Entry (Ass CompareFn Key (igetv Table i))))
+ (if Entry then (RplacD Entry value)
+ else
+ (setf (igetv Table i)
+ (cons (cons (funcall KeyCopyfn key) value)
+ (igetv Table i)))
+ (setf Usage (add1 Usage))
+ (if (not (< Usage OverFlowLevel)) then
+ (=> Self resize (* 2 Usage))))))
+ value)
+
+(defmethod (Hash DeleteAssn) (key)
+ (let ((i (Hash$HashBucket Table (funcall HashFn Key))))
+ (let ((Entry (Ass CompareFn Key (igetv Table i))) (Value))
+ (if Entry then
+ (setq Value (cdr Entry))
+ (setf (igetv Table i) (DelQIP Entry (igetv Table i)))
+ (setf Usage (- Usage 1))
+ Value
+ else
+ NullValue))))
+
+(defmethod (Hash MapAssn) (fn)
+ (for (from i 0 (Size Table))
+ (do (for (in a (igetv Table i))
+ (do (funcall fn (car a)))))))
+
+% Operations that are not basic
+
+(defmethod (Hash ReSize) (new-size)
+ (if (< new-size 1)
+ (StdError (BldMsg "Hash table size of %p too small" new-size)))
+ (let ((newtable
+ (mkvect (- new-size 1)))
+ (oldtable table))
+ (setf NBuckets new-size)
+ (setf Table newtable)
+ (setf OverFlowLevel (Fix (* NBuckets MaxFillRatio)))
+ (setf Usage 0)
+ (for (from i 0 (Size oldtable))
+ (do (for (in a (igetv oldtable i))
+ (do (=> Self PutAssn (car a) (cdr a))))))
+ Self))
+
+%%% Internal functions
+
+(on fast-integers)
+
+(defun Hash$HashBucket (table hashed-key) % Returns index of bucket
+ (remainder hashed-key (isizev table)))
+
+(defun no-op (x) x)
+
+%%% Useful related function
+
+(defun StrHash (S) % Compute hash function of string
+ (let ((len (StrLen S))
+ (AvailableBits (- (wconst InfBitLength) 8))
+ (HashVal 0))
+ (if (> Len AvailableBits) then
+ (setq Len AvailableBits))
+ (setq s (StrBase (StrInf s)))
+ (for (from I 0 Len)
+ (do (setq HashVal
+ (LXOR HashVal
+ (LShift (Byte S I)
+ (- AvailableBits I))))))
+ HashVal))
+
+(off fast-integers)
ADDED psl-1983/3-1/util/hcons.sl
Index: psl-1983/3-1/util/hcons.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/hcons.sl
@@ -0,0 +1,345 @@
+% HCONS.SL - Hashing (unique) CONS and associated utilities.
+%
+% Author: William Galway
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 2 June 1982
+% Copyright (c) 1982 University of Utah
+%
+(BothTimes % ?? Compile time may suffice.
+ (load useful)
+ (load fast-vector))
+
+% Summary of "user level" functions provided:
+% (DM Hcons (X) ...) % Nary hashed cons, right associative.
+% (DN Hlist (X) ...) % Hcons version of "list" function.
+
+% Hcons version of "copy" function. Note that unlike copy, this is not
+% guaranteed to create a new copy of a structure. (In fact, rather the
+% opposite.)
+% (DE Hcopy (lst) ...)
+
+% (DE Happend (U V) ...) % Hcons version of "append" function.
+% (DE Hreverse (U) ...) % Hcons version of "reverse" function.
+
+% Pairs for property list functions must be created by Hcons.
+% Get property of id or pair.
+% (DE extended-get (id-or-pair indicator) ...)
+% Put property of id or pair. Known to setf.
+% (DE extended-put (id-or-pair indicator val) ...)
+
+
+% Number of hash "slots" in table, should be a prime number to get an even
+% spread of hits (??). This package has been written so that it should be
+% possible to modify this size at runtime (I hope). So if the hash-tables
+% get too heavily loaded they can be copied to larger ones.
+(DefConst hcons-table-size 103)
+
+% Build the two tables (we switch from one to the other on each garbage
+% collection. Note that (MkVect 1) gives TWO locations.
+(setf hash-cons-tables (MkVect 1))
+
+(setf (IGetV hash-cons-tables 0)
+ (MkVect (sub1 (const hcons-table-size))))
+
+(setf (IGetV hash-cons-tables 1)
+ (MkVect (sub1 (const hcons-table-size))))
+
+% current-table-number switches between 0 and one at each garbage
+% collection--selecting the current table to use.
+(setf current-table-number 0)
+
+(DE next-table-number (table-number)
+ (cond
+ ((equal table-number 0) 1)
+ (T 0)))
+
+% Should really use structs for this, but I'm unsure on the exact details
+% of how structs work, and it's very important to understand how much free
+% space will be demanded by any routines that are called.
+% Anyway, each location in a "hash table" is either NIL, or an "entry",
+% where an entry is implemented as a vector of
+% [ <dotted-pair> <property-list-for-pair> <next-entry-in-chain> ]
+
+% This should be done differently too.
+(DefConst entry-size 4) % The size of an entry in "heap units"??
+(DefConst pair-size 2) % Similarly for pairs.
+
+(DS create-hash-entry ()
+ % Create a 3 element vector.
+ (MkVect 2))
+
+(DS pair-info (ent)
+ (IGetV ent 0))
+
+(DS prop-list-info (ent)
+ (IGetV ent 1))
+
+(DS next-entry (ent)
+ (IGetV ent 2))
+
+% Finds a location within a "hash table", for a pair (X,Y).
+% This version is very simpleminded!
+(DS hcons-hash-function (htable X Y)
+ (remainder
+ % Take absolute value to avoid sign problems with remainder.
+ (abs (plus (Sys2Int X) (Sys2Int Y)))
+ (add1 (ISizeV htable))))
+
+% Copy entries from one "hash cons table" to another, setting the source
+% table to all NILs. Return the dst-table, as well as copying into it.
+% This routine is used to place entries in their new locations after a
+% garbage collection. This routine MUST NOT allocate anything on the heap.
+(DE move-hcons-table (src-table dst-table)
+ (prog (dst-index src-entry src-pair nxt-entry)
+ (for (from src-index 0 (ISizeV src-table) 1)
+ (do
+ (progn
+ (setf src-entry (IGetV src-table src-index))
+ % Use GetV here, until "the bug" in IGetV gets fixed.
+ (setf (GetV src-table src-index) NIL)
+ (while src-entry
+ (progn
+ (setf src-pair (pair-info src-entry))
+ (setf dst-index
+ (hcons-hash-function
+ dst-table
+ (car src-pair) (cdr src-pair)))
+ % Save the next entry in the the chain, and then relink the
+ % current entry into its new location.
+ (setf nxt-entry (next-entry src-entry))
+ (setf (next-entry src-entry)
+ (IGetV dst-table dst-index))
+ (setf (IGetV dst-table dst-index) src-entry)
+ % Move to next thing in chain.
+ (setf src-entry nxt-entry))))))
+
+ (return dst-table)))
+
+% Nary version of hashed cons.
+(DM Hcons (X)
+ (RobustExpand (cdr X) 'hcons2 NIL))
+
+% Binary "hashed" cons of X and Y, returns pointer to previously
+% constructed pair if it can be found in the hash table.
+(DE Hcons2 (X Y)
+ (prog (hashloc hitchain tmpchain newpair newentry)
+ (setf hashloc (hcons-hash-function
+ (IGetV hash-cons-tables current-table-number)
+ X Y))
+
+ % Get chain of entries at the appropriate hash location in the
+ % appropriate table.
+ (setf hitchain (IGetV
+ (IGetV hash-cons-tables current-table-number)
+ hashloc))
+
+ % Search for a previously constructed pair, if any, with car and cdr
+ % equal to X and Y respectively.
+ % Note that tmpchain is not a list, but a "chain" of "entries".
+ (setf tmpchain hitchain)
+ (while (and tmpchain
+ % Keep searching unless an exact match is found.
+ (not (and
+ % EqN test might be better, so that we handle numbers
+ % intelligently? Probably have to worry about hash
+ % code also.
+ (eq X (car (setf newpair (pair-info tmpchain))))
+ (eq Y (cdr newpair)))))
+ % do
+ (setf tmpchain (next-entry tmpchain)))
+
+ (cond
+ % If no entry was found, create a new one.
+ ((null tmpchain)
+ (progn
+ % We need enough room for one new pair, plus one new entry. If
+ % there isn't enough room on the heap then collect garbage (and
+ % in the process move EVERYTHING around, switch hash tables,
+ % etc.)
+ (cond
+ ((LessP
+ (GtHeap NIL) % Returns free space in heap.
+ (plus (const pair-size) (const entry-size)))
+ (progn
+ (reclaim)
+ % Recalculate locations of everything.
+ (setf hashloc
+ (hcons-hash-function
+ (IGetV hash-cons-tables current-table-number)
+ X Y))
+
+ % Get chain of entries at the appropriate hash location in
+ % the appropriate table.
+ (setf hitchain
+ (IGetV
+ (IGetV hash-cons-tables current-table-number)
+ hashloc)))))
+
+ % Allocate the new pair, store information into the appropriate
+ % spot in appropriate table.
+ (setf newpair (cons X Y))
+ (setf newentry (create-hash-entry))
+
+ (setf (pair-info newentry) newpair)
+ (setf (prop-list-info newentry) NIL)
+ (setf (next-entry newentry) hitchain)
+ % Link the new entry into the front of the table.
+ (setf
+ (IGetV
+ (IGetV hash-cons-tables current-table-number)
+ hashloc)
+ newentry))))
+
+ % Return the pair (either newly constructed, or old).
+ (return newpair)))
+
+% "hcons" version of "list" function.
+(DN Hlist (X)
+ (do-hlist X))
+
+(DE do-hlist (X)
+ (cond
+ ((null X) NIL)
+ (T (hcons (car X) (do-hlist (cdr X))))))
+
+% "hcons" version of copy. Note that unlike copy, this is not guaranteed
+% to create a new copy of a structure. (In fact, rather the opposite.)
+(DE Hcopy (lst)
+ (cond
+ ((not (pairp lst)) lst)
+ (T (hcons (hcopy (car lst)) (hcopy (cdr lst))))))
+
+% "hcons" version of Append function.
+(DE Happend (U V)
+ (cond
+ % First arg is NIL, or some other non-pair.
+ ((not (PairP U)) V)
+ % else ...
+ (T (hcons (car U) (Happend (cdr U) V)))))
+
+% Hcons version of Reverse.
+(DE Hreverse (U)
+ (prog (V)
+ (while (PairP U)
+ (progn
+ (setf V (hcons (car U) V))
+ (setf U (cdr U))))
+ (return V)))
+
+% Look up and return the entry for a pair, if any. Return NIL if argument
+% is not a pair.
+(DE entry-for-pair (p)
+ (cond
+ ((PairP p)
+ (prog (hashloc ent)
+ (setf hashloc
+ (hcons-hash-function
+ (IGetV hash-cons-tables current-table-number)
+ (car p) (cdr p)))
+
+ % Look at appropriate spot in hash table.
+ (setf ent
+ (IGetV (IGetV hash-cons-tables current-table-number) hashloc))
+
+ % Search through chain for p.
+ (while (and ent
+ (not (eq (pair-info ent) p)))
+ (setf ent (next-entry ent)))
+
+ % Return the entry, or NIL if none found.
+ (return ent)))))
+
+% Get a property for a pair or identifier. Only pairs stored in the hash
+% table have properties.
+(DE extended-get (id-or-pair indicator)
+ (cond
+ ((IdP id-or-pair) (get id-or-pair indicator))
+
+ ((PairP id-or-pair)
+ (prog (proplist prop-pair)
+ (setf proplist (pair-property-list id-or-pair))
+ (setf prop-pair (atsoc indicator proplist))
+ (return
+ (cond
+ ((PairP prop-pair) (cdr prop-pair))))))))
+
+% Put function for pairs and identifiers. Only pairs in the hash table can
+% be given properties. (We are very sloppy about case when pair isn't in
+% table, but hopefully the code won't blow up.) "val" is returned in all
+% cases.
+(DE extended-put (id-or-pair indicator val)
+ (cond
+ ((IdP id-or-pair) (put id-or-pair indicator val))
+
+ ((PairP id-or-pair)
+ (prog (proplist prop-pair)
+ (setf proplist (pair-property-list id-or-pair))
+ % Get the information (if any) stored under the indicator.
+ (setf prop-pair (Atsoc indicator proplist))
+ (cond
+ % Modify the information under the indicator, if any.
+ ((PairP prop-pair)
+ (setf (cdr prop-pair) val))
+
+ % Otherwise (nothing found under indicator), create new
+ % (indicator . value) pair.
+ (T
+ (progn
+ % Note use of cons, not Hcons, WHICH IS RIGHT? (I think cons.)
+ (setf prop-pair (cons indicator val))
+ % Tack new (indicator . value) pair onto property list, and
+ % store in entry for the pair who's property list is being
+ % hacked.
+ (set-pair-property-list
+ id-or-pair (cons prop-pair proplist)))))
+
+ % We return the value even if the pair isn't in the hash table.
+ (return val)))))
+
+(PUT 'extended-get 'assign-op 'extended-put)
+(FLAG '(extended-get) 'SETF-SAFE)
+
+% Return the "property list" associated with a pair.
+(DE pair-property-list (p)
+ (prog (ent)
+ (setf ent (entry-for-pair p))
+ (return
+ (cond
+ (ent (prop-list-info ent))
+ (T NIL)))))
+
+% Set the "property list" cell for a pair, return the new "property list".
+(DE set-pair-property-list (p val)
+ (prog (ent)
+ (setf ent (entry-for-pair p))
+ (return
+ (cond
+ (ent (setf (prop-list-info ent) val))
+ (T NIL)))))
+
+% We redefine the garbage collector so that it rebuilds the hash table
+% after garbage collection has moved everything.
+(putd 'original-!%Reclaim (car (getd '!%Reclaim)) (cdr (getd '!%Reclaim)))
+
+% New version of !%reclaim--shuffles stuff in cons tables after collecting
+% garbage.
+(DE !%Reclaim ()
+ (prog1
+ (original-!%Reclaim)
+
+ % Move the old table to the new one, shuffling everything into its
+ % correct position.
+ (move-hcons-table
+ % Would use IGetV, but there appears to be a bug preventing it from
+ % working.
+ % Source
+ (GetV hash-cons-tables current-table-number)
+ % Destination
+ (GetV hash-cons-tables
+ (next-table-number current-table-number)))
+
+ % Point to new "current-table".
+ (setf current-table-number
+ (next-table-number current-table-number))))
ADDED psl-1983/3-1/util/heap-stats.sl
Index: psl-1983/3-1/util/heap-stats.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/heap-stats.sl
@@ -0,0 +1,151 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Ordinary LISP part of the heap statistics gathering package, HEAP-STATS.
+%%% Load this file to get the package.
+%%% The top-level function is collect-stats. See its description.
+%%%
+%%% Author: Cris Perdue
+%%% December 1982
+%%% Documented and cleaned up a litte, January 1983
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load if))
+
+(load h-stats-1 get-heap-bounds)
+
+%%% An object that holds a complete set of statistics for the heap
+%%% at some moment in time. When one of these is created, the
+%%% instance variable "template" must be initialized, and the
+%%% template must be a "histogram template" as discussed below.
+
+%%% Maintainer note: the code that actually gathers statistics assumes
+%%% that the heap-stats object is a vector (or evector) with a header,
+%%% 2 items of data allocated by the objects package, then the data shown
+%%% here, in order.
+(defflavor heap-stats
+ (template
+ string-count
+ string-space
+ vector-count
+ vector-space
+ wordvec-count
+ wordvec-space
+ (pairs 0)
+ (strings 0)
+ (halfwords 0)
+ (wordvecs 0)
+ (vectors 0))
+ ()
+ (initable-instance-variables template)
+ gettable-instance-variables)
+
+(defmethod (heap-stats init) (init-plist)
+ (if (not (vectorp template)) then
+ (error 0 "The TEMPLATE of a HEAP-STATS object must be initialized."))
+ (let ((s (+ (size template) 1)))
+ (setf string-count (make-vector s 0))
+ (setf string-space (make-vector s 0))
+ (setf vector-count (make-vector s 0))
+ (setf vector-space (make-vector s 0))
+ (setf wordvec-count (make-vector s 0))
+ (setf wordvec-space (make-vector s 0))))
+
+(global '(old-!%reclaim stats-channel))
+
+%%% This method prints statistics on a particular snapshot of the heap
+%%% onto the given channel.
+(defmethod (heap-stats print-stats) (channel)
+ (channelprintf
+ channel
+ "%w pairs, %w strings, %w vectors, %w wordvecs, %w halfwordvecs%n%n"
+ pairs strings vectors wordvecs halfwords)
+ (for (in table (list string-count vector-count))
+ (in spacetable (list string-space vector-space))
+ (in title '("STRINGS" "VECTORS"))
+ (do
+ (channelprintf channel "%w%n%n" title)
+ (print-histo template table spacetable channel)
+ (channelterpri channel)
+ (channelterpri channel))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Internal functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Prints a single histogram onto the given channel. Arguments
+%%% are the template from which the histogram was generated, a
+%%% corresponding table with a count of the number of objects of
+%%% each size range, and another corresponding table with the
+%%% total space occupied by the objects within each size range.
+(defun print-histo (template table spacetable channel)
+ (channelprintf channel
+ "Size <= n%tHow many%tStorage items used%n" 12 24)
+ (channelprintf channel
+ "------------------------------------------%n")
+ (for (from i 0 (size template))
+ (do (channelprintf channel
+ "%w%t%w%t%w%n" (indx template i) 12
+ (indx table i) 24 (indx spacetable i))))
+ (channelprintf channel
+ "> %w%t%w%t%w%n"
+ (indx template (size template)) 12
+ (indx table (+ (size template) 1)) 24
+ (indx spacetable (+ (size template) 1))))
+
+(fluid '(before-stats after-stats print-stats? stdtemplate))
+
+%%% This function initializes the collecting of statistics and
+%%% printing them to a file. The name of the file is the
+%%% argument to collect-stats. NIL rather than a string for the file
+%%% name turns statistics collection off. In statistics collection mode
+%%% statistics are gathered just before and after each garbage collection.
+(defun collect-stats (file)
+ (if (and file (not old-!%reclaim)) then
+ (if (not (and (eq (object-type before-stats) 'heap-stats)
+ (eq (object-type after-stats) 'heap-stats))) then
+ (printf "Caution: before- and after-stats are not both bound.%n"))
+ (setq old-!%reclaim (cdr (getd '!%reclaim)))
+ (setq stats-channel (open file 'output))
+ (putd '!%reclaim
+ 'expr
+ '(lambda ()
+ (heapstats before-stats)
+ (apply old-!%reclaim nil)
+ (heapstats after-stats)
+ (channelprintf stats-channel "BEFORE RECLAIMING%n%n")
+ (=> before-stats print-stats stats-channel)
+ (channelterpri stats-channel)
+ (channelprintf stats-channel "AFTER RECLAIMING%n%n")
+ (=> after-stats print-stats stats-channel)))
+ elseif (and (not file) old-!%reclaim) then
+ (close stats-channel)
+ (putd '!%reclaim 'expr old-!%reclaim)
+ (setq old-!%reclaim nil)
+ elseif old-!%reclaim then
+ (printf "Statistics collecting is apparently already turned on.%n")
+ else
+ (printf "Statistics collecting is apparently already off.%n")
+ (printf "Trying to close the channel anyway.%n")
+ (close stats-channel)))
+
+%%% This is initialized here to be a reasonable histogram template for
+%%% statistics on heap usage. A histogram template is a vector of
+%%% integers that define the buckets to be used in collecting the
+%%% histogram data. All values less than or equal to template[0]
+%%% go into data[0]. Of those values that do not go into data[0],
+%%% all less than or equal to template[1] go into data[1], etc..
+%%% The vector of data must have at least one more element that
+%%% the template does. All values greater than the last value in
+%%% the template go into the following element of the data vector.
+(setq StdTemplate
+ (make-vector 27 0))
+
+(for (from i 0 16)
+ (do (setf (indx StdTemplate i) i)))
+
+(for (from i 17 27)
+ (for k 32 (* k 2))
+ (do (setf (indx StdTemplate i) k)))
+
+(setq before-stats (make-instance 'heap-stats 'template StdTemplate))
+
+(setq after-stats (make-instance 'heap-stats 'template StdTemplate))
ADDED psl-1983/3-1/util/help.build
Index: psl-1983/3-1/util/help.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/help.build
@@ -0,0 +1,22 @@
+% Build file for HELP.RED module
+% MLG, 9 Feb, 1983
+% Changed Unix paths to use $ vars
+
+CompileTime load If!-System;
+
+if_system(Tops20, <<
+HelpFileFormat!* := "ph:%w.hlp";
+HelpTable!* := "ph:help.tbl";
+>>);
+
+if_system(Unix, <<
+HelpFileFormat!* := "$ph/%w.hlp";
+HelpTable!* := "$ph/help.tbl";
+>>);
+
+if_system(HP9836, <<
+HelpFileFormat!* := "ph:%w.hlp";
+HelpTable!* := "ph:help.tbl";
+>>);
+
+in "help.red"$
ADDED psl-1983/3-1/util/help.red
Index: psl-1983/3-1/util/help.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/help.red
@@ -0,0 +1,188 @@
+%
+% HELP.RED - User assistance and documentation
+%
+% Author: Eric Benson and Martin Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 23 October 1981
+% Copyright (c) 1981 University of Utah
+%
+% 30 Dec, 1982, MLG
+% Move IF_SYSTEM to the Build file
+% <PSL.UTIL.NEWVERSIONS>HELP.RED, 30-Nov-82 16:31, Edit by GALWAY
+% Changed "FLAG" to "SWITCH" to avoid confusion with flags on property
+% lists and to bring terminology in line with PSL manual.
+% <PSL.UTIL>HELP.RED.3, 1-Dec-82 16:16:39, Edit by BENSON
+% Added if_system(HP9836, ... )
+% <PSL.UTIL>HELP.RED.4, 10-Aug-82 00:54:26, Edit by BENSON
+% Changed ReadCh to ReadChar in DisplayHelpFile
+% <PSL.INTERP>HELP.RED.5, 31-May-82 11:50:48, Edit by GRISS
+% Make it LAPIN Help.Tbl
+% Changed: to use PH:
+
+% Display help texts, invoke interactive HELPs or print default values
+
+% Place a HELP function on topic name under 'HelpFunction
+% Or HELP file on topic name under 'HelpFile
+% Or even a short string under 'HelpString (this may be removed)
+
+fluid '(TopLoopRead!*
+ TopLoopPrint!*
+ TopLoopEval!*
+ TopLoopName!*
+ HelpFileFormat!*
+ Options!*
+ !*Echo
+ HelpIn!*
+ HelpOut!*
+ !*Lower
+ !*ReloadHelpTable
+ HelpTable!*
+);
+
+!*ReloadHelpTable := T;
+
+lisp procedure ReloadHelpTable();
+% Set !*ReloadHelpTable to T to cause a fresh help table to be loaded
+ if !*ReloadHelpTable then
+ << LapIn HelpTable!*;
+ !*ReloadHelpTable := NIL >>;
+
+lisp procedure DisplayHelpFile F;
+% Type help file about 'F'
+begin scalar NewIn, C, !*Echo;
+ (lambda(!*Lower);
+ F := BldMsg(HelpFileFormat!*, F))(T);
+ NewIn := ErrorSet(list('Open, MkQuote F, '(quote Input)), NIL, NIL);
+ if not PairP NewIn then
+ ErrorPrintF("*** Couldn't find help file %r", F)
+ else
+ << NewIn := car NewIn;
+ while not ((C := ChannelReadChar NewIn) = char EOF) do WriteChar C;
+ Close NewIn >>;
+end;
+
+fexpr procedure Help U;
+% Look for Help on topics U
+begin scalar OldOut;
+ OldOut := WRS HelpOut!*;
+ ReloadHelpTable(); % Conditional Reload
+ HelpTopicList U;
+ WRS OldOut;
+end;
+
+lisp procedure HelpTopicList U;
+% Auxilliary function to prind help for each topic in list U
+ if null U then HelpHelp()
+ else for each X in U do
+ begin scalar F;
+ if F := get(X, 'HelpFunction) then Apply(F, NIL)
+ else if F := get(X, 'HelpFile) then DisplayHelpFile F
+ else if F := get(X, 'HelpString) then Prin2T F
+ else DisplayHelpFile X; % Perhaps a File Exists.
+ end;
+
+lisp procedure HelpHelp();
+% HELPFUNCTION: for help itself
+<< DisplayHelpFile 'Help;
+ FindHelpTopics();
+ PrintF("%nOptional modules now loaded:%n%l%n",Options!*);
+ >>;
+
+lisp procedure FindHelpTopics();
+% Scan the ID HAST TABLE for loaded HELP info
+<< PrintF("Help is available on the following topics:%n");
+ MapObl Function TestHelpTopic;
+ TerPri();
+ PrintF("The files in the help directory can be read using Help.%n") >>;
+
+lisp procedure TestHelpTopic X;
+% auxilliary function applied to each ID to see if
+% some help info exists
+ if get(X, 'HelpFunction) or get(X, 'HelpFile) or get(X, 'HelpString) then
+ << Prin2 '! ;
+ Prin1 X >>;
+
+lisp procedure HelpTopLoop();
+% HELPFUNCTION: for TopLoop, show READER/WRITERS
+<< DisplayHelpFile 'Top!-Loop;
+ if TopLoopName!* then
+ << PrintF("%nCurrently inside %w top loop%n", TopLoopName!*);
+ PrintF("Reader: %p, Evaluator: %p, Printer: %p%n",
+ TopLoopRead!*, TopLoopEval!*, TopLoopPrint!*) >>
+ else PrintF("%nNot currently inside top loop%n") >>;
+
+% Switch and global help - record and display all switches and globals.
+
+lisp procedure DefineSwitch(Name, Info);
+% Define important switch
+% Name does Not have the !*, Info should be a string.
+%
+<< put(Name, 'SwitchInfo, Info);
+ Name >>;
+
+lisp procedure Show1Switch(Name);
+% Display a single switch
+begin scalar X;
+ Prin1 Name;
+ Tab 15;
+ Prin1 Eval Intern Concat("*", ID2String Name);
+ If (X := Get(Name, 'SwitchInfo)) then
+ << Tab 25;
+ Prin2 X >>;
+ TerPri();
+end;
+
+lisp procedure ShowSwitches L;
+% Display all switches in a list
+<< if not PairP L then MapObl function TestShowSwitch;
+ for each X in L do Show1Switch X >>;
+
+lisp procedure TestShowSwitch X;
+% Support function for 1 switch display
+ if get(X, 'SwitchInfo) then Show1Switch X;
+
+lisp procedure DefineGlobal(Name, Info);
+% Define important global
+% Name is an ID, Info should be a string.
+%
+<< put(Name, 'GlobalInfo, Info);
+ Name >>;
+
+lisp procedure Show1Global Name;
+% Display a Single Global
+begin scalar X;
+ Prin1 Name;
+ Tab 15;
+ Prin1 Eval Name;
+ If (X := get(Name, 'GlobalInfo)) then
+ << Tab 25;
+ Prin2 X >>;
+ TerPri();
+end;
+
+lisp procedure TestShowGlobal X;
+% Support for GLOBAL info
+ if get(X, 'GlobalInfo) then Show1Global X;
+
+lisp procedure Show1State Name;
+% Display a single switch or global
+<< if get(Name, 'GlobalInfo) then Show1Global Name;
+ if get(Name, 'SwitchInfo) then Show1Switch Name >>;
+
+lisp procedure ShowGlobals L;
+% Display all globals in a list
+<< if not PairP L then MapObl Function TestShowGlobal;
+ for each X in L do Show1Global X >>;
+
+lisp procedure ShowState L;
+% Display all globals in a list
+<< if not PairP L then MapObl function TestShowState;
+ for each X in L do Show1State X >>;
+
+lisp procedure TestShowState X;
+% Support for a Global
+ if get(X, 'SwitchInfo) or get(X, 'GlobalInfo) then Show1State X;
+
+END;
ADDED psl-1983/3-1/util/history.sl
Index: psl-1983/3-1/util/history.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/history.sl
@@ -0,0 +1,378 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; File containing functions to create a history mechanism.
+;; (exploited what is there with (inp n) (ans n) and historylist*).
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This file depends upon : init.lisp (basic lisp functions and syntax).
+;; (in <lanam.dhl>).
+;;
+;; This file written by Douglas H. Lanam. September 1982.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; How to use the history mechanism implemented in this file:
+;;
+;; This file allows you to take any previous input or output and substitute
+;; it in place of what you typed. Thus you can either print or redo
+;; any input you have previously done. You can also print or
+;; execute any result you have previously received.
+;; The system will work identify commands by either their history number,
+;; or by a subword in the input command.
+;;
+;; This file also allows you to take any previously expression and do
+;; global substitutions on subwords inside words or numbers inside
+;; expressions(Thus allowing spelling corrections, and other word
+;; changes easily.)
+;;
+;; This file has a set of read macros that insert the previous history
+;; text asked for inplace of them selves. Thus they can be put inside
+;; any lisp expression typed by the user. The system will evaluate
+;; the resulting expression the same as if the user had retyped everything
+;; in himself.
+;;
+;; ^^ : means insert last input command inplace of ^^.
+;; As an input command by itself,
+;; ^^ by itself means redo last command.
+;;
+;; ^n : where n is a number replaces itself with the result of
+;; (inp n). ^n by itself means (redo n).
+;; ^+n : same as ^n.
+;; ^-n : is replaced by the nth back command.
+;; replaced with the result of
+;; (inp (- current-history-number n)).
+;; by itself means (redo (- current-history-number n))
+;;
+;; ^word : where word starts with 'a'-'z' or 'A'-'Z', means
+;; take the last input command that has word as a subword
+;; or pattern of what was typed (after readmacros were
+;; executed.), and replace that ^word with that entire input
+;; command.
+;; If you want a word that doesn't begin with 'a'-'z', or 'A'-'Z',
+;; use ^?word where word can be any lisp atom.
+;; (say 23, *, |"ab|, word).
+;; ex.: 1 lisp> (plus 2 3)
+;; 5
+;; 2 lisp> (* 4 5)
+;; 20
+;; 3 lisp> ^us
+;; (PLUS 2 3)
+;; 5
+;; 4 lisp> (* 3 ^lu)
+;; (PLUS 2 3)
+;; 15
+;;
+;; Case is ignored in word. Word is read by the command read,
+;; And thus should be a normal lisp atom. Use the escape
+;; character as needed.
+;;
+;; If the first ^ in any of the above commands is replaced with
+;; ^@, then instead of (inp n) , the read macro is replaced with
+;; (ans n). Words are still matched against the input, not the
+;; answer. (Probably something should be added to allow matching
+;; of subwords against the answer also.)
+;;
+;; Thus:(if typed as commands by themselves):
+;;
+;; ^@^ = (eval (ans (last-command)))
+;; ^@3 = (eval (ans 3))
+;;
+;; ^@plus = (eval (ans (last-command which has plus as a subword in
+;; its input))).
+;;
+;;
+;; Once the ^ readmacro is replaced with its history expression, you are
+;; allowed to do some editing of the command. The way to do this
+;; is to type a colon immediately after the ^ command as described
+;; above before any space or other delimiting character.
+;; ex.: ^plus:p
+;; ^2:s/ab/cd/
+;; ^^:p
+;; ^@^:p
+;;
+;; Currently there are two types of editing commands allowed.
+;;
+;; :p means print only, do not insert in expression, whole
+;; read macro returns only nil.
+;;
+;; :s/word1/word2/ means take each atom in the expression found,
+;; and if word1 is a subword of that atom, replace the
+;; subword word1 with word2. Read is used to read word1
+;; and word2, thus the system expects an atom and will
+;; ignore anything after what read sees before the /.
+;; Use escape characters as necessary.
+;;
+;; :n where n is a positive unsigned number, means take the nth
+;; element of the command(must be a list) and return it.
+;;
+;; ^string1^string2^ is equivalent to ^string1:s/string1/string2/
+;; ex.: ^plus^times^ is equivalent to ^plus:s/plus/times/ .
+;;
+;; After a :s, ^ or :<n> command you may have another :s command, ^
+;; or a :p
+;; command. :p command may not be followed by any other command.
+;;
+;; The expression as modified by the :s commands is what is
+;; returned in place of the ^ readmacro.
+;; You need a closing / as seen in the :s command above.
+;; After the command you should type a delimiting character if
+;; you wish the next expression to begin with a :, since a :
+;; will be interpreted as another editing command.
+;;
+;; On substitution, case is ignored when matching the subword,
+;; and the replacement subword
+;; is capitalized(unless you use an escape character before
+;; typing a lowercase letter).
+;;
+;; Examples:
+;; 1 lisp> (plus 23 34)
+;; 57
+;; 2 lisp> ^^:s/plus/times/
+;; (TIMES 23 34)
+;; 782
+;; 3 lisp> ^plus:s/3/5/
+;; (PLUS 25 54)
+;; 79
+;; 4 lisp>
+;;
+;;
+(defmacro unreadch (x) `(unreadchar (id2int ,x)))
+(defmacro last-command () `(caadr historylist*))
+(defmacro last-answer () `(cdadr historylist*))
+(defun nth-command (n part) (cond ((eq part 'input) (inp n))
+ (t (ans n))))
+
+(defun my-nthcdr (l n)
+ (cond ((<= n 0) l)
+ ((null l) nil)
+ ((my-nthcdr (cdr l) (- n 1)))))
+
+(defvar *print-history-command-expansion t)
+
+(de skip-if (stop-char)
+ (let ((x (readch)))
+ (or (eq x stop-char) (unreadch x))))
+
+(defun return-command (command)
+ (and *print-history-command-expansion
+ command
+ ($prpr command) (terpri))
+ command)
+
+(defun do-history-command-and-return-command (string1 c)
+ (let ((command (do-history-command string1 c)))
+ (and *print-history-command-expansion command
+ ($prpr command) (terpri))
+ command))
+
+(defun nth-back-command (n)
+ (do ((i n (+ 1 i))
+ (command-list historylist*
+ (cdr command-list)))
+ ((eq i 0) (caar command-list))))
+
+(defvar *flink (*makhunk 80))
+
+(defun kmp-flowchart-construction (p m)
+ (rplacx 0 *flink -1)
+ (do ((i 1 (+ 1 i)))
+ ((> i m))
+ (do ((j (cxr (- i 1) *flink) (cxr j *flink)))
+ ((or (= j -1) (= (cxr j p) (cxr (- i 1) p)))
+ (rplacx i *flink (+ j 1))))))
+
+(defun kmp-scan (p m s)
+ (and s
+ (prog (j)
+ (setq j 0)
+ loop (cond ((and (<> j -1) (<> (uppercassify (cxr j p))
+ (uppercassify (car s))))
+ (setq j (cxr j *flink)) (go loop)))
+ (and (= j m) (return t))
+ (or (setq j (+ 1 j) s (cdr s)) (return nil))
+ (go loop))))
+
+(defun match-list-beginnings (starting-list list)
+ (do ((x starting-list (cdr x))
+ (y list (cdr y)))
+ ((null x) t)
+ (or (eq (car x) (car y))
+ (return nil))))
+
+(defun uppercassify (y)
+ (cond ((and (>= y '|a|) (<= y '|z|))
+ (+ y (- '|A| '|a|)))
+ (t y)))
+
+(defun read-till-and-raise (stop-char)
+ (let ((s (my-syntax stop-char)) (d))
+ (my-set-syntax stop-char 17)
+ (setq d (read)) (skip-if stop-char)
+ (my-set-syntax stop-char s)
+ d))
+
+(defun do-history-command (string1 command)
+ (let ((b))
+ ;; colon after word indicates history command.
+ ;;
+ (cond ((eq (setq b (readch)) '|:|)
+ ;; read key command
+ (selectq (setq b (readch))
+ (p
+ ;; only print result - dont execute
+ ;; return nil so that a quoted version doesn't confuse the
+ ;; history mechanism later. ( i would like to change this
+ ;; to enter command in the history list but not execute).
+ ($prpr command) (terpri)
+ (rplaca (car historylist*) command)
+ (*throw '$error$ nil))
+ (s ; change all subwords of string1 with string2.
+ (do-history-command string1
+ (let ((delimiter (readch)))
+ (match-and-substitute
+ (read-till-and-raise delimiter) command
+ (read-till-and-raise delimiter)))))
+ ;;
+ ;; number indicates get that element of the command out of
+ ;; the list.
+ ;;
+ ((|0| |1| |2| |3| |4| |5| |6| |7| |8| |9|)
+ (unreadch b)
+ (let ((s (my-syntax '|:|))
+ (s1 (my-syntax '|^|))
+ (n))
+ (my-set-syntax '|:| 17)
+ (my-set-syntax '|^| 17)
+ (setq n (read))
+ (my-set-syntax '|:| s)
+ (my-set-syntax '|^| s1)
+ (cond ((null (dtpr command))
+ (princ "Error: not a list : ") ($prpr command)
+ (terpri) nil)
+ ((null (numberp n))
+ (princ "Error: expected number. ")
+ (princ n)
+ (princ " is not a number.")
+ (terpri) nil)
+ ((> n (length command))
+ (princ "Error: ") (princ n)
+ (princ " is out of range for ") ($prpr command)
+ (terpri) nil)
+ (t (do-history-command string1 (nth command n))))))
+ (t
+ (princ "Error: unknown command key : \|")
+ (princ b) (princ "|")
+ (terpri)
+ ;; return original command
+ command)))
+ ((eq b '|^|)
+ ;; equivalent to :s/string1/string2/
+ ;; is ^string1^string2^
+ (cond (string1 (match-and-substitute
+ string1 command
+ (read-till-and-raise '|^|)))
+ (t (terpri)
+ (princ "illegal option to history command.")
+ (terpri)
+ nil)))
+ (t (unreadch b)
+ ;; return original command
+ command))))
+
+(defun match-back-command (partial-match /&optional (part-to-return 'input))
+ (let ((p (list2vector (explode partial-match))))
+ (let ((m (upbv p)))
+ (kmp-flowchart-construction p m)
+ (do ((x (cdr historylist*) (cdr x)))
+ ((null x) nil)
+ (and (kmp-scan p m (explode (caar x)))
+ (cond ((eq part-to-return 'input)
+ (return (caar x)))
+ (t (return (cdar x)))))))))
+
+(defun match-and-substitute (partial-match command replacement)
+ (let ((p (list2vector (explode partial-match))))
+ (let ((m (upbv p)))
+ (kmp-flowchart-construction p m)
+ (let ((l (flatsize partial-match)))
+ (match-and-substitute1 p m (explode partial-match)
+ command (explode replacement) l)))))
+
+(defun match-and-substitute1 (p m s command replacement l)
+ (cond ((or (atom command) (numberp command))
+ (kmp-scan-and-replace p m (explode command)
+ replacement l command))
+ (t (cons
+ (match-and-substitute1 p m s (car command) replacement l)
+ (match-and-substitute1 p m s (cdr command) replacement l)))))
+
+(defun kmp-scan-and-replace (p m s replacement l command)
+ (and s (prog (j k flag)
+ (setq flag (stringp command))
+ (setq j 0) (setq k nil)
+ loop
+ (cond ((and (<> j -1)
+ (<> (uppercassify (cxr j p))
+ (uppercassify (car s))))
+ (setq j (cxr j *flink)) (go loop)))
+ (setq k (cons (car s) k))
+ (and (= j m)
+ (return (cond ((stringp command)
+ (list2string
+ (cdr (append
+ (append (nreverse (my-nthcdr k l))
+ replacement)
+ (cdr (nreverse
+ (cdr (nreverse s))))))))
+ (t (let ((x (append
+ (append
+ (nreverse (my-nthcdr k l))
+ replacement)
+ (cdr s))))
+ (and (= (my-syntax (car x)) 14)
+ (<= (my-syntax (cadr x)) 10)
+ (setq x (cdr x)))
+ (let ((y (implode x)))
+ (cond ((eq (flatsize y) (length x)) y)
+ (t (intern (list2string x))))))))))
+ (or (setq j (+ 1 j) s (cdr s)) (return command))
+ (go loop))))
+
+(defun read-sub-word ()
+ (let ((c (my-syntax '|:|))
+ (d))
+ ;; dont read : since it is the special command character.
+ (my-set-syntax '|:| 17)
+ (setq d (read))
+ (my-set-syntax '|:| c)
+ d))
+
+(defun re-execute-command (/&optional (part 'input))
+ (let ((y (readch)))
+ (cond ((eq y '\^) (do-history-command-and-return-command
+ nil (last-command)))
+ ((eq y '\*) (do-history-command-and-return-command
+ nil (last-answer)))
+ ((eq y '\@) (re-execute-command 'answer))
+ ((eq y '\?)
+ (let ((yy (read-sub-word)))
+ (do-history-command-and-return-command yy
+ (match-back-command yy part))))
+ ((or (digit y) (memq y '(|+| |-|)))
+ (unreadch y)
+ (let ((y (read-sub-word)))
+ (cond ((numberp y)
+ (cond ((> y 0) (do-history-command-and-return-command nil
+ (nth-command y part)))
+ ((< y 0) (do-history-command-and-return-command nil
+ (nth-back-command y))))))))
+ ((liter y)
+ (unreadch y)
+ (let ((yy (read-sub-word)))
+ (do-history-command-and-return-command
+ yy
+ (match-back-command yy))))
+ )))
+
+(my-set-readmacro '\^ (function re-execute-command))
ADDED psl-1983/3-1/util/if-system.build
Index: psl-1983/3-1/util/if-system.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/if-system.build
@@ -0,0 +1,1 @@
+in "if-system.red"$
ADDED psl-1983/3-1/util/if-system.red
Index: psl-1983/3-1/util/if-system.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/if-system.red
@@ -0,0 +1,20 @@
+%
+% IF-SYSTEM.RED - Conditional compilation for system-dependent code
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 10 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+fluid '(system_list!*);
+
+macro procedure if_system U;
+ do_if_system(cadr U, caddr U, if cdddr U then cadddr U else NIL);
+
+expr procedure do_if_system(system_name, true_case, false_case);
+ if system_name memq system_list!* then true_case else false_case;
+
+END;
ADDED psl-1983/3-1/util/if.sl
Index: psl-1983/3-1/util/if.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/if.sl
@@ -0,0 +1,69 @@
+% IF macro
+% Cris Perdue 8/19/82
+
+(setq *usermode nil)
+
+% Syntax of new IF is:
+% (if <expr> [then <expr> ... ] [<elseif-part> ... ] [else <expr> ... ])
+% <elseif-part> = elseif <expr> [then <expr> ... ]
+% This syntax allows construction of arbitrary CONDs.
+(defun construct-new-if (form)
+ (let (
+ (clause)
+ (next-clause)
+ (stmt (list 'cond))
+ (e form))
+ (while e
+ (cond
+ ((or (sym= (first e) 'if)
+ (sym= (first e) 'elseif))
+ (cond ((or (null (rest e))
+ (not (or (null (rest (rest e)))
+ (sym= (third e) 'then)
+ (sym= (third e) 'else)
+ (sym= (third e) 'elseif))))
+ (error 0 "Can't expand IF.")))
+ (setq next-clause (next-if-clause e))
+ (setq clause
+ (cond ((and (rest (rest e))
+ (sym= (third e) 'then))
+ (cons (second e)
+ (ldiff (pnth e 4) next-clause)))
+ (t (list (second e)))))
+ (nconc stmt (list clause))
+ (setq e next-clause)
+ (next))
+ ((sym= (first e) 'else)
+ (cond ((or (null (rest e)) (next-if-clause e))
+ (error 0 "Can't expand IF.")))
+ (nconc stmt (list (cons t (rest e))))
+ (exit))))
+ stmt))
+
+(defun next-if-clause (tail)
+ (for (on x (rest tail))
+ (do (cond ((or (sym= (first x) 'else)
+ (sym= (first x) 'elseif))
+ (return x))))
+ (returns nil)))
+
+(defun sym= (a b) (eq a b))
+
+(defun ldiff (x y)
+ (cond ((null x) nil)
+ ((eq x y) nil)
+ (t (cons (first x) (ldiff (rest x) y)))))
+
+% Checks for (IF <expr> <KEYWORD> . . . ) form. If keyword form,
+% does fancy expansion, otherwise expands compatibly with MacLISP
+% IF expression. <KEYWORD> ::= THEN | ELSE | ELSEIF
+(dm if (form)
+ (let ((b (rest (rest form)))
+ (test (second form)))
+ (cond
+ ((or (sym= (first b) 'then)
+ (sym= (first b) 'else)
+ (sym= (first b) 'elseif))
+ (construct-new-if form))
+ ((eq (length b) 1) `(cond (,test ,(nth b 1))))
+ (t `(cond (,test ,(nth b 1)) (t ,@(pnth b 2)))))))
ADDED psl-1983/3-1/util/init-file.build
Index: psl-1983/3-1/util/init-file.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/init-file.build
@@ -0,0 +1,2 @@
+CompileTime load If!-System;
+in "init-file.sl"$
ADDED psl-1983/3-1/util/init-file.sl
Index: psl-1983/3-1/util/init-file.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/init-file.sl
@@ -0,0 +1,17 @@
+%
+% INIT-FILE.SL - Function which reads an init file
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 September 1982
+% Copyright (c) 1982 University of Utah
+%
+
+(if_system Tops20 (imports '(homedir)))
+
+(de read-init-file (program-name)
+ ((lambda (f)
+ (cond ((filep f) (lapin f))))
+ (init-file-string program-name)))
ADDED psl-1983/3-1/util/inspect.build
Index: psl-1983/3-1/util/inspect.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/inspect.build
@@ -0,0 +1,2 @@
+Compiletime Load Gsort; % Need a macro
+In "inspect.red"$
ADDED psl-1983/3-1/util/inspect.red
Index: psl-1983/3-1/util/inspect.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/inspect.red
@@ -0,0 +1,163 @@
+% INSPECT.RED - Scan files for defined functions
+%
+% Author: Martin Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 31 May 1982
+% Copyright (c) 1982 University of Utah
+%
+% adapted from CREF and BUILD
+
+Imports '(Gsort Dir!-Stuff);
+
+FLUID '(!*UserMode % To control USER Redef message
+ !*ECHO
+ !*RedefMsg % To suppress REDEF messages
+ CurrentFile!* % To keep tack of this file
+ FileList!* % Files seen so far
+ ProcedureList!* % procedures seen so far
+ ProcFileList!* % (PROC . FILE) so far
+ !*PrintInspect % Print each proc
+ !*QuietInspect % Suppress INSPECTOUT messages
+);
+
+!*PrintInspect:=T;
+!*QuietInspect:=NIL;
+
+Procedure Inspect X;
+begin scalar !*UserMode,!*Redefmsg,!*QuietInspect;
+ !*QuietInspect:=T;
+ INSPECTOut();
+ !*ECHO:=NIL;
+ If Not FunboundP 'Begin1 then EvIn list X
+ else EVAL LIST('Dskin, x);
+ INSPECTEnd();
+end;
+
+Procedure InspectOut; % Scan Files for Definitions
+ Begin
+ !*DEFN:=T; !*ECHO:=NIL; SEMIC!*:= '!$ ;
+ DFPRINT!* := 'InspectPrint;
+ ProcedureList!*:=FileList!* :=ProcFileList!*:=NIL;
+ CurrentFile!* := NIL;
+ if not !*QuietInspect then
+ << if not FUnBoundP 'Begin1 then
+ << Prin2T "INSPECTOUT: IN files; or type in expressions";
+ Prin2T "When all done execute INSPECTEND;" >>
+ else
+ << Prin2T "INSPECTOUT: (DSKIN files) or type in expressions";
+ Prin2T "When all done execute (INSPECTEND)" >> >>;
+ End;
+
+Procedure InspectEnd;
+ Begin
+ If !*PrintInspect then PrintF "%n%% --- Done with INSPECTION ---%n";
+ Dfprint!*:=NIL;
+ !*Defn:=NIL;
+ ProcedureList!* := IdSort ProcedureList!*;
+ If !*PrintInspect then <<Prin2T "% --- PROCS: --- ";
+ Print ProcedureList!*>>;
+ End;
+
+Procedure InspectPrint U;
+ BEGIN scalar x;
+ !*ECHO:=NIL;
+ SEMIC!*:='!$;
+ x:=IF PairP CLOC!* THEN CAR CLOC!* ELSE "*TTYInput*";
+ If x NEQ CurrentFile!* and !*PrintInspect then
+ PrintF("%n%% --- Inspecting File : %r --- %n",x);
+ CurrentFile!* := x;
+ % Find current FILE name, see if new
+ IF Not MEMBER(CurrentFile!*,FileList!*) THEN
+ FileList!*:=CurrentFile!* . FileList!*;
+ InspectForm U;
+ END;
+
+FLAG('(INSPECTEND),'IGNORE);
+PUT('InspectEnd,'RlispPrefix,'(NIL LAMBDA(X) (ESTAT 'Inspectend)));
+
+procedure InspectForm U; %. Called by TOP-loop, DFPRINT!*
+begin scalar Nam, Ty, Fn;
+ if not PairP U then return NIL;
+ Fn := car U;
+ IF FN = 'PUTD THEN GOTO DB2;
+ IF NOT (FN MEMQ '(DE DF DM DN)) THEN GOTO DB1;
+ NAM:=CADR U;
+ U:='LAMBDA . CDDR U;
+ TY:=CDR ASSOC(FN, '((DE . EXPR)
+ (DF . FEXPR)
+ (DM . MACRO)
+ (DN . NEXPR)));
+DB3: if Ty = 'MACRO then
+ begin scalar !*Comp;
+ PutD(Nam, Ty, U); % Macros get defined now
+ end;
+ if FlagP(Nam, 'Lose) then <<
+ ErrorPrintF("*** %r has not been defined, because it is flagged LOSE",
+ Nam);
+ return NIL >>;
+ InspectProc(Nam,Ty);
+ RETURN NIL;
+DB1: % Simple S-EXPRESSION look for LAP etc.
+ IF EQCAR(U,'LAP) Then Return InspectLap U;
+ IF EQCAR(U,'Imports)
+ then Return PrintF("%% --- Imports: %w in %w%n",Cadr U, CurrentFile!*);
+ % Maybe indicate IMPORTS etc.
+ RETURN NIL;
+DB2: % analyse PUTD
+ NAM:=CADR U;
+ TY:=CADDR U;
+ FN:=CADDDR U;
+ IF EQCAR(NAM,'QUOTE) THEN << NAM:=CADR NAM;
+ IF EQCAR(TY,'QUOTE) THEN << TY:=CADR TY;
+ IF PAIRP FN AND CAR FN MEMBER '(FUNCTION QUOTE) THEN << FN:=CADR FN;
+ IF TY MEMQ '(EXPR FEXPR MACRO NEXPR) THEN
+ << U:=FN; GOTO DB3 >> >> >> >>;
+ GOTO DB1;
+ END;
+
+Procedure InspectProc(Nam,Ty);
+<<If !*PrintInspect then <<Prin1 NAM; Prin2 " ">>;
+ ProcedureList!*:=NAM . ProcedureList!*;
+ ProcFileList!*:=(NAM . CurrentFile!*) . ProcFileList!*>>;
+
+Procedure InspectLap U;
+ For each x in U do if EQcar(x,'!*ENTRY) then InspectProc(Cadr U,Caddr U);
+
+% -- Handle LISTs of files and dirs ---
+
+Fluid '(!*PrintInspect !*QuietInspect);
+
+Nexpr procedure GetFileList L;
+ GetFiles1 L;
+
+Procedure GetFiles1 L;
+ If null L then Nil
+ else append(Vector2List GetCleandir Car L, GetFiles1 Cdr L);
+
+procedure InspectToFile F;
+ Begin scalar f1,c;
+ f1:=Bldmsg("%s-%s.ins",GetFileName(f),GetExtension(f));
+ Printf(" Inspecting %r to %r%n",F,F1);
+ c:=open(f1,'output);
+ WRS c;
+ !*PrintInspect:=NIL;
+ Inspect F$
+ Prin2 "(ProcList '"$
+ Print ProcedureList!*;
+ Prin2T ")";
+ WRS NIL;
+ close c;
+ End;
+
+procedure InspectAllFiles Files;
+For each x in files do
+ <<PrintF("Doing file: %w%n",x);
+ InspectToFile x>>;
+
+Procedure InspectAllPU();
+ InspectAllFiles getFileList("pu:*.red","PU:*.sl");
+
+
+END;
ADDED psl-1983/3-1/util/inum.build
Index: psl-1983/3-1/util/inum.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/inum.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp;
+in "inum.red"$
ADDED psl-1983/3-1/util/inum.red
Index: psl-1983/3-1/util/inum.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/inum.red
@@ -0,0 +1,116 @@
+%
+% INUM.RED - Interpreter entries for open-compiled integer arithmetic
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 18 March 1982
+% Copyright (c) 1982 University of Utah
+%
+
+off R2I;
+
+CompileTime
+<<
+
+smacro procedure InumTwoArg IName;
+lisp procedure IName(Arg1, Arg2);
+begin scalar Result;
+ return if IntP Arg1 and IntP Arg2
+ and IntP(Result := IName(Arg1, Arg2)) then Result
+ else Inum2Error(Arg1, Arg2, quote IName);
+end;
+
+smacro procedure InumTwoArgBool IName;
+lisp procedure IName(Arg1, Arg2);
+ if IntP Arg1 and IntP Arg2 then IName(Arg1, Arg2)
+ else Inum2Error(Arg1, Arg2, quote IName);
+
+smacro procedure InumOneArg IName;
+lisp procedure IName Arg;
+begin scalar Result;
+ return if IntP Arg and IntP(Result := IName Arg) then
+ Result
+ else Inum1Error(Arg, quote IName);
+end;
+
+smacro procedure InumOneArgBool IName;
+lisp procedure IName Arg;
+ if IntP Arg then IName Arg
+ else Inum1Error(Arg, quote IName);
+
+>>;
+
+lisp procedure Inum2Error(Arg1, Arg2, Name);
+ ContinuableError(99, "Inum out of range", list(Name, Arg1, Arg2));
+
+lisp procedure Inum1Error(Arg, Name);
+ ContinuableError(99, "Inum out of range", list(Name, Arg));
+
+InumTwoArg IPlus2;
+
+InumTwoArg IDifference;
+
+InumTwoArg ITimes2;
+
+InumTwoArg IQuotient;
+
+InumTwoArg IRemainder;
+
+InumTwoArgBool ILessP;
+
+InumTwoArgBool IGreaterP;
+
+InumTwoArgBool ILEQ;
+
+InumTwoArgBool IGEQ;
+
+InumTwoArg ILOR;
+
+InumTwoArg ILAND;
+
+InumTwoArg ILXOR;
+
+InumTwoArg ILSH;
+
+InumOneArg IAdd1;
+
+InumOneArg ISub1;
+
+InumOneArg IMinus;
+
+InumOneArgBool IZeroP;
+
+InumOneArgBool IOneP;
+
+InumOneArgBool IMinusP;
+
+on R2I;
+
+macro procedure IFor U;
+ MkSysFor U;
+
+if not FUnBoundP 'Begin1 then <<
+
+DEFINEROP('IFOR,NIL,ParseIFOR);
+
+SYMBOLIC PROCEDURE ParseIFOR X;
+ BEGIN SCALAR INIT,STP,UNTL,ACTION,ACTEXPR;
+ IF (OP := SCAN()) EQ 'SETQ THEN INIT := PARSE0(6,T)
+ ELSE PARERR("FOR missing loop VAR assignment",T);
+ IF OP EQ '!*COLON!* THEN <<STP := 1; OP := 'UNTIL>>
+ ELSE IF OP EQ 'STEP THEN STP := PARSE0(6,T)
+ ELSE PARERR("FOR missing : or STEP clause",T);
+ IF OP EQ 'UNTIL THEN UNTL := PARSE0(6,T)
+ ELSE PARERR("FOR missing UNTIL clause",T);
+ ACTION := OP;
+ IF ACTION MEMQ '(DO SUM PRODUCT) THEN ACTEXPR := PARSE0(6,T)
+ ELSE PARERR("FOR missing action keyword",T);
+ RETURN LIST('IFOR,
+ LIST('FROM,X,INIT,UNTL,STP),
+ LIST(ACTION,ACTEXPR))
+ END;
+>>;
+
+END;
ADDED psl-1983/3-1/util/iter-macros.sl
Index: psl-1983/3-1/util/iter-macros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/iter-macros.sl
@@ -0,0 +1,122 @@
+% ITER-MACROS.SL - macros for generalized iteration
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% <PSL.UTIL>ITER-MACROS.SL.9, 15-Sep-82 17:06:49, Edit by BENSON
+% Fixed typo, ((null (cdr result) nil)) ==> ((null (cdr result)) nil)
+
+(defmacro do (iterators result . body)
+ (let (vars steps)
+ (setq vars
+ (foreach U in iterators collect
+ (if (and (pairp U) (cdr U) (cddr U))
+ (progn
+ (setq steps (cons
+ (if (atom (car U)) (car U) (caar U))
+ (cons (caddr U) steps)))
+ (list (car U) (cadr U)))
+ U)))
+ (let ((form `(prog ()
+ ***DO-LABEL***
+ (cond
+ (,(car result)
+ (return ,(cond
+ ((null (cdr result)) nil)
+ ((and
+ (pairp (cdr result))
+ (null (cddr result)))
+ (cadr result))
+ (t `(progn ,@(cdr result)))))))
+ ,@body
+ (psetq ,.steps)
+ (go ***DO-LABEL***))))
+ (if vars `(let ,vars ,form) form))))
+
+(defmacro do* (iterators result . body)
+ (let (vars steps)
+ (setq vars
+ (foreach U in iterators collect
+ (if (and (pairp U) (cdr U) (cddr U))
+ (progn
+ (push
+ `(setq ,(if (atom (car U)) (car U) (caar U)) ,(caddr U))
+ steps)
+ (list (car U) (cadr U)))
+ U)))
+ (let ((form `(prog ()
+ ***DO-LABEL***
+ (cond
+ (,(car result)
+ (return ,(cond
+ ((null (cdr result)) nil)
+ ((and
+ (pairp (cdr result))
+ (null (cddr result)))
+ (cadr result))
+ (t `(progn ,@(cdr result)))))))
+ ,@body
+ ,.(reversip steps)
+ (go ***DO-LABEL***))))
+ (if vars `(let* ,vars ,form) form))))
+
+(defmacro do-loop (iterators prologue result . body)
+ (let (vars steps)
+ (setq vars
+ (foreach U in iterators collect
+ (if (and (pairp U) (cdr U) (cddr U))
+ (progn
+ (setq steps (cons
+ (if (atom (car U)) (car U) (caar U))
+ (cons (caddr U) steps)))
+ (list (car U) (cadr U)))
+ U)))
+ (let ((form `(prog ()
+ ,@prologue
+ ***DO-LABEL***
+ (cond
+ (,(car result)
+ (return ,(cond
+ ((null (cdr result)) nil)
+ ((and
+ (pairp (cdr result))
+ (null (cddr result)))
+ (cadr result))
+ (t `(progn ,@(cdr result)))))))
+ ,@body
+ (psetq ,.steps)
+ (go ***DO-LABEL***))))
+ (if vars `(let ,vars ,form) form))))
+
+(defmacro do-loop* (iterators prologue result . body)
+ (let (vars steps)
+ (setq vars
+ (foreach U in iterators collect
+ (if (and (pairp U) (cdr U) (cddr U))
+ (progn
+ (push
+ `(setq ,(if (atom (car U)) (car U) (caar U)) ,(caddr U))
+ steps)
+ (list (car U) (cadr U)))
+ U)))
+ (let ((form `(prog ()
+ ,@prologue
+ ***DO-LABEL***
+ (cond
+ (,(car result)
+ (return ,(cond
+ ((null (cdr result)) nil)
+ ((and
+ (pairp (cdr result))
+ (null (cddr result)))
+ (cadr result))
+ (t `(progn ,@(cdr result)))))))
+ ,@body
+ ,.(reversip steps)
+ (go ***DO-LABEL***))))
+ (if vars `(let* ,vars ,form) form))))
+
ADDED psl-1983/3-1/util/kernel.build
Index: psl-1983/3-1/util/kernel.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/kernel.build
@@ -0,0 +1,1 @@
+in "kernel.sl"$
ADDED psl-1983/3-1/util/kernel.sl
Index: psl-1983/3-1/util/kernel.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/kernel.sl
@@ -0,0 +1,114 @@
+%
+% KERNEL.SL - Generate scripts for building PSL kernel
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 26 May 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% <PSL.UTIL>KERNEL.SL.2, 20-Dec-82 11:21:03, Edit by BENSON
+% Added kernel-header and kernel-trailer
+% <PSL.UTIL>KERNEL.SL.9, 7-Jun-82 12:22:48, Edit by BENSON
+% Changed kernel-file to all-kernel-script-name* and all-kernel-script-format*
+% <PSL.UTIL>KERNEL.SL.8, 6-Jun-82 05:23:40, Edit by GRISS
+% Added kernel-file
+
+(compiletime (load useful))
+
+(compiletime (flag '(build-link-script build-kernel-file
+ build-init-file build-file-aux
+ insert-file-names insert-file-names-aux)
+ 'InternalFunction))
+
+(fluid '(kernel-name-list*
+ command-file-name*
+ command-file-format*
+ init-file-name*
+ init-file-format*
+ all-kernel-script-name*
+ all-kernel-script-header*
+ all-kernel-script-format*
+ all-kernel-script-trailer*
+ code-object-file-name*
+ data-object-file-name*
+ link-script-name*
+ link-script-format*
+ script-file-name-separator*))
+
+(de kernel (kernel-name-list*)
+ (let ((*lower t)) % For the benefit of Unix
+ (build-command-files kernel-name-list*)
+% MAIN is not included in all-kernel-script
+ (build-kernel-file (delete 'main kernel-name-list*))
+ (build-link-script)
+ (build-init-file)))
+
+(de build-command-files (k-list)
+ (unless (null k-list)
+ (let ((name-stem (first k-list)))
+ (let ((f (wrs (open (bldmsg command-file-name* name-stem)
+ 'output))))
+ (printf command-file-format* name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem
+ name-stem)
+ (close (wrs f))))
+ (build-command-files (rest k-list))))
+
+(de build-link-script ()
+ (let ((f (wrs (open link-script-name* 'output))))
+ (linelength 1000)
+ (printf link-script-format* '(insert-link-file-names)
+ '(insert-link-file-names)
+ '(insert-link-file-names)
+ '(insert-link-file-names)
+ '(insert-link-file-names)
+ '(insert-link-file-names))
+ (close (wrs f))))
+
+(de build-kernel-file (n-list)
+ (let ((f (wrs (open all-kernel-script-name* 'output))))
+ (linelength 1000)
+ (unless (null all-kernel-script-header*)
+ (prin2 all-kernel-script-header*))
+ (build-file-aux n-list all-kernel-script-format*)
+ (unless (null all-kernel-script-trailer*)
+ (prin2 all-kernel-script-trailer*))
+ (close (wrs f))))
+
+(de insert-link-file-names ()
+ (insert-file-names kernel-name-list* code-object-file-name*)
+ (prin2 script-file-name-separator*)
+ (insert-file-names kernel-name-list* data-object-file-name*))
+
+(de insert-file-names (n-list format)
+ (printf format (first n-list))
+ (insert-file-names-aux (rest n-list) format))
+
+(de insert-file-names-aux (n-list format)
+ (unless (null n-list)
+ (prin2 script-file-name-separator*)
+ (printf format (first n-list))
+ (insert-file-names-aux (rest n-list) format)))
+
+(de build-init-file ()
+ (let ((f (wrs (open init-file-name* 'output))))
+ (build-file-aux kernel-name-list* init-file-format*)
+ (close (wrs f))))
+
+(de build-file-aux (n-list format)
+ (unless (null n-list)
+ (printf format (first n-list))
+ (build-file-aux (rest n-list) format)))
ADDED psl-1983/3-1/util/loop.build
Index: psl-1983/3-1/util/loop.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/loop.build
@@ -0,0 +1,3 @@
+CompileTime load Clcomp;
+off Usermode;
+in "loop.lsp"$
ADDED psl-1983/3-1/util/loop.lsp
Index: psl-1983/3-1/util/loop.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/loop.lsp
@@ -0,0 +1,976 @@
+
+;(setq |SCCS-loop| "@(#)loop.l 1.2 7/9/81")
+;-*- Mode:LISP; Package:System-Internals; Base:8; Lowercase:T -*-
+
+;The master copy of this file is on ML:LSB1;LOOP >
+;The current Lisp machine copy is on AI:LISPM2;LOOP >
+;The FASL and QFASL should also be accessible from LIBLSP; on all machines.
+
+; Bugs/complaints/suggestions/solicitations-for-documentation to BUG-LOOP
+; at any ITS site.
+
+;; the file was franzified by JKF.
+;
+
+;; PSLified by Eric Benson, October 1982
+
+;;;; LOOP Iteration Macro
+
+
+; Hack up the stuff for data-types. DATA-TYPE? will always be a macro
+; so that it will not require the data-type package at run time if
+; all uses of the other routines are conditionalized upon that value.
+(defmacro data-type? (x) `(get ,x ':data-type))
+
+;(declare
+; (*lexpr variable-declarations)
+; (*expr initial-value form-wrapper))
+
+(eval-when (eval compile)
+(macro status (x) (errorprintf "***** %p" x) ())
+(copyd 'sstatus 'status)
+(copyd 'variable-declarations 'status)
+(defmacro c-mapc (x y) `(mapc ,y ,x))
+(defmacro c-mapcar (x y) `(mapcar ,y ,x))
+(defmacro loop-error (x y) `(stderror (list ,x ,y)))
+)
+;Loop macro
+
+;(eval-when (eval compile)
+; (defun lexpr-funcall macro (x)
+; `(apply ,(cadr x) (list* . ,(cddr x)))))
+
+
+(defun loop-displace (x y)
+ ((lambda (val) (rplaca x (car val)) (rplacd x (cdr val)) x)
+ (cond ((atom y) (list 'progn y)) (t y))))
+
+
+(defmacro loop-finish ()
+ '(go end-loop))
+
+(macro neq (x) `(not (eq . ,(cdr x))))
+
+
+(defun loop-make-psetq (frobs)
+ (loop-make-setq
+ (car frobs)
+ (cond ((null (cddr frobs)) (cadr frobs))
+ (t `(prog1 ,(cadr frobs) ,(loop-make-psetq (cddr frobs)))))))
+
+(defmacro loop-psetq frobs
+ (loop-make-psetq frobs))
+
+
+
+
+(defvar loop-keyword-alist ;clause introducers
+ '( (initially loop-do-initially)
+ (finally loop-do-finally)
+ (do loop-do-do)
+ (doing loop-do-do)
+ (return loop-do-return)
+ (collect loop-do-collect list)
+ (collecting loop-do-collect list)
+ (append loop-do-collect append)
+ (appending loop-do-collect append)
+ (nconc loop-do-collect nconc)
+ (nconcing loop-do-collect nconc)
+ (count loop-do-collect count)
+ (counting loop-do-collect count)
+ (sum loop-do-collect sum)
+ (summing loop-do-collect sum)
+ (maximize loop-do-collect max)
+ (minimize loop-do-collect min)
+ (always loop-do-always t)
+ (never loop-do-always nil)
+ (thereis loop-do-thereis)
+ (while loop-do-while or)
+ (until loop-do-while and)
+ (when loop-do-when nil)
+ (unless loop-do-when t)
+ (with loop-do-with)
+ (for loop-do-for)
+ (as loop-do-for)))
+
+(defvar loop-for-keyword-alist ;Types of FOR
+ '( (= loop-for-equals)
+ (in loop-for-in)
+ (on loop-for-on)
+ (from loop-for-arithmetic nil)
+ (downfrom loop-for-arithmetic down)
+ (upfrom loop-for-arithmetic up)
+ (being loop-for-being)))
+
+(defvar loop-path-keyword-alist nil) ; PATH functions
+(defvar loop-variables) ;Variables local to the loop
+(defvar loop-declarations) ; Local dcls for above
+(defvar loop-variable-stack)
+(defvar loop-declaration-stack)
+(defvar loop-prologue) ;List of forms in reverse order
+(defvar loop-body) ;..
+(defvar loop-after-body) ;.. for FOR steppers
+(defvar loop-epilogue) ;..
+(defvar loop-after-epilogue) ;So COLLECT's RETURN comes after FINALLY
+(defvar loop-conditionals) ;If non-NIL, condition for next form in body
+ ;The above is actually a list of entries of the form
+ ;(condition forms...)
+ ;When it is output, each successive condition will get
+ ;nested inside the previous one, but it is not built up
+ ;that way because you wouldn't be able to tell a WHEN-generated
+ ;COND from a user-generated COND.
+
+(defvar loop-when-it-variable) ;See LOOP-DO-WHEN
+(defvar loop-collect-cruft) ; for multiple COLLECTs (etc)
+(defvar loop-source-code)
+(defvar loop-attachment-transformer ; see attachment definition
+ (cond ((status feature lms) 'progn) (t nil)))
+
+(macro loop-lookup-keyword (x)
+
+ `(assq . ,(cdr x)))
+
+
+(defun loop-add-keyword (cruft alist-name)
+ (let ((val (symeval alist-name)) (known?))
+ (and (setq known? (loop-lookup-keyword (car cruft) val))
+ (set alist-name (delqip known? val)))
+ (set alist-name (cons cruft val))))
+
+
+(defmacro define-loop-macro (keyword)
+ (or (eq keyword 'loop)
+ (loop-lookup-keyword keyword loop-keyword-alist)
+ (loop-error "lisp: Not a loop keyword -- " keyword))
+ `(eval-when (compile load eval)
+ (putd ',keyword 'macro #'(lambda (macroarg) (loop-translate macroarg)))))
+
+(define-loop-macro loop)
+
+(defun loop-translate (x)
+ (loop-displace x (loop-translate-1 x)))
+
+
+(defun loop-translate-1 (loop-source-code)
+ (and (eq (car loop-source-code) 'loop)
+ (setq loop-source-code (cdr loop-source-code)))
+ (do ((loop-variables nil)
+ (loop-declarations nil)
+ (loop-variable-stack nil)
+ (loop-declaration-stack nil)
+ (loop-prologue nil)
+ (loop-body nil)
+ (loop-after-body nil)
+ (loop-epilogue nil)
+ (loop-after-epilogue nil)
+ (loop-conditionals nil)
+ (loop-when-it-variable nil)
+ (loop-collect-cruft nil)
+ (keyword)
+ (tem))
+ ((null loop-source-code)
+ (and loop-conditionals
+ (loop-error "lisp: hanging conditional in loop macro -- "
+ (caar loop-conditionals)))
+ (cond (loop-variables
+ (push loop-variables loop-variable-stack)
+ (push loop-declarations loop-declaration-stack)))
+ (setq tem `(prog ()
+ ,@(nreverse loop-prologue)
+ next-loop
+ ,@(nreverse loop-body)
+ ,@(nreverse loop-after-body)
+ (go next-loop)
+ end-loop
+ ,@(nreverse loop-epilogue)
+ ,@(nreverse loop-after-epilogue)))
+ (do ((vars) (dcls)) ((null loop-variable-stack))
+ (setq vars (pop loop-variable-stack)
+ dcls (pop loop-declaration-stack))
+ (and dcls (setq dcls `((declare . ,(nreverse dcls)))))
+ (setq tem `(,@dcls ,tem))
+ (cond ((do ((l vars (cdr l))) ((null l) nil)
+ (and (not (atom (car l)))
+ (not (atom (caar l)))
+ (return t)))
+ (setq tem `(let ,(nreverse vars) ,.tem)))
+ (t (let ((lambda-vars nil) (lambda-vals nil))
+ (do ((l vars (cdr l)) (v)) ((null l))
+ (cond ((atom (setq v (car l)))
+ (push v lambda-vars)
+ (push nil lambda-vals))
+ (t (push (car v) lambda-vars)
+ (push (cadr v) lambda-vals))))
+ (setq tem `((lambda ,(nreverse lambda-vars) ,.tem)
+ ,.(nreverse lambda-vals))))))
+ )
+ tem)
+ (if (symbolp (setq keyword (pop loop-source-code)))
+ (if (setq tem (loop-lookup-keyword keyword loop-keyword-alist))
+ (apply (cadr tem) (cddr tem))
+ (loop-error "lisp: unknown keyword in loop macro -- "
+ keyword))
+ (loop-error "lisp: loop found object where keyword expected -- "
+ keyword))))
+
+
+(defun loop-bind-block ()
+ (cond ((not (null loop-variables))
+ (push loop-variables loop-variable-stack)
+ (push loop-declarations loop-declaration-stack)
+ (setq loop-variables nil loop-declarations nil))
+ (loop-declarations (break))))
+
+
+;Get FORM argument to a keyword. Read up to atom. PROGNify if necessary.
+(defun loop-get-form ()
+ (do ((forms (list (pop loop-source-code)) (cons (pop loop-source-code) forms))
+ (nextform (car loop-source-code) (car loop-source-code)))
+ ((atom nextform)
+ (if (null (cdr forms)) (car forms)
+ (cons 'progn (nreverse forms))))))
+
+
+(defun loop-make-setq (var-or-pattern value)
+
+ (list (if (atom var-or-pattern) 'setq 'desetq) var-or-pattern value))
+
+
+(defun loop-imply-type (expression type)
+ (let ((frob (and (data-type? type)
+ (form-wrapper type expression))))
+ (cond ((not (null frob)) frob)
+ (t expression))))
+
+(defun loop-make-variable (name initialization dtype)
+ (cond ((null name)
+ (and initialization
+ (push (list nil
+ initialization)
+ loop-variables)))
+ ((atom name)
+ (cond ((data-type? dtype)
+ (setq loop-declarations
+ (append (variable-declarations dtype name)
+ loop-declarations))
+ (or initialization
+ (setq initialization (initial-value dtype))))
+ ((memq dtype '(fixnum flonum number))
+ (or initialization
+ (setq initialization (if (eq dtype 'flonum) 0.0 0)))))
+ (push (if initialization (list name initialization) name)
+ loop-variables))
+ (initialization
+ (push (list name initialization) loop-variables)
+ (loop-declare-variable name dtype))
+ (t (let ((tcar) (tcdr))
+ (cond ((atom dtype) (setq tcar (setq tcdr dtype)))
+ (t (setq tcar (car dtype) tcdr (cdr dtype))))
+ (loop-make-variable (car name) nil tcar)
+ (loop-make-variable (cdr name) nil tcdr))))
+ name)
+
+(defun loop-declare-variable (name dtype)
+ (cond ((or (null name) (null dtype)) nil)
+ ((atom name)
+ (cond ((data-type? dtype)
+ (setq loop-declarations
+ (append (variable-declarations dtype name)
+ loop-declarations)))
+ ))
+ ((atom dtype)
+ (loop-declare-variable (car name) dtype)
+ (loop-declare-variable (cdr name) dtype))
+ (t (loop-declare-variable (car name) (car dtype))
+ (loop-declare-variable (cdr name) (cdr dtype)))))
+
+
+(defun loop-maybe-bind-form (form data-type?)
+ (cond ((or (numberp form) (memq form '(t nil))
+ (and (not (atom form)) (eq (car form) 'quote)))
+ form)
+ (t (loop-make-variable (gensym) form data-type?))))
+
+
+(defun loop-optional-type ()
+ (let ((token (car loop-source-code)))
+ (and (not (null token))
+ (or (not (atom token))
+ (data-type? token)
+ (memq token '(fixnum flonum number)))
+ (pop loop-source-code))))
+
+
+;Compare two "tokens". The first is the frob out of LOOP-SOURCE-CODE,
+;the second a string (lispm) or symbol (maclisp) to check against.
+(defmacro loop-tequal (x1 x2) `(eq ,x1 ,x2))
+
+;Incorporates conditional if necessary
+(defun loop-emit-body (form)
+ (cond (loop-conditionals
+ (rplacd (last (car (last loop-conditionals)))
+ (cond ((and (not (atom form)) ;Make into list of forms
+ (eq (car form) 'progn))
+ (append (cdr form) nil))
+ (t (list form))))
+ (cond ((loop-tequal (car loop-source-code) "and")
+ (pop loop-source-code))
+ (t ;Nest up the conditionals and output them
+ (do ((prev (car loop-conditionals) (car l))
+ (l (cdr loop-conditionals) (cdr l)))
+ ((null l))
+ (rplacd (last prev) `((cond ,(car l)))))
+ (push `(cond ,(car loop-conditionals)) loop-body)
+ (setq loop-conditionals nil))))
+ (t (push form loop-body))))
+
+(defun loop-do-initially ()
+ (push (loop-get-form) loop-prologue))
+
+(defun loop-do-finally ()
+ (push (loop-get-form) loop-epilogue))
+
+(defun loop-do-do ()
+ (loop-emit-body (loop-get-form)))
+
+(defun loop-do-return ()
+ (loop-emit-body `(return ,(loop-get-form))))
+
+
+(defun loop-do-collect (type)
+ (let ((var) (form) (tem) (tail) (dtype) (cruft) (rvar)
+ (ctype (cond ((memq type '(max min)) 'maxmin)
+ ((memq type '(nconc list append)) 'list)
+ ((memq type '(count sum)) 'sum)
+ (t
+ (loop-error
+ "lisp: unrecognized loop collecting keyword -- "
+ type)))))
+ (setq form (loop-get-form) dtype (loop-optional-type))
+ (cond ((loop-tequal (car loop-source-code) 'into)
+ (pop loop-source-code)
+ (setq rvar (setq var (pop loop-source-code)))))
+ ; CRUFT will be (varname ctype dtype var tail (optional tem))
+ (cond ((setq cruft (assq var loop-collect-cruft))
+ (cond ((not (eq ctype (car (setq cruft (cdr cruft)))))
+ (loop-error "lisp: incompatible loop collections -- "
+ (list ctype (car cruft))))
+ ((and dtype (not (eq dtype (cadr cruft))))
+ (loop-error
+ "lisp: loop found unequal types in collector -- "
+ (list type (list dtype (cadr cruft))))))
+ (setq dtype (car (setq cruft (cdr cruft)))
+ var (car (setq cruft (cdr cruft)))
+ tail (car (setq cruft (cdr cruft)))
+ tem (cadr cruft))
+ (and (eq ctype 'maxmin)
+ (not (atom form)) (null tem)
+ (rplaca (cdr cruft) (setq tem (loop-make-variable
+ (gensym) nil dtype)))))
+ (t (and (null dtype)
+ (setq dtype (cond ((eq type 'count) 'fixnum)
+ ((memq type '(min max sum)) 'number))))
+ (or var (push `(return ,(setq var (gensym)))
+ loop-after-epilogue))
+ (loop-make-variable var nil dtype)
+ (setq tail
+ (cond ((eq ctype 'list)
+ (setq tem (loop-make-variable (gensym) nil nil))
+ (loop-make-variable (gensym) nil nil))
+ ((eq ctype 'maxmin)
+ (or (atom form)
+ (setq tem (loop-make-variable
+ (gensym) nil dtype)))
+ (loop-make-variable (gensym) nil nil))))
+ (push (list rvar ctype dtype var tail tem)
+ loop-collect-cruft)))
+ (loop-emit-body
+ (selectq type
+ (count (setq tem `(setq ,var (1+ ,var)))
+ (cond ((eq form t) tem) (t `(and ,form ,tem))))
+ (sum `(setq ,var (plus ,(loop-imply-type form dtype) ,var)))
+ ((max min)
+ `(setq ,@(and tem (prog1 `(,tem ,form) (setq form tem)))
+ ,var (cond (,tail (,type ,(loop-imply-type form dtype)
+ ,var))
+ (t (setq ,tail t) ,form))))
+ (list `(setq ,tem (ncons ,form)
+ ,tail (cond (,tail (cdr (rplacd ,tail ,tem)))
+ ((setq ,var ,tem))))
+ )
+ (nconc `(setq ,tem ,form
+ ,tail (last (cond (,tail (rplacd ,tail ,tem))
+ ((setq ,var ,tem))))))
+ (append `(setq ,tem (append ,form nil)
+ ,tail (last (cond (,tail (rplacd ,tail ,tem))
+ ((setq ,var ,tem))))))))))
+
+
+(defun loop-do-while (cond)
+ (loop-emit-body `(,cond ,(loop-get-form) (go end-loop))))
+
+(defun loop-do-when (negate?)
+ (let ((form (loop-get-form)) (cond))
+ (cond ((loop-tequal (cadr loop-source-code) 'it)
+ ;WHEN foo RETURN IT and the like
+ (or loop-when-it-variable
+ (setq loop-when-it-variable
+ (loop-make-variable (gensym) nil nil)))
+ (setq cond `(setq ,loop-when-it-variable ,form))
+ (setq loop-source-code ;Plug in variable for IT
+ (list* (car loop-source-code)
+ loop-when-it-variable
+ (cddr loop-source-code))))
+ (t (setq cond form)))
+ (and negate? (setq cond `(not ,cond)))
+ (setq loop-conditionals (nconc loop-conditionals (ncons (list cond))))))
+
+
+(defun loop-do-with ()
+ (do ((var) (equals) (val) (dtype)) (nil)
+ (setq var (pop loop-source-code) equals (car loop-source-code))
+ (cond ((loop-tequal equals '=)
+ (pop loop-source-code)
+ (setq val (pop loop-source-code) dtype nil))
+ ((or (loop-tequal equals 'and)
+ (loop-lookup-keyword equals loop-keyword-alist))
+ (setq val nil dtype nil))
+ (t (setq dtype (pop loop-source-code)
+ equals (car loop-source-code))
+ (cond ((loop-tequal equals '=)
+ (pop loop-source-code)
+ (setq val (pop loop-source-code)))
+ ((and (not (null loop-source-code))
+ (not (loop-lookup-keyword equals loop-keyword-alist))
+ (not (loop-tequal equals 'and)))
+ (loop-error "lisp: loop was expecting = but found "
+ equals))
+ (t (setq val nil)))))
+ (loop-make-variable var val dtype)
+ (cond ((not (loop-tequal (car loop-source-code) 'and)) (return nil))
+ ((pop loop-source-code))))
+ (loop-bind-block))
+
+(defun loop-do-always (true)
+ (let ((form (loop-get-form)))
+ (or true (setq form `(not ,form)))
+ (loop-emit-body `(or ,form (return nil)))
+ (push '(return t) loop-after-epilogue)))
+
+;THEREIS expression
+;If expression evaluates non-nil, return that value.
+(defun loop-do-thereis ()
+ (let ((var (loop-make-variable (gensym) nil nil))
+ (expr (loop-get-form)))
+ (loop-emit-body `(and (setq ,var ,expr) (return ,var)))))
+
+;FOR variable keyword ..args.. {AND more-clauses}
+;For now AND only allowed with the = keyword
+(defun loop-do-for ()
+ (and loop-conditionals
+ (loop-error "lisp: loop for or as starting inside of conditional"))
+ (do ((var) (data-type?) (keyword) (first-arg)
+ (tem) (pretests) (posttests) (inits) (steps))
+ (nil)
+ (setq var (pop loop-source-code) data-type? (loop-optional-type)
+ keyword (pop loop-source-code) first-arg (pop loop-source-code))
+ (and (or (not (symbolp keyword))
+ (null (setq tem (loop-lookup-keyword
+ keyword
+ loop-for-keyword-alist))))
+ (loop-error "lisp: unknown keyword in for or as loop clause -- "
+ keyword))
+ (setq tem (lexpr-funcall (cadr tem) var first-arg data-type? (cddr tem)))
+ (and (car tem) (push (car tem) pretests))
+ (setq inits (nconc inits (append (car (setq tem (cdr tem))) nil)))
+ (and (car (setq tem (cdr tem))) (push (car tem) posttests))
+ (setq steps (nconc steps (append (car (setq tem (cdr tem))) nil)))
+ (cond ((not (loop-tequal (car loop-source-code) 'and))
+ (cond ((cdr (setq pretests (nreverse pretests)))
+ (push 'or pretests))
+ (t (setq pretests (car pretests))))
+ (cond ((cdr (setq posttests (nreverse posttests)))
+ (push 'or posttests))
+ (t (setq posttests (car posttests))))
+ (and pretests (push `(and ,pretests (go end-loop)) loop-body))
+ (and inits (push (loop-make-psetq inits) loop-body))
+ (and posttests (push `(and ,posttests (go end-loop))
+ loop-after-body))
+ (and steps (push (loop-make-psetq steps) loop-after-body))
+ (loop-bind-block)
+ (return nil))
+ (t (pop loop-source-code)))))
+
+(defun loop-for-equals (var val data-type?)
+ (cond ((loop-tequal (car loop-source-code) 'then)
+ ;FOR var = first THEN next
+ (pop loop-source-code)
+ (loop-make-variable var val data-type?)
+ (list nil nil nil `(,var ,(loop-get-form))))
+ (t (loop-make-variable var nil data-type?)
+ (list nil `(,var ,val) nil nil))))
+
+
+(defun loop-for-on (var val data-type?)
+ (let ((step (if (loop-tequal (car loop-source-code) 'by)
+ (progn (pop loop-source-code) (pop loop-source-code))
+ '(function cdr)))
+ (var1 (cond ((not (atom var))
+ ; Destructuring? Then we can't use VAR as the
+ ; iteration variable.
+ (loop-make-variable var nil nil)
+ (loop-make-variable (gensym) val nil))
+ (t (loop-make-variable var val nil)
+ var))))
+ (setq step (cond ((or (atom step)
+ (not (memq (car step) '(quote function))))
+ `(funcall ,(loop-make-variable (gensym) step nil)
+ ,var1))
+ (t (list (cadr step) var1))))
+ (list `(null ,var1) (and (not (eq var var1)) `(,var ,var1))
+ nil `(,var1 ,step))))
+
+
+(defun loop-for-in (var val data-type?)
+ (let ((var1 (gensym)) ;VAR1 is list, VAR is element
+ (step (if (loop-tequal (car loop-source-code) 'by)
+ (progn (pop loop-source-code) (pop loop-source-code))
+ '(function cdr))))
+ (loop-make-variable var1 val nil)
+ (loop-make-variable var nil data-type?)
+ (setq step (cond ((or (atom step)
+ (not (memq (car step) '(quote function))))
+ `(funcall (loop-make-variable (gensym) step nil)
+ var1))
+ (t (list (cadr step) var1))))
+ (list `(null ,var1) `(,var (car ,var1)) nil `(,var1 ,step))))
+
+
+(defun loop-for-arithmetic (var val data-type? forced-direction)
+ (let ((limit) (step 1) (test) (direction) (eval-to-first t) (inclusive))
+ (do () (nil)
+ (cond ((not (symbolp (car loop-source-code))) (return nil))
+ ((loop-tequal (car loop-source-code) 'by)
+ (pop loop-source-code)
+ (setq step (loop-get-form) eval-to-first t))
+ ((loop-tequal (car loop-source-code) 'to)
+ (pop loop-source-code)
+ (setq limit (loop-get-form) inclusive t eval-to-first nil))
+ ((loop-tequal (car loop-source-code) 'downto)
+ (pop loop-source-code)
+ (setq limit (loop-get-form) inclusive t
+ eval-to-first nil direction 'down))
+ ((loop-tequal (car loop-source-code) 'below)
+ (pop loop-source-code)
+ (setq limit (loop-get-form) direction 'up eval-to-first nil))
+ ((loop-tequal (car loop-source-code) 'above)
+ (pop loop-source-code)
+ (setq limit (loop-get-form) direction 'down eval-to-first nil))
+ (t (return nil))))
+ (cond ((null direction) (setq direction (or forced-direction 'up)))
+ ((and forced-direction (not (eq forced-direction direction)))
+ (loop-error "lisp: loop variable stepping lossage with " var)))
+ (or data-type? (setq data-type? 'fixnum))
+ (and (eq data-type? 'flonum) (fixp step) (setq step (float step)))
+ (loop-make-variable var val data-type?)
+ (cond ((and limit eval-to-first)
+ (setq limit (loop-maybe-bind-form limit data-type?))))
+ (setq step (loop-maybe-bind-form step data-type?))
+ (cond ((and limit (not eval-to-first))
+ (setq limit (loop-maybe-bind-form limit data-type?))))
+ (cond ((not (null limit))
+ (let ((z (list var limit)))
+ (setq test (cond ((eq direction 'up)
+ (cond (inclusive `(greaterp . ,z))
+ (t `(not (lessp . ,z)))))
+ (t (cond (inclusive `(lessp . ,z))
+ (t `(not (greaterp . ,z))))))))))
+ (setq step (cond ((eq direction 'up)
+ (cond ((equal step 1) `(add1 ,var))
+ (t `(plus ,var ,step))))
+ ((equal step 1) `(sub1 ,var))
+ (t `(difference ,var ,step))))
+ ;; The object of the following crock is to get the INTERPRETER to
+ ;; do error checking. This is only correct for data-type of FIXNUM,
+ ;; since floating-point arithmetic is contagious.
+ #+Maclisp (and (eq data-type? 'fixnum)
+ (rplaca step (cdr (assq (car step) '((sub1 . 1-) (add1 . 1+)
+ (plus . +)
+ (difference . -))))))
+ (list test nil nil `(,var ,step))))
+
+
+(defun loop-for-being (var val data-type?)
+ ; FOR var BEING something ... - var = VAR, something = VAL.
+ ; If what passes syntactically for a pathname isn't, then
+ ; we trap to the ATTACHMENTS path; the expression which looked like
+ ; a path is given as an argument to the IN preposition. If
+ ; LOOP-ATTACHMENT-TRANSFORMER is not NIL, then we call that on the
+ ; "form" to get the actual form; otherwise, we quote it. Thus,
+ ; by default, FOR var BEING EACH expr OF expr-2
+ ; ==> FOR var BEING ATTACHMENTS IN 'expr OF expr-2.
+ (let ((tem) (inclusive?) (ipps) (each?) (attachment))
+ (cond ((loop-tequal val "each")
+ (setq each? t val (car loop-source-code)))
+ (t (push val loop-source-code)))
+ (cond ((and (setq tem (loop-lookup-keyword val loop-path-keyword-alist))
+ (or each? (not (loop-tequal (cadr loop-source-code) 'and))))
+ ;; FOR var BEING {each} path {prep expr}..., but NOT
+ ;; FOR var BEING var-which-looks-like-path AND {ITS} ...
+ (pop loop-source-code))
+ (t (setq val (loop-get-form))
+ (cond ((loop-tequal (car loop-source-code) 'and)
+ ;; FOR var BEING value AND ITS path-or-ar
+ (or (null each?)
+ (loop-error "lisp: malformed being clause in loop of var "
+ var))
+ (setq ipps `((of ,val)) inclusive? t)
+ (pop loop-source-code)
+ (or (loop-tequal (setq tem (pop loop-source-code))
+ 'its)
+ (loop-tequal tem 'his)
+ (loop-tequal tem 'her)
+ (loop-tequal tem 'their)
+ (loop-tequal tem 'each)
+ (loop-error "lisp: loop expected its or each but found "
+ tem))
+ (cond ((setq tem (loop-lookup-keyword
+ (car loop-source-code)
+ loop-path-keyword-alist))
+ (pop loop-source-code))
+ (t (push (setq attachment `(in ,(loop-get-form)))
+ ipps))))
+ ((not (setq tem (loop-lookup-keyword
+ (car loop-source-code)
+ loop-path-keyword-alist)))
+ ; FOR var BEING {each} a-r ...
+ (setq ipps (list (setq attachment (list 'in val)))))
+ (t ; FOR var BEING {each} pathname ...
+ ; Here, VAL should be just PATHNAME.
+ (pop loop-source-code)))))
+ (cond ((not (null tem)))
+ ((not (setq tem (loop-lookup-keyword 'attachments
+ loop-path-keyword-alist)))
+ (loop-error "lisp: loop trapped to attachments path illegally"))
+ (t (or attachment (break))
+ (rplaca (cdr attachment)
+ (cond (loop-attachment-transformer
+ (funcall loop-attachment-transformer
+ (cadr attachment)))
+ (t (list 'quote (cadr attachment)))))))
+ (setq tem (funcall (cadr tem) (car tem) var data-type?
+ (nreconc ipps (loop-gather-preps (caddr tem)))
+ inclusive? (caddr tem) (cdddr tem)))
+ ;; TEM is now (bindings prologue-forms endtest setups steps)
+ (c-mapc #'(lambda (x)
+ (let (var val dtype)
+ (cond ((atom x) (setq var x))
+ (t (setq var (car x) val (cadr x) dtype (caddr x))))
+ (loop-make-variable var val dtype)))
+ (car tem))
+ (setq loop-prologue (nconc (reverse (cadr tem)) loop-prologue))
+ (cddr tem)))
+
+
+(defun loop-gather-preps (preps-allowed)
+ (do ((list nil (cons (list (pop loop-source-code) (loop-get-form)) list))
+ (token (car loop-source-code) (car loop-source-code)))
+ ((not (memq token preps-allowed))
+ (nreverse list))))
+
+
+(defun loop-add-path (name data)
+ (loop-add-keyword (cons name data) 'loop-path-keyword-alist))
+
+
+(defmacro define-loop-path (names . cruft)
+ (let ((forms ()))
+ (setq forms (c-mapcar
+ #'(lambda (name)
+ `(loop-add-path
+ ',name ',cruft))
+ (cond ((atom names) (list names))
+ (t names))))
+ `(eval-when (eval load compile) ,@forms)))
+
+
+(defun loop-path-carcdr (name var dtype pps inclusive? preps data)
+ preps dtype ;Prevent unused arguments error
+ (let ((vars) (step) (endtest `(,(cadr data) ,var)) (tem))
+ (or (setq tem (loop-lookup-keyword 'of pps))
+ (loop-error "lisp: loop path has no initialization -- " name))
+ (setq vars `((,var ,(cond (inclusive? (cadr tem))
+ (t `(,(car data) ,(cadr tem))))
+ ,dtype)))
+ (setq step `(,var (,(car data) ,var)))
+ (list vars nil nil nil endtest step)))
+
+
+(defun loop-interned-symbols-path (path variable data-type prep-phrases
+ inclusive? allowed-preps data)
+ path data-type allowed-preps data ; unused vars
+ ; data-type should maybe be error-checked.....
+ (let ((bindings) (presteps) (pretest) (poststeps) (posttest)
+ (prologue) (indexv) (listv) (ob)
+ (test) (step))
+ (push variable bindings)
+ (and (not (null prep-phrases))
+ (or (cdr prep-phrases)
+ (and (not (loop-tequal (caar prep-phrases) 'in))
+ (not (loop-tequal (caar prep-phrases) 'of))))
+ (loop-error
+ "Illegal prep phrase(s) in interned-symbols path --"
+ (list* variable 'being path prep-phrases)))
+ (push (list (setq ob (gensym))
+ (cond ((null prep-phrases) 'obarray )
+ (t (cadar prep-phrases))))
+ bindings)
+ ; Multics lisp does not store single-char-obs in the obarray buckets.
+ ; Thus, we need to iterate over the portion of the obarray
+ ; containing them also. (511. = (ascii 0))
+ (push `(,(setq indexv (gensym))
+ #+Multics 639. #+(and Maclisp (not Multics)) 511. #+Lispm 0
+ fixnum)
+ bindings)
+ #+Maclisp (push `(,(setq listv (gensym)) nil) bindings)
+ #+Lispm (push `(setq ,indexv (array-dimension-n 2 ,ob)) prologue)
+ (setq test
+ `(and #-Multics (null ,listv)
+ #+Multics (or (> ,indexv 510.) (null ,listv))
+ (prog ()
+ lp (cond ((< (setq ,indexv (1- ,indexv)) 0) (return t))
+ ((setq ,listv (arraycall #+Multics obarray
+ #-Multics t ,ob ,indexv))
+ (return nil))
+ (t (go lp)))))
+ )
+ (setq step
+ `(,variable
+ #+Multics (cond ((> ,indexv 510.) ,listv)
+ (t (prog2 nil (car ,listv)
+ (setq ,listv (cdr ,listv)))))
+ #+(and Maclisp (not Multics)) (car ,listv)
+ #+Lispm (ar-2 ,ob 1 ,indexv)))
+ (cond (inclusive? (setq posttest test poststeps step
+ prologue `((setq ,variable ,ob))))
+ (t (setq pretest test presteps step)))
+ #+(and Maclisp (not Multics))
+ (setq poststeps `(,@poststeps ,listv (cdr ,listv)))
+ (list bindings prologue pretest presteps posttest poststeps)))
+
+
+; We don't want these defined in the compilation environment because
+; the appropriate environment hasn't been set up. So, we just bootstrap
+; them up.
+(c-mapc #'(lambda (x)
+ (c-mapc #'(lambda (y) (loop-add-path y (cdr x))) (car x)))
+ '(((car cars) loop-path-carcdr (of) car atom)
+ ((cdr cdrs) loop-path-carcdr (of) cdr atom)
+ ((cddr cddrs) loop-path-carcdr (of) cddr null)
+ ((interned-symbols interned-symbol)
+ loop-interned-symbols-path (in))
+ ))
+
+(or (status feature loop) (sstatus feature loop))
+
+;Loop macro blathering.
+;
+; This doc is totally wrong. Complete documentation (nice looking
+; hardcopy) is available from GSB, or from ML:LSBDOC;LPDOC (which
+; needs to be run through BOLIO).
+;
+;This is intended to be a cleaned-up version of PSZ's FOR package
+;which is a cleaned-up version of the Interlisp CLisp FOR package.
+;Note that unlike those crocks, the order of evaluation is the
+;same as the textual order of the code, always.
+;
+;The form is introduced by the word LOOP followed by a series of clauses,
+;each of which is introduced by a keyword which however need not be
+;in any particular package. Certain keywords may be made "major"
+;which means they are global and macros themselves, so you could put
+;them at the front of the form and omit the initial "LOOP".
+;
+;Each clause can generate:
+;
+; Variables local to the loop.
+;
+; Prologue Code.
+;
+; Main Code.
+;
+; Epilogue Code.
+;
+;Within each of the three code sections, code is always executed strictly
+;in the order that the clauses were written by the user. For parallel assignments
+;and such there are special syntaxes within a clause. The prologue is executed
+;once to set up. The main code is executed several times as the loop. The epilogue
+;is executed once after the loop terminates.
+;
+;The term expression means any Lisp form. The term expression(s) means any number
+;of Lisp forms, where only the first may be atomic. It stops at the first atom
+;after the first form.
+;
+;The following clauses exist:
+;
+;Prologue:
+; INITIALLY expression(s)
+; This explicitly inserts code into the prologue. More commonly
+; code comes from variable initializations.
+;
+;Epilogue:
+; FINALLY expression(s)
+; This is the only way to explicitly insert code into the epilogue.
+;
+;Side effects:
+; DO expression(s)
+; The expressions are evaluated. This is how you make a "body".
+; DOING is synonymous with DO.
+;
+;Return values:
+; RETURN expression(s)
+; The last expression is returned immediately as the value of the form.
+; This is equivalent to DO (RETURN expression) which you will
+; need to use if you want to return multiple values.
+; COLLECT expression(s)
+; The return value of the form will be a list (unless over-ridden
+; with a RETURN). The list is formed out of the values of the
+; last expression.
+; COLLECTING is synonymous with COLLECT.
+; APPEND (or APPENDING) and NCONC (or NCONCING) can be used
+; in place of COLLECT, forming the list in the appropriate ways.
+; COUNT expression(s)
+; The return value of the form will be the number of times the
+; value of the last expression was non-NIL.
+; SUM expression(s)
+; The return value of the form will be the arithmetic sum of
+; the values of the last expression.
+; The following are a bit wierd syntactically, but Interlisp has them
+; so they must be good.
+; ALWAYS expression(s)
+; The return value will be T if the last expression is true on
+; every iteration, NIL otherwise.
+; NEVER expressions(s)
+; The return value will be T if the last expression is false on
+; every iteration, NIL otherwise.
+; THEREIS expression(s)
+; This is wierd, I'm not sure what it really does.
+
+
+; You probably want WHEN (NUMBERP X) RETURN X
+; or maybe WHEN expression RETURN IT
+;
+;Conditionals: (these all affect only the main code)
+;
+; WHILE expression
+; The loop terminates at this point if expression is false.
+; UNTIL expression
+; The loop terminates at this point if expression is true.
+; WHEN expression clause
+; Clause is performed only if expression is true.
+; This affects only the main-code portion of a clause
+; such as COLLECT. Use with FOR is a little unclear.
+; IF is synonymous with WHEN.
+; WHEN expression RETURN IT (also COLLECT IT, COUNT IT, SUM IT)
+; This is a special case, the value of expression is returned if non-NIL.
+; This works by generating a temporary variable to hold
+; the value of the expression.
+; UNLESS expression clause
+; Clause is performed only if expression is false.
+;
+;Variables and iterations: (this is the hairy part)
+;
+; WITH variable = expression {AND variable = expression}...
+; The variable is set to the expression in the prologue.
+; If several variables are chained together with AND
+; the setq's happen in parallel. Note that all variables
+; are bound before any expressions are evaluated (unlike DO).
+;
+; FOR variable = expression {AND variable = expression}...
+; At this point in the main code the variable is set to the expression.
+; Equivalent to DO (PSETQ variable expression variable expression...)
+; except that the variables are bound local to the loop.
+;
+; FOR variable FROM expression TO expression {BY expression}
+; Numeric iteration. BY defaults to 1.
+; BY and TO may be in either order.
+; If you say DOWNTO instead of TO, BY defaults to -1 and
+; the end-test is reversed.
+; If you say BELOW instead of TO or ABOVE instead of DOWNTO
+; the iteration stops before the end-value instead of after.
+; The expressions are evaluated in the prologue then the
+; variable takes on its next value at this point in the loop;
+; hair is required to win the first time around if this FOR is
+; not the first thing in the main code.
+; FOR variable IN expression
+; Iteration down members of a list.
+; FOR variable ON expression
+; Iteration down tails of a list.
+; FOR variable IN/ON expression BY expression
+; This is an Interlisp crock which looks useful.
+; FOR var ON list BY expression[var]
+; is the same as FOR var = list THEN expression[var]
+; FOR var IN list BY expression[var]
+; is similar except that var gets tails of the list
+; and, kludgiferously, the internal tail-variable
+; is substituted for var in expression.
+; FOR variable = expression THEN expression
+; General DO-type iteration.
+; Note that all the different types of FOR clauses can be tied together
+; with AND to achieve parallel assignment. Is this worthwhile?
+; [It's only implemented for = mode.]
+; AS is synonymous with FOR.
+;
+; FOR variable BEING expression(s) AND ITS pathname
+; FOR variable BEING expression(s) AND ITS a-r
+; FOR variable BEING {EACH} pathname {OF expression(s)}
+; FOR variable BEING {EACH} a-r {OF expression(s)}
+; Programmable iteration facility. Each pathname has a
+; function associated with it, on LOOP-PATH-KEYWORD-ALIST; the
+; alist has entries of the form (pathname function prep-list).
+; prep-list is a list of allowed prepositions; after either of
+; the above formats is parsed, then pairs of (preposition expression)
+; are collected, while preposition is in prep-list. The expression
+; may be a progn if there are multiple prepositions before the next
+; keyword. The function is then called with arguments of:
+; pathnname variable prep-phrases inclusive? prep-list
+; Prep-phrases is the list of pairs collected, in order. Inclusive?
+; is T for the first format, NIL otherwise; it says that the init
+; value of the form takes on expression. For the first format, the
+; list (OF expression) is pushed onto the fromt of the prep-phrases.
+; In the above examples, a-r is a form to be evaluated to get an
+; attachment-relationship. In this case, the pathname is taken as
+; being ATTACHMENTS, and a-r is passed in by being treated as if it
+; had been used with the preposition IN. The function should return
+; a list of the form (bindings init-form step-form end-test); bindings
+; are stuffed onto loop-variables, init-form is initialization code,
+; step-form is step-code, and end-test tells whether or not to exit.
+;
+;Declarations? Not needed by Lisp machine. For Maclisp these will be done
+;by a reserved word in front of the variable name as in PSZ's macro.
+;
+;The implementation is as a PROG. No initial values are given for the
+;PROG-variables. PROG1 is used for parallel assignment.
+;
+;The iterating forms of FOR present a special problem. The problem is that
+;you must do everything in the order that it was written by the user, but the
+;FOR-variable gets its value in a different way in the first iteration than
+;in the subsequent iterations. Note that the end-tests created by FOR have
+;to be done in the appropriate order, since otherwise the next clause might get
+;an error.
+;
+;The most general way is to introduce a flag, !FIRST-TIME, and compile the
+;clause "FOR var = first TO last" as "INITIALLY (SETQ var first)
+;WHEN (NOT !FIRST-TIME) DO (SETQ var (1+ var)) WHILE (<= var last)".
+;However we try to optimize this by recognizing a special case:
+;The special case is recognized where all FOR clauses are at the front of
+;the main code; in this case if there is only one its stepping and
+;endtest are moved to the end, and a jump to the endtest put at the
+;front. If there are more than one their stepping and endtests are moved
+;to the end, with duplicate endtests at the front except for the last
+;which doesn't need a duplicate endtest. If FORs are embedded in the
+;main code it can only be implemented by either a first-time flag or
+;starting the iteration variable at a special value (initial minus step
+;in the numeric iteration case). This could probably just be regarded as
+;an error. The important thing is that it never does anything out of
+;order.
+
ADDED psl-1983/3-1/util/macroexpand.sl
Index: psl-1983/3-1/util/macroexpand.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/macroexpand.sl
@@ -0,0 +1,81 @@
+% MACROEXPAND.SL - tools for expanding macros in forms
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% <PSL.UTIL>MACROEXPAND.SL.15, 2-Sep-82 10:32:10, Edit by BENSON
+% Fixed multiple argument SETQ macro expansion
+
+(defmacro macroexpand (form . macros)
+ `(macroexpand1 ,form (list ,@macros)))
+
+(fluid '(macroexpand-signal*))
+
+(de macroexpand1 (U L)
+ (let ((macroexpand-signal* nil)(*macro-displace nil))
+ (while (null macroexpand-signal*)
+ (setq macroexpand-signal* t)
+ (setq U (macroexpand2 U L))))
+ U)
+
+(de macroexpand2 (U L)
+ (cond
+ ((or (atom U) (constantp (car U))) U)
+ ((eqcar (car U) 'lambda)
+ `((lambda ,(cadar U) ,.(foreach V in (cddar U)
+ collect (macroexpand2 V L)))
+ ,.(foreach V in (cdr U) collect (macroexpand2 V L))))
+ ((not (idp (car U))) U)
+ (t
+ (let ((fn (getd (car U)))(spfn (get (car U) 'macroexpand-func)))
+ (cond
+ (spfn (apply spfn (list U L)))
+ ((eqcar fn 'fexpr) U)
+ ((and (eqcar fn 'macro) (or (null L) (memq (car U) L)))
+ (setq macroexpand-signal* nil)
+ (apply (cdr fn) (list U)))
+ (t
+ (cons
+ (car U)
+ (foreach V in (cdr U) collect (macroexpand2 V L)))))))))
+
+(de macroexpand-cond (U L)
+ (cons 'cond (foreach V in (cdr U) collect
+ (foreach W in V collect (macroexpand2 W L)))))
+
+(de macroexpand-prog (U L)
+ `(prog ,(cadr U) ,.(foreach V in (cddr U) collect (macroexpand2 V L))))
+
+(de macroexpand-random (U L)
+ (cons (car U) (foreach V in (cdr U) collect (macroexpand2 V L))))
+
+(deflist '( % Should probably add a bunch more...
+ (prog macroexpand-prog)
+ (progn macroexpand-random)
+ (cond macroexpand-cond)
+ (and macroexpand-random)
+ (or macroexpand-random)
+ (setq macroexpand-random)
+ (function macroexpand-random)
+ ) 'macroexpand-func)
+
+(de macroexpand-loop ()
+ (catch 'macroexpand-loop
+ `(toploop
+ ',(and toploopread* #'read)
+ ',#'prettyprint
+ ',#'(lambda (u) (if (atom u) (throw 'macroexpand-loop) (macroexpand u)))
+ "expand"
+ ',(bldmsg
+ "Entering macroexpand loop (atomic input forces exit) %w..."
+ (if (and
+ toploopread*
+ (idp toploopread*)
+ (not (eq toploopread* 'read)))
+ (bldmsg "[reading with %w]" toploopread*)
+ ""))))
+ (printf "... Leaving macroexpand loop."))
ADDED psl-1983/3-1/util/man.sl
Index: psl-1983/3-1/util/man.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/man.sl
@@ -0,0 +1,187 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% MAN -- an online PSL reference manual facility.
+%%% Principal features are easy access to the index and
+%%% a command to jump directly from a line in the index
+%%% to the place in the manual referred to.
+%%%
+%%% Author: Cris Perdue
+%%% Date: 12/1/82
+%%%
+%%% This package is still under development.
+%%% An index browsing mode is contemplated, also use of a specialized
+%%% representation of the reference manual.
+%%% A concept index browser and a table of contents browser
+%%% are contemplated as extensions.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Edit by Cris Perdue, 8 Feb 1983 1145-PST
+% Modified to use functions now defined in their own modules.
+
+(compiletime (load fast-int if extended-char))
+
+(imports '(nmode string-search string-input))
+
+%%% Defines 2 new nondestructive commands for text mode,
+%%% which seems to make them apply in LISP mode as well.
+%%% One is M-!, which takes you to information about the
+%%% subject of interest in the chapter and page referred to
+%%% by the next index reference.
+%%% The other is C-X I, which does a "Find File" on the file
+%%% containing the function index to the PSL manual.
+
+(add-to-command-list
+ 'read-only-text-command-list (x-char M-!!) 'index-browse-command)
+(add-to-command-list
+ 'read-only-text-command-list (x-chars C-X i) 'get-index-buffer)
+(nmode-establish-current-mode)
+
+(fluid '(manual-chapters manual-file-template))
+
+% 0-TITLEPAGE
+% 00-PREFACE
+% 000-CONTENTS
+
+%%% A list of strings, each containing the base name of a chapter
+%%% of the manual. The first member of this list must be
+%%% referred to as chapter 1 in index references, and similarly
+%%% for other elements of the list.
+
+(setq manual-chapters '(
+"01-INTRODUCTION"
+"02-GETSTART"
+"03-RLISP"
+"04-DATATYPES"
+"05-NUMBERS"
+"06-IDS"
+"07-LISTS"
+"08-STRINGS"
+"09-FLOWOFCONTROL"
+"10-FUNCTIONS"
+"11-INTERP"
+"12-GLOBALS"
+"13-IO"
+"14-TOPLOOP"
+"15-ERRORS"
+"16-DEBUG"
+"17-EDITOR"
+"18-UTILITIES"
+"19-COMPLR"
+"20-DEC20"
+"21-SYSLISP"
+"22-IMPLEMENTATION"
+"23-PARSER"
+"24-BIBLIO"
+"25-FUN-INDEX"
+"26-TOP-INDEX"
+))
+
+%%% This variable is a template for the name of a file that is
+%%% part of the manual. Actual manual file names are obtained by
+%%% substituting a name from the name list into this template.
+
+(setq manual-file-template "plpt:%w.lpt")
+
+(defun get-index-buffer ()
+ (find-file (bldmsg manual-file-template "25-FUN-INDEX")))
+
+%%% This function gets the name that information is desired for,
+%%% gets the chapter and page of the "next" index reference after
+%%% point, does a "Find File" on the appropriate manual file,
+%%% goes to the appropriate page, and searches for an occurrence
+%%% of the key string.
+
+(defun index-browse-command ()
+ (let ((l (=> nmode-current-buffer current-line)))
+ (let ((key (get-key l))
+ (dotpos (get-dot-pos l (=> nmode-current-buffer char-pos)))
+ digitpos endpos chapter page)
+
+ %% The first "." coming after point and with a digit on either
+ %% side is used as the "." of the index entry.
+ %% Contiguous digits to either side of the "." are taken
+ %% to be chapter and page of the reference.
+ %% This allows the user to distinguish between different
+ %% index references even on the same line.
+ (if (or (null key) (null dotpos)) then (ding)
+ else
+ (setq digitpos
+ %% Search for non-digit or beginning of line.
+ %% Position of earliest digit is returned.
+ (for (from i (- dotpos 2) 0 -1)
+ (do (if (not (digitp (indx l i))) then
+ (return (+ i 1))))
+ (finally (return 0))))
+ (setq chapter (string-read (substring l digitpos dotpos)))
+
+ %% Endpos is set to position of first non-digit after
+ %% the page number, or end of line position, if all digits
+ %% to end of line.
+ (setq endpos (search-in-string-fn 'not-digitp l (+ dotpos 1)))
+ (if (null endpos) then (setq endpos (+ (isizes l) 1)))
+
+ (setq page (string-read (substring l (+ dotpos 1) endpos)))
+
+ (find-file (bldmsg manual-file-template
+ (nth manual-chapters chapter)))
+ (move-to-buffer-start)
+ %% Skip over pages preceding the desired one.
+ (for (from i 1 (- page 1))
+ (do (forward-search " ")
+ (move-over-characters 1)))
+ %% Search for an occurrence of the key string.
+ %% This part should perhaps be refined to only move to
+ %% a place within the page of interest.
+ %% Note that forward-search expects the key to be entirely
+ %% upper case and leaves point at the beginning of the string
+ %% if found.
+ (forward-search (string-upcase key))))))
+
+%%% The key is taken to be a substring of the line string.
+%%% The key starts at the first nonblank character and runs
+%%% up to the first occurrence of either ". " or " .". This
+%%% is dependent on the precise format of index files produced
+%%% by Scribe.
+%%% This function is capable of returning NIL.
+
+(defun get-key (line)
+ (let ((p1 (string-search ". " line))
+ (p2 (string-search " ." line)))
+ (let ((end-pos (if (and p1 p2) then (min p1 p2)
+ elseif (and p1 (null p2)) then p1
+ elseif (and p2 (null p1)) then p2
+ else nil))
+ (key-pos (search-in-string-fn 'nonblank line 0)))
+ (if (and key-pos end-pos) then
+ (substring line key-pos end-pos)
+ else nil))))
+
+%%% Searches for a dot which must be at or after "start".
+%%% The dot must be surrounded by a digit on either side.
+%%% NIL is returned if none found.
+
+(defun get-dot-pos (line start)
+ (for (for dotpos
+ (string-search-from "." line start)
+ (string-search-from "." line (+ dotpos 1)))
+ (while dotpos)
+ (do (if (and (digitp (indx line (- dotpos 1)))
+ (digitp (indx line (+ dotpos 1)))) then
+ (return dotpos)))))
+
+(defun not-digitp (c)
+ (not (digitp c)))
+
+(defun nonblank (c)
+ (neq c #\SPACE))
+
+%%% The position of the first character of the domain for which
+%%% testfn returns true and whose index is at least "start" is
+%%% returned. If none such exists, NIL is returned.
+
+(defun search-in-string-fn (testfn domain start)
+ (if (not (stringp domain)) then
+ (error 0 "Arg to search-in-string-fn not a string"))
+ (for (from i start (isizes domain))
+ (do (if (funcall testfn (igets domain i)) then
+ (return i)))
+ (finally (return nil))))
ADDED psl-1983/3-1/util/mathlib.build
Index: psl-1983/3-1/util/mathlib.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mathlib.build
@@ -0,0 +1,1 @@
+in "mathlib.red"$
ADDED psl-1983/3-1/util/mathlib.red
Index: psl-1983/3-1/util/mathlib.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mathlib.red
@@ -0,0 +1,523 @@
+%. MATHLIB.RED - Some useful mathematical functions for PSL
+%
+% Most of these routines not very heavily tested.
+% Contributions from Galway, Griss, Irish, Morrison, and others.
+%
+% MATHLIB.RED, 16-Dec-82 21:56:52, Edit by GALWAY
+% Various fixes and enhancements too numerous for me to remember.
+% Includes fixes in SQRT function, modifications of RANDOM and other
+% functions to bring them more in line with Common Lisp, addition of MOD
+% and FLOOR.
+% <PSL.UTIL>MATHLIB.RED.13, 13-Sep-82 08:49:52, Edit by BENSON
+% Bug in EXP, changed 2**N to 2.0**N
+% <PSL.UTIL>MATHLIB.RED.12, 2-Sep-82 09:22:19, Edit by BENSON
+% Changed all calls in REDERR to calls on STDERROR
+% <PSL.UTIL>MATHLIB.RED.2, 17-Jan-82 15:48:21, Edit by GRISS
+% changed for PSL
+
+% Should these names be changed so that they all begin with an F or some
+% other distinguishing mark? Are they in conflict with anything? Or should
+% we wait until we have packages?
+
+% Consider using Sasaki's BigFloat package -- it has all this and more, to
+% arbitrary precision. The only drawback is speed.
+
+%***************** Constants declared as NewNam's ****************************
+
+% We can't use these long ones in Lisp1.6 'cause the reader craps out (and
+% it would truncate instead of round, anyway). These are here for reference
+% for implementation on other machines.
+% put('NumberPi,'NewNam,3.14159265358979324);
+% put('NumberPi!/2,'NewNam,1.57079632679489662);
+% put('NumberPi!/4,'NewNam,0.785398163397448310);
+
+BothTimes <<
+put('Number2Pi,'NewNam,6.2831853);
+put('NumberPi,'NewNam,3.1415927);
+put('NumberPi!/2,'NewNam,1.5707963);
+put('NumberPi!/4,'NewNam,0.78539816);
+put('Number3Pi!/4,'NewNam,2.3561945);
+put('Number!-2Pi,'Newnam,-6.2831853);
+put('Number!-Pi,'NewNam,-3.1415927);
+put('Number!-Pi!/2,'NewNam,-1.5707963);
+put('Number!-Pi!/4,'NewNam,-0.78539816);
+
+put('SqrtTolerance,'NewNam,0.0000001);
+put('NumberE, 'NewNam, 2.718281828);
+put('NumberInverseE, 'NewNam, 0.36787944); % 1/e
+put('NaturalLog2,'NewNam,0.69314718);
+put('NaturalLog10,'NewNam,2.3025851);
+put('TrigPrecisionLimit,'NewNam,80);
+
+>>;
+%********************* Basic functions ***************************************
+
+lisp procedure mod(M,N);
+% Return M modulo N. Unlike remainder function--it returns positive result
+% in range 0..N-1, even if M is negative. (Needs more work for case of
+% negative N.)
+begin scalar result;
+ result := remainder(M,N);
+ if result >= 0 then
+ return result;
+ % else
+ return
+ N + result;
+end;
+
+lisp procedure Floor X;
+% Returns the largest integer less than or equal to X. (I.e. the "greatest
+% integer" function.)
+if fixp X then
+ X
+else begin scalar N;
+ N := fix X;
+ % Note the trickiness to compensate for fact that (unlike APL's "FLOOR"
+ % function) FIX truncates towards zero.
+ return if X = float N then N else if X>=0 then N else N-1;
+end;
+
+lisp procedure Ceiling X;
+% Returns the smallest integer greater than or equal to X.
+if fixp X then
+ X
+else begin scalar N;
+ N := fix X;
+ % Note the trickiness to compensate for fact that (unlike APL's "FLOOR"
+ % function) FIX truncates towards zero.
+ return if X = float N then N else if X>0 then N+1 else N;
+end;
+
+lisp procedure Round X;
+% Rounds to the closest integer.
+% Kind of sloppy -- it's biased when the digit causing rounding is a five,
+% it's a bit weird with negative arguments, round(-2.5)= -2.
+if fixp X then
+ X
+else
+ floor(X+0.5);
+
+%***************** Trigonometric Functions ***********************************
+
+% Trig functions are all in radians. The following few functions may be used
+% to convert to/from degrees, or degrees/minutes/seconds.
+
+lisp procedure DegreesToRadians x;
+x*0.017453292; % 2*pi/360
+
+lisp procedure RadiansToDegrees x;
+ x*57.29578; % 360/(2*pi)
+
+lisp procedure RadiansToDMS x;
+% Converts radians to a list of degrees, minutes, and seconds (rounded, not
+% truncated, to the nearest integer).
+begin scalar Degs,Mins;
+ x := RadiansToDegrees x;
+ Degs := fix x;
+ x := 60*(x-Degs);
+ Mins := fix x;
+ return list(Degs,Mins, Round(60*(x-Mins)))
+end;
+
+lisp procedure DMStoRadians(Degs,Mins,Sex);
+% Converts degrees, minutes, seconds to radians.
+% DegreesToRadians(Degs+Mins/60.0+Sex/3600.0)
+DegreesToRadians(Degs+Mins*0.016666667+Sex*0.00027777778);
+
+lisp procedure sin x;
+% Accurate to about 6 decimal places, so long as the argument is
+% of commensurate precision. This will, of course, NOT be true for
+% large arguments, since they will be coming in with small precision.
+begin scalar neg;
+ if minusp x then <<
+ neg := T;
+ x := - x >>;
+ if x > TrigPrecisionLimit then
+ LPriM "Possible loss of precision in computation of SIN";
+ if x > NumberPi then
+ x := x-Number2Pi*fix((x+NumberPi)/Number2Pi);
+ if minusp x then <<
+ neg := not neg;
+ x := -x >>;
+ if x > NumberPi!/2 then
+ x := NumberPi-x;
+ return if neg then -ScaledSine x else ScaledSine x
+end;
+
+lisp procedure ScaledSine x;
+% assumes its argument is scaled to between 0 and pi/2.
+begin scalar xsqrd;
+ xsqrd := x*x;
+ return x*(1+xsqrd*(-0.16666667+xsqrd*(0.0083333315+xsqrd*(-0.0001984090+
+ xsqrd*(0.0000027526-xsqrd*0.0000000239)))))
+end;
+
+lisp procedure cos x;
+% Accurate to about 6 decimal places, so long as the argument is
+% of commensurate precision. This will, of course, NOT be true for
+% large arguments, since they will be coming in with small precision.
+<< if minusp x then
+ x := - x;
+ if x > TrigPrecisionLimit then
+ LPriM "Possible loss of precision in computation of COS";
+ if x > NumberPi then
+ x := x-Number2Pi*fix((x+NumberPi)/Number2Pi);
+ if minusp x then
+ x := - x;
+ if x > NumberPi!/2 then
+ -ScaledCosine(NumberPi-x)
+ else
+ ScaledCosine x >>;
+
+lisp procedure ScaledCosine x;
+% Expects its argument to be between 0 and pi/2.
+begin scalar xsqrd;
+ xsqrd := x*x;
+ return 1+xsqrd*(-0.5+xsqrd*(0.041666642+xsqrd*(-0.0013888397+
+ xsqrd*(0.0000247609-xsqrd*0.0000002605))))
+end;
+
+lisp procedure tan x;
+% Accurate to about 6 decimal places, so long as the argument is
+% of commensurate precision. This will, of course, NOT be true for
+% large arguments, since they will be coming in with small precision.
+begin scalar neg;
+ if minusp x then <<
+ neg := T;
+ x := - x >>;
+ if x > TrigPrecisionLimit then
+ LPriM "Possible loss of precision in computation of TAN";
+ if x > NumberPi!/2 then
+ x := x-NumberPi*fix((x+NumberPi!/2)/NumberPi);
+ if minusp x then <<
+ neg := not neg;
+ x := - x >>;
+ if x < NumberPi!/4 then
+ x := ScaledTangent x
+ else
+ x := ScaledCotangent(-(x-numberpi!/2));
+ return if neg then -x else x
+end;
+
+lisp procedure cot x;
+% Accurate to about 6 decimal places, so long as the argument is
+% of commensurate precision. This will, of course, NOT be true for
+% large arguments, since they will be coming in with small precision.
+begin scalar neg;
+ if minusp x then <<
+ neg := T;
+ x := - x >>;
+ if x > NumberPi!/2 then
+ x := x-NumberPi*fix((x+NumberPi!/2)/NumberPi);
+ if x > TrigPrecisionLimit then
+ LPriM "Possible loss of precision in computation of COT";
+ if minusp x then <<
+ neg := not neg;
+ x := - x >>;
+ if x < NumberPi!/4 then
+ x := ScaledCotangent x
+ else
+ x := ScaledTangent(-(x-numberpi!/2));
+ return if neg then -x else x
+end;
+
+lisp procedure ScaledTangent x;
+% Expects its argument to be between 0 and pi/4.
+begin scalar xsqrd;
+ xsqrd := x*x;
+ return x*(1.0+xsqrd*(0.3333314+xsqrd*(0.1333924+xsqrd*(0.05337406 +
+ xsqrd*(0.024565089+xsqrd*(0.002900525+xsqrd*0.0095168091))))))
+end;
+
+lisp procedure ScaledCotangent x;
+% Expects its argument to be between 0 and pi/4.
+begin scalar xsqrd;
+ xsqrd := x*x;
+ return (1.0-xsqrd*(0.33333334+xsqrd*(0.022222029+xsqrd*(0.0021177168 +
+ xsqrd*(0.0002078504+xsqrd*0.0000262619)))))/x
+end;
+
+lisp procedure sec x;
+1.0/cos x;
+
+lisp procedure csc x;
+1.0/sin x;
+
+lisp procedure sinD x;
+sin DegreesToRadians x;
+
+lisp procedure cosD x;
+cos DegreesToRadians x;
+
+lisp procedure tanD x;
+tan DegreesToRadians x;
+
+lisp procedure cotD x;
+cot DegreesToRadians x;
+
+lisp procedure secD x;
+sec DegreesToRadians x;
+
+lisp procedure cscD x;
+csc DegreesToRadians x;
+
+lisp procedure asin x;
+begin scalar neg;
+ if minusp x then <<
+ neg := T;
+ x := -x >>;
+ if x > 1.0 then
+ stderror list("Argument to ASIN too large:",x);
+ return if neg then CheckedArcCosine x - NumberPi!/2
+ else NumberPi!/2 - CheckedArcCosine x
+end;
+
+lisp procedure acos x;
+begin scalar neg;
+ if minusp x then <<
+ neg := T;
+ x := -x >>;
+ if x > 1.0 then
+ stderror list("Argument to ACOS too large:",x);
+ return if neg then NumberPi - CheckedArcCosine x
+ else CheckedArcCosine x
+end;
+
+lisp procedure CheckedArcCosine x;
+% Return cosine of a "checked number", assumes its argument is in the range
+% 0 <= x <= 1.
+sqrt(1.0-x)*(1.5707963+x*(-0.2145988+x*(0.088978987+x*(-0.050174305+
+ x*(0.030891881+x*(-0.017088126+x*(0.0066700901-x*(0.0012624911))))))));
+
+lisp procedure atan x;
+if minusp x then
+ if x < -1.0 then
+ Number!-Pi!/2 + CheckedArcTangent(-1.0/x)
+ else
+ -CheckedArcTangent(-x)
+else
+ if x > 1.0 then
+ NumberPi!/2 - CheckedArcTangent(1.0/x)
+ else
+ CheckedArcTangent x;
+
+lisp procedure acot x;
+if minusp x then
+ if x < -1.0 then
+ -CheckedArcTangent(-1.0/x)
+ else
+ Number!-Pi!/2 + CheckedArcTangent(-x)
+else
+ if x > 1.0 then
+ CheckedArcTangent(1.0/x)
+ else
+ NumberPi!/2 - CheckedArcTangent x;
+
+lisp procedure CheckedArcTangent x;
+begin scalar xsqrd;
+ xsqrd := x*x;
+ return x*(1+xsqrd*(-0.33333145+xsqrd*(0.19993551+xsqrd*(-0.14208899+
+ xsqrd*(0.10656264+xsqrd*(-0.07528964+xsqrd*(0.042909614+
+ xsqrd*(-0.016165737+xsqrd*0.0028662257))))))))
+end;
+
+lisp procedure asec x;
+acos(1.0/x);
+
+lisp procedure acsc x;
+asin(1.0/x);
+
+lisp procedure asinD x;
+RadiansToDegrees asin x;
+
+lisp procedure acosD x;
+RadiansToDegrees acos x;
+
+lisp procedure atanD x;
+RadiansToDegrees atan x;
+
+lisp procedure acotD x;
+RadiansToDegrees acot x;
+
+lisp procedure asecD x;
+RadiansToDegrees asec x;
+
+lisp procedure acscD x;
+RadiansToDegrees acsc x;
+
+%****************** Roots and such *******************************************
+
+lisp procedure sqrt N;
+% Simple Newton-Raphson floating point square root calculator.
+% Not waranted against truncation errors, etc.
+begin integer answer,scale;
+ N:=FLOAT N;
+ if N < 0.0 then stderror list("SQRT given negative argument:",N);
+ if zerop N then
+ return N;
+ % Scale argument to within 1e-10 to 1e+10;
+ scale := 0;
+ while N > 1.0E10 do
+ <<
+ scale := scale + 1;
+ N := N * 1.0E-10 >>;
+ while N < 1.0E-10 do
+ <<
+ scale := scale - 1;
+ N := N * 1.0E10 >>;
+ answer := if N>2.0 then (N+1)/2
+ else if N<0.5 then 2/(N+1)
+ else N;
+
+ % Here's the heart of the algorithm.
+ while abs(answer**2/N - 1.0) > SqrtTolerance do
+ answer := 0.5*(answer+N/answer);
+ return answer * 10.0**(5*scale)
+end;
+
+%******************** Logs and Exponentials **********************************
+
+lisp procedure exp x;
+% Returns the exponential (ie, e**x) of its floatnum argument as
+% a flonum. The argument is scaled to
+% the interval -ln 2 to 0, and a Taylor series expansion
+% used (formula 4.2.45 on page 71 of Abramowitz and Stegun,
+% "Handbook of Mathematical Functions").
+begin scalar N;
+ N := ceiling(x / NaturalLog2);
+ x := N * NaturalLog2 - x;
+ return 2.0**N * (1.0+x*(-0.9999999995+x*(0.4999999206+x*(-0.1666653019+
+ x*(0.0416573475+x*(-0.0083013598+x*(0.0013298820+
+ x*(-0.0001413161))))))))
+end;
+
+
+lisp procedure log x;
+% See Abramowitz and Stegun, page 69.
+
+ if x <= 0.0 then
+ stderror list("LOG given non-positive argument:",x)
+ else if x < 1.0 then
+ -log(1.0/x)
+ else
+ % Find natural log of x > 1;
+ begin scalar nextx, ipart; % ipart is the "integer part" of the
+ % logarithm.
+ ipart := 0;
+
+ % Keep multiplying by 1/e until x is small enough, may want to be more
+ % "efficient" if we ever use really big numbers.
+ while (nextx := NumberInverseE * x) > 1.0 do
+ <<
+ x := nextx;
+ ipart := ipart + 1;
+ >>;
+
+ return
+ ipart +
+ if x < 2.0 then
+ CheckedLogarithm x
+ else
+ 2.0 * CheckedLogarithm(sqrt(x));
+ end;
+
+lisp procedure CheckedLogarithm x;
+% Should have 1 <= x <= 2. (i.e. x = 1+y 0 <= y <= 1)
+<< x := x-1.0;
+ x*(0.99999642+x*(-0.49987412+x*(0.33179903+x*(-0.24073381+x*(0.16765407+
+ x*(-0.09532939+x*(0.036088494-x*0.0064535442))))))) >>;
+
+lisp procedure log2 x;
+log x / NaturalLog2;
+
+lisp procedure log10 x;
+log x / NaturalLog10;
+
+%********************* Random Number Generator *******************************
+
+% The declarations below constitute a linear, congruential
+% random number generator (see Knuth, "The Art of Computer
+% Programming: Volume 2: Seminumerical Algorithms", pp9-24).
+% With the given constants it has a period of 392931 and
+% potency 6. To have deterministic behaviour, set
+% RANDOMSEED.
+%
+% Constants are: 6 2
+% modulus: 392931 = 3 * 7 * 11
+% multiplier: 232 = 3 * 7 * 11 + 1
+% increment: 65537 is prime
+%
+% Would benefit from being recoded in SysLisp, when full word integers should
+% be used with "automatic" modular arithmetic (see Knuth). Perhaps we should
+% have a longer period version?
+% By E. Benson, W. Galway and M. Griss
+
+fluid '(RandomSeed RandomModulus);
+
+RandomModulus := 392931;
+RandomSeed := remainder(time(),RandomModulus);
+
+lisp procedure next!-random!-number;
+% Returns a pseudo-random number between 0 and RandomModulus-1 (inclusive).
+RandomSeed := remainder(232*RandomSeed + 65537, RandomModulus);
+
+lisp procedure Random(N);
+% Return a pseudo-random number uniformly selected from the range 0..N-1.
+% NOTE that this used to be called RandomMod(N). Needs to be made more
+% compatible with Common LISP's random?
+ fix( (float(N) * next!-random!-number()) / RandomModulus);
+
+procedure FACTORIAL N; % Simple factorial
+ Begin scalar M;
+ M:=1;
+ for i:=1:N do M:=M*I;
+ Return M;
+ end;
+
+
+% Some functions from ALPHA_1 users
+
+lisp procedure Atan2D( Y, X );
+ RadiansToDegrees Atan2( Y, X );
+
+lisp procedure Atan2( Y, X );
+<<
+ X := float X; Y := Float Y;
+
+ if X = 0.0 then % Y axis.
+ if Y >= 0.0 then NumberPI!/2 else NumberPi + NumberPI!/2
+
+ else if X >= 0.0 and Y >= 0.0 then % First quadrant.
+ Atan( Y / X )
+
+ else if X < 0.0 and Y >= 0.0 then % Second quadrant.
+ NumberPI - Atan( Y / -X )
+
+ else if X < 0.0 and Y < 0.0 then % Third quadrant.
+ NumberPI + Atan( Y / X )
+
+ else % Fourth quadrant.
+ Number2Pi - Atan( -Y / X )
+>>;
+
+lisp procedure TransferSign( S, Val );
+% Transfers the sign of S to Val by returning abs(Val) if S >= 0,
+% otherwise -abs(Val).
+ if S >= 0 then abs(Val) else -abs(Val);
+
+lisp procedure DMStoDegrees(Degs,Mins,Sex);
+% Converts degrees, minutes, seconds to degrees
+% Degs+Mins/60.0+Sex/3600.0
+ Degs+Mins*0.016666667+Sex*0.00027777778;
+
+lisp procedure DegreesToDMS x;
+% Converts degrees to a list of degrees, minutes, and seconds (all integers,
+% rounded, not truncated).
+begin scalar Degs,Mins;
+ Degs := fix x;
+ x := 60*(x-Degs);
+ Mins := fix x;
+ return list(Degs,Mins, round(60*(x-Mins)))
+end;
+
+end;
ADDED psl-1983/3-1/util/mini-support-patch.red
Index: psl-1983/3-1/util/mini-support-patch.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini-support-patch.red
@@ -0,0 +1,9 @@
+GLOBAL '(SCNVAL);
+LISP PROCEDURE !%SCAN;
+<<SCNVAL := CHANNELREADTOKEN IN!*;
+ TOKTYPE!*>>;
+
+PROCEDURE UNREADCH U;
+ UNREADCHAR (ID2INT (U));
+
+END;
ADDED psl-1983/3-1/util/mini-support.fix
Index: psl-1983/3-1/util/mini-support.fix
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini-support.fix
@@ -0,0 +1,46 @@
+FLUID '(PromptString!* !*Break);
+
+% Error-print is called when the major loop returns a NIL.
+
+SYMBOLIC PROCEDURE ERROR!-PRINT;
+ <<PRIN2 "ERROR in grammar, current token is ";
+ PRIN2 !#TOK!#; PRIN2 " and stack is ";
+ PRIN2 !#STACK!#; TERPRI() >>;
+
+% The following errs out if its argument is NIL
+
+SYMBOLIC PROCEDURE FAIL!-NOT U;
+IF U then T
+ else begin scalar Promptstring!*;
+ PRIN2T "FAIL-NOT called in a concatenation";
+ ERROR!-PRINT();
+ PromptString!*:="Mini-Error>";
+ U:=ContinuableERROR(997,"Failure scanning a concatenation",'(QUOTE T));
+ IF U AND SCAN!-TERM() THEN RETURN T;
+ return begin scalar !*Break;
+ return Error(997, "Could not Recover from FAIL-NOT");
+ end;
+ end;
+
+% Invoke starts execution of a previously defined grammar.
+
+SYMBOLIC PROCEDURE INVOKE U;
+ BEGIN SCALAR X,PromptString!*;
+ PromptString!*:=Concat(Id2String U,">");
+ !#IDTYPE!# := 0;
+ !#NUMTYPE!# := 2;
+ !#STRTYPE!# := 1;
+ FLAG (GET (U, 'KEYS), 'KEY);
+ DIPBLD (GET (U, 'DIPS));
+ !#RTNOW!# := GET (U, 'RTS);
+ !#GTNOW!# := GET (U, 'GTS);
+ !#DIP!# := !#KEY!# := !#RT!# := !#GT!# := !#GENLABLIST!# := NIL;
+ L: !#STACK!# := NIL;
+ NEXT!-TOK();
+ X := APPLY (U, NIL);
+ IF NULL X THEN
+ << ERROR!-PRINT();
+ IF SCAN!-TERM() THEN <<PRIN2 ("Resuming scan"); TERPRI(); GOTO L>> >>;
+ REMFLAG (GET (U, 'KEYS), 'KEY)
+ END;
+
ADDED psl-1983/3-1/util/mini-support.red
Index: psl-1983/3-1/util/mini-support.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini-support.red
@@ -0,0 +1,445 @@
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % %
+ % %
+ % MINI %
+ % (A SMALL META SYSTEM) %
+ % %
+ % %
+ % Copyright (c) Robert R. Kessler 1979 %
+ % Mods: MLG, Feb 1981
+ % %
+ % This file is the support routines. %
+ % The file MINI.MIN contains the MINI %
+ % system self definition and MINI.SL %
+ % is the Standard LISP translation %
+ % of MINI.MIN. %
+ % %
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+GLOBAL '(!#KEY!# !#DIP!# !*MDEFN !#STACK!# !#STACK!-ELE!# !#TOK!#
+ !#TOKTYPE!# !#NTOK!# !#LABLIST!# SINGLEOP!* FAILURE!* INDEXLIST!*
+ !#RT!# !#GT!# !#RTNOW!# !#GTNOW!# !#IDTYPE!# !#NUMTYPE!#
+ !#STRTYPE!# !#GENLABLIST!#);
+
+% Global description:
+% !#DIP!# - List of diphthongs for grammar being defined.
+% FAILURE!* - Value of failed match in pattern matcher.
+% !#GENLABLIST!# - List of generated labels used in push/pop lab.
+% !#GT!# - List of grammar terminators for invoked grammar.
+% !#GTNOW!# - List of grammar terminators for grammar being def.
+% !#IDTYPE!# - The value of toktype for id's (0)
+% INDEXLIST!* - List of number value pairs for pattern matcher.
+% !#KEY!# - List of key workds for grammar being defined.
+% !#LABLIST!# - The list of gensymed labels ($n).
+% !*MDEFN - Flag to MPRINT (ON) or EVAL (OFF) defined rule.
+% !#NUMTYPE!# - The value of toktype for numbers (2)
+% !#NTOK!# - Next token, used for diphthong checking.
+% !#RT!# - List of rule terminators for invoked grammar.
+% !#RTNOW!# - List of rule terminators for grammar being defined.
+% SINGLEOP!* - The operator for any match pattern (&).
+% !#STACK!# - The stack list: push +, pop #n , ref ##n
+% !#STACK!-ELE!# - Used to pass info between stack operations
+% !#SPECTYPE!# - The value of toktype for specials (3)
+% !#STRTYPE!# - The value of toktype for strings (1)
+% !#TOK!# - The current token
+% !#TOKTYPE!# - The type of the token from rSYMBOLIC Parser
+% (0-id, 1-str, 2-num, 3-special)
+
+% A grammar is defined by calling the function MINI with argument of
+% the name of the goal rule. i.e. MINI 'RUL redefines MINI itself.
+% Then to invoke a grammar, you use INVOKE goal rule name.(INVOKE 'RUL).
+
+SYMBOLIC PROCEDURE MINI U;
+ << INVOKE 'RUL;
+ RULE!-DEFINE LIST ('PUT, LIST('QUOTE, U), '(QUOTE KEYS),
+ LIST('QUOTE, !#KEY!#));
+ RULE!-DEFINE LIST ('PUT, LIST('QUOTE, U), '(QUOTE DIPS),
+ LIST('QUOTE, !#DIP!#));
+ RULE!-DEFINE LIST ('PUT, LIST('QUOTE, U), '(QUOTE RTS),
+ LIST('QUOTE, !#RT!#));
+ RULE!-DEFINE LIST ('PUT, LIST('QUOTE, U), '(QUOTE GTS),
+ LIST('QUOTE, !#GT!#));
+ NIL >>;
+
+% Invoke starts execution of a previously defined grammar.
+
+SYMBOLIC PROCEDURE INVOKE U;
+ BEGIN SCALAR X;
+ !#IDTYPE!# := 0;
+ !#NUMTYPE!# := 2;
+ !#STRTYPE!# := 1;
+ FLAG (GET (U, 'KEYS), 'KEY);
+ DIPBLD (GET (U, 'DIPS));
+ !#RTNOW!# := GET (U, 'RTS);
+ !#GTNOW!# := GET (U, 'GTS);
+ !#DIP!# := !#KEY!# := !#RT!# := !#GT!# := !#GENLABLIST!# := NIL;
+ L: !#STACK!# := NIL;
+ NEXT!-TOK();
+ X := APPLY (U, NIL);
+ IF NULL X THEN
+ << ERROR!-PRINT();
+ IF SCAN!-TERM() THEN <<PRIN2 ("Resuming scan"); TERPRI(); GOTO L>> >>;
+ REMFLAG (GET (U, 'KEYS), 'KEY)
+ END;
+
+% The following errs out if its argument is NIL
+
+SYMBOLIC PROCEDURE FAIL!-NOT U;
+U OR <<ERROR!-PRINT();
+ ERROR(997,"Failure scanning a concatenation.")>>;
+
+
+% This procedure is called when a rule is defined. If ON MDEFN then the
+% value is MPRINTed, otherwise, it is evaled.
+
+SYMBOLIC PROCEDURE RULE!-DEFINE U;
+ << IF !*MDEFN THEN MPRINT U
+ ELSE EVAL U>>;
+
+% Mprint is used so it may be redefined if something other than PRINT
+% is desired when ON MDEFN is used.
+
+SYMBOLIC PROCEDURE MPRINT U;
+ << TERPRI(); PRINT U>>;
+
+% Error-print is called when the major loop returns a NIL.
+
+SYMBOLIC PROCEDURE ERROR!-PRINT;
+ <<PRIN2 "ERROR in grammar, current token is ";
+ PRIN2 !#TOK!#; PRIN2 " and stack is ";
+ PRIN2 !#STACK!#; TERPRI() >>;
+
+% Scan for a rule terminator or grammar terminator by fetching tokens.
+% Returns T if a rule terminator is found and NIL for a grammar term.
+% The rule terminator causes processing to continue after the terminator.
+% The grammar terminator ceases processing.
+
+SYMBOLIC PROCEDURE SCAN!-TERM;
+ BEGIN SCALAR X;
+ PRIN2 ("Scanning for rule terminator: "); PRIN2 !#RTNOW!#;
+ PRIN2 (" or grammar terminator: "); PRIN2 !#GTNOW!#;
+ TERPRI();
+ L: X := NEXT!-TOK();
+ IF MEMQ (X, !#GTNOW!#) THEN RETURN NIL
+ ELSE IF MEMQ (X, !#RTNOW!#) THEN RETURN T
+ ELSE GOTO L
+ END;
+
+% Add the argument to the current key list, if not already there.
+
+SYMBOLIC PROCEDURE ADDKEY U;
+ <<IF NOT MEMQ (U, !#KEY!#) THEN !#KEY!# := U . !#KEY!#; T>>;
+
+% Add the argument to the current grammar terminator list.
+
+SYMBOLIC PROCEDURE ADDGTERM U;
+ <<IF NOT MEMQ (U, !#GT!#) THEN !#GT!# := U . !#GT!#; T>>;
+
+% Add the argument to the current rule terminator list.
+
+SYMBOLIC PROCEDURE ADDRTERM U;
+ <<IF NOT MEMQ (U, !#RT!#) THEN !#RT!# := U . !#RT!#; T>>;
+
+% This procedure will take a list of identifiers and flag them as
+% diphthongs (2 character max).
+
+SYMBOLIC PROCEDURE DIPBLD U;
+ BEGIN SCALAR W, X, Y;
+ FOR EACH X IN U DO
+ << IF NOT MEMQ (X, !#DIP!#) THEN !#DIP!# := X . !#DIP!#;
+ Y := EXPLODE X;
+ Y := STRIP!! Y; % Take out the escapes;
+ W := GET (CAR Y, 'FOLLOW); % Property follow is list of legal dip terms;
+ PUT (CAR Y, 'FOLLOW, (LIST (CADR Y, X)) . W) >>;
+ RETURN T
+ END;
+
+SYMBOLIC PROCEDURE UNDIPBLD U;
+ BEGIN SCALAR W, X, Y;
+ FOR EACH X IN U DO
+ << Y := EXPLODE X;
+ Y := STRIP!! Y; % Take out the escapes;
+ REMPROP(CAR Y, 'FOLLOW) >>;
+ RETURN T
+ END;
+
+% Following procedure will eliminate the escapes in a list
+
+SYMBOLIC PROCEDURE STRIP!! U;
+ IF PAIRP U THEN
+ IF CAR U EQ '!! THEN CADR U . STRIP!! CDDR U
+ ELSE CAR U . STRIP!! CDR U
+ ELSE NIL;
+
+% Push something onto the stack;
+
+SYMBOLIC PROCEDURE PUSH U;
+ !#STACK!# := U . !#STACK!#;
+
+% Reference a stack element
+
+SYMBOLIC PROCEDURE REF U;
+ SCAN!-STACK (U, !#STACK!#);
+
+% Stack underflow is called then that error happens. Right now, it errors
+% out. Future enhancement is to make it more friendly to the user.
+
+SYMBOLIC PROCEDURE STACK!-UNDERFLOW;
+ ERROR (4000, "Stack underflow");
+
+% Like above, a stack error has occured, so quit the game.
+
+SYMBOLIC PROCEDURE STACK!-ERROR;
+ ERROR (4001, "Error in stack access");
+
+% Search stack for the element U elements from the top (1 is top).
+
+SYMBOLIC PROCEDURE SCAN!-STACK (U, STK);
+ IF NULL STK THEN STACK!-UNDERFLOW ()
+ ELSE IF U = 1 THEN CAR STK
+ ELSE SCAN!-STACK (U-1, CDR STK);
+
+% Remove the Uth element from the stack (1 is the top).
+
+SYMBOLIC PROCEDURE EXTRACT U;
+ << !#STACK!# := FETCH!-STACK (U, !#STACK!#);
+ !#STACK!-ELE!# >>; % Return the value found;
+
+% Recursive routine to remove the Uth element from the stack.
+
+SYMBOLIC PROCEDURE FETCH!-STACK (U, STK);
+ BEGIN SCALAR X;
+ IF NULL STK THEN STACK!-UNDERFLOW ()
+ ELSE IF U EQ 1 THEN <<!#STACK!-ELE!# := CAR STK; RETURN CDR STK>>
+ ELSE RETURN CAR STK . FETCH!-STACK (U-1, CDR STK)
+ END;
+
+% Retrieve the length of the stack. This is used to build a single
+% list used in repetition. It takes the top of the stack down to
+% the stack length at the beginning to build the list. Therefore,
+% STK!-LENGTH must be called prior to calling BUILD!-REPEAT, which
+% must be passed the value returned by the call to STK!-LENGTH.
+
+SYMBOLIC PROCEDURE STK!-LENGTH;
+ LENGTH !#STACK!#;
+
+% The procedure to handle repetition by building a list out of the
+% top n values on the stack.
+
+SYMBOLIC PROCEDURE BUILD!-REPEAT U;
+ BEGIN SCALAR V;
+ V := STK!-LENGTH();
+ IF U > V THEN STACK!-ERROR()
+ ELSE IF U = V THEN PUSH NIL
+ ELSE IF U < V THEN
+ BEGIN SCALAR L, I; % Build it for the top V-U elements
+ L := NIL;
+ FOR I := 1:(V-U) DO
+ L := (EXTRACT 1) . L;
+ PUSH L
+ END;
+ RETURN T
+ END;
+
+% Actually get the next token, if !#NTOK!# has a value then use that,
+% else call your favorite token routine.
+% This routine must return an identifier, string or number.
+% If U is T then don't break up a quoted list right now.
+
+SYMBOLIC PROCEDURE GET!-TOK U;
+ BEGIN SCALAR X;
+ IF !#NTOK!# THEN
+ << X := !#NTOK!#;
+ !#NTOK!# := NIL;
+ RETURN X >>
+ ELSE
+ << X := !%SCAN();
+ % Scan sets the following codes:
+ % 0 - ID, and thus was escapeed
+ % 1 - STRING
+ % 2 - Integer
+ % 3 - Special (;, (, ), etc.)
+ % Therefore, it is important to distinguish between
+ % the special and ID for key words.
+ IF (X EQ 2) OR (X EQ 1) THEN RETURN (X . SCNVAL)
+ ELSE RETURN (0 . INTERN SCNVAL) >> %//Ignore ESCAPE for now
+ END;
+
+% Fetch the next token, if a diphthong, turn into an identifier
+
+SYMBOLIC PROCEDURE NEXT!-TOK;
+ BEGIN SCALAR X,Y;
+ !#TOK!# := GET!-TOK(NIL);
+ !#TOKTYPE!# := CAR !#TOK!#;
+ !#TOK!# := CDR !#TOK!#;
+ IF (Y:=GET(!#TOK!#, 'FOLLOW)) THEN
+ << !#NTOK!# := 0 . READCH(); % Use READCH since white space
+ IF X := ATSOC(CDR !#NTOK!#, Y) THEN % within diphthong is illegal
+ << !#TOK!# := CADR X;
+ !#TOKTYPE!# := !#IDTYPE!# >>
+ ELSE UNREADCH CDR !#NTOK!#; % Push the character back for the
+ !#NTOK!# := NIL >>; % scanner if not part of diphthong
+ RETURN !#TOK!#
+ END;
+
+SYMBOLIC PROCEDURE T!-NTOK;
+ <<NEXT!-TOK(); 'T>>;
+
+SYMBOLIC PROCEDURE EQTOK(X); % Test Token Value
+ EQUAL(!#TOK!#,X); % maybe use EQ?
+
+SYMBOLIC PROCEDURE EQTOK!-NEXT(X);
+ EQTOK(X) AND T!-NTOK();
+
+% See if current token is an identifier and not a keyword. If it is,
+% then push onto the stack and fetch the next token.
+
+SYMBOLIC PROCEDURE ID;
+ IF !#TOKTYPE!# EQ !#IDTYPE!# AND NOT FLAGP(!#TOK!#,'KEY) THEN
+ <<PUSH !#TOK!#;
+ IF NOT (MEMQ (!#TOK!#, !#GTNOW!#)
+ OR MEMQ(!#TOK!#, !#RTNOW!#)) THEN
+ NEXT!-TOK();
+ T>>
+ ELSE NIL;
+
+% See if current token is an id whether or not it is a keyword.
+
+SYMBOLIC PROCEDURE ANYID;
+ IF (!#TOKTYPE!# EQ !#IDTYPE!#) THEN
+% (!#TOKTYPE!# EQ !#SPECTYPE!#) OR FLAGP(!#TOK!#, 'KEY) THEN
+ ANYTOK() ELSE NIL;
+
+% Always succeeds by pushing the current token onto the stack.
+
+SYMBOLIC PROCEDURE ANYTOK;
+ <<PUSH !#TOK!#; NEXT!-TOK(); T>>;
+
+% Tests to see if the current token is a number, if so it pushes the
+% number onto the stack and fetches the next token.
+
+SYMBOLIC PROCEDURE NUM;
+ IF (!#TOKTYPE!# EQ !#NUMTYPE!#) THEN ANYTOK() ELSE NIL;
+
+% Same as NUM, except for strings.
+
+SYMBOLIC PROCEDURE STR;
+ IF (!#TOKTYPE!# EQ !#STRTYPE!#) THEN ANYTOK() ELSE NIL;
+
+% Generate a label. If the label has been previously generated, the
+% return the old value. (used by $n).
+
+SYMBOLIC PROCEDURE GENLAB U;
+ BEGIN SCALAR X;
+ IF X:=ASSOC(U, !#LABLIST!#) THEN RETURN CADR X;
+ X:=INTERN GENSYM();
+ !#LABLIST!# := LIST(U, X) . !#LABLIST!#;
+ RETURN X
+ END;
+
+% Push the current label lists so we don't get any conflicts.
+LISP PROCEDURE PUSH!-LAB;
+ << !#GENLABLIST!# := !#LABLIST!# . !#GENLABLIST!#;
+ !#LABLIST!# := NIL;
+ T>>;
+
+% Pop label lists.
+LISP PROCEDURE POP!-LAB;
+ <<!#LABLIST!# := CAR !#GENLABLIST!#;
+ !#GENLABLIST!# := CDR !#GENLABLIST!#;
+ T>>;
+
+GLOBAL '(!*DO!#);
+
+ON DO!#;
+
+FLUID '(NEWENV!*);
+
+% RBMATCH will accept a list of rules and subject list and
+% search for a match on one of the rules. Upon finding the
+% match, the body will be executed.
+
+SYMBOLIC PROCEDURE RBMATCH (SUBLIST, RULESLIST, INITENV);
+ BEGIN SCALAR TEMP, ENVLIST, RULFOUND, RVAL, TRYAGAIN, SN;
+% IF NUMARGS() EQ 4 THEN TRYAGAIN := T ELSE TRYAGAIN := NIL;
+% IF NUMARGS() > 2 THEN INITENV := ARGUMENT(3) ELSE INITENV:=NIL;
+ RVAL := FAILURE!*;
+ WHILE RULESLIST DO
+ <<
+ RULFOUND := CAR RULESLIST;
+ RULESLIST := CDR RULESLIST;
+ ENVLIST := LIST (LIST (0, SUBLIST));
+ IF INITENV THEN ENVLIST := APPEND (ENVLIST, INITENV);
+ IF (NEWENV!* := PEVAL (CAR RULFOUND, SUBLIST, ENVLIST)) NEQ FAILURE!*
+ THEN
+ IF (TEMP := EVAL (LIST (CDR RULFOUND, 'NEWENV!*, NIL, NIL, NIL)))
+ NEQ FAILURE!*
+ THEN
+ IF TEMP EQ 'FAIL THEN <<RVAL := NIL; RETURN NIL>>
+ ELSE IF TRYAGAIN THEN
+ << PRIN2T ("Success, will try again");
+ RVAL := APPEND (TEMP, RVAL) >>
+ ELSE <<RVAL := TEMP;
+ RETURN TEMP >>
+ >>;
+ RETURN RVAL
+ END RBMATCH;
+%
+% PEVAL accepts a subjectlist, a pattern and an environment.
+% It then determines if the subjectlist matches the pattern
+% with the particular environment. The pattern may contain
+% lists or variable expressions. The variable expressions are
+% of two form: & "ATOM" which will match a single list or
+% ATOM and & & "ATOM" which will test to see if the match is
+% equal to a previously matched item.
+%;
+SINGLEOP!* := '&;
+
+FAILURE!* := NIL;
+
+SYMBOLIC PROCEDURE PEVAL(P, S, ENV);
+ IF P EQ S THEN LIST ENV
+ ELSE IF EQCAR (S, '!#) AND !*DO!# THEN TST!#(P, S, ENV)
+ ELSE IF ATOM P THEN NIL
+ ELSE IF CAR P EQ SINGLEOP!* THEN TST!-SINGLE(P, S, ENV)
+ ELSE IF ATOM S THEN NIL
+ ELSE BEGIN SCALAR ENVL;
+ ENVL := PEVAL (CAR P, CAR S, ENV);
+ RETURN PEVALL (CDR P, CDR S, ENVL)
+ END;
+
+SYMBOLIC PROCEDURE PEVALL (P, S, ENVL);
+ IF NULL ENVL THEN NIL
+ ELSE IF NULL CDR ENVL THEN PEVAL (P, S, CAR ENVL)
+ ELSE APPEND (PEVAL(P, S, CAR ENVL), PEVALL(P, S, CDR ENVL));
+
+SYMBOLIC PROCEDURE TST!-SINGLE (P, S, ENV);
+ BEGIN SCALAR IDX;
+ IF LENGTH (IDX := CDR P) NEQ 1 THEN
+ << IF CAR IDX EQ SINGLEOP!* THEN
+ (IF EQUAL (S, CADR ASSOC (CADR IDX, ENV)) THEN
+ RETURN LIST (ENV))
+ ELSE IF MEMBER (S, CAR IDX) THEN
+ RETURN LIST (LIST(CADR IDX, S) . ENV);
+ RETURN FAILURE!* >>;
+ RETURN LIST (LIST (CAR IDX, S) . ENV)
+ END;
+
+SYMBOLIC PROCEDURE TST!# (P, S, ENV);
+ BEGIN SCALAR OLST, N, ENVL, CLST, X;
+ OLST := CADR S;
+ N := CADDR S;
+ ENVL := NIL;
+ L: IF NULL OLST THEN RETURN ENVL;
+ CLST := CAR OLST;
+ X := PEVAL (P, CLST, ENV);
+ OLST := CDR OLST;
+ FOR EACH Y IN X DO
+ ENVL := (LIST (N, CLST) . Y) . ENVL;
+ GO TO L
+ END;
+
+END;
+
+
+
ADDED psl-1983/3-1/util/mini.build
Index: psl-1983/3-1/util/mini.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini.build
@@ -0,0 +1,5 @@
+in "mini-support-patch.red"$
+in "mini-support.red"$
+in "mini-support.fix"$
+global '(PNAM);
+in "mini.sl"$
ADDED psl-1983/3-1/util/mini.demo
Index: psl-1983/3-1/util/mini.demo
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini.demo
@@ -0,0 +1,24 @@
+% ----- A simple DEMO of MINI -------
+% Use after IN "/utah/psl/mini.build"
+
+MINI 'ROOT; % starts the mini parser generator
+
+ROOT: STMT* / 'QUIT ; % Define ROOT
+
+STMT: ID '= EXP @; +(SETQ #2 #1)
+ .(PRINT #1) .(NEXT!-TOK) ; % Define STMT
+
+EXP: TERM < '+ EXP +(PLUS #2 #1) /
+ '- EXP +(DIFFERENCE #2 #1)>;
+
+TERM: NUM / ID / '( EXP ') ;
+
+FIN
+
+% To run it, use
+
+% INVOKE 'ROOT;
+
+
+END;
+
ADDED psl-1983/3-1/util/mini.min
Index: psl-1983/3-1/util/mini.min
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini.min
@@ -0,0 +1,159 @@
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % %
+ % MINI - a small META system %
+ % %
+ % Copyright (c) Robert R. Kessler 1979 %
+ % Mods: MLG, Feb 1981 %
+ % %
+ % This is the MINI system self definition. %
+ % The file MINI-SUPPORT.RED contains the %
+ % support routines and MINI.SL is the %
+ % Standard LISP translation of this file. %
+ % %
+ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% The following is the definition of the mini meta system in terms of
+% itself. MINI is very similar to META/REDUCE, except a lot of it has
+% been eliminated. The following features that are in META/REDUCE, are
+% not present in MINI:
+% - Backup is not supported.
+% - Diphthongs of more than 2 characters are not supported. Also, in
+% MINI, the diphthongs must be declared before they are used.
+% - Format operations are not supported (the => op).
+% - The symbol table operations are not supported (however, they could
+% easily be added as calls to the routines.
+% - The - operator for stripping off a level of parens is not supported.
+% - The META/REDUCE error operators are not supported (*** *****).
+% The following is a list of the differences between MINI and META/REDUCE:
+% - The += operator has been changed to +. to be consistent with the
+% meanings of the + (PUSH) and . (EVAL) operators.
+% - The @ operator also includes the semantics that it's token is used
+% as a rule terminator (for error recovery). When a token is found
+% during error recovery that is a rule terminator, the grammar is
+% reset to its initial stage and scanning continues.
+% - A new operator @@ has been added that is the same as the @ operator
+% but it signifies a grammar terminator. During error recovery, if
+% a grammar terminator is scanned, parsing will stop.
+% - The flag MDEFN controls whether a rule defined is EVALED or MPRINTed.
+% - MINI uses the RLISP token reader and is therefore much faster.
+% One consequences of this is that comments may be embedded anywhere
+% in the text and are ignored by %SCAN
+% Also, since %SCAN is used, certain quoted keywords need to have a
+% escape in front of them. The ones discovered so far are: '!+ '!-
+% '!( and '!). This also means that diphthongs that use these as
+% the first character must also be quoted (i.e. '!+= or '!-.).
+% The safe approach is to quote every special character.
+
+% To define a grammar, call the procedure MINI with the argument being the
+% root rule name. Then when the grammar is defined it may be called by
+% using INVOKE root rule name.
+
+% The following is the MINI Meta self definition.
+
+GLOBAL '(PNAM);
+
+MINI 'RUL;
+
+% Define the diphthongs to be used in the grammar.
+DIP: !#!#, !-!>, !+!., !@!@ ;
+
+% The root rule is called RUL.
+RUL: ('DIP ': ANYTOK[,]* .(DIPBLD #1) '; /
+ (ID .(SETQ !#LABLIST!# NIL)
+ ( ': ALT +(DE #2 NIL #1) @; /
+ '= PRUL[,]* @; .(RULE!-DEFINE '(PUT (QUOTE ##2) (QUOTE RB)
+ (QUOTE #1)))
+ +(DE ##1 (A)
+ (RBMATCH A (GET (QUOTE #1) (QUOTE RB)) NIL)))
+ .(RULE!-DEFINE #1) .(NEXT!-TOK) ))* @@FIN ;
+
+% An alternative is a sequence of statements separated by /'s;
+ALT: SEQ < '/ ALT +(OR #2 #1) >;
+
+% A sequence is a list of items that must be matched.
+SEQ: REP < SEQ +(AND #2 (FAIL!-NOT #1)) >;
+
+% A repetition may be 0 or more single items (*) or 0 or more items
+% separated by any token (ID[,]* will parse a list of ID's separated by ,'s.
+REP: ONE
+ <'[ (ID +(#1) /
+ '' ANYKEY +(EQTOK!-NEXT (QUOTE #1)) /
+ ANYKEY +(EQTOK!-NEXT (QUOTE #1))) '] +(AND #2 #1) '* BLD!-EXPR /
+ '* BLD!-EXPR>;
+
+% Create an sexpression to build a repetition.
+BLD!-EXPR: +(PROG (X) (SETQ X (STK!-LENGTH))
+ $1 (COND (#1 (GO $1)))
+ (BUILD!-REPEAT X)
+ (RETURN T));
+
+ANYKEY: ANYTOK .(ADDKEY ##1) ; % Add a new KEY
+
+% One defines a single item.
+ONE: '' ANYKEY +(EQTOK!-NEXT (QUOTE #1)) /
+ '@ ANYKEY .(ADDRTERM ##1) +(EQTOK (QUOTE #1)) /
+ '@@ ANYKEY .(ADDGTERM ##1) +(EQTOK (QUOTE #1)) /
+ '+ UNLBLD +(PUSH #1) /
+ '. EVLBLD +(PROGN #1 T) /
+ '= EVLBLD /
+ '< ALT '> +(PROGN #1 T) /
+ '( ALT ') /
+ '+. EVLBLD +(PUSH #1) /
+ ID +(#1) ;
+
+% This rule defines an un evaled list. It builds a list with everything
+% quoted.
+UNLBLD: '( UNLBLD ('. UNLBLD ') +(CONS #2 #1) /
+ UNLBLD* ') +(LIST . (#2 . #1)) /
+ ') +(LIST . #1)) /
+ LBLD /
+ ID +(QUOTE #1) ;
+
+% EVLBLD builds a list of evaled items.
+EVLBLD: '( EVLBLD ('. EVLBLD ') +(CONS #2 #1) /
+ EVLBLD* ') +(#2 . #1) /
+ ') ) /
+ LBLD /
+ ID ;
+
+LBLD: '# NUM +(EXTRACT #1) /
+ '## NUM +(REF #1) /
+ '$ NUM +(GENLAB #1) /
+ '& NUM +(CADR (ASSOC #1 (CAR VARLIST))) /
+ NUM /
+ STR /
+ '' ('( UNLBLD* ') +(LIST . #1) /
+ ANYTOK +(QUOTE #1));
+
+% Defines the pattern matching rules (PATTERN -> BODY).
+PRUL: .(SETQ INDEXLIST!* NIL)
+ PAT '-> (EVLBLD)*
+ +(LAMBDA (VARLIST T1 T2 T3) (AND . #1))
+ .(SETQ PNAM (GENSYM))
+ .(RULE!-DEFINE (LIST 'PUTD (LIST 'QUOTE PNAM)
+ '(QUOTE EXPR) (LIST 'QUOTE #1)))
+ +.(CONS #1 PNAM);
+
+% Defines a pattern.
+% We now allow the . operator to be the next to last in a ().
+PAT: '& ('< PSIMP[/]* '> NUM
+ +.(PROGN (SETQ INDEXLIST!* (CONS ##1 INDEXLIST!*))
+ (LIST '!& #2 #1) ) /
+ NUM
+ +.(COND ((MEMQ ##1 INDEXLIST!*)
+ (LIST '!& '!& #1))
+ (T (PROGN (SETQ INDEXLIST!* (CONS ##1 INDEXLIST!*))
+ (LIST '!& #1)))) )
+ / ID
+ / '!( PAT* <'. PAT +.(APPEND #2 #1)> '!)
+ / '' ANYTOK
+ / STR
+ / NUM ;
+
+% Defines the primitives in a pattern.
+PSIMP: ID / NUM / '( PSIMP* ') / '' ANYTOK;
+
+% The grammar terminator.
+FIN
+END;
+
ADDED psl-1983/3-1/util/mini.sl
Index: psl-1983/3-1/util/mini.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/mini.sl
@@ -0,0 +1,134 @@
+NIL
+
+(DE RUL NIL (AND (PROG (X) (SETQ X (STK!-LENGTH)) G0109 (COND ((OR (AND (
+EQTOK!-NEXT (QUOTE DIP)) (FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !:)) (FAIL!-NOT (
+AND (PROG (X) (SETQ X (STK!-LENGTH)) G0109 (COND ((AND (ANYTOK) (EQTOK!-NEXT (
+QUOTE !,))) (GO G0109))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (
+PROGN (DIPBLD (EXTRACT 1)) T) (FAIL!-NOT (EQTOK!-NEXT (QUOTE !;)))))))))) (
+AND (ID) (FAIL!-NOT (AND (PROGN (SETQ !#LABLIST!# NIL) T) (FAIL!-NOT (AND (
+OR (AND (EQTOK!-NEXT (QUOTE !:)) (FAIL!-NOT (AND (ALT) (FAIL!-NOT (AND (PUSH (
+LIST (QUOTE DE) (EXTRACT 2) (QUOTE NIL) (EXTRACT 1))) (FAIL!-NOT (EQTOK (
+QUOTE !;)))))))) (AND (EQTOK!-NEXT (QUOTE !=)) (FAIL!-NOT (AND (PROG (X) (
+SETQ X (STK!-LENGTH)) G0109 (COND ((AND (PRUL) (EQTOK!-NEXT (QUOTE !,))) (GO
+G0109))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (EQTOK (QUOTE !;)) (
+FAIL!-NOT (AND (PROGN (RULE!-DEFINE (LIST (QUOTE PUT) (LIST (QUOTE QUOTE) (
+REF 2)) (LIST (QUOTE QUOTE) (QUOTE RB)) (LIST (QUOTE QUOTE) (EXTRACT 1)))) T) (
+FAIL!-NOT (PUSH (LIST (QUOTE DE) (REF 1) (LIST (QUOTE A)) (LIST (QUOTE
+RBMATCH) (QUOTE A) (LIST (QUOTE GET) (LIST (QUOTE QUOTE) (EXTRACT 1)) (LIST (
+QUOTE QUOTE) (QUOTE RB))) (QUOTE NIL))))))))))))) (FAIL!-NOT (AND (PROGN (
+RULE!-DEFINE (EXTRACT 1)) T) (FAIL!-NOT (PROGN (NEXT!-TOK) T)))))))))) (GO
+G0109))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (EQTOK (QUOTE FIN)))))
+
+(DE ALT NIL (AND (SEQ) (FAIL!-NOT (PROGN (AND (EQTOK!-NEXT (QUOTE !/)) (
+FAIL!-NOT (AND (ALT) (FAIL!-NOT (PUSH (LIST (QUOTE OR) (EXTRACT 2) (EXTRACT
+1))))))) T))))
+
+(DE SEQ NIL (AND (REP) (FAIL!-NOT (PROGN (AND (SEQ) (FAIL!-NOT (PUSH (LIST (
+QUOTE AND) (EXTRACT 2) (LIST (QUOTE FAIL!-NOT) (EXTRACT 1)))))) T))))
+
+(DE REP NIL (AND (ONE) (FAIL!-NOT (PROGN (OR (AND (EQTOK!-NEXT (QUOTE ![)) (
+FAIL!-NOT (AND (OR (AND (ID) (FAIL!-NOT (PUSH (LIST (EXTRACT 1))))) (OR (AND (
+EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (AND (ANYKEY) (FAIL!-NOT (PUSH (LIST (
+QUOTE EQTOK!-NEXT) (LIST (QUOTE QUOTE) (EXTRACT 1)))))))) (AND (ANYKEY) (
+FAIL!-NOT (PUSH (LIST (QUOTE EQTOK!-NEXT) (LIST (QUOTE QUOTE) (EXTRACT
+1)))))))) (FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !])) (FAIL!-NOT (AND (PUSH (
+LIST (QUOTE AND) (EXTRACT 2) (EXTRACT 1))) (FAIL!-NOT (AND (EQTOK!-NEXT (
+QUOTE !*)) (FAIL!-NOT (BLD!-EXPR))))))))))) (AND (EQTOK!-NEXT (QUOTE !*)) (
+FAIL!-NOT (BLD!-EXPR)))) T))))
+
+(DE BLD!-EXPR NIL (PUSH (LIST (QUOTE PROG) (LIST (QUOTE X)) (LIST (QUOTE
+SETQ) (QUOTE X) (LIST (QUOTE STK!-LENGTH))) (GENLAB 1) (LIST (QUOTE COND) (
+LIST (EXTRACT 1) (LIST (QUOTE GO) (GENLAB 1)))) (LIST (QUOTE BUILD!-REPEAT) (
+QUOTE X)) (LIST (QUOTE RETURN) (QUOTE T)))))
+
+(DE ANYKEY NIL (AND (ANYTOK) (FAIL!-NOT (PROGN (ADDKEY (REF 1)) T))))
+
+(DE ONE NIL (OR (AND (EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (AND (ANYKEY) (
+FAIL!-NOT (PUSH (LIST (QUOTE EQTOK!-NEXT) (LIST (QUOTE QUOTE) (EXTRACT
+1)))))))) (OR (AND (EQTOK!-NEXT (QUOTE !@)) (FAIL!-NOT (AND (ANYKEY) (
+FAIL!-NOT (AND (PROGN (ADDRTERM (REF 1)) T) (FAIL!-NOT (PUSH (LIST (QUOTE
+EQTOK) (LIST (QUOTE QUOTE) (EXTRACT 1)))))))))) (OR (AND (EQTOK!-NEXT (QUOTE
+!@!@)) (FAIL!-NOT (AND (ANYKEY) (FAIL!-NOT (AND (PROGN (ADDGTERM (REF 1)) T) (
+FAIL!-NOT (PUSH (LIST (QUOTE EQTOK) (LIST (QUOTE QUOTE) (EXTRACT 1)))))))))) (
+OR (AND (EQTOK!-NEXT (QUOTE !+)) (FAIL!-NOT (AND (UNLBLD) (FAIL!-NOT (PUSH (
+LIST (QUOTE PUSH) (EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (QUOTE !.)) (
+FAIL!-NOT (AND (EVLBLD) (FAIL!-NOT (PUSH (LIST (QUOTE PROGN) (EXTRACT 1) (
+QUOTE T))))))) (OR (AND (EQTOK!-NEXT (QUOTE !=)) (FAIL!-NOT (EVLBLD))) (OR (
+AND (EQTOK!-NEXT (QUOTE !<)) (FAIL!-NOT (AND (ALT) (FAIL!-NOT (AND (
+EQTOK!-NEXT (QUOTE !>)) (FAIL!-NOT (PUSH (LIST (QUOTE PROGN) (EXTRACT 1) (
+QUOTE T))))))))) (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (AND (ALT) (
+FAIL!-NOT (EQTOK!-NEXT (QUOTE !))))))) (OR (AND (EQTOK!-NEXT (QUOTE !+!.)) (
+FAIL!-NOT (AND (EVLBLD) (FAIL!-NOT (PUSH (LIST (QUOTE PUSH) (EXTRACT 1))))))) (
+AND (ID) (FAIL!-NOT (PUSH (LIST (EXTRACT 1)))))))))))))))
+
+(DE UNLBLD NIL (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (AND (UNLBLD) (
+FAIL!-NOT (OR (AND (EQTOK!-NEXT (QUOTE !.)) (FAIL!-NOT (AND (UNLBLD) (
+FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (LIST (QUOTE CONS) (
+EXTRACT 2) (EXTRACT 1))))))))) (OR (AND (PROG (X) (SETQ X (STK!-LENGTH))
+G0110 (COND ((UNLBLD) (GO G0110))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (
+AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (CONS (QUOTE LIST) (CONS (
+EXTRACT 2) (EXTRACT 1)))))))) (AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (
+CONS (QUOTE LIST) (EXTRACT 1))))))))))) (OR (LBLD) (AND (ID) (FAIL!-NOT (
+PUSH (LIST (QUOTE QUOTE) (EXTRACT 1))))))))
+
+(DE EVLBLD NIL (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (AND (EVLBLD) (
+FAIL!-NOT (OR (AND (EQTOK!-NEXT (QUOTE !.)) (FAIL!-NOT (AND (EVLBLD) (
+FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (LIST (QUOTE CONS) (
+EXTRACT 2) (EXTRACT 1))))))))) (OR (AND (PROG (X) (SETQ X (STK!-LENGTH))
+G0111 (COND ((EVLBLD) (GO G0111))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (
+AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (CONS (EXTRACT 2) (EXTRACT
+1))))))) (EQTOK!-NEXT (QUOTE !))))))))) (OR (LBLD) (ID))))
+
+(DE LBLD NIL (OR (AND (EQTOK!-NEXT (QUOTE !#)) (FAIL!-NOT (AND (NUM) (
+FAIL!-NOT (PUSH (LIST (QUOTE EXTRACT) (EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (
+QUOTE !#!#)) (FAIL!-NOT (AND (NUM) (FAIL!-NOT (PUSH (LIST (QUOTE REF) (
+EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (QUOTE !$)) (FAIL!-NOT (AND (NUM) (
+FAIL!-NOT (PUSH (LIST (QUOTE GENLAB) (EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (
+QUOTE !&)) (FAIL!-NOT (AND (NUM) (FAIL!-NOT (PUSH (LIST (QUOTE CADR) (LIST (
+QUOTE ASSOC) (EXTRACT 1) (LIST (QUOTE CAR) (QUOTE VARLIST))))))))) (OR (NUM) (
+OR (STR) (AND (EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (OR (AND (EQTOK!-NEXT (
+QUOTE !()) (FAIL!-NOT (AND (PROG (X) (SETQ X (STK!-LENGTH)) G0112 (COND ((
+UNLBLD) (GO G0112))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (
+EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (CONS (QUOTE LIST) (EXTRACT 1)))))))))
+(AND (ANYTOK) (FAIL!-NOT (PUSH (LIST (QUOTE QUOTE) (EXTRACT 1)))))))))))))))
+
+(DE PRUL NIL (AND (PROGN (SETQ INDEXLIST!* NIL) T) (FAIL!-NOT (AND (PAT) (
+FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !-!>)) (FAIL!-NOT (AND (PROG (X) (SETQ X (
+STK!-LENGTH)) G0113 (COND ((EVLBLD) (GO G0113))) (BUILD!-REPEAT X) (RETURN T)) (
+FAIL!-NOT (AND (PUSH (LIST (QUOTE LAMBDA) (LIST (QUOTE VARLIST) (QUOTE T1) (
+QUOTE T2) (QUOTE T3)) (CONS (QUOTE AND) (EXTRACT 1)))) (FAIL!-NOT (AND (
+PROGN (SETQ PNAM (GENSYM)) T) (FAIL!-NOT (AND (PROGN (RULE!-DEFINE (LIST (
+QUOTE PUTD) (LIST (QUOTE QUOTE) PNAM) (LIST (QUOTE QUOTE) (QUOTE EXPR)) (
+LIST (QUOTE QUOTE) (EXTRACT 1)))) T) (FAIL!-NOT (PUSH (CONS (EXTRACT 1) PNAM))))
+)))))))))))))
+
+(DE PAT NIL (OR (AND (EQTOK!-NEXT (QUOTE !&)) (FAIL!-NOT (OR (AND (
+EQTOK!-NEXT (QUOTE !<)) (FAIL!-NOT (AND (PROG (X) (SETQ X (STK!-LENGTH))
+G0114 (COND ((AND (PSIMP) (EQTOK!-NEXT (QUOTE !/))) (GO G0114))) (
+BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !>)) (
+FAIL!-NOT (AND (NUM) (FAIL!-NOT (PUSH (PROGN (SETQ INDEXLIST!* (CONS (REF
+1) INDEXLIST!*)) (LIST (QUOTE !&) (EXTRACT 2) (EXTRACT 1)))))))))))) (AND (
+NUM) (FAIL!-NOT (PUSH (COND ((MEMQ (REF 1) INDEXLIST!*) (LIST (QUOTE !&) (
+QUOTE !&) (EXTRACT 1))) (T (PROGN (SETQ INDEXLIST!* (CONS (REF 1) INDEXLIST!*))
+(LIST (QUOTE !&) (EXTRACT 1))))))))))) (OR (ID) (OR (AND (EQTOK!-NEXT (QUOTE
+!()) (FAIL!-NOT (AND (PROG (X) (SETQ X (STK!-LENGTH)) G0114 (COND ((PAT) (GO
+G0114))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (PROGN (AND (
+EQTOK!-NEXT (QUOTE !.)) (FAIL!-NOT (AND (PAT) (FAIL!-NOT (PUSH (APPEND (
+EXTRACT 2) (EXTRACT 1))))))) T) (FAIL!-NOT (EQTOK!-NEXT (QUOTE !))))))))) (
+OR (AND (EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (ANYTOK))) (OR (STR) (NUM)))))))
+
+(DE PSIMP NIL (OR (ID) (OR (NUM) (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (
+AND (PROG (X) (SETQ X (STK!-LENGTH)) G0115 (COND ((PSIMP) (GO G0115))) (
+BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (EQTOK!-NEXT (QUOTE !))))))) (AND (
+EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (ANYTOK)))))))
+
+(PUT (QUOTE RUL) (QUOTE KEYS) (QUOTE (!-!> !& !$ !#!# !# !+!. !) !( !> !< !.
+!+ !@!@ !@ !* !] !' ![ !/ FIN != !; !, !: DIP)))
+
+(PUT (QUOTE RUL) (QUOTE DIPS) (QUOTE (!@!@ !+!. !-!> !#!#)))
+
+(PUT (QUOTE RUL) (QUOTE RTS) (QUOTE (!;)))
+
+(PUT (QUOTE RUL) (QUOTE GTS) (QUOTE (FIN)))
+NIL
+NIL
ADDED psl-1983/3-1/util/misc-macros.sl
Index: psl-1983/3-1/util/misc-macros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/misc-macros.sl
@@ -0,0 +1,44 @@
+% MISC-MACROS.SL - assorted useful macros
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+(defmacro funcall u `(apply ,(car u) (list ,@(cdr u))))
+
+(copyd 'call 'funcall)
+
+(defmacro eqfirst (u v) `(eqcar ,u ,v))
+
+(defmacro bldid (s . args) `(intern (bldmsg ,s ,@args)))
+
+(defmacro nary-concat u (expand u 'concat))
+
+(defmacro-no-displace defstub (name . rst)
+% quick, kludgy hack -- should be much better
+ (let ((args (if (pairp rst) (pop rst))))
+ `(de ,name ,args
+ (stub-print ',name ',args (list ,@args))
+ ,@rst
+ (let ((*ContinuableError t)) (break)))))
+
+(de stub-print (name arg-names actual-args)
+ (errorprintf "Stub %w called with arguments:" name)
+ (for (in u arg-names) (in v actual-args)
+ (do (errorprintf " %w: %p%n" u v)))
+ (terpri))
+
+(defmacro circular-list L
+ `(let ((***CIRCULAR-LIST-ARG*** (list ,@L)))
+ (nconc ***CIRCULAR-LIST-ARG*** ***CIRCULAR-LIST-ARG***)))
+
+(defmacro nothing U nil) % Nary no-op returning nil; args not evaluated.
+
+(defmacro make-list (N . rst)
+ `(make-list-1 ,N ,(if (pairp rst) (car rst) nil)))
+
+(de make-list-1 (N init)
+ (for (from i 1 N) (collect init)))
ADDED psl-1983/3-1/util/narith.build
Index: psl-1983/3-1/util/narith.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/narith.build
@@ -0,0 +1,4 @@
+% NARITH.BUILD - Changes built-in arith to include BIGNUM hooks
+%/ Should later install as basic BIGNUM package
+
+in "narith.red"$
ADDED psl-1983/3-1/util/narith.red
Index: psl-1983/3-1/util/narith.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/narith.red
@@ -0,0 +1,406 @@
+%
+% ARITHMETIC.RED - Generic arithmetic routines for PSL
+% New model, much less hairy lap
+
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 9 August 1982
+% Copyright (c) 1982 University of Utah
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Note: Loading BIGFACE is supposed to define (or redefine)
+% the functions:
+% ISINUM
+% StaticIntBig
+% StaticBigFloat
+% Sys2Int
+% Int2Sys
+% FloatFix
+%
+% Mods by MLG, 21 dec 1982
+% Take off INTERNALFUNCTION form FLOATFIX and StaticFloatBig
+% Change IsInum to be a procedure
+% Change names of FAKE and SFL to xxxxLOC
+
+CompileTime << % Some aliases
+ Fluid '(ArithArgLoc StaticFloatLoc);
+ put('ArithArg, 'NewNam, '(LispVar ArithArgLoc));
+ put('StaticFloat, 'NewNam, '(LispVar StaticFloatLoc));
+>>;
+
+LoadTime << % Allocate Physical Space
+ ArithArgLoc := GtWArray 2;
+ StaticFloatLoc := GtWArray 3;
+>>;
+
+on Syslisp;
+
+%internal WArray ArithArg[1], StaticFloat = [1, 0, 0];
+
+CompileTime <<
+
+flag('(Coerce2 FloatPlus2 FloatDifference FloatTimes2
+ FloatQuotient FloatGreaterP FloatLessP IntFloat
+ NonInteger2Error NonNumber1Error
+), 'InternalFunction);
+
+syslsp macro procedure IsInumMac U;
+<< U := second U;
+ if atom U then
+ list('eq, list('SignedField, U, '(ISub1 (WConst InfStartingBit)),
+ '(IAdd1 (WConst InfBitLength))), U)
+ else
+ list('(lambda (X) (eq (SignedField X
+ (ISub1 (WConst InfStartingBit))
+ (IAdd1 (WConst InfBitLength)))
+ X)),
+ U) >>;
+
+expr procedure NameGen Name;
+ Intern Concat(ID2String Name, StringGensym());
+
+macro procedure DefArith2Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen, gen0;
+ U :=rest U;
+ generic := first U;
+ U := rest U;
+ wgen := first U;
+ U := rest U;
+ fgen := first U;
+ U := rest U;
+ bgen := first U;
+ hardgen := NameGen generic;
+ gen0 := NameGen generic;
+ Flag1(hardgen, 'InternalFunction);
+ Flag1(gen0, 'InternalFunction);
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN GEN0),
+ list(generic, wgen, fgen, bgen, hardgen, gen0)),
+ quote <<
+
+expr procedure GENERIC(x,y);
+ if intp x and intp y then GEN0(x, y, WGEN(x, y)) else HARDGEN(x, y);
+
+expr procedure GEN0(x, y, z);
+ if isinum z then z else HARDGEN(x, y);
+
+expr procedure HARDGEN(x, y);
+ case Coerce2(x, y, 'GENERIC) of
+ POSINT:
+ Sys2Int WGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ FLTN:
+ FGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ BIGN:
+ BGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ end;
+
+>>);
+end;
+
+macro procedure DefArithPred2Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen, gen0;
+ U :=rest U;
+ generic := first U;
+ U := rest U;
+ wgen := first U;
+ U := rest U;
+ fgen := first U;
+ U := rest U;
+ bgen := first U;
+ hardgen := NameGen generic;
+ gen0 := NameGen generic;
+ Flag1(hardgen, 'InternalFunction);
+ Flag1(gen0, 'InternalFunction);
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN GEN0),
+ list(generic, wgen, fgen, bgen, hardgen, gen0)),
+ quote <<
+
+expr procedure GENERIC(x,y);
+ if intp x and intp y then WGEN(x, y) else HARDGEN(x, y);
+
+expr procedure HARDGEN(x, y);
+ case Coerce2(x, y, 'GENERIC) of
+ POSINT:
+ WGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ FLTN:
+ FGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ BIGN:
+ BGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ end;
+
+>>);
+end;
+
+macro procedure DefInt2Entry U;
+begin scalar generic, wgen, bgen, hardgen, gen0;
+ U :=rest U;
+ generic := first U;
+ U := rest U;
+ wgen := first U;
+ U := rest U;
+ bgen := first U;
+ hardgen := NameGen generic;
+ gen0 := NameGen generic;
+ Flag1(hardgen, 'InternalFunction);
+ Flag1(gen0, 'InternalFunction);
+ return SublA(Pair('(GENERIC WGEN BGEN HARDGEN GEN0),
+ list(generic, wgen, bgen, hardgen, gen0)),
+ quote <<
+
+expr procedure GENERIC(x,y);
+ if intp x and intp y then GEN0(x, y, WGEN(x, y)) else HARDGEN(x, y);
+
+expr procedure GEN0(x, y, z);
+ if isinum z then z else HARDGEN(x, y);
+
+expr procedure HARDGEN(x, y);
+ case Coerce2(x, y, 'GENERIC) of
+ POSINT:
+ Sys2Int WGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ FLTN:
+ NonInteger2Error(x, y, 'GENERIC);
+ BIGN:
+ BGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ end;
+
+>>);
+end;
+
+macro procedure DefArith1Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen, gen0;
+ U :=rest U;
+ generic := first U;
+ U := rest U;
+ wgen := first U;
+ U := rest U;
+ fgen := first U;
+ U := rest U;
+ bgen := first U;
+ hardgen := NameGen generic;
+ gen0 := NameGen generic;
+ Flag1(hardgen, 'InternalFunction);
+ Flag1(gen0, 'InternalFunction);
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN GEN0),
+ list(generic, wgen, fgen, bgen, hardgen, gen0)),
+ quote <<
+
+expr procedure GENERIC x;
+ if intp x then GEN0(x, WGEN x) else HARDGEN x;
+
+expr procedure GEN0(x, z);
+ if isinum z then z else HARDGEN x;
+
+expr procedure HARDGEN x;
+ case Tag x of
+ NEGINT, POSINT:
+ Sys2Int WGEN x;
+ FIXN:
+ Sys2Int WGEN FixVal FixInf x;
+ FLTN:
+ FGEN x;
+ BIGN:
+ BGEN x;
+ default:
+ NonNumber1Error(x, 'GENERIC);
+ end;
+
+>>);
+end;
+
+macro procedure DefArithPred1Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen, gen0;
+ U :=rest U;
+ generic := first U;
+ U := rest U;
+ wgen := first U;
+ U := rest U;
+ fgen := first U;
+ U := rest U;
+ bgen := first U;
+ hardgen := NameGen generic;
+ gen0 := NameGen generic;
+ Flag1(hardgen, 'InternalFunction);
+ Flag1(gen0, 'InternalFunction);
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN GEN0),
+ list(generic, wgen, fgen, bgen, hardgen, gen0)),
+ quote <<
+
+expr procedure GENERIC x;
+ if intp x then WGEN x else HARDGEN x;
+
+expr procedure HARDGEN x;
+ case Tag x of
+ NEGINT, POSINT:
+ WGEN x;
+ FIXN:
+ WGEN FixVal FixInf x;
+ FLTN:
+ FGEN x;
+ BIGN:
+ BGEN x;
+ default:
+ NIL;
+ end;
+
+>>);
+end;
+
+smacro procedure DefFloatEntry(Name, Prim);
+procedure Name(x, y);
+begin scalar f;
+ f := GtFLTN();
+ Prim(FloatBase f, FloatBase FltInf x,
+ FloatBase FltInf y);
+ return MkFLTN f;
+end;
+
+
+>>;
+
+procedure Coerce2(X, Y, F);
+%
+% Returns type tag of strongest type and sets ArithArg[0] to be coerced X
+% and ArithArg[1] to coerced Y.
+%
+begin scalar T1, T2, P, C;
+ T1 := Tag X;
+ case T1 of
+ NEGINT:
+ T1 := POSINT;
+ FIXN:
+ << T1 := POSINT;
+ X := FixVal FixInf X >>;
+ end;
+ T2 := Tag Y;
+ case T2 of
+ NEGINT:
+ T2 := POSINT;
+ FIXN:
+ << T2 := POSINT;
+ Y := FixVal FixInf Y >>;
+ end;
+ ArithArg[0] := X;
+ ArithArg[1] := Y;
+ if T1 eq T2 then return T1; % no coercion to be done
+ if T1 < T2 then % coerce first arg to second
+ << P := &ArithArg[0]; % P points to first (to be coerced)
+ C := T2; % swap T1 and T2
+ T2 := T1;
+ T1 := C >>
+ else
+ P := &ArithArg[1]; % P points to second
+ if T1 > FLTN then return
+ ContinuableError(99, "Non-numeric argument in arithmetic",
+ list(F, MkQuote X, MkQuote Y));
+ case T1 of
+ FLTN:
+ case T2 of
+ POSINT:
+ @P := StaticIntFloat @P;
+ BIGN:
+ @P := StaticBigFloat @P;
+ end;
+ BIGN:
+ @P := StaticIntBig @P; % @P must be inum
+ end;
+ return T1;
+end;
+
+procedure StaticIntFloat X;
+<< !*WFloat(&StaticFloat[1], X);
+ MkFLTN &StaticFloat[0] >>;
+
+procedure NonInteger2Error(X, Y, F);
+ ContinuableError(99, "Non-integer argument in arithmetic",
+ list(F, MkQuote X, MkQuote Y));
+
+procedure NonNumber1Error(X, F);
+ ContinuableError(99, "Non-numeric argument in arithmetic",
+ list(F, MkQuote X));
+
+
+DefArith2Entry(Plus2, WPlus2, FloatPlus2, BigPlus2);
+
+DefFloatEntry(FloatPlus2, !*FPlus2);
+
+DefArith2Entry(Difference, WDifference, FloatDifference, BigDifference);
+
+DefFloatEntry(FloatDifference, !*FDifference);
+
+DefArith2Entry(Times2, WTimes2, FloatTimes2, BigTimes2);
+
+DefFloatEntry(FloatTimes2, !*FTimes2);
+
+DefArith2Entry(Quotient, WQuotient, FloatQuotient, BigQuotient);
+
+DefFloatEntry(FloatQuotient, !*FQuotient);
+
+DefArithPred2Entry(GreaterP, WGreaterP, FloatGreaterP, BigGreaterP);
+
+procedure FloatGreaterP(X, Y);
+ if !*FGreaterP(FloatBase FltInf X, FloatBase FltInf Y) then T else NIL;
+
+DefArithPred2Entry(LessP, WLessP, FloatLessP, BigLessP);
+
+procedure FloatLessP(X, Y);
+ if !*FLessP(FloatBase FltInf X, FloatBase FltInf Y) then T else NIL;
+
+DefInt2Entry(Remainder, WRemainder, BigRemainder);
+
+DefInt2Entry(LAnd, WAnd, BigLAnd);
+
+DefInt2Entry(LOr, WOr, BigLOr);
+
+DefInt2Entry(LXOr, WXOr, BigLXOr);
+
+DefInt2Entry(LShift, WShift, BigLShift);
+
+PutD('LSH, 'EXPR, cdr GetD 'LShift);
+
+DefArith1Entry(Add1, IAdd1, lambda X; FloatPlus2(X, '1.0), BigAdd1);
+
+DefArith1Entry(Sub1, ISub1, lambda X; FloatDifference(X, '1.0), BigSub1);
+
+DefArith1Entry(Minus, IMinus, lambda X; FloatDifference('0.0, X), BigMinus);
+
+DefArith1Entry(Fix, lambda X; X, FloatFix, lambda X; X);
+
+procedure FloatFix X;
+ Sys2Int !*WFix FloatBase FltInf X;
+
+procedure Float X;
+ case Tag X of
+ POSINT, NEGINT:
+ IntFloat X;
+ FIXN:
+ IntFloat FixVal FixInf X;
+ FLTN:
+ X;
+ BIGN:
+ FloatBigArg X;
+ default:
+ NonNumber1Error(X, 'Float);
+ end;
+
+procedure IntFloat X;
+begin scalar F;
+ F := GtFLTN();
+ !*WFloat(FloatBase F, X);
+ return MkFLTN F;
+end;
+
+DefArithPred1Entry(MinusP, IMinusP, lambda X; FloatLessP(X, '0.0), BigMinusP);
+
+DefArithPred1Entry(ZeroP, IZeroP, lambda X; EQN(X, '0.0), ReturnNil);
+
+DefArithPred1Entry(OneP, IOneP, lambda X; EQN(X, '1.0), ReturnNil);
+
+syslsp procedure ReturnNil U;
+ NIL;
+
+syslsp procedure IsInum U;
+ IsInumMac U;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/util/nbarith.build
Index: psl-1983/3-1/util/nbarith.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/nbarith.build
@@ -0,0 +1,4 @@
+% NARITH.BUILD - Changes built-in arith to include BIGNUM hooks
+%/ Should later install as basic BIGNUM package
+
+in "nbarith.red"$
ADDED psl-1983/3-1/util/nbarith.red
Index: psl-1983/3-1/util/nbarith.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/nbarith.red
@@ -0,0 +1,369 @@
+% NBARITH.RED - Generic arithmetic routines for PSL
+% New model, much less hairy lap
+
+% Author: Eric Benson and Martin Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 9 August 1982
+% Copyright (c) 1982 University of Utah
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% The MODEL:
+% It is assumed that there is a range of INUMs (subset) called
+% BETAnums that can be safely operated on by the Wxxx or Ixxx routines
+% without loss of precesion or overflow, and return an INUM (or at least
+% a SYSINT.
+%
+% A UNARY operation (UN x) is done as:
+% Procedure UN x;
+% If BetaP x then <<x:=WUN x; if IntRangeP x then x else Sys2Int x>>
+% else UN!-HARD(x);
+
+% A UNARY predicate (UNP x) is done as:
+% Procedure UNP x;
+% If BetaP x then WUNP x
+% else UNP!-HARD(x);
+
+
+% A BINARY operation (BIN x y) is done as:
+% Procedure BIN(x,y);
+% If BetaP x and BetaP y
+% then <<x:=WBIN(x,y);
+% if IntRangeP x then x else Sys2Int x>>
+% else BIN!-HARD(x,y);
+
+% A BINARY predicate (BINP x y) is done as:
+% Procedure BINP(x,y);
+% If BetaP x and BetaP y then WBINP(x,y)
+% else BINP!-HARD(x,y);
+
+% IN some "safe" cases, BetaP can become IntP (beware of *)
+% In others, BetaP(y) may be too weak (eg, Lshift and Expt)
+
+% Note: Loading NBIG0 is supposed to define (or redefine)
+% the functions:
+% BetaP
+% Beta2P
+% BetaRangeP
+% Sys2Big
+% FloatFromBignum
+% Sys2Int
+% FloatFix
+% Removed IsInum and INTP in favor of BetaP
+%
+% Mods by MLG, 21 dec 1982
+% Take off INTERNALFUNCTION form FLOATxxx
+% Change names of FAKE and SFL to xxxxLOC
+
+CompileTime << % Some aliases
+ Fluid '(ArithArgLoc StaticFloatLoc);
+ put('ArithArg, 'NewNam, '(LispVar ArithArgLoc));
+ put('StaticFloat, 'NewNam, '(LispVar StaticFloatLoc));
+>>;
+
+LoadTime << % Allocate Physical Space
+ ArithArgLoc := GtWArray 2;
+ StaticFloatLoc := GtWArray 3;
+>>;
+
+expr procedure BetaP x;
+% Test tagged number is in Beta Range when BIGNUM loaded
+% Will redefine if NBIG loaded
+ IntP x;
+
+expr procedure BetaRangeP w;
+% Test Word is in Beta Range when BIGNUM loaded
+% Ie, is FIXNUM size with no NBIG
+% Will redefine if NBIG loaded
+ 'T;
+
+expr procedure Beta2P(x,y);
+% Test if BOTH in Beta range
+% Will be redefined if NBIG loaded
+ if IntP x then Intp y else NIL;
+
+expr procedure Sys2Big W;
+% Out of safe range, convert to BIGN
+ ContinuableError(99, "Sys2Big cant convert Word to BIGNUM, no BIGNUM's loaded",
+ Sys2Int W);
+
+on Syslisp;
+
+CompileTime <<
+
+%flag('(Coerce2 FloatPlus2 FloatDifference FloatTimes2
+% FloatQuotient FloatGreaterP FloatLessP IntFloat
+% NonInteger2Error NonNumber1Error NonNumber2Error
+%), 'NotYetInternalFunction);
+
+expr procedure NameGen(Name,Part);
+% Generate Nice specific name from Generic name
+ Intern Concat(ID2String Name,ID2String Part);
+
+smacro procedure NextArg();
+% Just substitute in the context of U
+ <<U:=cdr U; car U>>;
+
+smacro procedure Prologue();
+% Common Prologue
+<< generic := NextArg();
+ wgen := NextArg();
+ fgen := NextArg();
+ bgen := NextArg();
+ hardgen := NameGen(generic,'!-Hardcase);
+ Flag1(hardgen, 'NotYetInternalFunction);
+>>;
+
+macro procedure DefArith2Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen;
+ Prologue();
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN),
+ list(generic, wgen, fgen, bgen, hardgen)),
+ quote <<
+
+expr procedure GENERIC(x,y);
+ if Beta2P(x,y) then <<x:=WGEN(x,y);
+ If IntP x then x else Sys2Int x>>
+ else HARDGEN(x, y);
+
+expr procedure HARDGEN(x, y);
+ case Coerce2(x, y, 'GENERIC) of
+ POSINT: Sys2Int WGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ %/ Beware of Overflow, WGEN maybe should test args
+ %/ Coerce2 is supposed to check this case
+ FLTN: FGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ BIGN: BGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ end;
+
+>>);
+end;
+
+macro procedure DefArithPred2Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen;
+ Prologue();
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN),
+ list(generic, wgen, fgen, bgen, hardgen)),
+ quote <<
+
+expr procedure GENERIC(x,y);
+ if Beta2P(x,y) then WGEN(x, y) else HARDGEN(x, y);
+
+expr procedure HARDGEN(x, y);
+ case Coerce2(x, y, 'GENERIC) of
+ POSINT: WGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+%/ Assumes Preds are safe against Overflow
+ FLTN: FGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ BIGN: BGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ end;
+
+>>);
+end;
+
+macro procedure DefInt2Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen;
+ Prologue();
+ return SublA(Pair('(GENERIC WGEN BGEN HARDGEN),
+ list(generic, wgen, bgen, hardgen)),
+ quote <<
+
+expr procedure GENERIC(x,y);
+ if Beta2P(x,y) then <<x:=WGEN(x, y);
+ if IntP x then x else Sys2Int x>>
+ else HARDGEN(x, y);
+
+expr procedure HARDGEN(x, y);
+ case Coerce2(x, y, 'GENERIC) of
+ POSINT: Sys2Int WGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ FLTN: NonInteger2Error(x, y, 'GENERIC);
+ BIGN: BGEN(WGetV(ArithArg, 0), WGetV(ArithArg, 1));
+ end;
+
+>>);
+end;
+
+macro procedure DefArith1Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen;
+ Prologue();
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN),
+ list(generic, wgen, fgen, bgen, hardgen)),
+ quote <<
+
+expr procedure GENERIC x;
+ if BetaP x then <<x:=WGEN x;
+ if IntP x then x else Sys2Int x>>
+ else HARDGEN x;
+
+expr procedure HARDGEN x;
+ case Coerce1(x,'GENERIC) of
+ POSINT: Sys2Int WGEN WGetv(ArithArg,0);
+ FLTN: FGEN WGetv(ArithArg,0);
+ BIGN: BGEN WGetv(ArithArg,0);
+ default: NonNumber1Error(x,'GENERIC);
+ end;
+
+>>);
+end;
+
+macro procedure DefArithPred1Entry U;
+begin scalar generic, wgen, fgen, bgen, hardgen;
+ Prologue();
+ return SublA(Pair('(GENERIC WGEN FGEN BGEN HARDGEN),
+ list(generic, wgen, fgen, bgen, hardgen)),
+ quote <<
+
+expr procedure GENERIC x;
+ if BetaP x then WGEN x else HARDGEN x;
+
+expr procedure HARDGEN x;
+ case Coerce1(x,'GENERIC) of
+ POSINT: WGEN Wgetv(ArithArg,0);
+ FLTN: FGEN Wgetv(ArithArg,0);
+ BIGN: BGEN Wgetv(ArithArg,0);
+ default: NIL;
+ end;
+
+>>);
+end;
+
+smacro procedure DefFloatEntry(Name, Prim);
+procedure Name(x, y);
+begin scalar f;
+ f := GtFLTN();
+ Prim(FloatBase f, FloatBase FltInf x,
+ FloatBase FltInf y);
+ return MkFLTN f;
+end;
+
+>>;
+
+% The support procedures for coercing types
+
+procedure Coerce1(X, F);
+% Returns type tag of coerced X type and sets ArithArg[0] to be coerced X
+% Beware of ADD1/SUB1 cases, maybe can optimize later
+begin scalar T1;
+ T1 := Tag X;
+ case T1 of
+ NEGINT: T1 := POSINT;
+ FIXN: << T1 := POSINT; X := FixVal FixInf X >>;
+ end;
+ If T1=POSINT and not BetaRangeP(x) then <<T1:=BIGN; x:=Sys2Big x>>;
+ WPutv(ArithArg,0,X);
+ return T1;
+end;
+
+procedure Coerce2(X, Y, F);
+% Returns type tag of strongest type and sets ArithArg[0] to be coerced X
+% and ArithArg[1] to coerced Y.
+begin scalar T1, T2, P, C;
+ T1 := Tag X;
+ case T1 of
+ NEGINT: T1 := POSINT;
+ FIXN: << T1 := POSINT; X := FixVal FixInf X >>;
+ end;
+ If T1=POSINT and not BetaRangeP(x) then <<T1:=BIGN; x:=Sys2Big x>>;
+ T2 := Tag Y;
+ case T2 of
+ NEGINT: T2 := POSINT;
+ FIXN: << T2 := POSINT; Y := FixVal FixInf Y >>;
+ end;
+ If T2=POSINT and not BetaRangeP(Y) then <<T2:=BIGN; y:=Sys2Big y>>;
+ ArithArg[0] := X;
+ ArithArg[1] := Y;
+ if T1 eq T2 then return T1; % no coercion to be done
+ if T1 < T2 then % coerce first arg to second
+ << P := &ArithArg[0]; % P points to first (to be coerced)
+ C := T2; % swap T1 and T2
+ T2 := T1;
+ T1 := C >>
+ else
+ P := &ArithArg[1]; % P points to second
+ if T1 > FLTN then return NonNumber2Error(X,Y,F);
+ % Here, since no 2 arg Arith Preds that accept 1 number, one not
+ case T1 of
+ FLTN: case T2 of
+ POSINT: @P := StaticIntFloat @P;
+ BIGN: @P := FloatFromBignum @P;
+ end;
+ BIGN: @P := Sys2Big @P; % @P must be SYSint
+ end;
+ return T1;
+end;
+
+procedure StaticIntFloat X;
+<< !*WFloat(&StaticFloat[1], X);
+ MkFLTN &StaticFloat[0] >>;
+
+procedure NonInteger2Error(X, Y, F);
+ ContinuableError(99, "Non-integer argument in arithmetic",
+ list(F, MkQuote X, MkQuote Y));
+
+procedure NonNumber1Error(X, F);
+ ContinuableError(99, "Non-numeric argument in arithmetic",
+ list(F, MkQuote X));
+
+procedure NonNumber2Error(X, Y, F);
+ ContinuableError(99, "Non-numeric argument in arithmetic",
+ list(F, MkQuote X,Mkquote Y));
+
+
+% Now generate the entries for each operator
+
+DefArith2Entry(Plus2, WPlus2, FloatPlus2, BigPlus2);
+DefFloatEntry(FloatPlus2, !*FPlus2);
+DefArith2Entry(Difference, WDifference, FloatDifference, BigDifference);
+DefFloatEntry(FloatDifference, !*FDifference);
+DefArith2Entry(Times2, WTimes2, FloatTimes2, BigTimes2);
+ % Beware of Overflow
+DefFloatEntry(FloatTimes2, !*FTimes2);
+DefArith2Entry(Quotient, WQuotient, FloatQuotient, BigQuotient);
+ DefFloatEntry(FloatQuotient, !*FQuotient);
+DefArithPred2Entry(GreaterP, WGreaterP, FloatGreaterP, BigGreaterP);
+ procedure FloatGreaterP(X, Y);
+ if !*FGreaterP(FloatBase FltInf X, FloatBase FltInf Y)
+ then T else NIL;
+DefArithPred2Entry(LessP, WLessP, FloatLessP, BigLessP);
+ procedure FloatLessP(X, Y);
+ if !*FLessP(FloatBase FltInf X, FloatBase FltInf Y) then T else NIL;
+ procedure Fdummy(x,y);
+ StdError "Fdummy should never be called";
+DefInt2Entry(Remainder, WRemainder, Fdummy, BigRemainder);
+DefInt2Entry(LAnd, WAnd, Fdummy, BigLAnd);
+DefInt2Entry(LOr, WOr, Fdummy, BigLOr);
+DefInt2Entry(LXOr, WXOr, Fdummy, BigLXOr);
+% Cant DO Lshift in terms of BETA sized shifts
+% Will toatlly redefine in BIG package
+DefInt2Entry(LShift, WShift, BigLShift);
+ PutD('LSH, 'EXPR, cdr GetD 'LShift);
+DefArith1Entry(Add1, IAdd1, lambda X; FloatPlus2(X, '1.0), BigAdd1);
+DefArith1Entry(Sub1, ISub1, lambda X; FloatDifference(X, '1.0), BigSub1);
+DefArith1Entry(Minus, IMinus, lambda X; FloatDifference('0.0, X), BigMinus);
+DefArith1Entry(Fix, lambda X; X, FloatFix, lambda X; X);
+ procedure FloatFix X;
+ Sys2Int !*WFix FloatBase FltInf X;
+
+ procedure Float X;
+ case Tag X of
+ POSINT, NEGINT: IntFloat X;
+ FIXN: IntFloat FixVal FixInf X;
+ FLTN: X;
+ BIGN: FloatFromBigNum X;
+ default: NonNumber1Error(X, 'Float);
+ end;
+
+ procedure IntFloat X;
+ begin scalar F;
+ F := GtFLTN();
+ !*WFloat(FloatBase F, X);
+ return MkFLTN F;
+ end;
+
+DefArithPred1Entry(MinusP, IMinusP, lambda X; FloatLessP(X, '0.0), BigMinusP);
+DefArithPred1Entry(ZeroP, IZeroP, lambda X; EQN(X, '0.0), ReturnNil);
+DefArithPred1Entry(OneP, IOneP, lambda X; EQN(X, '1.0), ReturnNil);
+ syslsp procedure ReturnNil U;
+ NIL;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/util/nbig0.build
Index: psl-1983/3-1/util/nbig0.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/nbig0.build
@@ -0,0 +1,36 @@
+% NBIG0.BUILD - MLG, move BUILD info, add MC68000 case
+
+Compiletime<<load syslisp;
+ Load Fast!-Vector;
+ load inum;
+ load if!-system>>;
+
+in "nbig0.red"$
+
+% Now install the important globals for this machine
+
+if_system(VAX,
+ <<
+ BigFloatHi!*:=btimes2(bdifference(btwopower 67, btwopower 11),
+ btwopower 60);% Largest representable float.
+ BigFloatLow!*:=BMinus BigFloatHi!*>>);
+
+if_system(MC68000,
+ <<Setbits 30$ %/ Some BUG?
+ % HP9836 sizes, range 10^-308 .. 10 ^308
+ % i GUESS:
+ % 10^308 = 2 ^1025
+ % 15.8 digits, IEEE double ~56 bits
+ BigFloatHi!*:=btimes2(BSUB1 BTWOPOWER 56,
+ btwopower 961);% Largest representable float.
+ BigFloatLow!*:=BMinus BigFloatHi!*>>);
+
+if_system(PDP10,
+ <<
+ BigFloatHi!*:=btimes2(bsub1 btwopower 62, btwopower 65);
+ BigFloatLow!*:=BMinus BigFloatHi!*>>);
+
+ FloatSysHi!* := Float SysHi!*;
+ FloatSysLow!* := Float SysLow!*;
+
+END;
ADDED psl-1983/3-1/util/nbig0.red
Index: psl-1983/3-1/util/nbig0.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/nbig0.red
@@ -0,0 +1,1128 @@
+% NBIG0.RED - Vector based BIGNUM package with INUM operations
+% M. L. Griss & B Morrison, 25 June 1982.
+% Copyright (C) 1982, A. C. Norman, B. Morrison, M. Griss
+%
+% Revision log:
+% 10 March, 1983, MLG
+% LSH in Twopower replaced by 2**n
+% Fixed a bug in SYS2BIG that did not convert negative BIGNUMS correctly
+% 7 February 1983, MLG
+% Merged in NBIG1 (see its "revision history" below), plus clean-up.
+% Revision History of old NBIG1:
+% 28 Dec 1982, MLG:
+% Added BigZeroP and BigOneP for NArith
+% Changed Name to NBIG1.RED from BIGFACE
+% 22 Dec 1982, MLG:
+% Change way of converting from VECT to BIGN
+% Move Module dependency to .BUILD file
+% Changes for NEW-ARITH, involve name changes for MAKEFIXNUM
+% ISINUM, etc.
+% 21 December, 82: MLG
+% Change PRIN1 and PRIN2 hooks to refer to RecursiveChannelprinx
+% which changed in PK:PRINTERS.RED for prinlevel stuff
+% November: Variety of Bug Fixes by A. Norman
+% Use the BIGN tag for better Interface
+%
+% 31 Dec 1982, MLG
+% Changed BNUM to check if arg ALREADY Big. Kludge
+% since new NARITH makes some things BIG earlier
+% since it calls the BIG funcs directly
+% 20 Dec 1982, MLG
+% Changed TrimBigNUM to TrimBigNum1 in BhardDivide
+%
+% 14 Dec 1982, MLG
+% Changed to put LOAD and IMPORTS in BUILD file
+%
+% 31 August 1982, A. C . Norman
+% Adjustments to many routines: in particular corrections to BHardDivide
+% (case D6 utterly wrong), and adjustments to BExpt (for performance) and
+% all logical operators (for treatment of negative inputs);
+% ---------------------------------------------------------------
+
+% -----------------------
+% A bignum will be a VECTOR of Bigits: (digits in base BigBase):
+% [BIGPOS b1 ... bn] or [BIGNEG b1 ... bn]. BigZero is thus [BIGPOS]
+% All numbers are positive, with BIGNEG as 0 element to indicate negatives.
+
+% BETA.RED - some values of BETA testing
+% On DEC-20, Important Ranges are:
+% --------------------------------
+% POSBETA | 0 | n |
+% --------------------------------
+% 19 17 bits
+% --------------------------------
+% NEGBETA | -1 | |
+% --------------------------------
+%
+% --------------------------------
+% POSINT | 0 | 0 | |
+% --------------------------------
+% 5 13 18 bits
+% --------------------------------
+% NEGINT | -1 | -1 | |
+% --------------------------------
+% Thus BETA: 2^17-1 -131072 ... 131071
+% INT 2^18-1 -262144 ... 262143
+% FIX 2^35-1 -34359738368 ... 34359738367
+% [Note that one bit used for sign in 36 bit word]
+
+fluid '(BigBetaHi!* % Largest BetaNum in BIG format
+ BigBetaLow!* % Smallest BetaNum in BIG format
+ BetaHi!* % Largest BetaNum as Inum
+ BetaLow!* % Smallest BetaNum as Inum
+ SysHi!* % Largest SYSINT in FixN format
+ SysLow!* % Smallest SYSINT in FixN format
+ BigSysHi!* % Largest SYSINT in BIG format
+ BigSysLow!* % Smallest SYSINT in BIG format
+ FloatSysHi!* % Largest SYSINT in Float format
+ FloatSysLow!* % Smallest SYSINT in Float format
+ BBase!* % BETA, base of system
+ FloatBbase!* % As a float
+ BigFloatHi!* % Largest Float in BIG format
+ BigFloatLow!* % Smallest Float in BIG format
+ StaticBig!* % Warray for conversion of SYS to BIG
+ Bone!* % A one
+ Bzero!* % A zero
+ BBits!* % Number of Bits in BBASE!*
+ LogicalBits!*
+ Digit2Letter!*
+ Carry!*
+ OutputBase!*
+);
+
+% --------------------------------------------------------------------------
+% --------------------------------------------------------------------------
+% Support functions:
+%
+% U, V, V1, V2 for arguments are Bignums. Other arguments are usually
+% fix/i-nums.
+
+smacro procedure PutBig(b,i,val);
+% Access elements of a BIGNUM
+ IputV(b,i,val);
+
+smacro procedure GetBig(b,i);
+% Access elements of a BIGNUM
+ IgetV(B,i);
+
+procedure setbits x;
+%
+% This function sets the globals for big bignum package.
+% "x" should be total # of bits per word.
+Begin scalar y;
+ BBits!*:=iquotient(isub1 x,2); % Total number of bits per word used.
+ BBase!*:=TwoPower BBits!*; % "Beta", where n=A0 + A1*beta + A2*(beta^2).
+ FloatBbase!* := IntFloat Bbase!*;
+ LogicalBits!*:=ISub1 BBase!*; % Used in LAnd,Lor, etc.
+ BetaHi!*:=isub1 Bbase!*;
+ BetaLow!* :=Iminus Bbase!*;
+ Bone!* := Bnum 1;
+ Bzero!* := Bnum 0;
+ BigBetaHi!*:=BNum BetaHi!*; % Highest value of Ai
+ BigBetaLow!*:=BMinus BigBetaHi!*; % Lowest value of Ai
+ % here assume 2's complement
+
+ y:=TwoPower idifference (x,2); % eg, 36 bits, 2^35-1=2^34+2^34-1
+ SysHi!* :=y+(y-1);
+ y:=-y;
+ Syslow!* :=y+y;
+ BigSysHi!*:=bdifference(btwopower isub1 x,
+ Bone!*); % Largest representable Syslisp integer.
+ % Note that SYSPOS has leading 0, ie only x-1 active bits
+ BigSysLow!*:=BMinus BPlus2(Bone!*, BigSysHi!*);
+ % Smallest representable Syslisp integer.
+end;
+
+procedure NonBigNumError(V,L);
+ StdError BldMsg(" Expect a BIGNUM in %r, given %p%n",L,V);
+
+procedure BSize V;
+% Upper Limit of [BIGxxx a1 ... An]
+ If BigP V then VecLen VecInf V else 0;
+
+procedure GtPOS N;
+% Allocate [BIGPOS a1 ... an]
+ Begin
+ N:=MkVect N;
+ IPutV(N,0,'BIGPOS);
+ Return MkBigN Vecinf N;
+ End;
+
+procedure GtNeg N;
+% Allocate [BIGNEG a1 ... an]
+ Begin
+ N:=MkVect N;
+ IPutV(N,0,'BIGNEG);
+ Return MkBigN VecInf N;
+ End;
+
+procedure TrimBigNum V3;
+% truncate trailing 0
+ If Not BigP V3 then NonBigNumError(V3,'TrimBigNum)
+ else TrimBigNum1(V3,BSize V3);
+
+procedure TrimBigNum1(B,L3);
+ Begin scalar v3;
+ V3:=BigAsVec B;
+ While IGreaterP(L3,0) and IZeroP IGetV(V3,L3) do L3:=ISub1 L3;
+ If IZerop UpBv TruncateVector(V3,L3) then return GtPOS 0
+ else return B;
+ end;
+
+procedure BigAsVec B;
+% In order to see BIGITS
+ MkVec Inf B;
+
+procedure VecAsBig V;
+ MkBigN VecInf V;
+
+Procedure BIG2Sys U;
+% Convert a BIG to SYS, if in range
+ If Blessp(U,BigSysLow!*) or Bgreaterp(U,BigSysHi!*) then
+ ContinuableError(99,"BIGNUM too large to convert to SYS", U)
+ else Big2SysAux U;
+
+procedure Big2SysAux U;
+% Convert a BIGN that is in range to a SYSINT
+ begin scalar L,Sn,res;
+ L:=BSize U;
+ if IZeroP L then return 0;
+ res:=IGetV(U,L);
+ L:=ISub1 L;
+ If BMinusP U then
+ <<res:=-res;
+ while L neq 0 do <<res:=ITimes2(res, Bbase!*);
+ res:=IDifference(res, IGetV(U,L));
+ L:=ISub1 L>>;
+ >>
+ else
+ while L neq 0 do <<res:=ITimes2(res, Bbase!*);
+ res:=IPlus2(res, IGetV(U,L));
+ L:=ISub1 L>>;
+ return Res;
+ end;
+
+procedure TwoPower N; %fix/i-num 2**n
+ 2**n;
+
+procedure BTwoPower N; % gives 2**n; n is fix/i-num; result BigNum
+ if not (fixp N or BigP N) then NonIntegerError(N, 'BTwoPower)
+ else begin scalar quot, rem, V;
+ if BigP N then n:=big2sys n;
+ quot:=Quotient(N,Bbits!*);
+ rem:=Remainder(N,Bbits!*);
+ V:=GtPOS(IAdd1 quot);
+ IFor i:=1:quot do IPutV(v,i,0);
+ IPutV(V,IAdd1 quot,twopower rem);
+ return TrimBigNum1(V,IAdd1 quot);
+ end;
+
+procedure BZeroP V1;
+ IZerop BSize V1 and not BMinusP V1;
+
+procedure BOneP V1;
+ Not BMinusP V1 and IOneP (BSize V1) and IOneP IGetV(V1,1);
+
+procedure BAbs V1;
+ if BMinusP V1 then BMinus V1 else V1;
+
+procedure BMax(V1,V2);
+ if BGreaterP(V2,V1) then V2 else V1;
+
+procedure BMin(V1,V2);
+ if BLessP(V2,V1) then V2 else V1;
+
+procedure BExpt(V1,N);
+% V1 is Bignum, N is fix/i-num
+ if not fixp N then NonIntegerError(N,'BEXPT)
+ else if IZeroP N then Bone!*
+ else if IOneP N then V1
+ else if IMinusP N then BQuotient(Bone!*,BExpt(V1,IMinus N))
+ else begin scalar V2;
+ V2 := BExpt(V1,IQuotient(N,2));
+ if IZeroP IRemainder(N,2) then return BTimes2(V2,V2)
+ else return BTimes2(BTimes2(V2,V1),V2)
+ end;
+
+
+% ---------------------------------------
+% Logical Operations
+%
+% All take Bignum arguments
+
+
+procedure BLOr(V1,V2);
+% The main body of the OR code is only obeyed when both arguments
+% are positive, and so the result will be positive;
+ if BMinusp V1 or BMinusp V2 then BLnot BLand(BLnot V1,BLnot V2)
+ else begin scalar L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ IF L2>L1 then <<L3:=L2; L2:=L1;L1:=L3;
+ V3:=V2; V2:=V1;V1:=V3>>;
+ V3:=GtPOS L1;
+ IFor I:=1:L2 do IPutV(V3,I,ILor(IGetV(V1,I),IGetV(V2,I)));
+ IFor I:=(IAdd1 L2):L1 do IPutV(V3,i,IGetV(V1,I));
+ Return V3
+ end;
+
+procedure BLXor(V1,V2);
+% negative arguments are coped with using the identity
+% LXor(a,b) = LNot LXor(Lnot a,b) = LNor LXor(a,Lnot b);
+ begin scalar L1,L2,L3,V3,S;
+ if BMinusp V1 then << V1 := BLnot V1; S := t >>;
+ if BMinusp V2 then << V2 := BLnot V2; S := not S >>;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ IF L2>L1 then <<L3:=L2; L2:=L1;L1:=L3;
+ V3:=V2; V2:=V1;V1:=V3>>;
+ V3:=GtPOS L1;
+ IFor I:=1:L2 do IPutV(V3,I,ILXor(IGetV(V1,I),IGetV(V2,I)));
+ IFor I:=(IAdd1 L2):L1 do IPutV(V3,i,IGetV(V1,I));
+ V1:=TrimBigNum1(V3,L1);
+ if S then V1:=BLnot V1;
+ return V1
+ end;
+
+% Not Used Currently:
+%
+% procedure BLDiff(V1,V2);
+% ***** STILL NEEDS ADJUSTING WRT -VE ARGS *****
+% begin scalar V3,L1,L2;
+% L1:=BSize V1;
+% L2:=BSize V2;
+% V3:=GtPOS(max(L1,L2));
+% IFor i:=1:min(L1,L2) do
+% IPutV(V3,i,ILAnd(IGetV(V1,i),ILXor(LogicalBits!*,IGetV(V2,i))));
+% if IGreaterP(L1,L2) then IFor i:=(IAdd1 L2):L1 do IPutV(V3,i,IGetV(V1,i));
+% if IGreaterP(L2,L1) then IFor i:=(IAdd1 L1):L2 do IPutV(V3,i,0);
+% return TrimBigNum1(V3,max(L1,L2));
+% end;
+
+procedure BLAnd(V1,V2);
+% If both args are -ve the result will be too. Otherwise result will
+% be positive;
+ if BMinusp V1 and BMinusp V2 then BLnot BLor(BLnot V1,BLnot v2)
+ else begin scalar L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ L3:=Min(L1,L2);
+ V3:=GtPOS L3;
+ if BMinusp V1 then
+ IFor I:=1:L3 do IPutV(V3,I,ILand(ILXor(Logicalbits!*,IGetV(V1,I)),
+ IGetV(V2,I)))
+ else if BMinusp V2 then
+ IFor I:=1:L3 do IPutV(V3,I,ILand(IGetV(V1,I),
+ ILXor(Logicalbits!*,IGetV(V2,I))))
+ else IFor I:=1:L3 do IPutV(V3,I,ILand(IGetV(V1,I),IGetV(V2,I)));
+ return TrimBigNum1(V3,L3);
+ End;
+
+procedure BLNot(V1);
+ BMinus BSmallAdd(V1,1);
+
+procedure BLShift(V1,V2);
+% This seems a grimly inefficient way of doing things given that
+% the representation of big numbers uses a base that is a power of 2.
+% However it will do for now;
+if BMinusP V2 then BQuotient(V1, BTwoPower BMinus V2)
+ else BTimes2(V1, BTwoPower V2);
+
+
+
+% -----------------------------------------
+% Arithmetic Functions:
+%
+% U, V, V1, V2 are Bignum arguments.
+
+procedure BMinus V1; % Negates V1.
+ if BZeroP V1 then V1
+ else begin scalar L1,V2;
+ L1:=BSize V1;
+ if BMinusP V1 then V2 := GtPOS L1
+ else V2 := GtNEG L1;
+ IFor I:=1:L1 do IPutV(V2,I,IGetV(V1,I));
+ return V2;
+ end;
+
+% Returns V1 if V1 is strictly less than 0, NIL otherwise.
+%
+procedure BMinusP V1;
+ if (IGetV(V1,0) eq 'BIGNEG) then V1 else NIL;
+
+% To provide a conveninent ADD with CARRY.
+procedure AddCarry A;
+ begin scalar S;
+ S:=IPlus2(A,Carry!*);
+ if IGeq(S,BBase!*) then <<Carry!*:= 1; S:=IDifference(S,BBase!*)>>
+ else Carry!*:=0;
+ return S;
+ end;
+
+procedure BPlus2(V1,V2);
+ begin scalar Sn1,Sn2;
+ Sn1:=BMinusP V1;
+ Sn2:=BMinusP V2;
+ if Sn1 and Not Sn2 then return BDifference2(V2,BMinus V1,Nil);
+ if Sn2 and Not Sn1 then return BDifference2(V1,BMinus V2,Nil);
+ return BPlusA2(V1,V2,Sn1);
+ end;
+
+procedure BPlusA2(V1,V2,Sn1); % Plus with signs pre-checked and
+ begin scalar L1,L2,L3,V3,temp; % identical.
+ L1:=BSize V1;
+ L2:=BSize V2;
+ If IGreaterP(L2,L1) then <<L3:=L2; L2:=L1;L1:=L3;
+ V3:=V2; V2:=V1;V1:=V3>>;
+ L3:=IAdd1 L1;
+ If Sn1 then V3:=GtNeg L3
+ else V3:=GtPOS L3;
+ Carry!*:=0;
+ IFor I:=1:L2 do <<temp:=IPlus2(IGetV(V1,I),IGetV(V2,I));
+ IPutV(V3,I,AddCarry temp)>>;
+ temp:=IAdd1 L2;
+ IFor I:=temp:L1 do IPutV(V3,I,AddCarry IGetV(V1,I));
+ IPutV(V3,L3,Carry!*); % Carry Out
+ Return TrimBigNum1(V3,L3);
+ end;
+
+procedure BDifference(V1,V2);
+ if BZeroP V2 then V1
+ else if BZeroP V1 then BMinus V2
+ else begin scalar Sn1,Sn2;
+ Sn1:=BMinusP V1;
+ Sn2:=BMinusP V2;
+ if (Sn1 and Not Sn2) or (Sn2 and Not Sn1)
+ then return BPlusA2(V1,BMinus V2,Sn1);
+ return BDifference2(V1,V2,Sn1);
+ end;
+
+procedure SubCarry A;
+ begin scalar S;
+ S:=IDifference(A,Carry!*);
+ if ILessP(S,0) then <<Carry!*:=1; S:=IPlus2(BBase!*,S)>> else Carry!*:=0;
+ return S;
+ end;
+
+Procedure BDifference2(V1,V2,Sn1); % Signs pre-checked and identical.
+ begin scalar i,L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ if IGreaterP(L2,L1) then <<L3:=L1;L1:=L2;L2:=L3;
+ V3:=V1;V1:=V2;V2:=V3; Sn1:=not Sn1>>
+ else if L1 Eq L2 then <<i:=L1;
+ while (IGetV(V2,i) Eq IGetV(V1,i) and IGreaterP(i,1))
+ do i:=ISub1 i;
+ if IGreaterP(IGetV(V2,i),IGetV(V1,i))
+ then <<L3:=L1;L1:=L2;L2:=L3;
+ V3:=V1;V1:=V2;V2:=V3;Sn1:=not Sn1>> >>;
+ if Sn1 then V3:=GtNEG L1
+ else V3:=GtPOS L1;
+ carry!*:=0;
+ IFor I:=1:L2 do IPutV(V3,I,SubCarry IDifference(IGetV(V1,I),IGetV(V2,I)));
+ IFor I:=(IAdd1 L2):L1 do IPutV(V3,I,SubCarry IGetV(V1,I));
+ return TrimBigNum1(V3,L1);
+ end;
+
+procedure BTimes2(V1,V2);
+ begin scalar L1,L2,L3,Sn1,Sn2,V3;
+ L1:=BSize V1;
+ L2:=BSize V2;
+ if IGreaterP(L2,L1)
+ then <<V3:=V1; V1:=V2; V2:=V3; % If V1 is larger, will be fewer
+ L3:=L1; L1:=L2; L2:=L3>>; % iterations of BDigitTimes2.
+ L3:=IPlus2(L1,L2);
+ Sn1:=BMinusP V1;
+ Sn2:=BMinusP V2;
+ If (Sn1 and Sn2) or not(Sn1 or Sn2) then V3:=GtPOS L3 else V3:=GtNEG L3;
+ IFor I:=1:L3 do IPutV(V3,I,0);
+ IFor I:=1:L2 do BDigitTimes2(V1,IGetV(V2,I),L1,I,V3);
+ return TrimBigNum1(V3,L3);
+ end;
+
+Procedure BDigitTimes2(V1,V2,L1,I,V3);
+% V1 is a bignum, V2 a fixnum, L1=BSize L1, I=position of V2 in a bignum,
+% and V3 is bignum receiving result. I affects where in V3 the result of
+% a calculation goes; the relationship is that positions I:I+(L1-1)
+% of V3 receive the products of V2 and positions 1:L1 of V1.
+% V3 is changed as a side effect here.
+ begin scalar J,carry,temp1,temp2;
+ if zerop V2 then return V3
+ else <<
+ carry:=0;
+ IFor H:=1:L1 do <<
+ temp1:=ITimes2(IGetV(V1,H),V2);
+ temp2:=IPlus2(H,ISub1 I);
+ J:=IPlus2(IPlus2(temp1,IGetV(V3,temp2)),carry);
+ IPutV(V3,temp2,IRemainder(J,BBase!*));
+ carry:=IQuotient(J,BBase!*)>>;
+ IPutV(V3,IPlus2(L1,I),carry)>>; % carry should be < BBase!* here
+ return V3;
+ end;
+
+Procedure BSmallTimes2(V1,C); % V1 is a BigNum, C a fixnum.
+ % Assume C positive, ignore sign(V1)
+ % also assume V1 neq 0.
+ if ZeroP C then return GtPOS 0 % Only used from BHardDivide, BReadAdd.
+ else begin scalar J,carry,L1,L2,L3,V3;
+ L1:=BSize V1;
+ L2:=IPlus2(IQuotient(C,BBase!*),L1);
+ L3:=IAdd1 L2;
+ V3:=GtPOS L3;
+ carry:=0;
+ IFor H:=1:L1 do <<
+ J:=IPlus2(ITimes2(IGetV(V1,H),C),carry);
+ IPutV(V3,H,IRemainder(J,BBase!*));
+ carry:=IQuotient(J,BBase!*)>>;
+ IFor H:=(IAdd1 L1):L3 do <<
+ IPutV(V3,H,IRemainder(J:=carry,BBase!*));
+ carry:=IQuotient(J,BBase!*)>>;
+ return TrimBigNum1(V3,L3);
+ end;
+
+procedure BQuotient(V1,V2);
+ car BDivide(V1,V2);
+
+procedure BRemainder(V1,V2);
+ cdr BDivide(V1,V2);
+
+% BDivide returns a dotted pair, (Q . R). Q is the quotient and R is
+% the remainder. Both are bignums. R is of the same sign as V1.
+%;
+
+smacro procedure BSimpleQuotient(V1,L1,C,SnC);
+ car BSimpleDivide(V1,L1,C,SnC);
+
+smacro procedure BSimpleRemainder(V1,L1,C,SnC);
+ cdr BSimpleDivide(V1,L1,C,SnC);
+
+procedure BDivide(V1,V2);
+ begin scalar L1,L2,Q,R,V3;
+ L2:=BSize V2;
+ If IZerop L2 then error(99, "Attempt to divide by 0 in BDIVIDE");
+ L1:=BSize V1;
+ If ILessP(L1,L2) or (L1 Eq L2 and ILessP(IGetV(V1,L1),IGetV(V2,L2)))
+ % This also takes care of case
+ then return (GtPOS 0 . V1); % when V1=0.
+ if IOnep L2 then return BSimpleDivide(V1,L1,IGetV(V2,1),BMinusP V2);
+ return BHardDivide(V1,L1,V2,L2);
+ end;
+
+
+% C is a fixnum (inum?); V1 is a bignum and L1 is its length.
+% SnC is T if C (which is positive) should be considered negative.
+% Returns quotient . remainder; each is a bignum.
+%
+procedure BSimpleDivide(V1,L1,C,SnC);
+ begin scalar I,P,R,RR,Sn1,V2;
+ Sn1:=BMinusP V1;
+ if (Sn1 and SnC) or not(Sn1 or SnC) then V2:=GtPOS L1 else V2:=GtNEG L1;
+ R:=0;
+ I:=L1;
+ While not IZeroP I do <<P:=IPlus2(ITimes2(R,BBase!*),IGetV(V1,I));
+ % Overflow.
+ IPutV(V2,I,IQuotient(P, C));
+ R:=IRemainder(P, C);
+ I:=ISub1 I>>;
+ If Sn1 then RR:=GtNeg 1 else RR:=GtPOS 1;
+ IPutV(RR,1,R);
+ return (TrimBigNum1(V2,L1) . TrimBigNum1(RR,1));
+ end;
+
+
+procedure BHardDivide(U,Lu,V,Lv);
+% This is an algorithm taken from Knuth.
+ begin scalar U1,V1,A,D,LCV,LCV1,f,f2,J,K,Lq,carry,temp,
+ LL,M,N,N1,P,Q,QBar,SnU,SnV,U2;
+ N:=Lv;
+ N1:=IAdd1 N;
+ M:=IDifference(Lu,Lv);
+ Lq:=IAdd1 M;
+
+ % Deal with signs of inputs;
+
+ SnU:=BMinusP U;
+ SnV:=BMinusp V; % Note that these are not extra-boolean, i.e.
+ % for positive numbers MBinusP returns nil, for
+ % negative it returns its argument. Thus the
+ % test (SnU=SnV) does not reliably compare the signs of
+ % U and V;
+ if SnU then if SnV then Q := GtPOS Lq else Q := GtNEG Lq
+ else if SnV then Q := GtNEG Lq else Q := GtPOS Lq;
+
+ U1 := GtPOS IAdd1 Lu; % U is ALWAYS stored as if one digit longer;
+
+ % Compute a scale factor to normalize the long division;
+ D:=IQuotient(BBase!*,IAdd1 IGetV(V,Lv));
+ % Now, at the same time, I remove the sign information from U and V
+ % and scale them so that the leading coefficeint in V is fairly large;
+
+ carry := 0;
+ IFor i:=1:Lu do <<
+ temp := IPlus2(ITimes2(IGetV(U,I),D),carry);
+ IPutV(U1,I,IRemainder(temp,BBase!*));
+ carry := IQuotient(temp,BBase!*) >>;
+ Lu := IAdd1 Lu;
+ IPutV(U1,Lu,carry);
+
+ V1:=BSmallTimes2(V,D); % So far all variables contain safe values,
+ % i.e. numbers < BBase!*;
+ IPutV(V1,0,'BIGPOS);
+
+ if ILessp(Lv,2) then NonBigNumError(V,'BHARDDIVIDE); % To be safe;
+
+ LCV := IGetV(V1,Lv);
+ LCV1 := IGetv(V1,ISub1 Lv); % Top two digits of the scaled V accessed once
+ % here outside the main loop;
+
+ % Now perform the main long division loop;
+
+ IFor I:=0:M do <<
+ J:=IDifference(Lu,I); % J>K; working on U1[K:J]
+ K:=IDifference(J,N1); % in this loop.
+ A:=IGetV(U1,J);
+
+ P := IPlus2(ITimes2(A,BBase!*),IGetv(U1,Isub1 J));
+ % N.B. P is up to 30 bits long. Take care! ;
+
+ if A Eq LCV then QBar := ISub1 BBase!*
+ else QBar := Iquotient(P,LCV); % approximate next digit;
+
+ f:=ITimes2(QBar,LCV1);
+ f2:=IPlus2(ITimes2(IDifference(P,ITimes2(QBar,LCV)),BBase!*),
+ IGetV(U1,IDifference(J,2)));
+
+ while IGreaterP(f,f2) do << % Correct most overshoots in Qbar;
+ QBar:=ISub1 QBar;
+ f:=IDifference(f,LCV1);;
+ f2:=IPlus2(f2,ITimes2(LCV,BBase!*)) >>;
+
+ carry := 0; % Ready to subtract QBar*V1 from U1;
+
+ IFor L:=1:N do <<
+ temp := IPlus2(
+ Idifference(
+ IGetV(U1,IPlus2(K,L)),
+ ITimes2(QBar,IGetV(V1,L))),
+ carry);
+ carry := IQuotient(temp,BBase!*);
+ temp := IRemainder(temp,BBase!*);
+ if IMinusp temp then <<
+ carry := ISub1 carry;
+ temp := IPlus2(temp,BBase!*) >>;
+ IPutV(U1,IPlus2(K,L),temp) >>;
+
+ % Now propagate borrows up as far as they go;
+
+ LL := IPlus2(K,N);
+ while (not IZeroP carry) and ILessp(LL,J) do <<
+ LL := IAdd1 LL;
+ temp := IPlus2(IGetV(U1,LL),carry);
+ carry := IQuotient(temp,BBase!*);
+ temp := IRemainder(temp,BBase!*);
+ if IMinusP temp then <<
+ carry := ISub1 carry;
+ temp := IPlus2(temp,BBase!*) >>;
+ IPutV(U1,LL,temp) >>;
+
+ if not IZerop carry then <<
+ % QBar was still wrong - correction step needed.
+ % This should not happen very often;
+ QBar := ISub1 QBar;
+
+ % Add V1 back into U1;
+ carry := 0;
+
+ IFor L := 1:N do <<
+ carry := IPlus2(
+ IPlus2(IGetV(U1,Iplus2(K,L)),
+ IGetV(V1,L)),
+ carry);
+ IPutV(U1,IPlus2(K,L),IRemainder(carry,BBase!*));
+ carry := IQuotient(carry,BBase!*) >>;
+
+ LL := IPlus2(K,N);
+ while ILessp(LL,J) do <<
+ LL := IAdd1 LL;
+ carry := IPlus2(IGetv(U1,LL),carry);
+ IPutV(U1,LL,IRemainder(carry,BBase!*));
+ carry := IQuotient(carry,BBase!*) >> >>;
+
+ IPutV(Q,IDifference(Lq,I),QBar)
+
+ >>; % End of main loop;
+
+
+ U1 := TrimBigNum1(U1,IDifference(Lu,M));
+
+ f := 0; f2 := 0; % Clean up potentially wild values;
+
+ if not BZeroP U1 then <<
+ % Unnormalize the remainder by dividing by D
+
+ if SnU then IPutV(U1,0,'BIGNEG);
+ if not IOnep D then <<
+ Lu := BSize U1;
+ carry := 0;
+ IFor L:=Lu step -1 until 1 do <<
+ P := IPlus2(ITimes2(carry,BBase!*),IGetV(U1,L));
+ IPutv(U1,L,IQuotient(P,D));
+ carry := IRemainder(P,D) >>;
+
+ P := 0;
+ if not IZeroP carry then BHardBug("remainder when unscaling",
+ U,V,TrimBigNum1(U1,Lu),TrimBigNum1(Q,Lq));
+
+ U1 := TrimBigNum1(U1,Lu) >> >>;
+
+ Q := TrimBigNum1(Q,Lq); % In case leading digit happened to be zero;
+ P := 0; % flush out a 30 bit number;
+
+% Here, for debugging purposes, I will try to validate the results I
+% have obtained by testing if Q*V+U1=U and 0<=U1<V. I Know this slows things
+% down, but I will remove it when my confidence has improved somewhat;
+
+% if not BZerop U1 then <<
+% if (BMinusP U and not BMinusP U1) or
+% (BMinusP U1 and not BMinusP U) then
+% BHardBug("remainder has wrong sign",U,V,U1,Q) >>;
+% if not BAbs U1<BAbs V then BHardBug("remainder out of range",U,V,U1,Q)
+% else if not BZerop(BDifference(BPlus2(BTimes2(Q,V),U1),U)) then
+% BHardBug("quotient or remainder incorrect",U,V,U1,Q);
+
+ return (Q . U1)
+ end;
+
+procedure BHardBug(msg,U,V,R,Q);
+% Because the inputs to BHardDivide are probably rather large, I am not
+% going to rely on BldMsg to display them;
+ << Prin2T "***** Internal error in BHardDivide";
+ Prin2 "arg1="; Prin2T U;
+ Prin2 "arg2="; Prin2T V;
+ Prin2 "computed quotient="; Prin2T Q;
+ Prin2 "computed remainder="; Prin2T R;
+ StdError msg >>;
+
+
+procedure BGreaterP(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGreaterP(V,U)
+ else nil
+ else if BMinusP V then U
+ else BUnsignedGreaterP(U,V);
+
+procedure BLessp(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGreaterP(U,V)
+ else U
+ else if BMinusP V then nil
+ else BUnsignedGreaterP(V,U);
+
+procedure BGeq(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGeq(V,U)
+ else nil
+ else if BMinusP V then U
+ else BUnsignedGeq(U,V);
+
+procedure BLeq(U,V);
+ if BMinusP U then
+ if BMinusP V then BUnsignedGeq(U,V)
+ else U
+ else if BMinusP V then nil
+ else BUnsignedGeq(V,U);
+
+procedure BUnsignedGreaterP(U,V);
+% Compare magnitudes of two bignums;
+ begin
+ scalar Lu,Lv,I;
+ Lu := BSize U;
+ Lv := BSize V;
+ if not (Lu eq Lv) then <<
+ if IGreaterP(Lu,Lv) then return U
+ else return nil >>;
+ while IGetV(U,Lv) eq IGetV(V,Lv) and IGreaterP(Lv,1) do Lv := ISub1 Lv;
+ if IGreaterP(IGetV(U,Lv),IGetV(V,Lv)) then return U
+ else return nil
+ end;
+
+procedure BUnsignedGeq(U,V);
+% Compare magnitudes of two unsigned bignums;
+ begin
+ scalar Lu,Lv;
+ Lu := BSize U;
+ Lv := BSize V;
+ if not (Lu eq Lv) then <<
+ if IGreaterP(Lu,Lv) then return U
+ else return nil >>;
+ while IGetV(U,Lv) eq IGetV(V,Lv) and IGreaterP(Lv,1) do Lv := ISub1 Lv;
+ If IGreaterP(IGetV(V,Lv),IGetV(U,Lv)) then return nil
+ else return U
+ end;
+
+
+
+procedure BAdd1 V;
+ BSmallAdd(V, 1);
+
+procedure BSub1 U;
+ BSmallDiff(U, 1);
+
+% ------------------------------------------------
+% Conversion to Float:
+
+procedure FloatFromBigNum V;
+ if BZeroP V then 0.0
+ else if BGreaterP(V, BigFloatHi!*) or BLessp(V, BigFloatLow!*)
+ then Error(99,list("Argument, ",V," to FLOAT is too large"))
+ else begin scalar L,Res,Sn,I;
+% Careful, do not want to call itself recursively
+ L:=BSize V;
+ Sn:=BMinusP V;
+ Res:=IntFloat IGetv(V,L);
+ I:=ISub1 L;
+ While not IZeroP I do << Res:=FloatTimes2(res,FloatBBase!*);
+ Res:=FloatPlus2(Res, IntFloat IGetV(V,I));
+ I:=ISub1 I>>;
+ if Sn then Res:=minus res;
+ return res;
+ end;
+
+
+% ------------------------------------------------
+% Input and Output:
+Digit2Letter!* := % Ascii values of digits and characters.
+'[48 49 50 51 52 53 54 55 56 57 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+80 81 82 83 84 85 86 87 88 89 90];
+
+% OutputBase!* is assumed to be positive and less than 37.
+
+procedure BChannelPrin2(Channel,V);
+ If not BigP V then NonBigNumError(V, 'BPrin) %need?
+ else begin scalar quot, rem, div, result, resultsign, myobase;
+ myobase:=OutputBase!*;
+ resultsign:=BMinusP V;
+ div:=BSimpleDivide(V,Bsize V,OutputBase!*,nil);
+ quot:=car div;
+ rem:=cdr div;
+ if Bzerop rem then rem:=0 else rem:=IGetV(rem,1);
+ result:=rem . result;
+ while Not BZeroP quot do
+ <<div:=BSimpleDivide(quot,Bsize quot,OutputBase!*,nil);
+ quot:=car div;
+ rem:=cdr div;
+ if Bzerop rem then rem:=0 else rem:=IGetV(rem,1);
+ result:=rem . result>>;
+ if resultsign then channelwritechar(Channel,char !-);
+ if myobase neq 10 then <<ChannelWriteSysInteger(channel,myobase,10);
+ ChannelWriteChar(Channel, char !#)>>;
+ For each u in result do ChannelWriteChar(Channel, IGetV(digit2letter!*,u));
+ OutputBase!*:=myobase;
+ return;
+ end;
+
+procedure BRead(s,radix,sn); % radix is < Bbase!*
+ %s=string of digits, radix=base, sn=1 or -1
+ begin scalar sz, res, ch;
+ sz:=size s;
+ res:=GtPOS 1;
+ ch:=indx(s,0);
+ if IGeq(ch,char A) and ILeq(ch,char Z)
+ then ch:=IPlus2(IDifference(ch,char A),10);
+ if IGeq(ch,char 0) and ILeq(ch,char 9)
+ then ch:=IDifference(ch,char 0);
+ IPutV(res,1,ch);
+ IFor i:=1:sz do <<ch:=indx(s,i);
+ if IGeq(ch,char A) and ILeq(ch,char Z)
+ then ch:=IDifference(ch,IDifference(char A,10));
+ if IGeq(ch,char 0) and ILeq(ch,char 9)
+ then ch:=IDifference(ch,char 0);
+ res:=BReadAdd(res, radix, ch)>>;
+ if iminusp sn then res:=BMinus res;
+ return res;
+ end;
+
+procedure BReadAdd(V, radix, ch);
+ << V:=BSmallTimes2(V, radix);
+ V:=BSmallAdd(V,ch)>>;
+
+procedure BSmallAdd(V,C); %V big, C fix.
+ if IZerop C then return V
+ else if Bzerop V then return int2Big C
+ else if BMinusp V then BMinus BSmallDiff(BMinus V, C)
+ else if IMinusP C then BSmallDiff(V, IMinus C)
+ else begin scalar V1,L1;
+ Carry!*:=C;
+ L1:=BSize V;
+ V1:=GtPOS(IAdd1 L1);
+ IFor i:=1:L1 do IPutV(V1,i,addcarry IGetV(V,i));
+ if IOneP carry!* then IPutV(V1,IAdd1 L1,1) else return TrimBigNum1(V1,L1);
+ return V1
+ end;
+
+procedure BNum N;
+% Creates a Bignum of one BETA digit, value N.
+% N is POS or NEG
+ IF BIGP N then N else BnumAux N;
+
+procedure BNumAux N;
+% Creates a Bignum of one BIGIT value N.
+% N is POS or NEG
+ begin scalar B;
+ if IZerop n then return GtPOS 0
+ else if IMinusp N then <<b:=GtNEG 1; n:= IMinus n>> else b:=GtPos 1;
+ IPutV(b,1,N);
+ Return b;
+ end;
+
+procedure BSmallDiff(V,C); %V big, C fix
+ if IZerop C then V
+ else if BZeroP V then int2Big IMinus C
+ else if BMinusP V then BMinus BSmallAdd(BMinus V, C)
+ else if IMinusP C then BSmallAdd(V, IMinus C)
+ else begin scalar V1,L1;
+ Carry!*:=C;
+ L1:=BSize V;
+ V1:=GtPOS L1;
+ IFor i:=1:L1 do IPuTV(V1,i,subcarry IGetV(V,i));
+ if not IZeroP carry!* then
+ StdError BldMsg(" BSmallDiff V<C %p %p%n",V,C);
+ return TrimBigNum1(V1,L1);
+ end;
+
+on syslisp;
+
+syslsp procedure int2Big n;
+% Creates BigNum of value N.
+% From any N, BETA,INUM,FIXNUM or BIGNUM
+case tag n of
+ NEGINT,POSINT: sys2Big n;
+ FIXN: sys2Big fixval fixinf n;
+ BIGN: N;
+ default: NonIntegerError(n, 'int2Big);
+ End;
+
+off syslisp;
+
+% Convert BIGNUMs to FLOAT
+
+procedure bigfromfloat X;
+ if fixp x or bigp x then x
+ else begin scalar bigpart,floatpart,power,sign,thispart;
+ if minusp X then <<sign:=-1; X:=minus X>> else sign:=1;
+ bigpart:=bzero!*;
+ while neq(X, 0) and neq(x,0.0) do <<
+ if X < bbase!* then << bigpart:=bplus2(bigpart, bnum fix x);
+ X:=0 >>
+ else <<floatpart:=x;
+ power:=0;
+ while floatpart>=bbase!* do % get high end of number.
+ <<floatpart:=floatpart/bbase!*;
+ power:=power + bbits!* >>;
+ thispart:=btimes2(btwopower power, bnum fix floatpart);
+ X:=X- floatfrombignum thispart;
+ bigpart:=bplus2(bigpart, thispart) >> >>;
+ if minusp sign then bigpart := bminus bigpart;
+ return bigpart;
+ end;
+
+
+% Now Install Interfacing
+
+on syslisp;
+
+syslsp procedure SetUpGlobals;
+ << Prin2t '"SetupGlobals";
+ SetBits BitsPerWord;
+ Prin2T '" ... done";>>;
+
+
+off syslisp;
+
+SetupGlobals();
+
+LoadTime <<
+ StaticBig!*:=GtWarray 10>>;
+
+% Assume dont need more than 10 slots to represent a BigNum
+% Version of SYSint
+
+% -- Output---
+
+% MLG Change to interface to Recursive hooks, added for
+% Prinlevel stuff
+
+CopyD('OldChannelPrin1,'RecursiveChannelPrin1);
+CopyD('OldChannelPrin2,'RecursiveChannelPrin2);
+
+Procedure RecursiveChannelPrin1(Channel,U,Level);
+ <<if BigP U then BChannelPrin2(Channel,U)
+ else OldChannelPrin1(Channel, U,Level);U>>;
+
+Procedure RecursiveChannelPrin2(Channel,U,level);
+ <<If BigP U then BChannelPrin2(Channel, U)
+ else OldChannelPrin2(Channel, U,level);U>>;
+
+
+procedure checkifreallybig UU;
+% If BIGNUM result is in older FIXNUM or INUM range
+% Convert Back.
+%/ Need a faster test
+ if BLessP(UU, BigSysLow!*) or BGreaterp(UU,BigSysHi!*) then UU
+ else Sys2Int Big2SysAux UU;
+
+procedure checkifreallybigpair VV;
+% Used to process DIVIDE
+ checkifreallybig car VV . checkifreallybig cdr VV;
+
+procedure checkifreallybigornil UU;
+% Used for EXTRA-boolean tests
+ if Null UU or BLessp(UU, BigSysLow!*) or BGreaterP(UU,BigSysHi!*) then UU
+ else Sys2Int Big2SysAux UU;
+
+procedure BigPlus2(U,V);
+ CheckIfReallyBig BPlus2(U,V);
+
+procedure BigDifference(U,V);
+ CheckIfReallyBig BDifference(U,V);
+
+procedure BigTimes2(U,V);
+ CheckIfReallyBig BTimes2(U,V);
+
+procedure BigDivide(U,V);
+ CheckIfReallyBigPair BDivide(U,V);
+
+procedure BigQuotient(U,V);
+ CheckIfReallyBig BQuotient(U,V);
+
+procedure BigRemainder(U,V);
+ CheckIfReallyBig BRemainder(U,V);
+
+procedure BigLAnd(U,V);
+ CheckIfReallyBig BLand(U,V);
+
+procedure BigLOr(U,V);
+ CheckIfReallyBig BLOr(U,V);
+
+procedure BigLXOr(U,V);
+ CheckIfReallyBig BLXor(U,V);
+
+procedure BigLShift(U,V);
+ CheckIfReallyBig BLShift(U,V);
+
+on syslisp;
+
+procedure Lshift(U,V);
+ If BetaP U and BetaP V
+ then (if V<0 then Sys2Int Wshift(U,V)
+ else if V< LispVar (BBits!* ) then Sys2Int Wshift(U,V)
+ else BigLshift(Sys2Big U, Sys2Big V) )
+ else BigLshift(Sys2Big U, Sys2Big V) ;
+
+off syslisp;
+
+Copyd('LSH,'Lshift);
+
+procedure BigGreaterP(U,V);
+ CheckIfReallyBigOrNil BGreaterP(U,V);
+
+procedure BigLessP(U,V);
+ CheckIfReallyBigOrNil BLessP(U,V);
+
+procedure BigAdd1 U;
+ CheckIfReallyBig BAdd1 U;
+
+procedure BigSub1 U;
+ CheckIfReallyBig BSub1 U;
+
+procedure BigLNot U;
+ CheckIfReallyBig BLNot U;
+
+procedure BigMinus U;
+ CheckIfReallyBig BMinus U;
+
+procedure BigMinusP U;
+ CheckIfReallyBigOrNil BMinusP U;
+
+procedure BigOneP U;
+ CheckIfReallyBigOrNil BOneP U;
+
+procedure BigZeroP U;
+ CheckIfReallyBigOrNil BZeroP U;
+
+
+% ---- Input ----
+
+procedure MakeStringIntoLispInteger(S,Radix,Sn);
+ CheckIfReallyBig BRead(S,Radix,Sn);
+
+on syslisp;
+
+procedure Int2Sys N;
+% Convert a random FIXed number to WORD Integer
+ case tag(N) of
+ POSINT,NEGINT: N;
+ FIXN: FixVal FixInf N;
+ BIGN: Big2SysAux N;
+ default: NonNumber1Error(N,'Int2SYS);
+ End;
+
+syslsp procedure Sys2Big N;
+% Convert a SYSint to a BIG
+% Must NOT use generic arith here
+% Careful that no GC if this BIGger than INUM
+Begin scalar Sn, A, B;
+ If N=0 then return GtPos 0;
+ A:= LispVar StaticBig!*; % Grab the base
+ If N<0 then sn:=T;
+ A[1]:=N; % Plant number
+ N:=1; % now use N as counter
+% Careful handling of -N in case have largest NEG, not just
+% flip sign
+ If Sn then <<B:=-Bbase!*;
+ While A[n]<=B do
+ <<N:=N+1;
+ A[n]:=A[n-1]/Bbase!*;
+ A[n-1]:=A[n-1]-a[n]*Bbase!*>>;
+ B:=GtNeg N;
+ For i:=1:N do Iputv(B,i,-A[i])>>
+ else << While A[n]>=Bbase!* do
+ <<N:=N+1;
+ A[n]:=A[n-1]/Bbase!*;
+ A[n-1]:=A[n-1]-a[n]*Bbase!*>>;
+ B:= GtPos N;
+ For i:=1:N do IputV(B,i,A[i])>>;
+ Return B;
+End;
+
+off syslisp;
+
+
+% Coercion/Transfer Functions
+
+copyd('oldFloatFix,'FloatFix);
+
+procedure FloatFix U;
+% Careful of sign and range
+ If FloatSysLow!* <= U and U <= FloatSysHi!* then Oldfloatfix U
+ else bigfromfloat U;
+
+on syslisp;
+
+procedure BetaP x;
+% test if NUMBER in reduced INUM range
+ If Intp x then (x <= Lispvar(betaHi!*)) and (x >= LispVar(betaLow!*))
+ else NIL;
+
+procedure BetaRangeP x;
+% Test if SYSINT in reduced INUM range
+ if (x <= Lispvar(betaHi!*)) then (x>=LispVar(betaLow!*)) else NIL;
+
+procedure Beta2P(x,y);
+% Check for 2 argument arithmetic functions
+ if BetaP x then BetaP y;
+
+off syslisp;
+
+End;
+end;
ADDED psl-1983/3-1/util/nstruct.build
Index: psl-1983/3-1/util/nstruct.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/nstruct.build
@@ -0,0 +1,3 @@
+compiletime load clcomp,strings;
+in "nstruct.lsp"$
+in "fast-struct.lsp"$
ADDED psl-1983/3-1/util/nstruct.lsp
Index: psl-1983/3-1/util/nstruct.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/nstruct.lsp
@@ -0,0 +1,1772 @@
+;;; -*- Mode:Lisp; Package:SI; Lowercase:True; Base:8 -*-
+;;; ** (c) Copyright 1980 Massachusetts Institute of Technology **
+
+;The master copy of this file is in MC:ALAN;NSTRUCT >
+;The current Lisp machine copy is in AI:LISPM2;STRUCT >
+;The current Multics copy is in >udd>Mathlab>Bawden>defstruct.lisp
+
+;***** READ THIS PLEASE! *****
+;If you are thinking of munging anything in this file you might want
+;to consider finding me (ALAN) and asking me to mung it for you.
+;There is more than one copy of this file in the world (it runs in PDP10
+;and Multics MacLisp and on LispMachines) and whatever amazing
+;features you are considering adding might be usefull to those people
+;as well. If you still cannot contain yourself long enough to find
+;me, AT LEAST send me a piece of mail describing what you did and why.
+;Thanks for reading this flame.
+; Alan Bawden (ALAN@MC)
+
+;Things to fix:
+
+;For LispMachine:
+; :%P-LDB type (this is hard to do, punt for now.)
+
+;For Multics:
+; displacement is a problem (no displace)
+; nth, nthcdr don't exist there
+; ldb, dpb don't exist, so byte fields don't work without Mathlab macros
+; callable accessors don't work
+; dpb is needed at the user's compile time if he is using byte fields.
+
+; PSL change deleted
+;(eval-when (compile)
+; (cond ((status feature ITS)
+; (load '|alan;lspenv init|))
+; ((status feature Multics)
+; (load '|>udd>Mathlab>Bawden>lspenv.lisp|))))
+;
+;#+PDP10
+;(cond ((status nofeature noldmsg)
+; (terpri msgfiles)
+; (princ '#.(and (status feature PDP10)
+; (maknam (nconc (exploden ";Loading DEFSTRUCT ")
+; (exploden (caddr (truename infile))))))
+; msgfiles)))
+;
+;#+Multics
+;(declare (genprefix defstruct-internal-)
+; (macros t))
+;
+;#M
+;(eval-when (eval compile)
+; (setsyntax #/: (ascii #\space) nil))
+
+; PSL change -- make sure everything we need at run time gets loaded
+(imports '(useful common strings))
+
+(eval-when (eval)
+ ;;So we may run the thing interpreted we need the simple
+ ;;defstruct that lives here:
+; PSL change
+ (lapin "struct.initial"))
+; (cond ((status feature ITS)
+; (load '|alan;struct initial|))
+; ((status feature Multics)
+; (load '|>udd>Mathlab>Bawden>initial_defstruct|))))
+
+(eval-when (compile)
+ ;;To compile the thing this probably is an old fasl: (!)
+; PSL change
+ (load nstruct))
+; (cond ((status feature ITS)
+; (load '|alan;struct boot|))
+; ((status feature Multics)
+; (load '|>udd>Mathlab>Bawden>boot_defstruct|))))
+
+#+Multics
+(defun nth (n l)
+ (do ((n n (sub1 n))
+ (l l (cdr l)))
+ ((zerop n) (car l))))
+
+#+Multics
+(defun nthcdr (n l)
+ (do ((n n (1- n))
+ (l l (cdr l)))
+ ((zerop n) l)))
+
+; PSL change I'm not sure whether we need this at all
+;#+Multics
+(defun displace (x y)
+ (cond ((atom y)
+ (rplaca x 'progn)
+ (rplacd x (list y)))
+ (t
+ (rplaca x (car y))
+ (rplacd x (cdr y))))
+ x)
+
+;;; You might think you could use progn for this, but you can't!
+(defun defstruct-dont-displace (x y)
+ x ;ignored
+ y)
+
+;;; Eval this before attempting incremental compilation
+(eval-when (eval compile)
+
+; PSL change
+;#+PDP10
+;(defmacro append-symbols args
+; (do ((l (reverse args) (cdr l))
+; (x)
+; (a nil (if (or (atom x)
+; (not (eq (car x) 'quote)))
+; (if (null a)
+; `(exploden ,x)
+; `(nconc (exploden ,x) ,a))
+; (let ((l (exploden (cadr x))))
+; (cond ((null a) `',l)
+; ((= 1 (length l)) `(cons ,(car l) ,a))
+; (t `(append ',l ,a)))))))
+; ((null l) `(implode ,a))
+; (setq x (car l))))
+;
+;#+Multics
+;(defmacro append-symbols args
+; `(make_atom (catenate . ,args)))
+;
+;#+LispM
+;(defmacro append-symbols args
+; `(intern (string-append . ,args)))
+(defmacro append-symbols args
+ `(intern (string-concat . ,args)))
+
+(defmacro defstruct-putprop (sym val ind)
+ `(push `(defprop ,,sym ,,val ,,ind) returns))
+
+(defmacro defstruct-put-macro (sym fcn)
+; PSL change
+ `(push `(putd ',,sym 'macro (function (lambda (**put-mac**)
+ (,,fcn **put-mac**))))
+ returns))
+; #M `(defstruct-putprop ,sym ,fcn 'macro)
+; #Q (setq fcn (if (and (not (atom fcn))
+; (eq (car fcn) 'quote))
+; `'(macro . ,(cadr fcn))
+; `(cons 'macro ,fcn)))
+; #Q `(push `(fdefine ',,sym ',,fcn t) returns))
+
+(defmacro make-empty () `'%%defstruct-empty%%)
+
+(defmacro emptyp (x) `(eq ,x '%%defstruct-empty%%))
+
+;;;Here we must deal with the fact that error reporting works
+;;;differently everywhere!
+
+; PSL change
+(defmacro defstruct-error (message . args)
+ `(stderror (list ,message . ,args)))
+;#+PDP10
+;;;;first arg is ALWAYS a symbol or a quoted symbol:
+;(defmacro defstruct-error (message &rest args)
+; (let* ((chars (nconc (exploden (if (atom message)
+; message
+; (cadr message)))
+; '(#/.))) ;"Bad frob" => "Bad frob."
+; (new-message
+; (maknam (if (null args)
+; chars
+; (let ((c (car chars))) ;"Bad frob." => "-- bad frob."
+; (or (< c #/A)
+; (> c #/Z)
+; (rplaca chars (+ c #o40)))
+; (append '(#/- #/- #\space) chars))))))
+; `(error ',new-message
+; ,@(cond ((null args) `())
+; ((null (cdr args)) `(,(car args)))
+; (t `((list ,@args)))))))
+;
+;#+Multics
+;;;;first arg is ALWAYS a string:
+;(defmacro defstruct-error (message &rest args)
+; `(error ,(catenate "defstruct: "
+; message
+; (if (null args)
+; "."
+; ": "))
+; ,@(cond ((null args) `())
+; ((null (cdr args)) `(,(car args)))
+; (t `((list ,@args))))))
+;
+;#+LispM
+;;;;first arg is ALWAYS a string:
+;(defmacro defstruct-error (message &rest args)
+; (do ((l args (cdr l))
+; (fs "")
+; (na nil))
+; ((null l)
+; `(ferror nil
+; ,(string-append message
+; (if (null args)
+; "."
+; (string-append ":" fs)))
+; ,.(nreverse na)))
+; (cond ((and (not (atom (car l)))
+; (eq (caar l) 'quote)
+; (symbolp (cadar l)))
+; (setq fs (string-append fs " " (string-downcase (cadar l)))))
+; (t
+; (push (car l) na)
+; (setq fs (string-append fs " ~S"))))))
+
+);End of eval-when (eval compile)
+
+;;;If you mung the the ordering af any of the slots in this structure,
+;;;be sure to change the version slot and the definition of the function
+;;;get-defstruct-description. Munging the defstruct-slot-description
+;;;structure should also cause you to change the version "number" in this manner.
+(defstruct (defstruct-description
+ (:type :list)
+ (:default-pointer description)
+ (:conc-name defstruct-description-)
+ (:alterant nil))
+ (version 'one)
+ type
+ (displace 'defstruct-dont-displace)
+ slot-alist
+; PSL change
+ (named-p t)
+; named-p
+ constructors
+ (default-pointer nil)
+ (but-first nil)
+ size
+ (property-alist nil)
+ ;;end of "expand-time" slots
+ name
+ include
+ (initial-offset 0)
+ (eval-when '(eval compile load))
+ alterant
+ (conc-name nil)
+; PSL change
+ (callable-accessors nil)
+; (callable-accessors #M nil #Q t)
+ (size-macro nil)
+ (size-symbol nil)
+ )
+
+(defun get-defstruct-description (name)
+ (let ((description (get name 'defstruct-description)))
+ (cond ((null description)
+ (defstruct-error
+ "A structure with this name has not been defined" name))
+ ((not (eq (defstruct-description-version) 'one))
+ (defstruct-error "The description of this structure is out of date,
+it should be recompiled using the current version of defstruct"
+ name))
+ (t description))))
+
+;;;See note above defstruct-description structure before munging this one.
+(defstruct (defstruct-slot-description
+ (:type :list)
+ (:default-pointer slot-description)
+ (:conc-name defstruct-slot-description-)
+ (:alterant nil))
+ number
+ (ppss nil)
+ init-code
+ (type 'notype)
+ (property-alist nil)
+ ref-macro-name
+ )
+
+;;;Perhaps this structure wants a version slot too?
+(defstruct (defstruct-type-description
+ (:type :list)
+ (:default-pointer type-description)
+ (:conc-name defstruct-type-description-)
+ (:alterant nil))
+ ref-expander
+ ref-no-args
+ cons-expander
+ cons-flavor
+ (cons-keywords nil)
+ (named-type nil)
+ (overhead 0)
+ (defstruct-expander nil)
+ )
+
+;; (DEFSTRUCT (<name> . <options>) . <slots>) or (DEFSTRUCT <name> . <slots>)
+;;
+;; <options> is of the form (<option> <option> (<option> <val>) ...)
+;;
+;; <slots> is of the form (<slot> (<slot> <initial-value>) ...)
+;;
+;; Options:
+;; :TYPE defaults to HUNK
+;; :CONSTRUCTOR defaults to "MAKE-<name>"
+;; :DEFAULT-POINTER defaults to empty (if no <val> given defaults to "<name>")
+;; :CONC-NAME defaults to empty (if no <val> given defaults to "<name>-")
+;; :SIZE-SYMBOL defaults to empty (if no <val> given defaults to "<name>-SIZE")
+;; :SIZE-MACRO defaults to empty (if no <val> given defaults to "<name>-SIZE")
+;; :ALTERANT defaults to "ALTER-<name>"
+;; :BUT-FIRST must have a <val> given
+;; :INCLUDE must have a <val> given
+;; :PROPERTY (:property foo bar) gives the structure a foo property of bar.
+;; :INITIAL-OFFSET can cause defstruct to skip over that many slots.
+;; :NAMED takes no value. Tries to make the structure a named type.
+;; :CALLABLE-ACCESSORS defaults to T on the LispMachine, NIL elsewhere.
+;; <type> any type name can be used without a <val> instead of saying (TYPE <type>)
+;; <other> any symbol with a non-nil :defstruct-option property. You say
+;; (<other> <val>) and the effect is that of (:property <other> <val>)
+;;
+;; Properties used:
+;; DEFSTRUCT-TYPE-DESCRIPTION each type has one, it is a type-description.
+;; DEFSTRUCT-NAME each constructor, alterant and size macro has one, it is a name.
+;; DEFSTRUCT-DESCRIPTION each name has one, it is a description (see below).
+;; DEFSTRUCT-SLOT each accesor has one, it is of the form: (<name> . <slot>)
+;; :DEFSTRUCT-OPTION if a symbol FOO has this property then it can be used as an
+;; option giving the structure a FOO property of the value (which must be given).
+
+; PSL change
+;#Q
+;(defprop defstruct "Structure" definition-type-name)
+
+; PSL change
+(defmacro defstruct (options . items)
+;(defmacro defstruct (options &body items)
+ (let* ((description (defstruct-parse-options options))
+ (type-description (get (defstruct-description-type)
+ 'defstruct-type-description))
+ (name (defstruct-description-name))
+ (new-slots (defstruct-parse-items items description))
+ (returns nil))
+ (push `',name returns)
+ (or (null (defstruct-type-description-defstruct-expander))
+ (setq returns (append (funcall (defstruct-type-description-defstruct-expander)
+ description)
+ returns)))
+; PSL change
+; #Q (push `(record-source-file-name ',name 'defstruct) returns)
+ (defstruct-putprop name description 'defstruct-description)
+ (let ((alterant (defstruct-description-alterant))
+ (size-macro (defstruct-description-size-macro))
+ (size-symbol (defstruct-description-size-symbol)))
+ (cond (alterant
+ (defstruct-put-macro alterant 'defstruct-expand-alter-macro)
+ (defstruct-putprop alterant name 'defstruct-name)))
+ (cond (size-macro
+ (defstruct-put-macro size-macro 'defstruct-expand-size-macro)
+ (defstruct-putprop size-macro name 'defstruct-name)))
+ (cond (size-symbol
+; PSL change
+ (push `(defvar ,size-symbol
+; (push `(#M defvar #Q defconst ,size-symbol
+ ,(+ (defstruct-description-size)
+ (defstruct-type-description-overhead)))
+ returns))))
+; PSL change old style DO
+ (do ((cs (defstruct-description-constructors) (cdr cs))) ((null cs))
+; (do cs (defstruct-description-constructors) (cdr cs) (null cs)
+ (defstruct-put-macro (caar cs) 'defstruct-expand-cons-macro)
+ (defstruct-putprop (caar cs) name 'defstruct-name))
+ `(eval-when ,(defstruct-description-eval-when)
+ ,.(defstruct-define-ref-macros new-slots description)
+ . ,returns)))
+
+(defun defstruct-parse-options (options)
+ (let ((name (if (atom options) options (car options)))
+ (type nil)
+ (constructors (make-empty))
+ (alterant (make-empty))
+ (included nil)
+ (named-p nil)
+ (but-first nil)
+ (description (make-defstruct-description)))
+ (setf (defstruct-description-name) name)
+ (do ((op) (val) (vals)
+ (options (if (atom options) nil (cdr options))
+ (cdr options)))
+ ((null options))
+ (if (atom (setq op (car options)))
+ (setq vals nil)
+ (setq op (prog1 (car op) (setq vals (cdr op)))))
+ (setq val (if (null vals) (make-empty) (car vals)))
+; PSL change
+; #Q AGAIN
+ (selectq op
+ (:type
+ (if (emptyp val)
+ (defstruct-error
+ "The type option to defstruct must have a value given"
+ name))
+ (setq type val))
+ (:default-pointer
+ (setf (defstruct-description-default-pointer)
+ (if (emptyp val) name val)))
+ (:but-first
+ (if (emptyp val)
+ (defstruct-error
+ "The but-first option to defstruct must have a value given"
+ name))
+ (setq but-first val)
+ (setf (defstruct-description-but-first) val))
+ (:conc-name
+ (setf (defstruct-description-conc-name)
+ (if (emptyp val)
+ (append-symbols name '-)
+ val)))
+ (:callable-accessors
+ (setf (defstruct-description-callable-accessors)
+ (if (emptyp val) t val)))
+ (:displace
+ (setf (defstruct-description-displace)
+ (cond ((or (emptyp val)
+ (eq val 't))
+ 'displace)
+ ((null val) 'defstruct-dont-displace)
+ (t val))))
+ (:constructor
+ (cond ((null val)
+ (setq constructors nil))
+ (t
+ (and (emptyp val)
+ (setq val (append-symbols 'make- name)))
+ (setq val (cons val (cdr vals)))
+ (if (emptyp constructors)
+ (setq constructors (list val))
+ (push val constructors)))))
+ (:alterant
+ (setq alterant val))
+ (:size-macro
+ (setf (defstruct-description-size-macro)
+ (if (emptyp val)
+; PSL change
+ (append-symbols name '\-size)
+; (append-symbols name '-size)
+ val)))
+ (:size-symbol
+ (setf (defstruct-description-size-symbol)
+ (if (emptyp val)
+; PSL change
+ (append-symbols name '\-size)
+; (append-symbols name '-size)
+ val)))
+ (:include
+ (and (emptyp val)
+ (defstruct-error
+ "The include option to defstruct requires a value"
+ name))
+ (setq included val)
+ (setf (defstruct-description-include) vals))
+ (:property
+ (push (cons (car vals) (if (null (cdr vals)) t (cadr vals)))
+ (defstruct-description-property-alist)))
+ (:named
+ (or (emptyp val)
+ (defstruct-error
+ "The named option to defstruct doesn't take a value" name))
+ (setq named-p t))
+ (:eval-when
+ (and (emptyp val)
+ (defstruct-error
+ "The eval-when option to defstruct requires a value"
+ name))
+ (setf (defstruct-description-eval-when) val))
+ (:initial-offset
+ (and (or (emptyp val)
+ (not (fixp val)))
+ (defstruct-error
+ "The initial-offset option to defstruct requires a fixnum"
+ name))
+ (setf (defstruct-description-initial-offset) val))
+ (otherwise
+ (cond ((get op 'defstruct-type-description)
+ (or (emptyp val)
+ (defstruct-error
+ "defstruct type used as an option with a value"
+ op 'in name))
+ (setq type op))
+ ((get op ':defstruct-option)
+ (push (cons op (if (emptyp val) t val))
+ (defstruct-description-property-alist)))
+ (t
+; PSL change
+; #Q (multiple-value-bind (new foundp)
+; (intern-soft op si:pkg-user-package)
+; (or (not foundp)
+; (eq op new)
+; (progn (setq op new) (go AGAIN))))
+ (defstruct-error
+ "defstruct doesn't understand this option"
+ op 'in name))))))
+ (cond ((emptyp constructors)
+ (setq constructors
+ (list (cons (append-symbols 'make- name)
+ nil)))))
+ (setf (defstruct-description-constructors) constructors)
+ (cond ((emptyp alterant)
+ (setq alterant
+ (append-symbols 'alter- name))))
+ (setf (defstruct-description-alterant) alterant)
+ (cond ((not (null type))
+ (let ((type-description
+ (or (get type 'defstruct-type-description)
+; PSL change
+; #Q (multiple-value-bind
+; (new foundp)
+; (intern-soft type si:pkg-user-package)
+; (and foundp
+; (not (eq type new))
+; (progn (setq type new)
+; (get type 'defstruct-type-description))))
+ (defstruct-error
+ "Unknown type in defstruct"
+ type 'in name))))
+ (if named-p
+ (setq type
+ (or (defstruct-type-description-named-type)
+ (defstruct-error
+ "There is no way to make this defstruct type named"
+ type 'in name)))))))
+ (cond (included
+ (let ((d (get-defstruct-description included)))
+ (if (null type)
+ (setq type (defstruct-description-type d))
+ (or (eq type (defstruct-description-type d))
+ (defstruct-error
+ "defstruct types must agree for include option"
+ included 'included 'by name)))
+ (and named-p
+ (not (eq type (defstruct-type-description-named-type
+ (or (get type 'defstruct-type-description)
+ (defstruct-error
+ "Unknown type in defstruct"
+ type 'in name 'including included)))))
+ (defstruct-error
+ "Included defstruct's type isn't a named type"
+ included 'included 'by name))
+ (if (null but-first)
+ (setf (defstruct-description-but-first)
+ (defstruct-description-but-first d))
+ (or (equal but-first (defstruct-description-but-first d))
+ (defstruct-error
+ "but-first options must agree for include option"
+ included 'included 'by name)))))
+ ((null type)
+ (setq type
+ (cond (named-p
+; PSL change
+ ':named-vector)
+; #+PDP10 ':named-hunk
+; #+Multics ':named-list
+; #+LispM ':named-array)
+ (t
+ ':vector)))))
+; #+PDP10 ':hunk
+; #+Multics ':list
+; #+LispM ':array)))))
+ (let ((type-description (or (get type 'defstruct-type-description)
+ (defstruct-error
+ "Undefined defstruct type"
+ type 'in name))))
+ (setf (defstruct-description-type) type)
+ (setf (defstruct-description-named-p)
+ (eq (defstruct-type-description-named-type) type)))
+ description))
+
+(defun defstruct-parse-items (items description)
+ (let ((name (defstruct-description-name))
+ (offset (defstruct-description-initial-offset))
+ (include (defstruct-description-include))
+ (o-slot-alist nil)
+ (conc-name (defstruct-description-conc-name)))
+ (or (null include)
+ (let ((d (get (car include) 'defstruct-description)))
+ (setq offset (+ offset (defstruct-description-size d)))
+ (setq o-slot-alist
+ (subst nil nil (defstruct-description-slot-alist d)))
+ (do ((l (cdr include) (cdr l))
+ (it) (val))
+ ((null l))
+ (cond ((atom (setq it (car l)))
+ (setq val (make-empty)))
+ (t
+ (setq val (cadr it))
+ (setq it (car it))))
+ (let ((slot-description (cdr (assq it o-slot-alist))))
+ (and (null slot-description)
+ (defstruct-error
+ "Unknown slot in included defstruct"
+ it 'in include 'included 'by name))
+ (setf (defstruct-slot-description-init-code) val)))))
+; PSL change 1+ ==> add1
+ (do ((i offset (add1 i))
+; (do ((i offset (1+ i))
+ (l items (cdr l))
+ (slot-alist nil)
+; PSL change
+ )
+; #+PDP10 (chars (exploden conc-name)))
+ ((null l)
+ (setq slot-alist (nreverse slot-alist))
+ (setf (defstruct-description-size) i)
+ (setf (defstruct-description-slot-alist)
+ (nconc o-slot-alist slot-alist))
+ slot-alist)
+ (cond ((atom (car l))
+ (push (defstruct-parse-one-field
+; PSL change
+ (car l) i nil nil conc-name)
+; (car l) i nil nil conc-name #+PDP10 chars)
+ slot-alist))
+ ((atom (caar l))
+ (push (defstruct-parse-one-field
+; PSL change
+ (caar l) i nil (cdar l) conc-name)
+; (caar l) i nil (cdar l) conc-name #+PDP10 chars)
+ slot-alist))
+ (t
+; PSL change old style DO
+ (do ((ll (car l) (cdr ll))) ((null ll))
+; (do ll (car l) (cdr ll) (null ll)
+ (push (defstruct-parse-one-field
+ (caar ll) i (cadar ll)
+; PSL change
+ (cddar ll) conc-name)
+; (cddar ll) conc-name #+PDP10 chars)
+ slot-alist)))))))
+
+; PSL change
+(defun defstruct-parse-one-field (it number ppss rest conc-name)
+;(defun defstruct-parse-one-field (it number ppss rest conc-name #+PDP10 chars)
+; PSL change
+ (let ((mname (if conc-name (intern (string-concat conc-name it))
+; (let ((mname (if conc-name #+PDP10 (implode (append chars (exploden it)))
+; #+Multics (make_atom (catenate conc-name it))
+; #+LispM (intern (string-append conc-name it))
+ it)))
+; PSL change bootstrap apparently doesn't work
+ (cons it
+ (let ((kludge (make-defstruct-slot-description)))
+ (setf (defstruct-slot-description-number kludge) number)
+ (setf (defstruct-slot-description-ppss kludge) ppss)
+ (setf (defstruct-slot-description-init-code kludge)
+ (if (null rest) (make-empty) (car rest)))
+ (setf (defstruct-slot-description-ref-macro-name kludge)
+ mname)
+ kludge))))
+; (cons it (make-defstruct-slot-description
+; number number
+; ppss ppss
+; init-code (if (null rest) (make-empty) (car rest))
+; ref-macro-name mname))))
+
+(defun defstruct-define-ref-macros (new-slots description)
+ (let ((name (defstruct-description-name))
+ (returns nil))
+ (if (not (defstruct-description-callable-accessors))
+ (do ((l new-slots (cdr l))
+; PSL change
+; #Q (parent `(,name defstruct))
+ (mname))
+ ((null l))
+ (setq mname (defstruct-slot-description-ref-macro-name (cdar l)))
+ (defstruct-put-macro mname 'defstruct-expand-ref-macro)
+ (defstruct-putprop mname (cons name (caar l)) 'defstruct-slot))
+ (let ((type-description
+ (get (defstruct-description-type)
+ 'defstruct-type-description)))
+ (let ((code (defstruct-type-description-ref-expander))
+ (n (defstruct-type-description-ref-no-args))
+ (but-first (defstruct-description-but-first))
+ (default-pointer (defstruct-description-default-pointer)))
+ (do ((args nil (cons (gensym) args))
+; PSL change 1- ==> sub1
+ (i n (sub1 i)))
+; (i n (1- i)))
+ ((< i 2)
+ ;;Last arg (if it exists) is name of structure,
+ ;; for documentation purposes.
+ (and (= i 1)
+ (setq args (cons name args)))
+ (let ((body (cons (if but-first
+ `(,but-first ,(car args))
+ (car args))
+ (cdr args))))
+ (and default-pointer
+ (setq args `((,(car args) ,default-pointer)
+ &optional . ,(cdr args))))
+ (setq args (reverse args))
+ (setq body (reverse body))
+ (do ((l new-slots (cdr l))
+ (mname))
+ ((null l))
+ (setq mname (defstruct-slot-description-ref-macro-name
+ (cdar l)))
+; PSL change
+; #M ;;This must come BEFORE the defun. THINK!
+ (defstruct-put-macro mname 'defstruct-expand-ref-macro)
+ (let ((ref (lexpr-funcall
+ code
+ (defstruct-slot-description-number (cdar l))
+ description
+ body))
+ (ppss (defstruct-slot-description-ppss (cdar l))))
+; PSL change
+ (push `(defun ,mname ,args
+; (push `(#M defun #Q defsubst-with-parent ,mname #Q ,parent ,args
+ ,(if (null ppss) ref `(ldb ,ppss ,ref)))
+ returns))
+ (defstruct-putprop mname
+ (cons name (caar l))
+ 'defstruct-slot))))))))
+ returns))
+
+; PSL change
+;#Q
+;(defprop defstruct-expand-cons-macro
+; defstruct-function-parent
+; macroexpander-function-parent)
+;
+;#Q
+;(defprop defstruct-expand-size-macro
+; defstruct-function-parent
+; macroexpander-function-parent)
+;
+;#Q
+;(defprop defstruct-expand-alter-macro
+; defstruct-function-parent
+; macroexpander-function-parent)
+;
+;#Q
+;(defprop defstruct-expand-ref-macro
+; defstruct-function-parent
+; macroexpander-function-parent)
+;
+;#Q
+;(defun defstruct-function-parent (sym)
+; (values (or (get sym 'defstruct-name)
+; (car (get sym 'defstruct-slot)))
+; 'defstruct))
+;
+(defun defstruct-expand-size-macro (x)
+ (let ((description (get-defstruct-description (get (car x) 'defstruct-name))))
+ (let ((type-description (or (get (defstruct-description-type)
+ 'defstruct-type-description)
+ (defstruct-error
+ "Unknown defstruct type"
+ (defstruct-description-type)))))
+ (funcall (defstruct-description-displace)
+ x
+ (+ (defstruct-description-size)
+ (defstruct-type-description-overhead))))))
+
+(defvar defstruct-ref-macro-name)
+
+(defun defstruct-expand-ref-macro (x)
+ (let* ((defstruct-ref-macro-name (car x))
+ (pair (get (car x) 'defstruct-slot))
+ (description (get-defstruct-description (car pair)))
+ (type-description (or (get (defstruct-description-type)
+ 'defstruct-type-description)
+ (defstruct-error
+ "Unknown defstruct type"
+ (defstruct-description-type))))
+ (code (defstruct-type-description-ref-expander))
+ (n (defstruct-type-description-ref-no-args))
+ (args (reverse (cdr x)))
+ (nargs (length args))
+ (default (defstruct-description-default-pointer))
+ (but-first (defstruct-description-but-first)))
+ (cond ((= n nargs)
+ (and but-first
+ (rplaca args `(,but-first ,(car args)))))
+; PSL change 1+ ==> add1
+ ((and (= n (add1 nargs)) default)
+; ((and (= n (1+ nargs)) default)
+ (setq args (cons (if but-first
+ `(,but-first ,default)
+ default)
+ args)))
+ (t
+ (defstruct-error
+ "Wrong number of args to an accessor macro" x)))
+ (let* ((slot-description
+ (cdr (or (assq (cdr pair)
+ (defstruct-description-slot-alist))
+ (defstruct-error
+ "This slot no longer exists in this structure"
+ (cdr pair) 'in (car pair)))))
+ (ref (lexpr-funcall
+ code
+ (defstruct-slot-description-number)
+ description
+ (nreverse args)))
+ (ppss (defstruct-slot-description-ppss)))
+ (funcall (defstruct-description-displace)
+ x
+ (if (null ppss)
+ ref
+ `(ldb ,ppss ,ref))))))
+
+(defun defstruct-parse-setq-style-slots (l slots others x)
+ (do ((l l (cddr l))
+ (kludge (cons nil nil)))
+ ((null l) kludge)
+ (or (and (cdr l)
+ (symbolp (car l)))
+ (defstruct-error
+ "Bad argument list to constructor or alterant macro" x))
+ (defstruct-make-init-dsc kludge (car l) (cadr l) slots others x)))
+
+(defun defstruct-make-init-dsc (kludge name code slots others x)
+ (let ((p (assq name slots)))
+ (if (null p)
+ (if (memq name others)
+ (push (cons name code) (cdr kludge))
+ (defstruct-error
+ "Unknown slot to constructor or alterant macro" name 'in x))
+ (let* ((slot-description (cdr p))
+ (number (defstruct-slot-description-number))
+ (ppss (defstruct-slot-description-ppss))
+ (dsc (assoc number (car kludge))))
+ (cond ((null dsc)
+ (setq dsc (list* number nil (make-empty) 0 0 nil))
+ (push dsc (car kludge))))
+ (cond ((null ppss)
+ (setf (car (cddr dsc)) code)
+ (setf (cadr dsc) t))
+ (t (cond ((and (numberp ppss) (numberp code))
+ (setf (ldb ppss (cadr (cddr dsc))) -1)
+ (setf (ldb ppss (caddr (cddr dsc))) code))
+ (t
+ (push (cons ppss code) (cdddr (cddr dsc)))))
+ (or (eq t (cadr dsc))
+ (push name (cadr dsc)))))))))
+
+(defun defstruct-code-from-dsc (dsc)
+ (let ((code (car (cddr dsc)))
+ (mask (cadr (cddr dsc)))
+ (bits (caddr (cddr dsc))))
+ (if (emptyp code)
+ (setq code bits)
+ (or (zerop mask)
+ (setq code (if (numberp code)
+ (boole 7 bits (boole 2 mask code))
+ (if (zerop (logand mask
+; PSL change (next 2 lines) 1+ => add1, 1- => sub1
+; (1+ (logior mask (1- mask)))))
+; (let ((ss (haulong (boole 2 mask (1- mask)))))
+ (add1 (logior mask(sub1 mask)))))
+ (let ((ss (haulong (boole 2 mask (sub1 mask)))))
+ `(dpb ,(lsh bits (- ss))
+ ,(logior (lsh ss 6)
+; PSL change
+ (logand 8#77
+; (logand #o77
+ (- (haulong mask) ss)))
+ ,code))
+ `(boole 7 ,bits (boole 2 ,mask ,code)))))))
+; PSL change old style DO
+ (do ((l (cdddr (cddr dsc)) (cdr l))) ((null l))
+; (do l (cdddr (cddr dsc)) (cdr l) (null l)
+ (setq code `(dpb ,(cdar l) ,(caar l) ,code)))
+ code))
+
+(defun defstruct-expand-cons-macro (x)
+ (let* ((description (get-defstruct-description (get (car x) 'defstruct-name)))
+ (type-description (or (get (defstruct-description-type)
+ 'defstruct-type-description)
+ (defstruct-error
+ "Unknown defstruct type"
+ (defstruct-description-type))))
+ (slot-alist (defstruct-description-slot-alist))
+ (cons-keywords (defstruct-type-description-cons-keywords))
+ inits kludge
+ (constructor-description
+ (cdr (or (assq (car x) (defstruct-description-constructors))
+ (defstruct-error
+ "This constructor is no longer defined for this structure"
+ (car x) 'in (defstruct-description-name)))))
+ (aux nil)
+ (aux-init nil))
+ (if (null constructor-description)
+ (setq kludge (defstruct-parse-setq-style-slots (cdr x)
+ slot-alist
+ cons-keywords
+ x))
+ (prog (args l)
+ (setq kludge (cons nil nil))
+ (setq args (cdr x))
+ (setq l (car constructor-description))
+ R (cond ((null l)
+ (if (null args)
+ (return nil)
+ (go barf-tma)))
+ ((atom l) (go barf))
+ ((eq (car l) '&optional) (go O))
+ ((eq (car l) '&rest) (go S))
+ ((eq (car l) '&aux) (go A))
+ ((null args) (go barf-tfa)))
+ (defstruct-make-init-dsc kludge
+ (pop l)
+ (pop args)
+ slot-alist
+ cons-keywords
+ x)
+ (go R)
+ O (and (null args) (go OD))
+ (pop l)
+ (cond ((null l) (go barf-tma))
+ ((atom l) (go barf))
+ ((eq (car l) '&optional) (go barf))
+ ((eq (car l) '&rest) (go S))
+ ((eq (car l) '&aux) (go barf-tma)))
+ (defstruct-make-init-dsc kludge
+ (if (atom (car l)) (car l) (caar l))
+ (pop args)
+ slot-alist
+ cons-keywords
+ x)
+ (go O)
+ OD (pop l)
+ (cond ((null l) (return nil))
+ ((atom l) (go barf))
+ ((eq (car l) '&optional) (go barf))
+ ((eq (car l) '&rest) (go S))
+ ((eq (car l) '&aux) (go A)))
+ (or (atom (car l))
+ (defstruct-make-init-dsc kludge
+ (caar l)
+ (cadar l)
+ slot-alist
+ cons-keywords
+ x))
+ (go OD)
+ S (and (atom (cdr l)) (go barf))
+ (defstruct-make-init-dsc kludge
+ (cadr l)
+ `(list . ,args)
+ slot-alist
+ cons-keywords
+ x)
+ (setq l (cddr l))
+ (and (null l) (return nil))
+ (and (atom l) (go barf))
+ (or (eq (car l) '&aux) (go barf))
+ A (pop l)
+ (cond ((null l) (return nil))
+ ((atom l) (go barf))
+ ((atom (car l))
+ (push (car l) aux)
+ (push (make-empty) aux-init))
+ (t
+ (push (caar l) aux)
+ (push (cadar l) aux-init)))
+ (go A)
+ barf (defstruct-error
+ "Bad format for defstruct constructor arglist"
+ `(,(car x) . ,(car constructor-description)))
+ barf-tfa (defstruct-error "Too few arguments to constructor macro" x)
+ barf-tma (defstruct-error "Too many arguments to constructor macro" x)))
+; PSL change old style DO
+ (do ((l slot-alist (cdr l))) ((null l))
+; (do l slot-alist (cdr l) (null l)
+ (let* ((name (caar l))
+ (slot-description (cdar l))
+ (code (do ((aux aux (cdr aux))
+ (aux-init aux-init (cdr aux-init)))
+ ((null aux) (defstruct-slot-description-init-code))
+ (and (eq name (car aux)) (return (car aux-init)))))
+ (ppss (defstruct-slot-description-ppss)))
+ (or (and (emptyp code) (null ppss))
+ (let* ((number (defstruct-slot-description-number))
+ (dsc (assoc number (car kludge))))
+ (cond ((null dsc)
+ (setq dsc (list number nil (make-empty) 0 0))
+ (setq dsc (list* number nil (make-empty) 0 0 nil))
+ (push dsc (car kludge))))
+ (cond ((emptyp code))
+ ((eq t (cadr dsc)))
+ ((null ppss)
+ (and (emptyp (car (cddr dsc)))
+ (setf (car (cddr dsc)) code)))
+ ((memq name (cadr dsc)))
+ ((and (numberp ppss) (numberp code))
+ (setf (ldb ppss (cadr (cddr dsc))) -1)
+ (setf (ldb ppss (caddr (cddr dsc))) code))
+ (t
+ (push (cons ppss code) (cdddr (cddr dsc)))))))))
+ (selectq (defstruct-type-description-cons-flavor)
+ (:list
+ (do ((l nil (cons nil l))
+; PSL change 1- ==> sub1
+ (i (defstruct-description-size) (sub1 i)))
+; (i (defstruct-description-size) (1- i)))
+ ((= i 0) (setq inits l)))
+; PSL change old style DO
+ (do ((l (car kludge) (cdr l))) ((null l))
+; (do l (car kludge) (cdr l) (null l)
+; PSL change incompatible NTH
+ (setf (nth inits (add1 (caar l)))
+; (setf (nth (caar l) inits)
+ (defstruct-code-from-dsc (car l)))))
+ (:alist
+ (setq inits (car kludge))
+; PSL change old style DO
+ (do ((l inits (cdr l))) ((null l))
+; (do l inits (cdr l) (null l)
+ (rplacd (car l) (defstruct-code-from-dsc (car l)))))
+ (otherwise
+ (defstruct-error
+ "Unknown constructor kind in this defstruct type"
+ (defstruct-description-type))))
+ (funcall (defstruct-description-displace)
+ x (funcall (defstruct-type-description-cons-expander)
+ inits description (cdr kludge)))))
+
+(defun defstruct-expand-alter-macro (x)
+ (let* ((description (get-defstruct-description (get (car x) 'defstruct-name)))
+ (type-description (or (get (defstruct-description-type)
+ 'defstruct-type-description)
+ (defstruct-error
+ "Unknown defstruct type"
+ (defstruct-description-type))))
+ (ref-code (defstruct-type-description-ref-expander)))
+ (or (= 1 (defstruct-type-description-ref-no-args))
+ (defstruct-error
+ "Alterant macros cannot handle this defstruct type"
+ (defstruct-description-type)))
+ (do ((l (car (defstruct-parse-setq-style-slots
+ (cddr x)
+ (defstruct-description-slot-alist)
+ nil
+ x))
+ (cdr l))
+ (but-first (defstruct-description-but-first))
+ (body nil)
+ (var (gensym))
+ (vars nil)
+ (vals nil))
+ ((null l)
+ (funcall (defstruct-description-displace)
+ x
+ `((lambda (,var)
+ . ,(if (null vars)
+ body
+ `(((lambda ,vars . ,body) . ,vals))))
+ ,(if but-first
+ `(,but-first ,(cadr x))
+ (cadr x)))))
+ (let ((ref (funcall ref-code (caar l) description var)))
+ (and (emptyp (car (cddr (car l))))
+ (setf (car (cddr (car l))) ref))
+ (let ((code (defstruct-code-from-dsc (car l))))
+ (if (null (cdr l))
+ (push `(setf ,ref ,code) body)
+ (let ((sym (gensym)))
+ (push `(setf ,ref ,sym) body)
+ (push sym vars)
+ (push code vals))))))))
+
+(defmacro defstruct-define-type (type . options)
+ (do ((options options (cdr options))
+ (op) (args)
+ (type-description (make-defstruct-type-description))
+ (cons-expander nil)
+ (ref-expander nil)
+ (defstruct-expander nil))
+ ((null options)
+ (or cons-expander
+ (defstruct-error "No cons option in defstruct-define-type" type))
+ (or ref-expander
+ (defstruct-error "No ref option in defstruct-define-type" type))
+ `(progn 'compile
+ ,cons-expander
+ ,ref-expander
+ ,@(and defstruct-expander (list defstruct-expander))
+ (defprop ,type ,type-description defstruct-type-description)))
+ (cond ((atom (setq op (car options)))
+ (setq args nil))
+ (t
+ (setq args (cdr op))
+ (setq op (car op))))
+; PSL change
+;#Q AGAIN
+ (selectq op
+ (:cons
+ (or (> (length args) 2)
+ (defstruct-error
+ "Bad cons option in defstruct-define-type"
+ (car options) 'in type))
+ (let ((n (length (car args)))
+; PSL change
+ (name (append-symbols type '\-defstruct-cons)))
+; (name (append-symbols type '-defstruct-cons)))
+ (or (= n 3)
+ (defstruct-error
+ "Bad cons option in defstruct-define-type"
+ (car options) 'in type))
+ (setf (defstruct-type-description-cons-flavor)
+ #-LispM (cadr args)
+; PSL change
+ )
+; #+LispM (intern (string (cadr args)) si:pkg-user-package))
+ (setf (defstruct-type-description-cons-expander) name)
+ (setq cons-expander `(defun ,name ,(car args)
+ . ,(cddr args)))))
+ (:ref
+ (or (> (length args) 1)
+ (defstruct-error
+ "Bad ref option in defstruct-define-type"
+ (car options) 'in type))
+ (let ((n (length (car args)))
+; PSL change
+ (name (append-symbols type '\-defstruct-ref)))
+; (name (append-symbols type '-defstruct-ref)))
+ (or (> n 2)
+ (defstruct-error
+ "Bad ref option in defstruct-define-type"
+ (car options) 'in type))
+ (setf (defstruct-type-description-ref-no-args) (- n 2))
+ (setf (defstruct-type-description-ref-expander) name)
+ (setq ref-expander `(defun ,name ,(car args)
+ . ,(cdr args)))))
+ (:overhead
+ (setf (defstruct-type-description-overhead)
+ (if (null args)
+ (defstruct-error
+ "Bad option to defstruct-define-type"
+ (car options) 'in type)
+ (car args))))
+ (:named
+ (setf (defstruct-type-description-named-type)
+ (if (null args)
+ type
+ (car args))))
+ (:keywords
+ (setf (defstruct-type-description-cons-keywords) args))
+ (:defstruct
+ (or (> (length args) 1)
+ (defstruct-error
+ "Bad defstruct option in defstruct-define-type"
+ (car options) 'in type))
+; PSL change
+ (let ((name (append-symbols type '\-defstruct-expand)))
+; (let ((name (append-symbols type '-defstruct-expand)))
+ (setf (defstruct-type-description-defstruct-expander) name)
+ (setq defstruct-expander `(defun ,name . ,args))))
+ (otherwise
+; PSL change
+; #Q (multiple-value-bind (new foundp)
+; (intern-soft op si:pkg-user-package)
+; (or (not foundp)
+; (eq op new)
+; (progn (setq op new) (go AGAIN))))
+ (defstruct-error
+ "Unknown option to defstruct-define-type"
+ (car options) 'in type)))))
+
+; PSL change
+;#Q
+;(defprop :make-array t :defstruct-option)
+;
+;(defstruct-define-type :array
+; #Q (:named :named-array)
+; #Q (:keywords :make-array)
+; (:cons
+; (arg description etc) :alist
+; #M etc ;ignored in MacLisp
+; #Q (lispm-array-for-defstruct arg #'(lambda (v a i) `(aset ,v ,a ,i))
+; description etc nil nil nil 1)
+; #M (maclisp-array-for-defstruct arg description 't))
+; (:ref
+; (n description arg)
+; description ;ignored
+; #M `(arraycall t ,arg ,n)
+; #Q `(aref ,arg ,n)))
+;
+;#Q
+;(defstruct-define-type :named-array
+; (:keywords :make-array)
+; :named (:overhead 1)
+; (:cons
+; (arg description etc) :alist
+; (lispm-array-for-defstruct arg #'(lambda (v a i) `(aset ,v ,a ,(1+ i)))
+; description etc nil t nil 1))
+; (:ref (n description arg)
+; description ;ignored
+; `(aref ,arg ,(1+ n))))
+;
+;(defstruct-define-type :fixnum-array
+; #Q (:keywords :make-array)
+; (:cons
+; (arg description etc) :alist
+; #M etc ;ignored in MacLisp
+; #Q (lispm-array-for-defstruct arg #'(lambda (v a i) `(aset ,v ,a ,i))
+; description etc 'art-32b nil nil 1)
+; #M (maclisp-array-for-defstruct arg description 'fixnum))
+; (:ref
+; (n description arg)
+; description ;ignored
+; #M `(arraycall fixnum ,arg ,n)
+; #Q `(aref ,arg ,n)))
+;
+;(defstruct-define-type :flonum-array
+; #Q (:keywords :make-array)
+; (:cons
+; (arg description etc) :alist
+; #M etc ;ignored in MacLisp
+; #Q (lispm-array-for-defstruct arg #'(lambda (v a i) `(aset ,v ,a ,i))
+; description etc 'art-float nil nil 1)
+; #M (maclisp-array-for-defstruct arg description 'flonum))
+; (:ref
+; (n description arg)
+; description ;ignored
+; #M `(arraycall flonum ,arg ,n)
+; #Q `(aref ,arg ,n)))
+;
+;#M
+;(defstruct-define-type :un-gc-array
+; (:cons
+; (arg description etc) :alist
+; etc ;ignored
+; (maclisp-array-for-defstruct arg description 'nil))
+; (:ref
+; (n description arg)
+; description ;ignored
+; `(arraycall nil ,arg ,n)))
+;
+;#Q
+;(defstruct-define-type :array-leader
+; (:named :named-array-leader)
+; (:keywords :make-array)
+; (:cons
+; (arg description etc) :alist
+; (lispm-array-for-defstruct arg #'(lambda (v a i)
+; `(store-array-leader ,v ,a ,i))
+; description etc nil nil t 1))
+; (:ref
+; (n description arg)
+; description ;ignored
+; `(array-leader ,arg ,n)))
+;
+;#Q
+;(defstruct-define-type :named-array-leader
+; (:keywords :make-array)
+; :named (:overhead 1)
+; (:cons
+; (arg description etc) :alist
+; (lispm-array-for-defstruct
+; arg
+; #'(lambda (v a i)
+; `(store-array-leader ,v ,a ,(if (zerop i)
+; 0
+; (1+ i))))
+; description etc nil t t 1))
+; (:ref
+; (n description arg)
+; description ;ignored
+; (if (zerop n)
+; `(array-leader ,arg 0)
+; `(array-leader ,arg ,(1+ n)))))
+;
+;#Q
+;(defprop :times t :defstruct-option)
+;
+;#Q
+;(defstruct-define-type :grouped-array
+; (:keywords :make-array :times)
+; (:cons
+; (arg description etc) :alist
+; (lispm-array-for-defstruct
+; arg
+; #'(lambda (v a i) `(aset ,v ,a ,i))
+; description etc nil nil nil
+; (or (cdr (or (assq ':times etc)
+; (assq ':times (defstruct-description-property-alist))))
+; 1)))
+; (:ref
+; (n description index arg)
+; description ;ignored
+; (cond ((numberp index)
+; `(aref ,arg ,(+ n index)))
+; ((zerop n)
+; `(aref ,arg ,index))
+; (t `(aref ,arg (+ ,n ,index))))))
+;
+;#Q
+;(defun lispm-array-for-defstruct (arg cons-init description etc type named-p leader-p times)
+; (let ((p (cons nil nil))
+; (no-op 'nil))
+; (defstruct-grok-make-array-args
+; (cdr (assq ':make-array (defstruct-description-property-alist)))
+; p)
+; (defstruct-grok-make-array-args
+; (cdr (assq ':make-array etc))
+; p)
+; (and type (putprop p type ':type))
+; (and named-p (putprop p `',(defstruct-description-name) ':named-structure-symbol))
+; (putprop p
+; (let ((size (if named-p
+; (1+ (defstruct-description-size))
+; (defstruct-description-size))))
+; (if (numberp times)
+; (* size times)
+; `(* ,size ,times)))
+; (if leader-p ':leader-length ':dimensions))
+; (or leader-p
+; (let ((type (get p ':type)))
+; (or (atom type)
+; (not (eq (car type) 'quote))
+; (setq type (cadr type)))
+; (caseq type
+; ((nil art-q art-q-list))
+; ((art-32b art-16b art-8b art-4b art-2b art-1b art-string) (setq no-op '0))
+; ((art-float) (setq no-op '0.0))
+; (t (setq no-op (make-empty))))))
+; (do ((creator
+; (let ((dims (remprop p ':dimensions)))
+; (do l (cdr p) (cddr l) (null l)
+; (rplaca l `',(car l)))
+; `(make-array ,(if (null dims) 0 (car dims)) ,@(cdr p))))
+; (var (gensym))
+; (set-ups nil (if (equal (cdar l) no-op)
+; set-ups
+; (cons (funcall cons-init (cdar l) var (caar l))
+; set-ups)))
+; (l arg (cdr l)))
+; ((null l)
+; (if set-ups
+; `((lambda (,var)
+; ,@(nreverse set-ups)
+; ,var)
+; ,creator)
+; creator)))))
+;
+;#Q
+;(defun defstruct-grok-make-array-args (args p)
+; (let ((nargs (length args)))
+; (if (and (not (> nargs 7))
+; (or (oddp nargs)
+; (do ((l args (cddr l)))
+; ((null l) nil)
+; (or (memq (car l) '(:area :type :displaced-to :leader-list
+; :leader-length :displaced-index-offset
+; :named-structure-symbol :dimensions
+; :length))
+; (return t)))))
+; (do ((l args (cdr l))
+; (keylist '(:area :type :dimensions :displaced-to :old-leader-length-or-list
+; :displaced-index-offset :named-structure-symbol)
+; (cdr keylist)))
+; ((null l)
+; (and (boundp 'compiler:compiler-warnings-context)
+; (boundp 'compiler:last-error-function)
+; (not (null compiler:compiler-warnings-context))
+; (compiler:barf args '|-- old style :MAKE-ARRAY constructor keyword argument|
+; 'compiler:warn))
+; p)
+; (putprop p (car l) (car keylist)))
+; (do ((l args (cddr l)))
+; ((null l) p)
+; (if (or (null (cdr l))
+; (not (memq (car l) '(:area :type :displaced-to :leader-list
+; :leader-length :displaced-index-offset
+; :named-structure-symbol :dimensions
+; :length))))
+; (defstruct-error
+; "defstruct can't grok these make-array arguments"
+; args))
+; (putprop p
+; (cadr l)
+; (if (eq (car l) ':length)
+; ':dimensions
+; (car l)))))))
+;
+;#M
+;(defun maclisp-array-for-defstruct (arg description type)
+; (do ((creator `(array nil ,type ,(defstruct-description-size)))
+; (var (gensym))
+; (no-op (caseq type
+; (fixnum 0)
+; (flonum 0.0)
+; ((t nil) nil)))
+; (set-ups nil (if (equal (cdar l) no-op)
+; set-ups
+; (cons `(store (arraycall ,type ,var ,(caar l))
+; ,(cdar l))
+; set-ups)))
+; (l arg (cdr l)))
+; ((null l)
+; (if set-ups
+; `((lambda (,var)
+; ,@(nreverse set-ups)
+; ,var)
+; ,creator)
+; creator))))
+;
+;#+PDP10
+;(defprop :sfa-function t :defstruct-option)
+;
+;#+PDP10
+;(defprop :sfa-name t :defstruct-option)
+;
+;#+PDP10
+;(defstruct-define-type :sfa
+; (:keywords :sfa-function :sfa-name)
+; (:cons
+; (arg description etc) :alist
+; (do ((creator `(sfa-create ,(or (cdr (or (assq ':sfa-function etc)
+; (assq ':sfa-function (defstruct-description-property-alist))))
+; `',(defstruct-description-name))
+; ,(defstruct-description-size)
+; ,(or (cdr (or (assq ':sfa-name etc)
+; (assq ':sfa-name (defstruct-description-property-alist))))
+; `',(defstruct-description-name))))
+; (l arg (cdr l))
+; (var (gensym))
+; (set-ups nil (if (null (cdar l))
+; set-ups
+; (cons `(sfa-store ,var ,(caar l)
+; ,(cdar l))
+; set-ups))))
+; ((null l)
+; (if set-ups
+; `((lambda (,var)
+; ,@(nreverse set-ups)
+; ,var)
+; ,creator)
+; creator))))
+; (:ref
+; (n description arg)
+; description ;ignored
+; `(sfa-get ,arg ,n)))
+;
+;#+PDP10
+;(defstruct-define-type :hunk
+; (:named :named-hunk)
+; (:cons
+; (arg description etc) :list
+; description ;ignored
+; etc ;ignored
+; (if arg
+; `(hunk . ,(nconc (cdr arg) (ncons (car arg))))
+; (defstruct-error "No slots in hunk type defstruct")))
+; (:ref
+; (n description arg)
+; description ;ignored
+; `(cxr ,n ,arg)))
+;
+;#+PDP10
+;(defstruct-define-type :named-hunk
+; :named (:overhead 1)
+; (:cons
+; (arg description etc) :list
+; etc ;ignored
+; (if arg
+; `(hunk ',(defstruct-description-name)
+; . ,(nconc (cdr arg) (ncons (car arg))))
+; `(hunk ',(defstruct-description-name) nil)))
+; (:ref
+; (n description arg)
+; description ;ignored
+; (cond ((= n 0) `(cxr 0 ,arg))
+; (t `(cxr ,(1+ n) ,arg)))))
+;
+
+; PSL change
+;#+(or PDP10 NIL)
+(defstruct-define-type :vector
+ (:named :named-vector)
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(vector ,@arg))
+ (:ref
+ (n description arg)
+ description ;ignored
+ `(vref ,arg ,n)))
+
+;added for PSL
+
+(defstruct-define-type :named-vector
+ (:keywords :make-vector)
+ :named (:overhead 1)
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(vector ',(defstruct-description-name) ,@arg))
+ (:ref
+ (n description arg)
+ description ;ignored
+ `(vref ,arg ,(add1 n))))
+
+;#+(or PDP10 NIL)
+;;;;Do this (much) better someday:
+;(defstruct-define-type :extend
+; :named
+; (:defstruct (description)
+; (and (defstruct-description-include)
+; (error "--structure of type extend cannot include another."
+; (defstruct-description-name)))
+; (let* ((name (defstruct-description-name))
+; (ica-name (append-symbols 'internal-cons-a- name))
+; (v-slots nil))
+; (do ((i (defstruct-description-size) (1- i)))
+; ((zerop i))
+; (push (do ((l (defstruct-description-slot-alist) (cdr l))
+; (n (1- i)))
+;; ((null l) (let ((base 10.)
+; (*nopoint t))
+; (implode (cons #/# (exploden n)))))
+; (let ((slot-description (cdar l)))
+; (and (= (defstruct-slot-description-number) n)
+; (null (defstruct-slot-description-ppss))
+; (return (caar l)))))
+; v-slots))
+; (push (cons 'extend-internal-conser ica-name)
+; (defstruct-description-property-alist))
+; `((defvst (,name (no-selector-macros) (constructor ,ica-name))
+; ,@v-slots))))
+; (:cons (arg description etc) alist
+; etc ;ignored
+; (do ((alist arg (cdr alist))
+; (var (gensym))
+; (name (defstruct-description-name))
+; (conser `(,(cdr (assq 'extend-internal-conser
+; (defstruct-description-property-alist)))))
+; (inits nil (if (null (cdar alist))
+; inits
+; (cons `(setf (|defvst-reference-by-name/||
+; ,name ,(caar alist) ,conser ,var)
+; ,(cdar alist))
+; inits))))
+; ((null alist)
+; (if (null inits)
+; conser
+; `((lambda (,var)
+; ,.inits
+; ,var)
+; ,conser)))))
+; (:ref (n description arg)
+; `(|defvst-reference-by-name/||
+; ,(defstruct-description-name) ,n ,defstruct-ref-macro-name ,arg)))
+;
+(defstruct-define-type :list
+ (:named :named-list)
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(list . ,arg))
+ (:ref
+ (n description arg)
+ description ;ignored
+ #+Multics `(,(let ((i (\ n 4)))
+ (cond ((= i 0) 'car)
+ ((= i 1) 'cadr)
+ ((= i 2) 'caddr)
+ (t 'cadddr)))
+ ,(do ((a arg `(cddddr ,a))
+ (i (// n 4) (1- i)))
+ ((= i 0) a)))
+; PSL change incompatible NTH
+ #-Multics `(nth ,arg ,(add1 n))))
+; #-Multics `(nth ,n ,arg)))
+
+(defstruct-define-type :named-list
+ :named (:overhead 1)
+ (:cons
+ (arg description etc) :list
+ etc ;ignored
+ `(list ',(defstruct-description-name) . ,arg))
+ (:ref
+ (n description arg)
+ description ;ignored
+; #+Multics `(,(let ((i (\ (1+ n) 4)))
+; (cond ((= i 0) 'car)
+; ((= i 1) 'cadr)
+; ((= i 2) 'caddr)
+; (t 'cadddr)))
+; ,(do ((a arg `(cddddr ,a))
+; (i (// (1+ n) 4) (1- i)))
+; ((= i 0) a)))
+; PSL change incompatible NTH
+ #-Multics `(nth ,arg ,(+ n 2))))
+; #-Multics `(nth ,(1+ n) ,arg)))
+
+(defstruct-define-type :list*
+ (:cons
+ (arg description etc) :list
+ description ;ignored
+ etc ;ignored
+ `(list* . ,arg))
+ (:ref
+ (n description arg)
+; PSL change 1- ==> sub1
+ (let ((size (sub1 (defstruct-description-size))))
+; (let ((size (1- (defstruct-description-size))))
+ #+Multics (do ((a arg `(cddddr ,a))
+ (i (// n 4) (1- i)))
+ ((= i 0)
+ (let* ((i (\ n 4))
+ (a (cond ((= i 0) a)
+ ((= i 1) `(cdr ,a))
+ ((= i 2) `(cddr ,a))
+ (t `(cdddr ,a)))))
+ (if (< n size) `(car ,a) a))))
+ #-Multics (if (< n size)
+; PSL change incompatible NTH
+ `(nth ,arg ,(add1 n))
+ `(pnth ,arg ,(add1 n)))))
+; `(nth ,n ,arg)
+; `(nthcdr ,n ,arg))))
+ (:defstruct (description)
+ (and (defstruct-description-include)
+ (defstruct-error
+ "Structure of type list* cannot include another"
+ (defstruct-description-name)))
+ nil))
+
+(defstruct-define-type :tree
+ (:cons
+ (arg description etc) :list
+ etc ;ignored
+ (if (null arg) (defstruct-error
+ "defstruct cannot make an empty tree"
+ (defstruct-description-name)))
+ (make-tree-for-defstruct arg (defstruct-description-size)))
+ (:ref
+ (n description arg)
+ (do ((size (defstruct-description-size))
+ (a arg)
+ (tem))
+ (())
+ (cond ((= size 1) (return a))
+; PSL change // ==> /
+ ((< n (setq tem (/ size 2)))
+; ((< n (setq tem (// size 2)))
+ (setq a `(car ,a))
+ (setq size tem))
+ (t (setq a `(cdr ,a))
+ (setq size (- size tem))
+ (setq n (- n tem))))))
+ (:defstruct (description)
+ (and (defstruct-description-include)
+ (defstruct-error
+ "Structure of type tree cannot include another"
+ (defstruct-description-name)))
+ nil))
+
+(defun make-tree-for-defstruct (arg size)
+ (cond ((= size 1) (car arg))
+ ((= size 2) `(cons ,(car arg) ,(cadr arg)))
+ (t (do ((a (cdr arg) (cdr a))
+; PSL change // ==> /, 1- ==> sub1
+ (m (/ size 2))
+ (n (sub1 (/ size 2)) (sub1 n)))
+; (m (// size 2))
+; (n (1- (// size 2)) (1- n)))
+ ((zerop n)
+ `(cons ,(make-tree-for-defstruct arg m)
+ ,(make-tree-for-defstruct a (- size m))))))))
+
+;(defstruct-define-type :fixnum
+; (:cons
+; (arg description etc) :list
+; etc ;ignored
+; (and (or (null arg)
+; (not (null (cdr arg))))
+; (defstruct-error
+; "Structure of type fixnum must have exactly 1 slot to be constructable"
+; (defstruct-description-name)))
+; (car arg))
+; (:ref
+; (n description arg)
+; n ;ignored
+; description ;ignored
+; arg))
+;
+#+Multics
+(defprop :external-ptr t :defstruct-option)
+
+#+Multics
+(defstruct-define-type :external
+ (:keywords :external-ptr)
+ (:cons (arg description etc) :alist
+ (let ((ptr (cdr (or (assq ':external-ptr etc)
+ (assq ':external-ptr
+ (defstruct-description-property-alist))
+ (defstruct-error
+ "No pointer given for external array"
+ (defstruct-description-name))))))
+ (do ((creator `(array nil external ,ptr ,(defstruct-description-size)))
+ (var (gensym))
+ (alist arg (cdr alist))
+ (inits nil (cons `(store (arraycall fixnum ,var ,(caar alist))
+ ,(cdar alist))
+ inits)))
+ ((null alist)
+ (if (null inits)
+ creator
+ `((lambda (,var) ,.inits ,var)
+ ,creator))))))
+ (:ref (n description arg)
+ description ;ignored
+ `(arraycall fixnum ,arg ,n)))
+
+;(defvar *defstruct-examine&deposit-arg*)
+;
+;(defun defstruct-examine (*defstruct-examine&deposit-arg*
+; name slot-name)
+; (eval (list (defstruct-slot-description-ref-macro-name
+; (defstruct-examine&deposit-find-slot-description
+; name slot-name))
+; '*defstruct-examine&deposit-arg*)))
+;
+;(defvar *defstruct-examine&deposit-val*)
+;
+;(defun defstruct-deposit (*defstruct-examine&deposit-val*
+; *defstruct-examine&deposit-arg*
+; name slot-name)
+; (eval (list 'setf
+; (list (defstruct-slot-description-ref-macro-name
+; (defstruct-examine&deposit-find-slot-description
+; name slot-name))
+; '*defstruct-examine&deposit-arg*)
+; '*defstruct-examine&deposit-val*)))
+
+;#Q
+;(defun defstruct-get-locative (*defstruct-examine&deposit-arg*
+; name slot-name)
+; (let ((slot-description (defstruct-examine&deposit-find-slot-description
+; name slot-name)))
+; (or (null (defstruct-slot-description-ppss))
+; (defstruct-error
+; "You cannot get a locative to a byte field"
+; slot-name 'in name))
+; (eval (list 'locf
+; (list (defstruct-slot-description-ref-macro-name)
+; '*defstruct-examine&deposit-arg*)))))
+;
+;(defun defstruct-examine&deposit-find-slot-description (name slot-name)
+; (let ((description (get-defstruct-description name)))
+; (let ((slot-description
+; (cdr (or (assq slot-name (defstruct-description-slot-alist))
+; (defstruct-error
+; "No such slot in this structure"
+; slot-name 'in name))))
+; (type-description
+; (or (get (defstruct-description-type) 'defstruct-type-description)
+; (defstruct-error
+; "Undefined defstruct type"
+; (defstruct-description-type)))))
+; (or (= (defstruct-type-description-ref-no-args) 1)
+; (defstruct-error
+; "defstruct-examine and defstruct-deposit cannot handle structures of this type"
+; (defstruct-description-type)))
+; slot-description)))
+;
+; PSL change
+;#+PDP10
+;(defprop defstruct
+; #.(and (status feature PDP10)
+; (caddr (truename infile)))
+; version)
+;
+;(sstatus feature defstruct)
ADDED psl-1983/3-1/util/numeric-operators.sl
Index: psl-1983/3-1/util/numeric-operators.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/numeric-operators.sl
@@ -0,0 +1,210 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Numeric-Operators.SL - Definitions of Numeric Operators with "Fast" Option
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 7 January 1983 (based on the earlier Fast-Int module)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Edit by Cris Perdue, 7 Mar 1983 1131-PST
+% Redefined + and * to take any number of arguments.
+% This involved defining exprs fast-plus and fast-times.
+% Added an error check to - and /
+
+% WARNING: + and * are no longer exprs. Code using this module and COMPILED
+% with the fast-integers switch set to NIL will not work until it is
+% recompiled. /csp
+
+% Note: This must be LOAD, not IMPORTS. Common also defines +, others. /csp
+(BothTimes (load common useful))
+
+% This file defines a set of C-like numeric operators that are a superset of the
+% numeric operators defined by the Common Lisp compatibility package.
+
+% The operators are:
+%
+% = Numeric Equal
+% /= Numeric Not Equal (common lisp)
+% ~= Numeric Not Equal (CLU)
+% < Numeric Less Than
+% > Numeric Greater Than
+% <= Numeric Less Than or Equal
+% >= Numeric Greater Than or Equal
+% + Numeric Addition
+% - Numeric Minus or Subtraction
+% * Numeric Multiplication
+% / Numeric Division
+% // Numeric Remainder
+% ~ Integer Bitwise Logical Not
+% & Integer Bitwise Logical And
+% | Integer Bitwise Logical Or
+% ^ Integer Bitwise Logical Xor
+% << Integer Bitwise Logical Left Shift
+% >> Integer Bitwise Logical Right Shift
+
+% +, -, *, and / are defined as in Common LISP, but when compiled they
+% do open-coded arithmetic only, just like all the other operators.
+% The arithmetic relational operators all take exactly 2 arguments,
+% unlike the genuine Common LISP versions.
+
+% The switch FAST-INTEGERS controls an option that provides for an efficient
+% compiled implementation of these operators using Syslisp arithmetic. When the
+% switch is on, uses of these operators will compile into the corresponding
+% Syslisp arithmetic operators, which generally are open-compiled and fast.
+% However, the Syslisp operators perform machine arithmetic on untagged
+% integers: they will work only if their inputs are untagged integers, and they
+% produce untagged integer outputs. The (undocumented) functions Int2Sys and
+% Sys2Int can be used to convert between tagged Lisp integers and Syslisp
+% integers; however, no conversion is needed to convert between INUMs and
+% Syslisp integers within the valid range of INUMs.
+
+% This module modifies the FOR macro to use the numeric operators to implement
+% the FROM clause; thus, the FOR statement will use Syslisp arithmetic when the
+% FAST-INTEGERS switch is on.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% The Implementation:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Generic definitions of functions defined in the Common Lisp package:
+
+(de = (a b) (EqN a b))
+(de < (a b) (LessP a b))
+(de > (a b) (GreaterP a b))
+(de <= (a b) (LEq a b))
+(de >= (a b) (GEq a b))
+
+(defmacro + args
+ (cond ((null args) 0)
+ ((null (rest args))
+ (first args))
+ ((null (cddr args))
+ `(fast-plus ,@args))
+ (t (left-expand args 'fast-plus))))
+
+(defmacro * args
+ (cond ((null args) 1)
+ ((null (rest args))
+ (first args))
+ ((null (cddr args))
+ `(fast-times ,@args))
+ (t (left-expand args 'fast-times))))
+
+(defmacro - args
+ (cond ((null args)
+ (stderror "No args supplied to ""-"""))
+ ((null (cdr args))
+ `(fast-minus ,@args))
+ ((null (cddr args))
+ `(fast-difference ,@args))
+ (t (left-expand args 'fast-difference))))
+
+(defmacro / args
+ (cond ((null args)
+ (stderror "No args supplied to ""/"""))
+ ((null (cdr args))
+ `(recip ,(car args)))
+ ((null (cddr args))
+ `(fast-quotient ,@args))
+ (t (left-expand args 'fast-quotient))))
+
+% Generic definitions of functions not defined by the Common Lisp package:
+
+(de ~= (a b) (not (EqN a b)))
+(de fast-plus (a b) (Plus a b))
+(de fast-times (a b) (Times a b))
+(de fast-minus (a) (Minus a))
+(de fast-difference (a b) (Difference a b))
+(de fast-quotient (a b) (Quotient a b))
+(de // (a b) (Remainder a b))
+(de ~ (a) (LNot a))
+(de & (a b) (LAnd a b))
+(de | (a b) (LOr a b))
+(de ^ (a b) (LXor a b))
+(de << (a b) (LShift a b))
+(de >> (a b) (LShift a (Minus b)))
+
+% Enable and Disable "fast" compiled definitions:
+
+(fluid '(*fast-integers))
+(put 'fast-integers 'simpfg '((T (enable-fast-numeric-operators))
+ (NIL (disable-fast-numeric-operators))
+ ))
+
+(de enable-fast-numeric-operators ()
+ (put '= 'cmacro '(lambda (a b) (WEQ a b)))
+ (put '/= 'cmacro '(lambda (a b) (WNEQ a b)))
+ (put '~= 'cmacro '(lambda (a b) (WNEQ a b)))
+ (put '< 'cmacro '(lambda (a b) (WLessP a b)))
+ (put '> 'cmacro '(lambda (a b) (WGreaterP a b)))
+ (put '<= 'cmacro '(lambda (a b) (WLEQ a b)))
+ (put '>= 'cmacro '(lambda (a b) (WGEQ a b)))
+ (put 'fast-plus 'cmacro '(lambda (a b) (WPlus2 a b)))
+ (put 'fast-difference 'cmacro '(lambda (a b) (WDifference a b)))
+ (put 'fast-minus 'cmacro '(lambda (a) (WDifference 0 a)))
+ (put 'fast-times 'cmacro '(lambda (a b) (WTimes2 a b)))
+ (put 'fast-quotient 'cmacro '(lambda (a b) (WQuotient a b)))
+ (put '// 'cmacro '(lambda (a b) (WRemainder a b)))
+ (put '~ 'cmacro '(lambda (a) (WNot a)))
+ (put '& 'cmacro '(lambda (a b) (WAnd a b)))
+ (put '| 'cmacro '(lambda (a b) (WOr a b)))
+ (put '^ 'cmacro '(lambda (a b) (WXor a b)))
+ (put '<< 'cmacro '(lambda (a b) (WShift a b)))
+ (put '>> 'cmacro '(lambda (a b) (WShift a (WDifference 0 b))))
+ )
+
+(de disable-fast-numeric-operators ()
+ (remprop '= 'cmacro)
+ (remprop '/= 'cmacro)
+ (remprop '~= 'cmacro)
+ (remprop '< 'cmacro)
+ (remprop '> 'cmacro)
+ (remprop '<= 'cmacro)
+ (remprop '>= 'cmacro)
+ (remprop '+ 'cmacro)
+ (remprop 'fast-difference 'cmacro)
+ (remprop 'fast-minus 'cmacro)
+ (remprop '* 'cmacro)
+ (remprop 'fast-quotient 'cmacro)
+ (remprop '// 'cmacro)
+ (remprop '~ 'cmacro)
+ (remprop '& 'cmacro)
+ (remprop '| 'cmacro)
+ (remprop '^ 'cmacro)
+ (remprop '<< 'cmacro)
+ (remprop '>> 'cmacro)
+ )
+
+% Here we redefine the FROM clause of FOR statements:
+
+(fluid '(for-vars* for-outside-vars* for-tests* for-prologue* for-conditions*
+ for-body* for-epilogue* for-result*))
+
+(de for-from-function (clause)
+ (let* ((var (car clause))
+ (var1 (if (pairp var) (car var) var))
+ (clause (cdr clause))
+ (init (if (pairp clause) (or (pop clause) 1) 1))
+ (fin (if (pairp clause) (pop clause) nil))
+ (fin-var (if (and fin (not (numberp fin))) (gensym) nil))
+ (step (if (pairp clause) (car clause) 1))
+ (step-var (if (and step (not (numberp step))) (gensym) nil)))
+ (tconc
+ for-vars*
+ (list* var init (cond
+ (step-var `((+ ,var1 ,step-var)))
+ ((zerop step) nil)
+ ((onep step) `((+ ,var1 1)))
+ ((eqn step -1) `((- ,var1 1)))
+ (t `((+ ,var1 ,step))))))
+ (if fin-var (tconc for-vars* `(,fin-var ,fin)))
+ (if step-var (tconc for-vars* `(,step-var ,step)))
+ (cond (step-var
+ (tconc for-tests* `(if (< ,step-var 0)
+ (< ,var1 ,(or fin-var fin))
+ (> ,var1 ,(or fin-var fin)))))
+ ((null fin))
+ ((minusp step) (tconc for-tests* `(< ,var1 ,(or fin-var fin))))
+ (t (tconc for-tests* `(> ,var1 ,(or fin-var fin)))))))
ADDED psl-1983/3-1/util/objects.sl
Index: psl-1983/3-1/util/objects.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/objects.sl
@@ -0,0 +1,921 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Objects.SL - A simple facility for object-oriented programming.
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 22 July 1982
+% Revised: 16 February 1983
+%
+% 16-Feb-83 Alan Snyder
+% Add ev-send function. Rename declare and undeclare to declare-flavor
+% and undeclare-flavor, to avoid conflict with common lisp declare.
+% 30-Dec-82 Alan Snyder
+% General clean-up; rename internal functions and variables; document
+% method lookup functions; add method lookup trace facility.
+% 1-Nov-82 Alan Snyder
+% Added Object-Type function.
+% 27-Sept-82 Alan Snyder
+% Removed Variable-Table (which was available only at compile-time); made
+% Variable-Names available at both compile-time and load-time; now use
+% Variable-Names to "compile" method bodies. Result: now can compile new
+% method bodies after loading a "compiled" flavor definition.
+% 27-Sept-82 Alan Snyder
+% Evaluating (or loading) a DEFFLAVOR no longer clears the method table, if it
+% had been defined previously.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(Bothtimes (imports '(common fast-vector)))
+(imports '(association strings))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% NOTE: THIS FILE DEFINES MACROS. IT MUST BE LOADED BEFORE ANY OF THESE
+% FUNCTIONS ARE USED. The recommended way to do this is to put the statement
+% (BothTimes (load objects)) at the beginning of your source file.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Summary of Public Functions:
+%
+% (defflavor flavor-name (var1 var2 ...) (flav1 flav2 ...) option1 option2 ...)
+% (defmethod (flavor-name message-name) (arg1 arg2 ...) form1 form2 ...)
+%
+% (make-instance 'flavor-name 'var1 value1 ...)
+%
+% (=> foo message-name arg1 arg2 ...)
+%
+% (send foo 'message-name arg1 arg2 ...)
+% (lexpr-send foo 'message-name arg1 arg2 ... rest-arg-list)
+% (lexpr-send-1 foo 'message-name arg-list)
+% (ev-send foo 'message-name arg-list) {EXPR form}
+%
+% (send-if-handles foo 'message-name arg1 arg2 ...)
+% (lexpr-send-if-handles foo 'message-name arg1 arg2 ... rest-arg-list)
+% (lexpr-send-1-if-handles foo 'message-name arg-list)
+%
+% (instantiate-flavor 'flavor-name init-list)
+%
+% (object-type x) --- returns the type of an object, or NIL if not an object
+%
+% (object-get-handler x message-name) -- lookup method function (see below)
+% (object-get-handler-quietly x message-name)
+%
+% (trace-method-lookups) - start recording stats about method lookup
+% (untrace-method-lookups) - stop recording stats about method lookup
+% (print-method-lookup-info) - untrace and print accumulated stats
+%
+% (declare-flavor flavor var1 var2 ...) NOTE: see warnings below!
+% (undeclare-flavor var1 var2 ...)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Private Constants, Fluids, and Macros (mere mortals should ignore these)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '($defflavor-expansion-context
+ $object-number-of-reserved-slots
+ $object-flavor-slot
+ $object-debug-slot
+ $defflavor-option-table
+ $method-lookup-stats
+ ))
+
+(setf $defflavor-expansion-context NIL)
+(BothTimes (progn
+ (setf $object-number-of-reserved-slots 2)
+ (setf $object-flavor-slot 0)
+ (setf $object-debug-slot 1)
+ ))
+(setf $defflavor-option-table
+ (list
+ (cons 'gettable-instance-variables '$defflavor-do-gettable-option)
+ (cons 'settable-instance-variables '$defflavor-do-settable-option)
+ (cons 'initable-instance-variables '$defflavor-do-initable-option)
+ ))
+
+% Note the free variable FLAVOR-NAME in this macro:
+(defmacro $defflavor-error (format . arguments)
+ `(ContinuableError 1000 (BldMsg ,(string-concat "DEFFLAVOR %w: " format)
+ flavor-name . ,arguments) NIL))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Public Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% DEFFLAVOR - Define a new flavor of Object
+%
+% Examples:
+%
+% (defflavor complex-number (real-part imaginary-part) ())
+%
+% (defflavor complex-number (real-part imaginary-part) ()
+% gettable-instance-variables
+% initable-instance-variables
+% )
+%
+% (defflavor complex-number ((real-part 0.0)
+% (imaginary-part 0.0)
+% )
+% ()
+% gettable-instance-variables
+% (settable-instance-variables real-part)
+% )
+%
+% An object is represented by a vector; instance variables are allocated
+% specific slots in the vector. Do not use names like "IF" or "WHILE" for
+% instance varibles: they are translated freely within method bodies (see
+% DEFMETHOD). Initial values for instance variables may be specified as
+% arguments to MAKE-INSTANCE, or as initializing expressions in the variable
+% list, or may be supplied by an INIT method (see MAKE-INSTANCE).
+% Uninitializied instance variables are bound to *UNBOUND*.
+%
+% The component flavor list currently must be null. Recognized options are:
+%
+% (GETTABLE-INSTANCE-VARIABLES var1 var2 ...)
+% (SETTABLE-INSTANCE-VARIABLES var1 var2 ...)
+% (INITABLE-INSTANCE-VARIABLES var1 var2 ...)
+% GETTABLE-INSTANCE-VARIABLES [make all instance variables GETTABLE]
+% SETTABLE-INSTANCE-VARIABLES [make all instance variables SETTABLE]
+% INITABLE-INSTANCE-VARIABLES [make all instance variables INITABLE]
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro defflavor (flavor-name variable-list flavor-list . options-list)
+ (prog (var-names % List of valid instance variable names
+ init-code % body of DEFAULT-INIT method
+ describe-code % body of DESCRIBE method
+ defmethod-list % list of created DEFMETHODs
+ var-options % AList mapping var names to option list
+ initable-vars % list of INITABLE instance variables
+ )
+ (desetq (var-names init-code)
+ ($defflavor-process-varlist flavor-name variable-list)
+ )
+ (setf describe-code ($defflavor-build-describe flavor-name var-names))
+ (setf var-options
+ ($defflavor-process-options-list flavor-name var-names options-list)
+ )
+ (setf defmethod-list ($defflavor-create-methods flavor-name var-options))
+ (setf initable-vars ($defflavor-initable-vars flavor-name var-options))
+
+ (put flavor-name 'variable-names var-names)
+ (setf defmethod-list
+ (cons `(defmethod (,flavor-name default-init) () . ,init-code)
+ defmethod-list))
+ (setf defmethod-list
+ (cons `(defmethod (,flavor-name describe) () . ,describe-code)
+ defmethod-list))
+ (if flavor-list
+ ($defflavor-error "Component Flavors not implemented")
+ )
+
+ % The previous actions happen at compile or dskin time.
+ % The following actions happen at dskin or load time.
+
+ (return `(progn
+ (if (not (get ',flavor-name 'method-table))
+ (put ',flavor-name 'method-table (association-create)))
+ (put ',flavor-name 'instance-vector-size
+ ,(+ #.$object-number-of-reserved-slots (length var-names)))
+ (put ',flavor-name 'variable-names ',var-names)
+ (put ',flavor-name 'initable-variables ',initable-vars)
+ ,@defmethod-list
+ '(flavor ,flavor-name) % for documentation only
+ ))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% DEFMETHOD - Define a method on an existing flavor.
+%
+% Examples:
+%
+% (defmethod (complex-number real-part) ()
+% real-part)
+%
+% (defmethod (complex-number set-real-part) (new-real-part)
+% (setf real-part new-real-part))
+%
+% The body of a method can freely refer to the instance variables of the flavor
+% and can set them using SETF. Each method defines a function FLAVOR$METHOD
+% whose first argument is SELF, the object that is performing the method. All
+% references to instance variables (except within vectors or quoted lists) are
+% translated to an invocation of the form (IGETV SELF n).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro defmethod ((flavor-name method-name) argument-list . body)
+ (setf argument-list (cons 'self argument-list))
+ (let ((function-name ($defflavor-function-name flavor-name method-name)))
+ (put function-name 'source-code `(lambda ,argument-list . ,body))
+ (let ((new-code ($create-method-source-code function-name flavor-name)))
+
+ % The previous actions happen at compile or dskin time.
+ % The following actions happen at dskin or load time.
+
+ `(progn
+ ($flavor-define-method ',flavor-name ',method-name ',function-name)
+ (putd ',function-name 'expr ',new-code)
+ '(method ,flavor-name ,method-name) % for documentation only
+ ))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% => - Convenient form for sending a message
+%
+% Examples:
+%
+% (=> r real-part)
+%
+% (=> r set-real-part 1.0)
+%
+% The message name is not quoted. Arguments to the method are supplied as
+% arguments to =>.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro => (object message-name . arguments)
+ `(send ,object ',message-name . ,arguments))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% SEND - Send a Message (Evaluated Message Name)
+%
+% Examples:
+%
+% (send r 'real-part)
+%
+% (send r 'set-real-part 1.0)
+%
+% Note that the message name is quoted.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro send (target-form method-form . argument-forms)
+
+ % If the method name is known at compile time (i.e., the method-form is of
+ % the form (QUOTE <id>)) and the target is either SELF (within the body of a
+ % DEFMETHOD) or a variable which has been declared (using DECLARE-FLAVOR),
+ % then optimize the form to a direct invocation of the method function.
+
+ (if (and (PairP method-form)
+ (eq (car method-form) 'quote)
+ (not (null (cdr method-form)))
+ (IdP (cadr method-form))
+ )
+ (let ((method-name (cadr method-form)))
+ (cond ((and (eq target-form 'self) $defflavor-expansion-context)
+ ($self-send-expansion method-name argument-forms))
+ ((and (IdP target-form) (get target-form 'declared-type))
+ ($direct-send-expansion target-form method-name argument-forms))
+ (t ($normal-send-expansion target-form method-form argument-forms))
+ ))
+ ($normal-send-expansion target-form method-form argument-forms)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% SEND-IF-HANDLES - Conditionally Send a Message (Evaluated Message Name)
+%
+% Examples:
+%
+% (send-if-handles r 'real-part)
+%
+% (send-if-handles r 'set-real-part 1.0)
+%
+% SEND-IF-HANDLES is like SEND, except that if the object defines no method
+% to handle the message, no error is reported and NIL is returned.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro send-if-handles (object message-name . arguments)
+ `(let* ((***SELF*** ,object)
+ (***HANDLER*** (object-get-handler-quietly ***SELF*** ,message-name))
+ )
+ (and ***HANDLER*** (apply ***HANDLER*** (list ***SELF*** ,@arguments)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% LEXPR-SEND - Send a Message (Explicit "Rest" Argument List)
+%
+% Examples:
+%
+% (lexpr-send foo 'bar a b c list)
+%
+% The last argument to LEXPR-SEND is a list of the remaining arguments.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro lexpr-send (object message-name . arguments)
+ (if arguments
+ (let ((explicit-args (reverse (cdr (reverse arguments))))
+ (last-arg (LastCar arguments))
+ )
+ (if explicit-args
+ `(lexpr-send-1 ,object ,message-name
+ (append (list ,@explicit-args) ,last-arg))
+ `(lexpr-send-1 ,object ,message-name ,last-arg)
+ )
+ )
+ `(let ((***SELF*** ,object))
+ (apply (object-get-handler ***SELF*** ,message-name)
+ (list ***SELF***)))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% LEXPR-SEND-IF-HANDLES
+%
+% This is the same as LEXPR-SEND, except that no error is reported
+% if the object fails to handle the message.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro lexpr-send-if-handles (object message-name . arguments)
+ (if arguments
+ (let ((explicit-args (reverse (cdr (reverse arguments))))
+ (last-arg (LastCar arguments))
+ )
+ (if explicit-args
+ `(lexpr-send-1-if-handles ,object ,message-name
+ (append (list ,@explicit-args) ,last-arg))
+ `(lexpr-send-1-if-handles ,object ,message-name ,last-arg)
+ )
+ )
+ `(let* ((***SELF*** ,object)
+ (***HANDLER***
+ (object-get-handler-quietly ***SELF*** ,message-name))
+ )
+ (and ***HANDLER*** (apply ***HANDLER*** (list ***SELF***))))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% LEXPR-SEND-1 - Send a Message (Explicit Argument List)
+%
+% Examples:
+%
+% (lexpr-send-1 r 'real-part nil)
+%
+% (lexpr-send-1 r 'set-real-part (list 1.0))
+%
+% Note that the message name is quoted and that the argument list is passed as a
+% single argument to LEXPR-SEND-1.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro lexpr-send-1 (object message-name argument-list)
+ `(let ((***SELF*** ,object))
+ (apply (object-get-handler ***SELF*** ,message-name)
+ (cons ***SELF*** ,argument-list))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% EV-SEND - EXPR form of LEXPR-SEND-1
+%
+% EV-SEND is just like LEXPR-SEND-1, except that it is an EXPR instead of
+% a MACRO. Its sole purpose is to be used as a run-time function object,
+% for example, as a function argument to a function.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de ev-send (obj msg arg-list)
+ (lexpr-send-1 obj msg arg-list)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% LEXPR-SEND-1-IF-HANDLES
+%
+% This is the same as LEXPR-SEND-1, except that no error is reported if the
+% object fails to handle the message.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro lexpr-send-1-if-handles (object message-name argument-list)
+ `(let* ((***SELF*** ,object)
+ (***HANDLER*** (object-get-handler-quietly ***SELF*** ,message-name))
+ )
+ (and ***HANDLER*** (apply ***HANDLER*** (cons ***SELF*** ,argument-list)))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% MAKE-INSTANCE - Create a new instance of a flavor.
+%
+% Examples:
+%
+% (make-instance 'complex-number)
+% (make-instance 'complex-number 'real-part 0.0 'imaginary-part 1.0)
+%
+% MAKE-INSTANCE accepts an optional initialization list, consisting of
+% alternating pairs of instance variable names and corresponding initial values.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro make-instance (flavor-name . init-plist)
+ `(instantiate-flavor ,flavor-name
+ (list . ,init-plist)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% INSTANTIATE-FLAVOR
+%
+% This is the same as MAKE-INSTANCE, except that the initialization list is
+% provided as a single (required) argument.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defun instantiate-flavor (flavor-name init-plist)
+ (let* ((vector-size (get flavor-name 'instance-vector-size)))
+ (if vector-size
+ (let* ((object (MkVect (- vector-size 1)))
+ )
+ (setf (igetv object #.$object-flavor-slot) flavor-name)
+ (setf (igetv object #.$object-debug-slot) NIL)
+ (for (from i #.$object-number-of-reserved-slots (- vector-size 1) 1)
+ (do (iputv object i '*UNBOUND*))
+ )
+ ($object-perform-initialization object init-plist)
+ (send-if-handles object 'default-init)
+ (send-if-handles object 'init init-plist)
+ object
+ )
+ (ContError 0 "Attempt to instantiate undefined flavor: %w"
+ flavor-name (Instantiate-Flavor flavor-name init-plist))
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Object-Type
+%
+% The OBJECT-TYPE function returns the type (an ID) of the specified object, or
+% NIL, if the argument is not an object.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defun object-type (object)
+ (if (and (VectorP object) (> (UpbV object) 1))
+ (let ((flavor-name (igetv object #.$object-flavor-slot)))
+ (if (IdP flavor-name) flavor-name)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Method Lookup
+%
+% The following functions return method functions given an object and a message
+% name. The returned function can be invoked, passing the object as the first
+% argument and the message arguments as the remaining arguments. For example,
+% the expression (=> foo gorp a b c) is equivalent to:
+%
+% (apply (object-get-handler foo 'gorp) (list foo a b c))
+%
+% It can be useful for efficiency reasons to lookup a method function once and
+% then apply it many times to the same object.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defun object-get-handler (object message-name)
+ % Returns the method function that implements the specified message when sent
+ % to the specified object. If no such method exists, generate a continuable
+ % error.
+
+ (let ((flavor-name (object-type object)))
+ (cond
+ (flavor-name
+ (let ((function-name ($flavor-fetch-method flavor-name message-name)))
+ (or function-name
+ (ContError 1000
+ "Flavor %w has no method %w."
+ flavor-name
+ message-name
+ (object-get-handler object message-name)
+ ))))
+ (t (ContError 1000
+ "Object %w cannot receive messages."
+ object
+ (object-get-handler object message-name)
+ )))))
+
+(defun object-get-handler-quietly (object message-name)
+ % Returns the method function that implements the specified message when sent
+ % to the specified object, if it exists, otherwise returns NIL.
+
+ (let ((flavor-name (object-type object)))
+ (if flavor-name
+ ($flavor-fetch-method flavor-name message-name))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Method Lookup Tracing
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de trace-method-lookups ()
+ % Begin accumulating information about method lookups (invocations of
+ % object-get-handler). The statistics are reset.
+ (setf $method-lookup-stats (association-create))
+ (copyd 'object-get-handler '$traced-object-get-handler)
+ )
+
+(de untrace-method-lookups ()
+ % Stop accumulating information about method lookups.
+ (copyd 'object-get-handler '$untraced-object-get-handler)
+ )
+
+(de print-method-lookup-info ()
+ % Stop accumulating information about method lookups and print a summary of
+ % the accumulated information about method lookups. This summary shows which
+ % methods were looked up and how many times each method was looked up.
+
+ (untrace-method-lookups)
+ (load gsort stringx)
+ (setf $method-lookup-stats (gsort $method-lookup-stats '$method-info-sortfn))
+ (for (in pair $method-lookup-stats)
+ (do (printf "%w %w%n"
+ (string-pad-left (bldmsg "%w" (cdr pair)) 6)
+ (car pair))))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% DECLARE-FLAVOR
+%
+% *** Read these warnings carefully! ***
+%
+% The DECLARE-FLAVOR macro allows you to declare that a specific symbol is
+% bound to an object of a specific flavor. This allows the flavors
+% implementation to eliminate the run-time method lookup normally associated
+% with sending a message to that variable, which can result in an appreciable
+% improvement in execution speed. This feature is motivated solely by
+% efficiency considerations and should be used ONLY where the performance
+% improvement is critical.
+%
+% Details: if you declare the variable X to be bound to an object of flavor
+% FOO, then WITHIN THE CONTEXT OF THE DECLARATION (see below), expressions of
+% the form (=> X GORP ...) or (SEND X 'GORP ...) will be replaced by function
+% invocations of the form (FOO$GORP X ...). Note that there is no check made
+% that the flavor FOO actually contains a method GORP. If it does not, then a
+% run-time error "Invocation of undefined function FOO$GORP" will be reported.
+%
+% WARNING: The DECLARE-FLAVOR feature is not presently well integrated with
+% the compiler. Currently, the DECLARE-FLAVOR macro may be used only as a
+% top-level form, like the PSL FLUID declaration. It takes effect for all
+% code evaluated or compiled henceforth. Thus, if you should later compile a
+% different file in the same compiler, the declaration will still be in
+% effect! THIS IS A DANGEROUS CROCK, SO BE CAREFUL! To avoid problems, I
+% recommend that DECLARE-FLAVOR be used only for uniquely-named variables.
+% The effect of a DECLARE-FLAVOR can be undone by an UNDECLARE-FLAVOR, which
+% also may be used only as a top-level form. Therefore, it is good practice
+% to bracket your code in the source file with a DECLARE-FLAVOR and a
+% corresponding UNDECLARE-FLAVOR.
+%
+% Here are the syntactic details:
+%
+% (DECLARE-FLAVOR FLAVOR-NAME VAR1 VAR2 ...)
+% (UNDECLARE-FLAVOR VAR1 VAR2 ...)
+%
+% *** Did you read the above warnings??? ***
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro declare-flavor (flavor-name . variable-names)
+ (prog () % This macro returns NIL!
+ (if (not (IdP flavor-name))
+ (StdError
+ (BldMsg "Flavor name in DECLARE-FLAVOR is not an ID: %p" flavor-name))
+ % else
+ (for (in var-name variable-names)
+ (do (if (not (IdP var-name))
+ (StdError (BldMsg
+ "Variable name in DECLARE-FLAVOR is not an ID: %p"
+ var-name))
+ % else
+ (put var-name 'declared-type flavor-name)
+ )))
+ )))
+
+(dm undeclare-flavor (form)
+ (prog () % This macro returns NIL!
+ (for (in var-name (cdr form))
+ (do (if (not (IdP var-name))
+ (StdError (BldMsg
+ "Variable name in UNDECLARE-FLAVOR is not an ID: %p"
+ var-name))
+ % else
+ (remprop var-name 'declared-type)
+ )))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Representation Information:
+%
+% (You don't need to know any of this to use this stuff.)
+%
+% A flavor-name is an ID. It has the following properties:
+%
+% VARIABLE-NAMES A list of the instance variables of the flavor, in
+% order of their location in the instance vector. This
+% property exists at compile time, dskin time, and load
+% time.
+%
+% INITABLE-VARIABLES A list of the instance variables that have been declared
+% to be INITABLE. This property exists at dskin time and
+% at load time.
+%
+% METHOD-TABLE An association list mapping each method name (ID)
+% defined for the flavor to the corresponding function
+% name (ID) that implements the method. This property
+% exists at dskin time and at load time.
+%
+% INSTANCE-VECTOR-SIZE An integer that specifies the number of elements in the
+% vector that represents an instance of this flavor. This
+% property exists at dskin time and at load time. It is
+% used by MAKE-INSTANCE.
+%
+% The function that implements a method has a name of the form FLAVOR$METHOD.
+% Each such function ID has the following properties:
+%
+% SOURCE-CODE A list of the form (LAMBDA (SELF ...) ...) which is the
+% untransformed source code for the method. This property
+% exists at compile time and dskin time.
+%
+% Implementation Note:
+%
+% A tricky aspect of this code is making sure that the right things happen at
+% the right time. When a source file is read and evaluated (using DSKIN), then
+% everything must happen at once. However, when a source file is compiled to
+% produce a FASL file, then some actions must be performed at compile-time,
+% whereas other actions are supposed to occur when the FASL file is loaded.
+% Actions to occur at compile time are performed by macros; actions to occur at
+% load time are performed by the forms returned by macros.
+%
+% Another goal of the implementation is to avoid consing whenever possible
+% during method invocation. The current scheme prefers to compile into (APPLY
+% HANDLER (LIST args...)), for which the PSL compiler will produce code that
+% performs no consing.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Internal Functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defun $object-perform-initialization (object init-plist)
+
+ % Perform the initialization of instance variables in OBJECT as specified by
+ % the INIT-PLIST, which contains alternating instance variable names and
+ % initializing values.
+
+ (let* ((flavor-name (igetv object #.$object-flavor-slot))
+ (initable-vars (get flavor-name 'initable-variables))
+ (variable-names (get flavor-name 'variable-names))
+ name value
+ )
+ (while init-plist
+ (setf name (car init-plist))
+ (setf init-plist (cdr init-plist))
+ (if init-plist
+ (progn (setf value (car init-plist))
+ (setf init-plist (cdr init-plist)))
+ (setf value nil)
+ )
+ (if (memq name initable-vars)
+ (iputv object
+ ($object-lookup-variable-in-list variable-names name)
+ value)
+ (ContinuableError 1000
+ (BldMsg "%p not an initable instance variable of flavor %w"
+ name
+ flavor-name)
+ NIL)
+ ))))
+
+(defun $object-lookup-variable-in-list (variable-names name)
+ (for (in v-name variable-names)
+ (for i #.$object-number-of-reserved-slots (+ i 1))
+ (do (if (eq v-name name) (exit i)))
+ (returns nil)
+ ))
+
+(defun $substitute-for-symbols (U var-names)
+ % Substitute in U for all unquoted instances of the symbols defined in
+ % Var-Names. Also, change SETQ to SETF in forms, since only SETF can handle
+ % the substituted forms.
+
+ (cond
+ ((IdP U)
+ (let ((address ($object-lookup-variable-in-list var-names U)))
+ (if address (list 'igetv 'self address) U)
+ ))
+ ((PairP U)
+ (cond
+ ((eq (car U) 'quote) U)
+ ((eq (car U) 'setq)
+ (cons 'setf ($substitute-for-symbols (cdr U) var-names)))
+ (t (cons ($substitute-for-symbols (car U) var-names)
+ ($substitute-for-symbols (cdr U) var-names)))
+ )
+ )
+ (t U)
+ ))
+
+(defun $flavor-define-method (flavor-name method-name function-name)
+ (let ((method-table (get flavor-name 'method-table)))
+ (association-bind method-table method-name function-name)))
+(copyd 'flavor-define-method '$flavor-define-method) % for compatibility!
+
+(defun $flavor-fetch-method (flavor-name method-name)
+ % Returns NIL if the method is undefined.
+ (let* ((method-table (get flavor-name 'method-table))
+ (assoc-pair (atsoc method-name method-table))
+ )
+ (if assoc-pair (cdr assoc-pair) nil)))
+
+(defun $create-method-source-code (function-name flavor-name)
+ (let ((var-names (get flavor-name 'variable-names))
+ (source-code (get function-name 'source-code))
+ ($defflavor-expansion-context flavor-name) % FLUID variable!
+ )
+ ($substitute-for-symbols (MacroExpand source-code) var-names)
+ ))
+
+(defun $defflavor-process-varlist (flavor-name variable-list)
+
+ % Process the instance variable list of a DEFFLAVOR. Create a list of valid
+ % instance variable names and a list of forms to perform default
+ % initialization of instance variables.
+
+ (prog (var-names default-init-code init-form v)
+ (for (in v-entry variable-list) (do
+ (cond ((and (PairP v-entry) (IdP (car v-entry)))
+ (setf v (car v-entry))
+ (setf init-form (cdr v-entry))
+ (if init-form (setf init-form (car init-form)))
+ (setf init-form `(if (eq ,v '*UNBOUND*) (setf ,v ,init-form)))
+ (setf default-init-code (aconc default-init-code init-form))
+ )
+ ((IdP v-entry) (setf v v-entry))
+ (t ($defflavor-error "Bad item in variable list: %p" v-entry)
+ (setf v NIL)
+ )
+ )
+ (if v (setf var-names (aconc var-names v)))
+ ))
+ (return (list var-names default-init-code))))
+
+(defun $defflavor-build-describe (flavor-name var-names)
+ % Return a list of forms that print a description of an instance.
+
+ (let ((describe-code
+ `((printf ,(string-concat "An object of flavor "
+ (id2string flavor-name)
+ ", has instance variable values:%n")))))
+ (for (in v var-names)
+ (do
+ (setf describe-code
+ (aconc describe-code `(printf " %w: %p%n" ',v ,v)))
+ ))
+ (aconc describe-code NIL)
+ ))
+
+(defun $defflavor-process-options-list (flavor-name var-names options-list)
+ % Return an AList mapping var-names to a list of options
+ (let ((var-options (association-create)))
+ (for (in option options-list)
+ (do ($defflavor-process-option flavor-name var-names
+ var-options option)
+ ))
+ var-options
+ ))
+
+(defun $defflavor-process-option (flavor-name var-names var-options option)
+ % Process the option by modifying the AList VAR-OPTIONS.
+ (let (option-keyword option-arguments)
+ (cond ((PairP option)
+ (setf option-keyword (car option))
+ (setf option-arguments (cdr option))
+ )
+ ((IdP option)
+ (setf option-keyword option)
+ )
+ (t ($defflavor-error "Bad item in options list: %p" option)
+ (setf option-keyword '*NONE*)
+ )
+ )
+ (when (neq option-keyword '*NONE*)
+ (let ((pair (atsoc option-keyword $defflavor-option-table)))
+ (if (null pair)
+ ($defflavor-error "Bad option in options list: %w" option)
+ (apply (cdr pair)
+ (list flavor-name var-names var-options option-arguments))
+ )))))
+
+(defun $defflavor-do-gettable-option (flavor-name var-names var-options args)
+ ($defflavor-insert-keyword flavor-name var-names var-options args 'GETTABLE)
+ )
+
+(defun $defflavor-do-settable-option (flavor-name var-names var-options args)
+ ($defflavor-insert-keyword flavor-name var-names var-options args 'SETTABLE)
+ )
+
+(defun $defflavor-do-initable-option (flavor-name var-names var-options args)
+ ($defflavor-insert-keyword flavor-name var-names var-options args 'INITABLE)
+ )
+
+(defun $defflavor-insert-keyword (flavor-name var-names var-options args key)
+ (if (null args) (setf args var-names)) % default: applies to all variables
+ (for (in var args) % for each specified instance variable
+ (do
+ (if (not (memq var var-names))
+ ($defflavor-error "%p (in keyword option) not a variable." var)
+ % else
+ (let ((pair (atsoc var var-options)))
+ (when (null pair)
+ (setf pair (cons var nil))
+ (aconc var-options pair)
+ )
+ (setf (cdr pair) (adjoinq key (cdr pair)))
+ )))))
+
+(defun $defflavor-define-access-function (flavor-name var-name)
+ `(defmethod (,flavor-name ,var-name) () ,var-name))
+
+(defun $defflavor-define-update-function (flavor-name var-name)
+ (let ((method-name (intern (string-concat "SET-" (id2string var-name)))))
+ `(defmethod (,flavor-name ,method-name) (new-value)
+ (setf ,var-name new-value))))
+
+(defun $defflavor-create-methods (flavor-name var-options)
+ % Return a list of DEFMETHODs for GETTABLE and SETTABLE instance variables.
+
+ (let ((defmethod-list))
+ (for (in pair var-options)
+ (do
+ (let ((var-name (car pair))
+ (keywords (cdr pair))
+ )
+ (if (or (memq 'GETTABLE keywords) (memq 'SETTABLE keywords))
+ (setf defmethod-list
+ (cons ($defflavor-define-access-function flavor-name var-name)
+ defmethod-list
+ )))
+ (if (memq 'SETTABLE keywords)
+ (setf defmethod-list
+ (cons ($defflavor-define-update-function flavor-name var-name)
+ defmethod-list
+ )))
+ )))
+ defmethod-list
+ ))
+
+(defun $defflavor-initable-vars (flavor-name var-options)
+ % Return a list containing the names of instance variables that have been
+ % declared to be INITable.
+ (for (in pair var-options)
+ (when (and (PairP pair)
+ (or (memq 'INITABLE (cdr pair))
+ (memq 'SETTABLE (cdr pair))
+ )))
+ (collect (car pair))
+ )
+ )
+
+(de $defflavor-function-name (flavor-name method-name)
+ (intern (string-concat (id2string flavor-name) "$" (id2string method-name))))
+
+(de $normal-send-expansion (target-form method-form argument-forms)
+ `(let ((***SELF*** ,target-form))
+ (apply (object-get-handler ***SELF*** ,method-form)
+ (list ***SELF*** ,@argument-forms))))
+
+(de $self-send-expansion (method-name argument-forms)
+ (cons ($defflavor-function-name $defflavor-expansion-context method-name)
+ (cons 'self argument-forms)))
+
+(de $direct-send-expansion (target-id method-name argument-forms)
+ (let ((target-type (get target-id 'declared-type)))
+ (cons ($defflavor-function-name target-type method-name)
+ (cons target-id argument-forms))))
+
+(copyd '$untraced-object-get-handler 'object-get-handler)
+
+(de $traced-object-get-handler (obj method-name)
+ (let* ((result ($untraced-object-get-handler obj method-name))
+ (count (association-lookup $method-lookup-stats result))
+ )
+ (association-bind $method-lookup-stats result (if count (+ count 1) 1))
+ result
+ ))
+
+(de $method-info-sortfn (m1 m2)
+ (numbersortfn (cdr m2) (cdr m1))
+ )
ADDED psl-1983/3-1/util/old-prettyprint.sl
Index: psl-1983/3-1/util/old-prettyprint.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/old-prettyprint.sl
@@ -0,0 +1,252 @@
+%(!* YPP -- THE PRETTYPRINTER
+%
+% <BENSON>YPP.SL.19, 17-Sep-82 09:52:42, Edit by BENSON
+% Courtesy of IMSSS, with modifications for PSL
+%
+%
+%PP( LST:list ) FEXPR
+%PRETTYPRINT( X:any ) EXPR
+%
+%")
+
+(COMPILETIME
+ (FLAG '(WARNING
+ PP-VAL
+ PP-DEF
+ PP-DEF-1
+ BROKEN
+ GET-GOOD-DEF
+ S2PRINT
+ SPRINT
+ CHRCT
+ SPACES-LEFT
+ SAFE-PPOS
+ PPFLATSIZE
+ PP-SAVINGS
+ POSN1
+ POSN2
+ PPOS) 'INTERNALFUNCTION))
+
+(DE WARNING (X) (ERRORPRINTF "*** %L" X))
+
+%(!* "Change the system prettyprint function to use this one.")
+
+(DE PRETTYPRINT (X) (PROGN (SPRINT X 1) (TERPRI)))
+
+(DM PP (L)
+ (LIST 'EVPP (LIST 'QUOTE (CDR L))))
+
+(DE EVPP (L)
+ (PROGN (MAPC L (FUNCTION PP1)) (TERPRI) T))
+
+(DE PP1 (EXP)
+ (PROG NIL
+ (COND ((IDP EXP)
+ (PROGN (PP-VAL EXP)
+ (PP-DEF EXP)))
+ (T (PROGN (SPRINT EXP 1) (TERPRI))))))
+
+(DE PP-VAL (ID)
+ (PROG (VAL)
+ (COND ((ATOM (SETQ VAL (ERRORSET ID NIL NIL))) (RETURN NIL)))
+ (TERPRI)
+ (PRIN2 "(SETQ ")
+ (PRIN1 ID)
+ (S2PRINT " '" (CAR VAL))
+ (PRIN2 ")")
+ (TERPRI)))
+
+(DE PP-DEF (ID)
+ (PROG (DEF TYPE ORIG-DEF)
+ (SETQ DEF (GETD ID))
+ TEST (COND ((NULL DEF)
+ (RETURN (AND ORIG-DEF
+ (WARNING (LIST "Gack. "
+ ID
+ " has no unbroken definition.")))))
+ ((CODEP (CDR DEF))
+ (RETURN (WARNING (LIST "Can't PP compiled definition for"
+ ID))))
+ ((AND (NOT ORIG-DEF) (BROKEN ID))
+ (PROGN (WARNING (LIST "Note:"
+ ID
+ "is broken or traced."))
+ (SETQ ORIG-DEF DEF)
+ (SETQ DEF
+ (CONS (CAR DEF) (GET-GOOD-DEF ID)))
+ (GO TEST))))
+ (SETQ TYPE (CAR DEF))
+ (TERPRI)
+ (SETQ ORIG-DEF
+ (ASSOC TYPE
+ '((EXPR . DE)
+ (MACRO . DM)
+ (FEXPR . DF)
+ (NEXPR . DN))))
+ (RETURN (PP-DEF-1 (CDR ORIG-DEF) ID (CDDR DEF)))))
+
+(DE PP-DEF-1 (FN NAME TAIL)
+(PROGN (PRIN2 "(")
+ (PRIN1 FN)
+ (PRIN2 " ")
+ (PRIN1 NAME)
+ (PRIN2 " ")
+ (COND ((NULL (CAR TAIL)) (PRIN2 "()")) (T (PRIN1 (CAR TAIL))))
+ (MAPC (CDR TAIL)
+ (FUNCTION (LAMBDA (X) (S2PRINT " " X))))
+ (PRIN2 ")")
+ (TERPRI)))
+
+(DE BROKEN (X) (GET X 'TRACE))
+
+(DE GET-GOOD-DEF (X)
+ (PROG (XX)
+ (COND ((AND (SETQ XX (GET X 'TRACE))
+ (SETQ XX (ASSOC 'ORIGINALFN XX)))
+ (RETURN (CDR XX))))))
+
+%(!* "S2PRINT: prin2 a string and then sprint an expression.")
+
+(DE S2PRINT (S EXP)
+ (PROGN
+ (OR (GREATERP (SPACES-LEFT) (PLUS (FLATSIZE2 S) (FLATSIZE EXP)))
+ (TERPRI))
+ (PRIN2 S)
+ (SPRINT EXP (ADD1 (POSN)))))
+
+(DE SPRINT (EXP LEFT-MARGIN)
+ (PROG (ORIGINAL-SPACE NEW-SPACE CAR-EXP P-MACRO CADR-MARGIN ELT-MARGIN
+ LBL-MARGIN SIZE)
+ (COND ((ATOM EXP)
+ (PROGN (SAFE-PPOS LEFT-MARGIN (FLATSIZE EXP))
+ (RETURN (PRIN1 EXP)))))
+ (PPOS LEFT-MARGIN)
+ (SETQ LEFT-MARGIN (ADD1 LEFT-MARGIN))
+ (SETQ ORIGINAL-SPACE (SPACES-LEFT))
+ (COND ((PAIRP (SETQ CAR-EXP (CAR EXP)))
+ (PROGN (PRIN2 "(") (SPRINT CAR-EXP LEFT-MARGIN)))
+ ((AND (IDP CAR-EXP)
+ (SETQ P-MACRO (GET CAR-EXP 'PRINTMACRO)))
+ (COND ((AND (STRINGP P-MACRO)
+ (PAIRP (CDR EXP))
+ (NULL (CDDR EXP)))
+ (PROGN (SAFE-PPOS (POSN1) (FLATSIZE2 P-MACRO))
+ (PRIN2 P-MACRO)
+ (RETURN (AND (CDR EXP)
+ (SPRINT (CADR EXP) (POSN1))))))
+ (T (PROGN
+ (RETURN (APPLY P-MACRO (LIST EXP)))))))
+ (T (PROGN (PRIN2 "(")
+ (SAFE-PPOS (POSN1) (FLATSIZE CAR-EXP))
+ (PRIN1 CAR-EXP))))
+ (COND ((ATOM (SETQ EXP (CDR EXP))) (GO C)))
+ (SETQ CADR-MARGIN (POSN2))
+ (SETQ NEW-SPACE (SPACES-LEFT))
+ (SETQ SIZE (PPFLATSIZE CAR-EXP))
+ (COND ((NOT (LESSP SIZE ORIGINAL-SPACE))
+ (SETQ CADR-MARGIN
+ (SETQ ELT-MARGIN (SETQ LBL-MARGIN LEFT-MARGIN))))
+ ((OR (LESSP (PPFLATSIZE EXP) NEW-SPACE)
+ (PROG (E1)
+ (SETQ E1 EXP)
+ LP (COND ((PAIRP (CAR E1)) (RETURN NIL))
+ ((ATOM (SETQ E1 (CDR E1))) (RETURN T))
+ (T (GO LP)))))
+ (SETQ ELT-MARGIN (SETQ LBL-MARGIN NIL)))
+ ((LESSP NEW-SPACE 24)
+ (PROGN (COND ((NOT (AND (MEMQ CAR-EXP '(PROG LAMBDA SETQ))
+ (LESSP (PPFLATSIZE (CAR EXP))
+ NEW-SPACE)))
+ (SETQ CADR-MARGIN LEFT-MARGIN)))
+ (SETQ ELT-MARGIN (SETQ LBL-MARGIN LEFT-MARGIN))))
+ ((EQ CAR-EXP 'LAMBDA)
+ (SETQ ELT-MARGIN (SETQ LBL-MARGIN LEFT-MARGIN)))
+ ((EQ CAR-EXP 'PROG)
+ (PROGN (SETQ ELT-MARGIN CADR-MARGIN)
+ (SETQ LBL-MARGIN LEFT-MARGIN)))
+ ((OR (GREATERP SIZE 14)
+ (AND (GREATERP SIZE 4)
+ (NOT (LESSP (PPFLATSIZE (CAR EXP)) NEW-SPACE))))
+ (SETQ CADR-MARGIN
+ (SETQ ELT-MARGIN (SETQ LBL-MARGIN LEFT-MARGIN))))
+ (T (SETQ ELT-MARGIN (SETQ LBL-MARGIN CADR-MARGIN))))
+ (COND ((ATOM (SETQ CAR-EXP (CAR EXP)))
+ (PROGN (SAFE-PPOS CADR-MARGIN (PPFLATSIZE CAR-EXP))
+ (PRIN1 CAR-EXP)))
+ (T (SPRINT CAR-EXP CADR-MARGIN)))
+ A (COND ((ATOM (SETQ EXP (CDR EXP))) (GO C)))
+ B (SETQ CAR-EXP (CAR EXP))
+ (COND ((ATOM CAR-EXP)
+ (PROGN (SETQ SIZE (PPFLATSIZE CAR-EXP))
+ (COND (LBL-MARGIN (SAFE-PPOS LBL-MARGIN SIZE))
+ ((LESSP SIZE (SPACES-LEFT)) (PRIN2 " "))
+ (T (SAFE-PPOS LEFT-MARGIN SIZE)))
+ (PRIN1 CAR-EXP)))
+ (T (SPRINT CAR-EXP
+ (COND (ELT-MARGIN ELT-MARGIN) (T (POSN2))))))
+ (GO A)
+ C (COND (EXP (PROGN (COND ((LESSP (SPACES-LEFT) 3)
+ (PPOS LEFT-MARGIN)))
+ (PRIN2 " . ")
+ (SETQ SIZE (PPFLATSIZE EXP))
+ (COND ((GREATERP SIZE (SPACES-LEFT))
+ (SAFE-PPOS LEFT-MARGIN SIZE)))
+ (PRIN1 EXP))))
+ (COND ((LESSP (SPACES-LEFT) 1) (PPOS LEFT-MARGIN)))
+ (PRIN2 ")")))
+
+(PUT 'QUOTE 'PRINTMACRO "'")
+
+(PUT 'BACKQUOTE 'PRINTMACRO "`")
+
+(PUT 'UNQUOTE 'PRINTMACRO ",")
+
+(PUT 'UNQUOTEL 'PRINTMACRO ",@")
+
+(PUT 'UNQUOTED 'PRINTMACRO ",.")
+
+(PUT 'DE 'PRINTMACRO (FUNCTION PM-DEF))
+
+(PUT 'DM 'PRINTMACRO (FUNCTION PM-DEF))
+
+(PUT 'DF 'PRINTMACRO (FUNCTION PM-DEF))
+
+(PUT 'DN 'PRINTMACRO (FUNCTION PM-DEF))
+
+(DE PM-DEF (FORM)
+ (PP-DEF-1 (CAR FORM) (CADR FORM) (CDDR FORM)))
+
+(DE CHRCT NIL (DIFFERENCE (MIN 80 (LINELENGTH NIL)) (POSN)))
+
+(DE SPACES-LEFT NIL (SUB1 (CHRCT)))
+
+(DE SAFE-PPOS (N SIZE)
+ (PROG (MIN-N)
+ (SETQ MIN-N (SUB1 (DIFFERENCE (LINELENGTH NIL) SIZE)))
+ (COND ((LESSP MIN-N N)
+ (PROGN (OR (GREATERP MIN-N (POSN1)) (TERPRI)) (PPOS MIN-N)))
+ (T (PPOS N)))))
+
+(DE PPFLATSIZE (EXP) (DIFFERENCE (FLATSIZE EXP) (PP-SAVINGS EXP)))
+
+(DE PP-SAVINGS (Y)
+ (PROG (N)
+ (COND ((ATOM Y) (RETURN 0))
+ ((AND (EQ (CAR Y) 'QUOTE) (CDR Y) (NOT (NUMBERP (CADR Y))))
+ (RETURN (PLUS 7 (PP-SAVINGS (CDR Y))))))
+ (SETQ N 0)
+ LP (COND ((ATOM Y) (RETURN N)))
+ (SETQ N (PLUS N (PP-SAVINGS (CAR Y))))
+ (SETQ Y (CDR Y))
+ (GO LP)))
+
+(DE POSN1 NIL (ADD1 (POSN)))
+
+(DE POSN2 NIL (PLUS 2 (POSN)))
+
+(DE PPOS (N)
+ (PROG NIL
+ (OR (GREATERP N (POSN)) (TERPRI))
+ (SETQ N (SUB1 N))
+ LOOP (COND ((LESSP (POSN) N) (PROGN (PRIN2 " ") (GO LOOP))))))
+
ADDED psl-1983/3-1/util/package.build
Index: psl-1983/3-1/util/package.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/package.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp;
+in "package.red"$
ADDED psl-1983/3-1/util/package.red
Index: psl-1983/3-1/util/package.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/package.red
@@ -0,0 +1,388 @@
+%
+% PACKAGE.RED - Start of small package system
+%
+% Author: Martin Griss
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Friday, 23 October 1981
+% Copyright (c) 1981 University of Utah
+%
+
+% Idea is that Hierachical ObLists created
+% Permit Root at NIL, ie Forest Of Trees
+% CurrentPackage!* is Name of package
+% Structure [Name,Father,Getfn,PutFn,RemFn,MapFn] under 'Package
+% Have set of Localxxxx(s) and Pathxxxx(s) for
+% xxxx= InternP Intern RemOb MapObl
+% By Storing Functions, have possibility of different
+% Oblist models at each level (Abstract data Type for Local Obarray )
+
+CompileTime <<
+Lisp Procedure PACKAGE x; %. Called from Token reader
+ NIL; % dummy % To chnge package
+>>;
+
+Fluid '(\CurrentPackage!* %. Start of Search Path
+ \PackageNames!* %. List of ALL package names
+ PackageCharacter!* %. Character prefix for package
+ );
+
+PackageCharacter!* := char !\; % used for output
+
+Global '(SymPak!* MaxSym!*); % Dummy Package Field, to be SYSLSP
+<<MaxSym!*:=8000;
+ SymPak!*:=Mkvect MaxSym!*;
+ MaxSym!*>>;
+
+Lisp procedure SymPak d; % Access SYPAK field
+ SymPak!*[d];
+
+Lisp procedure PutSymPak(d,v);
+ SymPak!*[d]:=v;
+
+CompileTime Put('SymPak,'Assign!-op,'PutSymPak);
+
+% -Hook in GetFn,PutFn, RemFn and MapFn for \Global ------
+
+CopyD('GlobalMapObl,'MapObl);
+
+Lisp Procedure \SetUpInitialPackage;
+Begin
+ Put('\Global,'\Package,
+ '[\Global NIL \GlobalLookup \GlobalInstall \GlobalRemove \GlobalMapObl]);
+ % Package is [name of self, father, GetFn, PutFn,RemFn,MapFn]
+ \PackageNames!* := '(\Global);
+ \CurrentPackage!* := '\Global;
+End;
+
+CompileTime <<
+Lisp Smacro Procedure PackageName x;
+ x[0];
+
+Lisp Smacro Procedure PackageFather x;
+ x[1];
+
+Lisp Smacro Procedure PackageGetFn x;
+ x[2];
+
+Lisp Smacro Procedure PackagePutFn x;
+ x[3];
+
+Lisp Smacro Procedure PackageRemFn x;
+ x[4];
+
+Lisp Smacro Procedure PackageMapFn x;
+ x[5];
+>>;
+
+\SetupInitialPackage();
+
+Lisp Procedure \PackageP(Name); %. test if legal package
+ IdP(Name) and Get(Name,'\Package);
+
+Lisp Procedure \CreateRawPackage(Name,Father, GetFn, PutFn, RemFn, MapFn);
+ %. Build New Package
+ Begin Scalar V;
+ If \PackageP Name then
+ return ErrorPrintF("*** %r is already a package",Name);
+ If Not \PackageP Father then
+ return ErrorPrintF("*** %r cant be Father package",Father);
+ V:=Mkvect(5);
+ V[0]:=Name;
+ V[1]:=Father;
+ V[2]:=GetFn;
+ V[3]:=PutFn;
+ V[4] := RemFn;
+ V[5] := MapFn;
+ \PackageNames!* := Name . \PackageNames!*;
+ Put(Name,'\Package,V);
+ Return V
+ End;
+
+Lisp Procedure \SetPackage(Name); %. Change Default
+ If \PackageP(Name) then
+ <<%PrintF(" Pack: %r->%r %n",\CurrentPackage!*,Name);
+ \CurrentPackage!*:=Name>>
+
+ else if Null Name then \SetPackage('\Global)
+ else \PackageError(Name);
+
+Lisp procedure \PackageError(Name);
+ Error(99, LIST(Name, " Is not a Package "));
+
+% Note that we have to cleanup to some default package if
+% there is an error during ID name reading:
+
+CopyD('UnSafeToken,'ChannelReadToken);
+
+Lisp Procedure SafeToken(Channel);
+ (LAMBDA (\CurrentPackage!*); UnSafeToken(Channel)) (\CurrentPackage!*);
+
+CopyD('ChannelReadToken,'SafeToken);
+
+Lisp Procedure PACKAGE x; %. Called from Token reader
+ \SetPackage x;
+
+% --- User Package Stuff
+% --- Simple Buck Hash, using PAIRs (could later use Blocks)
+
+lisp Procedure HashFn(S,Htab);
+begin scalar Len, HashVal; % Fold together a bunch of bits
+ S := StrInf S;
+ HashVal := 0; % from the first 28 characters of the
+ Len := StrLen S; % string.
+ if IGreaterP(Len, 25) then Len := 25;
+ for I := 0 step 1 until Len do
+ HashVal := ILXOR(HashVal, ILSH(StrByt(S, I), IDifference(25, I)));
+ return IRemainder(HashVal, VecLen VecInf Htab);
+end;
+
+Lisp Procedure HashGetFn(S,Htab); %. See if String S is There
+ % Htab is Vector of Buckets
+ Begin Scalar H,Buk,Hashloc;
+ If not StringP S then Return NonStringError(S,'HashGetFn);
+ HashLoc:=HashFn(S,Htab);
+ Buk:=Htab[HashLoc];
+Loop: If Null Buk then return 0;
+ H:=Car Buk; Buk:=cdr Buk;
+ If S=ID2String H then return H;
+ goto Loop;
+End;
+
+Lisp Procedure HashPutFn(S,Htab); %. Install String at HashLoc
+ Begin Scalar H,TopBuk,Buk,HashLoc;
+ If not StringP S then NonStringError(S,'HashPutFn);
+ HashLoc :=HashFn(S,Htab);
+ TopBuk:=Buk:=Htab[HashLoc];
+Loop: If Null Buk then goto new;
+ H:=Car Buk; Buk:=cdr Buk;
+ If S=ID2String H then return H;
+ goto Loop;
+New:
+ S:=CopyString S; % So doesnt grab I/O buffer
+ H:=NewID S;
+ SymPak(ID2Int H) := CurrentPackage!*;
+ TopBuk:= H . TopBuk;
+ Htab[HashLoc] := TopBuk;
+ Return H;
+End;
+
+Lisp Procedure HashRemFn(S,Htab); %. remove String if there
+ Begin Scalar H,TopBuk,Buk,HashLoc;
+ If not StringP S then Return NonStringError(S,'HashRemFn);
+ HashLoc :=HashFn(S,Htab);
+ TopBuk:=Buk:=Htab[HashLoc];
+Loop:
+ If Null Buk then return 0;
+ H:=Car Buk; Buk:=cdr Buk;
+ If S=ID2String H then goto Rem;
+ goto Loop;
+Rem:
+ Htab[HashLoc] :=DelQ(H,TopBuk);
+ SymPak(ID2Int H) := NIL;
+ Return H
+End;
+
+Lisp Procedure HashMapFn(F,Htab);
+ Begin Scalar H,Buk,HashLoc,Hmax;
+ Hmax:=UPBV Htab;
+ For HashLoc:=0:Hmax do
+ <<Buk:=Htab[HashLoc];
+ For each H in Buk do Apply(F, List H)>>;
+ Return Hmax;
+End;
+
+
+% -------- Generic routines over hash tables
+% --- Local Only
+
+Lisp procedure LocalIntern S; %. Force Into Current Package
+ If IDP S then return LocalIntern Id2String S
+ else if not StringP S then NonStringError(S,'LocalIntern)
+ else if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalInstall S
+ else begin scalar P,H;
+ P:=Get(CurrentPackage!*,'\Package);
+ H:=Apply(PackageGetFn P,list S);
+ If IDP H then return H; % already there
+ Return Apply(PackagePutFn P,list S);
+ End;
+
+Lisp procedure LocalInternP S; %. Test in Current Package
+ If IDP S then LocalInternP ID2String S
+ else if not StringP S then NonStringError(S,'LocalInternP)
+ else if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalLookup S
+ else begin scalar P;
+ P:=Get(CurrentPackage!*,'\Package);
+ Return Apply(PackageGetFn P,list S);
+ End;
+
+Lisp procedure LocalRemOb S; %. Remove from Current Package
+ If IDP S then LocalRemob ID2String S
+ else if not StringP S then NonStringError(S,'LocalRemob)
+ else if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalRemove S
+ else begin scalar P,H;
+ P:=Get(CurrentPackage!*,'\Package);
+ Return Apply(PackageRemFn P,list S);
+ End;
+
+Lisp procedure LocalMapObl F; %. Force Into Current Package
+ if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalMapObl F
+ else begin scalar P;
+ P:=Get(CurrentPackage!*,'\Package);
+ Return Apply(PackageMapFn P,list F);
+ End;
+
+% Over Full Tree From CurrentPackage!*
+
+Lisp procedure PathIntern S; %. Do in Current If not Internd
+ If IDP S then PathIntern ID2String S
+ else if not StringP S then NonStringError(S,'PathIntern)
+ else if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalInstall S
+ else begin scalar H,P;
+ If IDP(H:=PathIntern1(S,CurrentPackage!*)) then return H;
+ P:=Get(CurrentPackage!*,'\Package);
+ Return Apply(PackagePutFn P,list S); % Do it at top level
+ end;
+
+Lisp Procedure PathIntern1(S,CurrentPackage!*); % Search Ancestor Chain
+ if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalLookup S
+ else begin scalar P,H;
+ P:=Get(CurrentPackage!*,'\Package);
+ H:=Apply(PackageGetFn P,list S);
+ If IDP H then return H;
+ Return PathIntern1(S,PackageFather P); % try ancestor
+ End;
+
+Lisp Procedure AlternatePathIntern S;
+ begin scalar H;
+ H:=PathInternP S;
+ If IDP H then return H;
+ return LocalIntern S;
+ End;
+
+Lisp procedure PathInternP S; %. TEST if Interned on Path
+ PathInternP1(S,CurrentPackage!*);
+
+Lisp Procedure PathInternP1(S,CurrentPackage!*);
+ If IDP S then PathInternP1(ID2String S,CurrentPackage!*)
+ else if not StringP S then NonStringError(S,'PathInternP)
+ else if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalLookup S
+ else begin scalar P,H;
+ P:=Get(CurrentPackage!*,'\Package);
+ H:=Apply(PackageGetFn P,list S);
+ If IDP H then return H;
+ return PathInternP1(S,PackageFather P); % try ancestor
+ End;
+
+Lisp procedure PathRemOb S; %. Remove First On Path
+ PathRemOb1(S,CurrentPackage!*);
+
+Lisp Procedure PathRemOb1(S,CurrentPackage!*);
+ If IDP S then PathRemOb1(ID2String S,CurrentPackage!*)
+ else if not StringP S then NonStringError(S,'PathRemob)
+ else if CurrentPackage!* eq NIL
+ or CurrentPackage!* eq '\Global then GlobalRemove S
+ else begin scalar P,H;
+ P:=Get(CurrentPackage!*,'\Package);
+ H:=Apply(PackageRemFn P,list S);
+ If IDP H then return H;
+ return PathRemob1(S,PackageFather P); % try ancestor
+ End;
+
+Lisp procedure PathMapObl F; %. Full path
+ PathMapObl1(F,CurrentPackage!*);
+
+Lisp procedure PathMapObl1(F,Pack);
+ if Pack eq NIL
+ or Pack eq '\Global then GlobalMapObl F
+ else begin scalar P,H;
+ P:=Get(Pack,'\Package);
+ Apply(PackageMapFn P,list F);
+ Return PathMapObl1(F,PackageFather P);
+ End;
+
+% ---- Build default Htabs for Bucket Hashed Case
+
+Lisp Procedure \CreateHashedPackage(Name,Father,n);
+ Begin Scalar Gf,Pf,Rf,Mf,G;
+ G:=Gensym();
+ Set(G, Mkvect n);
+ Gf:=Gensym();
+ Pf:=Gensym();
+ Rf:=Gensym();
+ Mf:=Gensym();
+ PutD(Gf,'Expr,LIST('Lambda,'(S),LIST('HashGetFn,'S,G)));
+ PutD(Pf,'Expr,LIST('Lambda,'(S),LIST('HashPutFn,'S,G)));
+ PutD(Rf,'Expr,LIST('Lambda,'(S),LIST('HashRemFn,'S,G)));
+ PutD(Mf,'Expr,LIST('Lambda,'(F),LIST('HashMapFn,'F,G)));
+ Return \CreateRawPackage(Name,Father,Gf,Pf,Rf,Mf);
+End;
+
+Lisp Procedure \CreatePackage(Name,Father);
+ \CreateHashedPackage(Name,Father,100);
+
+% ------ OutPut Functions
+
+CopyD('OldCprin2,'ChannelPrin2);
+CopyD('OldCprin1,'ChannelPrin1);
+%/ Take Channel and Itm
+
+Lisp Procedure NewCprin1(Channel,Itm);
+If IDP Itm then
+ Begin Scalar IDN,PN;
+ IDN:=ID2Int Itm;
+ PN:=SymPak IDN;
+ If IDP PN and PN then
+ <<NewCprin1(Channel,PN);ChannelWriteChar(Channel,PackageCharacter!*)>>;
+ OldCprin1(Channel,Itm);
+ End
+else OldCprin1(Channel,Itm);
+
+Lisp Procedure NewCprin2(Channel,Itm);
+If IDP Itm then
+ Begin Scalar IDN,PN;
+ IDN:=ID2Int Itm;
+ PN:=SymPak IDN;
+ If IDP PN and PN then
+ <<NewCprin2(Channel,PN);ChannelWriteChar(Channel,PackageCharacter!*)>>;
+ OldCprin2(Channel,Itm);
+ End
+else
+ OldCprin2(Channel,Itm);
+
+% ----- A simple Demo ---------------
+
+Procedure redef;
+Begin
+ CopyD('Intern,'PathIntern );
+ CopyD('InternP,'PathInternP );
+ CopyD('RemOb ,'PathRemOb );
+ CopyD('MapObl ,'PathMapObl);
+ CopyD('ChannelPrin1,'NewCPrin1);
+ CopyD('ChannelPrin2,'NewCPrin2);
+end;
+
+CopyD('CachedGlobalLookup,'GlobalLookup);
+
+Procedure GlobalLookup S;
+ <<LastLookedUp:=NIL; %/ Fix Cache Bug that always said YES
+ CachedGlobalLookup S>>;
+
+CopyD('NonCopyInstall,'GlobalInstall); % Some Bug in this too, clobers string
+Procedure GlobalInstall(S);
+ NonCopyInstall CopyString S;
+
+Redef();
+
+\CreatePackage('\P1,'\Global);
+\CreatePackage('\P2,'\Global);
+
+end;
ADDED psl-1983/3-1/util/parse-command-string.sl
Index: psl-1983/3-1/util/parse-command-string.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/parse-command-string.sl
@@ -0,0 +1,42 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Parse-Command-String.SL - Parse Program Command String
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 10 August 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common fast-vector))
+
+(de parse-command-string (s)
+
+ % This procedure accepts a string and parses it into a sequence
+ % of substrings separated by spaces. It is used to parse the
+ % "command string" given to the PSL program when it is invoked.
+
+ (let (s-list j
+ (high (size s))
+ (i 0))
+ (while T
+ % Scan for the beginning of an argument.
+ (while (<= i high)
+ (cond ((= (igets s i) (char space))
+ (setq i (+ i 1))
+ )
+ (t (exit)))
+ )
+ (if (> i high) (exit))
+ % Scan for the end of the argument.
+ (setq j i)
+ (while (<= j high)
+ (cond ((= (igets s j) (char space))
+ (exit)
+ )
+ (t (setf j (+ j 1))))
+ )
+ (setq s-list (aconc s-list (substring s i j)))
+ (setq i (+ j 1))
+ )
+ s-list))
ADDED psl-1983/3-1/util/parser-fix.red
Index: psl-1983/3-1/util/parser-fix.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/parser-fix.red
@@ -0,0 +1,76 @@
+%7:51am Sunday, 4 April 1982 Some parser fixes.
+
+FLUID '(!*BREAK);
+
+procedure ParErr(x,y);
+ Begin Scalar !*BREAK; % Turn off BREAK
+ StdError(x);
+ End;
+
+procedure ElseError x;
+ ParErr("ELSE should appear only in IF statement",T);
+
+procedure ThenError x;
+ ParErr("THEN should appear only in IF statement",T);
+
+DefineRop('THEN,4,ThenError);
+DefineRop('ELSE,4,ElseError);
+
+procedure DoError x;
+ ParErr("DO should appear only in WHILE or FOR statements",T);
+
+procedure UntilError x;
+ ParErr("UNTIL should appear only in REPEAT statement",T);
+
+DefineRop('Do,4,DoPError);
+DefineRop('Until,4,UntilMError);
+
+procedure SUMError x;
+ ParErr("SUM should appear only in FOR statements",T);
+
+procedure STEPError x;
+ ParErr("STEP should appear only in FOR statement",T);
+
+procedure ProductError x;
+ ParErr("PRODUCT should appear only in FOR statement",T);
+
+DefineRop('STEP,4,STEPError);
+DefineRop('SUM,4,SUMError);
+DefineRop('PRODUCT,4,ProductError);
+
+procedure CollectError x;
+ ParErr("COLLECT should appear only in FOR EACH statements",T);
+
+procedure CONCError x;
+ ParErr("CONC should appear only in FOR EACH statement",T);
+
+procedure JOINError x;
+ ParErr("JOIN should appear only in FOR EACH statement",T);
+
+DefineRop('CONC,4,CONCError);
+DefineRop('Collect,4,CollectError);
+DefineRop('JOIN,4,JOINError);
+
+% Parse Simple ATOM list
+
+SYMBOLIC PROCEDURE ParseAtomList(U,V,W); %. parse LIST of Atoms, maybe quoted
+ % U=funcname, V=following Token, W=arg treatment
+ BEGIN Scalar Atoms;
+ IF V EQ '!*SEMICOL!* THEN
+ RETURN ParErr("Missing AtomList after KEYWORD",T);
+ L: Atoms:=V . Atoms;
+ SCAN();
+ IF CURSYM!* eq '!*COMMA!* then <<V:=SCAN(); goto L>>;
+ IF CURSYM!* eq '!*SEMICOL!* then Return
+ <<OP := CURSYM!*;
+ If W eq 'FEXPR then U . Reverse Atoms
+ else LIST(U,MkQuotList Reverse Atoms)>>;
+ ParErr("Expect only Comma delimeter in ParseAtomList",T);
+ END;
+
+DefineRop('Load,NIL,ParseAtomList('Load,X,'Fexpr));
+Definerop('A1,NIL,ParseAtomList('A0,X,'Expr));
+Definerop('A2,NIL,ParseAtomList('A0,X,'FExpr));
+
+procedure a0 x;
+ print x;
ADDED psl-1983/3-1/util/pathin.build
Index: psl-1983/3-1/util/pathin.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pathin.build
@@ -0,0 +1,2 @@
+CompileTime load Useful;
+in "pathin.sl"$
ADDED psl-1983/3-1/util/pathin.sl
Index: psl-1983/3-1/util/pathin.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pathin.sl
@@ -0,0 +1,41 @@
+%
+% PATHIN.SL - Rlisp IN function with a search path
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 26 July 1982
+% Copyright (c) 1982 University of Utah
+%
+
+% PATHIN(filename-tail:string):none EXPR
+%
+% PATHIN allows the use of a directory search path with the Rlisp IN function.
+% The fluid variable PATHIN* should be a list of strings, which are directory
+% names. These will be successively concatenated onto the front of the
+% string argument to PATHIN until an existing file is found. If one is found,
+% IN will be invoked on the file. If not, a continuable error occurs.
+% E.g, if PATHIN* is ("" "/usr/src/cmd/psl/" "/u/smith/"), (pathin "foo.red")
+% will attempt to open "foo.red", then "/usr/src/cmd/psl/foo.red", and finally
+% "/u/smith/foo.red".
+
+(bothtimes (fluid '(pathin*)))
+
+(compiletime (flag '(pathin-aux) 'internalfunction))
+
+(loadtime (flag '(pathin) 'ignore)) % just like IN, gets done while compiling
+
+(loadtime (if (null pathin*) (setq pathin* '(""))))
+ % acts like IN until path is changed
+
+(de pathin (filename-tail)
+ (pathin-aux filename-tail pathin*))
+
+(de pathin-aux (filename-tail search-path-list)
+ (if (null search-path-list)
+ (conterror 99 "File not found in path" (pathin filename-tail))
+ (let ((test-file (concat (first search-path-list) filename-tail)))
+ (if (filep test-file)
+ (evin (list test-file))
+ (pathin-aux filename-tail (rest search-path-list))))))
ADDED psl-1983/3-1/util/pathnamex.sl
Index: psl-1983/3-1/util/pathnamex.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pathnamex.sl
@@ -0,0 +1,79 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PathNameX.SL - Useful Functions involving Pathnames
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 27 September 1982
+% Revised: 4 March 1983
+%
+% 4-Mar-83 Alan Snyder
+% Added maybe-pathname function.
+% 4-Feb-83 Alan Snyder
+% Added pathname-without-name function.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load pathnames))
+
+(de maybe-pathname (x)
+ % Attempt to convert X to a pathname. If not possible, return NIL.
+ (let ((result (errset (pathname x) NIL)))
+ (when (listp result) (car result))
+ ))
+
+(de pathname-without-name (pn)
+ % Return a pathname like PN but with no NAME, TYPE, or VERSION.
+
+ (setf pn (pathname pn))
+ (make-pathname 'host (pathname-host pn)
+ 'device (pathname-device pn)
+ 'directory (pathname-directory pn)
+ ))
+
+(de pathname-without-type (pn)
+ % Return a pathname like PN but with no TYPE or VERSION.
+
+ (setf pn (pathname pn))
+ (make-pathname 'host (pathname-host pn)
+ 'device (pathname-device pn)
+ 'directory (pathname-directory pn)
+ 'name (pathname-name pn)
+ ))
+
+(de pathname-without-version (pn)
+ % Return a pathname like PN but with no VERSION.
+
+ (setf pn (pathname pn))
+ (make-pathname 'host (pathname-host pn)
+ 'device (pathname-device pn)
+ 'directory (pathname-directory pn)
+ 'name (pathname-name pn)
+ 'type (pathname-type pn)
+ ))
+
+(de pathname-set-default-type (pn typ)
+ % Return a pathname like PN, except that if PN specifies no TYPE,
+ % then with type TYP and no version.
+
+ (setf pn (pathname pn))
+ (cond ((not (pathname-type pn))
+ (make-pathname 'host (pathname-host pn)
+ 'device (pathname-device pn)
+ 'directory (pathname-directory pn)
+ 'name (pathname-name pn)
+ 'type typ
+ ))
+ (t pn)))
+
+(de pathname-set-type (pn typ)
+ % Return a pathname like PN, except with type TYP and no version.
+
+ (setf pn (pathname pn))
+ (make-pathname 'host (pathname-host pn)
+ 'device (pathname-device pn)
+ 'directory (pathname-directory pn)
+ 'name (pathname-name pn)
+ 'type typ
+ ))
+
ADDED psl-1983/3-1/util/pcheck.build
Index: psl-1983/3-1/util/pcheck.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pcheck.build
@@ -0,0 +1,1 @@
+in "pcheck.red"$
ADDED psl-1983/3-1/util/pcheck.red
Index: psl-1983/3-1/util/pcheck.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pcheck.red
@@ -0,0 +1,46 @@
+% <PSL.UTIL>PCHECK.RED.3, 11-Oct-82 18:14:36, Edit by BENSON
+% Changed CATCH to *CATCH
+
+% A little program to check parens in a LISP file
+
+Fluid '(LastSexpr!*);
+procedure Pcheck F;
+ begin scalar Chan,OldChan;
+ LastSexpr!*:=NIL;
+ Chan:=Open(F,'Input);
+ OldChan:=RDS(Chan);
+ !*Catch(NIL,Pcheck1());
+ Rds(OldChan);
+ Close chan;
+% Printf("last Full S-expression%r%n",LastSexpr!*);
+ end;
+
+%/ can we enable Line counter somehow?
+
+procedure Pcheck1();
+ Begin Scalar x;
+ L: x:=Read();
+ if x eq !$EOF!$ then return NIL;
+ LastSexpr!*:=x;
+ PrintSome x;
+ Goto L;
+ End;
+
+procedure printsome x;
+ <<Prinsomelevel(x,2,3);terpri()>>;
+
+procedure prinsomelevel(x,l1,l2);
+If not pairp x then <<prin1 x; prin2 " ">>
+ else if l1 <=0 then prin2 " ... "
+ else if l2 <=0 then prin2 " ... "
+ else <<prin2 "("; prinsomelevel(car x,l1-1,l2);
+ if null cdr x then prin2 ")"
+ else if ListP cdr x then <<prinsomelevel(cdr x,l1,l2-1); prin2 ")">>
+ else <<prin2 " . "; prinsomelevel(cdr x,l1,l2-1); prin2 ")">>
+ >>;
+
+procedure ListP x;
+ null x or (Pairp x and ListP cdr x);
+
+end;
+
ADDED psl-1983/3-1/util/poly.build
Index: psl-1983/3-1/util/poly.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/poly.build
@@ -0,0 +1,1 @@
+in "poly.red"$
ADDED psl-1983/3-1/util/poly.red
Index: psl-1983/3-1/util/poly.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/poly.red
@@ -0,0 +1,716 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Simple POLY, RAT AND ALG system, based on POLY by Fitch and Marti.
+
+% Edit by Cris Perdue, 28 Jan 1983 2045-PST
+% "Dipthong" -> "Diphthong", order of revision history reversed
+% Modified by GRISS, JUly 1982 for PSL
+% MORRISON again, March 1981.
+% Parses INFIX expressions to PREFIX, then SIMPlifies and PRINTs
+% Handles also PREFIX expressions
+% Parser modified by OTTENHEIMER
+% February 1981, to be left associative March 1981.
+% Further modified by MORRISON
+% October 1980.
+% Modifed by GRISS and GALWAY
+% September 1980.
+
+% RUNNING: After loading POLY.RED, run function ALGG();
+% This accepts a sequence of expressions:
+% <exp> ; (Semicolon terminator)
+% <exp> ::= <term> [+ <exp> | - <exp>]
+% <term> ::= <primary> [* <term> | / <term>]
+% <primary> ::= <primary0> [^ <primary0> | ' <primary0> ]
+% ^ is exponentiation, ' is derivative
+% <primary0> ::= <number> | <variable> | ( <exp> )
+
+% PREFIX Format: <number> | <id> | (op arg1 arg2)
+% + -> PLUS2
+% - -> DIFFERENCE (or MINUS)
+% * -> TIMES2
+% / -> QUOTIENT
+% ^ -> EXPT
+% ' -> DIFF
+
+% Canonical Formats: Polynomial: integer | (term . polynomial)
+% term : (power . polynomial)
+% power : (variable . integer)
+% Rational : (polynomial . polynomial)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ %******************** Selectors and Constructors **********************
+
+smacro procedure RATNUM X; % parts of Rational
+ CAR X;
+
+smacro procedure RATDEN X;
+ CDR X;
+
+smacro procedure MKRAT(X,Y);
+ CONS(X,Y);
+
+smacro procedure POLTRM X; % parts of Poly
+ CAR X;
+
+smacro procedure POLRED X;
+ CDR X;
+
+smacro procedure MKPOLY(X,Y);
+ CONS(X,Y);
+
+smacro procedure TRMPWR X; % parts of TERM
+ CAR X;
+
+smacro procedure TRMCOEF X;
+ CDR X;
+
+smacro procedure MKTERM(X,Y);
+ CONS(X,Y);
+
+smacro procedure PWRVAR X; % parts of Poly
+ CAR X;
+
+smacro procedure PWREXPT X;
+ CDR X;
+
+smacro procedure MKPWR(X,Y);
+ CONS(X,Y);
+
+smacro procedure POLVAR X;
+ PWRVAR TRMPWR POLTRM X;
+
+smacro procedure POLEXPT X;
+ PWREXPT TRMPWR POLTRM X;
+
+smacro procedure POLCOEF X;
+ TRMCOEF POLTRM X;
+
+ %*********************** Utility Routines *****************************
+
+procedure VARP X;
+ IDP X OR (PAIRP X AND IDP CAR X);
+
+
+ %*********************** Entry Point **********************************
+
+FLUID '(!*RBACKTRACE
+ !*RECHO
+ REXPRESSION!*
+ !*RMESSAGE
+ PromptString!*
+ TOK!*
+ CurrentScantable!*
+);
+
+!*RECHO := NIL; % No echo of parse
+!*RMESSAGE := T; % Do Print messages
+
+procedure RAT(); %. Main LOOP, end with QUIT OR Q
+BEGIN SCALAR VVV,PromptString!*;
+ Prin2T "Canonical Rational Evaluator";
+ PromptString!*:="poly> ";
+ ALGINIT();
+ CLEARTOKEN(); % Initialize scanner
+LOOP: VVV := ERRORSET('(RPARSE),T,!*RBACKTRACE);
+ IF ATOM VVV THEN % What about resetting the Scanner?
+ <<PRINT LIST('RATT, 'error, VVV); CLEARTOKEN();GO TO LOOP>>;
+ REXPRESSION!* := CAR VVV;
+ IF !*RECHO THEN PRINT LIST('parse,REXPRESSION!*);
+ IF REXPRESSION!* EQ 'QUIT THEN <<
+ PRINT 'QUITTING;
+ RETURN >>;
+ ERRORSET('(RATPRINT (RSIMP REXPRESSION!*)),T,!*RBACKTRACE);
+ GOTO LOOP
+END RAT;
+
+procedure ALGG(); %. Main LOOP, end with QUIT OR Q
+BEGIN SCALAR VVV,PromptString!*;
+ prin2t "non-canonical rational evaluator";
+ alginit();
+ promptstring!* := "poly> ";
+ cleartoken(); % initialize scanner
+loop: vvv := errorset('(rparse),t,!*rbacktrace);
+ if atom vvv then % what about resetting the scanner?
+ <<print list('algg, 'error, vvv); cleartoken();go to loop>>;
+ rexpression!* := car vvv;
+ if !*recho then print rexpression!*;
+ if rexpression!* eq 'quit then <<
+ print 'quitting;
+ return >>;
+ errorset('(preprint (presimp rexpression!*)),t,!*rbacktrace);
+ go to loop
+end algg;
+
+procedure alginit(); %. called to init tables
+ begin
+ inittoken();
+ prin2t "quit; to exit";
+ put('times2,'rsimp,'r!*); %. simplifier tables
+ put('plus2,'rsimp,'r!+);
+ put('difference,'rsimp,'r!-);
+ put('quotient,'rsimp,'r!/);
+ put('expt,'rsimp,'r!^);
+ put('diff,'rsimp,'r!');
+ put('minus,'rsimp,'r!.neg);
+ put('!+,'rexp,'plus2); % use corresponding 'r!xx in eval mode
+ put('!-,'rexp,'difference);
+ put('!*,'rterm,'times2);;
+ put('!/,'rterm,'quotient);
+ put('!^,'rprimary,'expt);
+ put('!','rprimary,'diff);
+ put('plus2,'prinop,'plusprin); %. output funs
+ put('difference,'prinop,'differenceprin);
+ put('times2,'prinop,'timesprin);
+ put('quotient,'prinop,'quotprin);
+ put('expt,'prinop,'expprin);
+ end;
+
+procedure cleartoken;
+ nil;
+
+procedure inittoken;
+<< AlgScantable!* :=
+ '[17 11 11 11 11 11 11 11 11 17 17 11 17 17 11 11 11 11 11 11 11 11 11 11
+ 11 11 11 11 11 11 11 11 17 14 15 11 11 12 11 11 11 11 13 19 11 18 20 11
+ 0 1 2 3 4 5 6 7 8 9 13 11 13 11 13 11 11 10 10 10 10 10 10 10 10 10 10
+ 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 11 10 11 10 10
+ 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+ 11 11 11 11 11 Algdiphthong];
+ AlgScanTable!*[char '!+]:=11;
+ AlgScanTable!*[char '!-]:=11;
+>>;
+
+
+procedure NTOKEN;
+ Begin Scalar CurrentScantable!*;
+ CurrentScanTable!* := AlgScanTable!*;
+ TOK!* := RATOM();
+ Return Tok!*;
+ End;
+
+procedure RSIMP X; %. Simplify Prefix Form to Canonical
+ IF ATOM X THEN RCREATE X
+ ELSE BEGIN SCALAR Y,OP;
+ OP:=CAR X;
+ IF (Y:=GET(OP,'RSIMP)) THEN RETURN APPLY(Y,RSIMPL CDR X);
+ Y:=PRESIMP X; % As "variable" ?
+ IF ATOM Y OR NOT(X=Y) THEN RETURN RSIMP Y;
+ RETURN RCREATE Y;
+ END;
+
+procedure RSIMPL X; %. Simplify argument list
+ IF NULL X THEN NIL ELSE RSIMP(CAR X) . RSIMPL CDR X;
+
+procedure PRESIMP X; %. Simplify Prefix Form to PREFIX
+ IF ATOM X THEN X
+ ELSE BEGIN SCALAR Y,OP;
+ OP:=CAR X;
+ IF (Y:=GET(OP,'RSIMP)) THEN RETURN RAT2PRE APPLY(Y,RSIMPL CDR X);
+ X:=PRESIMPL CDR X;
+ IF (Y:=GET(OP,'PRESIMP)) THEN RETURN APPLY(Y,X);
+ RETURN (OP . X);
+ END;
+
+procedure PRESIMPL X; %. Simplify argument list
+ IF NULL X THEN NIL ELSE PRESIMP(CAR X) . PRESIMPL CDR X;
+
+ %**************** Simplification Routines for Rationals ***************
+
+procedure R!+(A,B); %. RAT addition
+ IF RATDEN A = RATDEN B THEN %/ Risa
+ MAKERAT(P!+(RATNUM A,RATNUM B),RATDEN A)
+ ELSE
+ MAKERAT(P!+(P!*(RATNUM A,RATDEN B),
+ P!*(RATDEN A,RATNUM B)),
+ P!*(RATDEN A,RATDEN B));
+
+procedure R!-(A,B); %. RAT subtraction
+ R!+(A,R!.NEG B);
+
+procedure R!.NEG A; %. RAT negation
+ MKRAT(P!.NEG RATNUM A,RATDEN A);
+
+procedure R!*(A,B); %. RAT multiplication
+ BEGIN SCALAR X,Y;
+ X:=MAKERAT(RATNUM A,RATDEN B);
+ Y:=MAKERAT(RATNUM B,RATDEN A);
+ IF RATNUM X=0 OR RATNUM Y=0 THEN RETURN 0 . 1;
+ RETURN MKRAT(P!*(RATNUM X,RATNUM Y),
+ P!*(RATDEN X,RATDEN Y))
+END;
+
+procedure R!.RECIP A; %. RAT inverse
+ IF RATNUM A=0 THEN ERROR(777,'(ZERO DIVISOR))
+ ELSE MKRAT(RATDEN A,RATNUM A);
+
+procedure R!/(A,B); %. RAT division
+ R!*(A,R!.RECIP B);
+
+procedure R!.LVAR A; %. Leading VARIABLE of RATIONAL
+ BEGIN SCALAR P;
+ P:=RATNUM A;
+ IF NUMBERP P THEN RETURN ERROR(99,'(non structured polynomial));
+ P:=POLVAR P;
+ RETURN P;
+ END;
+
+procedure R!'(A,X); %. RAT derivative
+ <<X:=R!.LVAR X;
+ IF RATDEN A=1 THEN MKRAT(PDIFF(RATNUM A,X),1)
+ ELSE R!-(MAKERAT(PDIFF(RATNUM A,X),RATDEN A),
+ MAKERAT(P!*(RATNUM A,PDIFF(RATDEN A,X)),
+ P!*(RATDEN A,RATDEN A) ) ) >>;
+
+procedure RCREATE X; %. RAT create
+ IF NUMBERP X THEN X . 1
+ ELSE IF VARP X THEN (PCREATE X) . 1
+ ELSE ERROR(100,LIST(X, '(non kernel)));
+
+procedure MAKERAT(A,B);
+IF A=B THEN MKRAT(1,1)
+ ELSE IF A=0 THEN 0 . 1
+ ELSE IF B=0 THEN ERROR(777,'(ZERO DIVISOR))
+ ELSE IF NUMBERP A AND NUMBERP B THEN
+ BEGIN SCALAR GG;
+ GG:=NUMGCD(A,B);
+ IF B<0 THEN <<B:=-B; A := -A>>;
+ RETURN MKRAT(A/GG,B/GG)
+ END
+ ELSE BEGIN SCALAR GG,NN;
+ GG:=PGCD(A,B);
+ IF GG=1 THEN RETURN MKRAT(A,B);
+ NN:=GG;
+LL: IF NUMBERP NN THEN NN:=GCDPT(GG,NN)
+ ELSE << NN:=POLCOEF GG; GOTO LL >>;
+ GG:=CAR PDIVIDE(GG,NN);
+ RETURN MKRAT(DIVIDEOUT(A,GG),DIVIDEOUT(B,GG))
+END;
+
+procedure R!^(A,N); %. RAT Expt
+ BEGIN SCALAR AA;
+ N:=RATNUM N;
+ IF NOT NUMBERP N THEN RETURN ERROR(777,'(Non numeric exponent))
+ ELSE IF N=0 THEN RETURN RCREATE 1;
+ IF N<0 THEN <<A:=R!.RECIP A; N:=-N>>;
+ AA:=1 . 1;
+ FOR I:=1:N DO AA:=R!*(AA,A);
+ RETURN AA
+ END;
+
+ %**************** Simplification Routines for Polynomials *************
+
+procedure P!+(A,B); %. POL addition
+ IF A=0 THEN B ELSE IF B=0 THEN A ELSE
+ IF NUMBERP A AND NUMBERP B THEN PLUS2(A,B)
+ ELSE IF NUMBERP A THEN MKPOLY(POLTRM B,P!+(A,POLRED B))
+ ELSE IF NUMBERP B THEN MKPOLY(POLTRM A,P!+(B,POLRED A))
+ ELSE BEGIN SCALAR ORD;
+ ORD:=PORDERP(POLVAR A,POLVAR B);
+ IF ORD=1 THEN RETURN MKPOLY(POLTRM A,P!+(POLRED A,B));
+ IF ORD=-1 THEN RETURN MKPOLY(POLTRM B,P!+(POLRED B,A));
+ IF POLEXPT A=POLEXPT B THEN RETURN
+ BEGIN SCALAR AA,BB;
+ AA:=P!+(POLCOEF A,POLCOEF B);
+ IF AA=0 THEN RETURN P!+(POLRED A,POLRED B);
+ AA:=MKPOLY(TRMPWR POLTRM A,AA);
+ AA:=ZCONS AA; BB:=P!+(POLRED A,POLRED B);
+ RETURN P!+(AA,BB) END;
+ IF POLEXPT A>POLEXPT B THEN RETURN
+ MKPOLY(POLTRM A,P!+(POLRED A,B));
+ RETURN MKPOLY(POLTRM B,P!+(POLRED B,A))
+ END;
+
+procedure PORDERP(A,B); %. POL variable ordering
+ IF A EQ B THEN 0
+ ELSE IF ORDERP(A,B) THEN 1 ELSE -1;
+
+procedure P!*(A,B); %. POL multiply
+ IF NUMBERP A THEN
+ IF A=0 THEN 0
+ ELSE IF NUMBERP B THEN TIMES2(A,B)
+ ELSE CONS(CONS(CAAR B,PNTIMES(CDAR B,A)),
+ PNTIMES(CDR B,A))
+ ELSE IF NUMBERP B THEN PNTIMES(A,B)
+ ELSE P!+(PTTIMES(CAR A,B),P!*(CDR A,B));
+
+procedure PTTIMES(TT,A); %. POL term mult
+ IF NUMBERP A THEN
+ IF A=0 THEN 0 ELSE
+ ZCONS CONS(CAR TT,PNTIMES(CDR TT,A))
+ ELSE P!+(TTTIMES(TT,CAR A),PTTIMES(TT,CDR A));
+
+procedure PNTIMES(A,N); %. POL numeric coef mult
+ IF N=0 THEN 0
+ ELSE IF NUMBERP A THEN TIMES2(A,N)
+ ELSE CONS(CONS(CAAR A,PNTIMES(CDAR A,N)),PNTIMES(CDR A,N));
+
+procedure TTTIMES(TA,TB); %. TERM Mult
+ BEGIN SCALAR ORD;
+ ORD:=PORDERP(CAAR TA,CAAR TB);
+ RETURN IF ORD=0 THEN
+ ZCONS(CONS(CONS(CAAR TA,PLUS2(CDAR TA,CDAR TB)),
+ P!*(CDR TA,CDR TB)))
+ ELSE IF ORD=1 THEN
+ ZCONS(CONS(CAR TA,P!*(ZCONS TB,CDR TA)))
+ ELSE ZCONS(CONS(CAR TB,P!*(ZCONS TA,CDR TB)))
+END;
+
+procedure ZCONS A; %. Make single term POL
+ CONS(A,0);
+
+procedure PCREATE1(X); %. Create POLY from Variable/KERNEL
+ ZCONS(CONS(CONS(X,1),1));
+
+procedure PCREATE X;
+ IF IDP X THEN PCREATE1 X
+ ELSE IF PAIRP X AND IDP CAR X THEN PCREATE1 MKKERNEL X
+ ELSE ERROR(1000,LIST(X, '(bad kernel)));
+
+procedure PGCD(A,B); %. POL Gcd
+% A and B must be primitive.
+IF A=1 OR B=1 THEN 1 ELSE
+IF NUMBERP A AND NUMBERP B THEN NUMGCD(A,B)
+ ELSE IF NUMBERP A THEN GCDPT(B,A)
+ ELSE IF NUMBERP B THEN GCDPT(A,B)
+ ELSE BEGIN SCALAR ORD;
+ ORD:=PORDERP(CAAAR A,CAAAR B);
+ IF ORD=0 THEN RETURN GCDPP(A,B);
+ IF ORD>0 THEN RETURN GCDPT(A,B);
+ RETURN GCDPT(B,A)
+END;
+
+procedure NUMGCD(A,B); %. Numeric GCD
+ IF A=0 THEN ABS B
+ ELSE NUMGCD(REMAINDER(B,A),A);
+
+procedure GCDPT(A,B); %. POL GCD, non-equal vars
+IF NUMBERP A THEN IF NUMBERP B THEN NUMGCD(A,B) ELSE
+ GCDPT(B,A) ELSE
+BEGIN SCALAR ANS,ANS1;
+ ANS:=PGCD(CDAR A,B);
+ A:=CDR A;
+ WHILE NOT NUMBERP A DO <<
+ ANS1:=PGCD(CDAR A,B);
+ ANS:=PGCD(ANS,ANS1);
+ A:=CDR A;
+ IF ANS=1 THEN RETURN ANS >>;
+ RETURN IF A=0 THEN ANS ELSE GCDPT(ANS,A)
+END;
+
+procedure GCDPP(A,B); %. POL GCD, equal vars
+BEGIN SCALAR TT,PA,ALPHA,PREVALPHA;
+ IF POLEXPT B>POLEXPT A THEN <<
+ TT := A;
+ A := B;
+ B := TT >>;
+ ALPHA := 1;
+LOOP: PREVALPHA := ALPHA;
+ ALPHA := POLCOEF B;
+ PA := POLEXPT A - POLEXPT B;
+ IF PA<0 THEN <<
+ PRINT A;
+ PRINT B;
+ PRINT PA;
+ ERROR(999,'(WRONG)) >>;
+ WHILE NOT (PA=0) DO <<
+ PA := PA-1;
+ ALPHA := P!*(POLCOEF B,ALPHA) >>;
+ A := P!*(A,ALPHA); % to ensure no fractions;
+ TT := CDR PDIVIDE(A,B); % quotient and remainder of polynomials;
+ IF TT=0 THEN
+ RETURN B; % which is the GCD;
+ A := B;
+ B := PDIVIDE(TT,PREVALPHA);
+ IF NOT(CDR B=0) THEN
+ ERROR(12,'(REDUCED PRS FAILS));
+ B := CAR B;
+ IF NUMBERP B OR NOT (POLVAR A EQ POLVAR B) THEN RETURN 1;
+ % Lost leading VAR we started with. /MLG
+ GO TO LOOP
+END;
+
+procedure DIVIDEOUT(A,B); %. POL exact division
+ CAR PDIVIDE(A,B);
+
+procedure PDIVIDE(A,B); %. POL (quotient.remainder)
+ IF NUMBERP A THEN
+ IF NUMBERP B THEN DIVIDE(A,B)
+ ELSE CONS(0,A)
+ ELSE IF NUMBERP B THEN BEGIN SCALAR SS,TT;
+ SS:=PDIVIDE(CDR A,B);
+ TT:=PDIVIDE(CDAR A,B);
+ RETURN CONS(
+ P!+(P!*(ZCONS CONS(CAAR A,1),CAR TT),CAR SS),
+ P!+(P!*(ZCONS CONS(CAAR A,1),CDR TT),CDR SS))
+ END
+ ELSE BEGIN SCALAR QQ,BB,CC,TT;
+ IF NOT(POLVAR A EQ POLVAR B) OR POLEXPT A < POLEXPT B THEN
+ RETURN CONS(0,A); % Not same var/MLG, degree check/DFM
+ QQ:=PDIVIDE(POLCOEF A,POLCOEF B); % Look for leading term;
+ IF NOT(CDR QQ=0) THEN RETURN CONS(0,A);
+ QQ:=CAR QQ; %Get the quotient;
+ BB:=P!*(B,QQ);
+ IF CDAAR A>CDAAR B THEN <<
+ TT:=ZCONS CONS(CONS(CAAAR A,CDAAR A-CDAAR B),1);
+ BB:=P!*(BB,TT);
+ QQ:=P!*(QQ,TT)
+ >>;
+ CC:=P!-(A,BB); %Take it off;
+ BB:=PDIVIDE(CC,B);
+ RETURN CONS(P!+(QQ,CAR BB),CDR BB)
+ END;
+
+procedure P!-(A,B); %. POL subtract
+ P!+(A,P!.NEG B);
+
+procedure P!.NEG(A); %. POL Negate
+ IF NUMBERP A THEN -A
+ ELSE CONS(CONS(CAAR A,P!.NEG CDAR A),P!.NEG CDR A);
+
+procedure PDIFF(A,X); %. POL derivative (to variable)
+ IF NUMBERP A THEN 0
+ ELSE BEGIN SCALAR ORD;
+ ORD:=PORDERP(POLVAR A,X);
+ RETURN
+ IF ORD=-1 THEN 0
+ ELSE IF ORD=0 THEN
+ IF CDAAR A=1 THEN
+ CDAR A
+ ELSE P!+(ZCONS CONS(CONS(X,CDAAR A-1),P!*(CDAAR A,CDAR A)),
+ PDIFF(CDR A,X))
+ ELSE P!+(P!*(ZCONS CONS(CAAR A,1),PDIFF(CDAR A,X)),PDIFF(CDR A,X))
+END;
+
+procedure MKKERNEL X;
+ BEGIN SCALAR KERNELS,K,OP;
+ K:=KERNELS:=GET(OP:=CAR X,'KERNELS);
+ L: IF NULL K THEN RETURN<<PUT(OP,'KERNELS,X.KERNELS);X>>;
+ IF X=CAR K THEN RETURN CAR K;
+ K:=CDR K;
+ GOTO L
+ END;
+
+ %***************************** Parser *********************************
+
+% Simple parser creates expressions to be evaluated by the
+% rational polynomial routines.
+% J. Marti, August 1980.
+% Modified and Extended by GRISS and GALWAY
+% Rewritten to be left associative by OTTENHEIMER, March 1981
+
+
+procedure RPARSE(); %. PARSE Infix to Prefix
+BEGIN SCALAR X;
+ NTOKEN();
+ IF TOK!* EQ '!; THEN RETURN NIL; % Fix for null exp RBO 9 Feb 81
+ IF NULL(X := REXP()) THEN RETURN ERROR(105, '(Unparsable Expression));
+ IF TOK!* NEQ '!; THEN RETURN ERROR(106, '(Missing !; at end of expression));
+ RETURN X
+END;
+
+procedure REXP(); %. Parse an EXP and rename OP
+BEGIN SCALAR LEFT, RIGHT,OP;
+ IF NOT (LEFT := RTERM()) THEN RETURN NIL;
+ WHILE (OP := GET(TOK!*,'REXP)) DO
+ << NTOKEN();
+ IF NOT(RIGHT := RTERM()) THEN RETURN ERROR(100, '(Missing Term in Exp));
+ LEFT := LIST(OP, LEFT, RIGHT)
+ >>;
+ RETURN LEFT
+END;
+
+procedure RTERM(); %. PARSE a TERM
+BEGIN SCALAR LEFT, RIGHT, OP;
+ IF NOT (LEFT := RPRIMARY()) THEN RETURN NIL;
+ WHILE (OP := GET(TOK!*,'RTERM)) DO
+ << NTOKEN();
+ IF NOT (RIGHT := RPRIMARY()) THEN
+ RETURN ERROR (101, '(Missing Primary in Term));
+ LEFT := LIST(OP, LEFT, RIGHT)
+ >>;
+ RETURN LEFT
+END;
+
+procedure RPRIMARY(); %. RPRIMARY, allows "^" and "'"
+BEGIN SCALAR LEFT, RIGHT, OP;
+ IF TOK!* EQ '!+ THEN RETURN <<NTOKEN(); RPRIMARY0()>>;
+ IF TOK!* EQ '!-
+ THEN RETURN << NTOKEN();
+ IF (LEFT := RPRIMARY0()) THEN LIST('MINUS, LEFT)
+ ELSE RETURN ERROR(200,'(Missing Primary0 after MINUS))
+ >>;
+
+ IF NOT (LEFT := RPRIMARY0()) THEN RETURN NIL;
+ WHILE (OP := GET(TOK!*,'RPRIMARY)) DO
+ << NTOKEN();
+ IF NOT (RIGHT := RPRIMARY0()) THEN
+ RETURN ERROR(200, '(Missing Primary0 in Primary));
+ LEFT := LIST(OP, LEFT, RIGHT)
+ >>;
+ RETURN LEFT;
+END;
+
+procedure RPRIMARY0(); %. Variables, etc
+BEGIN SCALAR EXP, ARGS;
+ IF TOK!* EQ '!( THEN
+ << NTOKEN();
+ IF NOT (EXP := REXP()) THEN RETURN ERROR(102, '(Missing Expression));
+ IF TOK!* NEQ '!) THEN RETURN ERROR(103, '(Missing Right Parenthesis));
+ NTOKEN();
+ RETURN EXP
+ >>;
+
+ IF NUMBERP(EXP := TOK!*)
+ THEN RETURN <<NTOKEN(); EXP>>;
+
+ IF NOT IDP EXP THEN RETURN NIL;
+ NTOKEN();
+ IF ARGS := RARGS(EXP) THEN RETURN ARGS;
+ RETURN EXP;
+END;
+
+procedure RARGS(X);
+ BEGIN SCALAR ARGS,ARG;
+ IF TOK!* NEQ '!( THEN RETURN NIL;
+ NTOKEN();
+ IF TOK!* EQ '!) THEN RETURN <<NTOKEN();X . NIL>>;
+ L: IF NOT (ARG :=REXP()) THEN ERROR(104,'(Not expression in ARGLST));
+ ARGS := ARG . ARGS;
+ IF TOK!* EQ '!, THEN <<NTOKEN(); GOTO L>>;
+ IF TOK!* EQ '!) THEN RETURN <<NTOKEN();X . REVERSE ARGS>>;
+ ERROR(105,'(Missing !) or !, in ARGLST));
+ END;
+
+procedure MKATOM X;
+% Use LIST('RCREATE, LIST('QUOTE,x)); if doing EVAL mode
+ X;
+
+ %******************* Printing Routines ********************************
+
+procedure PPRINT A;
+% Print internal canonical form in Infix notation.
+ IF NUMBERP A THEN PRIN2 A ELSE
+BEGIN
+ IF NUMBERP CDAR A THEN
+ IF CDAR A = 0 THEN
+ << PRIN2 '0; RETURN NIL >>
+ ELSE IF CDAR A NEQ 1 THEN
+ << PRIN2 CDAR A; PRIN2 '!* >>
+ ELSE NIL
+ ELSE IF RPREC!* CDAR A THEN << PPRINT CDAR A; PRIN2 '!* >>
+ ELSE <<PRIN2 '!(; PPRINT CDAR A; PRIN2 '!)!* >>;
+ IF CDAAR A = 0 THEN PRIN2 1
+ ELSE IF CDAAR A = 1 THEN PRIN2 CAAAR A
+ ELSE << PRIN2 CAAAR A; PRIN2 '!^;
+ IF RPREC!^ CDAAR A THEN PPRINT CDAAR A
+ ELSE <<PRIN2 '!(; PPRINT CAAAR A; PRIN2 '!) >> >>;
+ IF NUMBERP CDR A THEN
+ IF CDR A> 0 THEN <<PRIN2 '!+ ; PRIN2 CDR A; RETURN NIL>>
+ ELSE IF CDR A < 0 THEN <<PRIN2 '!-! ; PRIN2 (-CDR A);
+ RETURN NIL>>
+ ELSE RETURN NIL;
+ IF ATOM CDR A THEN <<PRIN2 '!+ ; PRIN2 CDR A; RETURN NIL>>;
+ PRIN2 '!+ ; PPRINT CDR A;
+END;
+
+procedure RPREC!* X; %. T if there is no significant addition in X.
+ ATOM X OR (NUMBERP POLRED X AND POLRED X = 0);
+
+procedure RPREC!^ X; %. T if there is not significant
+ %. addition or multiplication in X.
+RPREC!* X AND (ATOM X OR
+ (ATOM CDAR X AND NUMBERP CDAR X));
+
+procedure SIMPLE X; %. POL that doest need ()
+ ATOM X OR ((POLRED X=0) AND (POLEXPT X=1) AND (POLCOEF X =1));
+
+procedure RATPRINT A; %. Print a RAT
+BEGIN
+ IF CDR A = 1 THEN PPRINT CAR A
+ ELSE <<NPRINT CAR A;
+ PRIN2 '!/;
+ NPRINT CDR A>>;
+ TERPRI()
+END;
+
+procedure NPRINT A; %. Add parens, if needed
+ IF NOT SIMPLE A THEN <<PRIN2 '!( ; PPRINT A; PRIN2 '!) >>
+ ELSE PPRINT A;
+
+%. Convert RCAN back to PREFIX form
+
+procedure RAT2PRE X; %. RATIONAL to Prefix
+ IF RATDEN X = 1 THEN POL2PRE RATNUM X
+ ELSE LIST('QUOTIENT,POL2PRE RATNUM X, POL2PRE RATDEN X);
+
+procedure POL2PRE X; %. Polynomial to Prefix
+BEGIN SCALAR TT,RR;
+ IF NOT PAIRP X THEN RETURN X;
+ TT:=TRM2PRE POLTRM X;
+ RR:=POL2PRE POLRED X;
+ IF RR = 0 THEN RETURN TT;
+ IF NUMBERP RR AND RR <0 THEN RETURN LIST('DIFFERENCE,TT,-RR);
+ RETURN LIST('PLUS2,TT,RR);
+END;
+
+procedure TRM2PRE X; %. Term to Prefix
+ IF TRMCOEF X = 1 THEN PWR2PRE TRMPWR X
+ ELSE IF TRMCOEF X = (-1) THEN LIST('MINUS,PWR2PRE TRMPWR X)
+ ELSE LIST('TIMES2,POL2PRE TRMCOEF X,PWR2PRE TRMPWR X);
+
+procedure PWR2PRE X; %. Power to Prefix
+ IF PWREXPT X = 1 THEN PWRVAR X
+ ELSE LIST('EXPT,PWRVAR X,PWREXPT X);
+
+%. prefix Pretty print
+
+procedure PREPRIN(A,PARENS); %. Print PREFIX form in Infix notation.
+ BEGIN SCALAR PRINOP;
+ IF ATOM A THEN RETURN PRIN2 A;
+ IF (PRINOP:=GET(CAR A,'PRINOP))
+ THEN RETURN APPLY(PRINOP,LIST(A,PARENS));
+ PRIN2(CAR A); PRINARGS CDR A;
+ RETURN A;
+ END;
+
+procedure PRINARGS A; %. Print ArgLIST
+ IF NOT PAIRP A THEN PRIN2 '!(!)
+ ELSE <<PRIN2 '!(; WHILE PAIRP A DO
+ <<PREPRIN(CAR A,NIL);
+ IF PAIRP (A:=CDR A) THEN PRIN2 '!,>>;
+ PRIN2 '!)>>;
+
+procedure PREPRINT A;
+ <<PREPRIN(A,NIL); TERPRI(); A>>;
+
+procedure NARYPRIN(OP,ARGS,PARENS);
+ IF NOT PAIRP ARGS THEN NIL
+ ELSE IF NOT PAIRP CDR ARGS THEN PREPRIN(CAR ARGS,PARENS)
+ ELSE <<IF PARENS THEN PRIN2 '!(;
+ WHILE PAIRP ARGS DO
+ <<PREPRIN(CAR ARGS,T); % Need precedence here
+ IF PAIRP(ARGS:=CDR ARGS) THEN PRIN2 OP>>;
+ IF PARENS THEN PRIN2 '!)>>;
+
+
+procedure PLUSPRIN(A,PARENS);
+ NARYPRIN('! !+! ,CDR A,PARENS);
+
+procedure DIFFERENCEPRIN(A,PARENS);
+ NARYPRIN('! !-! ,CDR A,PARENS);
+
+procedure TIMESPRIN(A,PARENS);
+ NARYPRIN('!*,CDR A,PARENS);
+
+procedure QUOTPRIN(A,PARENS);
+ NARYPRIN('!/,CDR A,PARENS);
+
+procedure EXPPRIN(A,PARENS);
+ NARYPRIN('!^,CDR A,PARENS);
+
+
+procedure OrderP(x,y);
+% ordering of ID's as VARS
+ Id2int(x) <= Id2Int (y);
+
+
+End;
+
ADDED psl-1983/3-1/util/pp.build
Index: psl-1983/3-1/util/pp.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pp.build
@@ -0,0 +1,2 @@
+Compiletime Load Useful;
+in "pp.sl"$
ADDED psl-1983/3-1/util/pp.sl
Index: psl-1983/3-1/util/pp.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pp.sl
@@ -0,0 +1,604 @@
+%(!* YPP -- THE PRETTYPRINTER
+%
+% <BENSON>YPP.SL.19, 17-Sep-82 09:52:42, Edit by BENSON
+% Courtesy of IMSSS, with modifications for PSL
+%
+% PP( LST:list ) FEXPR
+% PRETTYPRINT( X:any ) EXPR
+%
+% Revision History:
+%
+% April 4, 1983: Douglas
+% Take the words "cond" and "lambda" out of strings
+% so that they are not printed in the wrong case.
+%
+% March 17, 1983: Douglas
+% Patched bug introduced tuesday in let clause.
+%
+% March 15, 1983: Douglas
+% Modularized code for linear vertical lists.
+% Modified and simplified
+% special code for cond, do, do*, let, and let*.
+%
+% March 10, 1983: Douglas
+% Added dn to lists of functions specially printed.
+% (same as definitions of de,df,dm). Added a terpri
+% after printing function definitions.
+%
+% March 8, 1983: Douglas
+% Added a special feature to prettyprint lambda expression
+% in a more readable fashion. Added a line to load useful
+% when compiling.
+%
+% March 3, 1983: Douglas
+% Added line to load fast-int when compiling.
+%
+% Feb. 23, 1983 Douglas
+% Seperated the testing of specially treated test functions
+% and the printing of these special test functions to
+% eliminate a recursion problem with special forms in
+% the cdr slot.
+%
+% Feb. 10, 1983 Douglas Lanam
+% Fixed a bug where special list structures in the cdr position
+% were not handled correctly.
+% Also removed calls to the function "add" since this is not
+% a basic psl function. Replaced them with "plus".
+%
+% Feb. 8, 1983 Douglas Lanam
+% Fix of many numerous small bugs and some clean up of code.
+%
+% Feb. 5, 1983 MLG
+% Changed the nflatsize1 definition line to correct parens.
+%
+% Dec. 14, 1982 Douglas Lanam
+% Fixed bug with sprint-prog and sprint-lamdba, so that it
+% gets the correct left-margin for sub-expression.
+%
+% Dec. 13, 1982 Douglas Lanam
+% Removal of old code that put properties on 'de','df','dm',
+% than messed up prettyprint on expressions with that atom
+% in the car of the expression. Also handles prinlevel, and
+% prinlength.
+% Fix bug with '(quote x y). Taught system about labels in
+% progs and dos. Taught system about special forms: do,let,
+% de, df, dm, defmacro, and cond.
+%
+% November 1982 Douglas Lanam
+% Rewritten to be more compact, more modular,
+% and handle vectors.
+%")
+
+(compiletime
+ (load useful fast-int))
+
+(COMPILETIME
+ (FLAG '(WARNING
+ PP-VAL
+ PP-DEF
+ PP-DEF-1
+ BROKEN
+ GET-GOOD-DEF
+ S2PRINT
+ sprint-dtpr
+ sprint-vector
+ sprint-read-macro
+ read-macro-internal-sprint
+ is-read-macrop
+ handle-read-macros
+ handle-special-list-structures
+ check-if-room-for-and-back-indent
+ nflatsize1
+ CHRCT
+ SPACES-LEFT
+ SAFE-PPOS
+ POSN1
+ POSN2
+ PPOS) 'INTERNALFUNCTION))
+
+(compiletime
+ (fluid '(prinlength prinlevel sprint-level)))
+
+(setq sprint-level 0)
+
+(DE WARNING (X) (ERRORPRINTF "*** %L" X))
+
+%(!* "Change the system prettyprint function to use this one.")
+
+(DE PRETTYPRINT (X) (PROGN (SPRINT X (posn)) (TERPRI)))
+
+(DM PP (L)
+ (LIST 'EVPP (LIST 'QUOTE (CDR L))))
+
+(DE EVPP (L)
+ (PROGN (MAPC L (FUNCTION PP1)) (TERPRI) T))
+
+(DE PP1 (EXP)
+ (PROG NIL
+ (COND ((IDP EXP)
+ (PROGN (PP-VAL EXP)
+ (PP-DEF EXP)))
+ (T (PROGN (SPRINT EXP 1) (TERPRI))))))
+
+(DE PP-VAL (ID)
+ (PROG (VAL)
+ (COND ((ATOM (SETQ VAL (ERRORSET ID NIL NIL))) (RETURN NIL)))
+ (TERPRI)
+ (sprint `(setq ,id ',(car val)) (posn))
+ (TERPRI)))
+
+(DE PP-DEF (ID)
+ (PROG (DEF TYPE ORIG-DEF)
+ (SETQ DEF (GETD ID))
+ TEST (COND ((NULL DEF)
+ (RETURN (AND ORIG-DEF
+ (WARNING (LIST ID
+ " has no unbroken definition.")))))
+ ((CODEP (CDR DEF))
+ (RETURN (WARNING (LIST "Can't PP compiled definition for"
+ ID))))
+ ((AND (NOT ORIG-DEF) (BROKEN ID))
+ (PROGN (WARNING (LIST "Note:"
+ ID
+ "is broken or traced."))
+ (SETQ ORIG-DEF DEF)
+ (SETQ DEF
+ (CONS (CAR DEF) (GET-GOOD-DEF ID)))
+ (GO TEST))))
+ (SETQ TYPE (CAR DEF))
+ (TERPRI)
+ (SETQ ORIG-DEF
+ (ASSOC TYPE
+ '((EXPR . DE)
+ (MACRO . DM)
+ (FEXPR . DF)
+ (NEXPR . DN))))
+ (RETURN (PP-DEF-1 (CDR ORIG-DEF) ID (CDDR DEF)))))
+
+(DE PP-DEF-1 (FN NAME TAIL)
+ (sprint (cons fn (cons name tail)) (posn))
+ (terpri))
+
+(DE BROKEN (X) (GET X 'TRACE))
+
+(DE GET-GOOD-DEF (X)
+ (PROG (XX)
+ (COND ((AND (SETQ XX (GET X 'TRACE))
+ (SETQ XX (ASSOC 'ORIGINALFN XX)))
+ (RETURN (CDR XX))))))
+
+%(!* "S2PRINT: prin2 a string and then sprint an expression.")
+
+(DE S2PRINT (S EXP)
+ (PROGN
+ (OR (GREATERP (SPACES-LEFT) (PLUS (FLATSIZE2 S) (nFLATSIZE EXP)))
+ (TERPRI))
+ (PRIN2 S)
+ (SPRINT EXP (ADD1 (POSN)))))
+
+(de make-room-for (left-margin size flag)
+ (cond ((or %flag
+ (greaterp (add1 size) (difference 75 (posn)))
+ (lessp (add1 (posn)) left-margin))
+ (tab left-margin))))
+
+(de is-read-macrop (exp)
+ (and (pairp exp) (atom (car exp)) (pairp (cdr exp)) (null (cddr exp))
+ (get (car exp) 'printmacro)))
+
+(de read-macro-internal-sprint (read-macro-c a lm1)
+ (make-room-for lm1 (plus2 (flatsize2 read-macro-c) (nflatsize a))
+ (or (pairp a) (vectorp a)))
+ (princ read-macro-c)
+ (internal-sprint a (plus2 (flatsize2 read-macro-c) lm1)))
+
+(de sprint-read-macro (exp left-margin)
+ (let ((c (get (car exp) 'printmacro)))
+ (read-macro-internal-sprint c (cadr exp) left-margin)))
+
+(de handle-read-macros (exp left-margin)
+ (prog (c)
+ (cond ((and (pairp exp)
+ (atom (car exp))
+ (pairp (cdr exp))
+ (null (cddr exp))
+ (setq c (get (car exp) 'printmacro)))
+ (read-macro-internal-sprint c (cadr exp) left-margin)
+ (return t)))))
+
+(dm define-special-sprint-list-structure (x)
+ ((lambda (tag test-if-special sprint-function)
+ `(progn (put ',tag 'sprint-test ',test-if-special)
+ (put ',tag 'sprint-function ',sprint-function)))
+ (cadr x)
+ (caddr x)
+ (cadr (cddr x))))
+
+(de handle-special-list-structures (exp left-margin)
+ (prog (c test)
+ (cond ((pairp exp)
+ (cond ((idp (car exp))
+ (setq test (get (car exp) 'sprint-test))
+ (setq c (get (car exp) 'sprint-function))
+ (cond ((and (or (null test)
+ (apply test (list exp)))
+ c)
+ (apply c (list exp left-margin))
+ (return t))))
+ ((and (pairp (car exp))
+ (eq (caar exp) 'lambda))
+ (special-sprint-lambda-expression exp left-margin)
+ (return t)))))))
+
+(de handle-special-list-structures-in-cdr-slot (exp left-margin)
+ (prog (c test)
+ (cond ((and (pairp exp)
+ (atom (car exp)))
+ (setq test (get (car exp) 'sprint-test))
+ (setq c (get (car exp) 'sprint-function))
+ (cond ((and (or (null test)
+ (apply test (list exp)))
+ c)
+ (princ ". ")
+ (apply c (list exp left-margin))
+ (return t)))))))
+
+(define-special-sprint-list-structure lambda sprint-lambda-test sprint-lambda)
+(define-special-sprint-list-structure cond sprint-cond-test sprint-cond)
+(define-special-sprint-list-structure progn sprint-lambda-test sprint-lambda)
+(define-special-sprint-list-structure prog1 sprint-lambda-test sprint-lambda)
+(define-special-sprint-list-structure let sprint-let-test sprint-let)
+(define-special-sprint-list-structure let* sprint-let-test sprint-let)
+(define-special-sprint-list-structure defun sprint-defun-test sprint-defun)
+(define-special-sprint-list-structure do sprint-do-test sprint-do)
+(define-special-sprint-list-structure do* sprint-do-test sprint-do)
+(define-special-sprint-list-structure prog sprint-prog-test sprint-prog)
+(define-special-sprint-list-structure de sprint-defun-test sprint-defun)
+(define-special-sprint-list-structure df sprint-defun-test sprint-defun)
+(define-special-sprint-list-structure dn sprint-defun-test sprint-defun)
+(define-special-sprint-list-structure dm sprint-defun-test sprint-defun)
+(define-special-sprint-list-structure defmacro sprint-defun-test sprint-defun)
+
+(de sprint-cond-test (exp)
+ (and (pairp (cdr exp))
+ (pairp (cdr exp))))
+
+(de sprint-cond (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (princ "(") (princ 'cond) (princ " ") %)
+ (sprint-rest-of-vertical-list (cdr exp) (posn)))
+
+(de sprint-defun-test (exp)
+ (and (pairp (cdr exp))
+ (pairp (cddr exp))))
+
+(de sprint-defun (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (princ "(") %)
+ (let ((a (plus2 1 (posn))))
+ (princ (car exp)) (princ " ")
+ (internal-sprint (cadr exp) (posn)) (princ " ")
+ (internal-sprint (caddr exp) a)
+ (sprint-rest-of-vertical-list (cdddr exp) a)))
+
+(defun sprint-rest-of-vertical-list (list left-margin)
+ (do ((i list (cdr i)))
+ ((null i) %(
+ (princ ")"))
+ (tab left-margin)
+ (cond ((atom i)
+ (princ ". ") (internal-sprint i (plus2 2 left-margin))
+ %(
+ (princ ")")
+ (return nil))
+ ((is-read-macrop i)
+ (make-room-for left-margin (plus2 2 (nflatsize i)) nil)
+ (princ ". ")
+ (sprint-read-macro i left-margin)
+ %(
+ (princ ")")
+ (return nil))
+ (t (internal-sprint (car i) left-margin)))))
+
+(de special-sprint-lambda-expression (exp left-margin)
+ (princ "((") (princ 'lambda)(princ " ") %))
+ (let ((a (posn)))
+ (sprint-rest-of-vertical-list (cdar exp) a)
+ (sprint-rest-of-vertical-list (cdr exp) (plus2 left-margin 1))))
+
+(de sprint-prog-test (exp)
+ (and (pairp (cdr exp))
+ (pairp (cddr exp))))
+
+(de sprint-prog (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (princ "(") %)
+ (let ((b (posn))
+ (a (plus2 1 (plus2 (posn) (flatsize (car exp))))))
+ (princ (car exp)) (princ " ")
+ (internal-sprint (cadr exp) a)
+ (sprint-rest-of-prog-vertical-list (cddr exp) a b)))
+
+(de sprint-let-test (exp)
+ (and (pairp (cdr exp))
+ (pairp (cadr exp))))
+
+(de sprint-let (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (princ "(") %)
+ (princ (car exp))
+ (princ " ")
+ (princ "(") %)
+ (let ((b (posn)))
+ (sprint-rest-of-vertical-list (cadr exp) b)
+ (let ((c (idifference b 1)))
+ (tab c)
+ (sprint-rest-of-vertical-list (cddr exp) c))))
+
+(de sprint-do-test (exp)
+ (and (pairp exp)
+ (pairp (cdr exp))
+ (pairp (cadr exp))
+ (pairp (cddr exp))
+ (pairp (caddr exp))
+ (pairp (cdddr exp))))
+
+(de sprint-do (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (princ "(") %)
+ (princ (car exp))
+ (princ " (")
+ (let ((b (posn)))
+ (sprint-rest-of-vertical-list (cadr exp) b)
+ (let ((c (idifference b 1)))
+ (tab c)
+ (princ "(") %)
+ (sprint-rest-of-vertical-list (caddr exp) b)
+ (sprint-rest-of-prog-vertical-list (cdddr exp) c
+ (idifference b 3)))))
+
+(de sprint-rest-of-prog-vertical-list (exp a b)
+ (do ((i exp (cdr i)))
+ ((null i) %(
+ (princ ")"))
+ (tab b)
+ (cond ((atom i)
+ (princ ". ") (internal-sprint i (plus2 2 a) )
+ %(
+ (princ ")")
+ (return nil))
+ ((is-read-macrop i)
+ (make-room-for a (plus2 2 (nflatsize i)) nil)
+ (princ ". ")
+ (sprint-read-macro i a)
+ %(
+ (princ ")")
+ (return nil))
+ ((atom (car i))
+ (internal-sprint (car i) b))
+ (t (internal-sprint (car i) a)))))
+
+(de sprint-lambda-test (exp)
+ (and (cdr exp)
+ (pairp (cdr exp))))
+
+(de sprint-lambda (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (princ "(") %)
+ (princ (car exp)) (princ " ")
+ (let ((a (posn)))
+ (internal-sprint (cadr exp) a)
+ (sprint-rest-of-vertical-list (cddr exp) a)))
+
+(de depth-greater-than-n (l n)
+ (cond ((weq n 0) t)
+ ((pairp l)
+ (do ((i l (cdr i)))
+ ((null i))
+ (cond ((atom i) (return nil))
+ ((and (pairp i)
+ (depth-greater-than-n (car i) (sub1 n)))
+ (return t)))))))
+
+(de sprint-dtpr2 (exp left-margin)
+ (make-room-for left-margin (nflatsize exp) nil)
+ (prog (lm)
+ (princ "(") %)
+ (setq lm (plus2 1 (cond ((and (atom (car exp))
+ (null (vectorp (car exp)))
+ (lessp (plus2 (posn)
+ (nflatsize
+ (car exp)))
+ 40)
+ (null (depth-greater-than-n exp 13)))
+ (plus2 1 (plus2 left-margin
+ (nflatsize
+ (car exp)))))
+ (t left-margin))))
+ (do ((a exp (cdr a))
+ (i 1 (add1 i))
+ (l (add1 left-margin) lm))
+ ((null a) % (
+ (princ ")"))
+ (cond ((and (numberp prinlength)
+ (greaterp i prinlength))
+ % (
+ (princ "...)")
+ (return nil)))
+ (cond ((atom a)
+ (make-room-for l (plus2 2 (nflatsize a)) nil)
+ (princ ". ") (internal-sprint a l)
+ %(
+ (princ ")")
+ (return nil))
+ ((is-read-macrop a)
+ (princ ". ")
+ (sprint-read-macro a (plus2 l 2))
+ %(
+ (princ ")")
+ (return nil))
+ ((handle-special-list-structures-in-cdr-slot a left-margin)
+ %(
+ (princ ")")
+ (return nil))
+ (t (internal-sprint (car a) l)))
+ (cond ((cdr a)
+ (cond ((greaterp (nflatsize (car a))
+ (difference 75 l))
+ (tab l))
+ (t (princ " "))))))))
+
+(de sprint-dtpr (exp left-margin)
+ ((lambda
+ (sprint-level)
+ (cond ((and (numberp prinlevel)
+ (greaterp sprint-level prinlevel))
+ (princ "#"))
+ ((handle-read-macros exp left-margin))
+ ((handle-special-list-structures exp left-margin))
+ (t (sprint-dtpr2 exp left-margin))))
+ (add1 sprint-level)))
+
+(de sprint-vector (vector left-margin)
+ ((lambda
+ (sprint-level)
+ (cond ((and (Numberp prinlevel)
+ (greaterp sprint-level prinlevel))
+ (princ "#"))
+ (t
+ (prog (c)
+ (princ "[")
+ (let ((lm (add1 left-margin)))
+ (do ((i 0 (1+ i))
+ (size (size vector)))
+ ((greaterp i size) (princ "]"))
+ (cond ((and (numberp prinlength)
+ (greaterp i prinlength))
+ (princ "...]")
+ (return nil)))
+ (internal-sprint (getv vector i) lm)
+ (cond ((lessp i size)
+ (cond ((greaterp (nflatsize (getv vector
+ (plus2 i 1)))
+ (difference 75 lm))
+ (tab lm))
+ ((lessp (posn) lm)
+ (tab lm))
+ (t (princ " ")))))))))))
+ (add1 sprint-level)))
+
+(de check-if-room-for-and-back-indent (a lm)
+ (cond ((and (atom a)
+ (null (vectorp a))
+ (greaterp (add1 (nflatsize a)) (difference (linelength nil) lm))
+ (null (lessp (posn) 2)))
+ (terpri)
+ (cond ((eq (getv lispscantable* (id2int '!%)) 12)
+ (princ "%"))
+ ((eq (getv lispscantable* (id2int '!;)) 12)
+ (princ ";"))
+ (t (princ "%")))
+ (princ "**** <<<<<< Reindenting.")
+ (terpri)
+ lm)))
+
+(de internal-sprint (a lm)
+ (let ((indent (check-if-room-for-and-back-indent a lm)))
+ (cond ((lessp (posn) lm)
+ (tab lm)))
+ (cond ((handle-read-macros a lm))
+ ((handle-special-list-structures a lm))
+ (t (make-room-for lm (nflatsize a)
+ (or (pairp a) (vectorp a)))
+ (cond ((pairp a) (sprint-dtpr a (posn)))
+ ((vectorp a) (sprint-vector a (posn)))
+ (t (and (lessp (posn) lm)
+ (tab lm))
+ (prin1 a)))))
+ (cond (indent
+ (terpri)
+ (cond ((eq (getv lispscantable* (id2int '!%)) 12)
+ (princ "%"))
+ ((eq (getv lispscantable* (id2int '!;)) 12)
+ (princ ";"))
+ (t (princ "%")))
+ (princ "**** >>>>> Reindenting.")
+ (terpri)))))
+
+(de sprint (exp left-margin)
+ (let ((a (posn))
+ (sprint-level 0)
+ (b (linelength nil)))
+ (linelength 600)
+ (cond ((eq a left-margin))
+ (t (tab left-margin)))
+ (internal-sprint exp left-margin)
+ (linelength b)
+ nil))
+
+(PUT 'QUOTE 'PRINTMACRO "'")
+(PUT 'BACKQUOTE 'PRINTMACRO "`")
+(PUT 'UNQUOTE 'PRINTMACRO ",")
+(PUT 'UNQUOTEL 'PRINTMACRO ",@")
+(PUT 'UNQUOTED 'PRINTMACRO ",.")
+
+(DE PM-DEF (FORM)
+ (PP-DEF-1 (CAR FORM) (CADR FORM) (CDDR FORM)))
+
+(DE CHRCT NIL (DIFFERENCE (MIN 80 (LINELENGTH NIL)) (POSN)))
+
+(DE SPACES-LEFT NIL (SUB1 (CHRCT)))
+
+(DE SAFE-PPOS (N SIZE)
+ (PROG (MIN-N)
+ (SETQ MIN-N (SUB1 (DIFFERENCE (LINELENGTH NIL) SIZE)))
+ (COND ((LESSP MIN-N N)
+ (PROGN (OR (GREATERP MIN-N (POSN1)) (TERPRI)) (PPOS MIN-N)))
+ (T (PPOS N)))))
+
+(DE POSN1 NIL (ADD1 (POSN)))
+
+(DE POSN2 NIL (PLUS 2 (POSN)))
+
+(DE PPOS (N)
+ (PROG NIL
+ (OR (GREATERP N (POSN)) (TERPRI))
+ (SETQ N (SUB1 N))
+ LOOP (COND ((LESSP (POSN) N) (PROGN (PRIN2 " ") (GO LOOP))))))
+
+(de nflatsize (n) (nflatsize1 n sprint-level))
+
+(de nflatsize1 (n currentlevel)
+ (cond ((and (numberp prinlevel)
+ (wgreaterp currentlevel prinlevel)) 1)
+ ((vectorp n)
+ (do ((i (size n) (sub1 i))
+ (s (iplus2 1 (size n))
+ (iplus2 1 (iplus2 s
+ (nflatsize1 (getv n i)
+ (iplus2 1 currentlevel))))))
+ ((wlessp i 0) s)))
+ ((atom n) (flatsize n))
+ ((is-read-macrop n)
+ (let ((c (get (car n) 'printmacro)))
+ (iplus2 (flatsize2 c)
+ (nflatsize1 (cadr n) (iplus2 1 currentlevel)))))
+ ((do ((i n (cdr i))
+ (s 1 (iplus2 (nflatsize1 (car i) (iplus2 1 currentlevel))
+ (iplus2 1 s))))
+ ((null i) s)
+ (cond ((atom i)
+ (return (iplus2 3 (iplus2 s (nflatsize1
+ i (iplus2 1 currentlevel))))))
+ ((is-read-macrop i)
+ (return
+ (iplus2 3
+ (iplus2 s (nflatsize1
+ i (iplus2 1 currentlevel)))))))))))
+
+%***************************************************************************
+%
+% End of Prettyprinter.
+%
+%***************************************************************************
+
ADDED psl-1983/3-1/util/pr-demo.red
Index: psl-1983/3-1/util/pr-demo.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-demo.red
@@ -0,0 +1,47 @@
+% PR-DEMO.RED: A small 3D version Picture RLISP demo file
+% See also the LISP syntax form in PR-DEMO.SL
+% Use IN "PU:PR-DEMO.RED"$ for best effects
+
+LOAD PRLISP;
+HP!.INIT(); % For HP2648a
+
+Outline := { 10, 10} _ {-10, 10} _ % Outline is 20 by 20
+ {-10,-10} _ { 10,-10} _ {10, 10}$ % Square
+
+Arrow := {0,-1} _ {0,2} & {-1,1} _ {0,2} _ {1,1}$
+
+Cubeface := (Outline & Arrow) | ZMOVE 10$
+
+Cube := Cubeface
+ & Cubeface | XROT (180) % 180 degrees
+ & Cubeface | YROT ( 90)
+ & Cubeface | YROT (-90)
+ & Cubeface | XROT ( 90)
+ & Cubeface | XROT (-90)$
+
+% Make it larger for better viewing
+BigCube := Cube | Scale 5$
+
+% and show it
+ESHOW BigCube$
+
+% Some more views
+
+ESHOW (BigCube | XROT 20 | YROT 30 | ZROT 10)$
+ESHOW (Cube | scale 2 | XMOVE (-240) | REPEATED(5, XMOVE 80))$
+
+% Some curves:
+
+ESHOW {10,10} | circle(70)$
+SHOW {10,10} | circle(50) | Xmove 20$
+
+% Some control points for BSPLINE and BEZIER curves
+Cpts := {0,0} _ {70,-60} _ {189,-69} _ {206,33} _ {145,130} _ {48,130}
+ _ {0,84} $
+
+
+ESHOW (Cpts & Cpts | BEZIER())$
+
+ESHOW (Cpts & Cpts | BSPLINE())$
+
+END;
ADDED psl-1983/3-1/util/pr-demo.sl
Index: psl-1983/3-1/util/pr-demo.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-demo.sl
@@ -0,0 +1,68 @@
+% PR-DEMO.SL: A small 3D Picture RLISP demo file, using LISP syntax
+% Is equivalent to the PR-DEMO.RED form in RLISP syntax
+% Use (LAPIN "PU:PR-DEMO.SL") for best effects
+
+(LOAD PRLISP)
+
+% First call the xxx!.INIT routine,
+
+(HP!.INIT) % For HP2648a
+
+% Define a 20 x 20 square
+(SETQ OUTLINE
+ (POINTSET (ONEPOINT 10 10)
+ (ONEPOINT -10 10)
+ (ONEPOINT -10 -10)
+ (ONEPOINT 10 -10)
+ (ONEPOINT 10 10)))
+
+% and an Arrow to place in square
+(SETQ ARROW
+ (GROUP (POINTSET (ONEPOINT 0 -1) (ONEPOINT 0 2))
+ (POINTSET (ONEPOINT -1 1) (ONEPOINT 0 2) (ONEPOINT 1 1))))
+
+% to produce the CubeFace. Will be shifted out by 10 units
+(SETQ CUBEFACE (TRANSFORM (GROUP OUTLINE ARROW) (ZMOVE 10)))
+
+% to produce a 20 x 20 x 20 Cube
+(SETQ CUBE
+ (GROUP CUBEFACE
+ (TRANSFORM CUBEFACE (XROT 180))
+ (TRANSFORM CUBEFACE (YROT 90))
+ (TRANSFORM CUBEFACE (YROT -90))
+ (TRANSFORM CUBEFACE (XROT 90))
+ (TRANSFORM CUBEFACE (XROT -90))))
+
+% This is a bigger cube to be seen more clearly
+(SETQ BIGCUBE (TRANSFORM CUBE (SCALE 5)))
+
+% as can be seen
+(ESHOW BIGCUBE)
+
+% Some more views of the CUBE
+(ESHOW
+ (TRANSFORM (TRANSFORM (TRANSFORM BIGCUBE (XROT 20)) (YROT 30)) (ZROT 10)))
+(ESHOW
+ (TRANSFORM (TRANSFORM (TRANSFORM CUBE (SCALE 2)) (XMOVE -240))
+ (REPEATED 5 (XMOVE 80))))
+
+% Draw a circle
+(ESHOW (TRANSFORM (ONEPOINT 10 10) (CIRCLE 70)))
+% and another
+(SHOW (TRANSFORM (TRANSFORM (ONEPOINT 10 10) (CIRCLE 50))
+ (XMOVE 20)))
+
+% Define Some control points for Bspline and Bezier
+(SETQ CPTS
+ (POINTSET (ONEPOINT 0 0)
+ (ONEPOINT 70 -60)
+ (ONEPOINT 189 -69)
+ (ONEPOINT 206 33)
+ (ONEPOINT 145 130)
+ (ONEPOINT 48 130)
+ (ONEPOINT 0 84)))
+
+% And show the BSPLINE and BEZIER curves
+(ESHOW (GROUP CPTS (TRANSFORM CPTS (BEZIER))))
+(ESHOW (GROUP CPTS (TRANSFORM CPTS (BSPLINE))))
+
ADDED psl-1983/3-1/util/pr-driv.build
Index: psl-1983/3-1/util/pr-driv.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-driv.build
@@ -0,0 +1,2 @@
+CompileTime load pr!-main;
+in "pr-driv.red"$
ADDED psl-1983/3-1/util/pr-driv.red
Index: psl-1983/3-1/util/pr-driv.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-driv.red
@@ -0,0 +1,704 @@
+%. PR-DRIV.RED Terminal/Graphics Drivers for PRLISP
+%. Date: ~December 1981
+%. Authors: M.L. Griss, F. Chen, P. Stay
+%. Utah Computation Group
+%. Department of Computer Science
+%. University of Utah, Salt Lake City.
+%. Copyright (C) University of Utah 1982
+
+% Also, need either EMODE or RAWIO files for EchoON/EchoOff
+
+% Note that under EMODE (!*EMODE= T), EchoOn and EchoOff
+% Already Done, so GraphOn and GraphOff need to test !*EMODE
+
+FLUID '(!*EMODE);
+loadtime <<!*EMODE:=NIL;>>; % initialize emode to off
+
+
+ %***************************
+ % setup functions for *
+ % terminal devices *
+ %***************************
+
+FLUID '(!*UserMode);
+
+Procedure FNCOPY(NewName,OldName)$ %. to copy equivalent
+ Begin scalar !*UserMode;
+ CopyD(NewName,OldName);
+ end;
+
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % hp specific Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure HP!.OutChar x; % Raw Terminal I/O
+ Pbout x;
+
+Procedure HP!.OutCharString S; % Pbout a string
+ For i:=0:Size S do HP!.OutChar S[i];
+
+Procedure HP!.grcmd (acmd)$ %. prefix to graphic command
+<<HP!.OutChar char ESC$
+ HP!.OutChar char !*$
+ HP!.OutCharString ACMD$
+ DELAY() >>$
+
+Procedure HP!.OutInt X; % Pbout a integer
+ <<HP!.OutChar (char !0 + (X/100));
+ X:=Remainder(x,100);
+ HP!.OutChar (char !0 + (x/10));
+ HP!.OutChar (char !0+Remainder(x,10));
+ nil>>;
+
+Procedure HP!.Delay$ %. Delay to wait for the display
+ HP!.OutChar CHAR EOL; % Flush buffer
+
+Procedure HP!.EraseS()$ %. EraseS graphic diaplay screen
+<<HP!.GRCMD("dack")$
+ MoveToXY(0,0)>>$
+
+Procedure HP!.Erase()$ %. Erase graphic diaplay screen
+ <<HP!.Graphon();
+ HP!.Erases();
+ HP!.Graphoff()>>;
+
+Procedure HP!.NormX XX$ %. absolute position along
+ FIX(XX+0.5)+360$ % X axis
+
+Procedure HP!.NormY YY$ %. absolute position along
+ FIX(YY+0.5)+180$ % Y axis.
+
+Procedure HP!.MoveS (XDEST,YDEST)$ %. move pen to absolute location
+<< HP!.GRCMD("d")$
+ XDEST := HP!.NormX XDEST$
+ YDEST := HP!.NormY YDEST$
+ HP!.OutInt XDEST$
+ HP!.OutChar Char '!,$
+ HP!.OutInt YDEST$
+ HP!.OutCharString "oZ"$
+ HP!.GRCMD("pacZ") >>$
+
+Procedure HP!.DrawS (XDEST,YDEST)$ %. MoveS pen to the pen position
+ <<HP!.GRCMD("d")$
+ XDEST := HP!.NormX XDEST$ %. destination and draw a
+ YDEST := HP!.NormY YDEST$
+ HP!.OutInt XDEST$ %. line to it rom previous
+ HP!.OutChar Char '!,$ %. pen position.
+ HP!.OutInt YDEST$
+ HP!.OutCharString "oZ"$
+ HP!.GRCMD("pbcZ")$'NIL>>$
+
+Procedure HP!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport
+<< X1CLIP := MAX2 (-360,X1)$ %. for HP2648A terminal.
+ X2CLIP := MIN2 (360,X2)$
+ Y1CLIP := MAX2 (-180,Y1)$
+ Y2CLIP := MIN2 (180,Y2) >>$
+
+Procedure HP!.GRAPHON(); %. No special GraphOn/GraphOff
+ echooff();
+
+Procedure HP!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure HP!.INIT$ %. HP device specIfic
+Begin %. Procedures equivalent.
+ PRINT "HP IS DEVICE"$
+ DEV!. := 'HP;
+ FNCOPY( 'EraseS, 'HP!.EraseS)$ % should be called as for
+ FNCOPY( 'Erase, 'HP!.Erase)$ % should be called as for
+ FNCOPY( 'NormX, 'HP!.NormX)$ % initialization when
+ FNCOPY( 'NormY, 'HP!.NormY)$ % using HP2648A.
+ FNCOPY( 'MoveS, 'HP!.MoveS)$
+ FNCOPY( 'DrawS, 'HP!.DrawS)$
+ FNCOPY( 'VWPORT, 'HP!.VWPORT)$
+ FNCOPY( 'Delay, 'HP!.Delay)$
+ FNCOPY( 'GraphOn, 'HP!.GraphOn)$
+ FNCOPY( 'GraphOff, 'HP!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % TEKTRONIX specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure TEK!.OutChar x;
+ Pbout x;
+
+Procedure TEK!.EraseS(); %. EraseS screen, Returns terminal
+ <<Graphoff(); Tek!.Erase(); Graphon()>>;
+
+Procedure TEK!.Erase(); %. EraseS screen, Returns terminal
+ <<TEK!.OutChar Char ESC; %. to Alpha mode and places cursor.
+ TEK!.OutChar Char FF>>;
+
+Procedure TEK!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< TEK!.OutChar HIGHERY NormY YDEST$ %. information to the
+ TEK!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ TEK!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ TEK!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+
+Procedure HIGHERY YDEST$ %. convert Y to higher order Y.
+ FIX(YDEST) / 32 + 32$
+
+Procedure LOWERY YDEST$ %. convert Y to lower order Y.
+ REMAINDER (FIX YDEST,32) + 96$
+
+
+Procedure HIGHERX XDEST$ %. convert X to higher order X.
+ FIX(XDEST) / 32 + 32$
+
+Procedure LOWERX XDEST$ %. convert X to lower order X.
+ REMAINDER (FIX XDEST,32) + 64$
+
+
+Procedure TEK!.MoveS(XDEST,YDEST)$
+ <<TEK!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ TEK!.4BYTES (XDEST,YDEST)$
+ TEK!.OutChar 31>> $ %. US: sets terminal to Alpha mode.
+
+Procedure TEK!.DrawS (XDEST,YDEST)$ %. Same as Tek!.MoveS but
+<< TEK!.OutChar 29$ %. draw the line.
+ TEK!.4BYTES (Xprevious, Yprevious)$
+ TEK!.4BYTES (XDEST, YDEST)$
+ TEK!.OutChar 31>> $
+
+Procedure TEK!.NormX DESTX$ %. absolute location along
+ DESTX + 512$ %. X axis.
+
+Procedure TEK!.NormY DESTY$ %. absolute location along
+ DESTY + 390$ %. Y axis.
+
+Procedure TEK!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-512,X1)$ %. Tektronix 4006-1.
+ X2CLIP := MIN2 (512,X2)$
+ Y1CLIP := MAX2 (-390,Y1)$
+ Y2CLIP := MIN2 (390,Y2) >>$
+
+Procedure TEK!.Delay();
+ NIL;
+
+Procedure TEK!.GRAPHON(); %. No special GraphOn (? what of GS/US)
+ echooff(); % also issue GS?
+
+Procedure TEK!.GRAPHOFF();
+ If not !*emode then echoon(); % Also issue US?
+
+Procedure TEK!.INIT$ %. TEKTRONIX device specIfic
+Begin %. Procedures equivalent.
+ PRINT "TEKTRONIX IS DEVICE"$
+ DEV!. := ' TEK;
+ FNCOPY( 'EraseS, 'TEK!.EraseS)$ % should be called as for
+ FNCOPY( 'Erase, 'TEK!.Erase)$ % should be called as for
+ FNCOPY( 'NormX, 'TEK!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'TEK!.NormY)$ % Tektronix 4006-1.
+ FNCOPY( 'MoveS, 'TEK!.MoveS)$
+ FNCOPY( 'DrawS, 'TEK!.DrawS)$
+ FNCOPY( 'VWPORT, 'TEK!.VWPORT)$
+ FNCOPY( 'Delay, 'TEK!.Delay)$
+ FNCOPY( 'GraphOn, 'TEK!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEK!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % TELERAY specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Basic Teleray 1061 Plotter
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-12,12) := (Top . . Bottom)
+
+Procedure TEL!.OutChar x;
+ PBOUT x;
+
+Procedure TEL!.OutCharString S; % Pbout a string
+ For i:=0:Size S do TEL!.OutChar S[i];
+
+Procedure TEL!.NormX X;
+ FIX(X)+40;
+
+Procedure TEL!.NormY Y;
+ FIX(Y)+12;
+
+Procedure TEL!.ChPrt(X,Y,Ch);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutChar Ch>>;
+
+Procedure TEL!.IdPrt(X,Y,Id);
+ TEL!.ChPrt(X,Y,ID2Int ID);
+
+Procedure TEL!.StrPrt (X,Y,S);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutCharString S>>;
+
+Procedure TEL!.HOME (); % Home (0,0)
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar 'H>>;
+
+Procedure TEL!.Erase(); % Delete Entire Screen
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar '!j>>;
+
+Procedure TEL!.EraseS(); % Delete Entire Screen
+ <<GraphOFF(); Tel!.Erase(); Graphon()>>;
+
+Procedure TEL!.DDA (X1,Y1,X2,Y2,dotter);
+ Begin scalar Dx,Dy,Xc,Yc,I,R,S;
+ % From N & S, Page 44, Draw Straight Pointset
+ Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
+ If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
+ If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
+ If Dx <= Dy then Goto doy;
+ S := FLOAT(Dy)/Dx;
+ For I := 1:Dx do
+ <<R := R+S;
+ If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
+ X1 := X1+Xc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL;
+ doy:S := float(Dx) / Dy;
+ For I := 1:Dy do
+ <<R := R+S;
+ If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
+ Y1 := Y1+Yc;
+ APPLY(dotter,LIST (X1,Y1)) >>;
+ Return NIL
+ end;
+
+Procedure Tel!.MoveS (X1,Y1);
+ <<Xprevious := X1;
+ Yprevious := Y1>>;
+
+Procedure Tel!.DrawS (X1,Y1);
+ << TEL!.DDA (Xprevious,Yprevious, X1, Y1,function dotc);
+ Xprevious :=X1; Yprevious :=Y1>>;
+
+Procedure Idl2chl (X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp (X) do <<Y := getv (Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return (Reverse (Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter (X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl (Explode2 (Txt));
+ Return (TEL!.DDA (X1,Y1,X2,Y2,function Tdotc))
+ end;
+
+Procedure Tdotc (X1,Y1);
+ Begin
+ If Null Tchars then Return (Nil);
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return ('T)
+ end;
+
+Procedure dotc (X1,Y1); % Draw And Clip An X
+ TEL!.ChClip (X1,Y1,Char X) ;
+
+Procedure TEL!.ChClip (X1,Y1,Id);
+ Begin
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Id);
+ No:Return ('T)
+ end;
+
+Procedure Tel!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2 (-40,X1);
+ X2clip := Min2 (40,X2);
+ Y1clip := Max2 (-12,Y1);
+ Y2clip := Min2 (12,Y2)>>;
+
+Procedure Tel!.Wfill (X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do TEL!.ChClip (X,Y,Id);
+ end;
+
+Procedure TEL!.Wzap (X1,X2,Y1,Y2);
+ TEL!.Wfill (X1,X2,Y1,Y2,'! ) ;
+
+Procedure TEL!.Delay;
+ NIL;
+
+Procedure TEL!.GRAPHON();
+ Echooff();
+
+Procedure TEL!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure TEL!.INIT (); % Setup For TEL As Device;
+ Begin
+ Dev!. := 'TEL;
+ FNCOPY('EraseS,'TEL!.EraseS);
+ FNCOPY('Erase,'TEL!.Erase);
+ FNCOPY('MoveS,'TEL!.MoveS);
+ FNCOPY('DrawS,'TEL!.DrawS);
+ FNCOPY( 'NormX, 'TEL!.NormX)$
+ FNCOPY( 'NormY, 'TEL!.NormY)$
+ FNCOPY('VwPort,'TEL!.VwPort);
+ FNCOPY('Delay,'TEL!.Delay);
+ FNCOPY( 'GraphOn, 'TEL!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEL!.GraphOff)$
+ Erase();
+ VwPort (-40,40,-12,12);
+ Print "Device Now TEL";
+ end;
+
+% Basic ANN ARBOR AMBASSADOR Plotter
+%
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-30,30) := (Top . . Bottom)
+
+Procedure ANN!.OutChar x;
+ PBOUT x;
+
+Procedure ANN!.OutCharString S; % Pbout a string
+ For i:=0:Size S do ANN!.OutChar S[i];
+
+Procedure ANN!.NormX X; % so --> X
+ 40 + FIX(X+0.5);
+
+Procedure ANN!.NormY Y; % so ^
+ 30 - FIX(Y+0.5); % | Y
+
+Procedure ANN!.XY(X,Y);
+<< Ann!.OutChar(char ESC);
+ Ann!.OutChar(char ![);
+ x:=Ann!.NormX(x);
+ y:=Ann!.NormY(y);
+ % Use "quick and dirty" conversion to decimal digits.
+ Ann!.OutChar(char 0 + (1 + Y)/10);
+ Ann!.OutChar(char 0 + remainder(1 + Y, 10));
+
+ Ann!.OutChar(char !;);
+ % Delimiter between row digits and column digits.
+
+ Ann!.OutChar(char 0 + (1 + X)/10);
+ Ann!.OutChar(char 0 + remainder(1 + X, 10));
+
+ Ann!.OutChar(char H); % Terminate the sequence
+>>;
+
+
+Procedure ANN!.ChPrt(X,Y,Ch);
+ <<ANN!.XY(X,Y);
+ ANN!.OutChar Ch>>;
+
+Procedure ANN!.IdPrt(X,Y,Id);
+ ANN!.ChPrt(X,Y,ID2Int ID);
+
+Procedure ANN!.StrPrt(X,Y,S);
+ <<ANN!.XY(X,Y);
+ ANN!.OutCharString S>>;
+
+Procedure ANN!.EraseS(); % Delete Entire Screen
+ <<ANN!.OutChar CHAR ESC;
+ ANN!.OutChar Char '![;
+ Ann!.OutChar Char 2;
+ Ann!.OutChar Char J;
+ Ann!.XY(0,0);>>;
+
+Procedure ANN!.Erase(); % Delete Entire Screen
+ <<Graphon();
+ ANN!.Erases();
+ GraphOff()>>;
+
+Procedure ANN!.DDA(X1,Y1,X2,Y2,dotter);
+ Begin scalar Dx,Dy,Xc,Yc,I,R,S;
+ % From N & S, Page 44, Draw Straight Pointset
+ Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
+ If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
+ If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
+ If Dx <= Dy then Goto doy;
+ S := FLOAT(Dy)/Dx;
+ For I := 1:Dx do
+ <<R := R+S;
+ If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
+ X1 := X1+Xc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL;
+ doy:S := float(Dx) / Dy;
+ For I := 1:Dy do
+ <<R := R+S;
+ If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
+ Y1 := Y1+Yc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL
+ end;
+
+Procedure ANN!.MoveS(X1,Y1);
+ <<Xprevious := X1;
+ Yprevious := Y1>>;
+
+Procedure ANN!.DrawS(X1,Y1);
+ << ANN!.DDA(Xprevious,Yprevious, X1, Y1,function ANN!.dotc);
+ Xprevious :=X1; Yprevious :=Y1>>;
+
+Procedure Idl2chl(X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp(X) do <<Y := getv(Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return(Reverse(Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter(X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl(Explode2(Txt));
+ Return(ANN!.DDA(X1,Y1,X2,Y2,function ANN!.Tdotc))
+ end;
+
+Procedure ANN!.Tdotc(X1,Y1);
+ Begin
+ If Null Tchars then Return(Nil);
+ If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
+ If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
+ ANN!.ChPrt(X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return('T)
+ end;
+
+Procedure ANN!.dotc(X1,Y1); % Draw And Clip An X
+ ANN!.ChClip(X1,Y1,Char !*) ;
+
+Procedure ANN!.ChClip(X1,Y1,Id);
+ Begin
+ If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
+ If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
+ ANN!.ChPrt(X1 , Y1,Id);
+ No:Return('T)
+ end;
+
+Procedure ANN!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2(-40,X1);
+ X2clip := Min2(40,X2);
+ Y1clip := Max2(-30,Y1);
+ Y2clip := Min2(30,Y2)>>;
+
+Procedure ANN!.Wfill(X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do ANN!.ChClip(X,Y,Id);
+ end;
+
+Procedure ANN!.Wzap(X1,X2,Y1,Y2);
+ ANN!.Wfill(X1,X2,Y1,Y2,'! ) ;
+
+Procedure ANN!.Delay;
+ NIL;
+
+Procedure ANN!.GRAPHON();
+ echooff();
+
+Procedure ANN!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure ANN!.INIT(); % Setup For ANN As Device;
+ Begin
+ Dev!. := 'ANN60;
+ FNCOPY('EraseS,'ANN!.EraseS);
+ FNCOPY('Erase,'ANN!.Erase);
+ FNCOPY('MoveS,'ANN!.MoveS);
+ FNCOPY('DrawS,'ANN!.DrawS);
+ FNCOPY('NormX, 'ANN!.NormX)$
+ FNCOPY('NormY, 'ANN!.NormY)$
+ FNCOPY('VwPort,'ANN!.VwPort);
+ FNCOPY('Delay,'ANN!.Delay);
+ FNCOPY('GraphOn, 'ANN!.GraphOn)$
+ FNCOPY('GraphOff, 'ANN!.GraphOff)$
+ Erase();
+ VwPort(-40,40,-30,30);
+ Print "Device Now ANN60";
+ end;
+
+
+
+ %**********************************
+ % MPS device routines will only *
+ % work If the MPS C library is *
+ % resident in the system *
+ % contact Paul Stay or Russ Fish *
+ % University of Utah *
+ %**********************************
+
+Fluid '(DDDD MDDD ABSDD);
+
+Procedure MPS!.DrawS (XDEST, YDEST);
+<<PSdraw2d(LIST(XDEST,YDEST) ,DDDD,ABSDD,0,1); %draw a line from cursor
+ 0; %do x and y coordinates
+>>;
+
+Procedure MPS!.MoveS (XDEST, YDEST);
+<<PSdraw2d( LIST(XDEST,YDEST) , MDDD,ABSDD,0,1); %move to point x,y
+ 0;
+>>;
+
+Procedure MPS!.Delay(); % no Delay function for mps
+ NIL;
+
+Procedure MPS!.EraseS(); % setdisplay list to nil
+ DISPLAY!.LIST := NIL$
+
+Procedure MPS!.Erase(); % setdisplay list to nil
+ <<MPS!.GraphOn();
+ DISPLAY!.LIST := NIL$
+ MPS!.GraphOff()>>;
+
+Procedure MPS!.VWPORT( X1, X2, Y1, Y2); %set up viewport
+<<
+ PSsetscale(300); %set up scale factor
+ X1CLIP := MAX2(-500, X1);
+ X2CLIP := MIN2(500, X2);
+ Y1CLIP := MAX2(-500, Y1);
+ Y2CLIP := MIN2(500, Y2);
+>>;
+
+Procedure MPS!.GRAPHON(); % Check this
+ echooff();
+
+Procedure MPS!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure MPS!.INIT$
+<<
+ PRINT "MPS IS DISPLAY DEVICE";
+ DEV!. := 'MPS;
+ FNCOPY ( 'EraseS, 'MPS!.ERASES)$
+ FNCOPY ( 'Erase, 'MPS!.ERASE)$
+% Add NORM functions
+ FNCOPY ( 'MoveS, 'MPS!.MoveS)$
+ FNCOPY ( 'DrawS, 'MPS!.DrawS)$
+ FNCOPY ( 'VWPORT, 'MPS!.VWPORT)$
+ FNCOPY ( 'Delay, 'MPS!.Delay)$
+ FNCOPY( 'GraphOn, 'MPS!.GraphOn)$
+ FNCOPY( 'GraphOff, 'MPS!.GraphOff)$
+ PSINIT(1,0); % initialize device
+ ERASE();
+ MPS!.VWPORT(-500,500,-500,500); % setup viewport
+ Psscale(1,1,1,500); % setup scale hardware
+ GLOBAL!.TRANSFORM := WINdoW(-300,60);
+>>;
+
+ %***************************************
+ % Apollo terminal driver and functions *
+ %***************************************
+
+Procedure ST!.OutChar x; % use Pbout instead
+ PBOUT x;
+
+Procedure ST!.EraseS(); % erase screen in G-mode
+<< Graphoff();
+ ST!.OutChar 27;
+ ST!.OutChar 12;
+ GraphOn();
+>>;
+
+Procedure ST!.Erase(); % erase screen in Text mode
+<< Echooff();
+ ST!.OutChar 27;
+ ST!.OutChar 12;
+ If not !*emode then Echoon();>>;
+
+Procedure ST!.GraphOn();
+<< EchoOff();
+ ST!.OutChar 29>>$ % Should be same for TEK
+
+Procedure ST!.GraphOff();
+<<ST!.OutChar 31; % Maybe mixed VT-52/tek problem
+ If Not !*EMODE Then EchoOn()>>;
+
+Procedure ST!.MoveS(XDEST,YDEST)$
+<< ST!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ ST!.4BYTES (XDEST,YDEST)$ %. so next X,Y set is MOVE
+>>$
+
+Procedure ST!.DrawS (XDEST,YDEST)$
+<< %/ ST!.OutChar 29$ %/ Always after MOVE
+ %/ ST!.4bytes(Xprevious, Yprevious)$
+ ST!.4BYTES (XDEST, YDEST)$ %. draw the line.
+ >>$
+
+Procedure ST!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< ST!.OutChar HIGHERY NormY YDEST$ %. information to the
+ ST!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ ST!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ ST!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+Procedure ST!.Delay();
+ NIL;
+
+Procedure ST!.NormX DESTX$ %. absolute location along
+ DESTX + 400$ %. X axis.
+
+Procedure ST!.NormY DESTY$ %. absolute location along
+ DESTY + 300$ %. Y axis.
+
+Procedure ST!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-400,X1)$ %. Tektronix 4006-1.
+ X2CLIP := MIN2 (400,X2)$
+ Y1CLIP := MAX2 (-300,Y1)$
+ Y2CLIP := MIN2 (300,Y2) >>$
+
+Procedure ST!.INIT$ %. JW's fake TEKTRONIX
+Begin %. Procedures equivalent.
+ PRINT "Apollo/ST is device"$
+ DEV!. := 'Apollo;
+ FNCOPY( 'EraseS, 'ST!.EraseS)$ % should be called as for
+ FNCOPY( 'Erase, 'ST!.Erase)$ % should be called as for
+ FNCOPY( 'NormX, 'ST!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'ST!.NormY)$ % APOtronix 4006-1.
+ FNCOPY( 'MoveS, 'ST!.MoveS)$
+ FNCOPY( 'DrawS, 'ST!.DrawS)$
+ FNCOPY( 'VWPORT, 'ST!.VWPORT)$
+ FNCOPY( 'Delay, 'ST!.Delay)$
+ FNCOPY( 'GraphOn, 'ST!.GraphOn);
+ FNCOPY( 'GraphOff, 'ST!.GraphOff);
+ Erase()$
+ VWPORT(-400,400,-300,300)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+
+
+% --------- OTHER UTILITIES ------------
+
+Procedure SAVEPICT (FIL,PICT,NAM)$ %. save a picture with no
+Begin scalar OLD; %. vectors.
+ FIL := OPEN (FIL,'OUTPUT)$ % fil : list('dir,file.ext)
+ OLD := WRS FIL$ % nam : id
+ PRIN2 NAM$ PRIN2 '! !:!=! !'$ PRIN2 PICT$ % pict: name of pict to
+ PRIN2 '!;$ WRS 'NIL$ CLOSE FIL$ % be saved.
+ Return PICT$
+ % fil: file name to save
+ % "pict".
+end$ % nam: name to be used
+ % after TAILore.
+ % type "in fil" to TAILore
+ % old picture.
+
+
+
+
+
+
+
ADDED psl-1983/3-1/util/pr-main.build
Index: psl-1983/3-1/util/pr-main.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-main.build
@@ -0,0 +1,1 @@
+in "pr-main.red"$
ADDED psl-1983/3-1/util/pr-main.red
Index: psl-1983/3-1/util/pr-main.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-main.red
@@ -0,0 +1,765 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% PictureRLISP : A Lisp-Based Graphics Language System with %
+% Flexible Syntax and Hierarchical %
+% Data Structure %
+% %
+% Author: Fuh-Meei Chen, Paul Stay and Martin L. Griss %
+% Symbolic Computation Group %
+% Computer Science Dept. %
+% University of Utah %
+% %
+% <PSL.UTIL>PRLISP.RED.21, 9-Jan-82 22:47:43, Edit by GRISS %
+% <STAY.PICT>PRLISP.B 12-april-82 8:00:00 by Paul Stay %
+% changed bezier circle and bspline drivers and hp terminal %
+% on 10-april-82 by Paul Stay %
+% Added MPS support software for use on the graphics vax %
+% Added ST.INIT %
+% Copyright (c) 1981 University of Utah %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Part of the parser to accomplish the Pratt parser written %
+% in New-Rlisp runs at DEC-20. %
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+RemFlag('(MKVECT),'TWOREG); %/ Seems in Error
+RemProp('!{,'NEWNAM!-OP); %. left and right brackets
+RemProp('!},'NEWNAM!-OP); %. handling.
+RemProp('!{,'NEWNAM); % left and right brackets are
+RemProp('!},'NEWNAM); % used to Define points.
+Put('!{, 'NEWNAM,'!*LBRAC!*);
+Put('!}, 'NEWNAM,'!*RBRAC!*); % Put on to the property list.
+
+DefineROP('!*LBRAC!*,NIL,LBC); % Define the precedence.
+DefineBOP('!*RBRAC!*,1,0);
+
+FLUID '(OP);
+
+Procedure LBC X;
+Begin scalar RES;
+ If X EQ '!*RBRAC!* then
+ <<OP := X; RES := '!*EMPTY!*>>
+ else RES:= RDRIGHT(2,X);
+ If OP EQ '!*RBRAC!* then
+ OP := SCAN()
+ else PARERR("Missing } after argument list",NIL);
+ Return REPCOM('OnePoint,RES)
+end;
+
+Procedure REPCOM(TYPE,X); %. Create ARGLIST
+ IF EQCAR(X,'!*COMMA!*) THEN (TYPE . CDR X)
+ ELSE IF X EQ '!*EMPTY!* THEN LIST(TYPE)
+ ELSE LIST(TYPE,X);
+
+
+RemProp('!_,'NEWNAM); %. underscore handling.
+Put('!_,'NEWNAM,'POINTSET); % "_" is used for Pointset.
+DefineBOP('POINTSET,17,18,NARY('POINTSET,X,Y));
+
+
+Put('!&,'NEWNAM,'GROUP); %. and sign handling.
+DefineBOP('GROUP,13,14,NARY('GROUP,X,Y)); % "&" is used for Group.
+
+
+Put('!|,'NEWNAM,'TRANSFORM); %. back slash handling.
+DefineROP('TRANSFORM,20, % "|" is used for transform.
+ If EQCAR(X,'!*COMMA!*) then
+ REPCOM('TRANSFORM,X));
+DefineBOP('TRANSFORM,15,16);
+
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% conversion of external Procedures to %
+% internal form. %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% **************************************
+% conversion on structures of models. *
+% **************************************
+
+NExpr Procedure POINTSET L$
+ 'POINTSET . L$
+
+NExpr Procedure GROUP L$
+ 'GROUP . L$
+
+NExpr Procedure TRANSFORM L$
+ 'TRANSFORM . L$
+
+% ***********************************
+% conversion on interpreter level *
+% Procedures. *
+% ***********************************
+
+Procedure BSPLINE;
+ LIST 'BSPLINE;
+
+Procedure BEZIER;
+ LIST 'BEZIER;
+
+Procedure LINE;
+ LIST 'LINE;
+
+Procedure CIRCLE(R);
+ LIST('CIRCLE,R);
+
+Procedure COLOR N;
+ List('Color,N);
+
+Procedure REPEATED(COUNT,TRANS);
+ LIST('REPEATED,COUNT,TRANS);
+
+BothTimes <<Procedure MKLIST L$
+ 'LIST . L; >>;
+
+MACRO Procedure OnePoint L$
+ LIST('MKPOINT, MKLIST CDR L)$
+
+MACRO Procedure MAT16 L;
+ LIST('LIST2VECTOR, MKLIST (NIL. CDR L))$
+
+Procedure PNT4(X1,X2,X3,X4); % create a vector of a point
+ Begin scalar V;
+ V:=MKVECT 4;
+ V[1]:=X1;
+ V[2]:=X2;
+ V[3]:=X3;
+ V[4]:=X4;
+ Return V;
+ end;
+
+% %%%%%%%%%%%%%%%%%%%%%%%%%
+% PAIR KLUDGES %
+% %%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure PRLISPCDR L$ %. PRLISPCDR of a list.
+If PAIRP L then CDR L else 'NIL$
+
+Procedure CAR1 L$ %. the Car1 element of
+If PAIRP L then CAR L else 'NIL$ %. a list.
+
+Procedure CAR2 L$ %. the CAR2 element of
+If LENGTH L > 1 then CADR L else 'NIL$ %. a list.
+
+Procedure CAR3 L$ %. the CAR3 element of
+If LENGTH L > 2 then CADDR L else 'NIL$ %. a list.
+
+Procedure CAR4 L$ %. the CAR4 element of
+If LENGTH L > 3 then CADDDR L else 'NIL$ %. a list.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% interpreter supporting Procedures %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure V!.COPY V1$ %. Copy a vector
+Begin scalar N, V2$
+ V2 := MKVECT(N := SIZE V1)$
+ FOR I := 0 : N DO
+ V2[I] := V1[I]$
+ Return V2$
+end$
+
+ % *********************
+ % point primitive *
+ % *********************
+
+Procedure MKPOINT (POINTLIST)$ %. make a vector form for
+ Begin scalar P,I;
+ P:=Pnt4(0,0,0,1);
+ I:=1;
+ While PairP PointList and I<=4 do
+ <<P[I]:=Car PointList;
+ I:=I+1;
+ PointList:=Cdr PointList>>;
+ Return P
+ End;
+
+ % **************************
+ % initialize globals and *
+ % and fluids *
+ % set up for compiled *
+ % version *
+ % **************************
+
+FLUID '(
+ DISPLAY!.LIST %. Used for object definition for MPS
+ MAT!*0 %. 4 x 4 Zero Matrix
+ MAT!*1 %. 4 x 4 Unit Matrix
+ FirstPoint!* % FirstPoint of PointSet is MOVED to
+ GLOBAL!.TRANSFORM %. Accumulation Transform
+ CURRENT!.TRANSFORM
+ CURRENT!.LINE %. Line Style
+ CURRENT!.COLOR %. Default Color
+ X1CLIP % Set by VWPORT for Clipping
+ X2CLIP
+ Y1CLIP
+ Y2CLIP
+ FourClip % Vector to return New Clipped point
+ Xprevious
+ Yprevious
+ DEV!. % Device Name, set by xxx!.Init()
+ )$
+
+
+Procedure SetUpVariables; % Intialize Globals and Fluids
+ Begin
+ MAT!*0 := MAT16 ( 0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0,
+ 0,0,0,0)$
+ MAT!*1 := MAT16 (1,0,0,0,
+ 0,1,0,0,
+ 0,0,1,0,
+ 0,0,0,1)$ % unit matrix.
+ GLOBAL!.TRANSFORM := MAT!*1$
+ CURRENT!.TRANSFORM := MAT!*1$ % current transformation matrix
+ % initialized as mat!*1.
+ CURRENT!.LINE := 'LINE$
+ CURRENT!.COLOR := 'BLACK$
+ Xprevious := 0; Yprevious:=0;
+ FourClip := PNT4(0,0,0,0);
+ FirstPoint!* := NIL$
+ End;
+
+% ---------------- BASIC Moving and Drawing -------------------
+% Project from Normalized 4 Vector to X,Y plane
+
+Procedure MoveToXY(X,Y)$ %. Move current cursor to x,y of P
+ <<MoveS(X,Y);
+ Xprevious := X;
+ Yprevious := Y>>$
+
+Procedure DrawToXY(X,Y)$ %. Move cursor to "P" and draw from Previous
+ <<DrawS(X,Y);
+ Xprevious := X;
+ Yprevious := Y>>$
+
+ % **************************************
+ % clipping-- on 2-D display screen *
+ % **************************************
+
+Smacro procedure MakeFourClip(X1,Y1,X2,Y2);
+ <<FourClip[1]:=x1; FourClip[2]:=y1;
+ FourClip[3]:=x2; FourClip[4]:=y2;
+ FourClip>>;
+
+Procedure InView (L);
+ NULL(Car L) and NULL(cadr L) and NULL(caddr L) and NULL (cadddr L);
+
+Procedure CLIP2D (x1,y1,x2,y2); % Iterative Clipper
+Begin scalar P1,P2,TMP;
+ % Newmann and Sproull
+ P1 := TESTPOINT(x1,y1); % Classify EndPoints, get 4 List
+ P2 := TESTPOINT(x2,y2);
+ If InView(P1) and InView(P2) then Return MakeFourClip(x1,y1,X2,Y2);
+ WHILE NOT(InView(P1) AND InView(P2) OR LOGICAND(P1,P2)) DO
+ << If InView(P1) then % SWAP to get Other END
+ <<TMP := P1$ P1 := P2$ P2 := TMP$
+ TMP := X1$ X1 := X2$ X2 := TMP$
+ TMP := Y1$ Y1 := Y2$ Y2 := TMP>>$
+ If CADDDR P1 then
+ <<Y1 := Y1 + ((Y2-Y1)*(X1CLIP-X1)) / (X2-X1)$
+ X1 := X1CLIP>>
+ else If CADDR P1 then
+ <<Y1 := Y1 + ((Y2-Y1)*(X2CLIP-X1)) / (X2-X1)$
+ X1 := X2CLIP>>
+ else If CADR P1 then
+ <<X1 := X1 + ((X2-X1)*(Y1CLIP-Y1)) / (Y2-Y1)$
+ Y1 := Y1CLIP>>
+ else If CAR P1 then
+ <<X1 := X1 + ((X2-X1)*(Y2CLIP-Y1)) / (Y2-Y1)$
+ Y1 := Y2CLIP>>$
+ P1 := TESTPOINT(X1,Y1)>>; % reTest P1 after clipping
+ If Not LOGICAND(P1,P2) then Return MakeFourClip(X1,Y1,X2,Y2);
+ Return NIL
+ end$
+
+Procedure LOGICAND (P1, P2)$ %. logical "and".
+ (CAR P1 AND CAR P2) OR %. use in clipping
+ (CADR P1 AND CADR P2) OR
+ (CADDR P1 AND CADDR P2) OR
+ (CADDDR P1 AND CADDDR P2) $
+
+Procedure TESTPOINT(x,y)$ %. test If "P"
+ LIST (If y > Y2CLIP then T else NIL, %. inside the viewport.
+ If y < Y1CLIP then T else NIL, %.used in clipping
+ If x > X2CLIP then T else NIL,
+ If x < X1CLIP then T else NIL)$
+ % All NIL if Inside
+
+ % **********************************
+ % tranformation matrices *
+ % matrices internal are stored as *
+ % OnePoint = [x y z w] *
+ % matrix = [v1 v5 v9 v13 *
+ % v2 v6 v10 v14 *
+ % v3 v7 v11 v15 *
+ % v4 v8 v12 v16 ] *
+ % **********************************
+
+
+ %*******************************************************
+ % Matrix Multiplication given two 4 by 4 matricies *
+ %*******************************************************
+
+Procedure MAT!*MAT (V1,V2)$ %. multiplication of matrices.
+MAT16 ( % V1 and V2 are 4 by 4 matrices.
+ V1[ 1] * V2[ 1] + V1[ 5] * V2[ 2] + V1[ 9] * V2[ 3] + V1[ 13] * V2[ 4],
+ V1[ 2] * V2[ 1] + V1[ 6] * V2[ 2] + V1[ 10] * V2[ 3] + V1[ 14] * V2[ 4],
+ V1[ 3] * V2[ 1] + V1[ 7] * V2[ 2] + V1[ 11] * V2[ 3] + V1[ 15] * V2[ 4],
+ V1[ 4] * V2[ 1] + V1[ 8] * V2[ 2] + V1[ 12] * V2[ 3] + V1[ 16] * V2[ 4],
+ V1[ 1] * V2[ 5] + V1[ 5] * V2[ 6] + V1[ 9] * V2[ 7] + V1[ 13] * V2[ 8],
+ V1[ 2] * V2[ 5] + V1[ 6] * V2[ 6] + V1[ 10] * V2[ 7] + V1[ 14] * V2[ 8],
+ V1[ 3] * V2[ 5] + V1[ 7] * V2[ 6] + V1[ 11] * V2[ 7] + V1[ 15] * V2[ 8],
+ V1[ 4] * V2[ 5] + V1[ 8] * V2[ 6] + V1[ 12] * V2[ 7] + V1[ 16] * V2[ 8],
+ V1[ 1] * V2[ 9] + V1[ 5] * V2[ 10] + V1[ 9] * V2[ 11] + V1[ 13] * V2[ 12],
+ V1[ 2] * V2[ 9] + V1[ 6] * V2[ 10] + V1[ 10] * V2[ 11] + V1[ 14] * V2[ 12],
+ V1[ 3] * V2[ 9] + V1[ 7] * V2[ 10] + V1[ 11] * V2[ 11] + V1[ 15] * V2[ 12],
+ V1[ 4] * V2[ 9] + V1[ 8] * V2[ 10] + V1[ 12] * V2[ 11] + V1[ 16] * V2[ 12],
+ V1[ 1] * V2[ 13] + V1[ 5] * V2[ 14] + V1[ 9] * V2[ 15] + V1[ 13] * V2[ 16],
+ V1[ 2] * V2[ 13] + V1[ 6] * V2[ 14] + V1[ 10] * V2[ 15] + V1[ 14] * V2[ 16],
+ V1[ 3] * V2[ 13] + V1[ 7] * V2[ 14] + V1[ 11] * V2[ 15] + V1[ 15] * V2[ 16],
+ V1[ 4] * V2[ 13] + V1[ 8] * V2[ 14] + V1[ 12] * V2[ 15] + V1[ 16] * V2[ 16])$
+
+
+Procedure PNT!*PNT(U,V)$ %. multiplication of matrices
+ U[1] * V[1] + %. 1 by 4 and 4 by 1.
+ U[2] * V[2] + % Returning a value.
+ U[3] * V[3] +
+ U[4] * V[4] $
+
+
+Procedure PNT!*MAT(U,V)$ %. multiplication of matrices
+Begin scalar U1,U2,U3,U4$ %. 1 by 4 with 4 by 4.
+ U1 := U[1]$ % Returning a 1 by 4 vector.
+ U2 := U[2]$
+ U3 := U[3]$
+ U4 := U[4]$
+ U:=Mkvect 4;
+ u[1]:= U1 * V[1] + U2 * V[2] + U3 * V[3] + U4 * V[4];
+ u[2]:= U1 * V[5] + U2 * V[6] + U3 * V[7] + U4 * V[8];
+ u[3]:= U1 * V[9] + U2 * V[10] + U3 * V[11] + U4 * V[12];
+ u[4]:= U1 * V[13] + U2 * V[14] + U3 * V[15] + U4 * V[16];
+ Return U;
+end$
+
+ % ************************************
+ % set up perspective transformtion *
+ % given eye and screen distances *
+ % ************************************
+
+Procedure WINDOW(EYE,SCREEN)$ %. perspective transformation.
+Begin scalar SE$
+ SE := SCREEN - EYE$ % EYE and SCREEN are distances
+ Return MAT16(SE,0.0,0.0,0.0, % from eye and screen to
+ 0.0,SE,0.0,0.0, % origin respectively.
+ 0.0,0.0,SE,0.0,
+ 0.0,0.0,1.0, -EYE)
+end$
+
+ % **********************
+ % translation *
+ % **********************
+
+Procedure XMove (TX)$ %. x translation only
+ Move (TX,0,0) $
+
+Procedure YMove (TY)$ %. y translation only
+ Move (0,TY,0) $
+
+Procedure ZMove (TZ)$ %. z translation only
+ Move (0,0,TZ) $
+
+Procedure Move (TX,TY,TZ)$ %. Move origin / object$
+ MAT16 (1, 0, 0, TX, %. make a translation
+ 0, 1, 0, TY, %. transformation matrix
+ 0, 0, 1, TZ, %. [ 1 O O O
+ 0, 0, 0, 1)$ %. 0 1 0 0
+ %. 0 0 1 0
+ %. Tx Ty Tz 1 ]
+
+ % *******************
+ % rotation *
+ % *******************
+
+Procedure XROT (X)$ %. rotation about x
+ FROTATE (X,2,3) $
+
+Procedure YROT (X)$ %. rotation about y
+ FROTATE (X,3,1) $
+
+Procedure ZROT (X)$ %. rotation about z
+ FROTATE (X,1,2) $
+
+Procedure FROTATE (THETA,I,J)$ %. scale factor
+Begin scalar S,C,W,TEMP$ %. i and j are the index
+ %. values to set up matrix
+
+ S := SIND (THETA)$ %. sin in degrees uses mathlib
+ C := COSD (THETA)$ %. cos in degrees uses mathlib
+ TEMP := V!.COPY MAT!*1;
+ PutV (TEMP, 5 * I-4, C)$
+ PutV(TEMP, 5 * J-4, C)$
+ PutV (TEMP, I+4 * J-4,-S)$
+ PutV (TEMP, J+4 * I-4, S)$
+ Return TEMP
+end $
+
+%/ Need to add rotate about an AXIS
+
+ % ******************
+ % scaling *
+ % ******************
+
+Procedure XSCALE (SX)$ %. scaling along X axis only.
+ SCALE1 (SX,1,1) $
+
+Procedure YSCALE (SY)$ %. scaling along Y axis only.
+ SCALE1 (1,SY,1) $
+
+Procedure ZSCALE (SZ)$ %. scaling along Z axis only.
+ SCALE1 (1,1,SZ) $
+
+Procedure SCALE1(XT,YT,ZT)$ %. scaling transformation
+ MAT16 ( XT, 0, 0, 0, %. matrix.
+ 0 ,YT, 0, 0,
+ 0 , 0,ZT, 0,
+ 0 , 0, 0, 1)$
+
+Procedure SCALE SFACT; %. scaling along 3 axes.
+ SCALE1(SFACT,SFACT,SFACT);
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % Procedure definitions %
+ % in the interpreter %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Put('OnePoint,'PBINTRP,'DrawPOINT)$
+Put('POINTSET,'PBINTRP,'DrawPOINTSET)$
+Put('GROUP,'PBINTRP,'DrawGROUP)$
+Put('TRANSFORM,'PBINTRP,'PERFORMTRANSFORM)$
+Put('PICTURE,'PBINTRP,'DrawModel)$
+Put('CIRCLE,'PBINTRP,'DrawCIRCLE)$
+Put('BEZIER,'PBINTRP,'DOBEZIER)$
+Put('LINE,'PBINTRP,'DOLINE)$
+Put('BSPLINE,'PBINTRP,'DOBSPLINE)$
+Put('REPEATED, 'PBINTRP,'DOREPEATED)$
+Put('Color,'pbintrp,'Docolor);
+
+ %******************************************
+ % SETUP Procedure FOR BEZIER AND BSPLINE *
+ % LINE and COLOR
+ %******************************************
+
+procedure DoColor(Object,N);
+ Begin scalar SaveColor;
+ SaveColor:=Current!.color;
+ N:=Car1 N; % See CIRCLE example, huh?
+ If IDP N then N:=EVAL N;
+ ChangeColor N;
+ Draw1(Object,CURRENT!.TRANSFORM);
+ ChangeColor SaveColor;
+ Return NIL;
+ End;
+
+Procedure DOBEZIER OBJECT$
+Begin scalar CURRENT!.LINE$
+ CURRENT!.LINE := 'BEZIER$
+ Draw1(Object,CURRENT!.TRANSFORM);
+end$
+
+Procedure DOBSPLINE OBJECT$
+Begin scalar CURRENT!.LINE$
+ CURRENT!.LINE := 'BSPLINE$
+ Draw1(Object,CURRENT!.TRANSFORM);
+end$
+
+Procedure DOLINE OBJECT$
+Begin scalar CURRENT!.LINE$
+ CURRENT!.LINE := 'LINE$
+ Draw1(Object,CURRENT!.TRANSFORM);
+end$
+
+
+ %*************************************
+ % interpreted function calls *
+ %*************************************
+
+
+Procedure DOREPEATED(MODEL,REPTFUN)$ %. repeat applying
+Begin scalar TEMP,I,TRANS,COUNT,TS,TA,GRP$ %. transformations.
+ TRANS := PRLISPCDR REPTFUN$
+ If LENGTH TRANS = 1 then
+ TRANS := EVAL CAR1 TRANS
+ else % "TRANS": transformation
+ << TS :=CAR1 TRANS$ % matrix.
+ TA := PRLISPCDR TRANS $ % "MODEL": the model.
+ TRANS := APPLY(TS,TA) >> $ % "COUNT": the times "MODEL"
+ COUNT := CAR1 REPTFUN$ % is going to be
+ GRP := LIST('GROUP)$ % repeated.
+ TEMP := V!.COPY TRANS$
+ FOR I := 1 : COUNT DO
+ << GRP := LIST('TRANSFORM,MODEL,TEMP) . GRP$
+ TEMP := MAT!*MAT(TEMP,TRANS) >>$
+ GRP := REVERSE GRP$
+ Return GRP
+end$
+
+ %***********************************
+ % Define SHOW ESHOW Draw AND EDraw *
+ % ESHOW AND EDraw ERASE THE SCREEN *
+ %***********************************
+
+
+Procedure SHOW X; %. ALIAS FOR Draw
+<<
+ If DEV!. = 'MPS then %. MPS driver don't call
+ << %. echo functions for diplay
+ %. device
+ DISPLAY!.LIST := LIST (X, DISPLAY!.LIST);
+ FOR EACH Z IN DISPLAY!.LIST DO
+ If Z neq NIL then
+ Draw1(Z,GLOBAL!.TRANSFORM); % Draw object list
+ % to frame
+ PSnewframe(); % display frame
+ >>
+ else
+ << GraphOn(); % call echo off If not emode
+ % If neccessary turn low level
+ Draw1(X,GLOBAL!.TRANSFORM); % Draw model tekronix style
+
+ GraphOff(); % call echoon
+ >>;
+
+>>;
+
+Procedure ESHOW ZZ$ %. erases the screen and
+<< Erase();
+ GraphOn();
+ DELAY();
+ Draw1(ZZ,GLOBAL!.TRANSFORM); % Draw model tekronix style
+ If DEV!. = 'MPS then << % Mps display frame
+ PSnewframe();
+ DISPLAY!.LIST := ZZ; >>;
+ GraphOff();
+ 0 >>;
+
+DefineROP('SHOW,10); %. set up precedence
+DefineROP('ESHOW,10);
+
+Procedure Draw X; %. ALIAS FOR SHOW
+ SHOW X$
+
+Procedure EDraw ZZ$ %. erases the screen and
+ ESHOW ZZ$
+
+
+DefineROP('Draw,10);
+DefineROP('EDraw,10);
+
+
+Procedure Col N; % User top-level color
+ <<GraphOn(); ChangeColor N; GraphOff()>>;
+
+
+ %*************************************
+ % Define Draw FUNCTIONS FOR VARIOUS *
+ % TYPES OF DISPLAYABLE OBJECTS *
+ %*************************************
+
+
+Procedure DrawModel PICT$ %. given picture "PICT" will
+ Draw1(PICT,CURRENT!.TRANSFORM)$ %. be applyied with global
+
+Procedure DERROR(MSG,OBJECT);
+ <<PRIN2 " Draw Error `"; PRIN2T MSG;
+ PRIN2 OBJECT; ERROR(700,MSG)>>;
+
+Procedure Draw1 (PICT,CURRENT!.TRANSFORM)$ % Draw PICT with TRANSFORMATION
+Begin scalar ITM,ITSARGS$
+ If NULL Pict then Return NIL;
+ If IDP PICT then PICT:=EVAL PICT;
+ If VECTORP PICT AND SIZE(PICT)=4 then Return DrawPOINT PICT$
+ If NOT PAIRP PICT then DERROR("Non Pair in Draw1: ",PICT);
+ ITM := CAR1 PICT$
+ ITSARGS := PRLISPCDR PICT$
+ If NOT (ITM = 'TRANSFORM) then
+ ITSARGS := LIST ITSARGS$ % gets LIST of args
+ ITM := GET (ITM,'PBINTRP)$
+ If NULL ITM then DERROR("Unknown Operator in Draw1:",PICT);
+ APPLY(ITM,ITSARGS)$
+ Return PICT$
+end$
+
+
+Procedure DrawGROUP(GRP)$ % Draw a group object
+Begin scalar ITM,ITSARGS,LMNT$
+ If PAIRP GRP then
+ FOR EACH LMNT IN GRP DO
+ If PAIRP LMNT then Draw1 (LMNT,CURRENT!.TRANSFORM)
+ else Draw1 (EVAL LMNT,CURRENT!.TRANSFORM)
+ else Draw1 (EVAL GRP,CURRENT!.TRANSFORM)$
+ Return GRP$
+end$
+
+
+Procedure DrawPOINTSET (PNTSET)$
+Begin scalar ITM,ITSARGS,PT$
+ FirstPoint!* := 'T$
+ If PAIRP PNTSET then
+ << If CURRENT!.LINE = 'BEZIER then
+ PNTSET := DrawBEZIER PNTSET
+ else If CURRENT!.LINE = 'BSPLINE then
+ PNTSET := DrawBSPLINE PNTSET$
+ FOR EACH PT IN PNTSET DO
+ <<If PAIRP PT then Draw1 (PT,CURRENT!.TRANSFORM)
+ else Draw1 (EVAL PT,CURRENT!.TRANSFORM)$
+ FirstPoint!* := 'NIL>> >>
+ else Draw1 (EVAL PNTSET,CURRENT!.TRANSFORM)$
+ Return PNTSET$
+end$
+
+
+Procedure DrawPOINT (PNT)$
+Begin scalar CLP,X1,Y1,W1,V,U1,U2,U3,U4;
+ If IDP PNT then PNT := EVAL PNT$
+ If PAIRP PNT then PNT := MKPOINT PNT;
+ V:=CURRENT!.TRANSFORM;
+ % Transform Only x,y and W
+ U1:=PNT[1]; U2:=PNT[2]; U3:= PNT[3]; U4:=PNT[4];
+
+ X1:=U1 * V[1] + U2 * V[2] + U3 * V[3] + U4 * V[4];
+ Y1:=U1 * V[5] + U2 * V[6] + U3 * V[7] + U4 * V[8];
+ W1:=U1 * V[13] + U2 * V[14] + U3 * V[15] + U4 * V[16];
+
+ IF NOT (W1 = 1.0) then <<x1:=x1/w1; y1:=y1/w1>>;
+ If FirstPoint!* then Return MoveToXY(X1,Y1);
+ % back to w=1 plane If needed.
+ CLP := CLIP2D(Xprevious,Yprevious, X1,Y1)$
+ If CLP then <<MoveToXY(CLP[1],CLP[2])$
+ DrawToXY(CLP[3],CLP[4])>>$
+end$
+
+
+Procedure PERFORMTRANSFORM(PCTSTF,TRNSFRM)$
+Begin scalar PROC,OLDTRNS,TRNSFMD,TRANSFOP,
+ TRANSARG,ITM,ITSARGS$
+ If IDP TRNSFRM then
+ TRNSFRM := EVAL TRNSFRM$
+ If VECTORP TRNSFRM AND SIZE(TRNSFRM) = 16 then
+ Draw1 (PCTSTF,MAT!*MAT(TRNSFRM,CURRENT!.TRANSFORM))
+ else If PAIRP TRNSFRM then
+ <<TRANSFOP := CAR1 TRNSFRM$
+ If (TRANSARG := PRLISPCDR TRNSFRM)
+ then TRANSARG := LIST (PCTSTF,TRANSARG)
+ else TRANSARG := LIST PCTSTF$
+ If (TRANSFOP = 'BEZIER OR TRANSFOP = 'BSPLINE) then
+ APPLY(GET(TRANSFOP,'PBINTRP),TRANSARG)
+ else
+ Draw1 (APPLY(GET(TRANSFOP,'PBINTRP),TRANSARG),
+ CURRENT!.TRANSFORM) >>
+end$
+
+ %***************************************
+ % circle bezier and bspline functions *
+ %***************************************
+
+Procedure DrawCIRCLE(CCNTR,RADIUS); %. Draw a circle with radius
+Begin scalar APNT,POLY,APNTX, APNTY$ %. "RADIUS".
+ POLY := LIST('POINTSET)$
+ If IDP CCNTR then CCNTR := EVAL CCNTR$
+ RADIUS := CAR1 RADIUS$
+ If IDP RADIUS then
+ RADIUS := EVAL RADIUS$
+ FOR ANGL := 180 STEP -15 UNTIL -180 DO % each line segment
+ << APNTX := CCNTR[1] + RADIUS * COSD ANGL$ % represents an arc of 15 dgrs
+ APNTY := CCNTR[2] + RADIUS * SIND ANGL$
+ POLY := LIST('Onepoint,APNTX,APNTY) . POLY>>$
+ Return REVERSE POLY
+end$
+
+Procedure DrawBSPLINE CONPTS$ %. a closed bspline curve
+Begin scalar N,TWOLIST,PX,PY,CURPTS, %. will be Drawn when given
+ BSMAT,II,TFAC,CPX,CPY$ %. a polygon "CONPTS".
+ BSMAT := MAT16 % " CONPTS" is a pointset.
+ ( -0.166666, 0.5, -0.5, 0.166666,
+ 0.5 , -1.0, 0.0, 0.666666,
+ -0.5 , 0.5, 0.5, 0.166666,
+ 0.166666, 0.0, 0.0, 0.0 )$
+ CURPTS := NIL$
+ N := LENGTH CONPTS$
+ TWOLIST := APPend (CONPTS,CONPTS)$
+ WHILE N > 0 DO
+ << PX :=PNT4
+ (GETV(CAR1 TWOLIST,1), GETV(CAR2 TWOLIST,1),
+ GETV(CAR3 TWOLIST,1),GETV(CAR4 TWOLIST,1))$
+ PY := PNT4
+ (GETV(CAR1 TWOLIST,2), GETV(CAR2 TWOLIST,2),
+ GETV(CAR3 TWOLIST,2), GETV(CAR4 TWOLIST,2))$
+ FOR I := 0.0 STEP 1.0 UNTIL 4.0 DO
+ << II := I/4.$
+ TFAC := PNT4 (II*II*II, II*II, II, 1.)$
+ TFAC := PNT!*MAT(TFAC,BSMAT)$
+ CPX := PNT!*PNT(TFAC,PX)$
+ CPY := PNT!*PNT(TFAC,PY)$
+ CURPTS := LIST ('Onepoint, CPX, CPY) . CURPTS >>$
+ N := N - 1$
+ TWOLIST := PRLISPCDR TWOLIST >>$
+ Return REVERSE CURPTS
+end$
+
+
+LISP Procedure DrawBEZIER CNTS;
+Begin
+ scalar LEN, NALL, SAVEX, SAVEY, CPX, CPY,
+ CURPTS, I, T0, TEMP, FACTL;
+
+ CURPTS := NIL;
+ SAVEX := NIL;
+ SAVEY := NIL;
+ LEN := LENGTH CNTS;
+ FOR I := 1 STEP 1 UNTIL LEN DO
+ <<
+ SAVEX := GETV(CAR1 CNTS, 1) . SAVEX;
+ SAVEY := GETV(CAR1 CNTS, 2) . SAVEY;
+ CNTS := PRLISPCDR CNTS
+ >>;
+
+ SAVEX := LIST2VECTOR SAVEX;
+ SAVEY := LIST2VECTOR SAVEY;
+
+ NALL := 8.0 * (LEN - 1);
+ FACTL := FACT (LEN - 1);
+ T0 := 0.0;
+
+ FOR T0 := 0.0 STEP 1.0 / NALL UNTIL 1.0 DO
+ <<
+ CPX := 0.0;
+ CPY := 0.0;
+ TEMP := 0.0;
+ FOR I := 0 STEP 1 UNTIL LEN - 1 DO
+ <<
+ TEMP := FACTL / ((FACT I) * (FACT (LEN -1 - I))) *
+ (T0 ** I) * (1.0 - T0)**(LEN -1 - I);
+ CPX := TEMP * SAVEX[I] + CPX;
+ CPY := TEMP * SAVEY[I] + CPY
+ >>;
+
+ CURPTS := LIST ('ONEPOINT, CPX, CPY, 0.0) . CURPTS
+ >>;
+
+ Return REVERSE CURPTS;
+end;
+
+procedure FACT N; % Simple factorial
+ Begin scalar M;
+ M:=1;
+ for i:=1:N do M:=M*I;
+ Return M;
+ end;
+
+
+LoadTime SetUpVariables();
+
+
ADDED psl-1983/3-1/util/pr-text.build
Index: psl-1983/3-1/util/pr-text.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-text.build
@@ -0,0 +1,2 @@
+CompileTime load pr!-main;
+in "pr-text.red"$
ADDED psl-1983/3-1/util/pr-text.red
Index: psl-1983/3-1/util/pr-text.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr-text.red
@@ -0,0 +1,204 @@
+% 8 * 12 Vector Characters
+
+CV := MkVect(127)$
+
+BlankChar := 'NIL$
+
+% Labeled Points on Rectangle (8 x 12 )
+
+% C4 Q6 S3 Q5 C3
+%
+%
+% Q7 M3 Q4
+%
+%
+% S4 M4 M0 M2 S2
+%
+%
+% Q8 M1 Q3
+%
+%
+% C1 Q1 S1 Q2 C2
+
+% Corners:
+C1:={0,0}$ C2 := {8,0}$ C4:={0,12}$ C3:= {8,12}$
+
+% Side MidPoints:
+S1 := {4,0}$ S3 := {4,12}$
+S4 := {0,6}$ S2 := {8,6}$
+
+% Middle:
+M0 := {4,6}$
+M1 := {4,3}$
+M2 := {6,6}$
+M3 := {4,9}$
+M4 := {2,6}$
+
+% Side Quarter Points:
+
+Q1 := {2,0}$ Q2 := {6,0}$
+Q3 := {8,3}$ Q4 := {8,9}$
+Q5 := {6,12}$ Q6 := {2,12}$
+Q7 := {0,9}$ Q8 := {0,3}$
+
+For i:=0:127 do CV[I]:=BlankChar;
+
+% UpperCase:
+
+CV[Char A] := C1 _ S3 _ C2 & M4 _ M2$
+CV[Char B] := C1 _ C4 _ Q5 _ Q4 _ M2 _ S4 & M2 _ Q3 _ Q2 _ C1 $
+CV[Char C] := Q3 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4$
+CV[Char D] := C1 _ C4 _ Q5 _ Q4 _ Q3 _ Q2 _ C1$
+CV[Char E] := C3 _ C4 _ C1 _ C2 & S4 _ S2$
+CV[Char F] := C3 _ C4 _ C1 & S4 _ S2$
+CV[Char G] := M0 _ S2 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4$
+CV[Char H] := C4 _ C1 & S4 _ S2 & C3 _ C2$
+CV[Char I] := S1 _ S3$
+CV[Char J] := C3 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char K] := C4 _ C1 & C3 _ S4 _ C2$
+CV[Char L] := C4 _ C1 _ C2$
+CV[Char M] := C1 _ C4 _ M0 _ C3 _ C2$
+CV[Char N] := C1 _ C4 _ C2 _ C3$
+CV[Char O] := Q3 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4 _ Q3$
+CV[Char P] := C1 _ C4 _ Q5 _ Q4 _ M2 _ S4$
+CV[Char Q] := Q3 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4 _ Q3 & C2 _ M1$
+CV[Char R] := C1 _ C4 _ Q5 _ Q4 _ M2 _ S4 & M0 _ C2$
+CV[Char S] := Q4 _ Q5 _ Q6 _ Q7 _ M4 _ M2 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char T] := C4 _ C3 & S3 _ S1$
+CV[Char U] := C4 _ Q8 _ Q1 _ Q2 _ Q3 _ C3$
+CV[Char V] := C4 _ S1 _ C3$
+CV[Char W] := C4 _ Q1 _ M0 _ Q2 _ C3$
+CV[Char X] := C1 _ C3 & C4 _ C2$
+CV[Char Y] := C4 _ M0 _ C3 & M0 _ S1$
+CV[Char Z] := C4 _ C3 _ C1 _ C2$
+
+% Lower Case, Alias for Now:
+
+CV[Char Lower A] := CV[Char A]$
+CV[Char Lower B] := CV[Char B]$
+CV[Char Lower C] := CV[Char C]$
+CV[Char Lower D] := CV[Char D]$
+CV[Char Lower E] := CV[Char E]$
+CV[Char Lower F] := CV[Char F]$
+CV[Char Lower G] := CV[Char G]$
+CV[Char Lower H] := CV[Char H]$
+CV[Char Lower I] := CV[Char I]$
+CV[Char Lower J] := CV[Char J]$
+CV[Char Lower K] := CV[Char K]$
+CV[Char Lower L] := CV[Char L]$
+CV[Char Lower M] := CV[Char M]$
+CV[Char Lower N] := CV[Char N]$
+CV[Char Lower O] := CV[Char O]$
+CV[Char Lower P] := CV[Char P]$
+CV[Char Lower Q] := CV[Char Q]$
+CV[Char Lower R] := CV[Char R]$
+CV[Char Lower S] := CV[Char S]$
+CV[Char Lower T] := CV[Char T]$
+CV[Char Lower U] := CV[Char U]$
+CV[Char Lower V] := CV[Char V]$
+CV[Char Lower W] := CV[Char W]$
+CV[Char Lower X] := CV[Char X]$
+CV[Char Lower Y] := CV[Char Y]$
+CV[Char Lower Z] := CV[Char Z]$
+
+
+% Digits:
+
+CV[Char 0] := CV[Char O]$
+CV[Char 1] := CV[Char I]$
+CV[Char 2] := Q7 _ Q6 _ Q5 _ Q4 _ M0 _ C1 _ C2$
+CV[Char 3] := C4 _ C3 _ M0 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char 4] := S1 _ S3 _ S4 _ S2$
+CV[Char 5] := C3 _ C4 _ S4 _ M0 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char 6] := Q4 _ Q5 _ Q6 _ Q7 _ Q8 _ Q1 _ Q2 _ Q3 _
+ M2 _ M4 _ Q8$
+CV[Char 7] := C4 _ C3 _ S1$
+CV[Char 8] := M0 _ M4 _ Q8 _ Q1 _ Q2 _ Q3 _ M2 _ M0
+ & M2 _ Q4 _ Q5 _ Q6 _ Q7 _ M4$
+CV[Char 9] := Q8 _ Q1 _ Q2 _ Q3 _ Q4 _ Q5 _
+ Q6 _ Q7 _ M4 _ M2 _ Q4$
+
+% Some Special Chars:
+
+CV[Char !+ ] := S1 _ S3 & S4 _ S2$
+CV[Char !- ] := S4 _ S2 $
+
+CV[Char !* ] := S1 _ S3 & S4 _ S2 & C1 _ C3 & C4 _ C2 $
+CV[Char !/ ] := C1 _ C3 $
+CV[Char !\ ] := C4 _ C2 $
+
+CV[Char !( ] := Q6 _ Q7 _ Q8 _ Q1 $
+CV[Char !) ] := Q5 _ Q4 _ Q3 _ Q2 $
+
+CV[Char ![ ] := Q6 _ C4 _ C1 _ Q1$
+CV[Char !] ] := Q5 _ C3 _ C2 _ Q2$
+
+CV[Char != ] := Q7 _ Q4 & Q8 _ Q3 $
+
+
+% Some Simple Display Routines:
+
+Xshift := Xmove(10)$
+Yshift := Ymove(15)$
+
+Procedure ShowString(S);
+ <<Graphon();
+ ShowString1(S,Global!.Transform);
+ Graphoff()>>;
+
+Procedure ShowString1(S,Current!.Transform);
+ Begin scalar i,ch;
+ For i:=0:Size S
+ do <<Draw1(CV[S[i]],Current!.Transform);
+ Current!.Transform := Mat!*mat(XShift,Current!.TRansform)>>;
+ End;
+
+Procedure C x;
+ if x:=CV[x] then EShow x;
+
+Procedure FullTest();
+ <<Global!.Transform := MAT!*1;
+ ShowString "ABCDEFGHIJKLMNOPQRTSUVWXYZ 0123456789";
+ NIL>>;
+
+Procedure SpeedTest();
+ <<Global!.Transform := Mat!*1;
+ For i:=0:127 do C i;
+ NIL>>;
+
+
+Procedure SlowTest();
+ <<Global!.Transform := Mat!*1;
+ For i:=0:127 do
+ <<C i;
+ Delay()>>;
+ NIL>>;
+
+
+Procedure Delay;
+ For i:=1:500 do nil;
+
+
+Procedure Text(S);
+ List('TEXT,S);
+
+Put('TEXT,'PBINTRP,'DrawTEXT)$
+
+
+Procedure DrawText(StartPoint,S); %. Draw a Text String
+Begin scalar MoveP;
+ If IDP StartPoint then StartPoint := EVAL StartPoint$
+ S := CAR1 S$
+ If IDP S then
+ S := EVAL S$
+ MoveP:=PositionAt StartPoint;
+ ShowString1(S,Mat!*Mat(MoveP,Current!.Transform));
+ Return NIL;
+end$
+
+Procedure PositionAt StartPoint; % return A matrix to set relative Origin
+ << If IDP StartPoint then StartPoint := EVAL StartPoint$
+ Mat16(1,0,0,StartPoint[1],
+ 0,1,0,StartPoint[2],
+ 0,0,1,StartPoint[3],
+ 0,0,0,StartPoint[4])>>;
ADDED psl-1983/3-1/util/pr2d-demo.red
Index: psl-1983/3-1/util/pr2d-demo.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-demo.red
@@ -0,0 +1,47 @@
+% This is a small Picture RLISP demo file
+% For the simpler 2D version
+
+Load prlisp2d$
+
+HP!.Init()$
+
+Outline := { 10, 10} _ {-10, 10} _ % Outline is 20 by 20
+ {-10,-10} _ { 10,-10} _ {10, 10}$ % Square
+
+Arrow := {0,-1} _ {0,2} & {-1,1} _ {0,2} _ {1,1}$
+
+Cube := (Outline & Arrow)$
+
+BigCube := Cube | Scale 5$
+
+Eshow Cube$
+
+Show Cube | Xmove 30$
+
+SHOW BigCube$
+
+ESHOW BigCube | Zrot 30$
+
+ESHOW {10,10} | circle(70)$
+
+Cpts := {0,0} _ {70,-60} _ {189,-69} _ {206,33} _ {145,130} _ {48,130}
+ _ {0,84} $
+
+ESHOW ( {10,10} | CIRCLE(50))$
+
+ESHOW (Cpts & Cpts | BEZIER())$
+
+ESHOW (Cpts & Cpts | BSPLINE())$
+
+ESHOW (Cube | scale 2 | XMOVE (-240) | REPEATED(5, XMOVE 80))$
+
+
+ESHOW {0,0} | Text("ABC DEF")$
+
+ESHOW {5,5} | Text("123 456") | Zrot 25 | Scale 2$
+
+Eshow { 10,10} | Text("123")$
+
+Show {30,30} | Text("456") | scale 3$
+
+END$
ADDED psl-1983/3-1/util/pr2d-demo.sl
Index: psl-1983/3-1/util/pr2d-demo.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-demo.sl
@@ -0,0 +1,38 @@
+% Lisp Syntax form of PR2D-DEMO.RED
+% 2D Version
+
+(LOAD PRLISP2D)
+% Initialize for HP2648
+(HP!.INIT)
+
+% Build some ObJects
+
+(SETQ OUTLINE
+ (POINTSET (ONEPOINT 10 10) (ONEPOINT -10 10) (ONEPOINT -10 -10)
+ (ONEPOINT 10 -10) (ONEPOINT 10 10)))
+(SETQ ARROW
+ (GROUP (POINTSET (ONEPOINT 0 -1) (ONEPOINT 0 2))
+ (POINTSET (ONEPOINT -1 1) (ONEPOINT 0 2) (ONEPOINT 1 1))))
+
+(SETQ CUBE (GROUP OUTLINE ARROW))
+(SETQ BIGCUBE (TRANSFORM CUBE (SCALE 5)))
+(ESHOW CUBE)
+(SHOW (TRANSFORM CUBE (XMOVE 30)))
+(SHOW BIGCUBE)
+(ESHOW (TRANSFORM BIGCUBE (ZROT 30)))
+(ESHOW (TRANSFORM (ONEPOINT 10 10) (CIRCLE 70)))
+(SETQ CPTS
+ (POINTSET (ONEPOINT 0 0) (ONEPOINT 70 -60) (ONEPOINT 189 -69)
+ (ONEPOINT 206 33) (ONEPOINT 145 130) (ONEPOINT 48 130)
+ (ONEPOINT 0 84)))
+(ESHOW (TRANSFORM (ONEPOINT 10 10) (CIRCLE 50)))
+(ESHOW (GROUP CPTS (TRANSFORM CPTS (BEZIER))))
+(ESHOW (GROUP CPTS (TRANSFORM CPTS (BSPLINE))))
+(ESHOW (TRANSFORM (TRANSFORM (TRANSFORM CUBE (SCALE 2)) (XMOVE -240))
+ (REPEATED 5 (XMOVE 80))))
+(ESHOW (TRANSFORM (ONEPOINT 0 0) (TEXT "ABC DEF")))
+(ESHOW (TRANSFORM (TRANSFORM (TRANSFORM (ONEPOINT 5 5) (TEXT "123 456"))
+ (ZROT 25))
+ (SCALE 2)))
+(ESHOW (TRANSFORM (ONEPOINT 10 10) (TEXT "123")))
+(SHOW (TRANSFORM (TRANSFORM (ONEPOINT 30 30) (TEXT "456")) (SCALE 3)))
ADDED psl-1983/3-1/util/pr2d-driv.build
Index: psl-1983/3-1/util/pr2d-driv.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-driv.build
@@ -0,0 +1,2 @@
+CompileTime load Pr2d!-Main;
+in "pr2d-driv.red"$
ADDED psl-1983/3-1/util/pr2d-driv.red
Index: psl-1983/3-1/util/pr2d-driv.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-driv.red
@@ -0,0 +1,736 @@
+%---------------------------------
+
+%. PRLISP-DRIVER.RED Terminal/Graphics Drivers for PRLISP
+%. Date: ~December 1981
+%. Authors: M.L. Griss, F. Chen, P. Stay
+%. Utah Symbolic Computation Group
+%. Department of Computer Science
+%. University of Utah, Salt Lake City.
+%. Copyright (C) University of Utah 1982
+
+% Also, need either EMODE or RAWIO files for EchoON/EchoOff
+
+% Note that under EMODE (!*EMODE= T), EchoOn and EchoOff
+% Already Done, so GraphOn and GraphOff need to test !*EMODE
+
+FLUID '(!*EMODE);
+loadtime <<!*EMODE:=NIL;>>; % initialize emode to off
+
+
+ %***************************
+ % setup functions for *
+ % terminal devices *
+ %***************************
+
+FLUID '(!*UserMode);
+
+Procedure FNCOPY(NewName,OldName)$ %. to copy equivalent
+ Begin scalar !*UserMode;
+ CopyD(NewName,OldName);
+ end;
+
+Procedure DDA (X1,Y1,X2,Y2,dotter);
+ Begin scalar Dx,Dy,Xc,Yc,I,R,S;
+ % From N & S, Page 44, Draw Straight Pointset
+ Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
+ If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
+ If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
+ If Dx <= Dy then Goto doy;
+ S := FLOAT(Dy)/Dx;
+ For I := 1:Dx do
+ <<R := R+S;
+ If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
+ X1 := X1+Xc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL;
+ doy:S := float(Dx) / Dy;
+ For I := 1:Dy do
+ <<R := R+S;
+ If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
+ Y1 := Y1+Yc;
+ APPLY(dotter,LIST (X1,Y1)) >>;
+ Return NIL
+ end;
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % hp specific Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure HP!.OutChar x; % Raw Terminal I/O
+ Pbout x;
+
+Procedure HP!.OutCharString S; % Pbout a string
+ For i:=0:Size S do HP!.OutChar S[i];
+
+Procedure HP!.grcmd (acmd)$ %. prefix to graphic command
+<<HP!.OutChar char ESC$
+ HP!.OutChar char !*$
+ HP!.OutCharString ACMD$
+ DELAY() >>$
+
+
+Procedure HP!.OutInt X; % Pbout a integer
+ <<HP!.OutChar (char !0 + (X/100));
+ X:=Remainder(x,100);
+ HP!.OutChar (char !0 + (x/10));
+ HP!.OutChar (char !0+Remainder(x,10));
+ nil>>;
+
+Procedure HP!.Delay$ %. Delay to wait for the display
+ HP!.OutChar CHAR EOL; % Flush buffer
+
+Procedure HP!.EraseS()$ %. EraseS graphic diaplay screen
+<<HP!.GRCMD("dack")$
+ MoveToXY(0,0)>>;
+
+Procedure HP!.Erase()$ %. EraseS graphic diaplay screen
+ <<HP!.GraphOn(); HP!.Erases(); HP!.GraphOff()>>;
+
+Procedure HP!.NormX XX$ %. absolute position along
+ FIX(XX+0.5)+360$ % X axis
+
+Procedure HP!.NormY YY$ %. absolute position along
+ FIX(YY+0.5)+180$ % Y axis.
+
+Procedure HP!.MoveS (XDEST,YDEST)$ %. Move pen to absolute location
+<< HP!.GRCMD("d")$
+ HP!.OutInt HP!.NormX XDEST$
+ HP!.OutChar Char '!,$
+ HP!.OutInt HP!.NormY YDEST$
+ HP!.OutCharString "oZ"$
+ HP!.GRCMD("pacZ") >>$
+
+Procedure HP!.DrawS (XDEST,YDEST)$ %. MoveS pen to the pen position
+ <<HP!.GRCMD("d")$
+ HP!.OutInt HP!.NormX XDEST$ %. line to it rom previous
+ HP!.OutChar Char '!,$ %. pen position.
+ HP!.OutInt HP!.NormY YDEST$
+ HP!.OutCharString "oZ"$
+ HP!.GRCMD("pbcZ")$'NIL>>$
+
+Procedure HP!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport
+<< X1CLIP := MAX2 (-360,X1)$ %. for HP2648A terminal.
+ X2CLIP := MIN2 (360,X2)$
+ Y1CLIP := MAX2 (-180,Y1)$
+ Y2CLIP := MIN2 (180,Y2) >>$
+
+Procedure HP!.GRAPHON(); %. No special GraphOn/GraphOff
+ If not !*emode then echooff();
+
+Procedure HP!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure HP!.INIT$ %. HP device specIfic
+Begin %. Procedures equivalent.
+ PRINT "HP IS DEVICE"$
+ DEV!. := 'HP;
+ FNCOPY( 'EraseS, 'HP!.EraseS)$ % should be called as for
+ FNCOPY( 'Erase, 'HP!.Erase)$ % should be called as for
+ FNCOPY( 'NormX, 'HP!.NormX)$ % initialization when
+ FNCOPY( 'NormY, 'HP!.NormY)$ % using HP2648A.
+ FNCOPY( 'MoveS, 'HP!.MoveS)$
+ FNCOPY( 'DrawS, 'HP!.DrawS)$
+ FNCOPY( 'VWPORT, 'HP!.VWPORT)$
+ FNCOPY( 'Delay, 'HP!.Delay)$
+ FNCOPY( 'GraphOn, 'HP!.GraphOn)$
+ FNCOPY( 'GraphOff, 'HP!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := MAT!*1;
+end$
+
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % TEKTRONIX specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure TEK!.OutChar x;
+ Pbout x;
+
+Procedure TEK!.EraseS(); %. EraseS screen, Returns terminal
+ <<TEK!.OutChar Char ESC; %. to Alpha mode and places cursor.
+ TEK!.OutChar Char FF>>;
+
+Procedure TEK!.EraseS(); %. EraseS screen, Returns terminal
+ <<Tek!.GraphOn(); Tek!.Erases(); TEK!.GraphOff()>>;
+
+
+Procedure TEK!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< TEK!.OutChar HIGHERY NormY YDEST$ %. information to the
+ TEK!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ TEK!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ TEK!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+
+Procedure HIGHERY YDEST$ %. convert Y to higher order Y.
+FIX(YDEST) / 32 + 32$
+
+Procedure LOWERY YDEST$ %. convert Y to lower order Y.
+ REMAINDER (FIX YDEST,32) + 96$
+
+
+Procedure HIGHERX XDEST$ %. convert X to higher order X.
+ FIX(XDEST) / 32 + 32$
+
+Procedure LOWERX XDEST$ %. convert X to lower order X.
+ REMAINDER (FIX XDEST,32) + 64$
+
+
+Procedure TEK!.MoveS(XDEST,YDEST)$
+ <<TEK!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ TEK!.4BYTES (XDEST,YDEST)$
+%/ Dont do 31 unless go back to text mode
+ TEK!.OutChar 31>> $ %. US: sets terminal to Alpha mode.
+
+Procedure TEK!.DrawS (XDEST,YDEST)$ %. Same as Tek!.MoveS but
+<< TEK!.OutChar 29$ %. Draw the line.
+ TEK!.4BYTES (HerePointX, HerePointY)$
+ %/ Can just do this, ignore reset TEXT or GRPAHICS mode, see ST!
+ TEK!.4BYTES (XDEST, YDEST)$
+ TEK!.OutChar 31>> $
+
+Procedure TEK!.NormX DESTX$ %. absolute location along
+ DESTX + 512$ %. X axis.
+
+Procedure TEK!.NormY DESTY$ %. absolute location along
+ DESTY + 390$ %. Y axis.
+
+Procedure TEK!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-512,X1)$ %. Tektronix 4006-1.
+ X2CLIP := MIN2 (512,X2)$
+ Y1CLIP := MAX2 (-390,Y1)$
+ Y2CLIP := MIN2 (390,Y2) >>$
+
+Procedure TEK!.Delay();
+ NIL;
+
+Procedure TEK!.GRAPHON(); %. No special GraphOn (? what of GS/US)
+If not !*emode then echooff();
+
+Procedure TEK!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure TEK!.INIT$ %. TEKTRONIX device specIfic
+Begin %. Procedures equivalent.
+ PRINT "TEKTRONIX IS DEVICE"$
+ DEV!. := ' TEK;
+ FNCOPY( 'EraseS, 'TEK!.EraseS)$ % should be called as for
+ FNCOPY( 'Erase, 'TEK!.Erase)$ % should be called as for
+ FNCOPY( 'NormX, 'TEK!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'TEK!.NormY)$ % Tektronix 4006-1.
+ FNCOPY( 'MoveS, 'TEK!.MoveS)$
+ FNCOPY( 'DrawS, 'TEK!.DrawS)$
+ FNCOPY( 'VWPORT, 'TEK!.VWPORT)$
+ FNCOPY( 'Delay, 'TEK!.Delay)$
+ FNCOPY( 'GraphOn, 'TEK!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEK!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := MAT!*1;
+end$
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % TELERAY specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Basic Teleray 1061 Plotter
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-12,12) := (Bottom . . Top)
+
+Procedure TEL!.OutChar x;
+ PBOUT x;
+
+Procedure TEL!.OutCharString S; % Pbout a string
+ For i:=0:Size S do TEL!.OutChar S[i];
+
+Procedure TEL!.NormX X;
+ FIX(X+0.5)+40;
+
+Procedure TEL!.NormY Y;
+ 12- FIX(Y+0.5);
+
+Procedure TEL!.ChPrt(X,Y,Ch);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutChar Ch>>;
+
+Procedure TEL!.IdPrt(X,Y,Id);
+ TEL!.ChPrt(X,Y,ID2Int ID);
+
+Procedure TEL!.StrPrt (X,Y,S);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutCharString S>>;
+
+Procedure TEL!.HOME (); % Home (0,0)
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar 'H>>;
+
+Procedure TEL!.EraseS (); % Delete Entire Screen
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar '!j>>;
+
+Procedure TEL!.Erase (); % Delete Entire Screen
+ <<TEL!.GraphON(); TEL!.Erases(); TEL!.GraphOff()>>;
+
+
+Procedure Tel!.MoveS (X1,Y1);
+ <<Xprevious := X1;
+ Yprevious := Y1>>;
+
+Procedure Tel!.DrawS (X1,Y1);
+ << DDA (Xprevious,Yprevious, X1, Y1,function TEL!.dotc);
+ Xprevious :=X1; Yprevious :=Y1>>;
+
+Procedure Idl2chl (X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp (X) do <<Y := getv (Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return (Reverse (Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter (X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl (Explode2 (Txt));
+ Return (DDA (X1,Y1,X2,Y2,function TEL!.Tdotc))
+ end;
+
+Procedure TEL!.Tdotc (X1,Y1);
+ Begin
+ If Null Tchars then Return (Nil);
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return ('T)
+ end;
+
+Procedure TEL!.dotc (X1,Y1); % Draw And Clip An X
+ TEL!.ChClip (X1,Y1,Char X) ;
+
+Procedure TEL!.ChClip (X1,Y1,Id);
+ Begin
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Id);
+ No:Return ('T)
+ end;
+
+Procedure Tel!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2 (-40,X1);
+ X2clip := Min2 (40,X2);
+ Y1clip := Max2 (-12,Y1);
+ Y2clip := Min2 (12,Y2)>>;
+
+Procedure Tel!.Wfill (X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do TEL!.ChClip (X,Y,Id);
+ end;
+
+Procedure TEL!.Wzap (X1,X2,Y1,Y2);
+ TEL!.Wfill (X1,X2,Y1,Y2,'! ) ;
+
+Procedure TEL!.Delay;
+ NIL;
+
+Procedure TEL!.GRAPHON();
+If not !*emode then echooff();
+
+Procedure TEL!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure TEL!.INIT (); % Setup For TEL As Device;
+ Begin
+ Dev!. := 'TEL;
+ FNCOPY('EraseS,'TEL!.EraseS);
+ FNCOPY('Erase,'TEL!.Erase);
+ FNCOPY('MoveS,'TEL!.MoveS);
+ FNCOPY('DrawS,'TEL!.DrawS);
+ FNCOPY( 'NormX, 'TEL!.NormX)$
+ FNCOPY( 'NormY, 'TEL!.NormY)$
+ FNCOPY('VwPort,'TEL!.VwPort);
+ FNCOPY('Delay,'TEL!.Delay);
+ FNCOPY( 'GraphOn, 'TEL!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEL!.GraphOff)$
+ Erase();
+ VwPort (-40,40,-12,12);
+ Global!.Transform := MAT!*1;
+ Print "Device Now TEL";
+ end;
+
+% Basic ANN ARBOR AMBASSADOR Plotter
+%
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-30,30) := (Top . . Bottom)
+
+Procedure ANN!.OutChar x;
+ PBOUT x;
+
+Procedure ANN!.OutCharString S; % Pbout a string
+ For i:=0:Size S do ANN!.OutChar S[i];
+
+Procedure ANN!.NormX X; % so --> X
+ 40 + FIX(X+0.5);
+
+Procedure ANN!.NormY Y; % so ^
+ 30 - FIX(Y+0.5); % | Y
+
+Procedure ANN!.XY(X,Y);
+<< Ann!.OutChar(char ESC);
+ Ann!.OutChar(char ![);
+ x:=Ann!.NormX(x);
+ y:=Ann!.NormY(y);
+ % Use "quick and dirty" conversion to decimal digits.
+ Ann!.OutChar(char 0 + (1 + Y)/10);
+ Ann!.OutChar(char 0 + remainder(1 + Y, 10));
+
+ Ann!.OutChar(char !;);
+ % Delimiter between row digits and column digits.
+
+ Ann!.OutChar(char 0 + (1 + X)/10);
+ Ann!.OutChar(char 0 + remainder(1 + X, 10));
+
+ Ann!.OutChar(char H); % Terminate the sequence
+>>;
+
+
+Procedure ANN!.ChPrt(X,Y,Ch);
+ <<ANN!.XY(X,Y);
+ ANN!.OutChar Ch>>;
+
+Procedure ANN!.IdPrt(X,Y,Id);
+ ANN!.ChPrt(X,Y,ID2Int ID);
+
+Procedure ANN!.StrPrt(X,Y,S);
+ <<ANN!.XY(X,Y);
+ ANN!.OutCharString S>>;
+
+Procedure ANN!.EraseS(); % Delete Entire Screen
+ <<ANN!.OutChar CHAR ESC;
+ ANN!.OutChar Char '![;
+ Ann!.OutChar Char 2;
+ Ann!.OutChar Char J;
+ Ann!.XY(0,0);>>;
+
+Procedure ANN!.Erase();
+ <<ANN!.Graphon(); ANN!.Erases(); Ann!.GraphOff()>>;
+
+Procedure ANN!.MoveS(X1,Y1);
+ <<Xprevious := X1;
+ Yprevious := Y1>>;
+
+Procedure ANN!.DrawS(X1,Y1);
+ << DDA(Xprevious,Yprevious, X1, Y1,function ANN!.dotc);
+ Xprevious :=X1; Yprevious :=Y1>>;
+
+Procedure Idl2chl(X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp(X) do <<Y := getv(Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return(Reverse(Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter(X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl(Explode2(Txt));
+ Return(DDA(X1,Y1,X2,Y2,function ANN!.Tdotc))
+ end;
+
+Procedure ANN!.Tdotc(X1,Y1);
+ Begin
+ If Null Tchars then Return(Nil);
+ If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
+ If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
+ ANN!.ChPrt(X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return('T)
+ end;
+
+Procedure ANN!.dotc(X1,Y1); % Draw And Clip An X
+ ANN!.ChClip(X1,Y1,Char !*) ;
+
+Procedure ANN!.ChClip(X1,Y1,Id);
+ Begin
+ If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
+ If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
+ ANN!.ChPrt(X1 , Y1,Id);
+ No:Return('T)
+ end;
+
+Procedure ANN!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2(-40,X1);
+ X2clip := Min2(40,X2);
+ Y1clip := Max2(-30,Y1);
+ Y2clip := Min2(30,Y2)>>;
+
+Procedure ANN!.Wfill(X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do ANN!.ChClip(X,Y,Id);
+ end;
+
+Procedure ANN!.Wzap(X1,X2,Y1,Y2);
+ ANN!.Wfill(X1,X2,Y1,Y2,'! ) ;
+
+Procedure ANN!.Delay;
+ NIL;
+
+Procedure ANN!.GRAPHON();
+ If not !*emode then echooff();
+
+Procedure ANN!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure ANN!.INIT(); % Setup For ANN As Device;
+ Begin
+ Dev!. := 'ANN60;
+ FNCOPY('EraseS,'ANN!.EraseS);
+ FNCOPY('Erase,'ANN!.Erase);
+ FNCOPY('MoveS,'ANN!.MoveS);
+ FNCOPY('DrawS,'ANN!.DrawS);
+ FNCOPY('NormX, 'ANN!.NormX)$
+ FNCOPY('NormY, 'ANN!.NormY)$
+ FNCOPY('VwPort,'ANN!.VwPort);
+ FNCOPY('Delay,'ANN!.Delay);
+ FNCOPY('GraphOn, 'ANN!.GraphOn)$
+ FNCOPY('GraphOff, 'ANN!.GraphOff)$
+ Erase();
+ VwPort(-40,40,-30,30);
+ Global!.Transform := Mat!*1;
+ Print "Device Now ANN60";
+ end;
+
+ %***************************************
+ % Apollo terminal driver and functions *
+ %***************************************
+
+Procedure ST!.OutChar x; % use Pbout instead
+ PBOUT x;
+
+Procedure ST!.EraseS(); % erase screen
+<< GraphOff();
+ ST!.OutChar 27;
+ ST!.OutChar 12;
+ Graphon()>>;
+
+Procedure ST!.Erase(); % erase screen
+<< EchoOff();
+ ST!.OutChar 27;
+ ST!.OutChar 12;
+ If Not !*EMODE then EchoOn()>>;
+
+
+Procedure ST!.GraphOn();
+<< EchoOff();
+ ST!.OutChar 29>>$ % Should be same for TEK
+
+Procedure ST!.GraphOff();
+<<ST!.OutChar 31$ % Maybe mixed VT-52/tek problem
+ If Not !*Emode Then EchoOn()>>;
+
+
+Procedure ST!.MoveS(XDEST,YDEST)$
+<< ST!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ ST!.4BYTES (XDEST,YDEST)$ %. US: sets terminal to Alpha mode.
+>>;
+
+Procedure ST!.DrawS (XDEST,YDEST)$ %. Same as MoveS but
+<< %/ ST!.OutChar 29$ % Always after move
+ %/ ST!.4bytes(HerePointX, HerePointY)>>$
+ ST!.4BYTES (XDEST, YDEST)$ %. Draw the line.
+ >>;
+
+Procedure ST!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< ST!.OutChar HIGHERY NormY YDEST$ %. information to the
+ ST!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ ST!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ ST!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+Procedure ST!.Delay();
+ NIL;
+
+Procedure ST!.NormX DESTX$ %. absolute location along
+ DESTX + 400$ %. X axis.
+
+Procedure ST!.NormY DESTY$ %. absolute location along
+ DESTY + 300$ %. Y axis.
+
+Procedure ST!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-400,X1)$ %. Tektronix 4006-1.
+ X2CLIP := MIN2 (400,X2)$
+ Y1CLIP := MAX2 (-300,Y1)$
+ Y2CLIP := MIN2 (300,Y2) >>$
+
+Procedure ST!.INIT$ %. JW's fake TEKTRONIX
+Begin %. Procedures equivalent.
+ PRINT "Apollo/ST is device"$
+ DEV!. := 'Apollo;
+ FNCOPY( 'EraseS, 'ST!.EraseS)$ % should be called as for
+ FNCOPY( 'Erase, 'ST!.Erase)$ % should be called as for
+ FNCOPY( 'NormX, 'ST!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'ST!.NormY)$ % APOtronix 4006-1.
+ FNCOPY( 'MoveS, 'ST!.MoveS)$
+ FNCOPY( 'DrawS, 'ST!.DrawS)$
+ FNCOPY( 'VWPORT, 'ST!.VWPORT)$
+ FNCOPY( 'Delay, 'ST!.Delay)$
+ FNCOPY( 'GraphOn, 'ST!.GraphOn);
+ FNCOPY( 'GraphOff, 'ST!.GraphOff);
+ Erase()$
+ VWPORT(-400,400,-300,300)$
+ GLOBAL!.TRANSFORM := MAT!*1;
+end$
+
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % HP2382 specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Basic Hp2382 Plotter
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-12,12) := (Bottom . . Top)
+
+Procedure HP2382!.OutChar x;
+ PBOUT x;
+
+Procedure HP2382!.OutCharString S; % Pbout a string
+ For i:=0:Size S do HP2382!.OutChar S[i];
+
+Procedure HP2382!.NormX X;
+ FIX(X+0.5)+40;
+
+Procedure HP2382!.NormY Y;
+ 12- FIX(Y+0.5);
+
+Procedure HP2382!.ChPrt(X,Y,Ch);
+ <<HP2382!.OutChar Char ESC;
+ HP2382!.OutChar Char '!&;
+ HP2382!.OutChar Char '!a;
+
+ HP2382!.OutINT (HP2382!.NormY Y);
+ HP2382!.OutChar Char '!r;
+ HP2382!.OutINT (HP2382!.NormX X);
+ HP2382!.OutChar Char '!C;
+ HP2382!.OutChar Ch>>;
+
+procedure HP2382!.OutINT x;
+ <<If x>9 then HP2382!.OutChar(Char 0 +(x/10));
+ HP2382!.OutChar(Char 0 +remainder(x,10))>>;
+
+Procedure HP2382!.IdPrt(X,Y,Id);
+ HP2382!.ChPrt(X,Y,ID2Int ID);
+
+Procedure HP2382!.StrPrt (X,Y,S);
+ <<HP2382!.OutChar Char ESC;
+ HP2382!.OutChar 89;
+ HP2382!.OutChar (32+HP2382!.NormY Y);
+ HP2382!.OutChar (32+ HP2382!.NormX X);
+ HP2382!.OutCharString S>>;
+
+Procedure HP2382!.HOME (); % Home (0,0)
+ <<HP2382!.OutChar CHAR ESC;
+ HP2382!.OutChar 'H>>;
+
+Procedure HP2382!.EraseS (); % Delete Entire Screen
+ <<HP2382!.HOME();
+ HP2382!.OutChar CHAR ESC;
+ HP2382!.OutChar 'J>>;
+
+Procedure HP2382!.Erase (); % Delete Entire Screen
+ <<HP2382!.GraphON(); HP2382!.Erases(); HP2382!.GraphOff()>>;
+
+
+Procedure HP2382!.MoveS (X1,Y1);
+ <<Xprevious := X1;
+ Yprevious := Y1>>;
+
+Procedure HP2382!.DrawS (X1,Y1);
+ << DDA (Xprevious,Yprevious, X1, Y1,function HP2382!.dotc);
+ Xprevious :=X1; Yprevious :=Y1>>;
+
+Procedure Idl2chl (X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp (X) do <<Y := getv (Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return (Reverse (Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter (X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl (Explode2 (Txt));
+ Return (DDA (X1,Y1,X2,Y2,function HP2382!.Tdotc))
+ end;
+
+Procedure HP2382!.Tdotc (X1,Y1);
+ Begin
+ If Null Tchars then Return (Nil);
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ HP2382!.ChPrt (X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return ('T)
+ end;
+
+Procedure HP2382!.dotc (X1,Y1); % Draw And Clip An X
+ HP2382!.ChClip (X1,Y1,Char X) ;
+
+Procedure HP2382!.ChClip (X1,Y1,Id);
+ Begin
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ HP2382!.ChPrt (X1 , Y1,Id);
+ No:Return ('T)
+ end;
+
+Procedure HP2382!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2 (-40,X1);
+ X2clip := Min2 (40,X2);
+ Y1clip := Max2 (-12,Y1);
+ Y2clip := Min2 (12,Y2)>>;
+
+Procedure HP2382!.Wfill (X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do HP2382!.ChClip (X,Y,Id);
+ end;
+
+Procedure HP2382!.Wzap (X1,X2,Y1,Y2);
+ HP2382!.Wfill (X1,X2,Y1,Y2,'! ) ;
+
+Procedure HP2382!.Delay;
+ NIL;
+
+Procedure HP2382!.GRAPHON();
+If not !*emode then echooff();
+
+Procedure HP2382!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure HP2382!.INIT (); % Setup For TEL As Device;
+ Begin
+ Dev!. := 'TEL;
+ FNCOPY('EraseS,'HP2382!.EraseS);
+ FNCOPY('Erase,'HP2382!.Erase);
+ FNCOPY('MoveS,'HP2382!.MoveS);
+ FNCOPY('DrawS,'HP2382!.DrawS);
+ FNCOPY( 'NormX, 'HP2382!.NormX)$
+ FNCOPY( 'NormY, 'HP2382!.NormY)$
+ FNCOPY('VwPort,'HP2382!.VwPort);
+ FNCOPY('Delay,'HP2382!.Delay);
+ FNCOPY( 'GraphOn, 'HP2382!.GraphOn)$
+ FNCOPY( 'GraphOff, 'HP2382!.GraphOff)$
+ Erase();
+ VwPort (-40,40,-12,12);
+ Global!.Transform := MAT!*1;
+ Print "Device Now TEL";
+ end;
+
ADDED psl-1983/3-1/util/pr2d-main.build
Index: psl-1983/3-1/util/pr2d-main.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-main.build
@@ -0,0 +1,1 @@
+in "pr2d-main.red"$
ADDED psl-1983/3-1/util/pr2d-main.red
Index: psl-1983/3-1/util/pr2d-main.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-main.red
@@ -0,0 +1,757 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% %
+% PictureRLISP : A Lisp-Based Graphics Language System with %
+% Flexible Syntax and Hierarchical %
+% Data Structure %
+% 2D version................
+%
+% Author: Fuh-Meei Chen, Paul Stay and Martin L. Griss %
+% Symbolic Computation Group %
+% Computer Science Dept. %
+% University of Utah %
+% %
+% <PSL.UTIL>PRLISP.RED.21, 9-Jan-82 22:47:43, Edit by GRISS %
+% <STAY.PICT>PRLISP.B 12-april-82 8:00:00 by Paul Stay %
+% changed bezier circle and bspline drivers and hp terminal %
+% on 10-april-82 by Paul Stay %
+% Added MPS support software for use on the graphics vax %
+% Added ST.INIT %
+% Copyright (c) 1981 University of Utah %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Part of the parser to accomplish the Pratt parser written %
+% in New-Rlisp runs at DEC-20. %
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+RemFlag('(MKVECT),'TWOREG); %/ Seems in Error
+RemProp('!{,'NEWNAM!-OP); %. left and right brackets
+RemProp('!},'NEWNAM!-OP); %. handling.
+RemProp('!{,'NEWNAM); % left and right brackets are
+RemProp('!},'NEWNAM); % used to Define points.
+Put('!{, 'NEWNAM,'!*LBRAC!*);
+Put('!}, 'NEWNAM,'!*RBRAC!*); % Put on to the property list.
+
+DefineROP('!*LBRAC!*,NIL,LBC); % Define the precedence.
+DefineBOP('!*RBRAC!*,1,0);
+
+FLUID '(OP);
+
+Procedure LBC X;
+Begin scalar RES;
+ If X EQ '!*RBRAC!* then
+ <<OP := X; RES := '!*EMPTY!*>>
+ else RES:= RDRIGHT(2,X);
+ If OP EQ '!*RBRAC!* then
+ OP := SCAN()
+ else PARERR("Missing } after argument list",NIL);
+ Return REPCOM('OnePoint,RES)
+end;
+
+Procedure REPCOM(TYPE,X); %. Create ARGLIST
+ IF EQCAR(X,'!*COMMA!*) THEN (TYPE . CDR X)
+ ELSE IF X EQ '!*EMPTY!* THEN LIST(TYPE)
+ ELSE LIST(TYPE,X);
+
+
+RemProp('!_,'NEWNAM); %. underscore handling.
+Put('!_,'NEWNAM,'POINTSET); % "_" is used for Pointset.
+DefineBOP('POINTSET,17,18,NARY('POINTSET,X,Y));
+
+
+Put('!&,'NEWNAM,'GROUP); %. and sign handling.
+DefineBOP('GROUP,13,14,NARY('GROUP,X,Y)); % "&" is used for Group.
+
+
+Put('!|,'NEWNAM,'TRANSFORM); %. back slash handling.
+DefineROP('TRANSFORM,20, % "|" is used for transform.
+ If EQCAR(X,'!*COMMA!*) then
+ REPCOM('TRANSFORM,X));
+DefineBOP('TRANSFORM,15,16);
+
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% conversion of external Procedures to %
+% internal form. %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% **************************************
+% conversion on structures of models. *
+% **************************************
+
+NExpr Procedure POINTSET L$
+ 'POINTSET . L$
+
+NExpr Procedure GROUP L$
+ 'GROUP . L$
+
+NExpr Procedure TRANSFORM L$
+ 'TRANSFORM . L$
+
+% ***********************************
+% conversion on interpreter level *
+% Procedures. *
+% ***********************************
+
+Procedure BSPLINE;
+ LIST 'BSPLINE;
+
+Procedure BEZIER;
+ LIST 'BEZIER;
+
+Procedure LINE;
+ LIST 'LINE;
+
+Procedure CIRCLE(R);
+ LIST('CIRCLE,R);
+
+Procedure COLOR N;
+ List('Color,N);
+
+Procedure REPEATED(COUNT,TRANS);
+ LIST('REPEATED,COUNT,TRANS);
+
+BothTimes <<Procedure MKLIST L$
+ 'LIST . L; >>;
+
+MACRO Procedure OnePoint L$
+ LIST('MKPOINT, MKLIST CDR L)$
+
+MACRO Procedure Mat8 L;
+ LIST('LIST2VECTOR, MKLIST (CDR L))$
+
+Procedure Pnt2(X1,X2,X3); % create a vector of a point
+ Begin scalar V;
+ V:=MKVECT 2;
+ V[0]:=X1;
+ V[1]:=X2;
+ V[2]:=X3;
+ Return V;
+ end;
+
+% %%%%%%%%%%%%%%%%%%%%%%%%%
+% PAIR KLUDGES %
+% %%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure PRLISPCDR L$ %. PRLISPCDR of a list.
+If PAIRP L then CDR L else 'NIL$
+
+Procedure CAR1 L$ %. the Car1 element of
+If PAIRP L then CAR L else 'NIL$ %. a list.
+
+Procedure CAR2 L$ %. the CAR2 element of
+If LENGTH L > 1 then CADR L else 'NIL$ %. a list.
+
+Procedure CAR3 L$ %. the CAR3 element of
+If LENGTH L > 2 then CADDR L else 'NIL$ %. a list.
+
+Procedure CAR4 L$ %. the CAR4 element of
+If LENGTH L > 3 then CADDDR L else 'NIL$ %. a list.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% interpreter supporting Procedures %
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure V!.COPY V1$ %. Copy a vector
+Begin scalar N, V2$
+ V2 := MKVECT(N := SIZE V1)$
+ FOR I := 0 : N DO
+ V2[I] := V1[I]$
+ Return V2$
+end$
+
+ % *********************
+ % point primitive *
+ % *********************
+
+Procedure MKPOINT (POINTLIST)$ %. make a vector form for
+ Begin scalar P,I;
+ P:=Pnt2(0,0,1);
+ I:=0;
+ While PairP PointList and I<=2 do
+ <<P[I]:=Car PointList;
+ I:=I+1;
+ PointList:=Cdr PointList>>;
+ Return P
+ End;
+
+ % **************************
+ % initialize globals and *
+ % and fluids *
+ % set up for compiled *
+ % version *
+ % **************************
+
+FLUID '(
+ DISPLAY!.LIST %. Used for object definition for MPS
+ MAT!*0 %. 3 x 3 Zero Matrix
+ MAT!*1 %. 3 x 3 Unit Matrix
+ FirstPoint!* % FirstPoint of PointSet is MOVED to
+ GLOBAL!.TRANSFORM %. Accumulation Transform
+ CURRENT!.TRANSFORM
+ CURRENT!.LINE %. Line Style
+ CURRENT!.COLOR %. Default Color
+ X1CLIP % Set by VWPORT for Clipping
+ X2CLIP
+ Y1CLIP
+ Y2CLIP
+ ThreeClip % Vector to return New Clipped point
+ HEREPOINTX %/ Same as Xprevious?
+ HEREPOINTY
+ Xprevious % To do DDA on TEL and AAA
+ Yprevious % Set by Move, used by DRAW
+ DEV!. % Device Name, set by xxx!.Init()
+ )$
+
+
+Procedure SetUpVariables; % Intialize Globals and Fluids
+ Begin
+ MAT!*0 := Mat8 ( 0,0,0,
+ 0,0,0,
+ 0,0,0)$
+ MAT!*1 := Mat8 (1,0,0,
+ 0,1,0,
+ 0,0,1)$ % unit matrix.
+ GLOBAL!.TRANSFORM := MAT!*1$
+ CURRENT!.TRANSFORM := MAT!*1$ % current transformation matrix
+ % initialized as mat!*1.
+ CURRENT!.LINE := 'LINE$
+ CURRENT!.COLOR := 'BLACK$
+ HEREPOINTX := 0; HEREPOINTY:=0;
+ ThreeClip := Vector(0,0,0,0);
+ FirstPoint!* := NIL$
+ End;
+
+% ---------------- BASIC Moving and Drawing -------------------
+% Project from Normalized 3 Vector to X,Y plane
+
+Procedure MoveToXY(X,Y)$ %. Move current cursor to x,y of P
+ <<MoveS(X,Y);
+ HEREPOINTX := X;
+ HEREPOINTY := Y>>$
+
+Procedure DrawToXY(X,Y)$ %. Move cursor to "P" and draw from Previous
+ <<DrawS(X,Y);
+ HEREPOINTX := X;
+ HEREPOINTY := Y>>$
+
+ % **************************************
+ % clipping-- on 2-D display screen *
+ % **************************************
+
+Smacro procedure MakeThreeClip(X1,Y1,X2,Y2);
+ <<ThreeClip[0]:=x1; ThreeClip[1]:=y1;
+ ThreeClip[2]:=x2; ThreeClip[3]:=y2;
+ ThreeClip>>;
+
+Procedure InView (L);
+ NULL(Car L) and NULL(cadr L) and NULL(caddr L) and NULL (cadddr L);
+
+Procedure CLIP2D (x1,y1,x2,y2); % Iterative Clipper
+Begin scalar P1,P2,TMP;
+ % Newmann and Sproull
+ P1 := TESTPOINT(x1,y1); % Classify EndPoints, get 4 List
+ P2 := TESTPOINT(x2,y2);
+ If InView(P1) and InView(P2) then Return MakeThreeClip(x1,y1,X2,Y2);
+ WHILE NOT(InView(P1) AND InView(P2) OR LOGICAND(P1,P2)) DO
+ << If InView(P1) then % SWAP to get Other END
+ <<TMP := P1$ P1 := P2$ P2 := TMP$
+ TMP := X1$ X1 := X2$ X2 := TMP$
+ TMP := Y1$ Y1 := Y2$ Y2 := TMP>>$
+ If CADDDR P1 then
+ <<Y1 := Y1 + ((Y2-Y1)*(X1CLIP-X1)) / (X2-X1)$
+ X1 := X1CLIP>>
+ else If CADDR P1 then
+ <<Y1 := Y1 + ((Y2-Y1)*(X2CLIP-X1)) / (X2-X1)$
+ X1 := X2CLIP>>
+ else If CADR P1 then
+ <<X1 := X1 + ((X2-X1)*(Y1CLIP-Y1)) / (Y2-Y1)$
+ Y1 := Y1CLIP>>
+ else If CAR P1 then
+ <<X1 := X1 + ((X2-X1)*(Y2CLIP-Y1)) / (Y2-Y1)$
+ Y1 := Y2CLIP>>$
+ P1 := TESTPOINT(X1,Y1)>>; % reTest P1 after clipping
+ If Not LOGICAND(P1,P2) then Return MakeThreeClip(X1,Y1,X2,Y2);
+ Return NIL
+ end$
+
+Procedure LOGICAND (P1, P2)$ %. logical "and".
+ (CAR P1 AND CAR P2) OR %. use in clipping
+ (CADR P1 AND CADR P2) OR
+ (CADDR P1 AND CADDR P2) OR
+ (CADDDR P1 AND CADDDR P2) $
+
+Procedure TESTPOINT(x,y)$ %. test If "P"
+ LIST (If y > Y2CLIP then T else NIL, %. inside the viewport.
+ If y < Y1CLIP then T else NIL, %.used in clipping
+ If x > X2CLIP then T else NIL,
+ If x < X1CLIP then T else NIL)$
+ % All NIL if Inside
+
+ % **********************************
+ % tranformation matrices *
+ % matrices internal are stored as *
+ % OnePoint = [x y w] *
+ % matrix = [v0 v3 v6 *
+ % v1 v4 v7 *
+ % v2 v5 v8 ] *
+ % **********************************
+
+
+ %*******************************************************
+ % Matrix Multiplication given two 3 by 3 matricies *
+ %*******************************************************
+
+Procedure MAT!*MAT (V1,V2)$ %. multiplication of matrices.
+Mat8 ( % V1 and V2 are 3 by 3 matrices.
+ V1[0] * V2[0] + V1[3] * V2[1] + V1[6] * V2[2],
+ V1[1] * V2[0] + V1[4] * V2[1] + V1[7] * V2[2],
+ V1[2] * V2[0] + V1[5] * V2[1] + V1[8] * V2[2],
+
+ V1[0] * V2[3] + V1[3] * V2[4] + V1[6] * V2[5],
+ V1[1] * V2[3] + V1[4] * V2[4] + V1[7] * V2[5],
+ V1[2] * V2[3] + V1[5] * V2[4] + V1[8] * V2[5],
+
+ V1[0] * v2[6] + V1[3] * V2[7] + V1[6] * V2[8],
+ V1[1] * v2[6] + V1[4] * V2[7] + V1[7] * V2[8],
+ V1[2] * v2[6] + V1[5] * V2[7] + V1[8] * V2[8]);
+
+
+
+
+Procedure PNT!*PNT(U,V)$ %. multiplication of matrices
+ U[0] * V[0] +
+ U[1] * V[1] + %. 1 by 3 and 3 by 1.
+ U[2] * V[2] $ % Returning a value.
+
+
+
+Procedure PNT!*MAT(U,V)$ %. multiplication of matrices
+Begin scalar U0,U1,U2$ %. 1 by 3 with 3 by 3.
+ U0 := U[0]$
+ U1 := U[1]$ % Returning a 1 by 3 vector.
+ U2 := U[2]$
+ U:=Mkvect 2;
+ u[0]:= U0 * V[0] + U1 * V[3] + U2 * V[6];
+ u[1]:= U0 * V[1] + U1 * V[4] + U2 * V[7];
+ u[2]:= U0 * V[2] + U1 * V[5] + U2 * V[8];
+ Return U;
+end$
+
+ % **********************
+ % translation *
+ % **********************
+
+Procedure XMove(TX)$ %. x translation only
+ Move (TX,0) $
+
+Procedure YMove(TY)$ %. y translation only
+ Move (0,TY) $
+
+Procedure Move(TX,TY)$ %. Move origin / object$
+ Mat8(1, 0, TX, %. make a translation
+ 0, 1, TY, %. transformation matrix
+ 0, 0, 1)$
+
+ % *******************
+ % Z rotation *
+ % *******************
+
+
+Procedure ZROT(Theta)$ %. rotation about z
+ Begin scalar S,C;
+ S := SIND (THETA)$ %. sin in degrees uses mathlib
+ C := COSD (THETA)$ %. cos in degrees uses mathlib
+ Return Mat8( C,-S,0,
+ S,C,0,
+ 0,0,1);
+ end $
+
+ % ******************
+ % scaling *
+ % ******************
+
+Procedure XSCALE (SX)$ %. scaling along X axis only.
+ SCALE1 (SX,1) $
+
+Procedure YSCALE (SY)$ %. scaling along Y axis only.
+ SCALE1 (1,SY) $
+
+Procedure SCALE1(XT,YT)$ %. scaling transformation
+ Mat8 ( XT, 0, 0, %. matrix.
+ 0 ,YT, 0,
+ 0, 0, 1)$
+
+Procedure SCALE SFACT; %. scaling along 2 axes.
+ SCALE1(SFACT,SFACT);
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % Procedure definitions %
+ % in the interpreter %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Put('OnePoint,'PBINTRP,'DrawPOINT)$
+Put('POINTSET,'PBINTRP,'DrawPOINTSET)$
+Put('GROUP,'PBINTRP,'DrawGROUP)$
+Put('TRANSFORM,'PBINTRP,'PERFORMTRANSFORM)$
+Put('PICTURE,'PBINTRP,'DrawModel)$
+Put('CIRCLE,'PBINTRP,'DrawCIRCLE)$
+Put('BEZIER,'PBINTRP,'DOBEZIER)$
+Put('LINE,'PBINTRP,'DOLINE)$
+Put('BSPLINE,'PBINTRP,'DOBSPLINE)$
+Put('REPEATED, 'PBINTRP,'DOREPEATED)$
+Put('Color,'pbintrp,'Docolor);
+
+ %******************************************
+ % SETUP Procedure FOR BEZIER AND BSPLINE *
+ % LINE and COLOR
+ %******************************************
+
+procedure DoColor(Object,N);
+ Begin scalar SaveColor;
+ SaveColor:=Current!.color;
+ N:=Car1 N; % See CIRCLE example, huh?
+ If IDP N then N:=EVAL N;
+ ChangeColor N;
+ Draw1(Object,CURRENT!.TRANSFORM);
+ ChangeColor SaveColor;
+ Return NIL;
+ End;
+
+Procedure DOBEZIER OBJECT$
+Begin scalar CURRENT!.LINE$
+ CURRENT!.LINE := 'BEZIER$
+ Draw1(Object,CURRENT!.TRANSFORM);
+end$
+
+Procedure DOBSPLINE OBJECT$
+Begin scalar CURRENT!.LINE$
+ CURRENT!.LINE := 'BSPLINE$
+ Draw1(Object,CURRENT!.TRANSFORM);
+end$
+
+Procedure DOLINE OBJECT$
+Begin scalar CURRENT!.LINE$
+ CURRENT!.LINE := 'LINE$
+ Draw1(Object,CURRENT!.TRANSFORM);
+end$
+
+
+ %*************************************
+ % interpreted function calls *
+ %*************************************
+
+
+Procedure DOREPEATED(MODEL,REPTFUN)$ %. repeat applying
+Begin scalar TEMP,I,TRANS,COUNT,TS,TA,GRP$ %. transformations.
+ TRANS := PRLISPCDR REPTFUN$
+ If LENGTH TRANS = 1 then
+ TRANS := EVAL CAR1 TRANS
+ else % "TRANS": transformation
+ << TS :=CAR1 TRANS$ % matrix.
+ TA := PRLISPCDR TRANS $ % "MODEL": the model.
+ TRANS := APPLY(TS,TA) >> $ % "COUNT": the times "MODEL"
+ COUNT := CAR1 REPTFUN$ % is going to be
+ GRP := LIST('GROUP)$ % repeated.
+ TEMP := V!.COPY TRANS$
+ FOR I := 1 : COUNT DO
+ << GRP := LIST('TRANSFORM,MODEL,TEMP) . GRP$
+ TEMP := MAT!*MAT(TEMP,TRANS) >>$
+ GRP := REVERSE GRP$
+ Return GRP
+end$
+
+ %***********************************
+ % Define SHOW ESHOW Draw AND EDraw *
+ % ESHOW AND EDraw ERASE THE SCREEN *
+ %***********************************
+
+
+Procedure SHOW X; %. ALIAS FOR Draw
+<<
+ If DEV!. = 'MPS then %. MPS driver don't call
+ << %. echo functions for diplay
+ %. device
+ DISPLAY!.LIST := LIST (X, DISPLAY!.LIST);
+ FOR EACH Z IN DISPLAY!.LIST DO
+ If Z neq NIL then
+ Draw1(Z,GLOBAL!.TRANSFORM); % Draw object list
+ % to frame
+ PSnewframe(); % display frame
+ >>
+ else
+ << GraphOn(); % call echo off If not emode
+ % If neccessary turn low level
+ Draw1(X,GLOBAL!.TRANSFORM); % Draw model tekronix style
+
+ GraphOff(); % call echoon
+ >>;
+
+>>;
+
+Procedure ESHOW ZZ$ %. erases the screen and
+ <<Erase(); %. display the picture "ZZ"
+ GraphOn();
+ DELAY();
+ Draw1(ZZ,GLOBAL!.TRANSFORM); % Draw model tekronix style
+ If DEV!. = 'MPS then << % Mps display frame
+ PSnewframe();
+ DISPLAY!.LIST := ZZ; >>;
+ GraphOff();
+ 0 >>;
+
+DefineROP('SHOW,10); %. set up precedence
+DefineROP('ESHOW,10);
+
+Procedure Draw X; %. ALIAS FOR SHOW
+ SHOW X$
+
+Procedure EDraw ZZ$ %. erases the screen and
+ ESHOW ZZ$
+
+
+DefineROP('Draw,10);
+DefineROP('EDraw,10);
+
+
+Procedure Col N; % User top-level color
+ <<GraphOn(); ChangeColor N; GraphOff()>>;
+
+
+ %*************************************
+ % Define Draw FUNCTIONS FOR VARIOUS *
+ % TYPES OF DISPLAYABLE OBJECTS *
+ %*************************************
+
+
+Procedure DrawModel PICT$ %. given picture "PICT" will
+ Draw1(PICT,CURRENT!.TRANSFORM)$ %. be applyied with global
+
+Procedure DERROR(MSG,OBJECT);
+ <<PRIN2 " Draw Error `"; PRIN2T MSG;
+ PRIN2 OBJECT; ERROR(700,MSG)>>;
+
+Procedure Draw1 (PICT,CURRENT!.TRANSFORM)$ % Draw PICT with TRANSFORMATION
+Begin scalar ITM,ITSARGS$
+ If NULL Pict then Return NIL;
+ If IDP PICT then PICT:=EVAL PICT;
+ If VECTORP PICT AND SIZE(PICT)=2 then Return DrawPOINT PICT$
+ If NOT PAIRP PICT then DERROR("Non Pair in Draw1: ",PICT);
+ ITM := CAR1 PICT$
+ ITSARGS := PRLISPCDR PICT$
+ If NOT (ITM = 'TRANSFORM) then
+ ITSARGS := LIST ITSARGS$ % gets LIST of args
+ ITM := GET (ITM,'PBINTRP)$
+ If NULL ITM then DERROR("Unknown Operator in Draw1:",PICT);
+ APPLY(ITM,ITSARGS)$
+ Return PICT$
+end$
+
+
+Procedure DrawGROUP(GRP)$ % Draw a group object
+Begin scalar ITM,ITSARGS,LMNT$
+ If PAIRP GRP then
+ FOR EACH LMNT IN GRP DO
+ If PAIRP LMNT then Draw1 (LMNT,CURRENT!.TRANSFORM)
+ else Draw1 (EVAL LMNT,CURRENT!.TRANSFORM)
+ else Draw1 (EVAL GRP,CURRENT!.TRANSFORM)$
+ Return GRP$
+end$
+
+
+Procedure DrawPOINTSET (PNTSET)$
+Begin scalar ITM,ITSARGS,PT$
+ FirstPoint!* := 'T$
+ If PAIRP PNTSET then
+ << If CURRENT!.LINE = 'BEZIER then
+ PNTSET := DrawBEZIER PNTSET
+ else If CURRENT!.LINE = 'BSPLINE then
+ PNTSET := DrawBSPLINE PNTSET$
+ FOR EACH PT IN PNTSET DO
+ <<If PAIRP PT then Draw1 (PT,CURRENT!.TRANSFORM)
+ else Draw1 (EVAL PT,CURRENT!.TRANSFORM)$
+ FirstPoint!* := 'NIL>> >>
+ else Draw1 (EVAL PNTSET,CURRENT!.TRANSFORM)$
+ Return PNTSET$
+end$
+
+
+Procedure DrawPOINT (PNT)$
+Begin scalar CLP,X1,Y1,W1,V,U0,U1,U2;
+ If IDP PNT then PNT := EVAL PNT$
+ If PAIRP PNT then PNT := MKPOINT PNT;
+ V:=CURRENT!.TRANSFORM;
+ % Transform Only x,y and W
+
+ U0:=PNT[0]; U1:=PNT[1]; U2:=PNT[2];
+
+ X1:=U0 * V[0] + U1 * V[1] + U2 * V[2];
+ Y1:=U0 * V[3] + U1 * V[4] + U2 * V[5];
+ W1:=U0 * V[6] + U1 * V[7] + U2 * V[8];
+
+ IF NOT( (W1=1) or (W1 = 1.0)) then <<x1:=x1/w1; y1:=y1/w1>>;
+ If FirstPoint!* then Return MoveToXY(X1,Y1);
+ % back to w=1 plane If needed.
+ CLP := CLIP2D(HEREPOINTX,HerePointY, X1,Y1)$
+ If CLP then <<MoveToXY(CLP[0],CLP[1])$
+ DrawToXY(CLP[2],CLP[3])>>$
+end$
+
+
+Procedure PERFORMTRANSFORM(PCTSTF,TRNSFRM)$
+Begin scalar PROC,OLDTRNS,TRNSFMD,TRANSFOP,
+ TRANSARG,ITM,ITSARGS$
+ If IDP TRNSFRM then
+ TRNSFRM := EVAL TRNSFRM$
+ If VECTORP TRNSFRM AND SIZE(TRNSFRM) = 8 then
+ Draw1 (PCTSTF,MAT!*MAT(TRNSFRM,CURRENT!.TRANSFORM))
+ else If PAIRP TRNSFRM then
+ <<TRANSFOP := CAR1 TRNSFRM$
+ If (TRANSARG := PRLISPCDR TRNSFRM)
+ then TRANSARG := LIST (PCTSTF,TRANSARG)
+ else TRANSARG := LIST PCTSTF$
+ If (TRANSFOP = 'BEZIER OR TRANSFOP = 'BSPLINE) then
+ APPLY(GET(TRANSFOP,'PBINTRP),TRANSARG)
+ else
+ Draw1 (APPLY(GET(TRANSFOP,'PBINTRP),TRANSARG),
+ CURRENT!.TRANSFORM) >>
+end$
+
+ %***************************************
+ % circle bezier and bspline functions *
+ %***************************************
+
+Procedure DrawCIRCLE(CCNTR,RADIUS); %. Draw a circle
+Begin scalar APNT,POLY,APNTX, APNTY$
+ POLY := LIST('POINTSET)$
+ If IDP CCNTR then CCNTR := EVAL CCNTR$
+ RADIUS := CAR1 RADIUS$
+ If IDP RADIUS then
+ RADIUS := EVAL RADIUS$
+ FOR ANGL := 180 STEP -15 UNTIL -180 DO % each line segment
+ << APNTX := CCNTR[0] + RADIUS * COSD ANGL$ % represents an arc of 15 dgrs
+ APNTY := CCNTR[1] + RADIUS * SIND ANGL$
+ POLY := LIST('Onepoint,APNTX,APNTY) . POLY>>$
+ Return REVERSE POLY
+end$
+
+
+Procedure DrawBspline CONPTS$ %. a "closed" Periodic bspline curve
+ Begin scalar N,CURPTS, % See CATMUL thesis Appendix
+ CPX,CPY, % Note correction in Matrix!
+ X0,X1,X2,X3,
+ Y0,Y1,Y2,Y3,
+ T1,T2,T3,
+ J0,J1,J2,
+ NPTS;
+
+ NPTS := 4;
+
+ N := LENGTH CONPTS$ %/ Check at least 4 ?
+
+ CONPTS := Append (CONPTS,CONPTS)$ % To make a Closed Loop
+ % Set the Initial 4 points
+ X0:=0; % Dummy
+ Y0:=0;
+ X1:=GETV(CAR CONPTS,0); % Will Be X0,Y0 in loop
+ Y1:=GETV(CAR CONPTS,1);
+
+ CONPTS := CDR CONPTS;
+ X2:=GETV(CAR CONPTS,0);
+ Y2:=GETV(CAR CONPTS,1);
+
+ CONPTS := CDR CONPTS;
+ X3:=GETV(CAR CONPTS,0);
+ Y3:=GETV(CAR CONPTS,1);
+
+ WHILE N > 0 DO
+ << X0 := X1; Y0 := Y1; % Cycle Points
+ X1 := X2; Y1 := Y2;
+ X2 := X3; Y2 := Y3;
+ CONPTS := CDR CONPTS;
+ X3:=GETV(CAR CONPTS,0);
+ Y3:=GETV(CAR CONPTS,1);
+ % Compute X(t) and Y(t) for NPTS points on [0.0,1.0]
+ FOR I := 0:NPTS-1 DO
+ << T1 := FLOAT(I)/NPTS$ % Powers of t
+ T2 := T1 * T1;
+ T3 := T2 * T1;
+%/ ( -1 3 -3 1
+%/ 3 -6 3 0
+%/ -3 0 3 0
+%/ 1 4 1 0 )
+
+ J0:= (1.0-T3) + 3.0*(T2-T1);
+ J1 := 3.0*T3 - 6*T2 +4.0;
+ J2 := 1.0+ 3.0*(T1 +T2- T3);
+
+ CPX := (X0*J0 +X1*J1 + X2 *J2 +X3*T3)/6.0;
+ CPY := (Y0*J0 +Y1*J1 + Y2 *J2 +Y3*T3)/6.0;
+
+ CURPTS := Pnt2(CPX, CPY,1.0) . CURPTS >>$
+ N := N - 1>>;
+
+ Return CURPTS
+end$
+
+% Faster 2-d Bezier
+
+procedure DrawBEZIER CNTS; % Give list of Points
+Begin
+ scalar LEN, NALL, SAVEX, SAVEY, CPX, CPY,
+ CURPTS, T0, T1, TEMP, FACTL, TI, FI,COEFF;
+
+ LEN := Isub1 LENGTH(CNTS);
+ SaveX := MKVect Len;
+ SaveY := MKVect Len;
+ FACTL := IFACT LEN;
+ FOR I := 0:LEN DO
+ <<Coeff := FactL/(IFACT(i)*IFACT(Len-i));
+ SAVEX[I] := GETV(CAR CNTS, 0) * Coeff;
+ SAVEY[I] := GETV(CAR CNTS, 1) * Coeff;;
+ CNTS := CDR CNTS>>;
+
+ NALL := 1.0/(8.0 * LEN); % Step Size
+
+ FOR T0 := 0.0 STEP NALL UNTIL 1.0 DO
+ << T1 := 1.0-T0;
+ TI := T0;
+ TEMP := T1**LEN;
+ CPX := TEMP * SAVEX[0];
+ CPY := TEMP * SAVEY[0];
+ FOR I := 1:LEN DO
+ << TEMP := (TI * (T1**(LEN - I)));
+ TI := TI * T0;
+ CPX := TEMP * SAVEX[I] + CPX;
+ CPY := TEMP * SAVEY[I] + CPY >>;
+
+ CURPTS := LIST ('ONEPOINT, CPX, CPY) . CURPTS
+ >>;
+ Return REVERSE CURPTS;
+end;
+
+procedure IFACT N; % fast factorial
+ Begin scalar M;
+ M:=1;
+ While Igreaterp(N,1) do <<M:=Itimes2(N,M); N :=Isub1 N>>;
+ Return M;
+ end;
+
+LoadTime SetUpVariables();
+
+% --------- OTHER UTILITIES ------------
+
+Procedure SAVEPICT (FIL,PICT,NAM)$ %. save a picture with no
+Begin scalar OLD; %. vectors.
+ FIL := OPEN (FIL,'OUTPUT)$ % fil : list('dir,file.ext)
+ OLD := WRS FIL$ % nam : id
+ PRIN2 NAM$ PRIN2 '! !:!=! !'$ PRIN2 PICT$ % pict: name of pict to
+ PRIN2 '!;$ WRS 'NIL$ CLOSE FIL$ % be saved.
+ Return PICT$
+ % fil: file name to save
+ % "pict".
+end$ % nam: name to be used
+ % after TAILore.
+ % type "in fil" to TAILore
+ % old picture.
+
ADDED psl-1983/3-1/util/pr2d-text.build
Index: psl-1983/3-1/util/pr2d-text.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-text.build
@@ -0,0 +1,2 @@
+CompileTime load pr2d!-main;
+in "pr2d-text.red"$
ADDED psl-1983/3-1/util/pr2d-text.red
Index: psl-1983/3-1/util/pr2d-text.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pr2d-text.red
@@ -0,0 +1,203 @@
+% 8 * 12 Vector Characters
+
+CV := MkVect(127)$
+
+BlankChar := 'NIL$
+
+% Labeled Points on Rectangle (8 x 12 )
+
+% C4 Q6 S3 Q5 C3
+%
+%
+% Q7 M3 Q4
+%
+%
+% S4 M4 M0 M2 S2
+%
+%
+% Q8 M1 Q3
+%
+%
+% C1 Q1 S1 Q2 C2
+
+% Corners:
+C1:={0,0}$ C2 := {8,0}$ C4:={0,12}$ C3:= {8,12}$
+
+% Side MidPoints:
+S1 := {4,0}$ S3 := {4,12}$
+S4 := {0,6}$ S2 := {8,6}$
+
+% Middle:
+M0 := {4,6}$
+M1 := {4,3}$
+M2 := {6,6}$
+M3 := {4,9}$
+M4 := {2,6}$
+
+% Side Quarter Points:
+
+Q1 := {2,0}$ Q2 := {6,0}$
+Q3 := {8,3}$ Q4 := {8,9}$
+Q5 := {6,12}$ Q6 := {2,12}$
+Q7 := {0,9}$ Q8 := {0,3}$
+
+For i:=0:127 do CV[I]:=BlankChar;
+
+% UpperCase:
+
+CV[Char A] := C1 _ S3 _ C2 & M4 _ M2$
+CV[Char B] := C1 _ C4 _ Q5 _ Q4 _ M2 _ S4 & M2 _ Q3 _ Q2 _ C1 $
+CV[Char C] := Q3 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4$
+CV[Char D] := C1 _ C4 _ Q5 _ Q4 _ Q3 _ Q2 _ C1$
+CV[Char E] := C3 _ C4 _ C1 _ C2 & S4 _ S2$
+CV[Char F] := C3 _ C4 _ C1 & S4 _ S2$
+CV[Char G] := M0 _ S2 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4$
+CV[Char H] := C4 _ C1 & S4 _ S2 & C3 _ C2$
+CV[Char I] := S1 _ S3$
+CV[Char J] := C3 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char K] := C4 _ C1 & C3 _ S4 _ C2$
+CV[Char L] := C4 _ C1 _ C2$
+CV[Char M] := C1 _ C4 _ M0 _ C3 _ C2$
+CV[Char N] := C1 _ C4 _ C2 _ C3$
+CV[Char O] := Q3 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4 _ Q3$
+CV[Char P] := C1 _ C4 _ Q5 _ Q4 _ M2 _ S4$
+CV[Char Q] := Q3 _ Q2 _ Q1 _ Q8 _ Q7 _ Q6 _ Q5 _ Q4 _ Q3 & C2 _ M1$
+CV[Char R] := C1 _ C4 _ Q5 _ Q4 _ M2 _ S4 & M0 _ C2$
+CV[Char S] := Q4 _ Q5 _ Q6 _ Q7 _ M4 _ M2 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char T] := C4 _ C3 & S3 _ S1$
+CV[Char U] := C4 _ Q8 _ Q1 _ Q2 _ Q3 _ C3$
+CV[Char V] := C4 _ S1 _ C3$
+CV[Char W] := C4 _ Q1 _ M0 _ Q2 _ C3$
+CV[Char X] := C1 _ C3 & C4 _ C2$
+CV[Char Y] := C4 _ M0 _ C3 & M0 _ S1$
+CV[Char Z] := C4 _ C3 _ C1 _ C2$
+
+% Lower Case, Alias for Now:
+
+CV[Char Lower A] := CV[Char A]$
+CV[Char Lower B] := CV[Char B]$
+CV[Char Lower C] := CV[Char C]$
+CV[Char Lower D] := CV[Char D]$
+CV[Char Lower E] := CV[Char E]$
+CV[Char Lower F] := CV[Char F]$
+CV[Char Lower G] := CV[Char G]$
+CV[Char Lower H] := CV[Char H]$
+CV[Char Lower I] := CV[Char I]$
+CV[Char Lower J] := CV[Char J]$
+CV[Char Lower K] := CV[Char K]$
+CV[Char Lower L] := CV[Char L]$
+CV[Char Lower M] := CV[Char M]$
+CV[Char Lower N] := CV[Char N]$
+CV[Char Lower O] := CV[Char O]$
+CV[Char Lower P] := CV[Char P]$
+CV[Char Lower Q] := CV[Char Q]$
+CV[Char Lower R] := CV[Char R]$
+CV[Char Lower S] := CV[Char S]$
+CV[Char Lower T] := CV[Char T]$
+CV[Char Lower U] := CV[Char U]$
+CV[Char Lower V] := CV[Char V]$
+CV[Char Lower W] := CV[Char W]$
+CV[Char Lower X] := CV[Char X]$
+CV[Char Lower Y] := CV[Char Y]$
+CV[Char Lower Z] := CV[Char Z]$
+
+
+% Digits:
+
+CV[Char 0] := CV[Char O]$
+CV[Char 1] := CV[Char I]$
+CV[Char 2] := Q7 _ Q6 _ Q5 _ Q4 _ M0 _ C1 _ C2$
+CV[Char 3] := C4 _ C3 _ M0 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char 4] := S1 _ S3 _ S4 _ S2$
+CV[Char 5] := C3 _ C4 _ S4 _ M0 _ Q3 _ Q2 _ Q1 _ Q8$
+CV[Char 6] := Q4 _ Q5 _ Q6 _ Q7 _ Q8 _ Q1 _ Q2 _ Q3 _
+ M2 _ M4 _ Q8$
+CV[Char 7] := C4 _ C3 _ S1$
+CV[Char 8] := M0 _ M4 _ Q8 _ Q1 _ Q2 _ Q3 _ M2 _ M0
+ & M2 _ Q4 _ Q5 _ Q6 _ Q7 _ M4$
+CV[Char 9] := Q8 _ Q1 _ Q2 _ Q3 _ Q4 _ Q5 _
+ Q6 _ Q7 _ M4 _ M2 _ Q4$
+
+% Some Special Chars:
+
+CV[Char !+ ] := S1 _ S3 & S4 _ S2$
+CV[Char !- ] := S4 _ S2 $
+
+CV[Char !* ] := S1 _ S3 & S4 _ S2 & C1 _ C3 & C4 _ C2 $
+CV[Char !/ ] := C1 _ C3 $
+CV[Char !\ ] := C4 _ C2 $
+
+CV[Char !( ] := Q6 _ Q7 _ Q8 _ Q1 $
+CV[Char !) ] := Q5 _ Q4 _ Q3 _ Q2 $
+
+CV[Char ![ ] := Q6 _ C4 _ C1 _ Q1$
+CV[Char !] ] := Q5 _ C3 _ C2 _ Q2$
+
+CV[Char != ] := Q7 _ Q4 & Q8 _ Q3 $
+
+
+% Some Simple Display Routines:
+
+Xshift := Xmove(10)$
+Yshift := Ymove(15)$
+
+Procedure ShowString(S);
+ <<Graphon();
+ ShowString1(S,Global!.Transform);
+ Graphoff()>>;
+
+Procedure ShowString1(S,Current!.Transform);
+ Begin scalar i,ch;
+ For i:=0:Size S
+ do <<Draw1(CV[S[i]],Current!.Transform);
+ Current!.Transform := Mat!*mat(XShift,Current!.TRansform)>>;
+ End;
+
+Procedure C x;
+ if x:=CV[x] then EShow x;
+
+Procedure FullTest();
+ <<Global!.Transform := MAT!*1;
+ ShowString "ABCDEFGHIJKLMNOPQRTSUVWXYZ 0123456789";
+ NIL>>;
+
+Procedure SpeedTest();
+ <<Global!.Transform := Mat!*1;
+ For i:=0:127 do C i;
+ NIL>>;
+
+
+Procedure SlowTest();
+ <<Global!.Transform := Mat!*1;
+ For i:=0:127 do
+ <<C i;
+ Delay()>>;
+ NIL>>;
+
+
+Procedure Delay;
+ For i:=1:500 do nil;
+
+
+Procedure Text(S);
+ List('TEXT,S);
+
+Put('TEXT,'PBINTRP,'DrawTEXT)$
+
+
+Procedure DrawText(StartPoint,S); %. Draw a Text String
+Begin scalar MoveP;
+ If IDP StartPoint then StartPoint := EVAL StartPoint$
+ S := CAR1 S$
+ If IDP S then
+ S := EVAL S$
+ MoveP:=PositionAt StartPoint;
+ ShowString1(S,Mat!*Mat(MoveP,Current!.Transform));
+ Return NIL;
+end$
+
+Procedure PositionAt StartPoint; % return A matrix to set relative Origin
+ << If IDP StartPoint then StartPoint := EVAL StartPoint$
+ Mat8(1,0,StartPoint[0],
+ 0,1,StartPoint[1],
+ 0,0,StartPoint[2])>>;
ADDED psl-1983/3-1/util/pretty.build
Index: psl-1983/3-1/util/pretty.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pretty.build
@@ -0,0 +1,1 @@
+in "pretty.red"$
ADDED psl-1983/3-1/util/pretty.red
Index: psl-1983/3-1/util/pretty.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pretty.red
@@ -0,0 +1,400 @@
+% <PSL.UTIL>PRETTY.RED.2, 2-Sep-82 09:16:32, Edit by BENSON
+% PRETTYPRINT returns NIL instead of its argument
+
+% This package prints list structures in an indented format that
+% is intended to make them legible. There are a number of special
+% cases recognized, but in general the intent of the algorithm
+% is that given a list (R1 R2 R3 ...), SUPERPRINT checks if
+% the list will fit directly on the current line and if so
+% prints it as:
+% (R1 R2 R3 ...)
+% if not it prints it as:
+% (R1
+% R2
+% R3
+% ... )
+% where each sublist is similarly treated.
+%
+% A. C. Norman. July 1978;
+
+
+% Functions:
+% SUPERPRINT(X) print expression X
+% SUPERPRINTM(X,M) print expression X with left margin M
+% PRETTYPRINT(X) = << SUPERPRINTM(X,POSN()), TERPRI() >>
+%
+% Flag:
+% !*SYMMETRIC If TRUE, print with escape characters,
+% otherwise do not (as PRIN1/PRIN2
+% distinction). defaults to TRUE;
+% !*QUOTES If TRUE, (QUOTE x) gets displayed as 'x.
+% default is TRUE;
+%
+% Variable:
+% THIN!* if THIN!* expressions can be fitted onto
+% a single line they will be printed that way.
+% this is a parameter used to control the
+% formatting of long thin lists. default
+% value is 5;
+
+
+
+SYMBOLIC;
+
+GLOBAL '(!*SYMMETRIC !*QUOTES THIN!*);
+
+!*SYMMETRIC:=T;
+!*QUOTES:=T;
+THIN!*:=5;
+
+SYMBOLIC PROCEDURE SUPERPRINT X;
+ << SUPERPRINM(X,0); TERPRI(); X>>;
+
+SYMBOLIC PROCEDURE PRETTYPRINT X;
+ << SUPERPRINM(X,POSN()); %WHAT REDUCE DOES NOW;
+ TERPRI();
+ NIL >>;
+
+SYMBOLIC PROCEDURE SUPERPRINTM(X,LMAR);
+ << SUPERPRINM(X,LMAR); TERPRI(); X >>;
+
+
+% FROM HERE DOWN THE FUNCTIONS ARE NOT INTENDED FOR DIRECT USE;
+
+FLUID '(STACK BUFFERI BUFFERO BN LMAR RMAR INITIALBLANKS
+ PENDINGRPARS INDENTLEVEL INDBLANKS RPARCOUNT);
+
+SYMBOLIC PROCEDURE SUPERPRINM(X,LMAR);
+ BEGIN
+ SCALAR STACK,BUFFERI,BUFFERO,BN,INITIALBLANKS,RMAR,
+ PENDINGRPARS,INDENTLEVEL,INDBLANKS,RPARCOUNT,W;
+ BUFFERI:=BUFFERO:=LIST NIL; %FIFO BUFFER;
+ INITIALBLANKS:=0;
+ RPARCOUNT:=0;
+ INDBLANKS:=0;
+ RMAR:=LINELENGTH NIL-3; %RIGHT MARGIN;
+ IF RMAR<25 THEN ERROR(0,LIST(RMAR+3,
+ "LINELENGTH TOO SHORT FOR SUPERPRINTING"));
+ BN:=0; %CHARACTERS IN BUFFER;
+ INDENTLEVEL:=0; %NO INDENTATION NEEDED, YET;
+ IF LMAR+20>=RMAR THEN LMAR:=RMAR-21; %NO ROOM FOR SPECIFIED MARGIN;
+ W:=POSN();
+ IF W>LMAR THEN << TERPRI(); W:=0 >>;
+ IF W<LMAR THEN INITIALBLANKS:=LMAR-W;
+ PRINDENT(X,LMAR+3); %MAIN RECURSIVE PRINT ROUTINE;
+% TRAVERSE ROUTINE FINISHED - NOW TIDY UP BUFFERS;
+ OVERFLOW 'NONE; %FLUSH OUT THE BUFFER;
+ RETURN X
+ END;
+
+
+% ACCESS FUNCTIONS FOR A STACK ENTRY;
+
+
+CompileTime <<
+SMACRO PROCEDURE TOP; CAR STACK;
+SMACRO PROCEDURE DEPTH FRM; CAR FRM;
+SMACRO PROCEDURE INDENTING FRM; CADR FRM;
+SMACRO PROCEDURE BLANKCOUNT FRM; CADDR FRM;
+SMACRO PROCEDURE BLANKLIST FRM; CDDDR FRM;
+SMACRO PROCEDURE SETINDENTING(FRM,VAL); RPLACA(CDR FRM,VAL);
+SMACRO PROCEDURE SETBLANKCOUNT(FRM,VAL); RPLACA(CDDR FRM,VAL);
+SMACRO PROCEDURE SETBLANKLIST(FRM,VAL); RPLACD(CDDR FRM,VAL);
+SMACRO PROCEDURE NEWFRAME N; LIST(N,NIL,0);
+SMACRO PROCEDURE BLANKP CHAR; NUMBERP CAR CHAR;
+>>;
+
+
+
+
+SYMBOLIC PROCEDURE PRINDENT(X,N);
+% PRINT LIST X WITH INDENTATION LEVEL N;
+ IF ATOM X THEN IF VECTORP X THEN PRVECTOR(X,N)
+ ELSE FOR EACH C IN
+ (IF !*SYMMETRIC THEN IF STRINGP X THEN EXPLODES X ELSE EXPLODE X
+ ELSE EXPLODEC X) DO PUTCH C
+ ELSE IF READMACROP X THEN <<
+ FOR EACH C IN GET(CAR X,'READMACROTOKEN) DO
+ PUTCH C;
+ PRINDENT(CADR X,N+GET(CAR X,'READMACROSIZE)) >>
+ ELSE BEGIN
+ SCALAR CX;
+ IF 4*N>3*RMAR THEN << %LIST IS TOO DEEP FOR SANITY;
+ OVERFLOW 'ALL;
+ N:=N/8;
+ IF INITIALBLANKS>N THEN <<
+ LMAR:=LMAR-INITIALBLANKS+N;
+ INITIALBLANKS:=N >> >>;
+ STACK := (NEWFRAME N) . STACK;
+ PUTCH ('LPAR . TOP());
+ CX:=CAR X;
+ PRINDENT(CX,N+1);
+ IF IDP CX AND NOT ATOM CDR X THEN
+ CX:=GET(CX,'PPFORMAT) ELSE CX:=NIL;
+ IF CX=2 AND ATOM CDDR X THEN CX:=NIL;
+ IF CX='PROG THEN <<
+ PUTCH '! ;
+ PRINDENT(CAR (X:=CDR X),N+3) >>;
+% CX NOW CONTROLS THE FORMATTING OF WHAT FOLLOWS:
+% NIL DEFAULT ACTION
+% <NUMBER> FIRST FEW BLANKS ARE NON-INDENTING
+% PROG DISPLAY ATOMS AS LABELS;
+ X:=CDR X;
+
+ SCAN: IF ATOM X THEN GO TO OUTL;
+ FINISHPENDING(); %ABOUT TO PRINT A BLANK;
+ IF CX='PROG THEN <<
+ PUTBLANK();
+ OVERFLOW BUFFERI; %FORCE FORMAT FOR PROG;
+ IF ATOM CAR X THEN << % A LABEL;
+ LMAR:=INITIALBLANKS:=MAX(LMAR-6,0);
+ PRINDENT(CAR X,N-3); % PRINT THE LABEL;
+ X:=CDR X;
+ IF NOT ATOM X AND ATOM CAR X THEN GO TO SCAN;
+ IF LMAR+BN>N THEN PUTBLANK()
+ ELSE FOR I:=LMAR+BN:N-1 DO PUTCH '! ;
+ IF ATOM X THEN GO TO OUTL >> >>
+ ELSE IF NUMBERP CX THEN <<
+ CX:=CX-1;
+ IF CX=0 THEN CX:=NIL;
+ PUTCH '! >>
+ ELSE PUTBLANK();
+ PRINDENT(CAR X,N+3);
+ X:=CDR X;
+ GO TO SCAN;
+
+ OUTL: IF NOT NULL X THEN <<
+ FINISHPENDING();
+ PUTBLANK();
+ PUTCH '!.;
+ PUTCH '! ;
+ PRINDENT(X,N+5) >>;
+ PUTCH ('RPAR . (N-3));
+ IF INDENTING TOP()='INDENT AND NOT NULL BLANKLIST TOP() THEN
+ OVERFLOW CAR BLANKLIST TOP()
+ ELSE ENDLIST TOP();
+ STACK:=CDR STACK
+ END;
+
+SYMBOLIC PROCEDURE EXPLODES X;
+ %dummy function just in case another format is needed;
+ EXPLODE X;
+
+SYMBOLIC PROCEDURE PRVECTOR(X,N);
+ BEGIN
+ SCALAR BOUND;
+ BOUND:=UPBV X; % LENGTH OF THE VECTOR;
+ STACK:=(NEWFRAME N) . STACK;
+ PUTCH ('LSQUARE . TOP());
+ PRINDENT(GETV(X,0),N+3);
+ FOR I:=1:BOUND DO <<
+% PUTCH '!,; % removed "," between vector elements for PSL
+ PUTBLANK();
+ PRINDENT(GETV(X,I),N+3) >>;
+ PUTCH('RSQUARE . (N-3));
+ ENDLIST TOP();
+ STACK:=CDR STACK
+ END;
+
+SYMBOLIC PROCEDURE PUTBLANK();
+ BEGIN
+ SCALAR B;
+ PUTCH TOP(); %REPRESENTS A BLANK CHARACTER;
+ SETBLANKCOUNT(TOP(),BLANKCOUNT TOP()+1);
+ SETBLANKLIST(TOP(),BUFFERI . BLANKLIST TOP());
+ %REMEMBER WHERE I WAS;
+ INDBLANKS:=INDBLANKS+1
+ END;
+
+
+
+
+SYMBOLIC PROCEDURE ENDLIST L;
+%FIX UP THE BLANKS IN A COMPLETE LIST SO THAT THEY
+%WILL NOT BE TURNED INTO INDENTATIONS;
+ PENDINGRPARS:=L . PENDINGRPARS;
+
+% WHEN I HAVE PRINTED A ')' I WANT TO MARK ALL OF THE BLANKS
+% WITHIN THE PARENTHESES AS BEING UNINDENTED, ORDINARY BLANK
+% CHARACTERS. IT IS HOWEVER POSSIBLE THAT I MAY GET A BUFFER
+% OVERFLOW WHILE PRINTING A STRING OF )))))))))), AND SO THIS
+% MARKING SHOULD BE DELAYED UNTIL I GET ROUND TO PRINTING
+% A FURTHER BLANK (WHICH WILL BE A CANDIDATE FOR A PLACE TO
+% SPLIT LINES). THIS DELAY IS DEALT WITH BY THE LIST
+% PENDINGRPARS WHICH HOLDS A LIST OF LEVELS THAT, WHEN
+% CONVENIENT, CAN BE TIDIED UP AND CLOSED OUT;
+
+SYMBOLIC PROCEDURE FINISHPENDING();
+ << FOR EACH STACKFRAME IN PENDINGRPARS DO <<
+ IF INDENTING STACKFRAME NEQ 'INDENT THEN
+ FOR EACH B IN BLANKLIST STACKFRAME DO
+ << RPLACA(B,'! ); INDBLANKS:=INDBLANKS-1 >>;
+% BLANKLIST OF STACKFRAME MUST BE NON-NIL SO THAT OVERFLOW
+% WILL NOT TREAT THE '(' SPECIALLY;
+ SETBLANKLIST(STACKFRAME,T) >>;
+ PENDINGRPARS:=NIL >>;
+
+
+
+SYMBOLIC PROCEDURE READMACROP X;
+ !*QUOTES AND
+ NOT ATOM X AND
+ IDP CAR X AND
+ GET(CAR X,'READMACROTOKEN) AND
+ NOT ATOM CDR X AND
+ NULL CDDR X;
+
+DEFLIST('(
+ (QUOTE (!'))
+ (BACKQUOTE (!`))
+ (UNQUOTE (!,))
+ (UNQUOTEL (!, !@))
+ (UNQUOTED (!, !.))),
+ 'READMACROTOKEN);
+
+FOR EACH U IN '(QUOTE BACKQUOTE UNQUOTE) DO PUT(U,'READMACROSIZE,1);
+
+FOR EACH U IN '(UNQUOTEL UNQUOTED) DO PUT(U,'READMACROSIZE,2);
+
+% PROPERTY PPFORMAT DRIVES THE PRETTYPRINTER -
+% PROG : SPECIAL FOR PROG ONLY
+% 1 : (FN A1
+% A2
+% ... )
+% 2 : (FN A1 A2
+% A3
+% ... ) ;
+
+PUT('PROG,'PPFORMAT,'PROG);
+PUT('LAMBDA,'PPFORMAT,1);
+PUT('LAMBDAQ,'PPFORMAT,1);
+PUT('SETQ,'PPFORMAT,1);
+PUT('SET,'PPFORMAT,1);
+PUT('WHILE,'PPFORMAT,1);
+PUT('T,'PPFORMAT,1);
+PUT('DE,'PPFORMAT,2);
+PUT('DF,'PPFORMAT,2);
+PUT('DM,'PPFORMAT,2);
+PUT('FOREACH,'PPFORMAT,4); % (FOREACH X IN Y DO ...) ETC;
+
+
+% NOW FOR THE ROUTINES THAT BUFFER THINGS ON A CHARACTER BY CHARACTER
+% BASIS, AND DEAL WITH BUFFER OVERFLOW;
+
+
+SYMBOLIC PROCEDURE PUTCH C;
+ BEGIN
+ IF ATOM C THEN RPARCOUNT:=0
+ ELSE IF BLANKP C THEN << RPARCOUNT:=0; GO TO NOCHECK >>
+ ELSE IF CAR C='RPAR THEN <<
+ RPARCOUNT:=RPARCOUNT+1;
+% FORMAT FOR A LONG STRING OF RPARS IS:
+% )))) ))) ))) ))) ))) ;
+ IF RPARCOUNT>4 THEN << PUTCH '! ; RPARCOUNT:=2 >> >>
+ ELSE RPARCOUNT:=0;
+ WHILE LMAR+BN>=RMAR DO OVERFLOW 'MORE;
+NOCHECK:
+ BUFFERI:=CDR RPLACD(BUFFERI,LIST C);
+ BN:=BN+1
+ END;
+
+SYMBOLIC PROCEDURE OVERFLOW FLG;
+ BEGIN
+ SCALAR C,BLANKSTOSKIP;
+%THE CURRENT BUFFER HOLDS SO MUCH INFORMATION THAT IT WILL
+%NOT ALL FIT ON A LINE. TRY TO DO SOMETHING ABOUT IT;
+% FLG IS ONE OF:
+% 'NONE DO NOT FORCE MORE INDENTATION
+% 'MORE FORCE ONE LEVEL MORE INDENTATION
+% <A POINTER INTO THE BUFFER>
+% PRINTS UP TO AND INCLUDING THAT CHARACTER, WHICH
+% SHOULD BE A BLANK;
+ IF INDBLANKS=0 AND INITIALBLANKS>3 AND FLG='MORE THEN <<
+ INITIALBLANKS:=INITIALBLANKS-3;
+ LMAR:=LMAR-3;
+ RETURN 'MOVED!-LEFT >>;
+FBLANK:
+ IF BN=0 THEN <<
+%NO BLANK FOUND - CAN DO NO MORE FOR NOW;
+% IF FLG='MORE I AM IN TROUBLE AND SO HAVE TO PRINT
+% A CONTINUATION MARK. IN THE OTHER CASES I CAN JUST EXIT;
+ IF NOT(FLG = 'MORE) THEN RETURN 'EMPTY;
+ IF ATOM CAR BUFFERO THEN
+% CONTINUATION MARK NOT NEEDED IF LAST CHAR PRINTED WAS
+% SPECIAL (E.G. LPAR OR RPAR);
+ PRIN2 "%+"; %CONTINUATION MARKER;
+ TERPRI();
+ LMAR:=0;
+ RETURN 'CONTINUED >>
+ ELSE <<
+ SPACES INITIALBLANKS;
+ INITIALBLANKS:=0 >>;
+ BUFFERO:=CDR BUFFERO;
+ BN:=BN-1;
+ LMAR:=LMAR+1;
+ C:=CAR BUFFERO;
+ IF ATOM C THEN << PRINC C; GO TO FBLANK >>
+ ELSE IF BLANKP C THEN IF NOT ATOM BLANKSTOSKIP THEN <<
+ PRINC '! ;
+ INDBLANKS:=INDBLANKS-1;
+% BLANKSTOSKIP = (STACK-FRAME . SKIP-COUNT);
+ IF C EQ CAR BLANKSTOSKIP THEN <<
+ RPLACD(BLANKSTOSKIP,CDR BLANKSTOSKIP-1);
+ IF CDR BLANKSTOSKIP=0 THEN BLANKSTOSKIP:=T >>;
+ GO TO FBLANK >>
+ ELSE GO TO BLANKFOUND
+ ELSE IF CAR C='LPAR OR CAR C='LSQUARE THEN <<
+ PRINC GET(CAR C,'PPCHAR);
+ IF FLG='NONE THEN GO TO FBLANK;
+% NOW I WANT TO FLAG THIS LEVEL FOR INDENTATION;
+ C:=CDR C; %THE STACK FRAME;
+ IF NOT NULL BLANKLIST C THEN GO TO FBLANK;
+ IF DEPTH C>INDENTLEVEL THEN << %NEW INDENTATION;
+% THIS LEVEL HAS NOT EMITTED ANY BLANKS YET;
+ INDENTLEVEL:=DEPTH C;
+ SETINDENTING(C,'INDENT) >>;
+ GO TO FBLANK >>
+ ELSE IF CAR C='RPAR OR CAR C='RSQUARE THEN <<
+ IF CDR C<INDENTLEVEL THEN INDENTLEVEL:=CDR C;
+ PRINC GET(CAR C,'PPCHAR);
+ GO TO FBLANK >>
+ ELSE ERROR(0,LIST(C,"UNKNOWN TAG IN OVERFLOW"));
+
+BLANKFOUND:
+ IF EQCAR(BLANKLIST C,BUFFERO) THEN
+ SETBLANKLIST(C,NIL);
+% AT LEAST ONE ENTRY ON BLANKLIST OUGHT TO BE VALID, SO IF I
+% PRINT THE LAST BLANK I MUST KILL BLANKLIST TOTALLY;
+ INDBLANKS:=INDBLANKS-1;
+% CHECK IF NEXT LEVEL REPRESENTS NEW INDENTATION;
+ IF DEPTH C>INDENTLEVEL THEN <<
+ IF FLG='NONE THEN << %JUST PRINT AN ORDINARY BLANK;
+ PRINC '! ;
+ GO TO FBLANK >>;
+% HERE I INCREASE THE INDENTATION LEVEL BY ONE;
+ IF BLANKSTOSKIP THEN BLANKSTOSKIP:=NIL
+ ELSE <<
+ INDENTLEVEL:=DEPTH C;
+ SETINDENTING(C,'INDENT) >> >>;
+%OTHERWISE I WAS INDENTING AT THAT LEVEL ANYWAY;
+ IF BLANKCOUNT C>(THIN!*-1) THEN << %LONG THIN LIST FIX-UP HERE;
+ BLANKSTOSKIP:=C . ((BLANKCOUNT C) - 2);
+ SETINDENTING(C,'THIN);
+ SETBLANKCOUNT(C,1);
+ INDENTLEVEL:=(DEPTH C)-1;
+ PRINC '! ;
+ GO TO FBLANK >>;
+ SETBLANKCOUNT(C,BLANKCOUNT C-1);
+ TERPRI();
+ LMAR:=INITIALBLANKS:=DEPTH C;
+ IF BUFFERO EQ FLG THEN RETURN 'TO!-FLG;
+ IF BLANKSTOSKIP OR NOT (FLG='MORE) THEN GO TO FBLANK;
+% KEEP GOING UNLESS CALL WAS OF TYPE 'MORE';
+ RETURN 'MORE; %TRY SOME MORE;
+ END;
+
+PUT('LPAR,'PPCHAR,'!();
+PUT('LSQUARE,'PPCHAR,'![);
+PUT('RPAR,'PPCHAR,'!));
+PUT('RSQUARE,'PPCHAR,'!]);
+
ADDED psl-1983/3-1/util/printer-fix.build
Index: psl-1983/3-1/util/printer-fix.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/printer-fix.build
@@ -0,0 +1,1 @@
+in "printer-fix.red"$
ADDED psl-1983/3-1/util/printer-fix.red
Index: psl-1983/3-1/util/printer-fix.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/printer-fix.red
@@ -0,0 +1,56 @@
+% Some patches to I/O modules
+
+Fluid '(DigitStrBase);
+DigitStrBase:='"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
+
+on syslisp;
+
+smacro procedure DigitStr();
+ strinf LispVar DigitstrBase;
+
+syslsp procedure SysPowerOf2P Num;
+ case Num of
+ 1: 0;
+ 2: 1;
+ 4: 2;
+ 8: 3;
+ 16: 4;
+ 32: 5;
+ default: NIL
+ end;
+
+
+syslsp procedure ChannelWriteSysInteger(Channel, Number, Radix);
+begin scalar Exponent,N1;
+ return if (Exponent := SysPowerOf2P Radix) then
+ ChannelWriteBitString(Channel, Number, Radix - 1, Exponent)
+ else if Number < 0 then
+ << ChannelWriteChar(Channel, char '!-);
+ WriteNumber1(Channel,-(Number/Radix),Radix); % To catch largest NEG
+ ChannelWriteChar(Channel, strbyt(DigitStr(), - MOD(Number, Radix))) >>
+ else if Number = 0 then ChannelWriteChar(Channel, char !0)
+ else WriteNumber1(Channel, Number, Radix);
+end;
+
+syslsp procedure WriteNumber1(Channel, Number, Radix);
+ if Number = 0 then Channel
+ else
+ << WriteNumber1(Channel, Number / Radix, Radix);
+ ChannelWriteChar(Channel,
+ strbyt(Digitstr(), MOD(Number, Radix))) >>;
+
+
+syslsp procedure ChannelWriteBitString(Channel, Number, DigitMask, Exponent);
+ if Number = 0 then ChannelWriteChar(Channel,char !0)
+ else ChannelWriteBitStrAux(Channel, Number, DigitMask, Exponent);
+
+syslsp procedure ChannelWriteBitStrAux(Channel, Number, DigitMask, Exponent);
+ if Number = 0 then Channel % Channel means nothing here
+ else % just trying to fool the compiler
+ << ChannelWriteBitStrAux(Channel,
+ LSH(Number, -Exponent),
+ DigitMask,
+ Exponent);
+ ChannelWriteChar(Channel,
+ StrByt(DigitStr(),
+ LAND(Number, DigitMask))) >>;
ADDED psl-1983/3-1/util/prlisp-driver.red
Index: psl-1983/3-1/util/prlisp-driver.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/prlisp-driver.red
@@ -0,0 +1,578 @@
+%. PRLISP-DRIVER.RED Terminal/Graphics Drivers for PRLISP
+%. Date: ~December 1981
+%. Authors: M.L. Griss, F. Chen, P. Stay
+%. Utah Computation Group
+%. Department of Computer Science
+%. University of Utah, Salt Lake City.
+%. Copyright (C) University of Utah 1982
+
+% Also, need either EMODE or RAWIO files for EchoON/EchoOff
+
+% Note that under EMODE (!*EMODE= T), EchoOn and EchoOff
+% Already Done, so GraphOn and GraphOff need to test !*EMODE
+
+% csp 7/13/82
+% Change to only set !*EMODE to NIL if it is unbound.
+
+FLUID '(!*EMODE);
+% initialize emode to off
+loadtime <<if UnboundP '!*EMODE then !*EMODE:=NIL;>>;
+
+
+ %***************************
+ % setup functions for *
+ % terminal devices *
+ %***************************
+
+FLUID '(!*UserMode);
+
+Procedure FNCOPY(NewName,OldName)$ %. to copy equivalent
+ Begin scalar !*UserMode;
+ CopyD(NewName,OldName);
+ end;
+
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % hp specific Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure HP!.OutChar x; % Raw Terminal I/O
+ Pbout x;
+
+Procedure HP!.OutCharString S; % Pbout a string
+ For i:=0:Size S do HP!.OutChar S[i];
+
+Procedure HP!.grcmd (acmd)$ %. prefix to graphic command
+<<HP!.OutChar char ESC$
+ HP!.OutChar char !*$
+ HP!.OutCharString ACMD$
+ DELAY() >>$
+
+
+Procedure HP!.OutInt X; % Pbout a integer
+ <<HP!.OutChar (char !0 + (X/100));
+ X:=Remainder(x,100);
+ HP!.OutChar (char !0 + (x/10));
+ HP!.OutChar (char !0+Remainder(x,10));
+ nil>>;
+
+Procedure HP!.Delay$ %. Delay to wait for the display
+ HP!.OutChar CHAR EOL; % Flush buffer
+
+Procedure HP!.EraseS()$ %. EraseS graphic diaplay screen
+<<HP!.GRCMD("dack")$
+ MOVETOPOINT ORIGIN >>$
+
+Procedure HP!.NormX XX$ %. absolute position along
+ FIX(XX+0.5)+360$ % X axis
+
+Procedure HP!.NormY YY$ %. absolute position along
+ FIX(YY+0.5)+180$ % Y axis.
+
+Procedure HP!.MoveS (XDEST,YDEST)$ %. move pen to absolute location
+<< HP!.GRCMD("d")$
+ X := HP!.NormX XDEST$
+ Y := HP!.NormY YDEST$
+ HP!.OutInt HP!.NormX XDEST$
+ HP!.OutChar Char '!,$
+ HP!.OutInt HP!.NormY YDEST$
+ HP!.OutCharString "oZ"$
+ HP!.GRCMD("pacZ") >>$
+
+Procedure HP!.DrawS (XDEST,YDEST)$ %. MoveS pen to the pen position
+ <<HP!.GRCMD("d")$
+ X := HP!.NormX XDEST$ %. destination and draw a
+ Y := HP!.NormY YDEST$
+ HP!.OutInt HP!.NormX XDEST$ %. line to it rom previous
+ HP!.OutChar Char '!,$ %. pen position.
+ HP!.OutInt HP!.NormY YDEST$
+ HP!.OutCharString "oZ"$
+ HP!.GRCMD("pbcZ")$'NIL>>$
+
+Procedure HP!.CRSRWT()$ %. waiting for input a
+Begin scalar P,C1,C2,a$ %. character to position
+ HP!.GRCMD("s4^")$ %. a cursor.
+ C1:= READ()$
+ C2:= READ()$
+ a := READ()$
+ P := LIST ('POINT,C1-360,C2-180,HEREPOINT[3])$
+ HP!.GRCMD("dkZ")$
+ Return a.P$
+ end$
+
+Procedure HP!.BUILDP()$ %. builds a list of
+Begin scalar PNTLST,UNFINISHED,PNT,PNT2,ACT,GRP, %. points from cursor
+ PRVPNT,RAD$ %. MoveS.
+ UNFINISHED := 'T$
+ PNTLST := LIST(HERE,'POINTSET)$
+ GRP := LIST('GROUP)$
+ While UNFINISHED do
+ <<UNFINISHED := HP!.CRSRWT()$
+ HP!.OutInt UNFINISHED$
+ ACT := CAR1 UNFINISHED$
+ PNT := PRLISPCDR UNFINISHED$
+ HP!.OutInt PNT$HP!.OutInt ACT$
+
+ If ACT = 32 then % draw : using "space-bar"
+ <<DrawModel PNT$ % key.
+ PNTLST :=PNT . PNTLST>>
+
+ else If ACT = 127 then % move : using "del" key.
+ <<MOVEPOINT (PRLISPCDR PNT)$
+ PNTLST := REVERSE PNTLST$
+ GRP := PNTLST . GRP $
+ PNTLST := LIST (PNT,'POINTSET)>>
+
+ else If ACT = 67 then % draw circle around center
+ <<PNT2 := POINT % passing through cursor
+ (NILTOZERO CAR2 PNT, % using "uppercase c" key.
+ NILTOZERO CAR3 PNT)$
+ RAD := DISTANCE(CCNTR, PNT2)$
+ DRAWCIRCLE(LIST RAD)$
+ PNT := LIST('CIRCLE,RAD)$
+ PNTLST := PNT . PNTLST >>
+
+ else If ACT = 99 then % sets circle center :
+ <<MOVEPOINT (PRLISPCDR PNT)$ % using "lowercase c" key.
+ SETCENTER LIST PNT$
+ PNTLST := LIST('CENTER,PNT) . PNTLST >>
+
+
+ else If ACT = 13 then % finish : using "Return"
+ <<UNFINISHED := NIL$ % key.
+ GRP := REVERSE PNTLST . GRP >>
+ >>$
+ Return REVERSE GRP$
+end$
+
+Procedure HP!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport
+<< X1CLIP := MAX2 (-360,X1)$ %. for HP2648A terminal.
+ X2CLIP := MIN2 (360,X2)$
+ Y1CLIP := MAX2 (-180,Y1)$
+ Y2CLIP := MIN2 (180,Y2) >>$
+
+Procedure HP!.GRAPHON(); %. No special GraphOn/GraphOff
+ If not !*emode then echooff();
+
+Procedure HP!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure HP!.INIT$ %. HP device specIfic
+Begin %. Procedures equivalent.
+ PRINT "HP IS DEVICE"$
+ DEV!. := 'HP;
+ FNCOPY( 'EraseS, 'HP!.EraseS)$ % should be called as for
+ FNCOPY( 'NormX, 'HP!.NormX)$ % initialization when
+ FNCOPY( 'NormY, 'HP!.NormY)$ % using HP2648A.
+ FNCOPY( 'MoveS, 'HP!.MoveS)$
+ FNCOPY( 'DrawS, 'HP!.DrawS)$
+ FNCOPY( 'CRSRWT, 'HP!.CRSRWT)$
+ FNCOPY( 'VWPORT, 'HP!.VWPORT)$
+ FNCOPY( 'Delay, 'HP!.Delay)$
+ FNCOPY( 'GraphOn, 'HP!.GraphOn)$
+ FNCOPY( 'GraphOff, 'HP!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % TEKTRONIX specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+Procedure TEK!.OutChar x;
+ Pbout x;
+
+Procedure TEK!.EraseS(); %. EraseS screen, Returns terminal
+ <<TEK!.OutChar Char ESC; %. to Alpha mode and places cursor.
+ TEK!.OutChar Char FF>>;
+
+Procedure TEK!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< TEK!.OutChar HIGHERY NormY YDEST$ %. information to the
+ TEK!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ TEK!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ TEK!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+
+Procedure HIGHERY YDEST$ %. convert Y to higher order Y.
+FIX(YDEST) / 32 + 32$
+
+Procedure LOWERY YDEST$ %. convert Y to lower order Y.
+ REMAINDER (FIX YDEST,32) + 96$
+
+
+Procedure HIGHERX XDEST$ %. convert X to higher order X.
+ FIX(XDEST) / 32 + 32$
+
+Procedure LOWERX XDEST$ %. convert X to lower order X.
+ REMAINDER (FIX XDEST,32) + 64$
+
+
+Procedure TEK!.MoveS(XDEST,YDEST)$
+ <<TEK!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ TEK!.4BYTES (XDEST,YDEST)$
+ TEK!.OutChar 31>> $ %. US: sets terminal to Alpha mode.
+
+Procedure TEK!.DrawS (XDEST,YDEST)$ %. Same as Tek!.MoveS but
+<< TEK!.OutChar 29$ %. draw the line.
+ TEK!.4BYTES (CAR2 HERE, CAR3 HERE)$
+ TEK!.4BYTES (XDEST, YDEST)$
+ TEK!.OutChar 31>> $
+
+Procedure TEK!.NormX DESTX$ %. absolute location along
+ DESTX + 512$ %. X axis.
+
+Procedure TEK!.NormY DESTY$ %. absolute location along
+ DESTY + 390$ %. Y axis.
+
+Procedure TEK!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-512,X1)$ %. Tektronix 4006-1.
+ X2CLIP := MIN2 (512,X2)$
+ Y1CLIP := MAX2 (-390,Y1)$
+ Y2CLIP := MIN2 (390,Y2) >>$
+
+Procedure TEK!.Delay();
+ NIL;
+
+Procedure TEK!.GRAPHON(); %. No special GraphOn (? what of GS/US)
+If not !*emode then echooff();
+
+Procedure TEK!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure TEK!.INIT$ %. TEKTRONIX device specIfic
+Begin %. Procedures equivalent.
+ PRINT "TEKTRONIX IS DEVICE"$
+ DEV!. := ' TEK;
+ FNCOPY( 'EraseS, 'TEK!.EraseS)$ % should be called as for
+ FNCOPY( 'NormX, 'TEK!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'TEK!.NormY)$ % Tektronix 4006-1.
+ FNCOPY( 'MoveS, 'TEK!.MoveS)$
+ FNCOPY( 'DrawS, 'TEK!.DrawS)$
+ FNCOPY( 'VWPORT, 'TEK!.VWPORT)$
+ FNCOPY( 'Delay, 'TEK!.Delay)$
+ FNCOPY( 'GraphOn, 'TEK!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEK!.GraphOff)$
+ Erase()$
+ VWPORT(-800,800,-800,800)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ % TELERAY specIfic Procedures %
+ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Basic Teleray 1061 Plotter
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-12,12) := (Top . . Bottom)
+
+Procedure TEL!.OutChar x;
+ PBOUT x;
+
+Procedure TEL!.OutCharString S; % Pbout a string
+ For i:=0:Size S do TEL!.OutChar S[i];
+
+Procedure TEL!.NormX X;
+ FIX(X)+40;
+
+Procedure TEL!.NormY Y;
+ FIX(Y)+12;
+
+Procedure TEL!.ChPrt(X,Y,Ch);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutChar Ch>>;
+
+Procedure TEL!.IdPrt(X,Y,Id);
+ TEL!.ChPrt(X,Y,ID2Int ID);
+
+Procedure TEL!.StrPrt (X,Y,S);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutCharString S>>;
+
+Procedure TEL!.HOME (); % Home (0,0)
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar 'H>>;
+
+Procedure TEL!.EraseS (); % Delete Entire Screen
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar '!j>>;
+
+Procedure TEL!.DDA (X1,Y1,X2,Y2,dotter);
+ Begin scalar Dx,Dy,Xc,Yc,I,R,S;
+ % From N & S, Page 44, Draw Straight Pointset
+ Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
+ If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
+ If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
+ If Dx <= Dy then Goto doy;
+ S := FLOAT(Dy)/Dx;
+ For I := 1:Dx do
+ <<R := R+S;
+ If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
+ X1 := X1+Xc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL;
+ doy:S := float(Dx) / Dy;
+ For I := 1:Dy do
+ <<R := R+S;
+ If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
+ Y1 := Y1+Yc;
+ APPLY(dotter,LIST (X1,Y1)) >>;
+ Return NIL
+ end;
+
+Procedure Tel!.MoveS (X1,Y1);
+ <<Xhere := X1;
+ Yhere := Y1>>;
+
+Procedure Tel!.DrawS (X1,Y1);
+ << TEL!.DDA (Xhere,Yhere, X1, Y1,function dotc);
+ Xhere :=X1; Yhere :=Y1>>;
+
+Procedure Idl2chl (X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp (X) do <<Y := getv (Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return (Reverse (Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter (X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl (Explode2 (Txt));
+ Return (TEL!.DDA (X1,Y1,X2,Y2,function Tdotc))
+ end;
+
+Procedure Tdotc (X1,Y1);
+ Begin
+ If Null Tchars then Return (Nil);
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return ('T)
+ end;
+
+Procedure dotc (X1,Y1); % Draw And Clip An X
+ TEL!.ChClip (X1,Y1,Char X) ;
+
+Procedure TEL!.ChClip (X1,Y1,Id);
+ Begin
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Id);
+ No:Return ('T)
+ end;
+
+Procedure Tel!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2 (-40,X1);
+ X2clip := Min2 (40,X2);
+ Y1clip := Max2 (-12,Y1);
+ Y2clip := Min2 (12,Y2)>>;
+
+Procedure Tel!.Wfill (X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do TEL!.ChClip (X,Y,Id);
+ end;
+
+Procedure TEL!.Wzap (X1,X2,Y1,Y2);
+ TEL!.Wfill (X1,X2,Y1,Y2,'! ) ;
+
+Procedure TEL!.Delay;
+ NIL;
+
+Procedure TEL!.GRAPHON();
+If not !*emode then echooff();
+
+Procedure TEL!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure TEL!.INIT (); % Setup For TEL As Device;
+ Begin
+ Dev!. := 'TEL;
+ FNCOPY('EraseS,'TEL!.EraseS);
+ FNCOPY('MoveS,'TEL!.MoveS);
+ FNCOPY('DrawS,'TEL!.DrawS);
+ FNCOPY( 'NormX, 'TEL!.NormX)$
+ FNCOPY( 'NormY, 'TEL!.NormY)$
+ FNCOPY('VwPort,'TEL!.VwPort);
+ FNCOPY('Delay,'TEL!.Delay);
+ FNCOPY( 'GraphOn, 'TEL!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEL!.GraphOff)$
+ Erase();
+ VwPort (-40,40,-12,12);
+ Print "Device Now TEL";
+ end;
+
+ %**********************************
+ % MPS device routines will only *
+ % work If the MPS C library is *
+ % resident in the system *
+ % contact Paul Stay or Russ Fish *
+ % University of Utah *
+ %**********************************
+
+
+Procedure MPS!.DrawS (XDEST, YDEST);
+<<
+ X := XDEST;
+ Y := YDEST;
+ PSdraw2d(LIST(X,Y) ,DDDD,ABS,0,1); %draw a line from cursor
+ 0; %do x and y coordinates
+>>;
+
+Procedure MPS!.MoveS (XDEST, YDEST);
+<<
+ X := XDEST;
+ Y := YDEST;
+ PSdraw2d( LIST(X,Y) , MDDD,ABS,0,1); %move to point x,y
+ 0;
+>>;
+
+Procedure MPS!.Delay(); % no Delay function for mps
+ NIL;
+
+Procedure MPS!.EraseS(); % setdisplay list to nil
+ DISPLAY!.LIST := NIL$
+
+Procedure MPS!.VWPORT( X1, X2, Y1, Y2); %set up viewport
+<<
+ PSsetscale(300); %set up scale factor
+ X1CLIP := MAX2(-500, X1);
+ X2CLIP := MIN2(500, X2);
+ Y1CLIP := MAX2(-500, Y1);
+ Y2CLIP := MIN2(500, Y2);
+>>;
+
+Procedure MPS!.GRAPHON(); % Check this
+If not !*emode then echooff();
+
+Procedure MPS!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure MPS!.INIT$
+<<
+ PRINT "MPS IS DISPLAY DEVICE";
+ DEV!. := 'MPS;
+ FNCOPY ( 'EraseS, 'MPS!.ERASE)$
+% Add NORM functions
+ FNCOPY ( 'MoveS, 'MPS!.MoveS)$
+ FNCOPY ( 'DrawS, 'MPS!.DrawS)$
+ FNCOPY ( 'VWPORT, 'MPS!.VWPORT)$
+ FNCOPY ( 'Delay, 'MPS!.Delay)$
+ FNCOPY( 'GraphOn, 'MPS!.GraphOn)$
+ FNCOPY( 'GraphOff, 'MPS!.GraphOff)$
+ PSINIT(1,0); % initialize device
+ ERASE();
+ MPS!.VWPORT(-500,500,-500,500); % setup viewport
+ Psscale(1,1,1,500); % setup scale hardware
+ GLOBAL!.TRANSFORM := WINdoW(-300,60);
+>>;
+
+ %***************************************
+ % Apollo terminal driver and functions *
+ %***************************************
+
+Procedure ST!.OutChar x; % use Pbout instead
+ PBOUT x;
+
+Procedure ST!.EraseS(); % erase screen
+<< ST!.OutChar 27;
+ ST!.OutChar 12>>;
+
+Procedure ST!.GraphOn();
+<< If Not !*Emode Then EchoOff();
+ If !*emode then ST!.OutChar 29>>$ % Should be same for TEK
+
+Procedure ST!.GraphOff();
+<< If Not !*Emode Then EchoOn();
+ If !*emode then ST!.OutChar 31>>$ % Maybe mixed VT-52/tek problem
+
+
+Procedure ST!.MoveS(XDEST,YDEST)$
+<< ST!.OutChar 29 $ %. GS: sets terminal to Graphic mode.
+ ST!.4BYTES (XDEST,YDEST)$ %. US: sets terminal to Alpha mode.
+ If not !*emode then ST!.OutChar 31>>$
+
+Procedure ST!.DrawS (XDEST,YDEST)$ %. Same as MoveS but
+<< If not !*emode then << ST!.OutChar 29$
+ ST!.4bytes(car2 here, car3 here)>>$
+ ST!.4BYTES (XDEST, YDEST)$ %. draw the line.
+ If not !*emode then ST!.OutChar 31 >>$
+
+Procedure PRLISP();
+ <<PRIN2T "Set Up for Apollo under EMODE";
+ !*Emode:=T;
+ ST!.INIT()>>;
+
+Procedure ST!.4BYTES (XDEST, YDEST)$ %. Convert graphic plot
+<< ST!.OutChar HIGHERY NormY YDEST$ %. information to the
+ ST!.OutChar LOWERY NormY YDEST$ %. terminal in a 4 byte
+ ST!.OutChar HIGHERX NormX XDEST$ %. sequences containing the
+ ST!.OutChar LOWERX NormX XDEST >>$ %. High and Low order Y
+ %. informationand High and
+ %. Low order X information.
+Procedure ST!.Delay();
+ NIL;
+
+Procedure ST!.NormX DESTX$ %. absolute location along
+ DESTX + 400$ %. X axis.
+
+Procedure ST!.NormY DESTY$ %. absolute location along
+ DESTY + 300$ %. Y axis.
+
+Procedure ST!.VWPORT(X1,X2,Y1,Y2)$ %. set the viewport for
+ << X1CLIP := MAX2 (-400,X1)$ %. Tektronix 4006-1.
+ X2CLIP := MIN2 (400,X2)$
+ Y1CLIP := MAX2 (-300,Y1)$
+ Y2CLIP := MIN2 (300,Y2) >>$
+
+Procedure ST!.INIT$ %. JW's fake TEKTRONIX
+Begin %. Procedures equivalent.
+ PRINT "Apollo/ST is device"$
+ DEV!. := 'Apollo;
+ FNCOPY( 'EraseS, 'ST!.EraseS)$ % should be called as for
+ FNCOPY( 'NormX, 'ST!.NormX)$ % initialization when using
+ FNCOPY( 'NormY, 'ST!.NormY)$ % APOtronix 4006-1.
+ FNCOPY( 'MoveS, 'ST!.MoveS)$
+ FNCOPY( 'DrawS, 'ST!.DrawS)$
+ FNCOPY( 'VWPORT, 'ST!.VWPORT)$
+ FNCOPY( 'Delay, 'ST!.Delay)$
+ FNCOPY( 'GraphOn, 'ST!.GraphOn);
+ FNCOPY( 'GraphOff, 'ST!.GraphOff);
+ Erase()$
+ VWPORT(-400,400,-300,300)$
+ GLOBAL!.TRANSFORM := WINdoW(-300,60)
+end$
+
+
+% --------- OTHER UTILITIES ------------
+
+Procedure SAVEPICT (FIL,PICT,NAM)$ %. save a picture with no
+Begin scalar OLD; %. vectors.
+ FIL := OPEN (FIL,'OUTPUT)$ % fil : list('dir,file.ext)
+ OLD := WRS FIL$ % nam : id
+ PRIN2 NAM$ PRIN2 '! !:!=! !'$ PRIN2 PICT$ % pict: name of pict to
+ PRIN2 '!;$ WRS 'NIL$ CLOSE FIL$ % be saved.
+ Return PICT$
+ % fil: file name to save
+ % "pict".
+end$ % nam: name to be used
+ % after TAILore.
+ % type "in fil" to TAILore
+ % old picture.
+
+
+
+
+
+
+
ADDED psl-1983/3-1/util/program-command-interpreter.sl
Index: psl-1983/3-1/util/program-command-interpreter.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/program-command-interpreter.sl
@@ -0,0 +1,84 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Program-Command-Interpreter.SL - Perform Program Command
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 10 August 1982
+% Revised: 8 December 1982
+%
+% 8-Dec-82 Alan Snyder
+% Changed use of DSKIN (now an EXPR).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This file redefines the start-up routine for PSL (Lisp Reader) to first read
+% and interpret the program command string. If the command string contains a
+% recognized command name, then the corresponding function is immediately
+% executed and the program QUITs. Otherwise, the normal top-level function
+% definition is restored and invoked as normal. Commands are defined using the
+% property PROGRAM-COMMAND (see below). This file defines only one command,
+% COMPILE, which is used to compile Lisp files (not RLisp files).
+
+(BothTimes (load common))
+(load parse-command-string get-command-string compiler)
+
+(fluid '(*usermode *redefmsg CurrentReadMacroIndicator* CurrentScanTable*))
+
+(cond ((funboundp 'original-main)
+ (copyd 'original-main 'main)))
+
+(de main ()
+ (let ((CurrentReadMacroIndicator* 'LispReadMacro) % Crock!
+ (CurrentScanTable* LispScanTable*)
+ (c-list (parse-command-string (get-command-string)))
+ (*usermode nil)
+ (*redefmsg nil))
+ (perform-program-command c-list)
+ (copyd 'main 'original-main)
+ )
+ (original-main)
+ )
+
+(de perform-program-command (c-list)
+ (if (not (Null c-list))
+ (let ((command (car c-list)))
+ (if (StringP command)
+ (let* ((command-id (intern (string-upcase command)))
+ (func (get command-id 'PROGRAM-COMMAND)))
+ (if func (apply func (list c-list))))))))
+
+(put 'COMPILE 'PROGRAM-COMMAND 'compile-program-command)
+
+(fluid '(*quiet_faslout *WritingFASLFile))
+
+(de compile-program-command (c-list)
+ (setq c-list (cdr c-list))
+ (for (in file-name-root c-list)
+ (do (let* ((form (list 'COMPILE-FILE file-name-root))
+ (*break NIL)
+ (result (ErrorSet form T NIL))
+ )
+ (if (FixP result)
+ (progn
+ (if *WritingFASLFile (faslend))
+ (printf "%n ***** Error during compilation of %w.%n"
+ file-name-root)
+ ))
+ )))
+ (quit))
+
+(de compile-file (file-name-root)
+ (let ((source-fn (string-concat file-name-root ".SL"))
+ (binary-fn (string-concat file-name-root ".B"))
+ (*quiet_faslout T)
+ )
+ (if (not (FileP source-fn))
+ (printf "Unable to open source file: %w%n" source-fn)
+ % else
+ (printf "%n----- Compiling %w%n" source-fn binary-fn)
+ (faslout file-name-root)
+ (dskin source-fn)
+ (faslend)
+ (printf "%nDone compiling %w%n%n" source-fn)
+ )))
ADDED psl-1983/3-1/util/psl-cref.red
Index: psl-1983/3-1/util/psl-cref.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/psl-cref.red
@@ -0,0 +1,714 @@
+
+% ===============================================================
+% CREF for PSL, requires GSORT and PSL-CREFIO.RED
+% Adapted from older RCREF
+% MLG, 6:28am Tuesday, 15 December 1981
+% ===============================================================
+
+% MLG 20 Dec 1982:
+% Add FOR WHILE REPEAT FOREACH to EXPAND!* list
+% Ensures that not treated as undefined functions in processing
+% May need to add some other (CATCH?)
+
+% MLG 20 Dec 1982
+% Add DS and DN as new ANLFN types, similar to DE, DF, DM etc
+
+%FLAG('(ANLFN CRFLAPO),'FTYPE); % To force PUTC
+%FLAG('(ANLFN CRFLAPO),'COMPILE);
+
+CompileTime <<
+macro procedure DefANLFN U;
+ list('put, MkQuote cadr U, ''ANLFN, list('function, 'lambda . cddr U));
+
+flag('(ANLFN), 'FType);
+put('ANLFN, 'FunctionDefiningFunction, 'DefANLFN);
+>>;
+
+GLOBAL '(UNDEFG!* GSEEN!* BTIME!*
+ EXPAND!* HAVEARGS!* NOTUSE!*
+ NOLIST!* DCLGLB!*
+ ENTPTS!* UNDEFNS!* SEEN!* TSEEN!*
+ OP!*!*
+ CLOC!* PFILES!*
+ CURLIN!* PRETITL!* !*CREFTIME
+ !*SAVEPROPS MAXARG!* !*CREFSUMMARY
+ !*RLISP !*CREF !*DEFN !*MODE
+ !*GLOBALS !*ALGEBRAICS
+ );
+
+FLUID '(GLOBS!* CALLS!* LOCLS!* TOPLV!* CURFUN!* DFPRINT!*
+ );
+
+!*ALGEBRAICS:='T; % Default is normal parse of algebraic;
+!*GLOBALS:='T; % Do analyse globals;
+!*RLISP:=NIL; % REDUCE as default;
+!*SAVEPROPS:=NIL;
+MAXARG!*:=15; % Maximum args in Standard Lisp;
+
+COMMENT EXPAND flag on these forces expansion of MACROS;
+
+EXPAND!*:='(
+WHILE FOREACH FOR REPEAT
+);
+
+SYMBOLIC PROCEDURE STANDARDFUNCTIONS L;
+ NOLIST!* := NCONC(DEFLIST(L,'ARGCOUNT),NOLIST!*);
+
+STANDARDFUNCTIONS '(
+(ABS 1) (ADD1 1) (APPEND 2) (APPLY 2) (ASSOC 2) (ATOM 1)
+(CAR 1) (CDR 1) (CAAR 1) (CADR 1) (CDAR 1) (CDDR 1)
+(CAAAR 1) (CAADR 1) (CADAR 1) (CADDR 1) (CDAAR 1) (CDADR 1)
+(CDDAR 1) (CDDDR 1)
+(CAAAAR 1) (CAAADR 1) (CAADAR 1) (CAADDR 1)
+(CADAAR 1) (CADADR 1) (CADDAR 1) (CADDDR 1)
+(CDAAAR 1) (CDAADR 1) (CDADAR 1) (CDADDR 1)
+(CDDAAR 1) (CDDADR 1) (CDDDAR 1) (CDDDDR 1)
+(CLOSE 1) (CODEP 1) (COMPRESS 1) (CONS 2) (CONSTANTP 1)
+(DE 3) (DEFLIST 2) (DELETE 2) (DF 3) (DIFFERENCE 2) (DIGIT 1)
+(DIVIDE 2) (DM 3) (DS 3) (DN 3)
+(EJECT 0) (EQ 2) (EQN 2) (EQUAL 2) (ERROR 2) (ERRORSET 3)
+(EVAL 1) (EVLIS 1) (EXPAND 2) (EXPLODE 1) (EXPT 2)
+
+(FIX 1) (FIXP 1) (FLAG 2) (FLAGP 2) (FLOAT 1) (FLOATP 1)
+(FLUID 1) (FLUIDP 1) (FUNCTION 1)
+(GENSYM 0) (GET 2) (GETD 1) (GETV 2) (GLOBAL 1)
+(GLOBALP 1) (GO 1) (GREATERP 2)
+
+(IDP 1) (INTERN 1) (LENGTH 1) (LESSP 2) (LINELENGTH 1)
+(LITER 1) (LPOSN 0)
+(MAP 2) (MAPC 2) (MAPCAN 2) (MAPCAR 2) (MAPCON 2)
+(MAPLIST 2) (MAX2 2) (MEMBER 2) (MEMQ 2)
+(MINUS 1) (MINUSP 1) (MIN2 2) (MKVECT 1) (NCONC 2) (NOT 1) (NULL 1)
+(NUMBERP 1) (ONEP 1) (OPEN 2)
+(PAGELENGTH 1) (PAIR 2) (PAIRP 1) (PLUS2 2) (POSN 0)
+(PRINC 1) (PRINT 1) (PRIN1 1) (PRIN2 1) (PROG2 2)
+(PUT 3) (PUTD 3) (PUTV 3) (QUOTE 1) (QUOTIENT 2)
+(RDS 1) (READ 0) (READCH 0) (REMAINDER 2) (REMD 1)
+(REMFLAG 2) (REMOB 1) (REMPROP 2) (RETURN 1)
+(REVERSE 1) (RPLACA 2) (RPLACD 2) (SASSOC 3) (SET 2) (SETQ 2)
+(STRINGP 1) (SUBLIS 2) (SUBST 3) (SUB1 1)
+(TERPRI 0) (TIMES2 2) (UNFLUID 1) (UPBV 1) (VECTORP 1) (WRS 1)
+(ZEROP 1)
+);
+
+NOLIST!*:=APPEND('(AND COND LIST MAX MIN OR PLUS PROG PROG2 LAMBDA
+ PROGN TIMES),NOLIST!*);
+
+FLAG ('(PLUS TIMES AND OR PROGN MAX MIN COND PROG LAMBDA
+ CASE LIST),
+ 'NARYARGS);
+
+DCLGLB!*:='(!*COMP EMSG!* !*RAISE);
+
+FLAG('(RDS DEFLIST FLAG FLUID GLOBAL REMPROP REMFLAG UNFLUID
+ SETQ CREFOFF),'EVAL);
+
+
+SYMBOLIC PROCEDURE CREFON;
+ BEGIN SCALAR A,OCRFIL,CRFIL;
+ BTIME!*:=TIME();
+ DFPRINT!* := 'REFPRINT;
+ !*DEFN := T;
+ IF NOT !*ALGEBRAICS THEN PUT('ALGEBRAIC,'NEWNAM,'SYMBOLIC);
+ FLAG(NOLIST!*,'NOLIST);
+ FLAG(EXPAND!*,'EXPAND);
+ FLAG(DCLGLB!*,'DCLGLB);
+% Global lists;
+ ENTPTS!*:=NIL; % Entry points to package;
+ UNDEFNS!*:=NIL; % Functions undefined in package;
+ SEEN!*:=NIL; % List of all encountered functions;
+ TSEEN!*:=NIL; % List of all encountered types not flagged FUNCTION;
+ GSEEN!*:=NIL; % All encountered globals;
+ PFILES!*:=NIL; % Processed files;
+ UNDEFG!*:=NIL; % Undeclared globals encountered;
+ CURLIN!*:=NIL; % Position in file(s) of current command ;
+ PRETITL!*:=NIL; % T if error or questionables found ;
+% Usages in specific function under analysis;
+ GLOBS!*:=NIL; % Globals refered to in this ;
+ CALLS!*:=NIL; % Functions called by this;
+ LOCLS!*:=NIL; % Defined local variables in this ;
+ TOPLV!*:=T; % NIL if inside function body ;
+ CURFUN!*:=NIL; % Current function beeing analysed;
+ OP!*!*:=NIL; % Current op. in LAP code;
+ SETPAGE(" Errors or questionables",NIL);
+ END;
+
+SYMBOLIC PROCEDURE UNDEFDCHK FN;
+ IF NOT FLAGP(FN,'DEFD) THEN UNDEFNS!* := FN . UNDEFNS!*;
+
+SYMBOLIC PROCEDURE PRINCNG U;
+ PRINCN GETES U;
+
+SYMBOLIC PROCEDURE CREFOFF;
+% main call, sets up, alphabetizes and prints;
+ BEGIN SCALAR TIM,X;
+ DFPRINT!* := NIL;
+ !*DEFN:=NIL;
+ IF NOT !*ALGEBRAICS
+ THEN REMPROP('ALGEBRAIC,'NEWNAM); %back to normal;
+ TIM:=TIME()-BTIME!*;
+ FOR EACH FN IN SEEN!* DO
+ <<IF NULL GET(FN,'CALLEDBY) THEN ENTPTS!*:=FN . ENTPTS!*;
+ UNDEFDCHK FN>>;
+ TSEEN!*:=FOR EACH Z IN IDSORT TSEEN!* COLLECT
+ <<REMPROP(Z,'TSEEN);
+ FOR EACH FN IN (X:=GET(Z,'FUNS)) DO
+ <<UNDEFDCHK FN; REMPROP(FN,'RCCNAM)>>;
+ Z.X>>;
+ FOR EACH Z IN GSEEN!* DO
+ IF GET(Z,'USEDUNBY) THEN UNDEFG!*:=Z . UNDEFG!*;
+ SETPAGE(" Summary",NIL);
+ NEWPAGE();
+ PFILES!*:=PUNUSED("Crossreference listing for files:",
+ FOR EACH Z IN PFILES!* COLLECT CDR Z);
+ ENTPTS!*:=PUNUSED("Entry Points:",ENTPTS!*);
+ UNDEFNS!*:=PUNUSED("Undefined Functions:",UNDEFNS!*);
+ UNDEFG!*:=PUNUSED("Undeclared Global Variables:",UNDEFG!*);
+ GSEEN!*:=PUNUSED("Global variables:",GSEEN!*);
+ SEEN!*:=PUNUSED("Functions:",SEEN!*);
+ FOR EACH Z IN TSEEN!* DO
+ <<RPLACD(Z,PUNUSED(LIST(CAR Z," procedures:"),CDR Z));
+ X:='!( . NCONC(EXPLODE CAR Z,LIST '!));
+ FOR EACH FN IN CDR Z DO
+ <<FN:=GETES FN; RPLACD(FN,APPEND(X,CDR FN));
+ RPLACA(FN,LENGTH CDR FN)>> >>;
+ IF !*CREFSUMMARY THEN GOTO XY;
+ IF !*GLOBALS AND GSEEN!* THEN
+ <<SETPAGE(" Global Variable Usage",1);
+ NEWPAGE();
+ FOR EACH Z IN GSEEN!* DO CREF6 Z>>;
+ IF SEEN!* THEN CREF52(" Function Usage",SEEN!*);
+ FOR EACH Z IN TSEEN!* DO
+ CREF52(LIST(" ",CAR Z," procedures"),CDR Z);
+ SETPAGE(" Toplevel calls:",NIL);
+ X:=T;
+ FOR EACH Z IN PFILES!* DO
+ IF GET(Z,'CALLS) OR GET(Z,'GLOBS) THEN
+ <<IF X THEN <<NEWPAGE(); X:=NIL>>;
+ NEWLINE 0; NEWLINE 0; PRINCNG Z;
+ SPACES2 15; UNDERLINE2 (LINELENGTH(NIL)-10);
+ CREF51(Z,'CALLS,"Calls:");
+ IF !*GLOBALS THEN CREF51(Z,'GLOBS,"Globals:")>>;
+ XY: IF !*SAVEPROPS THEN GOTO XX;
+ REMPROPSS(SEEN!*,'(GALL CALLS GLOBS CALLEDBY ALSOIS SAMEAS));
+ REMFLAGSS(SEEN!*,'(SEEN CINTHIS DEFD));
+ REMPROPSS(GSEEN!*,'(USEDBY USEDUNBY BOUNDBY SETBY));
+ REMFLAGSS(GSEEN!*,'(DCLGLB GSEEN GLB2RF GLB2BD GLB2ST));
+ FOR EACH Z IN TSEEN!* DO REMPROP(CAR Z,'FUNS);
+ FOR EACH Z IN HAVEARGS!* DO REMPROP(Z,'ARGCOUNT);
+ HAVEARGS!* := NIL;
+ XX: NEWLINE 2;
+ IF NOT !*CREFTIME THEN RETURN;
+ BTIME!*:=TIME()-BTIME!*;
+ SETPAGE(" Timing Information",NIL);
+ NEWPAGE(); NEWLINE 0;
+ PRTATM " Total Time="; PRTNUM BTIME!*;
+ PRTATM " (ms)";
+ NEWLINE 0;
+ PRTATM " Analysis Time="; PRTNUM TIM;
+ NEWLINE 0;
+ PRTATM " Sorting Time="; PRTNUM (BTIME!*-TIM);
+ NEWLINE 0; NEWLINE 0
+ END;
+
+SYMBOLIC PROCEDURE PUNUSED(X,Y);
+ IF Y THEN
+ <<NEWLINE 2; PRTLST X; NEWLINE 0;
+ LPRINT(Y := IDSORT Y,8); NEWLINE 0; Y>>;
+
+SYMBOLIC PROCEDURE CREF52(X,Y);
+ <<SETPAGE(X,1); NEWPAGE(); FOR EACH Z IN Y DO CREF5 Z>>;
+
+SYMBOLIC PROCEDURE CREF5 FN;
+% Print single entry;
+ BEGIN SCALAR X,Y;
+ NEWLINE 0; NEWLINE 0;
+ PRIN1 FN; SPACES2 15;
+ Y:=GET(FN,'GALL);
+ IF Y THEN <<PRIN1 CDR Y; X:=CAR Y>>
+ ELSE PRIN2 "Undefined";
+ SPACES2 25;
+ IF FLAGP(FN,'NARYARGS) THEN PRIN2 " Nary Args "
+ ELSE IF (Y:=GET(FN,'ARGCOUNT)) THEN
+ <<PRIN2 " "; PRIN2 Y; PRIN2 " Args ">>;
+ UNDERLINE2 (LINELENGTH(NIL)-10);
+ IF X THEN
+ <<NEWLINE 15; PRTATM '!Line!:; SPACES2 27;
+ PRTNUM CDDR X; PRTATM '!/; PRTNUM CADR X;
+ PRTATM " in "; PRTATM CAR X>>;
+ CREF51(FN,'CALLEDBY,"Called by:");
+ CREF51(FN,'CALLS,"Calls:");
+ CREF51(FN,'ALSOIS,"Is also:");
+ CREF51(FN,'SAMEAS,"Same as:");
+ IF !*GLOBALS THEN CREF51(FN,'GLOBS,"Globals:")
+ END;
+
+SYMBOLIC PROCEDURE CREF51(X,Y,Z);
+ IF (X:=GET(X,Y)) THEN <<NEWLINE 15; PRTATM Z; LPRINT(IDSORT X,27)>>;
+
+SYMBOLIC PROCEDURE CREF6 GLB;
+% print single global usage entry;
+ <<NEWLINE 0; PRIN1 GLB; SPACES2 15;
+ NOTUSE!*:=T;
+ CREF61(GLB,'USEDBY,"Global in:");
+ CREF61(GLB,'USEDUNBY,"Undeclared:");
+ CREF61(GLB,'BOUNDBY,"Bound in:");
+ CREF61(GLB,'SETBY,"Set by:");
+ IF NOTUSE!* THEN PRTATM "*** Not Used ***">>;
+
+SYMBOLIC PROCEDURE CREF61(X,Y,Z);
+ IF (X:=GET(X,Y)) THEN
+ <<IF NOT NOTUSE!* THEN NEWLINE 15 ELSE NOTUSE!*:=NIL;
+ PRTATM Z; LPRINT(IDSORT X,27)>>;
+
+% Analyse bodies of LISP functions for
+% functions called, and globals used, undefined
+%;
+
+SMACRO PROCEDURE ISGLOB U;
+ FLAGP(U,'DCLGLB);
+
+SMACRO PROCEDURE CHKSEEN S;
+% Has this name been encountered already?;
+ IF NOT FLAGP(S,'SEEN) THEN
+ <<FLAG1(S,'SEEN); SEEN!*:=S . SEEN!*>>;
+
+SMACRO PROCEDURE GLOBREF U;
+ IF NOT FLAGP(U,'GLB2RF)
+ THEN <<FLAG1(U,'GLB2RF); GLOBS!*:=U . GLOBS!*>>;
+
+SMACRO PROCEDURE ANATOM U;
+% Global seen before local..ie detect extended from this;
+ IF !*GLOBALS AND U AND NOT(U EQ 'T)
+ AND IDP U AND NOT ASSOC(U,LOCLS!*)
+ THEN GLOBREF U;
+
+SMACRO PROCEDURE CHKGSEEN G;
+ IF NOT FLAGP(G,'GSEEN) THEN <<GSEEN!*:=G . GSEEN!*;
+ FLAG1(G,'GSEEN)>>;
+
+SYMBOLIC PROCEDURE DO!-GLOBAL L;
+% Catch global defns;
+% Distinguish FLUID from GLOBAL later;
+ IF PAIRP(L:=QCRF CAR L) AND !*GLOBALS AND TOPLV!* THEN
+ <<FOR EACH V IN L DO CHKGSEEN V; FLAG(L,'DCLGLB)>>;
+
+PUT('GLOBAL,'ANLFN,'DO!-GLOBAL);
+
+PUT('FLUID,'ANLFN,'DO!-GLOBAL);
+
+SYMBOLIC ANLFN PROCEDURE UNFLUID L;
+ IF PAIRP(L:=QCRF CAR L) AND !*GLOBALS AND TOPLV!* THEN
+ <<FOR EACH V IN L DO CHKGSEEN V; REMFLAG(L,'DCLGLB)>>;
+
+SYMBOLIC PROCEDURE ADD2LOCS LL;
+ BEGIN SCALAR OLDLOC;
+ IF !*GLOBALS THEN FOR EACH GG IN LL DO
+ <<OLDLOC:=ASSOC(GG,LOCLS!*);
+ IF NOT NULL OLDLOC THEN <<
+ QERLINE 0;
+ PRIN2 "*** Variable ";
+ PRIN1 GG;
+ PRIN2 " nested declaration in ";
+ PRINCNG CURFUN!*;
+ NEWLINE 0;
+ RPLACD(OLDLOC,NIL.OLDLOC)>>
+ ELSE LOCLS!*:=(GG . LIST NIL) . LOCLS!*;
+ IF ISGLOB(GG) OR FLAGP(GG,'GLB2RF) THEN GLOBIND GG;
+ IF FLAGP(GG,'SEEN) THEN
+ <<QERLINE 0;
+ PRIN2 "*** Function ";
+ PRINCNG GG;
+ PRIN2 " used as variable in ";
+ PRINCNG CURFUN!*;
+ NEWLINE 0>> >>
+ END;
+
+SYMBOLIC PROCEDURE GLOBIND GG;
+ <<FLAG1(GG,'GLB2BD); GLOBREF GG>>;
+
+SYMBOLIC PROCEDURE REMLOCS LLN;
+ BEGIN SCALAR OLDLOC;
+ IF !*GLOBALS THEN FOR EACH LL IN LLN DO
+ <<OLDLOC:=ASSOC(LL,LOCLS!*);
+ IF NULL OLDLOC THEN
+ IF GETD 'BEGIN THEN REDERR LIST(" Lvar confused",LL)
+ ELSE ERROR(0,LIST(" Lvar confused",LL));
+ IF CDDR OLDLOC THEN RPLACD(OLDLOC,CDDR OLDLOC)
+ ELSE LOCLS!*:=EFFACE1(OLDLOC,LOCLS!*)>>
+ END;
+
+SYMBOLIC PROCEDURE ADD2CALLS FN;
+% Update local CALLS!*;
+ IF NOT(FLAGP(FN,'NOLIST) OR FLAGP(FN,'CINTHIS))
+ THEN <<CALLS!*:=FN . CALLS!*; FLAG1(FN,'CINTHIS)>>;
+
+SYMBOLIC PROCEDURE ANFORM U;
+ IF ATOM U THEN ANATOM U
+ ELSE ANFORM1 U;
+
+SYMBOLIC PROCEDURE ANFORML L;
+ BEGIN
+ WHILE NOT ATOM L DO <<ANFORM CAR L; L:=CDR L>>;
+ IF L THEN ANATOM L
+ END;
+
+SYMBOLIC PROCEDURE ANFORM1 U;
+ BEGIN SCALAR FN,X;
+ FN:=CAR U; U:=CDR U;
+ IF NOT ATOM FN THEN RETURN <<ANFORM1 FN; ANFORML U>>;
+ IF NOT IDP FN THEN RETURN NIL
+ ELSE IF ISGLOB FN THEN <<GLOBREF FN; RETURN ANFORML U>>
+ ELSE IF ASSOC(FN,LOCLS!*) THEN RETURN ANFORML U;
+ ADD2CALLS FN;
+ CHECKARGCOUNT(FN,LENGTH U);
+ IF FLAGP(FN,'NOANL) THEN NIL
+ ELSE IF X:=GET(FN,'ANLFN) THEN APPLY(X,LIST U)
+ ELSE ANFORML U
+ END;
+
+SYMBOLIC ANLFN PROCEDURE LAMBDA U;
+ <<ADD2LOCS CAR U; ANFORML CDR U; REMLOCS CAR U>>;
+
+SYMBOLIC PROCEDURE ANLSETQ U;
+ <<ANFORML U;
+ IF !*GLOBALS AND FLAGP(U:=CAR U,'GLB2RF) THEN FLAG1(U,'GLB2ST)>>;
+
+PUT('SETQ,'ANLFN,'ANLSETQ);
+
+SYMBOLIC ANLFN PROCEDURE COND U;
+ FOR EACH X IN U DO ANFORML X;
+
+SYMBOLIC ANLFN PROCEDURE PROG U;
+ <<ADD2LOCS CAR U;
+ FOR EACH X IN CDR U DO
+ IF NOT ATOM X THEN ANFORM1 X;
+ REMLOCS CAR U>>;
+
+SYMBOLIC ANLFN PROCEDURE FUNCTION U;
+ IF PAIRP(U:=CAR U) THEN ANFORM1 U
+ ELSE IF ISGLOB U THEN GLOBREF U
+ ELSE IF NULL ASSOC(U,LOCLS!*) THEN ADD2CALLS U;
+
+FLAG('(QUOTE GO),'NOANL);
+
+SYMBOLIC ANLFN PROCEDURE ERRORSET U;
+ BEGIN SCALAR FN,X;
+ ANFORML CDR U;
+ IF EQCAR(U:=CAR U,'QUOTE) THEN RETURN ERSANFORM CADR U
+ ELSE IF NOT((EQCAR(U,'CONS) OR (X:=EQCAR(U,'LIST)))
+ AND QUOTP(FN:=CADR U))
+ THEN RETURN ANFORM U;
+ ANFORML CDDR U;
+ IF PAIRP(FN:=CADR FN) THEN ANFORM1 FN
+ ELSE IF FLAGP(FN,'GLB2RF) THEN NIL
+ ELSE IF ISGLOB FN THEN GLOBREF FN
+ ELSE <<ADD2CALLS FN; IF X THEN CHECKARGCOUNT(FN,LENGTH CDDR U)>>
+ END;
+
+SYMBOLIC PROCEDURE ERSANFORM U;
+ BEGIN SCALAR LOCLS!*;
+ RETURN ANFORM U
+ END;
+
+SYMBOLIC PROCEDURE ANLMAP U;
+ <<ANFORML CDR U;
+ IF QUOTP(U:=CADDR U) AND IDP(U:=CADR U)
+ AND NOT ISGLOBL U AND NOT ASSOC(U,LOCLS!*)
+ THEN CHECKARGCOUNT(U,1)>>;
+
+FOR EACH X IN '(MAP MAPC MAPLIST MAPCAR MAPCON MAPCAN) DO
+ PUT(X,'ANLFN,'ANLMAP);
+
+SYMBOLIC ANLFN PROCEDURE APPLY U;
+ BEGIN SCALAR FN;
+ ANFORML CDR U;
+ IF QUOTP(FN:=CADR U) AND IDP(FN:=CADR FN) AND EQCAR(U:=CADDR U,'LIST)
+ THEN CHECKARGCOUNT(FN,LENGTH CDR U)
+ END;
+
+SYMBOLIC PROCEDURE QUOTP U; EQCAR(U,'QUOTE) OR EQCAR(U,'FUNCTION);
+
+PUT('CREF ,'SIMPFG ,'((T (CREFON)) (NIL (CREFOFF))));
+
+SYMBOLIC PROCEDURE OUTREF(S,VARLIS,BODY,TYPE);
+ BEGIN SCALAR CURFUN!*,CALLS!*,GLOBS!*,LOCLS!*,TOPLV!*,A;
+ A:=IF VARLIS MEMQ '(ANP!!ATOM ANP!!IDB ANP!!EQ ANP!!UNKNOWN)
+ THEN NIL
+ ELSE LENGTH VARLIS;
+ S := OUTRDEFUN(S,TYPE,IF A THEN A ELSE GET(BODY,'ARGCOUNT));
+ IF A THEN <<ADD2LOCS VARLIS; ANFORM(BODY); REMLOCS VARLIS>>
+ ELSE IF NULL BODY OR NOT IDP BODY THEN NIL
+ ELSE IF VARLIS EQ 'ANP!!EQ
+ THEN <<PUT(S,'SAMEAS,LIST BODY); TRAPUT(BODY,'ALSOIS,S)>>
+ ELSE ADD2CALLS BODY;
+ OUTREFEND S
+ END;
+
+SYMBOLIC PROCEDURE TRAPUT(U,V,W);
+ BEGIN SCALAR A;
+ IF A:=GET(U,V) THEN
+ (IF NOT(TOPLV!* OR W MEMQ A) THEN RPLACD(A,W . CDR A))
+ ELSE PUT(U,V,LIST W)
+ END;
+
+SMACRO PROCEDURE TOPUT(U,V,W);
+ IF W THEN PUT(U,V,IF TOPLV!* THEN UNION(W,GET(U,V)) ELSE W);
+
+SYMBOLIC PROCEDURE OUTREFEND S;
+ <<TOPUT(S,'CALLS,CALLS!*);
+ FOR EACH X IN CALLS!* DO
+ <<REMFLAG1(X,'CINTHIS);
+ IF NOT X EQ S THEN <<CHKSEEN X; TRAPUT(X,'CALLEDBY,S)>> >>;
+ TOPUT(S,'GLOBS,GLOBS!*);
+ FOR EACH X IN GLOBS!* DO
+ <<TRAPUT(X,IF ISGLOB X THEN 'USEDBY
+ ELSE <<CHKGSEEN X; 'USEDUNBY>>,S);
+ REMFLAG1(X,'GLB2RF);
+ IF FLAGP(X,'GLB2BD)
+ THEN <<REMFLAG1(X,'GLB2BD); TRAPUT(X,'BOUNDBY,S)>>;
+ IF FLAGP(X,'GLB2ST)
+ THEN <<REMFLAG1(X,'GLB2ST); TRAPUT(X,'SETBY,S)>> >> >>;
+
+SYMBOLIC PROCEDURE RECREF(S,TYPE);
+ <<QERLINE 2;
+ PRTATM "*** Redefinition to ";
+ PRIN1 TYPE;
+ PRTATM " procedure, of:";
+ CREF5 S;
+ REMPROPSS(S,'(CALLS GLOBS SAMEAS));
+ NEWLINE 2>>;
+
+SYMBOLIC PROCEDURE OUTRDEFUN(S,TYPE,V);
+ BEGIN
+ S:=QTYPNM(S,TYPE);
+ IF FLAGP(S,'DEFD) THEN RECREF(S,TYPE)
+ ELSE FLAG1(S,'DEFD);
+ IF FLAGP(TYPE,'FUNCTION) AND (ISGLOB S OR ASSOC(S,LOCLS!*)) THEN
+ <<QERLINE 0;
+ PRIN2 "**** Variable ";
+ PRINCNG S;
+ PRIN2 " defined as function";
+ NEWLINE 0>>;
+ IF V AND NOT FLAGP(TYPE,'NARYARG) THEN DEFINEARGS(S,V);
+ PUT(S,'GALL,CURLIN!* . TYPE);
+ GLOBS!*:=NIL;
+ CALLS!*:=NIL;
+ RETURN CURFUN!*:=S
+ END;
+
+FLAG('(MACRO FEXPR),'NARYARG);
+
+SYMBOLIC PROCEDURE QTYPNM(S,TYPE);
+ IF FLAGP(TYPE,'FUNCTION) THEN <<CHKSEEN S; S>>
+ ELSE BEGIN SCALAR X,Y,Z;
+ IF (Y:=GET(TYPE,'TSEEN)) AND (X:=ATSOC(S,CDR Y))
+ THEN RETURN CDR X;
+ IF NULL Y THEN
+ <<Y:=LIST ('!( . NCONC(EXPLODE TYPE,LIST '!)));
+ PUT(TYPE,'TSEEN,Y); TSEEN!* := TYPE . TSEEN!*>>;
+ X := COMPRESS (Z := EXPLODE S);
+ CDR Y := (S . X) . CDR Y;
+ Y := APPEND(CAR Y,Z);
+ PUT(X,'RCCNAM,LENGTH Y . Y);
+ TRAPUT(TYPE,'FUNS,X);
+ RETURN X
+ END;
+
+SYMBOLIC PROCEDURE DEFINEARGS(NAME,N);
+ BEGIN SCALAR CALLEDWITH,X;
+ CALLEDWITH:=GET(NAME,'ARGCOUNT);
+ IF NULL CALLEDWITH THEN RETURN HASARG(NAME,N);
+ IF N=CALLEDWITH THEN RETURN NIL;
+ IF X := GET(NAME,'CALLEDBY) THEN INSTDOF(NAME,N,CALLEDWITH,X);
+ HASARG(NAME,N)
+ END;
+
+SYMBOLIC PROCEDURE INSTDOF(NAME,N,M,FNLST);
+ <<QERLINE 0;
+ PRIN2 "***** ";
+ PRIN1 NAME;
+ PRIN2 " called with ";
+ PRIN2 M;
+ PRIN2 " instead of ";
+ PRIN2 N;
+ PRIN2 " arguments in:";
+ LPRINT(IDSORT FNLST,POSN()+1);
+ NEWLINE 0>>;
+
+SYMBOLIC PROCEDURE HASARG(NAME,N);
+ <<HAVEARGS!*:=NAME . HAVEARGS!*;
+ IF N>MAXARG!* THEN
+ <<QERLINE 0;
+ PRIN2 "**** "; PRIN1 NAME;
+ PRIN2 " has "; PRIN2 N;
+ PRIN2 " arguments";
+ NEWLINE 0 >>;
+ PUT(NAME,'ARGCOUNT,N)>>;
+
+SYMBOLIC PROCEDURE CHECKARGCOUNT(NAME,N);
+ BEGIN SCALAR CORRECTN;
+ IF FLAGP(NAME,'NARYARGS) THEN RETURN NIL;
+ CORRECTN:=GET(NAME,'ARGCOUNT);
+ IF NULL CORRECTN THEN RETURN HASARG(NAME,N);
+ IF NOT CORRECTN=N THEN INSTDOF(NAME,CORRECTN,N,LIST CURFUN!*)
+ END;
+
+SYMBOLIC PROCEDURE REFPRINT U;
+ BEGIN SCALAR X,Y;
+ X:=IF CLOC!* THEN CAR CLOC!* ELSE "*TTYINPUT*";
+ IF (CURFUN!*:=ASSOC(X,PFILES!*)) THEN
+ <<X:=CAR CURFUN!*; CURFUN!*:=CDR CURFUN!*>>
+ ELSE <<PFILES!*:=(X.(CURFUN!*:=GENSYM())).PFILES!*;
+ Y:=REVERSIP CDR REVERSIP CDR EXPLODE X;
+ PUT(CURFUN!*,'RCCNAM,LENGTH Y . Y)>>;
+ CURLIN!*:=IF CLOC!* THEN X.CDR CLOC!* ELSE NIL;
+ CALLS!*:=GLOBS!*:=LOCLS!*:=NIL;
+ ANFORM U;
+ OUTREFEND CURFUN!*
+ END;
+
+FLAG('(SMACRO NMACRO),'CREF);
+
+SYMBOLIC ANLFN PROCEDURE PUT U;
+ IF TOPLV!* AND QCPUTX CADR U THEN ANPUTX U
+ ELSE ANFORML U;
+
+PUT('PUTC,'ANLFN,GET('PUT,'ANLFN));
+
+SYMBOLIC PROCEDURE QCPUTX U;
+ EQCAR(U,'QUOTE) AND (FLAGP(CADR U,'CREF) OR FLAGP(CADR U,'COMPILE));
+
+SYMBOLIC PROCEDURE ANPUTX U;
+ BEGIN SCALAR NAM,TYP,BODY;
+ NAM:=QCRF CAR U;
+ TYP:=QCRF CADR U;
+ U:=CADDR U;
+ IF ATOM U THEN <<BODY:=QCRF U; U:='ANP!!ATOM>>
+ ELSE IF CAR U MEMQ '(QUOTE FUNCTION) THEN
+ IF EQCAR(U:=CADR U,'LAMBDA) THEN <<BODY:=CADDR U; U:=CADR U>>
+ ELSE IF IDP U THEN <<BODY:=U; U:='ANP!!IDB>>
+ ELSE RETURN NIL
+ ELSE IF CAR U EQ 'CDR AND EQCAR(CADR U,'GETD) THEN
+ <<BODY:=QCRF CADADR U; U:='ANP!!EQ>>
+ ELSE IF CAR U EQ 'GET AND QCPUTX CADDR U THEN
+ <<BODY:=QTYPNM(QCRF CADR U,CADR CADDR U); U:='ANP!!EQ>>
+ ELSE IF CAR U EQ 'MKCODE THEN
+ <<ANFORM CADR U; U:=QCRF CADDR U; BODY:=NIL>>
+ ELSE <<BODY:=QCRF U; U:='ANP!!UNKNOWN>>;
+ OUTREF(NAM,U,BODY,TYP)
+ END;
+
+SYMBOLIC ANLFN PROCEDURE PUTD U;
+ IF TOPLV!* THEN ANPUTX U ELSE ANFORML U;
+
+SYMBOLIC ANLFN PROCEDURE DE U;
+ OUTDEFR(U,'EXPR);
+
+SYMBOLIC ANLFN PROCEDURE DN U;
+ OUTDEFR(U,'NEXPR);
+
+SYMBOLIC ANLFN PROCEDURE DF U;
+ OUTDEFR(U,'FEXPR);
+
+SYMBOLIC ANLFN PROCEDURE DM U;
+ OUTDEFR(U,'MACRO);
+
+SYMBOLIC ANLFN PROCEDURE DS U;
+ OUTDEFR(U,'SMACRO);
+
+SYMBOLIC PROCEDURE OUTDEFR(U,TYPE);
+ OUTREF(CAR U,CADR U,CADDR U,TYPE);
+
+SYMBOLIC PROCEDURE QCRF U;
+ IF NULL U OR U EQ T THEN U
+ ELSE IF EQCAR(U,'QUOTE) THEN CADR U
+ ELSE <<ANFORM U; COMPRESS EXPLODE '!?VALUE!?!?>>;
+
+FLAG('(EXPR FEXPR MACRO SMACRO NMACRO),'FUNCTION);
+
+CommentOutCode << % Lisp 1.6 LAP only
+SYMBOLIC ANLFN PROCEDURE LAP U;
+ IF PAIRP(U:=QCRF CAR U) THEN
+ BEGIN SCALAR GLOBS!*,LOCLS!*,CALLS!*,CURFUN!*,TOPLV!*,X;
+ WHILE U DO
+ <<IF PAIRP CAR U THEN
+ IF X:=GET(OP!*!*:=CAAR U,'CRFLAPO) THEN APPLY(X,LIST U)
+ ELSE IF !*GLOBALS THEN FOR EACH Y IN CDAR U DO ANLAPEV Y;
+ U:=CDR U>>;
+ QOUTREFE()
+ END;
+
+SYMBOLIC CRFLAPO PROCEDURE !*ENTRY U;
+ <<QOUTREFE(); U:=CDAR U; OUTRDEFUN(CAR U,CADR U,CADDR U)>>;
+
+SYMBOLIC PROCEDURE QOUTREFE;
+ BEGIN
+ IF NULL CURFUN!* THEN
+ IF GLOBS!* OR CALLS!* THEN
+ <<CURFUN!*:=COMPRESS EXPLODE '!?LAP!?!?; CHKSEEN CURFUN!*>>
+ ELSE RETURN;
+ OUTREFEND CURFUN!*
+ END;
+
+SYMBOLIC CRFLAPO PROCEDURE !*LAMBIND U;
+ FOR EACH X IN CADDAR U DO GLOBIND CAR X;
+
+SYMBOLIC CRFLAPO PROCEDURE !*PROGBIND U;
+ FOR EACH X IN CADAR U DO GLOBIND CAR X;
+
+SYMBOLIC PROCEDURE LINCALL U;
+ <<ADD2CALLS CAR (U:=CDAR U); CHECKARGCOUNT(CAR U,CADDR U)>>;
+
+PUT('!*LINK,'CRFLAPO,'LINCALL);
+
+PUT('!*LINKE,'CRFLAPO,'LINCALL);
+
+SYMBOLIC PROCEDURE ANLAPEV U;
+ IF PAIRP U THEN
+ IF CAR U MEMQ '(GLOBAL FLUID) THEN
+ <<U:=CADR U; GLOBREF U;
+ IF FLAGP(OP!*!*,'STORE) THEN PUT(U,'GLB2ST,'T)>>
+ ELSE <<ANLAPEV CAR U; ANLAPEV CDR U>>;
+
+FLAG('(!*STORE),'STORE);
+
+FLAG('(POP MOVEM SETZM HRRZM),'STORE);
+
+SYMBOLIC PROCEDURE LAPCALLF U;
+ BEGIN SCALAR FN;
+ RETURN
+ IF EQCAR(CADR (U:=CDAR U),'E) THEN
+ <<ADD2CALLS(FN:=CADADR U); CHECKARGCOUNT(FN,CAR U)>>
+ ELSE IF !*GLOBALS THEN ANLAPEV CADR U
+ END;
+
+PUT('JCALL,'CRFLAPO,'LAPCALLF);
+
+PUT('CALLF,'CRFLAPO,'LAPCALLF);
+
+PUT('JCALLF,'CRFLAPO,'LAPCALLF);
+
+SYMBOLIC CRFLAPO PROCEDURE CALL U;
+ IF NOT(CADDAR U = '(E !*LAMBIND!*)) THEN LAPCALLF U
+ ELSE WHILE ((U:=CDR U) AND PAIRP CAR U AND CAAR U = 0) DO
+ GLOBIND CADR CADDAR U;
+
+>>;
+
+SYMBOLIC PROCEDURE QERLINE U;
+ IF PRETITL!* THEN NEWLINE U
+ ELSE <<PRETITL!*:=T; NEWPAGE()>>;
+
+% These functions defined to be able to run in bare LISP
+% EQCAR MKQUOTE
+
+SYMBOLIC PROCEDURE EFFACE1(U,V);
+ IF NULL V THEN NIL
+ ELSE IF U EQ CAR V THEN CDR V
+ ELSE RPLACD(V,EFFACE1(U,CDR V));
+
+
+MAXARG!*:=15;
+
+END;
ADDED psl-1983/3-1/util/psl-crefio.red
Index: psl-1983/3-1/util/psl-crefio.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/psl-crefio.red
@@ -0,0 +1,175 @@
+% ===============================================================
+% General Purpose I/O package for CREF, adapted to PSL
+% MLG, 6:19am Tuesday, 15 December 1981
+% ===============================================================
+%==============================================================================
+% 11/18/82 - rrk - The function REMPROPSS was being called from RECREF in the
+% redefintion of a procedure with a single procedure name as the first
+% argument. This somehow caused the routine to go into an infinite loop. A
+% quick to turn the ID into a list within REMPROPSS solves the problem. The
+% reason that the call to REMPROPSS was not changed, is because it is not
+% clear if in some cases the argument will be a list.
+%==============================================================================
+
+
+GLOBAL '(!*FORMFEED ORIG!* LNNUM!* MAXLN!* TITLE!* PGNUM!* );
+
+% FLAGS: FORMFEED (ON) controls ^L or spacer of ====;
+
+SYMBOLIC PROCEDURE INITIO();
+% Set-up common defaults;
+ BEGIN
+ !*FORMFEED:=T;
+ ORIG!*:=0;
+ LNNUM!*:=0;
+ LINELENGTH(75);
+ MAXLN!*:=55;
+ TITLE!*:=NIL;
+ PGNUM!*:=1;
+ END;
+
+SYMBOLIC PROCEDURE LPOSN();
+ LNNUM!*;
+
+INITIO();
+
+SYMBOLIC PROCEDURE SETPGLN(P,L);
+ BEGIN IF P THEN MAXLN!*:=P;
+ IF L THEN LINELENGTH(L);
+ END;
+
+% We use EXPLODE to produce a list of chars from atomname,
+% and TERPRI() to terminate a buffer..all else
+% done in package..spaces,tabs,etc. ;
+
+COMMENT Character lists are (length . chars), for FITS;
+
+SYMBOLIC PROCEDURE GETES U;
+% Returns for U , E=(Length . List of char);
+ BEGIN SCALAR E;
+ IF NOT IDP U THEN RETURN<<E:=EXPLODE U;LENGTH(E).E>>;
+ IF NOT(E:=GET(U,'RCCNAM)) THEN <<E:=EXPLODE(U);
+ E:=LENGTH(E) . E;
+ PUT(U,'RCCNAM,E)>>;
+ RETURN E;
+ END;
+
+SYMBOLIC SMACRO PROCEDURE PRTWRD U;
+ IF NUMBERP U THEN PRTNUM U
+ ELSE PRTATM U;
+
+SYMBOLIC PROCEDURE PRTATM U;
+ PRIN2 U; % For a nice print;
+
+SYMBOLIC PROCEDURE PRTLST U;
+ IF ATOM U THEN PRIN2 U ELSE FOR EACH X IN U DO PRIN2 X;
+
+SYMBOLIC PROCEDURE PRTNUM N;
+ PRIN2 N;
+
+SYMBOLIC PROCEDURE PRINCN E;
+% output a list of chars, update POSN();
+ WHILE (E:=CDR E) DO PRINC CAR E;
+
+CommentOutCode << % Defined in PSL
+SYMBOLIC PROCEDURE SPACES N;
+ FOR I:=1:N DO PRINC '! ;
+
+SYMBOLIC PROCEDURE SPACES2 N;
+ BEGIN SCALAR X;
+ X := N - POSN();
+ IF X<1 THEN NEWLINE N
+ ELSE SPACES X;
+ END;
+>>;
+
+SYMBOLIC PROCEDURE SETPAGE(TITLE,PAGE);
+% Initialise current page and title;
+ BEGIN
+ TITLE!*:= TITLE ;
+ PGNUM!*:=PAGE;
+ END;
+
+SYMBOLIC PROCEDURE NEWLINE N;
+% Begins a fresh line at posn N;
+ BEGIN
+ LNNUM!*:=LNNUM!*+1;
+ IF LNNUM!*>=MAXLN!* THEN NEWPAGE()
+ ELSE TERPRI();
+ SPACES(ORIG!*+N);
+ END;
+
+SYMBOLIC PROCEDURE NEWPAGE();
+% Start a fresh page, with PGNUM and TITLE, if needed;
+ BEGIN SCALAR A;
+ A:=LPOSN();
+ LNNUM!*:=0;
+ IF POSN() NEQ 0 THEN NEWLINE 0;
+ IF A NEQ 0 THEN FORMFEED();
+ IF TITLE!* THEN
+ <<SPACES2 5; PRTLST TITLE!*>>;
+ SPACES2 (LINELENGTH(NIL)-4);
+ IF PGNUM!* THEN <<PRTNUM PGNUM!*; PGNUM!*:=PGNUM!*+1>>
+ ELSE PGNUM!*:=2;
+ NEWLINE 10;
+ NEWLINE 0;
+ END;
+
+SYMBOLIC PROCEDURE UNDERLINE2 N;
+ IF N>=LINELENGTH(NIL) THEN
+ <<N:=LINELENGTH(NIL)-POSN();
+ FOR I:=0:N DO PRINC '!- ;
+ NEWLINE(0)>>
+ ELSE BEGIN SCALAR J;
+ J:=N-POSN();
+ FOR I:=0:J DO PRINC '!-;
+ END;
+
+SYMBOLIC PROCEDURE LPRINT(U,N);
+% prints a list of atoms within block LINELENGTH(NIL)-n;
+ BEGIN SCALAR E, L,M;
+ SPACES2 N;
+ L := LINELENGTH NIL-POSN();
+ IF L<=0 THEN ERROR(13,"WINDOW TOO SMALL FOR LPRINT");
+ WHILE U DO
+ <<E:=GETES CAR U; U:=CDR U;
+ IF LINELENGTH NIL<POSN() THEN NEWLINE N;
+ IF CAR E<(M := LINELENGTH NIL-POSN()) THEN PRINCN E
+ ELSE IF CAR E<L THEN <<NEWLINE N; PRINCN E>>
+ ELSE BEGIN
+ E := CDR E;
+ A: FOR I := 1:M DO <<PRINC CAR E; E := CDR E>>;
+ NEWLINE N;
+ IF NULL E THEN NIL
+ ELSE IF LENGTH E<(M := L) THEN PRINCN(NIL . E)
+ ELSE GO TO A
+ END;
+ PRINC '! >>
+ END;
+
+
+% 11/18/82 rrk - Infinite loop caused by calls to this function with an
+% id as the ATMLST instead of a list. A quick patch to turn the single
+% id into a list is provided, eliminating the infinite loop.
+SYMBOLIC PROCEDURE REMPROPSS(ATMLST,LST);
+<< IF NOT PAIRP ATMLST THEN
+ ATMLST := LIST (ATMLST);
+ WHILE ATMLST DO
+ <<WHILE LST DO <<REMPROP(CAR ATMLST,CAR LST); LST:=CDR LST>>;
+ ATMLST:=CDR ATMLST>> >>;
+
+SYMBOLIC PROCEDURE REMFLAGSS(ATMLST,LST);
+ WHILE LST DO <<REMFLAG(ATMLST,CAR LST); LST:=CDR LST>>;
+
+CommentOutCode << % These are defined EXPRs in PSL
+SMACRO PROCEDURE REMFLAG1(U,V); REMFLAG(LIST U,V);
+
+SMACRO PROCEDURE FLAG1(U,V); FLAG(LIST U,V);
+>>;
+
+SYMBOLIC PROCEDURE FORMFEED;
+ IF !*FORMFEED THEN EJECT()
+ ELSE <<TERPRI();
+ PRIN2 " ========================================= ";
+ TERPRI()>>;
+
ADDED psl-1983/3-1/util/psl-input-stream.sl
Index: psl-1983/3-1/util/psl-input-stream.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/psl-input-stream.sl
@@ -0,0 +1,146 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PSL-Input-Stream.SL - File Input Stream Objects (Portable PSL Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 10 December 1982
+%
+% Summary of public functions:
+%
+% (setf s (open-input "file name")) % generates error on failure
+% (setf s (attempt-to-open-input "file name")) % returns NIL on failure
+% (setf ch (=> s getc)) % read character (map CRLF to LF)
+% (setf ch (=> s getc-image)) % read character (don't map CRLF to LF)
+% (setf ch (=> s peekc)) % peek at next character
+% (setf ch (=> s peekc-image)) % peek at next character (don't map CRLF to LF)
+% (setf str (=> s getl)) % Read a line; return string without terminating LF.
+% (=> s empty?) % Are there no more characters?
+% (=> s close) % Close the file.
+% (setf fn (=> s file-name)) % Return "true" name of file.
+% (setf date (=> s read-date)) % Return date that file was last read.
+% (setf date (=> s write-date)) % Return date that file was last written.
+% (=> s delete-file) % Delete the associated file.
+% (=> s undelete-file) % Undelete the associated file.
+% (=> s delete-and-expunge) % Delete and expunge the associated file.
+% (setf name (=> s author)) % Return the name of the file's author.
+% (setf name (=> s original-author)) % Return the original author's name.
+% (setf count (=> s file-length)) % Return the byte count of the file.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int))
+(BothTimes (load objects))
+
+(de attempt-to-open-input (file-name)
+ (let ((p (ErrorSet (list 'open-input file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de open-input (file-name)
+ (let ((s (make-instance 'input-stream)))
+ (=> s open file-name)
+ s))
+
+(defflavor input-stream ((chn NIL) % PSL "channel"
+ eof-flag % T => EOF has been detected
+ file-name % file name given to OPEN
+ )
+ ()
+ (gettable-instance-variables file-name)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (input-stream getc) ()
+
+ % Return the next character from the file. Line termination is represented
+ % by a single NEWLINE (LF) character. Returns NIL on end of file.
+
+ (if (not eof-flag)
+ (let ((ch (ChannelReadChar chn)))
+ (if (= ch #\EOF)
+ (prog () (setf eof-flag T)) % return NIL on EOF
+ ch % return the character, otherwise
+ ))))
+
+(defmethod (input-stream getc-image) ()
+ (=> self getc))
+
+(defmethod (input-stream empty?) ()
+ (null (=> self peekc-image)))
+
+(defmethod (input-stream peekc) ()
+
+ % Return the next character from the file, but don't advance to the next
+ % character. Returns NIL on end of file.
+
+ (let ((ch (=> self getc)))
+ (when ch
+ (ChannelUnReadChar chn ch)
+ ch)))
+
+(defmethod (input-stream peekc-image) ()
+ (=> self peekc))
+
+(defmethod (input-stream getl) ()
+ % Read and return (the remainder of) the current input line.
+ % Read, but don't return the terminating EOL (if any).
+ % Return NIL if no characters and end-of-file detected.
+
+ (let ((s ""))
+ (while T
+ (let ((ch (=> self getc)))
+ (if (null ch) (exit (if (string-empty? s) NIL s)))
+ (if (= ch #\EOL) (exit s))
+ (setf s (string-concat s (string ch)))
+ ))))
+
+(defmethod (input-stream tell-position) ()
+ NIL
+ )
+
+(defmethod (input-stream seek-position) (p)
+ )
+
+(defmethod (input-stream open) (name-of-file)
+
+ % Open the specified file for input via SELF. If the file cannot be opened,
+ % a Continuable Error is generated.
+
+ (if chn (=> self close))
+ (setf eof-flag NIL)
+ (setf chn (open name-of-file 'input))
+ (setf file-name (copystring name-of-file))
+ )
+
+(defmethod (input-stream close) ()
+ (when chn
+ (close chn)
+ (setf chn NIL)
+ (setf eof-flag T)
+ ))
+
+(defmethod (input-stream read-date) ()
+ 0)
+
+(defmethod (input-stream write-date) ()
+ 0)
+
+(defmethod (input-stream delete-file) ()
+ )
+
+(defmethod (input-stream undelete-file) ()
+ )
+
+(defmethod (input-stream delete-and-expunge-file) ()
+ )
+
+(defmethod (input-stream author) ()
+ "")
+
+(defmethod (input-stream original-author) ()
+ "")
+
+(defmethod (input-stream file-length) ()
+ 0)
ADDED psl-1983/3-1/util/psl-output-stream.sl
Index: psl-1983/3-1/util/psl-output-stream.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/psl-output-stream.sl
@@ -0,0 +1,89 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PSL-Output-Stream.SL - File Output Stream Objects (Portable PSL Version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 10 December 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-strings))
+(BothTimes (load objects))
+
+(de attempt-to-open-output (file-name)
+ (let ((p (ErrorSet (list 'open-output file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de attempt-to-open-append (file-name)
+ (let ((p (ErrorSet (list 'open-append file-name) NIL NIL)))
+ (and (PairP p) (car p))
+ ))
+
+(de open-output (file-name)
+ (let ((s (make-instance 'output-stream)))
+ (=> s open file-name)
+ s))
+
+(de open-append (file-name)
+ (let ((s (make-instance 'output-stream)))
+ (=> s open-append file-name)
+ s))
+
+(defflavor output-stream ((chn NIL) % PSL "channel"
+ file-name % file name given to open
+ )
+ ()
+ (gettable-instance-variables file-name)
+ )
+
+(defmethod (output-stream putc) (ch)
+
+ % Append the character CH to the file. Line termination is indicated by
+ % writing a single NEWLINE (LF) character.
+
+ (ChannelWriteChar chn ch)
+ )
+
+(defmethod (output-stream put-newline) ()
+ % Output a line terminator.
+ (ChannelWriteChar chn #\EOL)
+ )
+
+(defmethod (output-stream putc-image) (ch)
+ (ChannelWriteChar chn ch)
+ )
+
+(defmethod (output-stream puts) (str)
+ (for (from i 0 (string-upper-bound str))
+ (do (=> self putc (string-fetch str i)))
+ ))
+
+(defmethod (output-stream putl) (str)
+ % Write string followed by line terminator to output stream.
+ (=> self puts str)
+ (=> self put-newline)
+ )
+
+(defmethod (output-stream open) (name-of-file)
+
+ % Open the specified file for output via SELF. If the file cannot
+ % be opened, a Continuable Error is generated.
+
+ (if chn (=> self close))
+ (setf chn (open name-of-file 'output))
+ (setf file-name (copystring name-of-file))
+ )
+
+(defmethod (output-stream open-append) (name-of-file)
+ (=> self open name-of-file))
+
+(defmethod (output-stream close) ()
+ (when chn
+ (close chn)
+ (setf chn NIL)
+ ))
+
+(defmethod (output-stream flush) ()
+ )
ADDED psl-1983/3-1/util/pslcomp-main.sl
Index: psl-1983/3-1/util/pslcomp-main.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/pslcomp-main.sl
@@ -0,0 +1,118 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PSLCOMP-MAIN.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 27 September 1982
+% Revised: 8 December 1982
+%
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This file redefines the start-up routine for PSLCOMP to read and interpret
+% the program command string as a list of source files to be compiled.
+
+% Edit by Cris Perdue, 8 Apr 1983 1401-PST
+% Compile-files now does exitlisp rather than quit.
+% EvIn is only given a definition if not already defined.
+% Syntax is assumed to be LISP if given a crazy file extension.
+% Edit by Cris Perdue, 5 Apr 1983 1421-PST
+% Changed to use get-command-args rather than get-command-string
+% and parse-command-string.
+% Uses EVIN to read the file, thus compiles any type of file.
+% If no extension specified, tries "sl", "build", and "red" extensions.
+% Defines EVIN to load RLISP if needed. This also gets around the
+% problem of starting up in the RLISP top level with RLISP
+% loaded.
+% Now uses ErrSet rather than ErrorSet.
+% 8-Dec-82 Alan Snyder
+% Changed use of DSKIN (now an EXPR).
+
+(CompileTime (load common pathnames))
+(imports '(pathnamex get-command-args compiler))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(*usermode *redefmsg CurrentReadMacroIndicator* CurrentScanTable*))
+(fluid '(*quiet_faslout *WritingFASLFile))
+
+(cond ((funboundp 'original-main)
+ (copyd 'original-main 'main)))
+
+(de main ()
+ (let ((CurrentReadMacroIndicator* 'LispReadMacro) % Crock!
+ (CurrentScanTable* LispScanTable*)
+ (c-list (get-command-args))
+ (*usermode nil)
+ (*redefmsg nil))
+ (compile-files c-list)
+ (copyd 'main 'original-main)
+ )
+ (original-main)
+ )
+
+(de pslcomp () % Not in use. /csp
+ (let ((*usermode nil)
+ (*redefmsg nil))
+ (compile-files (get-command-args))))
+
+(if (funboundp 'evin)
+ (de evin (x)
+ (load rlisp)
+ (eval (list 'in x)))) % Hack. /csp
+
+(de compile-files (c-list)
+ (cond ((null c-list)
+ (PrintF "Portable Standard Lisp Compiler%n")
+ (PrintF "Usage: PSLCOMP source-file ...%n")
+ )
+ (t
+ (for (in fn c-list)
+ (do (attempt-to-compile-file fn))
+ )
+ (exitlisp)
+ )))
+
+(de attempt-to-compile-file (fn)
+ (let* ((*break NIL)
+ (result (ErrSet (compile-file fn) T))
+ )
+ (cond ((FixP result)
+ (if *WritingFASLFile (faslend))
+ (printf "%n ***** Error during compilation of %w.%n" fn)
+ ))
+ ))
+
+(de compile-file (fn)
+ (let* ((pathname (pathname fn))
+ (source-names
+ (cond ((pathname-type pathname)
+ (list (namestring pathname)))
+ (t (for (in ext '("build" "sl" "red"))
+ (collect
+ (namestring (pathname-set-default-type
+ pathname
+ ext)))))))
+ (binary-fn (namestring (pathname-set-type fn "b")))
+ (*quiet_faslout T)
+ (type NIL)
+ )
+ (for (in source-fn source-names)
+ (do
+ (cond
+ ((FileP source-fn)
+ (printf "%n----- Compiling %w%n" source-fn)
+ (faslout (namestring (pathname-without-type binary-fn)))
+ (setq type (pathname-type (pathname source-fn)))
+ (funcall (cond ((string-equal type "sl") 'dskin)
+ ((string-equal type "build") 'evin)
+ ((string-equal type "red") 'evin)
+ (t 'dskin))
+ source-fn)
+ (faslend)
+ (printf "%nDone compiling %w%n%n" source-fn)
+ (return t)
+ )))
+ (finally
+ (printf "Unable to find source file for: %w%n" fn)))))
ADDED psl-1983/3-1/util/rawbreak.build
Index: psl-1983/3-1/util/rawbreak.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rawbreak.build
@@ -0,0 +1,1 @@
+in "rawbreak.red"$
ADDED psl-1983/3-1/util/rawbreak.red
Index: psl-1983/3-1/util/rawbreak.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rawbreak.red
@@ -0,0 +1,19 @@
+% RAWBREAK.RED - A safer break loop if RAWIO is loaded
+% MLG 16 Jan 1983
+
+FLUID '(!*RAWIO);
+
+CopyD('OldBreak,'break);
+
+procedure newbreak();
+ Begin scalar OldRaw,x;
+ OldRaw :=!*RawIo;
+ If OldRaw then EchoOn();
+ x:=OldBreak();
+ If OldRaw Then EchoOff();
+ return x;
+ End;
+
+Copyd('break,'newbreak);
+flag('break,'lose);
+
ADDED psl-1983/3-1/util/rawio.red
Index: psl-1983/3-1/util/rawio.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rawio.red
@@ -0,0 +1,278 @@
+
+% RAWIO.RED - Support routines for PSL Emode
+%
+% Author: Eric Benson
+% Computer Science Dept.
+% University of Utah
+% Date: 17 August 1981
+% Copyright (c) 1981, 1982 University of Utah
+% Modified and maintained by William F. Galway.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% DEC-20 version
+
+FLUID '(!*rawio); % T if terminal is using "raw" i.o.
+
+CompileTime <<
+load if!-system;
+load syslisp$
+off UserMode; % csp 8/20/82
+
+if_system(Dec20,
+ <<
+ load monsym$
+ load jsys$
+ >>)
+>>;
+
+BothTimes if_system(Dec20, % CompileTime probably suffices.
+<<
+FLUID '( % Global?
+ OldCCOCWords
+ OldTIW
+ OldJFNModeWord
+ );
+
+lisp procedure BITS1 U;
+ if not NumberP U then Error(99, "Non-numeric argument to BITS")
+ else lsh(1, 35 - U);
+
+macro procedure BITS U;
+begin scalar V;
+ V := 0;
+ for each X in cdr U do V := lor(V, BITS1 X);
+ return V;
+end;
+
+>>);
+
+LoadTime if_system(Dec20,
+<<
+OldJfnModeWord := NIL; % Flag "modes not saved yet"
+
+lap '((!*entry PBIN expr 0)
+% Read a single character from the TTY as a Lisp integer
+ (pbin) % Issue PBIN
+ (!*CALL Sys2Int) % Turn it into a number
+
+ (!*exit 0)
+);
+
+lap '((!*entry PBOUT expr 1)
+% write a single charcter to the TTY, works for integers and single char IDs
+% Don't bother with Int2Sys?
+ (pbout)
+ (!*exit 0)
+);
+
+lap '((!*entry CharsInInputBuffer expr 0)
+% Returns the number of characters in the terminal input buffer.
+ (!*MOVE (WConst 8#101) (reg 1)) % The input file (the terminal, =
+ % 8#101)
+ (sibe) % skip if input buffer empty
+ (skipa (reg 1) (reg 2)) % otherwise # chars in r2
+ (setz (reg 1) 0) % if skipped, then zero
+ (!*CALL Sys2Int) % Turn it into a number
+
+ (!*exit 0)
+);
+
+lap '((!*entry RFMOD expr 1)
+% returns the JFN mode word as Lisp integer
+ (hrrzs (reg 1))
+ (rfmod)
+ (!*MOVE (reg 2) (reg 1)) % Get mode word from R2
+ (!*CALL Sys2Int)
+ (!*exit 0)
+);
+
+lap '((!*entry RFCOC expr 1)
+% returns the 2 CCOC words for JFN as dotted pair of Lisp integers
+ (hrrzs (reg 1))
+ (rfcoc)
+ (!*PUSH (reg 2)) % save the first word
+ (!*MOVE (reg 3) (reg 1))
+ (!*CALL Sys2Int) % make second into number
+
+ (exch (reg 1) (indexed (reg st) 0)) % grab first word, save
+ % tagged 2nd word.
+ (!*CALL Sys2Int) % make first into number
+ (!*POP (reg 2))
+ (!*JCALL Cons) % and cons them together
+);
+
+lap '((!*entry RTIW expr 1)
+% Returns terminal interrupt word for specified process, or -5 for entire job,
+% as Lisp integer
+ (hrrzs (reg 1)) % strip tag
+ (rtiw)
+ (!*MOVE (reg 2) (reg 1)) % result in r2, return in r1
+ (!*JCALL Sys2Int) % return as Lisp integer
+);
+
+lisp procedure SaveInitialTerminalModes();
+% Save the terminal modes, if not already saved.
+ if null OldJfnModeWord then
+ << OldJFNModeWord := RFMOD(8#101);
+ OldCCOCWords := RFCOC(8#101);
+ OldTIW := RTIW(-5);
+ >>;
+
+lap '((!*entry SFMOD expr 2)
+% SFMOD(JFN, ModeWord);
+% set program related modes for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (sfmod)
+ (!*exit 0)
+);
+
+lap '((!*entry STPAR expr 2)
+% STPAR(JFN, ModeWord);
+% set device related modes for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (stpar)
+ (!*exit 0)
+);
+
+lap '((!*entry SFCOC expr 3)
+% SFCOC(JFN, CCOCWord1, CCOCWord2);
+% set control character output control for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*PUSH (reg 3))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (exch (reg 1) (indexed (reg st) 0))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 3))
+ (!*POP (reg 2))
+ (!*POP (reg 1))
+ (sfcoc)
+ (!*exit 0)
+);
+
+lap '((!*entry STIW expr 2)
+% STIW(JFN, ModeWord);
+% set terminal interrupt word for the specified terminal
+ (hrrzs (reg 1))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL Int2Sys)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (stiw)
+ (!*exit 0)
+);
+
+lisp procedure EchoOff();
+% A bit of a misnomer, perhaps "on_rawio" would be better.
+% Off echo, On formfeed, send all control characters
+% Allow input of 8-bit characters (meta key)
+if not !*rawio then % Avoid doing anything if already "raw mode"
+<<
+ SaveInitialTerminalModes();
+
+ % Note that 8#101, means "the terminal".
+ % Clear bit 24 to turn echo off,
+ % bits 28,29 turn off "translation"
+ SFMOD(8#101, LAND(OldJFNModeWord, LNOT BITS(24, 28, 29)));
+
+ % Set bit 0 to indicate "has mechanical tab" (so cntrl-L gets
+ % through?).
+ % Clear bit 34 to turn off cntrl-S/cntrl-Q
+ STPAR(8#101, LAND(lor(OldJFNModeWord, BITS 1), LNOT BITS(34)));
+
+ % More nonsense to turn off processing of control characters?
+ SFCOC(8#101,
+ LNOT(8#252525252525),
+ LNOT(8#252525252525));
+
+ % Turn off terminal interrupts for entire job (-5), for everything
+ % except cntrl-C (the bit number three that's one).
+ STIW(-5,8#040000000000);
+
+ !*rawio := T; % Turn on flag
+>>;
+
+lisp procedure EchoOn();
+% Restore initial terminal echoing modes
+<<
+ % Avoid doing anything if OldJFNModeWord is NIL, means terminal mode
+ % already "restored".
+ if OldJFNModeWord then
+ <<
+ SFMOD(8#101,OldJFNModeWord);
+ STPAR(8#101,OldJFNModeWord);
+ SFCOC(8#101,car OldCCOCWords,cdr OldCCOCWords);
+ STIW(-5,OldTIW);
+ >>;
+
+ % Set to NIL so that things get saved again by
+ % SaveInitialTerminalModes. (The terminal status may have been changed
+ % between times.)
+ OldJFNModeWord := NIL;
+ !*rawio := NIL; % Indicate "cooked" i/o.
+>>;
+
+% Flush output buffer for stdoutput. (On theory that we're using buffered
+% I/O to speed things up.)
+Symbolic Procedure FlushStdOutputBuffer();
+NIL; % Just a dummy routine for the 20.
+>>
+);
+% END OF DEC-20 version.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% VAX Unix version
+
+LoadTime if_system(Unix,
+<<
+% EchoOn, EchoOff, and CharsInInputBuffer are part of "kernel".
+
+Symbolic Procedure PBIN();
+% Read a "raw character". NOTE--assumption that 0 gives terminal input.
+ VaxReadChar(0); % Just call this with "raw mode" on.
+
+Symbolic Procedure PBOUT(chr);
+% NOTE ASSUMPTION that 1 gives terminal output.
+ VaxWriteChar(1,chr);
+
+>>);
+% END OF Unix version.
+
+fluid '(!*EMODE);
+
+LoadTime
+<<
+!*EMODE := NIL;
+
+Symbolic Procedure rawio_break();
+% Redefined break handler to turn echoes back on after a break, unless
+% EMODE is running.
+<<
+ if !*rawio and not !*EMODE then
+ EchoOn();
+
+ pre_rawio_break(); % May want to be paranoid and use a "catch(nil,
+ % '(pre_rawio_break)" here.
+>>;
+
+% Carefully redefine the break handler.
+if null getd('pre_rawio_break) then
+<<
+CopyD('pre_rawio_break, 'Break);
+CopyD('break, 'rawio_break);
+>>;
+
+>>;
+
ADDED psl-1983/3-1/util/rcref.build
Index: psl-1983/3-1/util/rcref.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rcref.build
@@ -0,0 +1,4 @@
+% changed to LOAD GSORT when needed.
+in "psl-crefio.red"$
+Imports '(Gsort);
+in "psl-cref.red"$
ADDED psl-1983/3-1/util/read-macros.sl
Index: psl-1983/3-1/util/read-macros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/read-macros.sl
@@ -0,0 +1,322 @@
+% READ-MACROS.SL - some specilized reader macros
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% Edit by Cris Perdue, 1 Feb 1983 1400-PST
+% Dochar moved into "nonkernel", "C" for "CONTROL", etc. commented out.
+% Many miscellaneous symbolic names for characters removed.
+
+((lambda (o-table)
+ (setq LispScanTable* (TotalCopy o-table)) % in case it's in pure space
+ (cond ((eq CurrentScanTable* o-table)
+ (setq CurrentScanTable* LispScanTable*))))
+ LispScanTable*)
+
+% plug backquote and friends into the lisp reader via read macros
+% ` for backquote, , for unquote, ,@ for unquotel, and ,. for unquoted
+
+(de backquote-read-macro (channel qt)
+ (list 'backquote (ChannelReadTokenWithHooks channel)))
+
+(de unquote-read-macro (channel qt)
+ (list 'unquote (ChannelReadTokenWithHooks channel)))
+
+(de unquotel-read-macro (channel qt)
+ (list 'unquotel (ChannelReadTokenWithHooks channel)))
+
+(de unquoted-read-macro (channel qt)
+ (list 'unquoted (ChannelReadTokenWithHooks channel)))
+
+(putv LispScanTable* (char !`) 11)
+
+(putv LispScanTable* (char !,) 13)
+
+(put '!, (getv LispScanTable* 128) '((!@ . !,!@)(!. . !,!.)))
+
+(deflist
+ '((!` backquote-read-macro)
+ (!, unquote-read-macro)
+ (!,!@ unquotel-read-macro)
+ (!,!. unquoted-read-macro))
+ 'LispReadMacro)
+
+% A couple of MACLISP style sharp sign read macros...
+
+(putv LispScanTable* (char !#) 13)
+
+(put '!# (getv LispScanTable* 128) '((!. . !#!.)
+ (!/ . !#!/)
+ (!' . !#!')
+ (!+ . !#!+)
+ (!- . !#!-)
+ (!\ . !#!\)))
+
+(deflist
+ `((!#!' ,(function function-read-macro))
+ (!#!. ,(function eval-read-macro))
+ (!#!\ ,(function char-read-macro))
+ (!#!+ ,(function if-system-read-macro))
+ (!#!- ,(function if-not-system-read-macro))
+ (!#!/ ,(function single-char-read-macro)))
+ 'LispReadMacro)
+
+(de function-read-macro (channel qt)
+ `(function ,(ChannelReadTokenWithHooks channel)))
+
+(de eval-read-macro (channel qt)
+ (eval (ChannelReadTokenWithHooks channel)))
+
+% (imports '(if-system)) % actually doesn't use the code, just the convention
+
+(fluid '(system_list*))
+
+(de if-system-read-macro (channel qt)
+ ((lambda (system)
+ ((lambda (when_true)
+ (cond ((memq system system_list*) when_true)
+ (t (ChannelReadTokenWithHooks channel))))
+ (ChannelReadTokenWithHooks channel)))
+ (ChannelReadTokenWithHooks channel)))
+
+(de if-not-system-read-macro (channel qt)
+ ((lambda (system)
+ ((lambda (when_false)
+ (cond ((not (memq system system_list*)) when_false)
+ (t (ChannelReadTokenWithHooks channel))))
+ (ChannelReadTokenWithHooks channel)))
+ (ChannelReadTokenWithHooks channel)))
+
+%(de when-read-macro (channel qt)
+% (let ((a (ChannelReadTokenWithHooks channel)))
+% (let ((b (ChannelReadTokenWithHooks channel))
+% (fn (and (idp a) (get a 'when-macro))))
+% (if fn
+% (apply fn (list b))
+% (StdError (BldMsg "Can't evaluate %r at %r time" b a))))))
+
+% CompileTime and friends have to be made to work from LISP before these
+% will be of much use.
+
+%(foreach u in '(compile c CompileTime compile-time comp) do
+% (put u 'when-macro #'(lambda(x) `(CompileTime ,x))))
+
+%(foreach u in '(load l LoadTime load-time) do
+% (put u 'when-macro #'(lambda(x) `(LoadTime ,x))))
+
+%(foreach u in '(both b BothTimes both-times BothTime both-time) do
+% (put u 'when-macro #'(lambda(x) `(BothTimes ,x))))
+
+%(foreach u in '(read r ReadTime read-time) do
+% (put u 'when-macro #'eval))
+
+(de single-char-read-macro (channel qt)
+ (ChannelReadChar channel))
+% % Frightfully kludgey. Anybody know how to just read the one character?
+% ((lambda (*raise)
+% ((lambda (ch)
+% ((lambda (n)
+% (if (lessp n 128)
+% n
+% (StdError (BldMsg "%r is illegal after #/" ch))))
+% (dochar ch)))
+% (ChannelReadTokenWithHooks channel)))
+% nil))
+
+(de char-read-macro (channel qt)
+ (dochar (ChannelReadTokenWithHooks channel)))
+
+% Definition of dochar moved to char-macro.sl in the kernel /csp
+% Alternative modifiers (below) removed, hope they aren't needed (yuk) /csp
+
+% (put 'c 'char-prefix-function (get 'control 'char-prefix-function))
+% (put '!^ 'char-prefix-function (get 'control 'char-prefix-function))
+% (put 'm 'char-prefix-function (get 'meta 'char-prefix-function))
+
+(commentoutcode
+(deflist
+% let char know all about the "standard" two and three letter names for
+% non-printing ASCII characters.
+ '((NUL 0)
+ (SOH 1)
+ (STX 2)
+ (ETX 3)
+ (EOT 4)
+ (ENQ 5)
+ (ACK 6)
+ (BEL 7)
+ (BS 8)
+ (HT 9)
+ (NL 10)
+ (VT 11)
+ (NP 12)
+ (CR 13)
+ (SO 14)
+ (SI 15)
+ (DLE 16)
+ (DC1 17)
+ (DC2 18)
+ (DC3 19)
+ (DC4 20)
+ (NAK 21)
+ (SYN 22)
+ (ETB 23)
+ (CAN 24)
+ (EM 25)
+ (SUB 26)
+ (ESC 27)
+ (FS 28)
+ (GS 29)
+ (RS 30)
+ (US 31)
+ (SP 32)
+ (DEL 127))
+ 'charconst)
+)
+
+(commentoutcode
+(deflist
+ '((!^!@ 0) % "creeping featurism" here for sure...
+ (!^A 1)
+ (!^B 2)
+ (!^C 3)
+ (!^D 4)
+ (!^E 5)
+ (!^F 6)
+ (!^G 7)
+ (!^H 8)
+ (!^I 9)
+ (!^J 10)
+ (!^K 11)
+ (!^L 12)
+ (!^M 13)
+ (!^N 14)
+ (!^O 15)
+ (!^P 16)
+ (!^Q 17)
+ (!^R 18)
+ (!^S 19)
+ (!^T 20)
+ (!^U 21)
+ (!^V 22)
+ (!^W 23)
+ (!^X 24)
+ (!^Y 25)
+ (!^Z 26)
+ (!^![ 8#33)
+ (!^!\ 8#34)
+ (!^!] 8#35)
+ (!^!^ 8#36)
+ (!^!~ 8#36) % for telerays...
+ (!^!_ 8#37)
+ (!^!/ 8#37) % for telerays...
+ (!^!? 8#177))
+ 'charconst)
+)
+
+(commentoutcode
+% It has been suggested that nice names for printing characters would be good,
+% too, so here are some. I don't really see that they're all that much use,
+% but I guess they don't do any harm. I doubt I'll ever use them, though.
+% If this isn't "creeping featurism" I don't know what is....
+(foreach u in
+ '((BANG !!)
+ (EXCLAMATION !!)
+ (AT !@)
+ (ATSIGN !@)
+ (SHARP !#)
+ (POUND !#)
+ (NUMBER !#)
+ (NUMBER-SIGN !#)
+ (HASH !#)
+ (NOT-EQUAL !#) % For Algol 60 fans...
+ (DOLLAR !$)
+ (PERCENT !%)
+ (CARET !^)
+ (UPARROW !^)
+ (AND !&)
+ (AMPERSAND !&)
+ (STAR !*)
+ (TIMES !*)
+ (LPAREN !( )
+ (LEFT-PARENTHESIS !( )
+ (LEFT-PAREN !( )
+ (LPAR !( )
+ (OPEN !( )
+ (RPAREN !) )
+ (RIGHT-PARENTHESIS !) )
+ (RIGHT-PAREN !) )
+ (RPAR !) )
+ (CLOSE !) )
+ (MINUS !-)
+ (DASH !-)
+ (UNDERSCORE !_)
+ (UNDERLINE !_)
+ (BACKARROW !_)
+ (PLUS !+)
+ (EQUAL !=)
+ (EQUALS !=)
+ (TILDE !~)
+ (BACKQUOTE !`)
+ (LBRACE !{)
+ (LEFT-BRACE !{)
+ (RBRACE !})
+ (RIGHT-BRACE !})
+ (LBRACKET ![)
+ (LEFT-BRACKET ![)
+ (LBRA ![)
+ (RBRACKET !])
+ (RIGHT-BRACKET !])
+ (RBRA !])
+ (APOSTROPHE !')
+ (SINGLE-QUOTE !')
+ (QUOTE-MARK !')
+ (DOUBLE-QUOTE !")
+ (STRING-MARK !")
+% (QUOTE should this be ' or " -- I'll play it safe and not use either
+ (COLON !:)
+ (SEMI !;)
+ (SEMICOL !;)
+ (SEMICOLON !;)
+ (QUESTION !?)
+ (QUESTION-MARK !?)
+ (QUESTIONMARK !?)
+ (LESS !<)
+ (LESS-THAN !<)
+ (LANGLE !<)
+ (LEFT-ANGLE !<)
+ (LEFT-ANGLE-BRACKET !<)
+ (GREATER !>)
+ (GREATER-THAN !>)
+ (GRTR !>)
+ (RANGLE !>)
+ (RIGHT-ANGLE !>)
+ (RIGHT-ANGLE-BRACKET !>)
+ (COMMA !,)
+ (DOT !.)
+ (PERIOD !.)
+ (FULL-STOP !.) % For the English among us...
+ (SLASH !/)
+ (SOLIDUS !/)
+ (DIVIDE !/)
+ (BACKSLASH !\)
+ (BAR !|)
+ (VERTICAL !|)
+ (VETICAL-BAR !|)
+ (ZERO !0)
+ (NAUGHT !0) % For the English among us...
+ (ONE !1)
+ (TWO !2)
+ (THREE !3)
+ (FOUR !4)
+ (FIVE !5)
+ (SIX !6)
+ (SEVEN !7)
+ (EIGHT !8)
+ (NINE !9))
+ do (put (car u) 'charconst (dochar (cadr u))))
+)
ADDED psl-1983/3-1/util/read-utils.build
Index: psl-1983/3-1/util/read-utils.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/read-utils.build
@@ -0,0 +1,1 @@
+in "read-utils.red"$
ADDED psl-1983/3-1/util/read-utils.red
Index: psl-1983/3-1/util/read-utils.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/read-utils.red
@@ -0,0 +1,107 @@
+% READ-TABLE-UTILS.RED - Read Table Utils
+%
+% Author: M. L. Griss
+% Computer Science Dept.
+% University of Utah
+% Date: 28 August 1981
+% Copyright (c) 1981 University of Utah
+
+% NOTE: Rather Crude, needs some work.
+
+% Edit by Cris Perdue, 28 Jan 1983 2040-PST
+% Occurrences of dipthong changed to diphthong
+
+Fluid '( CharacterClass!* );
+
+Lisp procedure PrintScanTable (Table);
+ Begin Scalar I;
+ I := 0;
+ For I :=0:127 do
+ <<Prin1 I;
+ TAB 5;
+ prin2 Int2Id I;
+ Tab 15;
+ print CharacterClass!*[Table[I]] >>;
+ PrintF(" Diphthong name: %r%n",Table[128]);
+%/ PrintF(" ReadMacro name: %r%n",Table[129]);
+%/ PrintF(" SpliceMacro name: %r%n",Table[130]);
+ End;
+%%% Some id names for the classes
+
+Lisp Procedure CopyScanTable(OldTable);
+ Begin
+ If Null OldTable then OldTable:=CurrentScanTable!*;
+ If not (vectorp OldTable and UpbV(oldTable)=130) then
+ return StdError "CopyScanTable expects a valid Readtable";
+ OldTable:=Copy OldTable;
+ OldTable[128]:=Gensym();
+ OldTable[129]:=Gensym();
+ OldTable[130]:=Gensym();
+ Return OldTable;
+ End;
+
+LoadTime <<
+CharacterClass!*:=
+'[Digit Digit Digit Digit Digit Digit Digit Digit Digit Digit
+ Letter Delimiter Comment Diphthong IdEscape StringQuote Package Ignore
+ Minus Plus Decimal];
+
+Put('Letter, 'CharacterClass!*, 10);
+Put('Delimiter, 'CharacterClass!*, 11);
+Put('Comment, 'CharacterClass!*, 12);
+Put('Diphthong, 'CharacterClass!*, 13);
+Put('IdEscape, 'CharacterClass!*, 14);
+Put('StringQuote, 'CharacterClass!*, 15);
+Put('Package, 'CharacterClass!*, 16);
+Put('Ignore, 'CharacterClass!*, 17);
+Put('Minus, 'CharacterClass!*, 18);
+Put('Plus, 'CharacterClass!*, 19);
+Put('Decimal, 'CharacterClass!*, 20) >>;
+
+Lisp procedure PutCharacterClass(Table,Ch,Val);
+ ChangeCharType(Table,Ch,Val);
+
+Symbolic Procedure ChangeCharType(TBL,Ch,Ty); %. Set Character type
+begin scalar IDNum;
+ If IdP Ty then Ty := Get(Ty,'CharacterClass!*);
+ If IDP Ch and (IDNum := ID2Int Ch) < 128 and
+ Numberp Ty and Ty >=0 and Ty <=20 then
+ PutV(TBL,IDNum,Ty)
+ Else Error(99,"Cant Set ReadTable");
+end;
+
+Symbolic Procedure PutDiphthong(TBL,StartCh, FollowCh, Diphthong);
+ If IDP Startch and IDP FollowCh and IDP Diphthong
+ then <<ChangeCharType(TBL,StartCh,13);
+ PUT(StartCh,TBL[128],
+ (FollowCh . Diphthong) . GET(StartCh,TBL[128]))>>
+ else Error(99, "Cant Declare Diphthong");
+
+Symbolic Procedure MakeDiphthong(TBL,DipIndicator,StartCh, FollowCh, Diphthong);
+ If IDP Startch and IDP FollowCh and IDP Diphthong
+ then <<ChangeCharType(TBL,StartCh,13);
+ PUT(StartCh,DipIndicator,
+ (FollowCh . Diphthong) . GET(StartCh,DipIndicator))>>
+ else Error(99, "Cant Declare Diphthong");
+
+Lisp procedure PutReadMacro(Table,x,Fn);
+ Begin
+ If not IdP x then IdError(x,'PutReadMacro);
+ If Not IdP Fn then return IDError(x,'PutReadMacro);
+ % Check Delimiter Class as 11 or 23
+ Put(x,Table[129],Fn);
+ Remprop(x,Table[130]);
+ End;
+
+%/ Splice macros currently "frowned" upon
+
+Lisp procedure PutSpliceMacro(Table,x,Fn);
+ Begin
+ If not IdP x then IdError(x,'PutSpliceMacro);
+ If Not IdP Fn then return IDError(x,'PutSpliceMacro);
+ % Check Delimiter Class as 11 or 13
+ Put(x,Table[130],Fn);
+ Remprop(x,Table[129]);
+ End;
+
+end;
ADDED psl-1983/3-1/util/ring-buffer.sl
Index: psl-1983/3-1/util/ring-buffer.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/ring-buffer.sl
@@ -0,0 +1,90 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% RING-BUFFER.SL - General Ring Buffers
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 6 July 1982
+% Revised: 16 November 1982
+%
+% 16-Nov-82 Alan Snyder
+% Recoded using OBJECTS package. Added FETCH and ROTATE operations.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors))
+
+(de ring-buffer-create (maximum-size)
+ (make-instance 'ring-buffer 'maximum-size maximum-size))
+
+(defflavor ring-buffer ((maximum-size 16) % Maximum number of elements.
+ vec % Stores the elements.
+ (size 0) % Elements 0..size-1 are valid.
+ (ptr -1) % Element vec[ptr] is current.
+ )
+ ()
+ (gettable-instance-variables maximum-size size)
+ (initable-instance-variables maximum-size)
+ )
+
+(defmethod (ring-buffer init) (init-plist)
+ (setf vec (mkvect (- maximum-size 1))))
+
+(defmethod (ring-buffer push) (new-element)
+ (let ((new-ptr (+ ptr 1)))
+ (when (> new-ptr (vector-upper-bound vec))
+ (setf new-ptr 0))
+ (when (>= new-ptr size)
+ (setf size (+ new-ptr 1)))
+ (setf ptr new-ptr)
+ (vector-store vec new-ptr new-element)
+ new-element
+ ))
+
+(defmethod (ring-buffer top) ()
+ % Returns NIL if the buffer is empty.
+ (=> self fetch 0))
+
+(defmethod (ring-buffer pop) ()
+ % Returns NIL if the buffer is empty.
+ (when (> size 0)
+ (let ((old-element (vector-fetch vec ptr)))
+ (setf ptr (- ptr 1))
+ (when (< ptr 0) (setf ptr (- size 1)))
+ old-element
+ )))
+
+(defmethod (ring-buffer fetch) (index)
+ % Index 0 is the top element.
+ % Index -1 is the next previous element, etc.
+ % Index 1 is the most previous element, etc.
+ % Returns NIL if the buffer is empty.
+
+ (when (> size 0)
+ (vector-fetch vec (ring-buffer-mod (+ ptr index) size))
+ ))
+
+(defmethod (ring-buffer rotate) (count)
+ % Rotate -1 makes the next "older" element current (like POP), etc.
+ % Rotate 1 makes the next "newer" element current, etc.
+
+ (when (> size 0)
+ (setf ptr (ring-buffer-mod (+ ptr count) size))
+ ))
+
+(de ring-buffer-mod (a b)
+ (let ((remainder (// a b)))
+ (if (>= remainder 0) remainder (+ b remainder))
+ ))
+
+% The following functions are defined for backwards compatibility:
+
+(de ring-buffer-push (rb new-element)
+ (=> rb push new-element))
+
+(de ring-buffer-top (rb)
+ (=> rb top))
+
+(de ring-buffer-pop (rb)
+ (=> rb pop))
ADDED psl-1983/3-1/util/rlisp-parser.red
Index: psl-1983/3-1/util/rlisp-parser.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rlisp-parser.red
@@ -0,0 +1,1138 @@
+%
+% RLISP-PARSER.RED - RLISP parser based on Nordstrom and Pratt model
+%
+% Author: Martin Griss and Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: May 1981
+% Copyright (c) 1981 University of Utah
+%
+% Known Bugs and Problems:
+% Procedure TEMPLATES parsed at wrong precendence, so
+% procedure x/y; is ok
+% procedure (x/Y) fails!
+%
+% IF a Then B; ELSE c; parses badly, doesnt catch ELSE
+% QUOTIENT(A,B) parses as RECIP(A)
+%
+% Edit by Nancy Kendzierski, 07 Apr 1983 1337-PST
+% Changed SEMIC!* to fluid (also in rlisp-support) to match kernel decls.
+% Edit by Cris Perdue, 28 Jan 1983 2038-PST
+% Occurrences of "dipthong" changed to "diphthong"
+% <PSL.UTIL.NEWVERSIONS>RLISP-PARSER.RED.4, 16-Dec-82 12:11:15, Edit by KESSLER
+% Make SEMIC!* a Global (as in rlisp-support), so it won't be made fluid in
+% compilation of Scan.
+% <PSL.UTIL>RLISP-PARSER.RED.3, 13-Dec-82 13:14:36, Edit by OTHMER
+% Flagged EMB as 'FTYPE so debug functions will work
+% <PSL.UTIL>RLISP-PARSER.RED.42, 17-Mar-82 02:36:14, Edit by BENSON
+% Finally infix as prefix works!!!
+% <PSL.UTIL>RLISP-PARSER.RED.25, 14-Jan-82 13:16:34, Edit by BENSON
+% Added JOIN to for each
+% <PSL.UTIL>RLISP-PARSER.RED.24, 30-Dec-81 01:01:30, Edit by BENSON
+% Unfixed infix as prefix. Have to check to make sure the thing is an arglist
+% <PSL.UTIL>RLISP-PARSER.RED.21, 28-Dec-81 15:22:37, Edit by BENSON
+% fixed LAMBDA();...
+% <PSL.UTIL>RLISP-PARSER.RED.21, 28-Dec-81 15:21:43, Edit by BENSON
+% Infix operators used as prefix are parsed correctly
+% <PSL.UTIL>RLISP-PARSER.RED.19, 28-Dec-81 14:44:47, Edit by BENSON
+% Removed assign-op in favor of SetF
+% <PSL.UTIL>RLISP-PARSER.RED.36, 5-Feb-82 07:17:34, Edit by GRISS
+% Add NE as infix
+
+CompileTime flag('(DefineBOpX DefineROpX DoInfixAsPrefix IsOpOp
+ DoPrefix DoInfix MakeLocals MkQuotList
+ PrecSet InfixOp PrefixOp RlispRead RemSemicol
+ SymErr RAtomHook
+ CommentPart), 'InternalFunction);
+
+FLUID '(CURSYM!* !*InsideStructureRead SEMIC!*);
+CURSYM!*:='! ;
+global '(TokType!*);
+
+lisp procedure SymErr(X, Y);
+ StdError BldMsg("Syntax error %r", X);
+
+SYMBOLIC PROCEDURE SCAN;
+ BEGIN SCALAR X;
+A: CURSYM!* := RATOMHOOK();
+ IF TOKTYPE!* EQ 3 THEN %/ Also a R,
+ (IF CURSYM!* EQ '!' THEN CURSYM!* := LIST('QUOTE, RLISPREAD())
+ ELSE IF (X:=GET(CURSYM!*,'NeWNAM!-OP))THEN
+ <<IF X EQ '!*SEMICOL!* THEN SEMIC!* := CURSYM!*;
+ CURSYM!*:=X >> );
+ IF (X:=(GET(CURSYM!*,'NEWNAM))) THEN CURSYM!*:=X;
+ IF CURSYM!* EQ 'COMMENT THEN
+ << WHILE NOT (READCH() MEMQ '(!; !$)) DO ; GOTO A >>;
+ RETURN CURSYM!*;
+ END;
+
+SYMBOLIC PROCEDURE RESETPARSER;
+ CURSYM!*:= '! ;
+
+%-----------------------------------------------------------------
+%--- Boot strap functions, move to build file-----;
+
+FLUID '( %. Name of Grammer being defined
+ DEFPREFIX
+ DEFINFIX
+ GRAMPREFIX
+ GRAMINFIX
+); %. Name of grammer running
+
+
+DEFPREFIX := 'RLISPPREFIX; %. Key for Grammer being defined
+DEFINFIX := 'RLISPINFIX; %. Key for Grammer being defined
+GRAMPREFIX := 'RLISPPREFIX; %. Key for Grammer being defined
+GRAMINFIX := 'RLISPINFIX; %. Key for Grammer being defined
+
+
+SYMBOLIC FEXPR PROCEDURE DEFINEBOP U;
+ DEFINEBOPX U;
+
+SYMBOLIC PROCEDURE DEFINEBOPX U;
+% u=(opname, lprec, rprec,function)
+ BEGIN SCALAR W,Y;
+ W := EVAL CAR U; % Opname; Remove ' which used to suppress OP props
+ Y :=
+ EVAL CADR U % Lprec
+ . EVAL CADDR U % Rprec
+ . IF NULL CDDDR U THEN NIL % Default function is NIL
+ ELSE IF ATOM CADDDR U THEN CADDDR U
+ ELSE LIST('LAMBDA,'(X Y),CADDDR U);
+ PUT(W,DEFINFIX,Y) % Binop in CAR
+ END;
+
+SYMBOLIC PROCEDURE INFIXOP U; % Used also in REDUCE
+ GET(U,GRAMINFIX);
+
+SYMBOLIC PROCEDURE INFIXPREC U; % Used in REDUCE MathPrint
+ BEGIN SCALAR V;
+ IF NULL(V:=INFIXOP U) THEN RETURN NIL;
+ IF PAIRP V AND NUMBERP CAR V THEN RETURN CAR V;
+ RETURN NIL;
+ END;
+
+SYMBOLIC FEXPR PROCEDURE DEFINEROP U;
+ DEFINEROPX U;
+
+SYMBOLIC PROCEDURE DEFINEROPX U;
+% u=(opname,lprec,function)
+ BEGIN SCALAR W,Y;
+ W := EVAL CAR U; % Name, remove ' mark
+ Y :=
+ EVAL CADR U % Lprec
+ . IF NULL CDDR U THEN NIL % Default is NIL
+ ELSE IF ATOM CADDR U THEN CADDR U % function name
+ ELSE LIST('LAMBDA,'(X),CADDR U); %
+ PUT(W,DEFPREFIX,Y)
+ END;
+
+SYMBOLIC PROCEDURE PREFIXOP U;
+ GET(U,GRAMPREFIX);
+
+FLUID '(OP); %. Current TOKEN being studied
+
+% ***** General Parser Functions *****;
+
+SYMBOLIC PROCEDURE PARSE0(RP,PRESCAN); %. Collect Phrase to LP<RP
+ BEGIN SCALAR CURSYM,U;
+%/ IF COMPR!* AND CURSYM!* EQ CAAR COMPR!*
+%/ THEN <<CURSYM := CAR COMPR!*; COMPR!* := CDR COMPR!*>>;
+ OP := IF PRESCAN THEN SCAN() ELSE CURSYM!*;
+%/ IF PRESCAN AND COMPR!* AND CURSYM!* EQ CAAR COMPR!*
+%/ THEN <<CURSYM := CAR COMPR!*; COMPR!* := CDR COMPR!*>>;
+ U := RDRIGHT(RP,OP);
+%/ IF CURSYM THEN RPLACA(CURSYM,U);
+ RETURN U
+ END;
+
+SYMBOLIC PROCEDURE RDRIGHT(RP,Y); %. Collect phrase until OP with LP<RP
+% Y is starting TOKEN.
+% RP=NIL - Caller applies Function to Y, without collecting RHS subphrase
+ BEGIN SCALAR TEMP,OP1,TEMPSCAN, TEMPOP, !*InsideStructureRead;
+ !*InsideStructureRead := T;
+ IF NULL RP THEN RETURN Y
+ %/ ELSE IF IDFLAG THEN OP := SCAN() % Set IDFLAG if not Operator
+ ELSE IF RP=0 AND Y EQ '!*SEMICOL!* THEN RETURN NIL %/ Toplevel ; or $?
+ ELSE IF (TEMP:=PREFIXOP Y)
+ THEN
+ << TEMPSCAN := SCAN();
+ IF STRONGERINFIXOP(TEMPSCAN, Y, CAR TEMP) THEN
+ OP := TEMPSCAN
+ ELSE
+ Y := DOPREFIX(CDR TEMP,Y,RDRIGHT(CAR TEMP,TEMPSCAN)) >>
+ ELSE IF NOT INFIXOP Y THEN OP := SCAN()
+ %/ Binary OP in Prefix Position
+ ELSE IF ISOPOP(OP,RP,Y) THEN <<OP := Y; Y := NIL>>
+ ELSE OP := SCAN();% Y:=DoINFIXasPREFIX(Y,OP:=SCAN());
+ RDLEFT:
+ IF %/IDFLAG OR
+ NOT (TEMP := INFIXOP OP)
+ THEN IF NULL OP
+ THEN <<Y := LIST(Y,NIL); OP := SCAN()>>
+ ELSE Y := REPCOM(Y,RDRIGHT(99,OP)) %. Do as PREFIX
+ ELSE IF RP>CAR TEMP THEN RETURN Y
+ ELSE <<OP1:=OP; %/ !*ORD PROBLEM?
+ TEMPSCAN := SCAN();
+ IF TEMPSCAN = '!*LPAR!* AND NOT FUNBOUNDP OP1 THEN
+ << OP := TEMPSCAN; %/ kludge to allow infix/prefix
+ TEMPSCAN := RDRIGHT(CADR TEMP, OP);
+ IF EQCAR(TEMPSCAN, '!*COMMA!*) THEN
+ Y := LIST(Y, REPCOM(OP1, TEMPSCAN))
+ ELSE Y := DOINFIX(CDDR TEMP,Y,OP1,TEMPSCAN) >>
+ ELSE IF STRONGERINFIXOP(TEMPSCAN, OP1, CADR TEMP) THEN
+ << Y := LIST(Y, OP1);
+ OP := TEMPSCAN >>
+ ELSE
+ Y := DOINFIX(CDDR TEMP,Y,OP1,RDRIGHT(CADR TEMP,TEMPSCAN))>>;
+ GO TO RDLEFT
+ END;
+
+SYMBOLIC PROCEDURE STRONGERINFIXOP(NEXTOP, LASTOP, LASTPREC);
+BEGIN SCALAR TEMPOP, MATCHER;
+ RETURN NOT PREFIXOP NEXTOP
+ AND (TEMPOP := INFIXOP NEXTOP)
+ AND NUMBERP LASTPREC AND NUMBERP CAR TEMPOP
+ AND CAR TEMPOP <= 6
+ AND CAR TEMPOP <= LASTPREC
+ AND NOT ((MATCHER := GET(LASTOP, 'CLOSER))
+ AND MATCHER EQ NEXTOP)
+ AND NOT ISOPOP(NEXTOP, LASTPREC, LASTOP);
+END;
+
+DefList('((BEGIN END)
+ (!*LPAR!* !*RPAR!*)
+ (!*LSQB!* !*RSQB!*)
+ (!*LVEC!* !*RVEC!*)), 'CLOSER);
+
+SYMBOLIC PROCEDURE DoINFIXasPREFIX(LHS,BOP);
+ REPCOM(LHS,RDRIGHT(99,BOP));
+
+%. Note that PREFIX functions have next token SCANed, and get an argument,
+%. "X", that is either this TOKEN, or a complete parsed Phrase
+
+SYMBOLIC PROCEDURE DOPREFIX(ACT,ROP,RHS);
+ IF NULL ACT THEN LIST(ROP,RHS)
+ ELSE APPLY(ACT,LIST RHS);
+
+%. Note that INFIX functions have next token SCANed, and get two arguments,
+%. "X" and "Y"; "X" is LHS phrase,
+%. "Y" is either the scanned TOKEN, or a complete parsed Phrase
+
+SYMBOLIC PROCEDURE DOINFIX(ACT,LHS,BOP,RHS);
+ IF NULL ACT THEN LIST(BOP,LHS,RHS)
+ ELSE APPLY(ACT,LIST(LHS,RHS));
+
+SYMBOLIC PROCEDURE ISOPOP(XOP,RP,Y); %. Test for legal OP-> <-OP
+ IF RP=2 THEN Y EQ '!*RPAR!* % LPAR scans for LP 2
+ ELSE IF RP=0 AND XOP EQ 'END
+ AND Y MEMBER '(!*SEMICOL!* !*COLON!* !*RSQB!* END) THEN T
+ ELSE IF Y MEMQ '(!*SEMICOL!* END !*RSQB!*) % Special cases in BEGIN-END
+ THEN RP= -2 OR XOP MEMQ '(!*SEMICOL!* !*COLON!* !*RSQB!*)
+ ELSE NIL;
+
+SYMBOLIC PROCEDURE PARERR(X,Y);
+ StdError X;
+
+SYMBOLIC PROCEDURE REMCOM X; %. (, x y z) -> (x y z)
+ IF EQCAR(X,'!*COMMA!*) THEN CDR X ELSE LIST X;
+
+SYMBOLIC PROCEDURE REMSEMICOL X; %. (; x y z) -> (x y z)
+ IF EQCAR(X,'!*SEMICOL!*) THEN CDR X ELSE LIST X;
+
+SYMBOLIC PROCEDURE REPCOM(TYPE,X); %. Create ARGLIST
+ IF EQCAR(X,'!*COMMA!*) THEN (TYPE . CDR X)
+ ELSE IF X EQ '!*EMPTY!* THEN LIST(TYPE)
+ ELSE LIST(TYPE,X);
+
+%SYMBOLIC PROCEDURE SELF RHS; %. Prefix Operator returns RHS
+% RHS;
+
+SYMBOLIC PROCEDURE ParseNOOP X;
+ <<OP:=SCAN();X>>;
+
+DEFINEROP('NOOP,NIL,ParseNOOP); %. Prevent TOKEN from being an OP
+
+SYMBOLIC PROCEDURE MKQUOTLIST U;
+ %this could be replaced by MKQUOTE in most cases;
+ 'LIST
+ . FOR EACH X IN U COLLECT IF CONSTANTP X THEN X ELSE MKQUOTE X;
+
+SYMBOLIC PROCEDURE NARY(XOP,LHS,RHS); %. Remove repeated NARY ops
+ IF EQCAR(LHS,XOP) THEN ACONC(LHS,RHS) ELSE LIST(XOP,LHS,RHS);
+
+% ***** Tables for Various Infix Operators *****;
+
+SYMBOLIC PROCEDURE ParseCOMMA(X,Y);
+ NARY('!*COMMA!*,X,Y);
+
+DEFINEBOP('!*COMMA!*,5,6,ParseCOMMA );
+
+SYMBOLIC PROCEDURE ParseSEMICOL(X,Y);
+ NARY('!*SEMICOL!*,X,Y);
+
+DEFINEBOP('!*SEMICOL!*, - 1,0,ParseSEMICOL );
+
+SYMBOLIC PROCEDURE ParseSETQ(LHS,RHS); %. Extended SETQ
+ LIST(IF ATOM LHS THEN 'SETQ ELSE 'SETF, LHS, RHS);
+
+DEFINEBOP('SETQ,7,6,ParseSETQ);
+
+DEFINEBOP('CONS,23,21);
+
+SYMBOLIC PROCEDURE ParsePLUS2(X,Y);
+ NARY('PLUS,X,Y);
+
+DEFINEBOP('PLUS,17,18,ParsePLUS2);
+
+%SYMBOLIC PROCEDURE ParsePLUS1(X);
+% IF EQCAR(X,'!*COMMA!*) THEN REPCOM('PLUS,X) ELSE X;
+%
+%DEFINEROP('PLUS,26,ParsePLUS1); %/ **** Prefix + sign...
+
+DEFINEROP('MINUS,26);
+
+SYMBOLIC PROCEDURE ParseDIFFERENCE(X);
+ IF NUMBERP X THEN (0 - X )
+ ELSE IF EQCAR(X,'!*COMMA!*)
+ THEN REPCOM('DIFFERENCE,X)
+ ELSE LIST('MINUS,X);
+
+DEFINEROP('DIFFERENCE,26,ParseDIFFERENCE );
+
+DEFINEBOP('DIFFERENCE,17,18);
+
+DEFINEBOP('TIMES,19,20);
+
+SYMBOLIC PROCEDURE ParseQUOTIENT(X);
+ IF NOT EQCAR(X,'!*COMMA!*) THEN LIST('RECIP,X)
+ ELSE REPCOM('QUOTIENT,X);
+
+DEFINEROP('QUOTIENT,26,ParseQUOTIENT);
+
+DEFINEBOP('QUOTIENT,19,20);
+
+DEFINEROP('RECIP,26);
+
+DEFINEBOP('EXPT,23,24);
+
+SYMBOLIC PROCEDURE ParseOR(X,Y);
+ NARY('OR,X,Y);
+
+DEFINEBOP('OR,9,10,ParseOR);
+
+%/DEFINEROP('OR,26,REPCOM('OR,X));
+
+SYMBOLIC PROCEDURE ParseAND(X,Y);
+ NARY('AND,X,Y);
+
+DEFINEBOP('AND,11,12,ParseAND);
+
+%/DEFINEROP('AND,26,REPCOM('AND,X));
+
+DEFINEROP('NOT,14);
+
+DEFINEBOP('MEMBER,15,16);
+
+%/DEFINEROP('MEMBER,26,REPCOM('MEMBER,X));
+
+DEFINEBOP('MEMQ,15,16);
+
+%/DEFINEROP('MEMQ,26,REPCOM('MEMQ,X));
+
+DEFINEBOP('EQ,15,16);
+
+%/DEFINEROP('EQ,26,REPCOM('EQ,X));
+
+DEFINEBOP('EQUAL,15,16);
+
+DEFINEBOP('GEQ,15,16);
+
+DEFINEBOP('GREATERP,15,16);
+
+DEFINEBOP('LEQ,15,16);
+
+DEFINEBOP('LESSP,15,16);
+
+DEFINEBOP('NEQ,15,16);
+DEFINEBOP('NE,15,16);
+
+% ***** Tables and Definitions for Particular Parsing Constructs *****;
+
+% ***** IF Expression *****;
+
+DEFINEROP('IF,4,ParseIF);
+
+DEFINEBOP('THEN,3,6);
+
+DEFINEBOP('ELSE,3,6);
+
+SYMBOLIC PROCEDURE ParseIF X;
+ BEGIN SCALAR Y,Z;
+ IF OP EQ 'THEN THEN Y := PARSE0(6,T) ELSE PARERR("IF missing THEN",T);
+ IF OP EQ 'ELSE THEN Z := LIST PARSE0(6,T);
+ RETURN 'COND
+ . LIST(X,Y)
+ . IF Z
+ THEN IF EQCAR(CAR Z,'COND) THEN CDAR Z
+ ELSE LIST (T . Z)
+ ELSE NIL
+ END;
+
+SYMBOLIC PROCEDURE ParseCASE(X); %. Parser function
+ BEGIN
+ IF NOT (OP EQ 'OF) THEN PARERR("CASE Missing OF",T);
+ RETURN 'CASE . X . CASELIST()
+ END;
+
+DEFINEBOP('OF,3,6);
+DEFINEBOP('TO,8,9);
+DEFINEROP('CASE,4,ParseCASE);
+
+SYMBOLIC PROCEDURE CASELIST;
+ BEGIN SCALAR TG,BOD,TAGLIST,BODLIST;
+ L1: OP := SCAN(); % Drop OF, : , etc
+ IF OP EQ 'END THEN GOTO L2; % For optional ; before END
+ TG := PARSETAGS(); % The TAG expressions
+ BOD:= PARSE0(6,T); % The expression
+ BODLIST:=LIST(TG,BOD) . BODLIST;
+ IF OP EQ '!*SEMICOL!* THEN GOTO L1;
+ IF OP NEQ 'END THEN PARERR("Expect END after CASE list",T);
+ L2: OP:=SCAN(); % Skip 'END
+ RETURN REVERSE BODLIST;
+ END;
+
+SYMBOLIC PROCEDURE PARSETAGS();
+% Collects a single CASE-tag form; OP prescanned
+ BEGIN SCALAR TG,TGLST;
+ TG:=PARSE0(6,NIL); % , and : below 6
+ IF EQCAR(TG,'TO) THEN TG:='RANGE . CDR TG; % TO is infix OP
+ IF TG MEMQ '(OTHERWISE DEFAULT)
+ THEN RETURN <<IF OP NEQ '!*COLON!*
+ THEN PARERR("OTHERWISE in CASE must be SINGLE tag",T);
+ NIL>>;
+ IF OP EQ '!*COLON!* THEN RETURN LIST(TG);
+ IF OP EQ '!*COMMA!*
+ THEN RETURN
+ <<OP:=SCAN();
+ TGLST:=PARSETAGS();
+ IF NULL TGLST
+ THEN PARERR("OTHERWISE in CASE must be SINGLE tag",T);
+ TG . TGLST>>;
+ PARERR("Expect one or more tags before : in CASE",T);
+ END;
+
+% ***** Block Expression *****;
+
+fluid '(BlockEnders!*);
+BlockEnders!* :='(END !*RPAR!* !*SEMICOL!* ELSE UNTIL !*RSQB!*);
+
+SYMBOLIC PROCEDURE ParseBEGIN(X);
+ ParseBEGIN1(REMSEMICOL X,
+ COMMENTPART(SCAN(),BlockEnders!*));
+
+DEFINEROP('BEGIN,-2,ParseBEGIN);
+
+DEFINEBOP('END,-3,-2);
+
+SYMBOLIC PROCEDURE ParseGO X;
+ IF X EQ 'TO THEN LIST('GO,PARSE0(6,T)) % Why not Just SCAN?
+ ELSE <<OP := SCAN(); LIST('GO,X)>>;
+
+DEFINEROP('GO,NIL,ParseGO );
+
+SYMBOLIC PROCEDURE ParseGOTO X;
+ <<OP := SCAN(); LIST('GO,X)>>;
+
+DEFINEROP('GOTO,NIL,ParseGOTO );
+
+SYMBOLIC PROCEDURE ParseRETURN X;
+Begin Scalar XOP;
+ RETURN LIST('RETURN,
+ IF (XOP := INFIXOP X) AND NUMBERP CAR XOP AND CAR XOP <= 1
+ THEN <<OP := X; NIL>> ELSE RDRIGHT(6,X));
+END;
+
+DEFINEROP('RETURN,NIL,ParseRETURN);
+
+SYMBOLIC PROCEDURE ParseEXIT X;
+Begin Scalar XOP;
+ RETURN LIST('EXIT,
+ IF (XOP := INFIXOP X) AND NUMBERP CAR XOP AND CAR XOP <= 1
+ THEN <<OP := X; NIL>> ELSE RDRIGHT(6,X));
+END;
+
+DEFINEROP('EXIT,NIL,ParseEXIT);
+
+DEFINEBOP('!*COLON!*,1,0 );
+
+SYMBOLIC PROCEDURE COMMENTPART(A,L);
+ IF A MEMQ L THEN <<OP := A; NIL>>
+ ELSE A . COMMENTPART(SCAN(),L);
+
+SYMBOLIC PROCEDURE ParseBEGIN1(L,COMPART);
+ BEGIN SCALAR DECLS,S;
+ % Look for Sequence of Decls after Block Header
+ A: IF NULL L THEN GO TO ND
+%/ SCAN();
+%/ IF CURSYM!* MEMQ '(INTEGER REAL SCALAR)
+%/ THEN <<Z1:=REPCOM(CURSYM!*,PARSE0(0,NIL))>>; % Arg Decl;
+ ELSE IF NULL CAR L THEN <<L := CDR L; GO TO A>>
+ ELSE IF EQCAR(CAR L,'DECLARE)
+ THEN <<DECLS :=APPEND(CDAR L, DECLS); % Reverse order collection
+ L := CDR L>>
+ ELSE <<S:=L; GO TO B>>; % Hold Body for Rescan
+ GO TO A;
+ B: IF NULL L THEN GO TO ND
+ ELSE IF EQCAR(CAR L,'DECLARE)
+ THEN PARERR("DECLARATION invalid in BEGIN body",NIL)
+ ELSE IF EQCAR(CAR L,'!*COLON!*)
+ THEN <<RPLACD(CDDAR L,CDR L);
+ RPLACD(L,CDDAR L);
+ RPLACA(L,CADAR L)>>
+ ELSE IF CDR L AND NULL CADR L
+ THEN <<RPLACD(L,CDDR L); L := NIL . L>>;
+ L := CDR L;
+ GO TO B;
+ ND: RETURN ('PROG . MAKELOCALS(DECLS) . S);
+ END;
+
+SYMBOLIC PROCEDURE MAKELOCALS(U); %. Remove Types from Reversed DECLARE
+ IF NULL U THEN NIL
+ ELSE APPEND(CDAR U,MAKELOCALS CDR U);
+
+% ***** Procedure Expression *****;
+
+GLOBAL '(!*MODE);
+
+!*MODE := 'SYMBOLIC;
+
+SYMBOLIC PROCEDURE NMODESTAT VV; % Parses TOP-LEVEL mode ....;
+ BEGIN SCALAR TMODE,X;
+ X:= CURSYM!*;
+ % SCAN();
+ IF CURSYM!* EQ '!*SEMICOL!*
+ THEN RETURN <<NEWMODE VV;
+ OP:='!*SEMICOL!*;NIL>>;
+ IF FLAGP(CURSYM!*,'DELIM)
+ THEN RETURN <<NEWMODE VV;
+ OP:='!*SEMICOL!*;NIL>>;
+ TMODE := !*MODE;
+ !*MODE := VV; % Local MODE change for MKPROC
+ X := ERRORSET('(PARSE0 0 NIL),T,!*BACKTRACE);
+ !*MODE := TMODE;
+ RETURN IF ATOM X OR CDR X THEN NIL ELSE CAR X
+ END;
+
+SYMBOLIC PROCEDURE NEWMODE VV;
+ <<PRINT LIST('NEWMODE,LIST('QUOTE,VV));
+ IF NULL VV THEN VV:='SYMBOLIC;
+ !*MODE := VV>>;
+
+CommentOutCode <<
+fluid '(FTypes!*);
+FTYPES!* := '(EXPR FEXPR MACRO);
+
+SYMBOLIC PROCEDURE OLDPROCSTAT;
+ BEGIN SCALAR BOOL,U,TYPE,X,Y,Z;
+ IF FNAME!* THEN GO TO B
+ ELSE IF CURSYM!* EQ 'PROCEDURE THEN TYPE := 'EXPR
+ ELSE PROGN(TYPE := CURSYM!*,SCAN());
+ IF NOT CURSYM!* EQ 'PROCEDURE THEN GO TO C;
+ X := ERRORSET('(PARSE0 0 T),T,!*BACKTRACE);
+ IF ATOM X OR CDR X THEN GO TO A
+ ELSE IF ATOM (X := CAR X) THEN X := LIST X; %no arguments;
+ FNAME!* := CAR X; %function name;
+ IF IDP FNAME!* %AND NOT(TYPE MEMQ FTYPES!*);
+ THEN IF NULL FNAME!* OR (Z := GETTYPE FNAME!*)
+ AND NOT Z MEMQ '(PROCEDURE OPERATOR)
+ THEN GO TO D
+ ELSE IF NOT GETD FNAME!* THEN FLAG(LIST FNAME!*,'FNC);
+ %to prevent invalid use of function name in body;
+ U := CDR X;
+ Y := ERRORSET(LIST('FLAGTYPE,MKQUOTE U,MKQUOTE 'SCALAR),
+ T,!*BACKTRACE);
+ IF ATOM Y OR CDR Y THEN Y := NIL ELSE Y := CAR Y;
+ X := CAR X . Y;
+ A: Z := ERRORSET('(PARSE0 0 T),T,!*BACKTRACE);
+ IF NOT ATOM Z AND NULL CDR Z THEN Z := CAR Z;
+ IF NULL ERFG!* THEN Z:=PROCSTAT1(X,Z,TYPE);
+ REMTYPE Y;
+ REMFLAG(LIST FNAME!*,'FNC);
+ FNAME!*:=NIL;
+ IF NOT BOOL AND ERFG!* THEN REDERR "ERROR TERMINATION";
+ RETURN Z;
+ B: BOOL := T;
+ C: ERRORSET('(SYMERR (QUOTE PROCEDURE) T),T,!*BACKTRACE);
+ GO TO A;
+ D: LPRIE LIST(Z,FNAME!*,"INVALID AS PROCEDURE");
+ GO TO A
+ END;
+>>;
+% Some OLD Crap looks at 'STAT values!!!
+
+DEFLIST ('((PROCEDURE PROCSTAT)
+ (EXPR PROCSTAT)
+ (FEXPR PROCSTAT)
+ (EMB PROCSTAT)
+ (MACRO PROCSTAT) (NMACRO PROCSTAT) (SMACRO PROCSTAT)),
+ 'STAT);
+
+DEFLIST ('((ALGEBRAIC MODESTAT)
+ (SYMBOLIC MODESTAT)
+ (SYSLSP MODESTAT)
+ ),
+ 'STAT); %/ STAT used for OLD style BEGIN KEY search
+
+DEFLIST('((LISP SYMBOLIC)),'NEWNAM);
+
+DEFINEROP('SYMBOLIC,NIL,NMODESTAT('SYMBOLIC)); % Make it a Prefix OP
+DEFINEROP('ALGEBRAIC,NIL,NMODESTAT('ALGEBRAIC)); % Make it a Prefix OP
+DEFINEROP('SYSLSP,NIL,NMODESTAT('SYMBOLIC)); % Make it a Prefix OP
+DEFINEBOP('PROCEDURE,1,NIL,ParsePROCEDURE); % Pick up MODE -- will go
+
+DEFINEROP('PROCEDURE,NIL,ParsePROCEDURE('EXPR,X)); %/ Unary, use DEFAULT mode?
+
+SYMBOLIC PROCEDURE ParsePROCEDURE2(NAME,VARLIS,BODY,TYPE);
+ BEGIN SCALAR Y;
+% IF FLAGP(NAME,'LOSE) AND (!*LOSE OR NULL !*DEFN)
+% THEN RETURN PROGN(LPRIM LIST(NAME,
+% "Not defined (LOSE Flag)"),
+% NIL);
+ if (Y := get(Type, 'FunctionDefiningFunction)) then
+ Body := list(Y, Name, VarLis, Body)
+ else if (Y := get(Type, 'ImmediateDefiningFunction)) then return
+ Apply(Y, list(Name, VarLis, Body))
+ ELSE BODY := LIST('PUTC,
+ MKQUOTE NAME,
+ MKQUOTE TYPE,
+ MKQUOTE LIST('LAMBDA,VARLIS, REFORM BODY));
+ RETURN IF !*MODE NEQ 'ALGEBRAIC THEN BODY
+%/ ELSE LIST('PROGN,
+%/ LIST('FLAG,MKQUOTE LIST NAME,MKQUOTE 'OPFN),
+%/ BODY)
+ END;
+
+
+DefList('((Expr DE)
+ (FExpr DF)
+ (Macro DM)
+ (NExpr DN)
+ (SMacro DS)), 'FunctionDefiningFunction);
+
+put('Emb, 'ImmediateDefiningFunction, 'EmbFn);
+
+SYMBOLIC PROCEDURE ParsePROCEDURE1(NAM,ARGS,BODY,ARGTYPE,TYPES);
+%/ Crude conversion of PROC to PUTD. Need make Etypes and Ftypes
+%/ Keywords also.
+ BEGIN SCALAR ETYPE,FTYPE;
+ ETYPE:=!*MODE; FTYPE:='EXPR;
+ IF NOT PAIRP TYPES THEN TYPES:=TYPES . NIL;
+ FOR EACH Z IN TYPES DO
+ IF FLAGP(Z,'ETYPE) THEN ETYPE:=Z
+ ELSE IF FLAGP(Z,'FTYPE) THEN FTYPE:=Z;
+ RETURN ParsePROCEDURE2(NAM,ARGS,BODY,FTYPE);
+ END;
+
+FLAG('(EXPR FEXPR NEXPR NFEXPR MACRO SMACRO NMACRO EMB),'FTYPE);
+FLAG('(SYMBOLIC ALGEBRAIC LISP SYSLISP SYSLSP),'ETYPE);
+
+SYMBOLIC PROCEDURE ParsePROCEDURE(EFTYPES,Y);
+ BEGIN SCALAR OP1,Z,Z1;
+ OP := OP1 := SCAN();
+ IF OP1 EQ '!*SEMICOL!* THEN Y := LIST Y
+ ELSE IF INFIXOP OP1 THEN Y := LIST(OP1,Y,PARSE0(8,T))
+ % Binary as Prefix
+ ELSE Y := REPCOM(Y,PARSE0(8,NIL)); %/ Why 8
+ IF OP NEQ '!*SEMICOL!*
+ THEN PARERR("PROCEDURE missing terminator after template",T);
+%/ SCAN();
+%/ IF CURSYM!* MEMQ '(INTEGER REAL SCALAR)
+%/ THEN <<Z1:=REPCOM(CURSYM!*,PARSE0(0,NIL))>>; % Arg Decl;
+ Z := PARSE0(0,T);
+ IF EQCAR(Z,'DECLARE) THEN <<Z1 := Z; Z := PARSE0(0,T)>>; % repeated DECL?
+ RETURN ParsePROCEDURE1(CAR Y,CDR Y,Z,Z1,EFTYPES);
+ % Nam, args, body, arg decl, E/Fmode
+ END;
+
+% ***** Left and Right Parentheses Handling *****;
+
+DEFINEROP('!*LPAR!*,NIL,ParseLPAR);
+
+DEFINEBOP('!*RPAR!*,1,0);
+
+SYMBOLIC PROCEDURE ParseLPAR X;
+ BEGIN SCALAR RES;
+ IF X EQ '!*RPAR!* THEN <<OP := X; RES := '!*EMPTY!*>>
+ ELSE RES:= RDRIGHT(2,X);
+ IF OP EQ '!*RPAR!* THEN OP := SCAN()
+ ELSE PARERR("Missing ) after argument list",NIL);
+ RETURN RES
+ END;
+
+% ***** Left and Right << and >> Handling *****;
+
+DEFINEROP('!*LSQB!*,-2,ParseRSQB);
+SYMBOLIC PROCEDURE ParseRSQB(X);
+ IF OP EQ '!*RSQB!*
+ THEN <<OP := SCAN(); 'PROGN . REMSEMICOL X>>
+ ELSE PARERR("Missing right >> after Group",NIL);
+
+DEFINEBOP('!*RSQB!*,-3,0);
+
+%COMMENT ***** [] vector syntax;
+
+REMPROP('![,'NEWNAM);
+REMPROP('!],'NEWNAM);
+
+% ***** [] vector syntax;
+
+DEFINEBOP('!*LVEC!*,121,6,ParseLVEC);
+
+SYMBOLIC PROCEDURE ParseLVEC(X,Y);
+ IF OP EQ '!*RVEC!* THEN <<OP :=SCAN(); LIST('INDX,X,Y)>>
+ ELSE PARERR("Missing ] in index expression ",NIL);
+
+% INDX is used for both Vectors and Strings in PSL. You will need to
+% have INDX map to GETV in vanilla Standard Lisp
+
+DEFINEBOP('!*RVEC!*,5,7);
+
+% ***** Lambda Expression *****;
+
+DEFINEROP('LAMBDA,0,ParseLAMBDA);
+SYMBOLIC PROCEDURE ParseLAMBDA X;
+ LIST('LAMBDA,IF X AND X NEQ '!*EMPTY!* THEN REMCOM X ELSE NIL,
+ PARSE0(6,T));
+
+% ***** Repeat Expression *****;
+
+DEFINEROP('REPEAT,4,ParseREPEAT);
+SYMBOLIC PROCEDURE ParseREPEAT X;
+ LIST('REPEAT,X,
+ IF OP EQ 'UNTIL THEN PARSE0(6,T)
+ ELSE PARERR("REPEAT missing UNTIL clause",T)) ;
+
+DEFINEBOP('UNTIL,3,6);
+
+% ***** While Expression *****;
+
+DEFINEROP('WHILE,4, ParseWHILE);
+
+SYMBOLIC PROCEDURE ParseWHILE X;
+ LIST('WHILE,X,
+ IF OP EQ 'DO THEN PARSE0(6,T)
+ ELSE PARERR("WHILE missing DO clause",T)) ;
+
+DEFINEBOP('DO,3,6);
+
+% ***** Declare Expression *****;
+
+DEFINEROP('DECLARE,2,ParseDECL);
+
+DEFINEROP('DCL,2,ParseDECL);
+
+SYMBOLIC PROCEDURE ParseDECL X;
+ BEGIN SCALAR Y,Z;
+ A:
+ IF OP NEQ '!*COLON!* THEN PARERR("DECLARE needs : before mode",T);
+ IF (Z := SCAN()) MEMQ '(INTEGER REAL SCALAR) THEN OP := SCAN()
+ ELSE Z := PARSE0(6,NIL);
+ Y := ACONC(Y,Z . REMCOM X);
+ IF OP EQ '!*SEMICOL!* THEN RETURN 'DECLARE . Y
+ ELSE IF OP NEQ '!*COMMA!*
+ THEN PARERR("DECLAREd variables separated by ,",T);
+ X := PARSE0(2,T);
+ GO TO A
+ END;
+
+SYMBOLIC FEXPR PROCEDURE DECLARE U;
+ %to take care of top level declarations;
+ <<LPRIM "Declarations are not permitted at the top level";
+ NMODESTAT U>>;
+
+% ***** For Expression *****;
+
+DEFINEROP('FOR,NIL,ParseFOR);
+
+DEFINEBOP('STEP,3,6);
+
+DEFINEBOP('SUM,3,6);
+
+DEFINEBOP('PRODUCT,3,6);
+
+SYMBOLIC PROCEDURE ParseFOR X;
+ BEGIN SCALAR INIT,STP,UNTL,ACTION,ACTEXPR;
+ IF X EQ 'EACH THEN RETURN ParseFOREACH SCAN()
+ ELSE IF X EQ 'ALL THEN RETURN ParseFORALL PARSE0(4,T)
+ ELSE IF (OP := SCAN()) EQ 'SETQ THEN INIT := PARSE0(6,T)
+ ELSE PARERR("FOR missing loop VAR assignment",T);
+ IF OP EQ '!*COLON!* THEN <<STP := 1; OP := 'UNTIL>>
+ ELSE IF OP EQ 'STEP THEN STP := PARSE0(6,T)
+ ELSE PARERR("FOR missing : or STEP clause",T);
+ IF OP EQ 'UNTIL THEN UNTL := PARSE0(6,T)
+ ELSE PARERR("FOR missing UNTIL clause",T);
+ ACTION := OP;
+ IF ACTION MEMQ '(DO SUM PRODUCT) THEN ACTEXPR := PARSE0(6,T)
+ ELSE PARERR("FOR missing action keyword",T);
+ RETURN LIST('FOR,
+ LIST('FROM,X,INIT,UNTL,STP),
+ LIST(ACTION,ACTEXPR))
+ END;
+
+% ***** Foreach Expression *****;
+
+DEFINEROP('FOREACH,NIL,ParseFOREACH);
+
+DEFINEBOP('COLLECT,3,6);
+DEFINEBOP('CONC,3,6);
+DEFINEBOP('JOIN,3,6);
+
+SYMBOLIC PROCEDURE ParseFOREACH X;
+ BEGIN SCALAR L,INON,ACTION;
+ IF NOT ((INON := SCAN()) EQ 'IN OR INON EQ 'ON)
+ THEN PARERR("FOR EACH missing iterator clause",T);
+ L := PARSE0(6,T);
+ IF NOT ((ACTION := OP) MEMBER '(DO COLLECT CONC JOIN))
+ THEN PARERR("FOR EACH missing action clause",T);
+ RETURN LIST('FOREACH,X,INON,L,ACTION,PARSE0(6,T))
+ END;
+
+% ***** Let Expression *****;
+
+DEFINEBOP('LET,1,0,ParseLET);
+
+DEFINEROP('LET,0,ParseLET(NIL . NIL,X) );
+
+DEFINEBOP('CLEAR,0,1,ParseCLEAR);
+
+DEFINEROP('CLEAR,0,ParseCLEAR(NIL . NIL,X));
+
+DEFINEBOP('SUCH,3,6);
+
+SYMBOLIC PROCEDURE ParseLET(X,Y); ParseLET1(X,Y,NIL);
+
+SYMBOLIC PROCEDURE ParseCLEAR(X,Y); ParseLET1(X,Y,T);
+
+SYMBOLIC PROCEDURE ParseLET1(X,Y,Z);
+ LIST('LET!*,CAR X,REMCOM Y,CDR X,NIL,Z);
+
+SYMBOLIC PROCEDURE ParseFORALL X;
+ BEGIN SCALAR BOOL;
+ IF OP EQ 'SUCH
+ THEN IF SCAN() EQ 'THAT THEN BOOL := PARSE0(6,T)
+ ELSE PARERR("FOR ALL missing SUCH THAT clause",T);
+ IF NOT OP MEMQ '(LET CLEAR) THEN PARERR("FOR ALL missing ACTION",T);
+ RETURN REMCOM X . BOOL
+ END;
+
+% ******** Standard Qoted LIST collectors
+
+SYMBOLIC PROCEDURE RLISF(U,V,W); %. Used to Collect a list of IDs to
+ %. FLAG with Something
+ BEGIN
+ V := RDRIGHT(0,V);
+ V :=
+ IF EQCAR(V,'!*COMMA!*) THEN CDR V
+ ELSE IF V THEN LIST V
+ ELSE V;
+ RETURN FLAG(V,U)
+ END;
+
+SYMBOLIC PROCEDURE FLAGOP U; %. Declare U as Flagger
+ RLISTAT(U,'FLAGOP);
+
+SYMBOLIC PROCEDURE RLISTAT(OPLIST,B); %. Declare els of OPLIST to be RLIS
+ FOR EACH U IN OPLIST DO
+ DEFINEROPX LIST(MKQUOTE U,NIL,
+ LIST(IF B EQ 'FLAGOP THEN 'RLISF ELSE 'RLIS1,
+ MKQUOTE U,'X,MKQUOTE B));
+
+SYMBOLIC PROCEDURE RLIS1(U,V,W); %. parse LIST of args, maybe quoted
+ % U=funcname, V=following Phrase, W=arg treatment
+ BEGIN
+ IF V EQ '!*SEMICOL!* THEN RETURN
+ <<OP := V;
+ IF W = 'NOQUOTE THEN LIST U ELSE LIST(U, NIL) >>
+ ELSE V := RDRIGHT(0,V);
+ V :=
+ IF EQCAR(V,'!*COMMA!*) THEN CDR V
+ ELSE IF V THEN LIST V
+ ELSE V;
+ IF W EQ 'IO
+ THEN V := MAPCAR(V,FUNCTION (LAMBDA J; NEWMKFIL J));
+ RETURN IF W EQ 'NOQUOTE THEN U . V ELSE LIST(U,MKQUOTLIST V)
+ END;
+
+% ***** Parsing Rules For Various IO Expressions *****;
+
+RLISTAT('(IN OUT SHUT),'NOQUOTE);
+RLISTAT('(TR UNTR BR UNBR),'NOQUOTE); % for mini-trace in PSL
+
+RLISTAT('(LOAD HELP), 'NOQUOTE);
+
+FLAG('(IN OUT SHUT ON OFF
+ TR UNTR UNTRST TRST),'NOCHANGE); % No REVAL of args
+DEFINEROP('FSLEND,NIL,ESTAT('FasLEND));
+DEFINEROP('FaslEND,NIL,ESTAT('FaslEND));
+
+RLISTAT('(WRITE),'NOQUOTE);
+
+RLISTAT('(ARRAY),1);
+
+% 2.11.3 ON/OFF STATEMENTS
+
+RLISTAT('(ON OFF), 'NOQUOTE);
+
+% ***** Parsing Rules for INTEGER/SCALAR/REAL *****;
+
+% These will eventually be removed in favor of DECLARE;
+
+DEFINEROP('INTEGER,0,ParseINTEGER);
+
+SYMBOLIC PROCEDURE ParseINTEGER X;
+ LIST('DECLARE,REPCOM('INTEGER,X));
+
+DEFINEROP('REAL,0,ParseREAL);
+
+SYMBOLIC PROCEDURE ParseREAL X;
+ LIST('DECLARE,REPCOM('REAL,X));
+
+DEFINEROP('SCALAR,0,ParseSCALAR);
+
+SYMBOLIC PROCEDURE ParseSCALAR X;
+LIST('DECLARE,REPCOM('SCALAR,X));
+
+%/ Cuase problems in INTEGER procedure foo;...
+
+SYMBOLIC PROCEDURE COMM1 U; %. general Comment Parser
+ BEGIN
+ IF U EQ 'END THEN SCAN();
+ A:
+ IF CURSYM!* EQ '!*SEMICOL!*
+ OR U EQ 'END
+ AND CURSYM!*
+ MEMQ '(END ELSE UNTIL !*RPAR!* !*RSQB!*)
+ THEN RETURN NIL;
+ SCAN();
+ GOTO A;
+ END;
+
+SYMBOLIC PROCEDURE ESTAT(FN); %. returns (FN), dropping till semicol ;
+ BEGIN
+ WHILE CURSYM!* NEQ '!*SEMICOL!* DO SCAN();
+ OP := '!*SEMICOL!*;
+ RETURN LIST(FN);
+ END;
+
+SYMBOLIC PROCEDURE ENDSTAT;
+ %This procedure can also be used for any key-words which take no
+ %arguments;
+ BEGIN SCALAR X;
+ X := OP;
+ COMM1 'END;
+ OP := '!*SEMICOL!*;
+ RETURN LIST X
+ END;
+
+% Some useful ESTATs:
+
+DEFINEROP('QUIT,NIL,ESTAT('QUIT));
+DEFINEROP('PAUSE,NIL,ESTAT('PAUSE));
+DEFINEROP('CONT,NIL,ESTAT('CONT));
+DEFINEROP('RECLAIM,NIL,ESTAT('RECLAIM));
+DEFINEROP('RETRY,NIL,ESTAT('RETRY));
+DEFINEROP('SHOWTIME,NIL,ESTAT('SHOWTIME));
+
+FLAG('(FSLEND CONT RECLAIM RETRY SHOWTIME QUIT PAUSE),'OPFN);
+% Symbolic OPS, or could use NOCHANGE
+RLISTAT('(FLAGOP),1);
+
+CommentOutCode <<
+SYMBOLIC PROCEDURE INFIX X; % Makes Left ASSOC, not like CONS
+ FOR EACH Y IN X DO
+ DEFINEBOPX LIST(MKQUOTE Y,8,9,NIL);
+>>;
+
+FLAG('(NEWTOK),'EVAL);
+
+SYMBOLIC PROCEDURE PRECEDENCE U;
+ PRECSET(CAR U,CADR U);
+
+SYMBOLIC PROCEDURE PRECSET(U,V);
+ BEGIN SCALAR Z;
+ IF NULL (Z := INFIXOP V) OR NULL (Z := CDR Z)
+ THEN REDERR LIST(V,"NOT INFIX")
+ ELSE DEFINEBOPX LIST(MKQUOTE U,CAR Z,CADR Z,NIL)
+ END;
+
+RLISTAT('(INFIX PRECEDENCE),3);
+
+REMPROP('SHOWTIME,'STAT);
+%*********************************************************************
+% DEFINE STATEMENT
+%********************************************************************;
+
+SYMBOLIC PROCEDURE ParseDEFINE(X); % X is following Token
+ BEGIN SCALAR Y,Z;
+ B: IF X EQ '!*SEMICOL!* THEN RETURN <<OP:='!*SEMICOL!*;
+ MKPROG(NIL,Z)>>
+ ELSE IF X EQ '!*COMMA!* THEN <<X:=SCAN(); %/ Should use SCAN0
+ GO TO B>>
+ ELSE IF NOT IDP X THEN GO TO ER;
+ Y := SCAN();
+ IF NOT (Y EQ 'EQUAL) THEN GO TO ER;
+ Z := ACONC(Z,LIST('PUT,MKQUOTE X,MKQUOTE 'NEWNAM,
+ MKQUOTE PARSE0(6,T))); % So doesnt include ,
+ X := CURSYM!*;
+ GO TO B;
+ ER: SYMERR('DEFINE,T)
+ END;
+
+DEFINEROP('DEFINE,NIL,ParseDEFINE);
+
+FLAG('(DEFINE),'EVAL);
+
+
+%*********************************************************************
+% 3.2.4 WRITE STATEMENT
+%********************************************************************;
+
+SYMBOLIC PROCEDURE ParseWRITE(X);
+ BEGIN SCALAR Y,Z;
+ X := REMCOM XREAD1 'LAMBDA;
+ A: IF NULL X
+ THEN RETURN MKPROG(NIL,'(TERPRI) . Y);
+ Z := LIST('PRIN2,CAR X);
+ IF NULL CDR X THEN Z := LIST('RETURN,Z);
+ B: Y := ACONC(Y,Z);
+ X := CDR X;
+ GO TO A;
+ END;
+
+DEFINEROP('WRITE,NIL,ParseWRITE);
+
+%*********************************************************************
+% VARIOUS DECLARATIONS
+%********************************************************************;
+
+SYMBOLIC PROCEDURE ParseOPERATOR(X);
+ BEGIN SCALAR Y;
+ Y := REMCOM PARSE0(0,NIL);
+ RETURN
+ IF !*MODE EQ 'SYMBOLIC
+ THEN MKPROG(NIL,LIST LIST('FLAG,MKQUOTE Y,MKQUOTE 'OPFN))
+ ELSE IF X NEQ 'OPERATOR
+ THEN IF EQCAR(CAR Y,'PROG) THEN CAR Y
+ ELSE X . MAPCAR(LIST Y,FUNCTION MKARG)
+ ELSE IF KEY!* NEQ 'OPERATOR AND GET(KEY!*,'FN)
+ THEN (LAMBDA K; MKPROG(NIL,MAPCAR(Y,FUNCTION (LAMBDA J;
+ LIST('FLAG,LIST('LIST,MKQUOTE J),
+ K,K)))))
+ MKQUOTE GET(KEY!*,'FN)
+ ELSE MKPROG(NIL,
+ LIST LIST('OPERATOR,MKQUOTE Y))
+ END;
+
+SYMBOLIC PROCEDURE OPERATOR U; MAPCAR(U,FUNCTION MKOP);
+
+DEFINEROP('OPERATOR,NIL,ParseOPERATOR);
+
+ %. Diphthongs and READtable Changes
+
+Symbolic Procedure ChangeCharType(TBL,Ch,Ty); %. Set Character type
+begin scalar IDNum;
+ If IDP Ch and (IDNum := ID2Int Ch) < 128 and
+ Numberp Ty and Ty >=0 and Ty <=19 then
+ PutV(TBL,IDNum,Ty)
+ Else Error(99,"Cant Set ReadTable");
+end;
+
+Symbolic Procedure MakeDiphthong(TBL,DipIndicator,StartCh, FollowCh, Diphthong);
+ If IDP Startch and IDP FollowCh and IDP Diphthong
+ then <<ChangeCharType(TBL,StartCh,13);
+ PUT(StartCh,DipIndicator,
+ (FollowCh . Diphthong) . GET(StartCh,DipIndicator))>>
+ else Error(99, "Cant Declare Diphthong");
+
+
+SYMBOLIC PROCEDURE MYNEWTOK(X,REPLACE,PRTCHARS);
+ BEGIN SCALAR Y;
+ PUT(X,'NEWNAM!-OP,REPLACE);
+ IF NULL PRTCHARS THEN Y:=LIST(X,X)
+ ELSE IF IDP PRTCHARS THEN Y:=LIST(PRTCHARS,X)
+ ELSE Y:=PRTCHARS;
+ PUT(REPLACE,'PRTCH,Y);
+ END;
+
+MYNEWTOK('!;,'!*SEMICOL!*,NIL)$
+MYNEWTOK('!$,'!*SEMICOL!*,NIL)$
+MYNEWTOK('!,,'!*COMMA!*,NIL)$
+MYNEWTOK('!.,'CONS,NIL)$
+MYNEWTOK('!:!=,'SETQ,'! !:!=! )$
+MYNEWTOK('!+,'PLUS,'! !+! )$
+MYNEWTOK('!-,'DIFFERENCE,'! !-! )$
+MYNEWTOK('!*,'TIMES,NIL)$
+MYNEWTOK('!/,'QUOTIENT,NIL)$
+MYNEWTOK('!*!*,'EXPT,NIL)$
+MYNEWTOK('!^,'EXPT,NIL)$
+MYNEWTOK('!=,'EQUAL,NIL)$
+MYNEWTOK('!:,'!*COLON!*,NIL)$
+MYNEWTOK('!(,'!*LPAR!*,NIL)$
+MYNEWTOK('!),'!*RPAR!*,NIL)$
+MYNEWTOK('!{,'!*LSQB!*,NIL)$
+MYNEWTOK('!},'!*RSQB!*,NIL)$
+MYNEWTOK('!<!<,'!*LSQB!*,NIL)$
+MYNEWTOK('!>!>,'!*RSQB!*,NIL)$
+MYNEWTOK('![,'!*LVEC!*,NIL)$
+MYNEWTOK('!],'!*RVEC!*,NIL)$
+MYNEWTOK('!<,'LESSP,NIL)$
+MYNEWTOK('!<!=,'LEQ,NIL)$
+MYNEWTOK('!>!=,'GEQ,NIL)$
+MYNEWTOK('!>,'GREATERP,NIL)$
+
+fluid '(RLispScanTable!* RLispReadScanTable!*);
+RLispReadScanTable!* := '
+[17 11 11 11 11 11 11 11 11 17 17 11 17 17 11 11 11 11 11 11 11 11 11 11
+11 11 11 11 11 11 11 11 17 14 15 11 11 12 11 11 11 11 13 19 11 18 20 11
+0 1 2 3 4 5 6 7 8 9 13 11 13 11 13 11 11 10 10 10 10 10 10 10 10 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 11 16 11 11 10 11 10 10
+10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10 10
+11 11 11 11 11 LispDiphthong];
+
+RLispScanTable!* := TotalCopy RLispReadScanTable!*;
+PutV(RLispScanTable!*, 128, 'RLISPDIPHTHONG);
+
+ChangeCharType(RLispScanTable!*, '!-, 11);
+ChangeCharType(RLispScanTable!*, '!+, 11);
+MAKEDIPHTHONG(RLISPSCANTABLE!*,'RLISPDIPHTHONG,'!:,'!=,'!:!= );
+MAKEDIPHTHONG(RLISPSCANTABLE!*,'RLISPDIPHTHONG,'!<,'!=,'!<!= );
+MAKEDIPHTHONG(RLISPSCANTABLE!*,'RLISPDIPHTHONG,'!>,'!=,'!>!= );
+MAKEDIPHTHONG(RLISPSCANTABLE!*,'RLISPDIPHTHONG,'!<,'!<,'!<!< );
+MAKEDIPHTHONG(RLISPSCANTABLE!*,'RLISPDIPHTHONG,'!>,'!>,'!>!> );
+MAKEDIPHTHONG(RLISPSCANTABLE!*,'RLISPDIPHTHONG,'!*,'!*,'!*!* );
+
+Symbolic Procedure XReadEof(Channel,Ef);
+ if !*InsideStructureRead then
+ StdError BldMsg("Unexpected EOF while parsing on channel %r", Channel)
+ else Throw('!$ERROR!$, list !$EOF!$); % embarrasingly gross kludge
+
+Put(Int2ID char EOF, 'RlispReadMacro, 'XReadEOF);
+
+Symbolic Procedure RatomHOOK(); %. To get READ MACRO', EG EOF
+ ChannelReadTokenWithHooks IN!*;
+
+lisp procedure RlispChannelRead Channel; %. Parse S-expression from channel
+begin scalar CurrentScanTable!*, CurrentReadMacroIndicator!*,
+ CurrentDiphthongIndicator!*;
+ CurrentScanTable!* := RLispReadScanTable!*;
+ CurrentReadMacroIndicator!* := 'LispReadMacro;
+ CurrentDiphthongIndicator!* := 'LispDiphthong;
+ return ChannelReadTokenWithHooks Channel;
+end;
+
+lisp procedure RlispRead(); %. Parse S-expr from current input
+ RlispChannelRead IN!*;
+
+END;
ADDED psl-1983/3-1/util/rlisp-support.red
Index: psl-1983/3-1/util/rlisp-support.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rlisp-support.red
@@ -0,0 +1,877 @@
+% <PSL.UTIL>RLISP-SUPPORT.RED.14, 07-Apr-83 13:34:02, Edit by KENDZIERSKI
+% Changed !*OUTPUT and SEMIC!* to fluid from global to agree w/kernel decls.
+% <PSL.UTIL>RLISP-SUPPORT.RED.8, 13-Oct-82 10:21:02, Edit by BENSON
+% !*INT is globally T
+% <PSL.UTIL>RLISP-SUPPORT.RED.5, 5-Oct-82 11:05:30, Edit by BENSON
+% Changed SaveSystem to 3 arguments
+% <PSL.UTIL>RLISP-SUPPORT.RED.3, 20-Sep-82 11:57:21, Edit by BENSON
+% Added Begin1 and BeginRlisp to IgnoredInBacktrace!*
+
+CompileTime REMPROP('SHOWTIME,'STAT);
+
+%*********************************************************************
+% RLISP and REDUCE Support Code for NEW-RLISP / On PSL
+%********************************************************************;
+
+
+GLOBAL '(FLG!*);
+
+GLOBAL '(BLOCKP!* CMSG!* ERFG!* INITL!* LETL!*
+ PRECLIS!* VARS!* !*FORCE
+ CLOC!*
+ !*DEMO
+ !*QUIET
+ OTIME!* !*SLIN LREADFN!* TSLIN!*
+ !*NAT NAT!*!* CRCHAR!* IFL!* IPL!* KEY!* KEY1!*
+ OFL!* OPL!* PROGRAM!* PROGRAML!*
+ EOF!* TECHO!* !*INT !*MODE
+ !*CREF !*MSG !*PRET !*EXTRAECHO);
+
+FLUID '(!*DEFN !*ECHO DFPRINT!* !*TIME !*BACKTRACE CURSYM!* SEMIC!* !*OUTPUT);
+
+% These global variables divide into two classes. The first
+%class are those which must be initialized at the top level of the
+%program. These are as follows;
+
+BLOCKP!* := NIL; %keeps track of which block is active;
+CMSG!* := NIL; %shows that continuation msg has been printed;
+EOF!* := NIL; %flag indicating an end-of-file;
+ERFG!* := NIL; %indicates that an input error has occurred;
+INITL!* := '(BLOCKP!* VARS!*);
+ %list of variables initialized in BEGIN1;
+KEY!* := 'SYMBOLIC; %stores first word read in command;
+LETL!* := NIL; %used in algebraic mode for special delimiters;
+LREADFN!* := NIL; %used to define special reading function;
+%OUTL!* := NIL; %storage for output of input line;
+PRECLIS!*:= '(OR AND NOT MEMBER MEMQ EQUAL NEQ EQ GEQ GREATERP LEQ
+ LESSP PLUS DIFFERENCE TIMES QUOTIENT EXPT CONS);
+ %precedence list of infix operators;
+TECHO!* := NIL; %terminal echo status;
+VARS!* := NIL; %list of current bound variables during parse;
+!*BACKTRACE := NIL; %if ON, prints a LISP backtrace;
+!*CREF := NIL; %used by cross-reference program;
+!*DEMO := NIL; % causes a PAUSE (READCH) in COMMAND loop
+!*ECHO := NIL; %indicates echoing of input;
+!*FORCE := NIL; %causes all macros to expand;
+!*INT := T; % system is interactive
+%!*LOSE := T; %determines whether a function flagged LOSE
+ %is defined;
+%!*MSG:=NIL; %flag to indicate whether messages should be
+ %printed;
+!*NAT := NIL; %used in algebraic mode to denote 'natural'
+ %output. Must be on in symbolic mode to
+ %ensure input echoing;
+NAT!*!* := NIL; %temporary variable used in algebraic mode;
+!*OUTPUT := T; %used to suppress output;
+!*SLIN := NIL; %indicates that LISP code should be read;
+!*TIME := NIL; %used to indicate timing should be printed;
+
+% The second class are those global variables which are
+%initialized within some function, although they do not appear in that
+%function's variable list. These are;
+
+% CRCHAR!* next character in input line
+% CURSYM!* current symbol (i. e. identifier, parenthesis,
+% delimiter, e.t.c,) in input line
+% FNAME!* name of a procedure being read
+% FTYPES!* list of regular procedure types
+% IFL!* input file/channel pair - set in BEGIN to NIL
+% IPL!* input file list- set in BEGIN to NIL
+% KEY1!* current key-word being analyzed - set in RLIS1;
+% NXTSYM!* next symbol read in TOKEN
+% OFL!* output file/channel pair - set in BEGIN to NIL
+% OPL!* output file list- set in BEGIN to NIL
+% PROGRAM!* current input program
+% PROGRAML!* stores input program when error occurs for a
+% later restart
+% SEMIC!* current delimiter character (used to decide
+% whether to print result of calculation)
+% TTYPE!* current token type;
+% WS used in algebraic mode to store top level value
+% !*FORT used in algebraic mode to denote FORTRAN output
+% !*INT indicates interactive system use
+% !*MODE current mode of calculation
+% !*PRET indicates REDUCE prettyprinting of input;
+
+
+fluid '(IgnoredInBacktrace!*);
+IgnoredInBacktrace!* := Append(IgnoredInBacktrace!*, '(Begin1 BeginRlisp));
+
+CompileTime flag('(FlagP!*!* CondTerPri
+ LispFileNameP MkFil SetLispScanTable SetRlispScanTable
+ ProgVr),
+ 'InternalFunction);
+
+CompileTime <<
+macro procedure PgLine U; % needed for LOCN
+ ''(1 . 1);
+>>;
+
+%*********************************************************************
+% REDUCE SUPERVISOR
+%********************************************************************;
+
+% The true REDUCE supervisory function is BEGIN, again defined in
+%the system dependent part of this program. However, most of the work
+%is done by BEGIN1, which is called by BEGIN for every file
+%encountered on input;
+
+SYMBOLIC PROCEDURE FLAGP!*!*(U,V);
+ IDP U AND FLAGP(U,V);
+
+FLUID '(PROMPTSTRING!*);
+
+fluid '(STATCOUNTER!*);
+STATCOUNTER!* := 0;
+
+lisp procedure RlispPrompt();
+ BldMsg("[%w] ", StatCounter!*);
+
+put('Symbolic, 'PromptFn, 'RlispPrompt);
+
+SYMBOLIC PROCEDURE BEGIN1;
+ BEGIN SCALAR MODE,PARSERR,RESULT,PROMPT,WRKSP,MODEPRINT,PROMPTFN,RESULTL,
+ PROMPTSTRING!*;
+ A0: CURSYM!* := '!*SEMICOL!*;
+ OTIME!* := TIME();
+ GO TO A1;
+ A: %IF NULL IFL!* AND !*INT
+ % THEN <<%/CRBUFLIS!* := (STATCOUNTER!* . CRBUF!*) . CRBUFLIS!*;
+ % CRBUF!* := NIL>>;
+ A1: IF NULL IFL!* AND !*INT THEN STATCOUNTER!* := STATCOUNTER!* + 1;
+ IF PROMPTFN := GET(!*MODE,'PROMPTFN) THEN
+ PROMPTSTRING!* := APPLY(PROMPTFN,NIL);
+ A2: PARSERR := NIL;
+% IF !*OUTPUT AND !*INT AND NULL IFL!* AND NULL OFL!*
+% AND NULL !*DEFN
+% THEN TERPRI();
+ IF !*TIME THEN SHOWTIME();
+ IF TSLIN!*
+ THEN PROGN(!*SLIN := CAR TSLIN!*,
+ LREADFN!* := CDR TSLIN!*,
+ TSLIN!* := NIL);
+ MAPC(INITL!*,FUNCTION SINITL);
+ IF !*INT THEN ERFG!* := NIL; %to make editing work properly;
+ IF CURSYM!* EQ 'END THEN GO TO ND0;
+ PROGRAM!* := ERRORSET('(COMMAND),T,!*BACKTRACE);
+ CONDTERPRI();
+ IF ATOM PROGRAM!* OR CDR PROGRAM!* THEN GO TO ERR1;
+ PROGRAM!* := CAR PROGRAM!*;
+ IF PROGRAM!* EQ !$EOF!$ THEN GO TO ND1
+ ELSE IF EQCAR(PROGRAM!*,'!*COMMA!*) THEN GO TO ER
+ ELSE IF CURSYM!* EQ 'END THEN GO TO ND0
+ ELSE IF EQCAR(PROGRAM!*,'RETRY) THEN PROGRAM!* := PROGRAML!*
+;% ELSE IF PROGRAM!* EQ 'ED
+% THEN PROGN(CEDIT NIL,GO TO A2)
+% ELSE IF EQCAR(PROGRAM!*,'ED)
+% THEN PROGN(CEDIT CDR PROGRAM!*,GO TO A2);
+ IF !*DEFN THEN GO TO D;
+ B: %IF !*OUTPUT AND IFL!* AND !*ECHO THEN TERPRI();
+ RESULTL := ERRORSET(PROGRAM!*,T,!*BACKTRACE);
+ IF ATOM RESULTL OR CDR RESULTL OR ERFG!* THEN GO TO ERR2
+ ELSE IF !*DEFN THEN GO TO A;
+ RESULT := CAR RESULTL;
+ IF IDP KEY!* AND GET(KEY!*,'STAT) EQ 'MODESTAT
+ THEN MODE := KEY!*
+ ELSE MODE := !*MODE;
+ IF NULL !*OUTPUT OR IFL!* AND !*QUIET THEN GO TO C;
+ IF SEMIC!* EQ '!; THEN <<
+ MODEPRINT := GET(MODE,'MODEPRINFN) OR 'PrintWithFreshLine;
+% IF NOT FLAGP(MODE,'NOTERPRI) THEN
+% TERPRI();
+ APPLY(MODEPRINT,RESULTL) >>;
+ C: IF WRKSP := GET(MODE,'WORKSPACE) THEN
+ SET(WRKSP,RESULT);
+ GO TO A;
+ D: IF ERFG!* THEN GO TO A
+ ELSE IF FLAGP!*!*(KEY!*,'IGNORE) OR EQCAR(PROGRAM!*,'QUOTE)
+ THEN GO TO B;
+ IF PROGRAM!* THEN DFPRINT PROGRAM!*;
+ IF FLAGP!*!*(KEY!*,'EVAL) THEN GO TO B ELSE GO TO A;
+ ND0:COMM1 'END;
+ ND1: EOF!* := NIL;
+ IF NULL IPL!* %terminal END;
+ THEN BEGIN
+ IF OFL!* THEN WRS NIL;
+ AA: IF NULL OPL!* THEN RETURN(OFL!* := NIL);
+ CLOSE CDAR OPL!*;
+ OPL!* := CDR OPL!*;
+ GO TO AA
+ END;
+ RETURN NIL;
+ ERR1:
+ IF EOF!* OR PROGRAM!* EQ !$EOF!$ THEN GO TO ND1
+ ELSE IF PROGRAM!* EQ 'EXTRA! BEGIN THEN GO TO A
+% ELSE IF PROGRAM!* EQ !*!*ESC THEN GO TO A0
+ ELSE GO TO ER1;
+ ER: LPRIE IF NULL ATOM CADR PROGRAM!*
+ THEN LIST(CAADR PROGRAM!*,"UNDEFINED")
+ ELSE "SYNTAX ERROR";
+ ER1:
+ PARSERR := T;
+ GO TO ERR3;
+ ERR2:
+ PROGRAML!* := PROGRAM!*;
+ ERR3:
+ RESETPARSER();
+% IF NULL ERFG!* OR ERFG!* EQ 'HOLD
+% THEN LPRIE "ERROR TERMINATION *****";
+ ERFG!* := T;
+ IF NULL !*INT THEN GO TO E;
+ RESULT := PAUSE1 PARSERR;
+ IF RESULT THEN RETURN NULL EVAL RESULT;
+ ERFG!* := NIL;
+ GO TO A;
+ E: !*DEFN := T; %continue syntax analyzing but not evaluation;
+ !*ECHO := T;
+ IF NULL CMSG!* THEN LPRIE "CONTINUING WITH PARSING ONLY ...";
+ CMSG!* := T;
+ GO TO A
+ END;
+
+SYMBOLIC PROCEDURE CONDTERPRI;
+ !*OUTPUT AND !*ECHO AND !*EXTRAECHO AND (NULL !*INT OR IFL!*)
+ AND NULL !*DEFN AND POSN() > 0 AND TERPRI();
+
+CommentOutCode <<
+SYMBOLIC PROCEDURE ASSGNL U;
+ IF ATOM U OR NULL (CAR U MEMQ '(SETK SETQ SETEL))
+ THEN NIL
+ ELSE IF ATOM CADR U THEN MKQUOTE CADR U . ASSGNL CADDR U
+ ELSE CADR U . ASSGNL CADDR U;
+>>;
+
+SYMBOLIC PROCEDURE DFPRINT U;
+ %Looks for special action on a form, otherwise prettyprints it;
+ IF DFPRINT!* THEN APPLY(DFPRINT!*,LIST U)
+% ELSE IF CMSG!* THEN NIL
+ ELSE IF NULL EQCAR(U,'PROGN) THEN
+ << PRINTF "%f";
+ PRETTYPRINT U >>
+ ELSE BEGIN
+ A: U := CDR U;
+ IF NULL U THEN RETURN NIL;
+ DFPRINT CAR U;
+ GO TO A
+ END;
+
+SYMBOLIC PROCEDURE SHOWTIME;
+ BEGIN SCALAR X;
+ X := OTIME!*;
+ OTIME!* := TIME();
+ X := OTIME!*-X;
+% TERPRI();
+ PRIN2 "TIME: "; PRIN2 X; PRIN2T " MS";
+ END;
+
+SYMBOLIC PROCEDURE SINITL U;
+ SET(U,GET(U,'INITL));
+
+FLAG ('(IN OUT ON OFF SHUT),'IGNORE);
+
+
+%*********************************************************************
+% IDENTIFIER AND RESERVED CHARACTER READING
+%********************************************************************;
+
+% The function TOKEN defined below is used for reading
+%identifiers and reserved characters (such as parentheses and infix
+%operators). It is called by the function SCAN, which translates
+%reserved characters into their internal name, and sets up the output
+%of the input line. The following definitions of TOKEN and SCAN are
+%quite general, but also inefficient. THE READING PROCESS CAN OFTEN
+%BE SPEEDED UP BY A FACTOR OF AS MUCH AS FIVE IF THESE FUNCTIONS
+%(ESPECIALLY TOKEN) ARE CODED IN ASSEMBLY LANGUAGE;
+
+CommentOutCode <<
+SYMBOLIC PROCEDURE PRIN2X U;
+ OUTL!*:=U . OUTL!*;
+
+SYMBOLIC PROCEDURE PTOKEN;
+ BEGIN SCALAR X;
+ X := TOKEN();
+ IF X EQ '!) AND EQCAR(OUTL!*,'! ) THEN OUTL!*:= CDR OUTL!*;
+ %an explicit reference to OUTL!* used here;
+ PRIN2X X;
+ IF NULL ((X EQ '!() OR (X EQ '!))) THEN PRIN2X '! ;
+ RETURN X
+ END;
+>>;
+
+SYMBOLIC PROCEDURE MKEX U;
+ IF NOT(!*MODE EQ 'ALGEBRAIC) OR EQCAR(U,'AEVAL) THEN U
+ ELSE NIL;%APROC(U,'AEVAL);
+
+SYMBOLIC PROCEDURE MKSETQ(U,V);
+ LIST('SETQ,U,V);
+
+SYMBOLIC PROCEDURE MKVAR(U,V); U;
+
+SYMBOLIC PROCEDURE RPLCDX(U,V); IF CDR U=V THEN U ELSE RPLACD(U,V);
+
+SYMBOLIC PROCEDURE REFORM U;
+ IF ATOM U OR CAR U EQ 'QUOTE THEN U
+ ELSE IF CAR U EQ 'COND THEN 'COND . REFORM CDR U
+ ELSE IF CAR U EQ 'PROG
+ THEN PROGN(RPLCDX(CDR U,MAPCAR(CDDR U,FUNCTION REFORM)),U)
+ ELSE IF CAR U EQ 'LAMBDA
+ THEN PROGN(RPLACA(CDDR U,REFORM CADDR U),U)
+ ELSE IF CAR U EQ 'FUNCTION AND ATOM CADR U
+ THEN BEGIN SCALAR X;
+ IF NULL !*CREF AND (X:= GET(CADR U,'SMACRO))
+ THEN RETURN LIST('FUNCTION,X)
+ ELSE IF GET(CADR U,'NMACRO) OR MACROP CADR U
+ THEN REDERR "MACRO USED AS FUNCTION"
+ ELSE RETURN U END
+% ELSE IF CAR U EQ 'MAT THEN RPLCDX(U,MAPC2(CDR U,FUNCTION REFORM))
+ ELSE IF ATOM CAR U
+ THEN BEGIN SCALAR X,Y;
+ IF (Y := GETD CAR U) AND CAR Y EQ 'MACRO
+ AND EXPANDQ CAR U
+ THEN RETURN REFORM APPLY(CDR Y,LIST U);
+ X := REFORMLIS CDR U;
+ IF NULL IDP CAR U THEN RETURN(CAR U . X)
+ ELSE IF (NULL !*CREF OR EXPANDQ CAR U)
+ AND (Y:= GET(CAR U,'NMACRO))
+ THEN RETURN
+ APPLY(Y,IF FLAGP(CAR U,'NOSPREAD) THEN LIST X ELSE X)
+ ELSE IF (NULL !*CREF OR EXPANDQ CAR U)
+ AND (Y:= GET(CAR U,'SMACRO))
+ THEN RETURN SUBLIS(PAIR(CADR Y,X),CADDR Y)
+ %we could use an atom SUBLIS here (eg, SUBLA);
+ ELSE RETURN PROGN(RPLCDX(U,X),U)
+ END
+ ELSE REFORM CAR U . REFORMLIS CDR U;
+
+SYMBOLIC PROCEDURE REFORMLIS U;
+ IF ATOM U THEN U ELSE REFORM CAR U . REFORMLIS CDR U;
+
+SYMBOLIC PROCEDURE EXPANDQ U;
+ %determines if macro U should be expanded in REFORM;
+ FLAGP(U,'EXPAND) OR !*FORCE AND NULL FLAGP(U,'NOEXPAND);
+
+CommentOutCode <<
+SYMBOLIC PROCEDURE ARRAYP U;
+ GET(U,'ARRAY);
+
+SYMBOLIC PROCEDURE GETTYPE U;
+ %it might be better to use a table here for more generality;
+ IF NULL ATOM U THEN 'FORM
+ ELSE IF NUMBERP U THEN 'NUMBER
+ ELSE IF ARRAYP U THEN 'ARRAY
+ ELSE IF GETD U THEN 'PROCEDURE
+ ELSE IF GLOBALP U THEN 'GLOBAL
+ ELSE IF FLUIDP U THEN 'FLUID
+ ELSE IF GET(U,'MATRIX) THEN 'MATRIX
+ ELSE IF GET(U,'SIMPFN) OR GET(U,'MSIMPFN) THEN 'OPERATOR
+ ELSE IF FLAGP(U,'PARM) THEN 'PARAMETER
+ ELSE NIL;
+
+SYMBOLIC PROCEDURE GETELS U;
+ GETEL(CAR U . EVLIS(CDR U));
+
+SYMBOLIC PROCEDURE SETELS(U,V);
+ SETEL(CAR U . EVLIS(CDR U),V);
+>>;
+
+%. Top Level Entry Function
+%. --- Special Flags -----
+% !*DEMO -
+
+SYMBOLIC PROCEDURE COMMAND;
+ BEGIN SCALAR X,Y;
+ IF !*DEMO AND (X := IFL!*)
+ THEN PROGN(TERPRI(),RDS NIL,READCH(),RDS CDR X);
+% IF EDIT!* THEN EDITLINE() ELSE IF FLG!* THEN GO TO A;
+ IF !*SLIN THEN
+ <<KEY!* := SEMIC!* := '!;;
+ CLOC!* := IF IFL!* THEN CAR IFL!* . PGLINE() ELSE NIL;
+ X := IF LREADFN!* THEN APPLY(LREADFN!*,NIL) ELSE READ();
+ IF KEY!* EQ '!; THEN KEY!* := IF ATOM X THEN X ELSE CAR X>>
+ ELSE <<SetRlispScanTable(); MakeInputAvailable(); SCAN();
+ CLOC!* := IF IFL!* THEN CAR IFL!* . PGLINE() ELSE NIL;
+ KEY!* := CURSYM!*; X := XREAD1 NIL>>;
+ IF !*PRET THEN PROGN(TERPRI(),RPRINT X);
+ X := REFORM X;
+ IF CLOC!* AND NOT ATOM X AND CAR X MEMQ '(DE DF DM)
+ THEN PUT(CADR X,'LOCN,CLOC!*)
+ ELSE IF CLOC!* AND EQCAR(X,'PROGN)
+ AND CDDR X AND NOT ATOM CADDR X
+ AND CAADDR X MEMQ '(DE DF DM)
+ THEN PUT(CADR CADDR X,'LOCN,CLOC!*);
+% IF IFL!*='(DSK!: (INPUT . TMP)) AND
+% (Y:= PGLINE()) NEQ '(1 . 0)
+% THEN LPL!*:= Y; %use of IN(noargs);
+ IF NULL IDP KEY!* OR NULL(GET(KEY!*,'STAT) EQ 'MODESTAT)
+ AND NULL(KEY!* EQ 'ED)
+ THEN X := MKEX X;
+ A: IF FLG!* AND IFL!* THEN BEGIN
+ CLOSE CDR IFL!*;
+ IPL!* := DELETE(IFL!*,IPL!*);
+ IF IPL!* THEN RDS CDAR IPL!* ELSE RDS NIL;
+ IFL!* := NIL END;
+ FLG!* := NIL;
+ RETURN X
+ END;
+
+OFF R2I;
+
+SYMBOLIC PROCEDURE RPRINT U; % Autoloading stub
+<< LOAD RPRINT;
+ RPRINT U >>;
+
+ON R2I;
+
+%*********************************************************************
+% GENERAL FUNCTIONS
+%********************************************************************;
+
+
+%SYMBOLIC PROCEDURE MAPC2(U,V);
+% %this very conservative definition is to allow for systems with
+% %poor handling of functional arguments, and because of bootstrap-
+% %ping difficulties;
+% BEGIN SCALAR X,Y,Z;
+% A: IF NULL U THEN RETURN REVERSIP Z;
+% X := CAR U;
+% Y := NIL;
+% B: IF NULL X THEN GO TO C;
+% Y := APPLY(V,LIST CAR X) . Y;
+% X := CDR X;
+% GO TO B;
+% C: U := CDR U;
+% Z := REVERSIP Y . Z:
+% GO TO A
+% END;
+
+
+
+%*********************************************************************
+% FUNCTIONS FOR PRINTING DIAGNOSTIC AND ERROR MESSAGES
+%********************************************************************;
+
+SYMBOLIC PROCEDURE LPRIE U;
+<< ERRORPRINTF("***** %L", U);
+ ERFG!* := T >>;
+
+SYMBOLIC PROCEDURE LPRIM U;
+ !*MSG AND ERRORPRINTF("*** %L", U);
+
+SYMBOLIC PROCEDURE REDERR U;
+ BEGIN %TERPRI();
+ LPRIE U; ERROR(99,NIL) END;
+
+
+SYMBOLIC PROCEDURE PROGVR VAR;
+ IF NOT ATOM VAR THEN NIL
+ ELSE IF NUMBERP VAR OR FLAGP(VAR,'SHARE)
+ OR NOT(!*MODE EQ 'ALGEBRAIC) AND FLUIDP VAR THEN T
+ ELSE BEGIN SCALAR X;
+ IF X := GET(VAR,'DATATYPE) THEN RETURN CAR X END;
+
+SYMBOLIC PROCEDURE MKARG U;
+ IF NULL U THEN NIL
+ ELSE IF ATOM U THEN IF PROGVR U THEN U ELSE MKQUOTE U
+ ELSE IF CAR U EQ 'QUOTE THEN MKQUOTE U
+ ELSE IF FLAGP!*!*(CAR U,'NOCHANGE) AND NOT FLAGP(KEY1!*,'QUOTE)
+ THEN U
+ ELSE 'LIST . MAPCAR(U,FUNCTION MKARG);
+
+
+SYMBOLIC PROCEDURE MKPROG(U,V);
+ 'PROG . (U . V);
+
+CommentOutCode <<
+SYMBOLIC PROCEDURE SETDIFF(U,V);
+ IF NULL V THEN U ELSE SETDIFF(DELETE(CAR V,U),CDR V);
+
+SYMBOLIC PROCEDURE REMTYPE VARLIS;
+ BEGIN SCALAR X,Y;
+ VARS!* := SETDIFF(VARS!*,VARLIS);
+ A: IF NULL VARLIS THEN RETURN NIL;
+ X := CAR VARLIS;
+ Y := CDR GET(X,'DATATYPE);
+ IF Y THEN PUT(X,'DATATYPE,Y)
+ ELSE PROGN(REMPROP(X,'DATATYPE),REMFLAG(LIST X,'PARM));
+ VARLIS := CDR VARLIS;
+ GO TO A
+ END;
+>>;
+
+DEFLIST('((LISP SYMBOLIC)),'NEWNAM);
+
+FLAG('(FOR),'NOCHANGE);
+
+FLAG('(REPEAT),'NOCHANGE);
+
+FLAG('(WHILE),'NOCHANGE);
+
+CommentOutCode <<
+COMMENT LISP arrays built with computed index into a vector;
+% FLUID '(U V X Y N); %/ Fix for MAPC closed compile
+
+SYMBOLIC PROCEDURE ARRAY U;
+ FOR EACH X IN U DO
+ BEGIN INTEGER Y;
+ IF NULL CDR X OR NOT IDP CAR X
+ THEN REDERR LIST(X,"CANNOT BECOME AN ARRAY");
+ Y:=1;
+ FOR EACH V IN CDR X DO Y:=Y*(V+1);
+ PUT(CAR X,'ARRAY,MKVECT(Y-1));
+ PUT(CAR X,'DIMENSION,ADD1LIS CDR X);
+ END;
+
+SYMBOLIC PROCEDURE CINDX!* U;
+ BEGIN SCALAR V; INTEGER N;
+ N:=0;
+ IF NULL(V:=DIMENSION CAR U)
+ THEN REDERR LIST(CAR U,"NOT AN ARRAY");
+ FOR EACH Y IN CDR U DO
+ <<IF NULL V THEN REDERR LIST(U,"TOO MANY INDICES");
+ IF Y<0 OR Y>CAR V-1
+ THEN REDERR LIST(U,"INDEX OUT OF RANGE");
+ N:=Y+N*CAR V;
+ V:=CDR V>>;
+ IF V THEN REDERR LIST(U,"TOO FEW INDICES");
+ RETURN N
+ END;
+%UNFLUID '(U V X Y N); %/ Fix for MAPC closed compile
+
+SYMBOLIC PROCEDURE GETEL U;
+ GETV(ARRAYP CAR U,CINDX!* U);
+
+SYMBOLIC PROCEDURE SETEL(U,V);
+ PUTV(ARRAYP CAR U,CINDX!* U,V);
+
+SYMBOLIC PROCEDURE DIMENSION U;
+ GET(U,'DIMENSION);
+
+
+COMMENT further support for REDUCE arrays;
+
+SYMBOLIC PROCEDURE TYPECHK(U,V);
+ BEGIN SCALAR X;
+ IF (X := GETTYPE U) EQ V OR X EQ 'PARAMETER
+ THEN LPRIM LIST(U,"ALREADY DEFINED AS",V)
+ ELSE IF X THEN REDERR LIST(X,U,"INVALID AS",V)
+ END;
+
+SYMBOLIC PROCEDURE NUMLIS U;
+ NULL U OR (NUMBERP CAR U AND NUMLIS CDR U);
+
+CompileTime REMPROP('ARRAY,'STAT); %for bootstrapping purposes;
+
+SYMBOLIC PROCEDURE ARRAYFN U;
+ BEGIN SCALAR X,Y;
+ A: IF NULL U THEN RETURN;
+ X := CAR U;
+ IF ATOM X THEN REDERR "SYNTAX ERROR"
+ ELSE IF TYPECHK(CAR X,'ARRAY) THEN GO TO B;
+ Y := IF NOT(!*MODE EQ 'ALGEBRAIC) THEN !*EVLIS CDR X
+ ELSE REVLIS CDR X;
+ IF NOT NUMLIS Y
+ THEN LPRIE LIST("INCORRECT ARRAY ARGUMENTS FOR",CAR X);
+ ARRAY LIST (CAR X . Y);
+ B: U := CDR U;
+ GO TO A
+ END;
+
+SYMBOLIC PROCEDURE ADD1LIS U;
+ IF NULL U THEN NIL ELSE (CAR U+1) . ADD1LIS CDR U;
+
+>>;
+%*********************************************************************
+%*********************************************************************
+% REDUCE FUNCTIONS FOR HANDLING INPUT AND OUTPUT OF FILES
+%*********************************************************************
+%********************************************************************;
+
+GLOBAL '(CONTL!*);
+
+MACRO PROCEDURE IN U;
+ LIST('EVIN, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVIN U;
+ BEGIN SCALAR CHAN,ECHO,ECHOP,EXTN,OSLIN,OLRDFN,OTSLIN;
+ ECHOP := SEMIC!* EQ '!;;
+ ECHO := !*ECHO;
+ IF NULL IFL!* THEN TECHO!* := !*ECHO; %terminal echo status;
+ OSLIN := !*SLIN;
+ OLRDFN := LREADFN!*;
+ OTSLIN := TSLIN!*;
+ TSLIN!* := NIL;
+ FOR EACH FL IN U DO
+ <<CHAN := OPEN(FL,'INPUT); IFL!* := FL . CHAN;
+ IPL!* := IFL!* . IPL!*;
+ RDS (IF IFL!* THEN CDR IFL!* ELSE NIL);
+ !*ECHO := ECHOP;
+ !*SLIN := T;
+ IF LISPFILENAMEP FL THEN LREADFN!* := NIL
+ ELSE !*SLIN := OSLIN;
+ BEGIN1();
+ IF !*SLIN THEN RESETPARSER();
+ IF CHAN THEN CLOSE CHAN;
+ LREADFN!* := OLRDFN;
+ !*SLIN := OSLIN;
+ IF FL EQ CAAR IPL!* THEN IPL!* := CDR IPL!*
+ ELSE REDERR LIST("FILE STACK CONFUSION",FL,IPL!*)>>;
+ !*ECHO := ECHO; %restore echo status;
+ TSLIN!* := OTSLIN;
+ IF IPL!* AND NULL CONTL!* THEN IFL!* := CAR IPL!*
+ ELSE IFL!* := NIL;
+ RDS(IF IFL!* THEN CDR IFL!* ELSE NIL);
+ RETURN NIL
+ END;
+
+CommentOutCode <<
+lisp procedure RedIN F;
+begin scalar !*Echo, !*Output, !*SLIN, Chan;
+ IPL!* := (IFL!* := (F . (Chan := Open(F, 'Input)))) . IPL!*;
+ RDS Chan;
+ Begin1();
+ IPL!* := cdr IPL!*;
+ RDS(if not null IPL!* then cdr first IPL!* else NIL);
+end;
+>>;
+
+SYMBOLIC PROCEDURE LISPFILENAMEP S; %. Look for ".SL" or ".LSP"
+BEGIN SCALAR C, I, SS;
+ SS := SIZE S;
+ IF SS < 3 THEN RETURN NIL;
+ I := SS;
+LOOP:
+ IF I < 0 THEN RETURN NIL;
+ IF INDX(S, I) = CHAR '!. THEN GOTO LOOPEND;
+ I := I - 1;
+ GOTO LOOP;
+LOOPEND:
+ I := I + 1;
+ C := SS - I;
+ IF NOT (C MEMBER '(1 2)) THEN RETURN NIL;
+ C := SUBSEQ(S, I, SS + 1);
+ RETURN IF C MEMBER '("SL" "sl" "LSP" "lsp" "Sl" "Lsp") THEN T ELSE NIL;
+END;
+
+MACRO PROCEDURE OUT U;
+ LIST('EVOUT, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVOUT U;
+ %U is a list of one file;
+ BEGIN SCALAR CHAN,FL,X;
+ IF NULL U THEN RETURN NIL
+ ELSE IF CAR U EQ 'T THEN RETURN <<WRS(OFL!* := NIL); NIL>>;
+ FL := MKFIL CAR U;
+ IF NOT (X := ASSOC(FL,OPL!*))
+ THEN <<CHAN := OPEN(FL,'OUTPUT);
+ OFL!* := FL . CHAN;
+ OPL!* := OFL!* . OPL!*>>
+ ELSE OFL!* := X;
+ WRS CDR OFL!*
+ END;
+
+MACRO PROCEDURE SHUT U;
+ LIST('EVSHUT, MKQUOTE CDR U);
+
+SYMBOLIC PROCEDURE EVSHUT U;
+ %U is a list of names of files to be shut;
+ BEGIN SCALAR FL,FL1;
+ A: IF NULL U THEN RETURN NIL
+ ELSE IF FL1 := ASSOC((FL := MKFIL CAR U),OPL!*) THEN GO TO B
+ ELSE IF NOT (FL1 := ASSOC(FL,IPL!*))
+ THEN REDERR LIST(FL,"NOT OPEN");
+ IF FL1 NEQ IFL!*
+ THEN <<CLOSE CDR FL1; IPL!* := DELETE(FL1,IPL!*)>>
+ ELSE REDERR LIST("CANNOT CLOSE CURRENT INPUT FILE",CAR FL);
+ GO TO C;
+ B: OPL!* := DELETE(FL1,OPL!*);
+ IF FL1=OFL!* THEN <<OFL!* := NIL; WRS NIL>>;
+ CLOSE CDR FL1;
+ C: U := CDR U;
+ GO TO A
+ END;
+
+%/ removed STAT property
+
+%*********************************************************************
+% FUNCTIONS HANDLING INTERACTIVE FEATURES
+%********************************************************************;
+
+%GLOBAL Variables referenced in this Section;
+
+CONTL!* := NIL;
+
+SYMBOLIC PROCEDURE PAUSE;
+ PAUSE1 NIL;
+
+SYMBOLIC PROCEDURE PAUSE1 BOOL;
+ BEGIN
+% IF BOOL THEN
+% IF NULL IFL!*
+% THEN RETURN IF !*INT AND GETD 'CEDIT AND YESP 'EDIT!?
+% THEN CEDIT() ELSE
+% NIL
+% ELSE IF GETD 'EDIT1 AND ERFG!* AND CLOC!* AND YESP 'EDIT!?
+% THEN RETURN <<CONTL!* := NIL;
+% IF OFL!* THEN <<LPRIM LIST(CAR OFL!*,'SHUT);
+% CLOSE CDR OFL!*;
+% OPL!* := DELETE(OFL!*,OPL!*);
+% OFL!* := NIL>>;
+% EDIT1(CLOC!*,NIL)>>
+% ELSE IF FLG!* THEN RETURN (EDIT!* := NIL);
+ IF NULL IFL!* OR YESP 'CONT!? THEN RETURN NIL;
+ CONTL!* := IFL!* . !*ECHO . CONTL!*;
+ RDS (IFL!* := NIL);
+ !*ECHO := TECHO!*
+ END;
+
+SYMBOLIC PROCEDURE CONT;
+ BEGIN SCALAR FL,TECHO;
+ IF IFL!* THEN RETURN NIL %CONT only active from terminal;
+ ELSE IF NULL CONTL!* THEN REDERR "NO FILE OPEN";
+ FL := CAR CONTL!*;
+ TECHO := CADR CONTL!*;
+ CONTL!* := CDDR CONTL!*;
+ IF FL=CAR IPL!* THEN <<IFL!* := FL;
+ RDS IF FL THEN CDR FL ELSE NIL;
+ !*ECHO := TECHO>>
+ ELSE <<EOF!* :=T; LPRIM LIST(FL,"NOT OPEN"); ERROR(99,NIL)>>
+ END;
+
+%/DEFLIST ('((PAUSE ENDSTAT) (CONT ENDSTAT) (RETRY ENDSTAT)),'STAT);
+
+%/PUT('RETRY,'STAT,'ENDSTAT);
+
+FLAG ('(CONT),'IGNORE);
+
+
+%******** "rend" fixups
+
+GLOBAL '(!*INT CONTL!* DATE!* !*MODE
+ IMODE!* CRCHAR!* !*SLIN LREADFN!*);
+
+REMFLAG('(BEGINRLISP),'GO);
+
+%---- Merge into XREAD1 in command ----
+% Shouldnt USE Scan in COMMAND, since need change Parser first
+
+FLUID '(!*PECHO);
+
+Symbolic Procedure XREAD1 x; %. With Catches
+ Begin scalar Form!*;
+ Form!*:=PARSE0(0, NIL);
+ If !*PECHO then PRIN2T LIST("parse>",Form!*);
+ Return Form!*
+ end;
+
+lisp procedure Xread X;
+ Begin scalar Form!*;
+ MakeInputAvailable();
+ Form!*:=PARSE0(0, T);
+ If !*PECHO then PRIN2T LIST("parse>",Form!*);
+ Return Form!*
+ end;
+
+!*PECHO:=NIL;
+
+SYMBOLIC PROCEDURE BEGINRLISP;
+ BEGIN SCALAR A,B,PROMPTSTRING!*;
+%/ !*BAKGAG := NIL;
+ !*INT := T;
+ !*ECHO := NIL;
+ A := !*SLIN;
+ !*SLIN := LREADFN!* := NIL;
+ CONTL!* := IFL!* := IPL!* := OFL!* := OPL!* := NIL;
+ !*MODE := IMODE!*;
+ CRCHAR!* := '! ;
+%/ RDSLSH NIL;
+%/ SETPCHAR '!*;
+ SetRlispScanTable();
+% IF SYSTEM!* NEQ 0 THEN CHKLEN();
+ IF DATE!* EQ NIL
+ THEN IF A THEN <<PRIN2 "Entering RLISP..."; GO TO B>>
+ ELSE GO TO A;
+%/ IF FILEP '((REDUCE . INI)) THEN <<IN REDUCE.INI; TERPRI()>>;
+%/ ERRORSET(QUOTE LAPIN "PSL.INI", NIL, NIL); % no error if not there
+ PRIN2 DATE!*;
+ DATE!* := NIL;
+% IF SYSTEM!* NEQ 1 THEN GO TO A;
+% IF !*HELP THEN PRIN2 "For help, type HELP()";
+ B: TERPRI();
+ A: BEGIN1();
+% TERPRI();
+ !*SLIN := T;
+%/ RDSLSH NIL;
+ SetLispScanTable();
+ PRIN2T "Entering LISP..."
+ END;
+
+FLAG('(BEGINRLISP),'GO);
+
+PUTD('BEGIN,'EXPR, CDR GETD 'BEGINRLISP);
+
+SYMBOLIC PROCEDURE MKFIL U;
+ %converts file descriptor U into valid system filename;
+ U;
+
+SYMBOLIC PROCEDURE NEWMKFIL U;
+ %converts file descriptor U into valid system filename;
+ U;
+
+lisp procedure SetPChar C; %. Set prompt, return old one
+begin scalar OldPrompt;
+ OldPrompt := PromptString!*;
+ PromptString!* := if StringP C then C
+ else if IDP C then CopyString ID2String C
+ else BldMsg("%w", C);
+ return OldPrompt;
+end;
+
+COMMENT Some Global Variables required by REDUCE;
+
+%GLOBAL '(!*!*ESC);
+%
+%!*!*ESC := 'ESC!.NOT!.NEEDED!.NOW; %to make it user settable (used to be a NEWNAM);
+
+
+COMMENT The remaining material in this file introduces extensions
+ or redefinitions of code in the REDUCE source files, and
+ is not really necessary to run a basic system;
+
+
+lisp procedure SetRlispScanTable();
+<< CurrentReadMacroIndicator!* :='RLispReadMacro;
+ CurrentScanTable!* := RLispScanTable!* >>;
+
+lisp procedure SetLispScanTable();
+<< CurrentReadMacroIndicator!* :='LispReadMacro;
+ CurrentScanTable!* := LispScanTable!* >>;
+
+PutD('LispSaveSystem, 'EXPR, cdr GetD 'SaveSystem);
+
+lisp procedure SaveSystem(S, F, I); %. Set up for saving EXE file
+<< StatCounter!* := 0;
+ RemD 'Main;
+ Copyd('Main, 'RlispMain);
+ Date!* := BldMsg("%w, %w", S, Date());
+ LispSaveSystem("PSL", F, I) >>;
+
+lisp procedure RlispMain();
+<< BeginRlisp();
+ StandardLisp() >>;
+
+lisp procedure Rlisp(); % Uses new top loop
+<< SetRlispScanTable();
+ TopLoop('ReformXRead, 'PrintWithFreshLine, 'Eval, "rlisp", "PSL Rlisp") >>;
+
+lisp procedure ReformXRead();
+ Reform XRead T;
+
+!*RAISE := T;
+
+%IF GETD 'ADDSQ THEN IMODE!* := 'ALGEBRAIC ELSE IMODE!* := 'SYMBOLIC;
+IMODE!* := 'SYMBOLIC;
+
+TSLIN!* := NIL;
+!*MSG := T;
+
+END;
ADDED psl-1983/3-1/util/rlisp.build
Index: psl-1983/3-1/util/rlisp.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rlisp.build
@@ -0,0 +1,2 @@
+in "rlisp-parser.red"$
+in "rlisp-support.red"$
ADDED psl-1983/3-1/util/rlispcomp.sl
Index: psl-1983/3-1/util/rlispcomp.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rlispcomp.sl
@@ -0,0 +1,66 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% RLISPCOMP.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 27 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% This program reads and interprets
+% the program command string as a list of source files to be compiled.
+
+(CompileTime (load common pathnames))
+(load pathnamex parse-command-string get-command-string compiler)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(*usermode *redefmsg CurrentReadMacroIndicator* CurrentScanTable*))
+(fluid '(*quiet_faslout *WritingFASLFile))
+
+(de rlispcomp ()
+ (let ((c-list (parse-command-string (get-command-string)))
+ (*usermode nil)
+ (*redefmsg nil))
+ (compile-files c-list)
+ )
+ )
+
+(de compile-files (c-list)
+ (cond ((null c-list)
+ (PrintF "RLisp Compiler%n")
+ (PrintF "Usage: RLISPCOMP source-file ...%n")
+ )
+ (t
+ (for (in fn c-list)
+ (do (attempt-to-compile-file fn))
+ )
+ (quit)
+ )))
+
+(de attempt-to-compile-file (fn)
+ (let* ((form (list 'COMPILE-FILE fn))
+ (*break NIL)
+ (result (ErrorSet form T NIL))
+ )
+ (cond ((FixP result)
+ (if *WritingFASLFile (faslend))
+ (printf "%n ***** Error during compilation of %w.%n" fn)
+ ))
+ ))
+
+(de compile-file (fn)
+ (let ((source-fn (namestring (pathname-set-default-type fn "RED")))
+ (binary-fn (namestring (pathname-set-type fn "B")))
+ (*quiet_faslout T)
+ )
+ (if (not (FileP source-fn))
+ (printf "Unable to open source file: %w%n" source-fn)
+ % else
+ (printf "%n----- Compiling %w%n" source-fn binary-fn)
+ (faslout (namestring (pathname-without-type binary-fn)))
+ (eval (list 'in source-fn)) % Damn FEXPRs
+ (faslend)
+ (printf "%nDone compiling %w%n%n" source-fn)
+ )))
ADDED psl-1983/3-1/util/rprint.build
Index: psl-1983/3-1/util/rprint.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rprint.build
@@ -0,0 +1,1 @@
+in "rprint.red"$
ADDED psl-1983/3-1/util/rprint.red
Index: psl-1983/3-1/util/rprint.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/rprint.red
@@ -0,0 +1,601 @@
+COMMENT MODULE RPRINT;
+
+COMMENT THE STANDARD LISP TO REDUCE PRETTY PRINTER;
+
+COMMENT THESE GUYS ARE SET BY THE OLD PARSER AND DO NOT NORMALLY EXIST IN PSL;
+
+PUT('EXPT,'OP,'((19 19)));
+
+PUT('TIMES,'OP,'((17 17)));
+
+PUT('!*SEMICOL!*,'OP,'((-1 0)));
+
+PUT('OR,'OP,'((3 3)));
+
+PUT('GEQ,'OP,'((11 11)));
+
+PUT('NOT,'OP,'(NIL 5));
+
+PUT('RECIP,'OP,'(NIL 18));
+
+PUT('QUOTIENT,'OP,'((18 18)));
+
+PUT('MEMQ,'OP,'((7 7)));
+
+PUT('MINUS,'OP,'(NIL 16));
+
+PUT('SETQ,'OP,'((2 2)));
+
+PUT('GREATERP,'OP,'((12 12)));
+
+PUT('MEMBER,'OP,'((6 6)));
+
+PUT('AND,'OP,'((4 4)));
+
+PUT('CONS,'OP,'((20 20)));
+
+PUT('PLUS,'OP,'((15 15)));
+
+PUT('EQUAL,'OP,'((8 8)));
+
+PUT('LEQ,'OP,'((13 13)));
+
+PUT('DIFFERENCE,'OP,'((16 16)));
+
+PUT('NEQ,'OP,'((9 9)));
+
+PUT('LESSP,'OP,'((14 14)));
+
+PUT('!*COMMA!*,'OP,'((5 6)));
+
+PUT('EQ,'OP,'((10 10)));
+
+
+FLUID '(PRETOP PRETOPRINF);
+
+PRETOP := 'OP; PRETOPRINF := 'OPRINF;
+
+FLUID '(COMBUFF);
+
+FLUID '(CURMARK BUFFP RMAR !*N);
+
+SYMBOLIC PROCEDURE RPRINT U;
+ BEGIN INTEGER !*N; SCALAR BUFF,BUFFP,CURMARK,RMAR,X;
+ CURMARK := 0;
+ BUFF := BUFFP := LIST LIST(0,0);
+ RMAR := LINELENGTH NIL;
+ X := GET('!*SEMICOL!*,PRETOP);
+ !*N := 0;
+ MPRINO1(U,LIST(CAAR X,CADAR X));
+ PRIN2OX ";";
+ OMARKO CURMARK;
+ PRINOS BUFF
+ END;
+
+SYMBOLIC PROCEDURE RPRIN1 U;
+ BEGIN SCALAR BUFF,BUFFP,CURMARK,X;
+ CURMARK := 0;
+ BUFF := BUFFP := LIST LIST(0,0);
+ X := GET('!*SEMICOL!*,PRETOP);
+ MPRINO1(U,LIST(CAAR X,CADAR X));
+ OMARKO CURMARK;
+ PRINOS BUFF
+ END;
+
+SYMBOLIC PROCEDURE MPRINO U; MPRINO1(U,LIST(0,0));
+
+SYMBOLIC PROCEDURE MPRINO1(U,V);
+ BEGIN SCALAR X;
+ IF X := ATSOC(U,COMBUFF)
+ THEN <<FOR EACH Y IN CDR X DO COMPROX Y;
+ COMBUFF := DELETE(X,COMBUFF)>>;
+ IF NUMBERP U AND U<0 AND (X := GET('DIFFERENCE,PRETOP))
+ THEN RETURN BEGIN SCALAR P;
+ X := CAR X;
+ P := (NOT CAR X>CADR V) OR (NOT CADR X>CAR V);
+ IF P THEN PRIN2OX "(";
+ PRINOX U;
+ IF P THEN PRINOX ")"
+ END
+ ELSE IF ATOM U THEN RETURN PRINOX U
+ ELSE IF NOT ATOM CAR U
+ THEN <<CURMARK := CURMARK+1;
+ PRIN2OX "("; MPRINO CAR U; PRIN2OX ")";
+ OMARK LIST(CURMARK,3); CURMARK := CURMARK-1>>
+ ELSE IF X := GET(CAR U,PRETOPRINF)
+ THEN RETURN BEGIN SCALAR P;
+ P := CAR V>0 AND NOT CAR U MEMQ '(BLOCK PROG QUOTE STRING);
+ IF P THEN PRIN2OX "(";
+ APPLY(X,LIST CDR U);
+ IF P THEN PRIN2OX ")"
+ END
+ ELSE IF X := GET(CAR U,PRETOP)
+ THEN RETURN IF CAR X THEN INPRINOX(U,CAR X,V)
+ ELSE IF CDDR U THEN REDERR "SYNTAX ERROR"
+ ELSE IF NULL CADR X THEN INPRINOX(U,LIST(100,1),V)
+ ELSE INPRINOX(U,LIST(100,CADR X),V)
+ ELSE PRINOX CAR U;
+ IF RLISTATP CAR U THEN RETURN RLPRI(CDR U,V);
+ U := CDR U;
+ IF NULL U THEN PRIN2OX "()"
+ ELSE MPRARGS(U,V)
+ END;
+
+SYMBOLIC PROCEDURE MPRARGS(U,V);
+ IF NULL CDR U THEN <<PRIN2OX " "; MPRINO1(CAR U,LIST(100,100))>>
+ ELSE INPRINOX('!*COMMA!* . U,LIST(0,0),V);
+
+SYMBOLIC PROCEDURE INPRINOX(U,X,V);
+ BEGIN SCALAR P;
+ P := (NOT CAR X>CADR V) OR (NOT CADR X>CAR V);
+ IF P THEN PRIN2OX "("; OMARK '(M U);
+ INPRINO(CAR U,X,CDR U);
+ IF P THEN PRIN2OX ")"; OMARK '(M D)
+ END;
+
+SYMBOLIC PROCEDURE INPRINO(OPR,V,L);
+ BEGIN SCALAR FLG,X;
+ CURMARK := CURMARK+2;
+ X := GET(OPR,PRETOP);
+ IF X AND CAR X
+ THEN <<MPRINO1(CAR L,LIST(CAR V,0)); L := CDR L; FLG := T>>;
+ WHILE L DO
+ <<IF OPR EQ '!*COMMA!* THEN <<PRIN2OX ","; OMARKO CURMARK>>
+ ELSE IF OPR EQ 'SETQ
+ THEN <<PRIN2OX " := "; OMARK LIST(CURMARK,1)>>
+ ELSE IF ATOM CAR L OR NOT OPR EQ GET!*(CAAR L,'ALT)
+ THEN <<OMARK LIST(CURMARK,1); OPRINO(OPR,FLG); FLG := T>>;
+ MPRINO1(CAR L,LIST(IF NULL CDR L THEN 0 ELSE CAR V,
+ IF NULL FLG THEN 0 ELSE CADR V));
+ L := CDR L>>;
+ CURMARK := CURMARK-2
+ END;
+
+SYMBOLIC PROCEDURE OPRINO(OPR,B);
+ (LAMBDA X; IF NULL X
+ THEN <<IF B THEN PRIN2OX " "; PRINOX OPR; PRIN2OX " ">>
+ ELSE PRIN2OX CAR X)
+ GET(OPR,'PRTCH);
+
+SYMBOLIC PROCEDURE PRIN2OX U;
+ <<RPLACD(BUFFP,EXPLODE2 U);
+ WHILE CDR BUFFP DO BUFFP := CDR BUFFP>>;
+
+SYMBOLIC PROCEDURE PRINOX U;
+ <<RPLACD(BUFFP,EXPLODE U);
+ WHILE CDR BUFFP DO BUFFP := CDR BUFFP>>;
+
+SYMBOLIC PROCEDURE GET!*(U,V);
+ IF NUMBERP U THEN NIL ELSE GET(U,V);
+
+SYMBOLIC PROCEDURE OMARK U;
+ <<RPLACD(BUFFP,LIST U); BUFFP := CDR BUFFP>>;
+
+SYMBOLIC PROCEDURE OMARKO U; OMARK LIST(U,0);
+
+SYMBOLIC PROCEDURE COMPROX U;
+ BEGIN SCALAR X;
+ IF CAR BUFFP = '(0 0)
+ THEN RETURN <<FOR EACH J IN U DO PRIN2OX J;
+ OMARK '(0 0)>>;
+ X := CAR BUFFP;
+ RPLACA(BUFFP,LIST(CURMARK+1,3));
+ FOR EACH J IN U DO PRIN2OX J;
+ OMARK X
+ END;
+
+SYMBOLIC PROCEDURE RLISTATP U;
+ GET(U,'STAT) MEMBER '(ENDSTAT RLIS RLIS2);
+
+SYMBOLIC PROCEDURE RLPRI(U,V);
+ IF NULL U THEN NIL
+ ELSE IF NOT CAAR U EQ 'LIST OR CDR U THEN REDERR "RPRINT FORMAT ERROR"
+ ELSE BEGIN
+ PRIN2OX " ";
+ OMARK '(M U);
+ INPRINO('!*COMMA!*,LIST(0,0),RLPRI1 CDAR U);
+ OMARK '(M D)
+ END;
+
+SYMBOLIC PROCEDURE RLPRI1 U;
+ IF NULL U THEN NIL
+ ELSE IF EQCAR(CAR U,'QUOTE) THEN CADAR U . RLPRI1 CDR U
+ ELSE IF STRINGP CAR U THEN CAR U . RLPRI1 CDR U
+ ELSE REDERR "RPRINT FORMAT ERROR";
+
+SYMBOLIC PROCEDURE CONDOX U;
+ BEGIN SCALAR X;
+ OMARK '(M U);
+ CURMARK := CURMARK+2;
+ WHILE U DO
+ <<PRIN2OX "IF "; MPRINO CAAR U; OMARK LIST(CURMARK,1);
+ PRIN2OX " THEN ";
+ IF CDR U AND EQCAR(CADAR U,'COND)
+ AND NOT EQCAR(CAR REVERSE CADAR U,'T)
+ THEN <<X := T; PRIN2OX "(">>;
+ MPRINO CADAR U;
+ IF X THEN PRIN2OX ")";
+ U := CDR U;
+ IF U THEN <<OMARKO(CURMARK-1); PRIN2OX " ELSE ">>;
+ IF U AND NULL CDR U AND CAAR U EQ 'T
+ THEN <<MPRINO CADAR U; U := NIL>>>>;
+ CURMARK := CURMARK-2;
+ OMARK '(M D)
+ END;
+
+PUT('COND,PRETOPRINF,'CONDOX);
+
+SYMBOLIC PROCEDURE BLOCKOX U;
+ BEGIN
+ OMARK '(M U);
+ CURMARK := CURMARK+2;
+ PRIN2OX "BEGIN ";
+ IF CAR U THEN VARPRX CAR U;
+ U := CDR U;
+ OMARK LIST(CURMARK,IF EQCAR(CAR U,'!*LABEL) THEN 1 ELSE 3);
+ WHILE U DO
+ <<MPRINO CAR U;
+ IF NOT EQCAR(CAR U,'!*LABEL) AND CDR U THEN PRIN2OX "; ";
+ U := CDR U;
+ IF U THEN OMARK LIST(CURMARK,IF EQCAR(CAR U,'!*LABEL) THEN 1 ELSE 3)>>;
+ OMARK LIST(CURMARK-1,-1);
+ PRIN2OX " END";
+ CURMARK := CURMARK-2;
+ OMARK '(M D)
+ END;
+
+SYMBOLIC PROCEDURE RETOX U;
+ BEGIN
+ OMARK '(M U);
+ CURMARK := CURMARK+2;
+ PRIN2OX "RETURN ";
+ OMARK '(M U);
+ MPRINO CAR U;
+ CURMARK := CURMARK-2;
+ OMARK '(M D);
+ OMARK '(M D)
+ END;
+
+PUT('RETURN,PRETOPRINF,'RETOX);
+
+%SYMBOLIC PROCEDURE VARPRX U;
+% MAPC(CDR U,FUNCTION (LAMBDA J;
+% <<PRIN2OX CAR J;
+% PRIN2OX " ";
+% INPRINO('!*COMMA!*,LIST(0,0),CDR J);
+% PRIN2OX "; ";
+% OMARK LIST(CURMARK,6)>>));
+
+COMMENT a version for the old parser;
+
+SYMBOLIC PROCEDURE VARPRX U;
+ BEGIN SCALAR TYP;
+ U := REVERSE U;
+ WHILE U DO
+ <<IF CDAR U EQ TYP
+ THEN <<PRIN2OX ","; OMARKO(CURMARK+1); PRINOX CAAR U>>
+ ELSE <<IF TYP THEN <<PRIN2OX "; "; OMARK '(M D)>>;
+ PRINOX (TYP := CDAR U);
+ PRIN2OX " "; OMARK '(M U); PRINOX CAAR U>>;
+ U := CDR U>>;
+ PRIN2OX "; ";
+ OMARK '(M D)
+ END;
+
+PUT('BLOCK,PRETOPRINF,'BLOCKOX);
+
+SYMBOLIC PROCEDURE PROGOX U;
+ BLOCKOX(MAPCAR(REVERSE CAR U,FUNCTION (LAMBDA J; J . 'SCALAR))
+ . LABCHK CDR U);
+
+SYMBOLIC PROCEDURE LABCHK U;
+ BEGIN SCALAR X;
+ FOR EACH Z IN U DO IF ATOM Z
+ THEN X := LIST('!*LABEL,Z) . X ELSE X := Z . X;
+ RETURN REVERSIP X
+ END;
+
+PUT('PROG,PRETOPRINF,'PROGOX);
+
+SYMBOLIC PROCEDURE GOX U;
+ <<PRIN2OX "GO TO "; PRINOX CAR U>>;
+
+PUT('GO,PRETOPRINF,'GOX);
+
+SYMBOLIC PROCEDURE LABOX U;
+ <<PRINOX CAR U; PRIN2OX ": ">>;
+
+PUT('!*LABEL,PRETOPRINF,'LABOX);
+
+SYMBOLIC PROCEDURE QUOTOX U;
+ IF STRINGP U THEN PRINOX U ELSE <<PRIN2OX "'"; PRINSOX CAR U>>;
+
+SYMBOLIC PROCEDURE PRINSOX U;
+ IF ATOM U THEN PRINOX U
+ ELSE <<PRIN2OX "(";
+ OMARK '(M U);
+ CURMARK := CURMARK+1;
+ WHILE U DO <<PRINSOX CAR U;
+ U := CDR U;
+ IF U THEN <<OMARK LIST(CURMARK,-1);
+ IF ATOM U THEN <<PRIN2OX " . "; PRINSOX U; U := NIL>>
+ ELSE PRIN2OX " ">>>>;
+ CURMARK := CURMARK-1;
+ OMARK '(M D);
+ PRIN2OX ")">>;
+
+PUT('QUOTE,PRETOPRINF,'QUOTOX);
+
+SYMBOLIC PROCEDURE PROGNOX U;
+ BEGIN
+ CURMARK := CURMARK+1;
+ PRIN2OX "<<";
+ OMARK '(M U);
+ WHILE U DO <<MPRINO CAR U; U := CDR U;
+ IF U THEN <<PRIN2OX "; "; OMARKO CURMARK>>>>;
+ OMARK '(M D);
+ PRIN2OX ">>";
+ CURMARK := CURMARK-1
+ END;
+
+PUT('PROG2,PRETOPRINF,'PROGNOX);
+
+PUT('PROGN,PRETOPRINF,'PROGNOX);
+
+SYMBOLIC PROCEDURE REPEATOX U;
+ BEGIN
+ CURMARK := CURMARK+1;
+ OMARK '(M U);
+ PRIN2OX "REPEAT ";
+ MPRINO CAR U;
+ PRIN2OX " UNTIL ";
+ OMARK LIST(CURMARK,3);
+ MPRINO CADR U;
+ OMARK '(M D);
+ CURMARK := CURMARK-1
+ END;
+
+PUT('REPEAT,PRETOPRINF,'REPEATOX);
+
+SYMBOLIC PROCEDURE WHILEOX U;
+ BEGIN
+ CURMARK := CURMARK+1;
+ OMARK '(M U);
+ PRIN2OX "WHILE ";
+ MPRINO CAR U;
+ PRIN2OX " DO ";
+ OMARK LIST(CURMARK,3);
+ MPRINO CADR U;
+ OMARK '(M D);
+ CURMARK := CURMARK-1
+ END;
+
+PUT('WHILE,PRETOPRINF,'WHILEOX);
+
+SYMBOLIC PROCEDURE PROCOX U;
+ BEGIN
+ OMARK '(M U);
+ CURMARK := CURMARK+1;
+ IF CADDDR CDR U THEN <<MPRINO CADDDR CDR U; PRIN2OX " ">>;
+ PRIN2OX "PROCEDURE ";
+ PROCOX1(CAR U,CADR U,CADDR U)
+ END;
+
+SYMBOLIC PROCEDURE PROCOX1(U,V,W);
+ BEGIN
+ PRINOX U;
+ IF V THEN MPRARGS(V,LIST(0,0));
+ PRIN2OX "; ";
+ OMARK LIST(CURMARK,3);
+ MPRINO W;
+ CURMARK := CURMARK-1;
+ OMARK '(M D)
+ END;
+
+PUT('PROC,PRETOPRINF,'PROCOX);
+
+SYMBOLIC PROCEDURE PROCEOX U;
+ BEGIN
+ OMARK '(M U);
+ CURMARK := CURMARK+1;
+ MPRINO CADR U; PRIN2OX " ";
+ IF NOT CADDR U EQ 'EXPR THEN <<MPRINO CADDR U; PRIN2OX " ">>;
+ PRIN2OX "PROCEDURE ";
+ PROCEOX1(CAR U,CADDDR U,CAR CDDDDR U)
+ END;
+
+SYMBOLIC PROCEDURE PROCEOX1(U,V,W);
+ BEGIN
+ PRINOX U;
+ IF V THEN MPRARGS(MAPCAR(V,FUNCTION CAR),LIST(0,0));
+ %we need to check here for non-default type;
+ PRIN2OX "; ";
+ OMARK LIST(CURMARK,3);
+ MPRINO W;
+ CURMARK := CURMARK -1;
+ OMARK '(M D)
+ END;
+
+PUT('PROCEDURE,PRETOPRINF,'PROCEOX);
+
+SYMBOLIC PROCEDURE PROCEOX0(U,V,W,X);
+ PROCEOX LIST(U,'SYMBOLIC,V,MAPCAR(W,FUNCTION (LAMBDA J; J . 'SYMBOLIC)),X);
+
+SYMBOLIC PROCEDURE DEOX U;
+ PROCEOX0(CAR U,'EXPR,CADR U,CADDR U);
+
+PUT('DE,PRETOPRINF,'DEOX);
+
+SYMBOLIC PROCEDURE DFOX U;
+ PROCEOX0(CAR U,'FEXPR,CADR U,CADDR U);
+
+PUT('DF,PRETOPRINF,'DFOX);
+
+SYMBOLIC PROCEDURE DMOX U;
+ PROCEOX0(CAR U,'MACRO,CADR U,CADDR U);
+
+PUT('DM,PRETOPRINF,'DMOX);
+
+SYMBOLIC PROCEDURE LAMBDOX U;
+ BEGIN
+ OMARK '(M U);
+ CURMARK := CURMARK+1;
+ PROCOX1('LAMBDA,CAR U,CADR U)
+ END;
+
+PUT('LAMBDA,PRETOPRINF,'LAMBDOX);
+
+SYMBOLIC PROCEDURE EACHOX U;
+ <<PRIN2OX "FOR EACH ";
+ WHILE CDR U DO <<MPRINO CAR U; PRIN2OX " "; U := CDR U>>;
+ MPRINO CAR U>>;
+
+PUT('FOREACH,PRETOPRINF,'EACHOX);
+
+COMMENT Declarations needed by old parser;
+
+IF NULL GET('!*SEMICOL!*,'OP)
+ THEN <<PUT('!*SEMICOL!*,'OP,'((-1 0)));
+ PUT('!*COMMA!*,'OP,'((5 6)))>>;
+
+
+ COMMENT RPRINT MODULE, Page 2;
+
+FLUID '(ORIG CURPOS);
+
+SYMBOLIC PROCEDURE PRINOS U;
+ BEGIN INTEGER CURPOS;
+ SCALAR ORIG;
+ ORIG := LIST POSN();
+ CURPOS := CAR ORIG;
+ PRINOY(U,0);
+ TERPRI0X()
+ END;
+
+SYMBOLIC PROCEDURE PRINOY(U,N);
+ BEGIN SCALAR X;
+ IF CAR(X := SPACELEFT(U,N)) THEN RETURN PRINOM(U,N)
+ ELSE IF NULL CDR X THEN RETURN IF CAR ORIG<10 THEN PRINOM(U,N)
+ ELSE <<ORIG := 9 . CDR ORIG;
+ TERPRI0X();
+ RPSPACES2(CURPOS := 9+CADAR U);
+ PRINOY(U,N)>>
+ ELSE BEGIN
+ A: U := PRINOY(U,N+1);
+ IF NULL CDR U OR CAAR U<=N THEN RETURN;
+ TERPRI0X();
+ RPSPACES2(CURPOS := CAR ORIG+CADAR U);
+ GO TO A END;
+ RETURN U
+ END;
+
+SYMBOLIC PROCEDURE SPACELEFT(U,MARK);
+ %U is an expanded buffer of characters delimited by non-atom marks
+ %of the form: '(M ...) or '(INT INT))
+ %MARK is an integer;
+ BEGIN INTEGER N; SCALAR FLG,MFLG;
+ N := RMAR - CURPOS;
+ U := CDR U; %move over the first mark;
+ WHILE U AND NOT FLG AND N>=0 DO
+ <<IF ATOM CAR U THEN N := N-1
+ ELSE IF CAAR U EQ 'M THEN NIL
+ ELSE IF MARK>=CAAR U THEN <<FLG := T; U := NIL . U>>
+ ELSE MFLG := T;
+ U := CDR U>>;
+ RETURN ((N>=0) . MFLG)
+ END;
+
+SYMBOLIC PROCEDURE PRINOM(U,MARK);
+ BEGIN INTEGER N; SCALAR FLG,X;
+ N := CURPOS;
+ U := CDR U;
+ WHILE U AND NOT FLG DO
+ <<IF ATOM CAR U THEN <<X := PRIN20X CAR U; N := N+1>>
+ ELSE IF CAAR U EQ 'M THEN IF CADAR U EQ 'U THEN ORIG := N . ORIG
+ ELSE ORIG := CDR ORIG
+ ELSE IF MARK>=CAAR U
+ AND NOT(X='!, AND RMAR-N-6>CHARSPACE(U,X,MARK))
+ THEN <<FLG := T; U := NIL . U>>;
+ U := CDR U>>;
+ CURPOS := N;
+ IF MARK=0 AND CDR U
+ THEN <<TERPRI0X();
+ TERPRI0X();
+ ORIG := LIST 0; CURPOS := 0; PRINOY(U,MARK)>>;
+ %must be a top level constant;
+ RETURN U
+ END;
+
+SYMBOLIC PROCEDURE CHARSPACE(U,CHR,MARK);
+ %determines if there is space until the next character CHR;
+ BEGIN INTEGER N;
+ N := 0;
+ WHILE U DO
+ <<IF CAR U = CHR THEN U := LIST NIL
+ ELSE IF ATOM CAR U THEN N := N+1
+ ELSE IF CAR U='(M U) THEN <<N := 1000; U := LIST NIL>>
+ ELSE IF NUMBERP CAAR U AND CAAR U<MARK THEN U := LIST NIL;
+ U := CDR U>>;
+ RETURN N
+ END;
+
+SYMBOLIC PROCEDURE RPSPACES2 N;
+ %FOR I := 1:N DO PRIN20X '! ;
+ WHILE N>0 DO <<PRIN20X '! ; N := N-1>>;
+
+SYMBOLIC PROCEDURE PRIN2ROX U;
+ BEGIN INTEGER M,N; SCALAR X,Y;
+ M := RMAR-12;
+ N := RMAR-1;
+ WHILE U DO
+ IF CAR U EQ '!"
+ THEN <<IF NOT STRINGSPACE(CDR U,N-!*N) THEN <<TERPRI0X(); !*N := 0>>
+ ELSE NIL;
+ PRIN20X '!";
+ U := CDR U;
+ WHILE NOT CAR U EQ '!" DO
+ <<PRIN20X CAR U; U := CDR U; !*N := !*N+1>>;
+ PRIN20X '!";
+ U := CDR U;
+ !*N := !*N+2;
+ X := Y := NIL>>
+ ELSE IF ATOM CAR U AND NOT(CAR U EQ '! AND (!*N=0 OR NULL X
+ OR CDR U AND BREAKP CADR U OR BREAKP X AND NOT Y EQ '!!))
+ THEN <<Y := X; PRIN20X(X := CAR U); !*N := !*N+1;
+ U := CDR U;
+ IF !*N=N OR !*N>M AND NOT BREAKP CAR U AND NOSPACE(U,N-!*N)
+ THEN <<TERPRI0X(); X := Y := NIL>> ELSE NIL>>
+ ELSE U := CDR U
+ END;
+
+SYMBOLIC PROCEDURE NOSPACE(U,N);
+ IF N<1 THEN T
+ ELSE IF NULL U THEN NIL
+ ELSE IF NOT ATOM CAR U THEN NOSPACE(CDR U,N)
+ ELSE IF NOT CAR U EQ '!! AND (CADR U EQ '! OR BREAKP CADR U) THEN NIL
+ ELSE NOSPACE(CDR U,N-1);
+
+SYMBOLIC PROCEDURE BREAKP U;
+ U MEMBER '(!< !> !; !: != !) !+ !- !, !' !");
+
+SYMBOLIC PROCEDURE STRINGSPACE(U,N);
+ IF N<1 THEN NIL ELSE IF CAR U EQ '!" THEN T ELSE STRINGSPACE(CDR U,N-1);
+
+
+COMMENT Some interfaces needed;
+
+PUT('CONS,'PRTCH,'(! !.! !.));
+
+GLOBAL '(RPRIFN!* RTERFN!*);
+
+COMMENT RPRIFN!* allows output from RPRINT to be handled differently,
+ RTERFN!* allows end of lines to be handled differently;
+
+SYMBOLIC PROCEDURE PRIN20X U;
+ IF RPRIFN!* THEN APPLY(RPRIFN!*,LIST U) ELSE PRIN2 U;
+
+SYMBOLIC PROCEDURE TERPRI0X;
+ IF RTERFN!* THEN APPLY(RTERFN!*,NIL) ELSE TERPRI();
+
+
+END;
ADDED psl-1983/3-1/util/set-macros.sl
Index: psl-1983/3-1/util/set-macros.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/set-macros.sl
@@ -0,0 +1,238 @@
+% SET-MACROS.SL - macros for various flavors of assignments
+%
+% Author: Don Morrison
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: Wednesday, 12 May 1982
+% Copyright (c) 1981 University of Utah
+
+% <PSL.UTIL>SET-MACROS.SL.2, 12-Oct-82 15:53:58, Edit by BENSON
+% Added IGETV to SETF-SAFE list
+
+% Somewhat expanded setf macro. Major difference between this and the builtin
+% version is that it always returns the RHS, instead of something
+% indeterminant. Note that the setf-safe flag can be used to indicate that
+% the assignment function itself returns the "right thing", so setf needn't
+% do anything special. Also a lot more functions are represented in this
+% version, including c....r (mostly useful for macros) and list/cons (which
+% gives a primitive sort of destructuring setf).
+
+(defmacro setf u
+ (cond
+ ((atom u) nil)
+ ((atom (cdr u)) (stderror "Odd number of arguments to setf."))
+ ((atom (cddr u)) (setf2 (car u) (cadr u)))
+ (t `(progn ,@(setf1 u)))))
+
+(de setf1 (u)
+ (cond
+ ((atom u) nil)
+ ((atom (cdr u)) (stderror "Odd number of arguments to setf."))
+ (t (cons (setf2 (car u) (cadr u)) (setf1 (cddr u))))))
+
+(de setf2 (lhs rhs)
+ (if (atom lhs)
+ `(setq ,lhs ,rhs)
+ (cond
+ ((and (idp (car lhs)) (flagp (car lhs) 'setf-safe))
+ (expand-setf lhs rhs))
+ ((atom rhs)
+ `(progn ,(expand-setf lhs rhs) ,rhs))
+ (t
+ `(let ((***SETF-VAR*** ,rhs))
+ ,(expand-setf lhs '***SETF-VAR***)
+ ***SETF-VAR***)))))
+
+(de expand-setf (lhs rhs)
+ (let ((fn (car lhs)) (op))
+ (cond
+ ((and (idp fn) (setq op (get fn 'assign-op)))
+ `(,op ,@(cdr lhs) ,rhs))
+ ((and (idp fn) (setq op (get fn 'setf-expand)))
+ (apply op (list lhs rhs)))
+ ((and (idp fn) (setq op (getd fn)) (eqcar op 'macro))
+ (expand-setf (apply (cdr op) (list lhs)) rhs))
+ (t
+ (expand-setf
+ (ContinuableError
+ 99
+ (BldMsg "%r is not a known form for assignment" `(setf ,lhs ,rhs))
+ lhs)
+ rhs)))))
+
+(flag '(getv indx eval value get list cons vector getd igetv) 'setf-safe)
+
+(defmacro-no-displace car-cdr-setf (rplacfn pathfn)
+ `#'(lambda (lhs rhs) `(,',rplacfn (,',pathfn ,(cadr lhs)) ,rhs)))
+
+(deflist '(
+ (car rplaca)
+ (cdr rplacd)
+ (getv putv)
+ (igetv iputv)
+ (indx setindx)
+ (sub setsub)
+ (eval set)
+ (value set)
+ (get put)
+ (flagp flag-setf)
+ (getd getd-setf)
+ ) 'assign-op)
+
+(remprop 'nth 'assign-op) % Remove default version (which is incorrect anyway)
+
+(deflist `(
+ (caar ,(car-cdr-setf rplaca car))
+ (cadr ,(car-cdr-setf rplaca cdr))
+ (caaar ,(car-cdr-setf rplaca caar))
+ (cadar ,(car-cdr-setf rplaca cdar))
+ (caadr ,(car-cdr-setf rplaca cadr))
+ (caddr ,(car-cdr-setf rplaca cddr))
+ (caaaar ,(car-cdr-setf rplaca caaar))
+ (cadaar ,(car-cdr-setf rplaca cdaar))
+ (caadar ,(car-cdr-setf rplaca cadar))
+ (caddar ,(car-cdr-setf rplaca cddar))
+ (caaadr ,(car-cdr-setf rplaca caadr))
+ (cadadr ,(car-cdr-setf rplaca cdadr))
+ (caaddr ,(car-cdr-setf rplaca caddr))
+ (cadddr ,(car-cdr-setf rplaca cdddr))
+ (cdar ,(car-cdr-setf rplacd car))
+ (cddr ,(car-cdr-setf rplacd cdr))
+ (cdaar ,(car-cdr-setf rplacd caar))
+ (cddar ,(car-cdr-setf rplacd cdar))
+ (cdadr ,(car-cdr-setf rplacd cadr))
+ (cdddr ,(car-cdr-setf rplacd cddr))
+ (cdaaar ,(car-cdr-setf rplacd caaar))
+ (cddaar ,(car-cdr-setf rplacd cdaar))
+ (cdadar ,(car-cdr-setf rplacd cadar))
+ (cdddar ,(car-cdr-setf rplacd cddar))
+ (cdaadr ,(car-cdr-setf rplacd caadr))
+ (cddadr ,(car-cdr-setf rplacd cdadr))
+ (cdaddr ,(car-cdr-setf rplacd caddr))
+ (cddddr ,(car-cdr-setf rplacd cdddr))
+ (nth ,#'(lambda (lhs rhs) `(rplaca (pnth ,@(cdr lhs)) ,rhs)))
+ (pnth ,#'expand-pnth-setf)
+ (lastcar ,#'(lambda (lhs rhs) `(rplaca (lastpair ,(cadr lhs)) ,rhs)))
+ (list ,#'list-setf)
+ (cons ,#'cons-setf)
+ (vector ,#'vector-setf)
+ ) 'setf-expand)
+
+(fluid '(*setf-debug))
+
+(de expand-pnth-setf (lhs rhs)
+ (let ((L (cadr lhs))(n (caddr lhs)))
+ (cond
+ ((onep n) `(setf ,L ,rhs))
+ ((fixp n) `(rplacd (pnth ,L (sub1 ,n)) ,rhs))
+ (t
+ (let ((expnsn (errorset `(setf2 ',L ',rhs) *setf-debug *setf-debug)))
+ (if (atom expnsn)
+ `(rplacd (pnth ,L (sub1 ,n) ,rhs))
+ `(let ((***PNTH-SETF-VAR*** ,n))
+ (if (onep ***PNTH-SETF-VAR***)
+ ,(car expnsn)
+ (rplacd (pnth ,L (sub1 ***PNTH-SETF-VAR***)) ,rhs)))))))))
+
+(de flag-setf (nam flg val)
+ (cond
+ (val (flag (list nam) flg) t)
+ (t (remflag (list nam) flg) nil)))
+
+(de getd-setf (trgt src)
+ (cond
+% not correct for the parallel case...
+% ((idp src) (copyd trgt src))
+ ((or (codep src) (eqcar src 'lambda)) % is this kludge worthwhile?
+ (progn (putd trgt 'expr src) (cons 'expr src)))
+ ((pairp src)
+ (progn (putd trgt (car src) (cdr src)) src))
+ (t
+ (ContinuableError
+ 99
+ (bldmsg "%r is not a funtion spec." src)
+ src))))
+
+(de list-setf (lhs rhs)
+ (if (atom rhs)
+ `(progn ,.(destructure-form (cdr lhs) rhs) ,rhs)
+ `(let ((***LIST-SETF-VAR*** ,rhs))
+ ,.(destructure-form (cdr lhs) '***LIST-SETF-VAR***)
+ ***LIST-SETF-VAR***)))
+
+(de cons-setf (lhs rhs)
+ (if (atom rhs)
+ `(progn
+ (setf ,(cadr lhs) (car ,rhs))
+ (setf ,(caddr lhs) (cdr ,rhs))
+ ,rhs)
+ `(let ((***CONS-SETF-VAR*** ,rhs))
+ (setf ,(cadr lhs) (car ***CONS-SETF-VAR***))
+ (setf ,(caddr lhs) (cdr ***CONS-SETF-VAR***))
+ ***CONS-SETF-VAR***)))
+
+(de vector-setf (lhs rhs)
+ (let ((x (if (atom rhs) rhs '***VECTOR-SETF-VAR***)))
+ (let ((L (for (in u (cdr lhs)) (from i 0)
+ (collect `(setf ,u (getv ,x ,i))))))
+ (if (atom rhs)
+ `(progn ,.L ,x)
+ `(let ((***VECTOR-SETF-VAR*** ,rhs)) ,.L ,x)))))
+
+% Some more useful assignment macros
+
+(defmacro push (item stack) `(setf ,stack (cons ,item ,stack)))
+
+(defmacro pop (stack . rst)
+ (let ((x `(prog1 (car ,stack) (setf ,stack (cdr ,stack)))))
+ (if rst `(setf ,(car rst) ,x) x)))
+
+(defmacro adjoin-to (e s) `(setf ,s (adjoin ,e ,s)))
+
+(defmacro adjoinq-to (e s) `(setf ,s (adjoinq ,e ,s)))
+
+(defmacro incr (var . rst)
+ `(setf ,var ,(if rst `(plus ,var ,@rst) `(add1 ,var))))
+
+(defmacro decr (var . rst)
+ `(setf ,var ,(if rst `(difference ,var (plus ,@rst)) `(sub1 ,var))))
+
+(defmacro clear L
+ `(setf ,.(foreach u in L conc `(,u nil))))
+
+% Parallel assignment macros
+
+(defmacro psetq rst
+% psetq looks like a multi-arg setq but does its work in parallel.
+ (cond ((null rst) nil)
+ ((cddr rst)
+ `(setq ,(car rst)
+ (prog1 ,(cadr rst) (psetq . ,(cddr rst)))))
+ % the last pair. keep it simple; no superfluous
+ % (prog1 (setq...) (psetq)).
+ ((cdr rst) `(setq . ,rst))
+ (t (StdError "psetq passed an odd number of arguments"))))
+
+(defmacro psetf rst
+% psetf looks like a multi-arg setf but does its work in parallel.
+ (cond ((null rst) nil)
+ ((cddr rst)
+ `(setf ,(car rst)
+ (prog1 ,(cadr rst) (psetf . ,(cddr rst)))))
+ ((cdr rst) `(setf . ,rst))
+ (t (StdError "psetf passed an odd number of arguments"))))
+
+(defmacro defswitch (nam var . acts)
+ (let ((read-act (if (pairp acts) (car acts) nil))
+ (set-acts (if (pairp acts) (cdr acts) nil)))
+ (when (null var)
+ (setf var (newid (bldmsg "%w-SWITCH-VAR*" nam))))
+ `(progn
+ (fluid '(,var))
+ (de ,nam () (let ((,nam ,var)) ,read-act) ,var)
+ (setf
+ (get ',nam 'assign-op)
+ #'(lambda (,nam) ,@set-acts (setq ,var ,nam)))
+ (flag '(,nam) 'setf-safe))))
+
ADDED psl-1983/3-1/util/slow-strings.sl
Index: psl-1983/3-1/util/slow-strings.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/slow-strings.sl
@@ -0,0 +1,47 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% SLOW-STRINGS - Useful String Functions (with lots of error checking)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 September 1982
+%
+% Defines the following functions:
+%
+% (string-fetch s i)
+% (string-store s i ch)
+% (string-length s)
+% (string-upper-bound s)
+% (string-empty? s)
+%
+% See FAST-STRINGS for faster (unchecked) compiled versions of these functions.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de string-fetch (s i)
+ (cond ((not (StringP s)) (NonStringError s 'String-Fetch))
+ ((not (FixP i)) (NonIntegerError i 'String-Fetch))
+ (t (indx s i))
+ ))
+
+(de string-store (s i c)
+ (cond ((not (StringP s)) (NonStringError s 'String-Store))
+ ((not (FixP i)) (NonIntegerError i 'String-Store))
+ ((not (FixP c)) (NonCharacterError c 'String-Store))
+ (t (setindx s i c))
+ ))
+
+(de string-length (s)
+ (cond ((not (StringP s)) (NonStringError s 'String-Length))
+ (t (Plus2 (size s) 1))
+ ))
+
+(de string-upper-bound (s)
+ (cond ((not (StringP s)) (NonStringError s 'String-Upper-Bound))
+ (t (size s))
+ ))
+
+(de string-empty? (s)
+ (cond ((not (StringP s)) (NonStringError s 'String-Empty?))
+ (t (EqN (size s) -1))
+ ))
ADDED psl-1983/3-1/util/slow-vectors.sl
Index: psl-1983/3-1/util/slow-vectors.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/slow-vectors.sl
@@ -0,0 +1,46 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% SLOW-VECTORS - Useful Vector Functions (with lots of error checking)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 September 1982
+%
+% Defines the following functions:
+%
+% (vector-fetch v i)
+% (vector-store v i x)
+% (vector-size v)
+% (vector-upper-bound v)
+% (vector-empty? v)
+%
+% See FAST-VECTORS for faster (unchecked) compiled versions of these functions.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de vector-fetch (v i)
+ (cond ((not (Vectorp v)) (NonVectorError v 'Vector-Fetch))
+ ((not (FixP i)) (NonIntegerError i 'Vector-Fetch))
+ (t (indx v i))
+ ))
+
+(de vector-store (v i x)
+ (cond ((not (Vectorp v)) (NonVectorError v 'Vector-Store))
+ ((not (FixP i)) (NonIntegerError i 'Vector-Store))
+ (t (setindx v i x))
+ ))
+
+(de vector-size (v)
+ (cond ((not (Vectorp v)) (NonVectorError v 'Vector-Size))
+ (t (Plus2 (size v) 1))
+ ))
+
+(de vector-upper-bound (v)
+ (cond ((not (Vectorp v)) (NonVectorError v 'Vector-Upper-Bound))
+ (t (size v))
+ ))
+
+(de vector-empty? (v)
+ (cond ((not (Vectorp v)) (NonVectorError v 'Vector-Empty?))
+ (t (EqN (size v) -1))
+ ))
ADDED psl-1983/3-1/util/sm.build
Index: psl-1983/3-1/util/sm.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/sm.build
@@ -0,0 +1,1 @@
+in "sm.red"$
ADDED psl-1983/3-1/util/sm.red
Index: psl-1983/3-1/util/sm.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/sm.red
@@ -0,0 +1,37 @@
+% SM.RED - String match to replace find
+% M.L.G
+
+procedure sm(p,s);
+ Sm1(p,0,size(p),s,0,size(s));
+
+procedure sm1(p,p1,p2,s,s1,s2);
+ Begin scalar c;
+ L1: % test Range
+ if p1>p2 then
+ return (if s1>s2 then T else NIL)
+ else if s1>s2 then return NIL;
+
+ % test if % something
+ if (c:=p[p1]) eq char !% then goto L3;
+
+ L2: % exact match
+ if c eq s[s1] then <<p1:=p1+1;
+ s1:=s1+1;
+ goto L1>>;
+ return NIL;
+
+ L3: % special cases
+ p1:=p1+1;
+ if p1>p2 then return stderror "pattern ran out in % case of sm";
+ c:=p[p1];
+ if c eq char !% then goto L2;
+ if c eq char !? then <<p1:=p1+1;
+ s1:=s1+1;
+ goto L1>>;
+
+ if c eq char !* then % 0 or more vs 1 or more
+ return <<while not(c:=sm1(p,p1+1,p2,s,s1,s2)) and s1<=s2
+ do s1:=s1+1;
+ c>>;
+ Return Stderror Bldmsg(" %% %r not known in sm",int2id c);
+ end;
ADDED psl-1983/3-1/util/step.build
Index: psl-1983/3-1/util/step.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/step.build
@@ -0,0 +1,2 @@
+CompileTime load(Useful, CLComp);
+in "step.lsp"$
ADDED psl-1983/3-1/util/step.lsp
Index: psl-1983/3-1/util/step.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/step.lsp
@@ -0,0 +1,180 @@
+;;;
+;;; STEP.LSP - Single-step evaluator
+;;;
+;;; Author: Eric Benson
+;;; Symbolic Computation Group
+;;; Computer Science Dept.
+;;; University of Utah
+;;; Date: 30 March 1982
+;;; Copyright (c) 1982 University of Utah
+;;;
+
+#+Tops20
+(eval-when (compile eval) ; Needed for PBIN in STEP-GET-CHAR
+ (load monsym))
+
+(imports '(evalhook)) ; Tell the loader that evalhook is needed
+
+(defvar step-level 0 "Level of recursion while stepping")
+
+(defvar step-form () "Current form being evaluated")
+
+(defvar step-pending-forms () "Buffer of forms being evaluated")
+
+(defvar abort-step () "Flag to indicate exiting step")
+
+(defvar step-dispatch (make-vector 127 t ())
+ "Dispatch table for character commands")
+
+(defvar step-channel () "I/O Channel used for printing truncated forms.")
+
+(eval-when (compile eval)
+
+;;;; DEF-STEP-COMMAND - define a character command routine
+(defmacro def-step-command (char . form)
+ `(vset step-dispatch ,char (function (lambda () ,@form))))
+)
+
+;;;; STEP - user entry point
+(defun step (form)
+ (let ((step-level 0)
+ (step-pending-forms ())
+ (abort-step ()))
+ (prog1 (step-eval form)
+ (terpri))))
+
+;;;; STEP-EVAL - main routine
+(defun step-eval (step-form)
+ (if abort-step
+ (eval step-form)
+ (let ((step-pending-forms (cons step-form step-pending-forms)))
+ (step-print-form step-form "-> ")
+ (let ((macro-call (macro-p (first step-form))))
+ (when macro-call
+ (setq step-form (funcall macro-call step-form))
+ (step-print-form step-form "<->")))
+ (let ((step-value (let ((step-level (add1 step-level)))
+ (step-command))))
+ (unless (and abort-step (not (eql abort-step step-level)))
+ (setq abort-step ())
+ ;; Print the non macro-expanded form
+ (step-print-value (first step-pending-forms)
+ step-value))
+ step-value))))
+
+;;;; Control-N - Continue stepping each time
+(def-step-command #\
+ (evalhookfn step-form #'step-eval))
+
+;;;; Space - do not step lower levels
+(def-step-command #\blank
+ (eval step-form))
+
+;;;; Control-U - go up to next higher evaluation level
+(def-step-command #\
+ (setq abort-step (- step-level 2))
+ (eval step-form))
+
+;;;; Control-X - abort stepping entirely
+(def-step-command #\
+ (setq abort-step -1)
+ (eval step-form))
+
+;;;; Control-G - grind the current form
+(def-step-command #\bell
+ (terpri)
+ (prettyprint (first step-pending-forms))
+ (step-command))
+
+;;;; Control-P is the same as Control-G
+(vset step-dispatch #\ (vref step-dispatch #\bell))
+
+;;;; Control-R grinds the form in Rlisp syntax
+(def-step-command #\
+ (terpri)
+ (rprint (first step-pending-forms)) ; This will only
+ (step-command)) ; work in Rlisp
+
+
+;;;; Control-E - edit the current form
+(def-step-command #\
+ (setq step-form (edit step-form))
+ (step-command))
+
+;;;; Control-B - go into a break loop
+(def-step-command #\
+ (step-break)
+ (step-command))
+
+;;;; Control-L redisplay the last 10 pending forms
+(def-step-command #\ff
+ (display-last-10)
+ (step-command))
+
+;;;; ? - help
+(def-step-command #\?
+ (load help)
+ (displayhelpfile 'step)
+ (step-command))
+
+(defun display-last-10 ()
+ (display-aux step-pending-forms 10))
+
+(defun display-aux (b n)
+ (let ((step-level (sub1 step-level)))
+ (unless (or (null b) (eql n 0))
+ (display-aux (rest b) (sub1 n))
+ (step-print-form (first b) "-> "))))
+
+;;;; STEP-COMMAND - read a character and dispatch on it
+(defun step-command ()
+ (let ((c (vref step-dispatch (step-get-char))))
+ (if c (funcall c)
+ (ouch #\bell) (step-command))))
+
+;;;; STEP-PRINT-FORM - print incoming form with indentation
+(defun step-print-form (form herald)
+ (terpri)
+ (tab (min step-level 15))
+ (princ herald)
+ (channelprin1 step-channel form))
+
+;;;; STEP-PRINT-VALUE - print form and result of evaluation
+(defun step-print-value (form value)
+ (terpri)
+ (tab (min step-level 15))
+ (princ "<- ")
+ (channelprin1 step-channel form)
+ (terpri)
+ (tab (+ (min step-level 15) 3))
+ (prin1 value))
+
+;;;; STEP-BREAK - errset-protected break loop
+(defun step-break ()
+ (errset (break) ()))
+
+;;;; STEP-GET-CHAR - read a single character
+#+Tops20
+(lap '((*entry step-get-char expr 0)
+ (*move #\? (reg 1))
+ (pbout)
+ (pbin)
+ (*exit 0)))
+
+#-Tops20
+(defun step-get-char ()
+ (let ((promptstring* "?"))
+ (do ((ch (channelreadchar stdin*) (channelreadchar stdin*)))
+ ((not (eql ch #\eol)) ch))))
+
+;;;; STEP-PUT-CHAR - prints on current channel, truncates to one line
+(defun step-put-char (channel ch)
+ (if (not (eql ch #\eol))
+ (unless (> (posn) 75) (writechar ch))))
+
+(eval-when (load eval) ; Open a special channel
+(let ((specialwritefunction* #'step-put-char)
+ (specialreadfunction* #'writeonlychannel)
+ (specialclosefunction* #'illegalstandardchannelclose))
+ (setq step-channel (open "" 'special)))
+)
ADDED psl-1983/3-1/util/string-input.sl
Index: psl-1983/3-1/util/string-input.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/string-input.sl
@@ -0,0 +1,87 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Input from strings
+%%% Cris Perdue
+%%% 12/1/82
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load if fast-int))
+
+(fluid '(channel-string channel-string-pos))
+
+%%% Takes two arguments: a string and a function.
+%%% The function must take 1 argument. With-input-from-string
+%%% will call the function and pass it a channel number. If the
+%%% function takes input from the channel (which is the point of
+%%% all this), it will receive successive characters from the
+%%% string as its input.
+%%%
+%%% This is not currently unwind-protected.
+
+(defun with-input-from-string (str fn)
+ (let ((specialreadfunction* 'string-readchar)
+ (specialwritefunction* 'readonlychannel)
+ (specialclosefunction* 'null)
+ (channel-string str) (channel-string-pos 0))
+ (let ((chan (open "" 'special))
+ value)
+ (setq value (apply fn (list chan)))
+ (close chan)
+ value)))
+
+%%% This is similar to with-input-from-string, but the string
+%%% passed in is effectively padded on the right with a single
+%%% blank. No storage allocation is performed to give this
+%%% effect.
+
+(defun with-input-from-terminated-string (str fn)
+ (let ((specialreadfunction* 'string-readchar-terminated)
+ (specialwritefunction* 'readonlychannel)
+ (specialclosefunction* 'null)
+ (channel-string str)
+ (channel-string-pos 0))
+ (let ((chan (open "" 'special))
+ value)
+ (setq value (apply fn (list chan)))
+ (close chan)
+ value)))
+
+%%% Reads from the string. The string is effectively padded with
+%%% a blank at the end so if the expression in the string is for
+%%% example a single token, it need not be followed by a terminator.
+
+(defun string-read (str)
+ (with-input-from-terminated-string str 'channelread))
+
+%%% Reads a single token from the string using channelreadtoken.
+%%% The string need contain no terminator character; a blank is
+%%% provided if necessary by string-readtoken.
+
+(defun string-readtoken (str)
+ (with-input-from-terminated-string str 'channelreadtoken))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Internal routines.
+
+(defun string-readchar (chan)
+ (if (> channel-string-pos (size channel-string)) then
+ $eof$
+ else
+ (prog1
+ (indx channel-string channel-string-pos)
+ (setq channel-string-pos (+ channel-string-pos 1)))))
+
+%%% Includes hack that tacks on a blank for termination of READ
+%%% and friends.
+
+(defun string-readchar-terminated (chan)
+ (if (<= channel-string-pos (size channel-string)) then
+ (prog1
+ (indx channel-string channel-string-pos)
+ (setq channel-string-pos (+ channel-string-pos 1)))
+ elseif (= channel-string-pos (+ 1 (size channel-string))) then
+ (prog1
+ 32 % Blank
+ (setq channel-string-pos (+ channel-string-pos 1)))
+ else
+ $eof$))
+
ADDED psl-1983/3-1/util/string-search.sl
Index: psl-1983/3-1/util/string-search.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/string-search.sl
@@ -0,0 +1,70 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% STRING-SEARCH
+%%%
+%%% Author: Cris Perdue
+%%% 11/23/82
+%%%
+%%% General-purpose searches for substring. Case is important.
+%%% If the target is found, the index in the domain of the
+%%% leftmost character of the leftmost match is returned,
+%%% otherwise NIL.
+%%%
+%%% (STRING-SEARCH TARGET DOMAIN).
+%%%
+%%% If passed two strings, Common LISP "search" will give the
+%%% same results.
+%%%
+%%% (STRING-SEARCH-FROM TARGET DOMAIN START)
+%%%
+%%% Like string-search, but the search effectively starts at index
+%%% START in the domain.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%% Implementation note: In both of these, the value of the first
+%%% character of the target is precomputed and it is tested against
+%%% characters of the domain separately from the other characters of
+%%% the target.
+
+(compiletime (load fast-int if))
+
+(defun string-search (target domain)
+ (if (not (and (stringp target) (stringp domain))) then
+ (error 0 "Arg to string-search not a string"))
+ (let* ((s (isizes target))
+ (m (- (isizes domain) s)))
+ (if (= s -1) then 0
+ else
+ (let ((c (igets target 0)))
+ (for (from i 0 m)
+ (do (if (eq (igets domain i) c) then
+ (if
+ (for (from u 1 s)
+ (from v (+ i 1))
+ (do (if (neq (igets target u)
+ (igets domain v)) then
+ (return nil)))
+ (finally (return t))) then
+ (return i)))))))))
+
+%%% Like string-search, but takes an explicit starting index
+%%% in the domain string.
+
+(defun string-search-from (target domain start)
+ (if (not (and (stringp target) (stringp domain))) then
+ (error 0 "Arg to substring-search not a string"))
+ (let* ((s (isizes target))
+ (m (- (isizes domain) s)))
+ (if (= s -1) then start
+ else
+ (let ((c (igets target 0)))
+ (for (from i start m)
+ (do (if (eq (igets domain i) c) then
+ (if
+ (for (from u 1 s)
+ (from v (+ i 1))
+ (do (if (neq (igets target u)
+ (igets domain v)) then
+ (return nil)))
+ (finally (return t))) then
+ (return i)))))))))
+
ADDED psl-1983/3-1/util/strings.build
Index: psl-1983/3-1/util/strings.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/strings.build
@@ -0,0 +1,2 @@
+CompileTime load(SysLisp, Useful, CLComp);
+in "strings.lsp"$
ADDED psl-1983/3-1/util/strings.lsp
Index: psl-1983/3-1/util/strings.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/strings.lsp
@@ -0,0 +1,300 @@
+;;;
+;;; STRINGS.LSP - Common Lisp string operations
+;;;
+;;; Author: Eric Benson
+;;; Symbolic Computation Group
+;;; Computer Science Dept.
+;;; University of Utah
+;;; Date: 7 April 1982
+;;; Copyright (c) 1982 University of Utah
+;;;
+
+(eval-when (load)
+ (imports '(chars))) ; Uses the CHARS module
+
+(eval-when (compile) ; Local functions
+ (localf string-equal-aux string<-aux string<=-aux string<>-aux
+ string-lessp-aux string-not-greaterp-aux string-not-equal-aux
+ string-trim-left-index string-trim-right-index
+ bag-element bag-element-aux
+ string-concat-aux))
+
+;;;; CHAR - fetch a character in a string
+;(defun char (s i) ; not defined because CHAR means something else in PSL
+; (elt (stringify s) i))
+
+;;;; RPLACHAR - store a character in a string
+(defun rplachar (s i x)
+ (setelt s i x))
+
+;;;; STRING= - compare two strings (substring options not implemented)
+(fset 'string= (fsymeval 'eqstr)) ; Same function in PSL
+
+;;;; STRING-EQUAL - compare two strings, ignoring case, bits and font
+(defun string-equal (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (or (eq s1 s2)
+ (let ((len1 (string-length s1)) (len2 (string-length s2)))
+ (and (eql len1 len2) (string-equal-aux s1 s2 len1 0)))))
+
+(defun string-equal-aux (s1 s2 len i)
+ (or (eql len i)
+ (and (char-equal (char s1 i) (char s2 i))
+ (string-equal-aux s1 s2 len (add1 i)))))
+
+;;;; STRING< - lexicographic comparison of strings
+(defun string< (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (string<-aux s1
+ s2
+ (string-length s1)
+ (string-length s2)
+ 0))
+
+(defun string<-aux (s1 s2 len1 len2 i)
+ (cond ((eql i len1) (if (eql i len2) () i))
+ ((eql i len2) ())
+ ((char= (char s1 i) (char s2 i))
+ (string<-aux s1 s2 len1 len2 (add1 i)))
+ ((char< (char s1 i) (char s2 i)) i)
+ (t ())))
+
+;;;; STRING> - lexicographic comparison of strings
+(defun string> (s1 s2)
+ (string< s2 s1))
+
+;;;; STRING<= - lexicographic comparison of strings
+(defun string<= (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (string<=-aux s1 s2 (string-length s1) (string-length s2) 0))
+
+(defun string<=-aux (s1 s2 len1 len2 i)
+ (cond ((eql i len1) i)
+ ((eql i len2) ())
+ ((char= (char s1 i) (char s2 i))
+ (string<=-aux s1 s2 len1 len2 (add1 i)))
+ ((char< (char s1 i) (char s2 i)) i)
+ (t ())))
+
+;;;; STRING>= - lexicographic comparison of strings
+(defun string>= (s1 s2)
+ (string<= s2 s1))
+
+;;;; STRING<> - lexicographic comparison of strings
+(defun string<> (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (let ((len1 (string-length s1)) (len2 (string-length s2)))
+ (if (<= len1 len2)
+ (string<>-aux s1 s2 len1 len2 0)
+ (string<>-aux s2 s1 len2 len1 0))))
+
+(defun string<>-aux (s1 s2 len1 len2 i)
+ (cond ((eql i len1)
+ (if (eql i len2) () i))
+ ((char= (char s1 i) (char s2 i))
+ (string<>-aux s1 s2 len1 len2 (add1 i)))
+ (t i)))
+
+;;;; STRING-LESSP - lexicographic comparison of strings
+(defun string-lessp (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (string-lessp-aux s1 s2 (string-length s1) (string-length s2) 0))
+
+(defun string-lessp-aux (s1 s2 len1 len2 i)
+ (cond ((eql i len1) (if (eql i len2) () i))
+ ((eql i len2) ())
+ ((char-equal (char s1 i) (char s2 i))
+ (string-lessp-aux s1 s2 len1 len2 (add1 i)))
+ ((char-lessp (char s1 i) (char s2 i)) i)
+ (t ())))
+
+;;;; STRING-GREATERP - lexicographic comparison of strings
+(defun string-greaterp (s1 s2)
+ (string-lessp s2 s1))
+
+;;;; STRING-NOT-GREATERP - lexicographic comparison of strings
+(defun string-not-greaterp (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (string-not-greaterp-aux s1 s2 (string-length s1) (string-length s2) 0))
+
+(defun string-not-greaterp-aux (s1 s2 len1 len2 i)
+ (cond ((eql i len1) i)
+ ((eql i len2) ())
+ ((char-equal (char s1 i) (char s2 i))
+ (string-not-greaterp-aux s1 s2 len1 len2 (add1 i)))
+ ((char-lessp (char s1 i) (char s2 i))
+ i)
+ (t ())))
+
+;;;; STRING-NOT-LESSP - lexicographic comparison of strings
+(defun string-not-lessp (s1 s2)
+ (string-lessp= s2 s1))
+
+;;;; STRING-NOT-EQUAL - lexicographic comparison of strings
+(defun string-not-equal (s1 s2)
+ (setq s1 (stringify s1))
+ (setq s2 (stringify s2))
+ (let ((len1 (string-length s1)) (len2 (string-length s2)))
+ (if (<= len1 len2)
+ (string-not-equal-aux s1 s2 len1 len2 0)
+ (string-not-equal-aux s2 s1 len2 len1 0))))
+
+(defun string-not-equal-aux (s1 s2 len1 len2 i)
+ (cond ((eql i len1)
+ (if (eql i len2) () i))
+ ((char-equal (char s1 i) (char s2 i))
+ (string-not-equal-aux s1 s2 len1 len2 (add1 i)))
+ (t i)))
+
+;;;; MAKE-STRING - construct a string
+(defun make-string (count fill-character)
+ (mkstring (sub1 count) fill-character))
+
+;;;; STRING-REPEAT - concat together copies of a string
+(defun string-repeat (s i)
+ (setq s (stringify s))
+ (cond ((eql i 0) "")
+ ((eql i 1) (copystring s))
+ (t (let ((len (string-length s)))
+ (let ((s1 (make-string (* i len) #\Space)))
+ (do ((j 1 (+ j 1)) (i1 -1))
+ ((> j i))
+ (do ((k 0 (+ k 1)))
+ ((eql k len))
+ (setq i1 (add1 i1))
+ (rplachar s1 i1 (char s k))))
+ s1)))))
+
+;;;; STRING-TRIM - remove leading and trailing characters from a string
+(defun string-trim (c-bag s)
+ (setq s (stringify s))
+ (let ((len (string-length s)))
+ (let ((i1 (string-trim-left-index c-bag s 0 len))
+ (i2 (string-trim-right-index c-bag s len)))
+ (if (<= i2 i1) "" (substring s i1 i2)))))
+
+(defun string-trim-left-index (c-bag s i uplim)
+ (if (or (eql i uplim) (not (bag-element (char s i) c-bag)))
+ i
+ (string-trim-left-index c-bag s (add1 i) uplim)))
+
+(defun string-trim-right-index (c-bag s i)
+ (if (or (eql i 0) (not (bag-element (char s (sub1 i)) c-bag)))
+ i
+ (string-trim-right-index c-bag s (sub1 i))))
+
+(defun bag-element (elem c-bag)
+ (cond ((consp c-bag) (memq elem c-bag))
+ ((stringp c-bag)
+ (bag-element-aux elem c-bag 0 (string-length c-bag)))
+ (t ())))
+
+(defun bag-element-aux (elem c-bag i uplim)
+ (and (< i uplim)
+ (or (char= elem (char c-bag i))
+ (bag-element-aux elem c-bag (add1 i) uplim))))
+
+;;;; STRING-LEFT-TRIM - remove leading characters from string
+(defun string-left-trim (c-bag s)
+ (setq s (stringify s))
+ (let ((len (string-length s)))
+ (let ((i1 (string-trim-left-index c-bag s 0 len)))
+ (if (<= len i1) "" (substring s i1 len)))))
+
+;;;; STRING-RIGHT-TRIM - remove trailing characters from string
+(defun string-right-trim (c-bag s)
+ (setq s (stringify s))
+ (let ((i2 (string-trim-right-index c-bag s (string-length s))))
+ (if (<= i2 0) "" (substring s 0 i2))))
+
+;;;; STRING-UPCASE - copy and raise all alphabetic characters in string
+(defun string-upcase (s)
+ (setq s (stringify s))
+ (nstring-upcase (copystring s)))
+
+;;;; NSTRING-UPCASE - destructively raise all alphabetic characters in string
+(defun nstring-upcase (s)
+ (let ((len (string-length s)))
+ (do ((i 0 (+ i 1)))
+ ((eql i len))
+ (let ((c (char s i)))
+ (when (lowercasep c) (rplachar s i (char-upcase c)))))
+ s))
+
+;;;; STRING-DOWNCASE - copy and lower all alphabetic characters in string
+(defun string-downcase (s)
+ (setq s (stringify s))
+ (nstring-downcase (copystring s)))
+
+;;;; NSTRING-DOWNCASE - destructively raise all alphabetic characters in string
+(defun nstring-downcase (s)
+ (let ((len (string-length s)))
+ (do ((i 0 (+ i 1)))
+ ((eql i len))
+ (let ((c (char s i)))
+ (when (uppercasep c) (rplachar s i (char-downcase c)))))
+ s))
+
+;;;; STRING-CAPITALIZE - copy and raise first letter of all words in string
+(defun string-capitalize (s)
+ (setq s (stringify s))
+ (nstring-capitalize (copystring s)))
+
+;;;; NSTRING-CAPITALIZE - destructively raise first letter of all words
+(defun nstring-capitalize (s)
+ (let ((len (string-length s)) (in-word-flag ()))
+ (do ((i 0 (+ i 1)))
+ ((eql i len))
+ (let ((c (char s i)))
+ (cond ((uppercasep c)
+ (if in-word-flag
+ (rplachar s i (char-downcase c))
+ (setq in-word-flag t)))
+ ((lowercasep c)
+ (when (not in-word-flag)
+ (rplachar s i (char-upcase c))
+ (setq in-word-flag t)))
+ (t (setq in-word-flag ())))))
+ s))
+
+;;;; STRING - coercion to a string, named STRINGIFY in PSL
+(defun stringify (x)
+ (cond ((stringp x) x)
+ ((symbolp x) (get-pname x))
+ (t (stderror (bldmsg "%r cannot be coerced to a string" x)))))
+
+;;;; STRING-TO-LIST - unpack string characters into a list
+(defun string-to-list (s)
+ (string2list s)) ; PSL function
+
+;;;; STRING-TO-VECTOR - unpack string characters into a vector
+(defun string-to-vector (s)
+ (string2vector s)) ; PSL function
+
+;;;; SUBSTRING - subsequence restricted to strings
+(defun substring (string start end)
+ (subseq (stringify string) start end))
+
+;;;; STRING-LENGTH - last index of a string, plus one
+(defun string-length (s)
+ (add1 (size s)))
+
+;;;; STRING-CONCAT - concatenate strings
+(defmacro string-concat args
+ (let ((len (length args)))
+ (cond ((eql len 0) "")
+ ((eql len 1) `(copystring (stringify ,(first args))))
+ (t (string-concat-aux args len)))))
+
+(defun string-concat-aux (args len)
+ (if (eql len 2)
+ `(concat (stringify ,(first args))
+ (stringify ,(second args)))
+ `(concat (stringify ,(first args))
+ ,(string-concat-aux (rest args) (sub1 len)))))
ADDED psl-1983/3-1/util/stringx.sl
Index: psl-1983/3-1/util/stringx.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/stringx.sl
@@ -0,0 +1,86 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% STRINGX - Useful String Functions
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 9 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-int fast-strings common))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private Macros:
+
+(CompileTime (progn
+
+(put 'make-string 'cmacro % temporary bug fix
+ '(lambda (sz init)
+ (mkstring (- sz 1) init)))
+
+)) % End of CompileTime
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de string-rest (s i)
+ (substring s i (string-length s)))
+
+(de string-pad-right (s desired-length)
+
+ % Pad the specified string with spaces on the right side to the specified
+ % length. Returns a new string.
+
+ (let ((len (string-length s)))
+ (if (< len desired-length)
+ (string-concat s (make-string (- desired-length len) #\space))
+ s)))
+
+(de string-pad-left (s desired-length)
+
+ % Pad the specified string with spaces on the left side to the specified
+ % length. Returns a new string.
+
+ (let ((len (string-length s)))
+ (if (< len desired-length)
+ (string-concat (make-string (- desired-length len) #\space) s)
+ s)))
+
+(de string-largest-common-prefix (s1 s2)
+
+ % Return the string that is the largest common prefix of S1 and S2.
+
+ (for (from i 0 (min (string-upper-bound s1) (string-upper-bound s2)) 1)
+ (while (= (string-fetch s1 i) (string-fetch s2 i)))
+ (returns (substring s1 0 i))
+ ))
+
+(de strings-largest-common-prefix (l)
+
+ % Return the string that is the largest common prefix of the elements
+ % of L, which must be a list of strings.
+
+ (cond ((null l) "")
+ ((null (cdr l)) (car l))
+ (t
+ (let* ((prefix (car l))
+ (limit (string-length prefix))
+ )
+ % Prefix[0..LIMIT-1] is the string that is a prefix of all
+ % strings so far examined.
+
+ (for (in s (cdr l))
+ (with i)
+ (do (let ((n (string-length s)))
+ (if (< n limit) (setf limit n))
+ )
+ (setf i 0)
+ (while (< i limit)
+ (if (~= (string-fetch prefix i) (string-fetch s i))
+ (setf limit i)
+ (setf i (+ i 1))
+ ))
+ ))
+ (substring prefix 0 limit)
+ ))))
ADDED psl-1983/3-1/util/struct.initial
Index: psl-1983/3-1/util/struct.initial
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/struct.initial
@@ -0,0 +1,54 @@
+;;;-*-lisp-*-
+
+(defmacro defstruct ((name . opts) . slots)
+ (let ((dp (cadr (assq 'default-pointer opts)))
+ (conc-name (cadr (assq 'conc-name opts)))
+ (cons-name (implode (append '(m a k e -) (explodec name)))))
+; #Q (fset-carefully cons-name '(macro . initial_defstruct-cons))
+; #M (putprop cons-name 'initial_defstruct-cons 'macro)
+; PSL change
+ (putd cons-name 'macro (cdr (getd 'initial_defstruct-cons)))
+; PSL change 1+ ==> add1
+ (do ((i 0 (add1 i))
+ (l slots (cdr l))
+ (foo nil (cons (list slot init) foo))
+ (chars (explodec conc-name))
+ (slot) (acsor) (init))
+ ((null l)
+ (putprop cons-name foo 'initial_defstruct-inits)
+ `',name)
+ (cond ((atom (car l))
+ (setq slot (car l))
+ (setq init nil))
+ (t (setq slot (caar l))
+ (setq init (cadar l))))
+ (setq acsor (implode (append chars (explodec slot))))
+ (putprop acsor dp 'initial_defstruct-dp)
+; #Q (fset-carefully acsor '(macro . initial_defstruct-ref))
+; #M (putprop acsor 'initial_defstruct-ref 'macro)
+; PSL change
+ (putd acsor 'macro (cdr (getd 'initial_defstruct-ref)))
+ (putprop acsor i 'initial_defstruct-i))))
+
+(defun initial_defstruct-ref (form)
+ (let ((i (get (car form) 'initial_defstruct-i))
+ (p (if (null (cdr form))
+ (get (car form) 'initial_defstruct-dp)
+ (cadr form))))
+; PSL change incompatible NTH
+ #-Multics `(nth ,p ,(add1 i))
+; #-Multics `(nth ,i ,p)
+ #+Multics `(car ,(do ((i i (1- i))
+ (x p `(cdr ,x)))
+ ((zerop i) x)))
+ ))
+
+(defun initial_defstruct-cons (form)
+ (do ((inits (get (car form) 'initial_defstruct-inits)
+ (cdr inits))
+ (gen (gensym))
+ (x nil (cons (or (get form (caar inits))
+ (cadar inits))
+ x)))
+ ((null inits)
+ `(list . ,x))))
ADDED psl-1983/3-1/util/sysbuild.mic
Index: psl-1983/3-1/util/sysbuild.mic
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/sysbuild.mic
@@ -0,0 +1,7 @@
+@def pl: dsk:,plap:
+@PSL:RLISP
+*LOAD BUILD;
+*BUILD '''A;
+*QUIT;
+@def pl: plap:
+@reset .
ADDED psl-1983/3-1/util/tel-ann-driver.red
Index: psl-1983/3-1/util/tel-ann-driver.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/tel-ann-driver.red
@@ -0,0 +1,315 @@
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% TELERAY specIfic Procedures %
+% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Basic Teleray 1061 Plotter
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-12,12) := (Bottom . . Top)
+% Physical Size is D.X=~8inch, D.Y=~6inch
+% Want square asp[ect ratio for 100*100
+
+Procedure TEL!.OutChar x;
+ PBOUT x;
+
+Procedure TEL!.OutCharString S; % Pbout a string
+ For i:=0:Size S do TEL!.OutChar S[i];
+
+Procedure TEL!.NormX X;
+ FIX(X)+40;
+
+Procedure TEL!.NormY Y;
+ 12 - FIX(Y);
+
+Procedure TEL!.ChPrt(X,Y,Ch);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutChar Ch>>;
+
+Procedure TEL!.IdPrt(X,Y,Id);
+ TEL!.ChPrt(X,Y,ID2Int ID);
+
+Procedure TEL!.StrPrt (X,Y,S);
+ <<TEL!.OutChar Char ESC;
+ TEL!.OutChar 89;
+ TEL!.OutChar (32+TEL!.NormY Y);
+ TEL!.OutChar (32+ TEL!.NormX X);
+ TEL!.OutCharString S>>;
+
+Procedure TEL!.HOME (); % Home (0,0)
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar 'H>>;
+
+Procedure TEL!.EraseS (); % Delete Entire Screen
+ <<TEL!.OutChar CHAR ESC;
+ TEL!.OutChar '!j>>;
+
+Procedure TEL!.DDA (X1,Y1,X2,Y2,dotter);
+ Begin scalar Dx,Dy,Xc,Yc,I,R,S;
+ % From N & S, Page 44, Draw Straight Pointset
+ Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
+ If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
+ If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
+ If Dx <= Dy then Goto doy;
+ S := FLOAT(Dy)/Dx;
+ For I := 1:Dx do
+ <<R := R+S;
+ If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
+ X1 := X1+Xc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL;
+ doy:S := float(Dx) / Dy;
+ For I := 1:Dy do
+ <<R := R+S;
+ If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
+ Y1 := Y1+Yc;
+ APPLY(dotter,LIST (X1,Y1)) >>;
+ Return NIL
+ end;
+
+Procedure Tel!.MoveS (X1,Y1);
+ <<Xhere := X1;
+ Yhere := Y1>>;
+
+Procedure Tel!.DrawS (X1,Y1);
+ << TEL!.DDA (Xhere,Yhere, X1, Y1,function TEL!.dotc);
+ Xhere :=X1; Yhere :=Y1>>;
+
+Procedure Idl2chl (X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp (X) do <<Y := getv (Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return (Reverse (Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter (X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl (Explode2 (Txt));
+ Return (TEL!.DDA (X1,Y1,X2,Y2,function Tdotc))
+ end;
+
+Procedure Tdotc (X1,Y1);
+ Begin
+ If Null Tchars then Return (Nil);
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return ('T)
+ end;
+
+Procedure TEL!.dotc (X1,Y1); % Draw And Clip An X
+ TEL!.ChClip (X1,Y1,Char X) ;
+
+Procedure TEL!.ChClip (X1,Y1,Id);
+ Begin
+ If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
+ If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
+ TEL!.ChPrt (X1 , Y1,Id);
+ No:Return ('T)
+ end;
+
+Procedure Tel!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2 (-40,X1);
+ X2clip := Min2 (40,X2);
+ Y1clip := Max2 (-12,Y1);
+ Y2clip := Min2 (12,Y2)>>;
+
+Procedure Tel!.Wfill (X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do TEL!.ChClip (X,Y,Id);
+ end;
+
+Procedure TEL!.Wzap (X1,X2,Y1,Y2);
+ TEL!.Wfill (X1,X2,Y1,Y2,'! ) ;
+
+Procedure TEL!.Delay;
+ NIL;
+
+Procedure TEL!.GRAPHON();
+If not !*emode then echooff();
+
+Procedure TEL!.GRAPHOFF();
+If not !*emode then echoon();
+
+Procedure TEL!.INIT (); % Setup For TEL As Device;
+ Begin
+ Dev!. := 'TEL;
+ FNCOPY('EraseS,'TEL!.EraseS);
+ FNCOPY('MoveS,'TEL!.MoveS);
+ FNCOPY('DrawS,'TEL!.DrawS);
+ FNCOPY( 'NormX, 'TEL!.NormX)$
+ FNCOPY( 'NormY, 'TEL!.NormY)$
+ FNCOPY('VwPort,'TEL!.VwPort);
+ FNCOPY('Delay,'TEL!.Delay);
+ FNCOPY( 'GraphOn, 'TEL!.GraphOn)$
+ FNCOPY( 'GraphOff, 'TEL!.GraphOff)$
+ Erase();
+ VwPort (-40,40,-12,12);
+ Print "Device Now TEL";
+ end;
+
+% Basic ANN ARBOR AMBASSADOR Plotter
+%
+% Screen Range Is X := (-40,40) := (Left . . Right)
+% Y := (-30,30) := (Bottom . . Top)
+
+Procedure ANN!.OutChar x;
+ PBOUT x;
+
+Procedure ANN!.OutCharString S; % Pbout a string
+ For i:=0:Size S do ANN!.OutChar S[i];
+
+Procedure ANN!.NormX X; % so --> X
+ 40 + FIX(X+0.5);
+
+Procedure ANN!.NormY Y; % so ^
+ 30 - FIX(Y+0.5); % | Y
+
+Procedure ANN!.XY(X,Y);
+<< Ann!.OutChar(char ESC);
+ Ann!.OutChar(char ![);
+ x:=Ann!.NormX(x);
+ y:=Ann!.NormY(y);
+ % Use "quick and dirty" conversion to decimal digits.
+ Ann!.OutChar(char 0 + (1 + Y)/10);
+ Ann!.OutChar(char 0 + remainder(1 + Y, 10));
+
+ Ann!.OutChar(char !;);
+ % Delimiter between row digits and column digits.
+
+ Ann!.OutChar(char 0 + (1 + X)/10);
+ Ann!.OutChar(char 0 + remainder(1 + X, 10));
+
+ Ann!.OutChar(char H); % Terminate the sequence
+>>;
+
+
+Procedure ANN!.ChPrt(X,Y,Ch);
+ <<ANN!.XY(X,Y);
+ ANN!.OutChar Ch>>;
+
+Procedure ANN!.IdPrt(X,Y,Id);
+ ANN!.ChPrt(X,Y,ID2Int ID);
+
+Procedure ANN!.StrPrt(X,Y,S);
+ <<ANN!.XY(X,Y);
+ ANN!.OutCharString S>>;
+
+Procedure ANN!.EraseS(); % Delete Entire Screen
+ <<ANN!.OutChar CHAR ESC;
+ ANN!.OutChar Char '![;
+ Ann!.OutChar Char 2;
+ Ann!.OutChar Char J;
+ Ann!.XY(0,0);>>;
+
+Procedure ANN!.DDA(X1,Y1,X2,Y2,dotter);
+ Begin scalar Dx,Dy,Xc,Yc,I,R,S;
+ % From N & S, Page 44, Draw Straight Pointset
+ Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
+ If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
+ If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
+ If Dx <= Dy then Goto doy;
+ S := FLOAT(Dy)/Dx;
+ For I := 1:Dx do
+ <<R := R+S;
+ If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
+ X1 := X1+Xc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL;
+ doy:S := float(Dx) / Dy;
+ For I := 1:Dy do
+ <<R := R+S;
+ If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
+ Y1 := Y1+Yc;
+ APPLY(dotter,LIST(X1,Y1)) >>;
+ Return NIL
+ end;
+
+Procedure ANN!.MoveS(X1,Y1);
+ <<Xhere := X1;
+ Yhere := Y1>>;
+
+Procedure ANN!.DrawS(X1,Y1);
+ << ANN!.DDA(Xhere,Yhere, X1, Y1,function ANN!.dotc);
+ Xhere :=X1; Yhere :=Y1>>;
+
+Procedure Idl2chl(X); % Convert Idlist To Char List
+ Begin scalar Y;
+ While Pairp(X) do <<Y := getv(Sfromid car X, 1) . Y;X := Cdr X >>;
+ Return(Reverse(Y))
+ end;
+
+FLUID '(Tchars);
+
+Procedure Texter(X1,Y1,X2,Y2,Txt);
+ Begin scalar Tchars;
+ Tchars := Idl2chl(Explode2(Txt));
+ Return(ANN!.DDA(X1,Y1,X2,Y2,function ANN!.Tdotc))
+ end;
+
+Procedure ANN!.Tdotc(X1,Y1);
+ Begin
+ If Null Tchars then Return(Nil);
+ If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
+ If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
+ ANN!.ChPrt(X1 , Y1,Car Tchars);
+ No:Tchars := Cdr Tchars;
+ Return('T)
+ end;
+
+Procedure ANN!.dotc(X1,Y1); % Draw And Clip An X
+ ANN!.ChClip(X1,Y1,Char !*) ;
+
+Procedure ANN!.ChClip(X1,Y1,Id);
+ Begin
+ If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
+ If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
+ ANN!.ChPrt(X1 , Y1,Id);
+ No:Return('T)
+ end;
+
+Procedure ANN!.VwPort(X1,X2,Y1,Y2);
+ <<X1clip := Max2(-40,X1);
+ X2clip := Min2(40,X2);
+ Y1clip := Max2(-30,Y1);
+ Y2clip := Min2(30,Y2)>>;
+
+Procedure ANN!.Wfill(X1,X2,Y1,Y2,Id);
+ Begin scalar X,Y;
+ For Y := Y1 : Y2 do
+ For X := X1 : X2 do ANN!.ChClip(X,Y,Id);
+ end;
+
+Procedure ANN!.Wzap(X1,X2,Y1,Y2);
+ ANN!.Wfill(X1,X2,Y1,Y2,'! ) ;
+
+Procedure ANN!.Delay;
+ NIL;
+
+Procedure ANN!.GRAPHON();
+ If not !*emode then echooff();
+
+Procedure ANN!.GRAPHOFF();
+ If not !*emode then echoon();
+
+Procedure ANN!.INIT(); % Setup For ANN As Device;
+ Begin
+ Dev!. := 'ANN60;
+ FNCOPY('EraseS,'ANN!.EraseS);
+ FNCOPY('MoveS,'ANN!.MoveS);
+ FNCOPY('DrawS,'ANN!.DrawS);
+ FNCOPY('NormX, 'ANN!.NormX)$
+ FNCOPY('NormY, 'ANN!.NormY)$
+ FNCOPY('VwPort,'ANN!.VwPort);
+ FNCOPY('Delay,'ANN!.Delay);
+ FNCOPY('GraphOn, 'ANN!.GraphOn)$
+ FNCOPY('GraphOff, 'ANN!.GraphOff)$
+ Erase();
+ VwPort(-40,40,-30,30);
+ Print "Device Now ANN60";
+ end;
+
ADDED psl-1983/3-1/util/test-arith.red
Index: psl-1983/3-1/util/test-arith.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/test-arith.red
@@ -0,0 +1,570 @@
+%
+% ARITHMETIC.RED - Arithmetic routines for PSL with new integer tags
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 January 1982
+% Copyright (c) 1982 University of Utah
+%
+
+on SysLisp;
+
+syslsp procedure IsInum U;
+ SignedField(U, InfStartingBit - 1, InfBitLength + 1) eq U;
+
+CompileTime <<
+internal WConst IntFunctionEntry = 0,
+ BigFunctionEntry = 1,
+ FloatFunctionEntry = 2,
+ FunctionNameEntry = 3;
+
+>>;
+
+syslsp procedure TwoArgDispatch(FirstArg, SecondArg);
+ TwoArgDispatch1(FirstArg, SecondArg, Tag FirstArg, Tag SecondArg);
+
+lap '((!*entry TwoArgDispatch1 expr 4)
+ (!*JUMPNOTEQ (Label NotNeg1) (reg 3) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 3))
+NotNeg1
+ (!*JUMPNOTEQ (Label NotNeg2) (reg 4) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 4))
+NotNeg2
+ (!*JUMPWGREATERP (Label NonNumeric) (reg 3) (WConst FltN))
+ (!*JUMPWGREATERP (Label NonNumeric) (reg 4) (WConst FltN))
+ (!*WSHIFT (reg 3) (WConst 2))
+ (!*WPLUS2 (reg 4) (reg 3))
+ (!*POP (reg 3))
+ (!*JUMPON (reg 4) 0 15 ((Label IntInt)
+ (Label IntFix)
+ (Label IntBig)
+ (Label IntFloat)
+ (Label FixInt)
+ (Label FixFix)
+ (Label FixBig)
+ (Label FixFloat)
+ (Label BigInt)
+ (Label BigFix)
+ (Label BigBig)
+ (Label BigFloat)
+ (Label FloatInt)
+ (Label FloatFix)
+ (Label FloatBig)
+ (Label FloatFloat)))
+ (!*JCALL TwoArgError)
+FixBig
+ (!*FIELD (reg 1) (reg 1) % grab the value for the fixnum
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+IntBig
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 2))
+ (!*CALL StaticIntBig)
+ (!*POP (reg 2))
+ (!*POP (reg 3))
+BigBig
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst BigFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+BigFix
+ (!*FIELD (reg 2) (reg 2) % grab the value for the fixnum
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 2) (WConst AddressingUnitsPerItem)) (reg 2))
+BigInt
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL StaticIntBig)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (!*POP (reg 3))
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst BigFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+FixInt
+ (!*FIELD (reg 1) (reg 1) % grab the value for the fixnum
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+ (!*MOVE (MEMORY (reg 3) (WConst 0)) (reg t1))
+ (!*JCALL FastApply)
+FixFix
+ (!*FIELD (reg 1) (reg 1) % grab the value for the fixnum
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+IntFix
+ (!*FIELD (reg 2) (reg 2)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 2) (WConst AddressingUnitsPerItem)) (reg 2))
+IntInt
+ (!*MOVE (MEMORY (reg 3) (WConst 0)) (reg t1))
+ (!*JCALL FastApply)
+FixFloat
+ (!*FIELD (reg 1) (reg 1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+IntFloat
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 2))
+ (!*CALL StaticIntFloat)
+ (!*POP (reg 2))
+ (!*POP (reg 3))
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+FloatFix
+ (!*FIELD (reg 2) (reg 2)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 2) (WConst AddressingUnitsPerItem)) (reg 2))
+FloatInt
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL StaticIntFloat)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (!*POP (reg 3))
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+FloatFloat
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+BigFloat
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 2))
+ (!*CALL StaticBigFloat)
+ (!*POP (reg 2))
+ (!*POP (reg 3))
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+FloatBig
+ (!*PUSH (reg 3))
+ (!*PUSH (reg 1))
+ (!*MOVE (reg 2) (reg 1))
+ (!*CALL StaticBigFloat)
+ (!*MOVE (reg 1) (reg 2))
+ (!*POP (reg 1))
+ (!*POP (reg 3))
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+NonNumeric
+ (!*POP (reg 3))
+ (!*JCALL TwoArgError)
+);
+
+syslsp procedure TwoArgError(FirstArg, SecondArg, DispatchTable);
+ ContinuableError('99,
+ '"Non-numeric argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ FirstArg,
+ SecondArg));
+
+syslsp procedure NonInteger2Error(FirstArg, SecondArg, DispatchTable);
+ ContinuableError('99,
+ '"Non-integer argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ FirstArg,
+ SecondArg));
+
+syslsp procedure NonInteger1Error(Arg, DispatchTable);
+ ContinuableError('99,
+ '"Non-integer argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ Arg));
+
+syslsp procedure OneArgDispatch FirstArg;
+ OneArgDispatch1(FirstArg, Tag FirstArg);
+
+lap '((!*entry OneArgDispatch1 expr 2)
+ (!*JUMPNOTEQ (Label NotNeg1) (reg 2) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 2))
+NotNeg1
+ (!*POP (reg 3))
+ (!*JUMPON (reg 2) 0 3 ((Label OneInt)
+ (Label OneFix)
+ (Label OneBig)
+ (Label OneFloat)))
+ (!*JCALL OneArgError)
+OneBig
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst BigFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+OneFix
+ (!*FIELD (reg 1) (reg 1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+OneInt
+ (!*MOVE (MEMORY (reg 3) (WConst 0)) (reg t1))
+ (!*JCALL FastApply)
+OneFloat
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+);
+
+syslsp procedure OneArgError(FirstArg, Dummy, DispatchTable);
+ ContinuableError('99,
+ '"Non-numeric argument in arithmetic",
+ list(DispatchTable[FunctionNameEntry],
+ FirstArg));
+
+syslsp procedure OneArgPredicateDispatch FirstArg;
+ OneArgPredicateDispatch1(FirstArg, Tag FirstArg);
+
+lap '((!*entry OneArgPredicateDispatch1 expr 2)
+ (!*JUMPNOTEQ (Label NotNeg1) (reg 2) (WConst NegInt))
+ (!*MOVE (WConst PosInt) (reg 2))
+NotNeg1
+ (!*POP (reg 3))
+ (!*JUMPON (reg 2) 0 3 ((Label OneInt)
+ (Label OneFix)
+ (Label OneBig)
+ (Label OneFloat)))
+ (!*MOVE (QUOTE NIL) (reg 1))
+ (!*EXIT 0)
+OneBig
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst BigFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+OneFix
+ (!*FIELD (reg 1) (reg 1)
+ (WConst InfStartingBit) (WConst InfBitLength))
+ (!*MOVE (MEMORY (reg 1) (WConst AddressingUnitsPerItem)) (reg 1))
+OneInt
+ (!*MOVE (MEMORY (reg 3) (WConst 0)) (reg t1))
+ (!*JCALL FastApply)
+OneFloat
+ (!*MOVE (MEMORY (reg 3)
+ (WConst (times2 (WConst AddressingUnitsPerItem)
+ (WConst FloatFunctionEntry))))
+ (reg t1))
+ (!*JCALL FastApply)
+);
+
+syslsp procedure MakeFixnum N;
+begin scalar F;
+ F := GtFIXN();
+ FixVal F := N;
+ return MkFIXN F;
+end;
+
+syslsp procedure BigFloatFix N;
+ StdError List('"Bignums not yet supported [BigFloatFix]",N);
+
+syslsp procedure ReturnNIL();
+ NIL;
+
+syslsp procedure ReturnFirstArg Arg;
+ Arg;
+
+%internal WArray StaticFloatBuffer = [1, 0, 0];
+%
+%internal WConst StaticFloatItem = MkItem(FLTN, StaticFloatBuffer);
+%
+syslsp procedure StaticIntFloat Arg;
+%<< !*WFloat(&StaticFloatBuffer[1], Arg);
+% StaticFloatItem >>;
+FloatIntArg Arg;
+
+syslsp procedure StaticIntBig Arg;
+ StdError LIST('"Bignums not yet supported [StaticIntBig]",Arg);
+
+syslsp procedure StaticBigFloat Arg;
+ StdError LIST('"Bignums not yet supported [StaticBigFloat]",Arg);
+
+off SysLisp;
+
+CompileTime <<
+macro procedure DefArith2Entry U;
+ DefArithEntry(2 . 'TwoArgDispatch . StupidParserFix cdr U);
+
+macro procedure DefArith1Entry U;
+ DefArithEntry(1 . 'OneArgDispatch . StupidParserFix cdr U);
+
+macro procedure DefArith1PredicateEntry U;
+ DefArithEntry(1 . 'OneArgPredicateDispatch . StupidParserFix cdr U);
+
+lisp procedure StupidParserFix X;
+% Goddamn Rlisp parser won't let me just give "Difference" as the parameter
+% to a macro
+ if null X then X
+ else RemQuote car X . StupidParserFix cdr X;
+
+lisp procedure RemQuote X;
+ if EqCar(X, 'QUOTE) then cadr X else X;
+
+lisp procedure DefArithEntry L;
+ SublA(Pair('(NumberOfArguments
+ DispatchRoutine
+ NameOfFunction
+ IntFunction
+ BigFunction
+ FloatFunction),
+ L),
+ quote(lap '((!*entry NameOfFunction expr NumberOfArguments)
+ (!*Call DispatchRoutine) % 30 is ID, won't do for 68000
+ (fullword (MkItem 30 (IDLoc IntFunction)))
+ (fullword (MkItem 30 (IDLoc BigFunction)))
+ (fullword (MkItem 30 (IDLoc FloatFunction)))
+ (fullword (MkItem 30
+ (IDLoc NameOfFunction))))));
+>>;
+
+DefArith2Entry(Plus2, IntPlus2, BigPlus2, FloatPlus2);
+
+syslsp procedure IntPlus2(FirstArg, SecondArg);
+ if IsInum(FirstArg := WPlus2(FirstArg, SecondArg)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+syslsp procedure FloatPlus2(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FPlus2(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry('Difference, IntDifference, BigDifference, FloatDifference);
+
+syslsp procedure IntDifference(FirstArg, SecondArg);
+ if IsInum(FirstArg := WDifference(FirstArg, SecondArg)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+syslsp procedure FloatDifference(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FDifference(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry(Times2, IntTimes2, BigTimes2, FloatTimes2);
+
+% What about overflow?
+
+syslsp procedure IntTimes2(FirstArg, SecondArg);
+begin scalar Result;
+ Result := WTimes2(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+syslsp procedure FloatTimes2(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FTimes2(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry('Divide, IntDivide, BigDivide, FloatDivide);
+DefArith2Entry('Quotient, IntQuotient, BigQuotient, FloatQuotient);
+
+syslsp procedure IntDivide(FirstArg, SecondArg);
+ IntQuotient(FirstArg, SecondArg) . IntRemainder(FirstArg, SecondArg);
+
+syslsp procedure FloatDivide(FirstArg, SecondArg);
+ FloatQuotient(FirstArg, SecondArg) . FloatRemainder(FirstArg, SecondArg);
+
+syslsp procedure IntQuotient(FirstArg, SecondArg);
+begin scalar Result;
+ if SecondArg eq 0 then return
+ ContError(99,
+ "Attempt to divide by zero in Quotient",
+ Quotient(FirstArg, SecondArg));
+ Result := WQuotient(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+syslsp procedure FloatQuotient(FirstArg, SecondArg);
+begin scalar F;
+ if FloatZeroP SecondArg then return
+ ContError(99,
+ "Attempt to divide by zero in Quotient",
+ Quotient(FirstArg, SecondArg));
+ F := GtFLTN();
+ !*FQuotient(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry(Remainder, IntRemainder, BigRemainder, FloatRemainder);
+
+syslsp procedure IntRemainder(FirstArg, SecondArg);
+begin scalar Result;
+ if SecondArg eq 0 then return
+ ContError(99,
+ "Attempt to divide by zero in Remainder",
+ Remainder(FirstArg, SecondArg));
+ Result := WRemainder(FirstArg, SecondArg);
+ return if not IsInum Result then MakeFixnum Result else Result;
+end;
+
+syslsp procedure FloatRemainder(FirstArg, SecondArg);
+begin scalar F;
+ F := GtFLTN();
+ !*FRemainder(FloatBase F, FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg);
+
+ return MkFLTN F;
+end;
+
+DefArith2Entry(LAnd, IntLAnd, BigLAnd, NonInteger2Error);
+
+syslsp procedure IntLAnd(FirstArg, SecondArg);
+ if IsInum(FirstArg := WAnd(FirstArg, SecondArg)) then
+ FirstArg
+ else MakeFixnum FirstArg;
+
+DefArith2Entry(LOr, IntLOr, BigLOr, NonInteger2Error);
+
+syslsp procedure IntLOr(FirstArg, SecondArg);
+ if IsInum(FirstArg := WOr(FirstArg, SecondArg)) then
+ FirstArg
+ else MakeFixnum FirstArg;
+
+DefArith2Entry(LXOr, IntLXOr, BigLXOr, NonInteger2Error);
+
+syslsp procedure IntLXOr(FirstArg, SecondArg);
+ if IsInum(FirstArg := WXOr(FirstArg, SecondArg)) then
+ FirstArg
+ else MakeFixnum FirstArg;
+
+DefArith2Entry(LShift, IntLShift, BigLShift, NonInteger2Error);
+
+PutD('LSH, 'EXPR, cdr GetD 'LShift);
+
+procedure IntLShift(FirstArg, SecondArg);
+ BigLShift(Int2B FirstArg, Int2B SecondArg);
+
+DefArith2Entry('GreaterP, IntGreaterP, BigGreaterP, FloatGreaterP);
+
+syslsp procedure IntGreaterP(FirstArg, SecondArg);
+ WGreaterP(FirstArg, SecondArg);
+
+syslsp procedure FloatGreaterP(FirstArg, SecondArg);
+ !*FGreaterP(FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg) and T;
+
+DefArith2Entry('LessP, IntLessP, BigLessP, FloatLessP);
+
+syslsp procedure IntLessP(FirstArg, SecondArg);
+ WLessP(FirstArg, SecondArg);
+
+syslsp procedure FloatLessP(FirstArg, SecondArg);
+ !*FLessP(FloatBase FltInf FirstArg,
+ FloatBase FltInf SecondArg) and T;
+
+DefArith1Entry(Add1, IntAdd1, BigAdd1, FloatAdd1);
+
+syslsp procedure IntAdd1 FirstArg;
+ if IsInum(FirstArg := WPlus2(FirstArg, 1)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+lisp procedure FloatAdd1 FirstArg;
+ FloatPlus2(FirstArg, 1.0);
+
+DefArith1Entry(Sub1, IntSub1, BigSub1, FloatSub1);
+
+lisp procedure IntSub1 FirstArg;
+ if IsInum(FirstArg := WDifference(FirstArg, 1)) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+lisp procedure FloatSub1 FirstArg;
+ FloatDifference(FirstArg, 1.0);
+
+DefArith1Entry(LNot, IntLNot, BigLNot, NonInteger1Error);
+
+lisp procedure IntLNot X;
+ if IsInum(X := WNot X) then X else MakeFixnum X;
+
+DefArith1Entry('Minus, IntMinus, BigMinus, FloatMinus);
+
+lisp procedure IntMinus FirstArg;
+ if IsInum(FirstArg := WMinus FirstArg) then
+ FirstArg
+ else
+ MakeFixnum FirstArg;
+
+lisp procedure FloatMinus FirstArg;
+ FloatDifference(0.0, FirstArg);
+
+DefArith1Entry(Fix, ReturnFirstArg, ReturnFirstArg, FloatFix);
+
+syslsp procedure FloatFix Arg;
+begin scalar R;
+ return if IsInum(R :=!*WFix FloatBase FltInf Arg) then R
+ else MakeFixnum R;
+end;
+
+DefArith1Entry(Float, FloatIntArg, FloatBigArg, ReturnFirstArg);
+
+syslsp procedure FloatIntArg Arg;
+begin scalar F;
+ F := GtFLTN();
+ !*WFloat(FloatBase F, Arg);
+ return MkFLTN F;
+end;
+
+
+DefArith1PredicateEntry(MinusP, IntMinusP, BigMinusP, FloatMinusP);
+
+syslsp procedure IntMinusP FirstArg;
+ WLessP(FirstArg, 0);
+
+lisp procedure FloatMinusP FirstArg;
+ FloatLessP(FirstArg, 0.0);
+
+DefArith1PredicateEntry(ZeroP, IntZeroP, ReturnNIL, FloatZeroP);
+
+lisp procedure IntZeroP FirstArg;
+ FirstArg = 0;
+
+lisp procedure FloatZeroP FirstArg;
+ EQN(FirstArg, 0.0);
+
+DefArith1PredicateEntry(OneP, IntOneP, ReturnNIL, FloatOneP);
+
+lisp procedure IntOneP FirstArg;
+ FirstArg = 1;
+
+lisp procedure FloatOneP FirstArg;
+ EQN(FirstArg, 1.0);
+
+END;
ADDED psl-1983/3-1/util/time-fnc.sl
Index: psl-1983/3-1/util/time-fnc.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/time-fnc.sl
@@ -0,0 +1,170 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Time-fnc.sl : code to time function calls.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Written by Douglas Lanam. (November 1982).
+;;
+;; To be compiled inside `pfrl' using the command:
+;; (compile-file time-fnc).
+;;
+;; The object created is usuable in any psl on machine it is compiled for.
+;;
+;; Usage:
+;;
+;; do
+;; (timef function-name-1 function-name-2 ...)
+;;
+;; Timef is a fexpr.
+;; It will redefine the functions named so that timing information is
+;; kept on these functions.
+;; This information is kept on the property list of the function name.
+;; The properties used are `time' and `number-of-calls'.
+;;
+;; (get function-name 'time) gives you the total time in the function.
+;; (not counting gc time).
+;; Note, this is the time from entrance to exit.
+;; The timef function redefines the function with an
+;; unwind-protect, so calls that are interrupted
+;; by *throws are counted.
+;;
+;; (get function-name 'number-of-calls) gives you the number of times
+;; the function is called.
+;;
+;; To stop timing do :
+;; (untimef function-name1 ..)
+;; or do (untimef) for all functions.
+;; (untimef) is a fexpr.
+;;
+;; To print timing information do
+;; (print-time-info function-name-1 function-name-2 ..)
+;;
+;; or do (print-time-info) for timing information on all function names.
+;;
+;; special variables used:
+;; *timed-functions* : list of all functions currently being timed.
+;; *all-timed-functions* : list of all functions ever timed in the
+;; current session.
+;;
+;; Comment: if tr is called on a called on a function that is already
+;; being timed, and then untimef is called on the function, the
+;; function will no longer be traced.
+;;
+(defvar *timed-functions* nil)
+(defvar *all-timed-functions* nil)
+
+(defun timef fexpr (names)
+ (cond ((null names) *timed-functions*)
+ ((f-mapc
+ '(lambda (x)
+ (or (memq x *timed-functions*)
+ (let ((a (getd x)))
+ (cond (a (put x 'orig-function-def a)
+ (setq *timed-functions*
+ (cons x *timed-functions*))
+ (or (memq x *all-timed-functions*)
+ (setq *all-timed-functions*
+ (cons x *all-timed-functions*)))
+ (set-up-time-function
+ (car a) x (cdr a)))
+ (t (princ x)
+ (princ " is not a defined function.")
+ (terpri))))))
+ names))))
+
+(defun set-up-time-function (type x old-func)
+ (let ((y (cond ((codep old-func)
+ (code-number-of-arguments old-func))
+ (t (length (cadr old-func)))))
+ (args) (function) (result-var (gensym)) (gc-time-var (gensym))
+ (time-var (gensym)))
+ (do ((i y (difference i 1)))
+ ((= i 0))
+ (setq args (cons (gensym) args)))
+ (putd x type
+ `(lambda ,args
+ (time-function ',x ',old-func
+ (list (time) . ,args))))
+ x))
+
+(defvar |* timing time *| 0)
+
+#+dec20
+(defvar *call-overhead-time* 0.147)
+
+#+vax
+(defvar *call-overhead-time* 0.1)
+
+#+dec20
+(defvar *time-overhead-time* 0.437)
+
+#+vax
+(defvar *time-overhead-time* 1.3)
+
+(defvar |* number of sub time calls *| 0)
+
+(defun time-function (name function-pointer arguments)
+ (let ((itime-var (car arguments)) (result) (n)
+ (endt) (total-fnc-time) (time-var) (gc-time-var))
+ (unwind-protect
+ (let ((|* timing time *| 0)
+ (|* number of sub time calls *| 0))
+ (unwind-protect
+ (let () (setq gc-time-var gctime* time-var (time)
+ result (apply function-pointer (cdr arguments))
+ endt (time))
+ result)
+ (cond
+ (time-var
+ (or endt (setq endt (time)))
+ (Setq n |* number of sub time calls *|)
+ (put name 'number-of-sub-time-calls
+ (+ n (or (get name 'number-of-sub-time-calls) 0)))
+ (setq total-fnc-time (- (- endt time-var) |* timing time *|))
+ (put name 'time
+ (+ (or (get name 'time) 0)
+ (- total-fnc-time (- gctime* gc-time-var))))
+ (put name 'number-of-calls
+ (1+ (or (get name 'number-of-calls) 0)))))))
+ (prog ()
+ (setq |* timing time *|
+ (- (- |* timing time *| itime-var) total-fnc-time)))
+ (setq |* number of sub time calls *|
+ (1+ |* number of sub time calls *|))
+ (setq |* timing time *| (+ |* timing time *| (time)))))))
+
+(defun untimef fexpr (names)
+ (f-mapc '(lambda (x)
+ (cond ((memq x *timed-functions*)
+ (let ((a (get x 'orig-function-def)))
+ (cond (a (putd x (car a) (cdr a)))))
+ (setq *timed-functions*
+ (delq x *timed-functions*)))))
+ (or names *timed-functions*)))
+
+(defun print-time-info fexpr (names)
+ (f-mapc '(lambda (x)
+ (let ((n (get x 'number-of-calls))
+ (ns (get x 'number-of-sub-time-calls))
+ (time) (t1 (get x 'time)))
+ (princ x) (princ " ")
+ (tab 20)
+ (princ (or n 0)) (princ " calls")
+ (cond (n
+ (setq time
+ (max 0
+ (difference
+ (difference
+ (or t1 0)
+ (times *call-overhead-time*
+ (or n 0)))
+ (times *time-overhead-time*
+ (or ns 0)))))
+ (tab 31) (princ time) (princ " ms")
+ (tab 48)
+ (princ (quotient (float time) (float n)))
+ (princ " ms\/call")))
+ (terpri)))
+ (or names *all-timed-functions*))
+ (terpri))
ADDED psl-1983/3-1/util/useful.build
Index: psl-1983/3-1/util/useful.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/useful.build
@@ -0,0 +1,11 @@
+CompileTime load Useful;
+in "backquote.sl"$
+in "read-macros.sl"$
+in "destructure.sl"$
+in "cond-macros.sl"$
+in "bind-macros.sl"$
+in "set-macros.sl"$
+in "iter-macros.sl"$
+in "for-macro.sl"$
+in "misc-macros.sl"$
+in "macroexpand.sl"$
ADDED psl-1983/3-1/util/useful.ctl
Index: psl-1983/3-1/util/useful.ctl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/useful.ctl
@@ -0,0 +1,30 @@
+@cd pu:
+@psl:rlisp
+load build,useful;
+off redefmsg,usermode;
+in "backquote.sl"$
+in "read-macros.sl"$
+in "destructure.sl"$
+in "cond-macros.sl"$
+in "bind-macros.sl"$
+in "set-macros.sl"$
+in "iter-macros.sl"$
+remflag('(for),'lose);
+in "for-macro.sl"$
+in "misc-macros.sl"$
+in "macroexpand.sl"$
+build 'useful;
+quit;
+@tags
+pu:useful.tags
+pu:backquote.sl
+pu:read-macros.sl
+pu:destructure.sl
+pu:cond-macros.sl
+pu:bind-macros.sl
+pu:set-macros.sl
+pu:iter-macros.sl
+pu:for-macro.sl
+pu:misc-macros.sl
+pu:macroexpand.sl
+*
ADDED psl-1983/3-1/util/util.sl
Index: psl-1983/3-1/util/util.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/util.sl
@@ -0,0 +1,119 @@
+%
+% UTIL.SL - General Utility/Support functions
+%
+% Author: Nancy Kendzierski
+% Hewlett-Packard/CRC
+% Date: 23 September 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load common strings objects))
+
+(fluid '(nmode-terminal))
+
+(defun integer$parse (str)
+ % Return an integer corresponding to the string -- not the characters
+ % in the string, but the number in the string.
+ (prog (i negative error ch num)
+ (setf i 0)
+ (setf num 0)
+ (if (<= (string-length str) 0) (return NIL))
+ (setf ch (indx str 0))
+ (cond ((= ch (char -)) (let () (setf negative t)
+ (setf i (add1 i))))
+ ((= ch (char +)) (setf i (add1 i))))
+ (if (>= i (string-length str)) (return NIL))
+ (for (from i i (size str)) (do
+ (setq ch (indx str i))
+ (cond ((or (< ch (char 0)) (> ch (char 9)))
+ (exit (setq error t)))
+ (t (setq num (+ (* num 10) (- ch (char 0))))))))
+ (cond (error (return NIL))
+ (negative (return (setq num (minus num))))
+ (t (return num)))))
+
+(defun integer$unparse (num)
+ % Return an ASCII string version of the integer.
+ (let ((str "") (negative nil) temp)
+ (cond ((< num 0) (setf negative t) (setf num (minus num))))
+ (while (> num 0)
+ (setq temp (divide num 10))
+ (setq num (car temp))
+ (setq str (string-concat (string (+ (cdr temp) (char 0))) str)))
+ (cond ((equal str "") "0")
+ (negative (string-concat "-" str))
+ (t str))
+ ))
+
+(defun integer-base$parse (base str)
+ % Return an integer corresponding to the string -- not the characters
+ % in the string, but the number in the string.
+ (prog (i negative error ch num max-digit)
+ (setf max-digit (+ #\0 (- base 1)))
+ (setf i 0)
+ (setf num 0)
+ (if (<= (string-length str) 0) (return NIL))
+ (setf ch (indx str 0))
+ (cond ((= ch (char -)) (let () (setf negative t)
+ (setf i (add1 i))))
+ ((= ch (char +)) (setf i (add1 i))))
+ (if (>= i (string-length str)) (return NIL))
+ (for (from i i (size str)) (do
+ (setq ch (indx str i))
+ (cond ((or (< ch (char 0)) (> ch max-digit))
+ (exit (setq error t)))
+ (t (setq num (+ (* num base) (- ch (char 0))))))))
+ (cond (error (return NIL))
+ (negative (return (setq num (minus num))))
+ (t (return num)))))
+
+(defun integer-base$unparse (base num)
+ % Return an ASCII string version of the integer.
+ (let ((str "") (negative nil) temp)
+ (cond ((< num 0) (setf negative t) (setf num (minus num))))
+ (while (> num 0)
+ (setq temp (divide num base))
+ (setq num (car temp))
+ (setq str (string-concat (string (+ (cdr temp) (char 0))) str)))
+ (cond ((equal str "") "0")
+ (negative (string-concat "-" str))
+ (t str))
+ ))
+
+(defun LoadSoftKey (key mode command label)
+ % Load a soft key on an HP264X terminal
+ % key: 0 <= key <= 8
+ % mode: 'N 'L or 'T
+ % command: string (maximum 80 characters)
+ % label: string (maximum 80 characters)
+ (prog (cmd command-size label-size restore-echo?)
+ (setq cmd (string 27 38)) % Escape-& is soft-key command prefix start.
+ % Set up proper mode.
+ (cond ((= mode 'N) (setq cmd (concat cmd "f0a")))
+ ((= mode 'L) (setq cmd (concat cmd "f1a")))
+ ((= mode 'T) (setq cmd (concat cmd "f2a")))
+ (t (return "Illegal mode") ))
+ % Set up soft-key number.
+ (if (or (< key 0) (> key 8)) (return "Illegal soft-key number"))
+ (setq cmd (string-concat cmd (integer$unparse key) "k"))
+ % Set up label length, command length, and command.
+ (setq label-size (+ 1 (size label)))
+ (if (> label-size 80) (return "Label too long"))
+ (setq command-size (+ 1 (size command)))
+ (if (> command-size 80) (return "Command too long"))
+
+ (setq cmd (string-concat cmd
+ (integer$unparse label-size)
+ "d"
+ (integer$unparse command-size)
+ "L"
+ label
+ command))
+ % Turn echoing off, if necessary.
+ (cond ((not (=> nmode-terminal raw-mode))
+ (=> nmode-terminal enter-raw-mode)
+ (setq restore-echo? t)))
+ % Output the string of command characters.
+ (for (from i 0 (size cmd)) (do (pbout (indx cmd i))))
+ (if restore-echo? (=> nmode-terminal leave-raw-mode))
+ ))
ADDED psl-1983/3-1/util/vector-fix.build
Index: psl-1983/3-1/util/vector-fix.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/vector-fix.build
@@ -0,0 +1,2 @@
+CompileTime load Syslisp;
+in "vector-fix.red"$
ADDED psl-1983/3-1/util/vector-fix.red
Index: psl-1983/3-1/util/vector-fix.red
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/vector-fix.red
@@ -0,0 +1,100 @@
+% <PSL.UTIL>VECTOR-FIX.RED.5, 18-Mar-82 13:50:06, Edit by BENSON
+% Removed patches that were installed in V3 interp
+% <PSL.UTIL>VECTOR-FIX.RED.4, 20-Jan-82 12:15:26, Edit by GRISS
+% Patch to allow 0 element vectors
+%
+
+on Syslisp;
+
+syslsp procedure MkWords N; %. Allocate vector, init all to #0
+ if IntP N then
+ << if N < (-1) then
+ StdError
+ '"A WORD vector with fewer than zero elements cannot be allocated"
+ else begin scalar W;
+ W := GtWRDS N;
+ for I := 0 step 1 until N do WrdItm(W, I) := 0;
+ return MkWRDS W; % Tag it
+ end >>
+ else NonIntegerError(N, 'MkWords);
+
+% A special facility to truncate X-vects in place
+% extract peices
+
+syslsp procedure TruncateVector(V,I);
+ If Not VectorP V then NonVectorError(V,'TruncateVector)
+ else if not IntP I then NonIntegerError(I,'TruncateVector)
+ else begin scalar Len,Len2,VI;
+ VI:=VecInf V;
+ Len:=VecLen VI;
+ If Len=I then return V; % Already the size
+ If Len<I then
+ return StdError "Cannot Lengthen a Vector in TruncateVector";
+ If Len<(-1) then
+ return StdError "Cant TruncateVector to less then -1";
+ @VI := MkItem(HVECT,I);
+ VecItm(VI, I+1) := MkItem(HVECT, Len-I-2);
+ return V
+ end;
+
+% Missing Words Operations
+
+syslsp procedure WordsP W;
+ tag(w) eq Wrds;
+
+syslsp procedure TruncateWords(V,I);
+ If Not WordsP V then NonWordsError(V,'TruncateWords)
+ else if not IntP I then NonIntegerError(I,'TruncateWords)
+ else begin scalar Len,Len2,VI;
+ VI:=WRDInf V;
+ Len:=WRDLen VI;
+ If Len=I then return V; % Already the size
+ If Len<I then
+ return StdError "Cannot Lengthen a Words in TruncateWords";
+ If Len<(-1) then
+ return StdError "Cant TruncateWords to less then -1";
+ @VI := MkItem(HWRDS,I);
+ WrdItm(VI, I+1) := MkItem(HWRDS, Len-I-2);
+ return V
+ end;
+
+syslsp procedure GetWords(WRD, I); %. Retrieve the I'th entry of WRD
+begin scalar StripV, StripI;
+ return if WordsP WRD then
+ if IntP I then % can't have Wordss bigger than INUM
+ << StripV := WRDInf WRD;
+ StripI := IntInf I;
+ if StripI >= 0 and StripI <= WRDLen StripV then
+ WRDItm(StripV, StripI)
+ else
+ StdError BldMsg('"Subscript %r in GetWords is out of range",
+ I) >>
+ else
+ IndexError(I, 'GetWords)
+ else
+ NonWordsError(WRD, 'GetWords);
+end;
+
+syslsp procedure PutWords(WRD, I, Val); %. Store Val at I'th position of WRD
+begin scalar StripV, StripI;
+ return if WordsP WRD then
+ if IntP I then % can't have Wordss bigger than INUM
+ << StripV := WRDInf WRD;
+ StripI := IntInf I;
+ if StripI >= 0 and StripI <= WRDLen StripV then
+ WRDItm(StripV, StripI) := Val
+ else
+ StdError BldMsg('"Subscript %r in PutWords is out of range",
+ I) >>
+ else
+ IndexError(I, 'PutWords)
+ else
+ NonWordsError(WRD, 'PutWords);
+end;
+
+syslsp procedure UpbW V; %. Upper limit of Words V
+ if WordsP V then MkINT WRDLen WRDInf V else NIL;
+
+off Syslisp;
+
+END;
ADDED psl-1983/3-1/util/zbasic.build
Index: psl-1983/3-1/util/zbasic.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zbasic.build
@@ -0,0 +1,2 @@
+CompileTime load ZBoot;
+in "zbasic.lsp"$
ADDED psl-1983/3-1/util/zbasic.lsp
Index: psl-1983/3-1/util/zbasic.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zbasic.lsp
@@ -0,0 +1,1444 @@
+(!*
+"ZBASIC contains 6 packages --
+ (1) YLSTS -- useful functions for lists.
+ (2) YNUMS -- useful functions for numbers.
+ (3) YSTRS -- useful functions for strings.
+ (4) YIO -- useful functions for user io.
+ (5) YCNTRL -- useful functions for program control.
+ (6) YRARE -- functions we use now, but may eliminate. ")
+
+(!*
+" YLSTS -- BASIC LIST UTILITIES
+
+CCAR ( X:any ):any
+CCDR ( X:any ):any
+LAST ( X:list ):any
+NTH-CDR ( L:list N:number ):list
+NTH-ELT ( L:list N:number ):elt of list
+NTH-TAIL( L:list N:number ):list
+TAIL-P ( X:list Y:list ):extra-boolean
+NCONS ( X:any ): (CONS X NIL)
+KWOTE ( X:any ): '<eval of #X>
+MKQUOTE ( X:any ): '<eval of #X>
+RPLACW ( X:list Y:list ):list
+DREMOVE ( X:any L:list ):list
+REMOVE ( X:any L:list ):list
+DSUBST ( X:any Y:any Z:list ):list
+LSUBST ( NEW:list OLD:list X:any ):list
+COPY ( X:list ):list
+TCONC ( P:list X:any ): tconc-ptr
+LCONC ( P:list X:list ):list
+CVSET ( X:list ):set
+ENTER ( ELT:element SET:list ):set
+ABSTRACT( FN:function L:list ):list
+EACH ( L:list FN:function ):extra-boolean
+SOME ( L:list FN:function ):extra-boolean
+INTERSECTION ( SET1:list SET2:list ):extra-boolean
+SETDIFFERENCE ( SET1:list SET2:list ):extra-boolean
+SUBSET ( SET1:any SET2:list ):extra boolean
+UNION ( X:list Y:list ):list
+SEQUAL ( X:list Y:list ):extra boolean
+MAP2C ( X:list Y:list FN:function ):NIL
+MAP2 ( X:list Y:list FN:function ):NIL
+ATSOC ( ALST:list, KEY:atom ):any
+")
+
+(FLUID '(!#SET2))
+
+(!*
+"CCAR( X:any ):any
+ ----
+ Careful Car. Returns car of x if x is a list, else NIL.")
+
+(CDE CCAR (!#X) (COND ((PAIRP !#X) (CAR !#X))))
+
+(!*
+"CCDR( X:any ):any
+ ----
+ Careful Cdr. Returns cdr of x if x is a list, else NIL.")
+
+(CDE CCDR (!#X) (COND ((PAIRP !#X) (CDR !#X))))
+
+(!*
+"LAST( X:list ):any
+ ----
+ Returns the last cell in X.
+ E.g. (LAST '(A B C)) = (C), (LAST '(A B . C)) = C.")
+
+(!*
+(CDE LAST (!#X)
+ (COND ((ATOM !#X) !#X) ((NULL (CDR !#X)) !#X) (T (LAST (CDR !#X)))))
+)
+
+(CDM LAST (!#X) (CONS 'LASTPAIR (CDR !#X)))
+
+(!*
+"NTH-CDR( L:list N:number ):list
+ -------
+ Returns the nth cdr of list--0 is the list, 1 the cdr ...")
+
+(CDE NTH!-CDR (!#L !#N)
+ (COND ((LESSP !#N 1) !#L)
+ ((ATOM !#L) NIL)
+ (T (NTH!-CDR (CDR !#L) (SUB1 !#N)))))
+
+(!*
+"NTH-TAIL( L:list N:number ):list
+ -------
+ Returns the nth tail of list--1 is the list, 2 the cdr ...")
+
+(CDE NTH!-TAIL (!#L !#N)
+ (COND ((LESSP !#N 2) !#L)
+ ((ATOM !#L) NIL)
+ (T (NTH!-TAIL (CDR !#L) (SUB1 !#N)))))
+
+(!*
+"NTH-ELT( L:list N:number ):list
+ -------
+ Returns the nth elt of list--1 is the car, 2 the cadr ...")
+
+(CDE NTH!-ELT (!#L !#N) (CAR (NTH!-TAIL !#L !#N)))
+
+(!*
+"TAIL-P( X:list Y:list ):extra-boolean
+ ------
+ If X is a non-nil tail of Y (X eq cdr Y or cddr Y or...), return X.
+ Renamed to avoid a conflict with TAILP in compiler")
+
+(CDE TAIL!-P (!#X !#Y)
+ (COND (!#X (PROG NIL
+ LP (COND ((ATOM !#Y) (RETURN NIL)) ((EQ !#X !#Y) (RETURN !#X)))
+ (SETQ !#Y (CDR !#Y))
+ (GO LP)))))
+
+(!* " NCONS( X:any ): (CONS X NIL)
+ -----
+ Returns (CONS X NIL) ")
+
+(!*
+(CDE NCONS (!#X) (CONS !#X NIL))
+)
+
+(!*
+" KWOTE( X:any ): '<eval of #X>
+ MKQUOTE( X:any ): '<eval of #X>
+ -------
+ Returns the quoted value of its argument. ")
+
+(CDM KWOTE (!#X) (CONS 'MKQUOTE (CDR !#X)))
+
+(!*
+(CDE MKQUOTE (!#X) (LIST 'QUOTE !#X))
+)
+
+(!*
+"RPLACW( X:list Y:list ):list
+ ------
+ Destructively replace the Whole list X by Y.")
+
+(!*
+(CDE RPLACW (!#X !#Y) (RPLACA (RPLACD !#X (CDR !#Y)) (CAR !#Y)))
+)
+
+(!*
+"DREMOVE( X:any L:list ):list
+ -------
+ Remove destructively all equal occurrances of X from L.")
+
+(CDE DREMOVE (!#X !#L)
+ (COND ((ATOM !#L) NIL)
+ ((EQUAL !#X (CAR !#L))
+ (COND ((CDR !#L)
+ (PROGN (RPLACA !#L (CADR !#L))
+ (RPLACD !#L (CDDR !#L))
+ (DREMOVE !#X !#L)))))
+ (T (PROG (!#Z)
+ (SETQ !#Z !#L)
+ LP (COND ((ATOM (CDR !#L)) (RETURN !#Z))
+ ((EQUAL !#X (CADR !#L)) (RPLACD !#L (CDDR !#L)))
+ (T (SETQ !#L (CDR !#L))))
+ (GO LP)))))
+
+(!*
+"REMOVE( X:any L:list ):list
+ ------
+ Return copy of L with all equal occurrences of X removed.")
+
+(CDE REMOVE (!#X !#L)
+ (COND ((ATOM !#L) !#L)
+ ((EQUAL (CAR !#L) !#X) (REMOVE !#X (CDR !#L)))
+ (T (CONS (CAR !#L) (REMOVE !#X (CDR !#L))))))
+
+(!*
+"COPY( X:list ):list
+ ----
+ Make a copy of X--EQUAL but not EQ (except for atoms).")
+
+(!*
+(CDE COPY (!#X) (SUBST 0 0 !#X))
+)
+
+(!*
+"DSUBST( X:any Y:any Z:list ):list
+ ------
+ Destructively substitute copies(??) of X for Y in Z.")
+
+(!*
+(CDE DSUBST (!#X !#Y !#Z)
+ (PROG (!#B)
+ (COND ((EQUAL !#Y (SETQ !#B !#Z)) (RETURN (COPY !#X))))
+ LP (COND ((VECTORP !#Z)
+ (RETURN
+ (PROG (!#I)
+ (SETQ !#I (UPBV !#Z))
+ LOOP (COND ((LESSP !#I 1) (RETURN NIL)))
+ (PUTV !#Z !#I (DSUBST !#X !#Y (GETV !#Z !#I)))
+ (SETQ !#I (SUB1 !#I))
+ (GO LOOP))))
+ ((ATOM !#Z) (RETURN !#B))
+ ((EQUAL !#Y (CAR !#Z)) (RPLACA !#Z (COPY !#X)))
+ (T (DSUBST !#X !#Y (CAR !#Z))))
+ (COND ((AND !#Y (EQUAL !#Y (CDR !#Z)))
+ (PROGN (RPLACD !#Z (COPY !#X)) (RETURN !#B))))
+ (SETQ !#Z (CDR !#Z))
+ (GO LP)))
+)
+
+(!* "DSUBST is the same as SubstIP.")
+
+(CDM DSUBST (!#X) (CONS 'SUBSTIP (CDR !#X)))
+
+(!*
+"LSUBST( NEW:list OLD:list X:any ):list
+ ------
+ Substitute elts of NEW (splicing) for the element old in X")
+
+(CDE LSUBST (!#NEW !#OLD !#X)
+ (COND ((NULL !#X) NIL)
+ ((VECTORP !#X)
+ (PROG (!#V !#I)
+ (SETQ !#I (UPBV !#X))
+ (SETQ !#V (MKVECT !#I))
+ LOOP (COND ((LESSP !#I 1) (RETURN !#V)))
+ (PUTV !#V !#I (LSUBST !#NEW !#OLD (GETV !#V !#I)))
+ (SETQ !#I (SUB1 !#I))
+ (GO LOOP)))
+ ((ATOM !#X) (COND ((EQUAL !#OLD !#X) !#NEW) (T !#X)))
+ ((EQUAL !#OLD (CAR !#X))
+ (NCONC (COPY !#NEW) (LSUBST !#NEW !#OLD (CDR !#X))))
+ (T (CONS (LSUBST !#NEW !#OLD (CAR !#X)) (LSUBST !#NEW !#OLD (CDR !#X))))
+ ))
+
+(!*
+(!*
+"TCONC( P:list X:any ): tconc-ptr
+ -----
+ Pointer consists of (CONS LIST (LAST LIST)).
+ Returns (and alters) pointer consisting of (CONS LIST1 (LAST LIST1)),
+ where LIST1 = (NCONC1 LIST X).
+ Avoids searching down the list as nconc1 does, by pointing at last elt
+ of list for nconc1.
+ To use, setq ptr to (NCONS NIL), tconc elts, return car of ptr.")
+
+(CDE TCONC (!#P !#X)
+ (COND ((NULL !#P) (CONS (SETQ !#X (NCONS !#X)) !#X))
+ ((ATOM !#P) (PROGN (PRINT !#P) (ERROR 24 "BAD ARGUMENT 0 TCONC")))
+ ((CDR !#P) (RPLACD !#P (CDR (RPLACD (CDR !#P) (NCONS !#X)))))
+ (T (RPLACA (RPLACD !#P (SETQ !#X (NCONS !#X))) !#X))))
+
+(!*
+"LCONC( P:list X:list ):list
+ -----
+ Same as TCONC, but NCONCs instead of NCONC1s.")
+
+(CDE LCONC (!#P !#X)
+ (PROG (!#Y)
+ (COND ((NULL !#X) (RETURN !#P))
+ ((OR (ATOM !#X) (CDR (SETQ !#Y (LAST !#X)))) (PRINT !#X))
+ ((NULL !#P) (RETURN (CONS !#X !#Y)))
+ ((ATOM !#P) (PRINT !#P))
+ ((NULL (CAR !#P)) (RETURN (RPLACA (RPLACD !#P !#Y) !#X)))
+ (T (PROGN (RPLACD (CDR !#P) !#X) (RETURN (RPLACD !#P !#Y)))))
+ (ERROR 25 "BAD ARGUMENT 0 LCONC")))
+)
+
+(!*
+"CVSET( X:list ):list
+ --------------------
+ Converts list to set, i.e., removes redundant elements.")
+
+(CDE CVSET (!#X)
+ (PROG (!#RES)
+ (COND ((NULL !#X) (RETURN NIL)))
+ (SETQ !#RES (NCONS NIL))
+ LOOP (COND ((NULL !#X) (RETURN (CAR !#RES))))
+ (COND ((NOT (MEMBER (CAR !#X) (CDR !#X))) (TCONC !#RES (CAR !#X))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP)))
+
+(!*
+"ENTER( ELT:element SET:list ):list
+ -----
+ Returns (ELT . SET) if ELT is not member of SET, else SET.")
+
+(CDE ENTER (!#ELT !#SET)
+ (COND ((MEMBER !#ELT !#SET) !#SET) (T (CONS !#ELT !#SET))))
+
+(!*
+"ABSTRACT( FN:function L:list ):list
+ --------
+ Returns list of elts of list satisfying FN.")
+
+(CDE ABSTRACT (!#FN !#L)
+ (PROG (!#ABSTRACTED)
+ (SETQ !#ABSTRACTED (NCONS NIL))
+ (MAPC !#L
+ (FUNCTION
+ (LAMBDA (!#Z)
+ (COND ((APPLY !#FN (LIST !#Z)) (TCONC !#ABSTRACTED !#Z))))))
+ (RETURN (CAR !#ABSTRACTED))))
+
+(!*
+"EACH( L:list FN:function ):extra boolean
+ ----
+ Returns L if each elt satisfies FN, else NIL.")
+
+(CDE EACH (!#L !#FN)
+ (PROG (!#LIS)
+ (SETQ !#LIS !#L)
+ LOOP (COND ((NULL !#LIS) (RETURN (COND (!#L !#L) (T T))))
+ ((NOT (APPLY !#FN (NCONS (CAR !#LIS)))) (RETURN NIL)))
+ (SETQ !#LIS (CDR !#LIS))
+ (GO LOOP)))
+
+(!*
+"SOME( L:list FN:function ):extra boolean
+ ----
+ Returns the first tail of the list whose CAR satisfies function.")
+
+(CDE SOME (!#L !#FN)
+ (PROG NIL
+ LOOP (COND ((NULL !#L) (RETURN NIL))
+ ((APPLY !#FN (LIST (CAR !#L))) (RETURN !#L)))
+ (SETQ !#L (CDR !#L))
+ (GO LOOP)))
+
+(!*
+"INTERSECTION( #SET1:list #SET2:list ):extra boolean
+ ------------
+ Returns list of elts in SET1 which are also members of SET2 ")
+
+(CDE INTERSECTION (!#SET1 !#SET2) (ABSTRACT (FUNCTION INTERSECTION1) !#SET1))
+
+(CDE INTERSECTION1 (!#ELT) (MEMBER !#ELT !#SET2))
+
+(!*
+"SETDIFFERENCE( #SET1:list #SET2:list ):extra boolean
+ -------------
+ Returns all elts of SET1 not members of SET2.")
+
+(CDE SETDIFFERENCE (!#SET1 !#SET2) (ABSTRACT (FUNCTION SETDIFFERENCE1) !#SET1))
+
+(CDE SETDIFFERENCE1 (!#ELT) (NOT (MEMBER !#ELT !#SET2)))
+
+(!*
+"SUBSET( #SET1:any #SET2:list ):extra boolean
+ ------
+ Returns SET1 if each element of SET1 is a member of SET2.")
+
+(CDE SUBSET (!#SET1 !#SET2) (AND !#SET1 (EACH !#SET1 (FUNCTION SUBSET1))))
+
+(CDE SUBSET1 (!#ELT) (MEMBER !#ELT !#SET2))
+
+(!*
+"UNION( X:list Y:list ):list
+ -----
+ Returns the union of lists X, Y")
+
+(CDE UNION (!#X !#Y) (APPEND !#X (SETDIFFERENCE !#Y !#X)))
+
+(!*
+"SEQUAL( X:list Y:list ):extra boolean
+ ------
+ Returns X if X and Y are set-equal: same length and X subset of Y.")
+
+(CDE SEQUAL (!#X !#Y) (AND (EQUAL (LENGTH !#X) (LENGTH !#Y)) (SUBSET !#X !#Y)))
+
+(!*
+"MAP2( X:list Y:list FN:function ):NIL
+ ------
+ Applies FN (of two arguments) to successive paired tails of X and Y.")
+
+(DE MAP2 (!#L1 !#L2 !#FN)
+ (PROG NIL
+ LOOP (COND ((NULL (AND !#L1 !#L2))
+ (COND ((OR !#L1 !#L2) (ERROR 0 "MAP2: mismatched lists"))
+ (T (RETURN NIL)))))
+ (APPLY !#FN (LIST !#L1 !#L2))
+ (SETQ !#L1 (CDR !#L1))
+ (SETQ !#L2 (CDR !#L2))
+ (GO LOOP)))
+
+(!*
+"MAP2C( X:list Y:list FN:function ):NIL
+ ------
+ Applies FN (of two arguments) to successive paired elts of X and Y.")
+
+(DE MAP2C (!#L1 !#L2 !#FN)
+ (PROG NIL
+ LOOP (COND ((NULL (AND !#L1 !#L2))
+ (COND ((OR !#L1 !#L2) (ERROR 0 "MAP2C: mismatched lists"))
+ (T (RETURN NIL)))))
+ (APPLY !#FN (LIST (CAR !#L1) (CAR !#L2)))
+ (SETQ !#L1 (CDR !#L1))
+ (SETQ !#L2 (CDR !#L2))
+ (GO LOOP)))
+
+(!*
+"ATSOC( ALST:list, KEY:atom ):any
+ -----
+ Like ASSOC, except uses an EQ check. Returns first element of
+ ALST whose CAR is KEY.")
+
+(!*
+(CDE ATSOC (KEY ALST)
+ (COND ((NULL ALST) NIL)
+ ((EQ (CAAR ALST) KEY) (CAR ALST))
+ (T (ATSOC KEY (CDR ALST)))))
+)
+
+(!*
+" YNUMS -- BASIC NUMBER UTILITIES
+
+ADD1 ( number ):number EXPR
+SUB1 ( number ):number EXPR
+ZEROP ( any ):boolean EXPR
+MINUSP ( number ):boolean EXPR
+PLUSP ( number ):boolean EXPR
+POSITIVE( X:any ):extra-boolean EXPR
+NEGATIVE( X:any ):extra-boolean EXPR
+NUMERAL ( X:number/digit/any ):boolean EXPR
+GREAT1 ( X:number Y:number ):extra-boolean EXPR
+LESS1 ( X:number Y:number ):extra-boolean EXPR
+GEQ ( X:number Y:number ):extra-boolean EXPR
+LEQ ( X:number Y:number ):extra-boolean EXPR
+ODD ( X:integer ):boolean EXPR
+SIGMA ( L:list FN:function ):integer EXPR
+RAND16 ( ):integer EXPR
+IRAND ( N:integer ):integer EXPR
+")
+
+(!*
+"The DEC compiler may optimize calls to PLUS2, DIFFERENCE, EQUAL,
+ LESSP, etc. by converting them to calls to ADD1, SUB1, ZEROP,
+ MINUSP, etc. This will create circular defintions in the
+ conditional defintions, about which the compiler will complain.
+ Such complaints can be ignored.")
+
+(!*
+(COND ((AND (CODEP (CCDR (GETD 'ADD1)))
+ (CODEP (CCDR (GETD 'SUB1)))
+ (CODEP (CCDR (GETD 'MINUSP))))
+ (PROGN (TERPRI)
+ (PRIN2
+ "Ignore any circular definition msg for ADD1, SUB1, MINUSP")
+ (TERPRI))))
+
+(!*
+"ADD1( number ):number EXPR
+ ----
+ Note: DEC compiler optimizes (PLUS2 N 1) into (ADD1 N). ")
+
+(CDE ADD1 (!#N) (PLUS2 !#N 1))
+
+(!*
+"SUB1( number ):number EXPR
+ ----
+ Note: DEC compiler optimizes (DIFFERENCE N 1) into (SUB1 N). ")
+
+(CDE SUB1 (!#N) (DIFFERENCE !#N 1))
+
+(!*
+"ZEROP( X:any ):boolean EXPR
+ -----
+ Returns non-nil iff X equals 0.")
+
+(CDE ZEROP (!#X) (EQN !#X 0))
+
+(!*
+"MINUSP( N:number ):boolean EXPR
+ ------
+ Returns non-nil iff N is less than 0.")
+
+(CDE MINUSP (!#N) (LESSP !#N 0))
+)
+
+(!*
+"PLUSP( N:number ):boolean EXPR
+ -----
+ Returns non-nil iff N is greater than 0.")
+
+(CDE PLUSP (!#N) (GREATERP !#N 0))
+
+(!*
+"ODD( X:integer ):boolean EXPR
+ ---
+ Returns T if x is odd, else NIL.
+ WARNING: EVENP is used by REDUCE to test if a list has even
+ length. ODD and EVENP are thus highly distinct.")
+
+(CDE ODD (!#X) (EQN 1 (REMAINDER !#X 2)))
+
+(!*
+"POSITIVE( X:any ):boolean EXPR
+ --------
+ Returns non-nil iff X is a positive number.")
+
+(CDE POSITIVE (!#X) (AND (NUMBERP !#X) (GREATERP !#X 0)))
+
+(!*
+"NEGATIVE( X:any ):boolean EXPR
+ --------
+ Returns non-nil iff X is a negative number.")
+
+(CDE NEGATIVE (!#X) (AND (NUMBERP !#X) (LESSP !#X 0)))
+
+(!*
+"NUMERAL( X:any ): boolean EXPR
+ -------
+ Returns true for both numbers and digits. Some dialects
+ had been treating the digits as numbers, and this fn is
+ included as a replacement for NUMBERP where NUMBERP might
+ really be checking for digits.
+ N.B.: Digits are characters and thus ID's")
+
+(DE NUMERAL (!#X) (OR (DIGIT !#X) (NUMBERP !#X)))
+
+(!*
+"GREAT1( X:number Y:number ):extra-boolean EXPR
+ ------
+ Returns X if it is strictly greater than Y, else NIL.
+ GREATERP is simpler if only T/NIL is needed.")
+
+(CDE GREAT1 (!#X !#Y)
+ (COND ((AND (NUMBERP !#X) (NUMBERP !#Y) (GREATERP !#X !#Y)) !#X)))
+
+(!*
+"LESS1( X:number Y:number ):extra-boolean EXPR
+ -----
+ Returns X if it is strictly less than Y, else NIL
+ LESSP is simpler if only T/NIL is needed.")
+
+(CDE LESS1 (!#X !#Y)
+ (COND ((AND (NUMBERP !#X) (NUMBERP !#Y) (LESSP !#X !#Y)) !#X)))
+
+(!*
+(!*
+"GEQ( X:number Y:number ):extra-boolean EXPR
+ ---
+ Returns X if it is greater than or equal to Y, else NIL.")
+
+(CDE GEQ (!#X !#Y)
+ (COND ((AND (NUMBERP !#X) (NUMBERP !#Y) (NOT (LESSP !#X !#Y))) !#X)))
+
+(!*
+"LEQ( X:number Y:number ):extra-boolean EXPR
+ ---
+ Returns X if it is less than or equal to Y, else NIL.")
+
+(CDE LEQ (!#X !#Y)
+ (COND ((AND (NUMBERP !#X) (NUMBERP !#Y) (NOT (GREATERP !#X !#Y))) !#X)))
+)
+
+(!*
+"SIGMA( L:list, FN:function ):integer EXPR
+ -----
+ Returns sum of results of applying FN to each elt of LST.")
+
+(CDE SIGMA (!#L !#FN)
+ (COND ((NULL !#L) 0)
+ (T (PLUS2 (APPLY !#FN (LIST (CAR !#L))) (SIGMA (CDR !#L) !#FN)))))
+
+(!*
+"RAND16( ):integer EXPR
+ IRAND ( N:integer ):integer EXPR
+ ------
+ Linear-congruential random-number generator. To avoid dependence
+ upon the big number package, we are forced to use 16-bit numbers,
+ which means the generator will cycle after only 2^16.
+ The randomness obtained should be sufficient for selecting choices
+ in VOCAL, but not for monte-carlo experiments and other sensitive
+ stuff.")
+
+(GLOBAL '(G!:RANDOM G!:RADD G!:RMUL G!:RMOD))
+
+(!* "decimal 14933 = octal 35125, decimal 21749 = octal 52365 ")
+
+(SETQ G!:RANDOM 0)
+
+(SETQ G!:RADD 14933)
+
+(SETQ G!:RMUL 21749)
+
+(SETQ G!:RMOD (TIMES 256 256))
+
+(!*
+"Returns a new 16-bit unsigned random integer. Leftmost bits are
+ most random so you shouldn't use REMAINDER to scale this to range")
+
+(DE RAND16 NIL
+ (SETQ G!:RANDOM (REMAINDER (TIMES G!:RMUL (PLUS G!:RADD G!:RANDOM)) G!:RMOD)))
+
+(!*
+"Scale new random number to range 0 to N-1 with approximately equal
+ probability. Uses times/quotient instead of remainder to make best
+ use of high-order bits which are most random")
+
+(DE IRAND (N) (QUOTIENT (TIMES (RAND16) N) G!:RMOD))
+
+(!*
+" YSTRS -- BASIC STRING UTILITIES
+
+EXPLODEC ( X:any ):char-list EXPR
+EXPLODE2 ( X:any ):char-list EXPR
+FLATSIZE ( X:str ):integer EXPR
+FLATSIZE2( X:str ):integer EXPR
+NTHCHAR ( X:str N:number ):char-id EXPR
+ICOMPRESS( LST:lst ):<interned id> EXPR
+SUBSTR ( STR:str START:num LENGTH:num ):string EXPR
+CAT-DE ( L: list of strings ):string EXPR
+CAT-ID-DE( L: list of strings ):<uninterned id> EXPR
+SSEXPR ( S: string ):<interned id> EXPR
+")
+
+(!*
+(!*
+"EXPLODE2( X:any ):char-list EXPR
+ EXPLODEC( X:any ):char-list EXPR
+ --------
+ List of characters which would appear in PRIN2 of X. If either
+ is built into the interpreter, we will use that defintion for both.
+ Otherwise, the definition below should work, but inefficiently.
+ Note that this definition does not support vectors and lists.
+ (The DEC and IBM interpreters support EXPLODE and EXPLODE2 by using
+ the same internal algorithm that is used for PRIN1 (PRIN2), but put
+ the chars generated into a list instead of printing them.
+ Thus, they work on arbitrary s-expressions.) ")
+
+(!* "If either EXPLODEC or EXPLODE2 is defined, the CDE does nothing.")
+
+(COND ((GETD 'EXPLODEC) (FLAG '(EXPLODE2) 'LOSE)))
+
+(CDE EXPLODE2 (!#X)
+ (PROG (!#BIG !#TAIL)
+ (COND ((IDP !#X) (GO IDS))
+ ((STRINGP !#X) (GO STRS))
+ ((NUMBERP !#X) (RETURN (EXPLODE !#X)))
+ ((CODEP !#X) (RETURN (EXPLODE !#X)))
+ (T (ERROR "EXPLODE2 -- bad argument")))
+ (!*
+"For ids -- Note: last elt of #BIG will never be bang
+ unless char before it was also a bang.")
+ IDS (SETQ !#TAIL (SETQ !#BIG (EXPLODE !#X)))
+ IDLP (COND ((EQUAL (CAR !#TAIL) '!!) (RPLACW !#TAIL (CDR !#TAIL)))
+ ((NULL (CDR !#TAIL)) (RETURN !#BIG)))
+ (SETQ !#TAIL (CDR !#TAIL))
+ (GO IDLP)
+ (!* "For strings. #BIG has at least 2 elts, the quotes")
+ STRS (SETQ !#TAIL (SETQ !#BIG (EXPLODE !#X)))
+ STRLP(COND ((NULL (CDDR !#TAIL))
+ (PROGN (RPLACD !#TAIL NIL) (RETURN (CDR !#BIG))))
+ ((EQUAL (CAR (SETQ !#TAIL (CDR !#TAIL))) '!")
+ (RPLACD !#TAIL (CDDR !#TAIL))))
+ (GO STRLP)))
+
+(REMFLAG '(EXPLODEC EXPLODE2) 'LOSE)
+
+(CDE EXPLODEC (!#X) (EXPLODE2 !#X))
+
+(CDE EXPLODE2 (!#X) (EXPLODEC !#X))
+
+(!*
+"Note: According to the STANDARD LISP REPORT, EXPLODE and EXPLODE2
+ are only defined for atoms. If your interpreter does not support
+ extended EXPLODE and EXPLODE2, then change the second CDE's below
+ for FLATSIZE and FLATSIZE2 to get recursive versions of them.")
+
+(!*
+" FLATSIZE( X:any ):integer EXPR
+ --------
+ Number of chars in a PRIN1 of X.
+ Also equals length of list created by EXPLODE of X,
+ assuming that EXPLODE extends to arbitrary s-expressions.
+ DEC and IBM interpreters use the same internal algorithm that
+ is used for PRIN1, but count chars instead of printing them. ")
+
+(CDE FLATSIZE (!#X) (LENGTH (EXPLODE !#X)))
+
+(!*
+"If your EXPLODE only works for atoms, comment out the above
+ CDE and turn the CDE below into DE.")
+
+(CDE FLATSIZE (E)
+ (COND ((ATOM E) (LENGTH (EXPLODE E)))
+ (T ((LAMBDA (L1 D)
+ (COND ((NULL D) (PLUS L1 2))
+ (T ((LAMBDA (L2)
+ (COND ((ATOM D) (PLUS 5 L1 L2)) (T (PLUS 1 L1 L2))))
+ (FLATSIZE D)))))
+ (FLATSIZE (CAR E))
+ (CDR E)))))
+
+(!*
+" FLATSIZE2( X:any ):integer EXPR
+ ---------
+ Number of chars in a PRIN2 of X.
+ Also equals length of list created by EXPLODE2 of X,
+ assuming that EXPLODE2 extends to arbitrary s-expressions.
+ DEC and IBM interpreters use the same internal algorithm that
+ is used for PRIN2, but count chars instead of printing them. ")
+
+(!* " FLATSIZE will often suffice for FLATSIZE2 ")
+
+(CDE FLATSIZE2 (!#X) (LENGTH (EXPLODE2 !#X)))
+
+(!*
+"If your EXPLODE2 only works for atoms, comment out the CDE above
+ and turn the CDE below into DE.")
+
+(CDE FLATSIZE2 (E)
+ (COND ((ATOM E) (LENGTH (EXPLODE2 E)))
+ (T ((LAMBDA (L1 D)
+ (COND ((NULL D) (PLUS L1 2))
+ (T ((LAMBDA (L2)
+ (COND ((ATOM D) (PLUS 5 L1 L2)) (T (PLUS 1 L1 L2))))
+ (FLATSIZE2 D)))))
+ (FLATSIZE2 (CAR E))
+ (CDR E)))))
+)
+
+(!*
+" NTHCHAR( X:any, N:number ):character-id EXPR
+ -------
+ Returns nth character of EXPLODE2 of X.")
+
+(CDE NTHCHAR (!#X !#N)
+ (PROG (!#Y)
+ (COND ((SETQ !#Y (NTH!-TAIL (EXPLODE2 !#X) !#N)) (RETURN (CAR !#Y))))))
+
+(!*
+"ICOMPRESS( LST:list ):interned atom EXPR
+ ---------
+ Returns INTERN'ed atom made by COMPRESS.")
+
+(!*
+(CDE ICOMPRESS (!#LST) (INTERN (COMPRESS !#LST)))
+)
+
+(!* "Implode is the same as ICOMPRESS, but more efficient.")
+
+(CDM ICOMPRESS (!#X) (CONS 'IMPLODE (CDR !#X)))
+
+(!*
+"SUBSTR( STR:string START:number LENGTH:number ):string EXPR
+ ------
+ Returns a substring of the given LENGTH beginning with the
+ character at location START in the string.
+ NB: The first location of the string is 0.
+ If START or LENGTH is negative, 0 is assumed.
+ If the length given would exceed the end of the string, the
+ subtring returned quietly goes to end of string, no error.")
+
+(!*
+(CDE SUBSTR (!#STR !#START !#LENGTH)
+ (PROG (!#BIG !#TAIL)
+ (COND ((NOT (STRINGP !#STR))
+ (ERROR 0 "SUBSTR -- argument not a string."))
+ ((OR (NOT (NUMBERP !#START)) (NOT (NUMBERP !#LENGTH)))
+ (ERROR 0 "SUBSTR -- start or length not number"))
+ ((LESSP !#LENGTH 1) (RETURN ""))
+ ((EQUAL !#STR "") (RETURN ""))
+ ((MINUSP !#START) (SETQ !#START 0)))
+ (!* "Fall thru when CDR of #BIG is desired first character")
+ (SETQ !#BIG (EXPLODE !#STR))
+ LP (COND ((MINUSP (SETQ !#START (SUB1 !#START))) NIL)
+ ((NULL (CDR (SETQ !#BIG (CDR !#BIG)))) (RETURN ""))
+ ((EQUAL (CAR !#BIG) '!")
+ (PROGN (!* "Next char must also be quote")
+ (SETQ !#BIG (CDR !#BIG))
+ (GO LP)))
+ (T (GO LP)))
+ (!* "CDR of #BIG is desired first character")
+ (!* "When length drops below zero, chop off remainder")
+ (!* "If list ends first, make string from what we have")
+ (SETQ !#TAIL !#BIG)
+ LP2 (COND ((MINUSP (SETQ !#LENGTH (SUB1 !#LENGTH)))
+ (RPLACD !#TAIL (LIST '!")))
+ ((NULL (CDR (SETQ !#TAIL (CDR !#TAIL)))) NIL)
+ ((EQUAL (CAR !#TAIL) '!")
+ (PROGN (SETQ !#TAIL (CDR !#TAIL)) (GO LP2)))
+ (T (GO LP2)))
+ (RETURN (COMPRESS (RPLACA !#BIG '!")))))
+)
+
+(!* "SUBSTR is handled more efficiently by PSL function SUB")
+
+(CDE SUBSTR (!#S !#ST !#LEN)
+ (SUB !#S (COND ((MINUSP !#ST) 0) (T !#ST)) (SUB1 !#LEN)))
+
+(!*
+"CAT-DE( L: list of expressions ):string EXPR
+ -------
+ Returns a string made from the concatenation of the prin2 names
+ of the expressions in the list. Usually called via CAT macro.")
+
+(DE CAT!-DE (!#L)
+ (COMPRESS (CONS '!" (NCONC (MAPCAN !#L (FUNCTION EXPLODE2)) (LIST '!")))))
+
+(!*
+"CAT-ID-DE( L: list of any ):uninterned id EXPR
+ -------
+ Returns an id made from the concatenation of the prin2 names
+ of the expressions in the list. Usually called via CAT-ID macro.")
+
+(DE CAT!-ID!-DE (!#L) (COMPRESS (MAPCAN !#L (FUNCTION EXPLODE2))))
+
+(!*
+"SSEXPR( S: string ): id EXPR
+ ------
+ Returns ID `read' from string. Not very robust.")
+
+(DE SSEXPR (!#STR)
+ (COND ((STRINGP !#STR) (ICOMPRESS (EXPLODE2 !#STR))) (T !#STR)))
+
+(!*
+"YIO -- simple I/O utilities. All EXPR's.
+
+CONFIRM (#QUEST: string ):boolean
+EATEOL ():NIL
+TTY-DE (#L: list ):NIL
+TTY-TX-DE (#L: list ):NIL
+TTY-XT-DE (#L: list ):NIL
+TTY-TT-DE (#L: list ):NIL
+TTY-ELT (#X: elt ):NIL
+PRINA (#X: any ):NIL
+PRIN1SQ (#X: any ):NIL
+PRIN2SQ (#X: any ):NIL
+PRINCS (#X: single-char-id ):NIL
+--queue-code--
+SEND ():NIL
+SEND-1 (#EE)
+ENQUEUE (#FN #ARG)
+Q-PRIN1 (#E: any ):NIL
+Q-PRINT (#E: any ):NIL
+Q-PRIN2 (#E: any ):NIL
+Q-TERPRI ()
+ONEARG-TERPRI (#E: any ):NIL
+Q-TYO (#N: ascii-code ):NIL
+Q-PRINC (#C: single-char-id ):NIL
+* Q-TTY-DE (#CMDS: list ):NIL
+* Q-TTY-XT-DE (#CMDS: list ):NIL
+* Q-TTY-TX-DE (#CMDS: list ):NIL
+* Q-TTY-TT-DE (#CMDS: list ):NIL
+")
+
+(GLOBAL '(!#SELECTQ G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+
+(FLAG '(PRINT PRIN1 PRIN2 PRINC SETCUR TYO PPRINT TERPRI POSN PPOS)
+ 'SAY!:PRINT)
+
+(DE PRINT2 (!#X) (PROGN (PRIN2 !#X) (TERPRI) !#X))
+
+(DE CONFIRM (!#QUEST)
+ (PROG (!#ANS)
+ LP0 (TTY!-XT !#QUEST)
+ LP1 (SEND)
+ (SETQ !#ANS (UPPER!-CASE (READCH)))
+ (COND ((EQUAL !#ANS !$EOL!$) (SETQ !#ANS (UPPER!-CASE (READCH)))))
+ (COND ((EQUAL !#ANS 'Y) (PROGN (EATEOL) (RETURN T)))
+ ((EQUAL !#ANS 'N) (PROGN (EATEOL) (RETURN NIL)))
+ ((EQUAL !#ANS '!?) (PROGN (EATEOL) (GO LP0)))
+ (T (PROGN (EATEOL) (TTY!-XT "Please type Y, N or ?."))))
+ (GO LP1)))
+
+(CDE UPPER!-CASE (CH)
+ (PROG (TMP)
+ (COND ((AND (LITER CH)
+ (SETQ TMP
+ (MEMQ CH
+ '(A B C D E F G H I J K L M N O P Q R S T U V
+W X Y Z)))) (RETURN
+ (CAR (NTH!-TAIL
+ '(Z Y X W V U T S R Q P O N M L K J I H G F E D C B A)
+ (LENGTH TMP)))))
+ (T (RETURN CH)))))
+
+(!* DE CONFIRM (!#QUEST)
+ (PROG (!#ANS)
+ LP0 (TTY!-XT !#QUEST)
+ LP1 (SEND)
+ (SETQ !#ANS (CAR (EXPLODEC (READ))))
+ (COND ((EQ !#ANS 'Y) (PROGN (EATEOL) (RETURN T)))
+ ((EQ !#ANS 'N) (PROGN (EATEOL) (RETURN NIL)))
+ ((EQ !#ANS '!?) (GO LP0))
+ (T (TTY!-XT "Please type Y, N or ?.")))
+ (GO LP1)))
+
+(!*
+"Eat (discard) text until $EOL$ or <ESC> seen.
+ <ESC> meaningful only on PDP-10 systems.
+ $EOL$ meaningful only on correctly-implemented Standard-LISP systems. ")
+
+(DE EATEOL NIL
+ (PROG (!#CH)
+ LP (SETQ !#CH (READCH))
+ (COND ((MEMQ !#CH (LIST '!$EOL!$ !$EOL!$)) (RETURN NIL)))
+ (GO LP)))
+
+(!* "An idea whose time has not yet come... ")
+
+(!* DE TTY!-DE (EOLS!#BEFORE !#L EOLS!#AFTER)
+ (PROG (OLD!#CHAN)
+ (SETQ OLD!#CHAN (WRS NIL))
+ LP1 (COND ((ONEP EOLS!#BEFORE) (TTY!-ELT !$EOL!$))
+ ((ZEROP EOLS!#BEFORE) NIL)
+ (T (PROGN (TTY!-ELT !$EOL!$)
+ (SETQ EOLS!#BEFORE (SUB1 EOLS!#BEFORE))
+ (GO LP1))))
+ (MAPC !#L (FUNCTION TTY!-ELT))
+ LP1 (COND ((ONEP EOLS!#AFTER) (TTY!-ELT !$EOL!$))
+ ((ZEROP EOLS!#AFTER) NIL)
+ (T (PROGN (TTY!-ELT !$EOL!$)
+ (SETQ EOLS!#AFTER (SUB1 EOLS!#AFTER))
+ (GO LP2))))
+ (WRS OLD!#CHAN)))
+
+(!* "So, for now at least, ... ")
+
+(DE TTY!-DE (!#L)
+ (PROG (OLD!#CHAN)
+ (SETQ OLD!#CHAN (WRS NIL))
+ (MAPC !#L (FUNCTION TTY!-ELT))
+ (WRS OLD!#CHAN)))
+
+(DE TTY!-TX!-DE (!#L)
+ (PROG (OLD!#CHAN)
+ (SETQ OLD!#CHAN (WRS NIL))
+ (TTY!-ELT !$EOL!$)
+ (MAPC !#L (FUNCTION TTY!-ELT))
+ (WRS OLD!#CHAN)))
+
+(DE TTY!-XT!-DE (!#L)
+ (PROG (OLD!#CHAN)
+ (SETQ OLD!#CHAN (WRS NIL))
+ (MAPC !#L (FUNCTION TTY!-ELT))
+ (TTY!-ELT !$EOL!$)
+ (WRS OLD!#CHAN)))
+
+(DE TTY!-TT!-DE (!#L)
+ (PROG (OLD!#CHAN)
+ (SETQ OLD!#CHAN (WRS NIL))
+ (TTY!-ELT !$EOL!$)
+ (MAPC !#L (FUNCTION TTY!-ELT))
+ (TTY!-ELT !$EOL!$)
+ (WRS OLD!#CHAN)))
+
+(DE TTY!-ELT (!#E) (COND ((EQ !#E !$EOL!$) (Q!-TERPRI)) (T (Q!-PRIN2 !#E))))
+
+(!*
+"PRINA( X:any ): any
+ -----
+ Prin2s expression, after TERPRIing if it is too big for line, or spacing
+ if it is not at the beginning of a line. Returns the value of X.
+ Except for the space, this is just PRIN2 in the IBM interpreter.")
+
+(DE PRINA (!#X)
+ (PROGN
+ (COND ((LEQ (CHRCT) (FLATSIZE !#X)) (TERPRI))
+ ((GREATERP (POSN) 0) (PRIN2 " ")))
+ (PRIN2 !#X)))
+
+(!*
+"CHRCT (): <number>
+ -----
+ CHaRacter CounT left in line.
+ Also a CDE in YPP.LSP -- built into IMSSS DEC interpreter.")
+
+(CDE CHRCT NIL (DIFFERENCE (MIN 80 (LINELENGTH NIL)) (POSN)))
+
+(!*
+"BINARY (#X: boolean): old-value
+ ------
+ Stub for non-IMSSS interpreters.
+ In IMSSS interpreter, will put terminal into binary mode or
+ take it out, according to argument, and return old value.")
+
+(CDE BINARY (!#X) NIL)
+
+(!*
+"PRIN1SQ (#X: any)
+ -------
+ PRIN1, Safe, use apostrophe for Quoted expressions.
+ This is essentially a PRIN1 which tries not to exceed the right margin.
+ It exceeds it only in those cases where the pname of a single atom
+ exceeds the entire linelength. In such cases, <big> is printed at the
+ terminal as a warning.
+ (QUOTE xxx) structures are printed in 'xxx form to save space.
+ Again, this is a little superfluous for the IBM interpreter.
+")
+
+(DE PRIN1SQ (!#X)
+ (PROG (!#SIZE)
+ (COND ((ATOM !#X)
+ (PROGN (SETQ !#SIZE (FLATSIZE !#X))
+ (COND ((LESSP (CHRCT) !#SIZE)
+ (PROGN (TERPRI)
+ (COND ((LESSP (CHRCT) !#SIZE)
+ (TTY "<big>"))))))
+ (RETURN (PRIN1 !#X))))
+ ((AND (EQ (CAR !#X) 'QUOTE)
+ (CDR !#X)
+ (NULL (CDDR !#X))
+ (NOT (NUMBERP (CADR !#X))))
+ (PROGN (PRINCS "'") (RETURN (PRIN1SQ (CADR !#X))))))
+ (PRINCS "(")
+ LP (PRIN1SQ (CAR !#X))
+ (SETQ !#X (CDR !#X))
+ (COND ((NULL !#X) (RETURN (PRINCS ")"))))
+ (PRINCS " ")
+ (COND ((NULL (ATOM !#X)) (GO LP)))
+ (PRINCS ".")
+ (PRINCS " ")
+ (PRIN1SQ !#X)
+ (PRINCS ")")))
+
+(!*
+"PRIN2SQ (#X: any)
+ -------
+ PRIN2, Safe, use apostrophe for Quoted expressions.
+ Just like PRIN1SQ, but uses PRIN2 as a basis.
+")
+
+(DE PRIN2SQ (!#X)
+ (PROG (!#SIZE)
+ (COND ((ATOM !#X)
+ (PROGN (SETQ !#SIZE (FLATSIZE !#X))
+ (COND ((LESSP (CHRCT) !#SIZE)
+ (PROGN (TERPRI)
+ (COND ((LESSP (CHRCT) !#SIZE)
+ (TTY "<big>"))))))
+ (RETURN (PRIN2 !#X))))
+ ((AND (EQ (CAR !#X) 'QUOTE)
+ (CDR !#X)
+ (NULL (CDDR !#X))
+ (NOT (NUMBERP (CADR !#X))))
+ (PROGN (PRINCS "'") (RETURN (PRIN2SQ (CADR !#X))))))
+ (PRINCS "(")
+ LP (PRIN2SQ (CAR !#X))
+ (SETQ !#X (CDR !#X))
+ (COND ((NULL !#X) (RETURN (PRINCS ")"))))
+ (PRINCS " ")
+ (COND ((NULL (ATOM !#X)) (GO LP)))
+ (PRINCS ".")
+ (PRINCS " ")
+ (PRIN2SQ !#X)
+ (PRINCS ")")))
+
+(!*
+"PRINCS (#X: single-character-atom)
+ -------
+ PRINC Safe. Does a PRINC, but first worries about right margin.
+")
+
+(DE PRINCS (!#X) (PROGN (COND ((LESSP (CHRCT) 1) (TERPRI))) (PRINC !#X)))
+
+(!*
+"1980 Jul 24 -- New Queued-I/O routines.
+To interface other code to this new I/O method, the following changes
+must be made in other code:
+ PRIN2 --> TTY
+ TERPRI --> $EOL$ inside a TTY, which causes Q-TERPRI to be called
+ TYO --> Q-TYO
+ PRIN1, PRINT -- These are used only for debugging. Do a (SEND) just
+ before starting to print things in realtime, or use Q-PRIN1 etc.
+ TTY -- Ok, expands into TTY-DE which calls Q-PRIN2 and Q-TERPRI.
+ SAY -- I don't know what to do with this crock. It seems to be
+ a poor substitute for TTY. If so it can be changed to TTY
+ with the arguments fixed to be correct. <!GRAM>LPARSE.LSP
+")
+
+(GLOBAL
+ '(!*BATCHOUT !*BATCHQUEUE !*BATCHMAX !*BATCHCNT G!:WASTED!:SENDS
+ G!:GOOD!:SENDS G!:GOOD!:OUTPUTS))
+
+(!*
+"When *BATCHOUT is NIL, output is done in realtime and *BATCHQUEUE
+ remains NIL. When *BATCHOUT is true, output is queued and SEND
+ executes&dequeues it later.")
+
+(!* "Initialize *BATCHQUEUE for TCONC operations.")
+
+(SETQ !*BATCHQUEUE (NCONS NIL))
+
+(!* "Initialize *BATCHMAX and *BATCHCNT ")
+
+(SETQ !*BATCHMAX 100)
+
+(SETQ !*BATCHCNT !*BATCHMAX)
+
+(DE SEND NIL
+ (PROGN
+ (COND ((CAR !*BATCHQUEUE)
+ (PROGN (SETQ G!:GOOD!:SENDS (ADD1 G!:GOOD!:SENDS))
+ (SETQ G!:GOOD!:OUTPUTS
+ (PLUS G!:GOOD!:OUTPUTS (LENGTH (CAR !*BATCHQUEUE))))
+ (MAPC (CAR !*BATCHQUEUE) (FUNCTION SEND!-1))
+ (SETQ !*BATCHCNT !*BATCHMAX)
+ (!* "Set it again up for TCONC's.")
+ (SETQ !*BATCHQUEUE (NCONS NIL))))
+ (T (SETQ G!:WASTED!:SENDS (ADD1 G!:WASTED!:SENDS))))))
+
+(DE SEND!-1 (!#EE) (APPLY (CAR !#EE) (NCONS (CDR !#EE))))
+
+(DE ENQUEUE (!#FN !#ARG)
+ (PROGN (COND ((ZEROP (SETQ !*BATCHCNT (SUB1 !*BATCHCNT))) (SEND)))
+ (SETQ !*BATCHQUEUE (TCONC !*BATCHQUEUE (CONS !#FN !#ARG)))))
+
+(DE Q!-PRIN1 (!#E)
+ (COND (!*BATCHOUT (ENQUEUE 'PRIN1 !#E)) (1 (PRIN1 !#E))))
+
+(DE Q!-PRINT (!#E)
+ (COND (!*BATCHOUT (ENQUEUE 'PRINT !#E)) (1 (PRINT !#E))))
+
+(DE Q!-PRIN2 (!#E)
+ (COND (!*BATCHOUT (ENQUEUE 'PRIN2 !#E)) (1 (PRIN2 !#E))))
+
+(DE Q!-TERPRI NIL
+ (COND (!*BATCHOUT (ENQUEUE 'ONEARG!-TERPRI NIL)) (1 (TERPRI))))
+
+(DE ONEARG!-TERPRI (!#E) (TERPRI))
+
+(DE Q!-TYO (!#N) (COND (!*BATCHOUT (ENQUEUE 'TYO !#N)) (1 (TYO !#N))))
+
+(DE Q!-PRINC (!#C)
+ (COND (!*BATCHOUT (ENQUEUE 'PRINC !#C)) (1 (PRINC !#C))))
+
+(!* " These call PRIN2, so they would cause double-enqueuing. ")
+
+(!* DE Q!-TTY!-DE (!#CMDS)
+ (COND (!*BATCHOUT (ENQUEUE 'TTY!-DE !#CMDS)) (1 (TTY!-DE !#CMDS))))
+
+(!* DE Q!-TTY!-XT!-DE (!#CMDS)
+ (COND (!*BATCHOUT (ENQUEUE 'TTY!-XT!-DE !#CMDS)) (1 (TTY!-XT!-DE !#CMDS))))
+
+(!* DE Q!-TTY!-TX!-DE (!#CMDS)
+ (COND (!*BATCHOUT (ENQUEUE 'TTY!-TX!-DE !#CMDS)) (1 (TTY!-TX!-DE !#CMDS))))
+
+(!* DE Q!-TTY!-TT!-DE (!#CMDS)
+ (COND (!*BATCHOUT (ENQUEUE 'TTY!-TT!-DE !#CMDS)) (1 (TTY!-TT!-DE !#CMDS))))
+
+(SETQ G!:WASTED!:SENDS (SETQ G!:GOOD!:SENDS (SETQ G!:GOOD!:OUTPUTS 0)))
+
+(!*
+" YCNTRL -- ROUTINES INVOLVED WITH PROGRAM CONTROL STRUCTURES
+
+CATCH ( EXP:s-expression LABELS:id or idlist ):any EXPR
+THROW ( VALU:any LABEL:id ): error label EXPR
+ERRSET-DE ( #EXP #LBL ):any EXPR
+APPLY# ( ARG1: function ARG2: argument:list ):any EXPR
+BOUND ( X:any ):boolean EXPR
+MKPROG ( VARS:id-lst BODY:exp ):prog EXPR
+BUG-STOP (): any EXPR
+")
+
+(GLOBAL '(!$THROWN!$ G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+
+(!*
+(!*
+"CATCH( EXP:s-expression LABELS:id or idlist ): any EXPR
+ -----
+ For use with throw. If no THROW occurs in expression, then
+ returns value of expression. If thrown label is MEMQ or EQ to
+ labels, then returns thrown value. OW, thrown label is passed
+ up higher. Expression should be quoted, as in ERRORSET.")
+
+(CDE CATCH (!#EXP !#LABELS)
+ (PROG (!#EE)
+ (COND ((PAIRP
+ (SETQ !#EE (ERRORSET !#EXP G!:SHOW!:ERRORS G!:SHOW!:TRACE)))
+ (RETURN (CAR !#EE)))
+ ((OR (EQ !#LABELS T) (EQ !#EE !#LABELS) (MEMQ !#EE !#LABELS))
+ (RETURN !$THROWN!$))
+ (T (ERROR !#EE NIL)))))
+
+(!*
+"THROW( VALU:any LABEL:id ): error label EXPR
+ -----
+ Throws value with label up to enclosing CATCH having label.
+ If there is no such CATCH, causes error.")
+
+(CDE THROW (!#VALU !#LABEL)
+ (PROGN (SETQ !$THROWN!$ !#VALU) (ERROR !#LABEL NIL)))
+)
+
+(!*
+"ERRSET-DE ( EXP LBL ):any EXPR
+ Named errset. If error matches label, then acts like errorset.
+ Otherwise propagates error upward.
+ Matching: Every label stops errors NIL, $EOF$.
+ Label 'ERRORX stops any error.
+ Other labels stop errors whose first arg is EQ to them.
+ Usually called via ERRSET macro.")
+
+(DE ERRSET!-DE (!#EXP !#LBL)
+ (PROG (!#Y)
+ (SETQ !#Y (ERRORSET !#EXP G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+ (COND ((OR (PAIRP !#Y)
+ (NULL !#Y)
+ (EQ !#Y '!$EOF!$)
+ (EQ !#Y !#LBL)
+ (EQ !#LBL 'ERRORX))
+ (RETURN !#Y))
+ (T (ERROR !#Y "propagated")))))
+
+(!*
+"APPLY#(ARG1: function ARG2: argument:list): any EXPR
+ ------
+ Like APPLY, but can use fexpr and macro functions.")
+
+(CDE APPLY!# (!#ARG1 !#ARG2) (EVAL (CONS !#ARG1 !#ARG2)))
+
+(!*
+"BOUND( X:any ): boolean EXPR
+ -----
+ Returns T if X is a bound id.")
+
+(CDE BOUND (!#X) (AND (IDP !#X) (PAIRP (ERRORSET !#X NIL NIL))))
+
+(!*
+"MKPROG( VARS:id-lst BODY:exp ) EXPR
+ ------
+ Makes a prog around the body, binding the vars.")
+
+(CDE MKPROG (!#VARS !#BODY) (CONS 'PROG (CONS !#VARS !#BODY)))
+
+(!*
+"BUGSTOP ():NIL EXPR
+ -------
+ Enter a read/eval/print loop, exit when OK is seen.")
+
+(DE BUG!-STOP (!#STR)
+ (PROG (!#EXP OLD!#ICHAN OLD!#OCHAN OLD!#LENGTH)
+ (SETQ OLD!#ICHAN (RDS NIL))
+ (SETQ OLD!#OCHAN (WRS NIL))
+ (SETQ OLD!#LENGTH (LINELENGTH NIL))
+ (LINELENGTH 78)
+ (COND ((PAIRP !#STR) (TTY!-DE !#STR)) (T (PRIN2 !#STR)))
+ LOOP (TERPRI)
+ (PRIN2 "--Bug Stop-- Type OK to continue.")
+ (TERPRI)
+ (SETQ !#EXP (ERRORSET '(READ) T NIL))
+ (COND ((ATOM !#EXP) (PROGN (PRIN2 " --Read failed-- ") (GO LOOP))))
+ (SETQ !#EXP (CAR !#EXP))
+ (COND ((EQ !#EXP 'OK)
+ (PROGN (EATEOL)
+ (PRIN2 "resuming... ")
+ (TERPRI)
+ (LINELENGTH OLD!#LENGTH)
+ (RDS OLD!#ICHAN)
+ (WRS OLD!#OCHAN)
+ (RETURN NIL)))
+ ((AND (PAIRP !#EXP) (EQ (CAR !#EXP) 'RETURN))
+ (PROGN (EATEOL)
+ (PRIN2 "returning... ")
+ (TERPRI)
+ (LINELENGTH OLD!#LENGTH)
+ (RDS OLD!#ICHAN)
+ (WRS OLD!#OCHAN)
+ (RETURN (EVAL (CADR !#EXP))))))
+ (SETQ !#EXP (ERRORSET !#EXP T NIL))
+ (COND ((ATOM !#EXP) (PRIN2 " --EVAL failed-- "))
+ (T (PRIN1 (CAR !#EXP))))
+ (GO LOOP)))
+
+(!*
+" YRARE -- ROUTINES WHICH ARE USED, BUT OF DUBIOUS USEFULNESS
+ ?? DELETE THESE ??
+
+LOADV ( V:vector FN:function ):vector EXPR
+AMONG ( ALST KEY ITEM ) EXPR
+INSERT ( ITEM ALST KEY ) EXPR
+DCONS ( X:any Y:list ):list EXPR
+SUBLIST ( X:list P1:integer P2:integer ):list EXPR
+SUBLIST1( Y ) EXPR
+LDIFF ( X:list Y:list ):list EXPR used in editor/copy in ZEDIT
+MAPCAR# ( L:list FN:function ):any EXPR
+MAP# ( L:list FN:function ):any EXPR
+INITIALP( X:list Y:list ):boolean EXPR
+SUBLISTP( X:list Y:list ):list EXPR
+INITQ ( X:any Y:list R:fn ):boolean EXPR
+
+")
+
+(!*
+"LOADV( V:vector FN:function ):vector EXPR
+ -----
+ Loads vector with values. Function should be 1-place numerical.
+ V[I] _ FN( I ).
+ If value of function is 'novalue, then doesn't change value. ??")
+
+(CDE LOADV (!#V !#FN)
+ (PROG (!#CTR !#LEN)
+ (COND ((NOT (SETQ !#LEN (VECTORP !#V))) (RETURN !#V)))
+ (SETQ !#CTR 0)
+ LOOP (PUTV !#V !#CTR (APPLY !#FN (LIST !#CTR)))
+ (COND ((LESSP !#CTR !#LEN) (PROGN (MAKE !#CTR 1) (GO LOOP))))
+ (RETURN !#V)))
+
+(!*
+"AMONG(ALST:association-list KEY:atom ITEM:atom):boolean EXPR
+ -----
+ Tests if item is found under key in association list.
+ Uses EQUAL tests.")
+
+(CDE AMONG (!#ALST !#KEY !#ITEM)
+ (PROG (RES)
+ (SETQ RES
+ (ERRORSET
+ (LIST 'AMONG1 (MKQUOTE !#ALST) (MKQUOTE !#KEY) (MKQUOTE !#ITEM))
+ NIL
+ NIL))
+ (COND ((EQ RES 'FOUND) (RETURN T))
+ ((NULL RES) (RETURN NIL))
+ ((ATOM RES) (ERROR RES NIL)))))
+
+(CDE AMONG1 (!#ALST !#KEY !#ITEM)
+ (MAPC !#ALST
+ (FUNCTION
+ (LAMBDA (!#ENTRY)
+ (AND (EQUAL (CAR !#ENTRY) !#KEY)
+ (MEMQ !#ITEM (CDR !#ENTRY))
+ (ERROR 'FOUND NIL))))))
+
+(!*
+"INSERT (ITEM:item ALST:association:list KEY:any):association list
+ ------
+ EXPR (destructive operation on ALST)
+ Inserts item in association list under key or if key not present
+ adds (KEY ITEM) to the ALST.")
+
+(CDE INSERT (!#ITEM !#ALST !#KEY)
+ (PROG (!#AS!:ITEM)
+ (COND ((SETQ !#AS!:ITEM (ASSOC !#KEY !#ALST))
+ (COND ((NOT (MEMBER !#ITEM (CCDR !#AS!:ITEM)))
+ (RPLACD !#AS!:ITEM (CONS !#ITEM (CDR !#AS!:ITEM))))))
+ (T (DCONS (LIST !#KEY !#ITEM) !#ALST)))
+ (RETURN !#ALST)))
+
+(!*
+"DCONS( X:any Y:list ):list EXPR
+ -----
+ Destructively cons x to list.")
+
+(CDE DCONS (!#X !#Y)
+ (PROGN (RPLACD !#Y (CONS (CAR !#Y) (CDR !#Y))) (RPLACA !#Y !#X)))
+
+(!*
+"SUBLIST( X:list P1:integer P2:integer ):list EXPR
+ -------
+ Returns sublist from p1 to p2 positions, negatives counting from end.
+ I.e., (SUBLIST '(A B C D E) 2 -2) = (B C D)")
+
+(CDE SUBLIST (!#X !#P1 !#P2)
+ (LDIFF (NTH!-TAIL !#X (SETQ !#P1 (SUBLIST1 !#X !#P1)))
+ (NTH!-TAIL !#X (ADD1 (SUBLIST1 !#X !#P2)))))
+
+(CDE SUBLIST1 (!#X !#Y)
+ (COND ((LESSP !#Y 0) (MAX 1 (PLUS 1 !#Y (LENGTH !#X)))) (T !#Y)))
+
+(!*
+"LDIFF( X:list Y:list ):list EXPR
+ -----
+ If X is a tail of Y, returns the list difference of X and Y,
+ a list of the elements of Y preceeding X.")
+
+(CDE LDIFF (!#X !#Y)
+ (COND ((OR (EQ !#X !#Y) (ATOM !#X)) NIL)
+ ((NULL !#Y) !#X)
+ (T (PROG (!#V !#Z)
+ (SETQ !#Z (SETQ !#V (NCONS (CAR !#X))))
+ LOOP (SETQ !#X (CDR !#X))
+ (COND ((OR (EQ !#X !#Y) (ATOM !#X)) (RETURN !#Z)))
+ (SETQ !#V (CDR (RPLACD !#V (NCONS (CAR !#X)))))
+ (GO LOOP)))))
+
+(!*
+"MAPCAR#( L:list FN:function ):any EXPR
+ -------
+ Extends mapcar to work on general s-expressions as well as lists.
+ The return is of same form, i.e.
+ (MAPCAR# 'ATOM '(A B C . D)) = (T T T . T)
+ Also, if for any member of list the variable SPLICE is set to
+ true by function, then for that member the return from the
+ function is spliced into the return.")
+
+(CDE MAPCAR!# (!#L !#FN)
+ (PROG (!#M !#SPLICE !#TEMP)
+ (SETQ !#M (NCONS NIL))
+ LOOP (COND ((NULL !#L) (RETURN (CAR !#M)))
+ ((ATOM !#L)
+ (RETURN
+ (COND ((NULL (CAR !#M)) (APPLY !#FN (LIST !#L)))
+ (T (PROGN (RPLACD (CDR !#M) (APPLY !#FN (LIST !#L)))
+ (CAR !#M)))))))
+ (SETQ !#TEMP (APPLY !#FN (LIST (CAR !#L))))
+ (COND (!#SPLICE (PROGN (SETQ !#SPLICE NIL) (LCONC !#M !#TEMP)))
+ (T (TCONC !#M !#TEMP)))
+ (SETQ !#L (CDR !#L))
+ (GO LOOP)))
+
+(!*
+"MAP#( L:list FN:function ):any EXPR
+ ----
+ Extends map to work on general s-expressions as well as lists.")
+
+(CDE MAP!# (!#L !#FN)
+ (PROG (!#MAPPED)
+ LOOP (COND ((NULL !#L) (RETURN !#MAPPED)))
+ (APPLY !#FN (LIST !#L))
+ (COND ((ATOM !#L) (RETURN !#MAPPED)))
+ (SETQ !#L (CDR !#L))
+ (GO LOOP)))
+
+(!*
+"INITIALP( X:list Y:list ):boolean EXPR
+ --------
+ Returns T if X is EQUAL to some ldiff of Y.")
+
+(CDE INITIALP (!#X !#Y)
+ (COND ((NULL !#X) (COND (!#Y !#Y) (T T)))
+ ((NULL !#Y) NIL)
+ ((NOT (EQUAL (CAR !#X) (CAR !#Y))) NIL)
+ (T (INITIALP (CDR !#X) (CDR !#Y)))))
+
+(!*
+"SUBLISTP( X:list Y:list ):list EXPR
+ --------
+ Returns a tail of Y (or T) if X is a sublist of Y.")
+
+(CDE SUBLISTP (!#X !#Y)
+ (COND ((NULL !#X) (COND (!#Y !#Y) (T T)))
+ ((NULL !#Y) NIL)
+ ((INITIALP !#X !#Y) T)
+ (T (SUBLISTP !#X (CDR !#Y)))))
+
+(!*
+"INITQ( X:any Y:list R:fn ):boolean EXPR
+ -----
+ Returns T if x is an initial portion of Y under the relation R.")
+
+(CDE INITQ (!#X !#Y !#R)
+ (COND ((OR (NULL !#X) (NULL !#Y)) NIL)
+ ((APPLY !#R (LIST (CAR !#X) (CAR !#Y)))
+ (CONS (CAR !#X) (INITQ (CDR !#X) (CDR !#Y) !#R)))))
+
ADDED psl-1983/3-1/util/zboot.build
Index: psl-1983/3-1/util/zboot.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zboot.build
@@ -0,0 +1,2 @@
+compiletime load zboot;
+in "zboot.lsp"$
ADDED psl-1983/3-1/util/zboot.lsp
Index: psl-1983/3-1/util/zboot.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zboot.lsp
@@ -0,0 +1,188 @@
+(DM !* (!#X) NIL)
+
+(SETQ !*EOLINSTRINGOK T)
+
+(!*
+"Needed for PSL, to avoid error messages while reading strings which
+contain carriage returns.")
+
+(!*
+"*( X:any ): NIL MACRO
+ ===> NIL
+ For comments--doesn't evaluate anything. Returns NIL.
+ Note: expressions starting with * which are read by the
+ lisp scanner must obey all the normal syntax rules.")
+
+(!*
+" ZBOOT -- Bootstrapping functions and SLISP extensions
+
+ONEP (U) EXPR used where?
+LIST2 (U V) EXPR compiler support fn
+LIST3 (U V W) EXPR compiler support fn
+LIST4 (U V W X) EXPR compiler support fn
+LIST5 (U V W X Y) EXPR compiler support fn
+MAPOBL (!*PI!*) EXPR UTAH random utility
+REVERSIP (U) EXPR UTAH support fn
+WARNING (U) EXPR UTAH support fn
+
+IMSSS additions: (complement LOSE mechanism)
+
+CDEF (FDSCR TYPE) EXPR conditional function definition
+CDE (Z) FEXPR conditional expr definition
+CDF (Z) FEXPR conditional fexpr definition
+CDM (Z) FEXPR conditional macro definition
+CLAP( LAPCODE ) FEXPR conditional lap definition
+C-SETQ (#ARGS) FEXPR conditional setq
+
+These are for compatibility with the IBM interpreter:
+
+ERASE( #FILE: file descriptor ):NIL EXPR
+
+")
+
+(!* "ARE THESE USED ONLY IN COMPILER PACKAGE?")
+
+(!* (REMFLAG '(LIST2 LIST3 LIST4 LIST5 REVERSIP) 'LOSE))
+
+(!* (GLOBAL '(OBLIST)))
+
+(!* "IMSSS additions: ")
+
+(!*
+"CDEF( FNDSCR: pair, TYPE: {expr,fexpr,macro} ): {id,NIL} EXPR
+ ----
+ Conditional function definition.
+ #FNDSCR = (NAME ARGS BODY) #TYPE = {EXPR, FEXPR, or MACRO}
+ If the function is already defined, a warning is printed,
+ the function is not redefined, and nil is returned.
+ Otherwise, the function is defined and the name is returned.
+ CDEF is called by CDE, CDM and CDF, analogs to DE, DF and DM.")
+
+(!*
+(DE CDEF (!#FDSCR !#TYPE)
+ (PROG (!#NAME !#NEWARGS !#NEWBODY !#OLDDEF)
+ (COND ((ATOM !#FDSCR) (RETURN (WARNING "Bad arg to CDEF."))))
+ (SETQ !#NAME (CAR !#FDSCR))
+ (COND ((NOT (EQUAL (LENGTH !#FDSCR) 3))
+ (RETURN (WARNING (LIST "Bad args to CDEF for " !#NAME)))))
+ (SETQ !#NEWARGS (CADR !#FDSCR))
+ (SETQ !#NEWBODY (CADDR !#FDSCR))
+ (COND ((NULL (SETQ !#OLDDEF (GETD !#NAME)))
+ (RETURN (PUTD !#NAME !#TYPE (LIST 'LAMBDA !#NEWARGS !#NEWBODY))))
+ ((PAIRP (CDR !#OLDDEF))
+ (WARNING
+ (LIST !#NAME
+ " already "
+ (LENGTH (CADDR !#OLDDEF))
+ "-arg "
+ (CAR !#OLDDEF)
+ ", not redefined as "
+ (LENGTH !#NEWARGS)
+ "-arg "
+ !#TYPE)))
+ (T (WARNING
+ (LIST !#NAME
+ " is a compiled "
+ (CAR !#OLDDEF)
+ ", not redefined as "
+ (LENGTH !#NEWARGS)
+ "-arg "
+ !#TYPE))))))
+
+(DF CDE (!#Z) (CDEF !#Z 'EXPR))
+
+(DF CDF (!#Z) (CDEF !#Z 'FEXPR))
+
+(DF CDM (!#Z) (CDEF !#Z 'MACRO))
+
+(!*
+"CLAP( LAPCODE ): {id,NIL} EXPR
+ ----
+ Conditional lap definition.
+ If the function already has a compiled definition, warning is given,
+ the function is not redefined, and nil is returned.
+ Otherwise, LAP is called.")
+
+(DE CLAP (LAP!#CODE)
+ (PROG (!#ENTRY !#ID OLD!#DEF)
+ (COND ((NULL (SETQ !#ENTRY (ASSOC '!*ENTRY LAP!#CODE)))
+ (RETURN (WARNING "CLAP: No *ENTRY in lap code."))))
+ (SETQ !#ID (CADR !#ENTRY))
+ (SETQ OLD!#DEF (GETD !#ID))
+ (COND ((OR (NULL OLD!#DEF) (PAIRP (CDR OLD!#DEF))) (LAP LAP!#CODE))
+ (T (WARNING
+ (LIST !#ID
+ " is compiled "
+ (CAR OLD!#DEF)
+ ", not changed to compiled "
+ (CADDR !#ENTRY)
+ "."))))))
+)
+
+(DM CDE (!#X) (CONS 'DE (CDR !#X)))
+
+(DM CDF (!#X) (CONS 'DF (CDR !#X)))
+
+(DM CDM (!#X) (CONS 'DM (CDR !#X)))
+
+(!*
+"C-SETQ( ARGS: (id any)): any FEXPR
+ ------
+ Conditional SETQ.
+ If the cadr of #ARGS is already defined, it is not reset and its old
+ value is returned. Otherwise, it acts like SETQ. ")
+
+(DF C!-SETQ (!#ARGS)
+ (COND ((PAIRP (ERRORSET (CAR !#ARGS) NIL NIL)) (EVAL (CAR !#ARGS)))
+ (T (SET (CAR !#ARGS) (EVAL (CADR !#ARGS))))))
+
+(!* "This CDE is best left here to avoid bootstrapping problems.")
+
+(CDE WARNING (!#X!#)
+ (PROG (!#CHAN!#)
+ (SETQ !#CHAN!# (WRS NIL))
+ (TERPRI)
+ (PRIN2 "*** ")
+ (COND ((ATOM !#X!#) (PRIN2 !#X!#)) (T (MAPC !#X!# (FUNCTION PRIN2))))
+ (TERPRI)
+ (WRS !#CHAN!#)))
+
+(!*
+(CDE ONEP (U) (OR (EQUAL U 1) (EQUAL U 1.0)))
+
+(CDE LIST2 (U V) (CONS U (CONS V NIL)))
+
+(CDE LIST3 (U V W) (CONS U (CONS V (CONS W NIL))))
+
+(CDE LIST4 (U V W X) (CONS U (CONS V (CONS W (CONS X NIL)))))
+
+(CDE LIST5 (U V W X Y) (CONS U (CONS V (CONS W (CONS X (CONS Y NIL))))))
+)
+
+(!*
+"This definition of MAPOBL doesn't work in PSL, because the oblist has
+a different structure. MAPOBL is defined in the interpreter though.")
+
+(!*(CDE MAPOBL
+ (!*PI!*)
+ (FOREACH X IN OBLIST DO (FOREACH Y IN X DO (APPLY !*PI!* (LIST Y))))))
+
+(!*
+(CDE REVERSIP (U)
+ (PROG (X Y)
+ (WHILE U (PROGN (SETQ X (CDR U)) (SETQ Y (RPLACD U Y)) (SETQ U X)))
+ (RETURN Y)))
+)
+
+(!*
+"ERASE( #FILE: file descriptor ):NIL EXPR
+ -----
+ This is defined in the IBM interpreter to (irrevocably) delete
+ a file from the file system, which is a highly necessary operation
+ when you are not allowed versions of files.
+ It should be a no-op in the TENEX interpreters until such an
+ operation seems necessary. This assumes the user will delete and
+ expunge old versions from the exec.")
+
+(CDE ERASE (!#FILE) NIL)
+
ADDED psl-1983/3-1/util/zfiles.build
Index: psl-1983/3-1/util/zfiles.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zfiles.build
@@ -0,0 +1,3 @@
+CompileTime load(ZBoot, ZBasic, ZMacro, If!-System);
+in "zfiles.lsp"$
+in "zsys.lsp"$
ADDED psl-1983/3-1/util/zfiles.lsp
Index: psl-1983/3-1/util/zfiles.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zfiles.lsp
@@ -0,0 +1,494 @@
+(!*
+"ZFILES contains 2 packages --
+ (1) YFILES -- useful functions for accessing files.
+ (2) YTOPCOM -- useful functions for compiling files. ")
+
+(!*
+" YFILES -- BASIC FILE ACCESSING UTILITIES
+
+FORM-FILE ( FILE:DSCR ): filename EXPR
+GRABBER ( SELECTION FILE:DSCR ): NIL EXPR
+DUMPER ( FILE:DSCR ): NIL EXPR
+DUMPFNS-DE ( SELECTION FILE:DSCR ): NIL EXPR
+DUMP-REMAINING ( SELECTION:list DUMPED:list ): NIL EXPR
+FCOPY ( IN:DSCR OUT:DSCR filedscrs ):boolean EXPR
+REFPRINT-FOR-GRAB-CTL( #X: any ):NIL EXPR
+
+G:CREFON Switched on by cross reference program CREF:FILE
+G:JUST:FNS Save only fn names in variable whose name is the first
+ field of filename if T, O/W save all exprs in that variable
+G:FILES List of files read into LISP
+G:SHOW:TRACE Turns backtrace in ERRORSET on if T
+G:SHOW:ERRORS Prints ERRORSET error messages if T
+
+")
+
+(GLOBAL '(G!:FILES G!:CREFON G!:JUST!:FNS))
+
+(GLOBAL '(G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+
+(FLUID '(F!:FILE!:ID F!:OLD!:FILE PPPRINT))
+
+(FLUID '(DUMP!#ID))
+
+(!*
+"GRAB( <file description> ) MACRO
+ ===> (GRABBER NIL '<file-dscr>)
+ Reads in entire file, whose system name is created using
+ conventions described in FORM-FILE. See ZMACROS.")
+
+(!*
+"GRABFNS( <ids> . <file description> ) MACRO
+ ===> (GRABBER IDS <file-dscr>)
+ Like GRAB, but only reads in specified ids. See ZMACROS.")
+
+(!*
+"FORM-FILE( FILE:DSCR ): filename EXPR
+ ---------
+ Takes a file dscr, possibly NIL, and returns a file name
+ corresponding to that dscr and suitable as an argument to OPEN.
+ F:OLD:FILE is set to this file name for future reference.
+ Meanwhile, F:FILE:ID is set to a lisp identifier, and the file
+ name is put on the OPEN:FILE:NAME property of that identifier.
+ The identifier can be used to hold info about the file.
+ E.g. its value may be a list of objects read from the file.
+
+ NB: FORM-FILE is at the lowest level of machine-independant code.
+ MAKE-OPEN-FILE-NAME is a system dependant routine that creates
+ file names specifically tailored to the version of SLISP in use.
+")
+
+(DE FORM!-FILE (FILE!#DSCR)
+ (PROG (!#TEMP)
+ (COND ((IDP FILE!#DSCR) (MAKE FILE!#DSCR NCONS)))
+ (!*
+"COND below: case 1--defaults to most recent file referenced
+ case 2--virtual file name: access property list
+ case 3--build usable file name from all or part
+ of FILE:DSCR given")
+ (COND ((NULL (CAR FILE!#DSCR))
+ (COND (F!:OLD!:FILE
+ (PROGN (TTY " = " F!:FILE!:ID) (RETURN F!:OLD!:FILE)))
+ (T (ERROR 0 "No file specified and no default file."))))
+ ((SETQ !#TEMP (GET (CAR FILE!#DSCR) 'OPEN!:FILE!:NAME))
+ (PROGN (SETQ F!:FILE!:ID (CAR FILE!#DSCR))
+ (RETURN (SETQ F!:OLD!:FILE !#TEMP))))
+ (T (RETURN (MAKE!-OPEN!-FILE!-NAME FILE!#DSCR))))))
+
+(!*
+"GRABBER( SELECTION:id-list FILE:DSCR ):T EXPR
+ -------
+ Opens the specified file, applies GRAB-EVAL-CTL to each
+ expression on it, and then closes it. Returns T.
+ See GRAB-EVAL-CTL for important side effects.")
+
+(DE GRABBER (!#SELECTION FILE!#DSCR)
+ (PROG (!#Y EXPR!#READ !#ICHAN IBASE FILE!#ID FILE!#NAME)
+ (SETQ FILE!#NAME (FORM!-FILE FILE!#DSCR))
+ (!* SETQ FILE!#NAME (GET FILE!#ID 'FILE!:NAME))
+ (SETQ FILE!#ID F!:FILE!:ID)
+ (SETQ G!:FILES (NCONC1 G!:FILES FILE!#ID))
+ (SET FILE!#ID (LIST NIL))
+ (SETQ IBASE (PLUS 5 5))
+ (RDS (SETQ !#ICHAN (OPEN FILE!#NAME 'INPUT)))
+ LOOP (SETQ EXPR!#READ (ERRORSET '(READ) T G!:SHOW!:TRACE))
+ (COND (!#SELECTION (PRINA ".")))
+ (COND ((AND (PAIRP EXPR!#READ) (NEQ !$EOF!$ (CAR EXPR!#READ)))
+ (PROGN
+ (ERRORSET
+ (LIST 'GRAB!-EVAL!-CTL
+ (MKQUOTE !#SELECTION)
+ (MKQUOTE (CAR EXPR!#READ))
+ (MKQUOTE FILE!#ID))
+ T
+ G!:SHOW!:TRACE)
+ (COND ((NOT (SUBSET !#SELECTION (CDR (EVAL FILE!#ID))))
+ (GO LOOP))))))
+ (RDS NIL)
+ (CLOSE !#ICHAN)
+ (SET FILE!#ID (DREMOVE NIL (EVAL FILE!#ID)))
+ (TERPRI)
+ (RETURN T)))
+
+(!*
+"GRAB-EVAL-CTL( #SELECTION EXPR#READ FILE#ID ) EXPR
+ -------------
+ Examines each expression read from file, and determines whether
+ to EVAL that expression. Also decides whether to append the
+ expression, or an id taken from it, or nothing at all, to the
+ value of the file id poined at by FILE#ID.
+ The file id is stored for use as an argument to DUMP or COMPILE,
+ for example.
+ Note: G:JUSTFNS suppresses the storage of comments from the file.
+ When reading LAP files, no list of fns is made.")
+
+(DE GRAB!-EVAL!-CTL (!#SELECTION EXPR!#READ FILE!#ID)
+ (COND ((ATOM EXPR!#READ) NIL)
+ ((AND (EQ (CAR EXPR!#READ) 'SETQ) (EQ (CADR EXPR!#READ) FILE!#ID))
+NIL) ((AND (OR (NULL !#SELECTION) (MEMBER (CADR EXPR!#READ) !#SELECTION))
+ (MEMBER (CAR EXPR!#READ) '(DE DF DM SETQ CDE CDF CDM C!-SETQ)))
+ (PROGN (PRINA (CADR EXPR!#READ))
+ (EVAL EXPR!#READ)
+ (COND ((AND (NEQ (CADR EXPR!#READ) 'IBASE)
+ (NOT (MEMBER (CADR EXPR!#READ) (EVAL FILE!#ID)))
+ (NOT (MEMBER (CAR EXPR!#READ) '(LAP CLAP))))
+ (NCONC1 (EVAL FILE!#ID) (CADR EXPR!#READ))))))
+ ((NULL !#SELECTION)
+ (PROGN (OR G!:JUST!:FNS (NCONC1 (EVAL FILE!#ID) EXPR!#READ))
+ (!* "G:JUST:FNS reduces consumption of string space.")
+ (COND (G!:CREFON (REFPRINT!-FOR!-GRAB!-CTL EXPR!#READ)))
+ (EVAL EXPR!#READ)
+ (PRINA (CCAR EXPR!#READ))))))
+
+(!*
+"DUMPER( FILE:DSCR : file-dscr ): NIL EXPR
+ ------
+ Dumps file onto disk. Filename as in GRABBER.
+ Prettyprints the defined functions, set variables, and evaluated
+ expressions which are members of the value of the variable filename.
+ (For DEC versions:
+ If IBASE neq 10, puts (SETQ IBASE current:base) at head of file.)")
+
+(DE DUMPER (!#DSCR)
+ (PROG (!#OCHAN OLD!#OCHAN FILE!#ID)
+ (!* SETQ FILE!#ID (FORM!-FILE !#DSCR))
+ (SETQ !#OCHAN (OPEN (FORM!-FILE !#DSCR) 'OUTPUT))
+ (SETQ FILE!#ID F!:FILE!:ID)
+ (SETQ OLD!#OCHAN (WRS !#OCHAN))
+ (MAPC (EVAL FILE!#ID) (FUNCTION PP1))
+ (CLOSE !#OCHAN)
+ (WRS OLD!#OCHAN)
+ (RETURN T)))
+
+(!*
+"DUMPFNS-DE( FNS FILE:DSCR ): NIL EXPR
+ ----------
+ Like DUMPER. Copies old file, putting new definitions for specified
+ functions/variables.
+ E.g.: (DUMPFNS-DE '(A B) '(FOO)) will first copy verbatim all the
+ expressions on FOO.LSP which do not define A or B.
+ Then the core definitions of A and B are dumped onto the file.")
+
+(DE DUMPFNS!-DE (!#SELECTION FILE!#DSCR)
+ (PROG (FILE!#ID FILE!#NAME IBASE !#OLD !#DUMPED !#ICHAN !#OCHAN OLD!#ICHAN
+ OLD!#OCHAN !#ID)
+ (SETQ FILE!#NAME (FORM!-FILE FILE!#DSCR))
+ (SETQ FILE!#ID F!:FILE!:ID)
+ (SETQ IBASE (PLUS 5 5))
+ (SETQ OLD!#ICHAN (RDS (SETQ !#ICHAN (OPEN FILE!#NAME 'INPUT))))
+ (SETQ OLD!#OCHAN (WRS (SETQ !#OCHAN (OPEN FILE!#NAME 'OUTPUT))))
+ LOOP (SETQ !#OLD (ERRORSET '(READ) G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+ (COND ((OR (ATOM !#OLD) (EQ (SETQ !#OLD (CAR !#OLD)) !$EOF!$))
+ (PROGN (!* "dump remaining selected objects")
+ (DUMP!-REMAINING !#SELECTION !#DUMPED)
+ (CLOSE !#ICHAN)
+ (CLOSE !#OCHAN)
+ (RDS OLD!#ICHAN)
+ (WRS OLD!#OCHAN)
+ (RETURN T))))
+ (COND ((AND (PAIRP !#OLD)
+ (MEMBER (CAR !#OLD) '(SETQ DE DF DM CDE CDF CDM))
+ (MEMBER (SETQ !#ID (CADR !#OLD)) !#SELECTION))
+ (PROGN
+ (SETQ !#DUMPED
+ (CONS (CONS !#ID
+ (COND ((EQ 'SETQ (CAR !#OLD))
+ (PROGN (PP!-VAL !#ID) 'VAL))
+ (T (PROGN (PP!-DEF !#ID) 'DEF))))
+ !#DUMPED))
+ (GO LOOP))))
+ (COND ((AND (PAIRP !#OLD)
+ (EQ (CAR !#OLD) 'SETQ)
+ (EQ (CADR !#OLD) 'IBASE))
+ (ERRORSET !#OLD T G!:SHOW!:TRACE)))
+ (TERPRI)
+ (APPLY PPPRINT (LIST !#OLD 1))
+ (TERPRI)
+ (TERPRI)
+ (GO LOOP)))
+
+(!*
+"DUMP-REMAINING( SELECTION:list DUMPED:list ) EXPR
+ --------------
+ Taken out of DUMPFNS for ease of reading.
+ Dumps those properties of items in selection which have not
+ already been dumped.")
+
+(DE DUMP!-REMAINING (!#SELECTION !#DUMPED)
+ (PROG (DUMP!#ID !#IGNORE)
+ LOOP (SETQ DUMP!#ID (CAR !#SELECTION))
+ (SETQ !#IGNORE
+ (MAPCAN !#DUMPED
+ (FUNCTION
+ (LAMBDA (!#PAIR)
+ (COND ((EQ DUMP!#ID (CAR !#PAIR)) (LIST (CDR !#PAIR)))))
+ )))
+ (OR (MEMBER 'VAL !#IGNORE) (PP!-VAL DUMP!#ID))
+ (OR (MEMBER 'DEF !#IGNORE) (PP!-DEF DUMP!#ID))
+ (COND ((SETQ !#SELECTION (CDR !#SELECTION)) (GO LOOP)))))
+
+(!*
+"FCOPY( IN:DSCR filename, OUT:DSCR filename ):boolean EXPR
+ -----
+ Reformats file using the prettyprinter. Useful for removing
+ angle brackets or for tightening up function format.
+ Returns T on normal exit, NIL if error reading file. ")
+
+(DE FCOPY (IN!#DSCR OUT!#DSCR)
+ (PROG (IN!#CHAN OUT!#CHAN !#EXP)
+ (SETQ IN!#CHAN (OPEN (FORM!-FILE IN!#DSCR) 'INPUT))
+ (SETQ OUT!#CHAN (OPEN (FORM!-FILE OUT!#DSCR) 'OUTPUT))
+ (RDS IN!#CHAN)
+ (WRS OUT!#CHAN)
+ (LINELENGTH 80)
+ LOOP (SETQ !#EXP (ERRORSET '(READ) T T))
+ (COND ((OR (ATOM !#EXP) (EQ (CAR !#EXP) !$EOF!$))
+ (PROGN (CLOSE IN!#CHAN)
+ (RDS NIL)
+ (CLOSE OUT!#CHAN)
+ (WRS NIL)
+ (RETURN (EQ !#EXP !$EOF!$)))))
+ (SETQ !#EXP (CAR !#EXP))
+ (TTY ".")
+ (COND ((ATOM !#EXP) (SPRINT !#EXP 1))
+ ((MEMQ (CAR !#EXP) '(DE DF DM CDE CDF CDM))
+ (PROGN (PRIN2 "(")
+ (PRIN1 (CAR !#EXP))
+ (PRIN2 " ")
+ (PRIN1 (CADR !#EXP))
+ (PRIN2 " ")
+ (PRIN1 (CADDR !#EXP))
+ (S2PRINT " " (CADDDR !#EXP))
+ (PRIN2 ")")))
+ ((EQ (CAR !#EXP) 'SETQ)
+ (PROGN (PRIN2 "(")
+ (PRIN1 (CAR !#EXP))
+ (PRIN2 " ")
+ (PRIN1 (CADR !#EXP))
+ (S2PRINT " " (CADDR !#EXP))
+ (PRIN2 ")")))
+ (T (SPRINT !#EXP 1)))
+ (TERPRI)
+ (TERPRI)
+ (GO LOOP)))
+
+(!*
+"FCOPY-SQ ( IN:DSCR filename, OUT:DSCR filename ):boolean EXPR
+ -----
+ Reformats file using the compacting printer. Letterizes
+ and reports via '<big>' message long strings.
+ Returns T on normal exit, NIL if error reading file. ")
+
+(DE FCOPY!-SQ (IN!#DSCR OUT!#DSCR)
+ (PROG (IN!#CHAN OUT!#CHAN !#EXP)
+ (SETQ IN!#CHAN (OPEN (FORM!-FILE IN!#DSCR) 'INPUT))
+ (SETQ OUT!#CHAN (OPEN (FORM!-FILE OUT!#DSCR) 'OUTPUT))
+ (RDS IN!#CHAN)
+ (WRS OUT!#CHAN)
+ LOOP (SETQ !#EXP (ERRORSET '(READ) T T))
+ (COND ((ATOM !#EXP)
+ (PROGN (CLOSE IN!#CHAN)
+ (RDS NIL)
+ (CLOSE OUT!#CHAN)
+ (WRS NIL)
+ (RETURN (EQ !#EXP !$EOF!$))))
+ ((EQ (SETQ !#EXP (CAR !#EXP)) !$EOF!$)
+ (PROGN (CLOSE IN!#CHAN) (CLOSE OUT!#CHAN) (RETURN T))))
+ (TTY ".")
+ (PRIN1SQ !#EXP)
+ (TERPRI)
+ (TERPRI)
+ (GO LOOP)))
+
+(!* "Dummy -- may be replaced by real cref routine.")
+
+(DE REFPRINT!-FOR!-GRAB!-CTL (!#X) NIL)
+
+(!*
+" YTOPCOM -- Compiler Control functions
+
+(DF COMPILE-FILE (FILE:NAME)
+(DF COMPILE-IN-CORE (FILE:NAME)
+
+")
+
+(!*
+"Commonly used globals. Declared in this file so each individual
+ file doesn't have to declare them. ")
+
+(GLOBAL '(!#SELECTQ G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+
+(!* "Other globals/fluids")
+
+(GLOBAL '(!*SAVEDEF))
+
+(FLUID '(F!:FILE!:ID COMPILED!:FNS))
+
+(!* "This flag is checked by COMPILE-FILE.")
+
+(FLAG '(EXPR FEXPR) 'COMPILE)
+
+(!*
+"PPLAP( MODE CODE ) EXPR
+ -----
+ Prints the lap code in some appropriate format.
+ Currently uses PRIN1SQ (PRIN1, Safe, use apostrophe to Quote
+ non-numeric expressions).")
+
+(DE PPLAP (!#MODE !#CODE) (PRIN1SQ (LIST !#MODE (MKQUOTE !#CODE))))
+
+(!*
+"COMPILE-FILE( FILE:DSCR ) FEXPR
+ ------------
+ Reads the given file, and creates a corresponding LAP file.
+ Each expression on the original file is mapped into an expression
+ on the LAP file.
+ Comments map into NIL.
+ Function definitions map into the corresponding LAP code.
+ These definitions are compiled, but NOT evaluated -- hence the
+ functions will not be loaded into this core image by this routine.
+ All other expressions are evaluated in an errorset then copied verbatim.
+ EXCEPTION: UNFLUID is evalutated, but converted into a comment
+ when printed, to avoid confusing loader.
+")
+
+(FLUID '(QUIET_FASLOUT!*))
+
+(!* "Controls printing of welcome message in FASLOUT.")
+
+(DF COMPILE!-FILE (FILE!:DSCR)
+ (PROG (IN!:SEXPR LSP!:FILE LAP!:FILE OLD!:SAVEDEF LAP!:FN!:NAME LAP!:OUT
+ QUIET_FASLOUT!*
+ LAP!:FN LSP!:FILE!:ID OCHAN ICHAN TYPE MODE)
+ (!*
+"*SAVEDEF Saves LAP code generated by the compiler on the property
+ list of the function under indicator COMPEXP")
+(!* (SETQ OLD!:SAVEDEF !*SAVEDEF)
+ (SETQ !*SAVEDEF T))
+ (SETQ QUIET_FASLOUT!* T)
+ (GCMSG NIL)
+ (!*
+"Note: If FILE:DSCR = (AAA BBB) then
+ TENEX: from LSP:FILE = '<AAA>BBB.LSP', LSP:FILE:ID = BBB
+ to LAP:FILE = '<AAA>BBB.LAP', LAP:FILE:ID = BBB
+ CMS: from LSP:FILE = 'AAA BBB', LSP:FILE:ID = AAA
+ to LAP:FILE = 'AAA LAP', LAP:FILE:ID = AAA
+ This is non-ideal, since the first filename gets lost.
+ It is not clear, however, what an elegant solution would be.
+ Perhaps the file id should have a list of filenames, one for
+ each extension... ")
+ (SETQ LSP!:FILE (FORM!-FILE FILE!:DSCR))
+ (SETQ LSP!:FILE!:ID F!:FILE!:ID)
+ (SETQ ICHAN (OPEN LSP!:FILE 'INPUT))
+ (!* "Try to create lap file corresponding to LSP file.")
+ (SETQ LAP!:FILE (SUBST '!; 'LSP LSP!:FILE))
+ (!* "But if that doesn't work out..")
+ (COND ((EQUAL LSP!:FILE LAP!:FILE)
+ (SETQ LAP!:FILE (FORM!-FILE (CONS LSP!:FILE!:ID '!;)))))
+ (!* SETQ LAP!:FILE!:ID F!:FILE!:ID)
+ (ERRORSET (LIST 'ERASE (MKQUOTE LAP!:FILE))
+ G!:SHOW!:ERRORS
+ G!:SHOW!:TRACE)
+ (!*(SETQ OCHAN (OPEN LAP!:FILE 'OUTPUT)))
+ (FASLOUT LAP!:FILE)
+ (RDS ICHAN)
+ (WHILE
+ (AND (PAIRP (SETQ IN!:SEXPR (ERRORSET '(READ) NIL NIL)))
+ (NOT (EQ (SETQ IN!:SEXPR (CAR IN!:SEXPR)) !$EOF!$)))
+ (!* PROGN (SETQ COMPILED!:FNS NIL)
+ (SETQ TYPE
+ (SELECTQ (CAR IN!:SEXPR)
+ ((DE CDE) 'EXPR)
+ ((DF CDF) 'FEXPR)
+ ((DM CDM) 'MACRO)
+ NIL))
+ (SETQ MODE
+ (SELECTQ (CAR IN!:SEXPR)
+ ((CDE CDF CDM) 'CLAP)
+ ((DE DF DM) 'LAP)
+ NIL))
+ (COND ((FLAGP TYPE 'COMPILE)
+ (PROG NIL
+ (PRINA (SETQ LAP!:FN!:NAME (CADR IN!:SEXPR)))
+ (SETQ LAP!:OUT
+ (SIMPLIFYLAP
+ (CONS (LIST '!*ENTRY
+ LAP!:FN!:NAME
+ TYPE
+ (LENGTH (CADDR IN!:SEXPR)))
+ (!&COMPROC
+ (CONS 'LAMBDA (CDDR IN!:SEXPR))
+ LAP!:FN!:NAME))))
+ (WRS OCHAN)
+ (!* LOOP
+ (SETQ LAP!:OUT
+ (CDR (REMPROP LAP!:FN!:NAME 'COMPEXP))))
+ (PPLAP MODE LAP!:OUT)
+ (TERPRI)
+ (!*(COND ((SETQ COMPILED!:FNS
+ (DREMOVE LAP!:FN!:NAME
+ COMPILED!:FNS))
+ (PROGN
+ (SETQ LAP!:FN!:NAME
+ (CCAR COMPILED!:FNS))
+ (GO LOOP)))))
+ (WRS NIL)
+ (PRINA "ok")))
+ ((MEMQ (CAR IN!:SEXPR) '(!* !*!*)) NIL)
+ ((EQ (CAR IN!:SEXPR) 'UNFLUID) (EVAL IN!:SEXPR))
+ (T (PROGN
+ (ERRORSET (LIST 'EVAL (MKQUOTE IN!:SEXPR)) T NIL)
+ (!* "Be sure errors are printed to terminal")
+ (WRS OCHAN)
+ (SPRINT IN!:SEXPR 1)
+ (TERPRI)
+ (WRS NIL)))))
+ (DFPRINTFASL IN!:SEXPR))
+ (SETQ !*SAVEDEF OLD!:SAVEDEF)
+ (CLOSE ICHAN)
+ (RDS NIL)
+ (!* (CLOSE OCHAN))
+ (FASLEND)))
+
+(!*
+"COMPILE-IN-CORE( FILE:DSCR ):NIL FEXPR
+ ---------------
+ Compiles all EXPRS and FEXPRS on a file and loads compiled code into
+ core. Creates a file FILE:NAME.cpl which is a compilation log
+ consisting of the names of functions compiled and the space used in
+ their loading.")
+
+(DF COMPILE!-IN!-CORE (FILE!:DSCR)
+ (PROG (IN!:SEXPR LAP!:FN!:NAME LAP!:FN LOG!:FILE LOG!:CHAN LSP!:CHAN
+ LSP!:FILE!:ID LSP!:FILE)
+ (SETQ LSP!:FILE (FORM!-FILE FILE!:DSCR))
+ (SETQ LSP!:FILE!:ID F!:FILE!:ID)
+ (SETQ LSP!:CHAN (OPEN LSP!:FILE 'INPUT))
+ (SETQ LOG!:FILE (FORM!-FILE (CONS LSP!:FILE!:ID 'CPL)))
+ (SETQ LOG!:CHAN (OPEN LOG!:FILE 'OUTPUT))
+ (RDS LSP!:CHAN)
+ (WHILE
+ (AND (PAIRP
+ (SETQ IN!:SEXPR
+ (ERRORSET '(READ) G!:SHOW!:ERRORS G!:SHOW!:TRACE)))
+ (NOT (EQ !$EOF!$ (SETQ IN!:SEXPR (CAR IN!:SEXPR))))
+ (PAIRP (ERRORSET IN!:SEXPR G!:SHOW!:ERRORS G!:SHOW!:TRACE)))
+ (COND ((MEMQ (CAR IN!:SEXPR) '(DE DF CDE CDF))
+ (PROGN (SETQ LAP!:FN!:NAME (CADR IN!:SEXPR))
+ (WRS LOG!:CHAN)
+ (COMPILE (NCONS LAP!:FN!:NAME))
+ (WRS NIL)
+ (PRINA LAP!:FN!:NAME)))))
+ (SETQ COMPILED!:FNS NIL)
+ (RDS NIL)
+ (CLOSE LSP!:CHAN)
+ (CLOSE LOG!:CHAN)))
+
+(!*
+"GCMSG( X:boolean ):any EXPR
+ -----
+ Pre-defined in both SLISP and new IBM intpreter, so this cde shouln't
+ do anything. GCMSG turns the garbage collection msgs on or off.")
+
+(CDE GCMSG (!#X) NIL)
+
ADDED psl-1983/3-1/util/zmacro.build
Index: psl-1983/3-1/util/zmacro.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zmacro.build
@@ -0,0 +1,2 @@
+compiletime load(zboot,zbasic,zmacro);
+in "zmacro.lsp"$
ADDED psl-1983/3-1/util/zmacro.lsp
Index: psl-1983/3-1/util/zmacro.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zmacro.lsp
@@ -0,0 +1,654 @@
+(!*
+"ZMACRO contains two macro packages --
+ (1) YMACS -- basically useful macros and fexprs.
+ (2) YSAIMACS -- macros used to simulate many SAIL constructs. ")
+
+(!*
+" YMACS -- USEFUL MACROS AND FEXPRS (see also YSAIMAC)
+
+* ( X:any ): NIL MACRO
+** ( X:list ) MACRO
+NEQ ( X:any Y:any ):boolean MACRO
+NEQN ( X:any Y:any ):boolean MACRO
+NEQUAL ( X:any Y:any ):boolean MACRO
+MAKE ( variable template ) MACRO
+SETQQ ( variable value ) MACRO
+EXTEND ( function series ) MACRO
+DREVERSE( list ):list MACRO
+APPENDL ( lists ) MACRO
+NCONCL ( lists ) MACRO
+NCONC1 ( lst exp1 ... expn ): any MACRO
+SELECTQ ( exp cases last-resort ) MACRO
+WHILE ( test body ) MACRO
+REPEAT ( body test ) MACRO
+FOREACH ( var in/of lst do/collect exp ) MACRO
+SAY ( test expressions ) MACRO
+DIVERT ( channel expressions ) MACRO
+CAT ( list of any ):string MACRO
+CAT-ID ( list of any ):<uninterned id> MACRO
+TTY ( L:list ):NIL MACRO
+TTY-TX ( L:list ):NIL MACRO
+TTY-XT ( L:list ):NIL MACRO
+TTY-TT ( L:list ):NIL MACRO
+ERRSET ( expression label ) MACRO
+GRAB ( file ) MACRO
+GRABFNS ( ids file-dscr ) MACRO
+DUMP ( file-dscr ) MACRO
+DUMPFNS ( ids file-dscr ) MACRO
+
+used to expand macros:
+XP#SELECTQ (#L#) EXPR
+XP#WHILE (#BOOL #BODY) EXPR
+XP#FOREACH (#VAR #MOD #LST #ACTION #BODY) EXPR
+XP#SAY1 ( expression ) EXPR
+
+")
+
+(GLOBAL '(!#SELECTQ G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+
+(!* "In ZBOOT, not needed here."
+(CDM !* (!#X) NIL)
+)
+
+(!*
+"*( X:any ): NIL MACRO
+ ===> NIL
+ For comments--doesn't evaluate anything. Returns NIL.
+ Note: expressions starting with * which are read by the
+ lisp scanner must obey all the normal syntax rules.")
+
+(!*
+"**( X:list ) MACRO
+ ===> (PROGN <lists>)
+ For comments--all atoms are ignored, lists evaluated as in PROGN.")
+
+(CDM !*!* (!#X) (CONS 'PROGN (ABSTRACT (FUNCTION PAIRP) (CDR !#X))))
+
+(!*
+"NEQ( X:any Y:any ):boolean MACRO
+ ===> (NOT (EQ X Y)) ")
+
+(!*
+"Changed to CDM because NEQ in PSL means NOT EQUAL. We hope to change
+that situation, however.")
+
+(CDM NEQ (!#X) (LIST 'NOT (CONS 'EQ (CDR !#X))))
+
+(!*
+"NEQN( X:any Y:any ):boolean MACRO
+ ===> (NOT (EQN X Y)) ")
+
+(DM NEQN (!#X) (LIST 'NOT (CONS 'EQN (CDR !#X))))
+
+(!*
+"NEQUAL( X:any Y:any ):boolean MACRO
+ ===> (NOT (EQUAL X Y)) ")
+
+(DM NEQUAL (!#X) (LIST 'NOT (CONS 'EQUAL (CDR !#X))))
+
+(!*
+"MAKE( variable template ) MACRO
+ ===> (SETQ <var> <some form using var>)
+ To change the value of a variable depending upon template.
+ Uses similar format for template as editor MBD. There are 3 cases.
+
+ 1) template is numerical:
+ (MAKE VARIABLE 3)
+ = (SETQ VARIABLE (PLUS VARIABLE 3))
+
+ 2) Template is a series, whose first element is an atom:
+ (MAKE VARIABLE ASSOC ITEM)
+ = (SETQ VARIABLE (ASSOC ITEM VARIABLE))
+
+ 3) Otherwise, variable is substituted for occurrences of * in template.
+ (MAKE VARIABLE (ASSOC (CADR *) (CDDR *))
+ = (SETQ VARIABLE (ASSOC (CADR VARIABLE) (CDDR VARIABLE))")
+
+(CDM MAKE (!#X)
+ (PROGN (SETQ !#X (CDR !#X))
+ (LIST 'SETQ
+ (CAR !#X)
+ (COND ((NUMBERP (CADR !#X)) (CONS 'PLUS !#X))
+ ((ATOM (CADR !#X)) (APPEND (CDR !#X) (LIST (CAR !#X))))
+ (T (SUBST (CAR !#X) '!* (CADR !#X)))))))
+
+(!*
+"SETQQ( variable value ) MACRO
+ ===> (SETQ VARIABLE 'VALUE) ")
+
+(CDM SETQQ (!#X) (LIST 'SETQ (CADR !#X) (MKQUOTE (CADDR !#X))))
+
+(!*
+"EXTEND( function series ) MACRO
+ ===> (FN ELT1 (FN ELT2 ... (FN ELTn-1 ELTn)))
+ Applies 2-place function to series, similarly to PLUS.
+ E.g.: (EXTEND SETQ A B C D 5) = (SETQ A (SETQ B (SETQ C (SETQ D 5))))")
+
+(CDM EXTEND (!#X) (EXPAND (CDDR !#X) (CADR !#X)))
+
+(!*
+"DREVERSE( L: list ):list MACRO
+ ===> (REVERSIP L)
+ Synonym for REVERSIP.")
+
+(DM DREVERSE (!#X) (CONS 'REVERSIP (CDR !#X)))
+
+(!*
+"APPENDL( lists ) MACRO
+ ===> (APPEND LIST1 (APPEND LIST2 ....))
+ EXPAND's APPEND to a list of arguments instead of just 2.")
+
+(CDM APPENDL (!#X) (EXPAND (CDR !#X) 'APPEND))
+
+(!*
+"NCONCL( lists ) MACRO
+ ===> (NCONC LST1 (NCONC LST2 ....))
+ EXPAND's NCONC to a list of arguments instead of just 2.")
+
+(CDM NCONCL (!#X) (EXPAND (CDR !#X) 'NCONC))
+
+(!*
+"NCONC1( lst exp1 ... expn ): any MACRO
+ ===> (NCONC LST (LIST EXP1 ... EXPn))
+ Destructively add exp1 ... exp-n to the end of lst.")
+
+(CDM NCONC1 (!#X)
+ (LIST 'NCONC (CADR !#X) (CONS 'LIST (CDDR !#X))))
+
+(!*
+"SELECTQ( exp cases last-resort ) MACRO
+ ===> (COND ...)
+ Exp is a lisp expression to be evaluated.
+ Each case-i is of the form (key-i exp1 exp2...expm).
+ Last-resort is a lisp expression to be evaluated.
+
+ Generates a COND statement:
+ If key-i is an atom, case-i becomes the cond-pair:
+ ((EQUAL exp key-i) (PROGN exp1 exp2 ... expm))
+ If key-i is a list, case-i becomes the cond-pair:
+ ((MEMBER exp key-i) (PROGN exp1 exp2 ... expm))
+ Last-resort becomes the final cond-pair:
+ (T last-resort)
+
+ If exp is non-atomic, it should not be re-evaluated in each clause,
+ so a dummy variable (#SELECTQ) is set to the value of exp in the
+ first test and that dummy variable is used in all successive tests.
+
+ Note:
+ (1) A FEXPR version of SELECTQ would forbid use of RETURN and GO.
+ (2) The form created must NOT have a prog or lambda wrapped around
+ the cond expression, as this would also forbid RETURN and GO.
+ Since #SELECTQ can't be lambda-bound by any means whatsoever
+ and remain consistent with the standard-lisp report (if GO or
+ RETURN appears inside a consequent), there is no way we can make
+ SELECTQ re-entrant. If you go into a break with ^B or ^H and
+ execute another SELECTQ you will clobber the one and only
+ incarnation of #SELECTQ, and if it happened to be in the middle
+ of deciding which consequent to execute, then when you continue
+ the computation it won't work correctly.
+ Update -- IMSSS break pkg now tries to protect #SELECTQ.
+ Update -- uses XP#SELECTQ which can be compiled to speed up
+ macro expansion.
+ ")
+
+(CDM SELECTQ (!#SLQ) (XP!#SELECTQ (CDR !#SLQ)))
+
+(DE XP!#SELECTQ (!#L!#)
+ (PROG (!#FIRSTCL !#RESTCL !#RSLT)
+ (SETQ !#RSLT (NCONS 'COND))
+ (COND ((ATOM (CAR !#L!#)) (SETQ !#FIRSTCL (SETQ !#RESTCL (CAR !#L!#))))
+ ((EQ (CAAR !#L!#) 'SETQ)
+ (PROGN (SETQ !#FIRSTCL (CAR !#L!#))
+ (SETQ !#RESTCL (CADAR !#L!#))))
+ (T (SETQ !#FIRSTCL
+ (LIST 'SETQ (SETQ !#RESTCL '!#SELECTQ) (CAR !#L!#)))))
+ LP (COND ((CDR (SETQ !#L!# (CDR !#L!#)))
+ (PROGN
+ (NCONC !#RSLT
+ (NCONS
+ (CONS (LIST (COND ((ATOM (CAAR !#L!#)) 'EQUAL)
+ (T 'MEMBER))
+ !#FIRSTCL
+ (LIST 'QUOTE (CAAR !#L!#)))
+ (COND ((NULL (CDDAR !#L!#)) (CDAR !#L!#))
+ (T (NCONS (CONS 'PROGN (CDAR !#L!#))))))))
+ (SETQ !#FIRSTCL !#RESTCL)
+ (GO LP))))
+ (NCONC !#RSLT (NCONS (CONS T !#L!#)))
+ (RETURN !#RSLT)))
+
+(!*
+"WHILE( test body ) MACRO
+ ===> (PROG ...) <while loop>
+ While test is true do body.")
+
+(!*
+(CDM WHILE (!#X) (XP!#WHILE (CADR !#X) (CDDR !#X)))
+
+(DE XP!#WHILE (!#BOOL !#BODY)
+ (PROG (!#LAB)
+ (SETQ !#LAB (GENSYM))
+ (RETURN
+ (NCONC
+ (LIST 'PROG
+ NIL
+ !#LAB
+ (LIST 'COND (LIST (LIST 'NOT !#BOOL) (LIST 'RETURN NIL))))
+ (APPEND !#BODY (LIST (LIST 'GO !#LAB)))))))
+)
+
+(!*
+(!*
+"REPEAT( body test ) MACRO
+ ===> (PROG ...) <repeat loop>
+ Repeat body until test is true.
+ Jim found that this fn as we had it was causing compiler errors.
+ The BODY was (CDDR U) and the BOOL was (CADR U). Question:
+ Does the fact that Utah was unable to reproduce our compiler
+ errors lie in this fact. Does function until test becomes non-NIL.")
+
+(CDM REPEAT (!#X) (XP!#REPEAT (CADR !#X) (CADDR !#X)))
+
+(DE XP!#REPEAT (!#BODY !#BOOL)
+ (PROG (!#LAB)
+ (SETQ !#LAB (GENSYM))
+ (RETURN
+ (LIST 'PROG
+ NIL
+ !#LAB
+ !#BODY
+ (LIST 'COND (LIST (LIST 'NOT !#BOOL) (LIST 'GO !#LAB)))))))
+)
+
+(!*
+(!*
+"FOREACH( var in/of lst do/collect exp ) MACRO
+ ===> (MAPxx LST (FUNCTION (LAMBDA (VAR) EXP)))
+ Undocumented FOREACH supplied by Utah. Required by compiler.
+ Update: modified to call xp#foreach which can be compiled
+ to speed up macro expansion.")
+
+(CDM FOREACH (!#X)
+ (XP!#FOREACH (CADR !#X)
+ (CADDR !#X)
+ (CAR (SETQ !#X (CDDDR !#X)))
+ (CADR !#X)
+ (CADDR !#X)))
+
+(DE XP!#FOREACH (!#VAR !#MOD !#LST !#ACTION !#BODY)
+ (PROG (!#FN)
+ (SETQ !#FN
+ (COND ((EQ !#ACTION 'DO) (COND ((EQ !#MOD 'IN) 'MAPC) (T 'MAP)))
+ ((EQ !#MOD 'IN) 'MAPCAR)
+ (T 'MAPLIST)))
+ (RETURN
+ (LIST !#FN !#LST (LIST 'FUNCTION (LIST 'LAMBDA (LIST !#VAR) !#BODY))))))
+)
+
+(!*
+"SAY( test expressions ) MACRO
+ ===> (COND (<test> (PROGN (PRIN2 ...) (PRIN2 ...) ...)))
+ If test is true then evaluate and prin2 all expressions.
+ Exceptions: the value of printing functions, those flaged with
+ SAY:PRINT (including: PRINT PRIN1 PRIN2 PRINC TYO PPRINT TERPRI
+ POSN DOHOME DORIGH DOLEFT DOUP DODOWN DPYNCH DPYCHR SETCUR MOVECUR)
+ are just evaluated. E.g.: (In the example @ is used for quotes)
+ (SAY T @this @ (PRIN1 '!!AND!!) @ that@)
+ appears as:
+ this !!AND!! that ")
+
+(DM SAY (!#X)
+ (LIST 'COND
+ (LIST (CADR !#X) (CONS 'PROGN (MAPCAR (CDDR !#X) (FUNCTION XP!#SAY1))))))
+
+(DE XP!#SAY1 (!#Y)
+ (COND ((AND (PAIRP !#Y) (EQ (CAR !#Y) 'PRINTER)) (CADR !#Y))
+ ((AND (PAIRP !#Y) (FLAGP (CAR !#Y) 'SAY!:PRINT)) !#Y)
+ (T (LIST 'Q!-PRIN2 !#Y))))
+
+(FLAG '(Q!-PRINT Q!-PRIN1 Q!-PRIN2 Q!-PRINC SETCUR Q!-TYO PPRINT POSN PPOS
+TTY) 'SAY!:PRINT)
+
+(!*
+"DIVERT( channel expressions ) MACRO
+ ===> (PROG (ochan) <select given chan> <eval exps> <select ochan>)
+ Yields PROG that selects channel for output,
+ evaluates each expression, and then reselects prior channel.")
+
+(CDM DIVERT (!#L)
+ (CONS 'PROG
+ (CONS (LIST 'OLD!#CHAN)
+ (CONS (LIST 'SETQ 'OLD!#CHAN (LIST 'WRS (CADR !#L)))
+ (APPEND (CDDR !#L) (LIST (LIST 'WRS 'OLD!#CHAN)))))))
+
+(!*
+"CAT( list of any ):string MACRO
+ ===> (CAT-DE (LIST <list>))
+ Evaluates all arguments given and forms a string from the
+ concatenation of their prin2 names.
+")
+
+(CDM CAT (!#X) (LIST 'CAT!-DE (CONS 'LIST (CDR !#X))))
+
+(!*
+"CAT-ID( list of any ):<uninterned id> MACRO
+ ===> (CAT-ID-DE (LIST <list>))
+ Evaluates all arguments given and forms an id from the
+ concatenation of their prin2 names. ")
+
+(CDM CAT!-ID (!#X) (LIST 'CAT!-ID!-DE (CONS 'LIST (CDR !#X))))
+
+(!*
+"TTY ( L:list ):NIL MACRO
+ TTY-TX( L:list ):NIL MACRO
+ TTY-XT( L:list ):NIL MACRO
+ TTY-TT( L:list ):NIL MACRO
+ ===> (TTY-xx-DE (LIST <list>))
+
+ TTY is selected for output, then each elt of list is evaluated and
+ PRIN2'ed, except for $EOL$'s, which cause a TERPRI.
+ Then prior output channel is reselected.
+ TTY-TX adds leading TERPRI. TTY-XT adds trailing TERPRI.
+ TTY-TT adds leading and trailing TERPRI's. ")
+
+(!*
+"CDMs were making all of the following unloadable into existing
+ QDRIVER.SAV core image. I flushed the 'C' July 27")
+
+(!*
+"TTY-DE now takes two extra arguments, for the number of TERPRIs
+ to preceed and follow the other printed material.")
+
+(DM TTY (!#X) (LIST 'TTY!-DE (CONS 'LIST (CDR !#X))))
+
+(DM TTY!-TX (!#X) (LIST 'TTY!-TX!-DE (CONS 'LIST (CDR !#X))))
+
+(DM TTY!-XT (!#X) (LIST 'TTY!-XT!-DE (CONS 'LIST (CDR !#X))))
+
+(DM TTY!-TT (!#X) (LIST 'TTY!-TT!-DE (CONS 'LIST (CDR !#X))))
+
+(!*
+"ERRSET (expression label) MACRO
+ ===> (ERRSET-DE 'exp 'label)
+ Named errset. If error matches label, then acts like errorset.
+ Otherwise propagates error upward.
+ Matching: Every label stops errors NIL, $EOF$.
+ Label 'ERRORX stops any error.
+ Other labels stop errors whose first arg is EQ to them.")
+
+(CDM ERRSET (!#X)
+ (LIST 'ERRSET!-DE (MKQUOTE (CADR !#X)) (MKQUOTE (CADDR !#X))))
+
+(!*
+"GRAB( <file description> ) MACRO
+ ===> (GRABBER NIL '<file-dscr>)
+ Reads in entire file, whose system name is created using
+ conventions described in FORM-FILE.")
+
+(DM GRAB (!#X) (LIST 'GRABBER NIL (MKQUOTE (CDR !#X))))
+
+(!*
+"GRABFNS( <ids> . <file description> ) MACRO
+ ===> (GRABBER FNS <file-dscr>)
+ Like grab, but only reads in specified fns/vars.")
+
+(DM GRABFNS (!#X) (LIST 'GRABBER (CADR !#X) (MKQUOTE (CDDR !#X))))
+
+(!*
+"DUMP( <file description> ) MACRO
+ ===> (DUMPER '<file-dscr>)
+ Dumps file onto disk. Filename as in GRAB. Prettyprints.")
+
+(DM DUMP (!#X) (LIST 'DUMPER (MKQUOTE (CDR !#X))))
+
+(!*
+"DUMPFNS( <ids> . <file dscr> ) MACRO
+ ===> (DUMPFNS-DE <fns> '<file-dscr>)
+ Like DUMP, but copies old file, inserting new defs for
+ specified fns/vars")
+
+(DM DUMPFNS (!#X) (LIST 'DUMPFNS!-DE (CADR !#X) (MKQUOTE (CDDR !#X))))
+
+(!*
+" We are currently defining these to be macros everywhere, but might
+ want them to be exprs while interpreted, in which case use the
+ following to get compile-time macros.")
+
+(!* PUT 'NEQ 'CMACRO '(LAMBDA (!#X !#Y) (NOT (EQ !#X !#Y))))
+
+(!* PUT 'NEQN 'CMACRO '(LAMBDA (!#X !#Y) (NOT (EQN !#X !#Y))))
+
+(!* PUT 'NEQUAL 'CMACRO '(LAMBDA (!#X !#Y) (NOT (EQUAL !#X !#Y))))
+
+(!*
+" YSAIMAC -- MACROS used to simulate SAIL constructs.
+
+macros:
+ DO-UNTIL SAI-IF SAI2-IF SAI-DONE SAI-CONTINUE SAI-WHILE SAI-FOREACH
+ SAI-FOR SAI-BEGIN PBEGIN PRETURN SAI-ASSIGN MSETQ SAI-COLLECT IFC
+ OUTSTR SAI-SAY SAI-& SAI-LENGTH CVSEST CVSEN CVS SUBSTRING-FOR
+ SUBSTRING-TO PUSHES PUSHVARS SLIST SAI-MAPC SAI-EQU
+
+auxiliary exprs used to expand macros:
+ XP#SAY-IF XP#SAI-WHILE XP#SAI-FOREACH XP#SAI-FOR XP#SUBSTRING-TO
+
+")
+
+(DM DO!-UNTIL (FORM)
+ (LIST 'PROG
+ NIL
+ 'L
+ (CADR FORM)
+ (LIST 'COND (LIST (CADDDR FORM) NIL) (LIST 1 '(GO L)))))
+
+(!*
+"SAI-IF ( sailish if-expression ) MACRO
+ (IF test1 THEN exp1 [ ELSEIF testi THEN expi ] [ELSE expn])
+ ===> (COND (test1 exp1) ... (testi expi) ... (T expn))
+
+ Embedded expressions do not cause embedded COND's, (unlike ALGOL!).
+ Examples:
+ (IF (ATOM Y) THEN (CAR X))
+ (IF (ATOM Y) THEN (CAR X) ELSE (CADR X))
+ (IF (ATOM Y) THEN (CAR X) ELSEIF (ATOM Z) THEN (CADR X)) ")
+
+(DM SAI!-IF (IF!#X) (XP!#SAI!-IF (CDR IF!#X)))
+
+(DM SAI2!-IF (IF!#X) (XP!#SAI!-IF (CDR IF!#X)))
+
+(DE XP!#SAI!-IF (IF!#X)
+ (PROG (!#ANTE !#CONSEQ !#TEMP !#ANS)
+ (SETQ !#ANS NIL)
+ (PROG NIL
+ WHTAG(COND (IF!#X
+ (PROGN (SETQ !#ANTE (CAR IF!#X))
+ (SETQ IF!#X (CDR IF!#X))
+ (COND ((EQ (SETQ !#TEMP (CAR IF!#X)) 'THEN)
+ (SETQ IF!#X (CDR IF!#X))))
+ (SETQ !#CONSEQ NIL)
+ (PROG NIL
+ WHTAG(COND (IF!#X
+ (PROGN (SETQ !#TEMP (CAR IF!#X))
+ (COND ((OR
+ (EQ !#TEMP 'ELSE)
+ (EQ !#TEMP 'ELSEIF)
+ (EQ !#TEMP 'EF))
+ (RETURN NIL)))
+ (SETQ !#CONSEQ
+ (CONS !#TEMP !#CONSEQ))
+ (SETQ IF!#X (CDR IF!#X))
+ (GO WHTAG)))))
+ (SETQ !#ANS
+ (CONS (CONS !#ANTE (REVERSE !#CONSEQ)) !#ANS))
+ (COND ((NOT IF!#X) (RETURN NIL)))
+ (SETQ !#TEMP (CAR IF!#X))
+ (SETQ IF!#X (CDR IF!#X))
+ (COND ((EQ !#TEMP 'ELSE)
+ (PROGN
+ (SETQ !#ANS (CONS (CONS 'T IF!#X) !#ANS))
+ (RETURN NIL))))
+ (!* " MUST BE ELSEIF")
+ (GO WHTAG)))))
+ (RETURN (CONS 'COND (REVERSE !#ANS)))))
+
+(DM SAI!-DONE (C!#X) '(RETURN NIL))
+
+(DM SAI!-CONTINUE (C!#X) '(GO CONTINUE!:))
+
+(!*
+"SAI-WHILE ( sailish while-expression ) MACRO
+ (WHILE b DO e1 e2 ... en) does e1,..., en as long as b is non-nil.
+ ===> (PROG NIL CONTINUE:
+ (COND ((NULL b) (RETURN NIL)))
+ e1 ... en
+ (GO CONTINUE:))
+ N.B. (WHILE b DO ... (RETURN e)) has the RETURN relative to the PROG
+ in the expansion. As in SAIL, (CONTINUE) and DONE work as statements.
+ (They are also macros.) ")
+
+(DM SAI!-WHILE (WH!#X) (XP!#SAI!-WHILE WH!#X))
+
+(DE XP!#SAI!-WHILE (WH!#X)
+ (APPENDL
+ (LIST 'PROG
+ NIL
+ 'CONTINUE!:
+ (LIST 'COND (LIST (LIST 'NOT (CADR WH!#X)) (LIST 'RETURN NIL))))
+ (SAI!-IF (EQ (CADDR WH!#X) 'DO) THEN (CDDDR WH!#X) ELSE (CDDR WH!#X))
+ '((GO CONTINUE!:))))
+
+(DM SAI!-FOREACH (FOREACH!#X) (XP!#SAI!-FOREACH FOREACH!#X))
+
+(DE XP!#SAI!-FOREACH (FORE!#X)
+ (APPENDL
+ (LIST 'PROG
+ '(FORE!#TEMP)
+ (LIST 'SETQ 'FORE!#TEMP (CADDDR FORE!#X))
+ 'CONTINUE!:
+ '(SAI!-IF (NULL FORE!#TEMP) THEN (RETURN NIL))
+ (LIST 'SETQ (CADR FORE!#X) '(CAR FORE!#TEMP))
+ '(SETQ FORE!#TEMP (CDR FORE!#TEMP)))
+ (CDR (CDDDDR FORE!#X))
+ '((GO CONTINUE!:))))
+
+(DM SAI!-FOR (FOR!#X) (XP!#SAI!-FOR FOR!#X))
+
+(DE XP!#SAI!-FOR (FOR!#X)
+ (CONS 'PROG
+ (CONS NIL
+ (CONS (LIST 'SETQ (CADR FOR!#X) (CADDDR FOR!#X))
+ (CONS 'FOR!#LOOP!:
+ (CONS (LIST 'SAI!-IF
+ (LIST (COND ((GREATERP
+ (EVAL
+ (CADR (CDDDDR FOR!#X)))
+ 0)
+ 'GREATERP)
+ (T 'LESSP))
+ (CADR FOR!#X)
+ (CADDDR (CDDDDR FOR!#X)))
+ 'THEN
+ '(RETURN NIL))
+ (APPEND (CDR (CDDDDR (CDDDDR FOR!#X)))
+ (LIST 'CONTINUE!:
+ (LIST 'SETQ
+ (CADR FOR!#X)
+ (LIST
+ 'PLUS
+ (CADR FOR!#X)
+ (CADR (CDDDDR FOR!#X))))
+ '(GO FOR!#LOOP!:)))))))))
+
+(DM SAI!-BEGIN (BEG!#X) (CONS 'DO (CDR BEG!#X)))
+
+(DM PBEGIN (PBEG!#X)
+ (LIST 'CATCH (KWOTE (CONS 'PROG (CDR PBEG!#X))) ''!$PLAB))
+
+(DM PRETURN (PRET!#X)
+ (LIST 'THROW (KWOTE (CADR PRET!#X)) (KWOTE '!$PLAB)))
+
+(DM SAI!-ASSIGN (!#X) (LIST 'SETQ (CADR !#X) (CADDR !#X)))
+
+(DM MSETQ (MSETQ!#X)
+ (CONS 'PROG
+ (CONS '(!#!#RESULT)
+ (CONS (LIST 'SETQ '!#!#RESULT (CADDR MSETQ!#X))
+ (MAPCAR (CADR MSETQ!#X)
+ (FUNCTION
+ (LAMBDA (X) (LIST 'SETQ X '(POP !#!#RESULT)))))))))
+
+(DM SAI!-COLLECT (X)
+ (LIST 'SETQ (CADDDR X) (LIST 'CONS (CADR X) (CADDDR X))))
+
+(DM IFC (X)
+ (COND ((EVAL (CADR X)) (CADDDR X))
+ ((EQ (CAR (CDDDDR X)) 'ELSEC) (CADR (CDDDDR X)))
+ (T NIL)))
+
+(DM OUTSTR (!#X) (CONS 'TTY (CDR !#X)))
+
+(!* DE TTYMSG (!#X)
+ (MAPC !#X
+ (FUNCTION
+ (LAMBDA (!#ELT)
+ (COND ((STRINGP !#ELT) (PRIN2 !#ELT))
+ ((EQ !#ELT 'T) (TERPRI))
+ (T (PRINT (EVAL !#ELT))))))))
+
+(DM SAI!-SAY (!#X) (CONS 'TTY (CDR !#X)))
+
+(DM SAI!-!& (!#X) (CONS 'CAT (CDR !#X)))
+
+(DM SAI!-LENGTH (!#X) (CONS 'FLATSIZE2 (CDR !#X)))
+
+(DM CVSEST (!#X) (CADR !#X))
+
+(DM CVSEN (!#X) (CADR !#X))
+
+(DM CVS (!#X) (CADR !#X))
+
+(DM SUBSTRING!-FOR (!#L)
+ (LIST 'SUBSTR (CADR !#L) (LIST 'SUB1 (CADDR !#L)) (CADDDR !#L)))
+
+(!*
+"REM is planning on cleaning this up so it works in all cases...
+ The form that (SUBSTRING-TO stringexpr low high) should expand into is
+ ((LAMBDA (#STRING) (SUBSTR #STRING low high)) stringexpr)
+ except that low and high have been modified to replace INF by
+ explicit calls to (FLATSIZE2 #STRING). Thus things like
+ (SUBSTRING-TO (READ) 2 (SUB1 INF))
+ should work without requiring the user to type the same string twice.
+ Probably that inner (SUBSTR ...) should simply be
+ ((LAMBDA (INF) (SUBSTR #STRING low high)) (FLATSIZE2 #STRING))
+ where we don't have to internally modify low or high at all!")
+
+(DM SUBSTRING!-TO (!#L) (XP!#SUBSTRING!-TO (CDR !#L)))
+
+(DE XP!#SUBSTRING!-TO (!#L)
+ (PROG (STREXP LOWEXP HIEXP IN!:LOW!:BOUND INNER!:INF!:BOUND
+ OUTER!:STRING!:BOUND OLDRES NEWRES)
+ (SETQ STREXP (CAR !#L))
+ (SETQ LOWEXP (CADR !#L))
+ (SETQ HIEXP (CADDR !#L))
+ (SETQ IN!:LOW!:BOUND
+ (LIST (LIST 'LAMBDA
+ '(!#LOW !#HIGH)
+ '(SUBSTR !#STRING !#LOW (DIFFERENCE !#HIGH !#LOW)))
+ (LIST 'SUB1 (LIST 'MAX 1 LOWEXP))
+ HIEXP))
+ (SETQ INNER!:INF!:BOUND
+ (LIST (LIST 'LAMBDA '(INF) IN!:LOW!:BOUND) '(FLATSIZE2 !#STRING)))
+ (SETQ OUTER!:STRING!:BOUND
+ (LIST (LIST 'LAMBDA '(!#STRING) INNER!:INF!:BOUND) STREXP))
+ (RETURN OUTER!:STRING!:BOUND)))
+
+(DM PUSHES (!#X) NIL)
+
+(DM PUSHVARS (!#X) NIL)
+
+(DM SLIST (!#X) (CONS 'LIST (CDR !#X)))
+
+(DM SAI!-MAPC (!#L) (LIST 'MAPC (CADDR !#L) (CADR !#L)))
+
+(DM SAI!-EQU (!#L) (CONS 'EQUAL (CDR !#L)))
+
ADDED psl-1983/3-1/util/zpedit.build
Index: psl-1983/3-1/util/zpedit.build
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zpedit.build
@@ -0,0 +1,2 @@
+CompileTime load(ZBoot, ZBasic, ZMacro);
+in "zpedit.lsp"$
ADDED psl-1983/3-1/util/zpedit.lsp
Index: psl-1983/3-1/util/zpedit.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zpedit.lsp
@@ -0,0 +1,1826 @@
+(!*
+"ZPEDIT contains two packages --
+ (1) YPP -- a derivative of the ILISP pretty-printer.
+ (2) YEDIT -- a derivative of the ILISP form-oriented editor. ")
+
+(!*
+" YPP -- THE PRETTYPRINTER
+
+PP( LST:list ) FEXPR
+PP1( X:any ) EXPR
+PP-VAL ( X:id ) EXPR
+PP-DEF ( X:id ) EXPR
+SPRINT( X:any COL:number ) EXPR
+and others...
+
+")
+
+(FLUID
+ '(PP!#PROPS PP!#FLAGS PRINTMACRO COMMENTCOL COMMENTFLG CONTOURFLG PPPRINT))
+
+(FLUID '(!#FILE))
+
+(SETQ PP!#PROPS '(READMACRO PRINTMACRO))
+
+(SETQ PP!#FLAGS '(FLUID GLOBAL))
+
+(SETQ COMMENTCOL 50)
+
+(SETQ COMMENTFLG NIL)
+
+(SETQ CONTOURFLG T)
+
+(!* "Tell the loader we need ZBasic and ZMacro.")
+
+(IMPORTS '(ZBOOT ZBASIC ZMACRO))
+
+(!* "Change the system prettyprint function to use this one.")
+
+(DE PRETTYPRINT (!#X) (PROGN (SPRINT !#X 1) (TERPRI)))
+
+(!* "Tell editor to use SPRINT for PP command.")
+
+(SETQ PPPRINT 'SPRINT)
+
+(PUT 'QUOTE 'PRINTMACRO '!#QUOTE)
+
+(PUT '!* 'PRINTMACRO '!#!*)
+
+(CDF PP (!#L) (PROGN (MAPC !#L (FUNCTION PP1)) (TERPRI) T))
+
+(DF PPL (!#L)
+ (PROG (!#FILE)
+ (SETQ !#L
+ (APPLY (FUNCTION APPEND) (MAPCAR !#L (FUNCTION ADD!#SELF!#REF))))
+ (!* "Print the readmacros at the front of the file in a PROGN")
+ (!* "#FILE becomes non-nil when printing to files")
+ (WRS (SETQ !#FILE (WRS NIL)))
+ (COND ((AND !#FILE (MEMQ 'READMACRO PP!#PROPS))
+ (PROGN (MAPC !#L (FUNCTION FPP!#READMACRO))
+ (!* "Trick: #FILE is now NIL if readmacros were printed")
+ (COND ((NULL !#FILE)
+ (PROGN (SPRINT ''READMACROS!-LOADED 1)
+ (PRIN2 ")")))))))
+ (MAPC !#L (FUNCTION PP1))))
+
+(!* "SETCHR is only meaningful in the dec slisp, where it is defined")
+
+(CDE SETCHR (CHR FLAGS) NIL)
+
+(DE FPP!#READMACRO (!#A)
+ (COND ((GET !#A 'READMACRO)
+ (PROGN (!* "Put the readmacros inside a PROGN")
+ (COND (!#FILE
+ (PROGN (TERPRI) (PRIN2 "(PROGN") (SETQ !#FILE NIL))))
+ (SPRINT (LIST 'SETCHR (LIST 'QUOTE !#A) (SETCHR !#A NIL))
+2)))))
+
+(DE PP1 (!#EXP)
+ (PROG NIL
+ (TERPRI)
+ (COND ((IDP !#EXP)
+ (PROG (!#PROPS !#FLAGS)
+ (SETQ !#PROPS PP!#PROPS)
+ LP1 (COND (!#PROPS
+ (PROGN (PP!-PROP !#EXP (CAR !#PROPS))
+ (SETQ !#PROPS (CDR !#PROPS))
+ (GO LP1))))
+ (SETQ !#FLAGS PP!#FLAGS)
+ LP2 (COND (!#FLAGS
+ (PROGN (PP!-FLAG !#EXP (CAR !#FLAGS))
+ (SETQ !#FLAGS (CDR !#FLAGS))
+ (GO LP2))))
+ (PP!-VAL !#EXP)
+ (PP!-DEF !#EXP)))
+ (T (PROGN (SPRINT !#EXP 1) (TERPRI))))))
+
+(DE PP!-VAL (!#ID)
+ (PROG (!#VAL)
+ (COND ((ATOM (SETQ !#VAL (ERRORSET !#ID NIL NIL))) (RETURN NIL)))
+ (TERPRI)
+ (PRIN2 "(SETQ ")
+ (PRIN1 !#ID)
+ (S2PRINT " '" (CAR !#VAL))
+ (PRIN2 ")")
+ (TERPRI)))
+
+(DE PP!-DEF (!#ID)
+ (PROG (!#DEF !#TYPE ORIG!#DEF)
+ (SETQ !#DEF (GETD !#ID))
+ TEST (COND ((NULL !#DEF)
+ (RETURN
+ (AND ORIG!#DEF
+ (WARNING
+ (LIST "Gack. " !#ID " has no unbroken definition.")))))
+ ((ATOM !#DEF)
+ (RETURN (WARNING (LIST "Bad definition for " !#ID " : " !#DEF))))
+ ((CODEP (CDR !#DEF))
+ (RETURN (WARNING (LIST "Can't PP compiled def for " !#ID))))
+ ((NOT (AND (CDR !#DEF)
+ (EQ (CADR !#DEF) 'LAMBDA)
+ (CDDR !#DEF)
+ (CDDDR !#DEF)
+ (NULL (CDDDDR !#DEF))))
+ (WARNING (LIST !#ID " has ill-formed definition.")))
+ ((AND (NOT ORIG!#DEF) (BROKEN !#ID))
+ (PROGN (WARNING (LIST "Note: " !#ID " is broken or traced."))
+ (SETQ ORIG!#DEF !#DEF)
+ (SETQ !#DEF (GET!#GOOD!#DEF !#ID))
+ (GO TEST))))
+ (SETQ !#TYPE (CAR !#DEF))
+ (TERPRI)
+ (COND ((EQ !#TYPE 'EXPR) (PRIN2 "(DE "))
+ ((EQ !#TYPE 'FEXPR) (PRIN2 "(DF "))
+ ((EQ !#TYPE 'MACRO) (PRIN2 "(DM "))
+ (T (RETURN (WARNING (LIST "Bad fntype for " !#ID " : " !#TYPE)))))
+ (PRIN1 !#ID)
+ (PRIN2 " ")
+ (PRIN1 (CADDR !#DEF))
+ (MAPC (CDDDR !#DEF) (FUNCTION (LAMBDA (!#X) (S2PRINT " " !#X))))
+ (PRIN2 ")")
+ (TERPRI)))
+
+(DE BROKEN (!#X) (GET !#X 'TRACE))
+
+(DE GET!#GOOD!#DEF (!#X)
+ (PROG (!#XX!#)
+ (COND ((AND (SETQ !#XX!# (GET !#X 'TRACE))
+ (IDP (SETQ !#XX!# (CDR !#XX!#))))
+ (RETURN (GETD !#XX!#))))))
+
+(DE PP!-PROP (!#ID !#PROP)
+ (PROG (!#VAL)
+ (COND ((NULL (SETQ !#VAL (GET !#ID !#PROP))) (RETURN NIL)))
+ (TERPRI)
+ (PRIN2 "(PUT '")
+ (PRIN1 !#ID)
+ (PRIN2 " '")
+ (PRIN1 !#PROP)
+ (S2PRINT " '" !#VAL)
+ (PRIN2 ")")
+ (TERPRI)))
+
+(DE PP!-FLAG (!#ID !#FLAG)
+ (PROG NIL
+ (COND ((NULL (FLAGP !#ID !#FLAG)) (RETURN NIL)))
+ (TERPRI)
+ (PRIN2 "(FLAG '(")
+ (PRIN1 !#ID)
+ (PRIN2 ") '")
+ (PRIN1 !#FLAG)
+ (PRIN2 ")")
+ (TERPRI)))
+
+(DE ADD!#SELF!#REF (!#ID)
+ (PROG (!#L)
+ (COND ((NOT (MEMQ !#ID (SETQ !#L (EVAL !#ID))))
+ (PROGN (RPLACD !#L (CONS (CAR !#L) (CDR !#L)))
+ (RPLACA !#L !#ID))))
+ (RETURN !#L)))
+
+(!* "S2PRINT: prin2 a string and then sprint an expression.")
+
+(DE S2PRINT (!#S !#EXP)
+ (PROGN
+ (OR (GREATERP (SPACES!#LEFT) (PLUS (FLATSIZE2 !#S) (FLATSIZE !#EXP)))
+ (TERPRI))
+ (PRIN2 !#S)
+ (SPRINT !#EXP (ADD1 (POSN)))))
+
+(DE SPRINT (!#EXP LEFT!#MARGIN)
+ (PROG (ORIGINAL!#SPACE NEW!#SPACE CAR!#EXP P!#MACRO CADR!#MARGIN ELT!#MARGIN
+ LBL!#MARGIN !#SIZE)
+ (COND ((ATOM !#EXP)
+ (PROGN (SAFE!#PPOS LEFT!#MARGIN (FLATSIZE !#EXP))
+ (RETURN (PRIN1 !#EXP)))))
+ (PPOS LEFT!#MARGIN)
+ (SETQ LEFT!#MARGIN (ADD1 LEFT!#MARGIN))
+ (SETQ ORIGINAL!#SPACE (SPACES!#LEFT))
+ (COND ((PAIRP (SETQ CAR!#EXP (CAR !#EXP)))
+ (PROGN (PRIN2 "(") (SPRINT CAR!#EXP LEFT!#MARGIN)))
+ ((AND (IDP CAR!#EXP) (SETQ P!#MACRO (GET CAR!#EXP 'PRINTMACRO)))
+ (COND ((STRINGP P!#MACRO)
+ (PROGN (SAFE!#PPOS (POSN1) (FLATSIZE2 P!#MACRO))
+ (PRIN2 P!#MACRO)
+ (RETURN
+ (AND (CDR !#EXP) (SPRINT (CADR !#EXP) (POSN1))))))
+ (T (PROGN (SETQ PRINTMACRO NIL)
+ (SETQ !#EXP (APPLY P!#MACRO (LIST !#EXP)))
+ (COND ((NULL PRINTMACRO) (RETURN NIL))
+ ((ATOM PRINTMACRO)
+ (PROGN (SETQ CAR!#EXP PRINTMACRO)
+ (PRIN2 "(")
+ (SPRINT (CAR !#EXP) LEFT!#MARGIN)))
+ (T (PROGN
+ (SETQ CADR!#MARGIN
+ (SETQ ELT!#MARGIN
+ (CDR PRINTMACRO)))
+ (SETQ LBL!#MARGIN
+ (COND ((EQ
+ (CAR PRINTMACRO)
+ 'PROG)
+ LEFT!#MARGIN)
+ (T CADR!#MARGIN)))
+ (GO B))))))))
+ (T (PROGN (PRIN2 "(")
+ (SAFE!#PPOS (POSN1) (FLATSIZE CAR!#EXP))
+ (PRIN1 CAR!#EXP))))
+ (COND ((ATOM (SETQ !#EXP (CDR !#EXP))) (GO C)))
+ (SETQ CADR!#MARGIN (POSN2))
+ (SETQ NEW!#SPACE (SPACES!#LEFT))
+ (SETQ !#SIZE (PPFLATSIZE CAR!#EXP))
+ (COND ((NOT (LESSP !#SIZE ORIGINAL!#SPACE))
+ (SETQ CADR!#MARGIN
+ (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN))))
+ ((EQ CAR!#EXP '!*)
+ (PROGN
+ (SETQ LEFT!#MARGIN (SETQ CADR!#MARGIN (PLUS LEFT!#MARGIN
+2))) (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN NIL))))
+ ((OR (LESSP (PPFLATSIZE !#EXP) NEW!#SPACE)
+ (PROG (!#E1)
+ (SETQ !#E1 !#EXP)
+ LP (COND ((PAIRP (CAR !#E1)) (RETURN NIL))
+ ((ATOM (SETQ !#E1 (CDR !#E1))) (RETURN T))
+ (T (GO LP)))))
+ (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN NIL)))
+ ((LESSP NEW!#SPACE 24)
+ (PROGN
+ (COND ((NOT (AND (MEMQ CAR!#EXP
+ '(SETQ LAMBDA PROG SELECTQ SET))
+ (LESSP (PPFLATSIZE (CAR !#EXP)) NEW!#SPACE)))
+ (SETQ CADR!#MARGIN LEFT!#MARGIN)))
+ (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN))))
+ ((EQ CAR!#EXP 'LAMBDA)
+ (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN)))
+ ((EQ CAR!#EXP 'PROG)
+ (PROGN (SETQ ELT!#MARGIN CADR!#MARGIN)
+ (SETQ LBL!#MARGIN LEFT!#MARGIN)))
+ ((OR (GREATERP !#SIZE 14)
+ (AND (GREATERP !#SIZE 4)
+ (NOT (LESSP (PPFLATSIZE (CAR !#EXP)) NEW!#SPACE))))
+ (SETQ CADR!#MARGIN
+ (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN LEFT!#MARGIN))))
+ (T (SETQ ELT!#MARGIN (SETQ LBL!#MARGIN CADR!#MARGIN))))
+ (COND ((ATOM (SETQ CAR!#EXP (CAR !#EXP)))
+ (PROGN (SAFE!#PPOS CADR!#MARGIN (PPFLATSIZE CAR!#EXP))
+ (PRIN1 CAR!#EXP)))
+ (T (SPRINT CAR!#EXP CADR!#MARGIN)))
+ A (COND ((ATOM (SETQ !#EXP (CDR !#EXP))) (GO C)))
+ B (SETQ CAR!#EXP (CAR !#EXP))
+ (COND ((ATOM CAR!#EXP)
+ (PROGN (SETQ !#SIZE (PPFLATSIZE CAR!#EXP))
+ (COND (LBL!#MARGIN (SAFE!#PPOS LBL!#MARGIN !#SIZE))
+ ((LESSP !#SIZE (SPACES!#LEFT)) (PRIN2 " "))
+ (T (SAFE!#PPOS LEFT!#MARGIN !#SIZE)))
+ (PRIN1 CAR!#EXP)))
+ (T (SPRINT CAR!#EXP (COND (ELT!#MARGIN ELT!#MARGIN) (T (POSN2)))))
+ )
+ (GO A)
+ C (COND (!#EXP
+ (PROGN (COND ((LESSP (SPACES!#LEFT) 3) (PPOS LEFT!#MARGIN)))
+ (PRIN2 " . ")
+ (SETQ !#SIZE (PPFLATSIZE !#EXP))
+ (COND ((GREATERP !#SIZE (SPACES!#LEFT))
+ (SAFE!#PPOS LEFT!#MARGIN !#SIZE)))
+ (PRIN1 !#EXP))))
+ (COND ((LESSP (SPACES!#LEFT) 1) (PPOS LEFT!#MARGIN)))
+ (PRIN2 ")")))
+
+(DE SPRIN1 (!#EXP !#C1 !#C2)
+ (PROG (!#ROOM)
+ (SETQ !#ROOM (DIFFERENCE (LINELENGTH NIL) !#C1))
+ (COND ((GREATERP (PLUS (FLATSIZE !#EXP) 3) !#ROOM)
+ (COND ((NULL (STRINGP !#EXP)) (SPRINT !#EXP !#C2))
+ ((FIRSTLINE!-FITS !#EXP !#ROOM)
+ (PROGN (PPOS !#C1) (PRIN1 !#EXP)))
+ (T (PROGN (TERPRI) (PRIN1 !#EXP)))))
+ (T (SPRINT !#EXP !#C1)))))
+
+(DE SPRINL (!#EXP !#C1 !#C2)
+ (PROG (!#SIZE)
+ (COND ((ATOM !#EXP) (RETURN (SPRIN1 !#EXP !#C1 !#C2)))
+ (T (PROGN (PPOS !#C1) (PRIN2 "("))))
+ A (SPRIN1 (CAR !#EXP) (ADD1 !#C1) !#C2)
+ (COND ((NULL (SETQ !#EXP (CDR !#EXP)))
+ (PROGN (COND ((LESSP (SPACES!#LEFT) 1) (PPOS !#C2)))
+ (RETURN (PRIN2 ")"))))
+ ((ATOM !#EXP)
+ (PROGN (COND ((LESSP (SPACES!#LEFT) 3) (PPOS !#C1)))
+ (PRIN2 " . ")
+ (SETQ !#SIZE (ADD1 (PPFLATSIZE !#EXP)))
+ (COND ((GREATERP !#SIZE (SPACES!#LEFT))
+ (SAFE!#PPOS !#C1 !#SIZE)))
+ (PRIN1 !#EXP)
+ (PRIN2 ")")))
+ (T (PROGN (SETQ !#C1 (POSN1)) (GO A))))))
+
+(DE !#QUOTE (!#L)
+ (!#QUOTES !#L "'"))
+
+(DE !#QUOTES (!#L !#CH)
+ (PROG (!#N)
+ (COND ((ATOM (CDR !#L))
+ (PROGN (SETQ !#N (POSN1)) (SPRINL !#L !#N (PLUS !#N 3))))
+ (T (PROGN (PRIN2 !#CH)
+ (SETQ !#N (POSN1))
+ (SPRIN1 (CADR !#L) !#N !#N))))))
+
+(!* "Addition for PSL, backquote and friends.")
+
+(PUT 'BACKQUOTE 'PRINTMACRO '!#BACKQUOTE)
+
+(DE !#BACKQUOTE (!#L)
+ (!#QUOTES !#L "`"))
+
+(PUT 'UNQUOTE 'PRINTMACRO '!#UNQUOTE)
+
+(DE !#UNQUOTE (!#L)
+ (!#QUOTES !#L ","))
+
+(PUT 'UNQUOTEL 'PRINTMACRO '!#UNQUOTEL)
+
+(DE !#UNQUOTEL (!#L)
+ (!#QUOTES !#L ",@"))
+
+(PUT 'UNQUOTED 'PRINTMACRO '!#UNQUOTED)
+
+(DE !#UNQUOTED (!#L)
+ (!#QUOTES !#L ",."))
+
+(DE !#!* (!#L)
+ (PROG (!#F !#N)
+ (COND ((ATOM (CDR !#L))
+ (RETURN (SPRINL !#L (SETQ !#N (POSN1)) (PLUS !#N 3)))))
+ (!* COND ((EQ (CADR !#L) 'E) (EVAL (CADDR !#L))))
+ (WRS (SETQ !#F (WRS NIL)))
+ (COND ((OR !#F COMMENTFLG)
+ (SPRINL !#L
+ (COND (CONTOURFLG (POSN1)) (T COMMENTCOL))
+ (PLUS (COND (CONTOURFLG (POSN1)) (T COMMENTCOL))
+3))) (T (PRIN2 "(* ...)")))))
+
+(!* DE SPRINL (!#EXP !#C1 !#C2)
+ (PROG NIL
+ (COND ((ATOM !#EXP) (RETURN (SPRIN1 !#EXP !#C1 !#C2)))
+ (T (PROGN (PPOS !#C1) (PRIN2 "("))))
+ A (SPRIN1 (CAR !#EXP) (ADD1 !#C1) !#C2)
+ (COND ((NULL (SETQ !#EXP (CDR !#EXP)))
+ (PROGN (COND ((LESSP (SPACES!#LEFT) 1) (PPOS !#C2)))
+ (RETURN (PRIN2 ")"))))
+ (T (PROGN (SETQ !#C1 (POSN1)) (GO A))))))
+
+(!* DE !#QUOTE (!#L)
+ (PROG (!#N)
+ (COND ((NUMBERP (CADR !#L))
+ (SPRINL !#L (SETQ !#N (POSN1)) (PLUS !#N 3)))
+ (T (PROGN (PRIN2 "'")
+ (SETQ !#N (POSN1))
+ (SPRIN1 (CADR !#L) !#N !#N))))))
+
+(!* DE !#!* (!#L)
+ (PROG (!#F)
+ (COND ((EQ (CADR !#L) 'E) (EVAL (CADDR !#L))))
+ (WRS (SETQ !#F (WRS NIL)))
+ (COND ((OR !#F COMMENTFLG)
+ (SPRINL !#L
+ (COND (CONTOURFLG (POSN1)) (T COMMENTCOL))
+ (PLUS (COND (CONTOURFLG (POSN1)) (T COMMENTCOL))
+3))) (T (PRIN2 "(* ...)")))))
+
+(DE PRINCOMMA (!#LIST FIRST!#COL)
+ (COND (!#LIST
+ (PROGN (PRIN2 (CAR !#LIST))
+ (MAPC (CDR !#LIST)
+ (FUNCTION
+ (LAMBDA (ELT)
+ (PROGN (PRIN2 ", ")
+ (COND ((LESSP (SPACES!#LEFT)
+ (PLUS 2 (FLATSIZE2 ELT)))
+ (PROGN (TERPRI) (PPOS FIRST!#COL))))
+ (PRIN2 ELT)))))
+ (PRIN2 ".")))))
+
+(CDE CHRCT NIL (DIFFERENCE (MIN 80 (LINELENGTH NIL)) (POSN)))
+
+(DE SPACES!#LEFT NIL (SUB1 (CHRCT)))
+
+(DE SAFE!#PPOS (!#N !#SIZE)
+ (PROG (MIN!#N)
+ (SETQ MIN!#N (SUB1 (DIFFERENCE (LINELENGTH NIL) !#SIZE)))
+ (COND ((LESSP MIN!#N !#N)
+ (PROGN (OR (GREATERP MIN!#N (POSN1)) (TERPRI)) (PPOS MIN!#N)))
+ (T (PPOS !#N)))))
+
+(DE PPFLATSIZE (!#EXP) (DIFFERENCE (FLATSIZE !#EXP) (PP!#SAVINGS !#EXP)))
+
+(DE PP!#SAVINGS (Y)
+ (PROG (N)
+ (COND ((ATOM Y) (RETURN 0))
+ ((AND (EQ (CAR Y) 'QUOTE) (CDR Y) (NOT (NUMBERP (CADR Y))))
+ (RETURN (PLUS 7 (PP!#SAVINGS (CDR Y))))))
+ (SETQ N 0)
+ LP (COND ((ATOM Y) (RETURN N)))
+ (SETQ N (PLUS N (PP!#SAVINGS (CAR Y))))
+ (SETQ Y (CDR Y))
+ (GO LP)))
+
+(DE FIRSTLINE!-FITS (!#STR !#N)
+ (PROG (!#BIG)
+ (!* "This addition is an empirical hack")
+ (SETQ !#N (PLUS2 !#N 2))
+ (SETQ !#BIG (EXPLODE !#STR))
+ LP (COND ((EQ (CAR !#BIG) !$EOL!$) (RETURN T))
+ ((NULL (SETQ !#BIG (CDR !#BIG))) (RETURN T))
+ ((ZEROP (SETQ !#N (SUB1 !#N))) (RETURN NIL)))
+ (GO LP)))
+
+(DE POSN1 NIL (ADD1 (POSN)))
+
+(DE POSN2 NIL (PLUS 2 (POSN)))
+
+(DE PPOS (N)
+ (PROG NIL
+ (OR (GREATERP N (POSN)) (TERPRI))
+ (SETQ N (SUB1 N))
+ LOOP (COND ((LESSP (POSN) N) (PROGN (PRIN2 " ") (GO LOOP))))))
+
+(!* " YEDIT -- THE EDITOR "
+
+" Originally from ilisp editor -- see zedit.doc for evolution.
+
+EDITF (X) FEXPR
+EDITFNS (X) FEXPR
+EDITV (X) FEXPR
+EDITP (X) FEXPR
+EDITE (EXPR COMS ATM) EXPR
+
+")
+
+(!* "Due to deficiency in standard-lisp")
+
+(GLOBAL '(!#SELECTQ G!:SHOW!:ERRORS G!:SHOW!:TRACE))
+
+(!* "G!:EDIT!:ERRORS and G!:EDIT!:TRACE switch editor errorset args on/off")
+
+(GLOBAL '(G!:EDIT!:ERRORS G!:EDIT!:TRACE))
+
+(!* " Global to editor")
+
+(FLUID
+ '(F!:E!#LOOKDPTH F!:E!#TRACEFLG F!:E!#LAST!#ID F!:E!#MAXLEVEL F!:E!#UPFINDFLG
+ F!:E!#MAXLOOP F!:E!#EDITCOMSL F!:E!#USERMACROS F!:E!#MACROS F!:E!#OPS
+ F!:E!#MAX!#PLENGTH))
+
+(!* " Fluid in editor, but initialized to non-NIL at top level")
+
+(FLUID '(F!:E!#DEPTH))
+
+(!* " Fluid in editor ")
+
+(FLUID
+ '(F!:E!#LOCLST F!:E!#LOCLST!#0 F!:E!#MARKLST F!:E!#UNDOLST F!:E!#UNDOLST!#1
+ F!:E!#OLDPROMPT F!:E!#ID F!:E!#INBUF F!:E!#CMD F!:E!#UNFIND F!:E!#FINDFLAG
+ F!:E!#COM0 F!:E!#TOPFLG F!:E!#COPYFLG F!:E!#LASTP1 F!:E!#LASTP2 F!:E!#LCFLG
+ F!:E!#LASTAIL F!:E!#SN F!:E!#TOFLG F!:E!#1 F!:E!#2 F!:E!#3))
+
+(!*
+"EDITLINEREAD():list EXPR
+ ------------
+ Prints a supplementary prompt before the READ generated prompt.
+ Reads a line of input containing a series of LISP expressions.
+ But the several expressions on the line must be separated by
+ spaces or commas and terminated with a bare CR. ")
+
+(FLUID '(PROMPTSTRING!*))
+
+(DE EDITLINEREAD NIL
+ (PROG (!#NEXT !#RES PROMPTSTRING!*)
+ (!* "PromptString!* for PSL (EAB 2:08am Friday, 6 November 1981)")
+ (SETQ PROMPTSTRING!* "-E- ")
+ (!* (PRIN2 "-E-"))
+ (TERPRI)
+ LOOP (SETQ !#RES (NCONC !#RES (LIST (READ))))
+ (COND ((NOT (MEMQ (SETQ !#NEXT (READCH)) '(!, ! ))) (RETURN !#RES))
+ (T (GO LOOP)))))
+
+(DM EDIT!#!# (!#X) (LIST 'EDIT!#!#DE (MKQUOTE (CDR !#X))))
+
+(DE EDIT!#!#DE (!#COMS)
+ ((LAMBDA (F!:E!#LOCLST F!:E!#UNDOLST!#1) (EDITCOMS !#COMS)) F!:E!#LOCLST
+NIL))
+
+(DF EDITFNS (!#X)
+ (PROG (!#Y)
+ (SETQ !#Y (EVAL (CAR !#X)))
+ LP (COND ((NULL !#Y) (RETURN NIL)))
+ (ERRORSET (CONS 'EDITF (CONS (PRIN1 (CAR !#Y)) (CDR !#X)))
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE)
+ (SETQ !#Y (CDR !#Y))
+ (GO LP)))
+
+(DF EDITF (!#X)
+ (PROG (!#Y !#FN)
+ (COND ((NULL !#X)
+ (PROGN (PRIN2 " = ") (SETQ !#X (LIST (PRIN1 F!:E!#LAST!#ID))))))
+ (COND ((IDP (CAR !#X))
+ (PROGN
+ (COND ((SETQ !#Y (GET (SETQ !#FN (CAR !#X)) 'TRACE))
+ (SETQ !#FN (CDR !#Y))))
+ (COND ((SETQ !#Y (GETD !#FN))
+ (PROGN (RPLACD !#Y
+ (EDITE (CDR !#Y) (CDR !#X) (CAR !#X)))
+ (RETURN (SETQ F!:E!#LAST!#ID (CAR !#X)))))
+ ((AND (SETQ !#Y (GET !#FN 'VALUE)) (PAIRP (CDR !#Y)))
+ (GO L1)))))
+ ((PAIRP (CAR !#X)) (GO L1)))
+ (PRIN1 (CAR !#X))
+ (PRIN2 " not editable.")
+ (ERROR NIL NIL)
+ L1 (PRINT2 "=EDITV")
+ (RETURN (EVAL (CONS 'EDITV !#X)))))
+
+(DF EDITV (!#X)
+ (PROG (!#Y)
+ (COND ((NULL !#X)
+ (PROGN (PRIN2 " = ") (SETQ !#X (LIST (PRIN1 F!:E!#LAST!#ID))))))
+ (COND ((PAIRP (CAR !#X))
+ (PROGN (EDITE (EVAL (CAR !#X)) (CDR !#X) NIL) (RETURN T)))
+ ((AND (IDP (CAR !#X))
+ (PAIRP (ERRORSET (CAR !#X) G!:EDIT!:ERRORS G!:EDIT!:TRACE)))
+ (PROGN
+ (SET (CAR !#X) (EDITE (EVAL (CAR !#X)) (CDR !#X) (CAR !#X)))
+ (RETURN (SETQ F!:E!#LAST!#ID (CAR !#X)))))
+ (T (PROGN (TERPRI)
+ (PRIN1 (CAR !#X))
+ (PRIN2 " not editable")
+ (ERROR NIL NIL))))))
+
+(!* "For PSL, the BREAK function uses an EXPR, EDIT. I don't know how else
+to edit a form but to call the FEXPR EDITV.")
+
+(FLUID '(EDIT!:FORM))
+
+(DE EDIT (EDIT!:FORM)
+ (PROGN (EDITV EDIT!:FORM)
+ EDIT!:FORM))
+
+(DF EDITP (!#X)
+ (PROGN
+ (COND ((NULL !#X)
+ (PROGN (PRIN2 " = ") (SETQ !#X (LIST (PRIN1 F!:E!#LAST!#ID))))))
+ (COND ((PAIRP (CAR !#X)) (PROGN (PRIN2 "=EDITV") (EVAL (CONS 'EDITV !#X))))
+ ((IDP (CAR !#X))
+ (PROGN (!* "For PSL, changed (CDAR !#X) to (PROP (CAR !#X))")
+ (EDITE (PROP (CAR !#X)) (CDR !#X) (CAR !#X))
+ (SETQ F!:E!#LAST!#ID (CAR !#X))))
+ (T (PROGN (TERPRI)
+ (PRIN1 (CAR !#X))
+ (PRIN2 " not editable.")
+ (ERROR NIL NIL))))))
+
+(DE EDITE (!#EXPR !#COMS !#ATM)
+ (COND ((NULL (PAIRP !#EXPR))
+ (PROGN (PRINT !#EXPR) (PRIN2 " not editable.") (ERROR NIL NIL)))
+ (T (CAR (LAST (EDITL (LIST !#EXPR) !#COMS !#ATM NIL NIL))))))
+
+(DE EDITL (F!:E!#LOCLST !#COMS !#ATM F!:E!#MARKLST !#MESS)
+ (PROG (F!:E!#CMD F!:E!#LASTAIL F!:E!#UNDOLST F!:E!#UNDOLST!#1 F!:E!#FINDFLAG
+ F!:E!#LCFLG F!:E!#UNFIND F!:E!#LASTP1 F!:E!#LASTP2 F!:E!#INBUF
+ F!:E!#LOCLST!#0 F!:E!#COM0 F!:E!#OLDPROMPT)
+ (SETQ F!:E!#LOCLST
+ (ERRORSET
+ (LIST 'EDITL0
+ (ADD1 F!:E!#DEPTH)
+ (MKQUOTE !#COMS)
+ (MKQUOTE !#MESS)
+ (MKQUOTE !#ATM))
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (COND ((PAIRP F!:E!#LOCLST) (RETURN (CAR F!:E!#LOCLST)))
+ (T (ERROR NIL NIL)))))
+
+(DE EDITL0 (F!:E!#DEPTH !#COMS !#MESS F!:E!#ID)
+ (PROG (!#RES)
+ (COND ((NULL !#COMS) NIL)
+ ((EQ (CAR !#COMS) 'START) (SETQ F!:E!#INBUF (CDR !#COMS)))
+ ((PAIRP
+ (ERRORSET (LIST 'EDIT1 (MKQUOTE !#COMS))
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (RETURN F!:E!#LOCLST))
+ (T (ERROR NIL NIL)))
+ (TERPRI)
+ (PRINT2 (OR !#MESS "EDIT"))
+ (COND ((OR (EQ (CAR F!:E!#LOCLST)
+ (CAR (LAST (CAR (COND ((SETQ F!:E!#CMD
+ (GET 'EDIT 'LASTVALUE))
+ F!:E!#CMD)
+ (T '((NIL))))))))
+ (AND F!:E!#ID
+ (EQ (CAR F!:E!#LOCLST)
+ (CAR (LAST (CAR (COND ((SETQ F!:E!#CMD
+ (GET
+ F!:E!#ID
+ 'EDIT!-SAVE))
+ F!:E!#CMD)
+ (T '((NIL))))))))))
+ (PROGN (SETQ F!:E!#LOCLST (CAR F!:E!#CMD))
+ (SETQ F!:E!#MARKLST (CADR F!:E!#CMD))
+ (SETQ F!:E!#UNDOLST (CADDR F!:E!#CMD))
+ (COND ((CAR F!:E!#UNDOLST)
+ (SETQ F!:E!#UNDOLST (CONS NIL F!:E!#UNDOLST))))
+ (SETQ F!:E!#UNFIND (CDDDR F!:E!#CMD)))))
+ LP (SETQ !#RES (ERRORSET '(EDITL1) G!:EDIT!:ERRORS G!:EDIT!:TRACE))
+ (COND ((EQ !#RES 'OK) (RETURN F!:E!#LOCLST))
+ ((EQ !#RES 'STOP) (ERROR 'STOP NIL))
+ (T (GO LP)))))
+
+(DE EDIT1 (!#COMS)
+ (PROG (!#X)
+ (SETQ !#X !#COMS)
+ L1 (COND ((NULL !#X) (RETURN NIL)))
+ (EDITCOM (SETQ F!:E!#CMD (CAR !#X)) NIL)
+ (SETQ !#X (CDR !#X))
+ (GO L1)))
+
+(DE EDITVAL (!#X)
+ (PROG (!#RES)
+ (SETQ !#RES (ERRORSET !#X G!:EDIT!:ERRORS G!:EDIT!:TRACE))
+ (AND !#RES (ATOM !#RES) (ERROR !#RES NIL))
+ (RETURN !#RES)))
+
+(DE EDITL1 NIL
+ (PROG (!#RES)
+ CT (SETQ F!:E!#FINDFLAG NIL)
+ (COND ((NULL F!:E!#OLDPROMPT)
+ (SETQ F!:E!#OLDPROMPT (CONS F!:E!#DEPTH '!#))))
+ A (SETQ F!:E!#UNDOLST!#1 NIL)
+ (SETQ F!:E!#CMD (EDITREAD))
+ (SETQ F!:E!#LOCLST!#0 F!:E!#LOCLST)
+ (SETQ F!:E!#COM0
+ (COND ((ATOM F!:E!#CMD) F!:E!#CMD) (T (CAR F!:E!#CMD))))
+ (SETQ !#RES
+ (ERRORSET (LIST 'EDITCOM (MKQUOTE F!:E!#CMD) T)
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (COND ((EQ !#RES 'OK) (ERROR 'OK NIL))
+ ((EQ !#RES 'STOP) (ERROR 'STOP NIL))
+ (F!:E!#UNDOLST!#1
+ (PROGN
+ (SETQ F!:E!#UNDOLST!#1
+ (CONS F!:E!#COM0 (CONS F!:E!#LOCLST!#0 F!:E!#UNDOLST!#1)))
+ (SETQ F!:E!#UNDOLST (CONS F!:E!#UNDOLST!#1 F!:E!#UNDOLST)))))
+ (COND ((PAIRP !#RES) (GO A)))
+ (SETQ F!:E!#INBUF NIL)
+ (TERPRI)
+ (COND (F!:E!#CMD (PROGN (PRIN1 F!:E!#CMD) (PRIN2 " ?"))))
+ (GO CT)))
+
+(DE EDITREAD NIL
+ (PROG (!#X)
+ (COND ((NULL F!:E!#INBUF)
+ (PROG NIL
+ LP (TERPRI)
+ (COND ((NOT (EQUAL (CAR F!:E!#OLDPROMPT) 0))
+ (PRIN2 (CAR F!:E!#OLDPROMPT))))
+ (SETQ F!:E!#INBUF
+ (ERRORSET '(EDITLINEREAD)
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (COND ((ATOM F!:E!#INBUF) (PROGN (TERPRI) (GO LP))))
+ (SETQ F!:E!#INBUF (CAR F!:E!#INBUF)))))
+ (SETQ !#X (CAR F!:E!#INBUF))
+ (SETQ F!:E!#INBUF (CDR F!:E!#INBUF))
+ (RETURN !#X)))
+
+(DE EDITCOM (!#CMD F!:E!#TOPFLG)
+ (PROGN (SETQ F!:E!#CMD !#CMD)
+ (COND (F!:E!#TRACEFLG (EDITRACEFN !#CMD)))
+ (COND (F!:E!#FINDFLAG
+ (COND ((EQ F!:E!#FINDFLAG 'BF)
+ (PROGN (SETQ F!:E!#FINDFLAG NIL) (EDITBF !#CMD NIL)))
+ (T (PROGN (SETQ F!:E!#FINDFLAG NIL) (EDITQF !#CMD)))))
+ ((NUMBERP !#CMD)
+ (SETQ F!:E!#LOCLST (EDIT1F !#CMD F!:E!#LOCLST)))
+ ((ATOM !#CMD) (EDITCOMA !#CMD (NULL F!:E!#TOPFLG)))
+ (T (EDITCOML !#CMD (NULL F!:E!#TOPFLG))))
+ (CAR F!:E!#LOCLST)))
+
+(DE EDITCOMA (!#CMD F!:E!#COPYFLG)
+ (PROG (!#TEM)
+ (SELECTQ !#CMD
+ (NIL NIL)
+ (OK (COND (F!:E!#ID (REMPROP F!:E!#ID 'EDIT!-SAVE)))
+ (PUT 'EDIT
+ 'LASTVALUE
+ (CONS (LAST F!:E!#LOCLST)
+ (CONS F!:E!#MARKLST
+ (CONS F!:E!#UNDOLST F!:E!#LOCLST))))
+ (ERROR 'OK NIL))
+ (STOP (ERROR 'STOP NIL))
+ (SAVE (COND (F!:E!#ID
+ (PUT 'EDIT
+ 'LASTVALUE
+ (PUT F!:E!#ID
+ 'EDIT!-SAVE
+ (CONS F!:E!#LOCLST
+ (CONS F!:E!#MARKLST
+ (CONS F!:E!#UNDOLST
+ F!:E!#UNFIND)))))))
+ (ERROR 'OK NIL))
+ (TTY!: (SETQ F!:E!#CMD F!:E!#COM0)
+ (SETQ F!:E!#LOCLST
+ (EDITL F!:E!#LOCLST NIL NIL NIL 'TTY!:)))
+ (E (COND (F!:E!#TOPFLG
+ (COND ((PAIRP (SETQ !#TEM (EDITVAL (EDITREAD))))
+ (EDIT!#PRINT (CAR !#TEM) F!:E!#LOOKDPTH NIL)))
+ )
+ (T (PROGN (EDITQF !#CMD) T))))
+ (P (EDITBPNT0 (CAR F!:E!#LOCLST) 2))
+ (!? (EDITBPNT0 (CAR F!:E!#LOCLST) 100))
+ (PP (EDITBPNT0 (CAR F!:E!#LOCLST) NIL))
+ (!^ (AND (CDR F!:E!#LOCLST) (SETQ F!:E!#UNFIND F!:E!#LOCLST))
+ (SETQ F!:E!#LOCLST (LAST F!:E!#LOCLST)))
+ (!@0 (COND ((NULL (CDR F!:E!#LOCLST)) (ERROR NIL NIL)))
+ (PROG NIL
+ LP (SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST))
+ (COND ((TAIL!-P (CAR F!:E!#LOCLST)
+ (CADR F!:E!#LOCLST))
+ (GO LP)))))
+ (MARK (SETQ F!:E!#MARKLST (CONS F!:E!#LOCLST F!:E!#MARKLST)))
+ (UNDO (EDITUNDO F!:E!#TOPFLG
+ NIL
+ (COND (F!:E!#INBUF (EDITREAD)))))
+ (TEST (SETQ F!:E!#UNDOLST (CONS NIL F!:E!#UNDOLST)))
+ (!@UNDO (EDITUNDO T T NIL))
+ (UNBLOCK
+ (COND ((SETQ !#TEM (MEMQ NIL F!:E!#UNDOLST))
+ (EDITSMASH !#TEM (LIST NIL) (CDR !#TEM)))
+ (T (PRINT2 " not blocked"))))
+ (!_ (COND (F!:E!#MARKLST
+ (PROGN
+ (AND (CDR F!:E!#LOCLST)
+ (SETQ F!:E!#UNFIND F!:E!#LOCLST))
+ (SETQ F!:E!#LOCLST (CAR F!:E!#MARKLST))))
+ (T (ERROR NIL NIL))))
+ (!\ (COND (F!:E!#UNFIND
+ (PROGN (SETQ !#CMD F!:E!#LOCLST)
+ (SETQ F!:E!#LOCLST F!:E!#UNFIND)
+ (AND (CDR !#CMD) (SETQ F!:E!#UNFIND !#CMD))))
+ (T (ERROR NIL NIL))))
+ (!\P (COND ((AND F!:E!#LASTP1
+ (NOT (EQ F!:E!#LASTP1 F!:E!#LOCLST)))
+ (SETQ F!:E!#LOCLST F!:E!#LASTP1))
+ ((AND F!:E!#LASTP2
+ (NOT (EQ F!:E!#LASTP2 F!:E!#LOCLST)))
+ (SETQ F!:E!#LOCLST F!:E!#LASTP2))
+ (T (ERROR NIL NIL))))
+ (!_!_ (COND (F!:E!#MARKLST
+ (AND (CDR F!:E!#LOCLST)
+ (SETQ F!:E!#UNFIND F!:E!#LOCLST)
+ (SETQ F!:E!#LOCLST (CAR F!:E!#MARKLST))
+ (SETQ F!:E!#MARKLST (CDR F!:E!#MARKLST))))
+ (T (ERROR NIL NIL))))
+ ((F BF)
+ (COND ((NULL F!:E!#TOPFLG)
+ (PROGN (SETQ F!:E!#FINDFLAG !#CMD) (RETURN NIL)))
+ (T (PROGN (SETQ !#TEM (EDITREAD))
+ (SELECTQ !#CMD
+ (F (EDITQF !#TEM))
+ (BF (EDITBF !#TEM NIL))
+ (ERROR NIL NIL))))))
+ (UP (EDITUP))
+ (DELETE (SETQ !#CMD '(DELETE)) (EDIT!: '!: NIL NIL))
+ (NX (EDIT!* 1))
+ (BK (EDIT!* -1))
+ (!@NX (SETQ F!:E!#LOCLST
+ ((LAMBDA (F!:E!#LOCLST)
+ (PROG (!#UF)
+ (SETQ !#UF F!:E!#LOCLST)
+ LP (COND ((OR (NULL (SETQ F!:E!#LOCLST
+ (CDR F!:E!#LOCLST)))
+ (NULL (CDR F!:E!#LOCLST)))
+ (ERROR NIL NIL))
+ ((OR (NULL (SETQ !#TEM
+ (MEMQ
+ (CAR F!:E!#LOCLST)
+ (CADR F!:E!#LOCLST))))
+ (NULL (CDR !#TEM)))
+ (GO LP)))
+ (EDITCOM 'NX NIL)
+ (SETQ F!:E!#UNFIND !#UF)
+ (RETURN F!:E!#LOCLST)))
+ F!:E!#LOCLST)))
+ (!?!? (EDITH F!:E!#UNDOLST))
+ (COND ((AND (NULL (SETQ !#TEM
+ (EDITMAC !#CMD F!:E!#MACROS NIL)))
+ (NULL (SETQ !#TEM
+ (EDITMAC !#CMD F!:E!#USERMACROS NIL))))
+ (RETURN (EDITDEFAULT !#CMD)))
+ (T (EDITCOMS (COPY (CDR !#TEM))))))))
+
+(DE EDITCOML (!#CMD F!:E!#COPYFLG)
+ (PROG (!#C2 !#C3 !#TEM)
+ LP (COND ((PAIRP (CDR !#CMD))
+ (PROGN (SETQ !#C2 (CADR !#CMD))
+ (COND ((PAIRP (CDDR !#CMD)) (SETQ !#C3 (CADDR !#CMD)))))))
+ (COND ((AND F!:E!#LCFLG
+ (SELECTQ !#C2
+ ((TO THRU THROUGH)
+ (COND ((NULL (CDDR !#CMD))
+ (PROGN (SETQ !#C3 -1) (SETQ !#C2 'THRU))))
+ T)
+ NIL))
+ (PROGN (EDITTO (CAR !#CMD) !#C3 !#C2) (RETURN NIL)))
+ ((NUMBERP (CAR !#CMD))
+ (PROGN (EDIT2F (CAR !#CMD) (CDR !#CMD)) (RETURN NIL)))
+ ((EQ !#C2 '!:!:)
+ (PROGN (EDITCONT (CAR !#CMD) (CDDR !#CMD)) (RETURN NIL))))
+ (SELECTQ (CAR !#CMD)
+ (S (SET !#C2
+ (COND ((NULL !#C2) (ERROR NIL NIL))
+ (T ((LAMBDA (F!:E!#LOCLST)
+ (EDITLOC (CDDR !#CMD)))
+ F!:E!#LOCLST)))))
+ (R (SETQ !#C2 (EDITNEWC2 (LIST (CAR F!:E!#LOCLST)) !#C2))
+ (EDITDSUBST !#C3 !#C2 (CAR F!:E!#LOCLST)))
+ (E (SETQ !#TEM (EVAL !#C2))
+ (COND ((NULL (CDDR !#CMD)) (PRINT !#TEM)))
+ (RETURN !#TEM))
+ (I (SETQ !#CMD
+ (CONS (COND ((ATOM !#C2) !#C2) (T (EVAL !#C2)))
+ (MAPCAR (CDDR !#CMD)
+ (FUNCTION
+ (LAMBDA (X)
+ (COND (F!:E!#TOPFLG (PRINT (EVAL X)))
+ (T (EVAL X))))))))
+ (SETQ F!:E!#COPYFLG NIL)
+ (GO LP))
+ (N (COND ((ATOM (CAR F!:E!#LOCLST)) (ERROR NIL NIL)))
+ (EDITNCONC (CAR F!:E!#LOCLST)
+ (COND (F!:E!#COPYFLG (COPY (CDR !#CMD)))
+ (T (APPEND (CDR !#CMD) NIL)))))
+ (P (COND ((NOT (EQ F!:E!#LASTP1 F!:E!#LOCLST))
+ (PROGN (SETQ F!:E!#LASTP2 F!:E!#LASTP1)
+ (SETQ F!:E!#LASTP1 F!:E!#LOCLST))))
+ (EDITBPNT (CDR !#CMD)))
+ (F (EDIT4F !#C2 !#C3))
+ (FS (PROG NIL
+ L1 (COND ((SETQ !#CMD (CDR !#CMD))
+ (PROGN (EDITQF (SETQ F!:E!#CMD (CAR !#CMD)))
+ (GO L1))))))
+ (F!= (EDIT4F (CONS '!=!= !#C2) !#C3))
+ (ORF (EDIT4F (CONS '!*ANY!* (CDR !#CMD)) 'N))
+ (BF (EDITBF !#C2 !#C3))
+ (NTH (COND ((NOT (EQ (SETQ !#TEM
+ (EDITNTH (CAR F!:E!#LOCLST) !#C2))
+ (CAR F!:E!#LOCLST)))
+ (SETQ F!:E!#LOCLST (CONS !#TEM F!:E!#LOCLST)))))
+ (IF (COND ((AND (PAIRP (SETQ !#TEM (EDITVAL !#C2)))
+ (CAR !#TEM))
+ (COND ((CDR !#CMD) (EDITCOMS !#C3))))
+ ((AND (CDDR !#CMD) (CDDDR !#CMD))
+ (EDITCOMS (CADDDR !#CMD)))
+ (T (ERROR NIL NIL))))
+ (BI (EDITBI !#C2
+ (COND ((CDDR !#CMD) !#C3) (T !#C2))
+ (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
+ (RI (EDITRI !#C2
+ !#C3
+ (AND (CDR !#CMD) (CDDR !#CMD) (CAR F!:E!#LOCLST))))
+ (RO (EDITRO !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
+ (LI (EDITLI !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
+ (LO (EDITLO !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
+ (BO (EDITBO !#C2 (AND (CDR !#CMD) (CAR F!:E!#LOCLST))))
+ (M (EDITM !#CMD !#C2))
+ (NX (EDIT!* !#C2))
+ (BK (EDIT!* (MINUS !#C2)))
+ (ORR (EDITOR (CDR !#CMD)))
+ (MBD (EDITMBD NIL (CDR !#CMD)))
+ (XTR (EDITXTR NIL (CDR !#CMD)))
+ ((THRU TO) (EDITTO NIL !#C2 (CAR !#CMD)))
+ ((A B !: AFTER BEFORE) (EDIT!: (CAR !#CMD) NIL (CDR !#CMD)))
+ (MV (EDITMV NIL (CADR !#CMD) (CDDR !#CMD)))
+ ((LP LPQ) (EDITRPT (CDR !#CMD) (EQ (CAR !#CMD) 'LPQ)))
+ (LC (EDITLOC (CDR !#CMD)))
+ (LCL (EDITLOCL (CDR !#CMD)))
+ (!_ (SETQ F!:E!#LOCLST (EDITNEWLOCLST F!:E!#LOCLST !#C2)))
+ (BELOW (EDITBELOW !#C2 (COND ((CDDR !#CMD) !#C3) (T 1))))
+ (SW (EDITSW (CADR !#CMD) (CADDR !#CMD)))
+ (BIND (PROG (F!:E!#1 F!:E!#2 F!:E!#3) (EDITCOMS (CDR !#CMD))))
+ (COMS (PROG NIL
+ L1 (COND ((SETQ !#CMD (CDR !#CMD))
+ (PROGN
+ (EDITCOM
+ (SETQ F!:E!#CMD (EVAL (CAR !#CMD)))
+ NIL)
+ (GO L1))))))
+ (COMSQ (EDITCOMS (CDR !#CMD)))
+ (COND ((AND (NULL (SETQ !#TEM
+ (EDITMAC (CAR !#CMD) F!:E!#MACROS T)))
+ (NULL (SETQ !#TEM
+ (EDITMAC (CAR !#CMD)
+ F!:E!#USERMACROS
+ T))))
+ (RETURN (EDITDEFAULT !#CMD)))
+ ((NOT (ATOM (SETQ !#C3 (CAR !#TEM))))
+ (EDITCOMS (SUBLIS (PAIR !#C3 (CDR !#CMD)) (CDR !#TEM))))
+ (T (EDITCOMS (SUBST (CDR !#CMD) !#C3 (CDR !#TEM))))))))
+
+(DE EDITNEWC2 (F!:E!#LOCLST !#C2)
+ (PROGN (EDIT4F !#C2 T)
+ (SETQ F!:E!#UNFIND F!:E!#LOCLST)
+ (COND ((AND (ATOM !#C2) F!:E!#UPFINDFLG (PAIRP (CAR F!:E!#LOCLST)))
+ (CAAR F!:E!#LOCLST))
+ (T (CAR F!:E!#LOCLST)))))
+
+(DE EDITM (!#CMD !#C2)
+ (PROG (!#NEWMACRO !#TEM)
+ (COND ((ATOM !#C2)
+ (COND ((SETQ !#TEM (EDITMAC !#C2 F!:E!#USERMACROS NIL))
+ (PROGN (RPLACD !#TEM (CDDR !#CMD)) (RETURN NIL)))
+ (T (SETQ !#NEWMACRO (CONS !#C2 (CONS NIL (CDDR !#CMD)))))))
+ ((SETQ !#TEM (EDITMAC (CAR !#C2) F!:E!#USERMACROS T))
+ (PROGN (RPLACA !#TEM (CADDR !#CMD))
+ (RPLACD !#TEM (CDDDR !#CMD))
+ (RETURN NIL)))
+ (T (PROGN (NCONC F!:E!#EDITCOMSL (LIST (CAR !#C2)))
+ (SETQ !#NEWMACRO (CONS (CAR !#C2) (CDDR !#CMD))))))
+ (SETQ F!:E!#USERMACROS (CONS !#NEWMACRO F!:E!#USERMACROS))))
+
+(DE EDITNEWLOCLST (F!:E!#LOCLST !#C2)
+ (PROG (!#UF !#TEM)
+ (SETQ !#UF F!:E!#LOCLST)
+ (SETQ !#C2 (EDITFPAT !#C2))
+ LP (COND ((COND ((AND (ATOM !#C2) (PAIRP (CAR F!:E!#LOCLST)))
+ (EQ !#C2 (CAAR F!:E!#LOCLST)))
+ ((EQ (CAR !#C2) 'IF)
+ (COND ((ATOM (SETQ !#TEM (EDITVAL (CADR !#C2)))) NIL)
+ (T !#TEM)))
+ (T (EDIT4E !#C2
+ (COND ((EQ (CAR !#C2) '!') (CAAR F!:E!#LOCLST))
+ (T (CAR F!:E!#LOCLST))))))
+ (PROGN (SETQ F!:E!#UNFIND !#UF) (RETURN F!:E!#LOCLST)))
+ ((SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST)) (GO LP)))
+ (ERROR NIL NIL)))
+
+(DE EDITMAC (!#C !#LST !#FLG)
+ (PROG (!#X !#Y)
+ LP (COND ((NULL !#LST) (RETURN NIL))
+ ((EQ !#C (CAR (SETQ !#X (CAR !#LST))))
+ (PROGN (SETQ !#Y (CDR !#X))
+ (COND ((COND (!#FLG (CAR !#Y)) (T (NULL (CAR !#Y))))
+ (RETURN !#Y))))))
+ (SETQ !#LST (CDR !#LST))
+ (GO LP)))
+
+(DE EDITCOMS (!#COMS)
+ (PROG NIL
+ L1 (COND ((ATOM !#COMS) (RETURN (CAR F!:E!#LOCLST))))
+ (EDITCOM (CAR !#COMS) NIL)
+ (SETQ !#COMS (CDR !#COMS))
+ (GO L1)))
+
+(DE EDITH (!#LST)
+ (PROG NIL
+ (TERPRI)
+ (MAPC !#LST
+ (FUNCTION
+ (LAMBDA (!#ELT)
+ (PROGN
+ (COND ((NULL !#ELT) (PRIN2 " block"))
+ ((NULL (CAR !#ELT)) NIL)
+ ((NUMBERP (CAR !#ELT)) (PRIN2 (LIST (CAR !#ELT) "--")))
+ (T (PRIN1 (CAR !#ELT))))
+ (PRIN2 " ")))))))
+
+(DE EDITUNDO (!#PRINTFLG !#UNDOFLG !#UNDOP)
+ (PROG (!#LST !#FLG)
+ (SETQ !#LST F!:E!#UNDOLST)
+ LP (COND ((OR (NULL !#LST) (NULL (CAR !#LST))) (GO OUT)))
+ (COND ((NULL !#UNDOP)
+ (SELECTQ (CAAR !#LST)
+ ((NIL !@UNDO UNBLOCK) (GO LP1))
+ (UNDO (COND ((NULL !#UNDOFLG) (GO LP1))))
+ NIL))
+ ((NOT (EQ !#UNDOP (CAAR !#LST))) (GO LP1)))
+ (EDITUNDOCOM (CAR !#LST) !#PRINTFLG)
+ (COND ((NULL !#UNDOFLG) (RETURN NIL)))
+ (SETQ !#FLG T)
+ LP1 (SETQ !#LST (CDR !#LST))
+ (GO LP)
+ OUT (COND (!#FLG NIL)
+ ((AND !#LST (CDR !#LST)) (PRINT2 " blocked"))
+ (T (PRINT2 " nothing saved")))))
+
+(DE EDITUNDOCOM (!#X !#FLG)
+ (PROG (!#C !#Y !#Z)
+ (COND ((ATOM !#X) (ERROR NIL NIL))
+ ((NOT (EQ (CAR (LAST F!:E!#LOCLST)) (CAR (LAST (CADR !#X)))))
+ (PROGN (PRINT2 " different expression")
+ (SETQ F!:E!#CMD NIL)
+ (ERROR NIL NIL))))
+ (SETQ !#C (CAR !#X))
+ (SETQ F!:E!#LOCLST (CADR !#X))
+ (SETQ !#Y (CDR !#X))
+ L1 (COND ((SETQ !#Y (CDR !#Y))
+ (PROGN (SETQ !#Z (CAR !#Y))
+ (COND ((EQ (CAR !#Z) 'R)
+ ((LAMBDA (F!:E!#LOCLST)
+ (EDITCOM (LIST 'R (CADR !#Z) (CADDR !#Z)) NIL))
+ (CADDDR !#Z)))
+ (T (EDITSMASH (CAR !#Z) (CADR !#Z) (CDDR !#Z))))
+ (GO L1))))
+ (EDITSMASH !#X NIL (CONS (CAR !#X) (CDR !#X)))
+ (COND (!#FLG
+ (PROGN
+ (COND ((NUMBERP !#C) (PRINT2 (LIST !#C "--"))) (T (PRIN1 !#C)))
+ (PRIN2 " undone"))))
+ (RETURN T)))
+
+(DE EDITSMASH (!#OLD !#A !#D)
+ (PROGN (COND ((ATOM !#OLD) (ERROR NIL NIL)))
+ (SETQ F!:E!#UNDOLST!#1
+ (CONS (CONS !#OLD (CONS (CAR !#OLD) (CDR !#OLD)))
+ F!:E!#UNDOLST!#1))
+ (RPLACA !#OLD !#A)
+ (RPLACD !#OLD !#D)))
+
+(DE EDITNCONC (!#X !#Y)
+ (PROG (!#TEM)
+ (RETURN
+ (COND ((NULL !#X) !#Y)
+ ((ATOM !#X) (ERROR NIL NIL))
+ (T (PROGN (EDITSMASH (SETQ !#TEM (LAST !#X)) (CAR !#TEM) !#Y)
+ !#X))))))
+
+(DE EDITDSUBST (!#X !#Y !#Z)
+ (PROG NIL
+ LP (COND ((NULL (PAIRP !#Z)) (RETURN NIL))
+ ((EQUAL !#Y (CAR !#Z)) (EDITSMASH !#Z (COPY !#X) (CDR !#Z)))
+ (T (EDITDSUBST !#X !#Y (CAR !#Z))))
+ (COND ((AND !#Y (EQ !#Y (CDR !#Z)))
+ (PROGN (EDITSMASH !#Z (CAR !#Z) (COPY !#X)) (RETURN NIL))))
+ (SETQ !#Z (CDR !#Z))
+ (GO LP)))
+
+(DE EDIT1F (!#C F!:E!#LOCLST)
+ (COND ((EQUAL !#C 0)
+ (COND ((NULL (CDR F!:E!#LOCLST)) (ERROR NIL NIL))
+ (T (CDR F!:E!#LOCLST))))
+ ((ATOM (CAR F!:E!#LOCLST)) (ERROR NIL NIL))
+ ((GREATERP !#C 0)
+ (COND ((GREATERP !#C (LENGTH (CAR F!:E!#LOCLST))) (ERROR NIL NIL))
+ (T (CONS (CAR (SETQ F!:E!#LASTAIL
+ (NTH!-TAIL (CAR F!:E!#LOCLST) !#C)))
+ F!:E!#LOCLST))))
+ ((GREATERP (MINUS !#C) (LENGTH (CAR F!:E!#LOCLST))) (ERROR NIL NIL))
+ (T (CONS (CAR (SETQ F!:E!#LASTAIL
+ (NTH!-TAIL (CAR F!:E!#LOCLST)
+ (PLUS (LENGTH (CAR F!:E!#LOCLST))
+ (PLUS !#C 1)))))
+ F!:E!#LOCLST))))
+
+(DE EDIT2F (!#N !#X)
+ (PROG (!#CL)
+ (SETQ !#CL (CAR F!:E!#LOCLST))
+ (COND ((ATOM !#CL) (ERROR NIL NIL))
+ (F!:E!#COPYFLG (SETQ !#X (COPY !#X)))
+ (T (SETQ !#X (APPEND !#X NIL))))
+ (COND ((GREATERP !#N 0)
+ (COND ((GREATERP !#N (LENGTH !#CL)) (ERROR NIL NIL))
+ ((NULL !#X) (GO DELETE))
+ (T (GO REPLACE))))
+ ((OR (EQUAL !#N 0)
+ (NULL !#X)
+ (GREATERP (MINUS !#N) (LENGTH !#CL)))
+ (ERROR NIL NIL))
+ (T (PROGN
+ (COND ((NOT (EQUAL !#N -1))
+ (SETQ !#CL (NTH!-TAIL !#CL (MINUS !#N)))))
+ (EDITSMASH !#CL (CAR !#X) (CONS (CAR !#CL) (CDR !#CL)))
+ (COND ((CDR !#X)
+ (EDITSMASH !#CL
+ (CAR !#CL)
+ (NCONC (CDR !#X) (CDR !#CL)))))
+ (RETURN NIL))))
+ DELETE
+ (COND ((EQUAL !#N 1)
+ (PROGN (OR (PAIRP (CDR !#CL)) (ERROR NIL NIL))
+ (EDITSMASH !#CL (CADR !#CL) (CDDR !#CL))))
+ (T (PROGN (SETQ !#CL (NTH!-TAIL !#CL (DIFFERENCE !#N 1)))
+ (EDITSMASH !#CL (CAR !#CL) (CDDR !#CL)))))
+ (RETURN NIL)
+ REPLACE
+ (COND ((NOT (EQUAL !#N 1)) (SETQ !#CL (NTH!-TAIL !#CL !#N))))
+ (EDITSMASH !#CL (CAR !#X) (CDR !#CL))
+ (COND ((CDR !#X)
+ (EDITSMASH !#CL (CAR !#CL) (NCONC (CDR !#X) (CDR !#CL)))))))
+
+(DE EDIT4E (!#PAT !#Y)
+ (COND ((EQ !#PAT !#Y) T)
+ ((ATOM !#PAT) (OR (EQ !#PAT '!&) (EQUAL !#PAT !#Y)))
+ ((EQ (CAR !#PAT) '!*ANY!*)
+ (PROG NIL
+ LP (COND ((NULL (SETQ !#PAT (CDR !#PAT))) (RETURN NIL))
+ ((EDIT4E (CAR !#PAT) !#Y) (RETURN T)))
+ (GO LP)))
+ ((AND (EQ (CAR !#PAT) '!') (ATOM !#Y))
+ (PROG (!#Z)
+ (SETQ !#PAT (CDR !#PAT))
+ (SETQ !#Z (EXPLODE2 !#Y))
+ LP (COND ((EQ (CAR !#PAT) '!')
+ (PROGN (FREELIST !#Z)
+ (PRINT2 "=")
+ (PRIN1 !#Y)
+ (RETURN T)))
+ ((NULL !#Z) (RETURN NIL))
+ ((NOT (EQ (CAR !#PAT) (CAR !#Z)))
+ (PROGN (FREELIST !#Z) (RETURN NIL))))
+ (SETQ !#PAT (CDR !#PAT))
+ (SETQ !#Z (CDR !#Z))
+ (GO LP)))
+ ((EQ (CAR !#PAT) '!-!-)
+ (OR (NULL (SETQ !#PAT (CDR !#PAT)))
+ (PROG NIL
+ LP (COND ((EDIT4E !#PAT !#Y) (RETURN T))
+ ((ATOM !#Y) (RETURN NIL)))
+ (SETQ !#Y (CDR !#Y))
+ (GO LP))))
+ ((EQ (CAR !#PAT) '!=!=) (EQ (CDR !#PAT) !#Y))
+ ((ATOM !#Y) NIL)
+ ((EDIT4E (CAR !#PAT) (CAR !#Y)) (EDIT4E (CDR !#PAT) (CDR !#Y)))))
+
+(DE EDITQF (!#PAT)
+ (PROG (!#Q1)
+ (COND ((AND (PAIRP (CAR F!:E!#LOCLST))
+ (PAIRP (SETQ !#Q1 (CDAR F!:E!#LOCLST)))
+ (SETQ !#Q1 (MEMQ !#PAT !#Q1)))
+ (SETQ F!:E!#LOCLST
+ (CONS (COND (F!:E!#UPFINDFLG !#Q1)
+ (T (PROGN (SETQ F!:E!#LASTAIL !#Q1)
+ (CAR !#Q1))))
+ F!:E!#LOCLST)))
+ (T (EDIT4F !#PAT 'N)))))
+
+(DE EDIT4F (!#PAT F!:E!#SN)
+ (PROG (!#LL !#X !#FF)
+ (SETQ !#FF (LIST NIL))
+ (SETQ F!:E!#CMD !#PAT)
+ (SETQ !#PAT (EDITFPAT !#PAT))
+ (SETQ !#LL F!:E!#LOCLST)
+ (COND ((EQ F!:E!#SN 'N)
+ (PROGN (SETQ F!:E!#SN 1)
+ (COND ((ATOM (CAR F!:E!#LOCLST)) (GO LP1))
+ ((AND (ATOM (CAAR F!:E!#LOCLST)) F!:E!#UPFINDFLG)
+ (PROGN
+ (SETQ !#LL
+ (CONS (CAAR F!:E!#LOCLST) F!:E!#LOCLST))
+ (GO LP1)))
+ (T (SETQ !#LL
+ (CONS (CAAR F!:E!#LOCLST) F!:E!#LOCLST)))))
+ ))
+ (COND ((AND F!:E!#SN (NOT (NUMBERP F!:E!#SN))) (SETQ F!:E!#SN 1)))
+ (COND ((AND (EDIT4E
+ (COND ((AND (PAIRP !#PAT) (EQ (CAR !#PAT) '!:!:!:))
+ (CDR !#PAT))
+ (T !#PAT))
+ (CAR !#LL))
+ (OR (NULL F!:E!#SN)
+ (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
+ (RETURN (SETQ F!:E!#LOCLST !#LL))))
+ (SETQ !#X (CAR !#LL))
+ LP (COND ((EDIT4F1 !#PAT !#X F!:E!#MAXLEVEL !#FF)
+ (PROGN (AND (CDR F!:E!#LOCLST) (SETQ F!:E!#UNFIND F!:E!#LOCLST))
+ (RETURN
+ (CAR (SETQ F!:E!#LOCLST
+ (NCONC (CAR !#FF)
+ (COND ((EQ (CADR !#FF) (CAR !#LL))
+ (CDR !#LL))
+ (T !#LL))))))))
+ ((NULL F!:E!#SN) (ERROR NIL NIL)))
+ LP1 (SETQ !#X (CAR !#LL))
+ (COND ((NULL (SETQ !#LL (CDR !#LL))) (ERROR NIL NIL))
+ ((AND (SETQ !#X (MEMQ !#X (CAR !#LL)))
+ (PAIRP (SETQ !#X (CDR !#X))))
+ (GO LP)))
+ (GO LP1)))
+
+(DE EDITFPAT (!#PAT)
+ (COND ((PAIRP !#PAT)
+ (COND ((OR (EQ (CAR !#PAT) '!=!=) (EQ (CAR !#PAT) '!')) !#PAT)
+ (T (MAPCAR !#PAT (FUNCTION EDITFPAT)))))
+ ((EQ (NTHCHAR !#PAT -1) '!') (CONS '!' (EXPLODE2 !#PAT)))
+ (T !#PAT)))
+
+(DE EDIT4F1 (!#PAT !#X !#LVL !#FF)
+ (PROG NIL
+ LP (COND ((NOT (GREATERP !#LVL 0))
+ (PROGN (PRINT2 " maxlevel exceeded") (RETURN NIL)))
+ ((ATOM !#X) (RETURN NIL))
+ ((AND (PAIRP !#PAT)
+ (EQ (CAR !#PAT) '!:!:!:)
+ (EDIT4E (CDR !#PAT) !#X)
+ (OR (NULL F!:E!#SN)
+ (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
+ T)
+ ((AND (OR (ATOM !#PAT) (NOT (EQ (CAR !#PAT) '!:!:!:)))
+ (EDIT4E !#PAT (CAR !#X))
+ (OR (NULL F!:E!#SN)
+ (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
+ (COND ((OR (NULL F!:E!#UPFINDFLG) (PAIRP (CAR !#X)))
+ (PROGN (SETQ F!:E!#LASTAIL !#X) (SETQ !#X (CAR !#X))))))
+ ((AND !#PAT
+ (EQ !#PAT (CDR !#X))
+ (OR (NULL F!:E!#SN)
+ (EQUAL (SETQ F!:E!#SN (DIFFERENCE F!:E!#SN 1)) 0)))
+ (SETQ !#X (CDR !#X)))
+ ((AND F!:E!#SN
+ (PAIRP (CAR !#X))
+ (EDIT4F1 !#PAT (CAR !#X) (DIFFERENCE !#LVL 1) !#FF)
+ (EQUAL F!:E!#SN 0))
+ (SETQ !#X (CAR !#X)))
+ (T (PROGN (SETQ !#X (CDR !#X))
+ (SETQ !#LVL (DIFFERENCE !#LVL 1))
+ (GO LP))))
+ (COND ((AND !#FF (NOT (EQ !#X (CADR !#FF)))) (TCONC !#FF !#X)))
+ (RETURN (OR !#FF T))))
+
+(DE EDITFINDP (!#X !#PAT !#FLG)
+ (PROG (F!:E!#SN F!:E!#LASTAIL !#FF)
+ (SETQ F!:E!#SN 1)
+ (AND (NULL !#FLG) (SETQ !#PAT (EDITFPAT !#PAT)))
+ (RETURN (OR (EDIT4E !#PAT !#X) (EDIT4F1 !#PAT !#X F!:E!#MAXLEVEL !#FF)))
+ ))
+
+(DE EDITBF (!#PAT !#N)
+ (PROG (!#LL !#X !#Y !#FF)
+ (SETQ !#LL F!:E!#LOCLST)
+ (SETQ !#FF (LIST NIL))
+ (SETQ F!:E!#CMD !#PAT)
+ (SETQ !#PAT (EDITFPAT !#PAT))
+ (COND ((AND (NULL !#N) (CDR !#LL)) (GO LP1)))
+ LP (COND ((EDITBF1 !#PAT (CAR !#LL) F!:E!#MAXLEVEL !#Y !#FF)
+ (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST)
+ (RETURN
+ (CAR (SETQ F!:E!#LOCLST
+ (NCONC (CAR !#FF)
+ (COND ((EQ (CAR !#LL) (CADR !#FF))
+ (CDR !#LL))
+ (T !#LL)))))))))
+ LP1 (SETQ !#X (CAR !#LL))
+ (COND ((NULL (SETQ !#LL (CDR !#LL))) (ERROR NIL NIL))
+ ((OR (SETQ !#Y (MEMQ !#X (CAR !#LL)))
+ (SETQ !#Y (TAIL!-P !#X (CAR !#LL))))
+ (GO LP)))
+ (GO LP1)))
+
+(DE EDITBF1 (!#PAT !#X !#LVL !#TAIL !#FF)
+ (PROG (!#Y)
+ LP (COND ((NOT (GREATERP !#LVL 0))
+ (PROGN (PRINT2 " maxlevel exceeded") (RETURN NIL)))
+ ((EQ !#TAIL !#X)
+ (RETURN
+ (COND ((EDIT4E
+ (COND ((AND (PAIRP !#PAT) (EQ (CAR !#PAT) '!:!:!:))
+ (CDR !#PAT))
+ (T !#PAT))
+ !#X)
+ (TCONC !#FF !#X))))))
+ (SETQ !#Y !#X)
+ LP1 (COND ((NULL (OR (EQ (CDR !#Y) !#TAIL) (ATOM (CDR !#Y))))
+ (PROGN (SETQ !#Y (CDR !#Y)) (GO LP1))))
+ (SETQ !#TAIL !#Y)
+ (COND ((AND (PAIRP (CAR !#TAIL))
+ (EDITBF1 !#PAT (CAR !#TAIL) (DIFFERENCE !#LVL 1) NIL))
+ (SETQ !#TAIL (CAR !#TAIL)))
+ ((AND (EQ (CAR !#PAT) '!:!:!:) (EDIT4E (CDR !#PAT) !#TAIL)) T)
+ ((AND (OR (ATOM !#PAT) (NOT (EQ (CAR !#PAT) '!:!:!:)))
+ (EDIT4E !#PAT (CAR !#TAIL)))
+ (COND ((OR (NULL F!:E!#UPFINDFLG) (PAIRP (CAR !#TAIL)))
+ (PROGN (SETQ F!:E!#LASTAIL !#TAIL)
+ (SETQ !#TAIL (CAR !#TAIL))))))
+ ((AND !#PAT (EQ !#PAT (CDR !#TAIL))) (SETQ !#X (CDR !#X)))
+ (T (PROGN (SETQ !#LVL (DIFFERENCE !#LVL 1)) (GO LP))))
+ (COND ((NOT (EQ !#TAIL (CADR !#FF))) (TCONC !#FF !#TAIL)))
+ (RETURN !#FF)))
+
+(DE EDITNTH (!#X !#N)
+ (COND ((ATOM !#X) (ERROR NIL NIL))
+ ((NOT (NUMBERP !#N))
+ (OR (MEMQ !#N !#X)
+ (MEMQ (SETQ !#N (EDITELT !#N (LIST !#X))) !#X)
+ (TAIL!-P !#N !#X)))
+ ((EQUAL !#N 0) (ERROR NIL NIL))
+ ((NULL (SETQ !#N
+ (COND ((OR (NOT (LESSP !#N 0))
+ (GREATERP (SETQ !#N (PLUS (LENGTH !#X) !#N
+1)) 0))
+ (NTH!-TAIL !#X !#N)))))
+ (ERROR NIL NIL))
+ (T !#N)))
+
+(DE EDITBPNT0 (!#EXP !#DEPTH)
+ (PROGN
+ (COND ((NOT (EQUAL F!:E!#LASTP1 F!:E!#LOCLST))
+ (PROGN (SETQ F!:E!#LASTP2 F!:E!#LASTP1)
+ (SETQ F!:E!#LASTP1 F!:E!#LOCLST))))
+ (TERPRI)
+ (!* " 3nd arg to edit#print indicates whether print should start with ... ")
+ (!* " 2nd arg to sprint is left margin")
+ (COND (!#DEPTH
+ (EDIT!#PRINT !#EXP
+ !#DEPTH
+ (TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))))
+ (T (SPRINT !#EXP 1)))))
+
+(DE EDITBPNT (!#X)
+ (PROG (!#Y !#N)
+ (COND ((EQUAL (CAR !#X) 0) (SETQ !#Y (CAR F!:E!#LOCLST)))
+ (T (SETQ !#Y (CAR (EDITNTH (CAR F!:E!#LOCLST) (CAR !#X))))))
+ (COND ((NULL (CDR !#X)) (SETQ !#N 2))
+ ((NOT (NUMBERP (SETQ !#N (CADR !#X)))) (ERROR NIL NIL))
+ ((LESSP !#N 0) (ERROR NIL NIL)))
+ (TERPRI)
+ (!* " 3nd arg indicates whether print should start with ... ")
+ (EDIT!#PRINT !#Y !#N (TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST)))
+ (RETURN !#Y)))
+
+(DE EDITRI (!#M !#N !#X)
+ (PROG (!#A !#B)
+ (SETQ !#A (EDITNTH !#X !#M))
+ (SETQ !#B (EDITNTH (CAR !#A) !#N))
+ (COND ((OR (NULL !#A) (NULL !#B)) (ERROR NIL NIL)))
+ (EDITSMASH !#A (CAR !#A) (EDITNCONC (CDR !#B) (CDR !#A)))
+ (EDITSMASH !#B (CAR !#B) NIL)))
+
+(DE EDITRO (!#N !#X)
+ (PROGN (SETQ !#X (EDITNTH !#X !#N))
+ (COND ((OR (NULL !#X) (ATOM (CAR !#X))) (ERROR NIL NIL)))
+ (EDITSMASH (SETQ !#N (LAST (CAR !#X))) (CAR !#N) (CDR !#X))
+ (EDITSMASH !#X (CAR !#X) NIL)))
+
+(DE EDITLI (!#N !#X)
+ (PROGN (SETQ !#X (EDITNTH !#X !#N))
+ (COND ((NULL !#X) (ERROR NIL NIL)))
+ (EDITSMASH !#X (CONS (CAR !#X) (CDR !#X)) NIL)))
+
+(DE EDITLO (!#N !#X)
+ (PROGN (SETQ !#X (EDITNTH !#X !#N))
+ (COND ((OR (NULL !#X) (ATOM (CAR !#X))) (ERROR NIL NIL)))
+ (EDITSMASH !#X (CAAR !#X) (CDAR !#X))))
+
+(DE EDITBI (!#M !#N !#X)
+ (PROG (!#A !#B)
+ (SETQ !#B (CDR (SETQ !#A (EDITNTH !#X !#N))))
+ (SETQ !#X (EDITNTH !#X !#M))
+ (COND ((AND !#A (NOT (GREATERP (LENGTH !#A) (LENGTH !#X))))
+ (PROGN (EDITSMASH !#A (CAR !#A) NIL)
+ (EDITSMASH !#X (CONS (CAR !#X) (CDR !#X)) !#B)))
+ (T (ERROR NIL NIL)))))
+
+(DE EDITBO (!#N !#X)
+ (PROGN (SETQ !#X (EDITNTH !#X !#N))
+ (COND ((ATOM (CAR !#X)) (ERROR NIL NIL)))
+ (EDITSMASH !#X (CAAR !#X) (EDITNCONC (CDAR !#X) (CDR !#X)))))
+
+(DE EDITDEFAULT (!#X)
+ (PROG (!#Y)
+ (COND (F!:E!#LCFLG
+ (RETURN
+ (COND ((EQ F!:E!#LCFLG T) (EDITQF !#X))
+ (T (EDITCOM (LIST F!:E!#LCFLG !#X) F!:E!#TOPFLG)))))
+ ((PAIRP !#X)
+ (RETURN
+ (COND ((SETQ !#Y (ATSOC (CAR !#X) F!:E!#OPS))
+ (EDITRAN !#X (CDR !#Y)))
+ (T (ERROR NIL NIL)))))
+ ((NULL F!:E!#TOPFLG) (ERROR NIL NIL))
+ ((MEMQ !#X F!:E!#EDITCOMSL)
+ (COND (F!:E!#INBUF
+ (PROGN (SETQ !#X (CONS !#X F!:E!#INBUF))
+ (SETQ F!:E!#INBUF NIL)))
+ (T (ERROR NIL NIL))))
+ ((AND (EQ (NTHCHAR !#X -1) 'P)
+ (MEMQ (SETQ !#X
+ (ICOMPRESS
+ (REVERSIP (CDR (REVERSIP (EXPLODE !#X))))))
+ '(!^ !_ UP NX BK !@NX UNDO)))
+ (SETQ F!:E!#INBUF (CONS 'P F!:E!#INBUF)))
+ (T (ERROR NIL NIL)))
+ (RETURN
+ (COND ((SETQ !#Y (ATSOC (CAR !#X) F!:E!#OPS)) (EDITRAN !#X (CDR !#Y)))
+ (T (EDITCOM (SETQ F!:E!#CMD !#X) F!:E!#TOPFLG))))))
+
+(DE EDITUP NIL
+ (PROG (!#CL F!:E!#LOCLST!#1 !#X !#Y)
+ (SETQ !#CL (CAR F!:E!#LOCLST))
+ (!* "unused LP was here")
+ (COND ((NULL (SETQ F!:E!#LOCLST!#1 (CDR F!:E!#LOCLST)))
+ (ERROR NIL NIL))
+ ((TAIL!-P !#CL (CAR F!:E!#LOCLST!#1)) (RETURN NIL))
+ ((NOT (SETQ !#X (MEMQ !#CL (CAR F!:E!#LOCLST!#1))))
+ (ERROR NIL NIL))
+ ((OR (EQ !#X F!:E!#LASTAIL)
+ (NOT (SETQ !#Y (MEMQ !#CL (CDR !#X)))))
+ NIL)
+ ((AND (EQ !#CL (CAR F!:E!#LASTAIL)) (TAIL!-P F!:E!#LASTAIL !#Y))
+ (SETQ !#X F!:E!#LASTAIL))
+ (T (PROGN (TERPRI) (PRIN2 !#CL) (PRINT2 " - location uncertain")))
+ )
+ (COND ((EQ !#X (CAR F!:E!#LOCLST!#1))
+ (SETQ F!:E!#LOCLST F!:E!#LOCLST!#1))
+ (T (SETQ F!:E!#LOCLST (CONS !#X F!:E!#LOCLST!#1))))
+ (RETURN NIL)))
+
+(DE EDIT!* (!#N)
+ (CAR (SETQ F!:E!#LOCLST
+ ((LAMBDA (F!:E!#CMD F!:E!#LOCLST !#M)
+ (PROGN (COND ((NOT (GREATERP !#M !#N)) (ERROR NIL NIL)))
+ (EDITCOM '!@0 NIL)
+ (EDITCOM (DIFFERENCE !#N !#M) NIL)
+ F!:E!#LOCLST))
+ NIL
+ F!:E!#LOCLST
+ ((LAMBDA (F!:E!#LOCLST)
+ (PROGN (EDITUP) (LENGTH (CAR F!:E!#LOCLST))))
+ F!:E!#LOCLST)))))
+
+(DE EDITOR (!#COMS)
+ (PROG (!#RES)
+ LP (COND ((NULL !#COMS) (ERROR NIL NIL)))
+ (SETQ !#RES
+ (ERRORSET (LIST 'EDITOR1 (MKQUOTE !#COMS))
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (COND ((PAIRP !#RES) (RETURN (CAR F!:E!#LOCLST)))
+ (!#RES (ERROR !#RES NIL)))
+ (SETQ !#COMS (CDR !#COMS))
+ (GO LP)))
+
+(DE EDITOR1 (!#COMS)
+ (SETQ F!:E!#LOCLST
+ ((LAMBDA (F!:E!#LOCLST)
+ (PROGN
+ (COND ((ATOM (CAR !#COMS)) (EDITCOM (CAR !#COMS)))
+ (T (EDITCOMS (CAR !#COMS))))
+ F!:E!#LOCLST))
+ F!:E!#LOCLST)))
+
+(DE EDITERRCOM (!#COMS)
+ (ERRORSET (LIST 'EDITCOMS (MKQUOTE !#COMS)) G!:EDIT!:ERRORS G!:EDIT!:TRACE))
+
+(DE EDITRPT (!#EDRX !#QUIET)
+ (PROG (!#EDRL !#EDRPTCNT)
+ (SETQ !#EDRL F!:E!#LOCLST)
+ (SETQ !#EDRPTCNT 0)
+ LP (COND ((GREATERP !#EDRPTCNT F!:E!#MAXLOOP)
+ (PRINT2 " maxloop exceeded"))
+ ((PAIRP (EDITERRCOM !#EDRX))
+ (PROGN (SETQ !#EDRL F!:E!#LOCLST)
+ (SETQ !#EDRPTCNT (PLUS !#EDRPTCNT 1))
+ (GO LP)))
+ ((NULL !#QUIET) (PROGN (PRIN1 !#EDRPTCNT)
+ (PRINT2 " occurrences"))))
+ (SETQ F!:E!#LOCLST !#EDRL)))
+
+(DE EDITLOC (!#X)
+ (PROG (!#OLDL !#OLDF F!:E!#LCFLG !#L)
+ (SETQ !#OLDL F!:E!#LOCLST)
+ (SETQ !#OLDF F!:E!#UNFIND)
+ (SETQ F!:E!#LCFLG T)
+ (COND ((ATOM !#X) (EDITCOM !#X NIL))
+ ((AND (NULL (CDR !#X)) (ATOM (CAR !#X))) (EDITCOM (CAR !#X) NIL))
+ (T (GO LP)))
+ (SETQ F!:E!#UNFIND !#OLDL)
+ (RETURN (CAR F!:E!#LOCLST))
+ LP (SETQ !#L F!:E!#LOCLST)
+ (COND ((PAIRP (EDITERRCOM !#X))
+ (PROGN (SETQ F!:E!#UNFIND !#OLDL) (RETURN (CAR F!:E!#LOCLST)))))
+ (COND ((EQUAL !#L F!:E!#LOCLST)
+ (PROGN (SETQ F!:E!#LOCLST !#OLDL)
+ (SETQ F!:E!#UNFIND !#OLDF)
+ (ERROR NIL NIL))))))
+
+(DE EDITLOCL (!#COMS)
+ (CAR (SETQ F!:E!#LOCLST
+ (NCONC
+ ((LAMBDA (F!:E!#LOCLST F!:E!#UNFIND)
+ (PROGN (EDITLOC !#COMS) F!:E!#LOCLST))
+ (LIST (CAR F!:E!#LOCLST))
+ NIL)
+ (CDR F!:E!#LOCLST)))))
+
+(DE EDIT!: (!#TYPE !#LC !#X)
+ (PROG (F!:E!#TOFLG F!:E!#LOCLST!#0)
+ (SETQ F!:E!#LOCLST!#0 F!:E!#LOCLST)
+ (SETQ !#X
+ (MAPCAR !#X
+ (FUNCTION
+ (LAMBDA (!#X)
+ (COND ((AND (PAIRP !#X) (EQ (CAR !#X) '!#!#))
+ ((LAMBDA (F!:E!#LOCLST F!:E!#UNDOLST!#1)
+ (COPY (EDITCOMS (CDR !#X))))
+ F!:E!#LOCLST
+ NIL))
+ (T !#X))))))
+ (COND (!#LC (PROGN (COND ((EQ (CAR !#LC) 'HERE) (SETQ !#LC (CDR !#LC))))
+ (EDITLOC !#LC))))
+ (EDITUP)
+ (COND ((EQ F!:E!#LOCLST!#0 F!:E!#LOCLST) (SETQ !#LC NIL)))
+ (SELECTQ !#TYPE
+ ((B BEFORE) (EDIT2F -1 !#X))
+ ((A AFTER)
+ (COND ((CDAR F!:E!#LOCLST) (EDIT2F -2 !#X))
+ (T (EDITCOML (CONS 'N !#X) F!:E!#COPYFLG))))
+ ((!: FOR)
+ (COND ((OR !#X (CDAR F!:E!#LOCLST)) (EDIT2F 1 !#X))
+ ((MEMQ (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
+ (PROGN (EDITUP) (EDIT2F 1 (LIST NIL))))
+ (T (EDITCOMS '(0 (NTH -2) (2)))))
+ (RETURN (COND ((NULL !#LC) F!:E!#LOCLST))))
+ (ERROR NIL NIL))
+ (RETURN NIL)))
+
+(DE EDITMBD (!#LC !#X)
+ (PROG (!#Y F!:E!#TOFLG)
+ (COND (!#LC (EDITLOC !#LC)))
+ (EDITUP)
+ (SETQ !#Y
+ (COND (F!:E!#TOFLG (CAAR F!:E!#LOCLST))
+ (T (LIST (CAAR F!:E!#LOCLST)))))
+ (EDIT2F 1
+ (LIST (COND ((OR (ATOM (CAR !#X)) (CDR !#X)) (APPEND !#X !#Y))
+ (T (LSUBST !#Y '!* (CAR !#X))))))
+ (SETQ F!:E!#LOCLST
+ (CONS (CAAR F!:E!#LOCLST)
+ (COND ((TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
+ (CDR F!:E!#LOCLST))
+ (T F!:E!#LOCLST))))
+ (RETURN (COND ((NULL !#LC) F!:E!#LOCLST)))))
+
+(DE EDITXTR (!#LC !#X)
+ (PROG (F!:E!#TOFLG)
+ (COND (!#LC (EDITLOC !#LC)))
+ ((LAMBDA (F!:E!#LOCLST F!:E!#UNFIND)
+ (PROGN (EDITLOC !#X)
+ (SETQ !#X
+ (COND ((TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
+ (CAAR F!:E!#LOCLST))
+ (T (CAR F!:E!#LOCLST))))))
+ (LIST (COND ((TAIL!-P (CAR F!:E!#LOCLST) (CADR F!:E!#LOCLST))
+ (CAAR F!:E!#LOCLST))
+ (T (CAR F!:E!#LOCLST))))
+ NIL)
+ (EDITUP)
+ (EDIT2F 1 (COND (F!:E!#TOFLG (APPEND !#X NIL)) (T (LIST !#X))))
+ (AND (NULL F!:E!#TOFLG)
+ (PAIRP (CAAR F!:E!#LOCLST))
+ (SETQ F!:E!#LOCLST
+ (CONS (CAAR F!:E!#LOCLST)
+ (COND ((TAIL!-P (CAR F!:E!#LOCLST)
+ (CADR F!:E!#LOCLST))
+ (CDR F!:E!#LOCLST))
+ (T F!:E!#LOCLST)))))))
+
+(DE EDITELT (!#LC F!:E!#LOCLST)
+ (PROG (!#Y)
+ (EDITLOC !#LC)
+ LP (SETQ !#Y F!:E!#LOCLST)
+ (COND ((CDR (SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST))) (GO LP)))
+ (RETURN (CAR !#Y))))
+
+(DE EDITCONT (!#LC1 F!:E!#SN)
+ (SETQ F!:E!#LOCLST
+ ((LAMBDA (F!:E!#LOCLST)
+ (PROG (!#RES)
+ (SETQ !#LC1 (EDITFPAT !#LC1))
+ LP (COND ((NULL (EDIT4F !#LC1 'N)) (ERROR NIL NIL)))
+ (SETQ !#RES
+ (ERRORSET (LIST 'EDITLOCL (MKQUOTE F!:E!#SN))
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (COND ((NULL !#RES) (GO LP)) ((ATOM !#RES) (ERROR !#RES NIL)))
+ LP1 (COND ((NULL (SETQ F!:E!#LOCLST (CDR F!:E!#LOCLST)))
+ (ERROR NIL NIL))
+ ((COND ((ATOM !#LC1) (EQ !#LC1 (CAAR F!:E!#LOCLST)))
+ ((EQ (CAR !#LC1) '!')
+ (EDIT4E !#LC1 (CAAR F!:E!#LOCLST)))
+ (T (EDIT4E !#LC1 (CAR F!:E!#LOCLST))))
+ (RETURN F!:E!#LOCLST)))
+ (GO LP1)))
+ F!:E!#LOCLST)))
+
+(DE EDITSW (!#M !#N)
+ (PROG (!#Y !#Z !#TEM)
+ (SETQ !#Y (EDITNTH (CAR F!:E!#LOCLST) !#M))
+ (SETQ !#Z (EDITNTH (CAR F!:E!#LOCLST) !#N))
+ (SETQ !#TEM (CAR !#Y))
+ (EDITSMASH !#Y (CAR !#Z) (CDR !#Y))
+ (EDITSMASH !#Z !#TEM (CDR !#Z))))
+
+(DE EDITMV (!#LC !#OP !#X)
+ (PROG (F!:E!#LOCLST!#0 F!:E!#LOCLST!#1 !#Z F!:E!#TOFLG)
+ (SETQ F!:E!#LOCLST!#0 F!:E!#LOCLST)
+ (AND !#LC (EDITLOC !#LC))
+ (COND ((EQ !#OP 'HERE)
+ (PROGN (COND ((NULL !#LC) (PROGN (EDITLOC !#X) (SETQ !#X NIL))))
+ (SETQ !#OP '!:)))
+ ((EQ (CAR !#X) 'HERE)
+ (COND ((NULL !#LC) (PROGN (EDITLOC (CDR !#X)) (SETQ !#X NIL)))
+ (T (SETQ !#X (CDR !#X))))))
+ (EDITUP)
+ (SETQ F!:E!#LOCLST!#1 F!:E!#LOCLST)
+ (SETQ !#Z (CAAR F!:E!#LOCLST))
+ (SETQ F!:E!#LOCLST F!:E!#LOCLST!#0)
+ (AND !#X (EDITLOC !#X))
+ (EDITCOML
+ (COND (F!:E!#TOFLG (CONS !#OP (APPEND !#Z NIL))) (T (LIST !#OP !#Z)))
+ NIL)
+ (PROG (F!:E!#LOCLST)
+ (SETQ F!:E!#LOCLST F!:E!#LOCLST!#1)
+ (EDITCOMS '(1 DELETE)))
+ (RETURN
+ (COND ((NULL !#LC)
+ (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST!#1) F!:E!#LOCLST))
+ ((NULL !#X)
+ (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST!#1) F!:E!#LOCLST!#0))
+ (T (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST) F!:E!#LOCLST!#0))))))
+
+(DE EDITTO (!#LC1 !#LC2 !#FLG)
+ (PROGN
+ (SETQ F!:E!#LOCLST
+ ((LAMBDA (F!:E!#LOCLST)
+ (PROGN (COND (!#LC1 (PROGN (EDITLOC !#LC1) (EDITUP))))
+ (EDITBI 1
+ (COND ((AND (NUMBERP !#LC1)
+ (NUMBERP !#LC2)
+ (GREATERP !#LC2 !#LC1))
+ (DIFFERENCE (PLUS !#LC2 1) !#LC1))
+ (T !#LC2))
+ (CAR F!:E!#LOCLST))
+ (COND ((AND (EQ !#FLG 'TO) (CDAAR F!:E!#LOCLST))
+ (EDITRI 1 -2 (CAR F!:E!#LOCLST))))
+ (EDITCOM 1 NIL)
+ F!:E!#LOCLST))
+ F!:E!#LOCLST))
+ (SETQ F!:E!#TOFLG T)))
+
+(DE EDITBELOW (!#PLACE !#DEPTH)
+ (PROGN (COND ((LESSP (SETQ !#DEPTH (EVAL !#DEPTH)) 0) (ERROR NIL NIL)))
+ (PROG (!#N1 !#N2)
+ (SETQ !#N1
+ (LENGTH
+ ((LAMBDA (F!:E!#LOCLST F!:E!#LCFLG)
+ (PROGN (EDITCOM !#PLACE NIL) F!:E!#LOCLST))
+ F!:E!#LOCLST
+ '!_)))
+ (SETQ !#N2 (LENGTH F!:E!#LOCLST))
+ (COND ((LESSP !#N2 (PLUS !#N1 !#DEPTH)) (ERROR NIL NIL)))
+ (SETQ F!:E!#UNFIND F!:E!#LOCLST)
+ (SETQ F!:E!#LOCLST
+ (NTH!-TAIL F!:E!#LOCLST
+ (DIFFERENCE (DIFFERENCE (PLUS !#N2 1) !#N1)
+ !#DEPTH))))))
+
+(DE EDITRAN (!#C !#DEF)
+ (SETQ F!:E!#LOCLST
+ (OR ((LAMBDA (F!:E!#LOCLST)
+ (PROG (!#Z !#W)
+ (COND ((NULL !#DEF) (ERROR NIL NIL))
+ ((NULL (SETQ !#Z (CAR !#DEF))) (GO OUT)))
+ LP (COND ((NULL !#Z) (ERROR NIL NIL))
+ ((NULL (SETQ !#W (MEMQ (CAR !#Z) !#C)))
+ (PROGN (SETQ !#Z (CDR !#Z)) (GO LP))))
+ OUT (SETQ !#Z
+ (APPLY (CAR (SETQ !#DEF (CADR !#DEF)))
+ (PROG (F!:E!#1 F!:E!#2 F!:E!#3)
+ (SETQ F!:E!#1 (CDR (LDIFF !#C !#W)))
+ (SETQ F!:E!#2 (CAR !#Z))
+ (SETQ F!:E!#3 (CDR !#W))
+ (RETURN
+ (MAPCAR (CDR !#DEF)
+ (FUNCTION
+ (LAMBDA (!#X)
+ (SELECTQ !#X
+ (!#1 F!:E!#1)
+ (!#2 F!:E!#2)
+ (!#3 F!:E!#3)
+ (EVAL !#X)))))))))
+ (RETURN
+ (COND ((NULL !#Z)
+ (PROGN (SETQ F!:E!#UNFIND F!:E!#LOCLST) NIL))
+ (T !#Z)))))
+ F!:E!#LOCLST)
+ F!:E!#LOCLST)))
+
+(DE EDIT!#PRINT (!#E !#DEPTH !#DOTFLG)
+ (PROG (!#RES)
+ (SETQ !#RES
+ (ERRORSET
+ (LIST 'DEPTH!#PRINT (MKQUOTE !#E) !#DEPTH 0 (MKQUOTE !#DOTFLG))
+ G!:EDIT!:ERRORS
+ G!:EDIT!:TRACE))
+ (COND ((EQ !#RES 'TOOBIG) (RETURN (PRINT2 " ...> ")))
+ ((ATOM !#RES) (ERROR !#RES NIL)))
+ (RETURN !#E)))
+
+(DE DEPTH!#PRINT (!#E !#DEPTH !#PLENGTH !#DOTFLG)
+ (PROG NIL
+ (OR (LESSP (SETQ !#PLENGTH (ADD1 !#PLENGTH)) F!:E!#MAX!#PLENGTH)
+ (ERROR 'TOOBIG NIL))
+ (COND ((ATOM !#E) (PROGN (PRIN1 !#E) (RETURN !#PLENGTH)))
+ ((ZEROP !#DEPTH) (PROGN (PRIN2 "&") (RETURN !#PLENGTH))))
+ (PRIN2 (COND (!#DOTFLG "... ") (T "(")))
+ (SETQ !#DEPTH (SUB1 !#DEPTH))
+ LOOP (SETQ !#PLENGTH (DEPTH!#PRINT (CAR !#E) !#DEPTH !#PLENGTH NIL))
+ (SETQ !#E (CDR !#E))
+ (COND ((NULL !#E) NIL)
+ ((ATOM !#E) (PROGN (PRIN2 " . ") (PRIN1 !#E)))
+ (T (PROGN (PRIN2 " ") (GO LOOP))))
+ (PRIN2 ")")
+ (RETURN !#PLENGTH)))
+
+(!*
+"LDIFF( X:list Y:list ):list EXPR
+ -----
+ If X is a tail of Y, returns the list difference of X and Y,
+ a list of the elements of Y preceeding X.")
+
+(CDE LDIFF (!#X !#Y)
+ (COND ((OR (EQ !#X !#Y) (ATOM !#X)) NIL)
+ ((NULL !#Y) !#X)
+ (T (PROG (!#V !#Z)
+ (SETQ !#Z (SETQ !#V (LIST (CAR !#X))))
+ LOOP (SETQ !#X (CDR !#X))
+ (COND ((OR (EQ !#X !#Y) (ATOM !#X)) (RETURN !#Z)))
+ (SETQ !#V (CDR (RPLACD !#V (LIST (CAR !#X)))))
+ (GO LOOP)))))
+
+(!* "FREELIST is an efficiency hack in the DEC interpreter."
+"It explicitly returns the cells of a list to the freelist.")
+
+(CDE FREELIST (!#X) NIL)
+
+(!* "EDITRACEFN is an optional debugging routine for the editor.")
+
+(CDE EDITRACEFN (!#X) NIL)
+
+(DE PRINT2 (!#X) (PROGN (PRIN2 !#X) (TERPRI) !#X))
+
+(SETQ F!:E!#LOOKDPTH -1)
+
+(SETQ F!:E!#DEPTH -1)
+
+(SETQ F!:E!#TRACEFLG NIL)
+
+(SETQ F!:E!#LAST!#ID NIL)
+
+(SETQ F!:E!#MAXLEVEL 300)
+
+(SETQ F!:E!#UPFINDFLG T)
+
+(SETQ F!:E!#MAXLOOP 30)
+
+(SETQ F!:E!#EDITCOMSL
+ '(S R E I N P F FS F!= ORF BF NTH IF RI RO LI LO BI BO M NX BK ORR MBD XTR
+ THRU TO A B !: AFTER BEFORE FOR MV LP LPQ LC LCL !_ BELOW SW BIND COMS
+COMSQ INSERT REPLACE CHANGE DELETE EMBED SURROUND MOVE EXTRACT SECOND THIRD
+NEX REPACK MAKEFN))
+
+(SETQ F!:E!#USERMACROS NIL)
+
+(SETQ F!:E!#MAX!#PLENGTH 1750)
+
+(SETQ F!:E!#MACROS
+ '((MAKEFN (EX ARGS N M)
+ (IF 'M
+ ((BI N M) (LC . N) (BELOW !\))
+ ((IF 'N ((BI N) (LC . N) (BELOW !\)))))
+ (E (MAPC '(LAMBDA (!#X !#Y) (EDITDSUBST !#X !#Y (EDIT!#!#)))
+ 'ARGS
+ (CDR 'EX))
+ T)
+ (E (PUTD (CAR 'EX) 'EXPR (CONS 'LAMBDA (CONS 'ARGS (EDIT!#!#))))
+T) UP
+ (1 EX))
+ (REPACK !#X (LC . !#X) REPACK)
+ (REPACK NIL
+ (IF (PAIRP (EDIT!#!#)) (1) NIL)
+ (I !: (PRINT (READLIST (EDITE (EXPLODE (EDIT!#!#)) NIL NIL)))))
+ (NEX (!#X) (BELOW !#X) NX)
+ (NEX NIL (BELOW !_) NX)
+ (THIRD !#X (ORR ((LC . !#X) (LC . !#X) (LC . !#X))))
+ (SECOND !#X (ORR ((LC . !#X) (LC . !#X))))))
+
+(SETQ F!:E!#OPS
+ '((INSERT (BEFORE AFTER FOR) (EDIT!: F!:E!#2 F!:E!#3 F!:E!#1))
+ (REPLACE (WITH BY) (EDIT!: !: F!:E!#1 F!:E!#3))
+ (CHANGE (TO) (EDIT!: !: F!:E!#1 F!:E!#3))
+ (DELETE NIL (EDIT!: !: F!:E!#1 NIL))
+ (EMBED (IN WITH) (EDITMBD F!:E!#1 F!:E!#3))
+ (SURROUND (WITH IN) (EDITMBD F!:E!#1 F!:E!#3))
+ (MOVE (TO) (EDITMV F!:E!#1 (CAR F!:E!#3) (CDR F!:E!#3)))
+ (EXTRACT (FROM) (EDITXTR F!:E!#3 F!:E!#1))))
+
ADDED psl-1983/3-1/util/zsys.lsp
Index: psl-1983/3-1/util/zsys.lsp
==================================================================
--- /dev/null
+++ psl-1983/3-1/util/zsys.lsp
@@ -0,0 +1,303 @@
+(!*
+"ZSYS -- the system dependent file.
+ Currently, the only code in it is MAKE-OPEN-FILE-NAME, which
+ uses a semi machine-independant file description to create a
+ filename suitable for OPEN in the resident system.
+
+ N.B.: TO SET THIS CODE UP FOR A PARTICULAR INTEPRETER,
+ REMOVE THE * FROM BEFORE THE APPROPRIATE SETQ BELOW.
+ THAT SHOULD BE ALL YOU NEED TO DO.
+
+")
+
+(COMPILETIME
+(GLOBAL '(G!:SYSTEM))
+
+(IF!_SYSTEM TOPS20
+(SETQ G!:SYSTEM 'PSL!-TOPS20))
+
+(IF!_SYSTEM UNIX
+(SETQ G!:SYSTEM 'PSL!-UNIX))
+
+(!* SETQ G!:SYSTEM 'IMSSS!-TENEX)
+
+(!* SETQ G!:SYSTEM 'UTAH!-TOPS10)
+
+(!* SETQ G!:SYSTEM 'UTAH!-TENEX)
+
+(!* SETQ G!:SYSTEM 'CMS)
+
+(!* SETQ G!:SYSTEM 'ORVYL)
+
+(PROGN (TERPRI)
+ (PRIN2 "Filenames will be made for ")
+ (PRIN2 G!:SYSTEM)
+ (PRIN2 " system.")
+ (TERPRI))
+)
+
+(FLUID '(F!:FILE!:ID F!:OLD!:FILE))
+
+(COMPILETIME
+(!*
+"This macro (and those following) are separated only for readability.
+ The appropriate MAKE-xxx-NAME will provide the body of the definition
+ for MAKE-OPEN-FILE-NAME.
+ Note: (a) #DSCR can be mentioned free in the macros since it is the
+ lambda variable for MAKE-OPEN-FILE-NAME.
+ (b) ORVYL and CMS differ only in the delimiter they use.
+ (c) When compiling, all these macros are REMOB'ed to clear up
+ otherwise extraneous code.")
+
+(DM MAKE!-SYS!-FILE!-NAME (!#X)
+ (SELECTQ G!:SYSTEM
+ (PSL!-TOPS20 '(MAKE!-PSL!-TOPS20!-NAME))
+ (PSL!-UNIX '(MAKE!-PSL!-UNIX!-NAME))
+ (UTAH!-TENEX '(MAKE!-UTAH!-TENEX!-NAME))
+ (UTAH!-TOPS10 '(MAKE!-UTAH!-TOPS10!-NAME))
+ (IMSSS!-TENEX '(MAKE!-IMSSS!-TENEX!-NAME))
+ (ORVYL '(MAKE!-IBM!-NAME !.))
+ (CMS '(MAKE!-IBM!-NAME ! ))
+ (ERROR 0
+ (LIST "Don't know how to make file names for system "
+ G!:SYSTEM))))
+
+(DM MAKE!-UTAH!-TENEX!-NAME (!#X)
+ '(PROG (!#DIR !#NAM !#EXT)
+ (RETURN
+ (SETQ F!:OLD!:FILE
+ (COND ((NULL (PAIRP !#DSCR))
+ (ERROR 0 (LIST "BAD FILE DSCR: " !#DSCR)))
+ ((NULL (CDR !#DSCR))
+ (LIST (CONS (SETQ F!:FILE!:ID (CAR !#DSCR)) 'LSP)))
+ ((EQ (CDR !#DSCR) '!;)
+ (LIST (SETQ F!:FILE!:ID (CAR !#DSCR))))
+ ((IDP (CDR !#DSCR))
+ (PROGN (SETQ F!:FILE!:ID (CAR !#DSCR)) (LIST !#DSCR)))
+ (T (PROGN (SETQ !#DIR (CAR !#DSCR))
+ (SETQ F!:FILE!:ID (SETQ !#NAM (CADR !#DSCR)))
+ (SETQ !#EXT
+ (COND ((NULL (CDDR !#DSCR)) 'LSP)
+ ((IDP (CDDR !#DSCR)) (CDDR !#DSCR))
+ (T (CADDR !#DSCR))))
+ (LIST 'DIR!: !#DIR (CONS !#NAM !#EXT)))))))))
+
+(!*
+"Use decimal equivalent of PPNs for tops 10. Maybe the ROCT switch
+ in the interpreter will allow octal PPNS??")
+
+(DM MAKE!-UTAH!-TOPS10!-NAME (!#X)
+ '(PROG (!#DIR !#NAM !#EXT)
+ (RETURN
+ (SETQ F!:OLD!:FILE
+ (COND ((NULL (PAIRP !#DSCR))
+ (ERROR 0 (LIST "BAD FILE DSCR: " !#DSCR)))
+ ((NULL (CDR !#DSCR))
+ (LIST (CONS (SETQ F!:FILE!:ID (CAR !#DSCR)) 'LSP)))
+ ((EQ (CDR !#DSCR) '!;)
+ (LIST (SETQ F!:FILE!:ID (CAR !#DSCR))))
+ ((IDP (CDR !#DSCR))
+ (PROGN (SETQ F!:FILE!:ID (CAR !#DSCR)) (LIST !#DSCR)))
+ (T (PROGN (SETQ !#DIR (CAR !#DSCR))
+ (COND ((NOT (AND (PAIRP !#DIR)
+ (NUMBERP (CAR !#DIR))
+ (NUMBERP (CADR !#DIR))))
+ (BUG!-STOP
+ "Bad PPN: USE (<n> <n>) w/ decimal equiv of octal PPN.")
+ ))
+ (SETQ F!:FILE!:ID (SETQ !#NAM (CADR !#DSCR)))
+ (SETQ !#EXT
+ (COND ((NULL (CDDR !#DSCR)) 'LSP)
+ ((IDP (CDDR !#DSCR)) (CDDR !#DSCR))
+ (T (CADDR !#DSCR))))
+ (LIST !#DIR (CONS !#NAM !#EXT)))))))))
+
+(DM MAKE!-IMSSS!-TENEX!-NAME (!#X)
+ '(PROG (DIR!#NAM !#EXT)
+ (!* "#DSCR is a list")
+ (RETURN
+ (SETQ F!:OLD!:FILE
+ (LIST (COND ((NULL (PAIRP !#DSCR))
+ (ERROR 0 (LIST "BAD FILE DSCR: " !#DSCR)))
+ ((NULL (CDR !#DSCR))
+ (CONS (SETQ F!:FILE!:ID (CAR !#DSCR)) 'LSP))
+ ((EQ (CDR !#DSCR) '!;)
+ (SETQ F!:FILE!:ID (CAR !#DSCR)))
+ ((IDP (CDR !#DSCR))
+ (PROGN (SETQ F!:FILE!:ID (CAR !#DSCR)) !#DSCR))
+ (T (PROGN
+ (SETQ DIR!#NAM
+ (COMPRESS
+ (NCONCL (LIST '!! '!<)
+ (EXPLODE (CAR !#DSCR))
+ (LIST '!! '!>)
+ (EXPLODE (CADR !#DSCR)))))
+ (SETQ F!:FILE!:ID (CADR !#DSCR))
+ (SETQ !#EXT
+ (COND ((NULL (CDDR !#DSCR)) 'LSP)
+ ((IDP (CDDR !#DSCR)) (CDDR !#DSCR))
+ (T (CADDR !#DSCR))))
+ (CONS DIR!#NAM !#EXT)))))))))
+
+(DM MAKE!-PSL!-TOPS20!-NAME (!#X)
+ '(PROG (DIR!#NAM !#EXT)
+ (!* "#DSCR is a list")
+ (COND ((STRINGP !#DSCR) (MAKE !#DSCR NCONS)))
+ (RETURN
+ (SETQ F!:OLD!:FILE
+ (COND ((NULL (PAIRP !#DSCR))
+ (ERROR 0 (LIST "BAD FILE DSCR: " !#DSCR)))
+ ((NULL (CDR !#DSCR))
+ (COND ((STRINGP (CAR !#DSCR))
+ (PROGN
+ (SETQ F!:FILE!:ID
+ (EXTRACT!-FILE!-ID (CAR !#DSCR)))
+ (CAR !#DSCR)))
+ (T (ID!-LIST!-TO!-STRING
+ (LIST (SETQ F!:FILE!:ID (CAR !#DSCR))
+ '!.
+ 'LSP)))))
+ ((EQ (CDR !#DSCR) '!;)
+ (ID2STRING (SETQ F!:FILE!:ID (CAR !#DSCR))))
+ ((IDP (CDR !#DSCR))
+ (ID!-LIST!-TO!-STRING
+ (LIST (SETQ F!:FILE!:ID (CAR !#DSCR)) '!. (CDR !#DSCR)))
+ )
+ (T (PROGN
+ (SETQ DIR!#NAM
+ (COMPRESS
+ (NCONCL (LIST '!! '!<)
+ (EXPLODE (CAR !#DSCR))
+ (LIST '!! '!>)
+ (EXPLODE (CADR !#DSCR)))))
+ (SETQ F!:FILE!:ID (CADR !#DSCR))
+ (SETQ !#EXT
+ (COND ((NULL (CDDR !#DSCR)) 'LSP)
+ ((IDP (CDDR !#DSCR)) (CDDR !#DSCR))
+ (T (CADDR !#DSCR))))
+ (ID!-LIST!-TO!-STRING (LIST DIR!#NAM '!. !#EXT)))))))))
+
+
+(DM MAKE!-PSL!-UNIX!-NAME (!#X)
+ '(PROG (DIR!#NAM !#EXT)
+ (!* "#DSCR is a list")
+ (COND ((STRINGP !#DSCR) (MAKE !#DSCR NCONS)))
+ (RETURN
+ (SETQ F!:OLD!:FILE
+ (COND ((NULL (PAIRP !#DSCR))
+ (ERROR 0 (LIST "BAD FILE DSCR: " !#DSCR)))
+ ((NULL (CDR !#DSCR))
+ (COND ((STRINGP (CAR !#DSCR))
+ (PROGN (SETQ F!:FILE!:ID
+ (EXTRACT!-FILE!-ID (CAR
+ !#DSCR)))
+ (CAR !#DSCR)))
+ (T (ID!-LIST!-TO!-STRING (LIST (SETQ
+ F!:FILE!:ID
+ (CAR
+ !#DSCR))
+ '!.
+ 'LSP)))))
+ ((EQ (CDR !#DSCR) '!;)
+ (ID2STRING (SETQ F!:FILE!:ID (CAR !#DSCR))))
+ ((IDP (CDR !#DSCR))
+ (ID!-LIST!-TO!-STRING (LIST (SETQ F!:FILE!:ID
+ (CAR !#DSCR))
+ '!.
+ (CDR !#DSCR))))
+ (T (PROGN (SETQ DIR!#NAM
+ (COMPRESS (NCONCL (EXPLODE (CAR
+ !#DSCR))
+ (LIST '!!
+ '!/)
+ (EXPLODE (CADR
+ !#DSCR)))))
+ (SETQ F!:FILE!:ID (CADR !#DSCR))
+ (SETQ !#EXT
+ (COND ((NULL (CDDR !#DSCR))
+ 'LSP)
+ ((IDP (CDDR !#DSCR))
+ (CDDR !#DSCR))
+ (T (CADDR !#DSCR))))
+ (ID!-LIST!-TO!-STRING (LIST DIR!#NAM
+ '!.
+ !#EXT))))))))))
+
+(IF!_SYSTEM TOPS20 (PROGN
+(DE EXTRACT!-FILE!-ID (!#X)
+ (PROG (!#Y)
+ (!*
+"Take a TOPS-20 filename string and try to
+ find a root file name in it")
+ (SETQ !#Y (DREVERSE (EXPLODE2 !#X)))
+ (SETQ !#X !#Y)
+ LOOP1(COND ((OR (NULL !#X) (MEMQ (CAR !#X) '(!: !>))) (GO LOOP1END))
+ ((EQ (CAR !#X) '!.) (PROGN (SETQ !#Y (CDR !#X)) (GO LOOP1END))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP1)
+ LOOP1END
+ (SETQ !#X !#Y)
+ LOOP2(COND ((OR (NULL !#X) (NULL (CDR !#X))) (GO LOOP2END))
+ ((MEMQ (CADR !#X) '(!> !:))
+ (PROGN (RPLACD !#X NIL) (GO LOOP2END))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP2)
+ LOOP2END
+ (RETURN (ICOMPRESS (DREVERSE !#Y)))))
+
+(DE ID!-LIST!-TO!-STRING (!#X)
+ (PROG (!#S)
+ (SETQ !#S "")
+ LOOP (COND ((NULL !#X) (RETURN !#S)))
+ (SETQ !#S (CONCAT !#S (ID2STRING (CAR !#X))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP)))))
+
+(IF!_SYSTEM UNIX (PROGN
+(DE EXTRACT!-FILE!-ID (!#X)
+ (PROG (!#Y)
+ (!*
+"Take a UNIX filename string and try to
+find a root file name in it")
+ (SETQ !#Y (DREVERSE (EXPLODE2 !#X)))
+ (SETQ !#X !#Y)
+ LOOP1(COND ((OR (NULL !#X) (MEMQ (CAR !#X) '(!: !>))) (GO LOOP1END))
+ ((EQ (CAR !#X) '!.) (PROGN (SETQ !#Y (CDR !#X)) (GO LOOP1END))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP1)
+ LOOP1END
+ (SETQ !#X !#Y)
+ LOOP2(COND ((OR (NULL !#X) (NULL (CDR !#X))) (GO LOOP2END))
+ ((MEMQ (CADR !#X) '(!> !:))
+ (PROGN (RPLACD !#X NIL) (GO LOOP2END))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP2)
+ LOOP2END
+ (RETURN (ICOMPRESS (DREVERSE !#Y)))))
+
+(FLUID '(!*LOWER))
+
+(!* "*LOWER when T all output (including EXPLODE) is in lowercase")
+
+(DE ID!-LIST!-TO!-STRING (!#X)
+ (PROG (!#S !*LOWER)
+ (SETQ !*LOWER T)
+ (SETQ !#S "")
+ LOOP (COND ((NULL !#X) (RETURN !#S)))
+ (SETQ !#S (CONCAT !#S (LIST2STRING (EXPLODE2 (CAR !#X)))))
+ (SETQ !#X (CDR !#X))
+ (GO LOOP)))))
+
+(!* "IBM code got lost")
+
+(DE MAKE!-OPEN!-FILE!-NAME (!#DSCR) (MAKE!-SYS!-FILE!-NAME))
+
+(!* "Remove excess baggage once macros have been used.")
+
+(!* COND ((CODEP (CDR (GETD 'MAKE!-OPEN!-FILE!-NAME)))
+ (PROGN (REMOB 'MAKE!-SYS!-FILE!-NAME)
+ (REMOB 'MAKE!-UTAH!-TENEX!-NAME)
+ (REMOB 'MAKE!-UTAH!-TOPS10!-NAME)
+ (REMOB 'MAKE!-IMSSS!-TENEX!-NAME)
+ (REMOB 'MAKE!-IBM!-NAME))))
+
ADDED psl-1983/3-1/windows/-this-.directory
Index: psl-1983/3-1/windows/-this-.directory
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/-this-.directory
@@ -0,0 +1,6 @@
+This directory contains the sources and non-loadable binaries for the Window
+package used by NMode. The window package consists of two loadable modules:
+WINDOWS and DISPLAY-CHAR. WINDOWS is the main module and is essential.
+DISPLAY-CHAR is a module that defines some macros for manipulating "display
+characters", which are used in the Window Package. Load this module at
+compile time if you use any of these macros.
ADDED psl-1983/3-1/windows/-windows.files
Index: psl-1983/3-1/windows/-windows.files
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/-windows.files
@@ -0,0 +1,18 @@
+Window Package Source Files Summary - 5 April 1983
+-------------------------------------------------------------------------------
+9836-ALPHA.SL - display driver for 9836 alpha display
+9836-BITMAP.SL - display driver for memory-mapped raster displays
+9836-COLOR.SL - display driver for 9836 color display (Moon Unit)
+DIRECT-PHYSICAL-SCREEN.SL - direct-writing version of Physical Screen (for 9836)
+DISPLAY-CHAR.SL - type representing chars on display screen (with enhancements)
+FONT8.SL - font definition for bitmapped displays
+HP2648A.SL - terminal handler for HP2648A family
+PHYSICAL-SCREEN.SL - physical screen abstract data type
+SHARED-PHYSICAL-SCREEN.SL - shared physical screen: handles overlapping screens
+TELERAY.SL - terminal handler for Teleray terminal
+VAX-PHYSICAL-SCREEN.SL - Vax version of Physical Screen (flushes buffers)
+VIRTUAL-SCREEN.SL - virtual screen abstract data type
+VT52X.SL - terminal handler for 9836 extended VT52 emulator
+WINDOWS-20.SL - Dec-20 specific stuff
+WINDOWS-9836.SL - 9836 specific stuff
+WINDOWS-VAX.SL - Vax-Unix specific stuff
ADDED psl-1983/3-1/windows/9836-alpha.sl
Index: psl-1983/3-1/windows/9836-alpha.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/9836-alpha.sl
@@ -0,0 +1,144 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% 9836-Alpha.SL - Terminal Interface for 9836 Alpha Memory
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 13 December 1982
+% Revised: 27 January 1983
+%
+% Note: uses efficiency hacks that require 80-column width!
+% Note: contains 68000 LAP code; must be compiled!
+% Note: uses all 25 lines; assumes keyboard input buffer has been relocated
+%
+% 27-Jan-83 Alan Snyder
+% Revise to use all 25 lines of the screen.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int syslisp))
+
+(defflavor 9836-alpha (
+ (height 25) % number of rows (0 indexed)
+ (maxrow 24) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (buffer-address (int2sys 16#512000)) % an absolute address
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (9836-alpha get-character) ()
+ (keyboard-input-character)
+ )
+
+(defmethod (9836-alpha ring-bell) ()
+ (ChannelWriteChar 1 #\Bell)
+ )
+
+(defmethod (9836-alpha move-cursor) (row column)
+ (setf cursor-row row)
+ (setf cursor-column column)
+ (screen-set-cursor-position row column)
+ )
+
+(defmethod (9836-alpha enter-raw-mode) ()
+ (when (not raw-mode)
+ % (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)
+ ))
+
+(defmethod (9836-alpha leave-raw-mode) ()
+ (when raw-mode
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ % (EchoOn)
+ ))
+
+(defmethod (9836-alpha erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (setf cursor-column 0)
+ (for (from row 0 maxrow)
+ (do (setf cursor-row row)
+ (=> self clear-line)
+ ))
+ (setf cursor-row 0)
+ )
+
+(defmethod (9836-alpha clear-line) ()
+ (=> self write-line cursor-row #.(make-vector 80 32))
+ )
+
+(defmethod (9836-alpha convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ BLINK
+ UNDERLINE
+ INTENSIFY)
+ (dc-make-font-mask 0)
+ 16#FF)))
+ ch)
+
+(defmethod (9836-alpha normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (9836-alpha highlighted-enhancement) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ )
+
+(defmethod (9836-alpha supported-enhancements) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO BLINK UNDERLINE INTENSIFY)
+ )
+
+(defmethod (9836-alpha write-char) (row column ch)
+ (screen80-write-char buffer-address row column ch)
+ )
+
+(defmethod (9836-alpha write-line) (row data)
+ (screen80-write-line buffer-address row data)
+ )
+
+(defmethod (9836-alpha read-char) (row column)
+ (let ((offset (+ column (* row width))))
+ (halfword buffer-address offset)
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (9836-alpha init) ()
+ )
+
+(lap '((*entry screen80-write-char expr 4) % buffer-address row column word
+ (move!.l (reg 2) (reg t1))
+ (moveq 80 (reg t2))
+ (mulu (reg t1) (reg t2))
+ (add!.l (reg 3) (reg t2))
+ (lsl!.l 1 (reg t2))
+ (move!.w (reg 4) (indexed (reg t2) (displacement (reg 1) 0)))
+ (rts)
+ ))
+
+(lap '((*entry screen80-write-line expr 3) % buffer-address row data
+ (move!.l (reg 2) (reg t1)) % move row address to T1
+ (moveq 80 (reg t2)) % move 80 to T2
+ (mulu (reg t1) (reg t2)) % multiply row address by 80
+ (lsl!.l 1 (reg t2)) % convert to byte offset
+ (adda!.l (reg t2) (reg 1)) % A1: address of line in buffer
+ (move!.l (minus 80) (reg t1))
+ (addq!.l 4 (reg 3)) % skip data header word
+ (*lbl (label loop))
+ (addq!.l 2 (reg 3)) % skip upper halfword in data
+ (move!.w (autoincrement (reg 3)) (autoincrement (reg 1)))
+ (addq!.l 1 (reg t1))
+ (bmi (label loop))
+ (rts)
+ ))
ADDED psl-1983/3-1/windows/9836-bitmap.sl
Index: psl-1983/3-1/windows/9836-bitmap.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/9836-bitmap.sl
@@ -0,0 +1,261 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% 9836-Bitmap.SL - Terminal Interface for 9836 Bitmap Display
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 March 1983
+%
+% This code is adapted from 9836-COLOR.SL. It assumes a contiguous bitmap
+% memory, one bit per pixel, byte-aligned, with an integral number of bytes
+% per scan row.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-vectors numeric-operators syslisp))
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(font8-patterns))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defflavor 9836-bitmap
+ (
+ % The following parameters may be set at initialization:
+
+ (device-address (+ 16#600000 (* 28 16#10000))) % address of device
+ (plane device-address) % address of bitmap
+ (raster-width 512) % must be a multiple of 8!
+ (raster-height 392)
+ (character-height 14) % raster lines in each character
+ (interline-spacing 0) % raster lines between each text row
+ (patterns font8-patterns) % raster images of characters
+ (display-on-function NIL) % optional function to turn on display
+ (display-off-function NIL) % optional function to turn off display
+
+ % the following variables are computed from the above:
+
+ character-row-spacing % number of raster lines per text row
+ height % number of rows of characters
+ width % number of columns of characters
+ maxrow % highest numbered row of characters
+ maxcol % highest numbered column of characters
+ raster-area % number of bits in display raster
+ raster-area-words % number of words in display raster
+ bytes-per-row % number of bytes per raster row
+ bytes-per-character-row % number of bytes per character row
+ blank-pattern % raster for blank character
+
+ % State variables:
+
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (inverse-video? NIL)
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ (settable-instance-variables inverse-video?)
+ (initable-instance-variables device-address plane raster-width
+ raster-height character-height
+ interline-spacing patterns
+ display-on-function display-off-function
+ )
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (9836-bitmap get-character) ()
+ (keyboard-input-character)
+ )
+
+(defmethod (9836-bitmap ring-bell) ()
+ (ChannelWriteChar 1 #\Bell)
+ )
+
+(defmethod (9836-bitmap move-cursor) (row column)
+ (=> self xor-cursor)
+ (setf cursor-row row)
+ (setf cursor-column column)
+ (=> self xor-cursor)
+ )
+
+(defmethod (9836-bitmap xor-cursor) ()
+ (when (and cursor-row cursor-column)
+ (let ((byte-offset (* cursor-row bytes-per-character-row)))
+ (setf byte-offset (+ byte-offset cursor-column))
+ (for (from i 1 character-height)
+ (do
+ (putbyte plane byte-offset (~ (byte plane byte-offset)))
+ (setf byte-offset (+ byte-offset bytes-per-row))
+ )))))
+
+(defmethod (9836-bitmap enter-raw-mode) ()
+ (when (not raw-mode)
+ % (EchoOff)
+ % Enable Keypad?
+ (=> self display-on)
+ (setf raw-mode T)
+ ))
+
+(defmethod (9836-bitmap leave-raw-mode) ()
+ (when raw-mode
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ % (EchoOn)
+ ))
+
+(defmethod (9836-bitmap display-on) ()
+ (when display-on-function
+ (apply display-on-function (list device-address))
+ ))
+
+(defmethod (9836-bitmap display-off) ()
+ (when display-off-function
+ (apply display-off-function (list device-address))
+ ))
+
+(defmethod (9836-bitmap erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (=> self &fill-plane plane 0 raster-area-words)
+ (setf cursor-column NIL)
+ (setf cursor-row NIL)
+ (=> self move-cursor 0 0)
+ )
+
+(defmethod (9836-bitmap &fill-plane) (address word-value count)
+ (when (> count 0)
+ (wputv address 0 word-value)
+ (=> self &fill-plane (+ address 4) word-value (- count 1))
+ ))
+
+(defmethod (9836-bitmap clear-line) ()
+ % Not implemented yet.
+ )
+
+(defmethod (9836-bitmap convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ (dc-make-font-mask 0)
+ 16#FF))) % 8 bits
+ ch)
+
+(defmethod (9836-bitmap normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (9836-bitmap highlighted-enhancement) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ )
+
+(defmethod (9836-bitmap supported-enhancements) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ )
+
+(defmethod (9836-bitmap write-line) (row line)
+ (for (from col 0 maxcol)
+ (do (=> self write-char row col (vector-fetch line col)))
+ ))
+
+(defmethod (9836-bitmap write-char) (row column ch)
+ (let* ((pattern (vector-fetch patterns (dc-character-code ch)))
+ (inverse-bit (& ch (dc-make-enhancement-mask INVERSE-VIDEO)))
+ (byte-offset (mul16 row bytes-per-character-row))
+ (address (+ plane (+ byte-offset column)))
+ (inverse? (xor (~= 0 inverse-bit) inverse-video?))
+ )
+ (if (xor inverse? (and (= cursor-row row)
+ (= cursor-column column)))
+ (write-inverted-char-raster pattern address bytes-per-row 14)
+ (write-char-raster pattern address bytes-per-row 14)
+ )))
+
+(defmethod (9836-bitmap set-character-pattern) (ch pattern)
+ % CH must be an ASCII code (0..255); pattern must be a vector of bytes or
+ % NIL.
+
+ (when (and (fixp ch) (>= ch 0) (<= ch (vector-upper-bound patterns))
+ (or (null pattern) (vectorp pattern))
+ )
+ (if (null pattern)
+ (setf pattern blank-pattern)
+ (setf pattern (copyvector pattern))
+ )
+ (when (< (vector-size pattern) character-height)
+ (setf pattern
+ (concat pattern
+ (make-vector (- character-height (vector-size pattern)) 0))))
+ (vector-store patterns ch pattern)
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (9836-bitmap init) (init-plist)
+ (setf raster-area (* raster-width raster-height))
+ (setf raster-area-words (/ raster-area 32))
+ (setf character-row-spacing (+ character-height interline-spacing))
+ (setf height (/ (+ raster-height interline-spacing) character-row-spacing))
+ (setf width (/ raster-width 8))
+ (setf maxrow (- height 1))
+ (setf maxcol (- width 1))
+ (setf bytes-per-row (/ raster-width 8))
+ (setf bytes-per-character-row (* bytes-per-row character-row-spacing))
+ (setf blank-pattern (make-vector character-height 0))
+ (fixup-font-patterns patterns character-height)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Examples of bitmap devices:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de create-color-bitmap ()
+ (create-color-bitmap-selectcode 28)
+ )
+
+(de create-color-bitmap-selectcode (select-code)
+ (let ((device-address (+ 16#600000 (* select-code 16#10000))))
+ (make-instance '9836-bitmap
+ 'device-address device-address
+ 'plane (+ device-address (* 2 32768))
+ 'raster-width 512
+ 'raster-height 392
+ 'character-height 14
+ 'interline-spacing 0
+ 'patterns font8-patterns
+ 'display-on-function #'color-display-on-function
+ 'display-off-function #'color-display-off-function
+ )))
+
+(de color-display-on-function (device-address)
+ (let ((device-register-values [41 32 34 3 50 5 49 49 0 7 0 0 0 0 0 0 0 0]))
+ (for (from i 0 17)
+ (do (putbyte device-address 16 i)
+ (putbyte device-address 18 (vector-fetch device-register-values i))
+ ))
+ (putbyte device-address 1 -128)
+ ))
+
+(de color-display-off-function (device-address)
+ (putbyte device-address 1 0)
+ )
+
+(de create-graphics-bitmap ()
+ (let ((device-address 16#530000))
+ (make-instance '9836-bitmap
+ 'device-address device-address
+ 'plane device-address
+ 'raster-width 512
+ 'raster-height 392
+ 'character-height 14
+ 'interline-spacing 0
+ 'patterns font8-patterns
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/windows/9836-color.sl
Index: psl-1983/3-1/windows/9836-color.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/9836-color.sl
@@ -0,0 +1,247 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% 9836-Color.SL - Terminal Interface for 9836 Color Display
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 23 December 1982
+% Revised: 16 March 1983
+%
+% 16-Mar-83 Alan Snyder
+% Removed font definition (now in Font8.SL). New font definition supports
+% 8-bit characters. Speed up write-char using hand-coded assembly language
+% routines. Speed up erase using tail recursion.
+% 4-Mar-83 Alan Snyder
+% Check for 8-bit characters being displayed.
+% 29-Dec-82 Alan Snyder
+% Added SET-CHARACTER-PATTERN method.
+% Font hacking; changed: ' ` " a b d p q r s u
+% Use WPUTV instead of PutWord (it's faster, because it's open-coded).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-vectors numeric-operators syslisp))
+(on fast-integers)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% External variables:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(fluid '(font8-patterns))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defflavor 9836-color
+ (
+ (height 28) % number of rows (0 indexed)
+ (maxrow 27) % highest numbered row
+ (width 64) % number of columns (0 indexed)
+ (maxcol 63) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (inverse-video? NIL)
+ (color-card (+ 16#600000 (* 28 16#10000)))
+ (blue-plane (+ color-card 32768))
+ (green-plane (+ blue-plane 32768))
+ (red-plane (+ green-plane 32768))
+ (text-plane green-plane)
+ (cursor-plane red-plane)
+ (background-plane blue-plane)
+ (color-register-values [41 32 34 3 50 5 49 49 0 7 0 0 0 0 0 0 0 0])
+ (color-raster-width 512)
+ (color-raster-height 392)
+ (color-raster-area (* color-raster-width color-raster-height))
+ (color-raster-area-bytes (/ color-raster-area 8))
+ (color-raster-area-halfwords (/ color-raster-area 16))
+ (color-raster-area-words (/ color-raster-area 32))
+ (bytes-per-row (/ color-raster-width 8))
+ (character-height 14)
+ (character-row-spacing 14)
+ (bytes-per-character-row (* bytes-per-row character-row-spacing))
+ (blank-pattern (make-vector character-height 0))
+ (full-pattern (make-vector character-height -1))
+ patterns
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ (settable-instance-variables inverse-video?)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (9836-color select-color) (new-color)
+ (selectq new-color
+ (GREEN (setf text-plane green-plane))
+ (BLUE (setf text-plane blue-plane))
+ (RED (setf text-plane red-plane))
+ ))
+
+(defmethod (9836-color select-cursor-color) (new-color)
+ (=> self write-cursor 0)
+ (selectq new-color
+ (GREEN (setf cursor-plane green-plane))
+ (BLUE (setf cursor-plane blue-plane))
+ (RED (setf cursor-plane red-plane))
+ )
+ (=> self write-cursor -1)
+ )
+
+(defmethod (9836-color select-background-color) (new-color)
+ (selectq new-color
+ (GREEN (setf background-plane green-plane))
+ (BLUE (setf background-plane blue-plane))
+ (RED (setf background-plane red-plane))
+ (nil (setf background-plane nil))
+ )
+ )
+
+(defmethod (9836-color get-character) ()
+ (keyboard-input-character)
+ )
+
+(defmethod (9836-color ring-bell) ()
+ (ChannelWriteChar 1 #\Bell)
+ )
+
+(defmethod (9836-color move-cursor) (row column)
+ (=> self write-cursor 0)
+ (setf cursor-row row)
+ (setf cursor-column column)
+ (=> self write-cursor -1)
+ )
+
+(defmethod (9836-color write-cursor) (bits)
+ (let ((byte-offset (* cursor-row bytes-per-character-row)))
+ (setf byte-offset (+ byte-offset cursor-column))
+ (for (from i 0 13)
+ (do
+ (putbyte cursor-plane byte-offset bits)
+ (setf byte-offset (+ byte-offset bytes-per-row))
+ ))))
+
+(defmethod (9836-color enter-raw-mode) ()
+ (when (not raw-mode)
+ % (EchoOff)
+ % Enable Keypad?
+ (=> self display-on)
+ (setf raw-mode T)
+ ))
+
+(defmethod (9836-color leave-raw-mode) ()
+ (when raw-mode
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ % (EchoOn)
+ ))
+
+(defmethod (9836-color display-on) ()
+ (for (from i 0 17)
+ (do (putbyte color-card 16 i)
+ (putbyte color-card 18 (vector-fetch color-register-values i))
+ ))
+ (putbyte color-card 1 -128)
+ )
+
+(defmethod (9836-color display-off) ()
+ (putbyte color-card 1 0)
+ )
+
+(defmethod (9836-color erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (let ((blue-word (if (= background-plane blue-plane) -1 0))
+ (green-word (if (= background-plane green-plane) -1 0))
+ (red-word (if (= background-plane red-plane) -1 0))
+ (count color-raster-area-words)
+ )
+ (=> self &fill-plane blue-plane blue-word count)
+ (=> self &fill-plane green-plane green-word count)
+ (=> self &fill-plane red-plane red-word count)
+ )
+ (setf cursor-column 0)
+ (setf cursor-row 0)
+ (=> self move-cursor 0 0)
+ )
+
+(defmethod (9836-color &fill-plane) (plane word-value count)
+ % Fill the specified plane with the specified word.
+ (when (> count 0)
+ (wputv plane 0 word-value)
+ (=> self &fill-plane (+ plane 4) word-value (- count 1))
+ ))
+
+(defmethod (9836-color clear-line) ()
+ % Not implemented yet.
+ )
+
+(defmethod (9836-color convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ % BLINK
+ % UNDERLINE
+ % INTENSIFY
+ )
+ (dc-make-font-mask 0)
+ 16#FF))) % 8 bits
+ ch)
+
+(defmethod (9836-color normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (9836-color highlighted-enhancement) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ )
+
+(defmethod (9836-color supported-enhancements) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ % BLINK UNDERLINE INTENSIFY
+ )
+ )
+
+(defmethod (9836-color write-line) (row line)
+ (for (from col 0 maxcol)
+ (do (=> self write-char row col (vector-fetch line col)))
+ ))
+
+(defmethod (9836-color write-char) (row column ch)
+ (let* ((pattern (vector-fetch patterns (dc-character-code ch)))
+ (inverse-bit (& ch (dc-make-enhancement-mask INVERSE-VIDEO)))
+ (byte-offset (mul16 row bytes-per-character-row))
+ (address (+ text-plane (+ byte-offset column)))
+ (inverse? (xor (~= 0 inverse-bit) inverse-video?))
+ )
+ (if inverse?
+ (write-inverted-char-raster pattern address bytes-per-row 14)
+ (write-char-raster pattern address bytes-per-row 14)
+ )))
+
+(defmethod (9836-color set-character-pattern) (ch pattern)
+ % CH must be an ASCII code (0..255); pattern must be a vector
+ % of bytes or NIL.
+
+ (when (and (fixp ch) (>= ch 0) (<= ch (vector-upper-bound patterns))
+ (or (null pattern) (vectorp pattern))
+ )
+ (if (null pattern)
+ (setf pattern blank-pattern)
+ (setf pattern (copyvector pattern))
+ )
+ (when (< (vector-size pattern) character-height)
+ (setf pattern
+ (concat pattern
+ (make-vector (- character-height (vector-size pattern)) 0))))
+ (vector-store patterns ch pattern)
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (9836-color init) (init-plist)
+ (setf patterns font8-patterns)
+ (fixup-font-patterns patterns character-height)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(off fast-integers)
ADDED psl-1983/3-1/windows/binary/ambassador.b
Index: psl-1983/3-1/windows/binary/ambassador.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/ambassador.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/hazeltine-1500.b
Index: psl-1983/3-1/windows/binary/hazeltine-1500.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/hazeltine-1500.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/hp2648a.b
Index: psl-1983/3-1/windows/binary/hp2648a.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/hp2648a.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/physical-screen.b
Index: psl-1983/3-1/windows/binary/physical-screen.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/physical-screen.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/shared-physical-screen.b
Index: psl-1983/3-1/windows/binary/shared-physical-screen.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/shared-physical-screen.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/teleray.b
Index: psl-1983/3-1/windows/binary/teleray.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/teleray.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/televideo.b
Index: psl-1983/3-1/windows/binary/televideo.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/televideo.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/virtual-screen.b
Index: psl-1983/3-1/windows/binary/virtual-screen.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/virtual-screen.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/vt100.b
Index: psl-1983/3-1/windows/binary/vt100.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/vt100.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/vt52nx.b
Index: psl-1983/3-1/windows/binary/vt52nx.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/vt52nx.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/vt52x.b
Index: psl-1983/3-1/windows/binary/vt52x.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/vt52x.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/binary/windows-20.b
Index: psl-1983/3-1/windows/binary/windows-20.b
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/binary/windows-20.b
cannot compute difference between binary files
ADDED psl-1983/3-1/windows/direct-physical-screen.sl
Index: psl-1983/3-1/windows/direct-physical-screen.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/direct-physical-screen.sl
@@ -0,0 +1,172 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Direct-Physical-Screen.SL - Write-Line and Direct-Write Version
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 August 1982
+% Revised: 20 December 1982
+%
+% Adapted from Will Galway's EMODE Virtual Screen package.
+%
+% A physical screen is a rectangular character display. Changes to the physical
+% screen are made using the Write operation. FULL-REFRESH should be called to
+% initialize the state of the display.
+%
+% 20-Dec-82 Alan Snyder
+% Added cached methods for terminal Convert-Character and Get-Character.
+% 17-Dec-82 Alan Snyder
+% Revised for the 9836 to write whole lines at a time, keeping track only
+% of which lines have been modified, or write each character directly,
+% according to the DIRECT? variable.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors display-char))
+
+(de create-physical-screen (display-terminal)
+ (make-instance 'physical-screen 'terminal display-terminal))
+
+(defflavor physical-screen
+ (height % number of rows (0 indexed)
+ maxrow % highest numbered row
+ width % number of columns (0 indexed)
+ maxcol % highest numbered column
+ cursor-row % desired cursor position after refresh
+ cursor-column % desired cursor position after refresh
+ terminal % the display terminal
+ new-image % image for next refresh
+ row-modified? % which rows need to be rewritten?
+ (direct? T) % write directly to the terminal
+ write-char-method % terminal's write-char method
+ write-line-method % terminal's write-line method
+ move-cursor-method % terminal's move-cursor method
+ get-char-method % terminal's get-character method
+ convert-char-method % terminal's convert-character method
+ )
+ ()
+ (gettable-instance-variables height width cursor-row cursor-column)
+ (settable-instance-variables direct?)
+ (initable-instance-variables terminal)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private Macros:
+
+(defmacro image-fetch (image row col)
+ `(vector-fetch (vector-fetch ,image ,row) ,col))
+(defmacro image-store (image row col value)
+ `(vector-store (vector-fetch ,image ,row) ,col ,value))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Public methods:
+
+(defmethod (physical-screen ring-bell) ()
+ (=> terminal ring-bell))
+
+(defmethod (physical-screen enter-raw-mode) ()
+ (=> terminal enter-raw-mode))
+
+(defmethod (physical-screen leave-raw-mode) ()
+ (=> terminal leave-raw-mode))
+
+(defmethod (physical-screen get-character) ()
+ (apply get-char-method (list terminal)))
+
+(defmethod (physical-screen convert-character) (ch)
+ (apply convert-char-method (list terminal ch)))
+
+(defmethod (physical-screen normal-enhancement) ()
+ (=> terminal normal-enhancement))
+
+(defmethod (physical-screen highlighted-enhancement) ()
+ (=> terminal highlighted-enhancement))
+
+(defmethod (physical-screen supported-enhancements) ()
+ (=> terminal supported-enhancements))
+
+(defmethod (physical-screen write) (ch row col)
+ (when (not (= ch (image-fetch new-image row col)))
+ (image-store new-image row col ch)
+ (if direct?
+ (apply write-char-method (list terminal row col ch))
+ (vector-store row-modified? row T)
+ )))
+
+(defmethod (physical-screen set-cursor-position) (row col)
+ (setf cursor-row row)
+ (setf cursor-column col)
+ (if direct? (apply move-cursor-method (list terminal row col)))
+ )
+
+(defmethod (physical-screen refresh) (breakout-allowed)
+ (when (and (not direct?)
+ (not (and breakout-allowed (input-available?)))
+ )
+ (for (from row 0 maxrow)
+ (when (vector-fetch row-modified? row))
+ (do
+ (apply write-line-method
+ (list terminal row (vector-fetch new-image row)))
+ (vector-store row-modified? row NIL)
+ ))
+ (apply move-cursor-method (list terminal cursor-row cursor-column))
+ ))
+
+(defmethod (physical-screen full-refresh) (breakout-allowed)
+ (=> terminal erase)
+ (when (not (and breakout-allowed (input-available?)))
+ (for (from row 0 maxrow)
+ (do
+ (apply write-line-method
+ (list terminal row (vector-fetch new-image row)))
+ (vector-store row-modified? row NIL)
+ ))
+ (apply move-cursor-method (list terminal cursor-row cursor-column))
+ ))
+
+(defmethod (physical-screen write-to-stream) (s)
+ (for (from row 0 maxrow)
+ (with line)
+ (do (setf line (vector-fetch new-image row))
+ (for (from col 0 maxcol)
+ (do (=> s putc (dc-character-code (vector-fetch line col))))
+ )
+ (=> s put-newline)
+ ))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private methods:
+
+(defmethod (physical-screen init) (init-plist) % For internal use only!
+ (setf height (=> terminal height))
+ (setf maxrow (- height 1))
+ (setf width (=> terminal width))
+ (setf maxcol (- width 1))
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf new-image (=> self create-image))
+ (setf row-modified? (make-vector height NIL))
+ (setf write-char-method (object-get-handler terminal 'write-char))
+ (setf write-line-method (object-get-handler terminal 'write-line))
+ (setf move-cursor-method (object-get-handler terminal 'move-cursor))
+ (setf get-char-method (object-get-handler terminal 'get-character))
+ (setf convert-char-method (object-get-handler terminal 'convert-character))
+ )
+
+(defmethod (physical-screen create-image) ()
+ (let ((image (MkVect maxrow))
+ (line (MkVect maxcol))
+ )
+ (for (from col 0 maxcol)
+ (do (vector-store line col #\space))
+ )
+ (for (from row 0 maxrow)
+ (do (vector-store image row (copyvector line)))
+ )
+ image))
ADDED psl-1983/3-1/windows/display-char.sl
Index: psl-1983/3-1/windows/display-char.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/display-char.sl
@@ -0,0 +1,54 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% DISPLAY-CHAR.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 8 October 1982
+%
+% This file defines MACROS. Load it at Compile Time!
+%
+% Display characters are ASCII characters that are "tagged" with display
+% enhancement bits. They are used by the Windows package. This file defines
+% macros for creating and manipulating display characters.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(load fast-int)
+
+(put 'INVERSE-VIDEO 'enhancement-bits 1)
+(put 'BLINK 'enhancement-bits 2)
+(put 'UNDERLINE 'enhancement-bits 4)
+(put 'INTENSIFY 'enhancement-bits 8)
+
+(dm dc-make-enhancement-mask (form)
+ (setf form (cdr form))
+ (let ((mask 0) bits)
+ (for (in keyword form)
+ (do (if (setf bits (get keyword 'enhancement-bits))
+ (setf mask (| mask bits))
+ (StdError (BldMsg "Undefined enhancement: %p" keyword))
+ )))
+ (<< mask 8)))
+
+(defmacro dc-make-font-mask (font-number)
+ `(<< ,font-number 12))
+
+(defmacro display-character-cons (enhancement-mask font-mask char-code)
+ `(| (| ,enhancement-mask ,font-mask) ,char-code))
+
+(defmacro dc-enhancement-mask (dc)
+ `(& ,dc 16#F00))
+
+(defmacro dc-enhancement-index (dc)
+ % Use this to index an array.
+ `(& (>> ,dc 8) 16#F))
+
+(defmacro dc-font-mask (dc)
+ `(& ,dc 16#F000))
+
+(defmacro dc-font-number (dc)
+ `(>> ,dc 12))
+
+(defmacro dc-character-code (dc)
+ `(& ,dc 16#FF))
ADDED psl-1983/3-1/windows/display-char.t
Index: psl-1983/3-1/windows/display-char.t
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/display-char.t
@@ -0,0 +1,56 @@
+ NOTES ON THE DISPLAY CHARACTER DATATYPE
+ Cris Perdue
+ 10/11/82
+ File: PW:DISPLAY-CHAR.T
+ -----------------------------------
+
+This module provides a set of macros for manipulating
+"display-character" objects. These objects are represented to
+LISP as integers, but are dealt with as a separate type of
+object.
+
+(DC-MAKE-ENHANCEMENT-MASK KEYWORD . . . ) Macro
+
+This macro generates a specific enhancement mask object. The
+keywords are unevaluated identifiers. At present, the possible
+keywords are INVERSE-VIDEO, BLINK, UNDERLINE, and INTENSIFY,
+which should be meaningful with respect to HP terminals.
+
+(DC-MAKE-FONT-MASK FONT-NUMBER) Macro
+
+This makes a font mask object, given a font number. Font numbers
+have no definition yet, because we have no fonts.
+
+(DISPLAY-CHARACTER-CONS ENHANCEMENT-MASK FONT-MASK CHAR-CODE) Macro
+
+This macro generates a display character object, given an
+enhancement mask, a font mask, and a character code. The mask
+objects' purpose in life is to be used as arguments to this
+function and to be compared against each other.
+
+(DC-ENHANCEMENT-MASK DC) Macro
+
+Extracts the enhancement mask from a display character.
+
+(DC-ENHANCEMENT-INDEX DC) Macro
+
+There are a finite number of different combinations of display
+enhancements that are possible for a display-character. This
+macro returns an integer in the range from 0 that uniquely
+identifies the combination of enhancements in effect for this
+display-character. There should probably be a symbolic constant
+giving the maximum value for the identifying integer. With N
+different enhancements, the value turns out to be 2 raised to the
+Nth power, minus 1.
+
+(DC-FONT-MASK DC) Macro
+
+Extracts the font mask from a display character.
+
+(DC-FONT-NUMBER DC) Macro
+
+Obtains the font number from a display character.
+
+(DC-CHARACTER-CODE DC) Macro
+
+Obtains the character code from a display character object.
ADDED psl-1983/3-1/windows/font8.sl
Index: psl-1983/3-1/windows/font8.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/font8.sl
@@ -0,0 +1,1171 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Font8.SL - Font Description with 8-bit wide characters
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 March 1983 (code taken from 9836-COLOR.SL)
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime (load fast-vectors))
+
+% Font8-Patterns is a vector of 256 elements. Each element is either NIL or a
+% Vector of integers. If NIL, the character has no definition and should be
+% displayed as blank space. If a Vector, then each Integer in the Vector
+% represents one scan line of the character, right adjusted, starting with the
+% top scan line. Blank scan lines at the bottom of the raster are not
+% included in the vector. The function fixup-font-patterns, defined at the
+% end of this file, can be used to convert this vector so that all elements
+% are vectors with a minimum size. The recommended character height is 14
+% scan lines, which includes interline spacing.
+
+(fluid '(font8-patterns))
+(setf font8-patterns
+ (vector % this vector must go in the heap, since it may be modified
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL
+ [2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00000000
+ 2#00000000
+ 2#00010000
+ 2#00010000
+ ]
+ [2#00100100
+ 2#00100100
+ 2#00100100
+ 2#00100100
+ ]
+ [2#00000000
+ 2#00000000
+ 2#01000100
+ 2#01000100
+ 2#11111110
+ 2#01000100
+ 2#01000100
+ 2#11111110
+ 2#01000100
+ 2#01000100
+ ]
+ [2#00010000
+ 2#01111100
+ 2#11010110
+ 2#10010000
+ 2#11010000
+ 2#01111100
+ 2#00010110
+ 2#00010010
+ 2#11010110
+ 2#01111100
+ 2#00010000
+ ]
+ [2#01100000
+ 2#10010000
+ 2#10010010
+ 2#01100100
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ 2#01001100
+ 2#10010010
+ 2#00010010
+ 2#00001100
+ ]
+ [2#00110000
+ 2#01001000
+ 2#10001000
+ 2#10001000
+ 2#10010000
+ 2#01100000
+ 2#01100000
+ 2#10010000
+ 2#10001010
+ 2#10000100
+ 2#01111010
+ ]
+ [2#00001000
+ 2#00001000
+ 2#00010000
+ 2#00010000
+ ]
+ [2#00001000
+ 2#00010000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00010000
+ 2#00001000
+ ]
+ [2#00100000
+ 2#00010000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#10010010
+ 2#01010100
+ 2#00111000
+ 2#11111110
+ 2#00111000
+ 2#01010100
+ 2#10010010
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#11111110
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00011000
+ 2#00011000
+ 2#00010000
+ 2#00100000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#11111110
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00110000
+ 2#00110000
+ ]
+ [2#00000010
+ 2#00000010
+ 2#00000100
+ 2#00000100
+ 2#00001000
+ 2#00001000
+ 2#00010000
+ 2#00010000
+ 2#00100000
+ 2#00100000
+ 2#01000000
+ 2#01000000
+ ]
+ [2#00111000
+ 2#01000100
+ 2#10000010
+ 2#10000110
+ 2#10001010
+ 2#10010010
+ 2#10100010
+ 2#11000010
+ 2#10000010
+ 2#01000100
+ 2#00111000
+ ]
+ [2#00010000
+ 2#00110000
+ 2#01010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#01111100
+ ]
+ [2#01111100
+ 2#11000110
+ 2#00000010
+ 2#00000100
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ 2#01000000
+ 2#10000000
+ 2#10000000
+ 2#11111110
+ ]
+ [2#01111100
+ 2#11000110
+ 2#00000010
+ 2#00000010
+ 2#00000110
+ 2#01111100
+ 2#00000110
+ 2#00000010
+ 2#00000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#00001000
+ 2#00011000
+ 2#00101000
+ 2#01001000
+ 2#10001000
+ 2#11111110
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ ]
+ [2#11111110
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111100
+ 2#00000110
+ 2#00000010
+ 2#00000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111100
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#11111110
+ 2#00000010
+ 2#00000010
+ 2#00000010
+ 2#00000100
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111100
+ 2#11000110
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111010
+ 2#00000010
+ 2#00000010
+ 2#00000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00110000
+ 2#00110000
+ 2#00000000
+ 2#00000000
+ 2#00110000
+ 2#00110000
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00011000
+ 2#00011000
+ 2#00000000
+ 2#00000000
+ 2#00011000
+ 2#00011000
+ 2#00010000
+ 2#00100000
+ ]
+ [2#00000100
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ 2#01000000
+ 2#10000000
+ 2#01000000
+ 2#00100000
+ 2#00010000
+ 2#00001000
+ 2#00000100
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#11111110
+ 2#00000000
+ 2#00000000
+ 2#11111110
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ ]
+ [2#01000000
+ 2#00100000
+ 2#00010000
+ 2#00001000
+ 2#00000100
+ 2#00000010
+ 2#00000100
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ 2#01000000
+ ]
+ [2#01111100
+ 2#10000010
+ 2#10000010
+ 2#00000010
+ 2#00000100
+ 2#00001000
+ 2#00010000
+ 2#00010000
+ 2#00000000
+ 2#00000000
+ 2#00010000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111110
+ 2#10000010
+ 2#10111010
+ 2#10101010
+ 2#10111010
+ 2#10001110
+ 2#10000000
+ 2#01111110
+ ]
+ [2#00010000
+ 2#00101000
+ 2#01000100
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#11111110
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ ]
+ [2#11111100
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#11111100
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#11111100
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11000110
+ 2#01111100
+ ]
+ [2#11111000
+ 2#10001100
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#10001100
+ 2#11111000
+ ]
+ [2#11111110
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111110
+ ]
+ [2#11111110
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10001110
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#11111110
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ ]
+ [2#01111100
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#01111100
+ ]
+ [2#00000100
+ 2#00000100
+ 2#00000100
+ 2#00000100
+ 2#00000100
+ 2#00000100
+ 2#00000100
+ 2#00000100
+ 2#10000100
+ 2#11001100
+ 2#01111000
+ ]
+ [2#10000010
+ 2#10000100
+ 2#10001000
+ 2#10010000
+ 2#10100000
+ 2#11000000
+ 2#10100000
+ 2#10010000
+ 2#10001000
+ 2#10000100
+ 2#10000010
+ ]
+ [2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111110
+ ]
+ [2#10000010
+ 2#11000110
+ 2#10101010
+ 2#10111010
+ 2#10010010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ ]
+ [2#11000010
+ 2#11000010
+ 2#11100010
+ 2#10100010
+ 2#10110010
+ 2#10010010
+ 2#10011010
+ 2#10001010
+ 2#10001110
+ 2#10000110
+ 2#10000110
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#11111100
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#11111100
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ ]
+ [2#00111000
+ 2#01000100
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10010010
+ 2#10011010
+ 2#01001100
+ 2#00111110
+ ]
+ [2#11111100
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#11111100
+ 2#10100000
+ 2#10010000
+ 2#10001000
+ 2#10000100
+ 2#10000010
+ ]
+ [2#01111100
+ 2#11000110
+ 2#10000000
+ 2#10000000
+ 2#11000000
+ 2#01111100
+ 2#00000110
+ 2#00000010
+ 2#00000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#11111110
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ ]
+ [2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#11000110
+ 2#01111100
+ ]
+ [2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#01000100
+ 2#01000100
+ 2#00101000
+ 2#00101000
+ 2#00010000
+ ]
+ [2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10010010
+ 2#10010010
+ 2#10101010
+ 2#10101010
+ 2#11000110
+ 2#10000010
+ ]
+ [2#10000010
+ 2#01000100
+ 2#01000100
+ 2#00101000
+ 2#00101000
+ 2#00010000
+ 2#00101000
+ 2#00101000
+ 2#01000100
+ 2#01000100
+ 2#10000010
+ ]
+ [2#10000010
+ 2#01000100
+ 2#01000100
+ 2#00101000
+ 2#00101000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ ]
+ [2#11111110
+ 2#00000010
+ 2#00000010
+ 2#00000100
+ 2#00001000
+ 2#01111100
+ 2#00100000
+ 2#01000000
+ 2#10000000
+ 2#10000000
+ 2#11111110
+ ]
+ [2#00111000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00111000
+ ]
+ [2#01000000
+ 2#01000000
+ 2#00100000
+ 2#00100000
+ 2#00010000
+ 2#00010000
+ 2#00001000
+ 2#00001000
+ 2#00000100
+ 2#00000100
+ 2#00000010
+ 2#00000010
+ ]
+ [2#00111000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00111000
+ ]
+ [2#00010000
+ 2#00101000
+ 2#01000100
+ 2#10000010
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#11111110
+ ]
+ [2#00010000
+ 2#00010000
+ 2#00001000
+ 2#00001000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111100
+ 2#00000010
+ 2#00000010
+ 2#01111110
+ 2#10000010
+ 2#10000110
+ 2#01111010
+ ]
+ [2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10111100
+ 2#11000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#11000010
+ 2#10111100
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111100
+ 2#10000010
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000010
+ 2#01111100
+ ]
+ [2#00000010
+ 2#00000010
+ 2#00000010
+ 2#00000010
+ 2#01111010
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#01111010
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111100
+ 2#10000010
+ 2#10000010
+ 2#11111100
+ 2#10000000
+ 2#10000000
+ 2#01111110
+ ]
+ [2#00011100
+ 2#00100010
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#11111000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111100
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#01111110
+ 2#00000010
+ 2#00000010
+ 2#10000010
+ 2#01111100
+ ]
+ [2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#11111100
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ ]
+ [2#00000000
+ 2#00010000
+ 2#00000000
+ 2#00000000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00001000
+ 2#00000000
+ 2#00000000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#00001000
+ 2#01001000
+ 2#00110000
+ 2#00000000
+ ]
+ [2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000100
+ 2#10001000
+ 2#10010000
+ 2#10100000
+ 2#11010000
+ 2#10001000
+ 2#10000100
+ ]
+ [2#01110000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#01111100
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#11101100
+ 2#10010010
+ 2#10010010
+ 2#10010010
+ 2#10010010
+ 2#10010010
+ 2#10010010
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#11111000
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111000
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#01111000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10111100
+ 2#11000010
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#11000010
+ 2#10111100
+ 2#10000000
+ 2#10000000
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111010
+ 2#10000110
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10000110
+ 2#01111010
+ 2#00000010
+ 2#00000010
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10111100
+ 2#11000010
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#10000000
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#01111100
+ 2#10000010
+ 2#10000000
+ 2#01111100
+ 2#00000010
+ 2#10000010
+ 2#01111100
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#11111000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100000
+ 2#00100100
+ 2#00011000
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10000100
+ 2#10001100
+ 2#01110100
+ 2#00000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10000010
+ 2#10000010
+ 2#01000100
+ 2#01000100
+ 2#00101000
+ 2#00111000
+ 2#00010000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10000010
+ 2#10000010
+ 2#10000010
+ 2#10010010
+ 2#10101010
+ 2#11000110
+ 2#10000010
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10000010
+ 2#01000100
+ 2#00101000
+ 2#00010000
+ 2#00101000
+ 2#01000100
+ 2#10000010
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10000010
+ 2#01000100
+ 2#01000100
+ 2#00101000
+ 2#00010000
+ 2#00100000
+ 2#01000000
+ 2#01000000
+ 2#10000000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#11111110
+ 2#00000100
+ 2#00001000
+ 2#00010000
+ 2#00100000
+ 2#01000000
+ 2#11111110
+ ]
+ [2#00001110
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00110000
+ 2#11100000
+ 2#00110000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00001110
+ ]
+ [2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ ]
+ [2#11100000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#00011000
+ 2#00001110
+ 2#00011000
+ 2#00010000
+ 2#00010000
+ 2#00010000
+ 2#11100000
+ ]
+ [2#00000000
+ 2#00000000
+ 2#00000000
+ 2#00000000
+ 2#10011100
+ 2#01110010
+ ]
+ NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL
+ ))
+
+(de fixup-font-patterns (patterns character-height)
+ % Ensure that each element of a font pattern vector is a vector with at
+ % least Character-Height elements. This modification does not change the
+ % appearance of the font, but allows the code using the font description to
+ % be more efficient (avoid bounds checking, etc.)
+
+ (let ((blank-pattern (make-vector character-height 0)))
+ (for (from i 0 (vector-upper-bound patterns))
+ (do (let ((fc (vector-fetch patterns i)))
+ (when (null fc) (setf fc blank-pattern))
+ (when (< (vector-size fc) character-height)
+ (setf fc (concat fc (make-vector
+ (- character-height (vector-size fc))
+ 0))))
+ (vector-store patterns i fc)
+ )))))
ADDED psl-1983/3-1/windows/hp2648a.sl
Index: psl-1983/3-1/windows/hp2648a.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/hp2648a.sl
@@ -0,0 +1,327 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% HP2648A.SL - Terminal Interface
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 16 August 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+
+(defflavor hp2648a (
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ markers % vector indicating locations of field markers
+ (marker-table % table for generating markers
+ (Vector
+ (char @) (char B) (char A) (char C)
+ (char D) (char F) (char E) (char G)
+ (char H) (char J) (char I) (char K)
+ (char L) (char N) (char M) (char O)
+ ))
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-n (n)
+ `(progn
+ (if (> ,n 9)
+ (PBOUT (+ (char 0) (/ ,n 10))))
+ (PBOUT (+ (char 0) (// ,n 10))))))
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move ()
+ `(out-chars ESC & !a)))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (hp2648a get-character) ()
+ (& (PBIN) 8#377)
+ )
+
+(defmethod (hp2648a ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (hp2648a move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (cond ((and (= row cursor-row) (= column cursor-column))) % no action needed
+ ((and (= row 0) (= column 0))
+ (out-chars ESC H)) % cursor HOME
+ ((= row cursor-row) % movement on current row
+ (cond ((= column 0)
+ (out-char CR)) % move to left margin
+ ((= column (- cursor-column 1))
+ (out-chars ESC D)) % move LEFT
+ ((= column (+ cursor-column 1))
+ (out-chars ESC C)) % move RIGHT
+ (t (out-move) (out-n column) (out-char C))))
+ ((= column cursor-column) % movement on same column
+ (cond ((= row (- cursor-row 1))
+ (out-chars ESC A)) % move UP
+ ((= row (+ cursor-row 1))
+ (out-char LF)) % move DOWN
+ (t (out-move) (out-n row) (out-char R))))
+ (t % arbitrary movement
+ (out-move) (out-n row) (out-char (lower R))
+ (out-n column) (out-char C)))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (hp2648a enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ (out-chars ESC & !s 1 A) % Enable Keypad
+ (setf raw-mode T)))
+
+(defmethod (hp2648a leave-raw-mode) ()
+ (when raw-mode
+ (setf raw-mode NIL)
+ (out-chars ESC & !s 0 A) % Disable Keypad
+ (EchoOn)))
+
+(defmethod (hp2648a erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars ESC H ESC J)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (for (from row 0 maxrow)
+ (do (let ((marker-line (vector-fetch markers row)))
+ (for (from col 0 maxcol)
+ (do (vector-store marker-line col NIL))
+ ))))
+ )
+
+(defmethod (hp2648a clear-line) ()
+ (out-chars ESC K)
+ (let ((marker-line (vector-fetch markers cursor-row)))
+ (for (from col cursor-column maxcol)
+ (do (vector-store marker-line col NIL))
+ )))
+
+(defmethod (hp2648a convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ BLINK
+ UNDERLINE
+ INTENSIFY)
+ (dc-make-font-mask 0)
+ 16#FF)))
+ (let ((code (dc-character-code ch)))
+ (if (or (< code #\space) (= code (char rubout)))
+ (setq ch #\space)))
+ ch)
+
+(defmethod (hp2648a normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (hp2648a highlighted-enhancement) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ )
+
+(defmethod (hp2648a supported-enhancements) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO BLINK UNDERLINE INTENSIFY)
+ )
+
+(defmethod (hp2648a update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ % This code is particularly complicated because of the way HP terminals
+ % implement display enhancements using field markers. Most terminals
+ % don't require this level of complexity.
+
+ (prog (last-nonblank-column col terminal-enhancement old new marker-line
+ first-col last-col)
+ (setf first-col (car columns))
+ (setf last-col (cdr columns))
+
+ (setf marker-line (vector-fetch markers row))
+
+ % Find out the minimal actual bounds:
+
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col) (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (if (> first-col last-col) (return NIL)) % No change at all!
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col) (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ % Using ClearEOL can cause problems when display enhancements are used. If
+ % you write to the position just to the right of the terminal's
+ % end-of-line, the existing field will be extended. To avoid this problem,
+ % we will avoid using ClearEOL where the immediately preceding character
+ % has a non-zero enhancement.
+
+ (when (= (vector-fetch new-line last-col) #\space)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column) #\space)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether we want to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2))
+ (or (<= last-nonblank-column 0)
+ (~= (dc-enhancement-mask
+ (vector-fetch old-line last-nonblank-column)) 0)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col #\space)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (other than those that will be taken care
+ % of by ClearEOL):
+
+ (setf col first-col) % current column under examination
+ (setf old (vector-fetch old-line col)) % terminal's contents at that location
+ (setf new (vector-fetch new-line col)) % new contents for that location
+ (setf terminal-enhancement (dc-enhancement-mask old))
+ % terminal's enhancement for that location
+ % (enhancement in OLD will not always be correct as we go)
+ (if (not (and (= cursor-row row) (<= cursor-column col)))
+ (=> self move-cursor row col))
+
+ (while (<= col last-col)
+
+ % First, we check to see if we need to write a new field marker.
+ % A field marker is needed if the terminal's idea of the current
+ % character's enhancement is different than the desired enhancement.
+
+ (when (~= terminal-enhancement (dc-enhancement-mask new))
+ (=> self move-cursor-forward col old-line)
+ (=> self write-field-marker new)
+ )
+
+ % Next, we check to see if we need to write a new character code.
+
+ (when (~= old new) % check this first for efficiency
+ (let ((old-code (dc-character-code old))
+ (new-code (dc-character-code new))
+ )
+ (when (or (and (= new-code #\space) (= col last-col))
+ % last SPACE must be written (may extend EOL)
+ (~= old-code new-code))
+ (=> self move-cursor-forward col old-line)
+ (PBOUT new-code)
+ (setf cursor-column (+ cursor-column 1))
+ (when (> cursor-column maxcol)
+ (setf cursor-column 0)
+ (setf cursor-row (+ cursor-row 1))
+ (if (> cursor-row maxrow)
+ (=> self move-cursor 0 0)))
+ ))
+ (vector-store old-line col new)
+ )
+
+ % The following code is executed only if there is a next character.
+
+ (if (< col maxcol)
+ (let* ((next-col (+ col 1))
+ (next-old (vector-fetch old-line next-col))
+ (next-new (vector-fetch new-line next-col))
+ )
+
+ % Compute the terminal's idea of the enhancement for the next
+ % character. This is invalid if we are about to ClearEOL, but
+ % that case doesn't matter.
+
+ (setf terminal-enhancement
+ (if (vector-fetch marker-line next-col) % field marker there
+ (dc-enhancement-mask next-old)
+ (dc-enhancement-mask new)))
+
+ (setf old next-old)
+ (setf new next-new)
+ ))
+
+ (setf col (+ col 1))
+ )
+
+ % Check to see if a final field marker is needed.
+
+ (when (and (<= col maxcol)
+ (or (null last-nonblank-column) (<= col last-nonblank-column))
+ (~= terminal-enhancement (dc-enhancement-mask old)))
+ (=> self move-cursor-forward col old-line)
+ (=> self write-field-marker new)
+ )
+
+ % Do the ClearEOL, if that's what we decided to do.
+
+ (when last-nonblank-column
+ (=> self move-cursor-forward (+ last-nonblank-column 1) old-line)
+ (=> self clear-line)
+ )
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (hp2648a init) ()
+ (setf markers (MkVect maxrow))
+ (for (from row 0 maxrow)
+ (do (vector-store markers row (MkVect maxcol)))
+ )
+ )
+
+(defmethod (hp2648a move-cursor-forward) (column line)
+ (cond ((> (- column cursor-column) 4)
+ (out-move) (out-n column) (out-char C)
+ (setf cursor-column column))
+ (t (while (< cursor-column column)
+ (PBOUT (dc-character-code (vector-fetch line cursor-column)))
+ (setf cursor-column (+ cursor-column 1))
+ ))))
+
+(defmethod (hp2648a write-field-marker) (ch)
+ (out-chars ESC & !d)
+ (PBOUT (vector-fetch marker-table (dc-enhancement-index ch)))
+ (vector-store (vector-fetch markers cursor-row) cursor-column T)
+ )
ADDED psl-1983/3-1/windows/perq.sl
Index: psl-1983/3-1/windows/perq.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/perq.sl
@@ -0,0 +1,257 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% PERQ.SL - Terminal Interface
+%
+% Author: Robert Kessler, U of Utah
+% Date: 27 Jan 1983
+% based on teleray.SL by G.Q.Maguire,Jr.
+% U of Utah
+% 3 November 1982
+% based on VT52X.SL by Alan Snyder
+% Hewlett-Packard/CRC
+% 6 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+
+(defflavor perq (
+ (height 70) % number of rows (0 indexed)
+ (maxrow 69) % highest numbered row
+ (width 84) % number of columns (0 indexed)
+ (maxcol 83) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-n (n)
+ `(progn
+ (if (> ,n 9)
+ (PBOUT (+ (char 0) (/ ,n 10))))
+ (PBOUT (+ (char 0) (// ,n 10))))))
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move (row col)
+ `(progn
+ (out-chars ESC Y)
+ (PBOUT (+ ,row 32))
+ (PBOUT (+ ,col 32)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (perq get-character) ()
+ (& (PBIN) 8#377)
+ )
+
+(defmethod (perq ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (perq move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (cond ((and (= row cursor-row) (= column cursor-column))) % no action needed
+ ((and (= row 0) (= column 0))
+ (out-chars ESC H)) % cursor HOME
+ ((= row cursor-row) % movement on current row
+ (cond ((= column 0)
+ (out-char CR)) % move to left margin
+ ((= column (- cursor-column 1))
+ (out-chars ESC D)) % move LEFT
+ ((= column (+ cursor-column 1))
+ (out-chars ESC C)) % move RIGHT
+ (t (out-move row column))))
+ ((= column cursor-column) % movement on same column
+ (cond ((= row (- cursor-row 1))
+ (out-chars ESC A)) % move UP
+ ((= row (+ cursor-row 1))
+ (out-char LF)) % move DOWN
+ (t (out-move row column))))
+ (t % arbitrary movement
+ (out-move row column)))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (perq enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (perq leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (perq erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars ESC H ESC J)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (perq clear-line) ()
+ (out-chars ESC K)
+ )
+
+(defmethod (perq convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ BLINK
+ UNDERLINE
+ INTENSIFY)
+ (dc-make-font-mask 0)
+ 16#FF)))
+ (let ((code (dc-character-code ch)))
+ (if (or (< code #\space) (= code (char rubout)))
+ (setq ch #\space)))
+ ch)
+
+(defmethod (perq normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (perq highlighted-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (perq supported-enhancements) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (perq update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether we want to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (if (not (and (= cursor-row row) (<= cursor-column first-col)))
+ (=> self move-cursor row first-col))
+
+ % The VT52X will scroll if we write to the bottom right position.
+ % This (hopefully temporary) hack will avoid writing there.
+ (if (and (= row maxrow) (= last-col maxcol))
+ (setf last-col (- maxcol 1))
+ )
+
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (~= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (if (~= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement)
+ )
+ (=> self &move-cursor-forward col old-line)
+ (PBOUT new-code)
+ (setf cursor-column (+ cursor-column 1))
+ (when (> cursor-column maxcol)
+ (setf cursor-column 0)
+ (setf cursor-row (+ cursor-row 1))
+ (if (> cursor-row maxrow)
+ (=> self move-cursor 0 0)
+ ))
+ (vector-store old-line col new)
+ )))))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self &move-cursor-forward (+ last-nonblank-column 1) old-line)
+ (=> self clear-line)
+ )
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (perq init) ()
+ )
+
+(defmethod (perq &move-cursor-forward) (column line)
+ (cond ((> (- column cursor-column) 4)
+ (out-move cursor-row column)
+ (setf cursor-column column))
+ (t (while (< cursor-column column)
+ (PBOUT (dc-character-code (vector-fetch line cursor-column)))
+ (setf cursor-column (+ cursor-column 1))
+ ))))
+
+(defmethod (perq &set-terminal-enhancement) (enh)
+)
ADDED psl-1983/3-1/windows/physical-screen.sl
Index: psl-1983/3-1/windows/physical-screen.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/physical-screen.sl
@@ -0,0 +1,217 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Physical-Screen.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 August 1982
+% Revised: 20 December 1982
+%
+% Adapted from Will Galway's EMODE Virtual Screen package.
+%
+% A physical screen is a rectangular character display. Changes to the physical
+% screen are made using the Write operation. These changes are saved and sent
+% to the actual display only when REFRESH or FULL-REFRESH is performed.
+% FULL-REFRESH should be called to initialize the state of the display.
+%
+% 20-Dec-82 Alan Snyder
+% Added cached terminal methods to improve efficiency.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors display-char))
+
+(de create-physical-screen (display-terminal)
+ (make-instance 'physical-screen 'terminal display-terminal))
+
+(defflavor physical-screen
+ (height % number of rows (0 indexed)
+ maxrow % highest numbered row
+ width % number of columns (0 indexed)
+ maxcol % highest numbered column
+ cursor-row % desired cursor position after refresh
+ cursor-column % desired cursor position after refresh
+ changed-row-range % bounds on rows where new-image differs from display
+ changed-column-ranges % bounds on columns in each row
+ terminal % the display terminal
+ new-image % new image (after refresh)
+ displayed-image % image on the display terminal
+ update-line-method % terminal's update-line method
+ move-cursor-method % terminal's move-cursor method
+ get-char-method % terminal's get-character method
+ convert-char-method % terminal's convert-character method
+ )
+ ()
+ (gettable-instance-variables height width cursor-row cursor-column)
+ (initable-instance-variables terminal)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private Macros:
+
+(defmacro image-fetch (image row col)
+ `(vector-fetch (vector-fetch ,image ,row) ,col))
+(defmacro image-store (image row col value)
+ `(vector-store (vector-fetch ,image ,row) ,col ,value))
+
+(defmacro range-create ()
+ `(cons 10000 0))
+(defmacro range-cons (min max)
+ `(cons ,min ,max))
+(defmacro range-min (r)
+ `(car ,r))
+(defmacro range-max (r)
+ `(cdr ,r))
+(defmacro range-set-min (r x)
+ `(rplaca ,r ,x))
+(defmacro range-set-max (r x)
+ `(rplacd ,r ,x))
+(defmacro range-reset (r)
+ `(let ((*r* ,r))
+ (rplaca *r* 10000) (rplacd *r* 0)))
+(defmacro range-empty? (r)
+ `(< (range-max ,r) (range-min ,r)))
+(defmacro range-within? (r x)
+ `(and (<= (range-min ,r) ,x) (<= ,x (range-max ,r))))
+(defmacro range-extend (r x)
+ `(let ((*r* ,r) (*x* ,x))
+ % New minimum if x < old minimum
+ (if (< *x* (range-min *r*)) (range-set-min *r* *x*))
+ % New maximum if x > old maximum.
+ (if (> *x* (range-max *r*)) (range-set-max *r* *x*))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Public methods:
+
+(defmethod (physical-screen ring-bell) ()
+ (=> terminal ring-bell))
+
+(defmethod (physical-screen enter-raw-mode) ()
+ (=> terminal enter-raw-mode))
+
+(defmethod (physical-screen leave-raw-mode) ()
+ (=> terminal leave-raw-mode))
+
+(defmethod (physical-screen get-character) ()
+ (apply get-char-method (list terminal)))
+
+(defmethod (physical-screen convert-character) (ch)
+ (apply convert-char-method (list terminal ch)))
+
+(defmethod (physical-screen normal-enhancement) ()
+ (=> terminal normal-enhancement))
+
+(defmethod (physical-screen highlighted-enhancement) ()
+ (=> terminal highlighted-enhancement))
+
+(defmethod (physical-screen supported-enhancements) ()
+ (=> terminal supported-enhancements))
+
+(defmethod (physical-screen write) (ch row col)
+ (when (~= ch (image-fetch new-image row col))
+ (image-store new-image row col ch)
+ (range-extend changed-row-range row)
+ (range-extend (vector-fetch changed-column-ranges row) col)
+ ))
+
+(defmethod (physical-screen set-cursor-position) (row col)
+ (setf cursor-row row)
+ (setf cursor-column col))
+
+(defmethod (physical-screen refresh) (breakout-allowed)
+ (for (from row (range-min changed-row-range)
+ (range-max changed-row-range))
+ (for break-count 0 (+ break-count 1))
+ (with changed-columns breakout)
+ (until (and breakout-allowed
+ (= (& break-count 3) 0) % test every 4 lines
+ (input-available?)
+ (setf breakout T)))
+ (do
+ (setf changed-columns (vector-fetch changed-column-ranges row))
+ (when (not (range-empty? changed-columns))
+ (apply update-line-method
+ (list terminal
+ row
+ (vector-fetch displayed-image row)
+ (vector-fetch new-image row)
+ changed-columns
+ ))
+ (range-reset changed-columns)))
+ (finally
+ (range-set-min changed-row-range row)
+ (if (range-empty? changed-row-range)
+ (range-reset changed-row-range))
+ (if (not (or breakout
+ (and breakout-allowed (input-available?))))
+ (apply move-cursor-method
+ (list terminal cursor-row cursor-column)))
+ )
+ ))
+
+(defmethod (physical-screen full-refresh) (breakout-allowed)
+ (=> terminal erase)
+ (for (from row 0 maxrow)
+ (with line range)
+ (do (setq range (vector-fetch changed-column-ranges row))
+ (range-set-min range 0)
+ (range-set-max range maxcol)
+ (setf line (vector-fetch displayed-image row))
+ (for (from col 0 maxcol)
+ (do (vector-store line col (char space)))
+ )
+ ))
+ (range-set-min changed-row-range 0)
+ (range-set-max changed-row-range maxrow)
+ (=> self refresh breakout-allowed)
+ )
+
+(defmethod (physical-screen write-to-stream) (s)
+ (for (from row 0 maxrow)
+ (with line)
+ (do (setf line (vector-fetch displayed-image row))
+ (for (from col 0 maxcol)
+ (do (=> s putc (dc-character-code (vector-fetch line col))))
+ )
+ (=> s put-newline)
+ ))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private methods:
+
+(defmethod (physical-screen init) (init-plist) % For internal use only!
+ (setf height (=> terminal height))
+ (setf maxrow (- height 1))
+ (setf width (=> terminal width))
+ (setf maxcol (- width 1))
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf displayed-image (=> self create-image))
+ (setf new-image (=> self create-image))
+ (setf changed-row-range (range-create))
+ (setf changed-column-ranges (MkVect maxrow))
+ (for (from row 0 maxrow)
+ (do (vector-store changed-column-ranges row (range-create))))
+ (setf update-line-method (object-get-handler terminal 'update-line))
+ (setf move-cursor-method (object-get-handler terminal 'move-cursor))
+ (setf get-char-method (object-get-handler terminal 'get-character))
+ (setf convert-char-method (object-get-handler terminal 'convert-character))
+ )
+
+(defmethod (physical-screen create-image) ()
+ (let ((image (MkVect maxrow))
+ (line (MkVect maxcol))
+ )
+ (for (from col 0 maxcol)
+ (do (vector-store line col (char space)))
+ )
+ (for (from row 0 maxrow)
+ (do (vector-store image row (copyvector line)))
+ )
+ image))
ADDED psl-1983/3-1/windows/shared-physical-screen.sl
Index: psl-1983/3-1/windows/shared-physical-screen.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/shared-physical-screen.sl
@@ -0,0 +1,307 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Shared-Physical-Screen.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 August 1982
+% Revised: 22 February 1983
+%
+% Inspired by Will Galway's EMODE Virtual Screen package.
+%
+% A shared-physical-screen is a rectangular character display whose display
+% area is shared by a number of different owners. An owner can be any object
+% that supports the following operations:
+%
+% Assert-Ownership () - assert ownership of all desired screen locations
+% Send-Changes (break-ok) - send all changed contents to the shared screen
+% Send-Contents (break-ok) - send entire contents to the shared screen
+% Screen-Cursor-Position () - return desired cursor position on screen
+%
+% Each character position on the physical screen is owned by a single owner.
+% Each owner is responsible for asserting ownership of those character
+% positions it wishes to be able to write on. The actual ownership of each
+% character position is determined by a prioritized list of owners. Owners
+% assert ownership in reverse order of priority; the highest priority owner
+% therefore appears to "overlap" all other owners.
+%
+% A shared physical screen object provides an opaque interface: no access to
+% the underlying physical screen object should be required.
+%
+% 22-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 27-Dec-82 Alan Snyder
+% Changed SELECT-PRIMARY-OWNER and REMOVE-OWNER to avoid redundant
+% recomputation (and screen rewriting).
+% 21-Dec-82 Alan Snyder
+% Efficiency hacks: Special tests for owners that are virtual-screens.
+% Added methods: &GET-OWNER-CHANGES, &GET-OWNER-CONTENTS, and
+% &ASSERT-OWNERSHIP.
+% 16-Dec-82 Alan Snyder
+% Bug fix: SET-SCREEN failed to update size (invoked the wrong method).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors))
+
+(de create-shared-physical-screen (physical-screen)
+ (make-instance 'shared-physical-screen 'screen physical-screen))
+
+(defflavor shared-physical-screen (
+ height % number of rows (0 indexed)
+ maxrow % highest numbered row
+ width % number of columns (0 indexed)
+ maxcol % highest numbered column
+ (owner-list NIL) % prioritized list of owners (lowest priority first)
+ (recalculate T) % T => must recalculate ownership
+ owner-map % maps screen location to owner (or NIL)
+ screen % the physical-screen
+ )
+ ()
+ (gettable-instance-variables height width)
+ (initable-instance-variables screen)
+ )
+
+(declare-flavor physical-screen screen)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private Macros:
+
+(defmacro map-fetch (map row col)
+ `(vector-fetch (vector-fetch ,map ,row) ,col))
+(defmacro map-store (map row col value)
+ `(vector-store (vector-fetch ,map ,row) ,col ,value))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Public methods:
+
+(defmethod (shared-physical-screen ring-bell) ()
+ (=> screen ring-bell))
+
+(defmethod (shared-physical-screen enter-raw-mode) ()
+ (=> screen enter-raw-mode))
+
+(defmethod (shared-physical-screen leave-raw-mode) ()
+ (=> screen leave-raw-mode))
+
+(defmethod (shared-physical-screen get-character) ()
+ (=> screen get-character))
+
+(defmethod (shared-physical-screen convert-character) (ch)
+ (=> screen convert-character ch))
+
+(defmethod (shared-physical-screen normal-enhancement) ()
+ (=> screen normal-enhancement))
+
+(defmethod (shared-physical-screen highlighted-enhancement) ()
+ (=> screen highlighted-enhancement))
+
+(defmethod (shared-physical-screen supported-enhancements) ()
+ (=> screen supported-enhancements))
+
+(defmethod (shared-physical-screen write-to-stream) (s)
+ (=> screen write-to-stream s))
+
+(defmethod (shared-physical-screen set-screen) (new-screen)
+ (setf screen new-screen)
+ (=> self &new-screen)
+ )
+
+(defmethod (shared-physical-screen owner) (row col)
+
+ % Return the current owner of the specified screen location.
+
+ (if recalculate (=> self &recalculate-ownership))
+ (if (and (>= row 0) (<= row maxrow) (>= col 0) (<= col maxcol))
+ (map-fetch owner-map row col)))
+
+(defmethod (shared-physical-screen select-primary-owner) (owner)
+
+ % Make the specified OWNER the primary owner (adding it to the list of owners,
+ % if not already there).
+
+ (when (not (eq (lastcar owner-list) owner)) % redundancy check
+ (setf owner-list (DelQIP owner owner-list))
+ (setf owner-list (aconc owner-list owner))
+ (when (not recalculate)
+ (=> self &assert-ownership owner)
+ (=> self &get-owner-contents owner nil)
+ (=> self &update-cursor owner)
+ )))
+
+(defmethod (shared-physical-screen remove-owner) (owner)
+
+ % Remove the specified owner from the list of owners. The owner will lose
+ % ownership of his screen area. Screen ownership will be recalculated in its
+ % entirety when necessary (to determine the new ownership of the screen area).
+
+ (when (memq owner owner-list) % redundancy check
+ (setf owner-list (DelQIP owner owner-list))
+ (setf recalculate T)
+ ))
+
+(defmethod (shared-physical-screen refresh) (breakout-allowed)
+
+ % Update the screen: obtain changed contents from the owners,
+ % send it to the screen, refresh the screen.
+
+ (if recalculate
+ (=> self &recalculate-ownership)
+ (=> self &get-owners-changes breakout-allowed)
+ )
+ (=> screen refresh breakout-allowed))
+
+(defmethod (shared-physical-screen full-refresh) (breakout-allowed)
+
+ % Just like REFRESH, except that the screen is cleared first. This operation
+ % should be used to initialize the state of the screen when the program
+ % starts or when uncontrolled output may have occured.
+
+ (if recalculate
+ (=> self &recalculate-ownership)
+ (=> self &get-owners-changes breakout-allowed)
+ )
+ (=> screen full-refresh breakout-allowed))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Semi-Private methods
+
+% The following methods are for use only by owners to perform the
+% AssertOwnership operation when invoked by this object:
+
+(defmethod (shared-physical-screen set-owner) (row col owner)
+ (if (and (>= row 0) (<= row maxrow) (>= col 0) (<= col maxcol))
+ (map-store owner-map row col owner)))
+
+(defmethod (shared-physical-screen set-owner-region) (row col h w owner)
+ % This method provided for convenience and efficiency.
+ (let ((last-row (+ row (- h 1)))
+ (last-col (+ col (- w 1)))
+ (map owner-map)
+ )
+ (cond ((and (<= row maxrow) (<= col maxcol) (>= last-row 0) (>= last-col 0))
+ (if (< row 0) (setf row 0))
+ (if (< col 0) (setf col 0))
+ (if (> last-row maxrow) (setf last-row maxrow))
+ (if (> last-col maxcol) (setf last-col maxcol))
+ (for (from r row last-row)
+ (do (for (from c col last-col)
+ (do
+ (map-store map r c owner))
+ )))))))
+
+% The following method is for use only by owners:
+
+(defmethod (shared-physical-screen write) (ch row col owner)
+
+ % Conditional write: write the specified character to the specified location
+ % only if that location is owned by the specified owner. The actual display
+ % will not be updated until REFRESH or FULL-REFRESH is performed.
+
+ (if (and (>= row 0) (<= row maxrow) (>= col 0) (<= col maxcol))
+ (progn
+ (if recalculate (=> self &recalculate-ownership))
+ (if (eq owner (map-fetch owner-map row col))
+ (=> screen write ch row col)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private methods:
+
+(defmethod (shared-physical-screen init) (init-plist)
+ (=> self &new-screen)
+ )
+
+(defmethod (shared-physical-screen &new-screen) ()
+ (setf height (=> screen height))
+ (setf width (=> screen width))
+ (=> self &new-size)
+ )
+
+(defmethod (shared-physical-screen &new-size) ()
+ (if (< height 0) (setf height 0))
+ (if (< width 0) (setf width 0))
+ (setf maxrow (- height 1))
+ (setf maxcol (- width 1))
+ (setf owner-map (mkvect maxrow))
+ (for (from row 0 maxrow)
+ (do (iputv owner-map row (mkvect maxcol))))
+ (setf recalculate t))
+
+(defmethod (shared-physical-screen &recalculate-ownership) ()
+
+ % Reset ownership to NIL, then ask all OWNERS to assert ownership.
+ % Then ask all OWNERS to send all contents.
+
+ (let ((map owner-map))
+ (for (from r 0 maxrow)
+ (do (for (from c 0 maxcol)
+ (do (map-store map r c NIL))))))
+ (for (in owner owner-list)
+ (do (=> self &assert-ownership owner)))
+ (setf recalculate NIL)
+ (=> self &get-owners-contents))
+
+(defmethod (shared-physical-screen &get-owners-changes) (breakout-allowed)
+
+ % Ask all OWNERS to send any changed contents.
+
+ (for (in owner owner-list)
+ (with last-owner)
+ (do (=> self &get-owner-changes owner breakout-allowed)
+ (setf last-owner owner))
+ (finally
+ (if last-owner (=> self &update-cursor last-owner)))
+ )
+ )
+
+(defmethod (shared-physical-screen &get-owner-changes) (owner breakout-allowed)
+ (if (eq (object-type owner) 'virtual-screen) % hack for efficiency
+ (virtual-screen$send-changes owner breakout-allowed)
+ (=> owner send-changes breakout-allowed)
+ ))
+
+(defmethod (shared-physical-screen &get-owners-contents) (breakout-allowed)
+
+ % Ask all OWNERS to send all of their contents; unowned screen area
+ % is blanked.
+
+ (let ((map owner-map))
+ (for (from r 0 maxrow)
+ (do (for (from c 0 maxcol)
+ (do (if (null (map-fetch map r c))
+ (=> screen write #\space r c)))))))
+ (for (in owner owner-list)
+ (with last-owner)
+ (do (=> self &get-owner-contents owner breakout-allowed)
+ (setf last-owner owner))
+ (finally
+ (if last-owner (=> self &update-cursor last-owner)))
+ )
+ )
+
+(defmethod (shared-physical-screen &get-owner-contents) (owner breakout-allowed)
+ (if (eq (object-type owner) 'virtual-screen) % hack for efficiency
+ (virtual-screen$send-contents owner breakout-allowed)
+ (=> owner send-contents breakout-allowed)
+ ))
+
+(defmethod (shared-physical-screen &assert-ownership) (owner)
+ (if (eq (object-type owner) 'virtual-screen) % hack for efficiency
+ (virtual-screen$assert-ownership owner)
+ (=> owner assert-ownership)
+ ))
+
+(defmethod (shared-physical-screen &update-cursor) (owner)
+ (let ((pair (if (eq (object-type owner) 'virtual-screen)
+ (virtual-screen$screen-cursor-position owner)
+ (=> owner screen-cursor-position)
+ )))
+ (if (PairP pair)
+ (=> screen set-cursor-position (car pair) (cdr pair)))))
+
+(undeclare-flavor screen)
ADDED psl-1983/3-1/windows/teleray.sl
Index: psl-1983/3-1/windows/teleray.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/teleray.sl
@@ -0,0 +1,256 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% TELERAY.SL - Terminal Interface
+%
+% Author: G.Q. Maguire Jr., U of Utah
+% Date: 3 Nov 1982
+% based on VT52X.SL by Alan Snyder
+% Hewlett-Packard/CRC
+% 6 October 1982
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+
+(defflavor teleray (
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-n (n)
+ `(progn
+ (if (> ,n 9)
+ (PBOUT (+ (char 0) (/ ,n 10))))
+ (PBOUT (+ (char 0) (// ,n 10))))))
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move (row col)
+ `(progn
+ (out-chars ESC Y)
+ (PBOUT (+ ,row 32))
+ (PBOUT (+ ,col 32)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (teleray get-character) ()
+ (& (PBIN) 8#377)
+ )
+
+(defmethod (teleray ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (teleray move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (cond ((and (= row cursor-row) (= column cursor-column))) % no action needed
+ ((and (= row 0) (= column 0))
+ (out-chars ESC H)) % cursor HOME
+ ((= row cursor-row) % movement on current row
+ (cond ((= column 0)
+ (out-char CR)) % move to left margin
+ ((= column (- cursor-column 1))
+ (out-chars ESC D)) % move LEFT
+ ((= column (+ cursor-column 1))
+ (out-chars ESC C)) % move RIGHT
+ (t (out-move row column))))
+ ((= column cursor-column) % movement on same column
+ (cond ((= row (- cursor-row 1))
+ (out-chars ESC A)) % move UP
+ ((= row (+ cursor-row 1))
+ (out-char LF)) % move DOWN
+ (t (out-move row column))))
+ (t % arbitrary movement
+ (out-move row column)))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (teleray enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (teleray leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (teleray erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars ESC H ESC J)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (teleray clear-line) ()
+ (out-chars ESC K)
+ )
+
+(defmethod (teleray convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ BLINK
+ UNDERLINE
+ INTENSIFY)
+ (dc-make-font-mask 0)
+ 16#FF)))
+ (let ((code (dc-character-code ch)))
+ (if (or (< code #\space) (= code (char rubout)))
+ (setq ch #\space)))
+ ch)
+
+(defmethod (teleray normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (teleray highlighted-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (teleray supported-enhancements) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (teleray update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether we want to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (if (not (and (= cursor-row row) (<= cursor-column first-col)))
+ (=> self move-cursor row first-col))
+
+ % The VT52X will scroll if we write to the bottom right position.
+ % This (hopefully temporary) hack will avoid writing there.
+ (if (and (= row maxrow) (= last-col maxcol))
+ (setf last-col (- maxcol 1))
+ )
+
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (~= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (if (~= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement)
+ )
+ (=> self &move-cursor-forward col old-line)
+ (if (> new-code 127)
+ (progn (PBOUT 27) (PBOUT 82) (PBOUT (+ 64 (- new-code 128))))
+ (PBOUT new-code))
+ (setf cursor-column (+ cursor-column 1))
+ (when (> cursor-column maxcol)
+ (setf cursor-column 0)
+ (setf cursor-row (+ cursor-row 1))
+ (if (> cursor-row maxrow)
+ (=> self move-cursor 0 0)
+ ))
+ (vector-store old-line col new)
+ )))))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self &move-cursor-forward (+ last-nonblank-column 1) old-line)
+ (=> self clear-line)
+ )
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (teleray init) ()
+ )
+
+(defmethod (teleray &move-cursor-forward) (column line)
+ (cond ((> (- column cursor-column) 4)
+ (out-move cursor-row column)
+ (setf cursor-column column))
+ (t (while (< cursor-column column)
+ (PBOUT (dc-character-code (vector-fetch line cursor-column)))
+ (setf cursor-column (+ cursor-column 1))
+ ))))
+
+(defmethod (teleray &set-terminal-enhancement) (enh)
+)
ADDED psl-1983/3-1/windows/vax-physical-screen.sl
Index: psl-1983/3-1/windows/vax-physical-screen.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/vax-physical-screen.sl
@@ -0,0 +1,225 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Physical-Screen.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 17 August 1982
+% Revised: 20 December 1982
+%
+% Adapted from Will Galway's EMODE Virtual Screen package.
+%
+% A physical screen is a rectangular character display. Changes to the physical
+% screen are made using the Write operation. These changes are saved and sent
+% to the actual display only when REFRESH or FULL-REFRESH is performed.
+% FULL-REFRESH should be called to initialize the state of the display.
+%
+% 20-Dec-82 Alan Snyder
+% Added cached terminal methods to improve efficiency.
+%
+% 3-Mar-83 17:40:36, Edit by GALWAY
+% Inserted calls to FlushStdOutputBuffer, to make refresh work on the
+% Vax.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors display-char))
+
+(de create-physical-screen (display-terminal)
+ (make-instance 'physical-screen 'terminal display-terminal))
+
+(defflavor physical-screen
+ (height % number of rows (0 indexed)
+ maxrow % highest numbered row
+ width % number of columns (0 indexed)
+ maxcol % highest numbered column
+ cursor-row % desired cursor position after refresh
+ cursor-column % desired cursor position after refresh
+ changed-row-range % bounds on rows where new-image differs from display
+ changed-column-ranges % bounds on columns in each row
+ terminal % the display terminal
+ new-image % new image (after refresh)
+ displayed-image % image on the display terminal
+ update-line-method % terminal's update-line method
+ move-cursor-method % terminal's move-cursor method
+ get-char-method % terminal's get-character method
+ convert-char-method % terminal's convert-character method
+ )
+ ()
+ (gettable-instance-variables height width cursor-row cursor-column)
+ (initable-instance-variables terminal)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private Macros:
+
+(defmacro image-fetch (image row col)
+ `(vector-fetch (vector-fetch ,image ,row) ,col))
+(defmacro image-store (image row col value)
+ `(vector-store (vector-fetch ,image ,row) ,col ,value))
+
+(defmacro range-create ()
+ `(cons 10000 0))
+(defmacro range-cons (min max)
+ `(cons ,min ,max))
+(defmacro range-min (r)
+ `(car ,r))
+(defmacro range-max (r)
+ `(cdr ,r))
+(defmacro range-set-min (r x)
+ `(rplaca ,r ,x))
+(defmacro range-set-max (r x)
+ `(rplacd ,r ,x))
+(defmacro range-reset (r)
+ `(let ((*r* ,r))
+ (rplaca *r* 10000) (rplacd *r* 0)))
+(defmacro range-empty? (r)
+ `(< (range-max ,r) (range-min ,r)))
+(defmacro range-within? (r x)
+ `(and (<= (range-min ,r) ,x) (<= ,x (range-max ,r))))
+(defmacro range-extend (r x)
+ `(let ((*r* ,r) (*x* ,x))
+ % New minimum if x < old minimum
+ (if (< *x* (range-min *r*)) (range-set-min *r* *x*))
+ % New maximum if x > old maximum.
+ (if (> *x* (range-max *r*)) (range-set-max *r* *x*))
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Public methods:
+
+(defmethod (physical-screen ring-bell) ()
+ (=> terminal ring-bell))
+
+(defmethod (physical-screen enter-raw-mode) ()
+ (=> terminal enter-raw-mode))
+
+(defmethod (physical-screen leave-raw-mode) ()
+ (=> terminal leave-raw-mode))
+
+(defmethod (physical-screen get-character) ()
+ (apply get-char-method (list terminal)))
+
+(defmethod (physical-screen convert-character) (ch)
+ (apply convert-char-method (list terminal ch)))
+
+(defmethod (physical-screen normal-enhancement) ()
+ (=> terminal normal-enhancement))
+
+(defmethod (physical-screen highlighted-enhancement) ()
+ (=> terminal highlighted-enhancement))
+
+(defmethod (physical-screen supported-enhancements) ()
+ (=> terminal supported-enhancements))
+
+(defmethod (physical-screen write) (ch row col)
+ (when (~= ch (image-fetch new-image row col))
+ (image-store new-image row col ch)
+ (range-extend changed-row-range row)
+ (range-extend (vector-fetch changed-column-ranges row) col)
+ ))
+
+(defmethod (physical-screen set-cursor-position) (row col)
+ (setf cursor-row row)
+ (setf cursor-column col))
+
+(defmethod (physical-screen refresh) (breakout-allowed)
+ (for (from row (range-min changed-row-range)
+ (range-max changed-row-range))
+ (for break-count 0 (+ break-count 1))
+ (with changed-columns breakout)
+ (until (and breakout-allowed
+ (= (& break-count 3) 0) % test every 4 lines
+ (input-available?)
+ (setf breakout T)))
+ (do
+ (setf changed-columns (vector-fetch changed-column-ranges row))
+ (when (not (range-empty? changed-columns))
+ (apply update-line-method
+ (list terminal
+ row
+ (vector-fetch displayed-image row)
+ (vector-fetch new-image row)
+ changed-columns
+ ))
+ (range-reset changed-columns)
+ (FlushStdOutputBuffer)))
+ (finally
+ (range-set-min changed-row-range row)
+ (if (range-empty? changed-row-range)
+ (range-reset changed-row-range))
+ (if (not (or breakout
+ (and breakout-allowed (input-available?))))
+ (apply move-cursor-method
+ (list terminal cursor-row cursor-column)))
+
+ % Perhaps the "move-cursor-method" should do the flushing?
+ (FlushStdOutputBuffer)
+ )
+ ))
+
+(defmethod (physical-screen full-refresh) (breakout-allowed)
+ (=> terminal erase)
+ (for (from row 0 maxrow)
+ (with line range)
+ (do (setq range (vector-fetch changed-column-ranges row))
+ (range-set-min range 0)
+ (range-set-max range maxcol)
+ (setf line (vector-fetch displayed-image row))
+ (for (from col 0 maxcol)
+ (do (vector-store line col (char space)))
+ )
+ ))
+ (range-set-min changed-row-range 0)
+ (range-set-max changed-row-range maxrow)
+ (=> self refresh breakout-allowed)
+ )
+
+(defmethod (physical-screen write-to-stream) (s)
+ (for (from row 0 maxrow)
+ (with line)
+ (do (setf line (vector-fetch displayed-image row))
+ (for (from col 0 maxcol)
+ (do (=> s putc (dc-character-code (vector-fetch line col))))
+ )
+ (=> s put-newline)
+ ))
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+% Private methods:
+
+(defmethod (physical-screen init) (init-plist) % For internal use only!
+ (setf height (=> terminal height))
+ (setf maxrow (- height 1))
+ (setf width (=> terminal width))
+ (setf maxcol (- width 1))
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf displayed-image (=> self create-image))
+ (setf new-image (=> self create-image))
+ (setf changed-row-range (range-create))
+ (setf changed-column-ranges (MkVect maxrow))
+ (for (from row 0 maxrow)
+ (do (vector-store changed-column-ranges row (range-create))))
+ (setf update-line-method (object-get-handler terminal 'update-line))
+ (setf move-cursor-method (object-get-handler terminal 'move-cursor))
+ (setf get-char-method (object-get-handler terminal 'get-character))
+ (setf convert-char-method (object-get-handler terminal 'convert-character))
+ )
+
+(defmethod (physical-screen create-image) ()
+ (let ((image (MkVect maxrow))
+ (line (MkVect maxcol))
+ )
+ (for (from col 0 maxcol)
+ (do (vector-store line col (char space)))
+ )
+ (for (from row 0 maxrow)
+ (do (vector-store image row (copyvector line)))
+ )
+ image))
ADDED psl-1983/3-1/windows/virtual-screen.sl
Index: psl-1983/3-1/windows/virtual-screen.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/virtual-screen.sl
@@ -0,0 +1,334 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% Virtual-Screen.SL
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 18 August 1982
+% Revised: 22 February 1983
+%
+% Inspired by Will Galway's EMODE Virtual Screen package.
+%
+% A virtual screen is an object that can be used as independent rectangular
+% character display, but in fact shares a physical screen with other objects. A
+% virtual screen object maintains a stored representation of the image on the
+% virtual screen, which is used to update the physical screen when new areas of
+% the virtual screen become "exposed". A virtual screen does not itself
+% maintain any information about changes to its contents. It sends all changes
+% directly to the physical screen as they are made, and sends the entire screen
+% contents to the physical screen upon its request.
+%
+% A virtual screen is a legitimate "owner" for a shared physical screen, in that
+% it satisfies the required interface.
+%
+% 22-Feb-83 Alan Snyder
+% Declare -> Declare-Flavor.
+% 28-Dec-82 Alan Snyder
+% Avoid writing to shared screen when virtual screen is not exposed. Add
+% WRITE-STRING and WRITE-VECTOR methods. Improve efficiency of CLEAR-TO-EOL
+% method. Remove patch that avoided old compiler bug. Reformat.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load fast-int fast-vectors display-char))
+
+(de create-virtual-screen (shared-physical-screen)
+ (make-instance 'virtual-screen 'screen shared-physical-screen))
+
+(defflavor virtual-screen
+ ((height (=> screen height)) % number of rows (0 indexed)
+ maxrow % highest numbered row
+ (width (=> screen width)) % number of columns (0 indexed)
+ maxcol % highest numbered column
+ (row-origin 0) % position of upper left on the shared screen
+ (column-origin 0) % position of upper left on the shared screen
+ (default-enhancement (=> screen normal-enhancement))
+ (cursor-row 0) % the virtual cursor position
+ (cursor-column 0) % the virtual cursor position
+ (exposed? NIL)
+ image % the virtual image
+ screen % the shared-physical-screen
+ )
+ ()
+ (gettable-instance-variables height width row-origin column-origin screen
+ exposed?)
+ (settable-instance-variables default-enhancement)
+ (initable-instance-variables height width row-origin column-origin screen
+ default-enhancement)
+ )
+
+(declare-flavor shared-physical-screen screen)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Private Macros:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmacro image-fetch (image row col)
+ `(vector-fetch (vector-fetch ,image ,row) ,col))
+(defmacro image-store (image row col value)
+ `(vector-store (vector-fetch ,image ,row) ,col ,value))
+
+(dm for-all-positions (form)
+ % Executes the body repeatedly with the following variables
+ % bound: ROW, COL, SCREEN-ROW, SCREEN-COL.
+ `(for (from row 0 maxrow)
+ (with screen-row)
+ (do (setf screen-row (+ row-origin row))
+ (for (from col 0 maxcol)
+ (with screen-col ch)
+ (do (setf screen-col (+ column-origin col))
+ ,@(cdr form)
+ )))))
+
+(dm for-all-columns (form)
+ % Executes the body repeatedly with the following variables
+ % bound: COL, SCREEN-COL.
+ `(for (from col 0 maxcol)
+ (with screen-col ch)
+ (do (setf screen-col (+ column-origin col))
+ ,@(cdr form)
+ )))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Public methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (virtual-screen set-size) (new-height new-width)
+ % Change the size of the screen. The screen is first DeExposed. The contents
+ % are cleared. You must Expose the screen yourself if you want it to be
+ % displayed.
+
+ (=> self deexpose)
+ (setf height new-height)
+ (setf width new-width)
+ (=> self &new-size)
+ )
+
+(defmethod (virtual-screen set-origin) (new-row new-column)
+ % Change the location of the screen. The screen is first DeExposed. You must
+ % Expose the screen yourself if you want it to be displayed.
+
+ (=> self deexpose)
+ (setf row-origin new-row)
+ (setf column-origin new-column)
+ )
+
+(defmethod (virtual-screen set-cursor-position) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((> row maxrow) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((> column maxcol) (setf column maxcol)))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (virtual-screen write) (ch row column)
+ % Write one character using the default enhancement.
+ (if (and (>= row 0) (<= row maxrow) (>= column 0) (<= column maxcol))
+ (let ((dc (display-character-cons default-enhancement 0 (& ch 16#FF)))
+ (screen-row (+ row row-origin))
+ )
+ (setq dc (=> screen convert-character dc))
+ (image-store image row column dc)
+ (if exposed?
+ (=> screen write dc screen-row (+ column column-origin) self))
+ )))
+
+(defmethod (virtual-screen write-range) (ch row left-column right-column)
+ % Write repeatedly.
+ (when (and (>= row 0)
+ (<= row maxrow)
+ (<= left-column maxcol)
+ (>= right-column 0)
+ )
+ (if (< left-column 0) (setf left-column 0))
+ (if (> right-column maxcol) (setf right-column maxcol))
+ (let ((dc (display-character-cons default-enhancement 0 (& ch 16#FF)))
+ (screen-row (+ row row-origin))
+ )
+ (setq dc (=> screen convert-character dc))
+ (for (from col left-column right-column)
+ (do (image-store image row col dc)
+ (if exposed?
+ (=> screen write dc screen-row (+ col column-origin) self))
+ )))))
+
+(defmethod (virtual-screen write-display-character) (dc row column)
+ % Write one character (explicit enhancement)
+ (when (and (>= row 0) (<= row maxrow) (>= column 0) (<= column maxcol))
+ (setq dc (=> screen convert-character dc))
+ (image-store image row column dc)
+ (if exposed?
+ (=> screen write dc (+ row row-origin) (+ column column-origin) self))
+ ))
+
+(defmethod (virtual-screen write-string) (row left-column s count)
+ % S is a string of characters. Write S[0..COUNT-1] using the default
+ % enhancement to the specified row, starting at the specified column.
+
+ (when (and (> count 0)
+ (>= row 0)
+ (<= row maxrow)
+ (<= left-column maxcol)
+ (> (+ left-column count) 0)
+ )
+ (let ((smax (- count 1))
+ (image-row (vector-fetch image row))
+ (screen-row (+ row row-origin))
+ )
+ (if (< left-column 0) (setf left-column 0))
+ (if (> (+ left-column smax) maxcol)
+ (setf smax (- maxcol left-column)))
+ (for (from i 0 smax)
+ (for col left-column (+ col 1))
+ (for screen-col (+ left-column column-origin) (+ screen-col 1))
+ (do
+ (let ((ch (string-fetch s i)))
+ (setf ch (display-character-cons default-enhancement 0 ch))
+ (setf ch (=> screen convert-character ch))
+ (vector-store image-row col ch)
+ (if exposed?
+ (=> screen write ch screen-row screen-col self))
+ ))))))
+
+(defmethod (virtual-screen write-vector) (row left-column v count)
+ % V is a vector of display-characters. Write V[0..COUNT-1] to the specified
+ % row, starting at the specified column.
+
+ (when (and (> count 0)
+ (>= row 0)
+ (<= row maxrow)
+ (<= left-column maxcol)
+ (> (+ left-column count) 0)
+ )
+ (let ((vmax (- count 1))
+ (image-row (vector-fetch image row))
+ (screen-row (+ row row-origin))
+ )
+ (if (< left-column 0) (setf left-column 0))
+ (if (> (+ left-column vmax) maxcol)
+ (setf vmax (- maxcol left-column)))
+ (for (from i 0 vmax)
+ (for col left-column (+ col 1))
+ (for screen-col (+ left-column column-origin) (+ screen-col 1))
+ (do
+ (let ((ch (vector-fetch v i)))
+ (vector-store image-row col ch)
+ (if exposed?
+ (=> screen write ch screen-row screen-col self))
+ ))))))
+
+(defmethod (virtual-screen clear) ()
+ (let ((dc (display-character-cons default-enhancement 0 #\space)))
+ (setq dc (=> screen convert-character dc))
+ (for-all-positions
+ (image-store image row col dc)
+ )
+ (if exposed?
+ (for-all-positions
+ (=> screen write dc screen-row screen-col self)
+ ))
+ ))
+
+(defmethod (virtual-screen clear-to-end) (first-row)
+ (if (< first-row 0) (setf first-row 0))
+ (let ((dc (display-character-cons default-enhancement 0 #\space)))
+ (setq dc (=> screen convert-character dc))
+ (for (from row first-row maxrow)
+ (with screen-row)
+ (do (setf screen-row (+ row-origin row))
+ (for-all-columns
+ (image-store image row col dc)
+ )
+ (if exposed?
+ (for-all-columns
+ (=> screen write dc screen-row screen-col self)
+ ))
+ ))))
+
+(defmethod (virtual-screen clear-to-eol) (row first-column)
+ (when (and (>= row 0) (<= row maxrow))
+ (if (< first-column 0) (setf first-column 0))
+ (let ((dc (display-character-cons default-enhancement 0 #\space))
+ (image-row (vector-fetch image row))
+ )
+ (setq dc (=> screen convert-character dc))
+ (for (from col first-column maxcol)
+ (do (vector-store image-row col dc)))
+ (if exposed?
+ (let ((screen-row (+ row row-origin)))
+ (for
+ (from col (+ first-column column-origin) (+ maxcol column-origin))
+ (do (=> screen write dc screen-row col self)))))
+ )))
+
+(defmethod (virtual-screen expose) ()
+ % Expose the screen. Make it overlap all other screens.
+ (=> screen select-primary-owner self)
+ (setf exposed? T)
+ )
+
+(defmethod (virtual-screen deexpose) ()
+ % Remove the screen from the display.
+ (when exposed?
+ (=> screen remove-owner self)
+ (setf exposed? NIL)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Semi-Private methods:
+% The following methods are for use ONLY by the shared physical screen.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (virtual-screen send-changes) (breakout-allowed)
+ % This method is invoked by the shared physical screen to obtain any buffered
+ % changes to the virtual screen image. Since the virtual screen does not
+ % buffer any changes, this method does nothing.
+ )
+
+(defmethod (virtual-screen send-contents) (breakout-allowed)
+ % This method is invoked by the shared physical screen to obtain the entire
+ % virtual screen image.
+ (for-all-positions
+ (let ((ch (image-fetch image row col)))
+ (=> screen write ch screen-row screen-col self)
+ )))
+
+(defmethod (virtual-screen assert-ownership) ()
+ % This method is invoked by the shared physical screen to obtain the desired
+ % area for the virtual screen.
+ (=> screen set-owner-region row-origin column-origin height width self)
+ )
+
+(defmethod (virtual-screen screen-cursor-position) ()
+ % This method is invoked by the shared physical screen to obtain the desired
+ % cursor position for the virtual screen.
+ (cons
+ (+ cursor-row row-origin)
+ (+ cursor-column column-origin)
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Private methods:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (virtual-screen init) (init-plist)
+ (=> self &new-size)
+ )
+
+(defmethod (virtual-screen &new-size) ()
+ (if (< height 0) (setf height 0))
+ (if (< width 0) (setf width 0))
+ (setf maxrow (- height 1))
+ (setf maxcol (- width 1))
+ (setf image (make-vector maxrow NIL))
+ (let ((line (make-vector maxcol #\space)))
+ (for (from row 0 maxrow)
+ (do (vector-store image row (copyvector line))))
+ )
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(undeclare-flavor screen)
ADDED psl-1983/3-1/windows/vscreen.t
Index: psl-1983/3-1/windows/vscreen.t
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/vscreen.t
@@ -0,0 +1,175 @@
+ SPECIFICATION OF THE VIRTUAL-SCREEN DATATYPE
+ Cris Perdue
+ 10/1/82
+ File: pw:vscreen.t
+
+
+VIRTUAL-SCREEN Flavor
+
+A virtual screen is an object that can be used as independent
+rectangular character display, but in fact shares a physical
+screen with other objects. The coordinate system is based at
+(0,0) with the origin at the upper left-hand corner of the
+screen. A virtual-screen has an associated virtual cursor
+position. Each character on a virtual screen has a specific
+associated display enhancement, such as inverse video or
+underlining.
+
+A virtual screen object maintains a stored representation of the
+image on the virtual screen, which is used to update the physical
+screen when new areas of the virtual screen become "exposed". A
+virtual screen does not itself maintain any information about
+changes to its contents. It informs the physical screen of all
+changes as they are made, and sends the entire screen contents to
+the physical screen upon its request.
+
+In contrast with LISP Machine "windows" (the equivalent of these
+virtual-screens), a program may write onto a virtual screen at
+any time. Whether the virtual screen is exposed, covered, or
+partially covered by virtual screens makes no difference. In all
+cases any change to a virtual screen that shows is permitted and
+sent to the shared-physical-screen as soon as it is made. The
+change is visible to the user as soon as a refresh operation is
+done.
+
+The following initialization options exist:
+
+screen (required)
+
+The shared-physical-screen on which this screen may become
+exposed.
+
+height, width (optional)
+
+The height and width of this screen, in characters. These
+default to the height and width of the shared-physical-screen of
+this screen.
+
+row-origin, column-origin (optional)
+
+Offset of the upper left-hand corner (origin) of this screen from
+the upper left-hand corner of the associated
+shared-physical-screen. These may be negative. (?)
+
+default-enhancement (optional)
+
+Display enhancement(s) to be applied to characters written into
+this screen by the "write" method. Display enhancements include
+inverse video and underlining. Defaults to the value of the
+normal-enhancement of the associated shared-physical-screen.
+Enhancement values may be legally generated by the function
+dc-make-enhancement, not documented here. (Defined in the file
+pw:display-char.sl.) Note: Characters written to this screen by
+write-display-character do not have the default enhancement
+applied.
+
+Note on clipping:
+
+All operations that modify the contents of the virtual screen
+effectively clip. If any or all of the coordinates to be
+modified lie outside the screen, any part of the operation
+applying to those coordinates is ignored and no warning is given.
+Attempts to move the cursor off the virtual screen just move it
+to the nearest border point.
+
+(CREATE-VIRTUAL-SCREEN SHARED-PHYSICAL-SCREEN)
+
+Creates a virtual-screen associated with the specified
+shared-physical-screen. All the rest of the virtual-screen's
+attributes are defaulted.
+
+(=> VIRTUAL-SCREEN SET-CURSOR-POSITION ROW COLUMN)
+
+Sets the virtual-screen's (virtual) cursor position. It is
+intended that virtual screens will be shown on actual screens
+that have at least one actual cursor. At certain times there
+will be an actual cursor displayed at the position of the
+virtual-screen's cursor.
+
+If the position is out of range, the nearest in-range values will
+be used instead without complaint.
+
+(=> VIRTUAL-SCREEN WRITE CH ROW COLUMN)
+
+Write a single character, represented as an integer, at the given
+coordinates. The character is written with the virtual-screen's
+default enhancements.
+
+(=> VIRTUAL-SCREEN WRITE-RANGE CH ROW LEFT-COLUMN RIGHT-COLUMN)
+
+Writes the same character to a range of positions within a line
+of the virtual-screen. The left-column and right-column
+coordinates are inclusive. The default-enhancements are used.
+
+(=> VIRTUAL-SCREEN WRITE-DISPLAY-CHARACTER DC ROW COLUMN)
+
+A single character is written to the virtual-screen with explicit
+enhancements. The DC argument is a character-with-enhancements
+object, not documented here.
+
+(=> VIRTUAL-SCREEN CLEAR)
+
+The entire contents of the virtual-screen is set to blanks with
+the default enhancement. All clearing operations set the cleared
+portion of the screen to blanks with the default enhancement.
+
+(=> VIRTUAL-SCREEN CLEAR-TO-END FIRST-ROW)
+
+Clears the entire contents of the rows from first-row to the end
+of the screen.
+
+(=> VIRTUAL-SCREEN CLEAR-TO-EOL ROW FIRST-COLUMN)
+
+Clears the given row from first-column to the end.
+
+(=> VIRTUAL-SCREEN EXPOSE)
+
+Causes the select-primary-owner method to be invoked on the
+shared-physical-screen of the virtual screen. The effect of this
+should be to guarantee that the virtual screen is exposed in
+front of all other virtual screens associated with the same
+shared-physical-screen (until this operation is invoked on some
+other virtual-screen). Also guarantees that the actual screen's
+cursor is displayed at the position of this virtual-screen's
+cursor.
+
+(=> VIRTUAL-SCREEN DEEXPOSE)
+
+Causes the remove-owner method to be invoked on the
+shared-physical-screen of this virtual screen. The effect should
+be to entirely remove this virtual screen from display on the
+shared-physical-screen.
+
+SEMI-PRIVATE METHODS
+
+These methods are invoked by the shared-physical-screen. They
+are not intended for public use. Shared-physical-screens require
+their "owner" objects to supply these methods.
+
+(=> VIRTUAL-SCREEN SEND-CHANGES BREAKOUT-ALLOWED)
+
+An "owner" object is permitted to delay sending changes to the
+shared-physical-screen. When the shared-physical-screen is to be
+brought up to date, it invokes this operation on its owners,
+which must write onto the shared-physical-screen to bring it up
+to date. Virtual-screens do not buffer or delay any updating, so
+this operation is a no-op.
+
+(=> VIRTUAL-SCREEN SEND-CONTENTS BREAKOUT-ALLOWED)
+
+This method is invoked by the shared-physical-screen to force an
+owner to write its entire contents out to the
+shared-physical-screen.
+
+(=> VIRTUAL-SCREEN ASSERT-OWNERSHIP)
+
+This method is invoked by the shared-physical-screen with the
+expectation that it in turn will invoke the
+shared-physical-screen's set-owner-region operation with
+parameters specifying what area is to be occupied by the owner.
+
+(=> VIRTUAL-SCREEN SCREEN-CURSOR-POSITION)
+
+This method is expected to return the coordinates of the
+virtual-screen's cursor, in the coordinate system of the
+shared-physical-screen.
ADDED psl-1983/3-1/windows/vt52x.sl
Index: psl-1983/3-1/windows/vt52x.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/vt52x.sl
@@ -0,0 +1,255 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% VT52X.SL - Terminal Interface
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 6 October 1982
+% Revised: 1 March 1983
+%
+% 1-Mar-83 Alan Snyder
+% Removed right-corner-of-screen hack (no longer needed).
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(BothTimes (load objects))
+(CompileTime (load display-char fast-int fast-vectors))
+
+(defflavor vt52x (
+ (height 24) % number of rows (0 indexed)
+ (maxrow 23) % highest numbered row
+ (width 80) % number of columns (0 indexed)
+ (maxcol 79) % highest numbered column
+ (cursor-row 0) % cursor position
+ (cursor-column 0) % cursor position
+ (raw-mode NIL)
+ (terminal-enhancement 0) % current enhancement (applies to most output)
+ (terminal-blank #\space) % character used by ClearEOL
+ )
+ ()
+ (gettable-instance-variables height width maxrow maxcol raw-mode)
+ )
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(CompileTime
+ (defmacro out-n (n)
+ `(progn
+ (if (> ,n 9)
+ (PBOUT (+ (char 0) (/ ,n 10))))
+ (PBOUT (+ (char 0) (// ,n 10))))))
+
+(CompileTime
+ (defmacro out-char (ch)
+ `(PBOUT (char ,ch))))
+
+(CompileTime
+ (dm out-chars (form)
+ (for (in ch (cdr form))
+ (with L)
+ (collect (list 'out-char ch) L)
+ (returns (cons 'progn L)))))
+
+(CompileTime
+ (defmacro out-move (row col)
+ `(progn
+ (out-chars ESC Y)
+ (PBOUT (+ ,row 32))
+ (PBOUT (+ ,col 32)))))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(defmethod (vt52x get-character) ()
+ (& (PBIN) 8#377)
+ )
+
+(defmethod (vt52x ring-bell) ()
+ (out-char BELL)
+ )
+
+(defmethod (vt52x move-cursor) (row column)
+ (cond ((< row 0) (setf row 0))
+ ((>= row height) (setf row maxrow)))
+ (cond ((< column 0) (setf column 0))
+ ((>= column width) (setf column maxcol)))
+ (cond ((and (= row cursor-row) (= column cursor-column))) % no action needed
+ ((and (= row 0) (= column 0))
+ (out-chars ESC H)) % cursor HOME
+ ((= row cursor-row) % movement on current row
+ (cond ((= column 0)
+ (out-char CR)) % move to left margin
+ ((= column (- cursor-column 1))
+ (out-chars ESC D)) % move LEFT
+ ((= column (+ cursor-column 1))
+ (out-chars ESC C)) % move RIGHT
+ (t (out-move row column))))
+ ((= column cursor-column) % movement on same column
+ (cond ((= row (- cursor-row 1))
+ (out-chars ESC A)) % move UP
+ ((= row (+ cursor-row 1))
+ (out-char LF)) % move DOWN
+ (t (out-move row column))))
+ (t % arbitrary movement
+ (out-move row column)))
+ (setf cursor-row row)
+ (setf cursor-column column)
+ )
+
+(defmethod (vt52x enter-raw-mode) ()
+ (when (not raw-mode)
+ (EchoOff)
+ % Enable Keypad?
+ (setf raw-mode T)))
+
+(defmethod (vt52x leave-raw-mode) ()
+ (when raw-mode
+ (=> self &set-terminal-enhancement 0)
+ (setf raw-mode NIL)
+ % Disable Keypad?
+ (EchoOn)))
+
+(defmethod (vt52x erase) ()
+ % This method should be invoked to initialize the screen to a known state.
+ (out-chars ESC H ESC J)
+ (setf cursor-row 0)
+ (setf cursor-column 0)
+ (setf terminal-enhancement NIL) % force resetting when needed
+ )
+
+(defmethod (vt52x clear-line) ()
+ (out-chars ESC K)
+ )
+
+(defmethod (vt52x convert-character) (ch)
+ (setq ch (& ch (display-character-cons
+ (dc-make-enhancement-mask INVERSE-VIDEO
+ BLINK
+ UNDERLINE
+ INTENSIFY)
+ (dc-make-font-mask 0)
+ 16#FF)))
+ (let ((code (dc-character-code ch)))
+ (if (or (< code #\space) (= code (char rubout)))
+ (setq ch #\space)))
+ ch)
+
+(defmethod (vt52x normal-enhancement) ()
+ (dc-make-enhancement-mask)
+ )
+
+(defmethod (vt52x highlighted-enhancement) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO)
+ )
+
+(defmethod (vt52x supported-enhancements) ()
+ (dc-make-enhancement-mask INVERSE-VIDEO BLINK UNDERLINE INTENSIFY)
+ )
+
+(defmethod (vt52x update-line) (row old-line new-line columns)
+ % Old-Line is updated.
+
+ (let ((first-col (car columns))
+ (last-col (cdr columns))
+ (last-nonblank-column NIL)
+ )
+ % Find out the minimal actual bounds:
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line last-col)
+ (vector-fetch old-line last-col)))
+ (setf last-col (- last-col 1))
+ )
+ (while (and (<= first-col last-col)
+ (= (vector-fetch new-line first-col)
+ (vector-fetch old-line first-col)))
+ (setf first-col (+ first-col 1))
+ )
+
+ % The purpose of the following code is to determine whether or not to use
+ % ClearEOL. If we decide to use ClearEOL, then we will set the variable
+ % LAST-NONBLANK-COLUMN to the obvious index; otherwise, we will set it to
+ % NIL. If we decide to use ClearEOL, then we will clear out the OLD-LINE
+ % now, but do the actual ClearEOL later.
+
+ % Use of ClearEOL is appropriate if the rightmost changed character has
+ % been changed to a space, and the remainder of the line is blank. It
+ % is appropriate only if it replaces writing at least 3 blanks.
+
+ (when (= (vector-fetch new-line last-col) terminal-blank)
+ (setf last-nonblank-column (vector-upper-bound new-line))
+ (while (and (>= last-nonblank-column 0)
+ (= (vector-fetch new-line last-nonblank-column)
+ terminal-blank)
+ )
+ (setf last-nonblank-column (- last-nonblank-column 1))
+ )
+
+ % We have computed the column containing the rightmost non-blank
+ % character. Now, we can decide whether we want to do a ClearEOL or not.
+
+ (if (and (< last-nonblank-column (- last-col 2)))
+ % then
+ (while (> last-col last-nonblank-column)
+ (vector-store old-line last-col terminal-blank)
+ (setf last-col (- last-col 1))
+ )
+ % else
+ (setf last-nonblank-column NIL)
+ ))
+
+ % Output all changed characters (except those ClearEOL will do):
+ (if (not (and (= cursor-row row) (<= cursor-column first-col)))
+ (=> self move-cursor row first-col))
+
+ (for (from col first-col last-col)
+ (do
+ (let ((old (vector-fetch old-line col))
+ (new (vector-fetch new-line col))
+ )
+ (when (~= old new)
+ (let ((new-enhancement (dc-enhancement-mask new))
+ (new-code (dc-character-code new))
+ )
+ % Do we need to change the terminal enhancement?
+ (if (~= terminal-enhancement new-enhancement)
+ (=> self &set-terminal-enhancement new-enhancement)
+ )
+ (=> self &move-cursor-forward col old-line)
+ (PBOUT new-code)
+ (if (< cursor-column maxcol)
+ (setf cursor-column (+ cursor-column 1))
+ % otherwise
+ % (pretend we don't know the cursor position...
+ % the two versions of the emulator differ at this point!)
+ (setf cursor-column 10000)
+ (setf cursor-row 10000)
+ )
+ (vector-store old-line col new)
+ )))))
+
+ % Do the ClearEOL, if that's what we decided to do.
+ (when last-nonblank-column
+ (=> self &move-cursor-forward (+ last-nonblank-column 1) old-line)
+ (=> self clear-line)
+ )
+ ))
+
+% The following methods are provided for INTERNAL use only!
+
+(defmethod (vt52x init) ()
+ )
+
+(defmethod (vt52x &move-cursor-forward) (column line)
+ (cond ((> (- column cursor-column) 4)
+ (out-move cursor-row column)
+ (setf cursor-column column))
+ (t (while (< cursor-column column)
+ (PBOUT (dc-character-code (vector-fetch line cursor-column)))
+ (setf cursor-column (+ cursor-column 1))
+ ))))
+
+(defmethod (vt52x &set-terminal-enhancement) (enh)
+ (setf terminal-enhancement enh)
+ (out-char ESC)
+ (PBOUT 3)
+ (PBOUT (dc-enhancement-index enh))
+ )
ADDED psl-1983/3-1/windows/windows-20.sl
Index: psl-1983/3-1/windows/windows-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows-20.sl
@@ -0,0 +1,55 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% WINDOWS-20.SL - Dec-20 Windows Stuff (intended only for Dec-20 version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 April 1983
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings fast-int))
+(bothtimes (load strings common))
+
+(fluid '(window-file-list window-source-prefix window-binary-prefix))
+
+(if (or (unboundp 'window-source-prefix) (null window-source-prefix))
+ (setf window-source-prefix "pw:"))
+
+(if (or (unboundp 'window-binary-prefix) (null window-binary-prefix))
+ (setf window-binary-prefix "pwb:"))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building WINDOWS:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-fixup-name (s) s)
+
+(de window-load-all ()
+ (for (in s window-file-list)
+ (do (window-load s))
+ ))
+
+(de window-load (s)
+ (window-faslin window-binary-prefix s)
+ )
+
+(de window-faslin (directory-name module-name)
+ (setf module-name (window-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf window-file-list
+ (list
+ "hp2648a"
+ "physical-screen"
+ "shared-physical-screen"
+ "virtual-screen"
+ "vt52x"
+ ))
ADDED psl-1983/3-1/windows/windows-9836.lap
Index: psl-1983/3-1/windows/windows-9836.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows-9836.lap
@@ -0,0 +1,2 @@
+(faslin "pwb:windows-9836.b")
+(window-load-all)
ADDED psl-1983/3-1/windows/windows-9836.sl
Index: psl-1983/3-1/windows/windows-9836.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows-9836.sl
@@ -0,0 +1,119 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% WINDOWS-9836.SL - HP9836 Windows Stuff (intended only for HP9836 version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 20 January 1983
+% Revised: 5 April 1983
+%
+% 5-Apr-83 Alan Snyder
+% Changes relating to keeping WINDOWS source and binary files in separate
+% directories. Rename Shared-Screen to Shared-Physical-Screen, for
+% compatibility with other systems.
+% 16-Mar-83 Alan Snyder
+% Add font8, LAP support.
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings fast-int))
+(bothtimes (load strings common))
+
+(fluid '(window-file-list window-source-prefix window-binary-prefix))
+
+(if (or (unboundp 'window-source-prefix) (null window-source-prefix))
+ (setf window-source-prefix "pw:"))
+
+(if (or (unboundp 'window-binary-prefix) (null window-binary-prefix))
+ (setf window-binary-prefix "pwb:"))
+
+(de charsininputbuffer () (if (keyboard-input-available?) 1 0))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building WINDOWS:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-fixup-name (s) s)
+
+(de window-load-all ()
+ (for (in s window-file-list)
+ (do (window-load s))
+ ))
+
+(de window-load (s)
+ (window-faslin window-binary-prefix s)
+ )
+
+(de window-faslin (directory-name module-name)
+ (setf module-name (window-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf window-file-list
+ (list
+ "font8"
+ "9836-alpha"
+ "9836-color"
+ "direct-physical-screen"
+ "shared-physical-screen"
+ "virtual-screen"
+ ))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% LAP support for Window operations
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(lap '((*entry mul16 expr 2)
+ (move!.l (reg 1) (reg t1))
+ (move!.l (reg 2) (reg t2))
+ (muls (reg t1) (reg t2))
+ (movea!.l (reg t2) (reg 1))
+ (rts)
+ ))
+
+(lap '((*entry write-char-raster expr 4)
+
+ % Arguments are:
+ % 1. the raster pattern (vector of integers)
+ % 2. the initial screen address (address of top scan line)
+ % 3. the row-size (number of bytes per row of screen)
+ % 4. count (the number of scan lines in the pattern) (must be positive)
+
+ (move!.l (reg 4) (reg t2)) % loop control
+ (addq!.l 4 (reg 1)) % skip vector header
+ (*lbl (label loop))
+ (move!.l (autoincrement (reg 1)) (reg t1)) % read next row from pattern
+ (move!.b (reg t1) (displacement (reg 2) 0)) % store in screen memory
+ (adda!.l (reg 3) (reg 2)) % advance to next row of screen
+ (subq!.l 1 (reg t2)) % decrement loop counter
+ (bgt (label loop)) % loop if more bytes to copy
+ (move!.l (reg nil) (reg 1)) % avoid returning bad pointer
+ (rts)
+ ))
+
+(lap '((*entry write-inverted-char-raster expr 4)
+
+ % Arguments are:
+ % 1. the raster pattern (vector of integers)
+ % 2. the initial screen address (address of top scan line)
+ % 3. the row-size (number of bytes per row of screen)
+ % 4. count (the number of scan lines in the pattern) (must be positive)
+
+ (move!.l (reg 4) (reg t2)) % loop control
+ (addq!.l 4 (reg 1)) % skip vector header
+ (*lbl (label loop))
+ (move!.l (autoincrement (reg 1)) (reg t1)) % read next row from pattern
+ (not!.l (reg t1)) % complement the raster pattern
+ (move!.b (reg t1) (displacement (reg 2) 0)) % store in screen memory
+ (adda!.l (reg 3) (reg 2)) % advance to next row of screen
+ (subq!.l 1 (reg t2)) % decrement loop counter
+ (bgt (label loop)) % loop if more bytes to copy
+ (move!.l (reg nil) (reg 1)) % avoid returning bad pointer
+ (rts)
+ ))
ADDED psl-1983/3-1/windows/windows-ex-20.sl
Index: psl-1983/3-1/windows/windows-ex-20.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows-ex-20.sl
@@ -0,0 +1,61 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% WINDOWS-20.SL - Dec-20 Windows Stuff (intended only for Dec-20 version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 April 1983
+%
+% 15-Jun-83 - Robert Kessler
+% Added faslin of the 3 new device drivers: VT100, Ambassador and Teleray
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings fast-int))
+(bothtimes (load strings common))
+
+(fluid '(window-file-list window-source-prefix window-binary-prefix))
+
+(if (or (unboundp 'window-source-prefix) (null window-source-prefix))
+ (setf window-source-prefix "pw:"))
+
+(if (or (unboundp 'window-binary-prefix) (null window-binary-prefix))
+ (setf window-binary-prefix "pwb:"))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building WINDOWS:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-fixup-name (s) s)
+
+(de window-load-all ()
+ (for (in s window-file-list)
+ (do (window-load s))
+ ))
+
+(de window-load (s)
+ (window-faslin window-binary-prefix s)
+ )
+
+(de window-faslin (directory-name module-name)
+ (setf module-name (window-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf window-file-list
+ (list
+ "ambassador"
+ "hp2648a"
+ "physical-screen"
+ "shared-physical-screen"
+ "teleray"
+ "virtual-screen"
+ "vt100"
+ "vt52x"
+ ))
ADDED psl-1983/3-1/windows/windows-vax.lap
Index: psl-1983/3-1/windows/windows-vax.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows-vax.lap
@@ -0,0 +1,2 @@
+(faslin "$pwb/windows-vax.b")
+(window-load-all)
ADDED psl-1983/3-1/windows/windows-vax.sl
Index: psl-1983/3-1/windows/windows-vax.sl
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows-vax.sl
@@ -0,0 +1,55 @@
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% WINDOWS-VAX.SL - Vax-Unix Windows Stuff (intended only for Vax version)
+%
+% Author: Alan Snyder
+% Hewlett-Packard/CRC
+% Date: 4 April 1983
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(compiletime (load fast-strings fast-int))
+(bothtimes (load strings common))
+
+(fluid '(window-file-list window-source-prefix window-binary-prefix))
+
+(if (or (unboundp 'window-source-prefix) (null window-source-prefix))
+ (setf window-source-prefix "$pw/"))
+
+(if (or (unboundp 'window-binary-prefix) (null window-binary-prefix))
+ (setf window-binary-prefix "$pwb/"))
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Stuff for Building WINDOWS:
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+(de window-fixup-name (s) s)
+
+(de window-load-all ()
+ (for (in s window-file-list)
+ (do (window-load s))
+ ))
+
+(de window-load (s)
+ (window-faslin window-binary-prefix s)
+ )
+
+(de window-faslin (directory-name module-name)
+ (setf module-name (window-fixup-name module-name))
+ (setf module-name (string-concat module-name ".b"))
+ (let ((object-name (string-concat directory-name module-name)))
+ (if (filep object-name)
+ (faslin object-name)
+ (continuableerror 99
+ (bldmsg "Unable to FASLIN %w" object-name)
+ (list 'faslin object-name)
+ ))))
+
+(setf window-file-list
+ (list
+ "hp2648a"
+ "physical-screen"
+ "shared-physical-screen"
+ "virtual-screen"
+ "vt52x"
+ ))
ADDED psl-1983/3-1/windows/windows.lap
Index: psl-1983/3-1/windows/windows.lap
==================================================================
--- /dev/null
+++ psl-1983/3-1/windows/windows.lap
@@ -0,0 +1,5 @@
+(faslin "pw:hp2648a.b")
+(faslin "pw:physical-screen.b")
+(faslin "pw:shared-physical-screen.b")
+(faslin "pw:virtual-screen.b")
+(faslin "pw:vt52x.b")
ADDED psl-1983/CONTRIBUTORS
Index: psl-1983/CONTRIBUTORS
==================================================================
--- /dev/null
+++ psl-1983/CONTRIBUTORS
@@ -0,0 +1,52 @@
+The historical files here represents copies of earlier versions of
+Reduce and PSL with (at present) the oldes ones being from the early 1980s.
+They are in general unaltered from the original archives that they were
+recovered from, and a consequence of that is that some have restrictive
+rights messages embedded which represented their status at that time.
+Tony Hearn and Martin Griss as lead copyright holders were senty an enquiry:
+> Would you grant permission for me to make these public as part of the
+> above-mentioned web site (which Im expecting will eventually be
+> formally accessioned into the Computer History Museum digital
+> repository? Thanks very much.
+
+Tony Hearn replied:
+> Fine with me.
+
+Martin Griss replied:
+> I have no objections to their release with an appropriate note, but its
+> important to know that several files were written or updated by
+> multiple students at Utah and by several staff at HP Laboratories; many
+> of these folks have most likely retired.
+>
+> So, I am not sure if we need to contact them for permission. Perhaps
+> they at least need to be listed as contributors. As far as I can
+> tell/recall, only some of the files have copyright notices that request
+> my permission for release - I assume (or intended -:) these notice on
+> the "main" files apply to all subsidiary files, both hand written and
+> generated.
+>
+> We will need certainly to add some sort of caveat/disclosure that says
+> these files are provided for historical interest only, and there is no
+> implied warrantee of fitness or correctness for use, nor may they be
+> used for any commercial pupose..
+
+Please note that last paragraph that these files are made availanle to
+record the historical trail of the Reduce project and the contributors -
+both those named within the filea and others deserve thanks and credit.
+
+For later copies of Reduce Tony Hearn arranged that contributors completed
+paperwork to confirm that they were willing to have their code distributed
+as part of Reduce. For PSL at some stage control and support was organised
+through HP Labs, and a modest while after Reduce became an open source
+project they confirmed that they were happy for their code to be included
+as part of the open source version. It is probable that the rights that they
+acquired in order to be able to develop and exploit PSL means that their
+release of the code covers almost all of the versions here. See the HP
+disclaimer in the PSL section of the main current version of the code.
+
+The bibliography in the file doc/manual/bibl.bib lists many of those who
+contributed to Reduce.
+
+ ACN April 2020
+
+
ADDED psl-1983/a-full-build.mic
Index: psl-1983/a-full-build.mic
==================================================================
--- /dev/null
+++ psl-1983/a-full-build.mic
@@ -0,0 +1,134 @@
+@build rel4:<psl>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.comp>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.20-comp>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.doc>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.doc-nmode>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.emode>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.glisp>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.help>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.kernel>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.20-kernel>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.lap>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.lpt>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.nmode>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.nonkernel>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.tests>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.20-tests>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.util>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.20-util>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+@build rel4:<psl.windows>
+@per 1000
+@work 2000
+@fi
+@gen 0
+@pres
+@
+
ADDED psl-1983/a-full-logical-names.cmd
Index: psl-1983/a-full-logical-names.cmd
==================================================================
--- /dev/null
+++ psl-1983/a-full-logical-names.cmd
@@ -0,0 +1,23 @@
+; Officially recognized logical names for FULL set of
+; PSL subdirectories on UTAH-20 for V3 PSL distribution
+; EDIT <PSL to your <name
+define psl: rel4:<psl> ! Executable files and miscellaneous
+define pc: rel4:<psl.comp> ! Compiler sources
+define p20c: rel4:<psl.20-comp> ! 20 Specific Compiler sources
+define pd: rel4:<psl.doc> ! Documentation files
+define pnd: rel4:<psl.doc-nmode> ! NMODE Documentation files
+define pe: rel4:<psl.emode> ! EMODE support and drivers
+define pg: rel4:<psl.glisp> ! Glisp sources
+define ph: rel4:<psl.help> ! Help files
+define pk: rel4:<psl.kernel> ! Kernel Source files
+define p20k: rel4:<psl.20-kernel> ! 20 Specific Kernel Sources
+define pl: rel4:<psl.lap> ! LAP files
+define plpt: rel4:<psl.lpt> ! Printer version of Documentation
+define pn: rel4:<psl.nmode> ! NMODE editor files
+define pnk: rel4:<psl.nonkernel> ! PSL Non Kernel source files
+define pt: rel4:<psl.tests> ! Test files
+define p20t: rel4:<psl.20-tests> ! 20 Specific Test files
+define pu: rel4:<psl.util> ! Utility program sources
+define p20u: rel4:<psl.20-util> ! 20 Specific Utility files
+define pw: rel4:<psl.windows> ! NMODE Window files
+take
ADDED psl-1983/a-full-restore.mic
Index: psl-1983/a-full-restore.mic
==================================================================
--- /dev/null
+++ psl-1983/a-full-restore.mic
@@ -0,0 +1,24 @@
+@DUMPER
+*tape 'a
+*account system-default
+*restore dsk*:<*>*.*.* PSL:*.*.*
+*restore dsk*:<*>*.*.* PSL:*.*.*
+*restore dsk*:<*>*.*.* PC:*.*.*
+*restore dsk*:<*>*.*.* P20C:*.*.*
+*restore dsk*:<*>*.*.* PD:*.*.*
+*restore dsk*:<*>*.*.* PND:*.*.*
+*restore dsk*:<*>*.*.* PE:*.*.*
+*restore dsk*:<*>*.*.* PG:*.*.*
+*restore dsk*:<*>*.*.* ph:*.*.*
+*restore dsk*:<*>*.*.* pk:*.*.*
+*restore dsk*:<*>*.*.* p20K:*.*.*
+*restore dsk*:<*>*.*.* pl:*.*.*
+*restore dsk*:<*>*.*.* plpt:*.*.*
+*restore dsk*:<*>*.*.* pn:*.*.*
+*restore dsk*:<*>*.*.* pnk:*.*.*
+*restore dsk*:<*>*.*.* pT:*.*.*
+*restore dsk*:<*>*.*.* p20T:*.*.*
+*restore dsk*:<*>*.*.* pu:*.*.*
+*restore dsk*:<*>*.*.* p20u:*.*.*
+*restore dsk*:<*>*.*.* pw:*.*.*
+
ADDED psl-1983/bboard.msg
Index: psl-1983/bboard.msg
==================================================================
--- /dev/null
+++ psl-1983/bboard.msg
@@ -0,0 +1,30 @@
+ Version 3.1 PSL Available
+
+We have just installed the latest version of Utah's PSL (Portable
+Standard LISP) system. This system is written almost entirely in
+itself, and is compiled with an efficient optimizing LISP compiler,
+with machine oriented extensions (called "SYSLISP"). The LISP itself
+is based on Utah Standard LISP, with modernizations and extensions
+derived from FranzLISP, Common-LISP, etc. PSL currently runs on
+DEC-20 under TOPS-20, VAX under UNIX, and a number of Motorola MC68000
+systems. Future implementations for VAX-VMS, CRAY-1, IBM-370 and extended
+addressing TOPS-20 are envisioned or already underway.
+
+In order to run PSL, you must use a set of logical names, defined
+in <name>MINIMAL-LOGICAL-NAMES.CMD. You should insert a @TAKE of this
+file in your LOGIN.CMD file.
+
+A printed copy of the preliminary PSL manual can be obtained from
+[........]; there is also a complete online version of this manual,
+organized as a set of files, one per chapter. These are stored as
+PLPT:nnnn-chaptername.LPT. PLEASE DO NOT print your own copy.
+
+There are a set of short HELP files, on directory PH:. To get started,
+read PH:PSL-INTRO.HLP.
+
+
+The licence agrrement under which we have recieved this version of PSL
+restricts it to our internal use. Please do not distribute the code (source
+or listings), or documentation outside of our group.
+
+If there are any problems, please MAIL to [.....].
ADDED psl-1983/comp/anyreg-cmacro.sl
Index: psl-1983/comp/anyreg-cmacro.sl
==================================================================
--- /dev/null
+++ psl-1983/comp/anyreg-cmacro.sl
@@ -0,0 +1,263 @@
+(*
+"% ANYREG-CMACRO.SL - Table-driven Anyreg and C-macro expander
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 December 1981
+% Copyright (c) 1981 University of Utah
+%")
+
+(fluid '(ResultingCode!* TempLabel!* TempLabel2!*))
+
+(* "Generated code is collected in reverse order in ResultingCode*")
+
+(CompileTime (flag '(SafePair PatternSublA WConstEvaluabLis
+ AnyregPatternMatch1 MatchAll AnyregSubstitute1
+ TempLabelGen
+ CMacroSubstitute1)
+ 'InternalFunction))
+
+(dm DefAnyreg (Form)
+ (prog (AnyregName FunctionName Pattern)
+ (setq Form (cdr Form))
+ (setq AnyregName (car Form))
+ (setq Form (cdr Form))
+ (setq FunctionName (car Form))
+ (setq Pattern (cdr Form))
+ (return (list 'progn
+ (list 'put
+ (MkQuote AnyregName)
+ '(quote AnyregResolutionFunction)
+ (MkQuote FunctionName))
+ (list 'put
+ (MkQuote AnyregName)
+ '(quote AnyregPatternTable)
+ (MkQuote Pattern))))))
+
+(dm DefCMacro (Form)
+ (prog (CMacroName Pattern)
+ (setq Form (cdr Form))
+ (setq CMacroName (car Form))
+ (setq Pattern (cdr Form))
+ (return (list 'progn
+ (list 'flag
+ (MkQuote (list CMacroName))
+ '(quote MC))
+ (list 'put
+ (MkQuote CMacroName)
+ '(quote CMacroPatternTable)
+ (MkQuote Pattern))))))
+
+(de ResolveOperand (Register Source)
+ (prog (ResolveAnyregFunction)
+ (return (cond ((IDP Source) (ResolveWConst Source))
+ ((atom Source) Source)
+ ((FlagP (car Source) 'TerminalOperand) Source)
+ ((setq ResolveAnyregFunction
+ (get (car Source) 'AnyregResolutionFunction))
+ (Apply ResolveAnyregFunction
+ (cons Register (cdr Source))))
+ (t (ResolveWConst Source))))))
+
+(de ResolveWConst (Expression)
+ (prog (ResolvedExpression)
+ (setq ResolvedExpression (ResolveWConstExpression Expression))
+ (return (cond ((NumberP ResolvedExpression) ResolvedExpression)
+ (t (list 'Immediate Expression))))))
+
+(de ResolveWConstExpression (Expression)
+ (cond ((EqCar Expression 'WConst)
+ (ResolveWConstExpression (cadr Expression)))
+ (t (prog (ResultExpression)
+ (return
+ (cond
+ ((or (NumberP Expression) (StringP Expression)) Expression)
+ ((IDP Expression)
+ (cond ((setq ResultExpression (get Expression 'WConst))
+ ResultExpression)
+ (t Expression)))
+ (t (progn
+ (cond
+ ((MacroP (car Expression))
+ (return
+ (ResolveWConstExpression (Apply (car Expression)
+ (list Expression))))))
+ (setq Expression
+ (cons (car Expression)
+ (MapCar (cdr Expression)
+ (Function ResolveWConstExpression))))
+ (cond ((setq ResultExpression
+ (WConstEvaluable Expression))
+ ResultExpression)
+ (t Expression))))))))))
+
+(de WConstEvaluable (Expression)
+ (prog (WC WCLis DoFn)
+ (return
+ (cond ((NumberP Expression) Expression)
+ ((and (IDP Expression) (setq WC (get Expression 'WConst)))
+ WC)
+ ((and (PairP Expression) (IDP (setq WC (car Expression))))
+ (cond ((MacroP WC)
+ (WConstEvaluable (apply (car Expression)
+ (list Expression))))
+ ((and (or (and (setq DoFn (get WC 'DoFn))
+ (setq WC DoFn))
+ (not (FUnBoundP WC)))
+ (not (eq (setq WCLis
+ (WConstEvaluabLis (cdr
+ Expression)))
+ 'not)))
+ (Eval (cons WC WCLis)))
+ (T NIL)))
+ (T NIL)))))
+
+(de WConstEvaluabLis (ExpressionTail)
+ (prog (WC WCLis)
+ (return
+ (cond ((null ExpressionTail) NIL)
+ ((not (setq WC (WConstEvaluable (car ExpressionTail)))) 'not)
+ ((eq (setq WCLis (WConstEvaluabLis (cdr ExpressionTail)))
+ 'not)
+ 'not)
+ (T (cons WC WCLis))))))
+
+(de OneOperandAnyreg (Register Source AnyregName)
+ (ExpandOneArgumentAnyreg Register
+ (ResolveOperand Register Source)
+ AnyregName))
+
+(* "SecondArg must not require a register for evaluation.
+It is currently used only for (MEMORY reg const).")
+
+(de TwoOperandAnyreg (Register Source SecondArg AnyregName)
+ (ExpandTwoArgumentAnyreg Register
+ (ResolveOperand Register Source)
+ (ResolveOperand '(REG Error) SecondArg)
+ AnyregName))
+
+(de ExpandOneArgumentAnyreg (Register Source AnyregName)
+ (AnyregPatternExpand (list Register Source)
+ (get AnyregName 'AnyregPatternTable)))
+
+(de ExpandTwoArgumentAnyreg (Register Source SecondArg AnyregName)
+ (AnyregPatternExpand (list Register Source SecondArg)
+ (get AnyregName 'AnyregPatternTable)))
+
+(de ExpandThreeArgumentAnyreg (Register Source SecondArg ThirdArg AnyregName)
+ (AnyregPatternExpand (list Register Source SecondArg ThirdArg)
+ (get AnyregName 'AnyregPatternTable)))
+
+(de AnyregPatternExpand (ArgumentList PatternTable)
+ (AnyregSubstitute ArgumentList
+ (AnyregPatternMatch (cdr ArgumentList) PatternTable)))
+
+(* "The label operand must not require a register to resolve.")
+
+(de Expand2OperandAndLabelCMacro (Arg1 Arg2 Label CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1)
+ (ResolveOperand '(REG t2) Arg2)
+ (ResolveOperand '(REG Error) Label))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de Expand4OperandCMacro (Arg1 Arg2 Arg3 Arg4 CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1)
+ (ResolveOperand '(REG t2) Arg2)
+ (ResolveOperand '(REG Error) Arg3)
+ (ResolveOperand '(REG Error) Arg4))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de Expand2OperandCMacro (Arg1 Arg2 CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1)
+ (ResolveOperand '(REG t2) Arg2))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de Expand1OperandCMacro (Arg1 CMacroName)
+ (prog (ResultingCode!*)
+ (return (CMacroPatternExpand (list (ResolveOperand '(REG t1) Arg1))
+ (get CMacroName 'CMacroPatternTable)))))
+
+(de CMacroPatternExpand (ArgumentList PatternTable)
+ (CMacroSubstitute ArgumentList
+ (AnyregPatternMatch ArgumentList PatternTable)))
+
+(de AnyregPatternMatch (ArgumentList PatternTable)
+ (cond ((null (cdr PatternTable)) (car PatternTable))
+ ((AnyregPatternMatch1 ArgumentList (caar PatternTable))
+ (cdar PatternTable))
+ (t (AnyregPatternMatch ArgumentList (cdr PatternTable)))))
+
+(de AnyregPatternMatch1 (ArgumentList PredicateOrPredicateList)
+ (cond ((atom PredicateOrPredicateList)
+ (Apply PredicateOrPredicateList ArgumentList))
+ (t (MatchAll ArgumentList PredicateOrPredicateList))))
+
+(de MatchAll (ArgumentList PredicateList)
+ (or (atom ArgumentList)
+ (atom PredicateList)
+ (and (Apply (car PredicateList) (list (car ArgumentList)))
+ (MatchAll (cdr ArgumentList) (cdr PredicateList)))))
+
+(de AnyregSubstitute (ArgumentList CodeAndAddressExpressionList)
+ (AnyregSubstitute1 (SafePair '(Register Source ArgTwo ArgThree)
+ ArgumentList)
+ CodeAndAddressExpressionList))
+
+(de AnyregSubstitute1 (NameExpressionAList CodeAndAddressExpressionList)
+ (cond ((null (cdr CodeAndAddressExpressionList))
+ (SublA NameExpressionAList (car CodeAndAddressExpressionList)))
+ (t (progn (setq ResultingCode!*
+ (cons (SublA NameExpressionAList
+ (car CodeAndAddressExpressionList))
+ ResultingCode!*))
+ (AnyregSubstitute1 NameExpressionAList
+ (cdr CodeAndAddressExpressionList))))))
+
+(de CMacroSubstitute (ArgumentList CodeTemplateList)
+ (prog (TempLabel!* TempLabel2!*)
+ (return (CMacroSubstitute1 (SafePair '(ArgOne ArgTwo
+ ArgThree
+ ArgFour
+ ArgFive)
+ ArgumentList)
+ CodeTemplateList))))
+
+(de CMacroSubstitute1 (NameExpressionAList CodeTemplateList)
+ (cond ((null CodeTemplateList) (ReversIP ResultingCode!*))
+ (t (progn (setq ResultingCode!*
+ (cons (PatternSublA NameExpressionAList
+ (car CodeTemplateList))
+ ResultingCode!*))
+ (CMacroSubstitute1 NameExpressionAList
+ (cdr CodeTemplateList))))))
+
+(de SafePair (CarList CdrList)
+ (cond ((and (PairP CarList) (PairP CdrList))
+ (cons (cons (car CarList) (car CdrList))
+ (SafePair (cdr CarList) (cdr CdrList))))
+ (t NIL)))
+
+(de PatternSublA (AList Expression)
+ (prog (X)
+ (return (cond ((null Expression) Expression)
+ ((atom Expression)
+ (cond ((eq Expression 'TempLabel)
+ (TempLabelGen 'TempLabel!*))
+ ((eq Expression 'TempLabel2)
+ (TempLabelGen 'TempLabel2!*))
+ ((setq X (atsoc Expression AList))
+ (cdr X))
+ (t Expression)))
+ (t (cons (PatternSublA AList (car Expression))
+ (PatternSublA AList (cdr Expression))))))))
+
+(de TempLabelGen (X)
+ ((lambda (Y)
+ (cond ((StringP Y) Y)
+ (T (set X (StringGensym)))))
+ (Eval X)))
ADDED psl-1983/comp/bare-psl.sym
Index: psl-1983/comp/bare-psl.sym
==================================================================
--- /dev/null
+++ psl-1983/comp/bare-psl.sym
@@ -0,0 +1,4 @@
+(setq OrderedIDList!* (NCons NIL))
+(setq UncompiledExpressions!* (NCons NIL))
+(setq ToBeCompiledExpressions!* (NCons NIL))
+(setq NextIDNumber!* 129)
ADDED psl-1983/comp/big-faslend.build
Index: psl-1983/comp/big-faslend.build
==================================================================
--- /dev/null
+++ psl-1983/comp/big-faslend.build
@@ -0,0 +1,1 @@
+in "big-faslend.red"$
ADDED psl-1983/comp/big-faslend.red
Index: psl-1983/comp/big-faslend.red
==================================================================
--- /dev/null
+++ psl-1983/comp/big-faslend.red
@@ -0,0 +1,39 @@
+% BIG-FASLEND.RED - Patch to FASLEND for huge files
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 7 May 1982
+% Copyright (c) 1982 University of Utah
+% <PSL.COMP>BIG-FASLEND.RED.4, 10-Jun-82 10:39:32, Edit by GRISS
+% Added InitCodeMax!* for testing
+%
+
+lisp procedure CompileUncompiledExpressions();
+ <<ErrorPrintF("%n*** Init code length is %w%n",
+ length car UncompiledExpressions!*);
+ CompileInitCode('!*!*Fasl!*!*InitCode!*!*,
+ car UncompiledExpressions!*)>>;
+
+FLUID '(InitCodeMax!*);
+
+LoadTime <<InitCodeMax!*:=350>>;
+
+lisp procedure CompileInitCode(Name, InitCodeList);
+begin scalar X, Len, LastHalf;
+ return if ILessP(Len := length InitCodeList, InitCodeMax!*) then
+ DfPrintFasl list('de, Name, '(), 'progn . InitCodeList)
+ else
+ << ErrorPrintF(
+"*** Initcode length %w too large, splitting into smaller pieces", Len);
+ ErrorPrintF("*** Please use smaller files in FASL");
+ X := PNTH(InitCodeList, IQuotient(Len, 2));
+ LastHalf := cdr X;
+ Rplacd(X, NIL); % tricky, split the code in 2
+ X := Intern Concat(ID2String Name, StringGensym());
+ Flag1(X, 'InternalFunction); % has to be internal to get called!
+ CompileInitCode(X,
+ InitCodeList);
+ CompileInitCode(Name, list X . LastHalf) >>; % call previous
+end;
ADDED psl-1983/comp/common-cmacros.sl
Index: psl-1983/comp/common-cmacros.sl
==================================================================
--- /dev/null
+++ psl-1983/comp/common-cmacros.sl
@@ -0,0 +1,286 @@
+(*
+"% COMMON-CMACROS.SL - C-macros and Anyregs common to all implementations
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 17 December 1981
+% Copyright (c) 1981 University of Utah
+%")
+
+(fluid '(NAlloc!* AddressingUnitsPerItem StackDirection ResultingCode!*))
+
+(de !*Link (FunctionName FunctionType NumberOfArguments)
+ (list (cond ((FlagP FunctionName 'ForeignFunction)
+ (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments))
+ (t (list '!*Call FunctionName)))))
+
+(DefCMacro !*Link)
+
+(de !*Call (FunctionName)
+ (prog (ResultingCode!* OpenCodeSequence)
+ (return (cond ((setq OpenCodeSequence
+ (get FunctionName 'OpenCode))
+ OpenCodeSequence)
+ (t (CMacroPatternExpand (list FunctionName)
+ (get '!*Call
+ 'CMacroPatternTable)))))))
+
+(de !*LinkE (DeAllocCount FunctionName FunctionType NumberOfArguments)
+ (cons (list '!*DeAlloc DeAllocCount)
+ (cond ((FlagP FunctionName 'ForeignFunction)
+ (list (list '!*ForeignLink
+ FunctionName
+ FunctionType
+ NumberOfArguments)
+ '(!*Exit 0)))
+ (t (list (list '!*JCall FunctionName))))))
+
+(DefCMacro !*LinkE)
+
+(de !*JCall (FunctionName)
+ (prog (ResultingCode!* OpenCodeSequence)
+ (return (cond ((setq OpenCodeSequence
+ (get FunctionName 'ExitOpenCode))
+ OpenCodeSequence)
+ ((setq OpenCodeSequence
+ (get FunctionName 'OpenCode))
+ (Append OpenCodeSequence (list '(!*Exit 0))))
+ (t (CMacroPatternExpand (list FunctionName)
+ (get '!*JCall
+ 'CMacroPatternTable)))))))
+
+
+(de !*DeAlloc (DeAllocCount)
+ (Expand1OperandCMacro (times DeAllocCount AddressingUnitsPerItem)
+ '!*DeAlloc))
+
+(de !*Alloc (N)
+ (progn (setq NAlloc!* N)
+ (Expand1OperandCMacro (times N AddressingUnitsPerItem) '!*Alloc)))
+
+(de !*Exit (N)
+ (Expand1OperandCMacro (times N AddressingUnitsPerItem) '!*Exit))
+
+(de !*JumpWithin (Label LowerBound UpperBound)
+ (prog (ExitLabel)
+ (setq ExitLabel (list 'Label (GenSym)))
+ (return (list (list '!*JumpWLessP ExitLabel '(Reg 1) LowerBound)
+ (list '!*JumpWLeq Label '(Reg 1) UpperBound)
+ (list '!*Lbl ExitLabel)))))
+
+(DefCMacro !*JumpWithin)
+
+(de !*ProgBind (FluidsList)
+ (!*LamBind '(Registers) FluidsList))
+
+(DefCMacro !*ProgBind)
+
+(de !*FreeRstr (FluidsList)
+ (Expand1OperandCMacro (length (cdr FluidsList)) '!*FreeRstr))
+
+(de !*Jump (Arg1)
+ (Expand1OperandCMacro Arg1 '!*Jump))
+
+(de !*Lbl (Arg1)
+ (cdr Arg1))
+
+(de !*Push (Arg1)
+ (Expand1OperandCMacro Arg1 '!*Push))
+
+(de !*Pop (Arg1)
+ (Expand1OperandCMacro Arg1 '!*Pop))
+
+(de !*Move (Source Destination)
+ (prog (ResultingCode!* ResolvedDestination)
+ (setq ResolvedDestination (ResolveOperand '(REG t2) Destination))
+ (return
+ (CMacroPatternExpand
+ (list (ResolveOperand (cond ((RegisterP ResolvedDestination)
+ ResolvedDestination)
+ (t '(REG t1)))
+ Source)
+ ResolvedDestination)
+ (get '!*Move 'CMacroPatternTable)))))
+
+(de !*JumpEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpEQ))
+
+(de !*JumpNotEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpNotEQ))
+
+(de !*JumpWLessP (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWLessP))
+
+(de !*JumpWGreaterP (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWGreaterP))
+
+(de !*JumpWLEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWLEQ))
+
+(de !*JumpWGEQ (Label Arg1 Arg2)
+ (Expand2OperandAndLabelCMacro Arg1 Arg2 Label '!*JumpWGEQ))
+
+(de !*JumpType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpType))
+
+(de !*JumpNotType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpNotType))
+
+(de !*JumpInType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpInType))
+
+(de !*JumpNotInType (Label Arg TypeTag)
+ (Expand2OperandAndLabelCMacro Arg
+ (list 'WConst (get TypeTag 'WConst))
+ Label
+ '!*JumpNotInType))
+
+(de !*MkItem (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*MkItem))
+
+(de !*WPlus2 (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WPlus2))
+
+(de !*WDifference (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WDifference))
+
+(de !*WTimes2 (Arg1 Arg2)
+ (prog (P)
+ (return (cond ((and (or (EqCar Arg2 'Quote)
+ (EqCar Arg2 'WConst))
+ (setq P (PowerOf2P (cadr Arg2))))
+ (!*AShift Arg1 (list (car Arg2) P)))
+ (t (Expand2OperandCMacro Arg1 Arg2 '!*WTimes2))))))
+
+(* "PowerOf2P(X:integer):{integer,NIL}
+If X is a positive power of 2, log base 2 of X is returned. Otherwise
+NIL is returned.")
+
+(de PowerOf2P (X)
+ (prog (N)
+ (return (cond ((or (not (FixP X)) (MinusP X) (equal X 0)) NIL)
+ (t (progn (setq N 0)
+ (while (not (equal (lor x 1) x))
+ (progn (setq N (add1 N))
+ (setq X (lsh X -1))))
+ (cond ((equal X 1) N) (T NIL))))))))
+
+(de !*AShift (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*AShift))
+
+(de !*WShift (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WShift))
+
+(de !*WAnd (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WAnd))
+
+(de !*WOr (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WOr))
+
+(de !*WXOr (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WXOr))
+
+(de !*WMinus (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WMinus))
+
+(de !*WNot (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*WNot))
+
+(de !*Loc (Arg1 Arg2)
+ (Expand2OperandCMacro Arg1 Arg2 '!*Loc))
+
+(de !*Field (Arg1 Arg2 Arg3 Arg4)
+ (Expand4OperandCMacro Arg1 Arg2 Arg3 Arg4 '!*Field))
+
+(de !*SignedField (Arg1 Arg2 Arg3 Arg4)
+ (Expand4OperandCMacro Arg1 Arg2 Arg3 Arg4 '!*SignedField))
+
+(de !*PutField (Arg1 Arg2 Arg3 Arg4)
+ (Expand4OperandCMacro Arg1 Arg2 Arg3 Arg4 '!*PutField))
+
+(de AnyregCAR (Register Source)
+ (OneOperandAnyreg Register Source 'car))
+
+(de AnyregCDR (Register Source)
+ (OneOperandAnyreg Register Source 'cdr))
+
+(de AnyregQUOTE (Register Source)
+ (ExpandOneArgumentAnyreg Register Source 'quote))
+
+(de AnyregWVAR (Register Source)
+ (ExpandOneArgumentAnyreg Register Source 'WVar))
+
+(de AnyregREG (Register Source)
+ (ExpandOneArgumentAnyreg Register Source 'REG))
+
+(de AnyregWCONST (Register Source)
+ (OneOperandAnyreg Register Source 'WConst))
+
+(DefAnyreg WCONST
+ AnyregWCONST
+ (SOURCE))
+
+(de AnyregFRAME (Register Source)
+ (ExpandOneArgumentAnyreg Register
+ (times StackDirection
+ AddressingUnitsPerItem
+ (difference 1 Source))
+ 'Frame))
+
+(de AnyregFRAMESIZE (Register)
+ (times NAlloc!* AddressingUnitsPerItem))
+
+(DefAnyreg FrameSize
+ AnyregFRAMESIZE)
+
+(de AnyregMEMORY (Register Source ArgTwo)
+ (TwoOperandAnyreg Register Source ArgTwo 'MEMORY))
+
+(flag '(FLUID !$FLUID GLOBAL !$GLOBAL ExtraReg Label) 'TerminalOperand)
+
+
+(fluid '(labelgen*)) % a-list of tags and labels
+
+% (labelgen tag) and (labelref tag) can be used as either ANYREG or CMACRO.
+% (labelgen tag) creates and returns a unique label, (labelref tag) returns
+% the same one. Useful for 'OpenCode lists.
+
+(de anyreglabelgen (reg name)
+ ((lambda (lb al)
+ (cond ((null al)
+ (setq labelgen* (cons (cons name lb) labelgen*)))
+ (t (rplacd al lb)))
+ lb)
+ (gensym)
+ (assoc name labelgen*)))
+
+(defanyreg labelgen anyreglabelgen)
+
+(de labelgen (name)
+ (list (anyreglabelgen nil name)))
+
+(defcmacro labelgen)
+
+
+(de anyreglabelref (reg name) (cdr (assoc name labelgen*)))
+
+(defanyreg labelref anyreglabelref)
+
+(de labelref (name)
+ (list (anyreglabelref nil name)))
+
+(defcmacro labelref)
ADDED psl-1983/comp/common-predicates.sl
Index: psl-1983/comp/common-predicates.sl
==================================================================
--- /dev/null
+++ psl-1983/comp/common-predicates.sl
@@ -0,0 +1,40 @@
+(*
+"% COMMON-PREDICATES.SL - Predicates used for Anyreg and C-macro expansion
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 21 December 1981
+% Copyright (c) 1981 University of Utah
+%")
+
+(fluid '(EntryPoints!*
+ !*FastLinks))
+
+(global '(!*R2I))
+
+(de RegisterP (Expression)
+ (EqCar Expression 'REG))
+
+(de AnyP (Expression)
+ T)
+
+(de TaggedLabel (X)
+ (EqCar X 'Label))
+
+(de EqTP (Expression)
+ (equal Expression T))
+
+(de MinusOneP (Expression)
+ (equal Expression -1))
+
+(de InternallyCallableP (X) % only when writing a file
+ (and (or !*WritingFaslFile (not (FUnBoundP 'AsmOut)))
+ (or !*FastLinks
+ (and !*R2I (memq X EntryPoints!*))
+ (FlagP X 'InternalFunction)
+ (FlagP X 'FastLink))))
+
+(de AddressConstantP (Expression)
+ (or (atom Expression) (equal (car Expression) 'Immediate)))
ADDED psl-1983/comp/comp-decls.build
Index: psl-1983/comp/comp-decls.build
==================================================================
--- /dev/null
+++ psl-1983/comp/comp-decls.build
@@ -0,0 +1,1 @@
+in "comp-decls.red"$
ADDED psl-1983/comp/comp-decls.red
Index: psl-1983/comp/comp-decls.red
==================================================================
--- /dev/null
+++ psl-1983/comp/comp-decls.red
@@ -0,0 +1,403 @@
+%
+% COMP-DECLS.RED - Machine-independent declaractions used by the compiler
+%
+% Author: Eric Benson
+% Symbolic Computation Group
+% Computer Science Dept.
+% University of Utah
+% Date: 16 October 1981
+% Copyright (c) 1981 University of Utah
+%
+% <PSL.COMP>COMP-DECLS.RED.16, 3-Sep-82 09:46:43, Edit by BENSON
+% Added PA1REFORMFN for WNOT
+% <PSL.COMP>COMP-DECLS.RED.5, 3-Dec-82 18:20:08, Edit by PERDUE
+% Removed PA1REFORMFN for NE
+% <PSL.COMP>COMP-DECLS.RED.6, 24-Jan-83 16:04:00, Edit by MLGriss
+% Changed W to !%!%!%W in the EQCAR to avoid subst W into EQCAR form
+
+% Pass 1 functions
+
+put('Apply, 'PA1FN, '!&PaApply);
+PUT('ASSOC, 'PA1FN, '!&PAASSOC);
+PUT('EQUAL, 'PA1FN, '!&PAEQUAL);
+PUT('MEMBER, 'PA1FN, '!&PAMEMBER);
+put('Catch, 'Pa1Fn, '!&PaCatch);
+PUT('COND, 'PA1FN, '!&PACOND);
+PUT('DIFFERENCE,'PA1FN, '!&PADIFF);
+PUT('FUNCTION, 'PA1FN, '!&PAFUNCTION);
+PUT('GETMEM, 'PA1FN, '!&PAGETMEM);
+PUT('GO, 'PA1FN, '!&PAIDENT);
+PUT('CASE, 'PA1FN, '!&PACASE);
+PUT('INTERN, 'PA1FN, '!&PAINTERN);
+PUT('LAMBDA, 'PA1FN, '!&PALAMBDA);
+PUT('LESSP, 'PA1FN, '!&PALESSP);
+PUT('LIST, 'PA1FN, '!&PALIST);
+PUT('LOC, 'PA1REFORMFN, '!&REFORMLOC);
+PUT('MAP, 'PA1FN, '!&PAMAP);
+PUT('MAPC, 'PA1FN, '!&PAMAPC);
+PUT('MAPCAN, 'PA1FN, '!&PAMAPCAN);
+PUT('MAPCAR, 'PA1FN, '!&PAMAPCAR);
+PUT('MAPCON, 'PA1FN, '!&PAMAPCON);
+PUT('MAPLIST, 'PA1FN, '!&PAMAPLIST);
+PUT('MINUS, 'PA1FN, '!&PAMINUS);
+PUT('NULL, 'PA1REFORMFN, '!&REFORMNULL);
+% PUT('NE, 'PA1REFORMFN, '!&REFORMNE); % Perdue 12/3/82
+put('Nth, 'Pa1Fn, '!&PaNth);
+put('PNth, 'Pa1Fn, '!&PaPNth);
+PUT('PLUS2, 'PA1FN, '!&PAPLUS2);
+PUT('PROG, 'PA1FN, '!&PAPROG);
+PUT('PUTMEM, 'PA1FN, '!&PAPUTMEM);
+PUT('PUTLISPVAR,'PA1FN, '!&PAPUTLISPVAR);
+PUT('LISPVAR, 'PA1FN, '!&PALISPVAR);
+PUT('QUOTE, 'PA1FN, '!&PAIDENT);
+PUT('WCONST, 'PA1FN, '!&PAWCONST);
+PUT('SETQ, 'PA1FN, '!&PASETQ);
+PUT('WPLUS2, 'PA1FN, '!&GROUP);
+PUT('WDIFFERENCE,'PA1FN, '!&GROUP);
+PUT('WMINUS, 'PA1FN, '!&GROUP);
+PUT('WTIMES2, 'PA1FN, '!&ASSOCOP);
+PUT('WAND, 'PA1FN, '!&ASSOCOP);
+PUT('WOR, 'PA1FN, '!&ASSOCOP);
+PUT('WXOR, 'PA1FN, '!&ASSOCOP);
+PUT('WPLUS2, 'PA1ALGFN, '!&GROUPV);
+PUT('WDIFFERENCE,'PA1ALGFN, '!&GROUPV);
+PUT('WMINUS, 'PA1ALGFN, '!&GROUPV);
+PUT('WTIMES2, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WAND, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WOR, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WXOR, 'PA1ALGFN, '!&ASSOCOPV);
+PUT('WSHIFT, 'PA1REFORMFN, '!&DOOP);
+PUT('WNOT, 'PA1REFORMFN, '!&DOOP);
+put('WTimes2, 'PA1Reformfn, function !&PaReformWTimes2);
+
+% Simplification
+PUT('WPLUS2, 'DOFN, 'PLUS2);
+PUT('WDIFFERENCE,'DOFN, 'DIFFERENCE);
+PUT('WMINUS, 'DOFN, 'MINUS);
+PUT('WTIMES2, 'DOFN, 'TIMES2);
+PUT('WQUOTIENT, 'DOFN, 'QUOTIENT);
+PUT('WREMAINDER,'DOFN, 'REMAINDER);
+PUT('WAND, 'DOFN, 'LAND);
+PUT('WOR, 'DOFN, 'LOR);
+PUT('WXOR, 'DOFN, 'LXOR);
+PUT('WNOT, 'DOFN, 'LNOT);
+PUT('WSHIFT, 'DOFN, 'LSHIFT);
+
+PUT('WTIMES2, 'ONE, 1);
+PUT('WTIMES2, 'ZERO, 0);
+PUT('WPLUS2, 'ONE, 0);
+PUT('WPLUS2, 'GROUPOPS, '(WPLUS2 WDIFFERENCE WMINUS));
+PUT('WMINUS, 'GROUPOPS, '(WPLUS2 WDIFFERENCE WMINUS));
+PUT('WDIFFERENCE,'GROUPOPS, '(WPLUS2 WDIFFERENCE WMINUS));
+PUT('WAND, 'ZERO, 0);
+PUT('WOR, 'ONE, 0);
+PUT('WXOR, 'ONE, 0);
+
+% Compile functions
+
+PUT('AND, 'COMPFN, '!&COMANDOR);
+PUT('APPLY, 'COMPFN, '!&COMAPPLY);
+PUT('COND, 'COMPFN, '!&COMCOND);
+PUT('CONS, 'COMPFN, '!&COMCONS);
+PUT('GO, 'COMPFN, '!&COMGO);
+PUT('CASE, 'COMPFN, '!&COMCASE);
+PUT('OR, 'COMPFN, '!&COMANDOR);
+PUT('PROG, 'COMPFN, '!&COMPROG);
+PUT('PROG2, 'COMPFN, '!&COMPROGN);
+PUT('PROGN, 'COMPFN, '!&COMPROGN);
+PUT('RETURN, 'COMPFN, '!&COMRETURN);
+
+% Patterns for the tests and SETQ
+
+PUT('EQ, 'OPENTST, '(TSTPAT !*JUMPEQ));
+PUT('EQ, 'OPENFN, '(TVPAT !*JUMPEQ));
+PUT('NE, 'OPENTST, '(TSTPAT !*JUMPNOTEQ));
+PUT('NE, 'OPENFN, '(TVPAT !*JUMPNOTEQ));
+PUT('AND, 'OPENTST, '!&TSTANDOR);
+PUT('OR, 'OPENTST, '!&TSTANDOR);
+PUT('PAIRP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE PAIR));
+PUT('ATOM, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE PAIR));
+PUT('STRINGP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE STR));
+PUT('NOTSTRINGP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE STR));
+PUT('VECTORP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE VECT));
+PUT('NOTVECTORP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE VECT));
+PUT('CODEP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE CODE));
+PUT('NOTCODEP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE CODE));
+PUT('FLOATP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE FLTN));
+PUT('NOTFLOATP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE FLTN));
+PUT('INTP, 'OPENTST, '(TSTPAT2 !*JUMPINTYPE POSINT));
+PUT('NOTINTP, 'OPENTST, '(TSTPAT2 !*JUMPNOTINTYPE POSINT));
+PUT('FIXP, 'OPENTST, '(TSTPAT2 !*JUMPINTYPE BIGN));
+PUT('NOTFIXP, 'OPENTST, '(TSTPAT2 !*JUMPNOTINTYPE BIGN));
+PUT('NUMBERP, 'OPENTST, '(TSTPAT2 !*JUMPINTYPE FLTN));
+PUT('NOTNUMBERP,'OPENTST, '(TSTPAT2 !*JUMPNOTINTYPE FLTN));
+PUT('FIXNP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE FIXN));
+PUT('NOTFIXNP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE FIXN));
+PUT('BIGP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE BIGN));
+PUT('NOTBIGP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE BIGN));
+PUT('POSINTP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE POSINT));
+PUT('NOTPOSINTP,'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE POSINT));
+PUT('NEGINTP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE NEGINT));
+PUT('NOTNEGINTP,'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE NEGINT));
+PUT('IDP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE ID));
+PUT('NOTIDP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE ID));
+PUT('BYTESP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE BYTES));
+PUT('NOTBYTESP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE BYTES));
+PUT('WRDSP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE WRDS));
+PUT('NOTWRDSP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE WRDS));
+PUT('HALFWORDSP, 'OPENTST, '(TSTPAT2 !*JUMPTYPE HALFWORDS));
+PUT('NOTHALFWORDSP, 'OPENTST, '(TSTPAT2 !*JUMPNOTTYPE HALFWORDS));
+PUT('PAIRP, 'OPENFN, '(TVPAT1 !*JUMPTYPE PAIR));
+PUT('ATOM, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE PAIR));
+PUT('STRINGP, 'OPENFN, '(TVPAT1 !*JUMPTYPE STR));
+PUT('NOTSTRINGP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE STR));
+PUT('VECTORP, 'OPENFN, '(TVPAT1 !*JUMPTYPE VECT));
+PUT('NOTVECTORP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE VECT));
+PUT('CODEP, 'OPENFN, '(TVPAT1 !*JUMPTYPE CODE));
+PUT('NOTCODEP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE CODE));
+PUT('FLOATP, 'OPENFN, '(TVPAT1 !*JUMPTYPE FLTN));
+PUT('NOTFLOATP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE FLTN));
+PUT('INTP, 'OPENFN, '(TVPAT1 !*JUMPINTYPE POSINT));
+PUT('NOTINTP, 'OPENFN, '(TVPAT1 !*JUMPNOTINTYPE POSINT));
+PUT('FIXP, 'OPENFN, '(TVPAT1 !*JUMPINTYPE BIGN));
+PUT('NOTFIXP, 'OPENFN, '(TVPAT1 !*JUMPNOTINTYPE BIGN));
+PUT('NUMBERP, 'OPENFN, '(TVPAT1 !*JUMPINTYPE FLTN));
+PUT('NOTNUMBERP,'OPENFN, '(TVPAT1 !*JUMPNOTINTYPE FLTN));
+PUT('FIXNP, 'OPENFN, '(TVPAT1 !*JUMPTYPE FIXN));
+PUT('NOTFIXNP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE FIXN));
+PUT('BIGP, 'OPENFN, '(TVPAT1 !*JUMPTYPE BIGN));
+PUT('NOTBIGP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE BIGN));
+PUT('POSINTP, 'OPENFN, '(TVPAT1 !*JUMPTYPE POSINT));
+PUT('NOTPOSINTP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE POSINT));
+PUT('NEGINTP, 'OPENFN, '(TVPAT1 !*JUMPTYPE NEGINT));
+PUT('NOTNEGINTP,'OPENFN, '(TVPAT1 !*JUMPNOTTYPE NEGINT));
+PUT('IDP, 'OPENFN, '(TVPAT1 !*JUMPTYPE ID));
+PUT('NOTIDP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE ID));
+PUT('BYTESP, 'OPENFN, '(TVPAT1 !*JUMPTYPE BYTES));
+PUT('NOTBYTESP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE BYTES));
+PUT('WRDSP, 'OPENFN, '(TVPAT1 !*JUMPTYPE WRDS));
+PUT('NOTWRDSP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE WRDS));
+PUT('HALFWORDSP, 'OPENFN, '(TVPAT1 !*JUMPTYPE HALFWORDS));
+PUT('NOTHALFWORDSP, 'OPENFN, '(TVPAT1 !*JUMPNOTTYPE HALFWORDS));
+PUT('SETQ, 'OPENFN, '(SETQPAT NIL));
+PUT('RPLACA, 'OPENFN, '(RPLACPAT CAR));
+PUT('RPLACD, 'OPENFN, '(RPLACPAT CDR));
+PUT('WPLUS2, 'OPENFN, '(ASSOCPAT !*WPLUS2));
+PUT('WDIFFERENCE,'OPENFN, '(SUBPAT !*WDIFFERENCE));
+PUT('WTIMES2, 'OPENFN, '(ASSOCPAT !*WTIMES2));
+PUT('WMINUS, 'OPENFN, '(UNARYPAT !*WMINUS));
+PUT('WAND, 'OPENFN, '(ASSOCPAT !*WAND));
+PUT('WOR, 'OPENFN, '(ASSOCPAT !*WOR));
+PUT('WXOR, 'OPENFN, '(ASSOCPAT !*WXOR));
+PUT('WNOT, 'OPENFN, '(UNARYPAT !*WNOT));
+PUT('WSHIFT, 'OPENFN, '(NONASSOCPAT !*WSHIFT));
+PUT('MKITEMREV, 'OPENFN, '(NONASSOCPAT !*MKITEM));
+PUT('LOC, 'OPENFN, '(UNARYPAT !*LOC));
+PUT('!*ADDMEM, 'OPENFN, '(MODMEMPAT !*ADDMEM));
+PUT('!*MPYMEM, 'OPENFN, '(MODMEMPAT !*MPYMEM));
+PUT('FIELD, 'OPENFN, '(FIELDPAT !*FIELD));
+PUT('SIGNEDFIELD,'OPENFN, '(FIELDPAT !*SIGNEDFIELD));
+PUT('PUTFIELDREV,'OPENFN, '(PUTFIELDPAT !*PUTFIELD));
+PUT('WGREATERP,'OPENTST, '(TSTPATC !*JUMPWGREATERP !*JUMPWLESSP));
+PUT('WLEQ, 'OPENTST, '(TSTPATC !*JUMPWLEQ !*JUMPWGEQ));
+PUT('WGEQ, 'OPENTST, '(TSTPATC !*JUMPWGEQ !*JUMPWLEQ));
+PUT('WLESSP, 'OPENTST, '(TSTPATC !*JUMPWLESSP !*JUMPWGREATERP));
+PUT('WGREATERP, 'OPENFN, '(TVPAT !*JUMPWGREATERP));
+PUT('WLEQ, 'OPENFN, '(TVPAT !*JUMPWLEQ));
+PUT('WGEQ, 'OPENFN, '(TVPAT !*JUMPWGEQ));
+PUT('WLESSP, 'OPENFN, '(TVPAT !*JUMPWLESSP));
+
+PUT('EQ,'FLIPTST,'NE);
+PUT('NE,'FLIPTST,'EQ);
+PUT('ATOM,'FLIPTST,'PAIRP);
+PUT('PAIRP,'FLIPTST,'ATOM);
+PUT('STRINGP,'FLIPTST,'NOTSTRINGP);
+PUT('NOTSTRINGP,'FLIPTST,'STRINGP);
+PUT('BytesP,'FLIPTST,'NOTBytesP);
+PUT('NOTBytesP,'FLIPTST,'BytesP);
+PUT('WrdsP,'FLIPTST,'NOTWrdsP);
+PUT('NOTWrdsP,'FLIPTST,'WrdsP);
+PUT('HalfwordsP,'FLIPTST,'NOTHalfwordsP);
+PUT('NOTHalfwordsP,'FLIPTST,'HalfwordsP);
+PUT('CODEP,'FLIPTST,'NOTCODEP);
+PUT('NOTCODEP, 'FLIPTST,'CODEP);
+PUT('IDP,'FLIPTST,'NOTIDP);
+PUT('NOTIDP,'FLIPTST,'IDP);
+PUT('INTP,'FLIPTST,'NOTINTP);
+PUT('NOTINTP,'FLIPTST,'INTP);
+PUT('POSINTP,'FLIPTST,'NOTPOSINTP);
+PUT('NOTPOSINTP,'FLIPTST,'POSINTP);
+PUT('NEGINTP,'FLIPTST,'NOTNEGINTP);
+PUT('NOTNEGINTP,'FLIPTST,'NEGINTP);
+PUT('FIXP,'FLIPTST,'NOTFIXP);
+PUT('NOTFIXP,'FLIPTST,'FIXP);
+PUT('NUMBERP,'FLIPTST,'NOTNUMBERP);
+PUT('NOTNUMBERP,'FLIPTST,'NUMBERP);
+PUT('FIXNP,'FLIPTST,'NOTFIXNP);
+PUT('NOTFIXNP,'FLIPTST,'FIXNP);
+PUT('FLOATP,'FLIPTST,'NOTFLOATP);
+PUT('NOTFLOATP,'FLIPTST,'FLOATP);
+PUT('BIGP,'FLIPTST,'NOTBIGP);
+PUT('NOTBIGP,'FLIPTST,'BIGP);
+PUT('VECTORP,'FLIPTST,'NOTVECTORP);
+PUT('NOTVECTORP,'FLIPTST,'VECTORP);
+PUT('WLESSP,'FLIPTST,'WGEQ);
+PUT('WGEQ,'FLIPTST,'WLESSP);
+PUT('WLEQ,'FLIPTST,'WGREATERP);
+PUT('WGREATERP,'FLIPTST,'WLEQ);
+
+% Match functions
+
+PUT('ANY,'MATCHFN,'!&ANY);
+PUT('VAR,'MATCHFN,'!&VAR);
+PUT('REG,'MATCHFN,'!®FP);
+PUT('DEST,'MATCHFN,'!&DEST);
+PUT('USESDEST,'MATCHFN,'!&USESDEST);
+PUT('REGN,'MATCHFN,'!®N);
+PUT('NOTDEST,'MATCHFN,'!&NOTDEST);
+PUT('NOTANYREG,'MATCHFN,'!&NOTANYREG);
+PUT('MEM,'MATCHFN,'!&MEM);
+PUT('ANYREGFN,'MATCHFN,'!&ANYREGFNP);
+
+% Tag properties
+
+FLAG('(!$LOCAL !$GLOBAL !$FLUID QUOTE WCONST IDLOC WVAR
+ REG LABEL FRAME !*FRAMESIZE IREG),
+ 'TERMINAL);
+FLAG('(!$LOCAL !$GLOBAL !$FLUID WVAR),'VAR);
+FLAG('(QUOTE WCONST IDLOC FRAMESIZE),'CONST);
+FLAG('(REG),'REG);
+FLAG('(!$FLUID !$GLOBAL),'EXTVAR);
+FLAG('(CAR CDR !$NAME MEMORY FRAMESIZE), 'ANYREG);
+
+FLAG('(!*ADDMEM !*MPYMEM),'MEMMOD);
+
+% Optimizing functions
+
+PUT('!*LBL, 'OPTFN, '!&LBLOPT);
+PUT('!*MOVE, 'OPTFN, '!&STOPT);
+PUT('!*JUMP, 'OPTFN, '!&JUMPOPT);
+
+% Things which can be compiled
+
+FLAG('(EXPR FEXPR MACRO NEXPR),'COMPILE);
+
+% Some compiler macros
+
+DEFLIST('((CAAR (LAMBDA (U) (CAR (CAR U))))
+ (CADR (LAMBDA (U) (CAR (CDR U))))
+ (CDAR (LAMBDA (U) (CDR (CAR U))))
+ (CDDR (LAMBDA (U) (CDR (CDR U))))
+ (CAAAR (LAMBDA (U) (CAR (CAR (CAR U)))))
+ (CAADR (LAMBDA (U) (CAR (CAR (CDR U)))))
+ (CADAR (LAMBDA (U) (CAR (CDR (CAR U)))))
+ (CADDR (LAMBDA (U) (CAR (CDR (CDR U)))))
+ (CDAAR (LAMBDA (U) (CDR (CAR (CAR U)))))
+ (CDADR (LAMBDA (U) (CDR (CAR (CDR U)))))
+ (CDDAR (LAMBDA (U) (CDR (CDR (CAR U)))))
+ (CDDDR (LAMBDA (U) (CDR (CDR (CDR U)))))
+ (EQCAR (LAMBDA (U V)
+ ((LAMBDA (!%!%!%W) (AND (PAIRP !%!%!%W)
+ (EQ (CAR !%!%!%W) V))) U)))
+ (CONSTANTP (LAMBDA (U)
+ ((LAMBDA (V) (NOT (OR (PAIRP V) (IDP V))))
+ U)))
+ (WEQ (LAMBDA (U V) (EQ U V)))
+ (WNEQ (LAMBDA (U V) (NE U V)))
+ (IPLUS2 (LAMBDA (U V) (WPLUS2 U V)))
+ (IADD1 (LAMBDA (U) (WPLUS2 U 1)))
+ (IDIFFERENCE (LAMBDA (U V) (WDIFFERENCE U V)))
+ (ISUB1 (LAMBDA (U) (WDIFFERENCE U 1)))
+ (ITIMES2 (LAMBDA (U V) (WTIMES2 U V)))
+ (IQUOTIENT (LAMBDA (U V) (WQUOTIENT U V)))
+ (IREMAINDER (LAMBDA (U V) (WREMAINDER U V)))
+ (IGREATERP (LAMBDA (U V) (WGREATERP U V)))
+ (ILESSP (LAMBDA (U V) (WLESSP U V)))
+ (ILEQ (LAMBDA (U V) (WLEQ U V)))
+ (IGEQ (LAMBDA (U V) (WGEQ U V)))
+ (ILOR (LAMBDA (U V) (WOR U V)))
+ (ILSH (LAMBDA (U V) (WSHIFT U V)))
+ (ILAND (LAMBDA (U V) (WAND U V)))
+ (ILXOR (LAMBDA (U V) (WXOR U V)))
+ (IZEROP (LAMBDA (U) (EQ U 0)))
+ (IONEP (LAMBDA (U) (EQ U 1)))
+ (IMINUSP (LAMBDA (U) (WLESSP U 0)))
+ (IMINUS (LAMBDA (U) (WMINUS U)))
+ (PUTFIELD (LAMBDA (U V W X) (PUTFIELDREV X U V W)))
+ (MKITEM (LAMBDA (U V) (MKITEMREV V U)))
+ (NEQ (LAMBDA (U V) (NOT (EQUAL U V))))
+ (GEQ (LAMBDA (U V) (NOT (LESSP U V))))
+ (LEQ (LAMBDA (U V) (NOT (GREATERP U V))))
+ (NOT (LAMBDA (U) (NULL U)))),'CMACRO);
+
+% Macro functions
+
+PUT('A1,'SUBSTFN,'!&ARG1);
+PUT('A2,'SUBSTFN,'!&ARG2);
+PUT('A3,'SUBSTFN,'!&ARG3);
+PUT('A4,'SUBSTFN,'!&ARG4);
+PUT('FN,'SUBSTFN,'!&PARAM1);
+PUT('MAC,'SUBSTFN,'!&PARAM2);
+PUT('P2,'SUBSTFN,'!&PARAM3);
+PUT('P3,'SUBSTFN,'!&PARAM4);
+PUT('T1,'SUBSTFN,'!&GETTEMP);
+PUT('T2,'SUBSTFN,'!&GETTEMP);
+PUT('T3,'SUBSTFN,'!&GETTEMP);
+PUT('T4,'SUBSTFN,'!&GETTEMP);
+PUT('L1,'SUBSTFN,'!&GETTEMPLBL);
+PUT('L2,'SUBSTFN,'!&GETTEMPLBL);
+PUT('L3,'SUBSTFN,'!&GETTEMPLBL);
+PUT('L4,'SUBSTFN,'!&GETTEMPLBL);
+
+% Emit functions
+
+PUT('!*LOAD,'EMITFN,'!&EMITLOAD);
+PUT('!*STORE,'EMITFN,'!&EMITSTORE);
+PUT('!*JUMP,'EMITFN,'!&EMITJUMP);
+PUT('!*LBL,'EMITFN,'!&EMITLBL);
+PUT('!*ADDMEM,'EMITFN,'!&EMITMEMMOD);
+PUT('!*MPYMEM,'EMITFN,'!&EMITMEMMOD);
+PUT('!*ADDMEM, 'UNMEMMOD, '!*WPLUS2);
+PUT('!*MPYMEM, 'UNMEMMOD, '!*WTIMES2);
+
+% In memory operations
+
+PUT('WPLUS2,'MEMMODFN,'!*ADDMEM);
+PUT('WTIMES2,'MEMMODFN,'!*MPYMEM);
+
+% Flip jump for conditional jump macros
+
+PUT('!*JUMPEQ,'NEGJMP,'!*JUMPNOTEQ);
+PUT('!*JUMPNOTEQ,'NEGJMP,'!*JUMPEQ);
+PUT('!*JUMPTYPE,'NEGJMP,'!*JUMPNOTTYPE);
+PUT('!*JUMPNOTTYPE,'NEGJMP,'!*JUMPTYPE);
+PUT('!*JUMPINTYPE,'NEGJMP,'!*JUMPNOTINTYPE);
+PUT('!*JUMPNOTINTYPE,'NEGJMP,'!*JUMPINTYPE);
+PUT('!*JUMPWEQ,'NEGJMP,'!*JUMPWNEQ);
+PUT('!*JUMPWNEQ,'NEGJMP,'!*JUMPWEQ);
+PUT('!*JUMPWLESSP,'NEGJMP,'!*JUMPWGEQ);
+PUT('!*JUMPWGEQ,'NEGJMP,'!*JUMPWLESSP);
+PUT('!*JUMPWLEQ,'NEGJMP,'!*JUMPWGREATERP);
+PUT('!*JUMPWGREATERP,'NEGJMP,'!*JUMPWLEQ);
+
+% Assorted other flags
+
+FLAG('(!*JUMP !*LINKE !*EXIT),'TRANSFER);
+FLAG('(!*LINK !*LINKE),'UNKNOWNUSE);
+PUT('!*LINK, 'EXITING, '!*LINKE);
+
+% Initialize variables
+!*MSG := T; % Do print messages
+!*INSTALLDESTROY := NIL;
+!*USINGDESTROY := T;
+!*SHOWDEST := NIL;
+!*NOFRAMEFLUID := T;
+!*USEREGFLUID := NIL;
+!*NOLINKE := NIL; %. Permit LINKE
+!*ORD := NIL; %. Dont force ORDER
+!*R2I := T; %. Do convert Rec to Iter
+GLOBALGENSYM!&:=LIST GENSYM(); % initialize symbol list
+MAXNARGS!&:=15;
+LASTACTUALREG!& := 5;
+
+END;
ADDED psl-1983/comp/compiler.build
Index: psl-1983/comp/compiler.build
==================================================================
--- /dev/null
+++ psl-1983/comp/compiler.build
@@ -0,0 +1,15 @@
+CompileTime <<
+load If!-System;
+>>;
+if_system(PDP10, <<
+imports '(comp!-decls pass!-1!-lap
+ dec20!-lap dec20!-cmac faslout);
+if_system(KL10, NIL, imports '(non!-kl!-comp));
+>>);
+if_system(VAX,
+imports '(comp!-decls pass!-1!-lap
+ vax!-lap vax!-cmac faslout));
+if_system(HP9836,
+imports '(comp!-decls pass!-1!-lap
+ hp!-lap hp!-cmac hp!-comp faslout));
+in "compiler.red"$
ADDED psl-1983/comp/compiler.ctl
Index: psl-1983/comp/compiler.ctl
==================================================================
--- /dev/null
+++ psl-1983/comp/compiler.ctl
@@ -0,0 +1,5 @@
+psl:rlisp
+loaddirectories!*:='("pl:");
+load build;
+build 'compiler;
+quit;
ADDED psl-1983/comp/compiler.log
Index: psl-1983/comp/compiler.log
==================================================================
--- /dev/null
+++ psl-1983/comp/compiler.log
cannot compute difference between binary files
ADDED psl-1983/comp/compiler.red
Index: psl-1983/comp/compiler.red
==================================================================
--- /dev/null
+++ psl-1983/comp/compiler.red
@@ -0,0 +1,2706 @@
+% MLG: 15 Dec
+% added additional arguments to
+% Compiler BUG message in &LOCATE to get more info
+% <PSL.COMP>COMPILER.RED.19, 3-Dec-82 18:21:21, Edit by PERDUE
+% Removed REFORMNE, which was over-optimizing sometimes
+% <PSL.COMP>COMPILER.RED.18, 1-Dec-82 15:59:45, Edit by BENSON
+% Fixed car of atom bug in &PaApply
+% New extended compiler for PSL
+% John Peterson 4-5-81
+
+% <PSL.COMP>COMPILER.RED.4, 20-Sep-82 11:40:31, Edit by BENSON
+% Slight improvement to "FOO not compiled" messages
+% <PSL.COMP>COMPILER.RED.2, 20-Sep-82 10:32:51, Edit by BENSON
+% (DE FOO (LIST) (LIST LIST)) does the right thing
+% <PSL.COMP>COMPILER.RED.10, 10-Sep-82 12:43:27, Edit by BENSON
+% NONLOCALSYS calls NONLOCALLISP if not WVAR or WARRAY
+% <PSL.COMP>COMPILER.RED.9, 10-Sep-82 09:53:08, Edit by BENSON
+% Changed error and warning messages
+
+CompileTime flag(
+'(!&COMPERROR !&COMPWARN !&IREG
+!&ADDRVALS !&ALLARGS1 !&ALLCONST !&ANYREG !&ANYREGL !&ANYREGP
+!&ARGLOC !&ASSOCOP1 !&ASSOCOP2 !&ATTACH !&ATTJMP !&ATTLBL !&CALL
+!&CALL1 !&CALLOPEN !&CFNTYPE !&CLASSMEMBER !&CLRSTR !&COMLIS !&COMLIS1
+!&COMOPENTST !&COMPLY !&COMTST !&COMVAL !&COMVAL1 !&CONSTTAG
+!&DEFEQLBL !&DEFEQLBL1 !&DELARG !&DELCLASS !&DELETEMAC !&DELMAC
+!&EMITMAC !&EQP !&EQPL !&EQVP !&EXTERNALVARP !&FIXCHAINS !&FIXFRM
+!&FIXLABS !&FIXLINKS !&FIXREGTEST1
+!&FRAME !&FREERSTR !&GENLBL !&GENSYM !&GETFRAMES
+!&GETFRAMES1 !&GETFRAMES2 !&GETFRM !&GETFVAR !&GETGROUPARGS !&GETGROUPARGS1
+!&GETGROUPARGS2 !&GETLBL !&GETNUM !&HIGHEST !&HIGHEST1 !&HIGHEST2
+!&INALL !&INSERTMAC !&INSOP !&INSOP1 !&INSTALLDESTROY !&INSTBL !&JUMPNIL
+!&JUMPT !&LABCLASS !&LBLEQ !&LOADARGS !&LOADOPENEXP !&LOADTEMP1 !&LOADTEMP2
+!&LOADTEMPREG !&LOCATE !&LOCATEL !&LREG !&LREG1 !&MACROSUBST !&MACROSUBST1
+!&MACROSUBST2 !&MAKEADDRESS !&MAKEXP !&MATCHES !&MEMADDRESS !&MKFRAME
+!&MKFUNC !&MKNAM !&MKPROGN !&MKREG !&MOVEJUMP &NOANYREG1
+!&NOSIDEEFFECTP !&NOSIDEEFFECTPL !&OPENFNP !&OPENP !&OPENPL
+!&PA1V !&PALISV
+!&PA1X !&PAASSOC1 !&PAEQUAL1 !&PALIS !&PAMAPCOLLECT !&PAMAPCONC !&PAMAPDO
+!&PAMEMBER1 !&PANONLOCAL !&PAPROGBOD !&PASS1 !&PASS2 !&PASS3 !&